From 103178d88e95fc80b4c8fca43f482f3bda1713c9 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Fri, 23 Nov 1990 20:17:37 +0000
Subject: [PATCH] Initial revision

---
 code/sparc-vm.lisp | 45 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 45 insertions(+)
 create mode 100644 code/sparc-vm.lisp

diff --git a/code/sparc-vm.lisp b/code/sparc-vm.lisp
new file mode 100644
index 000000000..647c87f09
--- /dev/null
+++ b/code/sparc-vm.lisp
@@ -0,0 +1,45 @@
+;;; -*- Package: VM -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the Spice Lisp project at
+;;; Carnegie-Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of Spice Lisp, please contact
+;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; **********************************************************************
+;;;
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sparc-vm.lisp,v 1.1 1990/11/23 20:17:37 wlott Exp $
+;;;
+;;; This file contains the SPARC specific runtime stuff.
+;;;
+(in-package "SPARC")
+(use-package "SYSTEM")
+
+(export '(fixup-code-object))
+
+
+;;;; Add machine specific features to *features*
+
+(pushnew :SPARCstation *features*)
+(pushnew :sparc *features*)
+(pushnew :sun4 *features*)
+
+
+
+;;; FIXUP-CODE-OBJECT -- Interface
+;;;
+(defun fixup-code-object (code offset fixup kind)
+  (multiple-value-bind (word-offset rem) (truncate offset word-bytes)
+    (unless (zerop rem)
+      (error "Unaligned instruction?  offset=#x~X." offset))
+    (system:without-gcing
+     (let ((sap (truly-the system-area-pointer
+			   (%primitive c::code-instructions code))))
+       (ecase kind
+	 (:call
+	  (error "Can't deal with CALL fixups, yet."))
+	 (:sethi
+	  (setf (ldb (byte 22 0) (sap-ref-32 sap word-offset))
+		(ldb (byte 22 10) fixup)))
+	 (:add
+	  (setf (ldb (byte 10 0) (sap-ref-32 sap word-offset))
+		(ldb (byte 10 0) fixup))))))))
-- 
GitLab