From 4bbf1ca4e51c58e01e674c11f6321c3529d1e174 Mon Sep 17 00:00:00 2001 From: hallgren <hallgren> Date: Wed, 29 Jun 1994 21:54:46 +0000 Subject: [PATCH] Updated for the sgi. --- code/signal.lisp | 42 ++++++++++------- compiler/generic/new-genesis.lisp | 19 ++++++-- compiler/generic/vm-macs.lisp | 8 ++-- compiler/mips/array.lisp | 50 ++++++++++++++------ compiler/mips/float.lisp | 78 ++++++++++++++++++++++++------- compiler/mips/parms.lisp | 15 ++++-- compiler/mips/sap.lisp | 50 ++++++++++++++------ 7 files changed, 188 insertions(+), 74 deletions(-) diff --git a/code/signal.lisp b/code/signal.lisp index 59f8fdf40..8fbfdc44e 100644 --- a/code/signal.lisp +++ b/code/signal.lisp @@ -7,11 +7,11 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/signal.lisp,v 1.21 1993/08/27 14:58:35 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/signal.lisp,v 1.22 1994/06/29 21:50:05 hallgren Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/signal.lisp,v 1.21 1993/08/27 14:58:35 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/signal.lisp,v 1.22 1994/06/29 21:50:05 hallgren Exp $ ;;; ;;; Code for handling UNIX signals. ;;; @@ -109,27 +109,35 @@ (def-unix-signal :SIGPIPE 13 "Write on a pipe with no one to read it") (def-unix-signal :SIGALRM 14 "Alarm clock") (def-unix-signal :SIGTERM 15 "Software termination signal") -(def-unix-signal :SIGURG #-hpux 16 #+hpux 29 +(def-unix-signal :SIGURG #-(or hpux irix) 16 #+hpux 29 #+irix 21 "Urgent condition present on socket") -(def-unix-signal :SIGSTOP #-hpux 17 #+hpux 24 "Stop") -(def-unix-signal :SIGTSTP #-hpux 18 #+hpux 25 +(def-unix-signal :SIGSTOP #-(or hpux irix) 17 #+hpux 24 #+irix 23 "Stop") +(def-unix-signal :SIGTSTP #-(or hpux irix) 18 #+hpux 25 #+irix 24 "Stop signal generated from keyboard") -(def-unix-signal :SIGCONT #-hpux 19 #+hpux 26 "Continue after stop") -(def-unix-signal :SIGCHLD #-hpux 20 #+hpux 18 "Child status has changed") -(def-unix-signal :SIGTTIN #-hpux 21 #+hpux 27 +(def-unix-signal :SIGCONT #-(or hpux irix) 19 #+hpux 26 #+irix 25 + "Continue after stop") +(def-unix-signal :SIGCHLD #-(or hpux irix) 20 #+(or hpux irix) 18 + "Child status has changed") +(def-unix-signal :SIGTTIN #-(or hpux irix) 21 #+hpux 27 #+irix 26 "Background read attempted from control terminal") -(def-unix-signal :SIGTTOU #-hpux 22 #+hpux 28 +(def-unix-signal :SIGTTOU #-(or hpux irix) 22 #+hpux 28 #+irix 27 "Background write attempted to control terminal") -(def-unix-signal :SIGIO #-hpux 23 #+hpux 22 "I/O is possible on a descriptor") +(def-unix-signal :SIGIO #-(or hpux irix) 23 #+(or hpux irix) 22 + "I/O is possible on a descriptor") #-hpux -(def-unix-signal :SIGXCPU 24 "Cpu time limit exceeded") +(def-unix-signal :SIGXCPU #-irix 24 #+irix 30 "Cpu time limit exceeded") #-hpux -(def-unix-signal :SIGXFSZ 25 "File size limit exceeded") -(def-unix-signal :SIGVTALRM #-hpux 26 #+hpux 20 "Virtual time alarm") -(def-unix-signal :SIGPROF #-hpux 27 #+hpux 21 "Profiling timer alarm") -(def-unix-signal :SIGWINCH #-hpux 28 #+hpux 23 "Window size change") -(def-unix-signal :SIGUSR1 #-hpux 30 #+hpux 16 "User defined signal 1") -(def-unix-signal :SIGUSR2 #-hpux 31 #+hpux 17 "User defined signal 2") +(def-unix-signal :SIGXFSZ #-irix 25 #+irix 31 "File size limit exceeded") +(def-unix-signal :SIGVTALRM #-(or hpux irix) 26 #+hpux 20 #+irix 28 + "Virtual time alarm") +(def-unix-signal :SIGPROF #-(or hpux irix) 27 #+hpux 21 #+irix 29 + "Profiling timer alarm") +(def-unix-signal :SIGWINCH #-(or hpux irix) 28 #+hpux 23 #+irix 20 + "Window size change") +(def-unix-signal :SIGUSR1 #-(or hpux irix) 30 #+(or hpux irix) 16 + "User defined signal 1") +(def-unix-signal :SIGUSR2 #-(or hpux irix) 31 #+(or hpux irix) 17 + "User defined signal 2") ;;; ;;; These are Mach Specific #+mach diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp index 0b67be440..5dfa1eda4 100644 --- a/compiler/generic/new-genesis.lisp +++ b/compiler/generic/new-genesis.lisp @@ -6,7 +6,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.13 1994/05/22 18:05:49 hallgren Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.14 1994/06/29 21:53:00 hallgren Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1672,7 +1672,7 @@ (defun do-cold-fixup (code-object offset value kind) (let ((sap (sap+ (descriptor-sap code-object) offset))) (ecase (c:backend-fasl-file-implementation c:*backend*) - ((#.c:pmax-fasl-file-implementation #.c:sgi-fasl-file-implementation) + (#.c:pmax-fasl-file-implementation (ecase kind (:jump (assert (zerop (ash value -28))) @@ -1790,7 +1790,20 @@ (setf (sap-ref-8 sap 1) (ldb (byte 8 24) value)))) (:lda (setf (sap-ref-8 sap 0) (ldb (byte 8 0) value)) - (setf (sap-ref-8 sap 1) (ldb (byte 8 8) value))))))) + (setf (sap-ref-8 sap 1) (ldb (byte 8 8) value))))) + (#.c:sgi-fasl-file-implementation + (ecase kind + (:jump + (assert (zerop (ash value -28))) + (setf (ldb (byte 26 0) (sap-ref-32 sap 0)) + (ash value -2))) + (:lui + (setf (sap-ref-16 sap 2) + (+ (ash value -16) + (if (logbitp 15 value) 1 0)))) + (:addi + (setf (sap-ref-16 sap 2) + (ldb (byte 16 0) value))))))) (undefined-value)) (defun linkage-info-to-core () diff --git a/compiler/generic/vm-macs.lisp b/compiler/generic/vm-macs.lisp index bf441d2aa..ddef8db27 100644 --- a/compiler/generic/vm-macs.lisp +++ b/compiler/generic/vm-macs.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/generic/vm-macs.lisp,v 1.13 1994/04/06 17:09:11 hallgren Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-macs.lisp,v 1.14 1994/06/29 21:53:34 hallgren Exp $") ;;; ;;; ********************************************************************** ;;; @@ -239,13 +239,14 @@ hppa-fasl-file-implementation big-endian-fasl-file-implementation little-endian-fasl-file-implementation - alpha-fasl-file-implementation)) + alpha-fasl-file-implementation + sgi-fasl-file-implementation)) ;;; Constants for the different implementations. These are all defined in ;;; one place to make sure they are all unique. (defparameter fasl-file-implementations - '(nil "Pmax" "Sparc" "RT" "RT/AFPA" "x86" "HPPA" "Alpha" + '(nil "Pmax" "Sparc" "RT" "RT/AFPA" "x86" "HPPA" "Alpha" "SGI" "Big-endian byte-code" "Little-endian byte-code")) (defconstant pmax-fasl-file-implementation 1) (defconstant sparc-fasl-file-implementation 2) @@ -256,6 +257,7 @@ (defconstant big-endian-fasl-file-implementation 7) (defconstant little-endian-fasl-file-implementation 8) (defconstant alpha-fasl-file-implementation 9) +(defconstant sgi-fasl-file-implementation 10) ;;; The maximum number of SCs in any implementation. (defconstant sc-number-limit 32) diff --git a/compiler/mips/array.lisp b/compiler/mips/array.lisp index 9fadbae4c..f6e4a0d2a 100644 --- a/compiler/mips/array.lisp +++ b/compiler/mips/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/mips/array.lisp,v 1.44 1993/08/25 23:26:50 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/array.lisp,v 1.45 1994/06/29 21:54:17 hallgren Exp $") ;;; ;;; ********************************************************************** ;;; @@ -396,13 +396,23 @@ (:generator 20 (inst addu lip object index) (inst addu lip index) - (inst lwc1 value lip - (- (* vector-data-offset word-bytes) - other-pointer-type)) - (inst lwc1-odd value lip - (+ (- (* vector-data-offset word-bytes) - other-pointer-type) - word-bytes)) + (ecase (backend-byte-order *backend*) + (:big-endian + (inst lwc1 value lip + (+ (- (* vector-data-offset word-bytes) + other-pointer-type) + word-bytes)) + (inst lwc1-odd value lip + (- (* vector-data-offset word-bytes) + other-pointer-type))) + (:little-endian + (inst lwc1 value lip + (- (* vector-data-offset word-bytes) + other-pointer-type)) + (inst lwc1-odd value lip + (+ (- (* vector-data-offset word-bytes) + other-pointer-type) + word-bytes)))) (inst nop))) (define-vop (data-vector-set/simple-array-double-float) @@ -419,13 +429,23 @@ (:generator 20 (inst addu lip object index) (inst addu lip index) - (inst swc1 value lip - (- (* vector-data-offset word-bytes) - other-pointer-type)) - (inst swc1-odd value lip - (+ (- (* vector-data-offset word-bytes) - other-pointer-type) - word-bytes)) + (ecase (backend-byte-order *backend*) + (:big-endian + (inst swc1 value lip + (+ (- (* vector-data-offset word-bytes) + other-pointer-type) + word-bytes)) + (inst swc1-odd value lip + (- (* vector-data-offset word-bytes) + other-pointer-type))) + (:little-endian + (inst swc1 value lip + (- (* vector-data-offset word-bytes) + other-pointer-type)) + (inst swc1-odd value lip + (+ (- (* vector-data-offset word-bytes) + other-pointer-type) + word-bytes)))) (unless (location= result value) (inst fmove :double result value)))) diff --git a/compiler/mips/float.lisp b/compiler/mips/float.lisp index efe23a244..e7ba457e5 100644 --- a/compiler/mips/float.lisp +++ b/compiler/mips/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/mips/float.lisp,v 1.18 1993/05/25 21:27:54 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/float.lisp,v 1.19 1994/06/29 21:54:31 hallgren Exp $") ;;; ;;; ********************************************************************** ;;; @@ -34,16 +34,26 @@ ((double-stack) (double-reg)) (let ((nfp (current-nfp-tn vop)) (offset (* (tn-offset x) word-bytes))) - (inst lwc1 y nfp offset) - (inst lwc1-odd y nfp (+ offset word-bytes))) + (ecase (backend-byte-order *backend*) + (:big-endian + (inst lwc1 y nfp (+ offset word-bytes)) + (inst lwc1-odd y nfp offset)) + (:little-endian + (inst lwc1 y nfp offset) + (inst lwc1-odd y nfp (+ offset word-bytes))))) (inst nop)) (define-move-function (store-double 2) (vop x y) ((double-reg) (double-stack)) (let ((nfp (current-nfp-tn vop)) (offset (* (tn-offset y) word-bytes))) - (inst swc1 x nfp offset) - (inst swc1-odd x nfp (+ offset word-bytes)))) + (ecase (backend-byte-order *backend*) + (:big-endian + (inst swc1 x nfp (+ offset word-bytes)) + (inst swc1-odd x nfp offset)) + (:little-endian + (inst swc1 x nfp offset) + (inst swc1-odd x nfp (+ offset word-bytes)))))) @@ -75,10 +85,19 @@ (:note "float to pointer coercion") (:generator 13 (with-fixed-allocation (y pa-flag ndescr type size) - (inst swc1 x y (- (* data word-bytes) other-pointer-type)) - (when double-p - (inst swc1-odd x y (- (* (1+ data) word-bytes) - other-pointer-type)))))) + (ecase (backend-byte-order *backend*) + (:big-endian + (cond + (double-p + (inst swc1 x y (- (* (1+ data) word-bytes) other-pointer-type)) + (inst swc1-odd x y (- (* data word-bytes) other-pointer-type))) + (t + (inst swc1 x y (- (* data word-bytes) other-pointer-type))))) + (:little-endian + (inst swc1 x y (- (* data word-bytes) other-pointer-type)) + (when double-p + (inst swc1-odd x y (- (* (1+ data) word-bytes) + other-pointer-type)))))))) (macrolet ((frob (name sc &rest args) `(progn @@ -92,6 +111,7 @@ (frob move-from-double double-reg t double-float-size double-float-type double-float-value-slot)) + (macrolet ((frob (name sc double-p value) `(progn (define-vop (,name) @@ -99,11 +119,24 @@ (:results (y :scs (,sc))) (:note "pointer to float coercion") (:generator 2 - (inst lwc1 y x (- (* ,value word-bytes) - other-pointer-type)) - ,@(when double-p - `((inst lwc1-odd y x (- (* (1+ ,value) word-bytes) - other-pointer-type)))) + ,@(ecase (backend-byte-order *backend*) + (:big-endian + (cond + (double-p + `((inst lwc1 y x (- (* (1+ ,value) word-bytes) + other-pointer-type)) + (inst lwc1-odd y x (- (* ,value word-bytes) + other-pointer-type)))) + (t + `((inst lwc1 y x (- (* ,value word-bytes) + other-pointer-type)))))) + (:little-endian + `((inst lwc1 y x (- (* ,value word-bytes) + other-pointer-type)) + ,@(when double-p + `((inst lwc1-odd y x + (- (* (1+ ,value) word-bytes) + other-pointer-type))))))) (inst nop))) (define-move-vop ,name :move (descriptor-reg) (,sc))))) (frob move-to-single single-reg nil single-float-value-slot) @@ -125,10 +158,19 @@ (inst fmove ,format y x))) (,stack-sc (let ((offset (* (tn-offset y) word-bytes))) - (inst swc1 x nfp offset) - ,@(when double-p - '((inst swc1-odd x nfp - (+ offset word-bytes))))))))) + ,@(ecase (backend-byte-order *backend*) + (:big-endian + (cond + (double-p + '((inst swc1 x nfp (+ offset word-bytes)) + (inst swc1-odd x nfp offset))) + (t + '((inst swc1 x nfp offset))))) + (:little-endian + `((inst swc1 x nfp offset) + ,@(when double-p + '((inst swc1-odd x nfp + (+ offset word-bytes)))))))))))) (define-move-vop ,name :move-argument (,sc descriptor-reg) (,sc))))) (frob move-single-float-argument single-reg single-stack :single nil) diff --git a/compiler/mips/parms.lisp b/compiler/mips/parms.lisp index e471d3f57..b7cfd1209 100644 --- a/compiler/mips/parms.lisp +++ b/compiler/mips/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/mips/parms.lisp,v 1.109 1993/05/20 11:46:31 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/parms.lisp,v 1.110 1994/06/29 21:54:39 hallgren Exp $") ;;; ;;; ********************************************************************** ;;; @@ -28,16 +28,21 @@ (eval-when (compile eval load) -(setf (backend-name *target-backend*) "PMAX") +(setf (backend-name *target-backend*) #+pmax "PMAX" #+sgi "SGI") +#+pmax (setf (backend-version *target-backend*) #-gengc "DECstation 3100/Mach 1.0" #+gengc "DECstation 3100/Mach 1.0 (gengc)") -(setf (backend-fasl-file-type *target-backend*) "pmaxf") +#+sgi +(setf (backend-version *target-backend*) "SGI") + +(setf (backend-fasl-file-type *target-backend*) #+pmax "pmaxf" #+sgi "sgif") (setf (backend-fasl-file-implementation *target-backend*) - pmax-fasl-file-implementation) + #+pmax pmax-fasl-file-implementation #+sgi sgi-fasl-file-implementation) (setf (backend-fasl-file-version *target-backend*) #-gengc 6 #+gengc 7) (setf (backend-register-save-penalty *target-backend*) 3) -(setf (backend-byte-order *target-backend*) :little-endian) +(setf (backend-byte-order *target-backend*) #+pmax :little-endian + #+sgi :big-endian) (setf (backend-page-size *target-backend*) 4096) ); eval-when diff --git a/compiler/mips/sap.lisp b/compiler/mips/sap.lisp index efbf2b6f5..ed3b64b91 100644 --- a/compiler/mips/sap.lisp +++ b/compiler/mips/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/mips/sap.lisp,v 1.27 1993/01/13 15:58:41 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/sap.lisp,v 1.28 1994/06/29 21:54:46 hallgren Exp $") ;;; ;;; ********************************************************************** ;;; @@ -184,8 +184,13 @@ (:single '((inst lwc1 result sap 0))) (:double - '((inst lwc1 result sap 0) - (inst lwc1-odd result sap word-bytes)))) + (ecase (backend-byte-order *backend*) + (:big-endian + '((inst lwc1 result sap word-bytes) + (inst lwc1-odd result sap 0))) + (:little-endian + '((inst lwc1 result sap 0) + (inst lwc1-odd result sap word-bytes)))))) (inst nop))) (define-vop (,ref-name-c) (:translate ,ref-name) @@ -215,8 +220,13 @@ (:single '((inst lwc1 result object offset))) (:double - '((inst lwc1 result object offset) - (inst lwc1-odd result object (+ offset word-bytes))))) + (ecase (backend-byte-order *backend*) + (:big-endian + '((inst lwc1 result object (+ offset word-bytes)) + (inst lwc1-odd result object offset))) + (:little-endian + '((inst lwc1 result object offset) + (inst lwc1-odd result object (+ offset word-bytes))))))) (inst nop))) (define-vop (,set-name) (:translate ,set-name) @@ -245,10 +255,17 @@ (unless (location= result value) (inst fmove :single result value)))) (:double - '((inst swc1 value sap 0) - (inst swc1-odd value sap word-bytes) - (unless (location= result value) - (inst fmove :double result value))))))) + (ecase (backend-byte-order *backend*) + (:big-endian + '((inst swc1 value sap word-bytes) + (inst swc1-odd value sap 0) + (unless (location= result value) + (inst fmove :double result value)))) + (:little-endian + '((inst swc1 value sap 0) + (inst swc1-odd value sap word-bytes) + (unless (location= result value) + (inst fmove :double result value))))))))) (define-vop (,set-name-c) (:translate ,set-name) (:policy :fast-safe) @@ -280,10 +297,17 @@ (unless (location= result value) (inst fmove :single result value)))) (:double - '((inst swc1 value object offset) - (inst swc1-odd value object (+ offset word-bytes)) - (unless (location= result value) - (inst fmove :double result value)))))))))) + (ecase (backend-byte-order *backend*) + (:big-endian + '((inst swc1 value object (+ offset word-bytes)) + (inst swc1-odd value object (+ offset word-bytes)) + (unless (location= result value) + (inst fmove :double result value)))) + (:little-endian + '((inst swc1 value object offset) + (inst swc1-odd value object (+ offset word-bytes)) + (unless (location= result value) + (inst fmove :double result value)))))))))))) ); eval-when (compile eval) -- GitLab