X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-ir2tran.lisp;h=4254f3d22c0282da6664c650dc07d8185196988f;hb=57d30b9b5a4b2be52431e0a8daaf81d409d146a9;hp=0f5f92e84c8f809e1633ac19b68dfb3f3058e6b5;hpb=e840f481796d191997a47421d60cd039cd260613;p=sbcl.git diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp index 0f5f92e..4254f3d 100644 --- a/src/compiler/generic/vm-ir2tran.lisp +++ b/src/compiler/generic/vm-ir2tran.lisp @@ -13,6 +13,7 @@ sb!vm:instance-header-widetag sb!vm:instance-pointer-lowtag nil) +#!+stack-allocatable-fixed-objects (defoptimizer (%make-structure-instance stack-allocate-result) ((&rest args) node dx) t) @@ -68,7 +69,7 @@ (macrolet ((make-case () `(ecase raw-type ((t) - (vop set-slot node block object arg-tn + (vop init-slot node block object arg-tn name (+ sb!vm:instance-slots-offset slot) lowtag)) ,@(mapcar (lambda (rsd) `(,(sb!kernel::raw-slot-data-raw-type rsd) @@ -81,11 +82,11 @@ nil)))) (make-case)))) (:dd - (vop set-slot node block object + (vop init-slot node block object (emit-constant (sb!kernel::dd-layout-or-lose slot)) name sb!vm:instance-slots-offset lowtag)) (otherwise - (vop set-slot node block object + (vop init-slot node block object (ecase kind (:arg (aver args) @@ -218,13 +219,11 @@ node block (list value-tn) (node-lvar node)))))))) ;;; Stack allocation optimizers per platform support -;;; -;;; Platforms with stack-allocatable vectors -#!+(or hppa mips x86 x86-64) +#!+stack-allocatable-vectors (progn (defoptimizer (allocate-vector stack-allocate-result) ((type length words) node dx) - (or (eq dx :truly) + (or (eq dx :always-dynamic) (zerop (policy node safety)) ;; a vector object should fit in one page -- otherwise it might go past ;; stack guard pages. @@ -253,7 +252,7 @@ (annotate-1-value-lvar arg))))) ;;; ...lists -#!+(or alpha hppa mips ppc sparc x86 x86-64) +#!+stack-allocatable-lists (progn (defoptimizer (list stack-allocate-result) ((&rest args) node dx) (declare (ignore node dx)) @@ -266,7 +265,9 @@ t)) ;;; ...conses -#!+(or hppa mips x86 x86-64) -(defoptimizer (cons stack-allocate-result) ((&rest args) node dx) - (declare (ignore node dx)) - t) +#!+stack-allocatable-fixed-objects +(progn + (defoptimizer (cons stack-allocate-result) ((&rest args) node dx) + t) + (defoptimizer (%make-complex stack-allocate-result) ((&rest args) node dx) + t))