Changeset 13484
- Timestamp:
- 08/13/11 08:29:08 (11 years ago)
- 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 885 885 (compiland (make-compiland :name name :parent *current-compiland*)) 886 886 (local-function (make-local-function :name name :compiland compiland))) 887 (push compiland(compiland-children *current-compiland*))887 (push local-function (compiland-children *current-compiland*)) 888 888 (when variable-name 889 889 (setf (local-function-variable local-function) … … 1004 1004 name (gensym "ANONYMOUS-LAMBDA-")) 1005 1005 :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*)) 1008 1009 (multiple-value-bind (body decls) 1009 1010 (parse-body body) … … 1015 1016 (*current-compiland* compiland)) 1016 1017 (p1-compiland compiland))) 1017 (list 'FUNCTION compiland)))1018 (list 'FUNCTION local-function))) 1018 1019 ((setf local-function (find-local-function (cadr form))) 1019 1020 (dformat "p1-function local function ~S~%" (cadr form)) -
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r13471 r13484 4141 4141 (compile-progn-body body target representation)))) 4142 4142 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+)) 4171 4169 ; Stack: compiled-closure 4172 (t4173 (aver nil))) ;; Shouldn't happen.4170 (t 4171 (aver nil)))) ;; Shouldn't happen. 4174 4172 4175 4173 (emit-move-from-stack target)) … … 4251 4249 nil +lisp-object+) 4252 4250 (emit-move-from-stack target)))) 4253 (( compiland-p name)4251 ((local-function-p name) 4254 4252 (dformat t "p2-function case 3~%") 4255 4253 (p2-lambda name target)) -
trunk/abcl/src/org/armedbear/lisp/jvm.lisp
r13470 r13484 200 200 p1-result ; the parse tree as created in pass 1 201 201 parent ; the parent for compilands which defined within another 202 children ; List of local compilands202 children ; List of local functions 203 203 ; defined with FLET, LABELS or LAMBDA 204 204 blocks ; TAGBODY, PROGV, BLOCK, etc. blocks
Note: See TracChangeset
for help on using the changeset viewer.