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