November 2004 - movitz-cvs@common-lisp.net

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

24 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv26398 Modified Files: packages.lisp Log Message: *** empty log message *** Date: Wed Nov 24 17:22:44 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.41 movitz/packages.lisp:1.42 --- movitz/packages.lisp:1.41 Tue Nov 23 17:10:51 2004 +++ movitz/packages.lisp Wed Nov 24 17:22:43 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.41 2004/11/23 16:10:51 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.42 2004/11/24 16:22:43 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1097,6 +1097,7 @@ numargs-case movitz-accessor simple-read-from-string + #:read-key print-word fixnump below print-unreadable-movitz-object

1 0

[movitz-cvs] CVS update: movitz/losp/lib/net/tftp.lisp
by Frode Vatvedt Fjeld 24 Nov '04

24 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/lib/net In directory common-lisp.net:/tmp/cvs-serv26372 Modified Files: tftp.lisp Log Message: Minor output niceties. Date: Wed Nov 24 17:22:21 2004 Author: ffjeld Index: movitz/losp/lib/net/tftp.lisp diff -u movitz/losp/lib/net/tftp.lisp:1.1 movitz/losp/lib/net/tftp.lisp:1.2 --- movitz/losp/lib/net/tftp.lisp:1.1 Wed Nov 24 15:27:14 2004 +++ movitz/losp/lib/net/tftp.lisp Wed Nov 24 17:22:21 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Oct 6 12:42:51 2004 ;;;; -;;;; $Id: tftp.lisp,v 1.1 2004/11/24 14:27:14 ffjeld Exp $ +;;;; $Id: tftp.lisp,v 1.2 2004/11/24 16:22:21 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -84,8 +84,8 @@ for ack = nil then (receive *ip4-nic* ack) until (with-simple-restart (continue - "Continue TFTP stop-and-wait for block ~D~@[, port ~D~]." - ack-block-number port) + "Continue TFTP stop-and-wait for ~S block ~D~@[, port ~D~]." + file-name ack-block-number port) (when (funcall breaker) (break "TFTP/Ethernet")) (when (< (* timeout internal-time-units-per-second) @@ -137,7 +137,8 @@ (setf (fill-pointer packet) j)) (format-udp-header packet :destination ip :destination-port port) (format-ethernet-packet packet (mac-address *ip4-nic*) mac +ether-type-ip4+) - (write-char #\. speak) + (when speak + (write-char #\. speak)) (transmit-stop-and-wait packet block-number port))) (format speak "done.") (values)))))

1 0

[movitz-cvs] CVS update: movitz/losp/lib/net/ip4.lisp
by Frode Vatvedt Fjeld 24 Nov '04

24 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/lib/net In directory common-lisp.net:/tmp/cvs-serv26339 Modified Files: ip4.lisp Log Message: Include :lib/net/tftp. Date: Wed Nov 24 17:21:58 2004 Author: ffjeld Index: movitz/losp/lib/net/ip4.lisp diff -u movitz/losp/lib/net/ip4.lisp:1.11 movitz/losp/lib/net/ip4.lisp:1.12 --- movitz/losp/lib/net/ip4.lisp:1.11 Wed Nov 24 15:22:57 2004 +++ movitz/losp/lib/net/ip4.lisp Wed Nov 24 17:21:57 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 30 13:52:57 2003 ;;;; -;;;; $Id: ip4.lisp,v 1.11 2004/11/24 14:22:57 ffjeld Exp $ +;;;; $Id: ip4.lisp,v 1.12 2004/11/24 16:21:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -43,6 +43,7 @@ :type ,type)) (require :lib/net/arp) +(require :lib/net/tftp) (defclass ip4-stack () ((interface

1 0

[movitz-cvs] CVS update: movitz/losp/lib/net/ip6.lisp
by Frode Vatvedt Fjeld 24 Nov '04

24 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/lib/net In directory common-lisp.net:/tmp/cvs-serv26313 Modified Files: ip6.lisp Log Message: *** empty log message *** Date: Wed Nov 24 17:21:42 2004 Author: ffjeld Index: movitz/losp/lib/net/ip6.lisp diff -u movitz/losp/lib/net/ip6.lisp:1.6 movitz/losp/lib/net/ip6.lisp:1.7 --- movitz/losp/lib/net/ip6.lisp:1.6 Sun Apr 11 20:53:42 2004 +++ movitz/losp/lib/net/ip6.lisp Wed Nov 24 17:21:42 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 14 17:25:31 2001 ;;;; -;;;; $Id: ip6.lisp,v 1.6 2004/04/11 18:53:42 ffjeld Exp $ +;;;; $Id: ip6.lisp,v 1.7 2004/11/24 16:21:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -568,9 +568,12 @@ (defvar *ne2000* nil) -(defun ip6-test (&optional (ne2000 (or *ne2000* - (setf *ne2000* (some #'muerte.x86-pc.ne2k:ne2k-probe muerte.x86-pc.ne2k:+ne2k-probe-addresses+)) - (error "No ethernet device.")))) +(defun ip6-test (&optional (ne2000 + (or *ne2000* + (setf *ne2000* + (some #'muerte.x86-pc.ne2k:ne2k-probe + muerte.x86-pc.ne2k:*ne2k-probe-addresses*)) + (error "No ethernet device.")))) (let* ((link-local-address (link-local-address-by-mac (mac-address ne2000))) (solicited-node-address (solicited-node-address link-local-address)) (neighbor-cache (make-neighbor-cache)))

1 0

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

24 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv26251 Modified Files: ne2k.lisp Log Message: *** empty log message *** Date: Wed Nov 24 17:20:30 2004 Author: ffjeld Index: movitz/losp/x86-pc/ne2k.lisp diff -u movitz/losp/x86-pc/ne2k.lisp:1.12 movitz/losp/x86-pc/ne2k.lisp:1.13 --- movitz/losp/x86-pc/ne2k.lisp:1.12 Wed Nov 24 14:12:02 2004 +++ movitz/losp/x86-pc/ne2k.lisp Wed Nov 24 17:20:30 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.12 2004/11/24 13:12:02 ffjeld Exp $ +;;;; $Id: ne2k.lisp,v 1.13 2004/11/24 16:20:30 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -47,7 +47,7 @@ (let ((io-space (make-io-space :range io-base #x20))) (with-io-space-lock () (when (null (io-space-occupants io-space)) - (format t "Probing for ne2k NIC at #x~X.." io-base) + (format *query-io* "~&Probing for ne2k NIC at #x~X.." io-base) (with-dp8390 (dp8390 io-base) (let ((tmp (dp8390 #x1f))) (io-delay 5000)

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/keyboard.lisp
by Frode Vatvedt Fjeld 24 Nov '04

24 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv26225 Modified Files: keyboard.lisp Log Message: Make poll-key similar to poll-char. A key is a character or a symbolic key name. Date: Wed Nov 24 17:20:15 2004 Author: ffjeld Index: movitz/losp/x86-pc/keyboard.lisp diff -u movitz/losp/x86-pc/keyboard.lisp:1.3 movitz/losp/x86-pc/keyboard.lisp:1.4 --- movitz/losp/x86-pc/keyboard.lisp:1.3 Thu Oct 7 14:45:07 2004 +++ movitz/losp/x86-pc/keyboard.lisp Wed Nov 24 17:20:14 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Sep 24 16:04:12 2001 ;;;; -;;;; $Id: keyboard.lisp,v 1.3 2004/10/07 12:45:07 ffjeld Exp $ +;;;; $Id: keyboard.lisp,v 1.4 2004/11/24 16:20:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -23,6 +23,7 @@ ;; read-char poll-keypress read-keypress + poll-key set-leds cpu-reset)) @@ -155,7 +156,7 @@ (aref *scan-codes* key-code)))) ;;; (< -1 key-code (length *scan-codes*))) -(defun read-key () +(defun get-key () (when (lowlevel-event-p) (multiple-value-bind (key-code release-p) (lowlevel-read) @@ -175,7 +176,7 @@ (defun poll-keypress () (multiple-value-bind (key release-p) - (read-key) + (get-key) (unless release-p (values key *qualifier-state*)))) @@ -189,6 +190,7 @@ (multiple-value-bind (key qualifiers) (poll-keypress) (cond + ((not key) nil) ((symbolp key) (case key (:up #\^p) @@ -204,8 +206,16 @@ (- (char-code #\a))))) (t key)))) -;;;(defun read-char () -;;; (loop when (poll-char) return it)) +(defun poll-key () + (multiple-value-bind (key qualifiers) + (poll-keypress) + (if (and (characterp key) + (qualifier-p :ctrl qualifiers) + (char<= #\a (char-downcase key) #\z)) + (code-char (+ (char-code #\^a) + (char-code (char-downcase key)) + (- (char-code #\a)))) + key))) (defun set-leds (led0 led1 led2) (loop while (logbitp 1 (io-port #x64 :unsigned-byte8)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/streams.lisp
by Frode Vatvedt Fjeld 24 Nov '04

24 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv26183 Modified Files: streams.lisp Log Message: Added read-key, which is like read-char only it can return symbols such as :up, :page-down etc. also, not just characters. Date: Wed Nov 24 17:19:36 2004 Author: ffjeld Index: movitz/losp/muerte/streams.lisp diff -u movitz/losp/muerte/streams.lisp:1.3 movitz/losp/muerte/streams.lisp:1.4 --- movitz/losp/muerte/streams.lisp:1.3 Thu May 20 20:13:55 2004 +++ movitz/losp/muerte/streams.lisp Wed Nov 24 17:19:36 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Jun 30 14:33:15 2003 ;;;; -;;;; $Id: streams.lisp,v 1.3 2004/05/20 18:13:55 ffjeld Exp $ +;;;; $Id: streams.lisp,v 1.4 2004/11/24 16:19:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -115,6 +115,10 @@ (defun read-char (&optional input-stream (eof-error-p t) eof-value recursive-p) " => char" (%read-char (input-stream-designator input-stream) eof-error-p eof-value recursive-p t)) + +(defun read-key (&optional input-stream (eof-error-p t) eof-value recursive-p) + " => char, symbol, etc." + (%read-key (input-stream-designator input-stream) eof-error-p eof-value recursive-p t)) (defun finish-output (&optional stream) "finish-output attempts to ensure that any buffered output sent to output-stream has reached its

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/simple-streams.lisp
by Frode Vatvedt Fjeld 24 Nov '04

24 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv26156 Modified Files: simple-streams.lisp Log Message: Added %read-key. Date: Wed Nov 24 17:19:02 2004 Author: ffjeld Index: movitz/losp/muerte/simple-streams.lisp diff -u movitz/losp/muerte/simple-streams.lisp:1.6 movitz/losp/muerte/simple-streams.lisp:1.7 --- movitz/losp/muerte/simple-streams.lisp:1.6 Sat Sep 25 17:26:49 2004 +++ movitz/losp/muerte/simple-streams.lisp Wed Nov 24 17:19:02 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.6 2004/09/25 15:26:49 ffjeld Exp $ +;;;; $Id: simple-streams.lisp,v 1.7 2004/11/24 16:19:02 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -512,6 +512,13 @@ (%finish-output stream)) (funcall-stm-handler j-read-char (sm melded-stream stream) eof-error-p eof-value blocking-p))))) + +(defun %read-key (stream eof-error-p eof-value recursive-p blocking-p) + (etypecase stream + (function + (funcall stream 'stream-read-key)) + (simple-stream ; XXX + (%read-char stream eof-error-p eof-value recursive-p blocking-p)))) (defun %unread-char (stream character) (declare (type simple-stream stream) (ignore character))

1 0

[movitz-cvs] CVS update: movitz/losp/lib/net/tftp.lisp
by Frode Vatvedt Fjeld 24 Nov '04

24 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/lib/net In directory common-lisp.net:/tmp/cvs-serv19612 Added Files: tftp.lisp Log Message: Some simple TFTP code that writes a file to a tftp server. Date: Wed Nov 24 15:27:15 2004 Author: ffjeld

1 0

[movitz-cvs] CVS update: movitz/losp/lib/net/ip4.lisp
by Frode Vatvedt Fjeld 24 Nov '04

24 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/lib/net In directory common-lisp.net:/tmp/cvs-serv19491 Modified Files: ip4.lisp Log Message: Have checksum-ok accept any number of checksum terms, since typically there will be a frew terms from the pseudo-header and one term from the actual packet. Date: Wed Nov 24 15:22:57 2004 Author: ffjeld Index: movitz/losp/lib/net/ip4.lisp diff -u movitz/losp/lib/net/ip4.lisp:1.10 movitz/losp/lib/net/ip4.lisp:1.11 --- movitz/losp/lib/net/ip4.lisp:1.10 Wed Nov 24 14:12:26 2004 +++ movitz/losp/lib/net/ip4.lisp Wed Nov 24 15:22:57 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 30 13:52:57 2003 ;;;; -;;;; $Id: ip4.lisp,v 1.10 2004/11/24 13:12:26 ffjeld Exp $ +;;;; $Id: ip4.lisp,v 1.11 2004/11/24 14:22:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -112,10 +112,12 @@ (setf (ip4-ref packet start 10 :unsigned-byte16) checksum))) packet) -(defun checksum-ok (x) - (= #xffff - (+ (ldb (byte 16 0) x) - (ash x -16)))) +(defun checksum-ok (x &rest more-xes) + (declare (dynamic-extent more-xes)) + (let ((x (reduce #'add-u16-ones-complement more-xes :initial-value x))) + (= #xffff + (+ (ldb (byte 16 0) x) + (ash x -16))))) (defun ip-input (stack packet start) (let ((header-size (* 4 (ip-header-length packet start))))

1 0