January 2005 - movitz-cvs@common-lisp.net

[movitz-cvs] CVS update: movitz/losp/muerte/interrupt.lisp
by ffjeld＠common-lisp.net 25 Jan '05

25 Jan '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16828 Modified Files: interrupt.lisp Log Message: Minor tweaks in the DIT. Date: Tue Jan 25 05:50:17 2005 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.35 movitz/losp/muerte/interrupt.lisp:1.36 --- movitz/losp/muerte/interrupt.lisp:1.35 Mon Jan 17 02:51:09 2005 +++ movitz/losp/muerte/interrupt.lisp Tue Jan 25 05:50:16 2005 @@ -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.35 2005/01/17 10:51:09 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.36 2005/01/25 13:50:16 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -21,6 +21,7 @@ (defvar *last-dit-frame* nil) (defconstant +dit-frame-map+ + ;; Do NOT rearrange this randomly. '(:eflags :cs :eip :error-code :exception-vector :ebp :funobj @@ -275,8 +276,9 @@ (:int 63))) (:cmpw ,(movitz:basic-vector-type-tag :code) (:eax ,movitz:+other-type-offset+)) (:jne 'pf-continuation-not-code-vector) - (:leal (:eax ,movitz:+code-vector-word-offset+) :ecx) - (:movl :ecx (:ebp ,(dit-frame-offset :eip))) + (:movl ,movitz:+code-vector-word-offset+ (:ebp ,(dit-frame-offset :eip))) + (:addl :eax (:ebp ,(dit-frame-offset :eip))) + (:jmp 'normal-return) not-restart-continuation

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.lisp
by ffjeld＠common-lisp.net 25 Jan '05

25 Jan '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16792 Modified Files: inspect.lisp Log Message: Fixed %find-code-vector. Date: Tue Jan 25 05:49:51 2005 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.45 movitz/losp/muerte/inspect.lisp:1.46 --- movitz/losp/muerte/inspect.lisp:1.45 Tue Dec 21 06:27:09 2004 +++ movitz/losp/muerte/inspect.lisp Tue Jan 25 05:49:51 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001, 2003-2004, +;;;; Copyright (C) 2001, 2003-2005, ;;;; Department of Computer Science, University of Tromso, Norway. ;;;; ;;;; For distribution policy, see the accompanying file COPYING. @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.45 2004/12/21 14:27:09 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.46 2005/01/25 13:49:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -41,11 +41,21 @@ (defun stack-frame-funobj (stack frame) (stack-frame-ref stack frame -1)) +(defun stack-location (stack index) + (if (eq nil stack) + index + (+ (object-location stack) 2 index))) + (defun stack-frame-uplink (stack frame) (if (eq 0 (stack-frame-funobj stack frame)) (dit-frame-casf stack frame) (stack-frame-ref stack frame 0))) +(defun stack-vector-designator (stack) + (etypecase stack + (null (%run-time-context-slot 'stack-vector)) + (vector stack))) + (define-compiler-macro current-stack-frame () `(with-inline-assembly (:returns :eax) (:leal ((:ebp ,(truncate movitz::+movitz-fixnum-factor+ 4))) @@ -176,23 +186,21 @@ (do ((l (logand location -2) (- l 2))) ((< l stop-location) (error "Unable to find code-vector for location ~S." location)) - (multiple-value-bind (upper30 lower2) - (memref l 0 :type :signed-byte30+2) - (when (and (= 2 lower2) - (= #.(movitz:basic-vector-type-tag :code)) - ;; If the vector has a fill-pointer, it should be equal to the length. - (multiple-value-bind (len len-tag) - (memref l 4 :type :signed-byte30+2) - (and (= 0 len-tag) - (typecase len - ((integer 0 #x3fff) - (= len (memref l 2 :type :unsigned-byte14))) - (positive-fixnum t) - (t nil))))) - (let ((code-vector (%location-object l 6))) - (check-type code-vector code-vector) - (assert (location-in-object-p code-vector location)) - (return code-vector)))))) + (when (and (= (memref l 0 :type :unsigned-byte16) + #.(movitz:basic-vector-type-tag :code)) + ;; If the vector has a fill-pointer, it should be equal to the length. + (multiple-value-bind (len len-tag) + (memref l 4 :type :signed-byte30+2) + (and (= 0 len-tag) + (typecase len + ((integer 0 #x3fff) + (= len (memref l 2 :type :unsigned-byte14))) + (positive-fixnum t) + (t nil))))) + (let ((code-vector (%location-object l 6))) + (check-type code-vector code-vector) + (assert (location-in-object-p code-vector location)) + (return code-vector))))) (defun %shallow-copy-object (object word-count) "Copy any object with size word-count."

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/functions.lisp
by ffjeld＠common-lisp.net 25 Jan '05

25 Jan '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16766 Modified Files: functions.lisp Log Message: Renamed funobj-frame-raw-locals. Added funobj-frame-headers-p. Date: Tue Jan 25 05:46:54 2005 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.25 movitz/losp/muerte/functions.lisp:1.26 --- movitz/losp/muerte/functions.lisp:1.25 Tue Dec 14 08:20:57 2004 +++ movitz/losp/muerte/functions.lisp Tue Jan 25 05:46:54 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001-2004, +;;;; Copyright (C) 2001-2005, ;;;; Department of Computer Science, University of Tromso, Norway. ;;;; ;;;; For distribution policy, see the accompanying file COPYING. @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 12 22:58:54 2002 ;;;; -;;;; $Id: functions.lisp,v 1.25 2004/12/14 16:20:57 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.26 2005/01/25 13:46:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -388,10 +388,15 @@ (check-type funobj function) (memref funobj (movitz-type-slot-offset 'movitz-funobj 'debug-info) :type :unsigned-byte16)) -(defun funobj-frame-num-unboxed (funobj) +(defun funobj-frame-raw-locals (funobj) "The number of unboxed slots in this function's stack-frame(s)." (declare (ignore funobj)) 0) + +(defun funobj-frame-headers-p (funobj) + "Can this function place header-vals in its stack-frame?" + (declare (ignore funobj)) + t) (defun make-funobj (&key (name :unnamed) (code-vector (funobj-code-vector #'constantly-prototype))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/format.lisp
by ffjeld＠common-lisp.net 25 Jan '05

25 Jan '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16748 Modified Files: format.lisp Log Message: *** empty log message *** Date: Tue Jan 25 05:46:11 2005 Author: ffjeld Index: movitz/losp/muerte/format.lisp diff -u movitz/losp/muerte/format.lisp:1.9 movitz/losp/muerte/format.lisp:1.10 --- movitz/losp/muerte/format.lisp:1.9 Sun Nov 7 13:10:03 2004 +++ movitz/losp/muerte/format.lisp Tue Jan 25 05:46:10 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001-2004, +;;;; Copyright (C) 2001-2005, ;;;; Department of Computer Science, University of Tromso, Norway. ;;;; ;;;; For distribution policy, see the accompanying file COPYING. @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Mar 23 01:18:36 2002 ;;;; -;;;; $Id: format.lisp,v 1.9 2004/11/07 21:10:03 ffjeld Exp $ +;;;; $Id: format.lisp,v 1.10 2005/01/25 13:46:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -127,11 +127,12 @@ (i start)) (tagbody loop - (unless (< i (length control-string)) + (when (>= i (length control-string)) (go end-loop)) (let ((c (schar control-string i))) (if (char/= c #\~) (write-char c) + ;; Process ~ directive (prog ((colon-p nil) (at-sign-p nil) (prefix-parameters nil)) @@ -289,6 +290,14 @@ (third prefix-parameters)) (go end-loop))) (t (error "format directive ~^ takes at most 3 parameters.")))) + #+ignore + (#\( (multiple-value-setq (i args) + (format-by-string control-string (1+ i) loop-limit args + (cond + ((and colon-p at-sign-p) :upcase) + (colon-p :capitalize) + (at-sign-p :capitalize-first) + (t :downcase))))) (#\? (format-by-string (pop args) 0 0 (pop args))) (#\: (setf colon-p t) (go proceed))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/environment.lisp
by ffjeld＠common-lisp.net 25 Jan '05

25 Jan '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16703 Modified Files: environment.lisp Log Message: fixed some typos in match-caller. Date: Tue Jan 25 05:45:55 2005 Author: ffjeld Index: movitz/losp/muerte/environment.lisp diff -u movitz/losp/muerte/environment.lisp:1.8 movitz/losp/muerte/environment.lisp:1.9 --- movitz/losp/muerte/environment.lisp:1.8 Fri Jul 16 18:54:55 2004 +++ movitz/losp/muerte/environment.lisp Tue Jan 25 05:45:54 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001-2004, +;;;; Copyright (C) 2001-2005, ;;;; Department of Computer Science, University of Tromso, Norway. ;;;; ;;;; For distribution policy, see the accompanying file COPYING. @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Oct 20 00:41:57 2001 ;;;; -;;;; $Id: environment.lisp,v 1.8 2004/07/17 01:54:55 ffjeld Exp $ +;;;; $Id: environment.lisp,v 1.9 2005/01/25 13:45:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -52,10 +52,10 @@ (get-global-property :setf-namespace))))) (defun match-caller (name) - (do ((frame (stack-frame-uplink (current-stack-frame)) - (stack-frame-uplink frame))) + (do ((frame (stack-frame-uplink nil (current-stack-frame)) + (stack-frame-uplink nil frame))) ((not (plusp frame))) - (let ((f (stack-frame-funobj frame))) + (let ((f (stack-frame-funobj nil frame))) (cond ((not (typep f 'function)) (return nil))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/bignums.lisp
by ffjeld＠common-lisp.net 25 Jan '05

25 Jan '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16377 Modified Files: bignums.lisp Log Message: *** empty log message *** Date: Tue Jan 25 05:45:25 2005 Author: ffjeld Index: movitz/losp/muerte/bignums.lisp diff -u movitz/losp/muerte/bignums.lisp:1.13 movitz/losp/muerte/bignums.lisp:1.14 --- movitz/losp/muerte/bignums.lisp:1.13 Thu Nov 25 10:05:40 2004 +++ movitz/losp/muerte/bignums.lisp Tue Jan 25 05:45:24 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2003-2004, +;;;; Copyright (C) 2003-2005, ;;;; Department of Computer Science, University of Tromso, Norway. ;;;; ;;;; For distribution policy, see the accompanying file COPYING. @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Jul 17 19:42:57 2004 ;;;; -;;;; $Id: bignums.lisp,v 1.13 2004/11/25 18:05:40 ffjeld Exp $ +;;;; $Id: bignums.lisp,v 1.14 2005/01/25 13:45:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

1 0

[movitz-cvs] CVS update: movitz/special-operators-cl.lisp
by ffjeld＠common-lisp.net 25 Jan '05

25 Jan '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv16003 Modified Files: special-operators-cl.lisp Log Message: Don't do the recompile-body thing. It was an ugly hack. Really. Date: Tue Jan 25 05:44:11 2005 Author: ffjeld Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.42 movitz/special-operators-cl.lisp:1.43 --- movitz/special-operators-cl.lisp:1.42 Tue Jan 4 12:22:00 2005 +++ movitz/special-operators-cl.lisp Tue Jan 25 05:44:11 2005 @@ -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.42 2005/01/04 20:22:00 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.43 2005/01/25 13:44:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -56,8 +56,7 @@ (compiler-call #'compile-implicit-progn :forward all :form body) - (let* ((recompile-body-p nil) - (let-modifies nil) + (let* ((let-modifies nil) (let-vars (parse-let-var-specs let-var-specs)) (local-env (make-local-movitz-environment env funobj :type 'let-env @@ -242,8 +241,6 @@ (binding-name binding) init-form (car (type-specifier-singleton type))) - (when (code-uses-binding-p body-code binding :load t) - (setf recompile-body-p t)) (change-class binding 'constant-object-binding :object (car (type-specifier-singleton type))) (if functional-p @@ -313,10 +310,7 @@ `((:locally (:call (:edi ,(bt:slot-offset 'movitz-run-time-context 'dynamic-variable-install)))) (:locally (:movl :esp (:edi (:edi-offset dynamic-env)))))) - (if (or nil (not recompile-body-p)) - body-code - (progn #+ignore (warn "recompile..") ; XXX - (compile-body))) + body-code (when (and (plusp (num-specials local-env)) (not (eq :non-local-exit body-returns))) #+ignore

1 0

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

25 Jan '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv15977 Modified Files: compiler.lisp Log Message: Be more observant of *compiler-allow-transients* when locating bindings in registers. Date: Tue Jan 25 05:42:39 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.129 movitz/compiler.lisp:1.130 --- movitz/compiler.lisp:1.129 Fri Jan 21 14:06:07 2005 +++ movitz/compiler.lisp Tue Jan 25 05:42:39 2005 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.129 2005/01/21 22:06:07 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.130 2005/01/25 13:42:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2841,6 +2841,9 @@ (init-pc (second count-init-pc))) ;; (warn "b ~S: count: ~D, init-pc: ~{~&~A~}" binding count init-pc) (cond + ((and (not *compiler-allow-transients*) + (typep binding 'function-argument)) + (values nil :never)) ((binding-lended-p binding) ;; We can't lend a register. (values nil :never))

1 0

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

21 Jan '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv4792 Modified Files: compiler.lisp Log Message: Fixed compute-call-extra-prefix whose previous incarnation I _really_ didn't understand (what was I thinking??) Date: Fri Jan 21 14:06:08 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.128 movitz/compiler.lisp:1.129 --- movitz/compiler.lisp:1.128 Mon Jan 10 00:18:49 2005 +++ movitz/compiler.lisp Fri Jan 21 14:06:07 2005 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.128 2005/01/10 08:18:49 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.129 2005/01/21 22:06:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -34,7 +34,7 @@ "Make every compiled function check upon entry that the stack-pointer is within bounds. Costs 3 code-bytes and a few cycles.") -(defvar *compiler-allow-transients* t +(defvar *compiler-allow-transients* nil "Allow the compiler to keep function arguments solely in registers. Hurst debugging, improves performance.") @@ -117,22 +117,19 @@ (+ (ia-x86::assemble-env-current-pc env) size)))) (cond - ((not (and (ia-x86::instruction-operands instr) - (typep (car (ia-x86::instruction-operands instr)) - 'ia-x86::operand-indirect-register) - (eq 'ia-x86::esi - (ia-x86::operand-register (car (ia-x86::instruction-operands instr)))))) + ((not (typep instr 'ia-x86-instr::call)) nil) ((or (= (tag :even-fixnum) return-pointer-tag) (= (tag :odd-fixnum) return-pointer-tag)) ;; Insert a NOP '(#x90)) - ((= 3 return-pointer-tag) - ;; Insert two NOPs, 3 -> 5 - '(#x90 #x90)) +;;; ((= 3 return-pointer-tag) +;;; ;; Insert two NOPs, 3 -> 5 +;;; '(#x90 #x90)) ((= (tag :character) return-pointer-tag) ;; Insert three NOPs, 2 -> 5 - '(#x90 #x90 #x90))))) + '(#x90 #x90 #x90) + '(#x90))))) (defun make-compiled-primitive (form environment top-level-p docstring) "Primitive functions have no funobj, no stack-frame, and no implied @@ -3858,6 +3855,7 @@ (append (make-load-constant sub-funobj register funobj frame-map))) ((typep (movitz-allocation sub-funobj) 'with-dynamic-extent-scope-env) + (setf (headers-on-stack-frame-p funobj) t) (let ((dynamic-scope (movitz-allocation sub-funobj))) (append (make-load-lexical (base-binding dynamic-scope) :edx funobj nil frame-map)

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/debugger.lisp
by ffjeld＠common-lisp.net 21 Jan '05

21 Jan '05

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv1838 Modified Files: debugger.lisp Log Message: Added some entries to *stack-frame-setup-patterns* so we avoid some {eax/ebx unknown} in the backtrace. Date: Fri Jan 21 13:02:45 2005 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.28 movitz/losp/x86-pc/debugger.lisp:1.29 --- movitz/losp/x86-pc/debugger.lisp:1.28 Tue Jan 4 08:54:34 2005 +++ movitz/losp/x86-pc/debugger.lisp Fri Jan 21 13:02:45 2005 @@ -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.28 2005/01/04 16:54:34 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.29 2005/01/21 21:02:45 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -310,8 +310,10 @@ (:* 1 (#x55 #x8b #xec #x56)) ; pushl ebp, movl esp (:* 2 (#x80 #xf9 (cmpargs) (:or (#x72 (label)) + (#x75 (label)) (#x77 (label)) (#x0f #x82 (label) (label) (label) (label)) + (#x0f #x85 (label) (label) (label) (label)) (#x0f #x87 (label) (label) (label) (label))))) (:* 1 (#x84 #xc9 ; #<asm TESTB %CL %CL> (:or (#x78 (label)) ; #<asm JS %PC+#xed>

1 0