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

[movitz-cvs] CVS update: movitz/losp/muerte/symbols.lisp
by Frode Vatvedt Fjeld 29 Mar '04

29 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv14977 Modified Files: symbols.lisp Log Message: Re-named create-symbol to %create-symbol, and avoided it checking the name being a string (useful during GC migration). Date: Sun Mar 28 20:57:48 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.5 movitz/losp/muerte/symbols.lisp:1.6 --- movitz/losp/muerte/symbols.lisp:1.5 Sun Mar 28 12:33:46 2004 +++ movitz/losp/muerte/symbols.lisp Sun Mar 28 20:57:48 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 23:55:41 2001 ;;;; -;;;; $Id: symbols.lisp,v 1.5 2004/03/28 17:33:46 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.6 2004/03/29 01:57:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -137,7 +137,7 @@ (not (eq (movitz-accessor symbol movitz-symbol function-value) (load-global-constant movitz::unbound-function)))))) -(defun create-symbol (name &optional (package nil) +(defun %create-symbol (name &optional (package nil) (plist nil) (value (load-global-constant unbound-value)) (function (load-global-constant movitz::unbound-function)) @@ -146,16 +146,17 @@ (assert (= 1 (- (movitz:tag :symbol) (movitz:tag :other))))) (let ((symbol (%word-offset (malloc-clumps 3) 1))) (setf-movitz-accessor (symbol movitz-symbol package) package) + (setf-movitz-accessor (symbol movitz-symbol name) name) (setf-movitz-accessor (symbol movitz-symbol hash-key) (sxhash name)) (setf (symbol-flags symbol) flags (symbol-plist symbol) plist (symbol-function symbol) function - (symbol-name symbol) name (symbol-value symbol) value) symbol)) (defun make-symbol (name) - (create-symbol name)) + (check-type name string "a symbol name") + (%create-symbol name)) (defun copy-symbol (symbol &optional copy-properties) "copy-symbol returns a fresh, uninterned symbol, the name of which @@ -163,13 +164,13 @@ symbol." (if (or (eq nil symbol) (not copy-properties)) - (create-symbol (symbol-name symbol)) - (create-symbol (symbol-name symbol) - nil - (symbol-plist symbol) - (%unbounded-symbol-value symbol) - (%unbounded-symbol-function symbol) - (symbol-flags symbol)))) + (%create-symbol (symbol-name symbol)) + (%create-symbol (symbol-name symbol) + nil + (symbol-plist symbol) + (%unbounded-symbol-value symbol) + (%unbounded-symbol-function symbol) + (symbol-flags symbol)))) (defun symbol-flags (symbol) (etypecase symbol

1 0

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

29 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv19746 Modified Files: primitive-functions.lisp Log Message: Re-arranged complicated-class-of so as to do the "other" types first, since the classes with their own tags are likely to be caught before this function is ever called. Also, make sure that (class-of "foo") returns the string class, not vector. Date: Sun Mar 28 20:09:46 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.5 movitz/losp/muerte/primitive-functions.lisp:1.6 --- movitz/losp/muerte/primitive-functions.lisp:1.5 Thu Mar 18 04:21:17 2004 +++ movitz/losp/muerte/primitive-functions.lisp Sun Mar 28 20:09:46 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.5 2004/03/18 09:21:17 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.6 2004/03/29 01:09:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -577,22 +577,12 @@ (movitz-accessor object movitz-std-instance class)) (standard-gf-instance (movitz-accessor object movitz-funobj-standard-gf standard-gf-class)) - (null - (find-class 'null)) - (cons - (find-class 'cons)) - (symbol - (find-class 'symbol)) - (fixnum - (find-class 'fixnum)) + (string + (find-class 'string)) (vector (find-class 'vector)) (compiled-function (find-class 'function)) -;;; (hash-table -;;; (find-class 'hash-table)) -;;; (package -;;; (find-class 'package)) (structure-object (find-class (structure-object-name object))) (character @@ -601,6 +591,14 @@ (find-class 'basic-restart)) (run-time-context (find-class 'run-time-context)) + (null + (find-class 'null)) + (cons + (find-class 'cons)) + (symbol + (find-class 'symbol)) + (fixnum + (find-class 'fixnum)) (tag6 (error "Don't know the class of ~Z with other-type #x~X." object (with-inline-assembly (:returns :untagged-fixnum-ecx)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/symbols.lisp
by Frode Vatvedt Fjeld 28 Mar '04

28 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv14413 Modified Files: symbols.lisp Log Message: Added functions copy-symbol, create-symbol, %unbounded-symbol-value, and %unbounded-symbol-function, and rewrote make-symbol in terms of create-symbol. Date: Sun Mar 28 12:33:46 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.4 movitz/losp/muerte/symbols.lisp:1.5 --- movitz/losp/muerte/symbols.lisp:1.4 Wed Mar 24 08:31:43 2004 +++ movitz/losp/muerte/symbols.lisp Sun Mar 28 12:33:46 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 23:55:41 2001 ;;;; -;;;; $Id: symbols.lisp,v 1.4 2004/03/24 13:31:43 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.5 2004/03/28 17:33:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -30,6 +30,19 @@ (:compile-form (:result-mode :eax) symbol) (:call-global-constant dynamic-load))))) +(defun %unbounded-symbol-value (symbol) + "Return the symbol's value without checking if it's bound or not." + (check-type symbol symbol) + (with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) symbol) + (:call-global-constant dynamic-find-binding) + (:jnc 'no-local-binding) + (:movl (:eax) :eax) + (:jmp 'done) + no-local-binding + (:movl (:eax #.(bt:slot-offset 'movitz::movitz-symbol 'movitz::value)) :eax) + done)) + (defun (setf symbol-value) (value symbol) (etypecase symbol (null @@ -62,6 +75,10 @@ (error 'undefined-function :name symbol)) function-value)) +(defun %unbounded-symbol-function (symbol) + (check-type symbol symbol) + (movitz-accessor symbol movitz-symbol function-value)) + (defun (setf symbol-function) (value symbol) (check-type symbol symbol) (check-type value compiled-function) @@ -120,17 +137,39 @@ (not (eq (movitz-accessor symbol movitz-symbol function-value) (load-global-constant movitz::unbound-function)))))) -(defun make-symbol (name) +(defun create-symbol (name &optional (package nil) + (plist nil) + (value (load-global-constant unbound-value)) + (function (load-global-constant movitz::unbound-function)) + (flags 0)) (eval-when (:compile-toplevel) (assert (= 1 (- (movitz:tag :symbol) (movitz:tag :other))))) (let ((symbol (%word-offset (malloc-clumps 3) 1))) - (setf-movitz-accessor (symbol movitz-symbol package) nil) + (setf-movitz-accessor (symbol movitz-symbol package) package) (setf-movitz-accessor (symbol movitz-symbol hash-key) (sxhash name)) - (setf (symbol-flags symbol) 0 - (symbol-function symbol) (load-global-constant movitz::unbound-function) + (setf (symbol-flags symbol) flags + (symbol-plist symbol) plist + (symbol-function symbol) function (symbol-name symbol) name - (symbol-value symbol) (load-global-constant unbound-value)) + (symbol-value symbol) value) symbol)) + +(defun make-symbol (name) + (create-symbol name)) + +(defun copy-symbol (symbol &optional copy-properties) + "copy-symbol returns a fresh, uninterned symbol, the name of which + is string= to and possibly the same as the name of the given + symbol." + (if (or (eq nil symbol) + (not copy-properties)) + (create-symbol (symbol-name symbol)) + (create-symbol (symbol-name symbol) + nil + (symbol-plist symbol) + (%unbounded-symbol-value symbol) + (%unbounded-symbol-function symbol) + (symbol-flags symbol)))) (defun symbol-flags (symbol) (etypecase symbol

1 0

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

28 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7395 Modified Files: functions.lisp Log Message: Added placeholder function funobj-frame-num-unboxed. The idea is that when the compiler supports local unboxed variables, a field in the funobj is used to mark off such sections of the stack-frame (each stack-frame also holds a reference to the funobj). Date: Sun Mar 28 12:31:41 2004 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.6 movitz/losp/muerte/functions.lisp:1.7 --- movitz/losp/muerte/functions.lisp:1.6 Fri Mar 26 08:58:01 2004 +++ movitz/losp/muerte/functions.lisp Sun Mar 28 12:31:41 2004 @@ -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.6 2004/03/26 13:58:01 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.7 2004/03/28 17:31:41 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -312,6 +312,11 @@ (defun funobj-debug-info (funobj) (check-type funobj compiled-function) (movitz-accessor-u16 funobj movitz-funobj debug-info)) + +(defun funobj-frame-num-unboxed (funobj) + "The number of unboxed slots in this function's stack-frame(s)." + (declare (ignore funobj)) + 0) (defun make-funobj (&key (name :unnamed) (code-vector (funobj-code-vector #'constantly-prototype))

1 0

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

28 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv12544 Modified Files: arrays.lisp Log Message: Set initial-contents when make-array a string. Date: Sun Mar 28 11:20:44 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.11 movitz/losp/muerte/arrays.lisp:1.12 --- movitz/losp/muerte/arrays.lisp:1.11 Fri Mar 26 08:56:53 2004 +++ movitz/losp/muerte/arrays.lisp Sun Mar 28 11:20:44 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.11 2004/03/26 13:56:53 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.12 2004/03/28 16:20:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -516,9 +516,14 @@ 0 :unsigned-byte16) dimensions) (setf (fill-pointer a) fill-pointer) - (when initial-element + (cond + (initial-element + (check-type initial-element character) (dotimes (i dimensions) (setf (char%unsafe a i) initial-element))) + (initial-contents + (dotimes (i dimensions) + (setf (char a i) (elt initial-contents i))))) a)) ((member element-type '(u8 (unsigned-byte 8)) :test #'equal) (let ((a (inline-malloc (+ #.(bt:sizeof 'movitz::movitz-vector) dimensions)

1 0

[movitz-cvs] CVS update: movitz/special-operators.lisp
by Frode Vatvedt Fjeld 28 Mar '04

28 Mar '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv7776 Modified Files: special-operators.lisp Log Message: Removed a couple of useless warnings. Date: Sun Mar 28 11:20:05 2004 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.15 movitz/special-operators.lisp:1.16 --- movitz/special-operators.lisp:1.15 Fri Feb 20 21:04:50 2004 +++ movitz/special-operators.lisp Sun Mar 28 11:20:05 2004 @@ -8,7 +8,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 24 16:22:59 2000 ;;;; -;;;; $Id: special-operators.lisp,v 1.15 2004/02/21 02:04:50 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.16 2004/03/28 16:20:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -958,15 +958,16 @@ :protect-registers ,(cons protected-register protect-registers)))))))) (t ;; just put the (singular) result of form1 on the stack.. - (when (not (typep cover-returns 'keyword)) - ;; if it's a (non-modified) lexical-binding, we can do better.. - (warn "Covering non-register ~S" cover-returns)) - (when (type-specifier-singleton (type-specifier-primary cover-type)) - (warn "Covering constant ~S" - (type-specifier-singleton cover-type))) +;;; (when (not (typep cover-returns 'keyword)) +;;; ;; if it's a (non-modified) lexical-binding, we can do better.. +;;; (warn "Covering non-register ~S" cover-returns)) +;;; (when (type-specifier-singleton (type-specifier-primary cover-type)) +;;; (warn "Covering constant ~S" +;;; (type-specifier-singleton cover-type))) (let ((protected-register (case cover-returns ((:ebx :ecx :edx) cover-returns) (t :eax)))) + #+ignore (when (>= 2 (length cloaked-code)) (warn "simple-cloaking for ~S: ~{~&~S~}" cover-returns cloaked-code)) (setf (stack-used cloaked-env) 1)

1 0

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

28 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv2104 Modified Files: memref.lisp Log Message: Added a proper (setf memref .. :unsigned-byte32). Date: Sun Mar 28 11:19:20 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.3 movitz/losp/muerte/memref.lisp:1.4 --- movitz/losp/muerte/memref.lisp:1.3 Fri Mar 26 08:58:27 2004 +++ movitz/losp/muerte/memref.lisp Sun Mar 28 11:19:20 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.3 2004/03/26 13:58:27 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.4 2004/03/28 16:19:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -205,6 +205,18 @@ (:sarl #.movitz::+movitz-fixnum-shift+ :ebx) (:popl :ecx) ; object (:movb :ah (:ebx :ecx)))) + (:unsigned-byte32 + (assert (= 4 movitz::+movitz-fixnum-factor+)) + `(with-inline-assembly (:returns :untagged-fixnum-eax) + (:compile-form (:result-mode :push) ,object) + (:compile-form (:result-mode :push) ,offset) + (:compile-two-forms (:ebx :eax) ,index ,value) + (:popl :ecx) ; offset + (:shrl #.movitz::+movitz-fixnum-shift+ :eax) + (:sarl #.movitz::+movitz-fixnum-shift+ :ecx) + (:addl :ebx :ecx) ; index += offset + (:popl :ebx) ; object + (:movl :eax (:ebx :ecx)))) (:unsigned-byte16 `(with-inline-assembly (:returns :untagged-fixnum-eax) (:compile-form (:result-mode :push) ,object) @@ -214,8 +226,8 @@ (:popl :ecx) ; offset (:shrl #.movitz::+movitz-fixnum-shift+ :eax) (:sarl #.movitz::+movitz-fixnum-shift+ :ecx) - (:addl :ecx :ebx) ; index += offset - (:popl :ecx) ; object + (:addl :ebx :ecx) ; index += offset + (:popl :ebx) ; object (:movw :ax (:ebx :ecx)))) (:unsigned-byte8 `(with-inline-assembly (:returns :untagged-fixnum-eax) @@ -252,9 +264,7 @@ (:unsigned-byte16 (setf (memref object offset index :unsigned-byte16) value)) (:unsigned-byte32 - (setf (memref object offset (* index 2) :unsigned-byte16) (ldb (byte 16 0) value) - (memref object offset (+ 1 (* index 2)) :unsigned-byte16) (ldb (byte 14 16) value)) - value) + (setf (memref object offset index :unsigned-byte32) value)) (:lisp (setf (memref object offset index :lisp) value))))

1 0

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

28 Mar '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv28916 Modified Files: compiler.lisp Log Message: A small fix to assign-bindings so that certain lambda-variables are not erroneously assumed to be used when they really aren't. Date: Sun Mar 28 10:09:27 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.36 movitz/compiler.lisp:1.37 --- movitz/compiler.lisp:1.36 Thu Mar 25 20:34:13 2004 +++ movitz/compiler.lisp Sun Mar 28 10:09:27 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.36 2004/03/26 01:34:13 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.37 2004/03/28 15:09:27 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2618,7 +2618,8 @@ ((typep binding 'constant-object-binding)) ((typep binding 'forwarding-binding)) ((typep binding 'borrowed-binding)) - ((typep binding 'fixed-required-function-argument) + ((and (typep binding 'fixed-required-function-argument) + (plusp (or (car (gethash binding var-counts)) 0))) (prog1 nil ; may need lending-cons (setf (new-binding-location binding frame-map) :argument-stack)))

1 0

[movitz-cvs] CVS update: movitz/slime-movitz.el
by Frode Vatvedt Fjeld 28 Mar '04

28 Mar '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv15840 Modified Files: slime-movitz.el Log Message: Undid broken line in header. Date: Sun Mar 28 08:37:16 2004 Author: ffjeld Index: movitz/slime-movitz.el diff -u movitz/slime-movitz.el:1.1 movitz/slime-movitz.el:1.2 --- movitz/slime-movitz.el:1.1 Wed Mar 17 03:26:50 2004 +++ movitz/slime-movitz.el Sun Mar 28 08:37:16 2004 @@ -1,5 +1,4 @@ -;;; -*- mode: emacs-lisp; mode: outline-minor; outline-regexp: ";;;;*"; -indent-tabs-mode: nil -*- +;;; -*- mode: emacs-lisp; mode: outline-minor; outline-regexp: nil *indent-tabs-mode: nil -*- ;; movitz-slime.el -- Slime key bindings for Movitz, adapted from ;; movitz-mode.el by Frode Vatvedt Fjeld ;; Copyright (C) 2004 Aleksandar Bakic

1 0

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

28 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv10109 Modified Files: interrupt.lisp Log Message: Added a dependency on x86-pc/debugger, so as to fix the package error. Actually, the debugger should be relocated to inside Muerte proper. Date: Sun Mar 28 08:35:45 2004 Author: ffjeld Index: movitz/losp/x86-pc/interrupt.lisp diff -u movitz/losp/x86-pc/interrupt.lisp:1.5 movitz/losp/x86-pc/interrupt.lisp:1.6 --- movitz/losp/x86-pc/interrupt.lisp:1.5 Thu Mar 25 20:51:21 2004 +++ movitz/losp/x86-pc/interrupt.lisp Sun Mar 28 08:35:45 2004 @@ -10,11 +10,12 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri May 4 18:08:50 2001 ;;;; -;;;; $Id: interrupt.lisp,v 1.5 2004/03/26 01:51:21 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.6 2004/03/28 13:35:45 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ (require :x86-pc/pic8259) +(require :x86-pc/debugger) (provide :x86-pc/interrupt) (in-package muerte.x86-pc)

1 0