[movitz-cvs] CVS update: movitz/losp/muerte/run-time-context.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv1341

Modified Files:
	run-time-context.lisp 
Log Message:
Minor cleanup.

Date: Tue May  3 23:25:34 2005
Author: ffjeld

Index: movitz/losp/muerte/run-time-context.lisp
diff -u movitz/losp/muerte/run-time-context.lisp:1.17 movitz/losp/muerte/run-time-context.lisp:1.18
--- movitz/losp/muerte/run-time-context.lisp:1.17	Tue May  3 22:10:35 2005
+++ movitz/losp/muerte/run-time-context.lisp	Tue May  3 23:25:34 2005
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Wed Nov 12 18:33:02 2003
 ;;;;                
-;;;; $Id: run-time-context.lisp,v 1.17 2005/05/03 20:10:35 ffjeld Exp $
+;;;; $Id: run-time-context.lisp,v 1.18 2005/05/03 21:25:34 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -20,10 +20,6 @@
 
 (in-package muerte)
 
-(define-compiler-macro current-run-time-context ()
-  `(with-inline-assembly (:returns :register)
-     (:locally (:movl (:edi (:edi-offset self)) (:result-register)))))
-
 ;;;;
 
 (defclass run-time-context-class (std-slotted-class built-in-class) ())
@@ -144,43 +140,6 @@
       (code-vector-word
        (setf (memref context -6 :index (third slot) :type :code-vector) value)))))
 
-(defun %run-time-context-segment-base (slot-name
-				      &optional (context (current-run-time-context)))
-  (check-type context run-time-context)
-  (let ((slot (find-run-time-context-slot context slot-name)))
-    (ecase (second slot)
-      (segment-descriptor
-       (let ((index8 (* 4 (third slot)))
-	     (index16 (* 2 (third slot))))
-	 (+ (memref context (+ -6 2) :index index16 :type :unsigned-byte16)
-	    (ash (memref context (+ -6 4) :index index8 :type :unsigned-byte8) 16)
-	    (ash (memref context (+ -6 7) :index index8 :type :unsigned-byte8) 24)))))))
-
-(defun (setf %run-time-context-segment-base) (value slot-name
-					     &optional (context (current-run-time-context)))
-  (check-type context run-time-context)
-  (let ((slot (find-run-time-context-slot context slot-name)))
-    (ecase (second slot)
-      (segment-descriptor
-       (let ((index8 (* 4 (third slot)))
-	     (index16 (* 2 (third slot))))
-	 (setf (memref context (+ -6 2) :index index16 :type :unsigned-byte16) (ldb (byte 16 0) value)
-	       (memref context (+ -6 4) :index index8 :type :unsigned-byte8) (ldb (byte 8 16) value)
-	       (memref context (+ -6 7) :index index8 :type :unsigned-byte8) (ldb (byte 6 24) value)))))
-    value))
-
-(defun %run-time-context-ref (edi-offset)
-  "Get a run-time-context slot by its EDI-relative offset."
-  (with-inline-assembly (:returns :eax)
-    (:compile-form (:result-mode :eax) edi-offset)
-    (:leal (:eax #.(cl:* 1 movitz:+movitz-fixnum-factor+)) :ecx)
-    (:sarl #.movitz:+movitz-fixnum-shift+ :ecx)
-    (:testb 3 :cl)
-    (:jnz '(:sub-program ()
-	    (:compile-form (:result-mode :ignore)
-	     (error "Illegal edi-offset ~S" edi-offset))))
-    (:locally (:movl (:edi :ecx -1) :eax))))
-
 (defun clone-run-time-context (&key (parent (current-run-time-context))
 				    (name :anonymous))
   (check-type parent run-time-context)
@@ -189,21 +148,6 @@
 	  (%run-time-context-slot 'self context) context
 	  (%run-time-context-slot 'atomically-continuation context) 0)
     context))
-
-;;;(defun switch-to-context (context)
-;;;  (check-type context run-time-context)
-;;;  (with-inline-assembly (:returns :nothing)
-;;;    (:compile-form (:result-mode :eax) context)
-;;;    (:movw #.(cl:1- (cl:* 8 8)) (:esp -6))
-;;;    (:addl #.(cl:+ -6 (movitz::global-constant-offset 'movitz::segment-descriptor-table))
-;;;	   :eax)
-;;;    (:addl :edi :eax)
-;;;    (:locally (:addl (:edi (:edi-offset physical-address-offset)) :eax))
-;;;    (:movl :eax (:esp -4))
-;;;    (:lgdt (:esp -6))
-;;;    (:movw #x28 :ax)
-;;;    (:movw :ax :fs)
-;;;    (:locally (:movl (:edi (:edi-offset self)) :eax))))
 
 (defun %run-time-context-install-stack (context
 					&optional (control-stack