X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Falloc.lisp;h=58d95479ec17811de39480094555ff3cb8b97bf7;hb=7deecae2d959173eda6a153d490c752c32050a9e;hp=55c6df53aff6999fa29d4c1b8a8c86cea1869a7a;hpb=b9e94e326f79ab01e56cb437e424ce5ea489471f;p=sbcl.git diff --git a/src/compiler/ppc/alloc.lisp b/src/compiler/ppc/alloc.lisp index 55c6df5..58d9547 100644 --- a/src/compiler/ppc/alloc.lisp +++ b/src/compiler/ppc/alloc.lisp @@ -12,11 +12,6 @@ (in-package "SB!VM") ;;;; LIST and LIST* -(defoptimizer (list stack-allocate-result) ((&rest args)) - (not (null args))) -(defoptimizer (list* stack-allocate-result) ((&rest args)) - (not (null (rest args)))) - (define-vop (list-or-list*) (:args (things :more t)) (:temporary (:scs (descriptor-reg) :type list) ptr) @@ -147,7 +142,6 @@ (allocation result (pad-data-block size) fun-pointer-lowtag :temp-tn temp :flag-tn pa-flag) (inst lr temp (logior (ash (1- size) n-widetag-bits) closure-header-widetag)))) - ;;; should this be closure-fun-slot instead of 0? (storew temp result 0 fun-pointer-lowtag) (storew function result closure-fun-slot fun-pointer-lowtag))))) @@ -157,6 +151,8 @@ (:args (value :to :save :scs (descriptor-reg any-reg))) (:temporary (:scs (non-descriptor-reg)) temp) (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag) + (:info stack-allocate-p) + (:ignore stack-allocate-p) (:results (result :scs (descriptor-reg))) (:generator 10 (with-fixed-allocation (result pa-flag temp value-cell-header-widetag value-cell-size) @@ -180,8 +176,8 @@ (define-vop (fixed-alloc) (:args) - (:info name words type lowtag) - (:ignore name) + (:info name words type lowtag stack-allocate-p) + (:ignore name stack-allocate-p) (:results (result :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) temp) (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag) @@ -201,7 +197,7 @@ (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag) (:generator 6 (inst addi bytes extra (* (1+ words) n-word-bytes)) - (inst slwi header bytes (- n-widetag-bits 2)) + (inst slwi header bytes (- n-widetag-bits n-fixnum-tag-bits)) (inst addi header header (+ (ash -2 n-widetag-bits) type)) (inst clrrwi bytes bytes n-lowtag-bits) (pseudo-atomic (pa-flag)