Changeset 14641

Timestamp:

Feb 4, 2011, 11:28:57 AM (14 years ago)

Author:

R. Matthew Emerson

Message:

More places that need to subtract tcr-bias.

File:

• trunk/source/level-1/l1-lisp-threads.lisp (modified) (4 diffs)

trunk/source/level-1/l1-lisp-threads.lisp

@@ -293 +293 @@
 
 (defun %current-xp ()
-  (let ((xframe (%fixnum-ref (%current-tcr) target::tcr.xframe)))
+  (let ((xframe (%fixnum-ref (%current-tcr) (- target::tcr.xframe
+                                               target::tcr-bias))))
     (when (eql xframe 0)
       (error "No current exception frame"))
@@ -662 +663 @@
   (if context
     (bt.db-link context)
-    (%fixnum-ref (%current-tcr)  target::tcr.db-link)))
+    (%fixnum-ref (%current-tcr) (- target::tcr.db-link target::tcr-bias))))
 
 (defun previous-db-link (db-link start )
@@ -1140 +1141 @@
       ;; to BSP; if not, "append" them to the end of the current
       ;; linked list.
-      (let* ((current-db-link (%fixnum-ref (%current-tcr) target::tcr.db-link)))
+      (let* ((current-db-link (%fixnum-ref (%current-tcr)
+                                           (- target::tcr.db-link
+                                              target::tcr-bias))))
         (declare (fixnum current-db-link))
         (if (zerop current-db-link)
-          (setf (%fixnum-ref (%current-tcr) target::tcr.db-link) bsp)
+          (setf (%fixnum-ref (%current-tcr) (- target::tcr.db-link
+                                               target::tcr-bias)) bsp)
           (do* ((binding current-db-link)
                 (next (%fixnum-ref binding 0)
@@ -1154 +1158 @@
       ;; on the callback) don't try to unwind the binding stack beyond
       ;; where it was just set.
-      (do* ((catch (%fixnum-ref (%current-tcr) target::tcr.catch-top)
+      (do* ((catch (%fixnum-ref (%current-tcr) (- target::tcr.catch-top
+                                                  target::tcr-bias))
                    (%fixnum-ref catch target::catch-frame.link)))
            ((zerop catch))