movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[movitz-cvs] CVS update: movitz/compiler.lisp
by ffjeld＠common-lisp.net 24 May '05

24 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv11719 Modified Files: compiler.lisp Log Message: *** empty log message *** Date: Tue May 24 08:32:28 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.143 movitz/compiler.lisp:1.144 --- movitz/compiler.lisp:1.143 Tue May 24 01:30:14 2005 +++ movitz/compiler.lisp Tue May 24 08:32:27 2005 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.143 2005/05/23 23:30:14 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.144 2005/05/24 06:32:27 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -3990,10 +3990,16 @@ ((and (typep movitz-obj 'movitz-bignum) (eq :untagged-fixnum-ecx (new-binding-location result-mode frame-map :default nil))) + (unless (typep (movitz-bignum-value movitz-obj) '(unsigned-byte 32)) + (warn "Loading non-u32 ~S into ~S." + (movitz-bignum-value movitz-obj) + result-mode)) (make-immediate-move (ldb (byte 32 0) (movitz-bignum-value movitz-obj)) :ecx)) - (t #+ignore (warn "load to ~S at ~S from ~S" - result-mode (new-binding-location result-mode frame-map) movitz-obj) + (t (when (member (new-binding-location result-mode frame-map :default nil) + '(:ebx :ecx :edx :esi)) + (warn "load to ~S at ~S from ~S" + result-mode (new-binding-location result-mode frame-map) movitz-obj)) (append `((:movl ,(new-make-compiled-constant-reference movitz-obj funobj) :eax)) (make-store-lexical result-mode :eax nil funobj frame-map)))))

1 0

[movitz-cvs] CVS update: movitz/losp/lib/net/dhcp.lisp
by ffjeld＠common-lisp.net 23 May '05

23 May '05

Update of /project/movitz/cvsroot/movitz/losp/lib/net In directory common-lisp.net:/tmp/cvs-serv18991 Modified Files: dhcp.lisp Log Message: *** empty log message *** Date: Tue May 24 01:30:38 2005 Author: ffjeld Index: movitz/losp/lib/net/dhcp.lisp diff -u movitz/losp/lib/net/dhcp.lisp:1.1 movitz/losp/lib/net/dhcp.lisp:1.2 --- movitz/losp/lib/net/dhcp.lisp:1.1 Sun May 22 00:36:33 2005 +++ movitz/losp/lib/net/dhcp.lisp Tue May 24 01:30:38 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri May 13 23:24:01 2005 ;;;; -;;;; $Id: dhcp.lisp,v 1.1 2005/05/21 22:36:33 ffjeld Exp $ +;;;; $Id: dhcp.lisp,v 1.2 2005/05/23 23:30:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -103,6 +103,13 @@ (declare (dynamic-extent options)) (loop while options do (ecase (pop options) + (:lease-time + (vector-push 51 packet) + (vector-push 4 packet) + (let ((time (pop options))) + (check-type time (unsigned-byte 32)) + (loop for b from 24 downto 0 by 8 + do (vector-push (ldb (byte 8 b) time) packet)))) (:message-type (vector-push 53 packet) (vector-push 1 packet) @@ -168,6 +175,11 @@ (subseq packet (fill-pointer packet) (incf (fill-pointer packet) length))))) + (51 (assert (= 4 (vector-read packet))) + (cons :lease-time + (loop with time = 0 repeat 4 + do (setf time (+ (* 256 time) (vector-read packet))) + finally (return time)))) (53 (assert (= 1 (vector-read packet))) (cons :message-type (let ((message-type (vector-read packet))) @@ -193,7 +205,7 @@ (fill-pointer packet) (incf (fill-pointer packet) length))))))))) -(defun format-dhcp-request (nic) +(defun format-dhcp-request (nic &rest dhcp-options &key (message-type :dhcpdiscover)) (let ((packet (make-ethernet-packet))) (with-ether-header (ether packet) (setf (ether :source) (mac-address nic) @@ -217,8 +229,8 @@ (dhcp :chaddr) (mac-address nic) (dhcp :magic) +dhcp-magic+) (setf (fill-pointer packet) (dhcp :end)) + (apply #'dhcp-push-options packet dhcp-options) (dhcp-push-options packet - :message-type :dhcpdiscover :client-identifier (mac-address nic) :end) (setf (ip :length) (- (fill-pointer packet) (ether :end)) @@ -230,25 +242,26 @@ packet)))))) (defun dhcp-request (&optional (nic (or *ip4-nic* (ip4-init)))) - (transmit nic (format-dhcp-request nic)) - (loop with packet = (make-ethernet-packet) - when (and (receive nic packet) - (with-ether-header (ether packet) - (format t "~&From ~@/ethernet:pprint-mac/ to ~:/ethernet:pprint-mac/..~%" - packet packet) - (with-ip4-header (ip packet :start (ether :end)) - (warn "Seeing ~/ip4:pprint-ip4/ from ~/ip4:pprint-ip4/." - (ip4-address (ip :destination)) - (ip4-address (ip :source))) - (with-udp-header (udp packet) - (with-dhcp-header (dhcp packet) - (and (= 4 (ip :version)) - (= 17 (ip :protocol)) - (= 68 (udp :destination-port)) - (= +dhcp-magic+ (dhcp :magic)) - (setf (fill-pointer packet) - (dhcp :end)))))))) + (loop with packet = (make-ethernet-packet) + repeat 5 + do (transmit nic (format-dhcp-request nic)) + (sleep 1/2) + when (loop while (receive nic packet) + thereis (with-ether-header (ether packet) + (with-ip4-header (ip packet :start (ether :end)) + (when (and (= 4 (ip :version)) + (= 17 (ip :protocol))) + (warn "Seeing UDP ~/ip4:pprint-ip4/ from ~/ip4:pprint-ip4/." + (ip4-address (ip :destination)) + (ip4-address (ip :source))) + (with-udp-header (udp packet) + (when (= 68 (udp :destination-port)) + (with-dhcp-header (dhcp packet) + (and (= +dhcp-magic+ (dhcp :magic)) + (setf (fill-pointer packet) + (dhcp :end)))))))))) return (values packet (parse-dhcp-options packet)))) +

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by ffjeld＠common-lisp.net 23 May '05

23 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv18807 Modified Files: compiler.lisp Log Message: Fixed make-load-constant of a literal bignum. Date: Tue May 24 01:30:15 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.142 movitz/compiler.lisp:1.143 --- movitz/compiler.lisp:1.142 Tue May 24 00:40:55 2005 +++ movitz/compiler.lisp Tue May 24 01:30:14 2005 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.142 2005/05/23 22:40:55 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.143 2005/05/23 23:30:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -3986,9 +3986,17 @@ (let ((value (movitz-bignum-value object))) (make-immediate-move (ldb (byte 32 0) value) :ecx))) (:lexical-binding - (append `((:movl ,(new-make-compiled-constant-reference movitz-obj funobj) - :eax)) - (make-store-lexical result-mode :eax nil funobj frame-map))) + (cond + ((and (typep movitz-obj 'movitz-bignum) + (eq :untagged-fixnum-ecx + (new-binding-location result-mode frame-map :default nil))) + (make-immediate-move (ldb (byte 32 0) (movitz-bignum-value movitz-obj)) + :ecx)) + (t #+ignore (warn "load to ~S at ~S from ~S" + result-mode (new-binding-location result-mode frame-map) movitz-obj) + (append `((:movl ,(new-make-compiled-constant-reference movitz-obj funobj) + :eax)) + (make-store-lexical result-mode :eax nil funobj frame-map))))) (:push `((:pushl ,(new-make-compiled-constant-reference movitz-obj funobj)))) ((:eax :ebx :ecx :edx :esi)

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by ffjeld＠common-lisp.net 23 May '05

23 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv15839 Modified Files: compiler.lisp Log Message: Fixed make-store-lexical for :untagged-fixnum-ecx. Date: Tue May 24 00:40:55 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.141 movitz/compiler.lisp:1.142 --- movitz/compiler.lisp:1.141 Mon May 23 18:45:15 2005 +++ movitz/compiler.lisp Tue May 24 00:40:55 2005 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.141 2005/05/23 16:45:15 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.142 2005/05/23 22:40:55 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -3694,10 +3694,15 @@ "store-lexical argnum can't be ~A." (function-argument-argnum binding)) `((:movl ,source (:ebp ,(argument-stack-offset binding))))) (:untagged-fixnum-ecx - (append (unless (member source '(:ecx :untagged-fixnum-ecx)) - `((:movl ,source :ecx))) - (unless (eq source :untagged-fixnum-ecx) - `((:sarl ,+movitz-fixnum-shift+ :ecx))))))))))))) + (cond + ((eq source :untagged-fixnum-ecx) + nil) + ((eq source :eax) + `((,*compiler-global-segment-prefix* + :call (:edi ,(global-constant-offset 'unbox-u32))))) + (t `((:movl ,source :eax) + (,*compiler-global-segment-prefix* + :call (:edi ,(global-constant-offset 'unbox-u32))))))))))))))) (defun finalize-code (code funobj frame-map) ;; (print-code 'to-be-finalized code)

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by ffjeld＠common-lisp.net 23 May '05

23 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv26097 Modified Files: compiler.lisp Log Message: *** empty log message *** Date: Mon May 23 18:45:15 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.140 movitz/compiler.lisp:1.141 --- movitz/compiler.lisp:1.140 Sun May 22 00:38:51 2005 +++ movitz/compiler.lisp Mon May 23 18:45:15 2005 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.140 2005/05/21 22:38:51 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.141 2005/05/23 16:45:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -3964,10 +3964,6 @@ (:lexical-binding (append (make-immediate-move x :eax) (make-store-lexical result-mode :eax nil funobj frame-map))) - (:untagged-fixnum-eax - (let ((value (movitz-fixnum-value object))) - (check-type value (unsigned-byte 16)) - (make-immediate-move value :eax))) (:untagged-fixnum-ecx (let ((value (movitz-fixnum-value object))) (check-type value (signed-byte 30)) @@ -3981,6 +3977,9 @@ '((:clc))))))) (movitz-heap-object (ecase (result-mode-type result-mode) + (:untagged-fixnum-ecx + (let ((value (movitz-bignum-value object))) + (make-immediate-move (ldb (byte 32 0) value) :ecx))) (:lexical-binding (append `((:movl ,(new-make-compiled-constant-reference movitz-obj funobj) :eax))

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by ffjeld＠common-lisp.net 21 May '05

21 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv4956 Modified Files: compiler.lisp Log Message: *** empty log message *** Date: Sun May 22 00:38:51 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.139 movitz/compiler.lisp:1.140 --- movitz/compiler.lisp:1.139 Sun May 8 03:16:26 2005 +++ movitz/compiler.lisp Sun May 22 00:38:51 2005 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.139 2005/05/08 01:16:26 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.140 2005/05/21 22:38:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -6639,7 +6639,8 @@ ((movitz-subtypep type0 '(integer 0 0)) (cond ((eql destination loc1) - (break "NOP add: ~S" instruction)) + #+ignore (break "NOP add: ~S" instruction) + nil) ((and (member destination-location '(:eax :ebx :ecx :edx)) (member loc1 '(:eax :ebx :ecx :edx))) `((:movl ,loc1 ,destination-location))) @@ -6653,7 +6654,8 @@ ;; (warn "zero-add ~S => ~S [~S]" loc0 destination-location result-type) (cond ((eql destination loc0) - (break "NOP add: ~S" instruction)) + #+ignore (break "NOP add: ~S" instruction) + nil) ((and (member destination-location '(:eax :ebx :ecx :edx)) (member loc0 '(:eax :ebx :ecx :edx))) `((:movl ,loc0 ,destination-location)))

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by ffjeld＠common-lisp.net 21 May '05

21 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv4940 Modified Files: image.lisp Log Message: *** empty log message *** Date: Sun May 22 00:38:39 2005 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.100 movitz/image.lisp:1.101 --- movitz/image.lisp:1.100 Mon May 9 00:02:46 2005 +++ movitz/image.lisp Sun May 22 00:38:39 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.100 2005/05/08 22:02:46 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.101 2005/05/21 22:38:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -28,51 +28,43 @@ (raw-scratch0 ; A non-GC-root scratch register :binary-type lu32 :initform 0) + + (pointer-start :binary-type :label) - (scratch1 - :binary-type word - :initform 0) - (scratch2 - :binary-type word - :initform 0) - (class - :binary-type word - :map-binary-write 'movitz-intern - :map-binary-read-delayed 'movitz-word - :initarg :class - :accessor run-time-context-class) - (slots - :binary-type word - :map-binary-write 'movitz-read-and-intern - :map-binary-read-delayed 'movitz-word - :initarg :slots - :initform #(:init nil) - :accessor run-time-context-slots) - (fast-car + + (ret-trampoline :binary-type code-vector-word - :initform nil :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) - (fast-cdr + (cons-commit :binary-type code-vector-word :initform nil :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) - (fast-cddr + (cons-non-pointer :binary-type code-vector-word - :initform nil :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) - (fast-car-ebx + (cons-commit-non-pointer :binary-type code-vector-word - :initform nil :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) - (fast-cdr-ebx + (cons-non-header + :binary-type code-vector-word + :map-binary-write 'movitz-intern-code-vector + :map-binary-read-delayed 'movitz-word-code-vector + :binary-tag :primitive-function) + (cons-commit-non-header + :binary-type code-vector-word + :map-binary-write 'movitz-intern-code-vector + :map-binary-read-delayed 'movitz-word-code-vector + :binary-tag :primitive-function) + + (cons-pointer :binary-type code-vector-word :initform nil :map-binary-write 'movitz-intern-code-vector @@ -120,50 +112,37 @@ :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) - (unwind-protect-tag - :binary-type word - :map-binary-read-delayed 'movitz-word - :map-binary-write 'movitz-read-and-intern - :initform 'muerte::unwind-protect-tag) - (restart-tag - :binary-type word - :map-binary-read-delayed 'movitz-word - :map-binary-write 'movitz-read-and-intern - :initform 'muerte::restart-protect-tag) - (new-unbound-value - :binary-type word - :map-binary-read-delayed 'movitz-word - :map-binary-write 'movitz-read-and-intern - :initform 'unbound) - (stack-bottom ; REMEMBER BOCHS! - :binary-type word - :initform #x0ff000) - (stack-top ; stack-top must be right after stack-bottom - :binary-type word ; in order for the bound instruction to work. - :initform #x100000) - ;; - (boolean-one :binary-type :label) - (not-nil ; not-nil, t-symbol and not-not-nil must be consecutive. - :binary-type word + + (fast-car + :binary-type code-vector-word :initform nil - :map-binary-write 'movitz-read-and-intern - :map-binary-read-delayed 'movitz-word) - (boolean-zero :binary-type :label) - (t-symbol - :binary-type word - :initarg :t-symbol - :map-binary-write 'movitz-intern - :map-binary-read-delayed 'movitz-word) - (not-not-nil - :binary-type word + :map-binary-write 'movitz-intern-code-vector + :map-binary-read-delayed 'movitz-word-code-vector + :binary-tag :primitive-function) + (fast-cdr + :binary-type code-vector-word :initform nil - :map-binary-write 'movitz-read-and-intern - :map-binary-read-delayed 'movitz-word) - ;; (null-cons :binary-type :label) - (null-symbol - :binary-type movitz-symbol - :reader movitz-run-time-context-null-symbol - :initarg :null-symbol) + :map-binary-write 'movitz-intern-code-vector + :map-binary-read-delayed 'movitz-word-code-vector + :binary-tag :primitive-function) + (fast-cddr + :binary-type code-vector-word + :initform nil + :map-binary-write 'movitz-intern-code-vector + :map-binary-read-delayed 'movitz-word-code-vector + :binary-tag :primitive-function) + (fast-car-ebx + :binary-type code-vector-word + :initform nil + :map-binary-write 'movitz-intern-code-vector + :map-binary-read-delayed 'movitz-word-code-vector + :binary-tag :primitive-function) + (fast-cdr-ebx + :binary-type code-vector-word + :initform nil + :map-binary-write 'movitz-intern-code-vector + :map-binary-read-delayed 'movitz-word-code-vector + :binary-tag :primitive-function) ;; primitive functions global constants (pop-current-values :binary-type code-vector-word @@ -273,12 +252,41 @@ :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) - (+ - :initform 'muerte.cl:+ + (dynamic-jump-next + :binary-type code-vector-word + :map-binary-write 'movitz-intern-code-vector + :map-binary-read-delayed 'movitz-word-code-vector + :binary-tag :primitive-function) + (copy-funobj-code-vector-slots + :binary-type code-vector-word + :map-binary-write 'movitz-intern-code-vector + :map-binary-read-delayed 'movitz-word-code-vector + :binary-tag :primitive-function) + + ;; + (boolean-one :binary-type :label) + (not-nil ; not-nil, t-symbol and not-not-nil must be consecutive. :binary-type word - :binary-tag :global-function + :initform nil + :map-binary-write 'movitz-read-and-intern + :map-binary-read-delayed 'movitz-word) + (boolean-zero :binary-type :label) + (t-symbol + :binary-type word + :initarg :t-symbol :map-binary-write 'movitz-intern :map-binary-read-delayed 'movitz-word) + (not-not-nil + :binary-type word + :initform nil + :map-binary-write 'movitz-read-and-intern + :map-binary-read-delayed 'movitz-word) + ;; (null-cons :binary-type :label) + (null-symbol + :binary-type movitz-symbol + :reader movitz-run-time-context-null-symbol + :initarg :null-symbol) + (complicated-eql :initform 'muerte::complicated-eql :binary-type word @@ -293,6 +301,53 @@ (dynamic-env :binary-type word :initform 0) + + (scratch1 + :binary-type word + :initform 0) + (scratch2 + :binary-type word + :initform 0) + (class + :binary-type word + :map-binary-write 'movitz-intern + :map-binary-read-delayed 'movitz-word + :initarg :class + :accessor run-time-context-class) + (slots + :binary-type word + :map-binary-write 'movitz-read-and-intern + :map-binary-read-delayed 'movitz-word + :initarg :slots + :initform #(:init nil) + :accessor run-time-context-slots) + (unwind-protect-tag + :binary-type word + :map-binary-read-delayed 'movitz-word + :map-binary-write 'movitz-read-and-intern + :initform 'muerte::unwind-protect-tag) + (restart-tag + :binary-type word + :map-binary-read-delayed 'movitz-word + :map-binary-write 'movitz-read-and-intern + :initform 'muerte::restart-protect-tag) + (new-unbound-value + :binary-type word + :map-binary-read-delayed 'movitz-word + :map-binary-write 'movitz-read-and-intern + :initform 'unbound) + (stack-bottom ; REMEMBER BOCHS! + :binary-type word + :initform #x0ff000) + (stack-top ; stack-top must be right after stack-bottom + :binary-type word ; in order for the bound instruction to work. + :initform #x100000) + (+ + :initform 'muerte.cl:+ + :binary-type word + :binary-tag :global-function + :map-binary-write 'movitz-intern + :map-binary-read-delayed 'movitz-word) (the-class-t :binary-type word :initform t @@ -310,38 +365,6 @@ (movitz-intern (movitz-env-named-function name)))) - (cons-pointer - :binary-type code-vector-word - :initform nil - :map-binary-write 'movitz-intern-code-vector - :map-binary-read-delayed 'movitz-word-code-vector - :binary-tag :primitive-function) - (cons-commit - :binary-type code-vector-word - :initform nil - :map-binary-write 'movitz-intern-code-vector - :map-binary-read-delayed 'movitz-word-code-vector - :binary-tag :primitive-function) - (cons-non-pointer - :binary-type code-vector-word - :map-binary-write 'movitz-intern-code-vector - :map-binary-read-delayed 'movitz-word-code-vector - :binary-tag :primitive-function) - (cons-commit-non-pointer - :binary-type code-vector-word - :map-binary-write 'movitz-intern-code-vector - :map-binary-read-delayed 'movitz-word-code-vector - :binary-tag :primitive-function) - (cons-non-header - :binary-type code-vector-word - :map-binary-write 'movitz-intern-code-vector - :map-binary-read-delayed 'movitz-word-code-vector - :binary-tag :primitive-function) - (cons-commit-non-header - :binary-type code-vector-word - :map-binary-write 'movitz-intern-code-vector - :map-binary-read-delayed 'movitz-word-code-vector - :binary-tag :primitive-function) (classes ; A vector of class meta-objects. :initform nil ; The first element is the map of corresponding names :binary-type word @@ -370,21 +393,6 @@ :binary-type word :initform 6 :map-binary-read-delayed 'movitz-word) - (ret-trampoline - :binary-type code-vector-word - :map-binary-write 'movitz-intern-code-vector - :map-binary-read-delayed 'movitz-word-code-vector - :binary-tag :primitive-function) - (dynamic-jump-next - :binary-type code-vector-word - :map-binary-write 'movitz-intern-code-vector - :map-binary-read-delayed 'movitz-word-code-vector - :binary-tag :primitive-function) - (copy-funobj-code-vector-slots - :binary-type code-vector-word - :map-binary-write 'movitz-intern-code-vector - :map-binary-read-delayed 'movitz-word-code-vector - :binary-tag :primitive-function) (complicated-class-of :binary-type word :binary-tag :global-function @@ -417,7 +425,7 @@ (:slot-align null-symbol -5)) (defun atomically-continuation-simple-pf (pf-name) - (global-constant-offset pf-name) + (ldb (byte 32 0) (global-constant-offset pf-name)) #+ignore (bt:enum-value 'movitz::atomically-status (list* :restart-primitive-function

1 0

[movitz-cvs] CVS update: movitz/packages.lisp
by ffjeld＠common-lisp.net 21 May '05

21 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv4924 Modified Files: packages.lisp Log Message: *** empty log message *** Date: Sun May 22 00:38:29 2005 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.49 movitz/packages.lisp:1.50 --- movitz/packages.lisp:1.49 Sun May 8 03:16:40 2005 +++ movitz/packages.lisp Sun May 22 00:38:29 2005 @@ -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.49 2005/05/08 01:16:40 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.50 2005/05/21 22:38:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1233,6 +1233,7 @@ #:memref #:memref-int + #:memrange #:io-port #:io-register8 @@ -1264,6 +1265,9 @@ #:segment-descriptor-limit #:control-register-lo12 #:control-register-hi20 + #:ensure-data-vector + #:vector-read + #:vector-read-more-p ))

1 0

[movitz-cvs] CVS update: movitz/losp/lib/misc.lisp
by ffjeld＠common-lisp.net 21 May '05

21 May '05

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv4908 Modified Files: misc.lisp Log Message: *** empty log message *** Date: Sun May 22 00:38:19 2005 Author: ffjeld Index: movitz/losp/lib/misc.lisp diff -u movitz/losp/lib/misc.lisp:1.8 movitz/losp/lib/misc.lisp:1.9 --- movitz/losp/lib/misc.lisp:1.8 Thu May 5 17:16:59 2005 +++ movitz/losp/lib/misc.lisp Sun May 22 00:38:19 2005 @@ -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.8 2005/05/05 15:16:59 ffjeld Exp $ +;;;; $Id: misc.lisp,v 1.9 2005/05/21 22:38:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -22,7 +22,7 @@ (defun checksum-octets (packet &optional (start 0) (end (length packet))) "Generate sum of 16-bit big-endian words for a sequence of octets." (typecase packet - ((simple-array (unsigned-byte 8)) + ((simple-array (unsigned-byte 8) 1) (assert (<= 0 start end (length packet))) (with-inline-assembly (:returns :eax) (:compile-form (:result-mode :ebx) packet)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
by ffjeld＠common-lisp.net 21 May '05

21 May '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4891 Modified Files: arrays.lisp Log Message: *** empty log message *** Date: Sun May 22 00:37:53 2005 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.49 movitz/losp/muerte/arrays.lisp:1.50 --- movitz/losp/muerte/arrays.lisp:1.49 Thu Nov 25 03:10:38 2004 +++ movitz/losp/muerte/arrays.lisp Sun May 22 00:37:53 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001-2004, +;;;; Copyright (C) 2001-2005, ;;;; Department of Computer Science, University of Tromso, Norway. ;;;; ;;;; For distribution policy, see the accompanying file COPYING. @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sun Feb 11 23:14:04 2001 ;;;; -;;;; $Id: arrays.lisp,v 1.49 2004/11/25 02:10:38 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.50 2005/05/21 22:37:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -853,6 +853,15 @@ (setf (fill-pointer vector) p) (aref vector p))) +(defun vector-read (vector) + "Like vector-pop, only in the other direction." + (let ((x (aref vector (fill-pointer vector)))) + (incf (fill-pointer vector)) + x)) + +(defun vector-read-more-p (vector) + (< (fill-pointer vector) (array-dimension vector 0))) + (defun vector-push-extend (new-element vector &optional extension) (declare (ignore extension)) (check-type vector vector) @@ -916,3 +925,12 @@ ((eq dim '*)) ((= dim (array-dimension x d))) (t (return nil))))))))) + +(defun ensure-data-vector (vector start length) + (let ((end (typecase vector + ((simple-array (unsigned-byte 8) 1) + (array-dimension vector 0)) + (t (error "Not a data vector: ~S" vector))))) + (assert (<= (+ start length) end) (vector) + "Data vector too small.") + vector))

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