From 725ab9ee498d0edaf81e6ab70d11097b5b5c25ad Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Tue, 4 Nov 1997 09:11:23 +0000 Subject: [PATCH] Merge in changes to the x86 backend from the gencgc branch, allowing common binaries to be run on both: * The immediate-stack storage class has been removed, this is unnecessary as the descriptor-stack SC can be used. It may have once been part of some GC stragety to reduce the number of stack slots that needed to be noted for a GC. * The object allocation has been abstracted and cleaned up. This should produce slightly faster smaller code with CGC, and can be compiled to support inline allocation with GENCGC. CGC compiled code will run under GENCGC, and GENCGC binaries that don't use inline allocation will run under CGC. * A random hash is now placed in the unused symbol object slot (the symbol-hash slot). This saves flushing the info cache at each GC, and may have other uses for symbol based hash tables. Should help MP safety. * Common set of static symbols used by both CGC and GENCGC. * Corrections to the stack-ref VOP; now returns lisp objects not unsigned numbers. Required some patches to debug-int. * Inline unsigned/signed byte 32 to bignum allocation enabled. * Support for the x86 xadd instruction applied to instance slot and symbol values - may be handy for some MP code. * Bump up the FASL file version from 1 to 2. --- assembly/x86/alloc.lisp | 20 +- assembly/x86/arith.lisp | 26 ++- assembly/x86/array.lisp | 27 +-- code/debug-int.lisp | 32 +-- code/gc.lisp | 8 +- code/lispinit.lisp | 5 +- code/symbol.lisp | 4 +- compiler/generic/new-genesis.lisp | 18 +- compiler/generic/objdef.lisp | 13 +- compiler/globaldb.lisp | 18 +- compiler/x86/alloc.lisp | 174 +++++++--------- compiler/x86/arith.lisp | 75 +++---- compiler/x86/array.lisp | 18 +- compiler/x86/c-call.lisp | 12 +- compiler/x86/call.lisp | 67 +++---- compiler/x86/cell.lisp | 27 ++- compiler/x86/char.lisp | 13 +- compiler/x86/debug.lisp | 44 ++--- compiler/x86/float.lisp | 64 +++--- compiler/x86/insts.lisp | 6 +- compiler/x86/macros.lisp | 159 +++++++++++---- compiler/x86/memory.lisp | 29 ++- compiler/x86/move.lisp | 64 ++---- compiler/x86/nlx.lisp | 12 +- compiler/x86/parms.lisp | 43 ++-- compiler/x86/pred.lisp | 12 +- compiler/x86/print.lisp | 3 +- compiler/x86/sap.lisp | 11 +- compiler/x86/system.lisp | 4 +- compiler/x86/values.lisp | 3 +- compiler/x86/vm.lisp | 69 +++---- lisp/cgc.c | 24 +-- lisp/x86-arch.c | 2 + lisp/x86-assem.S | 316 +++++++++++++++++++++++++++++- 34 files changed, 885 insertions(+), 537 deletions(-) diff --git a/assembly/x86/alloc.lisp b/assembly/x86/alloc.lisp index 4a9b13ad0..4cd98cb44 100644 --- a/assembly/x86/alloc.lisp +++ b/assembly/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/assembly/x86/alloc.lisp,v 1.2 1997/02/10 16:59:54 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/alloc.lisp,v 1.3 1997/11/04 09:10:35 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -26,8 +26,7 @@ (define-assembly-routine (move-from-signed) ((:temp eax dword-reg eax-offset) - (:temp ebx dword-reg ebx-offset) - (:temp ecx dword-reg ecx-offset)) + (:temp ebx dword-reg ebx-offset)) (inst mov ebx eax) (inst shl ebx 1) (inst jmp :o bignum) @@ -36,8 +35,8 @@ (inst ret) BIGNUM - (with-fixed-allocation (ebx ecx bignum-type (+ bignum-digits-offset 1)) - (storew eax ebx bignum-digits-offset other-pointer-type)) + (fixed-allocation ebx bignum-type (+ bignum-digits-offset 1)) + (storew eax ebx bignum-digits-offset other-pointer-type) (inst ret)) @@ -45,8 +44,7 @@ (define-assembly-routine (move-from-unsigned) ((:temp eax dword-reg eax-offset) - (:temp ebx dword-reg ebx-offset) - (:temp ecx dword-reg ecx-offset)) + (:temp ebx dword-reg ebx-offset)) (inst test eax #xe0000000) (inst jmp :nz bignum) @@ -66,11 +64,11 @@ (inst mov ebx eax) ;; Two word bignum - (with-fixed-allocation (ebx ecx bignum-type (+ bignum-digits-offset 2)) - (storew eax ebx bignum-digits-offset other-pointer-type)) + (fixed-allocation ebx bignum-type (+ bignum-digits-offset 2)) + (storew eax ebx bignum-digits-offset other-pointer-type) (inst ret) ONE-WORD-BIGNUM - (with-fixed-allocation (ebx ecx bignum-type (+ bignum-digits-offset 1)) - (storew eax ebx bignum-digits-offset other-pointer-type)) + (fixed-allocation ebx bignum-type (+ bignum-digits-offset 1)) + (storew eax ebx bignum-digits-offset other-pointer-type) (inst ret)) diff --git a/assembly/x86/arith.lisp b/assembly/x86/arith.lisp index 1b4b385a4..5bc13ad32 100644 --- a/assembly/x86/arith.lisp +++ b/assembly/x86/arith.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/arith.lisp,v 1.4 1997/09/15 10:40:12 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/arith.lisp,v 1.5 1997/11/04 09:10:36 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -78,9 +78,8 @@ (move ecx res) - (with-fixed-allocation (res ebx bignum-type (1+ bignum-digits-offset)) - (storew ecx res bignum-digits-offset other-pointer-type)) - + (fixed-allocation res bignum-type (1+ bignum-digits-offset)) + (storew ecx res bignum-digits-offset other-pointer-type) OKAY) @@ -99,8 +98,8 @@ (move ecx res) - (with-fixed-allocation (res ebx bignum-type (1+ bignum-digits-offset)) - (storew ecx res bignum-digits-offset other-pointer-type)) + (fixed-allocation res bignum-type (1+ bignum-digits-offset)) + (storew ecx res bignum-digits-offset other-pointer-type) OKAY) (define-generic-arith-routine (* 30) @@ -120,15 +119,15 @@ (inst cmp x ecx) (inst jmp :e SINGLE-WORD-BIGNUM) - (with-fixed-allocation (res ebx bignum-type (+ bignum-digits-offset 2)) - (storew eax res bignum-digits-offset other-pointer-type) - (storew ecx res (1+ bignum-digits-offset) other-pointer-type)) + (fixed-allocation res bignum-type (+ bignum-digits-offset 2)) + (storew eax res bignum-digits-offset other-pointer-type) + (storew ecx res (1+ bignum-digits-offset) other-pointer-type) (inst jmp DONE) SINGLE-WORD-BIGNUM - (with-fixed-allocation (res ebx bignum-type (1+ bignum-digits-offset)) - (storew eax res bignum-digits-offset other-pointer-type)) + (fixed-allocation res bignum-type (1+ bignum-digits-offset)) + (storew eax res bignum-digits-offset other-pointer-type) (inst jmp DONE) OKAY @@ -168,9 +167,8 @@ (inst shr res 2) ; sign bit is data - remove type bits (move ecx res) - (with-fixed-allocation (res eax bignum-type (1+ bignum-digits-offset)) - (storew ecx res bignum-digits-offset other-pointer-type)) - + (fixed-allocation res bignum-type (1+ bignum-digits-offset)) + (storew ecx res bignum-digits-offset other-pointer-type) OKAY) diff --git a/assembly/x86/array.lisp b/assembly/x86/array.lisp index ce0e7d045..56ab832de 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.2 1997/02/10 17:03:44 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/array.lisp,v 1.3 1997/11/04 09:10:37 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -32,24 +32,13 @@ ((:arg type unsigned-reg eax-offset) (:arg length any-reg ebx-offset) (:arg words any-reg ecx-offset) - (:res result descriptor-reg edx-offset) - - (:temp alloc dword-reg edi-offset)) - #-cgc - (with-allocation (alloc) - (inst lea result (make-ea :byte :base alloc :disp other-pointer-type)) - (inst add alloc - (+ (1- (ash 1 lowtag-bits)) (* vector-data-offset word-bytes))) - (inst add alloc words) - (inst and alloc (lognot vm:lowtag-mask))) - #+cgc - (progn - (inst mov alloc (+ (1- (ash 1 lowtag-bits)) - (* vector-data-offset word-bytes))) - (inst add alloc words) - (inst and alloc (lognot vm:lowtag-mask)) - (with-cgc-allocation(alloc alloc) - (inst lea result (make-ea :byte :base alloc :disp other-pointer-type)))) + (:res result descriptor-reg edx-offset)) + (inst mov result (+ (1- (ash 1 lowtag-bits)) + (* vector-data-offset word-bytes))) + (inst add result words) + (inst and result (lognot vm:lowtag-mask)) + (var-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) (inst ret)) diff --git a/code/debug-int.lisp b/code/debug-int.lisp index 400628bec..fe5d50f3c 100644 --- a/code/debug-int.lisp +++ b/code/debug-int.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.71 1997/02/08 17:22:40 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.72 1997/11/04 09:10:41 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -915,12 +915,19 @@ ; (format t "c-lra-fpc ~a ~a ~a~%" pc code pc-offset) (values pc-offset code))))) +#+x86 +(defun stack-ref-32 (stack offset) + (declare (type sys:system-area-pointer stack) + (type fixnum offset) + (optimize (speed 3) (safety 0))) + (kernel::get-lisp-obj-address (stack-ref stack offset))) + ;;; maybe these should be generalized in xxx-vm.lisp ;;;(proclaim '(inline old-frame-pointer lisp-return-pc)) (defun old-frame-pointer(scp) (declare (type (alien:alien (* unix:sigcontext)) scp)) (let* #+x86 ((cfp (vm:sigcontext-register scp vm::ebp-offset)) - (ofp (kernel:stack-ref (int-sap cfp) vm::ocfp-save-offset))) + (ofp (stack-ref-32 (int-sap cfp) vm::ocfp-save-offset))) #-x86 ((ofp (vm:sigcontext-register scp vm::ocfp-offset))) (declare (type (unsigned-byte 32) #+x86 cfp ofp)) (int-sap ofp))) @@ -931,7 +938,7 @@ ;;; return a value that can be used in computation (declare (type (alien:alien (* unix:sigcontext)) scp)) (let* ((cfp (vm:sigcontext-register scp vm::ebp-offset)) - (lra (kernel:stack-ref (int-sap cfp) vm::return-pc-save-offset))) + (lra (stack-ref-32 (int-sap cfp) vm::return-pc-save-offset))) lra)) #-x86 (defun lisp-return-pc(scp) @@ -957,8 +964,8 @@ ;; These return hopefully correct ofp ret values at a call site (defun maybe-lisp-from-c(fp) (declare (type system-area-pointer fp)) - (let ((s0 (kernel:stack-ref fp vm::old-fp-save-offset)) - (s1 (kernel:stack-ref fp vm::return-pc-save-offset))) + (let ((s0 (stack-ref-32 fp vm::old-fp-save-offset)) + (s1 (stack-ref-32 fp vm::return-pc-save-offset))) (when (and (kernel:make-lisp-obj s0)(kernel:make-lisp-obj s1)) (let ((lisp-ofp (int-sap s0)) (lisp-lra (int-sap s1))) @@ -973,8 +980,8 @@ (defun maybe-lisp-from-lisp(fp) (declare (type system-area-pointer fp)) (when (cstack-pointer-valid-p fp) - (let ((s0 (kernel:stack-ref fp vm::old-fp-save-offset)) - (s1 (kernel:stack-ref fp vm::return-pc-save-offset))) + (let ((s0 (stack-ref-32 fp vm::old-fp-save-offset)) + (s1 (stack-ref-32 fp vm::return-pc-save-offset))) (when (and (kernel:make-lisp-obj s0) (kernel:make-lisp-obj s1)) (let ((ofp (int-sap s0)) @@ -1145,9 +1152,9 @@ (sub-access-debug-var-slot pointer loc escaped)))) (ecase stack-slot (#.vm::ocfp-save-offset - (kernel:stack-ref pointer stack-slot)) + (stack-ref-32 pointer stack-slot)) (#.vm::lra-save-offset - (kernel:make-lisp-obj (kernel:stack-ref pointer stack-slot))))))) + (kernel:stack-ref pointer stack-slot)))))) ;;; (defun (setf get-context-value) (value frame stack-slot loc) @@ -3082,9 +3089,8 @@ (system:int-sap (- (system:sap-int fp) (* (+ (c::sc-offset-offset sc-offset) 2) vm:word-bytes))) 0)) - ((#.vm:control-stack-sc-number #.vm:immediate-stack-sc-number) - (kernel:make-lisp-obj - (kernel:stack-ref fp (c::sc-offset-offset sc-offset)))) + (#.vm:control-stack-sc-number + (kernel:stack-ref fp (c::sc-offset-offset sc-offset))) (#.vm:base-char-stack-sc-number (code-char (system:sap-ref-32 @@ -3299,7 +3305,7 @@ (system:sap+ fp (* (+ (c::sc-offset-offset sc-offset) 2) (- vm:word-bytes))) 0) (the double-float value))) - ((#.vm:control-stack-sc-number #.vm:immediate-stack-sc-number) + (#.vm:control-stack-sc-number (setf (kernel:stack-ref fp (c::sc-offset-offset sc-offset)) value)) (#.vm:base-char-stack-sc-number (setf (system:sap-ref-32 diff --git a/code/gc.lisp b/code/gc.lisp index 7694c9f5b..7932f2625 100644 --- a/code/gc.lisp +++ b/code/gc.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.21 1997/02/08 21:08:01 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.22 1997/11/04 09:10:44 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -47,14 +47,14 @@ (c-var-frob current-dynamic-space-start "current_dynamic_space") (declaim (inline dynamic-usage)) -#-cgc +#-(or cgc gencgc) (defun dynamic-usage () (the (unsigned-byte 32) (- (system:sap-int (c::dynamic-space-free-pointer)) (current-dynamic-space-start)))) -#+cgc -(c-var-frob dynamic-usage "cgc_bytes_allocated") +#+(or cgc gencgc) +(c-var-frob dynamic-usage "bytes_allocated") (defun static-space-usage () (- (* lisp::*static-space-free-pointer* vm:word-bytes) diff --git a/code/lispinit.lisp b/code/lispinit.lisp index 45546857d..72fa50820 100644 --- a/code/lispinit.lisp +++ b/code/lispinit.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.50 1997/09/15 16:47:04 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.51 1997/11/04 09:10:45 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -518,7 +518,8 @@ (let ((loc (int-sap (- (sap-int ptr) offset)))) (cond ((= offset bytes-per-scrub-unit) count) - ((zerop (stack-ref loc 0)) + ((zerop (kernel::get-lisp-obj-address (stack-ref loc 0))) +; ((zerop (stack-ref loc 0)) (look ptr (+ offset vm:word-bytes) count)) (t (scrub ptr offset (+ count vm:word-bytes))))))) diff --git a/code/symbol.lisp b/code/symbol.lisp index abb94dd2a..c6dc92543 100644 --- a/code/symbol.lisp +++ b/code/symbol.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/symbol.lisp,v 1.22 1997/02/27 22:40:38 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/symbol.lisp,v 1.23 1997/11/04 09:10:46 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -99,7 +99,7 @@ #-gengc (make-symbol string) #+gengc (%make-symbol (random most-positive-fixnum) string)) -#+gengc +#+(or gengc x86) (defun symbol-hash (symbol) "Return the hash value for symbol." (symbol-hash symbol)) diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp index db4780cae..6ad67b111 100644 --- a/compiler/generic/new-genesis.lisp +++ b/compiler/generic/new-genesis.lisp @@ -4,7 +4,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.25 1997/11/01 22:58:33 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.26 1997/11/04 09:10:51 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -543,6 +543,10 @@ (or *cold-symbol-allocation-space* *dynamic*) vm:word-bits (1- vm:symbol-size) vm:symbol-header-type))) (write-indexed symbol vm:symbol-value-slot unbound-marker) + (when (c:backend-featurep :x86) + (write-indexed symbol vm:symbol-hash-slot + (make-fixnum-descriptor + (1+ (random vm:target-most-positive-fixnum))))) (write-indexed symbol vm:symbol-plist-slot *nil-descriptor*) (write-indexed symbol vm:symbol-name-slot (string-to-core name *dynamic*)) (write-indexed symbol vm:symbol-package-slot *nil-descriptor*) @@ -750,7 +754,8 @@ (frob "*FP-CONSTANT-0D0*" "X86" (number-to-core 0d0)) (frob "*FP-CONSTANT-1D0*" "X86" (number-to-core 1d0)) (frob "*FP-CONSTANT-0S0*" "X86" (number-to-core 0s0)) - (frob "*FP-CONSTANT-1S0*" "X86" (number-to-core 1s0))))) + (frob "*FP-CONSTANT-1S0*" "X86" (number-to-core 1s0)) + (frob "*SCAVENGE-READ-ONLY-SPACE*" "X86" (cold-intern t))))) ;;; Make-Make-Package-Args -- Internal ;;; @@ -1684,9 +1689,12 @@ ((and is-linux (gethash (concatenate 'string "PVE_stub_" name) *cold-foreign-symbol-table* nil))) ;; Non-linux case - ((let ((value (gethash name *cold-foreign-symbol-table* nil))) - #+irix (when (and (numberp value) (zerop value)) - (warn "Not-really-defined foreign symbol: ~S" name)) + (#-irix + (gethash name *cold-foreign-symbol-table* nil) + #+irix + (let ((value (gethash name *cold-foreign-symbol-table* nil))) + (when (and (numberp value) (zerop value)) + (warn "Not-really-defined foreign symbol: ~S" name)) value)) ((and is-linux (gethash (concatenate 'string "__libc_" name) *cold-foreign-symbol-table* nil))) diff --git a/compiler/generic/objdef.lisp b/compiler/generic/objdef.lisp index c58468c81..9dda74e92 100644 --- a/compiler/generic/objdef.lisp +++ b/compiler/generic/objdef.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.39 1997/11/01 22:58:35 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.40 1997/11/04 09:10:53 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -451,15 +451,20 @@ (defknown symbol-hash (symbol) index (flushable movable)) +#+x86 +(defknown symbol-hash (symbol) cl::hash + (flushable movable)) + (define-primitive-object (symbol :lowtag other-pointer-type :header symbol-header-type - :alloc-trans - #-gengc make-symbol + #-x86 :alloc-trans + #-(or gengc x86) make-symbol #+gengc %make-symbol) (value :set-trans %set-symbol-value :init :unbound) - #-gengc unused + #-(or gengc x86) unused #+gengc (hash :init :arg) + #+x86 (hash) (plist :ref-trans symbol-plist :set-trans %set-symbol-plist :init :null) diff --git a/compiler/globaldb.lisp b/compiler/globaldb.lisp index bc7c24b3d..9216f91bb 100644 --- a/compiler/globaldb.lisp +++ b/compiler/globaldb.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.34 1997/04/16 18:11:23 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.35 1997/11/04 09:10:48 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -289,16 +289,16 @@ (defun info-hash (x) (cond ((symbolp x) - #-gengc (%sxhash-simple-string (symbol-name x)) - #+gengc (symbol-hash x)) + #-(or gengc x86) (%sxhash-simple-string (symbol-name x)) + #+(or gengc x86) (symbol-hash x)) ((and (listp x) (eq (car x) 'setf) (let ((next (cdr x))) (when (listp next) (let ((name (car next))) (when (and (symbolp name) (null (cdr next))) - (logxor #-gengc (%sxhash-simple-string (symbol-name name)) - #+gengc (symbol-hash name) + (logxor #-(or gengc x86) (%sxhash-simple-string (symbol-name name)) + #+(or gengc x86) (symbol-hash name) 110680597))))))) (t (sxhash x)))) @@ -459,8 +459,8 @@ (logand (the fixnum (logxor (the fixnum - #+gengc (info-hash ,name) - #-gengc (cache-hash-eq ,name)) + #+(or gengc x86) (info-hash ,name) + #-(or gengc x86) (cache-hash-eq ,name)) (the fixnum (ash (the fixnum ,type) 7)))) #x3FF))) @@ -492,11 +492,11 @@ ;;; Not needed with the gengc system, because we use an address independent ;;; hashing. ;;; -#-gengc +#-(or gengc x86) (defun info-cache-gc-hook () (setq *cached-info-environment* nil)) ;;; -#-gengc +#-(or gengc x86) (pushnew 'info-cache-gc-hook *after-gc-hooks*) diff --git a/compiler/x86/alloc.lisp b/compiler/x86/alloc.lisp index 5d5601fbb..382fa61fa 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.2 1997/02/08 21:15:38 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/alloc.lisp,v 1.3 1997/11/04 09:10:55 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -16,6 +16,7 @@ ;;; Written by William Lott. ;;; ;;; Debugged by Paul F. Werkowski Spring/Summer 1995. +;;; Enhancements/debugging by Douglas T. Crosher 1996,1996. ;;; (in-package :x86) @@ -43,21 +44,13 @@ `(let ((reg (sc-case ,tn ((any-reg descriptor-reg) ,tn) - ((descriptor-stack immediate-stack) + ((descriptor-stack) (move temp ,tn) temp)))) (storew reg ,list ,slot vm:list-pointer-type)))) (let ((cons-cells (if star (1- num) num))) - #-cgc - (with-allocation (temp) - (inst lea res - (make-ea :byte :base temp :disp list-pointer-type)) - (inst add temp (* (pad-data-block cons-size) cons-cells))) - #+cgc - (with-cgc-allocation (temp (* (pad-data-block cons-size) - cons-cells)) - (inst lea res - (make-ea :byte :base temp :disp list-pointer-type))) + (allocation res (* (pad-data-block cons-size) cons-cells)) + (inst lea res (make-ea :byte :base res :disp list-pointer-type)) (move ptr res) (dotimes (i (1- cons-cells)) (store-car (tn-ref-tn things) ptr) @@ -99,17 +92,12 @@ (inst shr unboxed word-shift) (inst add unboxed lowtag-mask) (inst and unboxed (lognot lowtag-mask)) - #+nil ;; keep this here in case we load code in dynamic again - (with-allocation (temp) - (inst lea result (make-ea :byte :base temp :disp other-pointer-type)) - (inst add temp boxed) - (inst add temp unboxed)) - (progn ;; now loading code into static space cause it can't move - (load-symbol-value temp lisp::*static-space-free-pointer*) - (inst lea result (make-ea :byte :base temp :disp other-pointer-type)) - (inst add temp boxed) - (inst add temp unboxed) - (store-symbol-value temp lisp::*static-space-free-pointer*)) + ;; now loading code into static space cause it can't move + (load-symbol-value temp lisp::*static-space-free-pointer*) + (inst lea result (make-ea :byte :base temp :disp other-pointer-type)) + (inst add temp boxed) + (inst add temp unboxed) + (store-symbol-value temp lisp::*static-space-free-pointer*) (inst shl boxed (- type-bits word-shift)) (inst or boxed code-header-type) (storew boxed result 0 other-pointer-type) @@ -119,15 +107,11 @@ (storew temp result code-entry-points-slot other-pointer-type) (storew temp result code-debug-info-slot other-pointer-type))) -;;; Top-Level-Forms have a short lifetime as they are unreachable -;;; once the loader eval's them. No point loading them in static -;;; space. This justs gives the loader a way to grab a chunk -;;; of the dynamic heap. + (define-vop (allocate-dynamic-code-object) (:args (boxed-arg :scs (any-reg) :target boxed) (unboxed-arg :scs (any-reg) :target unboxed)) - (:results (result :scs (descriptor-reg))) - (:temporary (:sc dword-reg :from :eval) temp) + (:results (result :scs (descriptor-reg) :from :eval)) (:temporary (:sc dword-reg :from (:argument 0)) boxed) (:temporary (:sc dword-reg :from (:argument 1)) unboxed) (:generator 100 @@ -138,72 +122,52 @@ (inst shr unboxed word-shift) (inst add unboxed lowtag-mask) (inst and unboxed (lognot lowtag-mask)) - #-cgc - (with-allocation (temp) - (inst lea result (make-ea :byte :base temp :disp other-pointer-type)) - (inst add temp boxed) - (inst add temp unboxed)) - #+cgc - (progn - (move temp boxed) - (inst add temp unboxed) - (with-cgc-allocation (temp temp) - (inst lea result (make-ea :byte :base temp :disp other-pointer-type)))) + (inst mov result boxed) + (inst add result unboxed) + (var-allocation result result) + (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) (storew boxed result 0 other-pointer-type) (storew unboxed result code-code-size-slot other-pointer-type) - (inst mov temp nil-value) - (storew temp result code-entry-points-slot other-pointer-type) - (storew temp result code-debug-info-slot other-pointer-type))) + (storew nil-value result code-entry-points-slot other-pointer-type) + (storew nil-value result code-debug-info-slot other-pointer-type))) + (define-vop (make-fdefn) (:policy :fast-safe) (:translate make-fdefn) (:args (name :scs (descriptor-reg) :to :eval)) - (:temporary (:sc dword-reg) alloc) (:results (result :scs (descriptor-reg) :from :argument)) (:generator 37 - (with-fixed-allocation (result alloc fdefn-type fdefn-size) - (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 - fdefn-raw-addr-slot other-pointer-type)))) + (fixed-allocation result fdefn-type fdefn-size) + (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 + fdefn-raw-addr-slot other-pointer-type))) (define-vop (make-closure) - (:args (function :to :save :scs (descriptor-reg))) + (:args (function :to :save :scs (descriptor-reg))) (:info length) (:temporary (:sc any-reg) temp) (:results (result :scs (descriptor-reg))) (:generator 10 (let ((size (+ length closure-info-offset))) - #-cgc - (with-allocation (temp) - (inst lea result (make-ea :byte :base temp :disp function-pointer-type)) - (inst add temp (pad-data-block size)) - (storew 0 temp 0) - (storew (logior (ash (1- size) type-bits) closure-header-type) - result 0 function-pointer-type)) - #+cgc - (with-cgc-allocation(temp (pad-data-block size)) - (inst lea result - (make-ea :byte :base temp :disp function-pointer-type)) - (storew (logior (ash (1- size) type-bits) closure-header-type) - temp 0)) - - (loadw temp function closure-function-slot function-pointer-type) - (storew temp result closure-function-slot function-pointer-type)))) + (allocation result (pad-data-block size)) + (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)) + (loadw temp function closure-function-slot function-pointer-type) + (storew temp result closure-function-slot function-pointer-type))) ;;; 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))) - (:temporary (:sc any-reg) temp) - (:results (result :scs (descriptor-reg))) + (:args (value :scs (descriptor-reg any-reg) :to :result)) + (:results (result :scs (descriptor-reg) :from :eval)) (:generator 10 - (with-fixed-allocation - (result temp value-cell-header-type value-cell-size)) + (fixed-allocation result value-cell-header-type value-cell-size) (storew value result value-cell-value-slot other-pointer-type))) @@ -221,29 +185,21 @@ (:info name words type lowtag) (:ignore name) (:results (result :scs (descriptor-reg))) - (:temporary (:sc descriptor-reg) temp) - (:generator #-cgc 4 #+cgc 50 - #-cgc - (with-allocation(temp) ; dynamic free ptr - (inst lea result (make-ea :byte :base temp :disp lowtag)) - (inst add temp (pad-data-block words)) - (storew 0 temp 0 0)) - #+cgc - (with-cgc-allocation(temp (pad-data-block words)) - (inst lea result (make-ea :byte :base temp :disp lowtag))) - + (:generator 50 + (allocation result (pad-data-block words)) + (inst lea result (make-ea :byte :base result :disp lowtag)) (when type - (inst mov temp (logior (ash (1- words) type-bits) type)) - (storew temp result 0 lowtag)))) + (storew (logior (ash (1- words) type-bits) type) result 0 lowtag)))) (define-vop (var-alloc) - (:args (extra :scs (any-reg))) + (:args (extra :scs (any-reg))) (:arg-types positive-fixnum) (:info name words type lowtag) (:ignore name) - (:results (result :scs (descriptor-reg))) - (:temporary (:sc any-reg) bytes header alloc) - (:generator #-cgc 6 #+cgc 50 + (: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) + (:generator 50 (inst lea bytes (make-ea :dword :base extra :disp (* (1+ words) word-bytes))) (inst mov header bytes) @@ -252,17 +208,33 @@ (inst lea header ; (w-1 << 8) | type (make-ea :dword :base header :disp (+ (ash -2 type-bits) type))) (inst and bytes (lognot lowtag-mask)) - #-cgc - (with-allocation (alloc) - (inst lea result (make-ea :byte :base alloc :disp lowtag)) - (storew header result 0 lowtag) - (inst add alloc bytes) - (storew 0 alloc 0)) - ;; Note that the above inst stores into the free space which - ;; is probably already zeroed. It is a lose in the cgc case because - ;; it might trash the next region header. - #+cgc - (with-cgc-allocation (alloc bytes) - (inst lea result (make-ea :byte :base alloc :disp lowtag)) - (storew header result 0 lowtag)))) + (var-allocation result bytes) + (inst lea result (make-ea :byte :base result :disp lowtag)) + (storew header result 0 lowtag))) + + +(define-vop (make-symbol) + (:policy :fast-safe) + (:translate make-symbol) + (:args (name :scs (descriptor-reg) :to :eval)) + (:temporary (:sc dword-reg :from :eval) temp) + (:results (result :scs (descriptor-reg) :from :argument)) + (:generator 37 + (fixed-allocation result symbol-header-type symbol-size) + (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 + ;; address could be used for even faster and smaller code! + (inst imul temp + (make-fixup (extern-alien-name "fast_random_state") :foreign) + 1103515245) + (inst add temp 12345) + (inst mov (make-fixup (extern-alien-name "fast_random_state") :foreign) + temp) + ;; Want a positive fixnum for the hash value, discard the LS bits. + (inst shr temp 1) + (inst and temp #xfffffffc) + (storew temp result symbol-hash-slot other-pointer-type) + (storew nil-value result symbol-plist-slot other-pointer-type) + (storew nil-value result symbol-package-slot other-pointer-type))) diff --git a/compiler/x86/arith.lisp b/compiler/x86/arith.lisp index d82942c43..8d7436c67 100644 --- a/compiler/x86/arith.lisp +++ b/compiler/x86/arith.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/arith.lisp,v 1.6 1997/09/29 04:49:17 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.7 1997/11/04 09:10:56 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -77,16 +77,16 @@ (define-vop (fast-fixnum-binop fast-safe-arith-op) (:args (x :target r :scs (any-reg) - :load-if (not (and (sc-is x immediate-stack) + :load-if (not (and (sc-is x descriptor-stack) (sc-is y any-reg) - (sc-is r immediate-stack) + (sc-is r descriptor-stack) (location= x r)))) - (y :scs (any-reg immediate-stack))) + (y :scs (any-reg descriptor-stack))) (:arg-types tagged-num tagged-num) (:results (r :scs (any-reg) :from (:argument 0) - :load-if (not (and (sc-is x immediate-stack) + :load-if (not (and (sc-is x descriptor-stack) (sc-is y any-reg) - (sc-is r immediate-stack) + (sc-is r descriptor-stack) (location= x r))))) (:result-types tagged-num) (:note "inline fixnum arithmetic")) @@ -124,7 +124,7 @@ (:note "inline (signed-byte 32) arithmetic")) (define-vop (fast-fixnum-binop-c fast-safe-arith-op) - (:args (x :target r :scs (any-reg immediate-stack))) + (:args (x :target r :scs (any-reg descriptor-stack))) (:info y) (:arg-types tagged-num (:constant (signed-byte 30))) (:results (r :scs (any-reg) @@ -208,16 +208,16 @@ (define-vop (fast-+/fixnum=>fixnum fast-safe-arith-op) (:translate +) (:args (x :scs (any-reg) :target r - :load-if (not (and (sc-is x immediate-stack) + :load-if (not (and (sc-is x descriptor-stack) (sc-is y any-reg) - (sc-is r immediate-stack) + (sc-is r descriptor-stack) (location= x r)))) - (y :scs (any-reg immediate-stack))) + (y :scs (any-reg descriptor-stack))) (:arg-types tagged-num tagged-num) (:results (r :scs (any-reg) :from (:argument 0) - :load-if (not (and (sc-is x immediate-stack) + :load-if (not (and (sc-is x descriptor-stack) (sc-is y any-reg) - (sc-is r immediate-stack) + (sc-is r descriptor-stack) (location= x r))))) (:result-types tagged-num) (:note "inline fixnum arithmetic") @@ -231,7 +231,7 @@ (define-vop (fast-+-c/fixnum=>fixnum fast-safe-arith-op) (:translate +) - (:args (x :target r :scs (any-reg immediate-stack))) + (:args (x :target r :scs (any-reg descriptor-stack))) (:info y) (:arg-types tagged-num (:constant (signed-byte 30))) (:results (r :scs (any-reg) @@ -337,7 +337,7 @@ (:translate *) ;; We need different loading characteristics. (:args (x :scs (any-reg) :target r) - (y :scs (any-reg immediate-stack))) + (y :scs (any-reg descriptor-stack))) (:arg-types tagged-num tagged-num) (:results (r :scs (any-reg) :from (:argument 0))) (:result-types tagged-num) @@ -350,7 +350,7 @@ (define-vop (fast-*-c/fixnum=>fixnum fast-safe-arith-op) (:translate *) ;; We need different loading characteristics. - (:args (x :scs (any-reg immediate-stack))) + (:args (x :scs (any-reg descriptor-stack))) (:info y) (:arg-types tagged-num (:constant (signed-byte 30))) (:results (r :scs (any-reg))) @@ -407,7 +407,7 @@ (define-vop (fast-truncate/fixnum=>fixnum fast-safe-arith-op) (:translate truncate) (:args (x :scs (any-reg) :target eax) - (y :scs (any-reg immediate-stack))) + (y :scs (any-reg descriptor-stack))) (:arg-types tagged-num tagged-num) (:temporary (:sc dword-reg :offset eax-offset :target quo :from (:argument 0) :to (:result 0)) eax) @@ -568,14 +568,14 @@ (:translate ash) (:policy :fast-safe) (:args (number :scs (any-reg) :target result - :load-if (not (and (sc-is number any-reg immediate-stack) - (sc-is result any-reg immediate-stack) + :load-if (not (and (sc-is number any-reg descriptor-stack) + (sc-is result any-reg descriptor-stack) (location= number result))))) (:info amount) (:arg-types tagged-num (:constant integer)) (:results (result :scs (any-reg) - :load-if (not (and (sc-is number immediate-stack) - (sc-is result immediate-stack) + :load-if (not (and (sc-is number descriptor-stack) + (sc-is result descriptor-stack) (location= number result))))) (:result-types tagged-num) (:note "inline ASH") @@ -603,15 +603,15 @@ (define-vop (fast-ash-left/fixnum=>fixnum) (:translate ash) (:args (number :scs (any-reg) :target result - :load-if (not (and (sc-is number immediate-stack) - (sc-is result immediate-stack) + :load-if (not (and (sc-is number descriptor-stack) + (sc-is result descriptor-stack) (location= number result)))) (amount :scs (unsigned-reg) :target ecx)) (:arg-types tagged-num positive-fixnum) (:temporary (:sc dword-reg :offset ecx-offset :from (:argument 1)) ecx) (:results (result :scs (any-reg) :from (:argument 0) - :load-if (not (and (sc-is number immediate-stack) - (sc-is result immediate-stack) + :load-if (not (and (sc-is number descriptor-stack) + (sc-is result descriptor-stack) (location= number result))))) (:result-types tagged-num) (:policy :fast-safe) @@ -794,14 +794,14 @@ (define-vop (fast-conditional/fixnum fast-conditional) (:args (x :scs (any-reg) - :load-if (not (and (sc-is x immediate-stack) + :load-if (not (and (sc-is x descriptor-stack) (sc-is y any-reg)))) - (y :scs (any-reg immediate-stack))) + (y :scs (any-reg descriptor-stack))) (:arg-types tagged-num tagged-num) (:note "inline fixnum comparison")) (define-vop (fast-conditional-c/fixnum fast-conditional/fixnum) - (:args (x :scs (any-reg immediate-stack))) + (:args (x :scs (any-reg descriptor-stack))) (:arg-types tagged-num (:constant (signed-byte 30))) (:info target not-p y)) @@ -899,9 +899,9 @@ (define-vop (fast-eql/fixnum fast-conditional) (:args (x :scs (any-reg) - :load-if (not (and (sc-is x immediate-stack) + :load-if (not (and (sc-is x descriptor-stack) (sc-is y any-reg)))) - (y :scs (any-reg immediate-stack))) + (y :scs (any-reg descriptor-stack))) (:arg-types tagged-num tagged-num) (:note "inline fixnum comparison") (:translate eql) @@ -913,12 +913,12 @@ (:args (x :scs (any-reg descriptor-reg) :load-if (not (and (sc-is x descriptor-stack) (sc-is y any-reg)))) - (y :scs (any-reg immediate-stack))) + (y :scs (any-reg descriptor-stack))) (:arg-types * tagged-num) (:variant-cost 7)) (define-vop (fast-eql-c/fixnum fast-conditional/fixnum) - (:args (x :scs (any-reg immediate-stack))) + (:args (x :scs (any-reg descriptor-stack))) (:arg-types tagged-num (:constant (signed-byte 30))) (:info target not-p y) (:translate eql) @@ -930,7 +930,7 @@ (inst jmp (if not-p :ne :e) target))) ;;; (define-vop (generic-eql-c/fixnum fast-eql-c/fixnum) - (:args (x :scs (any-reg immediate-stack descriptor-reg descriptor-stack))) + (:args (x :scs (any-reg descriptor-reg descriptor-stack))) (:arg-types * (:constant (signed-byte 30))) (:variant-cost 6)) @@ -1052,6 +1052,7 @@ (move ecx amount) (inst shl r :cl))) + ;;;; Bignum stuff. @@ -1112,7 +1113,7 @@ (:policy :fast-safe) (:args (a :scs (unsigned-reg) :to :eval :target result) (b :scs (unsigned-reg unsigned-stack) :to :result) - (c :scs (any-reg immediate-stack))) + (c :scs (any-reg descriptor-stack))) (:arg-types unsigned-num unsigned-num positive-fixnum) (:results (result :scs (unsigned-reg) :from :eval) (borrow :scs (unsigned-reg))) @@ -1208,10 +1209,10 @@ (define-vop (fixnum-to-digit) (:translate bignum::%fixnum-to-digit) (:policy :fast-safe) - (:args (fixnum :scs (any-reg immediate-stack) :target digit)) + (:args (fixnum :scs (any-reg descriptor-stack) :target digit)) (:arg-types tagged-num) (:results (digit :scs (unsigned-reg) - :load-if (not (and (sc-is fixnum immediate-stack) + :load-if (not (and (sc-is fixnum descriptor-stack) (sc-is digit unsigned-stack) (location= fixnum digit))))) (:result-types unsigned-num) @@ -1247,12 +1248,12 @@ (:arg-types unsigned-num) (:results (res :scs (any-reg signed-reg) :load-if (not (and (sc-is digit unsigned-stack) - (sc-is res immediate-stack signed-stack) + (sc-is res descriptor-stack signed-stack) (location= digit res))))) (:result-types signed-num) (:generator 1 (move res digit) - (when (sc-is res any-reg immediate-stack) + (when (sc-is res any-reg descriptor-stack) (inst shl res 2)))) (define-vop (digit-ashr) diff --git a/compiler/x86/array.lisp b/compiler/x86/array.lisp index 74a4c8166..738ee52ad 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.6 1997/11/01 22:58:42 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.7 1997/11/04 09:10:58 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -30,10 +30,9 @@ (:args (type :scs (any-reg)) (rank :scs (any-reg))) (:arg-types positive-fixnum positive-fixnum) - (:temporary (:sc any-reg) bytes) - (:temporary (:sc any-reg) header) - (:temporary (:sc any-reg) alloc) - (:results (result :scs (descriptor-reg))) + (:temporary (:sc any-reg :to :eval) bytes) + (:temporary (:sc any-reg :to :result) header) + (:results (result :scs (descriptor-reg) :from :eval)) (:generator 13 (inst lea bytes (make-ea :dword :base rank @@ -45,13 +44,8 @@ (inst shl header type-bits) (inst or header type) (inst shr header 2) - #-cgc - (with-allocation (alloc) - (inst lea result (make-ea :dword :base alloc :disp other-pointer-type)) - (inst add alloc bytes)) - #+cgc - (with-cgc-allocation (alloc bytes) - (inst lea result (make-ea :dword :base alloc :disp other-pointer-type))) + (var-allocation result bytes) + (inst lea result (make-ea :dword :base result :disp other-pointer-type)) (storew header result 0 other-pointer-type))) diff --git a/compiler/x86/c-call.lisp b/compiler/x86/c-call.lisp index 360cc45ba..59bd18cd9 100644 --- a/compiler/x86/c-call.lisp +++ b/compiler/x86/c-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/c-call.lisp,v 1.4 1997/09/07 23:27:50 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/c-call.lisp,v 1.5 1997/11/04 09:10:59 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -17,7 +17,7 @@ ;;; Written by William Lott. ;;; ;;; Debugged by Paul F. Werkowski Spring/Summer 1995. -;;; Debugging and Enhancements by Douglas Crosher 1996. +;;; Debugging and Enhancements by Douglas Crosher 1996,1997. ;;; (in-package :x86) @@ -205,7 +205,7 @@ (:generator 0 (assert (location= result esp-tn)) (unless (zerop amount) - (let ( (delta (logandc2 (+ amount 3) 3)) ) + (let ((delta (logandc2 (+ amount 3) 3))) (inst sub esp-tn delta))) (move result esp-tn))) @@ -213,7 +213,7 @@ (:info amount) (:generator 0 (unless (zerop amount) - (let ( (delta (logandc2 (+ amount 3) 3)) ) + (let ((delta (logandc2 (+ amount 3) 3))) (inst add esp-tn delta))))) (define-vop (alloc-alien-stack-space) @@ -222,7 +222,7 @@ (:generator 0 (assert (not (location= result esp-tn))) (unless (zerop amount) - (let ( (delta (logandc2 (+ amount 3) 3)) ) + (let ((delta (logandc2 (+ amount 3) 3))) (inst sub (make-ea :dword :disp (+ nil-value (static-symbol-offset '*alien-stack*) @@ -235,7 +235,7 @@ (:info amount) (:generator 0 (unless (zerop amount) - (let ( (delta (logandc2 (+ amount 3) 3)) ) + (let ((delta (logandc2 (+ amount 3) 3))) (inst add (make-ea :dword :disp (+ nil-value (static-symbol-offset '*alien-stack*) diff --git a/compiler/x86/call.lisp b/compiler/x86/call.lisp index 654c4098c..51e7172db 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.3 1997/10/05 16:43:03 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/call.lisp,v 1.4 1997/11/04 09:11:00 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -50,7 +50,7 @@ (def-vm-support-routine make-return-pc-passing-location (standard) (declare (ignore standard)) (make-wired-tn *fixnum-primitive-type* - immediate-stack-sc-number + descriptor-stack-sc-number return-pc-save-offset)) ;;; ;;; If standard is true, then use the standard (full call) location, @@ -60,7 +60,7 @@ #+nil (def-vm-support-routine make-return-pc-passing-location (standard) (if standard - (make-wired-tn *fixnum-primitive-type* immediate-stack-sc-number + (make-wired-tn *fixnum-primitive-type* descriptor-stack-sc-number return-pc-save-offset) (make-normal-tn *fixnum-primitive-type*))) @@ -79,7 +79,7 @@ (def-vm-support-routine make-old-fp-passing-location (standard) (declare (ignore standard)) (make-wired-tn *fixnum-primitive-type* - immediate-stack-sc-number + descriptor-stack-sc-number old-fp-save-offset)) ;;; ;;; If standard is true, then use the standard (full call) location, @@ -89,7 +89,7 @@ #+nil (def-vm-support-routine make-old-fp-passing-location (standard) (if standard - (make-wired-tn *fixnum-primitive-type* immediate-stack-sc-number old-fp-save-offset) + (make-wired-tn *fixnum-primitive-type* descriptor-stack-sc-number old-fp-save-offset) (make-normal-tn *fixnum-primitive-type*))) ;;; Make-Old-FP-Save-Location, Make-Return-PC-Save-Location -- Interface @@ -102,7 +102,7 @@ ;;; wire to the stack? No problems. (def-vm-support-routine make-old-fp-save-location (env) (environment-debug-live-tn (make-wired-tn *fixnum-primitive-type* - immediate-stack-sc-number + descriptor-stack-sc-number old-fp-save-offset) env)) ;;; @@ -112,7 +112,7 @@ (specify-save-tn (environment-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env) (make-wired-tn *fixnum-primitive-type* - immediate-stack-sc-number + descriptor-stack-sc-number ocfp-save-offset))) ;;; @@ -120,7 +120,7 @@ ;;; wire to the stack? No problems. (def-vm-support-routine make-return-pc-save-location (env) (environment-debug-live-tn (make-wired-tn *fixnum-primitive-type* - immediate-stack-sc-number + descriptor-stack-sc-number return-pc-save-offset) env)) ;;; @@ -131,7 +131,7 @@ (specify-save-tn (environment-debug-live-tn (make-normal-tn ptype) env) (make-wired-tn ptype - immediate-stack-sc-number + descriptor-stack-sc-number return-pc-save-offset)))) ;;; Make-Argument-Count-Location -- Interface @@ -179,9 +179,12 @@ ;;; placeholder entries in the Constants to leave room for additional ;;; noise in the code object header. ;;; +;;; For the x86 the first constant is a pointer to a list of fixups, +;;; or nil if the code object has none. +;;; (def-vm-support-routine select-component-format (component) (declare (type component component)) - (dotimes (i code-constants-offset) + (dotimes (i (1+ code-constants-offset)) (vector-push-extend nil (ir2-component-constants (component-info component)))) (undefined-value)) @@ -192,7 +195,7 @@ ;;; Used for setting up the Old-FP in local call. ;;; (define-vop (current-fp) - (:results (val :scs (any-reg immediate-stack))) + (:results (val :scs (any-reg descriptor-stack))) (:generator 1 (move val ebp-tn))) @@ -224,7 +227,7 @@ (popw ebp-tn (- (1+ return-pc-save-offset))) ;; If copy-more-arg follows it will allocate the correct stack - ;; size. The stack is not allocate first here as this may expose + ;; size. The stack is not allocated first here as this may expose ;; args on the stack if they take up more space than the frame! (unless copy-more-arg-follows ;; The args fit within the frame so just allocate the frame. @@ -240,7 +243,7 @@ ;;; callee (who has the same size stack as us). ;;; (define-vop (allocate-frame) - (:results (res :scs (any-reg immediate-stack)) + (:results (res :scs (any-reg descriptor-stack)) (nfp)) (:info callee) (:ignore nfp callee) @@ -254,7 +257,7 @@ ;;; (define-vop (allocate-full-call-frame) (:info nargs) - (:results (res :scs (any-reg immediate-stack))) + (:results (res :scs (any-reg descriptor-stack))) (:generator 2 (move res esp-tn) (inst sub esp-tn (* (max nargs 3) vm:word-bytes)))) @@ -508,8 +511,8 @@ (:temporary (:sc any-reg :offset ecx-offset :from :eval :to (:result 1)) nvals) - (:results (start :scs (any-reg immediate-stack)) - (count :scs (any-reg immediate-stack)))) + (:results (start :scs (any-reg descriptor-stack)) + (count :scs (any-reg descriptor-stack)))) ;;;; Local call with unknown values convention return: @@ -556,7 +559,7 @@ ;; Is the return-pc on the stack or in a register? (sc-case ret-tn - ((immediate-stack) + ((descriptor-stack) #+nil (format t "*call-local: ret-tn on stack; offset=~s~%" (tn-offset ret-tn)) ;; Stack @@ -605,7 +608,7 @@ ;; Is the return-pc on the stack or in a register? (sc-case ret-tn - ((immediate-stack) + ((descriptor-stack) #+nil (format t "*multiple-call-local: ret-tn on stack; offset=~s~%" (tn-offset ret-tn)) ;; Stack @@ -662,7 +665,7 @@ ;; Is the return-pc on the stack or in a register? (sc-case ret-tn - ((immediate-stack) + ((descriptor-stack) #+nil (format t "*known-call-local: ret-tn on stack; offset=~s~%" (tn-offset ret-tn)) ;; Stack @@ -752,7 +755,7 @@ (sc-case return-pc ((any-reg descriptor-reg) (sc-case old-fp - ((immediate-stack) + ((descriptor-stack) #+nil (format t "*known-return: old-fp ~s on stack; offset=~s~%" old-fp (tn-offset old-fp)) @@ -781,7 +784,7 @@ ;; Return; return-pc is in a register. (inst jmp return-pc)) - ((immediate-stack descriptor-stack) + ((descriptor-stack) #+nil (format t "*known-return: return-pc ~s on stack; offset=~s~%" return-pc (tn-offset return-pc)) @@ -952,7 +955,7 @@ ;; standard locations then these moves will be ;; un-necessary; this is probably best for the x86. (sc-case old-fp - ((immediate-stack descriptor-stack) + ((descriptor-stack) (unless (= old-fp-save-offset (tn-offset old-fp)) (format t "** tail-call old-fp not S0~%") (move old-fp-tmp old-fp) @@ -963,7 +966,7 @@ #+x86-lra (sc-case return-pc - ((immediate-stack descriptor-stack) + ((descriptor-stack) (unless (= return-pc-save-offset (tn-offset return-pc)) (format t "** tail-call ret-pc not S1~%") (move ret-pc-tmp return-pc) @@ -1076,7 +1079,7 @@ ;;; set things up so that it can find what it needs. ;;; (define-vop (tail-call-variable) - (:args (args :scs (any-reg immediate-stack) :target esi) + (:args (args :scs (any-reg descriptor-stack) :target esi) (function :scs (descriptor-reg descriptor-stack) :target eax) (old-fp) (ret-addr)) @@ -1090,10 +1093,10 @@ ;; The following assumes that the return-pc and old-fp are on the ;; stack in their standard save locations - Check this. - (unless (and (sc-is old-fp immediate-stack descriptor-stack) + (unless (and (sc-is old-fp descriptor-stack) (= (tn-offset old-fp) old-fp-save-offset)) (error "tail-call-variable: old-fp not on stack in standard save location?")) - (unless (and (sc-is ret-addr immediate-stack descriptor-stack) + (unless (and (sc-is ret-addr descriptor-stack) (= (tn-offset ret-addr) return-pc-save-offset)) (error "tail-call-variable: ret-addr not on stack in standard save location?")) @@ -1437,15 +1440,9 @@ ;; Check to see if there are no arguments, and just return NIL if so. (inst mov result nil-value) (inst jecxz done) - #-cgc - (with-allocation (eax) - (inst lea dst (make-ea :byte :base eax :disp list-pointer-type)) - (inst lea eax (make-ea :dword :base eax :index ecx :scale 2))) - #+cgc - (progn - (inst lea eax (make-ea :dword :index ecx :scale 2)) - (with-cgc-allocation (eax eax) - (inst lea dst (make-ea :byte :base eax :disp list-pointer-type)))) + (inst lea dst (make-ea :dword :index ecx :scale 2)) + (var-allocation dst dst) + (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) ;; Set decrement mode (successive args at lower addresses) diff --git a/compiler/x86/cell.lisp b/compiler/x86/cell.lisp index b6e4e5a4b..2c1cef3f9 100644 --- a/compiler/x86/cell.lisp +++ b/compiler/x86/cell.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/cell.lisp,v 1.4 1997/09/29 05:06:53 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/cell.lisp,v 1.5 1997/11/04 09:11:01 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -107,6 +107,12 @@ (:policy :fast) (:translate symbol-value)) +(defknown fast-symbol-value-xadd (symbol fixnum) fixnum ()) +(define-vop (fast-symbol-value-xadd cell-xadd) + (:variant symbol-value-slot other-pointer-type) + (:policy :fast) + (:translate fast-symbol-value-xadd) + (:arg-types * tagged-num)) (define-vop (boundp) (:translate boundp) @@ -120,6 +126,19 @@ (inst cmp value unbound-marker-type) (inst jmp (if not-p :e :ne) target))) +(define-vop (symbol-hash) + (:policy :fast-safe) + (:translate symbol-hash) + (:args (symbol :scs (descriptor-reg))) + (:results (res :scs (any-reg))) + (:result-types positive-fixnum) + (:generator 2 + ;; the symbol-hash slot of NIL holds NIL because it is also the cdr + ;; slot, so we have to strip off the two low bits to make sure it is + ;; a fixnum. + (loadw res symbol symbol-hash-slot other-pointer-type) + (inst and res (lognot #b11)))) + ;;;; Fdefinition (fdefn) objects. @@ -323,6 +342,12 @@ temp) (move result eax))) +(defknown %instance-xadd (instance index fixnum) fixnum ()) +(define-vop (instance-xadd-c slot-xadd) + (:policy :fast-safe) + (:translate %instance-xadd) + (:variant instance-slots-offset instance-pointer-type) + (:arg-types instance (:constant index) tagged-num)) ;;;; Code object frobbing. diff --git a/compiler/x86/char.lisp b/compiler/x86/char.lisp index 6fdf6bd3d..64768571b 100644 --- a/compiler/x86/char.lisp +++ b/compiler/x86/char.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/char.lisp,v 1.1 1997/01/18 14:31:20 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/char.lisp,v 1.2 1997/11/04 09:11:02 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -19,9 +19,10 @@ ;;; And then to the x86, again by William. ;;; ;;; Debugged by Paul F. Werkowski, June-95. +;;; Enhancements/debugging by Douglas T. Crosher 1996,1997. ;;; -(in-package :x86) +(in-package :x86) ;;;; Moves and coercions: @@ -29,7 +30,7 @@ ;;; Move a tagged char to an untagged representation. ;;; (define-vop (move-to-base-char) - (:args (x :scs (any-reg immediate-stack) :target al)) + (:args (x :scs (any-reg descriptor-stack) :target al)) (:temporary (:sc byte-reg :offset al-offset :from (:argument 0) :to (:eval 0)) al) (:ignore al) @@ -42,7 +43,7 @@ (move y ah))) ;;; (define-move-vop move-to-base-char :move - (any-reg immediate-stack) (base-char-reg base-char-stack)) + (any-reg descriptor-stack) (base-char-reg base-char-stack)) ;;; Move an untagged char to a tagged representation. @@ -53,7 +54,7 @@ :from (:argument 0) :to (:result 0)) al) (:temporary (:sc byte-reg :offset ah-offset :from (:argument 0) :to (:result 0)) ah) - (:results (y :scs (any-reg descriptor-reg immediate-stack))) + (:results (y :scs (any-reg descriptor-reg descriptor-stack))) (:note "character tagging") (:generator 1 (move ah x) ; maybe move char byte @@ -63,7 +64,7 @@ ;;; (define-move-vop move-from-base-char :move - (base-char-reg base-char-stack) (any-reg descriptor-reg immediate-stack)) + (base-char-reg base-char-stack) (any-reg descriptor-reg descriptor-stack)) ;;; Move untagged base-char values. ;;; diff --git a/compiler/x86/debug.lisp b/compiler/x86/debug.lisp index 741804fec..c12c3d922 100644 --- a/compiler/x86/debug.lisp +++ b/compiler/x86/debug.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/debug.lisp,v 1.1 1997/01/18 14:31:21 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/debug.lisp,v 1.2 1997/11/04 09:11:03 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -16,12 +16,10 @@ ;;; Written by William Lott. ;;; ;;; Debugged by Paul F. Werkowski Spring/Summer 1995. -;;; Debugged by Douglas Crosher 1996. +;;; Enhancements/debugging by Douglas T. Crosher 1996,1997. ;;; (in-package :x86) -(defknown di::stack-ref (system-area-pointer index) - #-x86 t #+x86 (unsigned-byte 32) (flushable)) (define-vop (debug-cur-sp) (:translate current-sp) (:policy :fast-safe) @@ -38,34 +36,18 @@ (:generator 1 (move res ebp-tn))) -#+nil +;;; Stack-ref and %set-stack-ref can be used to read and store +;;; descriptor objects on the control stack. Use the sap-ref +;;; functions to access other data types. (define-vop (read-control-stack) - (:translate kernel:stack-ref) + (:translate stack-ref) (:policy :fast-safe) - (:args (sap :scs (sap-reg) :to (:argument 1)) - (offset :scs (any-reg) :to (:argument 0) :target temp)) - (:arg-types system-area-pointer tagged-num) - (:temporary (:sc dword-reg :from (:argument 0)) temp) - (:results (result :scs (descriptor-reg))) - (:result-types *) - (:generator 9 - (move temp offset) - (inst neg temp) - (inst sub temp (fixnum 1)) - (inst mov result (make-ea :dword :base sap :index temp)))) - -;;; Unlike the RISC implementations, the control stack also is a number -;;; stack and not just descriptors live there. - -(define-vop (read-control-stack) - (:translate kernel:stack-ref) - (:policy :fast-safe) - (:args (sap :scs (sap-reg) :to :eval) ; NOTE lifetime stuff IMPORTANT (why?) + (:args (sap :scs (sap-reg) :to :eval) (offset :scs (any-reg) :target temp)) (:arg-types system-area-pointer positive-fixnum) (:temporary (:sc dword-reg :from (:argument 1)) temp) - (:results (result :scs (unsigned-reg))) - (:result-types unsigned-num) + (:results (result :scs (descriptor-reg))) + (:result-types *) (:generator 9 (move temp offset) (inst neg temp) @@ -73,13 +55,13 @@ (make-ea :dword :base sap :disp (- word-bytes) :index temp)))) (define-vop (read-control-stack-c) - (:translate kernel:stack-ref) + (:translate stack-ref) (:policy :fast-safe) (:args (sap :scs (sap-reg))) (:info index) - (:arg-types system-area-pointer (:constant (signed-byte 32))) - (:results (result :scs (unsigned-reg))) - (:result-types unsigned-num) + (:arg-types system-area-pointer (:constant (signed-byte 30))) + (:results (result :scs (descriptor-reg))) + (:result-types *) (:generator 5 (inst mov result (make-ea :dword :base sap :disp (- (* (1+ index) word-bytes)))))) diff --git a/compiler/x86/float.lisp b/compiler/x86/float.lisp index 3f107708f..45cff64f8 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.10 1997/11/01 22:58:43 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.11 1997/11/04 09:11:04 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -298,13 +298,11 @@ (define-vop (move-from-single) (:args (x :scs (single-reg) :to :save)) (:results (y :scs (descriptor-reg))) - (:temporary (:sc dword-reg) ndescr) (:note "float to pointer coercion") (:generator 13 - (with-fixed-allocation (y ndescr vm:single-float-type - vm:single-float-size) - (with-tn@fp-top(x) - (inst fst (ea-for-sf-desc y)))))) + (fixed-allocation y vm:single-float-type vm:single-float-size) + (with-tn@fp-top(x) + (inst fst (ea-for-sf-desc y))))) (define-move-vop move-from-single :move (single-reg) (descriptor-reg)) @@ -321,13 +319,11 @@ (define-vop (move-from-double) (:args (x :scs (double-reg) :to :save)) (:results (y :scs (descriptor-reg))) - (:temporary (:sc dword-reg) ndescr) (:note "float to pointer coercion") (:generator 13 - (with-fixed-allocation (y ndescr vm:double-float-type - vm:double-float-size) - (with-tn@fp-top(x) - (inst fstd (ea-for-df-desc y)))))) + (fixed-allocation y vm:double-float-type vm:double-float-size) + (with-tn@fp-top(x) + (inst fstd (ea-for-df-desc y))))) (define-move-vop move-from-double :move (double-reg) (descriptor-reg)) @@ -369,42 +365,36 @@ (define-vop (move-from-complex-single) (:args (x :scs (complex-single-reg) :to :save)) (:results (y :scs (descriptor-reg))) - (:temporary (:sc dword-reg) ndescr) (:note "complex float to pointer coercion") (:generator 13 - (with-fixed-allocation (y ndescr vm:complex-single-float-type - vm:complex-single-float-size) - (let ((real-tn (make-random-tn :kind :normal - :sc (sc-or-lose 'single-reg) - :offset (tn-offset x)))) - (with-tn@fp-top(real-tn) - (inst fst (ea-for-csf-real-desc y)))) - (let ((imag-tn (make-random-tn :kind :normal - :sc (sc-or-lose 'single-reg) - :offset (1+ (tn-offset x))))) - (with-tn@fp-top(imag-tn) - (inst fst (ea-for-csf-imag-desc y))))))) + (fixed-allocation y vm:complex-single-float-type + vm:complex-single-float-size) + (let ((real-tn (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg) + :offset (tn-offset x)))) + (with-tn@fp-top(real-tn) + (inst fst (ea-for-csf-real-desc y)))) + (let ((imag-tn (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg) + :offset (1+ (tn-offset x))))) + (with-tn@fp-top(imag-tn) + (inst fst (ea-for-csf-imag-desc y)))))) (define-move-vop move-from-complex-single :move (complex-single-reg) (descriptor-reg)) (define-vop (move-from-complex-double) (:args (x :scs (complex-double-reg) :to :save)) (:results (y :scs (descriptor-reg))) - (:temporary (:sc dword-reg) ndescr) (:note "complex float to pointer coercion") (:generator 13 - (with-fixed-allocation (y ndescr vm:complex-double-float-type - vm:complex-double-float-size) - (let ((real-tn (make-random-tn :kind :normal - :sc (sc-or-lose 'double-reg) - :offset (tn-offset x)))) - (with-tn@fp-top(real-tn) - (inst fstd (ea-for-cdf-real-desc y)))) - (let ((imag-tn (make-random-tn :kind :normal - :sc (sc-or-lose 'double-reg) - :offset (1+ (tn-offset x))))) - (with-tn@fp-top(imag-tn) - (inst fstd (ea-for-cdf-imag-desc y))))))) + (fixed-allocation y vm:complex-double-float-type + vm:complex-double-float-size) + (let ((real-tn (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg) + :offset (tn-offset x)))) + (with-tn@fp-top(real-tn) + (inst fstd (ea-for-cdf-real-desc y)))) + (let ((imag-tn (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg) + :offset (1+ (tn-offset x))))) + (with-tn@fp-top(imag-tn) + (inst fstd (ea-for-cdf-imag-desc y)))))) (define-move-vop move-from-complex-double :move (complex-double-reg) (descriptor-reg)) diff --git a/compiler/x86/insts.lisp b/compiler/x86/insts.lisp index a175126b2..a039b3471 100644 --- a/compiler/x86/insts.lisp +++ b/compiler/x86/insts.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/insts.lisp,v 1.11 1997/10/18 04:09:50 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/insts.lisp,v 1.12 1997/11/04 09:11:07 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -103,11 +103,11 @@ (t (format stream "~A PTR [" (symbol-name (ea-size ea))) (when (ea-base ea) - (write-string (c::location-print-name (ea-base ea)) stream) + (write-string (x86-location-print-name (ea-base ea)) stream) (when (ea-index ea) (write-string "+" stream))) (when (ea-index ea) - (write-string (c::location-print-name (ea-index ea)) stream)) + (write-string (x86-location-print-name (ea-index ea)) stream)) (unless (= (ea-scale ea) 1) (format stream "*~A" (ea-scale ea))) (typecase (ea-disp ea) diff --git a/compiler/x86/macros.lisp b/compiler/x86/macros.lisp index 2949d95ae..8fac524be 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.4 1997/04/01 17:44:40 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.5 1997/11/04 09:11:08 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -16,6 +16,7 @@ ;;; Written by William Lott. ;;; ;;; Debugged by Paul F. Werkowski Spring/Summer 1995. +;;; Enhancements/debugging by Douglas T. Crosher 1996,1997. ;;; (in-package :x86) @@ -111,46 +112,124 @@ ;;;; Allocation helpers -#-cgc -(defmacro with-allocation ((alloc) &body body) +;;; 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) + "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 - (load-symbol-value ,alloc *allocation-pointer*) - ,@body - (store-symbol-value ,alloc *allocation-pointer*))) - -#-cgc -(defmacro with-fixed-allocation ((result alloc type-code size) &body body) - `(with-allocation (,alloc) - (inst lea ,result - (make-ea :byte :base ,alloc :disp other-pointer-type)) - (storew (logior (ash (1- ,size) vm:type-bits) ,type-code) ,alloc) - (inst add ,alloc (pad-data-block ,size)) - ,@body)) - -;;; Support for conservative GC and allocator. Call into C... -#+cgc -(defmacro with-cgc-allocation((alloc-tn size) &body body) - `(let ((stack-offset (- 28 (* 2 (tn-offset ,alloc-tn))))) - ;; I need to save all regs because C might trash a few. - ;; This works because register offsets are assigned in the - ;; same order that PUSHA pushes them on the stack. - (inst pusha) ; Save all registers - (inst push ,size) ; load the size param for C - (inst call (make-fixup (extern-alien-name "alloc") :foreign)) - (inst add esp-tn word-bytes) ; pop off the arg - (inst mov (make-ea :dword ; move result over saved alloc-tn - :base esp-tn :disp stack-offset) eax-tn) - (inst popa) ; restore all regs - ,@body)) - -#+cgc -(defmacro with-fixed-allocation ((result alloc type-code size) &body body) - `(with-cgc-allocation (,alloc (pad-data-block ,size)) - (inst lea ,result (make-ea :byte :base ,alloc :disp other-pointer-type)) - (storew (logior (ash (1- ,size) vm:type-bits) ,type-code) ,alloc) - ,@body)) - - + (allocation ,result-tn (pad-data-block ,size)) + (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)))) ;;;; Error Code diff --git a/compiler/x86/memory.lisp b/compiler/x86/memory.lisp index c2ea36368..9741c0898 100644 --- a/compiler/x86/memory.lisp +++ b/compiler/x86/memory.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/memory.lisp,v 1.3 1997/09/29 04:40:33 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/memory.lisp,v 1.4 1997/11/04 09:11:10 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -84,6 +84,19 @@ ,@(when set-trans `((:translate ,set-trans)))))))) +;;; X86 special +(define-vop (cell-xadd) + (:args (object :scs (descriptor-reg) :to :result) + (value :scs (any-reg) :target result)) + (:results (result :scs (any-reg) :from (:argument 1))) + (:result-types tagged-num) + (:variant-vars offset lowtag) + (:policy :fast-safe) + (:generator 4 + (move result value) + (inst xadd (make-ea :dword :base object + :disp (- (* offset word-bytes) lowtag)) + value))) ;;; Slot-Ref and Slot-Set are used to define VOPs like Closure-Ref, where the ;;; offset is constant at compile time, but varies for different uses. @@ -141,3 +154,17 @@ :disp (- (* (+ base offset) word-bytes) lowtag)) temp) (move result eax))) + +;;; X86 special +(define-vop (slot-xadd) + (:args (object :scs (descriptor-reg) :to :result) + (value :scs (any-reg) :target result)) + (:results (result :scs (any-reg) :from (:argument 1))) + (:result-types tagged-num) + (:variant-vars base lowtag) + (:info offset) + (:generator 4 + (move result value) + (inst xadd (make-ea :dword :base object + :disp (- (* (+ base offset) word-bytes) lowtag)) + value))) diff --git a/compiler/x86/move.lisp b/compiler/x86/move.lisp index cb448a820..745208c25 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.2 1997/02/23 09:42:02 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/move.lisp,v 1.3 1997/11/04 09:11:11 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -17,7 +17,7 @@ ;;; Written by William Lott. ;;; ;;; Debugged by Paul F. Werkowski Spring/Summer 1995. -;;; Enhancements/debugging by Douglas T. Crosher 1996. +;;; Enhancements/debugging by Douglas T. Crosher 1996,1997. ;;; (in-package :x86) @@ -49,13 +49,11 @@ (inst mov y (sap-int (tn-value x)))) (define-move-function (load-constant 5) (vop x y) - ;; pfw adds any-reg to no effect ((constant) (descriptor-reg any-reg)) (inst mov y x)) (define-move-function (load-stack 5) (vop x y) - ((descriptor-stack) (descriptor-reg) - (immediate-stack) (any-reg) + ((descriptor-stack) (any-reg descriptor-reg) (base-char-stack) (base-char-reg) (sap-stack) (sap-reg) (signed-stack) (signed-reg) @@ -63,27 +61,13 @@ (inst mov y x)) (define-move-function (store-stack 5) (vop x y) - ((descriptor-reg) (descriptor-stack) - (any-reg) (immediate-stack) + ((any-reg descriptor-reg) (descriptor-stack) (base-char-reg) (base-char-stack) (sap-reg) (sap-stack) (signed-reg) (signed-stack) (unsigned-reg) (unsigned-stack)) (inst mov y x)) -;;; -;;; ZZZZZ added by jrd. add a move-function for immediate-stack -> descriptor-reg. -;;; dunno if this is right, but we get into the pickle of trying to do this kind of -;;; move a fair amount. see if this fixes it -;;; -(define-move-function (load-immediate-stack 5) (vop x y) - ((immediate-stack) (descriptor-reg)) - (inst mov x y)) - -(define-move-function (store-immediate-stack 5) (vop x y) - ((descriptor-reg) (immediate-stack)) - (inst mov x y)) - ;;;; The Move VOP: ;;; @@ -94,12 +78,12 @@ :load-if (not (or (location= x y) (and (sc-is x any-reg descriptor-reg immediate) - (sc-is y immediate-stack descriptor-stack)))))) + (sc-is y descriptor-stack)))))) (:effects) (:affected) (:generator 0 (if (and (sc-is x immediate) - (sc-is y any-reg immediate-stack descriptor-reg descriptor-stack)) + (sc-is y any-reg descriptor-reg descriptor-stack)) (let ((val (tn-value x))) (etypecase val (integer @@ -133,7 +117,7 @@ (define-vop (move-argument) (:args (x :scs (any-reg descriptor-reg immediate) :target y :load-if (not (and (sc-is y any-reg descriptor-reg) - (sc-is x immediate-stack)))) + (sc-is x descriptor-stack)))) (fp :scs (any-reg) :load-if (not (sc-is y any-reg descriptor-reg)))) (:results (y)) @@ -153,7 +137,7 @@ (inst mov y (logior (ash (char-code val) type-bits) base-char-type))))) (move y x))) - ((descriptor-stack immediate-stack) + ((descriptor-stack) (if (sc-is x immediate) (let ((val (tn-value x))) (if (= (tn-offset fp) esp-offset) @@ -294,6 +278,7 @@ ;;; Result may be a bignum, so we have to check. Use a worst-case cost to make ;;; sure people know they may be number consing. ;;; +#+nil (define-vop (move-from-signed) (:args (x :scs (signed-reg unsigned-reg) :target eax)) (:temporary (:sc dword-reg :offset eax-offset :from (:argument 0)) eax) @@ -311,18 +296,14 @@ (move y ebx))) ;;; ;;; Faster inline version, -#+nil (define-vop (move-from-signed) - (:args (x :scs (signed-reg unsigned-reg) :to :save)) - (:temporary (:sc dword-reg) alloc) - (:results (y :scs (any-reg descriptor-reg))) + (:args (x :scs (signed-reg unsigned-reg) :to :result)) + (:results (y :scs (any-reg descriptor-reg) :from :argument)) (:note "signed word to integer coercion") (:generator 20 (assert (not (location= x y))) - (assert (not (location= x alloc))) - (assert (not (location= y alloc))) - (let ( (bignum (gen-label)) - (done (gen-label)) ) + (let ((bignum (gen-label)) + (done (gen-label))) (inst mov y x) (inst shl y 1) (inst jmp :o bignum) @@ -332,9 +313,8 @@ (assemble (*elsewhere*) (emit-label bignum) - (with-fixed-allocation (y alloc bignum-type - (+ bignum-digits-offset 1)) - (storew x y bignum-digits-offset other-pointer-type)) + (fixed-allocation y bignum-type (+ bignum-digits-offset 1)) + (storew x y bignum-digits-offset other-pointer-type) (inst jmp done))))) ;;; (define-move-vop move-from-signed :move @@ -344,7 +324,7 @@ ;;; Check for fixnum, and possibly allocate one or two word bignum result. Use ;;; a worst-case cost to make sure people know they may be number consing. ;;; - +#+nil (define-vop (move-from-unsigned) (:args (x :scs (signed-reg unsigned-reg) :target eax)) (:temporary (:sc dword-reg :offset eax-offset :from (:argument 0)) eax) @@ -362,7 +342,6 @@ (move y ebx))) ;;; ;;; Faster inline version. -#+nil (define-vop (move-from-unsigned) (:args (x :scs (signed-reg unsigned-reg) :to :save)) (:temporary (:sc dword-reg) alloc) @@ -372,10 +351,10 @@ (assert (not (location= x y))) (assert (not (location= x alloc))) (assert (not (location= y alloc))) - (let ( (bignum (gen-label)) - (done (gen-label)) - (one-word-bignum (gen-label)) - (l1 (gen-label)) ) + (let ((bignum (gen-label)) + (done (gen-label)) + (one-word-bignum (gen-label)) + (l1 (gen-label))) (inst test x #xe0000000) (inst jmp :nz bignum) ;; Fixnum. @@ -398,8 +377,7 @@ (inst mov y (logior (ash (1- (+ bignum-digits-offset 1)) vm:type-bits) bignum-type)) (emit-label l1) - (with-cgc-allocation - (alloc (pad-data-block (+ bignum-digits-offset 2)))) + (allocation alloc (pad-data-block (+ bignum-digits-offset 2))) (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/nlx.lisp b/compiler/x86/nlx.lisp index e9c4fdd97..a661e0b93 100644 --- a/compiler/x86/nlx.lisp +++ b/compiler/x86/nlx.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/nlx.lisp,v 1.5 1997/07/11 05:24:42 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/nlx.lisp,v 1.6 1997/11/04 09:11:12 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -16,7 +16,7 @@ ;;; Written by William Lott. ;;; ;;; Debugged by Paul F. Werkowski Spring/Summer 1995. -;;; Enhancements/debugging by Douglas T. Crosher 1996. +;;; Enhancements/debugging by Douglas T. Crosher 1996,1997. ;;; (in-package :x86) @@ -57,7 +57,6 @@ (eval :scs (descriptor-reg)) (oldfp :scs (descriptor-reg)) (alien-stack :scs (descriptor-reg))) - (:vop-var vop) (:generator 13 (load-symbol-value catch lisp::*current-catch-block*) (load-symbol-value eval lisp::*eval-stack-top*) @@ -70,7 +69,6 @@ (eval :scs (descriptor-reg)) (oldfp :scs (descriptor-reg)) (alien-stack :scs (descriptor-reg))) - (:vop-var vop) (:generator 10 (store-symbol-value catch lisp::*current-catch-block*) (store-symbol-value eval lisp::*eval-stack-top*) @@ -78,7 +76,7 @@ (storew oldfp ebp-tn (- (1+ old-fp-save-offset))))) (define-vop (current-stack-pointer) - (:results (res :scs (any-reg immediate-stack))) + (:results (res :scs (any-reg descriptor-stack))) (:generator 1 (move res esp-tn))) @@ -268,7 +266,7 @@ ;; (loadw tn start (- (1+ i))) (move move-temp start) (loadw tn move-temp (- (1+ i)))) - ((descriptor-stack immediate-stack) + ((descriptor-stack) ;; (loadw move-temp start (- (1+ i))) (move move-temp start) (loadw move-temp move-temp (- (1+ i))) @@ -348,7 +346,7 @@ (:temporary (:sc dword-reg :offset esi-offset) esi) (:temporary (:sc dword-reg :offset edi-offset) edi) (:results (result :scs (any-reg) :from (:argument 0)) - (num :scs (any-reg immediate-stack))) + (num :scs (any-reg descriptor-stack))) (:save-p :force-to-stack) (:vop-var vop) (:generator 30 diff --git a/compiler/x86/parms.lisp b/compiler/x86/parms.lisp index 173d1d601..18f8ee51b 100644 --- a/compiler/x86/parms.lisp +++ b/compiler/x86/parms.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/parms.lisp,v 1.7 1997/09/24 06:15:39 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.8 1997/11/04 09:11:13 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -42,7 +42,7 @@ (setf (backend-fasl-file-type *target-backend*) "x86f") (setf (backend-fasl-file-implementation *target-backend*) x86-fasl-file-implementation) -(setf (backend-fasl-file-version *target-backend*) 1) +(setf (backend-fasl-file-version *target-backend*) 2) (setf (backend-register-save-penalty *target-backend*) 3) (setf (backend-byte-order *target-backend*) :little-endian) @@ -240,35 +240,46 @@ lisp::*current-catch-block* lisp::*current-unwind-protect-block* *eval-stack-top* + *alien-stack* ;; Interrupt Handling lisp::*free-interrupt-context-index* unix::*interrupts-enabled* unix::*interrupt-pending* - ;; added by pfw *allocation-pointer* *binding-stack-pointer* - *x86-cgc-active-p* - *internal-gc-trigger* ; Keep C code happy + *internal-gc-trigger* ; Not used. - *fp-constant-1s0* + ;; The FP constants + *fp-constant-0d0* *fp-constant-1d0* *fp-constant-0s0* - *fp-constant-0d0* + *fp-constant-1s0* - *alien-stack* + ;; Used by gencgc. + *scavenge-read-only-space* + ;; Multi-process support. *control-stacks* - ;; Some unused static variables - very handy for hacking. - *unused-static-6* - *unused-static-5* - *unused-static-4* - *unused-static-3* - *unused-static-2* - *unused-static-1* - + ;; Spare symbols + spare-13 + spare-12 + spare-11 + spare-10 + spare-9 + spare-8 + spare-7 + spare-6 + spare-5 + spare-4 + spare-3 + spare-2 + spare-1 + + ;; Used by CGC. + *x86-cgc-active-p* *static-blue-bag* ; Must be last or change C code )) diff --git a/compiler/x86/pred.lisp b/compiler/x86/pred.lisp index 5021c9c3b..6ad950ca5 100644 --- a/compiler/x86/pred.lisp +++ b/compiler/x86/pred.lisp @@ -7,13 +7,14 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/pred.lisp,v 1.1 1997/01/18 14:31:22 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/pred.lisp,v 1.2 1997/11/04 09:11:14 dtc Exp $") ;;; ;;; ********************************************************************** ;;; ;;; This file contains the VM definition of predicate VOPs for the x86. ;;; ;;; Written by William Lott. +;;; Enhancements/debugging by Douglas T. Crosher 1996,1997. ;;; (in-package :x86) @@ -35,16 +36,13 @@ ;;; Note: a constant-tn is allowed in CMP; it uses an EA displacement, ;;; not immediate data. (define-vop (if-eq) - (:args (x :scs (any-reg descriptor-reg immediate-stack descriptor-stack - constant) + (:args (x :scs (any-reg descriptor-reg descriptor-stack constant) :load-if (not (and (sc-is x immediate) (sc-is y any-reg descriptor-reg - immediate-stack descriptor-stack - constant)))) + descriptor-stack constant)))) (y :scs (any-reg descriptor-reg immediate) :load-if (not (and (sc-is x any-reg descriptor-reg immediate) - (sc-is y immediate-stack descriptor-stack - constant))))) + (sc-is y descriptor-stack constant))))) (:conditional) (:info target not-p) (:policy :fast-safe) diff --git a/compiler/x86/print.lisp b/compiler/x86/print.lisp index d9a5317f3..db111aaf6 100644 --- a/compiler/x86/print.lisp +++ b/compiler/x86/print.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/print.lisp,v 1.1 1997/01/18 14:31:22 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/print.lisp,v 1.2 1997/11/04 09:11:15 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -15,6 +15,7 @@ ;;; core to keep the user entertained. ;;; ;;; Written by William Lott. +;;; Enhancements/debugging by Douglas T. Crosher 1996. ;;; (in-package :x86) diff --git a/compiler/x86/sap.lisp b/compiler/x86/sap.lisp index 0192ab51e..30f47bb37 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.3 1997/10/05 16:44:57 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/sap.lisp,v 1.4 1997/11/04 09:11:15 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -39,13 +39,12 @@ ;;; (define-vop (move-from-sap) - (:args (sap :scs (sap-reg) :to :save)) - (:temporary (:sc dword-reg) alloc) - (:results (res :scs (descriptor-reg))) + (:args (sap :scs (sap-reg) :to :result)) + (:results (res :scs (descriptor-reg) :from :argument)) (:note "SAP to pointer coercion") (:generator 20 - (with-fixed-allocation (res alloc sap-type sap-size) - (storew sap res sap-pointer-slot other-pointer-type)))) + (fixed-allocation res sap-type sap-size) + (storew sap res sap-pointer-slot other-pointer-type))) ;;; (define-move-vop move-from-sap :move diff --git a/compiler/x86/system.lisp b/compiler/x86/system.lisp index 629d98e79..9a1370109 100644 --- a/compiler/x86/system.lisp +++ b/compiler/x86/system.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/system.lisp,v 1.4 1997/09/24 06:15:39 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/system.lisp,v 1.5 1997/11/04 09:11:16 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -27,7 +27,7 @@ (define-vop (get-lowtag) (:translate get-lowtag) (:policy :fast-safe) - (:args (object :scs (any-reg descriptor-reg immediate-stack descriptor-stack) + (:args (object :scs (any-reg descriptor-reg descriptor-stack) :target result)) (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) diff --git a/compiler/x86/values.lisp b/compiler/x86/values.lisp index fd7109d08..765b09d78 100644 --- a/compiler/x86/values.lisp +++ b/compiler/x86/values.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/values.lisp,v 1.2 1997/02/08 21:38:35 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/values.lisp,v 1.3 1997/11/04 09:11:17 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -17,6 +17,7 @@ ;;; ;;; Debugged by Paul F. Werkowski Spring/Summer 1995. ;;; %more-arg-values by Douglas Thomas Crosher, March 1996. +;;; Enhancements/debugging by Douglas T. Crosher 1996. (in-package :x86) diff --git a/compiler/x86/vm.lisp b/compiler/x86/vm.lisp index cfea400a3..64037b528 100644 --- a/compiler/x86/vm.lisp +++ b/compiler/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/compiler/x86/vm.lisp,v 1.4 1997/11/01 22:58:46 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/vm.lisp,v 1.5 1997/11/04 09:11:18 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -16,6 +16,7 @@ ;;; Written by William Lott ;;; ;;; Debugged by Paul F. Werkowski Spring/Summer 1995. +;;; Enhancements/debugging by Douglas T. Crosher 1996, 1997. ;;; (in-package :x86) @@ -178,7 +179,6 @@ ;; The control stack. (descriptor-stack stack) ; may be pointers, scanned by GC - (immediate-stack stack) ; isn't pointers, ignored by GC ;; The non-descriptor stacks. (signed-stack stack) ; (signed-byte 32) @@ -198,36 +198,29 @@ ;; **** Things that can go in the integer registers. - ;; We don't have to distinguish between descriptor and non-descriptor - ;; registers, because we dump explicit information about what descriptor - ;; values are live at any potential GC point. Therefore, we only different - ;; scs to distinguish between descriptor and non-descriptor values and - ;; to specify size. + ;; We don't have to distinguish between descriptor and + ;; non-descriptor registers, because of the conservative GC. + ;; Therefore, we only use different scs to distinguish between + ;; descriptor and non-descriptor values and to specify size. + + ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing + ;; bad will happen if they are. (fixnums, characters, header values, etc). (any-reg registers :locations #.dword-regs :element-size 2 - :reserve-locations (#.eax-offset) +; :reserve-locations (#.eax-offset) :constant-scs (immediate) :save-p t - :alternate-scs (immediate-stack)) + :alternate-scs (descriptor-stack)) ;; Pointer descriptor objects. Must be seen by GC. (descriptor-reg registers :locations #.dword-regs :element-size 2 - :reserve-locations (#.eax-offset) +; :reserve-locations (#.eax-offset) :constant-scs - (constant immediate - ;; zzz jrd added IMMEDIATE-STACK here. - ;; it seems right, and references elsewhere - ;; in the code suggest that we expect to be - ;; able to do this. see - ;; DEFINE-MOVE-VOP MOVE :MOVE in MOVE.LISP - - ;; zzz this may not be right after all - ;; immediate-stack - ) + (constant immediate) :save-p t :alternate-scs (descriptor-stack)) @@ -243,7 +236,7 @@ (sap-reg registers :locations #.dword-regs :element-size 2 - :reserve-locations (#.eax-offset) +; :reserve-locations (#.eax-offset) :constant-scs (immediate) :save-p t :alternate-scs (sap-stack)) @@ -252,14 +245,14 @@ (signed-reg registers :locations #.dword-regs :element-size 2 - :reserve-locations (#.eax-offset) +; :reserve-locations (#.eax-offset) :constant-scs (immediate) :save-p t :alternate-scs (signed-stack)) (unsigned-reg registers :locations #.dword-regs :element-size 2 - :reserve-locations (#.eax-offset) +; :reserve-locations (#.eax-offset) :constant-scs (immediate) :save-p t :alternate-scs (unsigned-stack)) @@ -268,14 +261,17 @@ (dword-reg registers :locations #.dword-regs :element-size 2 - :reserve-locations (#.eax-offset)) +; :reserve-locations (#.eax-offset) + ) (word-reg registers :locations #.word-regs :element-size 2 - :reserve-locations (#.ax-offset)) +; :reserve-locations (#.ax-offset) + ) (byte-reg registers :locations #.byte-regs - :reserve-locations (#.al-offset #.ah-offset)) +; :reserve-locations (#.al-offset #.ah-offset) + ) ;; **** Things that can go in the floating point registers. @@ -336,7 +332,7 @@ (defconstant word-sc-names '(word-reg)) (defconstant dword-sc-names '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg dword-reg - descriptor-stack immediate-stack signed-stack unsigned-stack + descriptor-stack signed-stack unsigned-stack sap-stack single-stack constant)) ;;; @@ -392,7 +388,6 @@ ;;; some instruction instead of in the constants pool, then return ;;; the immediate SC. ;;; - #+nil ;; pw-- the way it was. (def-vm-support-routine immediate-constant-sc (value) (if (or (and (symbolp value) (static-symbol-p value)) @@ -410,24 +405,6 @@ (sc-number-or-lose 'immediate *backend*) nil)) -;;; I probably should use double-from-bits here -;;; to avoid any compilation errors, but lets see -;;; what happens. These should be part of lisp like PI? -(defconstant i387-lg2 3.010299956639811952137389d0) -(defconstant i387-ln2 0.6931471805599453094172321d0) -(defconstant i387-l10 2.3025850929940456840179915d0) -(defconstant i387-l2e (/ i387-ln2)) -(defconstant i387-l2t (/ i387-l10 i387-ln2)) -(export '(i387-lg2 i387-ln2 i387-l10 i387-l2e i387-l2t)) - - -;;; pw-- A good try and it works, but it also results in -;;; extra consing when the constant is an argument to -;;; some function. The descriptor from the constants vector -;;; would normally be passed instead. DTC processes zero and -;;; one in move-from-single|double as static symbols to -;;; save on CV space for these common values. - (def-vm-support-routine immediate-constant-sc (value) (typecase value ((or fixnum system-area-pointer character) diff --git a/lisp/cgc.c b/lisp/cgc.c index ea1b6c9ad..50f5819fc 100644 --- a/lisp/cgc.c +++ b/lisp/cgc.c @@ -1,5 +1,5 @@ /* cgc.c -*- Mode: C; comment-column: 40; -*- - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/cgc.c,v 1.6 1997/11/02 09:49:11 dtc Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/cgc.c,v 1.7 1997/11/04 09:11:21 dtc Exp $ * * Conservative Garbage Collector for CMUCL x86. * @@ -404,7 +404,7 @@ static void new_cluster(int min_blocks) region->space = NULL; } -unsigned long cgc_bytes_allocated = 0; /* Seen by (dynamic-usage) */ +unsigned long bytes_allocated = 0; /* Seen by (dynamic-usage) */ static unsigned long auto_gc_trigger = 0; static int maybe_gc_called = 0; @@ -471,7 +471,7 @@ static void *alloc_large(int nbytes) region->next = NULL; region->prev = NULL; region->space = NULL; - cgc_bytes_allocated += region->num_chunks*CHUNK_BYTES; + bytes_allocated += region->num_chunks*CHUNK_BYTES; move_to_newspace(region); return (char *)region + REGION_OVERHEAD; } @@ -506,7 +506,7 @@ void *cgc_alloc(int nbytes) region->contains_small_objects = 1; space->alloc_ptr = (char *)region + REGION_OVERHEAD; space->alloc_end = (char *)region + CHUNK_BYTES; - cgc_bytes_allocated += region->num_chunks*CHUNK_BYTES; + bytes_allocated += region->num_chunks*CHUNK_BYTES; } res = space->alloc_ptr; @@ -1398,7 +1398,7 @@ scavengex(lispobj*obj) static void scavenge_space( lispobj*where, int words, char*name ) { - int allocated = cgc_bytes_allocated; + int allocated = bytes_allocated; lispobj*end = where + words; lispobj*last; bytes_copied = 0; @@ -1412,7 +1412,7 @@ scavenge_space( lispobj*where, int words, char*name ) gc_assert(where == end); if(name) dprintf(noise,(" %ld bytes moved, %ld bytes allocated.\n", - bytes_copied, cgc_bytes_allocated - allocated)); + bytes_copied, bytes_allocated - allocated)); } static int boxed_registers[] = BOXED_REGISTERS; @@ -1817,7 +1817,7 @@ static int dolog=0; /* log copy ops to file */ static int dover=0; /* hunt pointers to oldspace */ void cgc_collect_garbage() { - unsigned long allocated = cgc_bytes_allocated; + unsigned long allocated = bytes_allocated; dprintf(noise,("GC\n")); if(dolog && !log) @@ -1850,10 +1850,10 @@ void cgc_collect_garbage() if(log) fclose(log); log=NULL; - dprintf(noise,(" %ld bytes copied.\n",(cgc_bytes_allocated - allocated))); + dprintf(noise,(" %ld bytes copied.\n",(bytes_allocated - allocated))); dprintf(noise,(" %ld bytes (%ld pages) reclaimed.\n", chunks_freed*CHUNK_BYTES, chunks_freed)); - cgc_bytes_allocated -= chunks_freed*CHUNK_BYTES; + bytes_allocated -= chunks_freed*CHUNK_BYTES; maybe_gc_called = 0; } void cgc_free_heap() @@ -1861,7 +1861,7 @@ void cgc_free_heap() /* Like above but just zap everything 'cause purify has * cleaned house! */ - unsigned long allocated = cgc_bytes_allocated; + unsigned long allocated = bytes_allocated; flip_spaces(); post_purify_fixup(oldspace); free_oldspace(); @@ -1869,7 +1869,7 @@ void cgc_free_heap() #if 0 /* purify is currently running on the C stack so don't do this */ zero_stack(); #endif - cgc_bytes_allocated -= chunks_freed*CHUNK_BYTES; + bytes_allocated -= chunks_freed*CHUNK_BYTES; } @@ -1934,7 +1934,7 @@ char*alloc(int nbytes) * though because lisp will remember *need to collect garbage* * and get to it when it can. */ if( auto_gc_trigger /* Only when enabled */ - && cgc_bytes_allocated > auto_gc_trigger + && bytes_allocated > auto_gc_trigger && !maybe_gc_called++) /* Only once */ funcall0(SymbolFunction(MAYBE_GC)); diff --git a/lisp/x86-arch.c b/lisp/x86-arch.c index 6bc81a8b6..7951e7964 100644 --- a/lisp/x86-arch.c +++ b/lisp/x86-arch.c @@ -23,6 +23,8 @@ #define BREAKPOINT_INST 0xcc /* INT3 */ +unsigned long fast_random_state = 1; + char * arch_init(void) { diff --git a/lisp/x86-assem.S b/lisp/x86-assem.S index 0c4fe17c6..34ceea34f 100644 --- a/lisp/x86-assem.S +++ b/lisp/x86-assem.S @@ -1,8 +1,9 @@ ### x86-assem.S -*- Mode: Asm; -*- /** - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-assem.S,v 1.4 1997/09/07 23:27:48 dtc Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-assem.S,v 1.5 1997/11/04 09:11:23 dtc Exp $ * - * Author: Paul F. Werkowski <pw@snoopy.mv.com> + * Authors: Paul F. Werkowski <pw@snoopy.mv.com> + * Douglas T. Crosher * * This code was written to support the port of CMU Common Lisp * to the Intel X86 ISA and the FreeBSD operating system. The @@ -324,7 +325,7 @@ GNAME(undefined_tramp): .byte trap_Cerror .byte 2 .byte 23 - .byte 14 + .byte sc_DescriptorReg # EAX in the Descriptor-reg SC. ret .size GNAME(undefined_tramp), .-GNAME(undefined_tramp) @@ -424,3 +425,312 @@ Lend: ret .size GNAME(fastcopy16),.-GNAME(fastcopy16) .end + + +/* + Allocate bytes and return the start of the allocated space + in the specified destination register. + + In the general case the size will be in the destination register. + + All registers must be preserved except the destination. + The C conventions will preserve ebx, esi, edi, and ebp. + So only eax, ecx, and edx need special care here. */ + + .globl GNAME(alloc_to_eax) + .type GNAME(alloc_to_eax),@function + .align align_4byte,0x90 +GNAME(alloc_to_eax): + pushl %ecx # Save ecx and edx as C could destroy them. + pushl %edx + pushl %eax # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + popl %edx # Restore ecx and edx. + popl %ecx + ret + .size GNAME(alloc_to_eax),.-GNAME(alloc_to_eax) + + .globl GNAME(alloc_8_to_eax) + .type GNAME(alloc_8_to_eax),@function + .align align_4byte,0x90 +GNAME(alloc_8_to_eax): + pushl %ecx # Save ecx and edx as C could destroy them. + pushl %edx + pushl $8 # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + popl %edx # Restore ecx and edx. + popl %ecx + ret + .size GNAME(alloc_8_to_eax),.-GNAME(alloc_8_to_eax) + + .globl GNAME(alloc_8_to_eax) + .type GNAME(alloc_8_to_eax),@function + .align align_4byte,0x90 + + .globl GNAME(alloc_16_to_eax) + .type GNAME(alloc_16_to_eax),@function + .align align_4byte,0x90 +GNAME(alloc_16_to_eax): + pushl %ecx # Save ecx and edx as C could destroy them. + pushl %edx + pushl $16 # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + popl %edx # Restore ecx and edx. + popl %ecx + ret + .size GNAME(alloc_16_to_eax),.-GNAME(alloc_16_to_eax) + + + .globl GNAME(alloc_to_ecx) + .type GNAME(alloc_to_ecx),@function + .align align_4byte,0x90 +GNAME(alloc_to_ecx): + pushl %eax # Save eax and edx as C could destroy them. + pushl %edx + pushl %ecx # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + movl %eax,%ecx # setup the destination. + popl %edx # Restore eax and edx. + popl %eax + ret + .size GNAME(alloc_to_ecx),.-GNAME(alloc_to_ecx) + + .globl GNAME(alloc_8_to_ecx) + .type GNAME(alloc_8_to_ecx),@function + .align align_4byte,0x90 +GNAME(alloc_8_to_ecx): + pushl %eax # Save eax and edx as C could destroy them. + pushl %edx + pushl $8 # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + movl %eax,%ecx # setup the destination. + popl %edx # Restore eax and edx. + popl %eax + ret + .size GNAME(alloc_8_to_ecx),.-GNAME(alloc_8_to_ecx) + + .globl GNAME(alloc_16_to_ecx) + .type GNAME(alloc_16_to_ecx),@function + .align align_4byte,0x90 +GNAME(alloc_16_to_ecx): + pushl %eax # Save eax and edx as C could destroy them. + pushl %edx + pushl $16 # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + movl %eax,%ecx # setup the destination. + popl %edx # Restore eax and edx. + popl %eax + ret + .size GNAME(alloc_16_to_ecx),.-GNAME(alloc_16_to_ecx) + + + .globl GNAME(alloc_to_edx) + .type GNAME(alloc_to_edx),@function + .align align_4byte,0x90 +GNAME(alloc_to_edx): + pushl %eax # Save eax and ecx as C could destroy them. + pushl %ecx + pushl %edx # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + movl %eax,%edx # setup the destination. + popl %ecx # Restore eax and ecx. + popl %eax + ret + .size GNAME(alloc_to_edx),.-GNAME(alloc_to_edx) + + .globl GNAME(alloc_8_to_edx) + .type GNAME(alloc_8_to_edx),@function + .align align_4byte,0x90 +GNAME(alloc_8_to_edx): + pushl %eax # Save eax and ecx as C could destroy them. + pushl %ecx + pushl $8 # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + movl %eax,%edx # setup the destination. + popl %ecx # Restore eax and ecx. + popl %eax + ret + .size GNAME(alloc_8_to_edx),.-GNAME(alloc_8_to_edx) + + .globl GNAME(alloc_16_to_edx) + .type GNAME(alloc_16_to_edx),@function + .align align_4byte,0x90 +GNAME(alloc_16_to_edx): + pushl %eax # Save eax and ecx as C could destroy them. + pushl %ecx + pushl $16 # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + movl %eax,%edx # setup the destination. + popl %ecx # Restore eax and ecx. + popl %eax + ret + .size GNAME(alloc_16_to_edx),.-GNAME(alloc_16_to_edx) + + + + .globl GNAME(alloc_to_ebx) + .type GNAME(alloc_to_ebx),@function + .align align_4byte,0x90 +GNAME(alloc_to_ebx): + pushl %eax # Save eax, ecx, and edx as C could destroy them. + pushl %ecx + pushl %edx + pushl %ebx # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + movl %eax,%ebx # setup the destination. + popl %edx # Restore eax, ecx and edx. + popl %ecx + popl %eax + ret + .size GNAME(alloc_to_ebx),.-GNAME(alloc_to_ebx) + + .globl GNAME(alloc_8_to_ebx) + .type GNAME(alloc_8_to_ebx),@function + .align align_4byte,0x90 +GNAME(alloc_8_to_ebx): + pushl %eax # Save eax, ecx, and edx as C could destroy them. + pushl %ecx + pushl %edx + pushl $8 # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + movl %eax,%ebx # setup the destination. + popl %edx # Restore eax, ecx and edx. + popl %ecx + popl %eax + ret + .size GNAME(alloc_8_to_ebx),.-GNAME(alloc_8_to_ebx) + + .globl GNAME(alloc_16_to_ebx) + .type GNAME(alloc_16_to_ebx),@function + .align align_4byte,0x90 +GNAME(alloc_16_to_ebx): + pushl %eax # Save eax, ecx, and edx as C could destroy them. + pushl %ecx + pushl %edx + pushl $16 # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + movl %eax,%ebx # setup the destination. + popl %edx # Restore eax, ecx and edx. + popl %ecx + popl %eax + ret + .size GNAME(alloc_16_to_ebx),.-GNAME(alloc_16_to_ebx) + + + + .globl GNAME(alloc_to_esi) + .type GNAME(alloc_to_esi),@function + .align align_4byte,0x90 +GNAME(alloc_to_esi): + pushl %eax # Save eax, ecx, and edx as C could destroy them. + pushl %ecx + pushl %edx + pushl %esi # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + movl %eax,%esi # setup the destination. + popl %edx # Restore eax, ecx and edx. + popl %ecx + popl %eax + ret + .size GNAME(alloc_to_esi),.-GNAME(alloc_to_esi) + + .globl GNAME(alloc_8_to_esi) + .type GNAME(alloc_8_to_esi),@function + .align align_4byte,0x90 +GNAME(alloc_8_to_esi): + pushl %eax # Save eax, ecx, and edx as C could destroy them. + pushl %ecx + pushl %edx + pushl $8 # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + movl %eax,%esi # setup the destination. + popl %edx # Restore eax, ecx and edx. + popl %ecx + popl %eax + ret + .size GNAME(alloc_8_to_esi),.-GNAME(alloc_8_to_esi) + + .globl GNAME(alloc_16_to_esi) + .type GNAME(alloc_16_to_esi),@function + .align align_4byte,0x90 +GNAME(alloc_16_to_esi): + pushl %eax # Save eax, ecx, and edx as C could destroy them. + pushl %ecx + pushl %edx + pushl $16 # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + movl %eax,%esi # setup the destination. + popl %edx # Restore eax, ecx and edx. + popl %ecx + popl %eax + ret + .size GNAME(alloc_16_to_esi),.-GNAME(alloc_16_to_esi) + + + .globl GNAME(alloc_to_edi) + .type GNAME(alloc_to_edi),@function + .align align_4byte,0x90 +GNAME(alloc_to_edi): + pushl %eax # Save eax, ecx, and edx as C could destroy them. + pushl %ecx + pushl %edx + pushl %edi # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + movl %eax,%edi # setup the destination. + popl %edx # Restore eax, ecx and edx. + popl %ecx + popl %eax + ret + .size GNAME(alloc_to_edi),.-GNAME(alloc_to_edi) + + .globl GNAME(alloc_8_to_edi) + .type GNAME(alloc_8_to_edi),@function + .align align_4byte,0x90 +GNAME(alloc_8_to_edi): + pushl %eax # Save eax, ecx, and edx as C could destroy them. + pushl %ecx + pushl %edx + pushl $8 # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + movl %eax,%edi # setup the destination. + popl %edx # Restore eax, ecx and edx. + popl %ecx + popl %eax + ret + .size GNAME(alloc_8_to_edi),.-GNAME(alloc_8_to_edi) + + .globl GNAME(alloc_16_to_edi) + .type GNAME(alloc_16_to_edi),@function + .align align_4byte,0x90 +GNAME(alloc_16_to_edi): + pushl %eax # Save eax, ecx, and edx as C could destroy them. + pushl %ecx + pushl %edx + pushl $16 # Push the size + call GNAME(alloc) + addl $4,%esp # pop the size arg. + movl %eax,%edi # setup the destination. + popl %edx # Restore eax, ecx and edx. + popl %ecx + popl %eax + ret + .size GNAME(alloc_16_to_edi),.-GNAME(alloc_16_to_edi) + + .end -- GitLab