April 2004 - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

[movitz-cvs] CVS update: movitz/losp/los0-gc.lisp
by Frode Vatvedt Fjeld 07 Apr '04

07 Apr '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv10915 Modified Files: los0-gc.lisp Log Message: Use interrupt 113 for los0-gc, avoiding any confusion with the old consing regime. Date: Wed Apr 7 09:55:10 2004 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.5 movitz/losp/los0-gc.lisp:1.6 --- movitz/losp/los0-gc.lisp:1.5 Tue Apr 6 20:45:54 2004 +++ movitz/losp/los0-gc.lisp Wed Apr 7 09:55:10 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Feb 21 17:48:32 2004 ;;;; -;;;; $Id: los0-gc.lisp,v 1.5 2004/04/07 00:45:54 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.6 2004/04/07 13:55:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -62,7 +62,8 @@ (:movl (:edx 2) :ecx) (:cmpl #x3fff4 :ecx) (:jge '(:sub-program () - (:int 112) + (:int 113) + ;; This interrupt can be retried. (:jmp 'retry-cons))) (:movl :eax (:edx :ecx 2)) (:movl :ebx (:edx :ecx 6)) @@ -112,7 +113,7 @@ (symbol-function 'new-malloc-clumps)) (setf (symbol-function 'new-malloc-clumps) old-malloc)) - (setf (interrupt-handler 112) 'los0-handle-out-of-memory) + (setf (interrupt-handler 113) 'los0-handle-out-of-memory) (values)) (defun install-old-consing ()

1 0

[movitz-cvs] CVS update: public_html/movitz.html
by Frode Vatvedt Fjeld 07 Apr '04

07 Apr '04

Update of /project/movitz/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv13569 Modified Files: movitz.html Log Message: Slight change to description of GC: interrupt frames are now somewhat supported. Date: Tue Apr 6 21:13:41 2004 Author: ffjeld Index: public_html/movitz.html diff -u public_html/movitz.html:1.6 public_html/movitz.html:1.7 --- public_html/movitz.html:1.6 Tue Mar 30 03:35:32 2004 +++ public_html/movitz.html Tue Apr 6 21:13:41 2004 @@ -10,7 +10,7 @@ Author: Frode Vatvedt Fjeld <frodef(a)acm.org> Created at: Wed Nov 5 09:55:54 2003 - $Id: movitz.html,v 1.6 2004/03/30 08:35:32 ffjeld Exp $ + $Id: movitz.html,v 1.7 2004/04/07 01:13:41 ffjeld Exp $ --> @@ -20,7 +20,7 @@ </head> <body> <h1>Movitz: A Common Lisp OS development platform</h1> -<tt>$Id: movitz.html,v 1.6 2004/03/30 08:35:32 ffjeld Exp $</tt> +<tt>$Id: movitz.html,v 1.7 2004/04/07 01:13:41 ffjeld Exp $</tt> <h2><a href="files/">Files</a></h2> <p> The latest <a href="files/los0.img"> los0 kernel image</a> and its @@ -157,7 +157,7 @@ <li> <tt>map-stack-words</tt> works similarly for a control stack. A stack is wrapped as a vector specialized to <tt>(unsigned-byte -32)</tt> in memory, so it will not recognized as pointers by +32)</tt> in memory, so it will not be recognized as pointers by e.g. <tt>map-heap-words</tt>. Hence, this function must be used explicitly over each live control stack in order to capture all pointers in the system. Another reason why stacks are special, is that @@ -179,8 +179,10 @@ to be promoted from the two 256 KB buffers, so you cannot have more than this amount of live, dynamically allocated data. You may trigger the GC process explicitly with <tt>(stop-and-copy)</tt>. Note that -there are still several rough edges remaining this GC implementation, -e.g. it will not behave across any kind of interrupt. +there are still rough edges remaining this GC implementation. +E.g. there is no support for code-vectors migrating yet, although this +will only become an issue when new code-vectors are consed up (i.e. by +incremental compilation of some sort). <h2>About OS design in Common Lisp</h2>

1 0

[movitz-cvs] CVS update: movitz/losp/los0-gc.lisp
by Frode Vatvedt Fjeld 07 Apr '04

07 Apr '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv13793 Modified Files: los0-gc.lisp Log Message: Added a handler for the out-of-memory exception to automatically call stop-and-copy. So now the GC architecture should in principle be complete! Date: Tue Apr 6 20:45:54 2004 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.4 movitz/losp/los0-gc.lisp:1.5 --- movitz/losp/los0-gc.lisp:1.4 Tue Apr 6 19:47:26 2004 +++ movitz/losp/los0-gc.lisp Tue Apr 6 20:45:54 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Feb 21 17:48:32 2004 ;;;; -;;;; $Id: los0-gc.lisp,v 1.4 2004/04/06 23:47:26 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.5 2004/04/07 00:45:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -57,10 +57,13 @@ (define-primitive-function new-fast-cons () "Allocate a cons cell from nursery-space." (with-inline-assembly (:returns :eax) + retry-cons (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) (:movl (:edx 2) :ecx) (:cmpl #x3fff4 :ecx) - (:jge '(:sub-program () (:int 112))) + (:jge '(:sub-program () + (:int 112) + (:jmp 'retry-cons))) (:movl :eax (:edx :ecx 2)) (:movl :ebx (:edx :ecx 6)) (:leal (:edx :ecx 3) :eax) @@ -92,6 +95,11 @@ (:jb 'init-loop) (:movl #.(movitz:tag :infant-object) (:ebx -2)))) +(defun los0-handle-out-of-memory (exception interrupt-frame) + (declare (ignore exception interrupt-frame)) + (format t "~&;; Handling out-of-memory exception..") + (stop-and-copy)) + (defun install-los0-consing () (setf (%run-time-context-slot 'nursery-space) (allocate-duo-space)) @@ -104,6 +112,7 @@ (symbol-function 'new-malloc-clumps)) (setf (symbol-function 'new-malloc-clumps) old-malloc)) + (setf (interrupt-handler 112) 'los0-handle-out-of-memory) (values)) (defun install-old-consing ()

1 0

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

07 Apr '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv20592 Modified Files: los0.lisp Log Message: Minor edits. Date: Tue Apr 6 20:35:51 2004 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.10 movitz/losp/los0.lisp:1.11 --- movitz/losp/los0.lisp:1.10 Tue Apr 6 09:36:42 2004 +++ movitz/losp/los0.lisp Tue Apr 6 20:35:51 2004 @@ -9,14 +9,13 @@ ;;;; Created at: Fri Dec 1 18:08:32 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: los0.lisp,v 1.10 2004/04/06 13:36:42 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.11 2004/04/07 00:35:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ (provide :los0 :load-priority 0) (require :common-lisp) -(require :x86-pc/interrupt) (require :x86-pc/all) (require :x86-pc/io-space) (require :x86-pc/ne2k) @@ -37,7 +36,6 @@ muerte.ip6 muerte.ip4 muerte.mop - muerte.debug #+ignore muerte.x86-pc.serial)) (require :los0-gc)

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/debugger.lisp
by Frode Vatvedt Fjeld 07 Apr '04

07 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv1866 Modified Files: debugger.lisp Log Message: Renamed int-frame- to interrupt-frame- Date: Tue Apr 6 20:34:57 2004 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.5 movitz/losp/x86-pc/debugger.lisp:1.6 --- movitz/losp/x86-pc/debugger.lisp:1.5 Tue Apr 6 10:45:24 2004 +++ movitz/losp/x86-pc/debugger.lisp Tue Apr 6 20:34:57 2004 @@ -10,14 +10,14 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 22 10:09:18 2002 ;;;; -;;;; $Id: debugger.lisp,v 1.5 2004/04/06 14:45:24 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.6 2004/04/07 00:34:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ (provide :x86-pc/debugger) -(defpackage muerte.debug - (:use #:muerte.cl #:muerte #:muerte.x86-pc) +(defpackage muerte + ;; (:use #:muerte.cl #:muerte #:muerte.x86-pc) (:export #:*debugger-function* #:*debugger-condition* #:*backtrace-conflate-names* @@ -33,7 +33,7 @@ #:backtrace )) -(in-package muerte.debug) +(in-package muerte) (defparameter *backtrace-be-spartan-p* nil) @@ -481,8 +481,8 @@ (format t "#x~X " stack-frame)))) (typecase funobj (integer - (let* ((int-frame stack-frame) - (funobj (int-frame-ref int-frame :esi :lisp))) + (let* ((interrupt-frame stack-frame) + (funobj (interrupt-frame-ref interrupt-frame :esi :lisp))) (if (and conflate ;; When the interrupted function has a stack-frame, conflate it. (typep funobj 'function) @@ -492,18 +492,19 @@ (incf count) (print-leadin stack-frame count conflate-count) (setf conflate-count 0) - (let ((exception (int-frame-ref int-frame :exception :unsigned-byte32)) - (eip (int-frame-ref int-frame :eip :unsigned-byte32))) + (let ((exception (interrupt-frame-ref interrupt-frame :exception + :unsigned-byte32)) + (eip (interrupt-frame-ref interrupt-frame :eip :unsigned-byte32))) (typecase funobj (function (let ((delta (code-vector-offset (funobj-code-vector funobj) eip))) (if delta (format t "{Interrupt ~D in ~W at offset ~D. [#x~X]}" - exception (funobj-name funobj) delta int-frame) + exception (funobj-name funobj) delta interrupt-frame) (format t "{Interrupt ~D in ~W at EIP=#x~X. [#x~X]}" - exception (funobj-name funobj) eip int-frame)))) + exception (funobj-name funobj) eip interrupt-frame)))) (t (format t "{Interrupt ~D with ESI=#x~Z and EIP=#x~X. [#x~X]}" - exception funobj eip int-frame)))))))) + exception funobj eip interrupt-frame)))))))) (function (let ((name (funobj-name funobj))) (cond

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/scavenge.lisp
by Frode Vatvedt Fjeld 07 Apr '04

07 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv27542 Modified Files: scavenge.lisp Log Message: Renamed int-frame- to interrupt-frame- Date: Tue Apr 6 20:34:52 2004 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.5 movitz/losp/muerte/scavenge.lisp:1.6 --- movitz/losp/muerte/scavenge.lisp:1.5 Tue Apr 6 20:16:38 2004 +++ movitz/losp/muerte/scavenge.lisp Tue Apr 6 20:34:52 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Mar 29 14:54:08 2004 ;;;; -;;;; $Id: scavenge.lisp,v 1.5 2004/04/07 00:16:38 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.6 2004/04/07 00:34:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -108,10 +108,10 @@ ;; 1. Scavenge the interrupt-frame (map-heap-words function (+ nether-frame 2) - (+ frame (int-frame-index :ecx))) + (+ frame (interrupt-frame-index :ecx))) (let* ((interrupt-frame frame) (interrupted-eip-loc - (int-frame-ref interrupt-frame :eip :signed-byte30+2))) + (interrupt-frame-ref interrupt-frame :eip :signed-byte30+2))) ;; 2. Pop to interrupted frame (setf nether-frame frame frame (stack-frame-uplink frame))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/interrupt.lisp
by Frode Vatvedt Fjeld 07 Apr '04

07 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv18401 Modified Files: interrupt.lisp Log Message: Renamed int-frame- to interrupt-frame- Date: Tue Apr 6 20:34:47 2004 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.1 movitz/losp/muerte/interrupt.lisp:1.2 --- movitz/losp/muerte/interrupt.lisp:1.1 Tue Apr 6 20:12:23 2004 +++ movitz/losp/muerte/interrupt.lisp Tue Apr 6 20:34:47 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.1 2004/04/07 00:12:23 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.2 2004/04/07 00:34:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -22,7 +22,7 @@ `(with-inline-assembly (:returns :eax) (:movl (:esp ,(* 4 offset)) :eax))) -(define-compiler-macro int-frame-index (&whole form name &environment env) +(define-compiler-macro interrupt-frame-index (&whole form name &environment env) (let ((name (and (movitz:movitz-constantp name env) (movitz:movitz-eval name env)))) (if (not name) @@ -31,19 +31,20 @@ '(nil :eflags :eip :error-code :exception :ebp nil :ecx :eax :edx :ebx :esi :edi)))))) -(defun int-frame-index (name) +(defun interrupt-frame-index (name) (- 5 (position name '(nil :eflags :eip :error-code :exception :ebp nil :ecx :eax :edx :ebx :esi :edi)))) -(define-compiler-macro int-frame-ref (&whole form frame reg type &optional (offset 0) &environment env) - `(memref ,frame (+ (* 4 (int-frame-index ,reg)) ,offset) 0 ,type)) +(define-compiler-macro interrupt-frame-ref (&whole form frame reg type &optional (offset 0) + &environment env) + `(memref ,frame (+ (* 4 (interrupt-frame-index ,reg)) ,offset) 0 ,type)) -(defun int-frame-ref (frame reg type &optional (offset 0)) - (int-frame-ref frame reg type offset)) +(defun interrupt-frame-ref (frame reg type &optional (offset 0)) + (interrupt-frame-ref frame reg type offset)) -(defun (setf int-frame-ref) (x frame reg type) - (setf (memref frame (* 4 (int-frame-index reg)) 0 type) x)) +(defun (setf interrupt-frame-ref) (x frame reg type) + (setf (memref frame (* 4 (interrupt-frame-index reg)) 0 type) x)) (define-primitive-function default-interrupt-trampoline () "Default first-stage interrupt handler." @@ -118,8 +119,8 @@ (:jnz 'skip-interrupt-handler) ; if it's not a symbol, never mind. (:movl (:eax #.(movitz::slot-offset 'movitz::movitz-symbol 'movitz::function-value)) :esi) ; load new funobj from symbol into ESI - (:movl :ebp :ebx) ; pass INT-frame as arg1 - ;; (:movl :ebx (:ebp -4)) ; put INT-frame as our fake stack-frame's funobj. + (:movl :ebp :ebx) ; pass interrupt-frame as arg1 + ;; (:movl :ebx (:ebp -4)) ; put interrupt-frame as our fake stack-frame's funobj. (:movl (:ebp 4) :eax) ; pass interrupt number as arg 0. (:shll #.movitz::+movitz-fixnum-shift+ :eax) (:call (:esi #.(movitz::slot-offset 'movitz::movitz-funobj 'movitz::code-vector%2op))) @@ -150,18 +151,18 @@ (defvar *last-interrupt-frame* nil) -(defun interrupt-default-handler (number int-frame) +(defun interrupt-default-handler (number interrupt-frame) (declare (without-check-stack-limit)) (macrolet ((@ (fixnum-address &optional (type :lisp)) "Dereference the fixnum-address." `(memref ,fixnum-address 0 0 ,type))) - (let (($eip (+ int-frame (int-frame-index :eip))) - ($eax (+ int-frame (int-frame-index :eax))) - ($ebx (+ int-frame (int-frame-index :ebx))) - ($ecx (+ int-frame (int-frame-index :ecx))) - ($edx (+ int-frame (int-frame-index :edx))) - ($esi (+ int-frame (int-frame-index :esi))) - (*last-interrupt-frame* int-frame)) + (let (($eip (+ interrupt-frame (interrupt-frame-index :eip))) + ($eax (+ interrupt-frame (interrupt-frame-index :eax))) + ($ebx (+ interrupt-frame (interrupt-frame-index :ebx))) + ($ecx (+ interrupt-frame (interrupt-frame-index :ecx))) + ($edx (+ interrupt-frame (interrupt-frame-index :edx))) + ($esi (+ interrupt-frame (interrupt-frame-index :esi))) + (*last-interrupt-frame* interrupt-frame)) (block nil (case number (0 (error "Division by zero.")) @@ -169,7 +170,7 @@ (6 (error "Illegal instruction at ~@Z." $eip)) (13 (error "General protection error. EIP=~@Z, error-code: #x~X, EAX: ~@Z, EBX: ~@Z, ECX: ~@Z" $eip - (int-frame-ref int-frame :error-code :unsigned-byte32) + (interrupt-frame-ref interrupt-frame :error-code :unsigned-byte32) $eax $ebx $ecx)) (68 (warn "EIP: ~@Z EAX: ~@Z EBX: ~@Z ECX: ~@Z EDX: ~@Z" $eip $eax $ebx $ecx $edx) @@ -179,7 +180,7 @@ (dotimes (i 100000) (with-inline-assembly (:returns :nothing) (:nop)))) (66 (error "Unspecified type error at ~@Z in ~S with EAX=~@Z, ECX=~@Z." - $eip (@ (+ int-frame (int-frame-index :esi))) + $eip (@ (+ interrupt-frame (interrupt-frame-index :esi))) $eax $ecx)) (62 (error "Trying to save too many values: ~@Z." $ecx)) ((5 55) @@ -204,7 +205,7 @@ new-bottom) (break "Stack overload exception ~D at ESP=~@Z with bottom #x~X." number - (+ int-frame (int-frame-index :ebp)) + (+ interrupt-frame (interrupt-frame-index :ebp)) old-bottom)) (format *debug-io* "~&Stack-warning: Resetting stack-bottom to #x~X.~%" old-bottom) @@ -222,12 +223,13 @@ (when (symbolp name) (error 'unbound-variable :name name)))) ((100);; 101 102 103 104 105) - (let ((funobj (@ (+ int-frame (int-frame-index :esi)))) - (code (int-frame-ref int-frame :ecx :unsigned-byte8))) + (let ((funobj (@ (+ interrupt-frame (interrupt-frame-index :esi)))) + (code (interrupt-frame-ref interrupt-frame :ecx :unsigned-byte8))) (error 'wrong-argument-count :function funobj :argument-count (if (logbitp 7 code) - (ash (int-frame-ref int-frame :ecx :unsigned-byte32) + (ash (interrupt-frame-ref interrupt-frame + :ecx :unsigned-byte32) -24) code)))) (108

1 0

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

07 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv19936 Modified Files: packages.lisp Log Message: More symbols added. Date: Tue Apr 6 20:34:07 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.13 movitz/packages.lisp:1.14 --- movitz/packages.lisp:1.13 Tue Apr 6 10:35:14 2004 +++ movitz/packages.lisp Tue Apr 6 20:34:06 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.13 2004/04/06 14:35:14 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.14 2004/04/07 00:34:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1104,19 +1104,21 @@ #:*print-safely* - stack-ref - with-each-dynamic-context - stack-frame-uplink - current-stack-frame - current-dynamic-context - stack-frame-funobj - stack-frame-call-site - stack-frame-ref - check-stack-limit + #:stack-ref + #:with-each-dynamic-context + #:stack-frame-uplink + #:current-stack-frame + #:current-dynamic-context + #:stack-frame-funobj + #:stack-frame-call-site + #:stack-frame-ref + #:check-stack-limit + #:interrupt-frame-ref + #:interrupt-handler - *build-number* - *error-no-condition-for-debugger* - formatted-error + #:*build-number* + #:*error-no-condition-for-debugger* + #:formatted-error #:package-object-use-list #:package-object-internal-symbols @@ -1289,6 +1291,7 @@ #:+movitz-fixnum-factor+ #:+movitz-fixnum-shift+ + #:+movitz-fixnum-zmask+ #:+scan-skip-word+ #:constant0

1 0

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

07 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv11575 Modified Files: special-operators.lisp Log Message: There's something funny in my lisp-mode that sometimes causes comments to be messed up like this.. Date: Tue Apr 6 20:21:29 2004 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.17 movitz/special-operators.lisp:1.18 --- movitz/special-operators.lisp:1.17 Wed Mar 31 11:33:25 2004 +++ movitz/special-operators.lisp Tue Apr 6 20:21:28 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.17 2004/03/31 16:33:25 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.18 2004/04/07 00:21:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -711,9 +711,8 @@ as sub-form-result-mode = buried-result-modes then (or (cdr sub-form-result-mode) sub-form-result-mode) - as current-result-mode = (if (endp (cdr sub-form)) all but the - ;; last form have result-mode as - ;; declared + as current-result-mode = (if (endp (cdr sub-form)) + ;; all but the last form have result-mode as declared result-mode (car sub-form-result-mode)) as last-form-p = (endp (cdr sub-form))

1 0

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

07 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv17952 Modified Files: basic-functions.lisp Log Message: Added object-location-offset operator, but I'm not really sure it's useful afterall, so I commented it out for now. Date: Tue Apr 6 20:20:13 2004 Author: ffjeld Index: movitz/losp/muerte/basic-functions.lisp diff -u movitz/losp/muerte/basic-functions.lisp:1.9 movitz/losp/muerte/basic-functions.lisp:1.10 --- movitz/losp/muerte/basic-functions.lisp:1.9 Wed Mar 31 21:10:38 2004 +++ movitz/losp/muerte/basic-functions.lisp Tue Apr 6 20:20:12 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.9 2004/04/01 02:10:38 ffjeld Exp $ +;;;; $Id: basic-functions.lisp,v 1.10 2004/04/07 00:20:12 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -340,6 +340,18 @@ (defun object-location (object) "The location is the object's address divided by fixnum-factor." (object-location object)) + +;;;(define-compiler-macro object-location-offset (object) +;;; "The offset from the object's location to it's true address." +;;; `(with-inline-assembly (:returns :register) +;;; (:compile-form (:result-mode :register) ,object) +;;; (:shll ,movitz:+movitz-fixnum-shift+ (:result-register)) +;;; (:andl ,(* movitz:+movitz-fixnum-factor+ +;;; movitz:+movitz-fixnum-zmask+) +;;; (:result-register)))) +;;; +;;;(defun object-location-offset (object) +;;; (object-location-offset object)) (defun halt-cpu () (halt-cpu))

1 0