From 7af795a216245c4421ceb2be001bf81a0529d822 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren>
Date: Wed, 6 Apr 1994 17:03:51 +0000
Subject: [PATCH] Added Alpha support.

---
 code/bit-bash.lisp  |  5 +++--
 code/debug-int.lisp | 39 ++++++++++++++++++++++++++++++++++-----
 code/exports.lisp   | 11 ++++++++---
 code/internet.lisp  | 12 ++++++------
 4 files changed, 51 insertions(+), 16 deletions(-)

diff --git a/code/bit-bash.lisp b/code/bit-bash.lisp
index 868d37d42..db8fd9a48 100644
--- a/code/bit-bash.lisp
+++ b/code/bit-bash.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bit-bash.lisp,v 1.16 1992/07/31 17:50:18 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bit-bash.lisp,v 1.17 1994/04/06 17:00:16 hallgren Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -126,7 +126,8 @@
 	   (type index offset)
 	   (values system-area-pointer index))
   (let ((address (sap-int sap)))
-    (values (int-sap (32bit-logical-andc2 address 3))
+    (values (int-sap #-alpha (32bit-logical-andc2 address 3)
+		     #+alpha (ash (ash address -2) 2))
 	    (+ (* (logand address 3) byte-bits) offset))))
 
 (declaim (inline word-sap-ref %set-word-sap-ref))
diff --git a/code/debug-int.lisp b/code/debug-int.lisp
index db9216582..e53473eb9 100644
--- a/code/debug-int.lisp
+++ b/code/debug-int.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.64 1993/11/08 00:22:25 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.65 1994/04/06 17:02:40 hallgren Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -920,8 +920,14 @@
 		   (let ((fp (frame-pointer real)))
 		     (when (cstack-pointer-valid-p fp)
 		       (compute-calling-frame
+			#-alpha
 			(system:sap-ref-sap fp (* vm::ocfp-save-offset
 						  vm:word-bytes))
+			#+alpha
+			(kernel::int-sap
+			 (system:sap-ref-32 fp (* vm::ocfp-save-offset
+						  vm:word-bytes)))
+
 			#-gengc
 			(kernel:stack-ref fp vm::lra-save-offset)
 			#+gengc
@@ -1421,9 +1427,15 @@
     (loop
       (when (zerop (sap-int catch)) (return (nreverse res)))
       (when (sap= fp
+		  #-alpha
 		  (system:sap-ref-sap catch
 				      (* vm:catch-block-current-cont-slot
-					 vm:word-bytes)))
+					 vm:word-bytes))
+		  #+alpha
+		  (kernel::int-sap
+		   (system:sap-ref-32 catch
+				      (* vm:catch-block-current-cont-slot
+					 vm:word-bytes))))
 	(let* (#-gengc
 	       (lra (kernel:stack-ref catch vm:catch-block-entry-pc-slot))
 	       #+gengc
@@ -1445,9 +1457,15 @@
 		       offset (frame-debug-function frame)))
 		res)))
       (setf catch
+	    #-alpha
 	    (system:sap-ref-sap catch
 				(* vm:catch-block-previous-catch-slot
-				   vm:word-bytes))))))
+				   vm:word-bytes))
+	    #+alpha
+	    (kernel::int-sap
+	     (system:sap-ref-32 catch
+				(* vm:catch-block-previous-catch-slot
+				   vm:word-bytes)))))))
 
 ;;; FRAME-REAL-FRAME -- Internal.
 ;;;
@@ -2712,8 +2730,13 @@
 				(system:int-sap
 				 (vm:sigcontext-register escaped
 							 vm::nfp-offset))
+				#-alpha
 				(system:sap-ref-sap fp (* vm::nfp-save-offset
-							  vm:word-bytes)))))
+							  vm:word-bytes))
+				#+alpha
+				(alpha::make-number-stack-pointer
+				 (system:sap-ref-32 fp (* vm::nfp-save-offset
+							  vm:word-bytes))))))
 		  ,@body)))
     (ecase (c::sc-offset-scn sc-offset)
       ((#.vm:any-reg-sc-number
@@ -2842,9 +2865,15 @@
 				(system:int-sap
 				 (vm:sigcontext-register escaped
 							 vm::nfp-offset))
+				#-alpha
 				(system:sap-ref-sap fp
 						    (* vm::nfp-save-offset
-						       vm:word-bytes)))))
+						       vm:word-bytes))
+				#+alpha
+				(alpha::make-number-stack-pointer
+				 (system:sap-ref-32 fp
+						    (* vm::nfp-save-offset
+						       vm:word-bytes))))))
 		  ,@body)))
     (ecase (c::sc-offset-scn sc-offset)
       ((#.vm:any-reg-sc-number
diff --git a/code/exports.lisp b/code/exports.lisp
index b2c96b39b..98469861d 100644
--- a/code/exports.lisp
+++ b/code/exports.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.98 1993/11/06 04:32:34 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.99 1994/04/06 17:03:07 hallgren Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -59,6 +59,10 @@
 (if (find-package "HPPA")
     (rename-package "HPPA" "HPPA" '("VM" "OLD-HPPA"))
     (make-package "HPPA" :nicknames '("VM" "OLD-HPPA") :use nil))
+#+alpha
+(if (find-package "ALPHA")
+    (rename-package "ALPHA" "ALPHA" '("VM" "OLD-ALPHA"))
+    (make-package "ALPHA" :nicknames '("VM" "OLD-ALPHA") :use nil))
 (if (find-package "CONDITIONS")
     (rename-package "CONDITIONS" "CONDITIONS" 'nil)
     (make-package "CONDITIONS" :nicknames 'nil :use nil))
@@ -556,10 +560,10 @@
        "DOUBLE-FLOAT-P" "SIMPLE-ARRAY-P" "SINGLE-FLOAT-P"))
   (intern name "KERNEL"))
 (defpackage #+pmax "MIPS" #+sparc "SPARC" #+ibmrt "RT"
-            #+x86 "X86" #+hppa "HPPA"
+            #+x86 "X86" #+hppa "HPPA" #+alpha "ALPHA"
             (:nicknames "VM"
 			#+pmax "OLD-MIPS" #+sparc "OLD-SPARC" #+ibmrt "OLD-RT"
-			#+x86 "OLD-X86" #+hppa "HPPA")
+			#+x86 "OLD-X86" #+hppa "HPPA" #+alpha "OLD-ALPHA")
             (:import-from "LISP" "%ARRAY-TYPEP" "%ASET" "%BITSET" "%CHARSET"
              "%PUT" "%RPLACA" "%RPLACD" "%SBITSET" "%SCHARSET"
              "%SET-DOCUMENTATION" "%SET-FDEFINITION" "%SET-FILL-POINTER"
@@ -1078,6 +1082,7 @@
 	   "DEF-SETTER"
 	   "FIXED-ALLOC"
 	   "HPPA-FASL-FILE-IMPLEMENTATION"
+	   "ALPHA-FASL-FILE-IMPLEMENTATION"
 	   "MAKE-UNBOUND-MARKER"
 	   "RETURN-SINGLE"
 	   "BACKEND-PAGE-SIZE"
diff --git a/code/internet.lisp b/code/internet.lisp
index 968716bc8..91c6df755 100644
--- a/code/internet.lisp
+++ b/code/internet.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/internet.lisp,v 1.13 1993/12/09 12:56:58 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/internet.lisp,v 1.14 1994/04/06 17:03:51 hallgren Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -91,14 +91,14 @@
 
 (def-alien-type unix-sockaddr
   (struct nil
-    (family short)
+    (family #-alpha short #+alpha unsigned-short)
     (path (array char 108))))
 
 (def-alien-type inet-sockaddr
   (struct nil
-    (family short)
+    (family #-alpha short #+alpha unsigned-short)
     (port unsigned-short)
-    (addr unsigned-long)
+    (addr #-alpha unsigned-long #+alpha unsigned-int)
     (zero (array char 8))))
 
 (def-alien-type hostent
@@ -135,7 +135,7 @@
 	     (iterate repeat ((index 0))
 	       (declare (type kernel:index index))
 	       (cond ((zerop (deref (cast (slot hostent 'aliases)
-					  (* (unsigned 32)))
+					  (* (unsigned #-alpha 32 #+alpha 64)))
 				    index))
 		      (results))
 		     (t
@@ -147,7 +147,7 @@
 	     (iterate repeat ((index 0))
 	       (declare (type kernel:index index))
 	       (cond ((zerop (deref (cast (slot hostent 'addr-list)
-					  (* (unsigned 32)))
+					  (* (unsigned #-alpha 32 #+alpha 64)))
 				    index))
 		      (results))
 		     (t
-- 
GitLab