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