Changeset 8364


Ignore:
Timestamp:
01/16/05 00:36:47 (17 years ago)
Author:
piso
Message:

Work in progress (tested).

File:
1 edited

Legend:

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

    r8362 r8364  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.351 2005-01-15 07:20:28 piso Exp $
     4;;; $Id: jvm.lisp,v 1.352 2005-01-16 00:36:47 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    518518           (let ((variable (local-function-variable local-function)))
    519519             (when variable
    520                (unless (eq (variable-compiland variable) *current-compiland*)
     520               (unless (or (eq (variable-compiland variable) *current-compiland*)
     521                           (eq (local-function-compiland local-function) *current-compiland*))
    521522                 (dformat t "p1-function ~S used non-locally~%" (variable-name variable))
    522523                 (setf (variable-used-non-locally-p variable) t))))
     
    21282129            g1
    21292130            +lisp-string+)
    2130       (emit 'dup)
     2131;;       (emit 'dup)
    21312132      (emit-invokestatic +lisp-class+
    21322133                         "recall"
     
    21372138            g2
    21382139            +lisp-object+)
    2139       (emit-invokestatic +lisp-class+
    2140                          "forget"
    2141                          "(Lorg/armedbear/lisp/SimpleString;)V"
    2142                          -1)
     2140;;       (emit-invokestatic +lisp-class+
     2141;;                          "forget"
     2142;;                          "(Lorg/armedbear/lisp/SimpleString;)V"
     2143;;                          -1)
    21432144      (setf *static-code* *code*)
    21442145      g2)))
     
    41234124  (let ((name (second form))
    41244125        (local-function))
    4125     (cond
    4126      ((symbolp name)
    4127       (cond
    4128        ((setf local-function (find-local-function name))
    4129         (when (eq (local-function-compiland local-function) *current-compiland*)
    4130           (emit 'aload 0) ; this
    4131           (emit-move-from-stack target)
    4132           (return-from p2-function))
    4133         (if (local-function-variable local-function)
    4134             (emit 'var-ref (local-function-variable local-function) :stack)
    4135             (let ((g (if *compile-file-truename*
    4136                          (declare-local-function local-function)
    4137                          (declare-object (local-function-function local-function)))))
    4138               (emit 'getstatic
    4139                     *this-class*
    4140                     g
    4141                     +lisp-object+))) ; Stack: template-function
    4142         (cond
    4143          ((null *closure-variables*)) ; Nothing to do.
    4144          ((compiland-closure-register *current-compiland*)
    4145           (emit 'aload (compiland-closure-register *current-compiland*))
    4146           (emit-invokestatic +lisp-class+
    4147                              "makeCompiledClosure"
    4148                              "(Lorg/armedbear/lisp/LispObject;[Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    4149                              -1)) ; Stack: compiled-closure
    4150          (t
    4151           (aver (progn 'unexpected nil))))
    4152         (emit-move-from-stack target))
    4153        ((inline-ok name)
    4154         (emit 'getstatic
    4155               *this-class*
    4156               (declare-function name)
    4157               +lisp-object+)
    4158         (emit-move-from-stack target))
    4159        (t
    4160         (emit 'getstatic
    4161               *this-class*
    4162               (declare-symbol name)
    4163               +lisp-symbol+)
    4164         (emit-invokevirtual +lisp-object-class+
    4165                             "getSymbolFunctionOrDie"
    4166                             "()Lorg/armedbear/lisp/LispObject;"
    4167                             0)
    4168         (emit-move-from-stack target))))
    4169      ((and (consp name) (eq (car name) 'SETF))
    4170       ; FIXME Need to check for NOTINLINE declaration!
    4171       (cond
    4172        ((member name *toplevel-defuns* :test #'equal)
    4173         (emit 'getstatic
    4174               *this-class*
    4175               (declare-setf-function name)
    4176               +lisp-object+)
    4177         (emit-move-from-stack target))
    4178        ((and (null *compile-file-truename*)
    4179              (fdefinition name))
    4180         (emit 'getstatic
    4181               *this-class*
    4182               (declare-object (fdefinition name))
    4183               +lisp-object+)
    4184         (emit-move-from-stack target))
    4185        (t
    4186         (emit 'getstatic
    4187               *this-class*
    4188               (declare-symbol (cadr name))
    4189               +lisp-symbol+)
    4190         (emit-invokevirtual +lisp-symbol-class+
    4191                             "getSymbolSetfFunctionOrDie"
    4192                             "()Lorg/armedbear/lisp/LispObject;"
    4193                             0)
    4194         (emit-move-from-stack target))))
    4195      ((compiland-p name)
    4196       (p2-lambda name target))
    4197      (t
    4198       (error "p2-function: unsupported case: ~S" form)))))
     4126    (cond ((symbolp name)
     4127           (cond ((setf local-function (find-local-function name))
     4128                  (dformat t "p2-function 1~%")
     4129                  (when (eq (local-function-compiland local-function) *current-compiland*)
     4130                    (emit 'aload 0) ; this
     4131                    (emit-move-from-stack target)
     4132                    (return-from p2-function))
     4133                  (cond ((local-function-variable local-function)
     4134                         (dformat t "p2-function 2~%")
     4135                         (emit 'var-ref (local-function-variable local-function) :stack))
     4136                        (t
     4137                         (let ((g (if *compile-file-truename*
     4138                                      (declare-local-function local-function)
     4139                                      (declare-object (local-function-function local-function)))))
     4140                           (emit 'getstatic
     4141                                 *this-class*
     4142                                 g
     4143                                 +lisp-object+)))) ; Stack: template-function
     4144                  (cond ((null *closure-variables*)) ; Nothing to do.
     4145                        ((compiland-closure-register *current-compiland*)
     4146                         (dformat t "p2-function 3~%")
     4147                         (emit 'aload (compiland-closure-register *current-compiland*))
     4148                         (emit-invokestatic +lisp-class+
     4149                                            "makeCompiledClosure"
     4150                                            "(Lorg/armedbear/lisp/LispObject;[Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
     4151                                            -1)) ; Stack: compiled-closure
     4152                        (t
     4153                         (aver (progn 'unexpected nil))))
     4154                  (emit-move-from-stack target))
     4155                 ((inline-ok name)
     4156                  (emit 'getstatic
     4157                        *this-class*
     4158                        (declare-function name)
     4159                        +lisp-object+)
     4160                  (emit-move-from-stack target))
     4161                 (t
     4162                  (emit 'getstatic
     4163                        *this-class*
     4164                        (declare-symbol name)
     4165                        +lisp-symbol+)
     4166                  (emit-invokevirtual +lisp-object-class+
     4167                                      "getSymbolFunctionOrDie"
     4168                                      "()Lorg/armedbear/lisp/LispObject;"
     4169                                      0)
     4170                  (emit-move-from-stack target))))
     4171          ((and (consp name) (eq (car name) 'SETF))
     4172           ; FIXME Need to check for NOTINLINE declaration!
     4173           (cond ((member name *toplevel-defuns* :test #'equal)
     4174                  (emit 'getstatic
     4175                        *this-class*
     4176                        (declare-setf-function name)
     4177                        +lisp-object+)
     4178                  (emit-move-from-stack target))
     4179                 ((and (null *compile-file-truename*)
     4180                       (fdefinition name))
     4181                  (emit 'getstatic
     4182                        *this-class*
     4183                        (declare-object (fdefinition name))
     4184                        +lisp-object+)
     4185                  (emit-move-from-stack target))
     4186                 (t
     4187                  (emit 'getstatic
     4188                        *this-class*
     4189                        (declare-symbol (cadr name))
     4190                        +lisp-symbol+)
     4191                  (emit-invokevirtual +lisp-symbol-class+
     4192                                      "getSymbolSetfFunctionOrDie"
     4193                                      "()Lorg/armedbear/lisp/LispObject;"
     4194                                      0)
     4195                  (emit-move-from-stack target))))
     4196          ((compiland-p name)
     4197           (p2-lambda name target))
     4198          (t
     4199           (error "p2-function: unsupported case: ~S" form)))))
    41994200
    42004201(defun p2-ash (form &key (target *val*) representation)
Note: See TracChangeset for help on using the changeset viewer.