Changeset 11620
- Timestamp:
- 02/03/09 22:07:06 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r11619 r11620 412 412 (t (emit 'ldc2_w (pool-double n))))) 413 413 414 (defknown emit-dup (symbol) t) 415 (defun emit-dup (representation) 416 (ecase (representation-size representation) 417 (1 (emit 'dup)) 418 (2 (emit 'dup2)))) 419 420 (defknown emit-swap (symbol symbol) t) 421 (defun emit-swap (rep1 rep2) 422 "Swaps 2 values on the stack, 423 the top-most value's representation being 'rep1'." 424 (let ((r1-size (representation-size rep1)) 425 (r2-size (representation-size rep2))) 426 (cond ((and (= 1 r1-size) 427 (= 1 r2-size)) 428 (emit 'swap)) 429 ((and (= 1 r1-size) 430 (= 2 r2-size)) 431 (emit 'dup2_x1) 432 (emit 'pop2)) 433 ((and (= 2 r1-size) 434 (= 1 r2-size)) 435 (emit 'dup_x2) 436 (emit 'pop)) 437 ((and (= 2 r1-size) 438 (= 2 r2-size)) 439 (emit 'dup2_x2) 440 (emit 'pop2))))) 441 414 442 (declaim (ftype (function (t t) cons) make-descriptor-info)) 415 443 (defun make-descriptor-info (arg-types return-type) … … 529 557 ((:long :double) 2))) 530 558 559 560 (defknown emit-unbox-boolean () t) 561 (defun emit-unbox-boolean () 562 (emit 'instanceof +lisp-nil-class+) 563 (emit 'iconst_1) 564 (emit 'ixor)) ;; 1 -> 0 && 0 -> 1: in other words, negate the low bit 565 566 (defknown emit-unbox-character () t) 567 (defun emit-unbox-character () 568 (cond ((> *safety* 0) 569 (emit-invokestatic +lisp-character-class+ "getValue" 570 (lisp-object-arg-types 1) "C")) 571 (t 572 (emit 'checkcast +lisp-character-class+) 573 (emit 'getfield +lisp-character-class+ "value" "C")))) 574 531 575 ;; source type / 532 576 ;; targets :boolean :char :int :long :float :double 533 (defvar rep-conversion '((:boolean . #( NIL :err :err :err :err :err)) 577 (defvar rep-conversion `((NIL . #( ,#'emit-unbox-boolean 578 ,#'emit-unbox-character 579 "intValue" "longValue" 580 "floatValue" "doubleValue")) 581 (:boolean . #( NIL :err :err :err :err :err)) 534 582 (:char . #( 1 NIL :err :err :err :err)) 535 583 (:int . #( 1 :err NIL i2l i2f i2d)) … … 577 625 ;; Convert from one internal representation into another 578 626 (assert (neq op :err)) 579 (if (eql op 1) 580 (progn 581 (emit-move-from-stack nil in) 582 (emit 'iconst_1)) 583 (emit op))))) 627 (cond ((eql op 1) 628 (emit-move-from-stack nil in) 629 (emit 'iconst_1)) 630 ((functionp op) 631 (funcall op)) 632 ((stringp op) 633 (emit-invokevirtual +lisp-object-class+ op nil 634 (cdr (assoc out rep-arg-chars)))) 635 (t 636 (emit op)))))) 584 637 585 638 (defvar common-representations '((:int :long :long) … … 859 912 (emit 'getfield +lisp-fixnum-class+ "value" "I")))) 860 913 861 (defknown emit-unbox-character () t)862 (defun emit-unbox-character ()863 (cond ((> *safety* 0)864 (emit-invokestatic +lisp-character-class+ "getValue"865 (lisp-object-arg-types 1) "C"))866 (t867 (emit 'checkcast +lisp-character-class+)868 (emit 'getfield +lisp-character-class+ "value" "C"))))869 870 914 (defknown emit-unbox-long () t) 871 915 (defun emit-unbox-long () … … 892 936 (emit 'checkcast +lisp-double-float-class+) 893 937 (emit 'getfield +lisp-double-float-class+ "value" "D")))) 894 895 (defknown emit-unbox-boolean () t)896 (defun emit-unbox-boolean ()897 (emit 'instanceof +lisp-nil-class+)898 (emit 'iconst_1)899 (emit 'ixor)) ;; 1 -> 0 && 0 -> 1: in other words, negate the low bit900 938 901 939 (defknown fix-boxing (t t) t) … … 4240 4278 4241 4279 (defun emit-move-to-variable (variable) 4280 (let ((representation (variable-representation variable))) 4281 (flet ((emit-array-store (representation) 4282 (emit (or (case representation 4283 ((:int :boolean :char) 4284 'iastore) 4285 (:long 'lastore) 4286 (:float 'fastore) 4287 (:double 'dastore)) 4288 'aastore)))) 4289 (cond ((variable-register variable) 4290 (emit (or (case (variable-representation variable) 4291 ((:int :boolean :char) 4292 'istore) 4293 (:long 'lstore) 4294 (:float 'fstore) 4295 (:double 'dstore)) 4296 'astore) 4297 (variable-register variable))) 4298 ((variable-index variable) 4299 (aload (compiland-argument-register *current-compiland*)) 4300 (emit-swap representation nil) 4301 (emit-push-constant-int (variable-index variable)) 4302 (emit-swap representation :int) 4303 (emit-array-store (variable-representation variable))) 4304 ((variable-closure-index variable) 4305 (aload (compiland-closure-register *current-compiland*)) 4306 (emit-swap representation nil) 4307 (emit-push-constant-int (variable-closure-index variable)) 4308 (emit-swap representation :int) 4309 (emit-array-store (variable-representation variable))) 4310 (t 4311 ;;###FIXME: We might want to address the "temp-register" case too. 4312 (assert nil)))))) 4313 4314 (defun emit-push-variable (variable) 4242 4315 (flet ((emit-array-store (representation) 4243 4316 (emit (or (case representation 4244 4317 ((:int :boolean :char) 4245 'ia store)4246 (:long 'la store)4247 (:float 'fa store)4248 (:double 'da store))4249 'aa store))))4318 'iaload) 4319 (:long 'laload) 4320 (:float 'faload) 4321 (:double 'daload)) 4322 'aaload)))) 4250 4323 (cond ((variable-register variable) 4251 4324 (emit (or (case (variable-representation variable) 4252 4325 ((:int :boolean :char) 4253 'i store)4254 (:long 'l store)4255 (:float 'f store)4256 (:double 'd store))4257 'a store)4326 'iload) 4327 (:long 'lload) 4328 (:float 'fload) 4329 (:double 'dload)) 4330 'aload) 4258 4331 (variable-register variable))) 4259 4332 ((variable-index variable) … … 7537 7610 (cond ((variable-special-p variable) 7538 7611 (compile-special-reference (variable-name variable) target representation)) 7539 ((eq (variable-representation variable) :int) 7540 (aver (variable-register variable)) 7541 (emit 'iload (variable-register variable)) 7542 (convert-representation :int representation) 7543 (emit-move-from-stack target representation)) 7544 ((eq (variable-representation variable) :char) 7545 (aver (variable-register variable)) 7546 (emit 'iload (variable-register variable)) 7547 (convert-representation :char representation) 7548 (emit-move-from-stack target representation)) 7549 ((eq (variable-representation variable) :long) 7550 (aver (variable-register variable)) 7551 (emit 'lload (variable-register variable)) 7552 (convert-representation :long representation) 7553 (emit-move-from-stack target representation)) 7554 ((eq (variable-representation variable) :boolean) 7555 (aver (variable-register variable)) 7556 (aver (or (null representation) (eq representation :boolean))) 7557 (emit 'iload (variable-register variable)) 7558 (convert-representation :boolean representation) 7559 (emit-move-from-stack target representation)) 7560 ((variable-register variable) 7561 (aload (variable-register variable)) 7562 (fix-boxing representation (variable-derived-type variable)) 7563 (emit-move-from-stack target representation)) 7564 ((variable-closure-index variable) 7565 (aver (not (null (compiland-closure-register *current-compiland*)))) 7566 (aload (compiland-closure-register *current-compiland*)) 7567 (emit-push-constant-int (variable-closure-index variable)) 7568 (emit 'aaload) 7569 (fix-boxing representation (derive-type ref)) 7570 (emit-move-from-stack target representation)) 7571 ((variable-index variable) 7572 (aver (not (null (compiland-argument-register *current-compiland*)))) 7573 (aload (compiland-argument-register *current-compiland*)) 7574 (emit-push-constant-int (variable-index variable)) 7575 (emit 'aaload) 7576 (fix-boxing representation (variable-derived-type variable)) 7612 ((or (variable-representation variable) 7613 (variable-register variable) 7614 (variable-closure-index variable) 7615 (variable-index variable)) 7616 (emit-push-variable variable) 7617 (convert-representation (variable-representation variable) 7618 representation) 7577 7619 (emit-move-from-stack target representation)) 7578 7620 (t … … 7701 7743 (convert-representation :int representation) 7702 7744 (emit-move-from-stack target representation))) 7703 ((eq (variable-representation variable) :int)7704 (dformat t "p2-setq :int case value-form = ~S~%"7705 value-form)7706 (compile-forms-and-maybe-emit-clear-values value-form 'stack :int)7707 (when target7708 (emit 'dup))7709 (emit 'istore (variable-register variable))7710 (when target7711 ;; int on stack here7712 (convert-representation :int representation)7713 (emit-move-from-stack target representation)))7714 ((eq (variable-representation variable) :char)7715 (dformat t "p2-setq :char case~%")7716 (compile-forms-and-maybe-emit-clear-values value-form 'stack :char)7717 (when target7718 (emit 'dup))7719 (emit 'istore (variable-register variable))7720 (when target7721 ;; char on stack here7722 (convert-representation :char representation)7723 (emit-move-from-stack target representation)))7724 ((eq (variable-representation variable) :long)7725 (compile-forms-and-maybe-emit-clear-values value-form 'stack :long)7726 (when target7727 (emit 'dup2))7728 (emit 'lstore (variable-register variable))7729 (when target7730 ;; long on stack here7731 (convert-representation :long representation)7732 (emit-move-from-stack target representation)))7733 ((eq (variable-representation variable) :boolean)7734 (compile-forms-and-maybe-emit-clear-values value-form 'stack :boolean)7735 (when target7736 (emit 'dup))7737 (emit 'istore (variable-register variable))7738 (when target7739 ;; int on stack here7740 (convert-representation :boolean representation)7741 (emit-move-from-stack target representation)))7742 7745 (t 7743 (compile-forms-and-maybe-emit-clear-values value-form 'stack nil) 7744 (when target 7745 (emit 'dup)) 7746 (emit 'var-set variable) 7747 (when target 7748 (fix-boxing representation nil) 7749 (emit-move-from-stack target representation)))))) 7746 (let ((rep (variable-representation variable))) 7747 (dformat t "p2-setq ~A case value-form = ~S~%" rep value-form) 7748 (compile-forms-and-maybe-emit-clear-values value-form 'stack rep) 7749 (when target 7750 (emit-dup rep)) 7751 (emit-move-to-variable variable) 7752 (when target 7753 (convert-representation rep representation) 7754 (emit-move-from-stack target representation))))))) 7750 7755 7751 7756 (defun p2-sxhash (form target representation)
Note: See TracChangeset
for help on using the changeset viewer.
