From d38bd46168c79dc5cce034f44b86f62dca32f704 Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Sat, 8 Feb 1997 22:09:34 +0000 Subject: [PATCH] Some style cleanups. Change the offset used by the sap VOPS from an unsigned-num to a signed-num. This helps fixes some SAP functions for negative offsets which are useful on the x86 with its stack growing down. The offset is currently declared to be a index (unsigned-byte 29) in compiler/saptran.lisp so this should work without change, but to use the negative offsets requires complementary changes to saptran (index -> fixnum). --- compiler/x86/sap.lisp | 175 +++++++++++++++++++++--------------------- 1 file changed, 86 insertions(+), 89 deletions(-) diff --git a/compiler/x86/sap.lisp b/compiler/x86/sap.lisp index 1bb0ca4ff..282b09bcb 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.1 1997/01/18 14:31:23 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/sap.lisp,v 1.2 1997/02/08 22:09:34 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. ;;; (in-package :x86) @@ -179,8 +180,8 @@ (:translate ,ref-name) (:policy :fast-safe) (:args (sap :scs (sap-reg)) - (offset :scs (unsigned-reg))) - (:arg-types system-area-pointer unsigned-num) + (offset :scs (signed-reg))) + (:arg-types system-area-pointer signed-num) ,@(unless (eq size :dword) `((:temporary (:sc ,temp-sc :from (:eval 0) :to (:eval 1)) temp))) @@ -213,10 +214,10 @@ (:translate ,set-name) (:policy :fast-safe) (:args (sap :scs (sap-reg) :to (:eval 0)) - (offset :scs (unsigned-reg) :to (:eval 0)) + (offset :scs (signed-reg) :to (:eval 0)) (value :scs (,sc) :target ,(if (eq size :dword) 'result 'temp))) - (:arg-types system-area-pointer unsigned-num ,type) + (:arg-types system-area-pointer signed-num ,type) ,@(unless (eq size :dword) `((:temporary (:sc ,temp-sc :offset eax-offset :from (:argument 2) :to (:result 0) @@ -275,8 +276,8 @@ (:translate sap-ref-double) (:policy :fast-safe) (:args (sap :scs (sap-reg)) - (offset :scs (unsigned-reg))) - (:arg-types system-area-pointer unsigned-num) + (offset :scs (signed-reg))) + (:arg-types system-area-pointer signed-num) (:results (result :scs (double-reg))) (:result-types double-float) (:generator 5 @@ -299,31 +300,30 @@ (:translate %set-sap-ref-double) (:policy :fast-safe) (:args (sap :scs (sap-reg) :to (:eval 0)) - (offset :scs (unsigned-reg) :to (:eval 0)) + (offset :scs (signed-reg) :to (:eval 0)) (value :scs (double-reg))) - (:arg-types system-area-pointer unsigned-num double-float) + (:arg-types system-area-pointer signed-num double-float) (:results (result :scs (double-reg))) (:result-types double-float) (:generator 5 - (if (zerop (tn-offset value)) - (progn - ;; Value is in ST0 - (inst fstd (make-ea :dword :base sap :index offset)) - (unless (zerop (tn-offset result)) - ;; Value is in ST0 but not result. - (inst fstd result))) - (progn - ;; Value is not in ST0. - (inst fxch value) - (inst fstd (make-ea :dword :base sap :index offset)) - (if (zerop (tn-offset result)) - ;; The result is in ST0. - (inst fstd value) - (progn - ;; Neither value or result are in ST0 - (unless (location= value result) - (inst fstd result)) - (inst fxch value))))))) + (cond ((zerop (tn-offset value)) + ;; Value is in ST0 + (inst fstd (make-ea :dword :base sap :index offset)) + (unless (zerop (tn-offset result)) + ;; Value is in ST0 but not result. + (inst fstd result))) + (t + ;; Value is not in ST0. + (inst fxch value) + (inst fstd (make-ea :dword :base sap :index offset)) + (cond ((zerop (tn-offset result)) + ;; The result is in ST0. + (inst fstd value)) + (t + ;; Neither value or result are in ST0 + (unless (location= value result) + (inst fstd result)) + (inst fxch value))))))) (define-vop (%set-sap-ref-double-c) (:translate %set-sap-ref-double) @@ -335,25 +335,24 @@ (:results (result :scs (double-reg))) (:result-types double-float) (:generator 4 - (if (zerop (tn-offset value)) - (progn - ;; Value is in ST0 - (inst fstd (make-ea :dword :base sap :disp offset)) - (unless (zerop (tn-offset result)) - ;; Value is in ST0 but not result. - (inst fstd result))) - (progn - ;; Value is not in ST0. - (inst fxch value) - (inst fstd (make-ea :dword :base sap :disp offset)) - (if (zerop (tn-offset result)) - ;; The result is in ST0. - (inst fstd value) - (progn - ;; Neither value or result are in ST0 - (unless (location= value result) - (inst fstd result)) - (inst fxch value))))))) + (cond ((zerop (tn-offset value)) + ;; Value is in ST0 + (inst fstd (make-ea :dword :base sap :disp offset)) + (unless (zerop (tn-offset result)) + ;; Value is in ST0 but not result. + (inst fstd result))) + (t + ;; Value is not in ST0. + (inst fxch value) + (inst fstd (make-ea :dword :base sap :disp offset)) + (cond ((zerop (tn-offset result)) + ;; The result is in ST0. + (inst fstd value)) + (t + ;; Neither value or result are in ST0 + (unless (location= value result) + (inst fstd result)) + (inst fxch value))))))) ;;; Sap-Ref-Single @@ -361,8 +360,8 @@ (:translate sap-ref-single) (:policy :fast-safe) (:args (sap :scs (sap-reg)) - (offset :scs (unsigned-reg))) - (:arg-types system-area-pointer unsigned-num) + (offset :scs (signed-reg))) + (:arg-types system-area-pointer signed-num) (:results (result :scs (single-reg))) (:result-types single-float) (:generator 5 @@ -385,31 +384,30 @@ (:translate %set-sap-ref-single) (:policy :fast-safe) (:args (sap :scs (sap-reg) :to (:eval 0)) - (offset :scs (unsigned-reg) :to (:eval 0)) + (offset :scs (signed-reg) :to (:eval 0)) (value :scs (single-reg))) - (:arg-types system-area-pointer unsigned-num single-float) + (:arg-types system-area-pointer signed-num single-float) (:results (result :scs (single-reg))) (:result-types single-float) (:generator 5 - (if (zerop (tn-offset value)) - (progn - ;; Value is in ST0 - (inst fst (make-ea :dword :base sap :index offset)) - (unless (zerop (tn-offset result)) - ;; Value is in ST0 but not result. - (inst fst result))) - (progn - ;; Value is not in ST0. - (inst fxch value) - (inst fst (make-ea :dword :base sap :index offset)) - (if (zerop (tn-offset result)) - ;; The result is in ST0. - (inst fst value) - (progn - ;; Neither value or result are in ST0 - (unless (location= value result) - (inst fst result)) - (inst fxch value))))))) + (cond ((zerop (tn-offset value)) + ;; Value is in ST0 + (inst fst (make-ea :dword :base sap :index offset)) + (unless (zerop (tn-offset result)) + ;; Value is in ST0 but not result. + (inst fst result))) + (t + ;; Value is not in ST0. + (inst fxch value) + (inst fst (make-ea :dword :base sap :index offset)) + (cond ((zerop (tn-offset result)) + ;; The result is in ST0. + (inst fst value)) + (t + ;; Neither value or result are in ST0 + (unless (location= value result) + (inst fst result)) + (inst fxch value))))))) (define-vop (%set-sap-ref-single-c) (:translate %set-sap-ref-single) @@ -421,25 +419,24 @@ (:results (result :scs (single-reg))) (:result-types single-float) (:generator 4 - (if (zerop (tn-offset value)) - (progn - ;; Value is in ST0 - (inst fst (make-ea :dword :base sap :disp offset)) - (unless (zerop (tn-offset result)) - ;; Value is in ST0 but not result. - (inst fst result))) - (progn - ;; Value is not in ST0. - (inst fxch value) - (inst fst (make-ea :dword :base sap :disp offset)) - (if (zerop (tn-offset result)) - ;; The result is in ST0. - (inst fst value) - (progn - ;; Neither value or result are in ST0 - (unless (location= value result) - (inst fst result)) - (inst fxch value))))))) + (cond ((zerop (tn-offset value)) + ;; Value is in ST0 + (inst fst (make-ea :dword :base sap :disp offset)) + (unless (zerop (tn-offset result)) + ;; Value is in ST0 but not result. + (inst fst result))) + (t + ;; Value is not in ST0. + (inst fxch value) + (inst fst (make-ea :dword :base sap :disp offset)) + (cond ((zerop (tn-offset result)) + ;; The result is in ST0. + (inst fst value)) + (t + ;; Neither value or result are in ST0 + (unless (location= value result) + (inst fst result)) + (inst fxch value))))))) ;;; Noise to convert normal lisp data objects into SAPs. -- GitLab