Changeset 13484


Ignore:
Timestamp:
08/13/11 08:29:08 (10 years ago)
Author:
ehuelsmann
Message:

Store local functions in the parent compiland, since you can't
reach the function from the compiland, but the other way around works.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
3 edited

Legend:

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

    r13473 r13484  
    885885         (compiland (make-compiland :name name :parent *current-compiland*))
    886886         (local-function (make-local-function :name name :compiland compiland)))
    887     (push compiland (compiland-children *current-compiland*))
     887    (push local-function (compiland-children *current-compiland*))
    888888    (when variable-name
    889889      (setf (local-function-variable local-function)
     
    10041004                                                       name (gensym "ANONYMOUS-LAMBDA-"))
    10051005                                             :lambda-expression lambda-form
    1006                                              :parent *current-compiland*)))
    1007              (push compiland (compiland-children *current-compiland*))
     1006                                             :parent *current-compiland*))
     1007                  (local-function (make-local-function :compiland compiland)))
     1008             (push local-function (compiland-children *current-compiland*))
    10081009             (multiple-value-bind (body decls)
    10091010                 (parse-body body)
     
    10151016                     (*current-compiland* compiland))
    10161017                 (p1-compiland compiland)))
    1017              (list 'FUNCTION compiland)))
     1018             (list 'FUNCTION local-function)))
    10181019          ((setf local-function (find-local-function (cadr form)))
    10191020           (dformat "p1-function local function ~S~%" (cadr form))
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r13471 r13484  
    41414141      (compile-progn-body body target representation))))
    41424142
    4143 (defun p2-lambda (compiland target)
    4144   (aver (null (compiland-class-file compiland)))
    4145   (cond (*file-compilation*
    4146          (compile-and-write-to-stream compiland)
    4147          (emit-getstatic *this-class*
    4148                          (declare-local-function
    4149                           (make-local-function :compiland compiland))
    4150                          +lisp-object+))
    4151         (t
    4152          (with-open-stream (stream (sys::%make-byte-array-output-stream))
    4153            (compile-and-write-to-stream compiland stream)
    4154            (let ((bytes (sys::%get-output-stream-bytes stream)))
    4155              (sys::put-memory-function *memory-class-loader*
    4156                                        (class-name-internal
    4157                                         (abcl-class-file-class-name
    4158                                          (compiland-class-file compiland)))
    4159                   bytes)
    4160              (emit-getstatic *this-class*
    4161                          (declare-local-function
    4162                           (make-local-function
    4163                            :compiland compiland))
    4164                          +lisp-object+)))))
    4165   (cond ((null *closure-variables*))    ; Nothing to do.
    4166         ((compiland-closure-register *current-compiland*)
    4167          (duplicate-closure-array *current-compiland*)
    4168          (emit-invokestatic +lisp+ "makeCompiledClosure"
    4169                             (list +lisp-object+ +closure-binding-array+)
    4170                             +lisp-object+))
     4143(defun p2-lambda (local-function target)
     4144  (let ((compiland (local-function-compiland local-function)))
     4145    (aver (null (compiland-class-file compiland)))
     4146    (cond (*file-compilation*
     4147           (compile-and-write-to-stream compiland)
     4148           (emit-getstatic *this-class*
     4149                           (declare-local-function local-function)
     4150                           +lisp-object+))
     4151          (t
     4152           (with-open-stream (stream (sys::%make-byte-array-output-stream))
     4153             (compile-and-write-to-stream compiland stream)
     4154             (let ((bytes (sys::%get-output-stream-bytes stream)))
     4155               (sys::put-memory-function *memory-class-loader*
     4156                                         (class-name-internal
     4157                                          (abcl-class-file-class-name
     4158                                           (compiland-class-file compiland)))
     4159                                         bytes)
     4160               (emit-getstatic *this-class*
     4161                               (declare-local-function local-function)
     4162                               +lisp-object+)))))
     4163    (cond ((null *closure-variables*))  ; Nothing to do.
     4164          ((compiland-closure-register *current-compiland*)
     4165           (duplicate-closure-array *current-compiland*)
     4166           (emit-invokestatic +lisp+ "makeCompiledClosure"
     4167                              (list +lisp-object+ +closure-binding-array+)
     4168                              +lisp-object+))
    41714169                                        ; Stack: compiled-closure
    4172         (t
    4173          (aver nil))) ;; Shouldn't happen.
     4170          (t
     4171           (aver nil)))) ;; Shouldn't happen.
    41744172
    41754173  (emit-move-from-stack target))
     
    42514249                              nil +lisp-object+)
    42524250          (emit-move-from-stack target))))
    4253       ((compiland-p name)
     4251      ((local-function-p name)
    42544252       (dformat t "p2-function case 3~%")
    42554253       (p2-lambda name target))
  • trunk/abcl/src/org/armedbear/lisp/jvm.lisp

    r13470 r13484  
    200200  p1-result         ; the parse tree as created in pass 1
    201201  parent            ; the parent for compilands which defined within another
    202   children          ; List of local compilands
     202  children          ; List of local functions
    203203                    ; defined with FLET, LABELS or LAMBDA
    204204  blocks            ; TAGBODY, PROGV, BLOCK, etc. blocks
Note: See TracChangeset for help on using the changeset viewer.