Changeset 11840


Ignore:
Timestamp:
05/08/09 17:30:48 (12 years ago)
Author:
vvoutilainen
Message:

Clean up p2-list*.

File:
1 edited

Legend:

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

    r11838 r11840  
    65486548           (emit-move-from-stack target)))))
    65496549
     6550(defun cons-for-list* (args target representation)
     6551  (let ((cons-heads (butlast args 1)))
     6552    (dolist (cons-head cons-heads)
     6553      (emit 'new +lisp-cons-class+)
     6554      (emit 'dup)
     6555      (compile-form cons-head 'stack nil))
     6556    (compile-form (first (last args)) 'stack nil)
     6557    (dolist (cons-head cons-heads)
     6558      (declare (ignore cons-head))
     6559      (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 2)))
     6560    (apply #'maybe-emit-clear-values args)
     6561    (emit-move-from-stack target representation)))
     6562 
    65506563(defun p2-list* (form target representation)
    65516564  (let* ((args (cdr form))
    65526565         (length (length args)))
    6553     (cond ((= length 1)
    6554      (compile-forms-and-maybe-emit-clear-values (first args) 'stack nil)
    6555            (emit-move-from-stack target representation))
    6556           ((= length 2)
    6557            (let ((arg1 (first args))
    6558                  (arg2 (second args)))
    6559              (emit 'new +lisp-cons-class+)
    6560              (emit 'dup)
    6561              (compile-form arg1 'stack nil)
    6562              (compile-form arg2 'stack nil)
    6563              (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 2))
    6564              (maybe-emit-clear-values arg1 arg2)
    6565              (emit-move-from-stack target representation)))
    6566           ((= length 3)
    6567            (let ((arg1 (first args))
    6568                  (arg2 (second args))
    6569                  (arg3 (third args)))
    6570              (emit 'new +lisp-cons-class+)
    6571              (emit 'dup)
    6572              (compile-form arg1 'stack nil)
    6573              (emit 'new +lisp-cons-class+)
    6574              (emit 'dup)
    6575              (compile-form arg2 'stack nil)
    6576              (compile-form arg3 'stack nil)
    6577              (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 2))
    6578              (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 2))
    6579              (maybe-emit-clear-values arg1 arg2 arg3)
    6580              (emit-move-from-stack target representation)))
    6581           ((= length 4)
    6582            (let ((arg1 (first args))
    6583                  (arg2 (second args))
    6584                  (arg3 (third args))
    6585                  (arg4 (fourth args)))
    6586              (emit 'new +lisp-cons-class+)
    6587              (emit 'dup)
    6588              (compile-form arg1 'stack nil)
    6589              (emit 'new +lisp-cons-class+)
    6590              (emit 'dup)
    6591              (compile-form arg2 'stack nil)
    6592              (emit 'new +lisp-cons-class+)
    6593              (emit 'dup)
    6594              (compile-form arg3 'stack nil)
    6595              (compile-form arg4 'stack nil)
    6596              (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 2))
    6597              (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 2))
    6598              (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 2))
    6599              (maybe-emit-clear-values arg1 arg2 arg3 arg4)
    6600              (emit-move-from-stack target representation)))
     6566     (cond ((= length 1)
     6567     (compile-forms-and-maybe-emit-clear-values (first args) 'stack nil)
     6568            (emit-move-from-stack target representation))
     6569     ((>= 4 length 2)
     6570      (cons-for-list* args target representation))
    66016571          (t
    66026572           (compile-function-call form target representation)))))
Note: See TracChangeset for help on using the changeset viewer.