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

Diff of /src/code/rt-vm.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by wlott, Tue Apr 16 19:33:16 1991 UTC revision 1.2 by wlott, Mon Apr 22 19:22:51 1991 UTC
# Line 44  Line 44 
44  ;;; FIXUP-CODE-OBJECT -- Interface  ;;; FIXUP-CODE-OBJECT -- Interface
45  ;;;  ;;;
46  (defun fixup-code-object (code offset fixup kind)  (defun fixup-code-object (code offset fixup kind)
47    (error "Not yet." code offset fixup kind))    (declare (type index offset) (type (unsigned-byte 32) fixup))
48      (system:without-gcing
49       (let ((sap (sap+ (kernel:code-instructions code) offset)))
50         (ecase kind
51           (:cal
52            (setf (sap-ref-16 sap 1)
53                  (ldb (byte 16 0) fixup)))
54           (:cau
55            (let ((high (ldb (byte 16 16) fixup)))
56              (setf (sap-ref-16 sap 1)
57                    (if (logbitp 15 fixup) (1+ high) high))))
58           (:ba
59            (unless (zerop (ash fixup -24))
60              (warn "#x~8,'0X out of range for branch-absolute." fixup))
61            (setf (sap-ref-8 sap 1)
62                  (ldb (byte 8 16) fixup))
63            (setf (sap-ref-16 sap 1)
64                  (ldb (byte 16 0) fixup)))))))
65    
66    
67    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

  ViewVC Help
Powered by ViewVC 1.1.5