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

[movitz-cvs] CVS update: movitz/losp/muerte/eval.lisp
by Frode Vatvedt Fjeld 22 Oct '04

22 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3953 Modified Files: eval.lisp Log Message: Added interpretation of the catch special operator. Date: Fri Oct 22 14:33:28 2004 Author: ffjeld Index: movitz/losp/muerte/eval.lisp diff -u movitz/losp/muerte/eval.lisp:1.13 movitz/losp/muerte/eval.lisp:1.14 --- movitz/losp/muerte/eval.lisp:1.13 Fri Oct 22 14:31:34 2004 +++ movitz/losp/muerte/eval.lisp Fri Oct 22 14:33:27 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 19 21:15:12 2001 ;;;; -;;;; $Id: eval.lisp,v 1.13 2004/10/22 12:31:34 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.14 2004/10/22 12:33:27 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -99,6 +99,9 @@ (make-destructuring-env (cadr form) (eval-form (caddr form) env) env))) + ((catch) + (catch (eval-form (second form) env) + (eval-progn (cddr form) env))) ((throw) (throw (eval-form (second form) env) (eval-form (third form) env)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/eval.lisp
by Frode Vatvedt Fjeld 22 Oct '04

22 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3927 Modified Files: eval.lisp Log Message: Added parse-docstring-declarations-and-body, and made the parsing of lambda-forms use it, so that e.g. (lambda (..) "docstring" (declare ..) ..) should now work in eval. Date: Fri Oct 22 14:31:34 2004 Author: ffjeld Index: movitz/losp/muerte/eval.lisp diff -u movitz/losp/muerte/eval.lisp:1.12 movitz/losp/muerte/eval.lisp:1.13 --- movitz/losp/muerte/eval.lisp:1.12 Thu Oct 21 22:45:48 2004 +++ movitz/losp/muerte/eval.lisp Fri Oct 22 14:31:34 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 19 21:15:12 2001 ;;;; -;;;; $Id: eval.lisp,v 1.12 2004/10/21 20:45:48 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.13 2004/10/22 12:31:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -152,6 +152,16 @@ (dolist (d (cdar p)) (push d declarations)))) +(defun parse-docstring-declarations-and-body (forms) + "From the list of FORMS, return first the list of non-declaration forms, ~ +second the list of declaration-specifiers, third any docstring." + (if (or (not (cdr forms)) + (not (stringp (car forms)))) + (parse-declarations-and-body forms) + (multiple-value-call #'values + (parse-declarations-and-body (cdr forms)) + (car forms)))) + (defun declared-special-p (var declarations) (dolist (d declarations nil) (when (and (consp d) @@ -315,7 +325,7 @@ (symbol-function (lookup-setf-function (second function-name)))) ((lambda) (let ((lambda-list (cadr function-name)) - (lambda-body (cddr function-name))) + (lambda-body (parse-docstring-declarations-and-body (cddr function-name)))) (install-funobj-name :anonymous-lambda (lambda (&rest args) (declare (dynamic-extent args))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/scavenge.lisp
by Frode Vatvedt Fjeld 22 Oct '04

22 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv17455 Modified Files: scavenge.lisp Log Message: Remove the *scan* variable that was used for debugging before. Also improve detection of non-pointers in the scanner. Date: Fri Oct 22 09:57:25 2004 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.33 movitz/losp/muerte/scavenge.lisp:1.34 --- movitz/losp/muerte/scavenge.lisp:1.33 Mon Oct 11 15:53:25 2004 +++ movitz/losp/muerte/scavenge.lisp Fri Oct 22 09:57:25 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Mar 29 14:54:08 2004 ;;;; -;;;; $Id: scavenge.lisp,v 1.33 2004/10/11 13:53:25 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.34 2004/10/22 07:57:25 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -48,12 +48,13 @@ ((>= scan end-location)) (with-simple-restart (continue-map-heap-words "Continue map-heap-words at location ~S." (1+ scan)) - (let ((*scan* scan) - (x (memref scan 0 :type :unsigned-byte16))) - (declare (special *scan*)) + (let ((x (memref scan 0 :type :unsigned-byte16)) + (x2 (memref scan 1 :type :unsigned-byte16))) (when verbose (format *terminal-io* " [at ~S: ~S]" scan x)) (cond + ((or (and (= 0 x2) (= 2 x)) + (and (= #xffff x2) (= #xfffe x)))) ((let ((tag (ldb (byte 3 0) x))) (or (= tag #.(movitz:tag :null)) (= tag #.(movitz:tag :even-fixnum))

1 0

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

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/lib/net In directory common-lisp.net:/tmp/cvs-serv4654 Modified Files: ip4.lisp Log Message: *** empty log message *** Date: Thu Oct 21 22:52:11 2004 Author: ffjeld Index: movitz/losp/lib/net/ip4.lisp diff -u movitz/losp/lib/net/ip4.lisp:1.6 movitz/losp/lib/net/ip4.lisp:1.7 --- movitz/losp/lib/net/ip4.lisp:1.6 Thu Apr 1 19:29:44 2004 +++ movitz/losp/lib/net/ip4.lisp Thu Oct 21 22:52:11 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.6 2004/04/01 17:29:44 ffjeld Exp $ +;;;; $Id: ip4.lisp,v 1.7 2004/10/21 20:52:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -252,10 +252,27 @@ ;;;; UDP +(defun udp-src-port (packet &optional (start 34)) + (bvref-u16 packet start 0)) + +(defun (setf udp-src-port) (value packet &optional (start 34)) + (setf (bvref-u16 packet start 0) value)) + +(defun udp-dst-port (packet &optional (start 34)) + (bvref-u16 packet start 2)) + +(defun udp-length (packet &optional (start 34)) + (bvref-u16 packet start 4)) + +(defun udp-checksum (packet &optional (start 34)) + (bvref-u16 packet start 6)) + + (defmethod udp-input ((stack ip4-stack) packet ip-start udp-start) (warn "Got UDP packet of length ~D from ~@v/ip4:pprint-ip4/." (- (length packet) udp-start) ip-start packet)) + ;;;; TCP

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/segments.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4631 Modified Files: segments.lisp Log Message: Add operator control-register to read the x86 CPU's control registers. Date: Thu Oct 21 22:51:13 2004 Author: ffjeld Index: movitz/losp/muerte/segments.lisp diff -u movitz/losp/muerte/segments.lisp:1.3 movitz/losp/muerte/segments.lisp:1.4 --- movitz/losp/muerte/segments.lisp:1.3 Tue Apr 6 16:32:00 2004 +++ movitz/losp/muerte/segments.lisp Thu Oct 21 22:51:13 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu May 8 14:25:06 2003 ;;;; -;;;; $Id: segments.lisp,v 1.3 2004/04/06 14:32:00 ffjeld Exp $ +;;;; $Id: segments.lisp,v 1.4 2004/10/21 20:51:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -90,6 +90,16 @@ (:lgdt (:ecx)))) ;;; + +(defun control-register (name) + (macrolet ((creg (reg) + `(with-inline-assembly (:returns :untagged-fixnum-ecx) + (:movcr ,reg :ecx)))) + (ecase name + (:cr0 (creg :cr0)) + (:cr2 (creg :cr2)) + (:cr3 (creg :cr3)) + (:cr4 (creg :cr4))))) (defun control-register-lo12 (name) "Return the low 12 bits of an x86 control register, such as :cr0 or :cr1."

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/packages.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4605 Modified Files: packages.lisp Log Message: Don't use movitz-accessor. Date: Thu Oct 21 22:50:19 2004 Author: ffjeld Index: movitz/losp/muerte/packages.lisp diff -u movitz/losp/muerte/packages.lisp:1.4 movitz/losp/muerte/packages.lisp:1.5 --- movitz/losp/muerte/packages.lisp:1.4 Sat Sep 25 17:36:16 2004 +++ movitz/losp/muerte/packages.lisp Thu Oct 21 22:50:19 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Aug 30 15:19:43 2001 ;;;; -;;;; $Id: packages.lisp,v 1.4 2004/09/25 15:36:16 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.5 2004/10/21 20:50:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -82,14 +82,14 @@ (unless status (let ((name (subseq name start end))) (map-into name key name) - (setf symbol (make-symbol name)) + (setf symbol (%create-symbol name package)) (when (eq package (find-package :keyword)) (setf (symbol-flags symbol) #.(bt:enum-value 'movitz::movitz-symbol-flags '(:constant-variable))) (setf (symbol-value symbol) symbol)))) (unless (symbol-package symbol) - (setf-movitz-accessor (symbol movitz-symbol package) package)) + (setf (memref symbol (movitz-type-slot-offset 'movitz-symbol 'package)) package)) (unless status (if (eq package (find-package :keyword)) (setf (gethash (symbol-name symbol) (package-object-external-symbols package)) symbol)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/memref.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4581 Modified Files: memref.lisp Log Message: Added (setf (memref :unsigned-byte14)) Date: Thu Oct 21 22:47:27 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.35 movitz/losp/muerte/memref.lisp:1.36 --- movitz/losp/muerte/memref.lisp:1.35 Thu Oct 21 18:31:35 2004 +++ movitz/losp/muerte/memref.lisp Thu Oct 21 22:47:26 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 6 21:25:49 2001 ;;;; -;;;; $Id: memref.lisp,v 1.35 2004/10/21 16:31:35 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.36 2004/10/21 20:47:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -634,6 +634,37 @@ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) (:movb :ah (:ebx :ecx))) ,value-var))))) + (:unsigned-byte14 + (cond + ((and (movitz:movitz-constantp offset env) + (movitz:movitz-constantp index env)) + `(with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ebx) ,value ,object) + (:andl ,(mask-field (byte 14 2) -1) :eax) + (:movw :ax (:ebx ,(+ (movitz:movitz-eval offset env) + (* 4 (movitz:movitz-eval index env))))))) + ((movitz:movitz-constantp offset env) + (let ((value-var (gensym "memref-value-"))) + `(let ((,value-var ,value)) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:ebx :ecx) ,object ,index) + (:load-lexical (:lexical-binding ,value-var) :eax) + ,@(when (plusp (- movitz:+movitz-fixnum-shift+ 2)) + `((:sarl ,(- movitz:+movitz-fixnum-shift+ 2)) :ecx)) + (:andl ,(mask-field (byte 14 2) -1) :eax) + (:movw :ax (:ebx :ecx ,(movitz:movitz-eval offset env))))))) + (t (let ((value-var (gensym "memref-value-")) + (object-var (gensym "memref-object-"))) + `(let ((,value-var ,value) (,object-var ,object)) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,offset ,index) + (:load-lexical (:lexical-binding ,value-var) :eax) + ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2)) + `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ebx)) + (:addl :ebx :ecx) ; index += offset + (:load-lexical (:lexical-binding ,object-var) :ebx) + (:andl ,(mask-field (byte 14 2) -1) :eax) + (:movl :ax (:ebx :ecx)))))))) (:lisp (let* ((localp (movitz:movitz-eval localp env)) (prefixes (if localp

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/eval.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4400 Modified Files: eval.lisp Log Message: Add eval of unwind-protect. Date: Thu Oct 21 22:45:48 2004 Author: ffjeld Index: movitz/losp/muerte/eval.lisp diff -u movitz/losp/muerte/eval.lisp:1.11 movitz/losp/muerte/eval.lisp:1.12 --- movitz/losp/muerte/eval.lisp:1.11 Tue Sep 21 15:02:57 2004 +++ movitz/losp/muerte/eval.lisp Thu Oct 21 22:45:48 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 19 21:15:12 2001 ;;;; -;;;; $Id: eval.lisp,v 1.11 2004/09/21 13:02:57 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.12 2004/10/21 20:45:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -102,6 +102,9 @@ ((throw) (throw (eval-form (second form) env) (eval-form (third form) env))) + ((unwind-protect) + (unwind-protect (eval-form (second form) env) + (eval-progn (cddr form) env))) (t (eval-funcall form env)))) (defun eval-progn (forms env)

1 0

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

21 Oct '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3657 Modified Files: special-operators-cl.lisp Log Message: In go, don't check if dynamic-unwind-next finds an unwind-protect or not, since there's noe sense in doing that. Date: Thu Oct 21 22:44:52 2004 Author: ffjeld Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.27 movitz/special-operators-cl.lisp:1.28 --- movitz/special-operators-cl.lisp:1.27 Mon Oct 11 15:48:07 2004 +++ movitz/special-operators-cl.lisp Thu Oct 21 22:44:52 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.27 2004/10/11 13:48:07 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.28 2004/10/21 20:44:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -740,7 +740,6 @@ ;; Now, install correct jumper within tagbody as target. `((:addl ,(* 4 label-id) (:edx 8)))) (:globally (:call (:edi (:edi-offset dynamic-unwind-next)))) - (:jnc '(:sub-program () (:int 63))) ;; have next-continuation in EAX, final-continuation in EDX (:locally (:movl :edx (:edi (:edi-offset raw-scratch0)))) ; final continuation (:locally (:movl :esi (:edi (:edi-offset scratch1))))

1 0

[movitz-cvs] CVS update: movitz/storage-types.lisp
by Frode Vatvedt Fjeld 21 Oct '04

21 Oct '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3638 Modified Files: storage-types.lisp Log Message: Somewhat improved support for movitz-ratio objects. Date: Thu Oct 21 22:42:51 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.42 movitz/storage-types.lisp:1.43 --- movitz/storage-types.lisp:1.42 Tue Sep 21 15:04:02 2004 +++ movitz/storage-types.lisp Thu Oct 21 22:42:51 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: storage-types.lisp,v 1.42 2004/09/21 13:04:02 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.43 2004/10/21 20:42:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -73,11 +73,11 @@ :old-vector #x1a :basic-vector #x22 + :defstruct #x2a :funobj #x3a :bignum #x4a :ratio #x52 :complex #x5a - :defstruct #x2a :std-instance #x40 :run-time-context #x50 :illegal #x13 @@ -1237,6 +1237,7 @@ (assert (= (movitz-bignum-value object) lisp-object)) object) + (defmethod read-binary-record ((type-name (eql 'movitz-bignum)) stream &key) (let* ((header (call-next-method)) (x (loop for i from 0 below (movitz-bignum-length header) @@ -1280,3 +1281,14 @@ (setf (slot-value obj 'numerator) (numerator value) (slot-value obj 'denominator) (denominator value)) (call-next-method))) + + +(defmethod update-movitz-object ((object movitz-ratio) lisp-object) + (assert (= (movitz-ratio-value object) lisp-object)) + object) + +(defmethod print-object ((x movitz-ratio) stream) + (print-unreadable-object (x stream :type t) + (format stream "~D" (slot-value x 'value))) + x) +

1 0