Changeset 11472


Ignore:
Timestamp:
12/22/08 20:13:11 (13 years ago)
Author:
ehuelsmann
Message:

Eliminate the need for CompiledClosure?: duplicate ClosureTemplateFunction? and set its ctx field.

Note: This commit is in preparation of fixing DEFUN.6 and DEFUN.7.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r11470 r11472  
    192192(defconstant +lisp-go-class+ "org/armedbear/lisp/Go")
    193193(defconstant +lisp-ctf-class+ "org/armedbear/lisp/ClosureTemplateFunction")
     194(defconstant +lisp-ctf+ "Lorg/armedbear/lisp/ClosureTemplateFunction;")
    194195(defconstant +lisp-compiled-closure-class+ "org/armedbear/lisp/CompiledClosure")
    195196(defconstant +lisp-compiled-function-class+ "org/armedbear/lisp/CompiledFunction")
     
    28452846      (emit 'aastore))))
    28462847
     2848
     2849(defun emit-dup-ctf-and-set-context (compiland)
     2850  (emit 'checkcast +lisp-ctf-class+)
     2851  (emit-invokevirtual +lisp-ctf-class+ "dup" nil +lisp-ctf+)
     2852  (emit 'aload (compiland-closure-register compiland))
     2853  (emit-invokevirtual +lisp-ctf-class+ "setContext"
     2854                      (list +lisp-object-array+)
     2855                      +lisp-ctf+))
     2856
    28472857(defknown compile-local-function-call (t t t) t)
    28482858(defun compile-local-function-call (form target representation)
     
    28752885             (emit 'getstatic *this-class* g +lisp-object+) ; Stack: template-function
    28762886             (when *closure-variables*
    2877                (emit 'checkcast +lisp-ctf-class+)
    2878                (emit 'aload (compiland-closure-register compiland))
    2879                (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    2880                                   (list +lisp-object+ +lisp-object-array+)
    2881                                   +lisp-object+)))))
     2887               (emit-dup-ctf-and-set-context compiland)))))
    28822888    (let ((must-clear-values nil))
    28832889      (declare (type boolean must-clear-values))
     
    47844790               (let ((parent (compiland-parent compiland)))
    47854791                 (when (compiland-closure-register parent)
    4786                    (dformat t "(compiland-closure-register parent) = ~S~%"
    4787                             (compiland-closure-register parent))
    4788                    (emit 'checkcast +lisp-ctf-class+)
    4789                    (emit 'aload (compiland-closure-register parent))
    4790                    (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    4791                                       (list +lisp-object+ +lisp-object-array+)
    4792                                       +lisp-object+)))
     4792                   (emit-dup-ctf-and-set-context parent)))
    47934793
    47944794               (dformat t "p2-flet-process-compiland var-set ~S~%" (variable-name (local-function-variable local-function)))
     
    48104810                       (let ((parent (compiland-parent compiland)))
    48114811                         (when (compiland-closure-register parent)
    4812                            (dformat t "(compiland-closure-register parent) = ~S~%"
    4813                                     (compiland-closure-register parent))
    4814                            (emit 'checkcast +lisp-ctf-class+)
    4815                            (emit 'aload (compiland-closure-register parent))
    4816                            (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    4817                                               (list +lisp-object+ +lisp-object-array+)
    4818                                               +lisp-object+)))
     4812                           (emit-dup-ctf-and-set-context parent)))
    48194813
    48204814                       (emit 'var-set (local-function-variable local-function)))))
     
    48404834               (let ((parent (compiland-parent compiland)))
    48414835                 (when (compiland-closure-register parent)
    4842                    (dformat t "(compiland-closure-register parent) = ~S~%"
    4843                             (compiland-closure-register parent))
    4844                    (emit 'checkcast +lisp-ctf-class+)
    4845                    (emit 'aload (compiland-closure-register parent))
    4846                    (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    4847                                       (list +lisp-object+ +lisp-object-array+)
    4848                                       +lisp-object+)))
     4836                   (emit-dup-ctf-and-set-context parent)))
    48494837
    48504838
     
    48634851                     (let ((parent (compiland-parent compiland)))
    48644852                       (when (compiland-closure-register parent)
    4865                          (dformat t "(compiland-closure-register parent) = ~S~%"
    4866                                   (compiland-closure-register parent))
    4867                          (emit 'checkcast +lisp-ctf-class+)
    4868                          (emit 'aload (compiland-closure-register parent))
    4869                          (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    4870                                             (list +lisp-object+ +lisp-object-array+)
    4871                                             +lisp-object+)))
     4853                         (emit-dup-ctf-and-set-context parent)))
    48724854
    48734855                     (emit 'var-set (local-function-variable local-function))))
     
    49474929    (cond ((null *closure-variables*)) ; Nothing to do.
    49484930          ((compiland-closure-register *current-compiland*)
    4949            (emit 'aload (compiland-closure-register *current-compiland*))
    4950            (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    4951                               (list +lisp-object+ +lisp-object-array+)
    4952                               +lisp-object+)
    4953            (emit 'checkcast +lisp-compiled-closure-class+)) ; Stack: compiled-closure
     4931           (emit-dup-ctf-and-set-context *current-compiland*)
     4932           ; Stack: cloned template function
     4933           )
    49544934          (t
    49554935           (aver nil))) ;; Shouldn't happen.
     
    49784958
    49794959                           (when (compiland-closure-register *current-compiland*)
    4980                              (emit 'checkcast +lisp-ctf-class+)
    4981                              (emit 'aload (compiland-closure-register *current-compiland*))
    4982                              (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    4983                                                 (list +lisp-object+ +lisp-object-array+)
    4984                                                 +lisp-object+)))))
     4960                             (emit-dup-ctf-and-set-context *current-compiland*)))))
    49854961                  (emit-move-from-stack target))
    49864962                 ((inline-ok name)
Note: See TracChangeset for help on using the changeset viewer.