[movitz-cvs] CVS update: movitz/losp/lib/net/ip4.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Tue Nov 23 16:14:53 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/lib/net
In directory common-lisp.net:/tmp/cvs-serv7811
Modified Files:
ip4.lisp
Log Message:
Use untyped (i.e. memref) accessors to packets.
Date: Tue Nov 23 17:14:49 2004
Author: ffjeld
Index: movitz/losp/lib/net/ip4.lisp
diff -u movitz/losp/lib/net/ip4.lisp:1.7 movitz/losp/lib/net/ip4.lisp:1.8
--- movitz/losp/lib/net/ip4.lisp:1.7 Thu Oct 21 22:52:11 2004
+++ movitz/losp/lib/net/ip4.lisp Tue Nov 23 17:14:49 2004
@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef at acm.org>
;;;; Created at: Wed Apr 30 13:52:57 2003
;;;;
-;;;; $Id: ip4.lisp,v 1.7 2004/10/21 20:52:11 ffjeld Exp $
+;;;; $Id: ip4.lisp,v 1.8 2004/11/23 16:14:49 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -25,12 +25,23 @@
#:read-ip4-address
#:ip4-address
#:ip4-test
- #:ip4-free))
-
-(require :lib/net/arp)
+ #:ip4-free
+ #:*ip4-nic*
+ #:*ip4-ip*))
(in-package muerte.ip4)
+(defvar *ip4-nic* nil)
+(defvar *ip4-ip* nil)
+
+(defmacro ip4-ref (packet start offset type)
+ `(memref ,packet (+ (muerte:movitz-type-slot-offset 'movitz-basic-vector 'data)
+ ,start ,offset)
+ :endian :big
+ :type ,type))
+
+(require :lib/net/arp)
+
(defclass ip4-stack ()
((interface
:initarg :interface
@@ -62,10 +73,11 @@
(20 options))
(defun ip-protocol (packet &optional (start 14))
- (aref packet (+ start +ip-header-protocol+)))
+ (ip4-ref packet start +ip-header-protocol+ :unsigned-byte8))
(defun ip-header-length (packet &optional (start 14))
- (ldb (byte 4 0) (aref packet (+ start +ip-header-version-header-length+))))
+ (ldb (byte 4 0)
+ (ip4-ref packet start +ip-header-version-header-length+ :unsigned-byte8)))
(defun checksum-ok (x)
(= #xffff
@@ -160,8 +172,6 @@
(warn "Received unknown ARP packet of type ~D~@[ ~A~]"
(arp-operation packet start)
(integer-name 'arp-op (arp-operation packet start) nil)))))
-
-
;;; ICMP
@@ -173,27 +183,27 @@
(8 echo-request))
(defun icmp-type (packet &optional (start 34))
- (aref packet start))
+ (ip4-ref packet start 0 :unsigned-byte8))
(defun (setf icmp-type) (value packet &optional (start 34))
- (setf (aref packet start) value))
+ (setf (ip4-ref packet start 0 :unsigned-byte8)
+ value))
(defun icmp-code (packet &optional (start 34))
- (aref packet (1+ start)))
+ (ip4-ref packet start 1 :unsigned-byte8))
(defun icmp-checksum (packet &optional (start 34))
- (bvref-u16 packet start 2))
+ (ip4-ref packet start 2 :unsigned-byte16))
(defun icmp-identifier (packet &optional (start 34))
- (bvref-u16 packet start 4))
+ (ip4-ref packet start 4 :unsigned-byte16))
(defun icmp-seqno (packet &optional (start 34))
- (bvref-u16 packet start 6))
+ (ip4-ref packet start 6 :unsigned-byte16))
(defun (setf icmp-checksum) (value packet &optional (start 34))
- (setf (aref packet (+ start 2)) (ldb (byte 8 8) value)
- (aref packet (+ start 3)) (ldb (byte 8 0) value))
- value)
+ (setf (ip4-ref packet start 2 :unsigned-byte16)
+ value))
(defmethod icmp-input ((stack ip4-stack) packet ip-start icmp-start)
(named-integer-case icmp-type (icmp-type packet icmp-start)
@@ -253,20 +263,20 @@
;;;; UDP
(defun udp-src-port (packet &optional (start 34))
- (bvref-u16 packet start 0))
+ (ip4-ref packet start 0 :unsigned-byte16))
(defun (setf udp-src-port) (value packet &optional (start 34))
- (setf (bvref-u16 packet start 0) value))
+ (setf (ip4-ref packet start 0 :unsigned-byte16)
+ value))
(defun udp-dst-port (packet &optional (start 34))
- (bvref-u16 packet start 2))
+ (ip4-ref packet start 2 :unsigned-byte16))
(defun udp-length (packet &optional (start 34))
- (bvref-u16 packet start 4))
+ (ip4-ref packet start 4 :unsigned-byte16))
(defun udp-checksum (packet &optional (start 34))
- (bvref-u16 packet start 6))
-
+ (ip4-ref packet start 6 :unsigned-byte16))
(defmethod udp-input ((stack ip4-stack) packet ip-start udp-start)
(warn "Got UDP packet of length ~D from ~@v/ip4:pprint-ip4/."
@@ -296,22 +306,24 @@
(5 urg))
(defun tcp-src-port (packet &optional (start 34))
- (bvref-u16 packet start +tcp-header-src-port+))
+ (ip4-ref packet start +tcp-header-src-port+ :unsigned-byte16))
(defun tcp-dst-port (packet &optional (start 34))
- (bvref-u16 packet start +tcp-header-dst-port+))
+ (ip4-ref packet start +tcp-header-dst-port+ :unsigned-byte16))
(defun tcp-header-length (packet &optional (start 34))
- (ldb (byte 4 4) (aref packet (+ start +tcp-header-flags-length+))))
+ (ldb (byte 4 4)
+ (ip4-ref packet start +tcp-header-flags-length+ :unsigned-byte8)))
(defun tcp-flags (packet &optional (start 34))
- (ldb (byte 6 0) (aref packet (+ start +tcp-header-flags-length+ 1))))
+ (ldb (byte 6 0)
+ (ip4-ref packet start (+ +tcp-header-flags-length+ 1) :unsigned-byte8)))
(defun tcp-window-size (packet &optional (start 34))
- (bvref-u16 packet start +tcp-header-window-size+))
+ (ip4-ref packet start +tcp-header-window-size+ :unsigned-byte16))
(defun tcp-checksum (packet &optional (start 34))
- (bvref-u16 packet start +tcp-header-checksum+))
+ (ip4-ref packet start +tcp-header-checksum+ :unsigned-byte16))
(defun print-flags (x set)
(loop with first = t
@@ -383,23 +395,23 @@
(setf *ne2000* nil))
(values))
-(defvar *ne2000* nil)
-
-(defun ip4-test (&key (ip #(129 242 16 173))
- (ethernet *ne2000*)
- (router #(129 242 16 1)))
- (unless ethernet
- (setf ethernet
- (some #'muerte.x86-pc.ne2k:ne2k-probe
- muerte.x86-pc.ne2k:+ne2k-probe-addresses+))
- (assert ethernet ethernet "No ethernet device.")
- (when ethernet
- (setf (promiscuous-p ethernet) nil
- (accept-broadcasts-p ethernet) t)
- (setf *ne2000* ethernet)))
- (let ((stack (make-instance 'ip4-stack
- :interface ethernet
- :address (ip4-address ip))))
+(defun ip4-init ()
+ (unless *ip4-nic*
+ (let ((ethernet
+ (some #'muerte.x86-pc.ne2k:ne2k-probe
+ muerte.x86-pc.ne2k:+ne2k-probe-addresses+)))
+ (assert ethernet ethernet "No ethernet device.")
+ (setf *ip4-nic* ethernet)))
+ (unless *ip4-ip*
+ (setf *ip4-ip* (ip4-address :129.242.16.173)))
+ (values *ip4-nic* *ip4-ip*))
+
+(defun ip4-test (&key (router #(129 242 16 1)))
+ (ip4-init)
+ (let ((ethernet *ip4-nic*)
+ (stack (make-instance 'ip4-stack
+ :interface *ip4-nic*
+ :address *ip4-ip*)))
(when router
(transmit (interface stack)
(format-ethernet-packet (format-arp-request nil +arp-op-request+
More information about the Movitz-cvs
mailing list