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

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

10 Aug '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv16978 Modified Files: image.lisp Log Message: Changed the way the interrupt-descriptor-table is generated. Now, the host/build-time value is a vector whose elements are names of primitive-functions that act as interrupt trampolines. Each such trampoline (ie. at present only muerte:default-interrupt-trampoline) at position x in the table must define an (integer) assembly-level label x, which will become the entry-point of that interrupt-gate. Date: Tue Aug 10 06:25:16 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.63 movitz/image.lisp:1.64 --- movitz/image.lisp:1.63 Mon Aug 9 06:38:54 2004 +++ movitz/image.lisp Tue Aug 10 06:25:16 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.63 2004/08/09 13:38:54 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.64 2004/08/10 13:25:16 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -358,9 +358,9 @@ (interrupt-descriptor-table :binary-type word :accessor movitz-run-time-context-interrupt-descriptor-table - :initarg :interrupt-descriptor-table + :initform (make-array 256 :initial-element 'muerte::default-interrupt-trampoline) :map-binary-read-delayed 'movitz-word - :map-binary-write 'map-idt-to-array) + :map-binary-write 'map-interrupt-trampolines-to-idt) (toplevel-funobj :binary-type word :initform nil @@ -813,8 +813,6 @@ 'segment-descriptor-table)) 16)) (warn "Segment descriptor table is not aligned on a 16-byte boundary.")) - (setf (movitz-run-time-context-interrupt-descriptor-table (image-run-time-context *image*)) - (movitz-read (make-initial-interrupt-descriptors))) (setf (image-t-symbol *image*) (movitz-read t)) ;; (warn "NIL value: #x~X" (image-nil-word *image*)) *image*))

1 0

[movitz-cvs] CVS update: movitz/packages.lisp
by Frode Vatvedt Fjeld 10 Aug '04

10 Aug '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv27328 Modified Files: packages.lisp Log Message: More symbols. Date: Tue Aug 10 06:03:06 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.35 movitz/packages.lisp:1.36 --- movitz/packages.lisp:1.35 Mon Aug 9 07:39:36 2004 +++ movitz/packages.lisp Tue Aug 10 06:03:06 2004 @@ -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.35 2004/08/09 14:39:36 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.36 2004/08/10 13:03:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1367,6 +1367,8 @@ #:*compiler-local-segment-prefix* #:*compiler-global-segment-prefix* #:*compiler-physical-segment-prefix* + #:*compiler-nonlocal-lispval-read-segment-prefix* + #:*compiler-nonlocal-lispval-write-segment-prefix* #:*compiler-compile-eval-whens* #:*compiler-compile-macro-expanders* #:*compiler-allow-untagged-word-bits*

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/interrupt.lisp
by Frode Vatvedt Fjeld 10 Aug '04

10 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv20610 Modified Files: interrupt.lisp Log Message: Remove dead macro end-of-interrupt. Date: Tue Aug 10 05:59:36 2004 Author: ffjeld Index: movitz/losp/x86-pc/interrupt.lisp diff -u movitz/losp/x86-pc/interrupt.lisp:1.9 movitz/losp/x86-pc/interrupt.lisp:1.10 --- movitz/losp/x86-pc/interrupt.lisp:1.9 Tue Apr 6 17:12:28 2004 +++ movitz/losp/x86-pc/interrupt.lisp Tue Aug 10 05:59:36 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri May 4 18:08:50 2001 ;;;; -;;;; $Id: interrupt.lisp,v 1.9 2004/04/07 00:12:28 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.10 2004/08/10 12:59:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -18,11 +18,6 @@ (provide :x86-pc/interrupt) (in-package muerte.x86-pc) - -(defmacro end-of-interrupt () - '(with-inline-assembly (:returns :nothing) - (:movb #x20 :al) - (:outb :al #x20))) (defun idt-init () (init-pic8259 32 40)

1 0

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

10 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv32225/losp/muerte Modified Files: memref.lisp Log Message: Add some support for *compiler-nonlocal-lispval-{read,write}-segment-prefix*. Date: Tue Aug 10 05:58:28 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.24 movitz/losp/muerte/memref.lisp:1.25 --- movitz/losp/muerte/memref.lisp:1.24 Mon Aug 9 07:39:41 2004 +++ movitz/losp/muerte/memref.lisp Tue Aug 10 05:58:28 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.24 2004/08/09 14:39:41 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.25 2004/08/10 12:58:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -18,8 +18,10 @@ (in-package muerte) -(define-compiler-macro memref (&whole form object offset index type &environment env) - (if (not (movitz:movitz-constantp type env)) +(define-compiler-macro memref (&whole form object offset index type &key (localp nil) + &environment env) + (if (or (not (movitz:movitz-constantp type env)) + (not (movitz:movitz-constantp localp env))) form (labels ((sub-extract-constant-delta (form) "Try to extract at compile-time an integer offset from form." @@ -220,32 +222,36 @@ (:addl :ebx :ecx) (:movl (:eax :ecx ,(offset-by 4)) :ecx))))))) (:lisp - (cond - ((and (eql 0 index) (eql 0 offset)) - `(with-inline-assembly (:returns :register) - (:compile-form (:result-mode :register) ,object) - (:movl ((:result-register) ,(offset-by 4)) (:result-register)))) - ((eql 0 offset) - `(with-inline-assembly (:returns :eax) - (:compile-two-forms (:eax :ecx) ,object ,index) - ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2)) - `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ecx)) - (:movl (:eax :ecx ,(offset-by 4)) :eax))) - ((eql 0 index) - `(with-inline-assembly (:returns :eax) - (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object ,offset) - (:movl (:eax :ecx ,(offset-by 4)) :eax))) - (t (assert (not (movitz:movitz-constantp offset env))) - (assert (not (movitz:movitz-constantp index env))) - (let ((object-var (gensym "memref-object-"))) - (assert (= 4 movitz:+movitz-fixnum-factor+)) - `(let ((,object-var ,object)) - (with-inline-assembly (:returns :eax) - (:compile-two-forms (:ecx :ebx) ,offset ,index) - (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) - (:load-lexical (:lexical-binding ,object-var) :eax) - (:addl :ebx :ecx) - (:movl (:eax :ecx ,(offset-by 4)) :eax))))))) + (let* ((localp (movitz:movitz-eval localp env)) + (prefixes (if localp + nil + movitz:*compiler-nonlocal-lispval-read-segment-prefix*))) + (cond + ((and (eql 0 index) (eql 0 offset)) + `(with-inline-assembly (:returns :register) + (:compile-form (:result-mode :register) ,object) + (,prefixes :movl ((:result-register) ,(offset-by 4)) (:result-register)))) + ((eql 0 offset) + `(with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ecx) ,object ,index) + ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2)) + `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ecx)) + (,prefixes :movl (:eax :ecx ,(offset-by 4)) :eax))) + ((eql 0 index) + `(with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object ,offset) + (,prefixes :movl (:eax :ecx ,(offset-by 4)) :eax))) + (t (assert (not (movitz:movitz-constantp offset env))) + (assert (not (movitz:movitz-constantp index env))) + (let ((object-var (gensym "memref-object-"))) + (assert (= 4 movitz:+movitz-fixnum-factor+)) + `(let ((,object-var ,object)) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:ecx :ebx) ,offset ,index) + (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) + (:load-lexical (:lexical-binding ,object-var) :eax) + (:addl :ebx :ecx) + (,prefixes :movl (:eax :ecx ,(offset-by 4)) :eax)))))))) (:code-vector ;; A code-vector is like a normal lisp word pointer, ;; except it's known to point to a code-vector, and @@ -297,8 +303,10 @@ (: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) - (if (not (movitz:movitz-constantp type env)) +(define-compiler-macro (setf memref) (&whole form &environment env value object offset index type + &key (localp nil)) + (if (or (not (movitz:movitz-constantp type env)) + (not (movitz:movitz-constantp localp env))) form (case (movitz::eval-form type) (:character @@ -544,33 +552,37 @@ (:movb :ah (:ebx :ecx))) ,value-var))))) (:lisp - (cond - ((and (movitz:movitz-constantp offset env) - (movitz:movitz-constantp index env)) - `(with-inline-assembly (:returns :eax) - (:compile-two-forms (:eax :ebx) ,value ,object) - (:movl :eax (:ebx ,(+ (movitz:movitz-eval offset env) - (* 4 (movitz:movitz-eval index env))))))) - ((movitz:movitz-constantp offset env) - (let ((value-var (gensym "memref-value-"))) - `(let ((,value-var ,value)) - (with-inline-assembly (:returns :eax) - (:compile-two-forms (:ebx :ecx) ,object ,index) - (:load-lexical (:lexical-binding ,value-var) :eax) - ,@(when (plusp (- movitz:+movitz-fixnum-shift+ 2)) - `((:sarl ,(- movitz:+movitz-fixnum-shift+ 2)) :ecx)) - (:movl :eax (:ebx :ecx ,(movitz:movitz-eval offset env))))))) - (t (let ((value-var (gensym "memref-value-")) - (object-var (gensym "memref-object-"))) - `(let ((,value-var ,value) (,object-var ,object)) + (let* ((localp (movitz:movitz-eval localp env)) + (prefixes (if localp + nil + movitz:*compiler-nonlocal-lispval-write-segment-prefix*))) + (cond + ((and (movitz:movitz-constantp offset env) + (movitz:movitz-constantp index env)) + `(with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ebx) ,value ,object) + (,prefixes :movl :eax (:ebx ,(+ (movitz:movitz-eval offset env) + (* 4 (movitz:movitz-eval index env))))))) + ((movitz:movitz-constantp offset env) + (let ((value-var (gensym "memref-value-"))) + `(let ((,value-var ,value)) (with-inline-assembly (:returns :eax) - (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,offset ,index) + (:compile-two-forms (:ebx :ecx) ,object ,index) (:load-lexical (:lexical-binding ,value-var) :eax) - ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2)) - `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ebx)) - (:addl :ebx :ecx) ; index += offset - (:load-lexical (:lexical-binding ,object-var) :ebx) - (:movl :eax (:ebx :ecx)))))))) + ,@(when (plusp (- movitz:+movitz-fixnum-shift+ 2)) + `((:sarl ,(- movitz:+movitz-fixnum-shift+ 2)) :ecx)) + (,prefixes :movl :eax (:ebx :ecx ,(movitz:movitz-eval offset env))))))) + (t (let ((value-var (gensym "memref-value-")) + (object-var (gensym "memref-object-"))) + `(let ((,value-var ,value) (,object-var ,object)) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,offset ,index) + (:load-lexical (:lexical-binding ,value-var) :eax) + ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2)) + `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ebx)) + (:addl :ebx :ecx) ; index += offset + (:load-lexical (:lexical-binding ,object-var) :ebx) + (,prefixes :movl :eax (:ebx :ecx))))))))) (:code-vector (cond ((and (movitz:movitz-constantp offset env)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
by Frode Vatvedt Fjeld 10 Aug '04

10 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv29984/losp/muerte Modified Files: arrays.lisp Log Message: Add some support for *compiler-nonlocal-lispval-{read,write}-segment-prefix*. Date: Tue Aug 10 05:58:23 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.41 movitz/losp/muerte/arrays.lisp:1.42 --- movitz/losp/muerte/arrays.lisp:1.41 Tue Jul 27 06:46:39 2004 +++ movitz/losp/muerte/arrays.lisp Tue Aug 10 05:58:22 2004 @@ -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.41 2004/07/27 13:46:39 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.42 2004/08/10 12:58:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -309,7 +309,8 @@ (:addl ,movitz:+movitz-fixnum-factor+ :eax) (:jmp 'return) :any-t - (:movl (:eax :ebx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data)) + (,movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax :ebx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data)) :eax) return))) (do-it))))) @@ -346,7 +347,8 @@ ;; t? (:cmpl ,(movitz:basic-vector-type-tag :any-t) :ecx) (:jne 'not-any-t-vector) - (:movl :eax + (,movitz:*compiler-nonlocal-lispval-write-segment-prefix* + :movl :eax (:ebx :edx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data))) (:jmp 'return) @@ -433,6 +435,7 @@ `(setf (memref ,simple-vector 2 ,index :lisp) ,value)) (defun svref%unsafe (simple-vector index) +;; (compiler-macro-call svref%unsafe simple-vector index)) (with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ebx) simple-vector index) (:movl (:eax :ebx #.(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data)) :eax)))

1 0

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

10 Aug '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv10403 Modified Files: compiler.lisp Log Message: Added variables *compiler-nonlocal-lispval-read-segment-prefix* and *compiler-nonlocal-lispval-write-segment-prefix*, which are the instruction prefixes the compiler should add when writing (potential) pointer values to (potentially) nonlocal cells. Also, changed make-compiled-primitive to also return the code-vectors symtab. Date: Tue Aug 10 05:56:12 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.91 movitz/compiler.lisp:1.92 --- movitz/compiler.lisp:1.91 Mon Aug 9 07:39:31 2004 +++ movitz/compiler.lisp Tue Aug 10 05:56:12 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.91 2004/08/09 14:39:31 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.92 2004/08/10 12:56:12 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -45,8 +45,15 @@ run-time context.") (defvar *compiler-physical-segment-prefix* '(:gs-override) - "Use this instruction prefix when accessing a physical memory location -(i.e. typically some memory-mapped hardware device).") + "Use this instruction prefix when accessing a physical memory location (i.e. typically some memory-mapped hardware device).") + +(defvar *compiler-nonlocal-lispval-read-segment-prefix* '(:fs-override) + "Use this segment prefix when reading a lispval at (potentially) +non-local locations.") + +(defvar *compiler-nonlocal-lispval-write-segment-prefix* '(:fs-override) + "Use this segment prefix when writing a lispval at (potentially) +non-local locations.") (defvar *compiler-allow-untagged-word-bits* 0 "Allow (temporary) untagged values of this bit-size to exist, because @@ -102,18 +109,20 @@ :result-mode :ignore)) ;; (ignmore (format t "~{~S~%~}" body-code)) (resolved-code (finalize-code body-code nil nil)) - (function-code (ia-x86:read-proglist resolved-code)) - (code-vector (ia-x86:proglist-encode :octet-vector - :32-bit - #x00000000 - function-code - :symtab-lookup - #'(lambda (label) - (case label - (:nil-value (image-nil-word *image*))))))) - (make-movitz-vector (length code-vector) - :element-type 'code - :initial-contents code-vector))) + (function-code (ia-x86:read-proglist resolved-code))) + (multiple-value-bind (code-vector symtab) + (ia-x86:proglist-encode :octet-vector + :32-bit + #x00000000 + function-code + :symtab-lookup + #'(lambda (label) + (case label + (:nil-value (image-nil-word *image*))))) + (values (make-movitz-vector (length code-vector) + :element-type 'code + :initial-contents code-vector) + symtab)))) (defun register-function-code-size (funobj) (let* ((name (movitz-print (movitz-funobj-name funobj)))

1 0

[movitz-cvs] CVS update: ia-x86/read.lisp
by Frode Vatvedt Fjeld 10 Aug '04

10 Aug '04

Update of /project/movitz/cvsroot/ia-x86 In directory common-lisp.net:/tmp/cvs-serv23378 Modified Files: read.lisp Log Message: Support integer labels. Date: Tue Aug 10 03:12:57 2004 Author: ffjeld Index: ia-x86/read.lisp diff -u ia-x86/read.lisp:1.5 ia-x86/read.lisp:1.6 --- ia-x86/read.lisp:1.5 Mon Jun 21 00:33:50 2004 +++ ia-x86/read.lisp Tue Aug 10 03:12:57 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Mon Jul 31 13:54:27 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: read.lisp,v 1.5 2004/06/21 07:33:50 ffjeld Exp $ +;;;; $Id: read.lisp,v 1.6 2004/08/10 10:12:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -269,7 +269,7 @@ (loop for expr in program if (null expr) do (error "Illegal NIL expr in program: ~S" program) - else if (symbolp expr) + else if (or (symbolp expr) (integerp expr)) collect expr ; a label, collect it. else if (inline-data-p expr) collect (read-inline-data expr) ; inline data, read it.

1 0

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

10 Aug '04

Update of /project/movitz/cvsroot/ia-x86 In directory common-lisp.net:/tmp/cvs-serv19437 Modified Files: proglist.lisp Log Message: Support integer labels. Date: Tue Aug 10 03:12:53 2004 Author: ffjeld Index: ia-x86/proglist.lisp diff -u ia-x86/proglist.lisp:1.3 ia-x86/proglist.lisp:1.4 --- ia-x86/proglist.lisp:1.3 Mon Feb 9 16:04:04 2004 +++ ia-x86/proglist.lisp Tue Aug 10 03:12:52 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.3 2004/02/10 00:04:04 ffjeld Exp $ +;;;; $Id: proglist.lisp,v 1.4 2004/08/10 10:12:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -182,7 +182,7 @@ (loop for expr-rest on prog-list do (let ((expr (first expr-rest))) (etypecase expr - (SYMBOL + ((or SYMBOL integer) (setf (assemble-env-symtab env) (symtab-def-label (assemble-env-symtab env) expr

1 0

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

09 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv1195 Modified Files: textmode.lisp Log Message: Added variable *compiler-physical-segment-prefix*, similar to *compiler-local-segment-prefix* etc. Date: Mon Aug 9 07:39:46 2004 Author: ffjeld Index: movitz/losp/x86-pc/textmode.lisp diff -u movitz/losp/x86-pc/textmode.lisp:1.9 movitz/losp/x86-pc/textmode.lisp:1.10 --- movitz/losp/x86-pc/textmode.lisp:1.9 Thu Jul 29 05:48:35 2004 +++ movitz/losp/x86-pc/textmode.lisp Mon Aug 9 07:39:46 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.9 2004/07/29 12:48:35 ffjeld Exp $ +;;;; $Id: textmode.lisp,v 1.10 2004/08/09 14:39:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -116,8 +116,8 @@ (:shrl 1 :ebx) (:jz 'end-copy-loop) copy-loop - ((:gs-override) :movl (:eax :ebx -4) :ecx) - ((:gs-override) :movl :ecx (:edx :ebx -4)) + (#.movitz:*compiler-physical-segment-prefix* :movl (:eax :ebx -4) :ecx) + (#.movitz:*compiler-physical-segment-prefix* :movl :ecx (:edx :ebx -4)) (:subl 4 :ebx) (:ja 'copy-loop) end-copy-loop @@ -180,26 +180,27 @@ (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) (:movb 2 :cl) - ((:gs-override) :movl #x07000700 (:ebx 0)) - ((:gs-override) :movl #x07000700 (:ebx 4)) - ((:gs-override) :movl #x07000700 (:ebx 8)) - ((:gs-override) :movl #x07000700 (:ebx 12)) + (,movitz:*compiler-physical-segment-prefix* + :movl #x07000700 (:ebx 0)) + (,movitz:*compiler-physical-segment-prefix* :movl #x07000700 (:ebx 4)) + (,movitz:*compiler-physical-segment-prefix* :movl #x07000700 (:ebx 8)) + (,movitz:*compiler-physical-segment-prefix* :movl #x07000700 (:ebx 12)) ,loop-label (:andl #x0f0f0f0f :eax) (:addl #x30303030 :eax) (:cmpb #x39 :al) (:jle ',l1) (:addb 7 :al) - ,l1 ((:gs-override) :movb :al (14 :ebx)) ; 8 + ,l1 (,movitz:*compiler-physical-segment-prefix* :movb :al (14 :ebx)) ; 8 (:cmpb #x39 :ah) (:jle ',l2) (:addb 7 :ah) - ,l2 ((:gs-override) :movb :ah (10 :ebx)) ; 6 + ,l2 (,movitz:*compiler-physical-segment-prefix* :movb :ah (10 :ebx)) ; 6 (:shrl 16 :eax) (:cmpb #x39 :al) (:jle ',l3) (:addb 7 :al) - ,l3 ((:gs-override) :movb :al (6 :ebx)) ; 4 + ,l3 (,movitz:*compiler-physical-segment-prefix* :movb :al (6 :ebx)) ; 4 (:cmpb #x39 :ah) (:jle ',l4) (:addb 7 :ah) - ,l4 ((:gs-override) :movb :ah (2 :ebx)) ; 2 + ,l4 (,movitz:*compiler-physical-segment-prefix* :movb :ah (2 :ebx)) ; 2 (:movl :edx :eax) (:shrl 4 :eax)

1 0

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

09 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv576 Modified Files: memref.lisp Log Message: Added variable *compiler-physical-segment-prefix*, similar to *compiler-local-segment-prefix* etc. Date: Mon Aug 9 07:39:41 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.23 movitz/losp/muerte/memref.lisp:1.24 --- movitz/losp/muerte/memref.lisp:1.23 Fri Aug 6 07:46:45 2004 +++ movitz/losp/muerte/memref.lisp Mon Aug 9 07:39:41 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.23 2004/08/06 14:46:45 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.24 2004/08/09 14:39:41 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -628,7 +628,9 @@ (not (movitz:movitz-constantp physicalp env))) form (let* ((physicalp (movitz::eval-form physicalp env)) - (prefixes (if physicalp '(:gs-override) ()))) + (prefixes (if (not physicalp) + () + movitz:*compiler-physical-segment-prefix*))) (ecase (movitz::eval-form type) (:lisp `(with-inline-assembly (:returns :eax) @@ -720,7 +722,9 @@ (warn "setf memref-int form: ~S, ~S ~S" form type physicalp) form) (let* ((physicalp (movitz::eval-form physicalp env)) - (prefixes (if physicalp '(:gs-override) ()))) + (prefixes (if (not physicalp) + () + movitz:*compiler-physical-segment-prefix*))) (ecase type (:unsigned-byte32 (assert (= 4 movitz:+movitz-fixnum-factor+))

1 0