Changeset 4680


Ignore:
Timestamp:
11/08/03 18:08:05 (18 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

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

    r4679 r4680  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.18 2003-11-08 16:43:59 piso Exp $
     4;;; $Id: jvm.lisp,v 1.19 2003-11-08 18:08:05 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    411411  (unless (listp args)
    412412    (setq args (list args)))
    413   (make-instruction :opcode opcode :args args :stack 0))
     413  (make-instruction :opcode opcode :args args :stack nil))
    414414
    415415(defun emit (instr &rest args)
     
    484484        "Lorg/armedbear/lisp/Symbol;"))
    485485
     486(defun emit-invokestatic (class-name method-name descriptor stack)
     487  (assert stack)
     488  (let ((instruction (emit 'invokestatic class-name method-name descriptor)))
     489    (setf (instruction-stack instruction) stack)
     490    (assert (eql (instruction-stack instruction) stack))))
     491
     492(defun emit-invokespecial (class-name method-name descriptor stack)
     493  (let ((instruction (emit 'invokespecial class-name method-name descriptor)))
     494    (setf (instruction-stack instruction) stack)))
     495
     496(defun emit-invokevirtual (class-name method-name descriptor stack)
     497  (let ((instruction (emit 'invokevirtual class-name method-name descriptor)))
     498    (setf (instruction-stack instruction) stack)))
     499
    486500;; Index of local variable used to hold the current thread.
    487501(defvar *thread* nil)
     
    496510    (let ((code *code*))
    497511      (setf *code* ())
    498       (emit 'invokestatic
    499             +lisp-thread-class+
    500             "currentThread"
    501             "()Lorg/armedbear/lisp/LispThread;")
     512      (emit-invokestatic +lisp-thread-class+
     513                         "currentThread"
     514                         "()Lorg/armedbear/lisp/LispThread;"
     515                         1)
    502516      (emit 'astore *thread*)
    503517      (setf *code* (append code *code*)))
    504518    (setf *thread-var-initialized* t)))
    505 
    506 (defun emit-invokevirtual (class-name method-name descriptor stack)
    507   (emit 'invokevirtual class-name method-name descriptor))
    508519
    509520(defun emit-clear-values ()
     
    588599        )
    589600       (let ((index (pool-method (first args) (second args) (third args))))
    590          (inst opcode (u2 index))))
     601;;          (inst opcode (u2 index))))
     602         (setf (instruction-args instruction) (u2 index))
     603         instruction))
    591604      ((189 ; ANEWARRAY class-name
    592605        )
     
    630643    '(153 ; IFEQ
    631644      154 ; IFNE
     645      165 ; IF_ACMPEQ
    632646      166 ; IF_ACMPNE
    633       165 ; IF_ACMPEQ
    634647      167 ; GOTO
    635648      )))
    636649
     650(defun stack-effect (opcode)
     651  (case opcode
     652    ((25 ; ALOAD
     653      42 ; ALOAD_0
     654      43 ; ALOAD_1
     655      44 ; ALOAD_2
     656      45 ; ALOAD_3
     657      )
     658     1)
     659    ((58 ; ASTORE
     660      75 ; ASTORE_0
     661      76 ; ASTORE_1
     662      77 ; ASTORE_2
     663      78 ; ASTORE_3
     664      )
     665     -1)
     666    (50 ; AALOAD
     667     -1)
     668    (83 ; AASTORE
     669     -3)
     670    ((1 ; ACONST_NULL
     671      3 4 5 6 7 8 ; ICONST_0 ... ICONST_5
     672      16 ; BIPUSH
     673      17 ; SIPUSH
     674      )
     675     1)
     676    (18 ; LDC
     677     1)
     678    (178 ; GETSTATIC
     679     1)
     680    (179 ; PUTSTATIC
     681     -1)
     682    (189 ; ANEWARRAY
     683     0)
     684    ((153 ; IFEQ
     685      )
     686     -1)
     687    ((165 ; IF_ACMPEQ
     688      166 ; IF_ACMPNE
     689      )
     690     -2)
     691    ((167 ; GOTO
     692      202 ; LABEL
     693      )
     694     0)
     695    (89 ; DUP
     696     1)
     697    (95 ; SWAP
     698     0)
     699    (87 ; POP
     700     -1)
     701    (176 ; ARETURN
     702     -1)
     703    (177 ; RETURN
     704     0)
     705    (t
     706     (format t "ANALYZE-STACK unsupported opcode ~S~%"
     707             (instruction-opcode instruction))
     708     0)))
     709
    637710(defun analyze-stack (code)
    638711  (sys::require-type code 'vector)
    639   )
     712  (dotimes (i (length code))
     713    (let ((instruction (svref code i)))
     714      (unless (instruction-stack instruction)
     715        (setf (instruction-stack instruction)
     716              (stack-effect (instruction-opcode instruction)))))))
    640717
    641718;; CODE is a list of INSTRUCTIONs.
     
    791868             (emit 'ldc
    792869                   (pool-string s))
    793              (emit 'invokestatic
    794                    "org/armedbear/lisp/Lisp"
    795                    "readObjectFromString"
    796                    "(Ljava/lang/String;)Lorg/armedbear/lisp/LispObject;"))
     870             (emit-invokestatic "org/armedbear/lisp/Lisp"
     871                                "readObjectFromString"
     872                                "(Ljava/lang/String;)Lorg/armedbear/lisp/LispObject;"
     873                                0))
    797874           (emit-push-nil) ;; body
    798875           (emit 'aconst_null) ;; environment
    799            (emit 'invokespecial
    800                  super
    801                  "<init>"
    802                  "(Ljava/lang/String;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/Environment;)V"))
     876           (emit-invokespecial super
     877                               "<init>"
     878                               "(Ljava/lang/String;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/Environment;)V"
     879                               -4))
    803880          (t
    804881           (emit 'aload_0)
    805            (emit 'invokespecial
    806                  super
    807                  "<init>"
    808                  "()V")))
     882           (emit-invokespecial super
     883                               "<init>"
     884                               "()V"
     885                               0)))
    809886    (setq *code* (append *static-code* *code*))
    810887    (emit 'return)
     
    878955        (emit 'ldc
    879956              (pool-string (package-name (symbol-package symbol))))
    880         (emit 'invokestatic
    881               +lisp-class+
    882               "internInPackage"
    883               "(Ljava/lang/String;Ljava/lang/String;)Lorg/armedbear/lisp/Symbol;")
     957        (emit-invokestatic +lisp-class+
     958                           "internInPackage"
     959                           "(Ljava/lang/String;Ljava/lang/String;)Lorg/armedbear/lisp/Symbol;"
     960                           -1)
    884961        (emit 'putstatic
    885962              *this-class*
     
    909986               (emit 'ldc
    910987                     (pool-string (package-name (symbol-package symbol))))
    911                (emit 'invokestatic
    912                      +lisp-class+
    913                      "internInPackage"
    914                      "(Ljava/lang/String;Ljava/lang/String;)Lorg/armedbear/lisp/Symbol;")))
     988               (emit-invokestatic +lisp-class+
     989                                  "internInPackage"
     990                                  "(Ljava/lang/String;Ljava/lang/String;)Lorg/armedbear/lisp/Symbol;"
     991                                  -1)))
    915992        (declare-field f "Lorg/armedbear/lisp/LispObject;")
    916993        (emit-invokevirtual +lisp-symbol-class+
     
    9321009    (emit 'ldc
    9331010          (pool-string (symbol-name symbol)))
    934     (emit 'invokestatic
    935           "org/armedbear/lisp/Keyword"
    936           "internKeyword"
    937           "(Ljava/lang/String;)Lorg/armedbear/lisp/Symbol;")
     1011    (emit-invokestatic "org/armedbear/lisp/Keyword"
     1012                       "internKeyword"
     1013                       "(Ljava/lang/String;)Lorg/armedbear/lisp/Symbol;"
     1014                       0)
    9381015    (emit 'putstatic
    9391016          *this-class*
     
    9501027    (emit 'ldc
    9511028          (pool-string s))
    952     (emit 'invokestatic
    953           "org/armedbear/lisp/Lisp"
    954           "readObjectFromString"
    955           "(Ljava/lang/String;)Lorg/armedbear/lisp/LispObject;")
     1029    (emit-invokestatic +lisp-class+
     1030                       "readObjectFromString"
     1031                       "(Ljava/lang/String;)Lorg/armedbear/lisp/LispObject;"
     1032                       0)
    9561033    (emit 'putstatic
    9571034          *this-class*
     
    9731050            +lisp-string+)
    9741051      (emit 'dup)
    975       (emit 'invokestatic
    976             +lisp-class+
    977             "recall"
    978             "(Lorg/armedbear/lisp/LispString;)Lorg/armedbear/lisp/LispObject;")
     1052      (emit-invokestatic +lisp-class+
     1053                         "recall"
     1054                         "(Lorg/armedbear/lisp/LispString;)Lorg/armedbear/lisp/LispObject;"
     1055                         0)
    9791056      (emit 'putstatic
    9801057            *this-class*
    9811058            g2
    9821059            +lisp-object+)
    983       (emit 'invokestatic
    984             +lisp-class+
    985             "forget"
    986             "(Lorg/armedbear/lisp/LispString;)V")
     1060      (emit-invokestatic +lisp-class+
     1061                         "forget"
     1062                         "(Lorg/armedbear/lisp/LispString;)V"
     1063                         -1)
    9871064      (setq *static-code* *code*)
    9881065      g2)))
     
    9941071    (emit 'ldc
    9951072          (pool-string string))
    996     (emit 'invokestatic
    997           "org/armedbear/lisp/LispString"
    998           "getInstance"
    999           "(Ljava/lang/String;)Lorg/armedbear/lisp/LispString;")
     1073    (emit-invokestatic "org/armedbear/lisp/LispString"
     1074                       "getInstance"
     1075                       "(Ljava/lang/String;)Lorg/armedbear/lisp/LispString;"
     1076                       0)
    10001077    (emit 'putstatic
    10011078          *this-class*
     
    11951272     (unless (remove-store-value)
    11961273       (emit-push-value))
    1197      (emit 'invokestatic
    1198            +lisp-class+
    1199            "list2"
    1200            "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/Cons;")
     1274     (emit-invokestatic +lisp-class+
     1275                        "list2"
     1276                        "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/Cons;"
     1277                        -1)
    12011278     (emit-store-value)
    12021279     t)
     
    12181295     (unless (remove-store-value)
    12191296       (emit-push-value))
    1220      (emit 'invokestatic
    1221            +lisp-class+
    1222            "list3"
    1223            "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/Cons;")
     1297     (emit-invokestatic +lisp-class+
     1298                        "list3"
     1299                        "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/Cons;"
     1300                        -2)
    12241301     (emit-store-value)
    12251302     t)
     
    14211498  (unless (remove-store-value)
    14221499    (emit-push-value))
    1423   (emit 'invokestatic
    1424         "org/armedbear/lisp/Lisp"
    1425         "multipleValueList"
    1426         "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")
     1500  (emit-invokestatic +lisp-class+
     1501                     "multipleValueList"
     1502                     "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
     1503                     0)
    14271504  (emit-store-value))
    14281505
     
    15101587                   "Lorg/armedbear/lisp/Symbol;")
    15111588             (emit 'swap)
    1512              (emit 'invokestatic
    1513                    "org/armedbear/lisp/Lisp"
    1514                    "bindSpecialVariable"
    1515                    "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)V")))
     1589             (emit-invokestatic +lisp-class+
     1590                                "bindSpecialVariable"
     1591                                "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)V"
     1592                                -2)))
    15161593          (t
    15171594           (emit 'astore i)))))
     
    15401617                       "Lorg/armedbear/lisp/Symbol;")
    15411618                 (emit 'swap)
    1542                  (emit 'invokestatic
    1543                        "org/armedbear/lisp/Lisp"
    1544                        "bindSpecialVariable"
    1545                        "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)V")))
     1619                 (emit-invokestatic +lisp-class+
     1620                                    "bindSpecialVariable"
     1621                                    "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)V"
     1622                                    -2)))
    15461623              (t
    15471624               (emit 'astore i)
     
    16391716      (unless (remove-store-value)
    16401717        (emit-push-value))
    1641       (emit 'invokestatic
    1642             +lisp-class+
    1643             "setSpecialVariable"
    1644             "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")
     1718      (emit-invokestatic +lisp-class+
     1719                         "setSpecialVariable"
     1720                         "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
     1721                         -1)
    16451722      (emit-store-value))))
    16461723
     
    16971774                    g
    16981775                    +lisp-object+)
    1699               (emit 'invokestatic
    1700                     +lisp-class+
    1701                     "coerceToFunction"
    1702                     "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/Function;")
     1776              (emit-invokestatic +lisp-class+
     1777                                 "coerceToFunction"
     1778                                 "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/Function;"
     1779                                 0)
    17031780              (emit-store-value)))
    17041781           (t
Note: See TracChangeset for help on using the changeset viewer.