movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[movitz-cvs] CVS movitz
by ffjeld 09 Jul '08

09 Jul '08

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv15867 Modified Files: image.lisp Log Message: Improved paranoia in intern-movitz-symbol. --- /project/movitz/cvsroot/movitz/image.lisp 2008/04/27 19:18:16 1.124 +++ /project/movitz/cvsroot/movitz/image.lisp 2008/07/09 19:54:56 1.125 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.124 2008/04/27 19:18:16 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.125 2008/07/09 19:54:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1139,7 +1139,13 @@ sum))))) (defun intern-movitz-symbol (name) - (assert (not (eq (symbol-package name) (find-package :common-lisp))) + (assert (not (member (symbol-package name) + '(:common-lisp :movitz) + :key #'find-package)) + (name) + "Trying to movitz-intern a symbol in the ~A package: ~S" (symbol-package name) name) + (assert (not (eq (symbol-package name) + (find-package :movitz))) (name) "Trying to movitz-intern a symbol in the Common-Lisp package: ~S" name) (or (gethash name (image-oblist *image*))

1 0

[movitz-cvs] CVS tftp-new.lisp
by aantoniadis 28 Jun '08

28 Jun '08

Update of /project/movitz/cvsroot/tftp-new.lisp In directory clnet:/tmp/cvs-serv27249 Log Message: Added tftp-new.lisp: my attempt to rewrite tftp.lisp Status: Vendor Tag: revision1 Release Tags: start N tftp-new.lisp/ext2fs.lisp N tftp-new.lisp/fs.lisp N tftp-new.lisp/harddisk.lisp N tftp-new.lisp/packet.lisp N tftp-new.lisp/partitions.lisp N tftp-new.lisp/tftp-new.lisp N tftp-new.lisp/vmware-vga.lisp No conflicts created by this import

1 0

[movitz-cvs] CVS movitz/losp/lib/net
by aantoniadis 13 Jun '08

13 Jun '08

Update of /project/movitz/cvsroot/movitz/losp/lib/net In directory clnet:/tmp/cvs-serv585 Modified Files: ip6.lisp Log Message: minor fixes --- /project/movitz/cvsroot/movitz/losp/lib/net/ip6.lisp 2004/11/24 16:21:42 1.7 +++ /project/movitz/cvsroot/movitz/losp/lib/net/ip6.lisp 2008/06/13 16:25:31 1.8 @@ -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.7 2004/11/24 16:21:42 ffjeld Exp $ +;;;; $Id: ip6.lisp,v 1.8 2008/06/13 16:25:31 aantoniadis Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -584,7 +584,7 @@ (format t "~&Solicited-node address: ~/ip6:pprint-ip6/~%" solicited-node-address) (setf (look-up-neighbor neighbor-cache link-local-address :start 0) (mac-address ne2000)) - ;; (format t "~&Local neighbor lookup: ~S.~%" (look-up-neighbor neighbor-cache link-local-address)) +; (format t "~&Local neighbor lookup: ~S.~%" (look-up-neighbor neighbor-cache link-local-address)) ;;comment this out (let ((packet-pool (make-array 16 :fill-pointer 0))) (flet ((get-packet (packet-pool) (cond @@ -704,7 +704,7 @@ (when (= (udp-header-checksum request) (udp-checksum request)) (when (= 1 (udp-header-destination request)) - (setf (muerte:vector-element-type request) + (setf (muerte::vector-element-type request) #.(bt:enum-value 'movitz::movitz-vector-element-type :character)) (let (seqno last-seqno (poff (+ 8 offset))) (multiple-value-setq (seqno poff) @@ -727,7 +727,7 @@ (t (warn "Eval-UDP lost packet ~D." eval-prev-seqno) (setf (fill-pointer eval-buffer) 0 eval-prev-seqno 0))) - (setf (muerte:vector-element-type request) + (setf (muerte::vector-element-type request) #.(bt:enum-value 'movitz::movitz-vector-element-type :u8)))) #+ignore (warn "UDP src ~D, dst ~D, len ~D"

1 0

[movitz-cvs] CVS movitz/losp/lib/net
by aantoniadis 13 Jun '08

13 Jun '08

Update of /project/movitz/cvsroot/movitz/losp/lib/net In directory clnet:/tmp/cvs-serv32554 Modified Files: arp.lisp Log Message: Added init-device, now test-arp can find a device --- /project/movitz/cvsroot/movitz/losp/lib/net/arp.lisp 2005/06/05 01:08:21 1.10 +++ /project/movitz/cvsroot/movitz/losp/lib/net/arp.lisp 2008/06/13 16:21:18 1.11 @@ -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.10 2005/06/05 01:08:21 ffjeld Exp $ +;;;; $Id: arp.lisp,v 1.11 2008/06/13 16:21:18 aantoniadis Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -97,22 +97,33 @@ (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*)) + + +(defun device-init () + (let ((ethernet + (some #'muerte.x86-pc.ne2k:ne2k-probe + muerte.x86-pc.ne2k:*ne2k-probe-addresses*))) + (assert ethernet ethernet "No ethernet device.") + ethernet)) + + +(defun test-arp (&optional (ip #(192 168 178 1)) (my-ip #(147 52 192 157)) + (device (device-init))) (loop with ip = (ip4-address ip) and my-ip = (ip4-address my-ip) for packet = (muerte.ethernet:receive device) - with i = 9999 - do (when (= (incf i) 10000) - (setf i 0) - (transmit device - (format-ethernet-packet (format-arp-request nil +arp-op-request+ - my-ip (mac-address device) ip) - (mac-address device) - muerte.ethernet:+broadcast-address+ - muerte.ethernet:+ether-type-arp+))) + with i = 9999 ;;this way we go into the do in the first iteration + do + (when (= (incf i) 10000) + (setf i 0) + (transmit device + (format-ethernet-packet (format-arp-request nil +arp-op-request+ + my-ip (mac-address device) ip) + (mac-address device) + muerte.ethernet:+broadcast-address+ + muerte.ethernet:+ether-type-arp+))) until (or (muerte.x86-pc.keyboard:poll-char) + ; (format t "~a~%" packet) ;;mine (when (and packet (or (eq +ether-type-arp+ (ether-type packet)) (warn "not type"))

1 0

[movitz-cvs] CVS movitz/losp/lib/net
by ffjeld 12 Jun '08

12 Jun '08

Update of /project/movitz/cvsroot/movitz/losp/lib/net In directory clnet:/tmp/cvs-serv20648 Modified Files: ethernet.lisp Log Message: Fix missing keyword args in format-ethernet-packet. --- /project/movitz/cvsroot/movitz/losp/lib/net/ethernet.lisp 2005/08/31 22:35:10 1.11 +++ /project/movitz/cvsroot/movitz/losp/lib/net/ethernet.lisp 2008/06/12 12:54:52 1.12 @@ -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.11 2005/08/31 22:35:10 ffjeld Exp $ +;;;; $Id: ethernet.lisp,v 1.12 2008/06/12 12:54:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -166,8 +166,8 @@ (defun format-ethernet-packet (packet source destination type &key (start 0) (source-start 0) (destination-start 0)) - (setf (ether-source packet start source-start) source - (ether-destination packet start destination-start) destination + (setf (ether-source packet start :source-start source-start) source + (ether-destination packet start :destination-start destination-start) destination (ether-type packet start) type) packet)

1 0

[movitz-cvs] CVS movitz/ide
by ffjeld 07 Jun '08

07 Jun '08

Update of /project/movitz/cvsroot/movitz/ide In directory clnet:/tmp/cvs-serv19205 Modified Files: movitz-slime.el Log Message: Patch from Yoni Rabkin. --- /project/movitz/cvsroot/movitz/ide/movitz-slime.el 2007/06/23 13:40:02 1.7 +++ /project/movitz/cvsroot/movitz/ide/movitz-slime.el 2008/06/07 13:00:08 1.8 @@ -61,7 +61,7 @@ (defcustom movitz-mode-image-file nil "*Movitz image file. -This is set by `movitz-dump-image' and can also be preinitialized in +This is set by `movitz-dump' and can also be preinitialized in your init file." :type 'string :group 'movitz) @@ -172,43 +172,24 @@ (lambda (result) (message "Movitz args for %s: %s." string result)))))) - - - -(defun movitz-dump-image (filename) - "Dump the current image to FILENAME." - (interactive (list (if (and (null current-prefix-arg) - movitz-mode-image-file) - movitz-mode-image-file - (let ((filename (read-file-name "Image file: "))) - (setq movitz-mode-image-file filename) - filename)))) - (message "Dumping..") - (slime-eval-async `(movitz.ide:dump-image ,filename) - (lambda (_) (message "Finished.")))) - - -(defun movitz-dump-image-and-qemu (filename) - "Dump the current image to FILENAME." - (interactive (list (if (and (null current-prefix-arg) - movitz-mode-image-file) - movitz-mode-image-file - (let ((filename (expand-file-name (read-file-name "Image file: ")))) - (setq movitz-mode-image-file filename) - filename)))) - (lexical-let ((filename filename)) - (message "Dumping '%s'.." filename) - (slime-eval-async `(movitz.ide:dump-image ,(file-name-nondirectory filename)) - (lambda (_) - (message "Dumping '%s'..done, starting qemu" filename) - (call-process movitz-mode-qemu-binary-path - nil 0 nil - "-s" - "-L" movitz-mode-qemu-directory - "-fda" filename - "-boot" "a"))))) - - +(defun movitz-dump (&optional run-emulator) + "Dump the current image to a file. +If RUN-EMULATOR is non-nil, call an emulator on the resulting file." + (when (not movitz-mode-image-file) + (setq movitz-mode-image-file (expand-file-name (read-file-name "Image file: ")))) + (message "Dumping '%s'.." movitz-mode-image-file) + (slime-eval-async `(movitz.ide:dump-image ,(file-name-nondirectory movitz-mode-image-file)) + (if run-emulator + ;; choose emulator here, currently only qemu + (lambda (_) + (message "Dumping '%s'..done, starting qemu" movitz-mode-image-file) + (call-process movitz-mode-qemu-binary-path + nil 0 nil + "-s" + "-L" movitz-mode-qemu-directory + "-fda" movitz-mode-image-file + "-boot" "a")) + (lambda (_) (message "Dumping '%s'..done" movitz-mode-image-file))))) (defun movitz-defun-name-and-type () (interactive) @@ -268,8 +249,8 @@ (defconst movitz-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map text-mode-map) - (define-key map (kbd "C-c d") 'movitz-dump-image) - (define-key map (kbd "C-c C-d") 'movitz-dump-image-and-qemu) + (define-key map (kbd "C-c d") '(lambda () (interactive) (movitz-dump))) + (define-key map (kbd "C-c C-d") '(lambda () (interactive) (movitz-dump t))) (define-key map (kbd "C-c C-v") 'movitz-disassemble-defun) (define-key map (kbd "C-c m") 'movitz-macroexpand) (define-key map (kbd "C-c a") 'movitz-arglist)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 27 Apr '08

27 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv6432 Modified Files: typep.lisp Log Message: Add bit-vector-p. --- /project/movitz/cvsroot/movitz/losp/muerte/typep.lisp 2008/04/21 19:43:57 1.59 +++ /project/movitz/cvsroot/movitz/losp/muerte/typep.lisp 2008/04/27 19:45:43 1.60 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.59 2008/04/21 19:43:57 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.60 2008/04/27 19:45:43 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -601,6 +601,8 @@ (or (eq xdim '*) (eql xdim adim))) dimension-spec (array-dimensions x))))))) +(defun bit-vector-p (x) + (typep x 'bit-vector)) (defun arrayp (x) (typep x 'array))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 27 Apr '08

27 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv6366 Modified Files: strings.lisp Log Message: Fix bug in string> & friends. --- /project/movitz/cvsroot/movitz/losp/muerte/strings.lisp 2008/04/21 19:43:30 1.5 +++ /project/movitz/cvsroot/movitz/losp/muerte/strings.lisp 2008/04/27 19:45:33 1.6 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 19 17:05:25 2001 ;;;; -;;;; $Id: strings.lisp,v 1.5 2008/04/21 19:43:30 ffjeld Exp $ +;;;; $Id: strings.lisp,v 1.6 2008/04/27 19:45:33 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -52,7 +52,11 @@ (return nil))))) (defun string-not-equal (string1 string2 &key (start1 0) end1 (start2 0) end2) - (not (string-equal string1 string2 :start1 start1 :end1 end1 :start2 start2 :end2 end2))) + (not (string-equal string1 string2 + :start1 start1 + :end1 end1 + :start2 start2 + :end2 end2))) (defun string (name) (typecase name @@ -104,25 +108,6 @@ (t (setf between-words-p (not (char-alpha-p c))) (char-downcase c)))))))) -(defun string%<= (string1 string2 result= start1 end1 start2 end2) - (let ((mismatch (mismatch string1 string2 - :start1 start1 - :end1 end1 - :start2 start2 - :end2 end2 - :test #'char=))) - (cond - ((not mismatch) - (when result= - (or end1 (length string1)))) - ((>= mismatch (or end1 (length string1))) - mismatch) - ((>= mismatch (or end2 (length string2))) - nil) - (t (when (char< (char string1 mismatch) - (char string2 mismatch)) - mismatch))))) - (defun string< (string1 string2 &key (start1 0) end1 (start2 0) end2) "=> mismatch-index" (let ((mismatch (mismatch string1 string2 @@ -134,12 +119,14 @@ (cond ((not mismatch) nil) - ((>= mismatch (or end1 (length string1))) + ((>= mismatch + (or end1 (length string1))) mismatch) - ((>= mismatch (or end2 (length string2))) + ((>= (+ start2 mismatch) + (or end2 (length string2))) nil) (t (when (char< (char string1 mismatch) - (char string2 mismatch)) + (char string2 (+ start2 mismatch))) mismatch))))) (defun string<= (string1 string2 &key (start1 0) end1 (start2 0) end2) @@ -153,12 +140,14 @@ (cond ((not mismatch) (or end1 (length string1))) - ((>= mismatch (or end1 (length string1))) + ((>= mismatch + (or end1 (length string1))) mismatch) - ((>= mismatch (or end2 (length string2))) + ((>= (+ start2 mismatch) + (or end2 (length string2))) nil) (t (when (char<= (char string1 mismatch) - (char string2 mismatch)) + (char string2 (+ start2 mismatch))) mismatch))))) (defun string> (string1 string2 result= start1 end1 start2 end2) @@ -172,12 +161,14 @@ (cond ((not mismatch) nil) - ((>= mismatch (or end1 (length string1))) + ((>= mismatch + (or end1 (length string1))) mismatch) - ((>= mismatch (or end2 (length string2))) + ((>= (+ start2 mismatch) + (or end2 (length string2))) nil) (t (when (char> (char string1 mismatch) - (char string2 mismatch)) + (char string2 (+ start2 mismatch))) mismatch))))) (defun string>= (string1 string2 result= start1 end1 start2 end2) @@ -191,10 +182,12 @@ (cond ((not mismatch) (or end1 (length string1))) - ((>= mismatch (or end1 (length string1))) + ((>= mismatch + (or end1 (length string1))) mismatch) - ((>= mismatch (or end2 (length string2))) + ((>= (+ start2 mismatch) + (or end2 (length string2))) nil) (t (when (char>= (char string1 mismatch) - (char string2 mismatch)) + (char string2 (+ start2 mismatch))) mismatch)))))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 27 Apr '08

27 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv6179 Modified Files: sequences.lisp Log Message: Add various foo-if and foo-if-not operators. --- /project/movitz/cvsroot/movitz/losp/muerte/sequences.lisp 2008/04/21 19:28:46 1.41 +++ /project/movitz/cvsroot/movitz/losp/muerte/sequences.lisp 2008/04/27 19:44:55 1.42 @@ -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.41 2008/04/21 19:28:46 ffjeld Exp $ +;;;; $Id: sequences.lisp,v 1.42 2008/04/27 19:44:55 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1078,7 +1078,7 @@ (when (test item (key (car p))) (incf n))))))))))) -(defun count-if (predicate sequence &key (start 0) end (key 'identity) #+ignore from-end) +(defun count-if (predicate sequence &key (start 0) end (key 'identity) from-end) (numargs-case (2 (predicate sequence) (with-funcallable (predicate) @@ -1098,7 +1098,9 @@ (when (predicate (sequence-ref i)) (incf count))) count)))))) - (t (predicate sequence &key (start 0) end (key 'identity) #+ignore from-end) + (t (predicate sequence &key (start 0) end (key 'identity) from-end) + (when from-end + (error "count-if from-end not implemented.")) (let ((start (check-the index start))) (with-funcallable (predicate) (with-funcallable (key) @@ -1122,6 +1124,32 @@ (vector (error "vector count-if not implemented."))))))))) +(defun count-if-not (predicate sequence &key (start 0) end (key 'identity) from-end) + (numargs-case + (2 (predicate sequence) + (with-funcallable (predicate) + (do-sequence-dispatch sequence + (list + (let ((count 0)) + (declare (index count)) + (dolist (x sequence) + (when (not (predicate x)) + (incf count))) + count)) + (vector + (with-subvector-accessor (sequence-ref sequence) + (let ((count 0)) + (declare (index count)) + (dotimes (i (length sequence)) + (when (not (predicate (sequence-ref i))) + (incf count))) + count)))))) + (t (predicate sequence &rest keys) + (apply #'count-if + (complement predicate) + sequence + keys)))) + (macrolet ((every-some-body () "This function body is shared between every and some." @@ -2009,6 +2037,10 @@ (return sequence))))) ((error 'program-error)))))))))) +(defun substitute-if-not (newitem predicate sequence &rest keyargs) + (declare (dynamic-extent keyargs)) + (apply #'substitute-if newitem (complement predicate) sequence keyargs)) + (defun nsubstitute-if-not (newitem predicate sequence &rest keyargs) (declare (dynamic-extent keyargs)) (apply #'nsubstitute-if newitem (complement predicate) sequence keyargs))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 27 Apr '08

27 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv5962 Modified Files: packages.lisp Log Message: Add package-used-by-list. --- /project/movitz/cvsroot/movitz/losp/muerte/packages.lisp 2008/04/23 18:47:46 1.16 +++ /project/movitz/cvsroot/movitz/losp/muerte/packages.lisp 2008/04/27 19:43:37 1.17 @@ -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.16 2008/04/23 18:47:46 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.17 2008/04/27 19:43:37 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -249,8 +249,32 @@ (apropos-symbol symbol string))))) (values)) +(defun package-used-by-list (package) + "Return a list of all packages that use package." + (let ((package (find-package package))) + (let ((used-by-list nil)) + (maphash (lambda (name other-package) + (declare (ignore name)) + (when (member package + (package-object-use-list other-package) + :test #'eq) + (pushnew other-package used-by-list))) + *packages*) + used-by-list))) + +(defun list-all-packages () + (with-hash-table-iterator (p *packages*) + (do (packages) (nil) + (multiple-value-bind (more k v) + (p) + (declare (ignore k)) + (when (not more) + (return packages)) + (push v packages))))) + + (defmacro with-package-iterator ((name package-list-form &rest symbol-types) &body body) `(macrolet ((,name () '(warn "with-package-iterator not implemented." (values nil nil nil nil)))) - ,@body)) \ No newline at end of file + ,@body))

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs