Changeset 4679


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

Work in progress.

File:
1 edited

Legend:

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

    r4678 r4679  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.17 2003-11-08 16:16:18 piso Exp $
     4;;; $Id: jvm.lisp,v 1.18 2003-11-08 16:43:59 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    416416  (unless (numberp instr)
    417417    (setq instr (get instr 'opcode)))
    418   (setq *code* (cons (inst instr args) *code*)))
     418  (let ((instruction (inst instr args)))
     419    (setq *code* (cons instruction *code*))
     420    instruction))
    419421
    420422(defmacro emit-store-value ()
     
    502504    (setf *thread-var-initialized* t)))
    503505
    504 (defun emit-invokevirtual (class-name method-name descriptor)
     506(defun emit-invokevirtual (class-name method-name descriptor stack)
    505507  (emit 'invokevirtual class-name method-name descriptor))
    506508
     
    508510  (ensure-thread-var-initialized)
    509511  (emit 'aload *thread*)
    510   (emit-invokevirtual +lisp-thread-class+ "clearValues" "()V"))
     512  (emit-invokevirtual +lisp-thread-class+ "clearValues" "()V" -1))
    511513
    512514(defun emit-invoke-method (method-name)
     
    515517  (emit-invokevirtual +lisp-object-class+
    516518                      method-name
    517                       "()Lorg/armedbear/lisp/LispObject;")
     519                      "()Lorg/armedbear/lisp/LispObject;"
     520                      0)
    518521  (emit-store-value))
    519522
     
    633636
    634637(defun analyze-stack (code)
    635   (require-type code vector)
     638  (sys::require-type code 'vector)
    636639  )
    637640
     
    913916        (emit-invokevirtual +lisp-symbol-class+
    914917                            "getSymbolFunctionOrDie"
    915                             "()Lorg/armedbear/lisp/LispObject;")
     918                            "()Lorg/armedbear/lisp/LispObject;"
     919                            0)
    916920        (emit 'putstatic
    917921              *this-class*
     
    10791083  (emit-invokevirtual +lisp-object-class+
    10801084                      op
    1081                       "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")
     1085                      "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
     1086                      -1)
    10821087  (emit-store-value))
    10831088
     
    12631268      (emit-invokevirtual +lisp-symbol-class+
    12641269                          "getSymbolFunctionOrDie"
    1265                           "()Lorg/armedbear/lisp/LispObject;")))
     1270                          "()Lorg/armedbear/lisp/LispObject;"
     1271                          0)))
    12661272    (case numargs
    12671273      (0
    12681274       (emit-invokevirtual +lisp-object-class+
    12691275                           "execute"
    1270                            "()Lorg/armedbear/lisp/LispObject;"))
     1276                           "()Lorg/armedbear/lisp/LispObject;"
     1277                           0))
    12711278      (1
    12721279       (compile-form (first args))
     
    12751282       (emit-invokevirtual +lisp-object-class+
    12761283                           "execute"
    1277                            "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"))
     1284                           "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
     1285                           -1))
    12781286      (2
    12791287       (compile-form (first args))
     
    12851293       (emit-invokevirtual +lisp-object-class+
    12861294                           "execute"
    1287                            "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"))
     1295                           "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
     1296                           -2))
    12881297      (3
    12891298       (compile-form (first args))
     
    12981307       (emit-invokevirtual +lisp-object-class+
    12991308                           "execute"
    1300                            "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"))
     1309                           "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
     1310                           -3))
    13011311      (t
    13021312       (emit 'sipush (length args))
     
    13141324       (emit-invokevirtual +lisp-object-class+
    13151325                           "execute"
    1316                            "([Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")))
     1326                           "([Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
     1327                           -1)))
    13171328    (if for-effect
    13181329        (emit 'pop)
     
    13501361             (emit-invokevirtual +lisp-object-class+
    13511362                                 s
    1352                                  "()Z")
     1363                                 "()Z"
     1364                                 0)
    13531365             (return-from compile-test 'ifeq))))
    13541366      (3 (when (eq (car form) 'EQ)
     
    13801392             (emit-invokevirtual +lisp-object-class+
    13811393                                 s
    1382                                  "(Lorg/armedbear/lisp/LispObject;)Z")
     1394                                 "(Lorg/armedbear/lisp/LispObject;)Z"
     1395                                 -1)
    13831396             (return-from compile-test 'ifeq))))))
    13841397  ;; Otherwise...
     
    14341447      (emit-invokevirtual +lisp-thread-class+
    14351448                          "getDynamicEnvironment"
    1436                           "()Lorg/armedbear/lisp/Environment;")
     1449                          "()Lorg/armedbear/lisp/Environment;"
     1450                          0)
    14371451      (emit 'astore env-var))
    14381452    (ecase (car form)
     
    14521466      (emit-invokevirtual +lisp-thread-class+
    14531467                          "setDynamicEnvironment"
    1454                           "(Lorg/armedbear/lisp/Environment;)V"))
     1468                          "(Lorg/armedbear/lisp/Environment;)V"
     1469                          -2))
    14551470    ;; Restore fill pointer to its saved value so the slots used by these
    14561471    ;; bindings will again be available.
     
    16701685              (emit-invokevirtual +lisp-object-class+
    16711686                                  "getSymbolFunctionOrDie"
    1672                                   "()Lorg/armedbear/lisp/LispObject;")
     1687                                  "()Lorg/armedbear/lisp/LispObject;"
     1688                                  0)
    16731689              (emit-store-value)))
    16741690           #+nil
     
    17621778    (emit-invokevirtual +lisp-symbol-class+
    17631779                        "symbolValue"
    1764                         "()Lorg/armedbear/lisp/LispObject;")
     1780                        "()Lorg/armedbear/lisp/LispObject;"
     1781                        0)
    17651782    (emit-store-value)
    17661783    (return-from compile-variable-ref)))
     
    18861903      (emit-invokevirtual *this-class*
    18871904                          "processArgs"
    1888                           "([Lorg/armedbear/lisp/LispObject;)[Lorg/armedbear/lisp/LispObject;")
     1905                          "([Lorg/armedbear/lisp/LispObject;)[Lorg/armedbear/lisp/LispObject;"
     1906                          -1)
    18891907      (emit 'astore_1))
    18901908    (dolist (f body)
Note: See TracChangeset for help on using the changeset viewer.