diff --git a/assembly/x86/alloc.lisp b/assembly/x86/alloc.lisp index 4a9b13ad0125164a969b1f38300a8b1b5ebfefbf..4cd98cb44b34e6cc0aca7559e47ed162c06113c5 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 1b4b385a4d8bf16396983a3f89f6b971cdc2cdb9..5bc13ad32115b1a93b67b4edecddd71ae0f69d76 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 ce0e7d04521afcd5eb2619c39811cc13b6d974ef..56ab832dec28a0d05b0b8b4198a540598df9d90e 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 400628bec33046975d2f4600aff58a5716cb557c..fe5d50f3c2c51089b80ec9c7951bbf034e6e4dd6 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 7694c9f5b59f71397576ffdfb6901e969e559708..7932f262559850fe881760a809f40c67ee06e208 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 45546857d385a7045a49214fbbbafa229bb7ec76..72fa50820a8fff521fda812b59302ff8e4e0b743 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 abb94dd2acc39fcf9ff5d196f6187f343e0f3fb5..c6dc92543bf276bc4942e5318da0db6289b9a12b 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 db4780caef7cfbd97c311ce53cd88ceba38f804a..6ad67b111fabcaf7efb2a3657c0eef25961c533c 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 c58468c8195305d071348777e4ed8d20134d4ff6..9dda74e9238687ee407d6e618917e43458f6e784 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 bc7c24b3dc2b18692976cb1d3f21253b2adfccee..9216f91bb08eb67de16653a920a0d752e75a6918 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 5d5601fbbb920b29e58ae3af9808670664dbc68e..382fa61fa5477ecf9a3eb257f0222037837a7745 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 d82942c43a499b18410f7c1e488eb4af13570059..8d7436c6752a0e41f043ed54a3aa16b792973cdb 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 74a4c8166e9e1b788ece4f890cd22a33a3a67583..738ee52ad02277ebb5cd3e88e3fb619216a548fb 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 360cc45ba53824eb3a1e0f207c3f56cbab1b8f7a..59bd18cd9e74655baeb76c09907d5f5b3e03483b 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 654c4098cf084beb409ea7325d2955b476a5a976..51e7172dbdeef0c09e947863abeff65e486a33c6 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 b6e4e5a4b174b7144c8f4245dd655059d7074aa0..2c1cef3f9beec8089eed4d3c5eac61efbf28338a 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 6fdf6bd3dccb59d2c5eb790f9360770cb683a0cb..64768571be87f4d946c1d6a26264fb88f159fde7 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 741804fec83a6181f2005b290314c866054546ab..c12c3d922f7fa0f5b3b414f180f5e72da8845cee 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 3f107708f44c6187a957766718259bbce97d8c4e..45cff64f870956c94488bbe97c54e4f8e1d11244 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 a175126b23d005bfa93fb04988c5ec9b2827332c..a039b3471de99bdb2570df0f419c9fd82945e468 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 2949d95ae596a4ae1db47422085a63bc1030502f..8fac524bee52e119715b7d5d6b1104ed1779bf36 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 c2ea36368bd5992f37c692c78433a0ceebe6a607..9741c0898137a640b8ed45d2f6fe80360acd77f3 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 cb448a820be51eebb978f9bdaa2e380433e6bc58..745208c251618019d10b57f27746d596d4367b76 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 e9c4fdd97fc089d0ef62570cecae92c604a30670..a661e0b932476d6bd0f5aa771eee972ab99ea60e 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 173d1d601ec5981e50f6c6de91f2acfc8ef2ce4f..18f8ee51bdcbc35f2505d76433bee868b81c1d2d 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 5021c9c3b07353f716c60f1fe96d919c5daddeaa..6ad950ca55c14508826caa5eb8c5222df892eb20 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 d9a5317f3b8e80de476b55b21e59efff0f520b51..db111aaf6ee3f717edccfbdcd2efaf7241ff7b96 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 0192ab51e196d9398b8ab3e6d055520ef0db8bdf..30f47bb376bc51f1162bcd20065574aaedbf31e2 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 629d98e796745d5a50154e0e134bb404f17a46c1..9a1370109c26998551c7d9ea7e4334b542d0df5e 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 fd7109d08fe1f6eb7af9d9425e0fc28c6e547e3d..765b09d7822e85f640ab324cae0f6008e020a77a 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 cfea400a39c6b0ae57e61b72ec5ce7691dcc89a1..64037b52804984286e3f8e8c65b871263eef26ab 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 ea1b6c9ad440b9073ac2f717d7da3af79b5a6289..50f5819fc2ed530e8212031804249d57cad52868 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 6bc81a8b63ea34aae99044902339a15bb670a066..7951e7964df9e2142262025edba8c7e9c7d26d38 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 0c4fe17c6edd3a463e4a20886fdbc214cae52606..34ceea34fe2eeea96d97081c497ea7bb2194527a 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