[movitz-cvs] CVS update: movitz/losp/los0.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Thu Nov 18 17:58:56 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp
In directory common-lisp.net:/tmp/cvs-serv27829
Modified Files:
los0.lisp
Log Message:
Changed dynamic binding lookup protocol. Only use the "unbounded"
primitive-function, and have the caller check whether the value is the
unbound-value or not. And, rename to dynamic-variable-lookup.
Date: Thu Nov 18 18:58:54 2004
Author: ffjeld
Index: movitz/losp/los0.lisp
diff -u movitz/losp/los0.lisp:1.29 movitz/losp/los0.lisp:1.30
--- movitz/losp/los0.lisp:1.29 Wed Nov 17 15:02:18 2004
+++ movitz/losp/los0.lisp Thu Nov 18 18:58:50 2004
@@ -9,7 +9,7 @@
;;;; Created at: Fri Dec 1 18:08:32 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
-;;;; $Id: los0.lisp,v 1.29 2004/11/17 14:02:18 ffjeld Exp $
+;;;; $Id: los0.lisp,v 1.30 2004/11/18 17:58:50 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -46,6 +46,8 @@
(in-package muerte.init)
+(defun xx (a b)
+ (eql b #x123456789))
(defun test0 ()
(ash 1 -1000000000000))
@@ -1494,20 +1496,23 @@
;;;;;;;;;;;;;;;;;; Shallow binding
(define-primitive-function dynamic-variable-install-shallow ()
- "Install each dynamic binding entry between that in ESP (offset by 4 due to
-the call to this primitive-function!) and current dynamic-env.
-Preserve EDX."
+ "Install each dynamic binding entry between that in ESP
+ (offset by 4 due to the call to this primitive-function!)
+and current dynamic-env. Preserve EDX."
(with-inline-assembly (:returns :nothing)
- (:leal (:esp 4) :ecx)
+ (:leal (:esp 4) :ecx) ; first entry
install-loop
- (:locally (:cmpl :ecx (:edi (:edi-offset dynamic-env))))
+ (:locally
+ (:cmpl :ecx (:edi (:edi-offset dynamic-env))))
(:je 'install-completed)
- (:movl (:ecx 0) :eax) ; symbol
- (:movl (:eax (:offset movitz-symbol value)) :ebx) ; symbol's old-value into EBX
- (:movl :ebx (:ecx 4)) ; save old-value in binding's scratch
- (:movl (:ecx 8) :ebx) ; new value
- (:movl :ebx (:eax (:offset movitz-symbol value))) ; install new value
- (:movl (:ecx 12) :ecx)
+ (:movl (:ecx 0) :eax) ; binding's name
+ (:movl (:eax (:offset movitz-symbol value))
+ :ebx) ; old value into EBX
+ (:movl :ebx (:ecx 4)) ; save old value in scratch
+ (:movl (:ecx 8) :ebx) ; new value..
+ (:movl :ebx ; ..into symbol's value slot
+ (:eax (:offset movitz-symbol value)))
+ (:movl (:ecx 12) :ecx) ; iterate next binding
(:jmp 'install-loop)
install-completed
(:ret)))
@@ -1587,14 +1592,6 @@
"Load the dynamic value of SYMBOL into EAX."
(with-inline-assembly (:returns :multiple-values)
(:movl (:eax (:offset movitz-symbol value)) :eax)
- (:globally (:cmpl (:edi (:edi-offset unbound-value)) :eax))
- (:je '(:sub-program (unbound) (:int 99)))
- (:ret)))
-
-(define-primitive-function dynamic-variable-lookup-unbound-shallow (symbol)
- "Load the dynamic value of SYMBOL into EAX."
- (with-inline-assembly (:returns :multiple-values)
- (:movl (:eax (:offset movitz-symbol value)) :eax)
(:ret)))
(define-primitive-function dynamic-variable-store-shallow (symbol value)
@@ -1609,27 +1606,25 @@
(warn "Installing shallow-binding strategy.."))
(without-interrupts
(macrolet ((install (slot function)
- `(prog1 (cons ',slot (%run-time-context-slot ',slot))
- (setf (%run-time-context-slot ',slot) (symbol-value ',function)))))
- (prog1
- (list (install muerte:dynamic-variable-install dynamic-variable-install-shallow)
- (install muerte:dynamic-variable-uninstall dynamic-variable-uninstall-shallow)
- (install muerte::dynamic-unwind-next dynamic-unwind-next-shallow)
- (install muerte::dynamic-variable-store dynamic-variable-store-shallow)
- (install muerte::dynamic-variable-lookup-unbound dynamic-variable-lookup-unbound-shallow)
- (install muerte::dynamic-variable-lookup dynamic-variable-lookup-shallow))
- (labels ((install-shallow-env (env)
- "We use this local function in order to install dynamic-env slots
+ `(setf (%run-time-context-slot ',slot) (symbol-value ',function))))
+ (install muerte:dynamic-variable-install dynamic-variable-install-shallow)
+ (install muerte:dynamic-variable-uninstall dynamic-variable-uninstall-shallow)
+ (install muerte::dynamic-unwind-next dynamic-unwind-next-shallow)
+ (install muerte::dynamic-variable-store dynamic-variable-store-shallow)
+ (install muerte::dynamic-variable-lookup dynamic-variable-lookup-shallow))
+ (labels ((install-shallow-env (env)
+ "We use this local function in order to install dynamic-env slots
in reverse order, by depth-first recursion."
- (unless (eq 0 env)
- (install-shallow-env (memref env 12))
- (let ((name (memref env 0)))
- (when (symbolp name)
- (setf (memref env 4)
- (%symbol-global-value name))
- (setf (%symbol-global-value name)
- (memref env 8)))))))
- (install-shallow-env (load-global-constant dynamic-env :thread-local t)))))))
+ (unless (eq 0 env)
+ (install-shallow-env (memref env 12))
+ (let ((name (memref env 0)))
+ (when (symbolp name)
+ (setf (memref env 4)
+ (%symbol-global-value name))
+ (setf (%symbol-global-value name)
+ (memref env 8)))))))
+ (install-shallow-env (load-global-constant dynamic-env :thread-local t))))
+ (values))
(defun deinstall-shallow-binding (&key quiet)
(unless quiet
@@ -1641,16 +1636,15 @@
(install muerte:dynamic-variable-uninstall)
(install muerte::dynamic-unwind-next)
(install muerte::dynamic-variable-store)
- (install muerte::dynamic-variable-lookup-unbound)
- (install muerte::dynamic-variable-lookup)
- (loop for env = (load-global-constant dynamic-env :thread-local t)
- then (memref env 12)
- while (plusp env)
- do (let ((name (memref env 0)))
- (when (symbolp name)
- (setf (%symbol-global-value name)
- (memref env 4)))))
- (values))))
+ (install muerte::dynamic-variable-lookup))
+ (loop for env = (load-global-constant dynamic-env :thread-local t)
+ then (memref env 12)
+ while (plusp env)
+ do (let ((name (memref env 0)))
+ (when (symbolp name)
+ (setf (%symbol-global-value name)
+ (memref env 4)))))
+ (values)))
(genesis)
More information about the Movitz-cvs
mailing list