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

[movitz-cvs] CVS update: ia-x86/proglist.lisp
by Frode Vatvedt Fjeld 12 Oct '04

12 Oct '04

Update of /project/movitz/cvsroot/ia-x86 In directory common-lisp.net:/tmp/cvs-serv7116 Modified Files: proglist.lisp Log Message: Removed warning about "assumption bigger than.." Date: Tue Oct 12 11:37:25 2004 Author: ffjeld Index: ia-x86/proglist.lisp diff -u ia-x86/proglist.lisp:1.5 ia-x86/proglist.lisp:1.6 --- ia-x86/proglist.lisp:1.5 Thu Sep 2 11:02:40 2004 +++ ia-x86/proglist.lisp Tue Oct 12 11:37:24 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Mon May 15 13:43:55 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: proglist.lisp,v 1.5 2004/09/02 09:02:40 ffjeld Exp $ +;;;; $Id: proglist.lisp,v 1.6 2004/10/12 09:37:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -101,7 +101,6 @@ :current-pc referring-pc) optimize-teo))) (when (< (imagpart cdatum) assumed-length) - (warn "Assumption ~D bigger than actual ~D" assumed-length (imagpart cdatum)) (setf cdatum (instruction-encode instruction (make-assemble-env :symtab (assemble-env-symtab env)

1 0

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

11 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30856 Modified Files: symbols.lisp Log Message: Changed the signature of memref and (setf memref) to use keywords also for the index and type arguments. Date: Mon Oct 11 15:53:28 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.19 movitz/losp/muerte/symbols.lisp:1.20 --- movitz/losp/muerte/symbols.lisp:1.19 Wed Sep 22 20:49:24 2004 +++ movitz/losp/muerte/symbols.lisp Mon Oct 11 15:53:28 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 23:55:41 2001 ;;;; -;;;; $Id: symbols.lisp,v 1.19 2004/09/22 18:49:24 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.20 2004/10/11 13:53:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -74,13 +74,13 @@ (setf (symbol-value symbol) value)) (define-compiler-macro %symbol-global-value (symbol) - `(memref ,symbol ,(bt:slot-offset 'movitz:movitz-symbol 'movitz::value) 0 :lisp)) + `(memref ,symbol ,(bt:slot-offset 'movitz:movitz-symbol 'movitz::value))) (defun %symbol-global-value (symbol) (%symbol-global-value symbol)) (define-compiler-macro (setf %symbol-global-value) (value symbol) - `(setf (memref ,symbol ,(bt:slot-offset 'movitz:movitz-symbol 'movitz::value) 0 :lisp) + `(setf (memref ,symbol ,(bt:slot-offset 'movitz:movitz-symbol 'movitz::value)) ,value)) (defun (setf %symbol-global-value) (value symbol) @@ -94,7 +94,8 @@ (defun %unbounded-symbol-function (symbol) (check-type symbol symbol) - (movitz-accessor symbol movitz-symbol function-value)) + (memref symbol (movitz-type-slot-offset 'movitz-symbol 'function-value))) + ;; (movitz-accessor symbol movitz-symbol function-value)) (defun (setf symbol-function) (value symbol) (check-type symbol symbol) @@ -109,7 +110,8 @@ (null (error "Can't change the name of NIL.")) (symbol - (setf-movitz-accessor (symbol movitz-symbol name) value)))) + (setf (memref symbol (movitz-type-slot-offset 'movitz-symbol 'name)) + value)))) (defun symbol-plist (symbol) (get-symbol-slot symbol plist)) @@ -119,7 +121,8 @@ (null (error "Can't change the plist of NIL.")) (symbol - (setf-movitz-accessor (symbol movitz-symbol plist) value)))) + (setf (memref symbol (movitz-type-slot-offset 'movitz-symbol 'plist)) + value)))) (defun symbol-package (symbol) (get-symbol-slot symbol package))

1 0

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

11 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30831 Modified Files: scavenge.lisp Log Message: Changed the signature of memref and (setf memref) to use keywords also for the index and type arguments. Date: Mon Oct 11 15:53:25 2004 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.32 movitz/losp/muerte/scavenge.lisp:1.33 --- movitz/losp/muerte/scavenge.lisp:1.32 Tue Sep 21 15:56:32 2004 +++ movitz/losp/muerte/scavenge.lisp Mon Oct 11 15:53: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.32 2004/09/21 13:56:32 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.33 2004/10/11 13:53:25 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -49,7 +49,7 @@ (with-simple-restart (continue-map-heap-words "Continue map-heap-words at location ~S." (1+ scan)) (let ((*scan* scan) - (x (memref scan 0 0 :unsigned-byte16))) + (x (memref scan 0 :type :unsigned-byte16))) (declare (special *scan*)) (when verbose (format *terminal-io* " [at ~S: ~S]" scan x)) @@ -65,7 +65,7 @@ (assert (evenp scan) () "Scanned bignum-header ~S at odd location #x~X." x scan) ;; Just skip the bigits - (let* ((bigits (memref scan 0 1 :unsigned-byte14)) + (let* ((bigits (memref scan 0 :index 1 :type :unsigned-byte14)) (delta (logior bigits 1))) (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) (incf scan delta))) @@ -76,7 +76,7 @@ ((scavenge-typep x :funobj) (assert (evenp scan) () "Scanned funobj-header ~S at odd location #x~X." - (memref scan 0 0 :unsigned-byte32) scan) + (memref scan 0 :type :unsigned-byte32) scan) (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) ;; Process code-vector pointers specially.. (let* ((funobj (%word-offset scan #.(movitz:tag :other))) @@ -88,7 +88,7 @@ (check-type new-code-vector code-vector) (unless (eq code-vector new-code-vector) (error "Code-vector migration is not implemented.") - (setf (memref scan 0 -1 :lisp) (%word-offset new-code-vector 2)) + (setf (memref scan 0 :index -1) (%word-offset new-code-vector 2)) ;; Do more stuff here to update code-vectors and jumpers )) (incf scan (+ 7 num-jumpers)))) ; Don't scan the jumpers. @@ -104,21 +104,21 @@ #.(bt:enum-value 'movitz:movitz-vector-element-type :code))) (assert (evenp scan) () "Scanned u8-vector-header ~S at odd location #x~X." x scan) - (let ((len (memref scan 0 1 :lisp))) + (let ((len (memref scan 0 :index 1 :type :lisp))) (check-type len positive-fixnum) (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) (incf scan (1+ (* 2 (truncate (+ 7 len) 8)))))) ((scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u16)) (assert (evenp scan) () "Scanned u16-vector-header ~S at odd location #x~X." x scan) - (let ((len (memref scan 0 1 :lisp))) + (let ((len (memref scan 0 :index 1))) (check-type len positive-fixnum) (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) (incf scan (1+ (* 2 (truncate (+ 3 len) 4)))))) ((scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u32)) (assert (evenp scan) () "Scanned u32-vector-header ~S at odd location #x~X." x scan) - (let ((len (memref scan 0 1 :lisp))) + (let ((len (memref scan 4))) (assert (typep len 'positive-fixnum) () "Scanned basic-vector at ~S with illegal length ~S." scan len) (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) @@ -133,17 +133,17 @@ ((eq x 3) (setf *scan-last* scan) (incf scan) - (let ((delta (memref scan 0 0 :lisp))) + (let ((delta (memref scan 0))) (check-type delta positive-fixnum) ;; (warn "at ~S skipping ~S to ~S." scan delta (+ scan delta)) (incf scan delta))) (t ;; (typep x 'pointer) - (let* ((old (memref scan 0 0 :lisp)) + (let* ((old (memref scan 0)) (new (funcall function old scan))) (when verbose (format *terminal-io* " [~Z => ~Z]" old new)) (unless (eq old new) - (setf (memref scan 0 0 :lisp) new))))))))) + (setf (memref scan 0) new))))))))) (values)) (defun map-stack-words (function stack start-frame) @@ -229,14 +229,14 @@ (dit-frame-ref stack dit-frame :eip :location)) (cond ((let ((x0-tag (ldb (byte 3 0) - (memref interrupted-esp 0 0 :unsigned-byte8)))) + (memref interrupted-esp 0 :type :unsigned-byte8)))) (and (member x0-tag '(1 5 6 7)) (location-in-object-p casf-code-vector - (memref interrupted-esp 0 0 :location)))) + (memref interrupted-esp 0 :type :location)))) ;; When code-vector migration is implemented... (warn "Scanning at ~S X0 call ~S in ~S." (dit-frame-ref stack dit-frame :eip :unsigned-byte32) - (memref interrupted-esp 0 0 :unsigned-byte32) + (memref interrupted-esp 0 :type :unsigned-byte32) (funobj-name casf-funobj)) #+ignore (map-heap-words function (+ interrupted-esp 1) frame) (when (eq 0 (stack-frame-ref stack frame -1)) @@ -244,14 +244,14 @@ (setf next-frame frame next-nether-frame (+ interrupted-esp 1 -2))) ((let ((x1-tag (ldb (byte 3 0) - (memref interrupted-esp 4 0 :unsigned-byte8)))) + (memref interrupted-esp 4 :type :unsigned-byte8)))) (and (member x1-tag '(1 5 6 7)) (location-in-object-p casf-code-vector - (memref interrupted-esp 0 1 :location)))) + (memref interrupted-esp 4 :type :location)))) ;; When code-vector migration is implemented... (warn "Scanning at ~S X1 call ~S in ~S." (dit-frame-ref stack dit-frame :eip :unsigned-byte32) - (memref interrupted-esp 0 1 :unsigned-byte32) + (memref interrupted-esp 4 :type :unsigned-byte32) (funobj-name casf-funobj)) (when (eq 0 (stack-frame-ref stack frame -1)) (break "X1 call in DIT-frame.")) @@ -263,10 +263,10 @@ (setf next-frame frame next-nether-frame (- interrupted-esp 2)) ))) - ((eq casf-frame (memref interrupted-esp 0 0 :location)) + ((eq casf-frame (memref interrupted-esp 0 :type :location)) ;; Situation ii. esp(0)=CASF, esp(1)=code-vector (assert (location-in-object-p casf-code-vector - (memref interrupted-esp 0 1 :location)) + (memref interrupted-esp 4 :type :location)) () "Stack discipline situation ii. invariant broken. CASF=#x~X, ESP=~S, EBP=~S" casf-frame interrupted-esp interrupted-ebp) @@ -275,7 +275,7 @@ next-nether-frame (+ interrupted-esp 2 -2))) (t ;; Situation iii. esp(0)=code-vector. (assert (location-in-object-p casf-code-vector - (memref interrupted-esp 0 0 :location)) + (memref interrupted-esp 0 :type :location)) () "Stack discipline situation iii. invariant broken. CASF=#x~X" casf-frame) #+ignore (map-heap-words function (+ interrupted-esp 1) frame)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/run-time-context.lisp
by Frode Vatvedt Fjeld 11 Oct '04

11 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30804 Modified Files: run-time-context.lisp Log Message: Changed the signature of memref and (setf memref) to use keywords also for the index and type arguments. Date: Mon Oct 11 15:53:20 2004 Author: ffjeld Index: movitz/losp/muerte/run-time-context.lisp diff -u movitz/losp/muerte/run-time-context.lisp:1.14 movitz/losp/muerte/run-time-context.lisp:1.15 --- movitz/losp/muerte/run-time-context.lisp:1.14 Mon Sep 27 10:54:53 2004 +++ movitz/losp/muerte/run-time-context.lisp Mon Oct 11 15:53:19 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 12 18:33:02 2003 ;;;; -;;;; $Id: run-time-context.lisp,v 1.14 2004/09/27 08:54:53 ffjeld Exp $ +;;;; $Id: run-time-context.lisp,v 1.15 2004/10/11 13:53:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -35,11 +35,11 @@ (let ((slot (find-run-time-context-slot context slot-name))) (ecase (second slot) (word - (memref context -6 (third slot) :lisp)) + (memref context -6 :index (third slot))) (code-vector-word - (memref context -6 (third slot) :code-vector)) + (memref context -6 :index (third slot) :type :code-vector)) (lu32 - (memref context -6 (third slot) :unsigned-byte32))))) + (memref context -6 :index (third slot) :type :unsigned-byte32))))) (define-compiler-macro (setf %run-time-context-slot) (&whole form &environment env value slot-name &optional (context '(current-run-time-context))) @@ -67,11 +67,11 @@ (let ((slot (find-run-time-context-slot context slot-name))) (ecase (second slot) (word - (setf (memref context -6 (third slot) :lisp) value)) + (setf (memref context -6 :index (third slot)) value)) (lu32 - (setf (memref context -6 (third slot) :unsigned-byte32) value)) + (setf (memref context -6 :index (third slot) :type :unsigned-byte32) value)) (code-vector-word - (setf (memref context -6 (third slot) :code-vector) value))))) + (setf (memref context -6 :index (third slot) :type :code-vector) value))))) (defun %run-time-context-segment-base (slot-name &optional (context (current-run-time-context))) @@ -81,9 +81,9 @@ (segment-descriptor (let ((index8 (* 4 (third slot))) (index16 (* 2 (third slot)))) - (+ (memref context (+ -6 2) index16 :unsigned-byte16) - (ash (memref context (+ -6 4) index8 :unsigned-byte8) 16) - (ash (memref context (+ -6 7) index8 :unsigned-byte8) 24))))))) + (+ (memref context (+ -6 2) :index index16 :type :unsigned-byte16) + (ash (memref context (+ -6 4) :index index8 :type :unsigned-byte8) 16) + (ash (memref context (+ -6 7) :index index8 :type :unsigned-byte8) 24))))))) (defun (setf %run-time-context-segment-base) (value slot-name &optional (context (current-run-time-context))) @@ -93,9 +93,9 @@ (segment-descriptor (let ((index8 (* 4 (third slot))) (index16 (* 2 (third slot)))) - (setf (memref context (+ -6 2) index16 :unsigned-byte16) (ldb (byte 16 0) value) - (memref context (+ -6 4) index8 :unsigned-byte8) (ldb (byte 8 16) value) - (memref context (+ -6 7) index8 :unsigned-byte8) (ldb (byte 6 24) value))))) + (setf (memref context (+ -6 2) :index index16 :type :unsigned-byte16) (ldb (byte 16 0) value) + (memref context (+ -6 4) :index index8 :type :unsigned-byte8) (ldb (byte 8 16) value) + (memref context (+ -6 7) :index index8 :type :unsigned-byte8) (ldb (byte 6 24) value))))) value)) (defun %run-time-context-ref (edi-offset)

1 0

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

11 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30787 Modified Files: read.lisp Log Message: Changed the signature of memref and (setf memref) to use keywords also for the index and type arguments. Date: Mon Oct 11 15:53:11 2004 Author: ffjeld Index: movitz/losp/muerte/read.lisp diff -u movitz/losp/muerte/read.lisp:1.10 movitz/losp/muerte/read.lisp:1.11 --- movitz/losp/muerte/read.lisp:1.10 Tue Sep 21 15:10:40 2004 +++ movitz/losp/muerte/read.lisp Mon Oct 11 15:53:11 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Oct 17 21:50:42 2001 ;;;; -;;;; $Id: read.lisp,v 1.10 2004/09/21 13:10:40 ffjeld Exp $ +;;;; $Id: read.lisp,v 1.11 2004/10/11 13:53:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -93,6 +93,7 @@ (digit-char-p (schar string (1+ start)) *read-base*) 0))) (denominator nil) + (decimal nil) (i (1+ start) (1+ i))) ((or (>= i end) (member (schar string i) +simple-token-terminators+)) @@ -103,19 +104,19 @@ integer)) (when (and integer denominator (plusp denominator)) denominator))) - (when (char= #\: (schar string i)) - (setf colon-position i)) - (setf almost-integer integer) - (when integer - (if (and (not denominator) - (char= #\/ (schar string i))) - (setf denominator 0) - (let ((digit (digit-char-p (schar string i) *read-base*))) + (let ((c (schar string i))) + (when (char= #\: c) + (setf colon-position i)) + (setf almost-integer integer) + (when integer + (let ((digit (digit-char-p c *read-base*))) (cond - ((and denominator (not digit)) - (setf integer nil)) (denominator - (setf denominator (+ (* denominator *read-base*) digit))) + (if (not digit) + (setf integer nil) + (setf denominator (+ (* denominator *read-base*) digit)))) + ((char= #\/ c) + (setf denominator 0)) (t (setf integer (and digit (+ (* integer *read-base*) digit))))))))) (cond (token-denominator @@ -123,14 +124,19 @@ token-end)) (token-integer (values token-integer token-end)) - ((and almost-integer ; check for base 10 <n>. notation. + ((and (char= #\. (schar string (1- token-end))) ; check for base-10 <n>. notation. (> token-end start) - (char= #\. (schar string (1- token-end)))) - (if (= *read-base* 10) - (values almost-integer token-end) - (values (parse-integer string :start start :end (1- token-end) - :junk-allowed nil) - token-end))) + (or almost-integer + (and (< *read-base* 10) + (do ((i start (1+ i))) + ((>= i (1- token-end)) t) + (unless (digit-char-p (schar string i) 10) + (return nil)))))) + (let ((x (if (= *read-base* 10) + almost-integer + (parse-integer string :start start :end (1- token-end) + :junk-allowed nil)))) + (values x token-end))) ((not colon-position) (values (intern-string string *package* :start start :end token-end :key #'char-upcase) token-end))

1 0

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

11 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30768 Modified Files: print.lisp Log Message: Changed the signature of memref and (setf memref) to use keywords also for the index and type arguments. Date: Mon Oct 11 15:53:09 2004 Author: ffjeld Index: movitz/losp/muerte/print.lisp diff -u movitz/losp/muerte/print.lisp:1.14 movitz/losp/muerte/print.lisp:1.15 --- movitz/losp/muerte/print.lisp:1.14 Tue Jul 27 17:16:55 2004 +++ movitz/losp/muerte/print.lisp Mon Oct 11 15:53:09 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Sep 3 11:48:19 2001 ;;;; -;;;; $Id: print.lisp,v 1.14 2004/07/27 15:16:55 ffjeld Exp $ +;;;; $Id: print.lisp,v 1.15 2004/10/11 13:53:09 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -395,12 +395,12 @@ #.(cl:cons 'progn (cl:loop for octet from 3 downto 1 collecting - `(let ((n (memref x 0 ,octet :unsigned-byte8))) + `(let ((n (memref x 0 :index ,octet :type :unsigned-byte8))) (when (setq z (or z (<= #x10 n))) (write-digit (ldb (byte 4 4) n) stream)) (when (setq z (or z (plusp n))) (write-digit (ldb (byte 4 0) n) stream))))) - (let ((n (memref x 0 0 :unsigned-byte8))) + (let ((n (memref x 0 :type :unsigned-byte8))) (when (or z (<= #x10 n)) (write-digit (ldb (byte 4 4) n) stream)) (write-digit (ldb (byte 4 0) n) stream)))

1 0

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

11 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30717 Modified Files: memref.lisp Log Message: Changed the signature of memref and (setf memref) to use keywords also for the index and type arguments. Date: Mon Oct 11 15:53:01 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.31 movitz/losp/muerte/memref.lisp:1.32 --- movitz/losp/muerte/memref.lisp:1.31 Thu Oct 7 14:43:29 2004 +++ movitz/losp/muerte/memref.lisp Mon Oct 11 15:53:01 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.31 2004/10/07 12:43:29 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.32 2004/10/11 13:53:01 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -18,7 +18,8 @@ (in-package muerte) -(define-compiler-macro memref (&whole form object offset index type &key (localp nil) (endian :host) +(define-compiler-macro memref (&whole form object offset &key (index 0) (type :lisp) + (localp nil) (endian :host) &environment env) (if (or (not (movitz:movitz-constantp type env)) (not (movitz:movitz-constantp localp env)) @@ -323,29 +324,29 @@ (:load-lexical (:lexical-binding ,object-var) :eax) (:addl :ebx :ecx) (:movl (:eax :ecx ,(offset-by 4)) :eax))))))) - (t (error "Unknown memref type: ~S" (movitz::eval-form type nil nil)) + (t (error "Unknown memref type: ~S" (movitz:movitz-eval type nil nil)) form))))))))) -(defun memref (object offset index type &key localp (endian :host)) +(defun memref (object offset &key (index 0) (type :lisp) localp (endian :host)) (ecase type (:lisp (if localp - (memref object offset index :lisp :localp t) - (memref object offset index :lisp :localp nil))) - (:unsigned-byte32 (memref object offset index :unsigned-byte32)) - (:character (memref object offset index :character)) - (:unsigned-byte8 (memref object offset index :unsigned-byte8)) - (:location (memref object offset index :location)) - (:unsigned-byte14 (memref object offset index :unsigned-byte14)) + (memref object offset :index index :localp t) + (memref object offset :index index :localp nil))) + (:unsigned-byte32 (memref object offset :index index :type :unsigned-byte32)) + (:character (memref object offset :index index :type :character)) + (:unsigned-byte8 (memref object offset :index index :type :unsigned-byte8)) + (:location (memref object offset :index index :type :location)) + (:unsigned-byte14 (memref object offset :index index :type :unsigned-byte14)) (:unsigned-byte16 (ecase endian ((:host :little) - (memref object offset index :unsigned-byte16 :endian :little)) + (memref object offset :index index :type :unsigned-byte16 :endian :little)) ((:big) - (memref object offset index :unsigned-byte16 :endian :big)))) - (:signed-byte30+2 (memref object offset index :signed-byte30+2)) - (:unsigned-byte29+3 (memref object offset index :unsigned-byte29+3)))) + (memref object offset :index index :type :unsigned-byte16 :endian :big)))))) +;;; (:signed-byte30+2 (memref object offset index :signed-byte30+2)) +;;; (:unsigned-byte29+3 (memref object offset index :unsigned-byte29+3)))) -(define-compiler-macro (setf memref) (&whole form &environment env value object offset index type - &key (localp nil) (endian :host)) +(define-compiler-macro (setf memref) (&whole form &environment env value object offset + &key (index 0) (type :lisp) (localp nil) (endian :host)) (if (or (not (movitz:movitz-constantp type env)) (not (movitz:movitz-constantp localp env)) (not (movitz:movitz-constantp endian env))) @@ -683,24 +684,29 @@ (t ;; (warn "Can't handle inline MEMREF: ~S" form) form)))) -(defun (setf memref) (value object offset index type &key localp (endian :host)) +(defun (setf memref) (value object offset &key (index 0) (type :lisp) localp (endian :host)) (ecase type (:character - (setf (memref object offset index :character) value)) + (setf (memref object offset :index index :type :character) + value)) (:unsigned-byte8 - (setf (memref object offset index :unsigned-byte8) value)) + (setf (memref object offset :index index :type :unsigned-byte8) + value)) (:unsigned-byte16 (ecase endian ((:host :little) - (setf (memref object offset index :unsigned-byte16 :endian :little) value)) + (setf (memref object offset :index index :type :unsigned-byte16 :endian :little) + value)) ((:big) - (setf (memref object offset index :unsigned-byte16 :endian :big) value)))) + (setf (memref object offset :index index :type :unsigned-byte16 :endian :big) + value)))) (:unsigned-byte32 - (setf (memref object offset index :unsigned-byte32) value)) + (setf (memref object offset :index index :type :unsigned-byte32) + value)) (:lisp (if localp - (setf (memref object offset index :lisp :localp t) value) - (setf (memref object offset index :lisp :localp nil) value))))) + (setf (memref object offset :index index :localp t) value) + (setf (memref object offset :index index :localp nil) value))))) (define-compiler-macro memref-int (&whole form &environment env address offset index type &optional physicalp)

1 0

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

11 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30699 Modified Files: interrupt.lisp Log Message: Changed the signature of memref and (setf memref) to use keywords also for the index and type arguments. Date: Mon Oct 11 15:52:54 2004 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.28 movitz/losp/muerte/interrupt.lisp:1.29 --- movitz/losp/muerte/interrupt.lisp:1.28 Thu Oct 7 14:42:38 2004 +++ movitz/losp/muerte/interrupt.lisp Mon Oct 11 15:52:54 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.28 2004/10/07 12:42:38 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.29 2004/10/11 13:52:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -57,7 +57,7 @@ (if (not (and (movitz:movitz-constantp stack env) (eq nil (movitz:movitz-eval stack env)))) form - `(memref ,frame (dit-frame-offset ,reg) 0 ,type))) + `(memref ,frame (dit-frame-offset ,reg) :type ,type))) (defun dit-frame-ref (stack frame reg &optional (type :lisp)) (stack-frame-ref stack frame (dit-frame-index reg) type)) @@ -263,7 +263,7 @@ (declare (without-check-stack-limit)) (macrolet ((dereference (fixnum-address &optional (type :lisp)) "Dereference the fixnum-address." - `(memref ,fixnum-address 0 0 ,type))) + `(memref ,fixnum-address 0 :type ,type))) (let (($eip (+ dit-frame (dit-frame-index :eip))) ($eax (+ dit-frame (dit-frame-index :eax))) ($ebx (+ dit-frame (dit-frame-index :ebx)))

1 0

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

11 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30674 Modified Files: integers.lisp Log Message: Changed the signature of memref and (setf memref) to use keywords also for the index and type arguments. Date: Mon Oct 11 15:52:51 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.97 movitz/losp/muerte/integers.lisp:1.98 --- movitz/losp/muerte/integers.lisp:1.97 Wed Sep 22 19:40:47 2004 +++ movitz/losp/muerte/integers.lisp Mon Oct 11 15:52:50 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.97 2004/09/22 17:40:47 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.98 2004/10/11 13:52:50 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -881,7 +881,7 @@ (t (check-type integer (integer 0 *)) (let ((result (%make-bignum (ceiling result-length 32)))) (dotimes (i (* 2 (%bignum-bigits result))) - (setf (memref result -2 i :unsigned-byte16) + (setf (memref result -2 :index i :type :unsigned-byte16) (let ((pos (- (* i 16) count))) (cond ((minusp (+ pos 16)) 0) @@ -889,8 +889,12 @@ (ldb (byte 16 pos) integer)) (t (ash (ldb (byte (+ pos 16) 0) integer) (- pos))))))) - (assert (or (plusp (memref result -2 (+ -1 (* 2 (%bignum-bigits result))) :unsigned-byte16)) - (plusp (memref result -2 (+ -2 (* 2 (%bignum-bigits result))) :unsigned-byte16)))) + (assert (or (plusp (memref result -2 + :index (+ -1 (* 2 (%bignum-bigits result))) + :type :unsigned-byte16)) + (plusp (memref result -2 + :index (+ -2 (* 2 (%bignum-bigits result))) + :type :unsigned-byte16)))) (bignum-canonicalize result)))))) (t (let ((count (- count))) (etypecase integer @@ -913,9 +917,9 @@ (let ((src-max-bigit (* 2 (%bignum-bigits integer)))) (dotimes (i (* 2 (%bignum-bigits result))) (let ((src (+ i long))) - (setf (memref result -2 i :unsigned-byte16) + (setf (memref result -2 :index i :type :unsigned-byte16) (if (< src src-max-bigit) - (memref integer -2 src :unsigned-byte16) + (memref integer -2 :index src :type :unsigned-byte16) 0))))) (bignum-canonicalize (macrolet

1 0

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

11 Oct '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30647 Modified Files: inspect.lisp Log Message: Changed the signature of memref and (setf memref) to use keywords also for the index and type arguments. Date: Mon Oct 11 15:52:44 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.42 movitz/losp/muerte/inspect.lisp:1.43 --- movitz/losp/muerte/inspect.lisp:1.42 Fri Sep 24 11:33:16 2004 +++ movitz/losp/muerte/inspect.lisp Mon Oct 11 15:52:44 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.42 2004/09/24 09:33:16 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.43 2004/10/11 13:52:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -76,8 +76,8 @@ (let ((pos (+ frame index))) (assert (< -1 pos (length stack)) () "Index ~S, pos ~S, len ~S" index pos (length stack)) - (memref stack 2 pos type))) - (t (memref frame 0 index type)))) + (memref stack 2 :index pos :type type))) + (t (memref frame 0 :index index :type type)))) (defun (setf stack-frame-ref) (value stack frame index &optional (type ':lisp)) (cond @@ -86,8 +86,8 @@ (let ((pos (+ frame index))) (assert (< -1 pos (length stack)) () "Index ~S, pos ~S, len ~S" index pos (length stack)) - (setf (memref stack 2 pos type) value))) - (t (setf (memref frame 0 index type) value)))) + (setf (memref stack 2 :index pos :type type) value))) + (t (setf (memref frame 0 :index index :type type) value)))) (defun current-dynamic-context () (with-inline-assembly (:returns :eax) @@ -248,12 +248,9 @@ (dotimes (i (funobj-num-constants x) t) (unless (test funobj-constant-ref i))))) (symbol - (and (test memref #.(bt:slot-offset 'movitz:movitz-symbol 'movitz::function-value) - 0 :lisp) - (test memref #.(bt:slot-offset 'movitz:movitz-symbol 'movitz::name) - 0 :lisp) - (test memref #.(bt:slot-offset 'movitz:movitz-symbol 'movitz::flags) - 0 :lisp))) + (and (test memref (movitz-type-slot-offset 'movitz-symbol 'function-value)) + (test memref (movitz-type-slot-offset 'movitz-symbol 'name)) + (test memref (movitz-type-slot-offset 'movitz-symbol 'flags)))) (vector (and (typep y 'vector) (test array-element-type)

1 0