/[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.4 by ram, Thu Jan 2 22:49:20 1992 UTC revision 1.5 by wlott, Fri Feb 21 22:00:06 1992 UTC
# Line 47  Line 47 
47     (let ((sap (sap+ (kernel:code-instructions code) offset)))     (let ((sap (sap+ (kernel:code-instructions code) offset)))
48       (ecase kind       (ecase kind
49         (:cal         (:cal
50          (setf (sap-ref-16 sap 1)          (setf (sap-ref-16 sap 2)
51                (ldb (byte 16 0) fixup)))                (ldb (byte 16 0) fixup)))
52         (:cau         (:cau
53          (let ((high (ldb (byte 16 16) fixup)))          (let ((high (ldb (byte 16 16) fixup)))
54            (setf (sap-ref-16 sap 1)            (setf (sap-ref-16 sap 2)
55                  (if (logbitp 15 fixup) (1+ high) high))))                  (if (logbitp 15 fixup) (1+ high) high))))
56         (:ba         (:ba
57          (unless (zerop (ash fixup -24))          (unless (zerop (ash fixup -24))
58            (warn "#x~8,'0X out of range for branch-absolute." fixup))            (warn "#x~8,'0X out of range for branch-absolute." fixup))
59          (setf (sap-ref-8 sap 1)          (setf (sap-ref-8 sap 1)
60                (ldb (byte 8 16) fixup))                (ldb (byte 8 16) fixup))
61          (setf (sap-ref-16 sap 1)          (setf (sap-ref-16 sap 2)
62                (ldb (byte 16 0) fixup)))))))                (ldb (byte 16 0) fixup)))))))
63    
64    

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

  ViewVC Help
Powered by ViewVC 1.1.5