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

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

09 Aug '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv31425 Modified Files: packages.lisp Log Message: Added variable *compiler-physical-segment-prefix*, similar to *compiler-local-segment-prefix* etc. Date: Mon Aug 9 07:39:37 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.34 movitz/packages.lisp:1.35 --- movitz/packages.lisp:1.34 Tue Jul 20 05:39:16 2004 +++ movitz/packages.lisp Mon Aug 9 07:39:36 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.34 2004/07/20 12:39:16 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.35 2004/08/09 14:39:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1366,6 +1366,7 @@ #:*compiler-auto-stack-checks-p* #:*compiler-local-segment-prefix* #:*compiler-global-segment-prefix* + #:*compiler-physical-segment-prefix* #:*compiler-compile-eval-whens* #:*compiler-compile-macro-expanders* #:*compiler-allow-untagged-word-bits*

1 0

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

09 Aug '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv30432 Modified Files: compiler.lisp Log Message: Added variable *compiler-physical-segment-prefix*, similar to *compiler-local-segment-prefix* etc. Date: Mon Aug 9 07:39:31 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.90 movitz/compiler.lisp:1.91 --- movitz/compiler.lisp:1.90 Mon Aug 9 06:38:20 2004 +++ movitz/compiler.lisp Mon Aug 9 07:39:31 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.90 2004/08/09 13:38:20 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.91 2004/08/09 14:39:31 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -43,6 +43,10 @@ (defvar *compiler-global-segment-prefix* nil "Use these assembly-instruction prefixes when accessing the global 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).") (defvar *compiler-allow-untagged-word-bits* 0 "Allow (temporary) untagged values of this bit-size to exist, because

1 0

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

09 Aug '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv24944 Modified Files: image.lisp Log Message: Remove restify-dynamic-extent from run-time-context. Date: Mon Aug 9 06:38:55 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.62 movitz/image.lisp:1.63 --- movitz/image.lisp:1.62 Fri Aug 6 07:43:46 2004 +++ movitz/image.lisp Mon Aug 9 06:38: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.62 2004/08/06 14:43:46 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.63 2004/08/09 13:38:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -224,11 +224,6 @@ :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function :binary-type code-vector-word) - (restify-dynamic-extent - :binary-type code-vector-word - :map-binary-write 'movitz-intern-code-vector - :map-binary-read-delayed 'movitz-word-code-vector - :binary-tag :primitive-function) (box-u32-ecx :binary-type code-vector-word :map-binary-write 'movitz-intern-code-vector

1 0

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

09 Aug '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv13376 Modified Files: compiler.lisp Log Message: Be more restrictive about when to allow not setting up a stack-frame for a function. Use EDX rather than ECX for temporary holding the value of optional-p in 1req1opt prelude. Make the optimizer also optimize e.g. (:pushl (:ebp -8)) into (:pushl :eax) at the start of functions, not just similar :movl instructions. Date: Mon Aug 9 06:38:20 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.89 movitz/compiler.lisp:1.90 --- movitz/compiler.lisp:1.89 Sat Aug 7 04:10:19 2004 +++ movitz/compiler.lisp Mon Aug 9 06:38:20 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.89 2004/08/07 11:10:19 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.90 2004/08/09 13:38:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -715,10 +715,7 @@ (stack-frame-size (frame-map-size (frame-map function-env))) (use-stack-frame-p (or (plusp stack-frame-size) (tree-search resolved-code - '(:ebp :esp :call :leave)))) - (optional-stack-frame-p (tree-search resolved-optional-code - '(:ebp :esp :call :leave)))) - (assert (not optional-stack-frame-p)) + '(:pushl :popl :ebp :esp :call :leave))))) (let* ((function-code (let* ((req-binding (movitz-binding (first (required-vars function-env)) function-env nil)) @@ -735,13 +732,13 @@ (unless (eql nil opt-location) resolved-optional-code) (when optp-location - `((:movl :edi :ecx) - (:jmp 'optp-into-ecx-ok))) + `((:movl :edi :edx) + (:jmp 'optp-into-edx-ok))) '(entry%2op) (when optp-location `((,*compiler-global-segment-prefix* - :movl (:edi ,(global-constant-offset 't-symbol)) :ecx) - optp-into-ecx-ok)) + :movl (:edi ,(global-constant-offset 't-symbol)) :edx) + optp-into-edx-ok)) (when use-stack-frame-p +enter-stack-frame-code+) '(start-stack-frame-setup) @@ -769,7 +766,7 @@ ()) ((= optp-location (1+ stack-setup-pre)) (incf stack-setup-pre 1) - `((:pushl :ecx))) + `((:pushl :edx))) (t (error "Can't deal with optional-p at ~S, after (~S ~S)." optp-location req-location opt-location))) (make-stack-setup-code (- stack-frame-size stack-setup-pre)) @@ -1824,6 +1821,16 @@ (explain nil "load ~S already in ~S." i old-reg) `(:movl ,old-reg ,(twop-dst i)))) + ((and (instruction-is i :pushl) + (stack-frame-operand (idst i)) + (assoc (stack-frame-operand (idst i)) + frame-map)) + (let ((old-reg + (cdr (assoc (stack-frame-operand (idst i)) + frame-map)))) + (explain nil "push ~S already in ~S." + i old-reg) + `(:pushl ,old-reg))) (t i)))) (unless (eq new-i i) (setf mod-p t))

1 0

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

07 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv21194 Modified Files: primitive-functions.lisp Log Message: Started work on having the pf's comply with the stack and register disciplines. Date: Sat Aug 7 04:12:09 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.38 movitz/losp/muerte/primitive-functions.lisp:1.39 --- movitz/losp/muerte/primitive-functions.lisp:1.38 Fri Aug 6 13:54:17 2004 +++ movitz/losp/muerte/primitive-functions.lisp Sat Aug 7 04:12:09 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 2 21:02:18 2001 ;;;; -;;;; $Id: primitive-functions.lisp,v 1.38 2004/08/06 20:54:17 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.39 2004/08/07 11:12:09 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -308,7 +308,7 @@ (:int 110) (:halt) (:jmp 'not-initialized))) - (:addl 7 :ebx) + (:addl 4 :ebx) (:andb #xf8 :bl) (:movl (:eax 4) :ecx) ; cons pointer to ECX (:leal (:ebx :ecx) :edx) ; new roof to EDX @@ -353,7 +353,7 @@ (check-type words (integer 2 *)) (compiler-macro-call malloc-non-pointer-words words)) -(define-primitive-function muerte::get-cons-pointer () +(define-primitive-function get-cons-pointer () "Return in EAX the next object location with space for EAX words, with tag 6. Preserve ECX." (macrolet @@ -361,9 +361,14 @@ ;; Here we just call malloc, and don't care if the allocation ;; is never comitted. `(with-inline-assembly (:returns :multiple-values) + ;; We need a stack-frame sice we're using the stack + (:pushl :ebp) + (:movl :esp :ebp) + (:pushl 4) (:locally (:movl :ecx (:edi (:edi-offset scratch0)))) (:call-local-pf malloc-pointer-words) (:locally (:movl (:edi (:edi-offset scratch0)) :ecx)) + (:leave) (:ret)))) (do-it)))

1 0

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

07 Aug '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv13722 Modified Files: compiler.lisp Log Message: When *compiler-auto-stack-checks-p* is true, perform check also after allocating an &rest-list on the stack. Date: Sat Aug 7 04:10:19 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.88 movitz/compiler.lisp:1.89 --- movitz/compiler.lisp:1.88 Fri Aug 6 07:41:37 2004 +++ movitz/compiler.lisp Sat Aug 7 04:10:19 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.88 2004/08/06 14:41:37 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.89 2004/08/07 11:10:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -5972,6 +5972,9 @@ (:pushl :edi) (:subl 4 :edx) (:jnz ',restify-alloca-loop) + ,@(when *compiler-auto-stack-checks-p* + `((,*compiler-local-segment-prefix* + :bound (:edi ,(global-constant-offset 'stack-bottom)) :esp))) (:leal (:esp 5) :edx) (:andl -7 :edx)) ; Make EDX a proper consp into the alloca area. (cond

1 0

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

06 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv18883 Modified Files: primitive-functions.lisp Log Message: Removed some dead code. Date: Fri Aug 6 13:54:17 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.37 movitz/losp/muerte/primitive-functions.lisp:1.38 --- movitz/losp/muerte/primitive-functions.lisp:1.37 Wed Aug 4 06:00:33 2004 +++ movitz/losp/muerte/primitive-functions.lisp Fri Aug 6 13:54:17 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 2 21:02:18 2001 ;;;; -;;;; $Id: primitive-functions.lisp,v 1.37 2004/08/04 13:00:33 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.38 2004/08/06 20:54:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -296,122 +296,6 @@ search-failed (:ret))) ; success: ZF=0, eax=value -(define-primitive-function resolve-key-args (pos) - "" - ;; 1. Match each provided argument. - (with-inline-assembly (:returns :multiple-values) - (:leal (:ebp (:ecx 4) -4) :edx) - (:movl (:edx) :eax) - - - )) - - -;;;(define-primitive-function trampoline-restify-dynamic-extent-at0%2op () -;;; "Process &rest at position 0 in lambda-list, when 2 args are provided (ECX=2 is implied). -;;;EAX: arg0, EBX: arg1, Returns list in EAX and 2 in ECX. -;;;This is a special case of restify-dynamic-extent." -;;; (with-inline-assembly (:returns :nothing) -;;; (:popl :edx) ; return address -;;; (:pushl :edi) -;;; (:popl :edi) -;;; (:andl -8 :esp) -;;; (:pushl :ebx) ; cadr -;;; (:pushl :edi) ; cddr -;;; (:pushl :eax) ; car -;;; (:movl :esp :eax) -;;; (:subl 7 :eax) -;;; (:pushl :eax) -;;; (:addl 8 :eax) -;;; (:movl 2 :ecx) -;;; (:ret))) - - -(define-primitive-function restify-dynamic-extent () - "Process &rest. -EAX: arg0, EBX: arg1, ECX: numargs, EDX: rest-position, -EBP: stack-frame with rest of arguments, as per calling conventions. -Returns list in EAX and preserves numargs in ECX." - (with-inline-assembly (:returns :nothing) - (:cmpl :edx :ecx) - (:jle '(:sub-program () - (:movl :edi :eax) (:ret))) ; no rest at all. - - ;; Pop the return address into (:esp -8) and (:esp -12). - (:popl (:esp -8)) - (:subl 4 :esp) - (:popl (:esp -12)) - - (:pushl :edi) - (:popl :edi) - ;; Now the stack (below) looks like this: - ;; (:esp 0) = ??? - ;; (:esp -4) = EDI - ;; (:esp -8) = Return address - ;; (:esp -12) = Return address - - (:andl -8 :esp) ; align stack to 8 (subtracts 4 when required) - - ;; We now know the return address is in (:esp -8). - - (:testl :edx :edx) - (:jnz 'rest-pos-not-zero) ; arg0 doesn't go into rest. - - (:pushl :esp) ; cdr - (:subl 15 (:esp)) - - (:subl 4 :esp) - (:popl (:esp -12)) ; keep return address in (:esp -8) - - (:pushl :eax) ; car = eax - - (:movl :esp :eax) - (:incl :eax) ; store head of list in eax. - - (:incl :edx) - (:cmpl :edx :ecx) - (:je '(:sub-program (done-early) - (:movl :edi (:esp 4)) ; terminate list - (:movl (:esp -8) :ebx) ; load return address into ebx - (:jmp :ebx))) ; return - (:jmp 'rest-pos-was-zero) - - rest-pos-not-zero - (:leal (:esp -7) :eax) ; store head of list in eax. - - rest-pos-was-zero - (:cmpl 1 :edx) - (:jnz 'rest-pos-not-one-or-zero) - - (:pushl :esp) - (:subl 15 (:esp)) ; cdr - - (:subl 4 :esp) - (:popl (:esp -12)) ; keep return address in (:esp -8) - - (:pushl :ebx) ; car = ebx - - (:incl :edx) - (:cmpl :edx :ecx) - (:je 'done-early) - - rest-pos-not-one-or-zero - - (:movl (:esp -8) :ebx) ; load return address into ebx - (:negl :edx) - (:addl :ecx :edx) ; edx = (- ecx edx) - - loop - (:pushl :esp) - (:subl 15 (:esp)) ; cdr - (:pushl (:ebp (:edx 4) 4)) ; car = next arg - (:decl :edx) - (:jnz 'loop) - - done - - (:movl :edi (:esp 4)) ; terminate list - (:jmp :ebx))) ; return (define-primitive-function malloc-pointer-words () "Stupid allocator.. Number of words in EAX/fixnum.

1 0

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

06 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv14784 Modified Files: debugger.lisp Log Message: Minor tweak to backtrace. Date: Fri Aug 6 07:47:41 2004 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.19 movitz/losp/x86-pc/debugger.lisp:1.20 --- movitz/losp/x86-pc/debugger.lisp:1.19 Fri Jul 23 18:29:06 2004 +++ movitz/losp/x86-pc/debugger.lisp Fri Aug 6 07:47:41 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 22 10:09:18 2002 ;;;; -;;;; $Id: debugger.lisp,v 1.19 2004/07/24 01:29:06 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.20 2004/08/06 14:47:41 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -450,7 +450,8 @@ (loop with conflate-count = 0 with count = 0 for stack-frame = initial-stack-frame then (let ((uplink (stack-frame-uplink stack-frame))) - (assert (> uplink stack-frame)) + (assert (> uplink stack-frame) () + "Backtracing uplink ~S from frame ~S." uplink stack-frame) uplink) as funobj = (stack-frame-funobj stack-frame t) do (flet ((print-leadin (stack-frame count conflate-count)

1 0

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

06 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30685 Modified Files: memref.lisp Log Message: Implemented (setf memref-int) for type :unsigned-byte32. Date: Fri Aug 6 07:46:45 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.22 movitz/losp/muerte/memref.lisp:1.23 --- movitz/losp/muerte/memref.lisp:1.22 Fri Jul 23 18:28:27 2004 +++ movitz/losp/muerte/memref.lisp Fri Aug 6 07:46: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.22 2004/07/24 01:28:27 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.23 2004/08/06 14:46:45 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -722,6 +722,26 @@ (let* ((physicalp (movitz::eval-form physicalp env)) (prefixes (if physicalp '(:gs-override) ()))) (ecase type + (:unsigned-byte32 + (assert (= 4 movitz:+movitz-fixnum-factor+)) + (if (not (movitz:movitz-constantp offset env)) + form + (let ((offset (movitz:movitz-eval offset env)) + (addr-var (gensym "memref-int-address-")) + (value-var (gensym "memref-int-value-"))) + `(let ((,value-var ,value) + (,addr-var (+ ,address ,index))) + (with-inline-assembly (:returns :untagged-fixnum-ecx) + (:compile-form (:result-mode :untagged-fixnum-ecx) ,addr-var) + (:testb ,(logior movitz:+movitz-fixnum-zmask+ + (* 3 movitz:+movitz-fixnum-factor+)) + :cl) + (:jnz '(:sub-program () (:int 70))) + (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) ; a fixnum (zerop (mod x 4)) shifted + (:pushl :ecx) ; ..twice left is still a fixnum! + (:compile-form (:result-mode :untagged-fixnum-ecx) ,value-var) + (:popl :eax) + (:movl :ecx (:eax ,offset))))))) (:lisp (assert (= 4 movitz:+movitz-fixnum-factor+)) `(with-inline-assembly (:returns :untagged-fixnum-eax)

1 0

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

06 Aug '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23008 Modified Files: cons.lisp Log Message: Minor docstring edit. Date: Fri Aug 6 07:46:07 2004 Author: ffjeld Index: movitz/losp/muerte/cons.lisp diff -u movitz/losp/muerte/cons.lisp:1.6 movitz/losp/muerte/cons.lisp:1.7 --- movitz/losp/muerte/cons.lisp:1.6 Wed Jul 21 18:02:15 2004 +++ movitz/losp/muerte/cons.lisp Fri Aug 6 07:46:06 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 15:25:45 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: cons.lisp,v 1.6 2004/07/22 01:02:15 ffjeld Exp $ +;;;; $Id: cons.lisp,v 1.7 2004/08/06 14:46:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -19,7 +19,7 @@ (in-package muerte) (define-primitive-function fast-cdr-car (cell) - "Compute both the car and the cdr of a cell." + "Compute both the car (into EBX) and the cdr (into EAX) of a cell." (with-inline-assembly (:returns :eax) (:leal (:eax -1) :ecx) (:testb 3 :cl)

1 0