- movitz-cvs@common-lisp.net - mailman3.common-lisp.net

[movitz-cvs] CVS update: movitz/image.lisp
by Frode Vatvedt Fjeld 17 Nov '04

17 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv23332 Modified Files: image.lisp Log Message: Renamed dynamic-load to dynamic-variable-lookup, and dynamic-store to dynamic-variable-store. Date: Wed Nov 17 14:32:55 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.78 movitz/image.lisp:1.79 --- movitz/image.lisp:1.78 Sat Nov 13 17:10:09 2004 +++ movitz/image.lisp Wed Nov 17 14:32:54 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.78 2004/11/13 16:10:09 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.79 2004/11/17 13:32:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -161,17 +161,17 @@ :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) - (dynamic-load-unprotected + (dynamic-variable-lookup-unbound :map-binary-write 'movitz-intern-code-vector :binary-tag :primitive-function :map-binary-read-delayed 'movitz-word-code-vector :binary-type code-vector-word) - (dynamic-load + (dynamic-variable-lookup :map-binary-write 'movitz-intern-code-vector :binary-tag :primitive-function :map-binary-read-delayed 'movitz-word-code-vector :binary-type code-vector-word) - (dynamic-store + (dynamic-variable-store :map-binary-write 'movitz-intern-code-vector :binary-tag :primitive-function :map-binary-read-delayed 'movitz-word-code-vector

1 0

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

17 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv23313 Modified Files: compiler.lisp Log Message: Renamed dynamic-load to dynamic-variable-lookup, and dynamic-store to dynamic-variable-store. Date: Wed Nov 17 14:32:47 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.106 movitz/compiler.lisp:1.107 --- movitz/compiler.lisp:1.106 Tue Nov 16 00:08:57 2004 +++ movitz/compiler.lisp Wed Nov 17 14:32:46 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.106 2004/11/15 23:08:57 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.107 2004/11/17 13:32:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -5602,7 +5602,7 @@ :modifies nil :final-form form :code `((:load-constant ,form :eax) - (:call (:edi ,(global-constant-offset 'dynamic-load)))))) + (:call (:edi ,(global-constant-offset 'dynamic-variable-lookup)))))) (t (check-type binding dynamic-binding) (compiler-values () :returns :eax @@ -5610,7 +5610,7 @@ :modifies nil :final-form form :code `((:load-constant ,form :eax) - (:call (:edi ,(global-constant-offset 'dynamic-load)))))))))) + (:call (:edi ,(global-constant-offset 'dynamic-variable-lookup)))))))))) (define-compiler compile-lambda-form (&form form) "3.1.2.2.4 Lambda Forms"

1 0

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

15 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv19292 Modified Files: special-operators-cl.lisp Log Message: Change the compilation of unwind-protect to only use a single dynamic-env entry. Date: Tue Nov 16 00:10:24 2004 Author: ffjeld Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.34 movitz/special-operators-cl.lisp:1.35 --- movitz/special-operators-cl.lisp:1.34 Sat Nov 13 15:49:51 2004 +++ movitz/special-operators-cl.lisp Tue Nov 16 00:10:24 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.34 2004/11/13 14:49:51 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.35 2004/11/15 23:10:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1235,15 +1235,9 @@ :returns :multiple-values :code (append ;; install default continuation dynamic-env.. - `((:locally (:pushl (:edi (:edi-offset dynamic-env)))) ; uplink - (:declare-label-set ,continue-label (,continue)) - (:pushl ',continue-label) - (:locally (:pushl (:edi (:edi-offset unbound-value)))) - (:pushl :ebp) - (:locally (:movl :esp (:edi (:edi-offset dynamic-env))))) - ;; install unwind-protect dynamic-env.. `((:locally (:pushl (:edi (:edi-offset dynamic-env)))) (:declare-label-set ,cleanup-label (,cleanup-entry)) + (:declare-label-set ,continue-label (,continue)) (:pushl ',cleanup-label) ; jumper index (:globally (:pushl (:edi (:edi-offset unwind-protect-tag)))) ; tag (:pushl :ebp) ; stack-frame @@ -1256,13 +1250,14 @@ :result-mode :multiple-values :form protected-form) ;; From now on, take care not to touch current-values from protected-form. - `((:leal (:esp 16) :edx) ; default final continuation - (:locally (:movl :edx (:edi (:edi-offset raw-scratch0)))) + `((:locally (:movl :esp (:edi (:edi-offset raw-scratch0)))) ,cleanup-entry - (:movl (:esp 12) :edx) ; pop out of unwind-protect - (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) - (:popl :ebp) - (:leal (:esp 12) :esp) + + ;; Modify unwind-protect dyn-env-entry to be normal continuation + (:locally (:movl (:edi (:edi-offset unbound-value)) :edx)) + (:movl :edx (:esp 4)) ; not unwind-protect-tag + (:movl ',continue-label (:esp 8)) ; new jumper index + (:locally (:pushl (:edi (:edi-offset raw-scratch0))))) ; push final-continuation ;; Execute cleanup-forms. (compiler-call #'compile-form-unprotected @@ -1295,7 +1290,6 @@ (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) (:popl :ebp) (:leal (:esp 12) :esp)))))))) - (define-special-operator if (&all all &form form &env env &result-mode result-mode) (destructuring-bind (test-form then-form &optional else-form)

1 0

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

15 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv19254 Modified Files: compiler.lisp Log Message: Disable optimize-code-dirties, because the optimization it performed wasn't safe. Date: Tue Nov 16 00:08:57 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.105 movitz/compiler.lisp:1.106 --- movitz/compiler.lisp:1.105 Sat Nov 13 17:13:01 2004 +++ movitz/compiler.lisp Tue Nov 16 00:08:57 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.105 2004/11/13 16:13:01 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.106 2004/11/15 23:08:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1457,7 +1457,9 @@ "These optimizations may rearrange register usage in a way that is incompatible with other optimizations that track register usage. So this is performed just once, initially." - (labels + unoptimized-code + #+ignore + (labels ; This stuff doesn't work.. ((explain (always format &rest args) (when (or always *explain-peephole-optimizations*) (warn "Peephole: ~?~&----------------------------" format args))) @@ -1488,16 +1490,15 @@ as i1 = (first pc) ; current instruction, collected by default. and i2 = (second pc) and i3 = (third pc) while pc - do (cond - ((let ((regx (register-operand (twop-src i1 :movl))) - (regy (register-operand (twop-dst i1 :movl)))) - (and regx regy - (eq regx (twop-dst i2 :movl)) - (eq regx (twop-src i3 :cmpl)) - (eq regy (twop-dst i3 :cmpl)))) - (setq p (list `(:cmpl ,(twop-src i2) ,(twop-src i1))) - next-pc (nthcdr 3 pc)) - (explain nil "4: ~S for ~S" p (subseq pc 0 4)))) + do (let ((regx (register-operand (twop-src i1 :movl))) + (regy (register-operand (twop-dst i1 :movl)))) + (when (and regx regy + (eq regx (twop-dst i2 :movl)) + (eq regx (twop-src i3 :cmpl)) + (eq regy (twop-dst i3 :cmpl))) + (setq p (list `(:cmpl ,(twop-src i2) ,regx) i1) + next-pc (nthcdr 3 pc)) + (explain t "4: ~S for ~S [regx ~S, regy ~S]" p (subseq pc 0 5) regx regy))) nconc p))) (defun optimize-code-internal (unoptimized-code recursive-count &rest key-args

1 0

[movitz-cvs] CVS update: movitz/movitz.lisp
by Frode Vatvedt Fjeld 15 Nov '04

15 Nov '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv21455 Modified Files: movitz.lisp Log Message: *** empty log message *** Date: Mon Nov 15 15:42:16 2004 Author: ffjeld Index: movitz/movitz.lisp diff -u movitz/movitz.lisp:1.9 movitz/movitz.lisp:1.10 --- movitz/movitz.lisp:1.9 Thu Jul 29 02:13:09 2004 +++ movitz/movitz.lisp Mon Nov 15 15:42:15 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Mon Oct 9 20:52:58 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: movitz.lisp,v 1.9 2004/07/29 00:13:09 ffjeld Exp $ +;;;; $Id: movitz.lisp,v 1.10 2004/11/15 14:42:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -31,7 +31,7 @@ (ldb (byte 32 0) (- +code-vector-word-offset+))) -(defconstant +movitz-multiple-values-limit+ 127) +(defvar +movitz-multiple-values-limit+ 63) (defvar *bq-level* 0) (defvar *default-image-init-file* #p"losp/los0.lisp")

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/vga.lisp
by Frode Vatvedt Fjeld 14 Nov '04

14 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv31843 Modified Files: vga.lisp Log Message: Changed the signature of memref-int. Date: Sun Nov 14 23:58:33 2004 Author: ffjeld Index: movitz/losp/x86-pc/vga.lisp diff -u movitz/losp/x86-pc/vga.lisp:1.5 movitz/losp/x86-pc/vga.lisp:1.6 --- movitz/losp/x86-pc/vga.lisp:1.5 Wed Apr 21 18:24:16 2004 +++ movitz/losp/x86-pc/vga.lisp Sun Nov 14 23:58:33 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 25 14:08:20 2001 ;;;; -;;;; $Id: vga.lisp,v 1.5 2004/04/21 16:24:16 ffjeld Exp $ +;;;; $Id: vga.lisp,v 1.6 2004/11/14 22:58:33 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -314,7 +314,7 @@ (defun vmemwr (dst-off src start end) (loop for i from start below end as dst upfrom dst-off - do (setf (memref-int (vga-memory-map) 0 dst :unsigned-byte8 t) + do (setf (memref-int (vga-memory-map) :index dst :type :unsigned-byte8) (aref src i))) (values))

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/textmode.lisp
by Frode Vatvedt Fjeld 14 Nov '04

14 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv31822 Modified Files: textmode.lisp Log Message: Changed the signature of memref-int. Date: Sun Nov 14 23:58:24 2004 Author: ffjeld Index: movitz/losp/x86-pc/textmode.lisp diff -u movitz/losp/x86-pc/textmode.lisp:1.12 movitz/losp/x86-pc/textmode.lisp:1.13 --- movitz/losp/x86-pc/textmode.lisp:1.12 Thu Sep 23 13:05:51 2004 +++ movitz/losp/x86-pc/textmode.lisp Sun Nov 14 23:58:23 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Thu Nov 9 15:38:56 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: textmode.lisp,v 1.12 2004/09/23 11:05:51 ffjeld Exp $ +;;;; $Id: textmode.lisp,v 1.13 2004/11/14 22:58:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -95,10 +95,9 @@ (when (>= x *screen-width*) (textmode-write-char #\newline) (setf x *cursor-x* y *cursor-y*)) - (let ((index (+ x (* y *screen-stride*)))) - (setf (memref-int *screen* 0 index :unsigned-byte16 t) - (logior #x0700 (char-code c))) - (move-vga-cursor (setf *cursor-x* (1+ x)) y))))) + (setf (memref-int *screen* :index (+ x (* y *screen-stride*)) :type :unsigned-byte16) + (logior #x0700 (char-code c))) + (move-vga-cursor (setf *cursor-x* (1+ x)) y)))) nil) (defun textmode-copy-line (destination source count) @@ -137,19 +136,19 @@ (defun textmode-clear-line (from-column line) (let ((dest (+ *screen* (* line *screen-width* 2) (* from-column 2)))) (dotimes (i (- *screen-width* from-column)) - (setf (memref-int dest 0 i :unsigned-byte16 t) #x0720)))) + (setf (memref-int dest :index i :type :unsigned-byte16) #x0720)))) (defun write-word (word) (let ((dest (+ *screen* (* *cursor-x* 2) (* *cursor-y* *screen-width* 2)))) - (setf (memref-int dest 0 0 :unsigned-byte16 t) #x0723 - (memref-int dest 0 1 :unsigned-byte16 t) #x0778) + (setf (memref-int dest :index 0 :type :unsigned-byte16) #x0723 + (memref-int dest :index 1 :type :unsigned-byte16) #x0778) (write-word-lowlevel word (+ dest 4)) (textmode-write-char #\newline))) (defun write-word-nl (word) (let ((dest (+ *screen* (* *cursor-x* 2) (* *cursor-y* 160)))) - (setf (memref-int dest 0 0 :unsigned-byte16 t) #x0723 - (memref-int dest 0 1 :unsigned-byte16 t) #x0778) + (setf (memref-int dest :index 0 :type :unsigned-byte16) #x0723 + (memref-int dest :index 1 :type :unsigned-byte16) #x0778) (write-word-lowlevel word (+ dest 4)))) (defun write-word-bottom (word)

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/textmode-console.lisp
by Frode Vatvedt Fjeld 14 Nov '04

14 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv31796 Modified Files: textmode-console.lisp Log Message: Changed the signature of memref-int. Date: Sun Nov 14 23:58:16 2004 Author: ffjeld Index: movitz/losp/x86-pc/textmode-console.lisp diff -u movitz/losp/x86-pc/textmode-console.lisp:1.3 movitz/losp/x86-pc/textmode-console.lisp:1.4 --- movitz/losp/x86-pc/textmode-console.lisp:1.3 Mon Jan 19 12:23:52 2004 +++ movitz/losp/x86-pc/textmode-console.lisp Sun Nov 14 23:58:16 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Jul 8 15:13:24 2003 ;;;; -;;;; $Id: textmode-console.lisp,v 1.3 2004/01/19 11:23:52 ffjeld Exp $ +;;;; $Id: textmode-console.lisp,v 1.4 2004/11/14 22:58:16 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -62,14 +62,14 @@ (* line (console-width console) 2) (* from-column 2)))) (dotimes (i (- (console-width console) from-column)) - (setf (memref-int dest 0 i :unsigned-byte16) #x0720)) + (setf (memref-int dest :index i :type :unsigned-byte16) #x0720)) nil)) (defmethod (setf console-char) (character (console vga-text-console) x y) (when (and (below x (console-width console)) (below y (console-height console))) (let ((index (+ x (* y (stride console))))) - (setf (memref-int (base console) 0 index :unsigned-byte16) + (setf (memref-int (base console) :index index :type :unsigned-byte16) (logior (ash (color console) 8) (char-code character))))) character) @@ -77,7 +77,7 @@ (when (and (below x (console-width console)) (below y (console-height console))) (let* ((index (+ x (* y (stride console)))) - (code (memref-int (base console) 0 index :unsigned-byte16))) + (code (memref-int (base console) :index index :type :unsigned-byte16))) (code-char (ldb (byte 8 0) code))))) (defmethod put-string ((console vga-text-console) string x y @@ -88,7 +88,7 @@ for column from x below (console-width console) for i from start below end as character = (char string i) - do (setf (memref-int base 0 cursor :unsigned-byte16) + do (setf (memref-int base :index cursor :type :unsigned-byte16) (logior color (char-code character))))) string) @@ -97,7 +97,7 @@ (loop with base = (base console) for index upfrom (+ x (* y (stride console))) for column from x below (console-width console) - do (setf (memref-int base 0 index :unsigned-byte16) + do (setf (memref-int base :index index :type :unsigned-byte16) #x0720)))) (defmethod scroll-down ((console vga-text-console)) @@ -106,8 +106,8 @@ for row from (base console) by ystride do (loop with next-row = (+ row ystride) for x below (console-width console) - do (setf (memref-int row 0 x :unsigned-byte16) - (memref-int next-row 0 x :unsigned-byte16)))) + do (setf (memref-int row :index x :type :unsigned-byte16) + (memref-int next-row :index x :type :unsigned-byte16)))) nil) (defmethod stream-read-char ((stream vga-text-console))

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/pci.lisp
by Frode Vatvedt Fjeld 14 Nov '04

14 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv31766 Modified Files: pci.lisp Log Message: Changed the signature of memref-int. Date: Sun Nov 14 23:58:02 2004 Author: ffjeld Index: movitz/losp/x86-pc/pci.lisp diff -u movitz/losp/x86-pc/pci.lisp:1.3 movitz/losp/x86-pc/pci.lisp:1.4 --- movitz/losp/x86-pc/pci.lisp:1.3 Wed May 5 10:24:38 2004 +++ movitz/losp/x86-pc/pci.lisp Sun Nov 14 23:58:02 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sun Dec 14 22:33:42 2003 ;;;; -;;;; $Id: pci.lisp,v 1.3 2004/05/05 08:24:38 ffjeld Exp $ +;;;; $Id: pci.lisp,v 1.4 2004/11/14 22:58:02 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -20,12 +20,11 @@ (defun find-bios32 () (loop for bios32 from #xe0000 to #xffff0 by 16 - if (and (= (memref-int bios32 0 0 :unsigned-byte16 t) #x335f) - (= (memref-int bios32 0 1 :unsigned-byte16 t) #x5f32) + if (and (= (memref-int bios32) #x5f32335f) (loop with checksum = 0 - ;; initially (warn "PCI magic found at #x~X" bios32) - as i from 0 below (* 16 (memref-int bios32 0 9 :unsigned-byte8 t)) + ;; initially (warn "PCI magic found at #x~X" bios32) + as i from 0 below (* 16 (memref-int bios32 :offset 9 :type :unsigned-byte8)) do (incf checksum - (memref-int bios32 0 i :unsigned-byte8 t)) + (memref-int bios32 :offset i :type :unsigned-byte8)) finally (return (= 0 (ldb (byte 8 0 ) checksum))))) return bios32))

1 0

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

14 Nov '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv31743 Modified Files: memref.lisp Log Message: Changed the signature of memref-int. Date: Sun Nov 14 23:57:46 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.37 movitz/losp/muerte/memref.lisp:1.38 --- movitz/losp/muerte/memref.lisp:1.37 Wed Nov 10 16:30:53 2004 +++ movitz/losp/muerte/memref.lisp Sun Nov 14 23:57:45 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.37 2004/11/10 15:30:53 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.38 2004/11/14 22:57:45 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -759,8 +759,9 @@ (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) +(define-compiler-macro memref-int + (&whole form address &key (offset 0) (index 0) (type :unsigned-byte32) (physicalp t) + &environment env) (if (or (not (movitz:movitz-constantp type physicalp)) (not (movitz:movitz-constantp physicalp env))) form @@ -793,9 +794,6 @@ (:shll 2 :ecx) (:addl :ebx :eax) (:into) -;;; (:testb ,(mask-field (byte (+ 2 movitz::+movitz-fixnum-shift+) 0) -1) -;;; :al) -;;; (:jnz '(:sub-program () (:int 63))) (:addl :eax :ecx) (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale down address (,prefixes :movl (:ecx) :ecx))))) @@ -852,31 +850,32 @@ (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) ; scale down address (,prefixes :movzxw (:ecx) :ecx))))))))))) -(defun memref-int (address offset index type &optional physicalp) +(defun memref-int (address &key (offset 0) (index 0) (type :unsigned-byte32) (physicalp t)) (cond - ((not physicalp) + (physicalp (ecase type (:lisp - (memref-int address offset index :lisp)) + (memref-int address :offset offset :index index)) (:unsigned-byte8 - (memref-int address offset index :unsigned-byte8)) + (memref-int address :offset offset :index index :type :unsigned-byte8)) (:unsigned-byte16 - (memref-int address offset index :unsigned-byte16)) + (memref-int address :offset offset :index index :type :unsigned-byte16)) (:unsigned-byte32 - (memref-int address offset index :unsigned-byte32)))) - (physicalp + (memref-int address :offset offset :index index)))) + ((not physicalp) (ecase type (:lisp - (memref-int address offset index :lisp t)) + (memref-int address :offset offset :index index :physicalp nil)) (:unsigned-byte8 - (memref-int address offset index :unsigned-byte8 t)) + (memref-int address :offset offset :index index :type :unsigned-byte8 :physicalp nil)) (:unsigned-byte16 - (memref-int address offset index :unsigned-byte16 t)) + (memref-int address :offset offset :index index :type :unsigned-byte16 :physicalp nil)) (:unsigned-byte32 - (memref-int address offset index :unsigned-byte32 t)))))) + (memref-int address :offset offset :index index :physicalp nil)))))) -(define-compiler-macro (setf memref-int) (&whole form &environment env value address offset index type - &optional physicalp) +(define-compiler-macro (setf memref-int) + (&whole form value address &key (offset 0) (index 0) (type :type) (physicalp t) + &environment env) (if (or (not (movitz:movitz-constantp type env)) (not (movitz:movitz-constantp physicalp env))) (progn @@ -977,20 +976,25 @@ (:leal ((:eax ,movitz:+movitz-fixnum-factor+)) :eax) (:cld))))))))))) -(defun (setf memref-int) (value address offset index type &optional physicalp) +(defun (setf memref-int) + (value address &key (offset 0) (index 0) (type :unsigned-byte32) (physicalp t)) (cond - ((not physicalp) + (physicalp (ecase type (:unsigned-byte8 - (setf (memref-int address offset index :unsigned-byte8) value)) + (setf (memref-int address :offset offset :index index :type :unsigned-byte8) + value)) (:unsigned-byte16 - (setf (memref-int address offset index :unsigned-byte16) value)))) - (physicalp + (setf (memref-int address :offset offset :index index :type :unsigned-byte16) + value)))) + ((not physicalp) (ecase type (:unsigned-byte8 - (setf (memref-int address offset index :unsigned-byte8 t) value)) + (setf (memref-int address :offset offset :index index :type :unsigned-byte8 :physicalp nil) + value)) (:unsigned-byte16 - (setf (memref-int address offset index :unsigned-byte16 t) value)))))) + (setf (memref-int address :offset offset :index index :type :unsigned-byte16 :physicalp nil) + value)))))) (defun memcopy (object-1 object-2 offset index-1 index-2 count type) (ecase type

1 0