diff --git a/compiler/x86/alloc.lisp b/compiler/x86/alloc.lisp index b906dbfa4ca9a1e34551fed7abcfd8288a34f6d1..5f6e429de7aea6223225252486937608bf526c9c 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.4 1997/11/05 14:59:50 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/alloc.lisp,v 1.5 1997/11/18 10:53:17 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -45,7 +45,7 @@ `(let ((reg (sc-case ,tn ((any-reg descriptor-reg) ,tn) - ((descriptor-stack) + ((control-stack) (move temp ,tn) temp)))) (storew reg ,list ,slot vm:list-pointer-type)))) diff --git a/compiler/x86/arith.lisp b/compiler/x86/arith.lisp index 8d7436c6752a0e41f043ed54a3aa16b792973cdb..cedbb2fba4d0b5d830536e526d7de163d987729e 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.7 1997/11/04 09:10:56 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.8 1997/11/18 10:53:18 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 descriptor-stack) + :load-if (not (and (sc-is x control-stack) (sc-is y any-reg) - (sc-is r descriptor-stack) + (sc-is r control-stack) (location= x r)))) - (y :scs (any-reg descriptor-stack))) + (y :scs (any-reg control-stack))) (:arg-types tagged-num tagged-num) (:results (r :scs (any-reg) :from (:argument 0) - :load-if (not (and (sc-is x descriptor-stack) + :load-if (not (and (sc-is x control-stack) (sc-is y any-reg) - (sc-is r descriptor-stack) + (sc-is r control-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 descriptor-stack))) + (:args (x :target r :scs (any-reg control-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 descriptor-stack) + :load-if (not (and (sc-is x control-stack) (sc-is y any-reg) - (sc-is r descriptor-stack) + (sc-is r control-stack) (location= x r)))) - (y :scs (any-reg descriptor-stack))) + (y :scs (any-reg control-stack))) (:arg-types tagged-num tagged-num) (:results (r :scs (any-reg) :from (:argument 0) - :load-if (not (and (sc-is x descriptor-stack) + :load-if (not (and (sc-is x control-stack) (sc-is y any-reg) - (sc-is r descriptor-stack) + (sc-is r control-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 descriptor-stack))) + (:args (x :target r :scs (any-reg control-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 descriptor-stack))) + (y :scs (any-reg control-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 descriptor-stack))) + (:args (x :scs (any-reg control-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 descriptor-stack))) + (y :scs (any-reg control-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 descriptor-stack) - (sc-is result any-reg descriptor-stack) + :load-if (not (and (sc-is number any-reg control-stack) + (sc-is result any-reg control-stack) (location= number result))))) (:info amount) (:arg-types tagged-num (:constant integer)) (:results (result :scs (any-reg) - :load-if (not (and (sc-is number descriptor-stack) - (sc-is result descriptor-stack) + :load-if (not (and (sc-is number control-stack) + (sc-is result control-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 descriptor-stack) - (sc-is result descriptor-stack) + :load-if (not (and (sc-is number control-stack) + (sc-is result control-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 descriptor-stack) - (sc-is result descriptor-stack) + :load-if (not (and (sc-is number control-stack) + (sc-is result control-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 descriptor-stack) + :load-if (not (and (sc-is x control-stack) (sc-is y any-reg)))) - (y :scs (any-reg descriptor-stack))) + (y :scs (any-reg control-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 descriptor-stack))) + (:args (x :scs (any-reg control-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 descriptor-stack) + :load-if (not (and (sc-is x control-stack) (sc-is y any-reg)))) - (y :scs (any-reg descriptor-stack))) + (y :scs (any-reg control-stack))) (:arg-types tagged-num tagged-num) (:note "inline fixnum comparison") (:translate eql) @@ -911,14 +911,14 @@ ;;; (define-vop (generic-eql/fixnum fast-eql/fixnum) (:args (x :scs (any-reg descriptor-reg) - :load-if (not (and (sc-is x descriptor-stack) + :load-if (not (and (sc-is x control-stack) (sc-is y any-reg)))) - (y :scs (any-reg descriptor-stack))) + (y :scs (any-reg control-stack))) (:arg-types * tagged-num) (:variant-cost 7)) (define-vop (fast-eql-c/fixnum fast-conditional/fixnum) - (:args (x :scs (any-reg descriptor-stack))) + (:args (x :scs (any-reg control-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 descriptor-reg descriptor-stack))) + (:args (x :scs (any-reg descriptor-reg control-stack))) (:arg-types * (:constant (signed-byte 30))) (:variant-cost 6)) @@ -1113,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 descriptor-stack))) + (c :scs (any-reg control-stack))) (:arg-types unsigned-num unsigned-num positive-fixnum) (:results (result :scs (unsigned-reg) :from :eval) (borrow :scs (unsigned-reg))) @@ -1209,10 +1209,10 @@ (define-vop (fixnum-to-digit) (:translate bignum::%fixnum-to-digit) (:policy :fast-safe) - (:args (fixnum :scs (any-reg descriptor-stack) :target digit)) + (:args (fixnum :scs (any-reg control-stack) :target digit)) (:arg-types tagged-num) (:results (digit :scs (unsigned-reg) - :load-if (not (and (sc-is fixnum descriptor-stack) + :load-if (not (and (sc-is fixnum control-stack) (sc-is digit unsigned-stack) (location= fixnum digit))))) (:result-types unsigned-num) @@ -1248,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 descriptor-stack signed-stack) + (sc-is res control-stack signed-stack) (location= digit res))))) (:result-types signed-num) (:generator 1 (move res digit) - (when (sc-is res any-reg descriptor-stack) + (when (sc-is res any-reg control-stack) (inst shl res 2)))) (define-vop (digit-ashr) diff --git a/compiler/x86/call.lisp b/compiler/x86/call.lisp index 588fa072ee1be76fa777ada23908919296dc9717..58e3c27d14a37494edadda90a2d195a817ae3b98 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.5 1997/11/05 14:59:53 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/call.lisp,v 1.6 1997/11/18 10:53:19 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -35,7 +35,7 @@ (if (< n register-arg-count) (make-wired-tn *any-primitive-type* descriptor-reg-sc-number (nth n register-arg-offsets)) - (make-wired-tn *any-primitive-type* descriptor-stack-sc-number n))) + (make-wired-tn *any-primitive-type* control-stack-sc-number n))) ;;; Make-Return-PC-Passing-Location -- Interface @@ -50,7 +50,7 @@ (def-vm-support-routine make-return-pc-passing-location (standard) (declare (ignore standard)) (make-wired-tn *fixnum-primitive-type* - descriptor-stack-sc-number + control-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* descriptor-stack-sc-number + (make-wired-tn *fixnum-primitive-type* control-stack-sc-number return-pc-save-offset) (make-normal-tn *fixnum-primitive-type*))) @@ -78,9 +78,8 @@ ;#+nil (def-vm-support-routine make-old-fp-passing-location (standard) (declare (ignore standard)) - (make-wired-tn *fixnum-primitive-type* - descriptor-stack-sc-number - old-fp-save-offset)) + (make-wired-tn *fixnum-primitive-type* control-stack-sc-number + ocfp-save-offset)) ;;; ;;; If standard is true, then use the standard (full call) location, ;;; otherwise use any legal location. @@ -89,7 +88,8 @@ #+nil (def-vm-support-routine make-old-fp-passing-location (standard) (if standard - (make-wired-tn *fixnum-primitive-type* descriptor-stack-sc-number old-fp-save-offset) + (make-wired-tn *fixnum-primitive-type* control-stack-sc-number + ocfp-save-offset) (make-normal-tn *fixnum-primitive-type*))) ;;; Make-Old-FP-Save-Location, Make-Return-PC-Save-Location -- Interface @@ -102,8 +102,8 @@ ;;; 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* - descriptor-stack-sc-number - old-fp-save-offset) + control-stack-sc-number + ocfp-save-offset) env)) ;;; ;;; Using a save-tn. No problems. @@ -112,7 +112,7 @@ (specify-save-tn (environment-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env) (make-wired-tn *fixnum-primitive-type* - descriptor-stack-sc-number + control-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* - descriptor-stack-sc-number + control-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 - descriptor-stack-sc-number + control-stack-sc-number return-pc-save-offset)))) ;;; Make-Argument-Count-Location -- Interface @@ -195,7 +195,7 @@ ;;; Used for setting up the Old-FP in local call. ;;; (define-vop (current-fp) - (:results (val :scs (any-reg descriptor-stack))) + (:results (val :scs (any-reg control-stack))) (:generator 1 (move val ebp-tn))) @@ -243,7 +243,7 @@ ;;; callee (who has the same size stack as us). ;;; (define-vop (allocate-frame) - (:results (res :scs (any-reg descriptor-stack)) + (:results (res :scs (any-reg control-stack)) (nfp)) (:info callee) (:ignore nfp callee) @@ -257,7 +257,7 @@ ;;; (define-vop (allocate-full-call-frame) (:info nargs) - (:results (res :scs (any-reg descriptor-stack))) + (:results (res :scs (any-reg control-stack))) (:generator 2 (move res esp-tn) (inst sub esp-tn (* (max nargs 3) vm:word-bytes)))) @@ -511,8 +511,8 @@ (:temporary (:sc any-reg :offset ecx-offset :from :eval :to (:result 1)) nvals) - (:results (start :scs (any-reg descriptor-stack)) - (count :scs (any-reg descriptor-stack)))) + (:results (start :scs (any-reg control-stack)) + (count :scs (any-reg control-stack)))) ;;;; Local call with unknown values convention return: @@ -559,7 +559,7 @@ ;; Is the return-pc on the stack or in a register? (sc-case ret-tn - ((descriptor-stack) + ((control-stack) #+nil (format t "*call-local: ret-tn on stack; offset=~s~%" (tn-offset ret-tn)) ;; Stack @@ -608,7 +608,7 @@ ;; Is the return-pc on the stack or in a register? (sc-case ret-tn - ((descriptor-stack) + ((control-stack) #+nil (format t "*multiple-call-local: ret-tn on stack; offset=~s~%" (tn-offset ret-tn)) ;; Stack @@ -665,7 +665,7 @@ ;; Is the return-pc on the stack or in a register? (sc-case ret-tn - ((descriptor-stack) + ((control-stack) #+nil (format t "*known-call-local: ret-tn on stack; offset=~s~%" (tn-offset ret-tn)) ;; Stack @@ -755,7 +755,7 @@ (sc-case return-pc ((any-reg descriptor-reg) (sc-case old-fp - ((descriptor-stack) + ((control-stack) #+nil (format t "*known-return: old-fp ~s on stack; offset=~s~%" old-fp (tn-offset old-fp)) @@ -765,7 +765,7 @@ (inst lea esp-tn (make-ea :dword :base ebp-tn :disp - (- (* (1+ old-fp-save-offset) word-bytes)))) + (- (* (1+ ocfp-save-offset) word-bytes)))) ;; Restore the old fp from its save location on the stack, ;; and zot the stack. (inst pop ebp-tn)) @@ -784,7 +784,7 @@ ;; Return; return-pc is in a register. (inst jmp return-pc)) - ((descriptor-stack) + ((control-stack) #+nil (format t "*known-return: return-pc ~s on stack; offset=~s~%" return-pc (tn-offset return-pc)) @@ -854,7 +854,7 @@ ,@(unless (eq return :tail) '((new-fp :scs (any-reg) :to (:argument 1)))) - (fun :scs (descriptor-reg descriptor-stack) + (fun :scs (descriptor-reg control-stack) :target eax :to (:argument 0)) ,@(when (eq return :tail) @@ -955,18 +955,18 @@ ;; standard locations then these moves will be ;; un-necessary; this is probably best for the x86. (sc-case old-fp - ((descriptor-stack) - (unless (= old-fp-save-offset (tn-offset old-fp)) + ((control-stack) + (unless (= ocfp-save-offset (tn-offset old-fp)) (format t "** tail-call old-fp not S0~%") (move old-fp-tmp old-fp) - (storew old-fp-tmp ebp-tn (- (1+ old-fp-save-offset))))) + (storew old-fp-tmp ebp-tn (- (1+ ocfp-save-offset))))) ((any-reg descriptor-reg) (format t "** tail-call old-fp in reg not S0~%") - (storew old-fp ebp-tn (- (1+ old-fp-save-offset))))) + (storew old-fp ebp-tn (- (1+ ocfp-save-offset))))) #+x86-lra (sc-case return-pc - ((descriptor-stack) + ((control-stack) (unless (= return-pc-save-offset (tn-offset return-pc)) (format t "** tail-call ret-pc not S1~%") (move ret-pc-tmp return-pc) @@ -997,7 +997,7 @@ '(inst sub esp-tn (fixnum 3))) ;; Save the fp - (storew ebp-tn new-fp (- (1+ old-fp-save-offset))) + (storew ebp-tn new-fp (- (1+ ocfp-save-offset))) ;; Save the return address. #+x86-lra @@ -1079,8 +1079,8 @@ ;;; set things up so that it can find what it needs. ;;; (define-vop (tail-call-variable) - (:args (args :scs (any-reg descriptor-stack) :target esi) - (function :scs (descriptor-reg descriptor-stack) :target eax) + (:args (args :scs (any-reg control-stack) :target esi) + (function :scs (descriptor-reg control-stack) :target eax) (old-fp) (ret-addr)) (:temporary (:sc dword-reg :offset esi-offset :from (:argument 0)) esi) @@ -1093,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 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 descriptor-stack) + (unless (and (sc-is old-fp control-stack) + (= (tn-offset old-fp) ocfp-save-offset)) + (error "tail-call-variable: ocfp not on stack in standard save location?")) + (unless (and (sc-is ret-addr control-stack) (= (tn-offset ret-addr) return-pc-save-offset)) (error "tail-call-variable: ret-addr not on stack in standard save location?")) diff --git a/compiler/x86/char.lisp b/compiler/x86/char.lisp index 64768571be87f4d946c1d6a26264fb88f159fde7..4225739c55385b60461286c09502cfab452b19a8 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.2 1997/11/04 09:11:02 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/char.lisp,v 1.3 1997/11/18 10:53:21 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -30,7 +30,7 @@ ;;; Move a tagged char to an untagged representation. ;;; (define-vop (move-to-base-char) - (:args (x :scs (any-reg descriptor-stack) :target al)) + (:args (x :scs (any-reg control-stack) :target al)) (:temporary (:sc byte-reg :offset al-offset :from (:argument 0) :to (:eval 0)) al) (:ignore al) @@ -43,7 +43,7 @@ (move y ah))) ;;; (define-move-vop move-to-base-char :move - (any-reg descriptor-stack) (base-char-reg base-char-stack)) + (any-reg control-stack) (base-char-reg base-char-stack)) ;;; Move an untagged char to a tagged representation. @@ -54,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 descriptor-stack))) + (:results (y :scs (any-reg descriptor-reg control-stack))) (:note "character tagging") (:generator 1 (move ah x) ; maybe move char byte @@ -64,7 +64,7 @@ ;;; (define-move-vop move-from-base-char :move - (base-char-reg base-char-stack) (any-reg descriptor-reg descriptor-stack)) + (base-char-reg base-char-stack) (any-reg descriptor-reg control-stack)) ;;; Move untagged base-char values. ;;; diff --git a/compiler/x86/debug.lisp b/compiler/x86/debug.lisp index c12c3d922f7fa0f5b3b414f180f5e72da8845cee..60ef8dac7c956617ec15773dd1747cbf0412c0f0 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.2 1997/11/04 09:11:03 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/debug.lisp,v 1.3 1997/11/18 10:53:22 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -143,7 +143,7 @@ (define-vop (get-lisp-obj-address) (:policy :fast-safe) (:translate di::get-lisp-obj-address) - (:args (thing :scs (descriptor-reg descriptor-stack) :target result)) + (:args (thing :scs (descriptor-reg control-stack) :target result)) (:results (result :scs (unsigned-reg) :load-if (not (and (sc-is thing descriptor-reg) (sc-is result unsigned-stack))))) diff --git a/compiler/x86/move.lisp b/compiler/x86/move.lisp index 210b1813a4732e9ffa1be15087ce099a027a14bb..9fc9a6232d58e28721d5d0cac4f2b91772541d87 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.4 1997/11/05 14:59:58 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/move.lisp,v 1.5 1997/11/18 10:53:23 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -53,7 +53,7 @@ (inst mov y x)) (define-move-function (load-stack 5) (vop x y) - ((descriptor-stack) (any-reg descriptor-reg) + ((control-stack) (any-reg descriptor-reg) (base-char-stack) (base-char-reg) (sap-stack) (sap-reg) (signed-stack) (signed-reg) @@ -61,7 +61,7 @@ (inst mov y x)) (define-move-function (store-stack 5) (vop x y) - ((any-reg descriptor-reg) (descriptor-stack) + ((any-reg descriptor-reg) (control-stack) (base-char-reg) (base-char-stack) (sap-reg) (sap-stack) (signed-reg) (signed-stack) @@ -78,12 +78,12 @@ :load-if (not (or (location= x y) (and (sc-is x any-reg descriptor-reg immediate) - (sc-is y descriptor-stack)))))) + (sc-is y control-stack)))))) (:effects) (:affected) (:generator 0 (if (and (sc-is x immediate) - (sc-is y any-reg descriptor-reg descriptor-stack)) + (sc-is y any-reg descriptor-reg control-stack)) (let ((val (tn-value x))) (etypecase val (integer @@ -117,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 descriptor-stack)))) + (sc-is x control-stack)))) (fp :scs (any-reg) :load-if (not (sc-is y any-reg descriptor-reg)))) (:results (y)) @@ -137,7 +137,7 @@ (inst mov y (logior (ash (char-code val) type-bits) base-char-type))))) (move y x))) - ((descriptor-stack) + ((control-stack) (if (sc-is x immediate) (let ((val (tn-value x))) (if (= (tn-offset fp) esp-offset) diff --git a/compiler/x86/nlx.lisp b/compiler/x86/nlx.lisp index a661e0b932476d6bd0f5aa771eee972ab99ea60e..2d8f334e77acb27feee629cc5511f48af309cb04 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.6 1997/11/04 09:11:12 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/nlx.lisp,v 1.7 1997/11/18 10:53:24 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -61,7 +61,7 @@ (load-symbol-value catch lisp::*current-catch-block*) (load-symbol-value eval lisp::*eval-stack-top*) (load-symbol-value alien-stack *alien-stack*) - (loadw oldfp ebp-tn (- (1+ old-fp-save-offset))))) + (loadw oldfp ebp-tn (- (1+ ocfp-save-offset))))) (define-vop (restore-dynamic-state) @@ -73,10 +73,10 @@ (store-symbol-value catch lisp::*current-catch-block*) (store-symbol-value eval lisp::*eval-stack-top*) (store-symbol-value alien-stack *alien-stack*) - (storew oldfp ebp-tn (- (1+ old-fp-save-offset))))) + (storew oldfp ebp-tn (- (1+ ocfp-save-offset))))) (define-vop (current-stack-pointer) - (:results (res :scs (any-reg descriptor-stack))) + (:results (res :scs (any-reg control-stack))) (:generator 1 (move res esp-tn))) @@ -208,7 +208,7 @@ ;; (loadw tn start (- (1+ i))) (inst mov move-temp start) (loadw tn move-temp (- (1+ i)))) - ((descriptor-stack immediate-stack) + ((control-stack immediate-stack) ;; (loadw move-temp start (- (1+ i))) (inst mov move-temp start) (loadw move-temp move-temp (- (1+ i))) @@ -266,7 +266,7 @@ ;; (loadw tn start (- (1+ i))) (move move-temp start) (loadw tn move-temp (- (1+ i)))) - ((descriptor-stack) + ((control-stack) ;; (loadw move-temp start (- (1+ i))) (move move-temp start) (loadw move-temp move-temp (- (1+ i))) @@ -346,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 descriptor-stack))) + (num :scs (any-reg control-stack))) (:save-p :force-to-stack) (:vop-var vop) (:generator 30 @@ -360,7 +360,7 @@ (emit-label label) (note-this-location vop :non-local-entry) - ;; The RISC implementations have old-fp-save wired to a register. + ;; The RISC implementations have ocfp-save wired to a register. ;; ir2tran calls (make-old-fp-save-location) to retrieve that tn ;; as the source address for the thrown results. Doing that here ;; provides the S0 slot as that source which is the wrong end of @@ -368,9 +368,9 @@ ;; that %ebx is the analog of OCFP here and at least in testing so ;; far does actually point (1 above) the values. ;; Actually, now it seems that 'unwind' is supposed to set up - ;; edx and old-fp with certain values so that the compiler can + ;; edx and ocfp with certain values so that the compiler can ;; call these nlx entry points correctly. NOT. - (move esi source) ; old-fp + (move esi source) ; ocfp (inst lea esi (make-ea :dword :base esi :disp (- word-bytes))) ;; The 'top' arg contains the %esp value saved prior to creating ;; the catch block and dynamic save structures and points to where diff --git a/compiler/x86/pred.lisp b/compiler/x86/pred.lisp index 6ad950ca55c14508826caa5eb8c5222df892eb20..910c4c160eff125bef6fede8ae21e91edc20ae76 100644 --- a/compiler/x86/pred.lisp +++ b/compiler/x86/pred.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/pred.lisp,v 1.2 1997/11/04 09:11:14 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/pred.lisp,v 1.3 1997/11/18 10:53:24 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -36,13 +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 descriptor-stack constant) + (:args (x :scs (any-reg descriptor-reg control-stack constant) :load-if (not (and (sc-is x immediate) (sc-is y any-reg descriptor-reg - descriptor-stack constant)))) + control-stack constant)))) (y :scs (any-reg descriptor-reg immediate) :load-if (not (and (sc-is x any-reg descriptor-reg immediate) - (sc-is y descriptor-stack constant))))) + (sc-is y control-stack constant))))) (:conditional) (:info target not-p) (:policy :fast-safe) diff --git a/compiler/x86/subprim.lisp b/compiler/x86/subprim.lisp index 532cd7ed4e3e34aa04ef28859fd7b21d68eab7ec..d042c0f50ae0950515aa18d5947a2e8bb50db4b0 100644 --- a/compiler/x86/subprim.lisp +++ b/compiler/x86/subprim.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/subprim.lisp,v 1.1 1997/01/18 14:31:23 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/subprim.lisp,v 1.2 1997/11/18 10:53:25 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -25,7 +25,7 @@ (define-vop (length/list) (:translate length) - (:args (object :scs (descriptor-reg descriptor-stack) :target ptr)) + (:args (object :scs (descriptor-reg control-stack) :target ptr)) (:arg-types list) (:temporary (:sc dword-reg :offset eax-offset) eax) (:temporary (:sc dword-reg :from (:argument 0)) ptr) @@ -63,7 +63,7 @@ (define-vop (fast-length/list) (:translate length) - (:args (object :scs (descriptor-reg descriptor-stack) :target ptr)) + (:args (object :scs (descriptor-reg control-stack) :target ptr)) (:arg-types list) (:temporary (:sc dword-reg :from (:argument 0)) ptr) (:results (count :scs (any-reg))) diff --git a/compiler/x86/system.lisp b/compiler/x86/system.lisp index 9a1370109c26998551c7d9ea7e4334b542d0df5e..a07be37d1cd2fa87160138640598b38def152c6a 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.5 1997/11/04 09:11:16 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/system.lisp,v 1.6 1997/11/18 10:53:26 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -27,7 +27,7 @@ (define-vop (get-lowtag) (:translate get-lowtag) (:policy :fast-safe) - (:args (object :scs (any-reg descriptor-reg descriptor-stack) + (:args (object :scs (any-reg descriptor-reg control-stack) :target result)) (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) diff --git a/compiler/x86/vm.lisp b/compiler/x86/vm.lisp index 64037b52804984286e3f8e8c65b871263eef26ab..97ae6b6f9e46425923344bcd33e2ee867ab4348f 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.5 1997/11/04 09:11:18 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/vm.lisp,v 1.6 1997/11/18 10:53:27 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -178,7 +178,7 @@ ;; **** The stacks. ;; The control stack. - (descriptor-stack stack) ; may be pointers, scanned by GC + (control-stack stack) ; may be pointers, scanned by GC ;; The non-descriptor stacks. (signed-stack stack) ; (signed-byte 32) @@ -212,7 +212,7 @@ ; :reserve-locations (#.eax-offset) :constant-scs (immediate) :save-p t - :alternate-scs (descriptor-stack)) + :alternate-scs (control-stack)) ;; Pointer descriptor objects. Must be seen by GC. (descriptor-reg registers @@ -222,7 +222,7 @@ :constant-scs (constant immediate) :save-p t - :alternate-scs (descriptor-stack)) + :alternate-scs (control-stack)) ;; Non-Descriptor characters (base-char-reg registers @@ -321,19 +321,13 @@ :reserve-locations ()) ) -;;; zzz added by jrd; has somebody been changing names of these things on me? -(export 'control-stack-sc-number) -(defconstant control-stack-sc-number descriptor-stack-sc-number) - - (eval-when (compile load eval) (defconstant byte-sc-names '(base-char-reg byte-reg base-char-stack)) (defconstant word-sc-names '(word-reg)) (defconstant dword-sc-names '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg dword-reg - descriptor-stack signed-stack unsigned-stack - sap-stack single-stack constant)) + control-stack signed-stack unsigned-stack sap-stack single-stack constant)) ;;; ;;; added by jrd. I guess the right thing to do is to treat floats @@ -384,27 +378,9 @@ ;;; Immediate-Constant-SC ;;; -;;; Basically, if it's easier to represent the value as an immediate in -;;; some instruction instead of in the constants pool, then return -;;; the immediate SC. +;;; If value can be represented as an immediate constant, then return the +;;; appropriate SC number, otherwise return NIL. ;;; -#+nil ;; pw-- the way it was. -(def-vm-support-routine immediate-constant-sc (value) - (if (or (and (symbolp value) (static-symbol-p value)) - #-cross-compiler - (typep value 'fixnum) - #+cross-compiler - (and (typep value 'integer) - (>= value (info variable constant-value 'most-negative-fixnum)) - (<= value (info variable constant-value 'most-positive-fixnum))) - #-cross-compiler - (typep value 'system-area-pointer) - (typep value - #+lispworks3 'lisp::base-character - #-lispworks3 'base-char)) - (sc-number-or-lose 'immediate *backend*) - nil)) - (def-vm-support-routine immediate-constant-sc (value) (typecase value ((or fixnum system-area-pointer character) @@ -424,17 +400,16 @@ ;;;; Function Call Parameters ;;; Offsets of special stack frame locations -(defconstant old-fp-save-offset 0) +(defconstant ocfp-save-offset 0) (defconstant return-pc-save-offset 1) (defconstant code-save-offset 2) - ;;; names of these things seem to have changed. these aliases by jrd -(defconstant ocfp-save-offset old-fp-save-offset) (defconstant lra-save-offset return-pc-save-offset) (defconstant cfp-offset ebp-offset) ; pfw - needed by stuff in /code ; related to sigcontext stuff + ;;; The number of arguments/return values passed in registers. ;;; (defconstant register-arg-count 3)