November 2004 - movitz-cvs@common-lisp.net

[movitz-cvs] CVS update: movitz/losp/los0.lisp
by Frode Vatvedt Fjeld 12 Nov '04

12 Nov '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv14518 Modified Files: los0.lisp Log Message: install-shallow-binding now really seems to work. Date: Fri Nov 12 17:25:10 2004 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.24 movitz/losp/los0.lisp:1.25 --- movitz/losp/los0.lisp:1.24 Thu Nov 11 20:28:18 2004 +++ movitz/losp/los0.lisp Fri Nov 12 17:25:09 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.24 2004/11/11 19:28:18 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.25 2004/11/12 16:25:09 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1254,7 +1254,7 @@ (:ret))) (defun genesis () - (install-shallow-binding) + ;; (install-shallow-binding) (let ((extended-memsize 0)) ;; Find out how much extended memory we have (setf (io-port #x70 :unsigned-byte8) #x18) @@ -1491,9 +1491,10 @@ (: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 - (:xchgl :ebx (:eax (:offset movitz-symbol value))) ; exchange new and old value - (:movl :ebx (:ecx 8)) + (:movl :ebx (:eax (:offset movitz-symbol value))) ; install new value (:movl (:ecx 12) :ecx) (:jmp 'install-loop) install-completed @@ -1517,7 +1518,7 @@ (:cmpl :edx :ecx) (:je 'uninstall-completed) (:movl (:ecx 0) :eax) ; symbol - (:movl (:ecx 8) :ebx) ; old value + (:movl (:ecx 4) :ebx) ; old value (:movl :ebx (:eax (:offset movitz-symbol value))) ; reload old value (:movl (:ecx 12) :ecx) (:jmp 'uninstall-loop) @@ -1550,15 +1551,31 @@ (:movl :ebx (:eax (:offset movitz-symbol value))) (:ret))) -(defun install-shallow-binding () - (macrolet ((install (slot function) - `(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-store dynamic-store-shallow) - (install muerte::dynamic-load-unprotected dynamic-load-unprotected-shallow) - (install muerte::dynamic-load dynamic-load-shallow)) - (values)) +(defun install-shallow-binding (&key quiet) + (without-interrupts + (unless quiet + (warn "Installing shallow-binding strategy..")) + (macrolet ((install (slot function) + `(prog1 (cons ',slot (%run-time-context-slot ',slot)) + (setf (%run-time-context-slot ',slot) (symbol-value ',function))))) + (list (install muerte:dynamic-variable-install dynamic-variable-install-shallow) + (install muerte:dynamic-variable-uninstall dynamic-variable-uninstall-shallow) + (install muerte::dynamic-store dynamic-store-shallow) + (install muerte::dynamic-load-unprotected dynamic-load-unprotected-shallow) + (prog1 (install muerte::dynamic-load dynamic-load-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)))))))) (genesis)

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by Frode Vatvedt Fjeld 12 Nov '04

12 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv14488 Modified Files: image.lisp Log Message: Make dynamic-env of "word" type. It's a "location", really. Date: Fri Nov 12 17:24:52 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.76 movitz/image.lisp:1.77 --- movitz/image.lisp:1.76 Fri Nov 12 15:51:28 2004 +++ movitz/image.lisp Fri Nov 12 17:24:51 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.76 2004/11/12 14:51:28 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.77 2004/11/12 16:24:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -107,7 +107,7 @@ :binary-tag :primitive-function) ;; per thread parameters (dynamic-env - :binary-type lu32 + :binary-type word :initform 0) ;; More per-thread parameters (unwind-protect-tag

1 0

[movitz-cvs] CVS update: movitz/special-operators-cl.lisp
by Frode Vatvedt Fjeld 12 Nov '04

12 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv10485 Modified Files: special-operators-cl.lisp Log Message: No longer need to push unbound-value as part of dynamic-binding's env-slots. Date: Fri Nov 12 16:13:47 2004 Author: ffjeld Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.32 movitz/special-operators-cl.lisp:1.33 --- movitz/special-operators-cl.lisp:1.32 Fri Nov 12 15:39:04 2004 +++ movitz/special-operators-cl.lisp Fri Nov 12 16:13:47 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 24 16:31:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: special-operators-cl.lisp,v 1.32 2004/11/12 14:39:04 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.33 2004/11/12 15:13:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -83,7 +83,7 @@ :form init-form :modify-accumulate let-modifies :result-mode :push) - `((:globally (:pushl (:edi (:edi-offset unbound-value))))) + `((:pushl :edi)) ; scratch (prog1 nil (incf (stack-used init-env) 2)) (compiler-call #'compile-self-evaluating ; binding name :env init-env @@ -1103,11 +1103,10 @@ (:movl (:eax 3) :eax) ; (pop values) ,no-more-values (:pushl :edx) ; push (car values) [[ binding value ]] - (:globally (:pushl (:edi (:edi-offset unbound-value)))) ; [[ binding tag ]] + (:pushl :edi) ; push binding scratch (:pushl (:ebx -1)) ; push (car symbols) [[ binding name ]] (:movl (:ebx 3) :ebx) ; (pop symbols) (:addl 4 :ecx) - ;; (:jc '(:sub-program (too-many-symbols) (:int 71))) (:pushl :esp) ; push next tail (:jmp ',loop) ,no-more-symbols

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/restarts.lisp
by Frode Vatvedt Fjeld 12 Nov '04

12 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv9613 Modified Files: restarts.lisp Log Message: Changed exact-throw, the basic operator for dynamic control transfer, quite a bit. The (ill-specified) primitive-function dynamic-locate-catch-tag is removed, its essential job is now performed by the normal function find-catch-tag. Date: Fri Nov 12 15:52:25 2004 Author: ffjeld Index: movitz/losp/muerte/restarts.lisp diff -u movitz/losp/muerte/restarts.lisp:1.4 movitz/losp/muerte/restarts.lisp:1.5 --- movitz/losp/muerte/restarts.lisp:1.4 Thu Sep 2 11:41:04 2004 +++ movitz/losp/muerte/restarts.lisp Fri Nov 12 15:52:24 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 28 09:27:13 2003 ;;;; -;;;; $Id: restarts.lisp,v 1.4 2004/09/02 09:41:04 ffjeld Exp $ +;;;; $Id: restarts.lisp,v 1.5 2004/11/12 14:52:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -119,8 +119,7 @@ (function (apply function arguments)) (symbol - (exact-throw (load-global-constant restart-tag) - (basic-restart->dynamic-context restart) + (exact-throw (basic-restart->dynamic-context restart) (ecase function ((with-simple-restart) (values nil t))))))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/primitive-functions.lisp
by Frode Vatvedt Fjeld 12 Nov '04

12 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv9581 Modified Files: primitive-functions.lisp Log Message: Changed exact-throw, the basic operator for dynamic control transfer, quite a bit. The (ill-specified) primitive-function dynamic-locate-catch-tag is removed, its essential job is now performed by the normal function find-catch-tag. Date: Fri Nov 12 15:52:17 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.51 movitz/losp/muerte/primitive-functions.lisp:1.52 --- movitz/losp/muerte/primitive-functions.lisp:1.51 Thu Nov 11 20:26:12 2004 +++ movitz/losp/muerte/primitive-functions.lisp Fri Nov 12 15:52:16 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 2 21:02:18 2001 ;;;; -;;;; $Id: primitive-functions.lisp,v 1.51 2004/11/11 19:26:12 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.52 2004/11/12 14:52:16 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -81,8 +81,8 @@ ;;; Dynamic binding: ;;; 12: parent (no parent == #x0) ;;; 8: value -;;; 4: tag = #:unbound (unique value that cannot be a catch tag) -;;; 0: binding name/symbol +;;; 4: scratch, free to use by binding implementation. +;;; 0: binding name (a symbol) ;;; Catch exit-point: ;;; 12: parent (no parent == #x0) @@ -161,44 +161,6 @@ (with-inline-assembly (:returns :nothing) ;; Default binding strategy is naive deep binding, so this is a NOP. (:ret))) - -(define-primitive-function dynamic-locate-catch-tag (tag) - "Search the dynamic environment for a catch slot matching <tag> in EAX. -If EBX is not zero, only match that exact dynamic context (which presumably -was located earlier by other means). -Iff a tag is found, any intervening unwind-protect cleanup-forms are executed, and -this functions returns with EAX pointing to the dynamic-slot for tag, and with carry set. -When the tag is not found, no cleanup-forms are executed, and carry is cleared upon return, -with EAX still holding the tag." - (with-inline-assembly (:returns :multiple-values) - (:globally (:movl (:edi (:edi-offset unwind-protect-tag)) :edx)) - (:locally (:movl (:edi (:edi-offset dynamic-env)) :ecx)) - - search-loop - (:jecxz 'search-failed) - - (:cmpl :eax (:ecx 4)) ; is env-slot in ECX == tag? - (:jne 'mismatch) - - (:cmpl :ecx :ebx) - (:je 'success) - (:testl :ebx :ebx) - (:jz 'success) - - mismatch - - not-unwind-protect - (:movl (:ecx 12) :ecx) ; get parent - (:jmp 'search-loop) - - success - (:movl :ecx :eax) - (:stc) ; signal success - (:ret) ; return - - search-failed - (:clc) ; signal failure - (:ret))) ; return. (define-primitive-function dynamic-unwind () "Unwind ECX dynamic environment slots. Scratch EAX."

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/basic-macros.lisp
by Frode Vatvedt Fjeld 12 Nov '04

12 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv9560 Modified Files: basic-macros.lisp Log Message: Changed exact-throw, the basic operator for dynamic control transfer, quite a bit. The (ill-specified) primitive-function dynamic-locate-catch-tag is removed, its essential job is now performed by the normal function find-catch-tag. Date: Fri Nov 12 15:52:08 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.44 movitz/losp/muerte/basic-macros.lisp:1.45 --- movitz/losp/muerte/basic-macros.lisp:1.44 Thu Nov 11 20:24:52 2004 +++ movitz/losp/muerte/basic-macros.lisp Fri Nov 12 15:52:05 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.44 2004/11/11 19:24:52 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.45 2004/11/12 14:52:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -116,7 +116,11 @@ `(compiled-cond (,test-form ,then-form)))) (defmacro throw (tag result-form) - `(exact-throw ,tag 0 ,result-form)) + (let ((tag-var (gensym "throw-tag-"))) + `(let ((,tag-var ,tag)) + (exact-throw (find-catch-tag ,tag-var) + ,result-form + (error 'throw-error :tag ,tag-var))))) (defmacro when (test-form &rest forms) `(cond (,test-form ,@forms)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/basic-functions.lisp
by Frode Vatvedt Fjeld 12 Nov '04

12 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv9528 Modified Files: basic-functions.lisp Log Message: Changed exact-throw, the basic operator for dynamic control transfer, quite a bit. The (ill-specified) primitive-function dynamic-locate-catch-tag is removed, its essential job is now performed by the normal function find-catch-tag. Date: Fri Nov 12 15:51:56 2004 Author: ffjeld Index: movitz/losp/muerte/basic-functions.lisp diff -u movitz/losp/muerte/basic-functions.lisp:1.13 movitz/losp/muerte/basic-functions.lisp:1.14 --- movitz/losp/muerte/basic-functions.lisp:1.13 Tue Jul 13 04:26:24 2004 +++ movitz/losp/muerte/basic-functions.lisp Fri Nov 12 15:51:56 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 18:41:57 2001 ;;;; -;;;; $Id: basic-functions.lisp,v 1.13 2004/07/13 02:26:24 ffjeld Exp $ +;;;; $Id: basic-functions.lisp,v 1.14 2004/11/12 14:51:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -27,6 +27,26 @@ (defun not (x) (not x)) + +(defun find-catch-tag (catch-tag) + "Find the dynamic-env slot that matches the catch-tag, or 0 if unseen." + (with-inline-assembly (:returns :eax) + (:load-lexical (:lexical-binding catch-tag) :eax) + (:locally (:movl (:edi (:edi-offset dynamic-env)) :ecx)) + (:jecxz 'search-done) + search-loop + (:cmpl :eax (:ecx 4)) ; Does tag match entry? + (:jne 'search-next) ; if not, goto next. + (:testl 3 (:ecx)) ; Is this really a catch entry? + (:jz 'search-done) ; if yes, we have found it. + search-next + (:movl (:ecx 12) :ecx) + (:testl :ecx :ecx) + (:jnz 'search-loop) + ;; Search failed, ECX=0 + search-done + (:movl :ecx :eax))) + (defmacro numargs () `(with-inline-assembly (:returns :ecx)

1 0

[movitz-cvs] CVS update: movitz/special-operators.lisp
by Frode Vatvedt Fjeld 12 Nov '04

12 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv9504 Modified Files: special-operators.lisp Log Message: Changed exact-throw, the basic operator for dynamic control transfer, quite a bit. The (ill-specified) primitive-function dynamic-locate-catch-tag is removed, its essential job is now performed by the normal function find-catch-tag. Date: Fri Nov 12 15:51:45 2004 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.42 movitz/special-operators.lisp:1.43 --- movitz/special-operators.lisp:1.42 Thu Oct 21 22:41:56 2004 +++ movitz/special-operators.lisp Fri Nov 12 15:51:44 2004 @@ -8,7 +8,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 24 16:22:59 2000 ;;;; -;;;; $Id: special-operators.lisp,v 1.42 2004/10/21 20:41:56 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.43 2004/11/12 14:51:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1175,7 +1175,10 @@ finally (error "No compiler-typecase clause matched compile-time type ~S." keyform-type))))) (define-special-operator muerte::exact-throw (&all all-throw &form form &env env &funobj funobj) - (destructuring-bind (tag context value-form) + "Perform a dynamic control transfer to catch-env-slot context (evaluated), +with values from value-form. Error-form, if provided, is evaluated in case the context +is zero (i.e. not found)." + (destructuring-bind (context value-form &optional error-form) (cdr form) (let* ((local-env (make-local-movitz-environment env funobj :type 'let-env)) (dynamic-slot-binding @@ -1186,43 +1189,46 @@ (movitz-env-add-binding local-env (make-instance 'located-binding :name (gensym "continuation-step-"))))) - (with-labels (throw (save-tag-var save-context-var)) - (compiler-values () - :returns :non-local-exit - :code (append (compiler-call #'compile-form - :forward all-throw - :result-mode :multiple-values - :form `(muerte.cl:let ((,save-tag-var ,tag) - (,save-context-var ,context)) - (muerte.cl:multiple-value-prog1 - ,value-form - (muerte::with-inline-assembly (:returns :nothing) - (:compile-two-forms (:eax :ebx) ,save-tag-var ,save-context-var) - (:globally (:call (:edi (:edi-offset dynamic-locate-catch-tag)))) - (:jnc '(:sub-program () (:int 108))) - (:store-lexical ,dynamic-slot-binding :eax :type t) - (:globally (:call (:edi (:edi-offset dynamic-unwind-next)))) - (:store-lexical ,next-continuation-step-binding :eax :type t) - )))) - ;; now outside of m-v-prog1's cloak, with final dynamic-slot in .. - ;; ..unwind it and transfer control. - ;; - ;; * 12 dynamic-env uplink - ;; * 8 target jumper number - ;; * 4 target catch tag - ;; * 0 target EBP - `((:load-lexical ,dynamic-slot-binding :edx) - (:locally (:movl :edx (:edi (:edi-offset raw-scratch0)))) ; final continuation - (:load-lexical ,next-continuation-step-binding :edx) ; next continuation-step - (:locally (:movl :esi (:edi (:edi-offset scratch1)))) - (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) ; exit dynamic-env - (:movl :edx :esp) ; enter non-local jump stack mode. + (compiler-values () + :returns :non-local-exit + :code (append (compiler-call #'compile-form + :forward all-throw + :result-mode dynamic-slot-binding + :form context) + (compiler-call #'compile-form + :forward all-throw + :result-mode :multiple-values + :form `(muerte.cl:multiple-value-prog1 + ,value-form + (muerte::with-inline-assembly (:returns :nothing) + (:load-lexical ,dynamic-slot-binding :eax) + ,@(when error-form + `((:testl :eax :eax) + (:jz '(:sub-program () + (:compile-form (:result-mode :ignore) + ,error-form))))) + (:locally (:call (:edi (:edi-offset dynamic-unwind-next)))) + (:store-lexical ,next-continuation-step-binding :eax :type t) + ))) + ;; now outside of m-v-prog1's cloak, with final dynamic-slot in .. + ;; ..unwind it and transfer control. + ;; + ;; * 12 dynamic-env uplink + ;; * 8 target jumper number + ;; * 4 target catch tag + ;; * 0 target EBP + `((:load-lexical ,dynamic-slot-binding :edx) + (:locally (:movl :edx (:edi (:edi-offset raw-scratch0)))) ; final continuation + (:load-lexical ,next-continuation-step-binding :edx) ; next continuation-step + (:locally (:movl :esi (:edi (:edi-offset scratch1)))) + (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) ; exit dynamic-env + (:movl :edx :esp) ; enter non-local jump stack mode. - (:movl (:esp) :edx) ; target stack-frame EBP - (:movl (:edx -4) :esi) ; get target funobj into ESI + (:movl (:esp) :edx) ; target stack-frame EBP + (:movl (:edx -4) :esi) ; get target funobj into ESI - (:movl (:esp 8) :edx) ; target jumper number - (:jmp (:esi :edx ,(slot-offset 'movitz-funobj 'constant0)))))))))) + (:movl (:esp 8) :edx) ; target jumper number + (:jmp (:esi :edx ,(slot-offset 'movitz-funobj 'constant0))))))))) (define-special-operator muerte::with-basic-restart (&all defaults &form form &env env)

1 0

[movitz-cvs] CVS update: movitz/packages.lisp
by Frode Vatvedt Fjeld 12 Nov '04

12 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv9478 Modified Files: packages.lisp Log Message: Changed exact-throw, the basic operator for dynamic control transfer, quite a bit. The (ill-specified) primitive-function dynamic-locate-catch-tag is removed, its essential job is now performed by the normal function find-catch-tag. Date: Fri Nov 12 15:51:37 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.39 movitz/packages.lisp:1.40 --- movitz/packages.lisp:1.39 Thu Nov 11 20:29:08 2004 +++ movitz/packages.lisp Fri Nov 12 15:51:37 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Nov 15 21:39:55 2003 ;;;; -;;;; $Id: packages.lisp,v 1.39 2004/11/11 19:29:08 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.40 2004/11/12 14:51:37 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1088,8 +1088,7 @@ (:use muerte.mop muerte.common-lisp) (:import-from common-lisp cl:nil) (:shadow get-setf-expansion) - (:export exact-throw - translate-program + (:export translate-program decode-macro-lambda-list with-inline-assembly with-progn-results

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by Frode Vatvedt Fjeld 12 Nov '04

12 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv9458 Modified Files: image.lisp Log Message: Changed exact-throw, the basic operator for dynamic control transfer, quite a bit. The (ill-specified) primitive-function dynamic-locate-catch-tag is removed, its essential job is now performed by the normal function find-catch-tag. Date: Fri Nov 12 15:51:29 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.75 movitz/image.lisp:1.76 --- movitz/image.lisp:1.75 Thu Nov 11 20:27:33 2004 +++ movitz/image.lisp Fri Nov 12 15:51:28 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.75 2004/11/11 19:27:33 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.76 2004/11/12 14:51:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -172,11 +172,6 @@ :map-binary-read-delayed 'movitz-word-code-vector :binary-type code-vector-word) (dynamic-store - :map-binary-write 'movitz-intern-code-vector - :binary-tag :primitive-function - :map-binary-read-delayed 'movitz-word-code-vector - :binary-type code-vector-word) - (dynamic-locate-catch-tag :map-binary-write 'movitz-intern-code-vector :binary-tag :primitive-function :map-binary-read-delayed 'movitz-word-code-vector

1 0