Changeset 4775


Ignore:
Timestamp:
11/16/03 01:47:08 (18 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/jvm.lisp

    r4774 r4775  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.33 2003-11-16 00:57:22 piso Exp $
     4;;; $Id: jvm.lisp,v 1.34 2003-11-16 01:47:08 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    6767    arraylength     athrow       checkcast       instanceof    monitorenter ; 190
    6868    monitorexit     wide         multianewarray  ifnull        ifnonnull    ; 195
    69     goto_w          jsr_w        label                                      ; 200
     69    goto_w          jsr_w        label           push-value    store-value  ; 200
    7070    ))
    7171
     
    421421
    422422(defmacro emit-store-value ()
    423   `(case *val*
    424      (0
    425       (emit 'astore_0))
    426      (1
    427       (emit 'astore_1))
    428      (2
    429       (emit 'astore_2))
    430      (3
    431       (emit 'astore_3))
    432      (t
    433       (emit 'astore *val*))))
     423;;   `(case *val*
     424;;      (0
     425;;       (emit 'astore_0))
     426;;      (1
     427;;       (emit 'astore_1))
     428;;      (2
     429;;       (emit 'astore_2))
     430;;      (3
     431;;       (emit 'astore_3))
     432;;      (t
     433;;       (emit 'astore *val*))))
     434  `(emit 'store-value))
    434435
    435436(defmacro emit-push-value ()
    436   `(case *val*
    437      (0
    438       (emit 'aload_0))
    439      (1
    440       (emit 'aload_1))
    441      (2
    442       (emit 'aload_2))
    443      (3
    444       (emit 'aload_3))
    445      (t
    446       (emit 'aload *val*))))
     437;;   `(case *val*
     438;;      (0
     439;;       (emit 'aload_0))
     440;;      (1
     441;;       (emit 'aload_1))
     442;;      (2
     443;;       (emit 'aload_2))
     444;;      (3
     445;;       (emit 'aload_3))
     446;;      (t
     447;;       (emit 'aload *val*))))
     448  `(emit 'push-value))
    447449
    448450(defun remove-store-value ()
     451;;   (let* ((instruction (car *code*))
     452;;          (opcode (instruction-opcode instruction))
     453;;          slot)
     454;;     (case opcode
     455;;       (75
     456;;        (setf slot 0))
     457;;       (76
     458;;        (setf slot 1))
     459;;       (77
     460;;        (setf slot 2))
     461;;       (78
     462;;        (setf slot 3))
     463;;       (58
     464;;        (setf slot (car (instruction-args instruction)))))
     465;;     (when (and slot (= slot *val*))
     466;;       (setf *code* (cdr *code*))
     467;;       t)))
    449468  (let* ((instruction (car *code*))
    450          (opcode (instruction-opcode instruction))
    451          slot)
    452     (case opcode
    453       (75
    454        (setf slot 0))
    455       (76
    456        (setf slot 1))
    457       (77
    458        (setf slot 2))
    459       (78
    460        (setf slot 3))
    461       (58
    462        (setf slot (car (instruction-args instruction)))))
    463     (when (and slot (= slot *val*))
    464       (setf *code* (cdr *code*))
    465       t)))
     469         (opcode (instruction-opcode instruction)))
     470;;     (format t "REMOVE-STORE-VALUE called opcode = ~S~%" opcode)
     471    (when (eql opcode 204) ; STORE-VALUE
     472;;       (format t "removing STORE-VALUE~%")
     473      (setf *code* (cdr *code*)))))
    466474
    467475(defconstant +lisp-class+ "org/armedbear/lisp/Lisp")
     
    538546        (args (instruction-args instruction)))
    539547    (case opcode
     548      (203 ; PUSH-VALUE
     549       (case *val*
     550         (0
     551          (inst 42)) ; ALOAD_0
     552         (1
     553          (inst 43)) ; ALOAD_1
     554         (2
     555          (inst 44)) ; ALOAD_2
     556         (3
     557          (inst 45)) ; ALOAD_3
     558         (t
     559          (inst 25 *val*))))
     560      (204 ; STORE-VALUE
     561       (case *val*
     562         (0
     563          (inst 75)) ; ASTORE_0
     564         (1
     565          (inst 76)) ; ASTORE_1
     566         (2
     567          (inst 77)) ; ASTORE_2
     568         (3
     569          (inst 78)) ; ASTORE_3
     570         (t
     571          (inst 58 *val*))))
    540572      ((1 ; ACONST_NULL
    541573        42 ; ALOAD_0
     
    652684(defun stack-effect (opcode)
    653685  (case opcode
     686    (203 ; PUSH-VALUE
     687     1)
     688    (204 ; STORE-VALUE
     689     -1)
    654690    ((25 ; ALOAD
    655691      42 ; ALOAD_0
     
    786822                                   (eq (car (instruction-args instruction))
    787823                                       (car (instruction-args next-instruction))))
     824                              ;; GOTO next instruction.
    788825                              (setf (instruction-opcode instruction) 0)
    789826                              (setf changed-p t))
Note: See TracChangeset for help on using the changeset viewer.