- Timestamp:
- 07/07/10 20:53:34 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r12787 r12789 199 199 n))) 200 200 201 (defconstant +fasl-loader-class+ 202 "org/armedbear/lisp/FaslClassLoader") 201 203 202 (defconstant +lisp-object-class+ "org/armedbear/lisp/LispObject") 204 203 (defconstant +lisp-object+ "Lorg/armedbear/lisp/LispObject;") … … 207 206 (defconstant +lisp-symbol-class+ "org/armedbear/lisp/Symbol") 208 207 (defconstant +lisp-symbol+ "Lorg/armedbear/lisp/Symbol;") 209 (defconstant +lisp-structure-object-class+ "org/armedbear/lisp/StructureObject")210 (defconstant +lisp-thread-class+ "org/armedbear/lisp/LispThread")211 (defconstant +lisp-thread+ "Lorg/armedbear/lisp/LispThread;")212 (defconstant +lisp-cons-class+ "org/armedbear/lisp/Cons")213 (defconstant +lisp-cons+ "Lorg/armedbear/lisp/Cons;")214 208 (defconstant +lisp-integer-class+ "org/armedbear/lisp/LispInteger") 215 209 (defconstant +lisp-integer+ "Lorg/armedbear/lisp/LispInteger;") … … 235 229 (defconstant +lisp-simple-string-class+ "org/armedbear/lisp/SimpleString") 236 230 (defconstant +lisp-simple-string+ "Lorg/armedbear/lisp/SimpleString;") 237 (defconstant +lisp-environment+ "Lorg/armedbear/lisp/Environment;")238 (defconstant +lisp-environment-class+ "org/armedbear/lisp/Environment")239 231 (defconstant +lisp-special-binding+ "Lorg/armedbear/lisp/SpecialBinding;") 240 232 (defconstant +lisp-special-binding-class+ "org/armedbear/lisp/SpecialBinding") 241 (defconstant +lisp-throw-class+ "org/armedbear/lisp/Throw")242 (defconstant +lisp-return-class+ "org/armedbear/lisp/Return")243 (defconstant +lisp-go-class+ "org/armedbear/lisp/Go")244 (defconstant +lisp-primitive-class+ "org/armedbear/lisp/Primitive")245 (defconstant +lisp-hash-table-class+ "org/armedbear/lisp/HashTable")246 (defconstant +lisp-eql-hash-table-class+ "org/armedbear/lisp/EqlHashTable")247 233 (defconstant +lisp-closure-parameter-class+ "org/armedbear/lisp/Closure$Parameter") 248 234 (defconstant +lisp-closure-parameter-array+ "[Lorg/armedbear/lisp/Closure$Parameter;") … … 686 672 ((equal class +lisp-symbol+) 687 673 "Symbol") 688 ((equal class +lisp-thread -class+)674 ((equal class +lisp-thread+) 689 675 "LispThread") 690 676 (t … … 726 712 (defun maybe-initialize-thread-var () 727 713 (when *initialize-thread-var* 728 (emit-invokestatic +lisp-thread -class+ "currentThread" nil +lisp-thread+)714 (emit-invokestatic +lisp-thread+ "currentThread" nil +lisp-thread+) 729 715 (astore *thread*) 730 716 (setf *initialize-thread-var* nil))) … … 773 759 (SYMBOL +lisp-symbol-class+) 774 760 (CHARACTER +lisp-character-class+) 775 (CONS +lisp-cons -class+)776 (HASH-TABLE +lisp-hash-table -class+)761 (CONS +lisp-cons+) 762 (HASH-TABLE +lisp-hash-table+) 777 763 (FIXNUM +lisp-fixnum-class+) 778 764 (STREAM +lisp-stream+) … … 1294 1280 (inst 'aload *thread*) 1295 1281 (inst 'aconst_null) 1296 (inst 'putfield (list +lisp-thread -class+ "_values"1282 (inst 'putfield (list +lisp-thread+ "_values" 1297 1283 +lisp-object-array+))))) 1298 1284 (dolist (instruction instructions) … … 1816 1802 (*handlers* nil)) 1817 1803 (setf (method-max-locals constructor) 1) 1818 (unless (eq ual super +lisp-primitive-class+)1804 (unless (eq super +lisp-primitive+) 1819 1805 (multiple-value-bind 1820 1806 (req opt key key-p rest … … 1884 1870 +lisp-object+ +lisp-object+)))))) 1885 1871 (aload 0) ;; this 1886 (cond ((eq ual super +lisp-primitive-class+)1872 (cond ((eq super +lisp-primitive+) 1887 1873 (emit-constructor-lambda-name lambda-name) 1888 1874 (emit-constructor-lambda-list args) … … 2157 2143 5. The type of the field to save the serialized result to") 2158 2144 2159 (defknown emit-load-externalized-object (t ) string)2145 (defknown emit-load-externalized-object (t &optional t) string) 2160 2146 (defun emit-load-externalized-object (object &optional cast) 2161 2147 "Externalizes `object' for use in a FASL. … … 2803 2789 (ht-form (%caddr form))) 2804 2790 (compile-form ht-form 'stack nil) 2805 (emit 'checkcast +lisp-hash-table -class+)2791 (emit 'checkcast +lisp-hash-table+) 2806 2792 (compile-form key-form 'stack nil) 2807 2793 (maybe-emit-clear-values ht-form key-form) 2808 (emit-invokevirtual +lisp-hash-table -class+ "gethash1"2794 (emit-invokevirtual +lisp-hash-table+ "gethash1" 2809 2795 (lisp-object-arg-types 1) +lisp-object+) 2810 2796 (fix-boxing representation nil) … … 2821 2807 (value-form (fourth form))) 2822 2808 (compile-form ht-form 'stack nil) 2823 (emit 'checkcast +lisp-hash-table -class+)2809 (emit 'checkcast +lisp-hash-table+) 2824 2810 (compile-form key-form 'stack nil) 2825 2811 (compile-form value-form 'stack nil) 2826 2812 (maybe-emit-clear-values ht-form key-form value-form) 2827 2813 (cond (target 2828 (emit-invokevirtual +lisp-hash-table -class+ "puthash"2814 (emit-invokevirtual +lisp-hash-table+ "puthash" 2829 2815 (lisp-object-arg-types 2) +lisp-object+) 2830 2816 (fix-boxing representation nil) 2831 2817 (emit-move-from-stack target representation)) 2832 2818 (t 2833 (emit-invokevirtual +lisp-hash-table -class+ "put"2819 (emit-invokevirtual +lisp-hash-table+ "put" 2834 2820 (lisp-object-arg-types 2) nil))))) 2835 2821 (t … … 2909 2895 (list +lisp-object+ +lisp-object-array+))) 2910 2896 (return-type +lisp-object+)) 2911 (emit-invokevirtual +lisp-thread -class+ "execute" arg-types return-type)))2897 (emit-invokevirtual +lisp-thread+ "execute" arg-types return-type))) 2912 2898 2913 2899 (defknown compile-function-call (t t t) t) … … 3078 3064 (emit-load-externalized-object 3079 3065 (local-function-environment local-function) 3080 +lisp-environment -class+)3066 +lisp-environment+) 3081 3067 (emit-load-externalized-object (local-function-name local-function)) 3082 (emit-invokevirtual +lisp-environment -class+ "lookupFunction"3068 (emit-invokevirtual +lisp-environment+ "lookupFunction" 3083 3069 (list +lisp-object+) 3084 3070 +lisp-object+)) … … 3400 3386 3401 3387 (defun p2-test-consp (form) 3402 (p2-test-instanceof-predicate form +lisp-cons -class+))3388 (p2-test-instanceof-predicate form +lisp-cons+)) 3403 3389 3404 3390 (defun p2-test-atom (form) 3405 (p2-test-instanceof-predicate form +lisp-cons -class+)3391 (p2-test-instanceof-predicate form +lisp-cons+) 3406 3392 'ifne) 3407 3393 … … 3842 3828 ;; Save multiple values returned by first subform. 3843 3829 (emit-push-current-thread) 3844 (emit 'getfield +lisp-thread -class+ "_values" +lisp-object-array+)3830 (emit 'getfield +lisp-thread+ "_values" +lisp-object-array+) 3845 3831 (astore values-register) 3846 3832 (dolist (subform subforms) … … 3849 3835 (emit-push-current-thread) 3850 3836 (aload values-register) 3851 (emit 'putfield +lisp-thread -class+ "_values" +lisp-object-array+)3837 (emit 'putfield +lisp-thread+ "_values" +lisp-object-array+) 3852 3838 ;; Result. 3853 3839 (aload result-register) … … 3892 3878 (emit 'swap) 3893 3879 (aload values-register) 3894 (emit-invokevirtual +lisp-thread -class+ "accumulateValues"3880 (emit-invokevirtual +lisp-thread+ "accumulateValues" 3895 3881 (list +lisp-object+ +lisp-object-array+) 3896 3882 +lisp-object-array+) … … 3945 3931 (emit-push-variable-name variable) 3946 3932 (emit 'swap) 3947 (emit-invokevirtual +lisp-thread -class+ "bindSpecial"3933 (emit-invokevirtual +lisp-thread+ "bindSpecial" 3948 3934 (list +lisp-symbol+ +lisp-object+) 3949 3935 +lisp-special-binding+) … … 3986 3972 (emit-push-current-thread) 3987 3973 (aload register) 3988 (emit-invokevirtual +lisp-thread -class+ "resetSpecialBindings"3974 (emit-invokevirtual +lisp-thread+ "resetSpecialBindings" 3989 3975 (list +lisp-special-bindings-mark+) nil) 3990 3976 ) … … 3992 3978 (defun save-dynamic-environment (register) 3993 3979 (emit-push-current-thread) 3994 (emit-invokevirtual +lisp-thread -class+ "markSpecialBindings"3980 (emit-invokevirtual +lisp-thread+ "markSpecialBindings" 3995 3981 nil +lisp-special-bindings-mark+) 3996 3982 (astore register) … … 4051 4037 ;; Store values from values form in values register. 4052 4038 (emit-push-current-thread) 4053 (emit 'getfield +lisp-thread -class+ "_values" +lisp-object-array+)4039 (emit 'getfield +lisp-thread+ "_values" +lisp-object-array+) 4054 4040 (emit-move-from-stack values-register) 4055 4041 ;; Did we get just one value? … … 4070 4056 (aload result-register) 4071 4057 (emit-push-constant-int (length vars)) 4072 (emit-invokevirtual +lisp-thread -class+ "getValues"4058 (emit-invokevirtual +lisp-thread+ "getValues" 4073 4059 (list +lisp-object+ "I") +lisp-object-array+) 4074 4060 ;; Values array is now on the stack at runtime. … … 4230 4216 (assert (not *file-compilation*)) 4231 4217 (emit-load-externalized-object (variable-environment variable) 4232 +lisp-environment -class+)4218 +lisp-environment+) 4233 4219 (emit 'swap) 4234 4220 (emit-push-variable-name variable) 4235 4221 (emit 'swap) 4236 (emit-invokevirtual +lisp-environment -class+ "rebind"4222 (emit-invokevirtual +lisp-environment+ "rebind" 4237 4223 (list +lisp-symbol+ +lisp-object+) 4238 4224 nil)) … … 4262 4248 (assert (not *file-compilation*)) 4263 4249 (emit-load-externalized-object (variable-environment variable) 4264 +lisp-environment -class+)4250 +lisp-environment+) 4265 4251 (emit-push-variable-name variable) 4266 (emit-invokevirtual +lisp-environment -class+ "lookup"4252 (emit-invokevirtual +lisp-environment+ "lookup" 4267 4253 (list +lisp-object+) 4268 4254 +lisp-object+)) … … 4357 4343 (emit-push-current-thread) 4358 4344 (emit-push-variable-name variable) 4359 (emit-invokevirtual +lisp-thread -class+4345 (emit-invokevirtual +lisp-thread+ 4360 4346 "bindSpecialToCurrentValue" 4361 4347 (list +lisp-symbol+) … … 4517 4503 (astore go-register) 4518 4504 ;; Get the tag. 4519 (emit 'getfield +lisp-go -class+ "tagbody" +lisp-object+) ; Stack depth is still 1.4505 (emit 'getfield +lisp-go+ "tagbody" +lisp-object+) ; Stack depth is still 1. 4520 4506 (emit-push-variable (tagbody-id-variable block)) 4521 4507 (emit 'if_acmpne RETHROW) ;; Not this TAGBODY 4522 4508 (aload go-register) 4523 (emit 'getfield +lisp-go -class+ "tag" +lisp-object+) ; Stack depth is still 1.4509 (emit 'getfield +lisp-go+ "tag" +lisp-object+) ; Stack depth is still 1. 4524 4510 (astore tag-register) 4525 4511 ;; Don't actually generate comparisons for tags … … 4545 4531 :to END-BLOCK 4546 4532 :code HANDLER 4547 :catch-type (pool-class +lisp-go-class+))4533 :catch-type (pool-class (!class-name +lisp-go+))) 4548 4534 *handlers*) 4549 4535 (push (make-handler :from BEGIN-BLOCK … … 4598 4584 (check-arg-count form 1)) 4599 4585 (compile-forms-and-maybe-emit-clear-values (cadr form) 'stack nil) 4600 (emit 'instanceof +lisp-cons -class+)4586 (emit 'instanceof +lisp-cons+) 4601 4587 (let ((LABEL1 (gensym)) 4602 4588 (LABEL2 (gensym))) … … 4638 4624 4639 4625 (defun p2-consp (form target representation) 4640 (p2-instanceof-predicate form target representation +lisp-cons -class+))4626 (p2-instanceof-predicate form target representation +lisp-cons+)) 4641 4627 4642 4628 (defun p2-fixnump (form target representation) … … 4700 4686 ;; The Return object is on the runtime stack. Stack depth is 1. 4701 4687 (emit 'dup) ; Stack depth is 2. 4702 (emit 'getfield +lisp-return -class+ "tag" +lisp-object+) ; Still 2.4688 (emit 'getfield +lisp-return+ "tag" +lisp-object+) ; Still 2. 4703 4689 (emit-push-variable (block-id-variable block)) 4704 4690 ;; If it's not the block we're looking for... … … 4710 4696 (emit 'athrow) 4711 4697 (label THIS-BLOCK) 4712 (emit 'getfield +lisp-return -class+ "result" +lisp-object+)4698 (emit 'getfield +lisp-return+ "result" +lisp-object+) 4713 4699 (emit-move-from-stack target) ; Stack depth is 0. 4714 4700 ;; Finally... … … 4716 4702 :to END-BLOCK 4717 4703 :code HANDLER 4718 :catch-type (pool-class +lisp-return-class+))4704 :catch-type (pool-class (!class-name +lisp-return+))) 4719 4705 *handlers*) 4720 4706 (push (make-handler :from BEGIN-BLOCK … … 4785 4771 (define-inlined-function p2-cons (form target representation) 4786 4772 ((check-arg-count form 2)) 4787 (emit 'new +lisp-cons -class+)4773 (emit 'new +lisp-cons+) 4788 4774 (emit 'dup) 4789 4775 (let* ((args (%cdr form)) … … 4792 4778 (compile-forms-and-maybe-emit-clear-values arg1 'stack nil 4793 4779 arg2 'stack nil)) 4794 (emit-invokespecial-init +lisp-cons -class+ (lisp-object-arg-types 2))4780 (emit-invokespecial-init +lisp-cons+ (lisp-object-arg-types 2)) 4795 4781 (emit-move-from-stack target)) 4796 4782 … … 5750 5736 (cond ((and (check-arg-count form 2) 5751 5737 (eq (derive-type (%cadr form)) 'SYMBOL)) 5752 (emit 'new +lisp-structure-object -class+)5738 (emit 'new +lisp-structure-object+) 5753 5739 (emit 'dup) 5754 5740 (compile-form (%cadr form) 'stack nil) … … 5758 5744 (emit-invokevirtual +lisp-object-class+ "copyToArray" 5759 5745 nil +lisp-object-array+) 5760 (emit-invokespecial-init +lisp-structure-object -class+5746 (emit-invokespecial-init +lisp-structure-object+ 5761 5747 (list +lisp-symbol+ +lisp-object-array+)) 5762 5748 (emit-move-from-stack target representation)) … … 5770 5756 (cond ((and (<= 1 slot-count 6) 5771 5757 (eq (derive-type (%car args)) 'SYMBOL)) 5772 (emit 'new +lisp-structure-object -class+)5758 (emit 'new +lisp-structure-object+) 5773 5759 (emit 'dup) 5774 5760 (compile-form (%car args) 'stack nil) … … 5777 5763 (compile-form slot-form 'stack nil)) 5778 5764 (apply 'maybe-emit-clear-values args) 5779 (emit-invokespecial-init +lisp-structure-object -class+5765 (emit-invokespecial-init +lisp-structure-object+ 5780 5766 (append (list +lisp-symbol+) 5781 5767 (make-list slot-count :initial-element +lisp-object+))) … … 5786 5772 (defun p2-make-hash-table (form target representation) 5787 5773 (cond ((= (length form) 1) ; no args 5788 (emit 'new +lisp-eql-hash-table -class+)5774 (emit 'new +lisp-eql-hash-table+) 5789 5775 (emit 'dup) 5790 (emit-invokespecial-init +lisp-eql-hash-table -class+ nil)5776 (emit-invokespecial-init +lisp-eql-hash-table+ nil) 5791 5777 (fix-boxing representation nil) 5792 5778 (emit-move-from-stack target representation)) … … 6452 6438 (cond ((>= 4 length 1) 6453 6439 (dolist (cons-head cons-heads) 6454 (emit 'new +lisp-cons -class+)6440 (emit 'new +lisp-cons+) 6455 6441 (emit 'dup) 6456 6442 (compile-form cons-head 'stack nil)) … … 6459 6445 (progn 6460 6446 (emit-invokespecial-init 6461 +lisp-cons -class+ (lisp-object-arg-types 1))6447 +lisp-cons+ (lisp-object-arg-types 1)) 6462 6448 (pop cons-heads))) ; we've handled one of the args, so remove it 6463 6449 (dolist (cons-head cons-heads) 6464 6450 (declare (ignore cons-head)) 6465 6451 (emit-invokespecial-init 6466 +lisp-cons -class+ (lisp-object-arg-types 2)))6452 +lisp-cons+ (lisp-object-arg-types 2))) 6467 6453 (if list-star-p 6468 6454 (progn … … 7181 7167 (0 7182 7168 (emit-push-current-thread) 7183 (emit-invokevirtual +lisp-thread -class+ "setValues" nil +lisp-object+)7169 (emit-invokevirtual +lisp-thread+ "setValues" nil +lisp-object+) 7184 7170 (emit-move-from-stack target)) 7185 7171 (1 … … 7201 7187 (compile-form arg1 'stack nil) 7202 7188 (compile-form arg2 'stack nil)))) 7203 (emit-invokevirtual +lisp-thread -class+7189 (emit-invokevirtual +lisp-thread+ 7204 7190 "setValues" 7205 7191 (lisp-object-arg-types len) … … 7211 7197 (dolist (arg args) 7212 7198 (compile-form arg 'stack nil)) 7213 (emit-invokevirtual +lisp-thread -class+7199 (emit-invokevirtual +lisp-thread+ 7214 7200 "setValues" 7215 7201 (lisp-object-arg-types len) … … 7283 7269 (compile-form (%caddr form) 'stack nil) 7284 7270 (maybe-emit-clear-values (%cadr form) (%caddr form)) 7285 (emit-invokevirtual +lisp-thread -class+ "setSpecialVariable"7271 (emit-invokevirtual +lisp-thread+ "setSpecialVariable" 7286 7272 (list +lisp-symbol+ +lisp-object+) +lisp-object+) 7287 7273 (fix-boxing representation nil) … … 7335 7321 (emit-load-externalized-object name) 7336 7322 (compile-forms-and-maybe-emit-clear-values (second value-form) 'stack nil) 7337 (emit-invokevirtual +lisp-thread -class+ "pushSpecial"7323 (emit-invokevirtual +lisp-thread+ "pushSpecial" 7338 7324 (list +lisp-symbol+ +lisp-object+) +lisp-object+)) 7339 7325 (t … … 7341 7327 (emit-load-externalized-object name) 7342 7328 (compile-forms-and-maybe-emit-clear-values value-form 'stack nil) 7343 (emit-invokevirtual +lisp-thread -class+ "setSpecialVariable"7329 (emit-invokevirtual +lisp-thread+ "setSpecialVariable" 7344 7330 (list +lisp-symbol+ +lisp-object+) +lisp-object+))) 7345 7331 (fix-boxing representation nil) … … 7475 7461 (SYMBOL +lisp-symbol-class+) 7476 7462 (CHARACTER +lisp-character-class+) 7477 (CONS +lisp-cons -class+)7478 (HASH-TABLE +lisp-hash-table -class+)7463 (CONS +lisp-cons+) 7464 (HASH-TABLE +lisp-hash-table+) 7479 7465 (FIXNUM +lisp-fixnum-class+) 7480 7466 (STREAM +lisp-stream+) … … 7682 7668 (emit-push-current-thread) 7683 7669 (aload tag-register) 7684 (emit-invokevirtual +lisp-thread -class+ "pushCatchTag"7670 (emit-invokevirtual +lisp-thread+ "pushCatchTag" 7685 7671 (lisp-object-arg-types 1) nil) 7686 7672 (let ((*blocks* (cons block *blocks*))) … … 7693 7679 ;; The Throw object is on the runtime stack. Stack depth is 1. 7694 7680 (emit 'dup) ; Stack depth is 2. 7695 (emit 'getfield +lisp-throw -class+ "tag" +lisp-object+) ; Still 2.7681 (emit 'getfield +lisp-throw+ "tag" +lisp-object+) ; Still 2. 7696 7682 (aload tag-register) ; Stack depth is 3. 7697 7683 ;; If it's not the tag we're looking for, we branch to the start of the … … 7699 7685 (emit 'if_acmpne DEFAULT-HANDLER) ; Stack depth is 1. 7700 7686 (emit-push-current-thread) 7701 (emit-invokevirtual +lisp-throw -class+ "getResult"7687 (emit-invokevirtual +lisp-throw+ "getResult" 7702 7688 (list +lisp-thread+) +lisp-object+) 7703 7689 (emit-move-from-stack target) ; Stack depth is 0. … … 7706 7692 ;; A Throwable object is on the runtime stack here. Stack depth is 1. 7707 7693 (emit-push-current-thread) 7708 (emit-invokevirtual +lisp-thread -class+ "popCatchTag" nil nil)7694 (emit-invokevirtual +lisp-thread+ "popCatchTag" nil nil) 7709 7695 (emit 'athrow) ; Re-throw. 7710 7696 (label EXIT) 7711 7697 ;; Finally... 7712 7698 (emit-push-current-thread) 7713 (emit-invokevirtual +lisp-thread -class+ "popCatchTag" nil nil)7699 (emit-invokevirtual +lisp-thread+ "popCatchTag" nil nil) 7714 7700 (let ((handler1 (make-handler :from BEGIN-PROTECTED-RANGE 7715 7701 :to END-PROTECTED-RANGE 7716 7702 :code THROW-HANDLER 7717 :catch-type (pool-class +lisp-throw-class+)))7703 :catch-type (pool-class (!class-name +lisp-throw+)))) 7718 7704 (handler2 (make-handler :from BEGIN-PROTECTED-RANGE 7719 7705 :to END-PROTECTED-RANGE … … 7731 7717 (emit-clear-values) ; Do this unconditionally! (MISC.503) 7732 7718 (compile-form (third form) 'stack nil) ; Result. 7733 (emit-invokevirtual +lisp-thread -class+ "throwToTag"7719 (emit-invokevirtual +lisp-thread+ "throwToTag" 7734 7720 (lisp-object-arg-types 2) nil) 7735 7721 ;; Following code will not be reached. … … 7774 7760 (unless (single-valued-p protected-form) 7775 7761 (emit-push-current-thread) 7776 (emit 'getfield +lisp-thread -class+ "_values" +lisp-object-array+)7762 (emit 'getfield +lisp-thread+ "_values" +lisp-object-array+) 7777 7763 (astore values-register)) 7778 7764 (label END-PROTECTED-RANGE)) … … 7787 7773 (astore exception-register) 7788 7774 (emit-push-current-thread) 7789 (emit 'getfield +lisp-thread -class+ "_values" +lisp-object-array+)7775 (emit 'getfield +lisp-thread+ "_values" +lisp-object-array+) 7790 7776 (astore values-register) 7791 7777 (let ((*register* *register*)) … … 7795 7781 (emit-push-current-thread) 7796 7782 (aload values-register) 7797 (emit 'putfield +lisp-thread -class+ "_values" +lisp-object-array+)7783 (emit 'putfield +lisp-thread+ "_values" +lisp-object-array+) 7798 7784 (aload exception-register) 7799 7785 (emit 'athrow) ; Re-throw exception. … … 7803 7789 (emit-push-current-thread) 7804 7790 (aload values-register) 7805 (emit 'putfield +lisp-thread -class+ "_values" +lisp-object-array+))7791 (emit 'putfield +lisp-thread+ "_values" +lisp-object-array+)) 7806 7792 ;; Result. 7807 7793 (aload result-register) … … 8191 8177 (emit 'aaload) 8192 8178 (setf (variable-index variable) nil))) 8193 (emit-invokevirtual +lisp-thread -class+ "bindSpecial"8179 (emit-invokevirtual +lisp-thread+ "bindSpecial" 8194 8180 (list +lisp-symbol+ +lisp-object+) 8195 8181 +lisp-special-binding+) … … 8240 8226 (and *child-p* *closure-variables*)) 8241 8227 +lisp-compiled-closure+ 8242 +lisp-primitive -class+))8228 +lisp-primitive+)) 8243 8229 8244 8230 (setf (abcl-class-file-lambda-list class-file) args)
Note: See TracChangeset
for help on using the changeset viewer.
