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

[movitz-cvs] CVS update: movitz/losp/lib/repl.lisp
by Frode Vatvedt Fjeld 23 Apr '04

23 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv9890 Modified Files: repl.lisp Log Message: Slightly better default-repl-prompter. Date: Fri Apr 23 10:59:35 2004 Author: ffjeld Index: movitz/losp/lib/repl.lisp diff -u movitz/losp/lib/repl.lisp:1.10 movitz/losp/lib/repl.lisp:1.11 --- movitz/losp/lib/repl.lisp:1.10 Tue Apr 6 10:37:04 2004 +++ movitz/losp/lib/repl.lisp Fri Apr 23 10:59:35 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Mar 19 14:58:12 2003 ;;;; -;;;; $Id: repl.lisp,v 1.10 2004/04/06 14:37:04 ffjeld Exp $ +;;;; $Id: repl.lisp,v 1.11 2004/04/23 14:59:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -29,7 +29,7 @@ (defun default-repl-prompter () (fresh-line) - (when (plusp *repl-level*) + (when (or (plusp *repl-level*) *repl-prompt-context*) (format t "[~D~@[~A~]] " *repl-level* *repl-prompt-context*)) (format t "~A> " (package-name *package*)))

1 0

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

23 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv1888 Modified Files: compiler.lisp Log Message: Improved compilation of dynamic-extent &rest arguments a bit. Especially functions with unused &rest parameters should be improved. Date: Fri Apr 23 10:58:53 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.58 movitz/compiler.lisp:1.59 --- movitz/compiler.lisp:1.58 Wed Apr 21 11:06:16 2004 +++ movitz/compiler.lisp Fri Apr 23 10:58:52 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.58 2004/04/21 15:06:16 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.59 2004/04/23 14:58:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -989,166 +989,163 @@ 1)) (t (error "make-2req confused by loc0: ~W, loc1: ~W" location-0 location-1))))) -#+ignore -(defun make-compiled-function-body-1rest (form funobj env top-level-p) - (when (and (null (required-vars env)) - (null (optional-vars env)) - (null (key-vars env)) - (rest-var env)) - (multiple-value-bind (code stack-frame-size use-stack-frame-p frame-map) - (make-compiled-body form funobj env top-level-p) - (let* ((rest-binding (movitz-binding (rest-var env) env nil)) - (edx-location (and (edx-var env) - (new-binding-location (edx-var env) frame-map - :default nil))) - (edx-code (when edx-location - `((:movl :edx (:ebp ,(stack-frame-offset edx-location))))))) - (cond - ((not (new-binding-located-p rest-binding frame-map)) - (append '(entry%1op - entry%2op - entry%3op) - (when use-stack-frame-p - +enter-stack-frame-code+) - '(start-stack-frame-setup) - (make-compiled-stack-frame-init stack-frame-size) - edx-code - code - (make-compiled-function-postlude funobj env use-stack-frame-p))) - (t ;; (new-binding-located-p rest-binding frame-map) - (let ((rest-location (new-binding-location rest-binding frame-map))) - (values (append +enter-stack-frame-code+ - '(start-stack-frame-setup) - (make-compiled-stack-frame-init stack-frame-size) - `((:movl :edi (:ebp ,(stack-frame-offset rest-location)))) - edx-code - `((:testb :cl :cl) - (:jz 'end-stack-frame-setup) - (:js '(:sub-program (normalize-ecx) - (:shrl 8 :ecx) - (:jmp 'ecx-ok))) - (:andl #x7f :ecx) - ecx-ok - (:xorl :edx :edx) - (:call (:edi ,(global-constant-offset 'restify-dynamic-extent))) - (:movl :eax (:ebp ,(stack-frame-offset rest-location))) - (:jmp 'end-stack-frame-setup)) - `(entry%1op - ,@+enter-stack-frame-code+ - ,@(make-compiled-stack-frame-init stack-frame-size) - ,@edx-code - (:andl -8 :esp) - (:pushl :edi) - (:pushl :eax) - (:leal (:esp 1) :ecx) - (:movl :ecx (:ebp ,(stack-frame-offset rest-location))) - (:jmp 'end-stack-frame-setup)) - `(entry%2op - ,@+enter-stack-frame-code+ - ,@(make-compiled-stack-frame-init stack-frame-size) - ,@edx-code - (:andl -8 :esp) - (:pushl :edi) - (:pushl :ebx) - (:leal (:esp 1) :ecx) - (:pushl :ecx) - (:pushl :eax) - (:leal (:esp 1) :ecx) - (:movl :ecx (:ebp ,(stack-frame-offset rest-location))) - (:jmp 'end-stack-frame-setup)) - '(end-stack-frame-setup) - code - (make-compiled-function-postlude funobj env t)) - use-stack-frame-p)))))))) +;;;(defun make-compiled-function-body-1rest (form funobj env top-level-p) +;;; (when (and (null (required-vars env)) +;;; (null (optional-vars env)) +;;; (null (key-vars env)) +;;; (rest-var env)) +;;; (multiple-value-bind (code stack-frame-size use-stack-frame-p frame-map) +;;; (make-compiled-body form funobj env top-level-p) +;;; (let* ((rest-binding (movitz-binding (rest-var env) env nil)) +;;; (edx-location (and (edx-var env) +;;; (new-binding-location (edx-var env) frame-map +;;; :default nil))) +;;; (edx-code (when edx-location +;;; `((:movl :edx (:ebp ,(stack-frame-offset edx-location))))))) +;;; (cond +;;; ((not (new-binding-located-p rest-binding frame-map)) +;;; (append '(entry%1op +;;; entry%2op +;;; entry%3op) +;;; (when use-stack-frame-p +;;; +enter-stack-frame-code+) +;;; '(start-stack-frame-setup) +;;; (make-compiled-stack-frame-init stack-frame-size) +;;; edx-code +;;; code +;;; (make-compiled-function-postlude funobj env use-stack-frame-p))) +;;; (t ;; (new-binding-located-p rest-binding frame-map) +;;; (let ((rest-location (new-binding-location rest-binding frame-map))) +;;; (values (append +enter-stack-frame-code+ +;;; '(start-stack-frame-setup) +;;; (make-compiled-stack-frame-init stack-frame-size) +;;; `((:movl :edi (:ebp ,(stack-frame-offset rest-location)))) +;;; edx-code +;;; `((:testb :cl :cl) +;;; (:jz 'end-stack-frame-setup) +;;; (:js '(:sub-program (normalize-ecx) +;;; (:shrl 8 :ecx) +;;; (:jmp 'ecx-ok))) +;;; (:andl #x7f :ecx) +;;; ecx-ok +;;; (:xorl :edx :edx) +;;; (:call (:edi ,(global-constant-offset 'restify-dynamic-extent))) +;;; (:movl :eax (:ebp ,(stack-frame-offset rest-location))) +;;; (:jmp 'end-stack-frame-setup)) +;;; `(entry%1op +;;; ,@+enter-stack-frame-code+ +;;; ,@(make-compiled-stack-frame-init stack-frame-size) +;;; ,@edx-code +;;; (:andl -8 :esp) +;;; (:pushl :edi) +;;; (:pushl :eax) +;;; (:leal (:esp 1) :ecx) +;;; (:movl :ecx (:ebp ,(stack-frame-offset rest-location))) +;;; (:jmp 'end-stack-frame-setup)) +;;; `(entry%2op +;;; ,@+enter-stack-frame-code+ +;;; ,@(make-compiled-stack-frame-init stack-frame-size) +;;; ,@edx-code +;;; (:andl -8 :esp) +;;; (:pushl :edi) +;;; (:pushl :ebx) +;;; (:leal (:esp 1) :ecx) +;;; (:pushl :ecx) +;;; (:pushl :eax) +;;; (:leal (:esp 1) :ecx) +;;; (:movl :ecx (:ebp ,(stack-frame-offset rest-location))) +;;; (:jmp 'end-stack-frame-setup)) +;;; '(end-stack-frame-setup) +;;; code +;;; (make-compiled-function-postlude funobj env t)) +;;; use-stack-frame-p)))))))) - -#+ignore -(defun make-compiled-function-body-1req-1opt (form funobj env top-level-p) - (when (and (= 1 (length (required-vars env))) - (= 1 (length (optional-vars env))) - (= 0 (length (key-vars env))) - (null (rest-var env))) - (let* ((opt-var (first (optional-vars env))) - (opt-binding (movitz-binding opt-var env nil)) - (req-binding (movitz-binding (first (required-vars env)) env nil)) - (default-form (optional-function-argument-init-form opt-binding))) - (compiler-values-bind (&code opt-default-code &producer opt-default-producer) - (compiler-call #'compile-form - :form default-form - :result-mode :push - :env env - :funobj funobj) - (cond - ((eq 'compile-self-evaluating opt-default-producer) - (multiple-value-bind (code stack-frame-size use-stack-frame-p frame-map) - (make-compiled-body form funobj env top-level-p nil (list opt-default-code)) - (declare (ignore use-stack-frame-p)) - (let ((use-stack-frame-p t)) - (cond - ((and (new-binding-located-p req-binding frame-map) - (new-binding-located-p opt-binding frame-map)) - (multiple-value-bind (eax-ebx-code eax-ebx-stack-offset) - (ecase (new-binding-location req-binding frame-map) - ;; might well be more cases here, but let's wait till they show up.. - (:eax (values nil 0)) - (1 (values '((:pushl :eax)) 1))) - ;; (warn "defc: ~S" opt-default-code) - (let ((stack-init-size (- stack-frame-size eax-ebx-stack-offset)) - (installed-default-code (finalize-code opt-default-code funobj env frame-map))) - (values (append `((:call (:edi ,(global-constant-offset 'decode-args-1or2))) - entry%2op - (:pushl :ebp) - (:movl :esp :ebp) - (:pushl :esi) - start-stack-frame-setup - ,@eax-ebx-code - ,@(if (eql (1+ eax-ebx-stack-offset) - (new-binding-location opt-binding frame-map)) - (append `((:pushl :ebx)) - (make-compiled-stack-frame-init (1- stack-init-size))) - (append (make-compiled-stack-frame-init stack-init-size) - `((:movl :ebx (:ebp ,(stack-frame-offset - (new-binding-location opt-binding - frame-map))))))) - (:jmp 'arg-init-done) - entry%1op - (:pushl :ebp) - (:movl :esp :ebp) - (:pushl :esi) - ,@eax-ebx-code - ,@(if (eql (1+ eax-ebx-stack-offset) - (new-binding-location opt-binding frame-map)) - (append installed-default-code - (make-compiled-stack-frame-init (1- stack-init-size))) - (append (make-compiled-stack-frame-init stack-init-size) - installed-default-code - `((:popl (:ebp ,(stack-frame-offset - (new-binding-location opt-binding - frame-map))))))) - arg-init-done) - code - (make-compiled-function-postlude funobj env t)) - use-stack-frame-p)))) - ((and (new-binding-located-p req-binding frame-map) - (not (new-binding-located-p opt-binding frame-map))) - (multiple-value-bind (eax-code eax-stack-offset) - (ecase (new-binding-location req-binding frame-map) - (:eax (values nil 0)) - (1 (values '((:pushl :eax)) 1))) - (values (append `((:call (:edi ,(global-constant-offset 'decode-args-1or2))) - ;; (:jmp 'decode-numargs) - entry%1op - entry%2op - (:pushl :ebp) - (:movl :esp :ebp) - (:pushl :esi)) - eax-code - (make-compiled-stack-frame-init (- stack-frame-size eax-stack-offset)) - code - (make-compiled-function-postlude funobj env t)) - use-stack-frame-p))) - (t (warn "1-req-1-opt failed")))))) - (t nil)))))) +;;;(defun make-compiled-function-body-1req-1opt (form funobj env top-level-p) +;;; (when (and (= 1 (length (required-vars env))) +;;; (= 1 (length (optional-vars env))) +;;; (= 0 (length (key-vars env))) +;;; (null (rest-var env))) +;;; (let* ((opt-var (first (optional-vars env))) +;;; (opt-binding (movitz-binding opt-var env nil)) +;;; (req-binding (movitz-binding (first (required-vars env)) env nil)) +;;; (default-form (optional-function-argument-init-form opt-binding))) +;;; (compiler-values-bind (&code opt-default-code &producer opt-default-producer) +;;; (compiler-call #'compile-form +;;; :form default-form +;;; :result-mode :push +;;; :env env +;;; :funobj funobj) +;;; (cond +;;; ((eq 'compile-self-evaluating opt-default-producer) +;;; (multiple-value-bind (code stack-frame-size use-stack-frame-p frame-map) +;;; (make-compiled-body form funobj env top-level-p nil (list opt-default-code)) +;;; (declare (ignore use-stack-frame-p)) +;;; (let ((use-stack-frame-p t)) +;;; (cond +;;; ((and (new-binding-located-p req-binding frame-map) +;;; (new-binding-located-p opt-binding frame-map)) +;;; (multiple-value-bind (eax-ebx-code eax-ebx-stack-offset) +;;; (ecase (new-binding-location req-binding frame-map) +;;; ;; might well be more cases here, but let's wait till they show up.. +;;; (:eax (values nil 0)) +;;; (1 (values '((:pushl :eax)) 1))) +;;; ;; (warn "defc: ~S" opt-default-code) +;;; (let ((stack-init-size (- stack-frame-size eax-ebx-stack-offset)) +;;; (installed-default-code (finalize-code opt-default-code funobj env frame-map))) +;;; (values (append `((:call (:edi ,(global-constant-offset 'decode-args-1or2))) +;;; entry%2op +;;; (:pushl :ebp) +;;; (:movl :esp :ebp) +;;; (:pushl :esi) +;;; start-stack-frame-setup +;;; ,@eax-ebx-code +;;; ,@(if (eql (1+ eax-ebx-stack-offset) +;;; (new-binding-location opt-binding frame-map)) +;;; (append `((:pushl :ebx)) +;;; (make-compiled-stack-frame-init (1- stack-init-size))) +;;; (append (make-compiled-stack-frame-init stack-init-size) +;;; `((:movl :ebx (:ebp ,(stack-frame-offset +;;; (new-binding-location opt-binding +;;; frame-map))))))) +;;; (:jmp 'arg-init-done) +;;; entry%1op +;;; (:pushl :ebp) +;;; (:movl :esp :ebp) +;;; (:pushl :esi) +;;; ,@eax-ebx-code +;;; ,@(if (eql (1+ eax-ebx-stack-offset) +;;; (new-binding-location opt-binding frame-map)) +;;; (append installed-default-code +;;; (make-compiled-stack-frame-init (1- stack-init-size))) +;;; (append (make-compiled-stack-frame-init stack-init-size) +;;; installed-default-code +;;; `((:popl (:ebp ,(stack-frame-offset +;;; (new-binding-location opt-binding +;;; frame-map))))))) +;;; arg-init-done) +;;; code +;;; (make-compiled-function-postlude funobj env t)) +;;; use-stack-frame-p)))) +;;; ((and (new-binding-located-p req-binding frame-map) +;;; (not (new-binding-located-p opt-binding frame-map))) +;;; (multiple-value-bind (eax-code eax-stack-offset) +;;; (ecase (new-binding-location req-binding frame-map) +;;; (:eax (values nil 0)) +;;; (1 (values '((:pushl :eax)) 1))) +;;; (values (append `((:call (:edi ,(global-constant-offset 'decode-args-1or2))) +;;; ;; (:jmp 'decode-numargs) +;;; entry%1op +;;; entry%2op +;;; (:pushl :ebp) +;;; (:movl :esp :ebp) +;;; (:pushl :esi)) +;;; eax-code +;;; (make-compiled-stack-frame-init (- stack-frame-size eax-stack-offset)) +;;; code +;;; (make-compiled-function-postlude funobj env t)) +;;; use-stack-frame-p))) +;;; (t (warn "1-req-1-opt failed")))))) +;;; (t nil)))))) (defun make-compiled-stack-frame-init (stack-frame-init) @@ -4218,14 +4215,15 @@ (when rest-var (let* ((rest-binding (movitz-binding rest-var env)) (rest-position (function-argument-argnum rest-binding))) + #+ignore (assert (or (typep rest-binding 'hidden-rest-function-argument) - (movitz-env-get rest-var 'dynamic-extent nil env) - (movitz-env-get rest-var 'ignore nil env)) + (movitz-env-get rest-var 'dynamic-extent nil env)) () "&REST variable ~S must be dynamic-extent." rest-var) - (setq need-normalized-ecx-p t) - (append (make-immediate-move rest-position :edx) - `((:call (:edi ,(global-constant-offset 'restify-dynamic-extent))) + ;; (setq need-normalized-ecx-p t) + (append #+ignore (make-immediate-move rest-position :edx) + `(#+ignore + (:call (:edi ,(global-constant-offset 'restify-dynamic-extent))) (:init-lexvar ,rest-binding :init-with-register :eax :init-with-type list))))) @@ -5755,27 +5753,53 @@ (declare (ignore protect-carry)) ; nothing modifies carry anyway. (assert (eq binding (ensure-local-binding binding funobj))) (cond - ((binding-lended-p binding) - (let ((cons-position (getf (binding-lended-p binding) - :stack-cons-location)) - (tmp-register (find-if (lambda (r) - (and (not (member r protect-registers)) - (not (eq r init-with-register)))) - '(:edx :ecx :ebx :eax))) - (init-register (or init-with-register :edi))) - (when init-with-register - (assert (not (null init-with-type)))) - (assert tmp-register () ; solve this with push eax .. pop eax if ever needed. - "Unable to find a tmp-register for ~S." instruction) - `((:leal (:ebp ,(1+ (stack-frame-offset (1+ cons-position)))) - ,tmp-register) - (:movl :edi (,tmp-register 3)) ; cdr - (:movl ,init-register (,tmp-register -1)) ; car - (:movl ,tmp-register - (:ebp ,(stack-frame-offset - (new-binding-location binding frame-map))))))) - (init-with-register - (make-store-lexical binding init-with-register nil frame-map))))) + ((not (new-binding-located-p binding frame-map)) + (unless (or (movitz-env-get (binding-name binding) 'ignore nil (binding-env binding)) + (movitz-env-get (binding-name binding) 'ignorable nil (binding-env binding))) + (warn "Unused variable: ~S." (binding-name binding)))) + (t (when (movitz-env-get (binding-name binding) 'ignore nil (binding-env binding)) + (warn "Variable ~S used while declared ignored." (binding-name binding))) + (append + (cond + ((typep binding 'rest-function-argument) + (assert (eq :eax init-with-register)) + (assert (or (typep binding 'hidden-rest-function-argument) + (movitz-env-get (binding-name binding) + 'dynamic-extent nil (binding-env binding))) + () + "&REST variable ~S must be dynamic-extent." (binding-name binding)) + (setf (need-normalized-ecx-p (find-function-env (binding-env binding) + funobj)) + t) + (append (make-immediate-move (function-argument-argnum binding) :edx) + `((:call (:edi ,(global-constant-offset 'restify-dynamic-extent)))) + #+ignore + (unless (or (typep binding 'hidden-rest-function-argument) + (movitz-env-get (binding-name binding) + 'dynamic-extent nil (binding-env binding))) + (make-compiled-funcall-by-symbol 'muerte.cl:copy-list 1 funobj))))) + (cond + ((binding-lended-p binding) + (let ((cons-position (getf (binding-lended-p binding) + :stack-cons-location)) + (tmp-register (find-if (lambda (r) + (and (not (member r protect-registers)) + (not (eq r init-with-register)))) + '(:edx :ecx :ebx :eax))) + (init-register (or init-with-register :edi))) + (when init-with-register + (assert (not (null init-with-type)))) + (assert tmp-register () ; solve this with push eax .. pop eax if ever needed. + "Unable to find a tmp-register for ~S." instruction) + `((:leal (:ebp ,(1+ (stack-frame-offset (1+ cons-position)))) + ,tmp-register) + (:movl :edi (,tmp-register 3)) ; cdr + (:movl ,init-register (,tmp-register -1)) ; car + (:movl ,tmp-register + (:ebp ,(stack-frame-offset + (new-binding-location binding frame-map))))))) + (init-with-register + (make-store-lexical binding init-with-register nil frame-map)))))))) ;;;;;;;;;;;;;;;;;; car

1 0

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

23 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv21872 Modified Files: integers.lisp Log Message: Fixed * a bit. Date: Fri Apr 23 09:02:23 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.7 movitz/losp/muerte/integers.lisp:1.8 --- movitz/losp/muerte/integers.lisp:1.7 Fri Apr 16 15:22:21 2004 +++ movitz/losp/muerte/integers.lisp Fri Apr 23 09:02:22 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.7 2004/04/16 19:22:21 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.8 2004/04/23 13:02:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -49,7 +49,7 @@ (t (let ((operands (loop for operand in operands if (movitz:movitz-constantp operand env) - sum (movitz::eval-form operand env) + sum (movitz:movitz-eval operand env) into constant-term else collect operand into non-constant-operands @@ -71,24 +71,24 @@ (define-compiler-macro +%2op (&whole form term1 term2) (cond ((and (movitz:movitz-constantp term1) ; first operand zero? - (zerop (movitz::eval-form term1))) + (zerop (movitz:movitz-eval term1))) term2) ; (+ 0 x) => x ((and (movitz:movitz-constantp term2) ; second operand zero? - (zerop (movitz::eval-form term2))) + (zerop (movitz:movitz-eval term2))) term1) ; (+ x 0) => x ((and (movitz:movitz-constantp term1) (movitz:movitz-constantp term2)) - (+ (movitz::eval-form term1) - (movitz::eval-form term2))) ; compile-time constant folding. + (+ (movitz:movitz-eval term1) + (movitz:movitz-eval term2))) ; compile-time constant folding. ((movitz:movitz-constantp term1) - (let ((constant-term1 (movitz::eval-form term1))) + (let ((constant-term1 (movitz:movitz-eval term1))) (check-type constant-term1 (signed-byte 30)) `(with-inline-assembly (:returns :register :side-effects nil) ; inline (:compile-form (:result-mode :register) ,term2) (:addl ,(* movitz::+movitz-fixnum-factor+ constant-term1) (:result-register)) (:into)))) ((movitz:movitz-constantp term2) - (let ((constant-term2 (movitz::eval-form term2))) + (let ((constant-term2 (movitz:movitz-eval term2))) (check-type constant-term2 (signed-byte 30)) `(with-inline-assembly (:returns :register :side-effects nil) ; inline (:compile-form (:result-mode :register) ,term1) @@ -164,20 +164,20 @@ (define-compiler-macro -%2op (&whole form minuend subtrahend) (cond ((and (movitz:movitz-constantp minuend) ; first operand zero? - (zerop (movitz::eval-form minuend))) + (zerop (movitz:movitz-eval minuend))) `(with-inline-assembly (:returns :register :side-effects nil) (:compile-form (:result-mode :register) ,subtrahend) (:negl (:result-register)) ; (- 0 x) => -x (:into))) ((and (movitz:movitz-constantp subtrahend) ; second operand zero? - (zerop (movitz::eval-form subtrahend))) - (movitz::eval-form minuend)) ; (- x 0) => x + (zerop (movitz:movitz-eval subtrahend))) + (movitz:movitz-eval minuend)) ; (- x 0) => x ((and (movitz:movitz-constantp minuend) (movitz:movitz-constantp subtrahend)) - (- (movitz::eval-form minuend) - (movitz::eval-form subtrahend))) ; compile-time constant folding. + (- (movitz:movitz-eval minuend) + (movitz:movitz-eval subtrahend))) ; compile-time constant folding. ((movitz:movitz-constantp minuend) - (let ((constant-minuend (movitz::eval-form minuend))) + (let ((constant-minuend (movitz:movitz-eval minuend))) (check-type constant-minuend (signed-byte 30)) `(with-inline-assembly (:returns :register :side-effects nil) ; inline (:compile-form (:result-mode :register) ,subtrahend) @@ -186,7 +186,7 @@ (:into) (:negl (:result-register))))) ((movitz:movitz-constantp subtrahend) - (let ((constant-subtrahend (movitz::eval-form subtrahend))) + (let ((constant-subtrahend (movitz:movitz-eval subtrahend))) (check-type constant-subtrahend (signed-byte 30)) `(+%2op ,minuend ,(- constant-subtrahend)))) (t `(with-inline-assembly (:returns :eax :side-effects nil) @@ -254,14 +254,14 @@ (cond ((and (movitz:movitz-constantp min env) (movitz:movitz-constantp max env)) - (let ((min (movitz::eval-form min env)) - (max (movitz::eval-form max env))) + (let ((min (movitz:movitz-eval min env)) + (max (movitz:movitz-eval max env))) (check-type min integer) (check-type max integer) ;; (warn "~D -- ~D" min max) (cond ((movitz:movitz-constantp x env) - (<= min (movitz::eval-form x env) max)) + (<= min (movitz:movitz-eval x env) max)) ((< max min) nil) ((= max min) @@ -295,7 +295,7 @@ (:adcl 0 :ecx)))))))) #+ignore ; this is buggy. ((movitz:movitz-constantp min env) - (let ((min (movitz::eval-form min env))) + (let ((min (movitz:movitz-eval min env))) (check-type min integer) (cond ((minusp min) @@ -396,7 +396,7 @@ (:compile-form (:result-mode :eax) ,x) (:testb ,movitz::+movitz-fixnum-zmask+ :al) (:jnz '(:sub-program (,below-not-integer) (:int 107))) - (:cmpl ,(* (movitz::eval-form max env) + (:cmpl ,(* (movitz:movitz-eval max env) movitz::+movitz-fixnum-factor+) :eax)) `(with-inline-assembly (:returns :boolean-cf=1) @@ -607,8 +607,11 @@ ((> 0 count #.(cl:- (cl:1- movitz::+movitz-fixnum-bits+))) `(with-inline-assembly (:returns :register :side-effects nil :type integer) ,@load-integer - (:sarl ,(- count) (:result-register)) - (:andb #.(cl:logxor #xff movitz::+movitz-fixnum-zmask+) (:result-register-low8)))) + (:andl ,(ldb (byte 32 0) + (ash movitz:+movitz-most-positive-fixnum+ + (- movitz:+movitz-fixnum-shift+ count))) + (:result-register)) + (:sarl ,(- count) (:result-register)))) ((minusp count) `(if (minusp ,integer) -1 0)) (t `(if (= 0 ,integer) 0 (with-inline-assembly (:returns :non-local-exit) (:int 4))))))))))) @@ -641,12 +644,12 @@ (cond ((and (movitz:movitz-constantp factor1 env) (movitz:movitz-constantp factor2 env)) - (* (movitz::eval-form factor1 env) - (movitz::eval-form factor2 env))) + (* (movitz:movitz-eval factor1 env) + (movitz:movitz-eval factor2 env))) ((movitz:movitz-constantp factor2 env) - `(*%2op ,(movitz::eval-form factor2 env) ,factor1)) + `(*%2op ,(movitz:movitz-eval factor2 env) ,factor1)) ((movitz:movitz-constantp factor1 env) - (let ((f1 (movitz::eval-form factor1 env))) + (let ((f1 (movitz:movitz-eval factor1 env))) (check-type f1 integer) (case f1 (0 `(progn ,factor2 0)) @@ -658,17 +661,17 @@ (:jnz '(:sub-program () (:int 107))) (:imull ,f1 :eax :eax) (:into)))))) - (t form))) + (t `(no-macro-call * ,factor1 ,factor2)))) -(defun *%2op (factor1 factor2) - (check-type factor1 fixnum) - (check-type factor2 fixnum) - (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) factor1) - (:compile-form (:result-mode :ebx) factor2) - (:sarl #.movitz::+movitz-fixnum-shift+ :eax) - (:imull :ebx :eax :edx) - (:into))) +;;;(defun *%2op (factor1 factor2) +;;; (check-type factor1 fixnum) +;;; (check-type factor2 fixnum) +;;; (with-inline-assembly (:returns :eax) +;;; (:compile-form (:result-mode :eax) factor1) +;;; (:compile-form (:result-mode :ebx) factor2) +;;; (:sarl #.movitz::+movitz-fixnum-shift+ :eax) +;;; (:imull :ebx :eax :edx) +;;; (:into))) (define-compiler-macro * (&whole form &rest operands) (case (length operands) @@ -723,7 +726,7 @@ (define-compiler-macro truncate%2ops%1ret (&whole form &environment env number divisor) (cond ((movitz:movitz-constantp divisor env) - (let ((d (movitz::eval-form divisor env))) + (let ((d (movitz:movitz-eval divisor env))) (check-type d number) (case d (0 (error "Truncate by zero.")) @@ -1008,12 +1011,12 @@ (cond ((and (constant-bytespec-p bytespec) (movitz:movitz-constantp integer env)) - (ldb (byte (movitz::eval-form (second bytespec) env) - (movitz::eval-form (third bytespec) env)) - (movitz::eval-form integer env))) ; constant folding + (ldb (byte (movitz:movitz-eval (second bytespec) env) + (movitz:movitz-eval (third bytespec) env)) + (movitz:movitz-eval integer env))) ; constant folding ((constant-bytespec-p bytespec) - (let ((size (movitz::eval-form (second bytespec) env)) - (position (movitz::eval-form (third bytespec) env))) + (let ((size (movitz:movitz-eval (second bytespec) env)) + (position (movitz:movitz-eval (third bytespec) env))) (assert (<= (+ size position) 30)) `(with-inline-assembly (:returns :register :type integer) (:compile-form (:result-mode :register) ,integer) @@ -1022,7 +1025,6 @@ ,@(unless (zerop position) `((:shrl ,position (:result-register))))))) (t form)))) - (define-setf-expander ldb (bytespec int &environment env) "Stolen from the Hyperspec example in the define-setf-expander entry."

1 0

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

23 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7822 Modified Files: eval.lisp Log Message: Changed read-time-stamp-counter to return two 29-bit fixnums, which seems more useful for most cases, even if the upper 6 bits are lost. Date: Fri Apr 23 09:00:30 2004 Author: ffjeld Index: movitz/losp/muerte/eval.lisp diff -u movitz/losp/muerte/eval.lisp:1.7 movitz/losp/muerte/eval.lisp:1.8 --- movitz/losp/muerte/eval.lisp:1.7 Fri Apr 16 15:21:51 2004 +++ movitz/losp/muerte/eval.lisp Fri Apr 23 09:00:30 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.7 2004/04/16 19:21:51 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.8 2004/04/23 13:00:30 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -127,22 +127,7 @@ "Supposed to be the time macro." (cond ((cpu-featurep :tsc) - (let ((start-mem (malloc-cons-pointer))) - (multiple-value-bind (start-time-lo start-time-hi) - (read-time-stamp-counter) - (multiple-value-prog1 - (eval-form form env) - (multiple-value-bind (end-time-lo end-time-hi) - (read-time-stamp-counter) - (let ((clumps (- (malloc-cons-pointer) start-mem)) - (delta-hi (- end-time-hi start-time-hi)) - (delta-lo (- end-time-lo start-time-lo))) - (format t "~&;; Time report:") - (if (< delta-hi #x1f) - (format t "~&;; CPU cycles: ~D.~%;; Space used: ~D clumps = ~/muerte:pprint-clumps/.~%" - (+ (ash delta-hi 24) delta-lo) clumps clumps) - (format t "~&;; CPU cycles: ~D000.~%;; Space used: ~D clumps = ~/muerte:pprint-clumps/.~%" - (+ (ash delta-hi 14) (ash delta-lo -10)) clumps clumps)))))))) + (time (eval-form form env))) (t (let ((start-mem (malloc-cons-pointer))) (multiple-value-prog1 (eval-form form env)

1 0

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

23 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7716 Modified Files: environment.lisp Log Message: Changed read-time-stamp-counter to return two 29-bit fixnums, which seems more useful for most cases, even if the upper 6 bits are lost. Date: Fri Apr 23 09:00:24 2004 Author: ffjeld Index: movitz/losp/muerte/environment.lisp diff -u movitz/losp/muerte/environment.lisp:1.5 movitz/losp/muerte/environment.lisp:1.6 --- movitz/losp/muerte/environment.lisp:1.5 Thu Mar 25 20:35:29 2004 +++ movitz/losp/muerte/environment.lisp Fri Apr 23 09:00:24 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Oct 20 00:41:57 2001 ;;;; -;;;; $Id: environment.lisp,v 1.5 2004/03/26 01:35:29 ffjeld Exp $ +;;;; $Id: environment.lisp,v 1.6 2004/04/23 13:00:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -120,28 +120,42 @@ (delete name *trace-map* :key 'car)))) (values)) +(defun time-skew-measure (mem x-lo x-hi) + (declare (ignore mem)) + (multiple-value-bind (y-lo y-hi) + (read-time-stamp-counter) + (assert (<= x-hi y-hi)) + (- y-lo x-lo (if (< y-lo x-lo) most-negative-fixnum 0)))) + +(defun report-time (start-mem start-time-lo start-time-hi) + (multiple-value-bind (end-time-lo end-time-hi) + (read-time-stamp-counter) + (let* ((skew (or (get 'report-time 'skew) + (setf (get 'report-time 'skew) + (multiple-value-bind (x-lo x-hi) + (read-time-stamp-counter) + (time-skew-measure start-mem x-lo x-hi))))) + (clumps (- (malloc-cons-pointer) start-mem)) + (delta-hi (- end-time-hi start-time-hi)) + (delta-lo (- end-time-lo start-time-lo skew))) + (if (= 0 delta-hi) + (format t "~&;; CPU cycles: ~D.~%;; Space used: ~D clumps = ~/muerte:pprint-clumps/.~%" + delta-lo clumps clumps) + (format t "~&;; CPU cycles: ~DM.~%;; Space used: ~D clumps = ~/muerte:pprint-clumps/.~%" + (+ (ash delta-hi 9) (ash delta-lo -20)) clumps clumps))))) + (defmacro time (form) `(let ((start-mem (malloc-cons-pointer))) (multiple-value-bind (start-time-lo start-time-hi) (read-time-stamp-counter) (multiple-value-prog1 ,form - (multiple-value-bind (end-time-lo end-time-hi) - (read-time-stamp-counter) - (let ((clumps (- (malloc-cons-pointer) start-mem)) - (delta-hi (- end-time-hi start-time-hi)) - (delta-lo (- end-time-lo start-time-lo))) - (if (< delta-hi #x1f) - (format t "~&;; CPU cycles: ~D.~%;; Space used: ~D clumps = ~/muerte:pprint-clumps/.~%" - (+ (ash delta-hi 24) delta-lo) clumps clumps) - (format t "~&;; CPU cycles: ~D000.~%;; Space used: ~D clumps = ~/muerte:pprint-clumps/.~%" - (+ (ash delta-hi 14) (ash delta-lo -10)) clumps clumps)))))))) + (report-time start-mem start-time-lo start-time-hi))))) (defun describe (object &optional stream) (describe-object object (output-stream-designator stream)) (values)) - (defmethod describe-object (object stream) (format stream "Don't know how to describe ~S." object))

1 0

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

23 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6368 Modified Files: cpu-id.lisp Log Message: Changed read-time-stamp-counter to return two 29-bit fixnums, which seems more useful for most cases, even if the upper 6 bits are lost. Date: Fri Apr 23 09:00:17 2004 Author: ffjeld Index: movitz/losp/muerte/cpu-id.lisp diff -u movitz/losp/muerte/cpu-id.lisp:1.3 movitz/losp/muerte/cpu-id.lisp:1.4 --- movitz/losp/muerte/cpu-id.lisp:1.3 Wed Apr 14 18:49:14 2004 +++ movitz/losp/muerte/cpu-id.lisp Fri Apr 23 09:00:17 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Apr 15 22:47:13 2002 ;;;; -;;;; $Id: cpu-id.lisp,v 1.3 2004/04/14 22:49:14 ffjeld Exp $ +;;;; $Id: cpu-id.lisp,v 1.4 2004/04/23 13:00:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -190,27 +190,56 @@ (defun read-time-stamp-counter () "Read the 64-bit i686 time-stamp counter. -Returned as three values: low 24 bits, mid 24 bits, high 16 bits. +Returned as two values: low 29 bits, mid 29 bits. This is an illegal instruction on lesser CPUs." (with-inline-assembly (:returns :multiple-values) (:std) (:rdtsc) ; Read Time-Stamp Counter into EDX:EAX - ;; Load upper 16 bits (of EDX) as ternary value. + (:shldl 5 :eax :edx) + (:shll #.movitz:+movitz-fixnum-shift+ :eax) + (:andl #.(cl:logxor #xffffffff movitz::+movitz-fixnum-zmask+) :edx) + (:andl #.(cl:* movitz:+movitz-fixnum-factor+ movitz:+movitz-most-positive-fixnum+) + :eax) (:movl :edx :ebx) - (:andl #xffff0000 :edx) - (:shll #.(cl:- 16 movitz::+movitz-fixnum-shift+) :edx) - ((:fs-override) :movl :edx (:edi #.(movitz::global-constant-offset 'values))) - ;; Bits 24-47 as fixnum into EBX - (:shldl #.(cl:+ 8 movitz::+movitz-fixnum-shift+) :eax :ebx) - (:andl #.(cl:* #x00ffffff movitz::+movitz-fixnum-factor+) :ebx) - ;; Bits 0-23 as fixnum into EAX - (:andl #x00ffffff :eax) - (:shll #.movitz::+movitz-fixnum-shift+ :eax) (:cld) - ;; Return 3 values - ((:fs-override) :movl 1 (:edi #.(movitz::global-constant-offset 'num-values))) - (:movl 3 :ecx) + (:movl 2 :ecx) (:stc))) + +(define-compiler-macro read-time-stamp-counter () + `(with-inline-assembly-case () + (do-case (:register :same) + (:std) + (:rdtsc) + (:movl :edi :edx) + (:leal ((:eax ,movitz:+movitz-fixnum-factor+)) (:result-register)) + (:cld)) + (do-case (t :multiple-values) + (:compile-form (:result-mode :multiple-values) (no-macro-call read-time-stamp-counter))))) + + +;;;(defun read-time-stamp-counter () +;;; "Read the 64-bit i686 time-stamp counter. +;;;Returned as three values: low 24 bits, mid 24 bits, high 16 bits. +;;;This is an illegal instruction on lesser CPUs." +;;; (with-inline-assembly (:returns :multiple-values) +;;; (:std) +;;; (:rdtsc) ; Read Time-Stamp Counter into EDX:EAX +;;; ;; Load upper 16 bits (of EDX) as ternary value. +;;; (:movl :edx :ecx) +;;; (:andl #xffff0000 :edx) +;;; (:shll #.(cl:- 16 movitz::+movitz-fixnum-shift+) :edx) +;;; ((:fs-override) :movl :edx (:edi #.(movitz::global-constant-offset 'values))) +;;; ;; Bits 24-47 as fixnum into EBX +;;; (:shldl #.(cl:+ 8 movitz::+movitz-fixnum-shift+) :eax :ebx) +;;; (:andl #.(cl:* #x00ffffff movitz::+movitz-fixnum-factor+) :ebx) +;;; ;; Bits 0-23 as fixnum into EAX +;;; (:andl #x00ffffff :eax) +;;; (:shll #.movitz::+movitz-fixnum-shift+ :eax) +;;; (:cld) +;;; ;; Return 3 values +;;; ((:fs-override) :movl 1 (:edi #.(movitz::global-constant-offset 'num-values))) +;;; (:movl 3 :ecx) +;;; (:stc))) (defun clear-time-stamp-counter () "Reset the i686 time-stamp-counter.

1 0

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

23 Apr '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv1547 Modified Files: los0.lisp Log Message: Changed read-time-stamp-counter to return two 29-bit fixnums, which seems more useful for most cases, even if the upper 6 bits are lost. Date: Fri Apr 23 09:00:10 2004 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.11 movitz/losp/los0.lisp:1.12 --- movitz/losp/los0.lisp:1.11 Tue Apr 6 20:35:51 2004 +++ movitz/losp/los0.lisp Fri Apr 23 09:00:08 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.11 2004/04/07 00:35:51 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.12 2004/04/23 13:00:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -94,11 +94,12 @@ ;;; (format t "test-loop: ~S~%" ;;; (loop for i from 0 to 10 collect x))) ;;; -;;;(defun delay (time) -;;; (dotimes (i time) -;;; (with-inline-assembly (:returns :nothing) -;;; (:nop) -;;; (:nop)))) +#+ignore +(defun delay (time) + (dotimes (i time) + (with-inline-assembly (:returns :nothing) + (:nop) + (:nop)))) ;;; ;;;(defun test-consp (x) ;;; (with-inline-assembly (:returns :boolean-cf=1) @@ -106,6 +107,9 @@ ;;; (:leal (:edi -4) :eax) ;;; (:rorb :cl :al))) +(defun foo (x) + (foo x x)) + #+ignore (defun test-block (x) @@ -335,11 +339,16 @@ (error "Huh?")) #+ignore -(defun test-catch () +(defun test-catch (x) (catch 'test-tag - (test-throw 'test-tag) + (test-throw x 'test-tag) (format t "Hello world"))) +(defun test-throw (x tag) + (when x + (warn "Throwing ~S.." tag) + (throw tag (values-list x)))) + #+ignore (defun test-up-catch () (catch 'test-tag @@ -574,13 +583,12 @@ for s0 = (rtc-register :second) while (= x s0) finally (return s0)))) - (multiple-value-bind (c0-lo c0-mid c0-hi) + (multiple-value-bind (c0-lo c0-hi) (read-time-stamp-counter) (loop while (= s0 (rtc-register :second))) - (multiple-value-bind (c1-lo c1-mid c1-hi) + (multiple-value-bind (c1-lo c1-hi) (read-time-stamp-counter) - (+ (ash (- c1-hi c0-hi) 38) - (ash (- c1-mid c0-mid) 14) + (+ (ash (- c1-hi c0-hi) 20) (ash (+ 512 (- c1-lo c0-lo)) -10)))))) (defun report-cpu-frequency () @@ -589,6 +597,26 @@ (format t "~&CPU frequency: ~D.~2,'0D MHz.~%" mhz (round khz 10))) (values)) +(defvar *cpu-frequency-mhz*) + +(defun init-nano-sleep () + (setf *cpu-frequency-mhz* + (truncate (assess-cpu-frequency) 100))) + +(defun nano-sleep (nano-seconds) + (let* ((t0 (read-time-stamp-counter)) + (t1 (+ t0 (truncate (* nano-seconds (%symbol-global-value '*cpu-frequency-mhz*)) + 10000)))) + (when (< t1 t0) + (loop until (< (read-time-stamp-counter) t0))) ; wait for wrap-around + (loop until (>= (read-time-stamp-counter) t1)))) + +(defun test-nano-sleep (x) + (time (nano-sleep x))) + +(defun test () + (time 123)) + (defun mvtest () (multiple-value-call #'list (round 5 2)) (list (memref-int #x1000000 0 0 :unsigned-byte8) @@ -607,34 +635,36 @@ for s0 = (rtc-register :second) while (= x s0) finally (return s0)))) - (multiple-value-bind (c0-lo c0-mid c0-hi) + (multiple-value-bind (c0-lo c0-hi) (read-time-stamp-counter) (loop while (= s0 (rtc-register :second))) - (multiple-value-bind (c1-lo c1-mid c1-hi) + (multiple-value-bind (c1-lo c1-hi) (read-time-stamp-counter) - (let ((lo-res (+ (ash (- c1-hi c0-hi) 24) - (- c1-mid c0-mid)))) + (let ((res (+ (ash (- c1-hi c0-hi) 12) + (ash (- c1-lo c0-lo) -17)))) (cond - ((> lo-res 100) + ((> res 100) (setf (symbol-function 'get-internal-run-time) (lambda () - (multiple-value-bind (lo mid hi) + (multiple-value-bind (lo hi) (read-time-stamp-counter) - (declare (ignore lo)) - (dpb hi (byte 5 24) mid)))) - (setf internal-time-units-per-second lo-res)) + (+ (ash lo -17) + (ash (ldb (byte 10 0) hi) 12))))) + (setf internal-time-units-per-second res)) (t ;; This is for really slow machines, like bochs.. - (setf (symbol-function 'get-internal-run-time) - (lambda () - (multiple-value-bind (lo mid hi) - (read-time-stamp-counter) - (declare (ignore hi)) - (dpb mid - (byte 19 10) - (ldb (byte 10 14) lo))))) - (setf internal-time-units-per-second - (+ (ash (ldb (byte 19 0) (- c1-mid c0-mid)) 10) - (ldb (byte 10 14) (- c1-lo c0-lo)))))))))))) + (let ((res (+ (ash (- c1-hi c0-hi) 15) + (ash (- c1-lo c0-lo) -14)))) + (setf (symbol-function 'get-internal-run-time) + (lambda () + (multiple-value-bind (lo hi) + (read-time-stamp-counter) + (+ (ash lo -14) + (ash (ldb (byte 10 0) hi) 15))))) + (setf internal-time-units-per-second res))))))) + (warn "Internal-time will wrap in ~D days." + (truncate most-positive-fixnum + (* internal-time-units-per-second 60 60 24)))))) + ;;;(defun get-internal-run-time () ;;; (multiple-value-bind (lo mid hi) @@ -873,6 +903,11 @@ (error "What's up? [~S]" 'hey)) +(defun read (&optional input-stream eof-error-p eof-value recursive-p) + (declare (ignore input-stream recursive-p)) + (let ((string (muerte.readline:contextual-readline *repl-readline-context*))) + (simple-read-from-string string eof-error-p eof-value))) + (defun handle-warning (condition) (format t "Handle-warning: ~S" condition) (throw :debugger nil)) @@ -886,7 +921,7 @@ #+ignore (defun progntest () (unwind-protect - (progn (print 'x) 'foo 'bar) + (progn (print 'x) 'foo (error "bar")) (print 'y))) #+ignore @@ -944,6 +979,5 @@ (case (muerte.x86-pc.keyboard:poll-char) (#\esc (break "Under the bridge.")) (#\e (error "this is an error!")))))))) - (genesis)

1 0

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

21 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv14981 Modified Files: vga.lisp Log Message: Added some more VGA interfacing. Try e.g. (set-textmode +vga-state-80x50+). Date: Wed Apr 21 12:24:16 2004 Author: ffjeld Index: movitz/losp/x86-pc/vga.lisp diff -u movitz/losp/x86-pc/vga.lisp:1.4 movitz/losp/x86-pc/vga.lisp:1.5 --- movitz/losp/x86-pc/vga.lisp:1.4 Fri Apr 16 15:17:55 2004 +++ movitz/losp/x86-pc/vga.lisp Wed Apr 21 12:24:16 2004 @@ -6,11 +6,11 @@ ;;;; For distribution policy, see the accompanying file COPYING. ;;;; ;;;; Filename: vga.lisp -;;;; Description: +;;;; Description: Low-level VGA interfacing. ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 25 14:08:20 2001 ;;;; -;;;; $Id: vga.lisp,v 1.4 2004/04/16 19:17:55 ffjeld Exp $ +;;;; $Id: vga.lisp,v 1.5 2004/04/21 16:24:16 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -19,6 +19,11 @@ (in-package muerte.x86-pc) +(defconstant +vga-base+ #x3c0) + +(defmacro vga-port (register) + `(io-register8 +vga-base+ ,register)) + (defun vga-crt-controller-register (register) (let* ((address-register (if (logbitp 0 (io-port #x3cc :unsigned-byte8)) #x3d4 #x3b4)) (data-register (1+ address-register))) @@ -39,6 +44,24 @@ (setf (io-port #x3ce :unsigned-byte8) register (io-port #x3cf :unsigned-byte8) value)) +(defun vga-sequencer-register (register) + (setf (vga-port 4) register) + (vga-port 5)) + +(defun (setf vga-sequencer-register) (value register) + (setf (vga-port 4) register + (vga-port 5) value)) + +(defun vga-attribute-register (register) + (vga-port #x1a) + (setf (vga-port 0) register) + (vga-port 1)) + +(defun (setf vga-attribute-register) (value register) + (vga-port #x1a) + (setf (vga-port 0) register + (vga-port 0) value)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun (setf vga-cursor-location) (value) @@ -74,3 +97,793 @@ (defun vga-character-height () (1+ (ldb (byte 5 0) (vga-crt-controller-register 9)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; VGA stuff ported from http://my.execpc.com/CE/AC/geezer/osd/graphics/modes.c + +(defconstant +vga-state-80x25+ + '((:misc . #x67) + (:sequencer + #x03 #x00 #x03 #x00 #x02) + (:crtc + #x5F #x4F #x50 #x82 #x55 #x81 #xBF #x1F + #x00 #x4F #x0D #x0E #x00 #x00 #x00 #x50 + #x9C #x0E #x8F #x28 #x1F #x96 #xB9 #xA3 + #xFF) + (:graphics + #x00 #x00 #x00 #x00 #x00 #x10 #x0E #x00 + #xFF) + (:attribute + #x00 #x01 #x02 #x03 #x04 #x05 #x14 #x07 + #x38 #x39 #x3A #x3B #x3C #x3D #x3E #x3F + #x0C #x00 #x0F #x08 #x00))) + +(defconstant +vga-state-80x50+ + '((:misc . #x67) + (:sequencer + #x03 #x00 #x03 #x00 #x02) + (:crtc + #x5F #x4F #x50 #x82 #x55 #x81 #xBF #x1F + #x00 #x47 #x06 #x07 #x00 #x00 #x01 #x40 + #x9C #x8E #x8F #x28 #x1F #x96 #xB9 #xA3 + #xFF) + (:graphics + #x00 #x00 #x00 #x00 #x00 #x10 #x0E #x00 + #xFF) + (:attribute + #x00 #x01 #x02 #x03 #x04 #x05 #x14 #x07 + #x38 #x39 #x3A #x3B #x3C #x3D #x3E #x3F + #x0C #x00 #x0F #x08 #x00))) + +(defconstant +vga-state-40x25+ + '((:misc . #x67) + (:sequencer + #x03 #x08 #x03 #x00 #x02) + (:crtc + #x2D #x27 #x28 #x90 #x2B #xA0 #xBF #x1F + #x00 #x4F #x0D #x0E #x00 #x00 #x00 #xA0 + #x9C #x8E #x8F #x14 #x1F #x96 #xB9 #xA3 + #xFF) + (:graphics + #x00 #x00 #x00 #x00 #x00 #x10 #x0E #x00 + #xFF) + (:attribute + #x00 #x01 #x02 #x03 #x04 #x05 #x14 #x07 + #x38 #x39 #x3A #x3B #x3C #x3D #x3E #x3F + #x0C #x00 #x0F #x08 #x00))) + +(defconstant +vga-state-40x50+ + '((:misc . #x67) + (:sequencer + #x03 #x08 #x03 #x00 #x02) + (:crtc + #x2D #x27 #x28 #x90 #x2B #xA0 #xBF #x1F + #x00 #x47 #x06 #x07 #x00 #x00 #x04 #x60 + #x9C #x8E #x8F #x14 #x1F #x96 #xB9 #xA3 + #xFF) + (:graphics + #x00 #x00 #x00 #x00 #x00 #x10 #x0E #x00 + #xFF) + (:attribute + #x00 #x01 #x02 #x03 #x04 #x05 #x14 #x07 + #x38 #x39 #x3A #x3B #x3C #x3D #x3E #x3F + #x0C #x00 #x0F #x08 #x00))) + +(defconstant +vga-state-90x30+ + '((:misc . #xE7) + (:sequencer + #x03 #x01 #x03 #x00 #x02) + (:crtc + #x6B #x59 #x5A #x82 #x60 #x8D #x0B #x3E + #x00 #x4F #x0D #x0E #x00 #x00 #x00 #x00 + #xEA #x0C #xDF #x2D #x10 #xE8 #x05 #xA3 + #xFF) + (:graphics + #x00 #x00 #x00 #x00 #x00 #x10 #x0E #x00 + #xFF) + (:attribute + #x00 #x01 #x02 #x03 #x04 #x05 #x14 #x07 + #x38 #x39 #x3A #x3B #x3C #x3D #x3E #x3F + #x0C #x00 #x0F #x08 #x00))) + +(defconstant +vga-state-90x60+ + '((:misc . #xE7) + (:sequencer + #x03 #x01 #x03 #x00 #x02) + (:crtc + #x6B #x59 #x5A #x82 #x60 #x8D #x0B #x3E + #x00 #x47 #x06 #x07 #x00 #x00 #x00 #x00 + #xEA #x0C #xDF #x2D #x08 #xE8 #x05 #xA3 + #xFF) + (:graphics + #x00 #x00 #x00 #x00 #x00 #x10 #x0E #x00 + #xFF) + (:attribute + #x00 #x01 #x02 #x03 #x04 #x05 #x14 #x07 + #x38 #x39 #x3A #x3B #x3C #x3D #x3E #x3F + #x0C #x00 #x0F #x08 #x00))) + + +(defconstant +vga-misc-read+ #x0c) +(defconstant +vga-misc-write+ #x02) + +(defconstant VGA-MISC-WRITE #x3C2) +(defconstant VGA-AC-INDEX #x3C0) +(defconstant VGA-AC-WRITE #x3C0) +(defconstant VGA-AC-READ #x3C1) +(defconstant VGA-SEQ-INDEX #x3C4) +(defconstant VGA-SEQ-DATA #x3C5) +(defconstant VGA-DAC-READ-INDEX #x3C7) +(defconstant VGA-DAC-WRITE-INDEX #x3C8) +(defconstant VGA-DAC-DATA #x3C9) +(defconstant VGA-MISC-READ #x3CC) +(defconstant VGA-GC-INDEX #x3CE) +(defconstant VGA-GC-DATA #x3CF) +(defconstant VGA-CRTC-INDEX #x3D4) +(defconstant VGA-CRTC-DATA #x3D5) +(defconstant VGA-INSTAT-READ #x3DA) + +(defun vga-state () + "Dump the state of the VGA register set." + (prog1 + (list + (cons :misc + (vga-port +vga-misc-read+)) + (cons :sequencer + (loop for i from 0 below 5 + collect (vga-sequencer-register i))) + (cons :crtc + (loop for i from 0 below 25 + collect (vga-crt-controller-register i))) + (cons :graphics + (loop for i from 0 below 9 + collect (vga-graphics-register i))) + (cons :attribute + (loop for i from 0 below 21 + collect (vga-attribute-register i)))) + ;; lock 16-color palette and unblank display + (io-port VGA-INSTAT-READ :unsigned-byte8) + (setf (io-port VGA-AC-INDEX :unsigned-byte8) #x20))) + +(defun (setf vga-state) (state &optional unsafe-p) + "Initialize the state of the VGA register set." + (let ((old-state (if unsafe-p nil (vga-state)))) + (flet ((vga-reset (&optional c) + (declare (ignore c)) + (when old-state + (warn "Something bad happened, resetting VGA state..") + (setf (vga-state t) old-state + old-state nil))) + (assert-register-set (state register-set) + (let ((set (assoc register-set state))) + (assert set () "VGA state is missing ~A." register-set) + (cdr set)))) + (unwind-protect + (handler-bind ((serious-condition #'vga-reset)) + ;; write MISCELLANEOUS reg + (setf (vga-port +vga-misc-write+) + (assert-register-set state :misc)) + ;; write SEQUENCER regs + (loop for x in (assert-register-set state :sequencer) + as i upfrom 0 + do (setf (vga-sequencer-register i) x)) + (loop + ;; unlock CRTC registers + initially (setf (vga-crt-controller-register 3) + (logior #x80 (vga-crt-controller-register 3))) + (setf (vga-crt-controller-register #x11) + (logand #x7f (vga-crt-controller-register #x11))) + for x in (assert-register-set state :crtc) + as i upfrom 0 + do (setf (vga-crt-controller-register i) + (case i + ;; make sure they remain unlocked + (#x03 (logior #x80 x)) + (#x11 (logand #x7f x)) + (t x)))) + ;; write GRAPHICS CONTROLLER regs + (loop for x in (assert-register-set state :graphics) + as i upfrom 0 + do (setf (vga-graphics-register i) x)) + ;; write ATTRIBUTE CONTROLLER regs + (loop for x in (assert-register-set state :attribute) + as i upfrom 0 + do (setf (vga-attribute-register i) x)) + ;; lock 16-color palette and unblank display + (io-port VGA-INSTAT-READ :unsigned-byte8) + (setf (io-port VGA-AC-INDEX :unsigned-byte8) #x20) + (setf old-state nil)) + (vga-reset)))) + state) + +(defun set-plane (p) + (check-type p (integer 0 3)) + (let* ((p (logand p 3)) + (pmask (ash 1 p))) + ;; set read plane + (setf (io-port VGA-GC-INDEX :unsigned-byte8) 4) + (setf (io-port VGA-GC-DATA :unsigned-byte8) p) + ;; set write plane + (setf (io-port VGA-SEQ-INDEX :unsigned-byte8) 2) + (setf (io-port VGA-SEQ-DATA :unsigned-byte8) pmask)) + (values)) + +(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) + (aref src i))) + (values)) + +(defun write-font (buf font-height) + (let* ((seq2 + (progn + ;; set_plane() modifies GC 4 and SEQ 2, so save them as well + (setf (io-port VGA-SEQ-INDEX :unsigned-byte8) 2) + (io-port VGA-SEQ-DATA :unsigned-byte8))) + (seq4 + (progn + (setf (io-port VGA-SEQ-INDEX :unsigned-byte8) 4) + (io-port VGA-SEQ-DATA :unsigned-byte8))) + (gc4 + (progn + ;; turn off even-odd addressing (set flat addressing) + ;; assume: chain-4 addressing already off + (setf (io-port VGA-SEQ-DATA :unsigned-byte8) + (logior #x04 seq4)) + (setf (io-port VGA-GC-INDEX :unsigned-byte8) 4) + (io-port VGA-GC-DATA :unsigned-byte8))) + (gc5 + (progn + (setf (io-port VGA-GC-INDEX :unsigned-byte8) 5) + (io-port VGA-GC-DATA :unsigned-byte8))) + (gc6 + (progn + ;; turn off even-odd addressing + (setf (io-port VGA-GC-DATA :unsigned-byte8) + (logand gc5 (logxor #x10 #xff))) + (setf (io-port VGA-GC-INDEX :unsigned-byte8) 6) + (io-port VGA-GC-DATA :unsigned-byte8)))) + ;; turn off even-odd addressing + (setf (io-port VGA-GC-DATA :unsigned-byte8) + (logand gc6 (logxor #xff #x02))) + ;; write font to plane P4 + (set-plane 2) ; set_plane(2) + ;; write font 0 + (dotimes (i 256) + (vmemwr (* i 32) buf (* i font-height) (* (1+ i) font-height))) + + ;; restore registers + (setf (io-port VGA-SEQ-INDEX :unsigned-byte8) 2) + (setf (io-port VGA-SEQ-DATA :unsigned-byte8) seq2) + (setf (io-port VGA-SEQ-INDEX :unsigned-byte8) 4) + (setf (io-port VGA-SEQ-DATA :unsigned-byte8) seq4) + (setf (io-port VGA-GC-INDEX :unsigned-byte8) 4) + (setf (io-port VGA-GC-DATA :unsigned-byte8) gc4) + (setf (io-port VGA-GC-INDEX :unsigned-byte8) 5) + (setf (io-port VGA-GC-DATA :unsigned-byte8) gc5) + (setf (io-port VGA-GC-INDEX :unsigned-byte8) 6) + (setf (io-port VGA-GC-DATA :unsigned-byte8) gc6)) + (values)) + + +(defconstant +vga-font-8x8+ + #{#x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x7E #x81 #xA5 #x81 #xBD #x99 #x81 #x7E + #x7E #xFF #xDB #xFF #xC3 #xE7 #xFF #x7E + #x6C #xFE #xFE #xFE #x7C #x38 #x10 #x00 + #x10 #x38 #x7C #xFE #x7C #x38 #x10 #x00 + #x38 #x7C #x38 #xFE #xFE #x92 #x10 #x7C + #x00 #x10 #x38 #x7C #xFE #x7C #x38 #x7C + #x00 #x00 #x18 #x3C #x3C #x18 #x00 #x00 + #xFF #xFF #xE7 #xC3 #xC3 #xE7 #xFF #xFF + #x00 #x3C #x66 #x42 #x42 #x66 #x3C #x00 + #xFF #xC3 #x99 #xBD #xBD #x99 #xC3 #xFF + #x0F #x07 #x0F #x7D #xCC #xCC #xCC #x78 + #x3C #x66 #x66 #x66 #x3C #x18 #x7E #x18 + #x3F #x33 #x3F #x30 #x30 #x70 #xF0 #xE0 + #x7F #x63 #x7F #x63 #x63 #x67 #xE6 #xC0 + #x99 #x5A #x3C #xE7 #xE7 #x3C #x5A #x99 + #x80 #xE0 #xF8 #xFE #xF8 #xE0 #x80 #x00 + #x02 #x0E #x3E #xFE #x3E #x0E #x02 #x00 + #x18 #x3C #x7E #x18 #x18 #x7E #x3C #x18 + #x66 #x66 #x66 #x66 #x66 #x00 #x66 #x00 + #x7F #xDB #xDB #x7B #x1B #x1B #x1B #x00 + #x3E #x63 #x38 #x6C #x6C #x38 #x86 #xFC + #x00 #x00 #x00 #x00 #x7E #x7E #x7E #x00 + #x18 #x3C #x7E #x18 #x7E #x3C #x18 #xFF + #x18 #x3C #x7E #x18 #x18 #x18 #x18 #x00 + #x18 #x18 #x18 #x18 #x7E #x3C #x18 #x00 + #x00 #x18 #x0C #xFE #x0C #x18 #x00 #x00 + #x00 #x30 #x60 #xFE #x60 #x30 #x00 #x00 + #x00 #x00 #xC0 #xC0 #xC0 #xFE #x00 #x00 + #x00 #x24 #x66 #xFF #x66 #x24 #x00 #x00 + #x00 #x18 #x3C #x7E #xFF #xFF #x00 #x00 + #x00 #xFF #xFF #x7E #x3C #x18 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x18 #x3C #x3C #x18 #x18 #x00 #x18 #x00 + #x6C #x6C #x6C #x00 #x00 #x00 #x00 #x00 + #x6C #x6C #xFE #x6C #xFE #x6C #x6C #x00 + #x18 #x7E #xC0 #x7C #x06 #xFC #x18 #x00 + #x00 #xC6 #xCC #x18 #x30 #x66 #xC6 #x00 + #x38 #x6C #x38 #x76 #xDC #xCC #x76 #x00 + #x30 #x30 #x60 #x00 #x00 #x00 #x00 #x00 + #x18 #x30 #x60 #x60 #x60 #x30 #x18 #x00 + #x60 #x30 #x18 #x18 #x18 #x30 #x60 #x00 + #x00 #x66 #x3C #xFF #x3C #x66 #x00 #x00 + #x00 #x18 #x18 #x7E #x18 #x18 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x18 #x18 #x30 + #x00 #x00 #x00 #x7E #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x18 #x18 #x00 + #x06 #x0C #x18 #x30 #x60 #xC0 #x80 #x00 + #x7C #xCE #xDE #xF6 #xE6 #xC6 #x7C #x00 + #x30 #x70 #x30 #x30 #x30 #x30 #xFC #x00 + #x78 #xCC #x0C #x38 #x60 #xCC #xFC #x00 + #x78 #xCC #x0C #x38 #x0C #xCC #x78 #x00 + #x1C #x3C #x6C #xCC #xFE #x0C #x1E #x00 + #xFC #xC0 #xF8 #x0C #x0C #xCC #x78 #x00 + #x38 #x60 #xC0 #xF8 #xCC #xCC #x78 #x00 + #xFC #xCC #x0C #x18 #x30 #x30 #x30 #x00 + #x78 #xCC #xCC #x78 #xCC #xCC #x78 #x00 + #x78 #xCC #xCC #x7C #x0C #x18 #x70 #x00 + #x00 #x18 #x18 #x00 #x00 #x18 #x18 #x00 + #x00 #x18 #x18 #x00 #x00 #x18 #x18 #x30 + #x18 #x30 #x60 #xC0 #x60 #x30 #x18 #x00 + #x00 #x00 #x7E #x00 #x7E #x00 #x00 #x00 + #x60 #x30 #x18 #x0C #x18 #x30 #x60 #x00 + #x3C #x66 #x0C #x18 #x18 #x00 #x18 #x00 + #x7C #xC6 #xDE #xDE #xDC #xC0 #x7C #x00 + #x30 #x78 #xCC #xCC #xFC #xCC #xCC #x00 + #xFC #x66 #x66 #x7C #x66 #x66 #xFC #x00 + #x3C #x66 #xC0 #xC0 #xC0 #x66 #x3C #x00 + #xF8 #x6C #x66 #x66 #x66 #x6C #xF8 #x00 + #xFE #x62 #x68 #x78 #x68 #x62 #xFE #x00 + #xFE #x62 #x68 #x78 #x68 #x60 #xF0 #x00 + #x3C #x66 #xC0 #xC0 #xCE #x66 #x3A #x00 + #xCC #xCC #xCC #xFC #xCC #xCC #xCC #x00 + #x78 #x30 #x30 #x30 #x30 #x30 #x78 #x00 + #x1E #x0C #x0C #x0C #xCC #xCC #x78 #x00 + #xE6 #x66 #x6C #x78 #x6C #x66 #xE6 #x00 + #xF0 #x60 #x60 #x60 #x62 #x66 #xFE #x00 + #xC6 #xEE #xFE #xFE #xD6 #xC6 #xC6 #x00 + #xC6 #xE6 #xF6 #xDE #xCE #xC6 #xC6 #x00 + #x38 #x6C #xC6 #xC6 #xC6 #x6C #x38 #x00 + #xFC #x66 #x66 #x7C #x60 #x60 #xF0 #x00 + #x7C #xC6 #xC6 #xC6 #xD6 #x7C #x0E #x00 + #xFC #x66 #x66 #x7C #x6C #x66 #xE6 #x00 + #x7C #xC6 #xE0 #x78 #x0E #xC6 #x7C #x00 + #xFC #xB4 #x30 #x30 #x30 #x30 #x78 #x00 + #xCC #xCC #xCC #xCC #xCC #xCC #xFC #x00 + #xCC #xCC #xCC #xCC #xCC #x78 #x30 #x00 + #xC6 #xC6 #xC6 #xC6 #xD6 #xFE #x6C #x00 + #xC6 #xC6 #x6C #x38 #x6C #xC6 #xC6 #x00 + #xCC #xCC #xCC #x78 #x30 #x30 #x78 #x00 + #xFE #xC6 #x8C #x18 #x32 #x66 #xFE #x00 + #x78 #x60 #x60 #x60 #x60 #x60 #x78 #x00 + #xC0 #x60 #x30 #x18 #x0C #x06 #x02 #x00 + #x78 #x18 #x18 #x18 #x18 #x18 #x78 #x00 + #x10 #x38 #x6C #xC6 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #xFF + #x30 #x30 #x18 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x78 #x0C #x7C #xCC #x76 #x00 + #xE0 #x60 #x60 #x7C #x66 #x66 #xDC #x00 + #x00 #x00 #x78 #xCC #xC0 #xCC #x78 #x00 + #x1C #x0C #x0C #x7C #xCC #xCC #x76 #x00 + #x00 #x00 #x78 #xCC #xFC #xC0 #x78 #x00 + #x38 #x6C #x64 #xF0 #x60 #x60 #xF0 #x00 + #x00 #x00 #x76 #xCC #xCC #x7C #x0C #xF8 + #xE0 #x60 #x6C #x76 #x66 #x66 #xE6 #x00 + #x30 #x00 #x70 #x30 #x30 #x30 #x78 #x00 + #x0C #x00 #x1C #x0C #x0C #xCC #xCC #x78 + #xE0 #x60 #x66 #x6C #x78 #x6C #xE6 #x00 + #x70 #x30 #x30 #x30 #x30 #x30 #x78 #x00 + #x00 #x00 #xCC #xFE #xFE #xD6 #xD6 #x00 + #x00 #x00 #xB8 #xCC #xCC #xCC #xCC #x00 + #x00 #x00 #x78 #xCC #xCC #xCC #x78 #x00 + #x00 #x00 #xDC #x66 #x66 #x7C #x60 #xF0 + #x00 #x00 #x76 #xCC #xCC #x7C #x0C #x1E + #x00 #x00 #xDC #x76 #x62 #x60 #xF0 #x00 + #x00 #x00 #x7C #xC0 #x70 #x1C #xF8 #x00 + #x10 #x30 #xFC #x30 #x30 #x34 #x18 #x00 + #x00 #x00 #xCC #xCC #xCC #xCC #x76 #x00 + #x00 #x00 #xCC #xCC #xCC #x78 #x30 #x00 + #x00 #x00 #xC6 #xC6 #xD6 #xFE #x6C #x00 + #x00 #x00 #xC6 #x6C #x38 #x6C #xC6 #x00 + #x00 #x00 #xCC #xCC #xCC #x7C #x0C #xF8 + #x00 #x00 #xFC #x98 #x30 #x64 #xFC #x00 + #x1C #x30 #x30 #xE0 #x30 #x30 #x1C #x00 + #x18 #x18 #x18 #x00 #x18 #x18 #x18 #x00 + #xE0 #x30 #x30 #x1C #x30 #x30 #xE0 #x00 + #x76 #xDC #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x10 #x38 #x6C #xC6 #xC6 #xFE #x00 + #x7C #xC6 #xC0 #xC6 #x7C #x0C #x06 #x7C + #x00 #xCC #x00 #xCC #xCC #xCC #x76 #x00 + #x1C #x00 #x78 #xCC #xFC #xC0 #x78 #x00 + #x7E #x81 #x3C #x06 #x3E #x66 #x3B #x00 + #xCC #x00 #x78 #x0C #x7C #xCC #x76 #x00 + #xE0 #x00 #x78 #x0C #x7C #xCC #x76 #x00 + #x30 #x30 #x78 #x0C #x7C #xCC #x76 #x00 + #x00 #x00 #x7C #xC6 #xC0 #x78 #x0C #x38 + #x7E #x81 #x3C #x66 #x7E #x60 #x3C #x00 + #xCC #x00 #x78 #xCC #xFC #xC0 #x78 #x00 + #xE0 #x00 #x78 #xCC #xFC #xC0 #x78 #x00 + #xCC #x00 #x70 #x30 #x30 #x30 #x78 #x00 + #x7C #x82 #x38 #x18 #x18 #x18 #x3C #x00 + #xE0 #x00 #x70 #x30 #x30 #x30 #x78 #x00 + #xC6 #x10 #x7C #xC6 #xFE #xC6 #xC6 #x00 + #x30 #x30 #x00 #x78 #xCC #xFC #xCC #x00 + #x1C #x00 #xFC #x60 #x78 #x60 #xFC #x00 + #x00 #x00 #x7F #x0C #x7F #xCC #x7F #x00 + #x3E #x6C #xCC #xFE #xCC #xCC #xCE #x00 + #x78 #x84 #x00 #x78 #xCC #xCC #x78 #x00 + #x00 #xCC #x00 #x78 #xCC #xCC #x78 #x00 + #x00 #xE0 #x00 #x78 #xCC #xCC #x78 #x00 + #x78 #x84 #x00 #xCC #xCC #xCC #x76 #x00 + #x00 #xE0 #x00 #xCC #xCC #xCC #x76 #x00 + #x00 #xCC #x00 #xCC #xCC #x7C #x0C #xF8 + #xC3 #x18 #x3C #x66 #x66 #x3C #x18 #x00 + #xCC #x00 #xCC #xCC #xCC #xCC #x78 #x00 + #x18 #x18 #x7E #xC0 #xC0 #x7E #x18 #x18 + #x38 #x6C #x64 #xF0 #x60 #xE6 #xFC #x00 + #xCC #xCC #x78 #x30 #xFC #x30 #xFC #x30 + #xF8 #xCC #xCC #xFA #xC6 #xCF #xC6 #xC3 + #x0E #x1B #x18 #x3C #x18 #x18 #xD8 #x70 + #x1C #x00 #x78 #x0C #x7C #xCC #x76 #x00 + #x38 #x00 #x70 #x30 #x30 #x30 #x78 #x00 + #x00 #x1C #x00 #x78 #xCC #xCC #x78 #x00 + #x00 #x1C #x00 #xCC #xCC #xCC #x76 #x00 + #x00 #xF8 #x00 #xB8 #xCC #xCC #xCC #x00 + #xFC #x00 #xCC #xEC #xFC #xDC #xCC #x00 + #x3C #x6C #x6C #x3E #x00 #x7E #x00 #x00 + #x38 #x6C #x6C #x38 #x00 #x7C #x00 #x00 + #x18 #x00 #x18 #x18 #x30 #x66 #x3C #x00 + #x00 #x00 #x00 #xFC #xC0 #xC0 #x00 #x00 + #x00 #x00 #x00 #xFC #x0C #x0C #x00 #x00 + #xC6 #xCC #xD8 #x36 #x6B #xC2 #x84 #x0F + #xC3 #xC6 #xCC #xDB #x37 #x6D #xCF #x03 + #x18 #x00 #x18 #x18 #x3C #x3C #x18 #x00 + #x00 #x33 #x66 #xCC #x66 #x33 #x00 #x00 + #x00 #xCC #x66 #x33 #x66 #xCC #x00 #x00 + #x22 #x88 #x22 #x88 #x22 #x88 #x22 #x88 + #x55 #xAA #x55 #xAA #x55 #xAA #x55 #xAA + #xDB #xF6 #xDB #x6F #xDB #x7E #xD7 #xED + #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 + #x18 #x18 #x18 #x18 #xF8 #x18 #x18 #x18 + #x18 #x18 #xF8 #x18 #xF8 #x18 #x18 #x18 + #x36 #x36 #x36 #x36 #xF6 #x36 #x36 #x36 + #x00 #x00 #x00 #x00 #xFE #x36 #x36 #x36 + #x00 #x00 #xF8 #x18 #xF8 #x18 #x18 #x18 + #x36 #x36 #xF6 #x06 #xF6 #x36 #x36 #x36 + #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 + #x00 #x00 #xFE #x06 #xF6 #x36 #x36 #x36 + #x36 #x36 #xF6 #x06 #xFE #x00 #x00 #x00 + #x36 #x36 #x36 #x36 #xFE #x00 #x00 #x00 + #x18 #x18 #xF8 #x18 #xF8 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #xF8 #x18 #x18 #x18 + #x18 #x18 #x18 #x18 #x1F #x00 #x00 #x00 + #x18 #x18 #x18 #x18 #xFF #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #xFF #x18 #x18 #x18 + #x18 #x18 #x18 #x18 #x1F #x18 #x18 #x18 + #x00 #x00 #x00 #x00 #xFF #x00 #x00 #x00 + #x18 #x18 #x18 #x18 #xFF #x18 #x18 #x18 + #x18 #x18 #x1F #x18 #x1F #x18 #x18 #x18 + #x36 #x36 #x36 #x36 #x37 #x36 #x36 #x36 + #x36 #x36 #x37 #x30 #x3F #x00 #x00 #x00 + #x00 #x00 #x3F #x30 #x37 #x36 #x36 #x36 + #x36 #x36 #xF7 #x00 #xFF #x00 #x00 #x00 + #x00 #x00 #xFF #x00 #xF7 #x36 #x36 #x36 + #x36 #x36 #x37 #x30 #x37 #x36 #x36 #x36 + #x00 #x00 #xFF #x00 #xFF #x00 #x00 #x00 + #x36 #x36 #xF7 #x00 #xF7 #x36 #x36 #x36 + #x18 #x18 #xFF #x00 #xFF #x00 #x00 #x00 + #x36 #x36 #x36 #x36 #xFF #x00 #x00 #x00 + #x00 #x00 #xFF #x00 #xFF #x18 #x18 #x18 + #x00 #x00 #x00 #x00 #xFF #x36 #x36 #x36 + #x36 #x36 #x36 #x36 #x3F #x00 #x00 #x00 + #x18 #x18 #x1F #x18 #x1F #x00 #x00 #x00 + #x00 #x00 #x1F #x18 #x1F #x18 #x18 #x18 + #x00 #x00 #x00 #x00 #x3F #x36 #x36 #x36 + #x36 #x36 #x36 #x36 #xFF #x36 #x36 #x36 + #x18 #x18 #xFF #x18 #xFF #x18 #x18 #x18 + #x18 #x18 #x18 #x18 #xF8 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x1F #x18 #x18 #x18 + #xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF + #x00 #x00 #x00 #x00 #xFF #xFF #xFF #xFF + #xF0 #xF0 #xF0 #xF0 #xF0 #xF0 #xF0 #xF0 + #x0F #x0F #x0F #x0F #x0F #x0F #x0F #x0F + #xFF #xFF #xFF #xFF #x00 #x00 #x00 #x00 + #x00 #x00 #x76 #xDC #xC8 #xDC #x76 #x00 + #x00 #x78 #xCC #xF8 #xCC #xF8 #xC0 #xC0 + #x00 #xFC #xCC #xC0 #xC0 #xC0 #xC0 #x00 + #x00 #x00 #xFE #x6C #x6C #x6C #x6C #x00 + #xFC #xCC #x60 #x30 #x60 #xCC #xFC #x00 + #x00 #x00 #x7E #xD8 #xD8 #xD8 #x70 #x00 + #x00 #x66 #x66 #x66 #x66 #x7C #x60 #xC0 + #x00 #x76 #xDC #x18 #x18 #x18 #x18 #x00 + #xFC #x30 #x78 #xCC #xCC #x78 #x30 #xFC + #x38 #x6C #xC6 #xFE #xC6 #x6C #x38 #x00 + #x38 #x6C #xC6 #xC6 #x6C #x6C #xEE #x00 + #x1C #x30 #x18 #x7C #xCC #xCC #x78 #x00 + #x00 #x00 #x7E #xDB #xDB #x7E #x00 #x00 + #x06 #x0C #x7E #xDB #xDB #x7E #x60 #xC0 + #x38 #x60 #xC0 #xF8 #xC0 #x60 #x38 #x00 + #x78 #xCC #xCC #xCC #xCC #xCC #xCC #x00 + #x00 #x7E #x00 #x7E #x00 #x7E #x00 #x00 + #x18 #x18 #x7E #x18 #x18 #x00 #x7E #x00 + #x60 #x30 #x18 #x30 #x60 #x00 #xFC #x00 + #x18 #x30 #x60 #x30 #x18 #x00 #xFC #x00 + #x0E #x1B #x1B #x18 #x18 #x18 #x18 #x18 + #x18 #x18 #x18 #x18 #x18 #xD8 #xD8 #x70 + #x18 #x18 #x00 #x7E #x00 #x18 #x18 #x00 + #x00 #x76 #xDC #x00 #x76 #xDC #x00 #x00 + #x38 #x6C #x6C #x38 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x18 #x18 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x18 #x00 #x00 #x00 + #x0F #x0C #x0C #x0C #xEC #x6C #x3C #x1C + #x58 #x6C #x6C #x6C #x6C #x00 #x00 #x00 + #x70 #x98 #x30 #x60 #xF8 #x00 #x00 #x00 + #x00 #x00 #x3C #x3C #x3C #x3C #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 }) + +(defconstant +vga-font-8x16+ + #{#x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x7E #x81 #xA5 #x81 #x81 #xBD #x99 #x81 #x81 #x7E #x00 #x00 #x00 #x00 + #x00 #x00 #x7E #xFF #xDB #xFF #xFF #xC3 #xE7 #xFF #xFF #x7E #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x6C #xFE #xFE #xFE #xFE #x7C #x38 #x10 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x10 #x38 #x7C #xFE #x7C #x38 #x10 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x18 #x3C #x3C #xE7 #xE7 #xE7 #x99 #x18 #x3C #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x18 #x3C #x7E #xFF #xFF #x7E #x18 #x18 #x3C #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x18 #x3C #x3C #x18 #x00 #x00 #x00 #x00 #x00 #x00 + #xFF #xFF #xFF #xFF #xFF #xFF #xE7 #xC3 #xC3 #xE7 #xFF #xFF #xFF #xFF #xFF #xFF + #x00 #x00 #x00 #x00 #x00 #x3C #x66 #x42 #x42 #x66 #x3C #x00 #x00 #x00 #x00 #x00 + #xFF #xFF #xFF #xFF #xFF #xC3 #x99 #xBD #xBD #x99 #xC3 #xFF #xFF #xFF #xFF #xFF + #x00 #x00 #x1E #x0E #x1A #x32 #x78 #xCC #xCC #xCC #xCC #x78 #x00 #x00 #x00 #x00 + #x00 #x00 #x3C #x66 #x66 #x66 #x66 #x3C #x18 #x7E #x18 #x18 #x00 #x00 #x00 #x00 + #x00 #x00 #x3F #x33 #x3F #x30 #x30 #x30 #x30 #x70 #xF0 #xE0 #x00 #x00 #x00 #x00 + #x00 #x00 #x7F #x63 #x7F #x63 #x63 #x63 #x63 #x67 #xE7 #xE6 #xC0 #x00 #x00 #x00 + #x00 #x00 #x00 #x18 #x18 #xDB #x3C #xE7 #x3C #xDB #x18 #x18 #x00 #x00 #x00 #x00 + #x00 #x80 #xC0 #xE0 #xF0 #xF8 #xFE #xF8 #xF0 #xE0 #xC0 #x80 #x00 #x00 #x00 #x00 + #x00 #x02 #x06 #x0E #x1E #x3E #xFE #x3E #x1E #x0E #x06 #x02 #x00 #x00 #x00 #x00 + #x00 #x00 #x18 #x3C #x7E #x18 #x18 #x18 #x18 #x7E #x3C #x18 #x00 #x00 #x00 #x00 + #x00 #x00 #x66 #x66 #x66 #x66 #x66 #x66 #x66 #x00 #x66 #x66 #x00 #x00 #x00 #x00 + #x00 #x00 #x7F #xDB #xDB #xDB #x7B #x1B #x1B #x1B #x1B #x1B #x00 #x00 #x00 #x00 + #x00 #x7C #xC6 #x60 #x38 #x6C #xC6 #xC6 #x6C #x38 #x0C #xC6 #x7C #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #xFE #xFE #xFE #xFE #x00 #x00 #x00 #x00 + #x00 #x00 #x18 #x3C #x7E #x18 #x18 #x18 #x18 #x7E #x3C #x18 #x7E #x00 #x00 #x00 + #x00 #x00 #x18 #x3C #x7E #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x00 #x00 #x00 #x00 + #x00 #x00 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x7E #x3C #x18 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x18 #x0C #xFE #x0C #x18 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x30 #x60 #xFE #x60 #x30 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #xC0 #xC0 #xC0 #xC0 #xFE #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x28 #x6C #xFE #x6C #x28 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x10 #x38 #x38 #x7C #x7C #xFE #xFE #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #xFE #xFE #x7C #x7C #x38 #x38 #x10 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x18 #x3C #x3C #x3C #x18 #x18 #x18 #x00 #x18 #x18 #x00 #x00 #x00 #x00 + #x00 #x66 #x66 #x66 #x24 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x6C #x6C #xFE #x6C #x6C #x6C #xFE #x6C #x6C #x00 #x00 #x00 #x00 + #x18 #x18 #x7C #xC6 #xC2 #xC0 #x7C #x06 #x86 #xC6 #x7C #x18 #x18 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #xC2 #xC6 #x0C #x18 #x30 #x60 #xC6 #x86 #x00 #x00 #x00 #x00 + #x00 #x00 #x38 #x6C #x6C #x38 #x76 #xDC #xCC #xCC #xCC #x76 #x00 #x00 #x00 #x00 + #x00 #x30 #x30 #x30 #x60 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x0C #x18 #x30 #x30 #x30 #x30 #x30 #x30 #x18 #x0C #x00 #x00 #x00 #x00 + #x00 #x00 #x30 #x18 #x0C #x0C #x0C #x0C #x0C #x0C #x18 #x30 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x66 #x3C #xFF #x3C #x66 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x18 #x18 #x7E #x18 #x18 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x18 #x18 #x18 #x30 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #xFE #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x18 #x18 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x02 #x06 #x0C #x18 #x30 #x60 #xC0 #x80 #x00 #x00 #x00 #x00 + #x00 #x00 #x7C #xC6 #xC6 #xCE #xD6 #xD6 #xE6 #xC6 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #x18 #x38 #x78 #x18 #x18 #x18 #x18 #x18 #x18 #x7E #x00 #x00 #x00 #x00 + #x00 #x00 #x7C #xC6 #x06 #x0C #x18 #x30 #x60 #xC0 #xC6 #xFE #x00 #x00 #x00 #x00 + #x00 #x00 #x7C #xC6 #x06 #x06 #x3C #x06 #x06 #x06 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #x0C #x1C #x3C #x6C #xCC #xFE #x0C #x0C #x0C #x1E #x00 #x00 #x00 #x00 + #x00 #x00 #xFE #xC0 #xC0 #xC0 #xFC #x0E #x06 #x06 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #x38 #x60 #xC0 #xC0 #xFC #xC6 #xC6 #xC6 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #xFE #xC6 #x06 #x06 #x0C #x18 #x30 #x30 #x30 #x30 #x00 #x00 #x00 #x00 + #x00 #x00 #x7C #xC6 #xC6 #xC6 #x7C #xC6 #xC6 #xC6 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #x7C #xC6 #xC6 #xC6 #x7E #x06 #x06 #x06 #x0C #x78 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x18 #x18 #x00 #x00 #x00 #x18 #x18 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x18 #x18 #x00 #x00 #x00 #x18 #x18 #x30 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x06 #x0C #x18 #x30 #x60 #x30 #x18 #x0C #x06 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #xFE #x00 #x00 #xFE #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x60 #x30 #x18 #x0C #x06 #x0C #x18 #x30 #x60 #x00 #x00 #x00 #x00 + #x00 #x00 #x7C #xC6 #xC6 #x0C #x18 #x18 #x18 #x00 #x18 #x18 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x7C #xC6 #xC6 #xDE #xDE #xDE #xDC #xC0 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #x10 #x38 #x6C #xC6 #xC6 #xFE #xC6 #xC6 #xC6 #xC6 #x00 #x00 #x00 #x00 + #x00 #x00 #xFC #x66 #x66 #x66 #x7C #x66 #x66 #x66 #x66 #xFC #x00 #x00 #x00 #x00 + #x00 #x00 #x3C #x66 #xC2 #xC0 #xC0 #xC0 #xC0 #xC2 #x66 #x3C #x00 #x00 #x00 #x00 + #x00 #x00 #xF8 #x6C #x66 #x66 #x66 #x66 #x66 #x66 #x6C #xF8 #x00 #x00 #x00 #x00 + #x00 #x00 #xFE #x66 #x62 #x68 #x78 #x68 #x60 #x62 #x66 #xFE #x00 #x00 #x00 #x00 + #x00 #x00 #xFE #x66 #x62 #x68 #x78 #x68 #x60 #x60 #x60 #xF0 #x00 #x00 #x00 #x00 + #x00 #x00 #x3C #x66 #xC2 #xC0 #xC0 #xDE #xC6 #xC6 #x66 #x3A #x00 #x00 #x00 #x00 + #x00 #x00 #xC6 #xC6 #xC6 #xC6 #xFE #xC6 #xC6 #xC6 #xC6 #xC6 #x00 #x00 #x00 #x00 + #x00 #x00 #x3C #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x3C #x00 #x00 #x00 #x00 + #x00 #x00 #x1E #x0C #x0C #x0C #x0C #x0C #xCC #xCC #xCC #x78 #x00 #x00 #x00 #x00 + #x00 #x00 #xE6 #x66 #x6C #x6C #x78 #x78 #x6C #x66 #x66 #xE6 #x00 #x00 #x00 #x00 + #x00 #x00 #xF0 #x60 #x60 #x60 #x60 #x60 #x60 #x62 #x66 #xFE #x00 #x00 #x00 #x00 + #x00 #x00 #xC6 #xEE #xFE #xFE #xD6 #xC6 #xC6 #xC6 #xC6 #xC6 #x00 #x00 #x00 #x00 + #x00 #x00 #xC6 #xE6 #xF6 #xFE #xDE #xCE #xC6 #xC6 #xC6 #xC6 #x00 #x00 #x00 #x00 + #x00 #x00 #x38 #x6C #xC6 #xC6 #xC6 #xC6 #xC6 #xC6 #x6C #x38 #x00 #x00 #x00 #x00 + #x00 #x00 #xFC #x66 #x66 #x66 #x7C #x60 #x60 #x60 #x60 #xF0 #x00 #x00 #x00 #x00 + #x00 #x00 #x7C #xC6 #xC6 #xC6 #xC6 #xC6 #xC6 #xD6 #xDE #x7C #x0C #x0E #x00 #x00 + #x00 #x00 #xFC #x66 #x66 #x66 #x7C #x6C #x66 #x66 #x66 #xE6 #x00 #x00 #x00 #x00 + #x00 #x00 #x7C #xC6 #xC6 #x60 #x38 #x0C #x06 #xC6 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #x7E #x7E #x5A #x18 #x18 #x18 #x18 #x18 #x18 #x3C #x00 #x00 #x00 #x00 + #x00 #x00 #xC6 #xC6 #xC6 #xC6 #xC6 #xC6 #xC6 #xC6 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #xC6 #xC6 #xC6 #xC6 #xC6 #xC6 #xC6 #x6C #x38 #x10 #x00 #x00 #x00 #x00 + #x00 #x00 #xC6 #xC6 #xC6 #xC6 #xC6 #xD6 #xD6 #xFE #x6C #x6C #x00 #x00 #x00 #x00 + #x00 #x00 #xC6 #xC6 #x6C #x6C #x38 #x38 #x6C #x6C #xC6 #xC6 #x00 #x00 #x00 #x00 + #x00 #x00 #x66 #x66 #x66 #x66 #x3C #x18 #x18 #x18 #x18 #x3C #x00 #x00 #x00 #x00 + #x00 #x00 #xFE #xC6 #x86 #x0C #x18 #x30 #x60 #xC2 #xC6 #xFE #x00 #x00 #x00 #x00 + #x00 #x00 #x3C #x30 #x30 #x30 #x30 #x30 #x30 #x30 #x30 #x3C #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x80 #xC0 #xE0 #x70 #x38 #x1C #x0E #x06 #x02 #x00 #x00 #x00 #x00 + #x00 #x00 #x3C #x0C #x0C #x0C #x0C #x0C #x0C #x0C #x0C #x3C #x00 #x00 #x00 #x00 + #x10 #x38 #x6C #xC6 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #xFF #x00 #x00 + #x30 #x30 #x18 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x78 #x0C #x7C #xCC #xCC #xCC #x76 #x00 #x00 #x00 #x00 + #x00 #x00 #xE0 #x60 #x60 #x78 #x6C #x66 #x66 #x66 #x66 #xDC #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x7C #xC6 #xC0 #xC0 #xC0 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #x1C #x0C #x0C #x3C #x6C #xCC #xCC #xCC #xCC #x76 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x7C #xC6 #xFE #xC0 #xC0 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #x38 #x6C #x64 #x60 #xF0 #x60 #x60 #x60 #x60 #xF0 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x76 #xCC #xCC #xCC #xCC #xCC #x7C #x0C #xCC #x78 #x00 + #x00 #x00 #xE0 #x60 #x60 #x6C #x76 #x66 #x66 #x66 #x66 #xE6 #x00 #x00 #x00 #x00 + #x00 #x00 #x18 #x18 #x00 #x38 #x18 #x18 #x18 #x18 #x18 #x3C #x00 #x00 #x00 #x00 + #x00 #x00 #x06 #x06 #x00 #x0E #x06 #x06 #x06 #x06 #x06 #x06 #x66 #x66 #x3C #x00 + #x00 #x00 #xE0 #x60 #x60 #x66 #x6C #x78 #x78 #x6C #x66 #xE6 #x00 #x00 #x00 #x00 + #x00 #x00 #x38 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x3C #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #xEC #xFE #xD6 #xD6 #xD6 #xD6 #xD6 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #xDC #x66 #x66 #x66 #x66 #x66 #x66 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x7C #xC6 #xC6 #xC6 #xC6 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #xDC #x66 #x66 #x66 #x66 #x66 #x7C #x60 #x60 #xF0 #x00 + #x00 #x00 #x00 #x00 #x00 #x76 #xCC #xCC #xCC #xCC #xCC #x7C #x0C #x0C #x1E #x00 + #x00 #x00 #x00 #x00 #x00 #xDC #x76 #x62 #x60 #x60 #x60 #xF0 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x7C #xC6 #x60 #x38 #x0C #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #x10 #x30 #x30 #xFC #x30 #x30 #x30 #x30 #x36 #x1C #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #xCC #xCC #xCC #xCC #xCC #xCC #x76 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x66 #x66 #x66 #x66 #x66 #x3C #x18 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #xC6 #xC6 #xC6 #xD6 #xD6 #xFE #x6C #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #xC6 #x6C #x38 #x38 #x38 #x6C #xC6 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #xC6 #xC6 #xC6 #xC6 #xC6 #xC6 #x7E #x06 #x0C #xF8 #x00 + #x00 #x00 #x00 #x00 #x00 #xFE #xCC #x18 #x30 #x60 #xC6 #xFE #x00 #x00 #x00 #x00 + #x00 #x00 #x0E #x18 #x18 #x18 #x70 #x18 #x18 #x18 #x18 #x0E #x00 #x00 #x00 #x00 + #x00 #x00 #x18 #x18 #x18 #x18 #x00 #x18 #x18 #x18 #x18 #x18 #x00 #x00 #x00 #x00 + #x00 #x00 #x70 #x18 #x18 #x18 #x0E #x18 #x18 #x18 #x18 #x70 #x00 #x00 #x00 #x00 + #x00 #x00 #x76 #xDC #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x10 #x38 #x6C #xC6 #xC6 #xC6 #xFE #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x3C #x66 #xC2 #xC0 #xC0 #xC0 #xC2 #x66 #x3C #x0C #x06 #x7C #x00 #x00 + #x00 #x00 #xCC #xCC #x00 #xCC #xCC #xCC #xCC #xCC #xCC #x76 #x00 #x00 #x00 #x00 + #x00 #x0C #x18 #x30 #x00 #x7C #xC6 #xFE #xC0 #xC0 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x10 #x38 #x6C #x00 #x78 #x0C #x7C #xCC #xCC #xCC #x76 #x00 #x00 #x00 #x00 + #x00 #x00 #xCC #xCC #x00 #x78 #x0C #x7C #xCC #xCC #xCC #x76 #x00 #x00 #x00 #x00 + #x00 #x60 #x30 #x18 #x00 #x78 #x0C #x7C #xCC #xCC #xCC #x76 #x00 #x00 #x00 #x00 + #x00 #x38 #x6C #x38 #x00 #x78 #x0C #x7C #xCC #xCC #xCC #x76 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x3C #x66 #x60 #x60 #x66 #x3C #x0C #x06 #x3C #x00 #x00 #x00 + #x00 #x10 #x38 #x6C #x00 #x7C #xC6 #xFE #xC0 #xC0 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #xC6 #xC6 #x00 #x7C #xC6 #xFE #xC0 #xC0 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x60 #x30 #x18 #x00 #x7C #xC6 #xFE #xC0 #xC0 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #x66 #x66 #x00 #x38 #x18 #x18 #x18 #x18 #x18 #x3C #x00 #x00 #x00 #x00 + #x00 #x18 #x3C #x66 #x00 #x38 #x18 #x18 #x18 #x18 #x18 #x3C #x00 #x00 #x00 #x00 + #x00 #x60 #x30 #x18 #x00 #x38 #x18 #x18 #x18 #x18 #x18 #x3C #x00 #x00 #x00 #x00 + #x00 #xC6 #xC6 #x10 #x38 #x6C #xC6 #xC6 #xFE #xC6 #xC6 #xC6 #x00 #x00 #x00 #x00 + #x38 #x6C #x38 #x00 #x38 #x6C #xC6 #xC6 #xFE #xC6 #xC6 #xC6 #x00 #x00 #x00 #x00 + #x18 #x30 #x60 #x00 #xFE #x66 #x60 #x7C #x60 #x60 #x66 #xFE #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #xCC #x76 #x36 #x7E #xD8 #xD8 #x6E #x00 #x00 #x00 #x00 + #x00 #x00 #x3E #x6C #xCC #xCC #xFE #xCC #xCC #xCC #xCC #xCE #x00 #x00 #x00 #x00 + #x00 #x10 #x38 #x6C #x00 #x7C #xC6 #xC6 #xC6 #xC6 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #xC6 #xC6 #x00 #x7C #xC6 #xC6 #xC6 #xC6 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x60 #x30 #x18 #x00 #x7C #xC6 #xC6 #xC6 #xC6 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x30 #x78 #xCC #x00 #xCC #xCC #xCC #xCC #xCC #xCC #x76 #x00 #x00 #x00 #x00 + #x00 #x60 #x30 #x18 #x00 #xCC #xCC #xCC #xCC #xCC #xCC #x76 #x00 #x00 #x00 #x00 + #x00 #x00 #xC6 #xC6 #x00 #xC6 #xC6 #xC6 #xC6 #xC6 #xC6 #x7E #x06 #x0C #x78 #x00 + #x00 #xC6 #xC6 #x00 #x38 #x6C #xC6 #xC6 #xC6 #xC6 #x6C #x38 #x00 #x00 #x00 #x00 + #x00 #xC6 #xC6 #x00 #xC6 #xC6 #xC6 #xC6 #xC6 #xC6 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x18 #x18 #x3C #x66 #x60 #x60 #x60 #x66 #x3C #x18 #x18 #x00 #x00 #x00 #x00 + #x00 #x38 #x6C #x64 #x60 #xF0 #x60 #x60 #x60 #x60 #xE6 #xFC #x00 #x00 #x00 #x00 + #x00 #x00 #x66 #x66 #x3C #x18 #x7E #x18 #x7E #x18 #x18 #x18 #x00 #x00 #x00 #x00 + #x00 #xF8 #xCC #xCC #xF8 #xC4 #xCC #xDE #xCC #xCC #xCC #xC6 #x00 #x00 #x00 #x00 + #x00 #x0E #x1B #x18 #x18 #x18 #x7E #x18 #x18 #x18 #x18 #x18 #xD8 #x70 #x00 #x00 + #x00 #x18 #x30 #x60 #x00 #x78 #x0C #x7C #xCC #xCC #xCC #x76 #x00 #x00 #x00 #x00 + #x00 #x0C #x18 #x30 #x00 #x38 #x18 #x18 #x18 #x18 #x18 #x3C #x00 #x00 #x00 #x00 + #x00 #x18 #x30 #x60 #x00 #x7C #xC6 #xC6 #xC6 #xC6 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x18 #x30 #x60 #x00 #xCC #xCC #xCC #xCC #xCC #xCC #x76 #x00 #x00 #x00 #x00 + #x00 #x00 #x76 #xDC #x00 #xDC #x66 #x66 #x66 #x66 #x66 #x66 #x00 #x00 #x00 #x00 + #x76 #xDC #x00 #xC6 #xE6 #xF6 #xFE #xDE #xCE #xC6 #xC6 #xC6 #x00 #x00 #x00 #x00 + #x00 #x3C #x6C #x6C #x3E #x00 #x7E #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x38 #x6C #x6C #x38 #x00 #x7C #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x30 #x30 #x00 #x30 #x30 #x60 #xC0 #xC6 #xC6 #x7C #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #xFE #xC0 #xC0 #xC0 #xC0 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #xFE #x06 #x06 #x06 #x06 #x00 #x00 #x00 #x00 #x00 + #x00 #xC0 #xC0 #xC2 #xC6 #xCC #x18 #x30 #x60 #xCE #x93 #x06 #x0C #x1F #x00 #x00 + #x00 #xC0 #xC0 #xC2 #xC6 #xCC #x18 #x30 #x66 #xCE #x9A #x3F #x06 #x0F #x00 #x00 + #x00 #x00 #x18 #x18 #x00 #x18 #x18 #x18 #x3C #x3C #x3C #x18 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x33 #x66 #xCC #x66 #x33 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #xCC #x66 #x33 #x66 #xCC #x00 #x00 #x00 #x00 #x00 #x00 + #x11 #x44 #x11 #x44 #x11 #x44 #x11 #x44 #x11 #x44 #x11 #x44 #x11 #x44 #x11 #x44 + #x55 #xAA #x55 #xAA #x55 #xAA #x55 #xAA #x55 #xAA #x55 #xAA #x55 #xAA #x55 #xAA + #xDD #x77 #xDD #x77 #xDD #x77 #xDD #x77 #xDD #x77 #xDD #x77 #xDD #x77 #xDD #x77 + #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 + #x18 #x18 #x18 #x18 #x18 #x18 #x18 #xF8 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 + #x18 #x18 #x18 #x18 #x18 #xF8 #x18 #xF8 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 + #x36 #x36 #x36 #x36 #x36 #x36 #x36 #xF6 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #xFE #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 + #x00 #x00 #x00 #x00 #x00 #xF8 #x18 #xF8 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 + #x36 #x36 #x36 #x36 #x36 #xF6 #x06 #xF6 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 + #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 + #x00 #x00 #x00 #x00 #x00 #xFE #x06 #xF6 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 + #x36 #x36 #x36 #x36 #x36 #xF6 #x06 #xFE #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x36 #x36 #x36 #x36 #x36 #x36 #x36 #xFE #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x18 #x18 #x18 #x18 #x18 #xF8 #x18 #xF8 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #xF8 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 + #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x1F #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x18 #x18 #x18 #x18 #x18 #x18 #x18 #xFF #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #xFF #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 + #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x1F #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #xFF #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x18 #x18 #x18 #x18 #x18 #x18 #x18 #xFF #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 + #x18 #x18 #x18 #x18 #x18 #x1F #x18 #x1F #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 + #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x37 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 + #x36 #x36 #x36 #x36 #x36 #x37 #x30 #x3F #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x3F #x30 #x37 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 + #x36 #x36 #x36 #x36 #x36 #xF7 #x00 #xFF #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #xFF #x00 #xF7 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 + #x36 #x36 #x36 #x36 #x36 #x37 #x30 #x37 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 + #x00 #x00 #x00 #x00 #x00 #xFF #x00 #xFF #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x36 #x36 #x36 #x36 #x36 #xF7 #x00 #xF7 #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 + #x18 #x18 #x18 #x18 #x18 #xFF #x00 #xFF #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x36 #x36 #x36 #x36 #x36 #x36 #x36 #xFF #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #xFF #x00 #xFF #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #xFF #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 + #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x3F #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x18 #x18 #x18 #x18 #x18 #x1F #x18 #x1F #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x1F #x18 #x1F #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x3F #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 + #x36 #x36 #x36 #x36 #x36 #x36 #x36 #xFF #x36 #x36 #x36 #x36 #x36 #x36 #x36 #x36 + #x18 #x18 #x18 #x18 #x18 #xFF #x18 #xFF #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 + #x18 #x18 #x18 #x18 #x18 #x18 #x18 #xF8 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x1F #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 + #xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF #xFF + #xF0 #xF0 #xF0 #xF0 #xF0 #xF0 #xF0 #xF0 #xF0 #xF0 #xF0 #xF0 #xF0 #xF0 #xF0 #xF0 + #x0F #x0F #x0F #x0F #x0F #x0F #x0F #x0F #x0F #x0F #x0F #x0F #x0F #x0F #x0F #x0F + #xFF #xFF #xFF #xFF #xFF #xFF #xFF #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x76 #xDC #xD8 #xD8 #xD8 #xDC #x76 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #xFC #xC6 #xFC #xC6 #xC6 #xFC #xC0 #xC0 #xC0 #x00 #x00 + #x00 #x00 #xFE #xC6 #xC6 #xC0 #xC0 #xC0 #xC0 #xC0 #xC0 #xC0 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x80 #xFE #x6C #x6C #x6C #x6C #x6C #x6C #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #xFE #xC6 #x60 #x30 #x18 #x30 #x60 #xC6 #xFE #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x7E #xD8 #xD8 #xD8 #xD8 #xD8 #x70 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x66 #x66 #x66 #x66 #x66 #x7C #x60 #x60 #xC0 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x76 #xDC #x18 #x18 #x18 #x18 #x18 #x18 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x7E #x18 #x3C #x66 #x66 #x66 #x3C #x18 #x7E #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x38 #x6C #xC6 #xC6 #xFE #xC6 #xC6 #x6C #x38 #x00 #x00 #x00 #x00 + #x00 #x00 #x38 #x6C #xC6 #xC6 #xC6 #x6C #x6C #x6C #x6C #xEE #x00 #x00 #x00 #x00 + #x00 #x00 #x1E #x30 #x18 #x0C #x3E #x66 #x66 #x66 #x66 #x3C #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x7E #xDB #xDB #xDB #x7E #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x03 #x06 #x7E #xCF #xDB #xF3 #x7E #x60 #xC0 #x00 #x00 #x00 #x00 + #x00 #x00 #x1C #x30 #x60 #x60 #x7C #x60 #x60 #x60 #x30 #x1C #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x7C #xC6 #xC6 #xC6 #xC6 #xC6 #xC6 #xC6 #xC6 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #xFE #x00 #x00 #xFE #x00 #x00 #xFE #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x18 #x18 #x7E #x18 #x18 #x00 #x00 #xFF #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x30 #x18 #x0C #x06 #x0C #x18 #x30 #x00 #x7E #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x0C #x18 #x30 #x60 #x30 #x18 #x0C #x00 #x7E #x00 #x00 #x00 #x00 + #x00 #x00 #x0E #x1B #x1B #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 + #x18 #x18 #x18 #x18 #x18 #x18 #x18 #x18 #xD8 #xD8 #xD8 #x70 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x18 #x18 #x00 #x7E #x00 #x18 #x18 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x76 #xDC #x00 #x76 #xDC #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x38 #x6C #x6C #x38 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x18 #x18 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x18 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x0F #x0C #x0C #x0C #x0C #x0C #xEC #x6C #x6C #x3C #x1C #x00 #x00 #x00 #x00 + #x00 #xD8 #x6C #x6C #x6C #x6C #x6C #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x70 #x98 #x30 #x60 #xC8 #xF8 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x7C #x7C #x7C #x7C #x7C #x7C #x7C #x00 #x00 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 }) + +

1 0

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

21 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv14722 Modified Files: textmode.lisp Log Message: Added some more VGA interfacing. Try e.g. (set-textmode +vga-state-80x50+). Date: Wed Apr 21 12:24:10 2004 Author: ffjeld Index: movitz/losp/x86-pc/textmode.lisp diff -u movitz/losp/x86-pc/textmode.lisp:1.5 movitz/losp/x86-pc/textmode.lisp:1.6 --- movitz/losp/x86-pc/textmode.lisp:1.5 Fri Apr 16 15:17:22 2004 +++ movitz/losp/x86-pc/textmode.lisp Wed Apr 21 12:24:10 2004 @@ -4,12 +4,12 @@ ;;;; Department of Computer Science, University of Tromso, Norway ;;;; ;;;; Filename: textmode.lisp -;;;; Description: A primitive 80x25 text-mode console driver. +;;;; Description: A primitive VGA text-mode console driver. ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Nov 9 15:38:56 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: textmode.lisp,v 1.5 2004/04/16 19:17:22 ffjeld Exp $ +;;;; $Id: textmode.lisp,v 1.6 2004/04/21 16:24:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -26,22 +26,22 @@ (define-global-variable *screen* (vga-memory-map)) +(define-global-variable *screen-width* + (vga-horizontal-display-end)) + +(define-global-variable *screen-stride* + (vga-horizontal-display-end)) + (define-global-variable *cursor-x* - (rem (vga-cursor-location) 80)) + (rem (vga-cursor-location) *screen-stride*)) (define-global-variable *cursor-y* - (truncate (vga-cursor-location) 80)) - -(define-global-variable *screen-width* - (vga-horizontal-display-end)) + (truncate (vga-cursor-location) *screen-stride*)) (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*)))) (setf (vga-cursor-location) dest))) @@ -102,26 +102,26 @@ nil) (defun textmode-copy-line (destination source count) - (check-type count (integer 0 511)) + (check-type count (and (integer 0 511) (satisfies evenp))) (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) + (:compile-form (:result-mode :edx) destination) + (:compile-form (:result-mode :ebx) count) + (:std) ; Only EBX is now (potential) GC root + (:andl #x-8 :ebx) ; ..so make sure EBX is a fixnum (:shrl 2 :eax) - (:shrl 2 :ebx) - (:shrl 1 :edx) + (:shrl 2 :edx) + (:shrl 1 :ebx) (:jz 'end-copy-loop) copy-loop - ((:gs-override) :movl (:eax :edx -4) :ecx) - ((:gs-override) :movl :ecx (:ebx :edx -4)) - (:subl 4 :edx) + ((:gs-override) :movl (:eax :ebx -4) :ecx) + ((:gs-override) :movl :ecx (:edx :ebx -4)) + (:subl 4 :ebx) (:ja 'copy-loop) - end-copy-loop)) + end-copy-loop + (:cld))) (defun textmode-scroll-down () (declare (special muerte.lib::*scroll-offset*)) @@ -133,12 +133,12 @@ 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)) + (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)))) (defun write-word (word) - (let ((dest (+ *screen* (* *cursor-x* 2) (* *cursor-y* 160)))) + (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) (write-word-lowlevel word (+ dest 4)) @@ -238,3 +238,22 @@ (cursor-x (setf (cursor-column) (car args))) (cursor-y (setf (cursor-row) (car args))))) (t (error "Unknown op: ~S" op)))))) + + +(defun set-textmode (mode-state) + (setf (vga-state) mode-state) + (ecase (vga-character-height) + (8 (write-font +vga-font-8x8+ 8)) + (16 (write-font +vga-font-8x16+ 16))) + (setf *screen-width* + (vga-horizontal-display-end)) + (setf *screen-height* + (truncate (vga-vertical-display-end) + (vga-character-height))) + (setf *screen-stride* + (vga-horizontal-display-end)) + (setf *cursor-x* + (min (1- *screen-width*) *cursor-x*)) + (setf *cursor-y* + (min (1- *screen-height*) *cursor-y*)) + (values))

1 0

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

21 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv14432 Modified Files: package.lisp Log Message: Added some more VGA interfacing. Try e.g. (set-textmode +vga-state-80x50+). Date: Wed Apr 21 12:24:05 2004 Author: ffjeld Index: movitz/losp/x86-pc/package.lisp diff -u movitz/losp/x86-pc/package.lisp:1.3 movitz/losp/x86-pc/package.lisp:1.4 --- movitz/losp/x86-pc/package.lisp:1.3 Mon Jan 19 06:23:52 2004 +++ movitz/losp/x86-pc/package.lisp Wed Apr 21 12:24:05 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 2 20:30:28 2001 ;;;; -;;;; $Id: package.lisp,v 1.3 2004/01/19 11:23:52 ffjeld Exp $ +;;;; $Id: package.lisp,v 1.4 2004/04/21 16:24:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -51,7 +51,14 @@ #:+pit8253-nanosecond-period+ #:textmode-console - #:vga-text-console + #:vga-text-console + #:set-textmode + #:+vga-state-80x25+ + #:+vga-state-80x50+ + #:+vga-state-40x25+ + #:+vga-state-40x50+ + #:+vga-state-90x30+ + #:+vga-state-90x60+ #:pic8259-irq-mask #:pic8259-end-of-interrupt

1 0