(:temporary (:scs (descriptor-reg) :type list) ptr)
(:temporary (:scs (descriptor-reg)) temp)
(:temporary (:scs (descriptor-reg) :type list :to (:result 0) :target result)
(:temporary (:scs (descriptor-reg) :type list) ptr)
(:temporary (:scs (descriptor-reg)) temp)
(:temporary (:scs (descriptor-reg) :type list :to (:result 0) :target result)
- (move null-tn result))
- ((and star (= num 1))
- (move (tn-ref-tn things) result))
- (t
- (macrolet
- ((store-car (tn list &optional (slot cons-car-slot))
- `(let ((reg
- (sc-case ,tn
- ((any-reg descriptor-reg) ,tn)
- (zero zero-tn)
- (null null-tn)
- (control-stack
- (load-stack-tn temp ,tn)
- temp))))
- (storew reg ,list ,slot list-pointer-lowtag))))
- (let* ((dx-p (node-stack-allocate-p node))
+ (move null-tn result))
+ ((and star (= num 1))
+ (move (tn-ref-tn things) result))
+ (t
+ (macrolet
+ ((store-car (tn list &optional (slot cons-car-slot))
+ `(let ((reg
+ (sc-case ,tn
+ ((any-reg descriptor-reg) ,tn)
+ (zero zero-tn)
+ (null null-tn)
+ (control-stack
+ (load-stack-tn temp ,tn)
+ temp))))
+ (storew reg ,list ,slot list-pointer-lowtag))))
+ (let* ((dx-p (node-stack-allocate-p node))
(cond (dx-p
(align-csp res)
(inst bis csp-tn list-pointer-lowtag res)
(inst lda csp-tn space csp-tn))
(t
(inst bis alloc-tn list-pointer-lowtag res)))
(cond (dx-p
(align-csp res)
(inst bis csp-tn list-pointer-lowtag res)
(inst lda csp-tn space csp-tn))
(t
(inst bis alloc-tn list-pointer-lowtag res)))
- (move res ptr)
- (dotimes (i (1- cons-cells))
- (store-car (tn-ref-tn things) ptr)
- (setf things (tn-ref-across things))
- (inst lda ptr (pad-data-block cons-size) ptr)
- (storew ptr ptr
- (- cons-cdr-slot cons-size)
- list-pointer-lowtag))
- (store-car (tn-ref-tn things) ptr)
- (cond (star
- (setf things (tn-ref-across things))
- (store-car (tn-ref-tn things) ptr cons-cdr-slot))
- (t
- (storew null-tn ptr
- cons-cdr-slot list-pointer-lowtag)))
- (aver (null (tn-ref-across things)))
- (move res result))))))))
+ (move res ptr)
+ (dotimes (i (1- cons-cells))
+ (store-car (tn-ref-tn things) ptr)
+ (setf things (tn-ref-across things))
+ (inst lda ptr (pad-data-block cons-size) ptr)
+ (storew ptr ptr
+ (- cons-cdr-slot cons-size)
+ list-pointer-lowtag))
+ (store-car (tn-ref-tn things) ptr)
+ (cond (star
+ (setf things (tn-ref-across things))
+ (store-car (tn-ref-tn things) ptr cons-cdr-slot))
+ (t
+ (storew null-tn ptr
+ cons-cdr-slot list-pointer-lowtag)))
+ (aver (null (tn-ref-across things)))
+ (move res result))))))))
(:results (result :scs (descriptor-reg)))
(:temporary (:scs (non-descriptor-reg)) ndescr)
(:temporary (:scs (any-reg) :from (:argument 0)) boxed)
(:results (result :scs (descriptor-reg)))
(:temporary (:scs (non-descriptor-reg)) ndescr)
(:temporary (:scs (any-reg) :from (:argument 0)) boxed)
(inst and boxed ndescr boxed)
(inst srl unboxed-arg word-shift unboxed)
(inst lda unboxed lowtag-mask unboxed)
(inst and unboxed ndescr unboxed)
(inst sll boxed (- n-widetag-bits word-shift) ndescr)
(inst bis ndescr code-header-widetag ndescr)
(inst and boxed ndescr boxed)
(inst srl unboxed-arg word-shift unboxed)
(inst lda unboxed lowtag-mask unboxed)
(inst and unboxed ndescr unboxed)
(inst sll boxed (- n-widetag-bits word-shift) ndescr)
(inst bis ndescr code-header-widetag ndescr)
(:info length stack-allocate-p)
(:temporary (:scs (non-descriptor-reg)) temp)
(:results (result :scs (descriptor-reg)))
(:info length stack-allocate-p)
(:temporary (:scs (non-descriptor-reg)) temp)
(:results (result :scs (descriptor-reg)))
(inst bis csp-tn fun-pointer-lowtag result)
(inst lda csp-tn alloc-size csp-tn))
(t
(inst bis alloc-tn fun-pointer-lowtag result)))
(inst bis csp-tn fun-pointer-lowtag result)
(inst lda csp-tn alloc-size csp-tn))
(t
(inst bis alloc-tn fun-pointer-lowtag result)))
- (storew temp result 0 fun-pointer-lowtag))
- (storew function result closure-fun-slot fun-pointer-lowtag))))
+ (storew temp result 0 fun-pointer-lowtag)
+ (storew function result closure-fun-slot fun-pointer-lowtag)))))
;;; The compiler likes to be able to directly make value cells.
(define-vop (make-value-cell)
(:args (value :to :save :scs (descriptor-reg any-reg null zero)))
(:temporary (:scs (non-descriptor-reg)) temp)
;;; The compiler likes to be able to directly make value cells.
(define-vop (make-value-cell)
(:args (value :to :save :scs (descriptor-reg any-reg null zero)))
(:temporary (:scs (non-descriptor-reg)) temp)
(storew value result value-cell-value-slot other-pointer-lowtag))))
\f
;;;; automatic allocators for primitive objects
(storew value result value-cell-value-slot other-pointer-lowtag))))
\f
;;;; automatic allocators for primitive objects
(:results (result :scs (descriptor-reg)))
(:temporary (:scs (non-descriptor-reg)) temp)
(:generator 4
(pseudo-atomic (:extra (pad-data-block words))
(inst bis alloc-tn lowtag result)
(when type
(:results (result :scs (descriptor-reg)))
(:temporary (:scs (non-descriptor-reg)) temp)
(:generator 4
(pseudo-atomic (:extra (pad-data-block words))
(inst bis alloc-tn lowtag result)
(when type