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

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

17 Nov '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv23374 Modified Files: los0.lisp Log Message: Renamed dynamic-load to dynamic-variable-lookup, and dynamic-store to dynamic-variable-store. Date: Wed Nov 17 14:33:16 2004 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.27 movitz/losp/los0.lisp:1.28 --- movitz/losp/los0.lisp:1.27 Sun Nov 14 23:57:39 2004 +++ movitz/losp/los0.lisp Wed Nov 17 14:33:11 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.27 2004/11/14 22:57:39 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.28 2004/11/17 13:33:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -53,6 +53,10 @@ (defun test1 () (unwind-protect 0 (the integer 1))) +(defun x (bios32) + (warn "X: ~S" (memref-int bios32)) + (warn "X: ~S" (= (memref-int bios32) #x5f32335f))) + (defun test2 () (funcall (compile @@ -1579,7 +1583,7 @@ (:movl :ecx :eax) (:ret))) -(define-primitive-function dynamic-load-shallow (symbol) +(define-primitive-function dynamic-variable-lookup-shallow (symbol) "Load the dynamic value of SYMBOL into EAX." (with-inline-assembly (:returns :multiple-values) (:movl (:eax (:offset movitz-symbol value)) :eax) @@ -1587,13 +1591,13 @@ (:je '(:sub-program (unbound) (:int 99))) (:ret))) -(define-primitive-function dynamic-load-unprotected-shallow (symbol) +(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-store-shallow (symbol value) +(define-primitive-function dynamic-variable-store-shallow (symbol value) "Store VALUE (ebx) in the dynamic binding of SYMBOL (eax). Preserves EBX and EAX." (with-inline-assembly (:returns :multiple-values) @@ -1610,9 +1614,9 @@ (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-store dynamic-store-shallow) - (install muerte::dynamic-load-unprotected dynamic-load-unprotected-shallow) - (prog1 (install muerte::dynamic-load dynamic-load-shallow) + (install muerte::dynamic-variable-store dynamic-variable-store-shallow) + (install muerte::dynamic-variable-lookup-unbound dynamic-variable-lookup-unbound-shallow) + (prog1 (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."

1 0

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

17 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv23352 Modified Files: special-operators-cl.lisp Log Message: Renamed dynamic-load to dynamic-variable-lookup, and dynamic-store to dynamic-variable-store. Date: Wed Nov 17 14:33:03 2004 Author: ffjeld Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.35 movitz/special-operators-cl.lisp:1.36 --- movitz/special-operators-cl.lisp:1.35 Tue Nov 16 00:10:24 2004 +++ movitz/special-operators-cl.lisp Wed Nov 17 14:33:03 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.35 2004/11/15 23:10:24 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.36 2004/11/17 13:33:03 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -623,7 +623,7 @@ :form value-form :result-mode :ebx) `((:load-constant ,var :eax) - (:globally (:call (:edi (:edi-offset dynamic-store))))))))))) + (:locally (:call (:edi (:edi-offset dynamic-variable-store))))))))))) (compiler-values () :code code :returns last-returns @@ -1253,11 +1253,11 @@ `((:locally (:movl :esp (:edi (:edi-offset raw-scratch0)))) ,cleanup-entry - ;; Modify unwind-protect dyn-env-entry to be normal continuation + ;; Now (?), modify unwind-protect dyn-env-entry to be normal continuation (:locally (:movl (:edi (:edi-offset unbound-value)) :edx)) (:movl :edx (:esp 4)) ; not unwind-protect-tag (:movl ',continue-label (:esp 8)) ; new jumper index - + (:locally (:pushl (:edi (:edi-offset raw-scratch0))))) ; push final-continuation ;; Execute cleanup-forms. (compiler-call #'compile-form-unprotected @@ -1274,8 +1274,14 @@ (:locally (:bound (:edi (:edi-offset stack-bottom)) :eax)) (:store-lexical ,next-continuation-step-binding :eax :type t)) ,@cleanup-forms)) - `((:load-lexical ,next-continuation-step-binding :edx) - (:locally (:popl (:edi (:edi-offset raw-scratch0)))) ; pop final continuation + `((:locally (:popl (:edi (:edi-offset raw-scratch0)))) ; pop final continuation + +;;; ;; Now (?), modify unwind-protect dyn-env-entry to be normal continuation +;;; (:locally (:movl (:edi (:edi-offset unbound-value)) :edx)) +;;; (:movl :edx (:esp 4)) ; not unwind-protect-tag +;;; (:movl ',continue-label (:esp 8)) ; new jumper index + + (:load-lexical ,next-continuation-step-binding :edx) (:locally (:movl :esi (:edi (:edi-offset scratch1)))) (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) (:movl :edx :esp) ; enter non-local jump stack mode (possibly).

1 0

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

17 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv23332 Modified Files: image.lisp Log Message: Renamed dynamic-load to dynamic-variable-lookup, and dynamic-store to dynamic-variable-store. Date: Wed Nov 17 14:32:55 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.78 movitz/image.lisp:1.79 --- movitz/image.lisp:1.78 Sat Nov 13 17:10:09 2004 +++ movitz/image.lisp Wed Nov 17 14:32:54 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.78 2004/11/13 16:10:09 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.79 2004/11/17 13:32:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -161,17 +161,17 @@ :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) - (dynamic-load-unprotected + (dynamic-variable-lookup-unbound :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-load + (dynamic-variable-lookup :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-store + (dynamic-variable-store :map-binary-write 'movitz-intern-code-vector :binary-tag :primitive-function :map-binary-read-delayed 'movitz-word-code-vector

1 0

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

17 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv23313 Modified Files: compiler.lisp Log Message: Renamed dynamic-load to dynamic-variable-lookup, and dynamic-store to dynamic-variable-store. Date: Wed Nov 17 14:32:47 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.106 movitz/compiler.lisp:1.107 --- movitz/compiler.lisp:1.106 Tue Nov 16 00:08:57 2004 +++ movitz/compiler.lisp Wed Nov 17 14:32: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.106 2004/11/15 23:08:57 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.107 2004/11/17 13:32:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -5602,7 +5602,7 @@ :modifies nil :final-form form :code `((:load-constant ,form :eax) - (:call (:edi ,(global-constant-offset 'dynamic-load)))))) + (:call (:edi ,(global-constant-offset 'dynamic-variable-lookup)))))) (t (check-type binding dynamic-binding) (compiler-values () :returns :eax @@ -5610,7 +5610,7 @@ :modifies nil :final-form form :code `((:load-constant ,form :eax) - (:call (:edi ,(global-constant-offset 'dynamic-load)))))))))) + (:call (:edi ,(global-constant-offset 'dynamic-variable-lookup)))))))))) (define-compiler compile-lambda-form (&form form) "3.1.2.2.4 Lambda Forms"

1 0

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

15 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv19292 Modified Files: special-operators-cl.lisp Log Message: Change the compilation of unwind-protect to only use a single dynamic-env entry. Date: Tue Nov 16 00:10:24 2004 Author: ffjeld Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.34 movitz/special-operators-cl.lisp:1.35 --- movitz/special-operators-cl.lisp:1.34 Sat Nov 13 15:49:51 2004 +++ movitz/special-operators-cl.lisp Tue Nov 16 00:10:24 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.34 2004/11/13 14:49:51 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.35 2004/11/15 23:10:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1235,15 +1235,9 @@ :returns :multiple-values :code (append ;; install default continuation dynamic-env.. - `((:locally (:pushl (:edi (:edi-offset dynamic-env)))) ; uplink - (:declare-label-set ,continue-label (,continue)) - (:pushl ',continue-label) - (:locally (:pushl (:edi (:edi-offset unbound-value)))) - (:pushl :ebp) - (:locally (:movl :esp (:edi (:edi-offset dynamic-env))))) - ;; install unwind-protect dynamic-env.. `((:locally (:pushl (:edi (:edi-offset dynamic-env)))) (:declare-label-set ,cleanup-label (,cleanup-entry)) + (:declare-label-set ,continue-label (,continue)) (:pushl ',cleanup-label) ; jumper index (:globally (:pushl (:edi (:edi-offset unwind-protect-tag)))) ; tag (:pushl :ebp) ; stack-frame @@ -1256,13 +1250,14 @@ :result-mode :multiple-values :form protected-form) ;; From now on, take care not to touch current-values from protected-form. - `((:leal (:esp 16) :edx) ; default final continuation - (:locally (:movl :edx (:edi (:edi-offset raw-scratch0)))) + `((:locally (:movl :esp (:edi (:edi-offset raw-scratch0)))) ,cleanup-entry - (:movl (:esp 12) :edx) ; pop out of unwind-protect - (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) - (:popl :ebp) - (:leal (:esp 12) :esp) + + ;; Modify unwind-protect dyn-env-entry to be normal continuation + (:locally (:movl (:edi (:edi-offset unbound-value)) :edx)) + (:movl :edx (:esp 4)) ; not unwind-protect-tag + (:movl ',continue-label (:esp 8)) ; new jumper index + (:locally (:pushl (:edi (:edi-offset raw-scratch0))))) ; push final-continuation ;; Execute cleanup-forms. (compiler-call #'compile-form-unprotected @@ -1295,7 +1290,6 @@ (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) (:popl :ebp) (:leal (:esp 12) :esp)))))))) - (define-special-operator if (&all all &form form &env env &result-mode result-mode) (destructuring-bind (test-form then-form &optional else-form)

1 0

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

15 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv19254 Modified Files: compiler.lisp Log Message: Disable optimize-code-dirties, because the optimization it performed wasn't safe. Date: Tue Nov 16 00:08:57 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.105 movitz/compiler.lisp:1.106 --- movitz/compiler.lisp:1.105 Sat Nov 13 17:13:01 2004 +++ movitz/compiler.lisp Tue Nov 16 00:08:57 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.105 2004/11/13 16:13:01 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.106 2004/11/15 23:08:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1457,7 +1457,9 @@ "These optimizations may rearrange register usage in a way that is incompatible with other optimizations that track register usage. So this is performed just once, initially." - (labels + unoptimized-code + #+ignore + (labels ; This stuff doesn't work.. ((explain (always format &rest args) (when (or always *explain-peephole-optimizations*) (warn "Peephole: ~?~&----------------------------" format args))) @@ -1488,16 +1490,15 @@ as i1 = (first pc) ; current instruction, collected by default. and i2 = (second pc) and i3 = (third pc) while pc - do (cond - ((let ((regx (register-operand (twop-src i1 :movl))) - (regy (register-operand (twop-dst i1 :movl)))) - (and regx regy - (eq regx (twop-dst i2 :movl)) - (eq regx (twop-src i3 :cmpl)) - (eq regy (twop-dst i3 :cmpl)))) - (setq p (list `(:cmpl ,(twop-src i2) ,(twop-src i1))) - next-pc (nthcdr 3 pc)) - (explain nil "4: ~S for ~S" p (subseq pc 0 4)))) + do (let ((regx (register-operand (twop-src i1 :movl))) + (regy (register-operand (twop-dst i1 :movl)))) + (when (and regx regy + (eq regx (twop-dst i2 :movl)) + (eq regx (twop-src i3 :cmpl)) + (eq regy (twop-dst i3 :cmpl))) + (setq p (list `(:cmpl ,(twop-src i2) ,regx) i1) + next-pc (nthcdr 3 pc)) + (explain t "4: ~S for ~S [regx ~S, regy ~S]" p (subseq pc 0 5) regx regy))) nconc p))) (defun optimize-code-internal (unoptimized-code recursive-count &rest key-args

1 0

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

15 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv21455 Modified Files: movitz.lisp Log Message: *** empty log message *** Date: Mon Nov 15 15:42:16 2004 Author: ffjeld Index: movitz/movitz.lisp diff -u movitz/movitz.lisp:1.9 movitz/movitz.lisp:1.10 --- movitz/movitz.lisp:1.9 Thu Jul 29 02:13:09 2004 +++ movitz/movitz.lisp Mon Nov 15 15:42:15 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Mon Oct 9 20:52:58 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: movitz.lisp,v 1.9 2004/07/29 00:13:09 ffjeld Exp $ +;;;; $Id: movitz.lisp,v 1.10 2004/11/15 14:42:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -31,7 +31,7 @@ (ldb (byte 32 0) (- +code-vector-word-offset+))) -(defconstant +movitz-multiple-values-limit+ 127) +(defvar +movitz-multiple-values-limit+ 63) (defvar *bq-level* 0) (defvar *default-image-init-file* #p"losp/los0.lisp")

1 0

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

14 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv31843 Modified Files: vga.lisp Log Message: Changed the signature of memref-int. Date: Sun Nov 14 23:58:33 2004 Author: ffjeld Index: movitz/losp/x86-pc/vga.lisp diff -u movitz/losp/x86-pc/vga.lisp:1.5 movitz/losp/x86-pc/vga.lisp:1.6 --- movitz/losp/x86-pc/vga.lisp:1.5 Wed Apr 21 18:24:16 2004 +++ movitz/losp/x86-pc/vga.lisp Sun Nov 14 23:58:33 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.5 2004/04/21 16:24:16 ffjeld Exp $ +;;;; $Id: vga.lisp,v 1.6 2004/11/14 22:58:33 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -314,7 +314,7 @@ (defun vmemwr (dst-off src start end) (loop for i from start below end as dst upfrom dst-off - do (setf (memref-int (vga-memory-map) 0 dst :unsigned-byte8 t) + do (setf (memref-int (vga-memory-map) :index dst :type :unsigned-byte8) (aref src i))) (values))

1 0

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

14 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv31822 Modified Files: textmode.lisp Log Message: Changed the signature of memref-int. Date: Sun Nov 14 23:58:24 2004 Author: ffjeld Index: movitz/losp/x86-pc/textmode.lisp diff -u movitz/losp/x86-pc/textmode.lisp:1.12 movitz/losp/x86-pc/textmode.lisp:1.13 --- movitz/losp/x86-pc/textmode.lisp:1.12 Thu Sep 23 13:05:51 2004 +++ movitz/losp/x86-pc/textmode.lisp Sun Nov 14 23:58:23 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.12 2004/09/23 11:05:51 ffjeld Exp $ +;;;; $Id: textmode.lisp,v 1.13 2004/11/14 22:58:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -95,10 +95,9 @@ (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))))) + (setf (memref-int *screen* :index (+ x (* y *screen-stride*)) :type :unsigned-byte16) + (logior #x0700 (char-code c))) + (move-vga-cursor (setf *cursor-x* (1+ x)) y)))) nil) (defun textmode-copy-line (destination source count) @@ -137,19 +136,19 @@ (defun textmode-clear-line (from-column line) (let ((dest (+ *screen* (* line *screen-width* 2) (* from-column 2)))) (dotimes (i (- *screen-width* from-column)) - (setf (memref-int dest 0 i :unsigned-byte16 t) #x0720)))) + (setf (memref-int dest :index i :type :unsigned-byte16) #x0720)))) (defun write-word (word) (let ((dest (+ *screen* (* *cursor-x* 2) (* *cursor-y* *screen-width* 2)))) - (setf (memref-int dest 0 0 :unsigned-byte16 t) #x0723 - (memref-int dest 0 1 :unsigned-byte16 t) #x0778) + (setf (memref-int dest :index 0 :type :unsigned-byte16) #x0723 + (memref-int dest :index 1 :type :unsigned-byte16) #x0778) (write-word-lowlevel word (+ dest 4)) (textmode-write-char #\newline))) (defun write-word-nl (word) (let ((dest (+ *screen* (* *cursor-x* 2) (* *cursor-y* 160)))) - (setf (memref-int dest 0 0 :unsigned-byte16 t) #x0723 - (memref-int dest 0 1 :unsigned-byte16 t) #x0778) + (setf (memref-int dest :index 0 :type :unsigned-byte16) #x0723 + (memref-int dest :index 1 :type :unsigned-byte16) #x0778) (write-word-lowlevel word (+ dest 4)))) (defun write-word-bottom (word)

1 0

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

14 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv31796 Modified Files: textmode-console.lisp Log Message: Changed the signature of memref-int. Date: Sun Nov 14 23:58:16 2004 Author: ffjeld Index: movitz/losp/x86-pc/textmode-console.lisp diff -u movitz/losp/x86-pc/textmode-console.lisp:1.3 movitz/losp/x86-pc/textmode-console.lisp:1.4 --- movitz/losp/x86-pc/textmode-console.lisp:1.3 Mon Jan 19 12:23:52 2004 +++ movitz/losp/x86-pc/textmode-console.lisp Sun Nov 14 23:58:16 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Jul 8 15:13:24 2003 ;;;; -;;;; $Id: textmode-console.lisp,v 1.3 2004/01/19 11:23:52 ffjeld Exp $ +;;;; $Id: textmode-console.lisp,v 1.4 2004/11/14 22:58:16 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -62,14 +62,14 @@ (* line (console-width console) 2) (* from-column 2)))) (dotimes (i (- (console-width console) from-column)) - (setf (memref-int dest 0 i :unsigned-byte16) #x0720)) + (setf (memref-int dest :index i :type :unsigned-byte16) #x0720)) nil)) (defmethod (setf console-char) (character (console vga-text-console) x y) (when (and (below x (console-width console)) (below y (console-height console))) (let ((index (+ x (* y (stride console))))) - (setf (memref-int (base console) 0 index :unsigned-byte16) + (setf (memref-int (base console) :index index :type :unsigned-byte16) (logior (ash (color console) 8) (char-code character))))) character) @@ -77,7 +77,7 @@ (when (and (below x (console-width console)) (below y (console-height console))) (let* ((index (+ x (* y (stride console)))) - (code (memref-int (base console) 0 index :unsigned-byte16))) + (code (memref-int (base console) :index index :type :unsigned-byte16))) (code-char (ldb (byte 8 0) code))))) (defmethod put-string ((console vga-text-console) string x y @@ -88,7 +88,7 @@ for column from x below (console-width console) for i from start below end as character = (char string i) - do (setf (memref-int base 0 cursor :unsigned-byte16) + do (setf (memref-int base :index cursor :type :unsigned-byte16) (logior color (char-code character))))) string) @@ -97,7 +97,7 @@ (loop with base = (base console) for index upfrom (+ x (* y (stride console))) for column from x below (console-width console) - do (setf (memref-int base 0 index :unsigned-byte16) + do (setf (memref-int base :index index :type :unsigned-byte16) #x0720)))) (defmethod scroll-down ((console vga-text-console)) @@ -106,8 +106,8 @@ for row from (base console) by ystride do (loop with next-row = (+ row ystride) for x below (console-width console) - do (setf (memref-int row 0 x :unsigned-byte16) - (memref-int next-row 0 x :unsigned-byte16)))) + do (setf (memref-int row :index x :type :unsigned-byte16) + (memref-int next-row :index x :type :unsigned-byte16)))) nil) (defmethod stream-read-char ((stream vga-text-console))

1 0