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

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv8308 Modified Files: symbols.lisp Log Message: Make %symbol-global-value a function, of course. Date: Fri Apr 16 15:24:20 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.9 movitz/losp/muerte/symbols.lisp:1.10 --- movitz/losp/muerte/symbols.lisp:1.9 Fri Apr 16 15:23:23 2004 +++ movitz/losp/muerte/symbols.lisp Fri Apr 16 15:24:20 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 23:55:41 2001 ;;;; -;;;; $Id: symbols.lisp,v 1.9 2004/04/16 19:23:23 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.10 2004/04/16 19:24:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -56,8 +56,11 @@ (defun set (symbol value) (setf (symbol-value symbol) value)) -(defmacro %symbol-global-value (symbol) +(define-compiler-macro %symbol-global-value (symbol) `(memref ,symbol ,(bt:slot-offset 'movitz:movitz-symbol 'movitz::value) 0 :lisp)) + +(defun %symbol-global-value (symbol) + (%symbol-global-value symbol)) (defun symbol-function (symbol) (let ((function-value

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv17516 Modified Files: symbols.lisp Log Message: Removed function symbol-global-value, added macro %symbol-global-value. Date: Fri Apr 16 15:23:23 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.8 movitz/losp/muerte/symbols.lisp:1.9 --- movitz/losp/muerte/symbols.lisp:1.8 Wed Apr 14 16:03:38 2004 +++ movitz/losp/muerte/symbols.lisp Fri Apr 16 15:23:23 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 23:55:41 2001 ;;;; -;;;; $Id: symbols.lisp,v 1.8 2004/04/14 20:03:38 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.9 2004/04/16 19:23:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -56,13 +56,8 @@ (defun set (symbol value) (setf (symbol-value symbol) value)) -(defun symbol-global-value (symbol) - (if symbol - (let ((x (movitz-accessor symbol movitz-symbol value))) - (if (eq x (load-global-constant unbound-value)) - (error 'unbound-value :name symbol) - x)) - nil)) +(defmacro %symbol-global-value (symbol) + `(memref ,symbol ,(bt:slot-offset 'movitz:movitz-symbol 'movitz::value) 0 :lisp)) (defun symbol-function (symbol) (let ((function-value

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv1445 Modified Files: integers.lisp Log Message: Minor typo. Date: Fri Apr 16 15:22:21 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.6 movitz/losp/muerte/integers.lisp:1.7 --- movitz/losp/muerte/integers.lisp:1.6 Thu Apr 15 09:10:37 2004 +++ movitz/losp/muerte/integers.lisp Fri Apr 16 15:22:21 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.6 2004/04/15 13:10:37 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.7 2004/04/16 19:22:21 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1088,7 +1088,7 @@ '(integer 0)) ((typep size '(integer 1 *)) (list 'integer 0 (1- (ash 1 size)))) - (t (error "Illegal size for signed-byte.")))) + (t (error "Illegal size for unsigned-byte.")))) (define-simple-typep (bit bitp) (x) (or (eq x 0) (eq x 1)))

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv9718 Modified Files: eval.lisp Log Message: We can use symbol-value to evaluate constant variables, I believe. Date: Fri Apr 16 15:21:51 2004 Author: ffjeld Index: movitz/losp/muerte/eval.lisp diff -u movitz/losp/muerte/eval.lisp:1.6 movitz/losp/muerte/eval.lisp:1.7 --- movitz/losp/muerte/eval.lisp:1.6 Thu Apr 15 09:16:28 2004 +++ movitz/losp/muerte/eval.lisp Fri Apr 16 15:21:51 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 19 21:15:12 2001 ;;;; -;;;; $Id: eval.lisp,v 1.6 2004/04/15 13:16:28 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.7 2004/04/16 19:21:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -49,7 +49,7 @@ (defun eval-symbol (form env) "3.1.2.1.1 Symbols as Forms" (if (symbol-constant-variable-p form) - (symbol-global-value form) + (symbol-value form) (let ((binding (env-binding env form))) (or (and binding (cdr binding)) (symbol-value form)))))

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv11392 Modified Files: packages.lisp Log Message: More symbols. Date: Fri Apr 16 15:21:13 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.18 movitz/packages.lisp:1.19 --- movitz/packages.lisp:1.18 Fri Apr 16 10:43:44 2004 +++ movitz/packages.lisp Fri Apr 16 15:21:13 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.18 2004/04/16 14:43:44 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.19 2004/04/16 19:21:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1149,6 +1149,9 @@ #:%run-time-context-slot #:shallow-copy + #:%symbol-global-value + #:define-global-variable + vector-element-type vector-element-size with-subvector-accessor @@ -1303,7 +1306,9 @@ #:code-vector%3op #:code-vector-word #:lu32 - + + #:+movitz-most-positive-fixnum+ + #:+movitz-most-negative-fixnum+ #:+movitz-fixnum-factor+ #:+movitz-fixnum-shift+ #:+movitz-fixnum-zmask+

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv19582 Modified Files: compiler.lisp Log Message: Fixed a nasty compiler bug that would let two function parameters be assigned to the same register. By some weird accident this bug didn't seem to do much actual harm, but the potential was certainly there. Date: Fri Apr 16 15:20:46 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.48 movitz/compiler.lisp:1.49 --- movitz/compiler.lisp:1.48 Thu Apr 15 15:58:20 2004 +++ movitz/compiler.lisp Fri Apr 16 15:20:46 2004 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.48 2004/04/15 19:58:20 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.49 2004/04/16 19:20:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2451,11 +2451,13 @@ (destructuring-bind (binding &key init-with-register init-with-type protect-registers protect-carry) (cdr i) - (declare (ignore binding protect-carry init-with-type)) + (declare (ignore protect-carry init-with-type)) (when init-with-register (setf free-so-far (remove-if (lambda (x) - (or (eq x init-with-register) - (member x protect-registers))) + (if (new-binding-located-p binding frame-map) + (eq x (new-binding-location binding frame-map)) + (or (eq x init-with-register) + (member x protect-registers)))) free-so-far))))) (t (case (instruction-is i) ((nil :call) @@ -2476,8 +2478,7 @@ (remove-if (lambda (r) (tree-search i r)) free-so-far))) - ((:load-constant :load-lexical :store-lexical :init-lexvar - :cons-get :endp :incf-lexvar) + ((:load-constant :load-lexical :store-lexical :cons-get :endp :incf-lexvar :init-lexvar) (assert (gethash (instruction-is i) *extended-code-expanders*)) (unless (can-expand-extended-p i frame-map) (return (values nil t))) @@ -3764,6 +3765,9 @@ (and (edx-var env) (new-binding-location (edx-var env) frame-map :default nil)))) ;; (warn "l0: ~S, l1: ~S" location-0 location-1) + (assert (not (and location-0 + (eql location-0 location-1))) () + "Compiler bug: two bindings in same location.") (cond ((and (eq :ebx location-0) (eq :eax location-1)) `((:xchgl :eax :ebx)))

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv13495 Modified Files: vga.lisp Log Message: Added some VGA register accessors. Date: Fri Apr 16 15:17:55 2004 Author: ffjeld Index: movitz/losp/x86-pc/vga.lisp diff -u movitz/losp/x86-pc/vga.lisp:1.3 movitz/losp/x86-pc/vga.lisp:1.4 --- movitz/losp/x86-pc/vga.lisp:1.3 Mon Jan 19 06:23:52 2004 +++ movitz/losp/x86-pc/vga.lisp Fri Apr 16 15:17:55 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 25 14:08:20 2001 ;;;; -;;;; $Id: vga.lisp,v 1.3 2004/01/19 11:23:52 ffjeld Exp $ +;;;; $Id: vga.lisp,v 1.4 2004/04/16 19:17:55 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -19,18 +19,18 @@ (in-package muerte.x86-pc) -(defun (setf vga-crt-controller-register) (value register) - (let* ((address-register (if (logbitp 0 (io-port #x3cc :unsigned-byte8)) #x3d4 #x3b4)) - (data-register (1+ address-register))) - (setf (io-port address-register :unsigned-byte8) register - (io-port data-register :unsigned-byte8) value))) - (defun vga-crt-controller-register (register) (let* ((address-register (if (logbitp 0 (io-port #x3cc :unsigned-byte8)) #x3d4 #x3b4)) (data-register (1+ address-register))) (setf (io-port address-register :unsigned-byte8) register) (io-port data-register :unsigned-byte8))) +(defun (setf vga-crt-controller-register) (value register) + (let* ((address-register (if (logbitp 0 (io-port #x3cc :unsigned-byte8)) #x3d4 #x3b4)) + (data-register (1+ address-register))) + (setf (io-port address-register :unsigned-byte8) register + (io-port data-register :unsigned-byte8) value))) + (defun vga-graphics-register (register) (setf (io-port #x3ce :unsigned-byte8) register) (io-port #x3cf :unsigned-byte8)) @@ -60,3 +60,17 @@ (#b01 (values #xa0000 #xaffff)) (#b10 (values #xb0000 #xb7fff)) (#b11 (values #xb8000 #xbffff)))) + +(defun vga-horizontal-display-end () + (1+ (vga-crt-controller-register 1))) + +(defun vga-vertical-display-end () + (let ((overflow (vga-crt-controller-register 7))) + (+ 1 + (vga-crt-controller-register #x12) + (if (logbitp 1 overflow) #x100 0) + (if (logbitp 6 overflow) #x200 0)))) + +(defun vga-character-height () + (1+ (ldb (byte 5 0) + (vga-crt-controller-register 9))))

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv19552 Modified Files: textmode.lisp Log Message: Changed the textmode parameters *screen* etc. to be "global variables". Re-wrote textmode-scroll-down. Various small fixes. Date: Fri Apr 16 15:17:22 2004 Author: ffjeld Index: movitz/losp/x86-pc/textmode.lisp diff -u movitz/losp/x86-pc/textmode.lisp:1.4 movitz/losp/x86-pc/textmode.lisp:1.5 --- movitz/losp/x86-pc/textmode.lisp:1.4 Wed Mar 31 21:15:21 2004 +++ movitz/losp/x86-pc/textmode.lisp Fri Apr 16 15:17:22 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Thu Nov 9 15:38:56 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: textmode.lisp,v 1.4 2004/04/01 02:15:21 ffjeld Exp $ +;;;; $Id: textmode.lisp,v 1.5 2004/04/16 19:17:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -23,16 +23,24 @@ (in-package muerte.x86-pc) -(defconstant *screen* #xb8000) -(defconstant *screen-width* 80) -(defconstant *screen-height* 24) -(defconstant *screen-stride* 80) - -(defparameter *cursor-x* (rem (vga-cursor-location) 80)) -(defparameter *cursor-y* (truncate (vga-cursor-location) 80)) -(defparameter *color* #x0700) +(define-global-variable *screen* + (vga-memory-map)) -(defparameter *simple-console-state* 'initialized) +(define-global-variable *cursor-x* + (rem (vga-cursor-location) 80)) + +(define-global-variable *cursor-y* + (truncate (vga-cursor-location) 80)) + +(define-global-variable *screen-width* + (vga-horizontal-display-end)) + +(define-global-variable *screen-height* + (truncate (vga-vertical-display-end) + (vga-character-height))) + +(define-global-variable *screen-stride* + (vga-horizontal-display-end)) (defun move-vga-cursor (x y) (let ((dest (+ x (* y *screen-stride*)))) @@ -59,91 +67,75 @@ value) (defun textmode-write-char (c) - (cond - #+ignore - ((and (not (eq 'initialized *simple-console-state*)) - (/= #xabba (memref-int #xb8000 0 0 :unsigned-byte16))) - (setf (memref-int #xb8000 0 0 :unsigned-byte16) #xabba - (memref-int #xb8000 0 1 :unsigned-byte16) 4 - (memref-int #xb8000 0 8 :unsigned-byte8) #x46 ; (char-code c) - (memref-int #xb8000 1 8 :unsigned-byte8) #xe0)) - #+ignore - ((not (eq 'initialized *simple-console-state*)) - (let ((pos (memref-int #xb8000 0 1 :unsigned-byte16))) - (when (< pos (* 80 25 2)) - (setf (memref-int #xb8000 0 (* 2 pos) :unsigned-byte8) (char-code c) - (memref-int #xb8000 1 (* 2 pos) :unsigned-byte8) #xe0 - (memref-int #xb8000 0 1 :unsigned-byte16) (1+ pos))))) - (t (case c - (#\newline - (setf *cursor-x* 0) - (cond - ((= *screen-height* *cursor-y*) - (textmode-scroll-down) - (move-vga-cursor 0 *cursor-y*)) - (t (incf *cursor-y*) - (move-vga-cursor 0 *cursor-y*)))) - (#\backspace - (if (/= 0 *cursor-x*) - (decf *cursor-x*) - (progn - (decf *cursor-y*) - (setf *cursor-x* (1- *screen-width*)))) - (move-vga-cursor *cursor-x* *cursor-y*)) - (#\return - (setf *cursor-x* 0) - (move-vga-cursor 0 *cursor-y*)) - (#\tab - (textmode-write-char #\space) - (do () ((zerop (rem *cursor-x* 8))) - (textmode-write-char #\space))) - (t (let ((x *cursor-x*) - (y *cursor-y*)) - (when (>= x *screen-width*) - (textmode-write-char #\newline) - (setf x *cursor-x* y *cursor-y*)) - (let ((index (+ x (* y *screen-stride*)))) - (setf (memref-int *screen* 0 index :unsigned-byte16 t) - (logior #x0700 (char-code c))) - (move-vga-cursor (setf *cursor-x* (1+ x)) y))))))) + (case c + (#\newline + (setf *cursor-x* 0) + (cond + ((>= (1+ *cursor-y*) *screen-height*) + (textmode-scroll-down) + (setf *cursor-y* (1- *screen-height*))) + (t (incf *cursor-y*))) + (move-vga-cursor 0 *cursor-y*)) + (#\backspace + (if (/= 0 *cursor-x*) + (decf *cursor-x*) + (progn + (decf *cursor-y*) + (setf *cursor-x* (1- *screen-width*)))) + (move-vga-cursor *cursor-x* *cursor-y*)) + (#\return + (setf *cursor-x* 0) + (move-vga-cursor 0 *cursor-y*)) + (#\tab + (textmode-write-char #\space) + (do () ((zerop (rem *cursor-x* 8))) + (textmode-write-char #\space))) + (t (let ((x *cursor-x*) + (y *cursor-y*)) + (when (>= x *screen-width*) + (textmode-write-char #\newline) + (setf x *cursor-x* y *cursor-y*)) + (let ((index (+ x (* y *screen-stride*)))) + (setf (memref-int *screen* 0 index :unsigned-byte16 t) + (logior #x0700 (char-code c))) + (move-vga-cursor (setf *cursor-x* (1+ x)) y))))) nil) +(defun textmode-copy-line (destination source count) + (check-type count (integer 0 511)) + (check-type source (unsigned-byte 20)) + (check-type destination (unsigned-byte 20)) + (with-inline-assembly (:returns :nothing) + (:compile-form (:result-mode :eax) source) + (:compile-form (:result-mode :ebx) destination) + (:compile-form (:result-mode :edx) count) + (:andl #x-16 :eax) + (:andl #x-16 :ebx) + (:andl #x-8 :edx) + (:shrl 2 :eax) + (:shrl 2 :ebx) + (:shrl 1 :edx) + (:jz 'end-copy-loop) + copy-loop + ((:gs-override) :movl (:eax :edx -4) :ecx) + ((:gs-override) :movl :ecx (:ebx :edx -4)) + (:subl 4 :edx) + (:ja 'copy-loop) + end-copy-loop)) + (defun textmode-scroll-down () - "Scroll the console down one line." (declare (special muerte.lib::*scroll-offset*)) (incf muerte.lib::*scroll-offset*) - (with-inline-assembly (:returns :nothing) - (:movl #xb8000 :eax) - (:movl #.(cl:+ #xb8000 160) :ebx) - (:movl #.(cl:* 80 24 1) :ecx) - copy-loop - ((:gs-override) :movw (:ebx) :dx) - ((:gs-override) :movw :dx (:eax)) - (:addl 2 :ebx) - (:addl 2 :eax) - (:subl 1 :ecx) - (:jnz 'copy-loop) - (:movl #.(cl:* 80 1) :ecx) - clear-loop - ((:gs-override) :movw #x0720 (:eax)) - (:addl 2 :eax) - (:subl 1 :ecx) - (:jnz 'clear-loop))) + (loop with stride = (* 2 *screen-stride*) + for y below *screen-height* + as src from (+ *screen* stride) by stride + as dst from *screen* by stride + do (textmode-copy-line dst src *screen-width*))) (defun textmode-clear-line (from-column line) (let ((dest (+ *screen* (* line 80 2) (* from-column 2)))) (dotimes (i (- 80 from-column)) - (setf (memref-int dest 0 i :unsigned-byte16 t) #x0720)) - #+ignore - (with-inline-assembly (:returns :nothing) - (:pushl :edi) - (:compile-form (:result-mode :eax) dest) - (:movl :eax :edi) - (:shrl #.movitz:+movitz-fixnum-shift+ :edi) - (:movl #.(cl:* 80 1) :ecx) - (:movw #x0720 :ax) - ((:repz) :stosw) - (:popl :edi)))) + (setf (memref-int dest 0 i :unsigned-byte16 t) #x0720)))) (defun write-word (word) (let ((dest (+ *screen* (* *cursor-x* 2) (* *cursor-y* 160)))) @@ -220,12 +212,12 @@ "This function can act as *terminal-io* without/before CLOS support." (declare (dynamic-extent args)) (case op + (muerte::stream-write-char + (textmode-write-char (car args))) (muerte::stream-fresh-line (when (plusp (cursor-column)) (textmode-write-char #\Newline) t)) - (muerte::stream-write-char - (textmode-write-char (car args))) (muerte::stream-read-char (loop when (muerte.x86-pc.keyboard:poll-char) return it)) (muerte::stream-read-char-no-hang

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv26126 Modified Files: bootblock.lisp Log Message: Removed the video-initialization part of the bootloader, because it shouldn't be needed anymore. Date: Fri Apr 16 15:15:20 2004 Author: ffjeld Index: movitz/bootblock.lisp diff -u movitz/bootblock.lisp:1.7 movitz/bootblock.lisp:1.8 --- movitz/bootblock.lisp:1.7 Thu Apr 15 09:03:16 2004 +++ movitz/bootblock.lisp Fri Apr 16 15:15:20 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Mon Oct 9 20:47:19 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: bootblock.lisp,v 1.7 2004/04/15 13:03:16 ffjeld Exp $ +;;;; $Id: bootblock.lisp,v 1.8 2004/04/16 19:15:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -209,17 +209,6 @@ (movw 'entering :si) ; Print welcome message (call 'print) - (:movb #xf :ah) - (:int #x10) ; - (:andb #x7f :al) - (:cmpb #x3 :al) - (:je 'video-ok) - (:movw #x0083 :ax) ; set screen mode - (:int #x10) - (:movb 2 :ah) ; set cursor position - (:int #x10) - video-ok - ;; Read the cursor position into DH (row) and DL (column). (:movb 3 :ah) (:movb 0 :bh)

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7751 Modified Files: basic-macros.lisp Log Message: Added macro define-global-variable. Date: Fri Apr 16 14:55:07 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.10 movitz/losp/muerte/basic-macros.lisp:1.11 --- movitz/losp/muerte/basic-macros.lisp:1.10 Wed Apr 14 17:59:34 2004 +++ movitz/losp/muerte/basic-macros.lisp Fri Apr 16 14:55:07 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.10 2004/04/14 21:59:34 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.11 2004/04/16 18:55:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1040,6 +1040,12 @@ (:je 'boundp-done) (:stc) boundp-done))) + +(defmacro define-global-variable (name init-form &optional docstring) + "A global variable will be accessed by ignoring local bindings." + `(progn + (defparameter ,name ,init-form ,docstring) + (define-symbol-macro ,name (%symbol-global-value ',name)))) (require :muerte/setf)

1 0