Changeset 11522


Ignore:
Timestamp:
01/02/09 16:36:05 (12 years ago)
Author:
vvoutilainen
Message:

Helper function for p2-flet-process-compiland and
p2-labels-process-compiland.

File:
1 edited

Legend:

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

    r11521 r11522  
    47524752  (compile-and-write-to-file class-file compiland))
    47534753
     4754
     4755(defun emit-make-compiled-closure-for-flet/labels (local-function compiland g)
     4756  (emit 'getstatic *this-class* g +lisp-object+)
     4757  (let ((parent (compiland-parent compiland)))
     4758    (when (compiland-closure-register parent)
     4759      (dformat t "(compiland-closure-register parent) = ~S~%"
     4760         (compiland-closure-register parent))
     4761      (emit 'checkcast +lisp-ctf-class+)
     4762      (aload (compiland-closure-register parent))
     4763      (emit-invokestatic +lisp-class+ "makeCompiledClosure"
     4764       (list +lisp-object+ +lisp-object-array+)
     4765       +lisp-object+)))
     4766  (emit 'var-set (local-function-variable local-function)))
     4767
     4768
    47544769(defknown p2-flet-process-compiland (t) t)
    47554770(defun p2-flet-process-compiland (local-function)
     
    47694784           (when (local-function-variable local-function)
    47704785             (let ((g (declare-local-function local-function)))
    4771                (emit 'getstatic *this-class* g +lisp-object+)
    4772 
    4773                (let ((parent (compiland-parent compiland)))
    4774                  (when (compiland-closure-register parent)
    4775                    (dformat t "(compiland-closure-register parent) = ~S~%"
    4776                             (compiland-closure-register parent))
    4777                    (emit 'checkcast +lisp-ctf-class+)
    4778                    (aload (compiland-closure-register parent))
    4779                    (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    4780                                       (list +lisp-object+ +lisp-object-array+)
    4781                                       +lisp-object+)))
    4782 
    4783                (dformat t "p2-flet-process-compiland var-set ~S~%" (variable-name (local-function-variable local-function)))
    4784                (emit 'var-set (local-function-variable local-function)))))
     4786         (emit-make-compiled-closure-for-flet/labels
     4787    local-function compiland g))))
    47854788          (t
    47864789           (let* ((pathname (make-temp-file))
     
    47954798                   (when (local-function-variable local-function)
    47964799                     (let ((g (declare-object (load-compiled-function pathname))))
    4797                        (emit 'getstatic *this-class* g +lisp-object+)
    4798 
    4799                        (let ((parent (compiland-parent compiland)))
    4800                          (when (compiland-closure-register parent)
    4801                            (dformat t "(compiland-closure-register parent) = ~S~%"
    4802                                     (compiland-closure-register parent))
    4803                            (emit 'checkcast +lisp-ctf-class+)
    4804                            (aload (compiland-closure-register parent))
    4805                            (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    4806                                               (list +lisp-object+ +lisp-object-array+)
    4807                                               +lisp-object+)))
    4808 
    4809                        (emit 'var-set (local-function-variable local-function)))))
    4810                (delete-file pathname)))))))
     4800           (emit-make-compiled-closure-for-flet/labels
     4801      local-function compiland g))))
     4802         (delete-file pathname)))))))
    48114803
    48124804(defknown p2-labels-process-compiland (t) t)
     
    48254817             (setf (local-function-class-file local-function) class-file)
    48264818             (let ((g (declare-local-function local-function)))
    4827                (emit 'getstatic *this-class* g +lisp-object+)
    4828 
    4829                (let ((parent (compiland-parent compiland)))
    4830                  (when (compiland-closure-register parent)
    4831                    (dformat t "(compiland-closure-register parent) = ~S~%"
    4832                             (compiland-closure-register parent))
    4833                    (emit 'checkcast +lisp-ctf-class+)
    4834                    (aload (compiland-closure-register parent))
    4835                    (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    4836                                       (list +lisp-object+ +lisp-object-array+)
    4837                                       +lisp-object+)))
    4838 
    4839 
    4840                (emit 'var-set (local-function-variable local-function)))))
     4819         (emit-make-compiled-closure-for-flet/labels
     4820    local-function compiland g))))
    48414821          (t
    48424822           (let* ((pathname (make-temp-file))
     
    48484828                   (setf (local-function-class-file local-function) class-file)
    48494829                   (let ((g (declare-object (load-compiled-function pathname))))
    4850                      (emit 'getstatic *this-class* g +lisp-object+)
    4851 
    4852                      (let ((parent (compiland-parent compiland)))
    4853                        (when (compiland-closure-register parent)
    4854                          (dformat t "(compiland-closure-register parent) = ~S~%"
    4855                                   (compiland-closure-register parent))
    4856                          (emit 'checkcast +lisp-ctf-class+)
    4857                          (aload (compiland-closure-register parent))
    4858                          (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    4859                                             (list +lisp-object+ +lisp-object-array+)
    4860                                             +lisp-object+)))
    4861 
    4862                      (emit 'var-set (local-function-variable local-function))))
     4830         (emit-make-compiled-closure-for-flet/labels
     4831          local-function compiland g)))
    48634832               (delete-file pathname)))))))
    48644833
Note: See TracChangeset for help on using the changeset viewer.