/[cmucl]/src/code/pmax-vm.lisp
ViewVC logotype

Contents of /src/code/pmax-vm.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations)
Tue Oct 23 14:44:19 1990 UTC (23 years, 5 months ago) by wlott
Branch: MAIN
Changes since 1.1: +13 -6 lines
Moved machine specific features into here.  Added a (use-package "SYSTEM")
to keep fixup-code-object happy.
1 wlott 1.1 ;;; -*- Package: VM -*-
2     ;;;
3     ;;; **********************************************************************
4     ;;; This code was written as part of the Spice Lisp project at
5     ;;; Carnegie-Mellon University, and has been placed in the public domain.
6     ;;; If you want to use this code or any part of Spice Lisp, please contact
7     ;;; Scott Fahlman (FAHLMAN@CMUC).
8     ;;; **********************************************************************
9     ;;;
10 wlott 1.2 ;;; $Header: /tiger/var/lib/cvsroots/cmucl/src/code/pmax-vm.lisp,v 1.2 1990/10/23 14:44:19 wlott Exp $
11 wlott 1.1 ;;;
12     ;;; This file contains the PMAX specific runtime stuff.
13     ;;;
14     (in-package "VM")
15 wlott 1.2 (use-package "SYSTEM")
16 wlott 1.1
17     (export '(fixup-code-object))
18    
19 wlott 1.2
20     ;;;; Add machine specific features to *features*
21    
22     (pushnew :decstation-3100 *features*)
23     (pushnew :pmax *features*)
24    
25    
26    
27     ;;; FIXUP-CODE-OBJECT -- Interface
28     ;;;
29 wlott 1.1 (defun fixup-code-object (code offset fixup kind)
30 wlott 1.2 (multiple-value-bind (word-offset rem) (truncate offset word-bytes)
31 wlott 1.1 (unless (zerop rem)
32     (error "Unaligned instruction? offset=#x~X." offset))
33     (system:without-gcing
34     (let ((sap (truly-the system-area-pointer
35     (%primitive c::code-instructions code))))
36     (ecase kind
37     (:jump
38     (assert (zerop (ash fixup -26)))
39     (setf (ldb (byte 26 0)
40     (system:sap-ref-32 sap word-offset))
41     (ash fixup -2)))
42     (:lui
43     (setf (sap-ref-16 sap (* word-offset 2))
44     (+ (ash fixup -16)
45     (if (logbitp 15 fixup) 1 0))))
46     (:addi
47     (setf (sap-ref-16 sap (* word-offset 2))
48     (ldb (byte 16 0) fixup))))))))

  ViewVC Help
Powered by ViewVC 1.1.5