[movitz-cvs] CVS update: movitz/losp/x86-pc/textmode.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Fri Apr 16 19:17:22 UTC 2004
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
More information about the Movitz-cvs
mailing list