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

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

24 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv19455/losp/lib Modified Files: package.lisp Log Message: Added extract-zero-terminated-string. Date: Wed Nov 24 15:20:56 2004 Author: ffjeld Index: movitz/losp/lib/package.lisp diff -u movitz/losp/lib/package.lisp:1.5 movitz/losp/lib/package.lisp:1.6 --- movitz/losp/lib/package.lisp:1.5 Wed Nov 24 11:08:59 2004 +++ movitz/losp/lib/package.lisp Wed Nov 24 15:20:55 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Sep 27 17:24:11 2002 ;;;; -;;;; $Id: package.lisp,v 1.5 2004/11/24 10:08:59 ffjeld Exp $ +;;;; $Id: package.lisp,v 1.6 2004/11/24 14:20:55 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -47,6 +47,7 @@ ;; :lib/misc #:checksum-octets #:add-u16-ones-complement + #:extract-zero-terminated-string #:make-counter-u32 #:u32-add

1 0

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

24 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv19438 Modified Files: misc.lisp Log Message: Added extract-zero-terminated-string. Date: Wed Nov 24 15:20:49 2004 Author: ffjeld Index: movitz/losp/lib/misc.lisp diff -u movitz/losp/lib/misc.lisp:1.6 movitz/losp/lib/misc.lisp:1.7 --- movitz/losp/lib/misc.lisp:1.6 Wed Nov 24 11:05:47 2004 +++ movitz/losp/lib/misc.lisp Wed Nov 24 15:20:49 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon May 12 17:13:31 2003 ;;;; -;;;; $Id: misc.lisp,v 1.6 2004/11/24 10:05:47 ffjeld Exp $ +;;;; $Id: misc.lisp,v 1.7 2004/11/24 14:20:49 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -88,6 +88,18 @@ (declare (dynamic-extent integers)) (reduce #'add-u16-ones-complement integers :initial-value 0)))) +(defun extract-zero-terminated-string (vector &optional start (end (length vector))) + (check-type vector (and vector (not simple-vector))) + (let ((string (make-string (- (or (position 0 vector :start start) end) + start)))) + (loop for i from 0 below (length string) + do (setf (char string i) + (memref vector (+ (movitz-type-slot-offset 'movitz-basic-vector 'data) + start) + :index i + :type :character)) + finally (return string)))) + (defstruct (counter-u32 (:constructor make-counter-u32-object)) lo hi)

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-serv15051 Modified Files: ip4.lisp Log Message: Ensure zero-padding for UDP checksum. Date: Wed Nov 24 14:12:27 2004 Author: ffjeld Index: movitz/losp/lib/net/ip4.lisp diff -u movitz/losp/lib/net/ip4.lisp:1.9 movitz/losp/lib/net/ip4.lisp:1.10 --- movitz/losp/lib/net/ip4.lisp:1.9 Wed Nov 24 11:06:25 2004 +++ movitz/losp/lib/net/ip4.lisp Wed Nov 24 14:12:26 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.9 2004/11/24 10:06:25 ffjeld Exp $ +;;;; $Id: ip4.lisp,v 1.10 2004/11/24 13:12:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -342,6 +342,8 @@ (setf (ip4-ref packet start 6 :unsigned-byte16) checksum)) ((eq t checksum) (setf (ip4-ref packet start 6 :unsigned-byte16) 0) + (when (oddp udp-length) ; Ensure zero-padding for checksum. + (setf (ip4-ref packet start udp-length :unsigned-byte8) 0)) (setf (ip4-ref packet start 6 :unsigned-byte16) (logxor #xffff (add-u16-ones-complement (checksum-octets source) @@ -472,7 +474,7 @@ (unless *ip4-nic* (let ((ethernet (some #'muerte.x86-pc.ne2k:ne2k-probe - muerte.x86-pc.ne2k:+ne2k-probe-addresses+))) + muerte.x86-pc.ne2k:*ne2k-probe-addresses*))) (assert ethernet ethernet "No ethernet device.") (setf *ip4-nic* ethernet))) (unless *ip4-ip*

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-serv15024 Modified Files: ne2k.lisp Log Message: *** empty log message *** Date: Wed Nov 24 14:12:03 2004 Author: ffjeld Index: movitz/losp/x86-pc/ne2k.lisp diff -u movitz/losp/x86-pc/ne2k.lisp:1.11 movitz/losp/x86-pc/ne2k.lisp:1.12 --- movitz/losp/x86-pc/ne2k.lisp:1.11 Mon Aug 23 15:53:36 2004 +++ movitz/losp/x86-pc/ne2k.lisp Wed Nov 24 14:12:02 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.11 2004/08/23 13:53:36 ffjeld Exp $ +;;;; $Id: ne2k.lisp,v 1.12 2004/11/24 13:12:02 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -20,8 +20,7 @@ (defpackage muerte.x86-pc.ne2k (:use muerte.cl muerte muerte.lib muerte.x86-pc muerte.ethernet) (:export #:ne2k-probe - #:+ne2k-probe-addresses+ - + #:*ne2k-probe-addresses* #:with-dp8390 #:with-dp8390-dma #:dp8390-initialize @@ -41,7 +40,8 @@ (in-package muerte.x86-pc.ne2k) -(defconstant +ne2k-probe-addresses+ '(#x240 #x260 #x280 #x300 #x320 #x340)) +(defparameter *ne2k-probe-addresses* + '(#x300 #x240 #x260 #x280 #x300 #x320 #x340)) (defun ne2k-probe (io-base) (let ((io-space (make-io-space :range io-base #x20)))

1 0

[movitz-cvs] CVS update: movitz/losp/lib/net/arp.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-serv4816 Modified Files: arp.lisp Log Message: *** empty log message *** Date: Wed Nov 24 11:09:12 2004 Author: ffjeld Index: movitz/losp/lib/net/arp.lisp diff -u movitz/losp/lib/net/arp.lisp:1.6 movitz/losp/lib/net/arp.lisp:1.7 --- movitz/losp/lib/net/arp.lisp:1.6 Tue Nov 23 17:14:33 2004 +++ movitz/losp/lib/net/arp.lisp Wed Nov 24 11:09:12 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Mar 20 15:01:15 2003 ;;;; -;;;; $Id: arp.lisp,v 1.6 2004/11/23 16:14:33 ffjeld Exp $ +;;;; $Id: arp.lisp,v 1.7 2004/11/24 10:09:12 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -79,21 +79,24 @@ (defvar *ne2000* nil) -(defun arp-polling (ip &optional (waiter #'false)) - (loop with nic = *ip4-nic* +(defun polling-arp (ip &optional (waiter #'false)) + (loop with ip = (ip4-address ip) and nic = *ip4-nic* and transmit-time = 0 for packet = (muerte.ethernet:receive nic) until (funcall waiter) - do (transmit nic - (format-ethernet-packet (format-arp-request nil +arp-op-request+ *ip4-ip* - (mac-address nic) ip) - (mac-address nic) - muerte.ethernet:+broadcast-address+ - muerte.ethernet:+ether-type-arp+)) - (when (and packet + do (when (and packet (eq +ether-type-arp+ (ether-type packet)) (eq +arp-op-reply+ (arp-operation packet)) (not (mismatch packet ip :start1 28 :end1 32))) - (return (subseq packet 22 28))))) + (return (subseq packet 22 28))) + (when (< internal-time-units-per-second + (- (get-internal-run-time) transmit-time)) + (setf transmit-time (get-internal-run-time)) + (transmit nic + (format-ethernet-packet (format-arp-request nil +arp-op-request+ *ip4-ip* + (mac-address nic) ip) + (mac-address nic) + muerte.ethernet:+broadcast-address+ + muerte.ethernet:+ether-type-arp+))))) (defun test-arp (&optional (ip #(129 242 16 30)) (my-ip #(129 242 16 173)) (device *ne2000*))

1 0

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

24 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv4790 Modified Files: package.lisp Log Message: *** empty log message *** Date: Wed Nov 24 11:08:59 2004 Author: ffjeld Index: movitz/losp/lib/package.lisp diff -u movitz/losp/lib/package.lisp:1.4 movitz/losp/lib/package.lisp:1.5 --- movitz/losp/lib/package.lisp:1.4 Thu Jul 22 00:29:16 2004 +++ movitz/losp/lib/package.lisp Wed Nov 24 11:08:59 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Sep 27 17:24:11 2002 ;;;; -;;;; $Id: package.lisp,v 1.4 2004/07/21 22:29:16 ffjeld Exp $ +;;;; $Id: package.lisp,v 1.5 2004/11/24 10:08:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -46,6 +46,7 @@ ;; :lib/misc #:checksum-octets + #:add-u16-ones-complement #:make-counter-u32 #:u32-add

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.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-serv4764 Modified Files: integers.lisp Log Message: Added deftype real Date: Wed Nov 24 11:08:42 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.102 movitz/losp/muerte/integers.lisp:1.103 --- movitz/losp/muerte/integers.lisp:1.102 Tue Nov 23 17:05:23 2004 +++ movitz/losp/muerte/integers.lisp Wed Nov 24 11:08:41 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.102 2004/11/23 16:05:23 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.103 2004/11/24 10:08:41 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -426,6 +426,11 @@ ((typep size '(integer 1 *)) (list 'integer 0 (1- (ash 1 size)))) (t (error "Illegal size for unsigned-byte.")))) + +(deftype real (&optional (lower-limit '*) (upper-limit '*)) + `(or (integer ,lower-limit ,upper-limit) + (rational ,lower-limit ,upper-limit))) + (define-simple-typep (bit bitp) (x) (or (eq x 0) (eq x 1)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/typep.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-serv4738 Modified Files: typep.lisp Log Message: Added better type-spec rational Date: Wed Nov 24 11:08:29 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.38 movitz/losp/muerte/typep.lisp:1.39 --- movitz/losp/muerte/typep.lisp:1.38 Thu Nov 18 10:28:52 2004 +++ movitz/losp/muerte/typep.lisp Wed Nov 24 11:08:28 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.38 2004/11/18 09:28:52 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.39 2004/11/24 10:08:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -574,6 +574,13 @@ (define-simple-typep (package packagep)) ;;; + +(define-typep rational (x &optional (lower-limit '*) (upper-limit '*)) + (and (typep x 'rational) + (or (eq lower-limit '*) + (<= lower-limit x)) + (or (eq upper-limit '*) + (<= x upper-limit)))) (define-typep and (x &rest types) (declare (dynamic-extent types))

1 0

[movitz-cvs] CVS update: movitz/losp/lib/net/ethernet.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-serv4700 Modified Files: ethernet.lisp Log Message: Have make-ethernet-packet take an optional size parameter. Date: Wed Nov 24 11:07:11 2004 Author: ffjeld Index: movitz/losp/lib/net/ethernet.lisp diff -u movitz/losp/lib/net/ethernet.lisp:1.5 movitz/losp/lib/net/ethernet.lisp:1.6 --- movitz/losp/lib/net/ethernet.lisp:1.5 Tue Nov 23 17:14:40 2004 +++ movitz/losp/lib/net/ethernet.lisp Wed Nov 24 11:07:11 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 17 15:25:31 2002 ;;;; -;;;; $Id: ethernet.lisp,v 1.5 2004/11/23 16:14:40 ffjeld Exp $ +;;;; $Id: ethernet.lisp,v 1.6 2004/11/24 10:07:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -235,7 +235,7 @@ (values)) -(defun make-ethernet-packet () - (make-array +max-ethernet-frame-size+ +(defun make-ethernet-packet (&optional (size +max-ethernet-frame-size+)) + (make-array size :element-type '(unsigned-byte 8) :fill-pointer t))

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-serv4673 Modified Files: ip4.lisp Log Message: Wrote format-ip-header, format-udp-header, etc. Date: Wed Nov 24 11:06:26 2004 Author: ffjeld Index: movitz/losp/lib/net/ip4.lisp diff -u movitz/losp/lib/net/ip4.lisp:1.8 movitz/losp/lib/net/ip4.lisp:1.9 --- movitz/losp/lib/net/ip4.lisp:1.8 Tue Nov 23 17:14:49 2004 +++ movitz/losp/lib/net/ip4.lisp Wed Nov 24 11:06:25 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.8 2004/11/23 16:14:49 ffjeld Exp $ +;;;; $Id: ip4.lisp,v 1.9 2004/11/24 10:06:25 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -26,6 +26,8 @@ #:ip4-address #:ip4-test #:ip4-free + #:format-ip4-header + #:format-udp-header #:*ip4-nic* #:*ip4-ip*)) @@ -79,6 +81,37 @@ (ldb (byte 4 0) (ip4-ref packet start +ip-header-version-header-length+ :unsigned-byte8))) +(defun ip-header-source (packet &optional (start 14)) + (subseq packet (+ start 12) (+ start 16))) + +(defun ip-header-destination (packet &optional (start 14)) + (subseq packet (+ start 16) (+ start 20))) + +(defun format-ip4-header (packet &key (start 14) (payload 0) + (id 0) (ttl 64) (checksum t) + (protocol 0) (flags 0) + (fragment-offset 0) + source destination) + (setf (ip4-ref packet start 0 :unsigned-byte16) #x4500 + (ip4-ref packet start 2 :unsigned-byte16) (+ payload 20) + (ip4-ref packet start 4 :unsigned-byte16) id + (ip4-ref packet start 6 :unsigned-byte16) (dpb flags (byte 3 13) fragment-offset) + (ip4-ref packet start 8 :unsigned-byte8) ttl + (ip4-ref packet start 9 :unsigned-byte8) protocol) + (when source + (replace packet source :start1 (+ start 12))) + (when destination + (replace packet destination :start1 (+ start 16))) + (cond + ((eq t checksum) + (setf (ip4-ref packet start 10 :unsigned-byte16) 0) + (setf (ip4-ref packet start 10 :unsigned-byte16) + (logxor #xffff + (checksum-octets packet start (+ start 20))))) + ((integerp checksum) + (setf (ip4-ref packet start 10 :unsigned-byte16) checksum))) + packet) + (defun checksum-ok (x) (= #xffff (+ (ldb (byte 16 0) x) @@ -272,11 +305,51 @@ (defun udp-dst-port (packet &optional (start 34)) (ip4-ref packet start 2 :unsigned-byte16)) +(defun (setf udp-dst-port) (value packet &optional (start 34)) + (setf (ip4-ref packet start 2 :unsigned-byte16) + value)) + (defun udp-length (packet &optional (start 34)) (ip4-ref packet start 4 :unsigned-byte16)) +(defun (setf udp-length) (value packet &optional (start 34)) + (setf (ip4-ref packet start 4 :unsigned-byte16) + value)) + (defun udp-checksum (packet &optional (start 34)) (ip4-ref packet start 6 :unsigned-byte16)) + +(defun (setf udp-checksum) (value packet &optional (start 34)) + (setf (ip4-ref packet start 6 :unsigned-byte16) + value)) + +(defun format-udp-header (packet &key (start 34) + (source *ip4-ip*) (source-port 1024) + destination (destination-port 0) + (payload (- (length packet) start 8)) + (checksum t)) + (let ((udp-length (+ payload 8))) + (format-ip4-header packet + :source source + :destination destination + :payload udp-length + :protocol +ip-protocol-udp+) + (setf (ip4-ref packet start 0 :unsigned-byte16) source-port + (ip4-ref packet start 2 :unsigned-byte16) destination-port + (ip4-ref packet start 4 :unsigned-byte16) udp-length) + (cond + ((integerp checksum) + (setf (ip4-ref packet start 6 :unsigned-byte16) checksum)) + ((eq t checksum) + (setf (ip4-ref packet start 6 :unsigned-byte16) 0) + (setf (ip4-ref packet start 6 :unsigned-byte16) + (logxor #xffff + (add-u16-ones-complement (checksum-octets source) + (checksum-octets destination) + +ip-protocol-udp+ udp-length + (checksum-octets packet start (+ start udp-length))))))) + packet)) + (defmethod udp-input ((stack ip4-stack) packet ip-start udp-start) (warn "Got UDP packet of length ~D from ~@v/ip4:pprint-ip4/."

1 0