movitz-cvs February 2004

movitz-cvs@common-lisp.net

1 participants
166 discussions

[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

[movitz-cvs] CVS update: movitz/losp/x86-pc/ne2k.lisp
by Frode Vatvedt Fjeld 01 Feb '04

01 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv11834 Modified Files: ne2k.lisp Log Message: Changed to using %io-port-read/write-succession. Date: Sun Feb 1 17:10:18 2004 Author: ffjeld Index: movitz/losp/x86-pc/ne2k.lisp diff -u movitz/losp/x86-pc/ne2k.lisp:1.4 movitz/losp/x86-pc/ne2k.lisp:1.5 --- movitz/losp/x86-pc/ne2k.lisp:1.4 Mon Jan 19 06:23:52 2004 +++ movitz/losp/x86-pc/ne2k.lisp Sun Feb 1 17:10:17 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 17 15:16:00 2002 ;;;; -;;;; $Id: ne2k.lisp,v 1.4 2004/01/19 11:23:52 ffjeld Exp $ +;;;; $Id: ne2k.lisp,v 1.5 2004/02/01 22:10:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -66,7 +66,7 @@ (defun ne-x000-probe (&optional (io-base #x300)) "Probe for the presence of a NE2000 compatible card at IO-address io-base." (with-dp8390 (dp8390 io-base) - (let ((test-vector (copy-seq #(#xab #xba #x00 #xff #x55 #x99 #x01 #x23 #x45 #xde #xad #xbe #xef #x23)))) + (let ((test-vector #(#xabba #x00ff #x5599 #x0123 #x45de #xadbe #xef23))) (declare (dynamic-extent test-vector)) ;; NE1000 has RAM buffer located at 8192 ;; NE2000 has RAM buffer located at 16384 @@ -75,17 +75,15 @@ (dp8390 ($page0-write dcr)) ($data-config fifo-threshold-8-bytes loopback-off dma-16-bit)) - (with-dp8390-dma (dp8390 remote-write (length test-vector) 16384) - (io-port-write-sequence test-vector (+ io-base #x10) :unsigned-byte8 :16-bits)) + (with-dp8390-dma (dp8390 remote-write (* 2 (length test-vector)) 16384) + (loop with asic = (+ io-base #x10) + for x across test-vector + do (setf (io-port asic :unsigned-byte16) x))) (let ((mismatch nil)) - (with-dp8390-dma (dp8390 remote-read (length test-vector) 16384) - (dotimes (i (truncate (length test-vector) 2)) - (let ((nic-byte (io-port (+ io-base #x10) :unsigned-byte16))) - (unless (and (= (aref test-vector (* 2 i)) - (ldb (byte 8 0) nic-byte)) - (= (aref test-vector (1+ (* 2 i))) - (ldb (byte 8 8) nic-byte))) - (setf mismatch t))))) + (with-dp8390-dma (dp8390 remote-read (* 2 (length test-vector)) 16384) + (loop for x across test-vector + do (unless (= x (io-port (+ io-base #x10) :unsigned-byte16)) + (setf mismatch t)))) (unless mismatch 'ne2000))))) @@ -102,8 +100,10 @@ (let ((mac (make-array 6 :element-type 'muerte::u8))) (with-dp8390 (dp8390 io-base) (with-dp8390-dma (dp8390 remote-read 12 0) - (io-port-read-sequence mac (asic-io-base ne2000) - :unsigned-byte16 :16-bits))) + (dotimes (i 6) + (setf (aref mac i) + (ldb (byte 8 0) + (io-port (asic-io-base ne2000) :unsigned-byte16)))))) (setf (mac-address ne2000) mac)) ne2000)) @@ -117,6 +117,7 @@ (let ((asic-io (asic-io-base device)) (bnry (cached-bnry device)) (packet (or packet (make-array +max-ethernet-frame-size+ :element-type 'muerte::u8)))) + (check-type packet 'vector-u8) (with-dp8390 (dp8390 (io-base device)) (multiple-value-bind (packet-status next-bnry packet-length) (with-dp8390-dma (dp8390 remote-read 4 (* 256 bnry)) @@ -140,7 +141,7 @@ ((< (+ bnry (ash (1- packet-length) -8)) (ring-stop device)) (with-dp8390-dma (dp8390 remote-read packet-length (+ (* 256 bnry) 4)) - (io-port-read-sequence packet asic-io :unsigned-byte8 :16-bits :start start) + (%io-port-read-succession asic-io packet 2 start rx-end :16-bit) (when (oddp rx-end) (setf (aref packet (1- rx-end)) (ldb (byte 8 0) (io-port asic-io :unsigned-byte16))))) @@ -148,13 +149,11 @@ (cached-bnry device) next-bnry)) (t (let ((split-point (+ -4 (ash (- (ring-stop device) bnry) 8)))) (with-dp8390-dma (dp8390 remote-read split-point) - (io-port-read-sequence packet asic-io :unsigned-byte8 :16-bits - :start start :end (+ start split-point))) + (%io-port-read-succession asic-io packet 2 start (+ start split-point) :16-bit)) (with-dp8390-dma (dp8390 remote-read (- rx-end start split-point) (* 256 (ring-start device))) - (io-port-read-sequence packet asic-io :unsigned-byte8 :16-bits - :start (+ start split-point)) + (%io-port-read-succession asic-io packet 2 (+ start split-point) rx-end :16-bit) (when (oddp rx-end) (setf (aref packet (1- rx-end)) (ldb (byte 8 0)

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs February 2004