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

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

02 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7693 Modified Files: basic-macros.lisp Log Message: Made defconstant proclaim the variable-name special (on the host-side), avoiding compiler warnings when macro-expanders use it. Date: Mon Feb 2 08:40:37 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.2 movitz/losp/muerte/basic-macros.lisp:1.3 --- movitz/losp/muerte/basic-macros.lisp:1.2 Mon Jan 19 06:23:46 2004 +++ movitz/losp/muerte/basic-macros.lisp Mon Feb 2 08:40:36 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.2 2004/01/19 11:23:46 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.3 2004/02/02 13:40:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -464,6 +464,7 @@ ',name (movitz::movitz-eval ',name) movitz-value)) + (proclaim `(special ,movitz-name)) (setf (movitz::movitz-symbol-value movitz-symbol) (movitz::movitz-read movitz-value) (symbol-value movitz-name) movitz-value))) (declaim (muerte::constant-variable ,name))))

1 0

[movitz-cvs] CVS update: movitz/movitz-mode.el
by Frode Vatvedt Fjeld 02 Feb '04

02 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv12447 Modified Files: movitz-mode.el Log Message: Various naming updates. Date: Mon Feb 2 08:31:23 2004 Author: ffjeld Index: movitz/movitz-mode.el diff -u movitz/movitz-mode.el:1.2 movitz/movitz-mode.el:1.3 --- movitz/movitz-mode.el:1.2 Thu Jan 15 12:37:11 2004 +++ movitz/movitz-mode.el Mon Feb 2 08:31:23 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Sep 27 18:12:17 2001 ;;;; -;;;; $Id: movitz-mode.el,v 1.2 2004/01/15 17:37:11 ffjeld Exp $ +;;;; $Id: movitz-mode.el,v 1.3 2004/02/02 13:31:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -108,7 +108,7 @@ (fi:eval-in-lisp "movitz::*bootblock-build*") display-shortcut) (call-process "/bin/sh" nil 0 nil "-c" - (format "DISPLAY=\"%s\" ~/tmp/bochs-cvs/bochs -nocp > bochs-parameters" + (format "DISPLAY=\"%s\" cd ~/clnet/movitz && ~/tmp/bochs-cvs/bochs -nocp > bochs-parameters" display-shortcut)))) (defun movitz-compile-file () @@ -220,7 +220,7 @@ (cl:char= #\\& (cl:char (cl:string x) 0)))) lambda-list))) (specializers (cl:mapcar #'muerte::find-specializer - (cl:mapcar (cl:lambda (x) (cl:if (cl:consp x) (cl:second x) 'los0.cl:t)) + (cl:mapcar (cl:lambda (x) (cl:if (cl:consp x) (cl:second x) 'muerte.cl:t)) specializing-lambda-list))) (method (muerte::movitz-find-method gf qualifiers specializers)) (funobj (muerte::movitz-slot-value method 'muerte::function)) @@ -258,7 +258,7 @@ (cl:let ((cl:*package* (cl:find-package :%s))) (cl:with-open-file (stream \"%s\" :direction :input) (cl:read stream)))) - :common-lisp :los0.common-lisp))))" + :common-lisp :muerte.common-lisp))))" fi:package fi:package tmp-file))

1 0

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

02 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv12267 Modified Files: image.lisp Log Message: Improved, hopefully, interaction between image-read-intern-constant and movitz-read. Date: Mon Feb 2 08:27:26 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.4 movitz/image.lisp:1.5 --- movitz/image.lisp:1.4 Mon Feb 2 08:04:49 2004 +++ movitz/image.lisp Mon Feb 2 08:27:26 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.4 2004/02/02 13:04:49 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.5 2004/02/02 13:27:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1238,19 +1238,11 @@ (string (or (gethash expr (image-string-constants *image*)) (setf (gethash expr (image-string-constants *image*)) - (make-movitz-string expr)))) + (movitz-read expr)))) (cons (or (gethash expr (image-cons-constants *image*)) (setf (gethash expr (image-cons-constants *image*)) - (if (eq '#0=#:error (ignore-errors (when (not (list-length expr)) '#0#))) - (multiple-value-bind (unfolded-expr cdr-index) - (unfold-circular-list expr) - (let ((result (movitz-read unfolded-expr))) - (setf (movitz-last-cdr result) - (movitz-nthcdr cdr-index result)) - result)) - (make-movitz-cons (movitz-read (car expr)) - (movitz-read (cdr expr))))))) + (movitz-read expr)))) (t (movitz-read expr)))) ;;; "Reader" @@ -1291,22 +1283,25 @@ (null *movitz-nil*) ((member t) (movitz-read 'muerte.cl:t)) (symbol (intern-movitz-symbol expr)) - (string (image-read-intern-constant *image* expr)) (integer (make-movitz-fixnum expr)) (character (make-movitz-character expr)) + (string (or (gethash expr (image-string-constants *image*)) + (setf (gethash expr (image-string-constants *image*)) + (make-movitz-string expr)))) (vector (make-movitz-vector (length expr) :initial-contents (map 'vector #'movitz-read expr))) (cons - (image-read-intern-constant *image* expr) - #+ignore (if (eq '#0=#:error (ignore-errors (when (not (list-length expr)) '#0#))) - (multiple-value-bind (unfolded-expr cdr-index) - (unfold-circular-list expr) - (let ((result (movitz-read unfolded-expr))) - (setf (movitz-last-cdr result) - (movitz-nthcdr cdr-index result)) - result)) - (make-movitz-cons (movitz-read (car expr)) - (movitz-read (cdr expr))))) + (or (gethash expr (image-cons-constants *image*)) + (setf (gethash expr (image-cons-constants *image*)) + (if (eq '#0=#:error (ignore-errors (when (not (list-length expr)) '#0#))) + (multiple-value-bind (unfolded-expr cdr-index) + (unfold-circular-list expr) + (let ((result (movitz-read unfolded-expr))) + (setf (movitz-last-cdr result) + (movitz-nthcdr cdr-index result)) + result)) + (make-movitz-cons (movitz-read (car expr)) + (movitz-read (cdr expr))))))) (hash-table (make-movitz-hash-table expr)) (structure-object

1 0

[movitz-cvs] CVS update: movitz/storage-types.lisp
by Frode Vatvedt Fjeld 02 Feb '04

02 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv5811 Modified Files: storage-types.lisp Log Message: Changed printing of Movitz vectors. Date: Mon Feb 2 08:09:26 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.2 movitz/storage-types.lisp:1.3 --- movitz/storage-types.lisp:1.2 Mon Jan 19 06:23:41 2004 +++ movitz/storage-types.lisp Mon Feb 2 08:09:26 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: storage-types.lisp,v 1.2 2004/01/19 11:23:41 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.3 2004/02/02 13:09:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -449,14 +449,15 @@ 8))) (defmethod print-object ((obj movitz-vector) stream) - (case (movitz-vector-element-type obj) - (:character - (format stream "#&~S" (map 'string #'identity + (print-unreadable-movitz-object (obj stream :type nil :identity t) + (case (movitz-vector-element-type obj) + (:character + (format stream "~S" (map 'string #'identity (movitz-vector-symbolic-data obj)))) - (t (format stream "#&[[ET:~A,NE:~A]~A]" - (movitz-vector-element-type obj) - (movitz-vector-num-elements obj) - (movitz-vector-symbolic-data obj)))) + (t (format stream "[ET:~A,NE:~A] ~A" + (movitz-vector-element-type obj) + (movitz-vector-num-elements obj) + (movitz-vector-symbolic-data obj))))) obj) (defmethod movitz-storage-alignment ((obj movitz-vector))

1 0

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

02 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv18305 Modified Files: packages.lisp Log Message: Added print-unreadable-movitz-object to movitz package. Date: Mon Feb 2 08:06:40 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.1.1.1 movitz/packages.lisp:1.2 --- movitz/packages.lisp:1.1.1.1 Tue Jan 13 06:04:59 2004 +++ movitz/packages.lisp Mon Feb 2 08:06:39 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Nov 15 21:39:55 2003 ;;;; -;;;; $Id: packages.lisp,v 1.1.1.1 2004/01/13 11:04:59 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.2 2004/02/02 13:06:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1100,6 +1100,7 @@ simple-read-from-string print-word fixnump below + print-unreadable-movitz-object stack-ref with-each-dynamic-context @@ -1208,6 +1209,8 @@ #:io-delay #:io-port-read-sequence #:io-port-write-sequence + #:%io-port-read-succession + #:%io-port-write-succession #:with-io-register-syntax #:with-register-syntax #:cpu-id

1 0

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

02 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv17856 Modified Files: movitz.lisp Log Message: Added macro print-unreadable-movitz-object. Date: Mon Feb 2 08:06:06 2004 Author: ffjeld Index: movitz/movitz.lisp diff -u movitz/movitz.lisp:1.3 movitz/movitz.lisp:1.4 --- movitz/movitz.lisp:1.3 Fri Jan 16 07:02:05 2004 +++ movitz/movitz.lisp Mon Feb 2 08:06:06 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Mon Oct 9 20:52:58 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: movitz.lisp,v 1.3 2004/01/16 12:02:05 ffjeld Exp $ +;;;; $Id: movitz.lisp,v 1.4 2004/02/02 13:06:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -29,6 +29,16 @@ (defvar *bq-level* 0) (defvar *default-image-init-file* #p"losp/los0.lisp") (defvar *default-image-file* #p"los0-image") + +(defmacro print-unreadable-movitz-object ((object stream &rest key-args) &body body) + "Just like print-unreadable-object, just adorn output so as to +make clear it's a Movitz object, with extra <..>" + (let ((stream-var (gensym "unreadable-movitz-stream-"))) + `(let ((,stream-var ,stream)) + (print-unreadable-object (,object ,stream-var ,@key-args) + (write-char #\< ,stream-var) + ,@body + (write-char #\> ,stream-var))))) (defmacro with-movitz-syntax (options &body body) (declare (ignore options))

1 0

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

02 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv15362 Modified Files: compiler.lisp Log Message: Minor edits. Date: Mon Feb 2 08:05:25 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.5 movitz/compiler.lisp:1.6 --- movitz/compiler.lisp:1.5 Mon Feb 2 04:59:26 2004 +++ movitz/compiler.lisp Mon Feb 2 08:05:25 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.5 2004/02/02 09:59:26 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.6 2004/02/02 13:05:25 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -910,9 +910,9 @@ (values)) (defun movitz-compile-file-internal (path &optional (*default-load-priority* - (and (boundp '*default-load-priority*) - *default-load-priority* - (1+ *default-load-priority*)))) + (and (boundp '*default-load-priority*) + *default-load-priority* + (1+ *default-load-priority*)))) (declare (special *default-load-priority*)) (with-retries-until-true (retry "Restart Movitz compilation of ~S." path) (let* ((muerte.cl::*compile-file-pathname* path) @@ -921,11 +921,11 @@ :name (intern (format nil "file-~A" path) :muerte) :lambda-list (movitz-read nil))) (funobj-env (make-local-movitz-environment nil funobj - :type 'funobj-env - :declaration-context :funobj)) + :type 'funobj-env + :declaration-context :funobj)) (function-env (make-local-movitz-environment funobj-env funobj - :type 'function-env - :declaration-context :funobj)) + :type 'function-env + :declaration-context :funobj)) (file-code (with-compilation-unit () (with-open-file (stream path :direction :input) @@ -1792,7 +1792,7 @@ (defmethod print-object ((object binding) stream) (print-unreadable-object (object stream :type t :identity t) (when (slot-boundp object 'name) - (princ (binding-name object) stream)))) + (format stream "name: ~S" (binding-name object))))) (defclass constant-object-binding (binding) ((object @@ -4289,7 +4289,8 @@ :functional-p nil :modifies arguments-modifies :code (append arguments-code - (if (and t (eq operator (movitz-print (movitz-funobj-name funobj)))) ; recursive? + (if (eq (movitz-read operator) + (movitz-read (movitz-funobj-name funobj))) ; recursive? (make-compiled-funcall-by-esi (length arg-forms)) (make-compiled-funcall-by-symbol operator (length arg-forms) funobj)) stack-restore-code)))))) @@ -4677,6 +4678,8 @@ (:movb ,value ,(register32-to-low8 destination-register)))) (t `((:movl ,value ,destination-register))))) +(defparameter *prev-self-eval* nil) + (define-compiler compile-self-evaluating (&form form &result-mode result-mode &funobj funobj) "3.1.2.1.3 Self-Evaluating Objects" (let* ((object (or (quote-form-p form) form)) @@ -4684,7 +4687,7 @@ (funobj-env (funobj-env funobj)) (binding (or (cdr (assoc movitz-obj (movitz-environment-bindings funobj-env))) (let ((binding (make-instance 'constant-object-binding - :name movitz-obj + :name (gensym "self-eval-") :object movitz-obj))) (setf (binding-env binding) funobj-env) (push (cons movitz-obj binding)

1 0

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

02 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv12269 Modified Files: image.lisp Log Message: Improved movitz-print so it's more symmetric with movitz-read. Date: Mon Feb 2 08:04:49 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.3 movitz/image.lisp:1.4 --- movitz/image.lisp:1.3 Mon Jan 19 06:23:41 2004 +++ movitz/image.lisp Mon Feb 2 08:04:49 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.3 2004/01/19 11:23:41 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.4 2004/02/02 13:04:49 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1262,6 +1262,9 @@ (setf (gethash movitz-object (image-inverse-read-map-hash image)) lisp-object (gethash lisp-object (image-read-map-hash image)) movitz-object)) +(defmethod image-movitz-to-lisp-object ((image symbolic-image) movitz-object) + (gethash movitz-object (image-inverse-read-map-hash image))) + (defmacro with-movitz-read-context (options &body body) (declare (ignore options)) `(let ((*movitz-reader-clean-map* (if (boundp '*movitz-reader-clean-map*) @@ -1292,7 +1295,7 @@ (integer (make-movitz-fixnum expr)) (character (make-movitz-character expr)) (vector (make-movitz-vector (length expr) - :initial-contents (map 'vector #'movitz-read expr))) + :initial-contents (map 'vector #'movitz-read expr))) (cons (image-read-intern-constant *image* expr) #+ignore (if (eq '#0=#:error (ignore-errors (when (not (list-length expr)) '#0#))) @@ -1387,25 +1390,17 @@ ;;; "Printer" (defun movitz-print (expr) + "Find the host lisp object equivalent to the Movitz object expr." (etypecase expr (integer expr) (symbol expr) (cons (mapcar #'movitz-print expr)) ((or movitz-nil movitz-constant-block) nil) - (movitz-symbol - (intern (movitz-print (movitz-symbol-name expr)))) - (movitz-string - (map 'string #'identity - (movitz-vector-symbolic-data expr))) (movitz-fixnum (movitz-fixnum-value expr)) - (movitz-vector - (map 'vector #'movitz-print (movitz-vector-symbolic-data expr))) - (movitz-cons - (cons (movitz-print (movitz-car expr)) - (movitz-print (movitz-cdr expr)))))) - -;;; + (movitz-heap-object + (or (image-movitz-to-lisp-object *image* expr) + (error "Unknown Movitz object: ~S" expr))))) (defmethod make-toplevel-funobj ((*image* symbolic-image)) (let ((toplevel-code (loop for (funobj) in (image-load-time-funobjs *image*)

1 0

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

02 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv7424 Modified Files: compiler.lisp Log Message: Added docstrings to some compiler defvars. Date: Mon Feb 2 04:59:26 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.4 movitz/compiler.lisp:1.5 --- movitz/compiler.lisp:1.4 Mon Jan 19 14:21:08 2004 +++ movitz/compiler.lisp Mon Feb 2 04:59:26 2004 @@ -8,25 +8,48 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.4 2004/01/19 19:21:08 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.5 2004/02/02 09:59:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ (in-package movitz) -(defvar *warn-function-change-p* t) -(defvar *explain-peephole-optimizations* nil) +(defvar *warn-function-change-p* t + "Emit a warning whenever a named function's code-vector changes size.") + +(defvar *compiler-do-optimize* t + "Apply the peephole optimizer to function code.") + +(defvar *explain-peephole-optimizations* nil + "Emit some cryptic information about which peephole optimization +heuristics that fire. Used for debugging the optimizer.") + +(defvar *compiler-use-cmov-p* nil + "Allow the compiler to emit CMOV instructions, making the code +incompatible with pre-pentium CPUs.") + +(defvar *compiler-auto-stack-checks-p* nil + "Make every compiled function check upon entry that the +stack-pointer is within bounds. Costs 3 code-bytes and a few cycles.") -(defvar *compiler-do-optimize* t) -(defvar *compiler-use-cmov-p* nil) -(defvar *compiler-auto-stack-checks-p* nil) (defvar *compiler-allow-transients* t "Allow the compiler to keep function arguments solely in registers. Hurst debugging, improves performance.") -(defvar *compiler-local-segment-prefix* '(:fs-override)) -(defvar *compiler-global-segment-prefix* nil) -(defvar *compiler-compile-eval-whens* t) -(defvar *compiler-compile-macro-expanders* t) + +(defvar *compiler-local-segment-prefix* '(:fs-override) + "Use these assembly-instruction prefixes when accessing the thread-local +run-time context.") + +(defvar *compiler-global-segment-prefix* nil + "Use these assembly-instruction prefixes when accessing the global +run-time context.") + +(defvar *compiler-compile-eval-whens* t + "When encountering (eval-when (:compile-toplevel) <code>), +compile, using the host compiler, the code rather than just using eval.") + +(defvar *compiler-compile-macro-expanders* t + "For macros of any kind, compile the macro-expanders using the host compiler.") (defvar *compiling-function-name*) (defvar muerte.cl:*compile-file-pathname* nil)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/io-port.lisp
by Frode Vatvedt Fjeld 01 Feb '04

01 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv21480 Modified Files: io-port.lisp Log Message: Added 16-bit case to %io-port-read-succession. Date: Sun Feb 1 17:16:26 2004 Author: ffjeld Index: movitz/losp/muerte/io-port.lisp diff -u movitz/losp/muerte/io-port.lisp:1.5 movitz/losp/muerte/io-port.lisp:1.6 --- movitz/losp/muerte/io-port.lisp:1.5 Tue Jan 20 16:53:11 2004 +++ movitz/losp/muerte/io-port.lisp Sun Feb 1 17:16:26 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Mar 21 22:14:08 2001 ;;;; -;;;; $Id: io-port.lisp,v 1.5 2004/01/20 21:53:11 ffjeld Exp $ +;;;; $Id: io-port.lisp,v 1.6 2004/02/01 22:16:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -222,11 +222,40 @@ io-read-loop (:cmpl :ecx (:esp)) (:jbe 'end-io-read-loop) - (:inl :dx :eax) (:addl 4 :ecx) + (:inl :dx :eax) (:movl :eax (:ebx ,(+ offset -4) :ecx)) (:jmp 'io-read-loop) (:popl :eax) ; increment :esp, and put a lispval in :eax. + end-io-read-loop)))) + (:16-bit + (assert (= 4 movitz:+movitz-fixnum-factor+)) + (if (and t (<= 1 count 20)) + `(with-inline-assembly-case () + (do-case (t :ebx) + (:compile-two-forms (:edx :ebx) ,port ,object) + (:andl ,(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) + (:xorl :eax :eax) + ,@(loop for i from start below end + appending + `((:inw :dx :ax) + (:movw :ax (:ebx ,(+ offset (* 2 i)))))))) + `(with-inline-assembly-case () + (do-case (t :ebx :labels (io-read-loop end-io-read-loop not-fixnum)) + (:compile-two-forms (:edx :ebx) ,port ,object) + (:andl ,(cl:* #xffff movitz::+movitz-fixnum-factor+) :edx) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) + ;; (:pushl ,(cl:* movitz::+movitz-fixnum-factor+ end)) ; keep end in (:esp) + (:movl ,(cl:* 1 start) :ecx) + (:xorl :eax :eax) + io-read-loop + (:cmpl ,end :ecx) + (:ja 'end-io-read-loop) + (:addl 1 :ecx) + (:inw :dx :ax) + (:movw :ax (:ebx ,(+ offset -2) (:ecx 2))) + (:jmp 'io-read-loop) end-io-read-loop)))) (t (error "~S byte-size ~S not implemented." (car form) byte-size))))) ((and (movitz:movitz-constantp offset env))

1 0