movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

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

03 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv32056 Modified Files: lists.lisp Log Message: Fixed typo in (setf getf). Date: Tue Feb 3 04:57:49 2004 Author: ffjeld Index: movitz/losp/muerte/lists.lisp diff -u movitz/losp/muerte/lists.lisp:1.2 movitz/losp/muerte/lists.lisp:1.3 --- movitz/losp/muerte/lists.lisp:1.2 Mon Jan 19 06:23:46 2004 +++ movitz/losp/muerte/lists.lisp Tue Feb 3 04:57:49 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Tue Dec 5 18:40:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: lists.lisp,v 1.2 2004/01/19 11:23:46 ffjeld Exp $ +;;;; $Id: lists.lisp,v 1.3 2004/02/03 09:57:49 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -269,7 +269,7 @@ (let ((new-value (gensym)) (indicator-var (gensym)) (default-var (if default (gensym)))) - (values `(,@temps ,indicator-var ,@(if default (list def-temp))) + (values `(,@temps ,indicator-var ,@(if default (list default-var))) `(,@values ,indicator ,@(if default (list default))) `(,new-value) `(let ((,(car stores) (putf ,getter ,indicator-var ,new-value)))

1 0

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

02 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv8416 Modified Files: ne2k.lisp Log Message: More updating related to using %io-port-read/write-succession. I hope it still works. Date: Mon Feb 2 16:59:27 2004 Author: ffjeld Index: movitz/losp/x86-pc/ne2k.lisp diff -u movitz/losp/x86-pc/ne2k.lisp:1.6 movitz/losp/x86-pc/ne2k.lisp:1.7 --- movitz/losp/x86-pc/ne2k.lisp:1.6 Mon Feb 2 09:57:34 2004 +++ movitz/losp/x86-pc/ne2k.lisp Mon Feb 2 16:59:27 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.6 2004/02/02 14:57:34 ffjeld Exp $ +;;;; $Id: ne2k.lisp,v 1.7 2004/02/02 21:59:27 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -112,8 +112,10 @@ (defun pop-ringbuffer (device &optional packet (start 0)) "When the ring-buffer isn't empty, fetch the next packet." + (assert (evenp start)) (unless (ring-empty-p device) - (let ((asic-io (asic-io-base device)) + (let ((io-start (truncate start 2)) + (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) @@ -132,7 +134,8 @@ (< next-bnry (ring-stop device))) () "Illegal next-bnry #x~X at #x~X, length ~D." next-bnry bnry packet-length) - (let ((rx-end (+ start packet-length))) + (let* ((rx-end (+ start packet-length)) + (io-end (truncate (1+ rx-end)))) (declare (type (unsigned-byte 16) rx-end)) (assert (evenp start)) (setf (fill-pointer packet) rx-end) @@ -140,23 +143,18 @@ ((< (+ bnry (ash (1- packet-length) -8)) (ring-stop device)) (with-dp8390-dma (dp8390 remote-read packet-length (+ (* 256 bnry) 4)) - (%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))))) + (%io-port-read-succession asic-io packet 2 io-start io-end :16-bit)) (setf (dp8390 ($page0-write bnry)) next-bnry (cached-bnry device) next-bnry)) - (t (let ((split-point (+ -4 (ash (- (ring-stop device) bnry) 8)))) + (t (let* ((split-point (+ -4 (ash (- (ring-stop device) bnry) 8))) + (io-split-point (truncate split-point 2))) (with-dp8390-dma (dp8390 remote-read split-point) - (%io-port-read-succession asic-io packet 2 start (+ start split-point) :16-bit)) + (%io-port-read-succession asic-io packet 2 + io-start (+ io-start io-split-point) :16-bit)) (with-dp8390-dma (dp8390 remote-read (- rx-end start split-point) (* 256 (ring-start device))) - (%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) - (io-port asic-io :unsigned-byte16))))) + (%io-port-read-succession asic-io packet 2 (+ io-start io-split-point) io-end :16-bit)) (setf (dp8390 ($page0-write bnry)) next-bnry (cached-bnry device) next-bnry) #+ignore (warn "split-point: ~D/~D bnry: ~S" @@ -213,11 +211,8 @@ (let ((packet-length (- end start))) (with-dp8390-dma (dp8390 remote-write packet-length (ash (transmit-buffer device) 8)) - (io-port-write-sequence packet (asic-io-base device) :unsigned-byte8 :16-bits - :start start :end end) - (when (oddp packet-length) - (setf (io-port (asic-io-base device) :unsigned-byte16) - (aref packet (1- end))))) + (%io-port-write-succession (asic-io-base device) packet 2 + (truncate start 2) (truncate (1+ end) 2) :16-bit)) (loop while (logbitp ($command-bit transmit) (dp8390 ($page0-read cr)))) (setf (io-register8x2 dp8390 ($page0-write tbcr1) ($page0-write tbcr0)) packet-length (dp8390 ($page0-write cr)) ($command transmit start abort-complete))

1 0

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

02 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv938 Modified Files: ne2k.lisp Log Message: Minor edit. Date: Mon Feb 2 09:57:35 2004 Author: ffjeld Index: movitz/losp/x86-pc/ne2k.lisp diff -u movitz/losp/x86-pc/ne2k.lisp:1.5 movitz/losp/x86-pc/ne2k.lisp:1.6 --- movitz/losp/x86-pc/ne2k.lisp:1.5 Sun Feb 1 17:10:17 2004 +++ movitz/losp/x86-pc/ne2k.lisp Mon Feb 2 09:57:34 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.5 2004/02/01 22:10:17 ffjeld Exp $ +;;;; $Id: ne2k.lisp,v 1.6 2004/02/02 14:57:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -67,10 +67,9 @@ "Probe for the presence of a NE2000 compatible card at IO-address io-base." (with-dp8390 (dp8390 io-base) (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 - ;; We have detected NE2000, check if 16-bit access works: + ;; Check if 16-bit access works to NE2000 RAM works: (setf (dp8390 ($page0-write cr)) ($command page-0) (dp8390 ($page0-write dcr)) ($data-config fifo-threshold-8-bytes loopback-off

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/simple-streams.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-serv25344 Modified Files: simple-streams.lisp Log Message: Minor edits. Date: Mon Feb 2 09:55:32 2004 Author: ffjeld Index: movitz/losp/muerte/simple-streams.lisp diff -u movitz/losp/muerte/simple-streams.lisp:1.2 movitz/losp/muerte/simple-streams.lisp:1.3 --- movitz/losp/muerte/simple-streams.lisp:1.2 Mon Jan 19 06:23:47 2004 +++ movitz/losp/muerte/simple-streams.lisp Mon Feb 2 09:55:32 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Aug 29 13:39:43 2003 ;;;; -;;;; $Id: simple-streams.lisp,v 1.2 2004/01/19 11:23:47 ffjeld Exp $ +;;;; $Id: simple-streams.lisp,v 1.3 2004/02/02 14:55:32 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -70,23 +70,23 @@ (type simple-vector ,slots-var) (ignorable ,slots-var)) (macrolet ((sm (slot-name stream) - ;; (declare (ignore stream)) - `(slot-value ,stream ',slot-name) + (declare (ignore stream)) + `(slot-value ,',stream-var ',slot-name) #+ignore `(svref%unsafe ,',slots-var ,(slot-location ,(movitz-find-class class-name) slot-name))) (add-stream-instance-flags (stream &rest flags) - ;; (declare (ignore stream)) + (declare (ignore stream)) `(setf (sm %flags ,',stream-var) (logior (sm %flags ,',stream-var) ,(%flags flags)))) (remove-stream-instance-flags (stream &rest flags) - ;; (declare (ignore stream)) + (declare (ignore stream)) `(setf (sm %flags ,',stream-var) (logandc2 (sm %flags ,',stream-var) ,(%flags flags)))) (any-stream-instance-flags (stream &rest flags) - ;; (declare (ignore stream)) + (declare (ignore stream)) `(not (zerop (logand (sm %flags ,',stream-var) ,(%flags flags)))))) ,@body)))

1 0

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

02 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv12306 Removed Files: los0-image Log Message: Removed from CVS, not supposed to be here. Date: Mon Feb 2 09:55:07 2004 Author: ffjeld

1 0

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

02 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3520 Modified Files: special-operators.lisp Log Message: Altered a call to movitz-macro-expander-make-function in accordance with new naming scheme. Date: Mon Feb 2 09:54:29 2004 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.3 movitz/special-operators.lisp:1.4 --- movitz/special-operators.lisp:1.3 Fri Jan 16 14:25:04 2004 +++ movitz/special-operators.lisp Mon Feb 2 09:54:29 2004 @@ -8,7 +8,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 24 16:22:59 2000 ;;;; -;;;; $Id: special-operators.lisp,v 1.3 2004/01/16 19:25:04 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.4 2004/02/02 14:54:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -442,7 +442,7 @@ (translate-program ,expansion-var :cl :muerte.cl))))))) (setf (movitz-compiler-macro-function operator-name nil) (movitz-macro-expander-make-function expander - :name (gensym (format nil "~A-compiler-macro-" name)) + :name name :type :compiler-macro)))))))) (compiler-values ()))

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-serv929 Modified Files: compiler.lisp Log Message: Rearranged movitz-macro-expander-make-function slightly, so it will generate gensym names (for compile) based on name and type. Date: Mon Feb 2 09:53:38 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.6 movitz/compiler.lisp:1.7 --- movitz/compiler.lisp:1.6 Mon Feb 2 08:05:25 2004 +++ movitz/compiler.lisp Mon Feb 2 09:53:38 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.6 2004/02/02 13:05:25 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.7 2004/02/02 14:53:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -132,14 +132,11 @@ (write (movitz-funobj-name object) :stream stream))) object) -(defun movitz-macro-expander-make-function (lambda-form - &key (name (gensym "macro-expander-")) - (type :unknown)) +(defun movitz-macro-expander-make-function (lambda-form &key name (type :unknown)) "Make a lambda-form that is a macro-expander into a proper function." - (declare (ignore type)) - (check-type name symbol) (if *compiler-compile-macro-expanders* - (compile name lambda-form) + (compile (gensym (format nil "~A-expander-~@[~A-~]" type name)) + lambda-form) (coerce lambda-form 'function))) (defun make-compiled-funobj (&rest args)

1 0

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

02 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv29601 Modified Files: special-operators-cl.lisp Log Message: Have macrolet do the right thing with declarations and docstrings in expanders and bodies. Removes many host-compiler-warnings. Date: Mon Feb 2 09:52:24 2004 Author: ffjeld Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.3 movitz/special-operators-cl.lisp:1.4 --- movitz/special-operators-cl.lisp:1.3 Mon Jan 19 06:23:41 2004 +++ movitz/special-operators-cl.lisp Mon Feb 2 09:52:24 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 24 16:31:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: special-operators-cl.lisp,v 1.3 2004/01/19 11:23:41 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.4 2004/02/02 14:52:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -264,25 +264,30 @@ (destructuring-bind (macrolet-specs &body declarations-and-body) (cdr form) (multiple-value-bind (body declarations) - declarations-and-body + (parse-declarations-and-body declarations-and-body) (let ((local-env (make-local-movitz-environment env funobj - :type 'operator-env - :declarations declarations))) - (loop for (name local-lambda-list . local-body) in macrolet-specs + :type 'operator-env + :declarations declarations))) + (loop for (name local-lambda-list . local-body-decl-doc) in macrolet-specs as cl-local-lambda-list = (translate-program local-lambda-list :muerte.cl :cl) + as (local-body local-declarations) = + (multiple-value-list (parse-docstring-declarations-and-body local-body-decl-doc)) as cl-local-body = (translate-program local-body :muerte.cl :cl) + as cl-local-declarations = (translate-program local-declarations :muerte.cl :cl) as expander = `(lambda (form env) (declare (ignorable env)) (destructuring-bind ,cl-local-lambda-list (translate-program (rest form) :muerte.cl :cl) + (declare ,@cl-local-declarations) (translate-program (block ,name (let () ,@cl-local-body)) :cl :muerte.cl))) - do (movitz-env-add-binding local-env - (make-instance 'macro-binding - :name name - :expander (movitz-macro-expander-make-function expander - :name name - :type :macrolet)))) + do (movitz-env-add-binding + local-env + (make-instance 'macro-binding + :name name + :expander (movitz-macro-expander-make-function expander + :name name + :type :macrolet)))) (compiler-values-bind (&all body-values &code body-code) (compiler-call #'compile-implicit-progn :defaults forward

1 0

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

02 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv32035 Modified Files: dp8390.lisp Log Message: Fixed with-dp8390-dma macro not to emit compiler warnings. Date: Mon Feb 2 09:03:13 2004 Author: ffjeld Index: movitz/losp/x86-pc/dp8390.lisp diff -u movitz/losp/x86-pc/dp8390.lisp:1.4 movitz/losp/x86-pc/dp8390.lisp:1.5 --- movitz/losp/x86-pc/dp8390.lisp:1.4 Mon Feb 2 08:41:52 2004 +++ movitz/losp/x86-pc/dp8390.lisp Mon Feb 2 09:03:13 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Sep 18 12:21:36 2002 ;;;; -;;;; $Id: dp8390.lisp,v 1.4 2004/02/02 13:41:52 ffjeld Exp $ +;;;; $Id: dp8390.lisp,v 1.5 2004/02/02 14:03:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -128,7 +128,7 @@ ;; Must be located inside with-dp8390. `(multiple-value-prog1 (macrolet ((dp8390-abort-dma () - `(setf (,dp8390-var ($page0-write cr)) ($command abort-complete)))) + `(setf (,',dp8390-var ($page0-write cr)) ($command abort-complete)))) (initialize-dma ,dp8390-var ($command ,rdma-command) ,size ,address) ,@body) (wait-for-dma-completion ,dp8390-var ',rdma-command)))

1 0

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

02 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv15284 Modified Files: dp8390.lisp Log Message: Added some information to dp8390 DMA protocol. Date: Mon Feb 2 08:41:53 2004 Author: ffjeld Index: movitz/losp/x86-pc/dp8390.lisp diff -u movitz/losp/x86-pc/dp8390.lisp:1.3 movitz/losp/x86-pc/dp8390.lisp:1.4 --- movitz/losp/x86-pc/dp8390.lisp:1.3 Mon Jan 19 06:23:52 2004 +++ movitz/losp/x86-pc/dp8390.lisp Mon Feb 2 08:41:52 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Sep 18 12:21:36 2002 ;;;; -;;;; $Id: dp8390.lisp,v 1.3 2004/01/19 11:23:52 ffjeld Exp $ +;;;; $Id: dp8390.lisp,v 1.4 2004/02/02 13:41:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -102,15 +102,15 @@ `((with-io-register-syntax (,var ,io-base-form) ,@body))))) -(defun wait-for-dma-completion (io-base) +(defun wait-for-dma-completion (io-base &optional command) (with-dp8390 (dp8390 io-base) (setf (dp8390 ($page0-write cr)) ($command page-0 abort-complete)) (if (logbitp ($interrupt-status dma-complete) (dp8390 ($page0-read isr))) (setf (dp8390 ($page0-write isr)) (ash 1 ($interrupt-status dma-complete))) - (error "Incomplete dp8390 @ #x~X DMA: crda=#x~X." - io-base + (error "Incomplete dp8390~@[ ~A~] @ #x~X DMA: crda=#x~X." + command io-base (io-register8x2 dp8390 ($page0-read crda1) ($page0-read crda0))))) nil) @@ -131,7 +131,7 @@ `(setf (,dp8390-var ($page0-write cr)) ($command abort-complete)))) (initialize-dma ,dp8390-var ($command ,rdma-command) ,size ,address) ,@body) - (wait-for-dma-completion ,dp8390-var))) + (wait-for-dma-completion ,dp8390-var ',rdma-command))) ;;; Utility functions

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