diff --git a/assembly/x86/array.lisp b/assembly/x86/array.lisp index 56ab832dec28a0d05b0b8b4198a540598df9d90e..1fc804b98d94989be24a5825293e29e57d132943 100644 --- a/assembly/x86/array.lisp +++ b/assembly/x86/array.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/array.lisp,v 1.3 1997/11/04 09:10:37 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/array.lisp,v 1.4 1997/11/05 14:59:40 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -37,7 +37,7 @@ (* vector-data-offset word-bytes))) (inst add result words) (inst and result (lognot vm:lowtag-mask)) - (var-allocation result result) + (allocation result result) (inst lea result (make-ea :byte :base result :disp other-pointer-type)) (storew type result 0 other-pointer-type) (storew length result vector-length-slot other-pointer-type) diff --git a/code/numbers.lisp b/code/numbers.lisp index 464103299a639631fc6c4b321287b4a671fd8da6..f8e508ee24a96c0be5fa018b6c3668439ee05967 100644 --- a/code/numbers.lisp +++ b/code/numbers.lisp @@ -5,11 +5,11 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.29 1997/11/01 22:58:17 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.30 1997/11/05 14:59:45 dtc Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.29 1997/11/01 22:58:17 dtc Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.30 1997/11/05 14:59:45 dtc Exp $ ;;; ;;; This file contains the definitions of most number functions. ;;; @@ -215,10 +215,12 @@ #+complex-float (cond ((and (typep realpart 'double-float) (typep imagpart 'double-float)) - (vm::make-complex-double-float realpart imagpart)) + (truly-the (complex double-float) + (complex realpart imagpart))) ((and (typep realpart 'single-float) (typep imagpart 'single-float)) - (vm::make-complex-single-float realpart imagpart)) + (truly-the (complex single-float) + (complex realpart imagpart))) (t (%make-complex realpart imagpart))) #-complex-float @@ -275,10 +277,12 @@ (flet ((%%make-complex (realpart imagpart) (cond ((and (typep realpart 'double-float) (typep imagpart 'double-float)) - (vm::make-complex-double-float realpart imagpart)) + (truly-the (complex double-float) + (complex realpart imagpart))) ((and (typep realpart 'single-float) (typep imagpart 'single-float)) - (vm::make-complex-single-float realpart imagpart)) + (truly-the (complex single-float) + (complex realpart imagpart))) (t (%make-complex realpart imagpart))))) (number-dispatch ((realpart real) (imagpart real)) diff --git a/code/x86-vm.lisp b/code/x86-vm.lisp index 2da6fe4f0ea0205921a139076e8743dbffdc827e..63c277f77ade8c7f4f2bb911c8f68d5c7cbd388f 100644 --- a/code/x86-vm.lisp +++ b/code/x86-vm.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; ;(ext:file-comment -; "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/x86-vm.lisp,v 1.5 1997/11/01 22:58:21 dtc Exp $") +; "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/x86-vm.lisp,v 1.6 1997/11/05 14:59:47 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -403,11 +403,11 @@ (progn (defun make-complex-single-float (x y) (declare (type single-float x y)) - (the (complex single-float) (make-complex-single-float x y))) + (truly-the (complex single-float) (complex x y))) (defun make-complex-double-float (x y) (declare (type double-float x y)) - (the (complex double-float) (make-complex-double-float x y))) + (truly-the (complex double-float) (complex x y))) (defun complex-single-float-real (x) (declare (type (complex single-float) x)) diff --git a/compiler/x86/alloc.lisp b/compiler/x86/alloc.lisp index 382fa61fa5477ecf9a3eb257f0222037837a7745..b906dbfa4ca9a1e34551fed7abcfd8288a34f6d1 100644 --- a/compiler/x86/alloc.lisp +++ b/compiler/x86/alloc.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/alloc.lisp,v 1.3 1997/11/04 09:10:55 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/alloc.lisp,v 1.4 1997/11/05 14:59:50 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -32,6 +32,7 @@ (:results (result :scs (descriptor-reg))) (:variant-vars star) (:policy :safe) + (:node-var node) (:generator 0 (cond ((zerop num) ;; (move result nil-value) @@ -49,7 +50,7 @@ temp)))) (storew reg ,list ,slot vm:list-pointer-type)))) (let ((cons-cells (if star (1- num) num))) - (allocation res (* (pad-data-block cons-size) cons-cells)) + (allocation res (* (pad-data-block cons-size) cons-cells) node) (inst lea res (make-ea :byte :base res :disp list-pointer-type)) (move ptr res) (dotimes (i (1- cons-cells)) @@ -114,6 +115,7 @@ (:results (result :scs (descriptor-reg) :from :eval)) (:temporary (:sc dword-reg :from (:argument 0)) boxed) (:temporary (:sc dword-reg :from (:argument 1)) unboxed) + (:node-var node) (:generator 100 (move boxed boxed-arg) (inst add boxed (fixnum (1+ code-trace-table-offset-slot))) @@ -124,7 +126,7 @@ (inst and unboxed (lognot lowtag-mask)) (inst mov result boxed) (inst add result unboxed) - (var-allocation result result) + (allocation result result node) (inst lea result (make-ea :byte :base result :disp other-pointer-type)) (inst shl boxed (- type-bits word-shift)) (inst or boxed code-header-type) @@ -139,8 +141,9 @@ (:translate make-fdefn) (:args (name :scs (descriptor-reg) :to :eval)) (:results (result :scs (descriptor-reg) :from :argument)) + (:node-var node) (:generator 37 - (fixed-allocation result fdefn-type fdefn-size) + (fixed-allocation result fdefn-type fdefn-size node) (storew name result fdefn-name-slot other-pointer-type) (storew nil-value result fdefn-function-slot other-pointer-type) (storew (make-fixup (extern-alien-name "undefined_tramp") :foreign) result @@ -152,9 +155,10 @@ (:info length) (:temporary (:sc any-reg) temp) (:results (result :scs (descriptor-reg))) + (:node-var node) (:generator 10 (let ((size (+ length closure-info-offset))) - (allocation result (pad-data-block size)) + (allocation result (pad-data-block size) node) (inst lea result (make-ea :byte :base result :disp function-pointer-type)) (storew (logior (ash (1- size) type-bits) closure-header-type) result 0 function-pointer-type)) @@ -166,8 +170,9 @@ (define-vop (make-value-cell) (:args (value :scs (descriptor-reg any-reg) :to :result)) (:results (result :scs (descriptor-reg) :from :eval)) + (:node-var node) (:generator 10 - (fixed-allocation result value-cell-header-type value-cell-size) + (fixed-allocation result value-cell-header-type value-cell-size node) (storew value result value-cell-value-slot other-pointer-type))) @@ -185,8 +190,9 @@ (:info name words type lowtag) (:ignore name) (:results (result :scs (descriptor-reg))) + (:node-var node) (:generator 50 - (allocation result (pad-data-block words)) + (allocation result (pad-data-block words) node) (inst lea result (make-ea :byte :base result :disp lowtag)) (when type (storew (logior (ash (1- words) type-bits) type) result 0 lowtag)))) @@ -199,6 +205,7 @@ (:results (result :scs (descriptor-reg) :from (:eval 1))) (:temporary (:sc any-reg :from :eval :to (:eval 1)) bytes) (:temporary (:sc any-reg :from :eval :to :result) header) + (:node-var node) (:generator 50 (inst lea bytes (make-ea :dword :base extra :disp (* (1+ words) word-bytes))) @@ -208,7 +215,7 @@ (inst lea header ; (w-1 << 8) | type (make-ea :dword :base header :disp (+ (ash -2 type-bits) type))) (inst and bytes (lognot lowtag-mask)) - (var-allocation result bytes) + (allocation result bytes node) (inst lea result (make-ea :byte :base result :disp lowtag)) (storew header result 0 lowtag))) @@ -220,8 +227,9 @@ (:args (name :scs (descriptor-reg) :to :eval)) (:temporary (:sc dword-reg :from :eval) temp) (:results (result :scs (descriptor-reg) :from :argument)) + (:node-var node) (:generator 37 - (fixed-allocation result symbol-header-type symbol-size) + (fixed-allocation result symbol-header-type symbol-size node) (storew name result symbol-name-slot other-pointer-type) (storew unbound-marker-type result symbol-value-slot other-pointer-type) ;; Setup a random hash value for the symbol. Perhaps the object diff --git a/compiler/x86/array.lisp b/compiler/x86/array.lisp index 738ee52ad02277ebb5cd3e88e3fb619216a548fb..110b22d4ec6d2c713c3aa29d43843fcfcbdbc6d8 100644 --- a/compiler/x86/array.lisp +++ b/compiler/x86/array.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.7 1997/11/04 09:10:58 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.8 1997/11/05 14:59:52 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -33,6 +33,7 @@ (:temporary (:sc any-reg :to :eval) bytes) (:temporary (:sc any-reg :to :result) header) (:results (result :scs (descriptor-reg) :from :eval)) + (:node-var node) (:generator 13 (inst lea bytes (make-ea :dword :base rank @@ -44,7 +45,7 @@ (inst shl header type-bits) (inst or header type) (inst shr header 2) - (var-allocation result bytes) + (allocation result bytes node) (inst lea result (make-ea :dword :base result :disp other-pointer-type)) (storew header result 0 other-pointer-type))) diff --git a/compiler/x86/call.lisp b/compiler/x86/call.lisp index 51e7172dbdeef0c09e947863abeff65e486a33c6..588fa072ee1be76fa777ada23908919296dc9717 100644 --- a/compiler/x86/call.lisp +++ b/compiler/x86/call.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/call.lisp,v 1.4 1997/11/04 09:11:00 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/call.lisp,v 1.5 1997/11/05 14:59:53 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1434,6 +1434,7 @@ (:temporary (:sc dword-reg :offset eax-offset) eax) (:temporary (:sc dword-reg) dst) (:results (result :scs (descriptor-reg))) + (:node-var node) (:generator 20 (move src context) (move ecx count) @@ -1441,7 +1442,7 @@ (inst mov result nil-value) (inst jecxz done) (inst lea dst (make-ea :dword :index ecx :scale 2)) - (var-allocation dst dst) + (allocation dst dst node) (inst lea dst (make-ea :byte :base dst :disp list-pointer-type)) ;; Convert the count into a raw value, so we can use the LOOP inst. (inst shr ecx 2) diff --git a/compiler/x86/float.lisp b/compiler/x86/float.lisp index 45cff64f870956c94488bbe97c54e4f8e1d11244..4c7388b154c5cbf02e22a8089e2dcb82fda11492 100644 --- a/compiler/x86/float.lisp +++ b/compiler/x86/float.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.11 1997/11/04 09:11:04 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.12 1997/11/05 14:59:55 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -258,7 +258,7 @@ (let ((x-real (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg) :offset (tn-offset x))) (y-real (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg) - :offset (tn-offset x)))) + :offset (tn-offset y)))) (cond ((zerop (tn-offset y-real)) (copy-fp-reg-to-fr0 x-real)) ((zerop (tn-offset x-real)) @@ -270,7 +270,7 @@ (let ((x-imag (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg) :offset (1+ (tn-offset x)))) (y-imag (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg) - :offset (1+ (tn-offset x))))) + :offset (1+ (tn-offset y))))) (inst fxch x-imag) (inst fstd y-imag) (inst fxch x-imag))))) @@ -298,9 +298,10 @@ (define-vop (move-from-single) (:args (x :scs (single-reg) :to :save)) (:results (y :scs (descriptor-reg))) + (:node-var node) (:note "float to pointer coercion") (:generator 13 - (fixed-allocation y vm:single-float-type vm:single-float-size) + (fixed-allocation y vm:single-float-type vm:single-float-size node) (with-tn@fp-top(x) (inst fst (ea-for-sf-desc y))))) (define-move-vop move-from-single :move @@ -319,9 +320,10 @@ (define-vop (move-from-double) (:args (x :scs (double-reg) :to :save)) (:results (y :scs (descriptor-reg))) + (:node-var node) (:note "float to pointer coercion") (:generator 13 - (fixed-allocation y vm:double-float-type vm:double-float-size) + (fixed-allocation y vm:double-float-type vm:double-float-size node) (with-tn@fp-top(x) (inst fstd (ea-for-df-desc y))))) (define-move-vop move-from-double :move @@ -365,10 +367,11 @@ (define-vop (move-from-complex-single) (:args (x :scs (complex-single-reg) :to :save)) (:results (y :scs (descriptor-reg))) + (:node-var node) (:note "complex float to pointer coercion") (:generator 13 (fixed-allocation y vm:complex-single-float-type - vm:complex-single-float-size) + vm:complex-single-float-size node) (let ((real-tn (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg) :offset (tn-offset x)))) (with-tn@fp-top(real-tn) @@ -383,10 +386,11 @@ (define-vop (move-from-complex-double) (:args (x :scs (complex-double-reg) :to :save)) (:results (y :scs (descriptor-reg))) + (:node-var node) (:note "complex float to pointer coercion") (:generator 13 (fixed-allocation y vm:complex-double-float-type - vm:complex-double-float-size) + vm:complex-double-float-size node) (let ((real-tn (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg) :offset (tn-offset x)))) (with-tn@fp-top(real-tn) @@ -499,7 +503,7 @@ (y-real (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg) - :offset (tn-offset x)))) + :offset (tn-offset y)))) (cond ((zerop (tn-offset y-real)) (copy-fp-reg-to-fr0 x-real)) ((zerop (tn-offset x-real)) @@ -515,7 +519,7 @@ (y-imag (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg) - :offset (1+ (tn-offset x))))) + :offset (1+ (tn-offset y))))) (inst fxch x-imag) (inst fstd y-imag) (inst fxch x-imag)))) @@ -2562,11 +2566,6 @@ complex-single-float-real complex-double-float-real complex-single-float-imag complex-double-float-imag))) -(defknown make-complex-single-float (single-float single-float) - (complex single-float) (flushable)) -(defknown make-complex-double-float (double-float double-float) - (complex double-float) (flushable)) - (define-vop (make-complex-float) (:args (x :target r) (y :to :save)) @@ -2595,7 +2594,7 @@ (inst fxch y))))))) (define-vop (make-complex-single-float make-complex-float) - (:translate make-complex-single-float) + (:translate complex) (:args (x :scs (single-reg) :target r) (y :scs (single-reg) :to :save)) (:arg-types single-float single-float) @@ -2603,7 +2602,7 @@ (:result-types complex-single-float)) (define-vop (make-complex-double-float make-complex-float) - (:translate make-complex-double-float) + (:translate complex) (:args (x :scs (double-reg) :target r) (y :scs (double-reg) :to :save)) (:arg-types double-float double-float) diff --git a/compiler/x86/macros.lisp b/compiler/x86/macros.lisp index 8fac524bee52e119715b7d5d6b1104ed1779bf36..c0a957eecc5842c3f7caccc1198e24478634aaf4 100644 --- a/compiler/x86/macros.lisp +++ b/compiler/x86/macros.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.5 1997/11/04 09:11:08 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.6 1997/11/05 14:59:58 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -112,121 +112,87 @@ ;;;; Allocation helpers -;;; Two allocation approaches are implemented. A call into C can be -;;; used where special care can be taken to disable -;;; interrupt. Alternatively with gencgc inline allocation is possible -;;; although it isn't interrupt safe. - -;;;; Call into C. -(defmacro var-allocation (alloc-tn size-tn) - "Allocate an object with a size in bytes given by Size-TN." - `(let ((alloc-tn-offset (tn-offset ,alloc-tn))) - ;; Dispatch to the appropriate allocation routine. Each - ;; destination has a special entry point. The size may be a - ;; register or a constant, although the constant case is better - ;; handled by with-fixed-cgc-allocation. - (ecase alloc-tn-offset - (,eax-offset - (move eax-tn ,size-tn) - (inst call (make-fixup (extern-alien-name "alloc_to_eax") :foreign))) - (,ecx-offset - (move ecx-tn ,size-tn) - (inst call (make-fixup (extern-alien-name "alloc_to_ecx") :foreign))) - (,edx-offset - (move edx-tn ,size-tn) - (inst call (make-fixup (extern-alien-name "alloc_to_edx") :foreign))) - (,ebx-offset - (move ebx-tn ,size-tn) - (inst call (make-fixup (extern-alien-name "alloc_to_ebx") :foreign))) - (,esi-offset - (move esi-tn ,size-tn) - (inst call (make-fixup (extern-alien-name "alloc_to_esi") :foreign))) - (,edi-offset - (move edi-tn ,size-tn) - (inst call (make-fixup (extern-alien-name "alloc_to_edi") :foreign)))))) - -(defmacro allocation (alloc-tn size) - "Allocate an object of the given fixed size in bytes; the size must be - an integer." - `(let ((alloc-tn-offset (tn-offset ,alloc-tn))) - (assert (integerp ,size)) - ;; Dispatch to the appropriate allocation routine. Each - ;; destination has a special entry point and there are special - ;; case for 2 and 4 word objects. - (ecase alloc-tn-offset - (,eax-offset - (case ,size - (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_eax") - :foreign))) - (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_eax") - :foreign))) - (t - ;; Else: push the size onto the stack. - (inst mov eax-tn ,size) - (inst call (make-fixup (extern-alien-name "alloc_to_eax") - :foreign))))) - (,ecx-offset - (case ,size - (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_ecx") - :foreign))) - (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_ecx") - :foreign))) - (t - ;; Else: push the size onto the stack. - (inst mov ecx-tn ,size) - (inst call (make-fixup (extern-alien-name "alloc_to_ecx") - :foreign))))) - (,edx-offset - (case ,size - (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_edx") - :foreign))) - (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_edx") - :foreign))) - (t - ;; Else: push the size onto the stack. - (inst mov edx-tn ,size) - (inst call (make-fixup (extern-alien-name "alloc_to_edx") - :foreign))))) - (,ebx-offset - (case ,size - (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_ebx") - :foreign))) - (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_ebx") - :foreign))) - (t - ;; Else: push the size onto the stack. - (inst mov ebx-tn ,size) - (inst call (make-fixup (extern-alien-name "alloc_to_ebx") - :foreign))))) - (,esi-offset - (case ,size - (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_esi") - :foreign))) - (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_esi") - :foreign))) - (t - ;; Else: push the size onto the stack. - (inst mov esi-tn ,size) - (inst call (make-fixup (extern-alien-name "alloc_to_esi") - :foreign))))) - (,edi-offset - (case ,size - (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_edi") - :foreign))) - (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_edi") - :foreign))) - (t - ;; Else: push the size onto the stack. - (inst mov edi-tn ,size) - (inst call (make-fixup (extern-alien-name "alloc_to_edi") - :foreign)))))))) - -(defmacro fixed-allocation (result-tn type-code size) +(defun allocation (alloc-tn size &optional inline) + "Allocate an object with a size in bytes given by Size. + The size may be an integer of a TN. + If Inline is a VOP node-var then it is used to make an appropriate + speed vs size decision." + (declare (ignore inline)) + (flet ((load-size (dst-tn size) + (unless (and (tn-p size) (location= alloc-tn size)) + (inst mov dst-tn size)))) + (let ((alloc-tn-offset (tn-offset alloc-tn))) + ;; C call to allocate via dispatch routines - each destination + ;; has a special entry point. + (ecase alloc-tn-offset + (#.eax-offset + (case size + (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_eax") + :foreign))) + (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_eax") + :foreign))) + (t + (load-size eax-tn size) + (inst call (make-fixup (extern-alien-name "alloc_to_eax") + :foreign))))) + (#.ecx-offset + (case size + (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_ecx") + :foreign))) + (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_ecx") + :foreign))) + (t + (load-size ecx-tn size) + (inst call (make-fixup (extern-alien-name "alloc_to_ecx") + :foreign))))) + (#.edx-offset + (case size + (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_edx") + :foreign))) + (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_edx") + :foreign))) + (t + (load-size edx-tn size) + (inst call (make-fixup (extern-alien-name "alloc_to_edx") + :foreign))))) + (#.ebx-offset + (case size + (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_ebx") + :foreign))) + (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_ebx") + :foreign))) + (t + (load-size ebx-tn size) + (inst call (make-fixup (extern-alien-name "alloc_to_ebx") + :foreign))))) + (#.esi-offset + (case size + (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_esi") + :foreign))) + (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_esi") + :foreign))) + (t + (load-size esi-tn size) + (inst call (make-fixup (extern-alien-name "alloc_to_esi") + :foreign))))) + (#.edi-offset + (case size + (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_edi") + :foreign))) + (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_edi") + :foreign))) + (t + (load-size edi-tn size) + (inst call (make-fixup (extern-alien-name "alloc_to_edi") + :foreign)))))))) + (values)) + +(defmacro fixed-allocation (result-tn type-code size &optional inline) "Allocate an other-pointer object of fixed Size with a single word header having the specified Type-Code. The result is placed in Result-TN." `(progn - (allocation ,result-tn (pad-data-block ,size)) + (allocation ,result-tn (pad-data-block ,size) ,inline) (storew (logior (ash (1- ,size) vm:type-bits) ,type-code) ,result-tn) (inst lea ,result-tn (make-ea :byte :base ,result-tn :disp other-pointer-type)))) diff --git a/compiler/x86/move.lisp b/compiler/x86/move.lisp index 745208c251618019d10b57f27746d596d4367b76..210b1813a4732e9ffa1be15087ce099a027a14bb 100644 --- a/compiler/x86/move.lisp +++ b/compiler/x86/move.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/move.lisp,v 1.3 1997/11/04 09:11:11 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/move.lisp,v 1.4 1997/11/05 14:59:58 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -300,6 +300,7 @@ (:args (x :scs (signed-reg unsigned-reg) :to :result)) (:results (y :scs (any-reg descriptor-reg) :from :argument)) (:note "signed word to integer coercion") + (:node-var node) (:generator 20 (assert (not (location= x y))) (let ((bignum (gen-label)) @@ -313,7 +314,7 @@ (assemble (*elsewhere*) (emit-label bignum) - (fixed-allocation y bignum-type (+ bignum-digits-offset 1)) + (fixed-allocation y bignum-type (+ bignum-digits-offset 1) node) (storew x y bignum-digits-offset other-pointer-type) (inst jmp done))))) ;;; @@ -346,6 +347,7 @@ (:args (x :scs (signed-reg unsigned-reg) :to :save)) (:temporary (:sc dword-reg) alloc) (:results (y :scs (any-reg descriptor-reg))) + (:node-var node) (:note "unsigned word to integer coercion") (:generator 20 (assert (not (location= x y))) @@ -377,7 +379,7 @@ (inst mov y (logior (ash (1- (+ bignum-digits-offset 1)) vm:type-bits) bignum-type)) (emit-label l1) - (allocation alloc (pad-data-block (+ bignum-digits-offset 2))) + (allocation alloc (pad-data-block (+ bignum-digits-offset 2)) node) (storew y alloc) (inst lea y (make-ea :byte :base alloc :disp other-pointer-type)) (storew x y bignum-digits-offset other-pointer-type) diff --git a/compiler/x86/sap.lisp b/compiler/x86/sap.lisp index 30f47bb376bc51f1162bcd20065574aaedbf31e2..0bbfd165df8f86f2547a4c6288a163ffad0c0a02 100644 --- a/compiler/x86/sap.lisp +++ b/compiler/x86/sap.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/sap.lisp,v 1.4 1997/11/04 09:11:15 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/sap.lisp,v 1.5 1997/11/05 14:59:59 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -42,8 +42,9 @@ (:args (sap :scs (sap-reg) :to :result)) (:results (res :scs (descriptor-reg) :from :argument)) (:note "SAP to pointer coercion") + (:node-var node) (:generator 20 - (fixed-allocation res sap-type sap-size) + (fixed-allocation res sap-type sap-size node) (storew sap res sap-pointer-slot other-pointer-type))) ;;;