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

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

29 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv22755 Modified Files: sequences.lisp Log Message: Completed map-into somewhat. Date: Sun Feb 29 14:14:59 2004 Author: ffjeld Index: movitz/losp/muerte/sequences.lisp diff -u movitz/losp/muerte/sequences.lisp:1.4 movitz/losp/muerte/sequences.lisp:1.5 --- movitz/losp/muerte/sequences.lisp:1.4 Wed Jan 28 16:06:08 2004 +++ movitz/losp/muerte/sequences.lisp Sun Feb 29 14:14:59 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 11 14:19:23 2001 ;;;; -;;;; $Id: sequences.lisp,v 1.4 2004/01/28 21:06:08 ffjeld Exp $ +;;;; $Id: sequences.lisp,v 1.5 2004/02/29 19:14:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -543,7 +543,21 @@ (q first-sequence (cdr q))) ((or (null p) (null q)) result-sequence) - (setf (car p) (map (car q)))))))) + (setf (car p) (map (car q))))) + ((vector list) + (with-subvector-accessor (result-ref result-sequence) + (do ((end (length result-sequence)) + (i 0 (1+ i)) + (p first-sequence (cdr p))) + ((or (endp p) (>= i end)) result-sequence) + (setf (result-ref i) (map (car p)))))) + ((list vector) + (with-subvector-accessor (first-ref first-sequence) + (do ((end (length first-sequence)) + (i 0 (1+ i)) + (p result-sequence (cdr p))) + ((or (endp p) (>= i end)) result-sequence) + (setf (car p) (map (first-ref i))))))))) (defun map-for-nil (function first-sequence &rest more-sequences) (numargs-case

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by Frode Vatvedt Fjeld 26 Feb '04

26 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv17969 Modified Files: compiler.lisp Log Message: Fixed a bug that caused compilation of some 1req1opt functions to fail. Date: Thu Feb 26 08:48:43 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.32 movitz/compiler.lisp:1.33 --- movitz/compiler.lisp:1.32 Sun Feb 22 10:55:03 2004 +++ movitz/compiler.lisp Thu Feb 26 08:48:42 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.32 2004/02/22 15:55:03 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.33 2004/02/26 13:48:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -599,7 +599,7 @@ finally (multiple-value-bind (const-list num-jumpers jumpers-map) (layout-funobj-vector all-constants-plist - jumper-sets + all-jumper-sets (length (borrowed-bindings funobj))) (setf (movitz-funobj-num-jumpers funobj) num-jumpers (movitz-funobj-const-list funobj) const-list @@ -705,9 +705,9 @@ use-stack-frame-p))))) (let ((optimized-function-code (optimize-code function-code - :keep-labels (nconc (subseq (movitz-funobj-const-list funobj) - 0 (movitz-funobj-num-jumpers funobj)) - '(entry%1op entry%2op))))) + :keep-labels (append (subseq (movitz-funobj-const-list funobj) + 0 (movitz-funobj-num-jumpers funobj)) + '(entry%1op entry%2op))))) (assemble-funobj funobj optimized-function-code))))) (defun complete-funobj-default (funobj) @@ -731,11 +731,11 @@ have-normalized-ecx-p))) (let ((optimized-function-code (optimize-code function-code - :keep-labels (nconc (subseq (movitz-funobj-const-list funobj) - 0 (movitz-funobj-num-jumpers funobj)) - '(entry%1op - entry%2op - entry%3op))))) + :keep-labels (append (subseq (movitz-funobj-const-list funobj) + 0 (movitz-funobj-num-jumpers funobj)) + '(entry%1op + entry%2op + entry%3op))))) (cons numargs optimized-function-code)))))))) (let ((code1 (cdr (assoc 1 code-specs))) (code2 (cdr (assoc 2 code-specs)))

1 0

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

26 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv13105 Modified Files: integers.lisp Log Message: Transforming e.g (- x 1) into (+ x -1). Added some type information. Date: Thu Feb 26 08:46:37 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.2 movitz/losp/muerte/integers.lisp:1.3 --- movitz/losp/muerte/integers.lisp:1.2 Mon Jan 19 06:23:46 2004 +++ movitz/losp/muerte/integers.lisp Thu Feb 26 08:46:36 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.2 2004/01/19 11:23:46 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.3 2004/02/26 13:46:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -188,10 +188,7 @@ ((movitz:movitz-constantp subtrahend) (let ((constant-subtrahend (movitz::eval-form subtrahend))) (check-type constant-subtrahend (signed-byte 30)) - `(with-inline-assembly (:returns :register :side-effects nil) ; inline - (:compile-form (:result-mode :register) ,minuend) - (:subl ,(* movitz::+movitz-fixnum-factor+ constant-subtrahend) (:result-register)) - (:into)))) + `(+%2op ,minuend ,(- constant-subtrahend)))) (t `(with-inline-assembly (:returns :eax :side-effects nil) (:compile-two-forms (:eax :ebx) ,minuend ,subtrahend) (:subl :ebx :eax) @@ -517,7 +514,7 @@ (if (< number1 number2) number2 number1)) (let ((label (gensym))) - `(with-inline-assembly (:returns :eax) + `(with-inline-assembly (:returns :eax :type integer) (:compile-two-forms (:eax :ebx) ,number1 ,number2) (:movl :ebx :ecx) (:orl :eax :ecx) @@ -542,30 +539,15 @@ (defun max (number1 &rest numbers) (declare (dynamic-extent numbers)) - #+ignore (reduce #'max%2op numbers :initial-value number1) (let ((max number1)) (dolist (x numbers max) (when (>= x max) (setq max x))))) (define-compiler-macro min%2op (number1 number2) - `(let ((number1 ,number1) (number2 ,number2)) - (if (< number1 number2) - number1 number2)) - #+ignore - (let ((label (gensym))) - `(with-inline-assembly (:returns :eax) - (:compile-two-forms (:eax :ebx) ,number1 ,number2) - (:movl :ebx :ecx) - (:orl :eax :ecx) - (:testb 7 :cl) - (:jnz '(:sub-program () (:int 107))) - (:subl :ebx :eax) (:sbbl :ecx :ecx) (:andl :ecx :eax) (:addl :ebx :eax) - - (:cmpl :eax :ebx) - (:jg ',label) - (:movl :ebx :eax) - ,label))) + `(let ((number1 ,number1) (number2 ,number2)) + (if (< number1 number2) + number1 number2))) (defun min%2op (number1 number2) (min%2op number1 number2)) @@ -608,7 +590,7 @@ append `((:addl (:result-register) (:result-register)) (:into))))) ((< 0 count #.(cl:1- movitz::+movitz-fixnum-bits+)) - `(with-inline-assembly (:returns :register :side-effects nil) + `(with-inline-assembly (:returns :register :side-effects nil :type integer) ,@load-integer (:cmpl ,(ash 1 (- (- 31 0) count)) (:result-register)) @@ -618,12 +600,12 @@ (:jl '(:sub-program () (:int 4))) (:shll ,count (:result-register)))) ((= -1 count) - `(with-inline-assembly (:returns :register :side-effects nil) + `(with-inline-assembly (:returns :register :side-effects nil :type integer) ,@load-integer (:andb #.(cl:logxor #xfe (cl:* 2 movitz::+movitz-fixnum-zmask+)) (:result-register-low8)) (:sarl 1 (:result-register)))) ((> 0 count #.(cl:- (cl:1- movitz::+movitz-fixnum-bits+))) - `(with-inline-assembly (:returns :register :side-effects nil) + `(with-inline-assembly (:returns :register :side-effects nil :type integer) ,@load-integer (:sarl ,(- count) (:result-register)) (:andb #.(cl:logxor #xff movitz::+movitz-fixnum-zmask+) (:result-register-low8)))) @@ -670,7 +652,7 @@ (0 `(progn ,factor2 0)) (1 factor2) (2 `(ash ,factor2 1)) - (t `(with-inline-assembly (:returns :eax) + (t `(with-inline-assembly (:returns :eax :type integer) (:compile-form (:result-mode :eax) ,factor2) (:testb #.movitz::+movitz-fixnum-zmask+ :al) (:jnz '(:sub-program () (:int 107))) @@ -762,7 +744,7 @@ (case d (0 (error "Truncate by zero.")) (1 number) - (t `(with-inline-assembly (:returns :eax) + (t `(with-inline-assembly (:returns :eax :type integer) (:compile-form (:result-mode :eax) ,number) (:compile-form (:result-mode :ebx) ,divisor) (:testb #.movitz::+movitz-fixnum-zmask+ :al) @@ -1028,7 +1010,7 @@ (let ((size (movitz::eval-form (second bytespec) env)) (position (movitz::eval-form (third bytespec) env))) (assert (<= (+ size position) 30)) - `(with-inline-assembly (:returns :register) + `(with-inline-assembly (:returns :register :type integer) (:compile-form (:result-mode :register) ,integer) (:andl ,(mask-field (byte size (+ position movitz::+movitz-fixnum-shift+)) -1) (:result-register))

1 0

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

26 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv28608 Modified Files: basic-functions.lisp Log Message: Minor edit of object-location inline assembly. Date: Thu Feb 26 08:44:29 2004 Author: ffjeld Index: movitz/losp/muerte/basic-functions.lisp diff -u movitz/losp/muerte/basic-functions.lisp:1.2 movitz/losp/muerte/basic-functions.lisp:1.3 --- movitz/losp/muerte/basic-functions.lisp:1.2 Mon Jan 19 06:23:46 2004 +++ movitz/losp/muerte/basic-functions.lisp Thu Feb 26 08:44:29 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 18:41:57 2001 ;;;; -;;;; $Id: basic-functions.lisp,v 1.2 2004/01/19 11:23:46 ffjeld Exp $ +;;;; $Id: basic-functions.lisp,v 1.3 2004/02/26 13:44:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -331,14 +331,14 @@ (getf (load-global-constant global-properties) property)) (define-compiler-macro object-location (object) - `(with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) ,object) - (:andb #xf8 :al))) + `(with-inline-assembly (:returns :register) + (:compile-form (:result-mode :register) ,object) + (:andl ,(* -2 movitz::+movitz-fixnum-factor+) (:result-register)))) + (defun object-location (object) "The location is the object's address divided by fixnum-factor." (object-location object)) - (defun halt-cpu () (halt-cpu))

1 0

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

26 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv15216 Modified Files: primitive-functions.lisp Log Message: Insignificant edits. Date: Thu Feb 26 08:43:52 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.3 movitz/losp/muerte/primitive-functions.lisp:1.4 --- movitz/losp/muerte/primitive-functions.lisp:1.3 Thu Feb 5 09:46:24 2004 +++ movitz/losp/muerte/primitive-functions.lisp Thu Feb 26 08:43:51 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 2 21:02:18 2001 ;;;; -;;;; $Id: primitive-functions.lisp,v 1.3 2004/02/05 14:46:24 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.4 2004/02/26 13:43:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -437,8 +437,8 @@ (defun malloc-initialize (buffer-start buffer-size) "BUFFER-START: the (fixnum) 4K address. BUFFER-SIZE: The size in 4K units." - (check-type buffer-start integer); unsigned-byte) - (check-type buffer-size integer); unsigned-byte) + (check-type buffer-start integer) + (check-type buffer-size integer) (with-inline-assembly (:returns :nothing) (:compile-form (:result-mode :eax) buffer-start) (:shll #.(cl:- 12 movitz::+movitz-fixnum-shift+) :eax)

1 0

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

26 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv12266 Modified Files: typep.lisp Log Message: Added vector-u32 type. Date: Thu Feb 26 08:43:01 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.2 movitz/losp/muerte/typep.lisp:1.3 --- movitz/losp/muerte/typep.lisp:1.2 Mon Jan 19 06:23:47 2004 +++ movitz/losp/muerte/typep.lisp Thu Feb 26 08:43:00 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.2 2004/01/19 11:23:47 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.3 2004/02/26 13:43:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -151,7 +151,7 @@ (:cmpw ,type-code (:eax ,(bt:slot-offset 'movitz::movitz-funobj 'movitz::type))) (:branch-when :boolean-zf=1) - function-typep-failed) + function-typep-failed) (do-case (t :boolean-zf=1 :labels (function-typep-failed)) (:compile-form (:result-mode :eax) ,object) (:leal (:eax ,(- (movitz::tag :other))) :ecx) @@ -159,11 +159,11 @@ (:jne 'function-typep-failed) (:cmpw ,type-code (:eax ,(bt:slot-offset 'movitz::movitz-funobj 'movitz::type))) - function-typep-failed))))) + function-typep-failed))))) (if (not (movitz:movitz-constantp type-specifier env)) form (let ((type (movitz::translate-program (movitz::eval-form type-specifier env) - :muerte.cl :cl))) + :muerte.cl :cl))) (or (cond ((symbolp type) (case type @@ -201,7 +201,7 @@ `(with-inline-assembly (:returns :boolean-zf=0) (:compile-form (:result-mode :eax) ,object) (:leal (:eax -1) :ecx) - (:testb 7 :cl))) ; tag 1 is not atom. + (:testb 7 :cl))) ; tag 1 is not atom. (character `(with-inline-assembly (:returns :boolean-zf=1) (:compile-form (:result-mode :eax) ,object) @@ -218,6 +218,8 @@ (make-vector-typep :u8)) (vector-u16 (make-vector-typep :u16)) + (vector-u32 + (make-vector-typep :u32)) (run-time-context (make-other-typep :run-time-context)) (structure-object

1 0

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

26 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11667 Modified Files: los-closette.lisp Log Message: Added function funcallable-instance-function, and removed some warnings. Date: Thu Feb 26 06:40:44 2004 Author: ffjeld Index: movitz/losp/muerte/los-closette.lisp diff -u movitz/losp/muerte/los-closette.lisp:1.4 movitz/losp/muerte/los-closette.lisp:1.5 --- movitz/losp/muerte/los-closette.lisp:1.4 Wed Feb 18 09:40:58 2004 +++ movitz/losp/muerte/los-closette.lisp Thu Feb 26 06:40:44 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Jul 23 14:29:10 2002 ;;;; -;;;; $Id: los-closette.lisp,v 1.4 2004/02/18 14:40:58 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.5 2004/02/26 11:40:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -186,9 +186,13 @@ (check-type funcallable-instance standard-gf-instance) (check-type function function) (setf-movitz-accessor (funcallable-instance movitz-funobj-standard-gf standard-gf-function) - function) + function) (values)) +(defun funcallable-instance-function (funcallable-instance) + (check-type funcallable-instance standard-gf-instance) + (movitz-accessor funcallable-instance movitz-funobj-standard-gf standard-gf-function)) + (defun instance-slot-p (slot) (eq (slot-definition-allocation slot) :instance)) @@ -535,9 +539,9 @@ (push (cons (car active-specializers) emfun) (std-gf-classes-to-emf-table gf)) - (when (< 5 (length (std-gf-classes-to-emf-table gf))) - (warn "method cache size for ~S: ~D" - gf (length (std-gf-classes-to-emf-table gf)))) +;;; (when (< 5 (length (std-gf-classes-to-emf-table gf))) +;;; (warn "method cache size for ~S: ~D" +;;; gf (length (std-gf-classes-to-emf-table gf)))) (apply emfun (car arg0-list) optional-args)))) (defun cached-lookup-failed-map10 (gf &rest arg01-class01-optionals) @@ -560,9 +564,9 @@ (push (cons (cadr active-specializers) emfun) (std-gf-classes-to-emf-table gf)) - (when (< 4 (length (std-gf-classes-to-emf-table gf))) - (warn "method cache size for ~S: ~D" - gf (length (std-gf-classes-to-emf-table gf)))) +;;; (when (< 4 (length (std-gf-classes-to-emf-table gf))) +;;; (warn "method cache size for ~S: ~D" +;;; gf (length (std-gf-classes-to-emf-table gf)))) (apply emfun (car arg01-list) (cadr arg01-list) optional-args)))) (defun cached-lookup-failed-map11 (gf &rest args) @@ -573,9 +577,9 @@ (second active-specializers) emfun) (std-gf-classes-to-emf-table gf)) - (when (< 4 (length (std-gf-classes-to-emf-table gf))) - (warn "method cache size for ~S: ~D" - gf (length (std-gf-classes-to-emf-table gf)))) +;;; (when (< 4 (length (std-gf-classes-to-emf-table gf))) +;;; (warn "method cache size for ~S: ~D" +;;; gf (length (std-gf-classes-to-emf-table gf)))) (apply emfun args))) (defun cached-lookup-failed-map101 (gf &rest args) @@ -586,9 +590,9 @@ (third active-specializers) emfun) (std-gf-classes-to-emf-table gf)) - (when (< 4 (length (std-gf-classes-to-emf-table gf))) - (warn "method cache size for ~S: ~D" - gf (length (std-gf-classes-to-emf-table gf)))) +;;; (when (< 4 (length (std-gf-classes-to-emf-table gf))) +;;; (warn "method cache size for ~S: ~D" +;;; gf (length (std-gf-classes-to-emf-table gf)))) (apply emfun args))) (defun cached-lookup-failed-map111 (gf &rest args) @@ -600,9 +604,9 @@ (third active-specializers) emfun) (std-gf-classes-to-emf-table gf)) - (when (< 4 (length (std-gf-classes-to-emf-table gf))) - (warn "method cache size for ~S: ~D" - gf (length (std-gf-classes-to-emf-table gf)))) +;;; (when (< 4 (length (std-gf-classes-to-emf-table gf))) +;;; (warn "method cache size for ~S: ~D" +;;; gf (length (std-gf-classes-to-emf-table gf)))) (apply emfun args))) (defun cached-lookup-failed-map1111 (gf &rest args) @@ -615,9 +619,9 @@ (fourth active-specializers) emfun) (std-gf-classes-to-emf-table gf)) - (when (< 4 (length (std-gf-classes-to-emf-table gf))) - (warn "method cache size for ~S: ~D" - gf (length (std-gf-classes-to-emf-table gf)))) +;;; (when (< 4 (length (std-gf-classes-to-emf-table gf))) +;;; (warn "method cache size for ~S: ~D" +;;; gf (length (std-gf-classes-to-emf-table gf)))) (apply emfun args))) (defun discriminating-function-map1-no-eqls (&edx gf arg0 &rest optional-args)

1 0

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

26 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv3553 Modified Files: misc.lisp Log Message: Added hand-written assembly version of checksum-octets for u8 vectors. This increases the speed of IP quite a bit. Date: Thu Feb 26 06:40:01 2004 Author: ffjeld Index: movitz/losp/lib/misc.lisp diff -u movitz/losp/lib/misc.lisp:1.3 movitz/losp/lib/misc.lisp:1.4 --- movitz/losp/lib/misc.lisp:1.3 Mon Jan 19 06:23:44 2004 +++ movitz/losp/lib/misc.lisp Thu Feb 26 06:40:00 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.3 2004/01/19 11:23:44 ffjeld Exp $ +;;;; $Id: misc.lisp,v 1.4 2004/02/26 11:40:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -21,21 +21,45 @@ (defun checksum-octets (packet &optional (start 0) (end (length packet))) "Generate sum of 16-bit big-endian words for a sequence of octets." - (cond - ((or (and (evenp start) (evenp end)) - (and (oddp start) (oddp end))) - (loop for i of-type (unsigned-byte 16) from start below end by 2 - sum (aref packet i) into hi of-type (unsigned-byte 24) - sum (aref packet (1+ i)) into lo of-type (unsigned-byte 24) - finally (return (+ lo (ash hi 8))))) - (t (+ (loop for i of-type (unsigned-byte 16) from start below (1- end) by 2 - sum (aref packet i) into hi - sum (aref packet (1+ i)) into lo - finally (return (+ lo (ash hi 8)))) - (ash (aref packet (1- end)) 8)))) - #+ignore - (with-inline-assembly (:returns :eax) - (:load-lexical))) + (typecase packet + (muerte:vector-u8 + (assert (<= 0 start end (length packet))) + (with-inline-assembly (:returns :ebx) + (:compile-form (:result-mode :eax) packet) + (:compile-form (:result-mode :ebx) start) + (:compile-form (:result-mode :edx) end) + (:movl :ebx :ecx) ; ecx = start + (:subl :ebx :edx) ; edx = (- end start) + (:movl 0 :ebx) + (:jz 'end-checksum-loop) + (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) + (:xorl :esi :esi) + checksum-loop + (:movw (:eax 2 :ecx) :bx) + (:xchgb :bl :bh) + (:addl :ebx :esi) + (:addl 2 :ecx) + (:subl #.(cl:* 2 movitz:+movitz-fixnum-factor+) :edx) + (:jnbe 'checksum-loop) + (:movw :si :bx) + (:shrl 16 :esi) + (:addw :si :bx) + (:movl (:ebp -4) :esi) + end-checksum-loop + (:shll #.movitz:+movitz-fixnum-shift+ :ebx))) + (t (muerte:with-subvector-accessor (packet-ref packet start end) + (cond + ((or (and (evenp start) (evenp end)) + (and (oddp start) (oddp end))) + (loop for i of-type (unsigned-byte 16) from start below end by 2 + sum (packet-ref i) into hi of-type (unsigned-byte 24) + sum (packet-ref (1+ i)) into lo of-type (unsigned-byte 24) + finally (return (+ lo (ash hi 8))))) + (t (+ (loop for i of-type (unsigned-byte 16) from start below (1- end) by 2 + sum (packet-ref i) into hi + sum (packet-ref (1+ i)) into lo + finally (return (+ lo (ash hi 8)))) + (ash (packet-ref (1- end)) 8)))))))) (defstruct (counter-u32 (:constructor make-counter-u32-object)) lo hi)

1 0

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

26 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv15456 Modified Files: packages.lisp Log Message: Added some symbols. Date: Thu Feb 26 06:31:31 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.5 movitz/packages.lisp:1.6 --- movitz/packages.lisp:1.5 Tue Feb 10 13:06:30 2004 +++ movitz/packages.lisp Thu Feb 26 06:31:31 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.5 2004/02/10 18:06:30 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.6 2004/02/26 11:31:31 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1151,6 +1151,10 @@ find-restart-from-context map-active-restarts with-basic-restart + + vector-u8 + vector-u16 + vector-u32 make-funobj funobj-type @@ -1240,6 +1244,7 @@ (:export #:create-image #:dump-image + #:other-type-byte #:parse-docstring-and-declarations #:global-constant-offset #:tag #:tag-name

1 0

[movitz-cvs] CVS update: movitz/losp/lib/net/ethernet.lisp
by Frode Vatvedt Fjeld 26 Feb '04

26 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/lib/net In directory common-lisp.net:/tmp/cvs-serv8022 Modified Files: ethernet.lisp Log Message: The +min-ethernet-frame-size+ should be 60, I believe, since we're not counting the CRC and preamble (?). 60 seems to be consistent with everyone else, anyway. Date: Thu Feb 26 06:30:08 2004 Author: ffjeld Index: movitz/losp/lib/net/ethernet.lisp diff -u movitz/losp/lib/net/ethernet.lisp:1.3 movitz/losp/lib/net/ethernet.lisp:1.4 --- movitz/losp/lib/net/ethernet.lisp:1.3 Mon Jan 19 06:23:46 2004 +++ movitz/losp/lib/net/ethernet.lisp Thu Feb 26 06:30:07 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.3 2004/01/19 11:23:46 ffjeld Exp $ +;;;; $Id: ethernet.lisp,v 1.4 2004/02/26 11:30:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -52,7 +52,7 @@ (in-package muerte.ethernet) (defconstant +max-ethernet-frame-size+ 1514) ; sans preamble and postable. -(defconstant +min-ethernet-frame-size+ 64) +(defconstant +min-ethernet-frame-size+ 60) ; except crc. (defconstant +broadcast-address+ #(#xff #xff #xff #xff #xff #xff)) (defconstant +source-mac+ 6)

1 0