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

[movitz-cvs] CVS update: movitz/losp/muerte/primitive-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-serv17058 Modified Files: primitive-functions.lisp Log Message: Minor edit. Date: Tue Jan 25 05:54:57 2005 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.60 movitz/losp/muerte/primitive-functions.lisp:1.61 --- movitz/losp/muerte/primitive-functions.lisp:1.60 Mon Jan 10 00:19:06 2005 +++ movitz/losp/muerte/primitive-functions.lisp Tue Jan 25 05:54:57 2005 @@ -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.60 2005/01/10 08:19:06 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.61 2005/01/25 13:54:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -482,11 +482,10 @@ (:movl (:eax #.(movitz::class-object-offset 'symbol)) :eax) (:ret))) - (define-primitive-function fast-class-of-std-instance () "Return the class of a std-instance object." (with-inline-assembly (:returns :multiple-values) - (:movl (:eax #.(bt:slot-offset 'movitz::movitz-std-instance 'movitz::class)) + (:movl (:eax (:offset movitz-std-instance class)) :eax) (:ret)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/los-closette.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-serv16960 Modified Files: los-closette.lisp Log Message: *** empty log message *** Date: Tue Jan 25 05:52:26 2005 Author: ffjeld Index: movitz/losp/muerte/los-closette.lisp diff -u movitz/losp/muerte/los-closette.lisp:1.25 movitz/losp/muerte/los-closette.lisp:1.26 --- movitz/losp/muerte/los-closette.lisp:1.25 Tue Jan 4 12:23:16 2005 +++ movitz/losp/muerte/los-closette.lisp Tue Jan 25 05:52:25 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Jul 23 14:29:10 2002 ;;;; -;;;; $Id: los-closette.lisp,v 1.25 2005/01/04 20:23:16 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.26 2005/01/25 13:52:25 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1004,6 +1004,7 @@ (defclass illegal-object (t) () (:metaclass built-in-class)) (defclass infant-object (t) () (:metaclass built-in-class)) +(defclass unbound-value (t) () (:metaclass built-in-class)) (defclass run-time-context (t) ()

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/memref.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-serv16914 Modified Files: memref.lisp Log Message: *** empty log message *** Date: Tue Jan 25 05:51:36 2005 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.41 movitz/losp/muerte/memref.lisp:1.42 --- movitz/losp/muerte/memref.lisp:1.41 Mon Jan 10 06:04:52 2005 +++ movitz/losp/muerte/memref.lisp Tue Jan 25 05:51:36 2005 @@ -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.41 2005/01/10 14:04:52 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.42 2005/01/25 13:51:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -224,7 +224,7 @@ ,@fix-ecx)) (t (let ((object-var (gensym "memref-object-"))) `(let ((,object-var ,object)) - (with-inline-assembly (:returns :ecx :type (unsigned-byte 29)) + (with-inline-assembly (:returns :multiple-values) (:compile-two-forms (:ecx :ebx) ,offset ,index) (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) (:load-lexical (:lexical-binding ,object-var) :eax) @@ -411,9 +411,9 @@ ((:big) (memref object offset :index index :type :unsigned-byte16 :endian :big)))) (:code-vector (memref object offset :index index :type :code-vector)) - (:unsigned-byte14 (memref object offset :index index :type :unsigned-byte14)))) -;;; (:signed-byte30+2 (memref object offset index :signed-byte30+2)) -;;; (:unsigned-byte29+3 (memref object offset index :unsigned-byte29+3)))) + (:unsigned-byte14 (memref object offset :index index :type :unsigned-byte14)) + (:signed-byte30+2 (memref object offset :index index :type :signed-byte30+2)) + (:unsigned-byte29+3 (memref object offset :index index :type :unsigned-byte29+3)))) (define-compiler-macro (setf memref) (&whole form &environment env value object offset &key (index 0) (type :lisp) (localp nil) (endian :host)) @@ -963,7 +963,7 @@ (:movl :ecx (:eax ,offset))))))) (:lisp (assert (= 4 movitz:+movitz-fixnum-factor+)) - `(with-inline-assembly (:returns :untagged-fixnum-eax) + `(with-inline-assembly (:returns :eax) (:compile-form (:result-mode :push) ,address) (:compile-form (:result-mode :push) ,index) (:compile-form (:result-mode :push) ,offset) @@ -975,7 +975,7 @@ (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) (,prefixes :movl :eax (:ecx :ebx)))) (:unsigned-byte8 - `(with-inline-assembly (:returns :untagged-fixnum-eax) + `(with-inline-assembly (:returns :nothing) (:compile-form (:result-mode :push) ,address) (:compile-form (:result-mode :push) ,index) (:compile-form (:result-mode :push) ,offset) @@ -983,11 +983,11 @@ (:popl :edx) ; offset (:popl :ebx) ; index (:popl :ecx) ; address - (:shrl ,movitz::+movitz-fixnum-shift+ :eax) + (:shll ,(- 8 movitz::+movitz-fixnum-shift+) :eax) (:addl :ebx :ecx) (:addl :edx :ecx) (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) - (,prefixes :movb :al (:ecx)))) + (,prefixes :movb :ah (:ecx)))) (:unsigned-byte16 (cond ((eq 0 offset)

1 0

[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