movitz-cvs July 2004

movitz-cvs@common-lisp.net

2 participants
376 discussions

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

29 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11648 Modified Files: basic-macros.lisp Log Message: Smarted up the defpackage macro slightly. Date: Wed Jul 28 18:24:45 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.34 movitz/losp/muerte/basic-macros.lisp:1.35 --- movitz/losp/muerte/basic-macros.lisp:1.34 Wed Jul 28 17:13:18 2004 +++ movitz/losp/muerte/basic-macros.lisp Wed Jul 28 18:24:45 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.34 2004/07/29 00:13:18 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.35 2004/07/29 01:24:45 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -70,16 +70,16 @@ ,(cons 'cl:progn body))) (defmacro defpackage (package-name &rest options) - (pushnew '(:use) options :key #'car) - (let ((uses (cdr (assoc :use options)))) + (let ((uses (if (not (assoc :use options)) + (list 'muerte.cl) + (cdr (assoc :use options))))) (setf uses (mapcar (lambda (use) (if (member use (cons :common-lisp (package-nicknames :common-lisp)) :test #'string=) :muerte.cl use)) uses)) - (when (or (null uses) - (member :muerte.cl uses :test #'string=) + (when (or (member :muerte.cl uses :test #'string=) (member :muerte.common-lisp uses :test #'string=)) (push '(:shadowing-import-from :common-lisp nil) options)) (let ((movitz-options (cons (cons :use uses)

1 0

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

29 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23880 Modified Files: symbols.lisp Log Message: Re-arranged many details about *movitz-nil*, movitz-null, and how it relates to the cons and symbol binary-classes etc. This should now be slightly less messy, and slightly more efficient. Date: Wed Jul 28 17:13:22 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.17 movitz/losp/muerte/symbols.lisp:1.18 --- movitz/losp/muerte/symbols.lisp:1.17 Thu Jul 15 14:07:32 2004 +++ movitz/losp/muerte/symbols.lisp Wed Jul 28 17:13:22 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.17 2004/07/15 21:07:32 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.18 2004/07/29 00:13:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -21,6 +21,23 @@ (in-package muerte) +(define-compiler-macro get-symbol-slot (object slot &optional (type t)) + "Read a slot off a symbol (including NIL)." + `(with-inline-assembly (:returns :eax :type ,type) + (:compile-form (:result-mode :eax) ,object) + (:leal (:eax ,(- (movitz:tag :null))) :ecx) + (:andl 7 :ecx) + (:testb 5 :cl) + (:jnz '(:sub-program (not-a-symbol) + (:compile-form (:result-mode :ignore) + (error-not-symbol (assembly-register :eax))))) + (:xorl 2 :ecx) + (:movl (:eax :ecx (:offset movitz-symbol ,slot)) + :eax))) + +(defun error-not-symbol (x) + (error 'type-error :expected-type 'symbol :datum x)) + (defun symbol-value (symbol) "Returns the dynamic value of SYMBOL." (etypecase symbol @@ -40,7 +57,7 @@ (:movl (:eax) :eax) (:jmp 'done) no-local-binding - (:movl (:eax #.(bt:slot-offset 'movitz::movitz-symbol 'movitz::value)) :eax) + (:movl (:eax (:offset movitz-symbol value)) :eax) done)) (defun (setf symbol-value) (value symbol) @@ -70,12 +87,7 @@ (setf (%symbol-global-value symbol) value)) (defun symbol-function (symbol) - (let ((function-value - (etypecase symbol - (null - (movitz-accessor symbol movitz-nil-symbol function-value)) - (symbol - (movitz-accessor symbol movitz-symbol function-value))))) + (let ((function-value (get-symbol-slot symbol function-value))) (when (eq function-value (load-global-constant movitz::unbound-function)) (error 'undefined-function :name symbol)) function-value)) @@ -90,14 +102,9 @@ (setf-movitz-accessor (symbol movitz-symbol function-value) value)) (defun symbol-name (symbol) - (etypecase symbol - (null - (movitz-accessor symbol movitz-nil-symbol name)) - (symbol - (movitz-accessor symbol movitz-symbol name)))) + (get-symbol-slot symbol name string)) (defun (setf symbol-name) (value symbol) - (check-type value string) (etypecase symbol (null (error "Can't change the name of NIL.")) @@ -105,11 +112,7 @@ (setf-movitz-accessor (symbol movitz-symbol name) value)))) (defun symbol-plist (symbol) - (etypecase symbol - (null - (movitz-accessor symbol movitz-nil-symbol plist)) - (symbol - (movitz-accessor symbol movitz-symbol plist)))) + (get-symbol-slot symbol plist)) (defun (setf symbol-plist) (value symbol) (etypecase symbol @@ -119,11 +122,7 @@ (setf-movitz-accessor (symbol movitz-symbol plist) value)))) (defun symbol-package (symbol) - (etypecase symbol - (null - (movitz-accessor symbol movitz-nil-symbol package)) - (symbol - (movitz-accessor symbol movitz-symbol package)))) + (get-symbol-slot symbol package)) (defun boundp (symbol) (boundp symbol)) @@ -134,11 +133,8 @@ symbol) (defun fboundp (symbol) - (etypecase symbol - (null nil) - (symbol - (not (eq (movitz-accessor symbol movitz-symbol function-value) - (load-global-constant movitz::unbound-function)))))) + (not (eq (get-symbol-slot symbol function-value) + (load-global-constant movitz::unbound-function)))) (defun %create-symbol (name &optional (package nil) (plist nil)

1 0

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

29 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23744 Modified Files: basic-macros.lisp Log Message: Re-arranged many details about *movitz-nil*, movitz-null, and how it relates to the cons and symbol binary-classes etc. This should now be slightly less messy, and slightly more efficient. Date: Wed Jul 28 17:13:18 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.33 movitz/losp/muerte/basic-macros.lisp:1.34 --- movitz/losp/muerte/basic-macros.lisp:1.33 Fri Jul 23 07:36:47 2004 +++ movitz/losp/muerte/basic-macros.lisp Wed Jul 28 17:13:18 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.33 2004/07/23 14:36:47 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.34 2004/07/29 00:13:18 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1040,7 +1040,8 @@ (do-case (t :boolean-cf=1 :labels (boundp-done)) (:compile-form (:result-mode :eax) ,symbol) (:cmpl :edi :eax) - (:je 'boundp-done) ; if ZF=0, then CF=0 + (:cmc) + (:je 'boundp-done) ; if ZF=1, then CF=1 after CMC (:call-local-pf dynamic-find-binding) (:jc 'boundp-done) (:movl (:eax #.(bt:slot-offset 'movitz:movitz-symbol 'movitz::value)) :eax) @@ -1054,6 +1055,9 @@ `(progn (defparameter ,name ,init-form ,docstring) (define-symbol-macro ,name (%symbol-global-value ',name)))) + +(define-compiler-macro assembly-register (register) + `(with-inline-assembly (:returns ,register))) (require :muerte/setf)

1 0

[movitz-cvs] CVS update: movitz/storage-types.lisp
by Frode Vatvedt Fjeld 29 Jul '04

29 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv23584 Modified Files: storage-types.lisp Log Message: Re-arranged many details about *movitz-nil*, movitz-null, and how it relates to the cons and symbol binary-classes etc. This should now be slightly less messy, and slightly more efficient. Date: Wed Jul 28 17:13:13 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.34 movitz/storage-types.lisp:1.35 --- movitz/storage-types.lisp:1.34 Wed Jul 28 03:00:50 2004 +++ movitz/storage-types.lisp Wed Jul 28 17:13:13 2004 @@ -9,14 +9,12 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: storage-types.lisp,v 1.34 2004/07/28 10:00:50 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.35 2004/07/29 00:13:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ (in-package movitz) -(defvar *movitz-nil* nil) - ;; (defconstant +tag-other+ 6) (define-unsigned lu64 8 :little-endian) @@ -276,14 +274,14 @@ (defun print-cons (ic stream) (typecase (movitz-cdr ic) - (movitz-nil (format stream "~A" (movitz-car ic))) + (movitz-null (format stream "~A" (movitz-car ic))) (movitz-cons (format stream "~A " (movitz-car ic))) (t (format stream "~A . ~A" (movitz-car ic) (movitz-cdr ic))))) (defun movitz-list-length (x) (etypecase x (list (list-length x)) - (movitz-nil 0) + (movitz-null 0) (movitz-cons (flet ((movitz-endp (x) (eq x *movitz-nil*))) (do ((n 0 (+ n 2)) ;Counter. @@ -533,38 +531,38 @@ ;;; Symbols (define-binary-class movitz-symbol (movitz-heap-object) - ((value - :binary-type word - :map-binary-write 'movitz-read-and-intern - :map-binary-read-delayed 'movitz-word - :initform 'muerte::unbound ; - :accessor movitz-symbol-value - :initarg value) - (function-value + ((function-value :binary-type word :accessor movitz-symbol-function-value :map-binary-write 'movitz-read-and-intern-function-value :map-binary-read-delayed 'movitz-word - :initarg function-value - :initform 'muerte::unbound) + :initarg :function-value + :initform 'muerte::unbound-function) + (value + :binary-type word + :map-binary-write 'movitz-read-and-intern + :map-binary-read-delayed 'movitz-word + :initform 'muerte::unbound ; + :accessor movitz-symbol-value + :initarg :value) (plist :binary-type word :accessor movitz-plist - :map-binary-write 'movitz-intern + :map-binary-write 'movitz-read-and-intern :map-binary-read-delayed 'movitz-word - :initform *movitz-nil* - :initarg plist) + :initform nil + :initarg :plist) (name :binary-type word - :map-binary-write 'movitz-intern + :map-binary-write 'movitz-read-and-intern :map-binary-read-delayed 'movitz-word - :initarg name + :initarg :name :accessor movitz-symbol-name) (package :binary-type word - :map-binary-write 'movitz-intern + :map-binary-write 'movitz-read-and-intern :map-binary-read-delayed 'movitz-word - :initform *movitz-nil* + :initform nil :accessor movitz-symbol-package) (flags :binary-type (define-bitfield movitz-symbol-flags (lu16) @@ -573,6 +571,7 @@ :constant-variable 4 :setf-placeholder 5))) :accessor movitz-symbol-flags + :initarg :flags :initform nil) (hash-key :binary-lisp-type lu16 @@ -581,7 +580,7 @@ (lisp-symbol :initform nil :initarg :lisp-symbol)) - (:slot-align value -7)) + (:slot-align function-value -7)) #+ignore (defmethod write-binary-record :before ((obj movitz-symbol) stream) @@ -604,7 +603,7 @@ (let ((name-string (image-read-intern-constant *image* (symbol-name name)))) (make-instance 'movitz-symbol :hash-key (movitz-sxhash name-string) - 'name name-string + :name name-string :lisp-symbol name))) (defmethod print-object ((object movitz-symbol) stream) @@ -620,8 +619,6 @@ (defun movitz-read-and-intern-function-value (obj type) (assert (eq type 'word)) (cond - ((eq 'muerte::unbound obj) - (binary-slot-value (image-run-time-context *image*) 'unbound-function)) ((typep obj 'movitz-funobj) (movitz-intern obj)) ((symbolp obj) @@ -632,90 +629,26 @@ ;;; NIL -(define-binary-class movitz-nil (movitz-heap-object) - ((car :binary-type word - :map-binary-read-delayed 'movitz-word - :map-binary-write 'movitz-intern) - (cdr :binary-type word - :map-binary-read-delayed 'movitz-word - :map-binary-write 'movitz-intern) - (sym :reader movitz-nil-sym))) - -(defmethod movitz-object-offset ((obj movitz-nil)) (error "xxx")) -(defmethod movitz-symbol-value ((obj movitz-nil)) obj) - -(defmethod update-movitz-object ((obj movitz-nil) lisp-obj) - (declare (ignore lisp-obj)) - (values)) - -(defmethod movitz-car ((x movitz-nil)) x) -(defmethod movitz-cdr ((x movitz-nil)) x) - -(define-binary-class movitz-nil-symbol (movitz-symbol) - ((value - :binary-type word - :initform nil - :map-binary-write 'movitz-read-and-intern - :map-binary-read-delayed 'movitz-word) - (function-value - :initarg function-value - :initform 'muerte::unbound - :binary-type word - :map-binary-write 'movitz-read-and-intern-function-value - :map-binary-read-delayed 'movitz-word) - (plist - :binary-type word - :initform nil - :map-binary-write 'movitz-intern - :map-binary-read-delayed 'movitz-word) - (name - :binary-type word - :map-binary-write 'movitz-intern - :map-binary-read-delayed 'movitz-word) - (package - :binary-type word - :initform *movitz-nil* - :map-binary-write 'movitz-intern - :map-binary-read-delayed 'movitz-word) - (hash-key - :binary-lisp-type lu16) - (flags - :binary-type movitz-symbol-flags - :initform '(:constant-variable))) - (:slot-align value 7)) - -(defmethod movitz-intern ((object movitz-nil-symbol) &optional type) - (declare (ignore type)) - (image-intern-object *image* object)) -;;;(defmethod movitz-intern ((obj movitz-nil)) -;;; (declare (special *image*)) -;;; (princ (image-nil-value *image*))) +(define-binary-class movitz-null (movitz-symbol) ()) (defun make-movitz-nil () - (let ((new-nil (make-instance 'movitz-nil))) - (setf (slot-value new-nil 'car) new-nil - (slot-value new-nil 'cdr) new-nil) - (let ((*movitz-nil* new-nil)) - (setf (slot-value new-nil 'sym) - (make-instance 'movitz-nil-symbol - 'name (make-movitz-string "NIL") - 'value new-nil - 'function-value 'muerte::unbound - 'plist new-nil - :hash-key (if (not (boundp '*image*)) 0 - (logand #xffff (incf (image-symbol-hash-key-counter *image*))))))) - new-nil)) + (make-instance 'movitz-null + :name (symbol-name nil) + :value nil + :plist nil + :hash-key 0 + :flags '(:constant-variable))) + +(defmethod movitz-intern ((object movitz-null) &optional (type 'word)) + (assert (eq 'word type)) + (image-nil-word *image*)) (defun movitz-null (x) - (eq x *movitz-nil*)) + (typep x 'movitz-null)) (deftype movitz-list () - `(or movitz-cons (satisfies movitz-null))) - -(defmethod movitz-intern ((obj movitz-nil) &optional type) - (declare (ignore type)) - (image-nil-word *image*)) + `(or movitz-cons movitz-null)) ;;; Compiled funobj @@ -1046,7 +979,8 @@ (defun movitz-sxhash (object) "Must match the SXHASH function in :cl/hash-tables." (typecase object - (movitz-nil 0) + (movitz-null + 0) (movitz-symbol (movitz-symbol-hash-key object)) (movitz-string @@ -1134,9 +1068,9 @@ ;;; -(unless (typep *movitz-nil* 'movitz-nil) - (warn "Creating new *MOVITZ-NIL* object!") - (setf *movitz-nil* (make-movitz-nil))) +;;;(unless (typep *movitz-nil* 'movitz-nil) +;;; (warn "Creating new *MOVITZ-NIL* object!") +;;; (setf *movitz-nil* (make-movitz-nil))) (define-binary-class gate-descriptor () @@ -1218,8 +1152,8 @@ (pad :binary-lisp-type 3) (dummy :binary-type word - :initform *movitz-nil* - :map-binary-write 'movitz-intern + :initform nil + :map-binary-write 'movitz-read-and-intern :map-binary-read-delayed 'movitz-word) (class :binary-type word

1 0

[movitz-cvs] CVS update: movitz/movitz.lisp
by Frode Vatvedt Fjeld 29 Jul '04

29 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv23364 Modified Files: movitz.lisp Log Message: Re-arranged many details about *movitz-nil*, movitz-null, and how it relates to the cons and symbol binary-classes etc. This should now be slightly less messy, and slightly more efficient. Date: Wed Jul 28 17:13:09 2004 Author: ffjeld Index: movitz/movitz.lisp diff -u movitz/movitz.lisp:1.8 movitz/movitz.lisp:1.9 --- movitz/movitz.lisp:1.8 Wed Jul 21 15:28:48 2004 +++ movitz/movitz.lisp Wed Jul 28 17:13:09 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Mon Oct 9 20:52:58 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: movitz.lisp,v 1.8 2004/07/21 22:28:48 ffjeld Exp $ +;;;; $Id: movitz.lisp,v 1.9 2004/07/29 00:13:09 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -19,6 +19,9 @@ (defvar *ii* nil) ; for interactive use. (defvar *image*) + +(define-symbol-macro *movitz-nil* + (image-nil-object *image*)) (define-unsigned lu16 2 :little-endian) (define-unsigned lu32 4 :little-endian)

1 0

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

29 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv23046 Modified Files: image.lisp Log Message: Re-arranged many details about *movitz-nil*, movitz-null, and how it relates to the cons and symbol binary-classes etc. This should now be slightly less messy, and slightly more efficient. Date: Wed Jul 28 17:13:00 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.53 movitz/image.lisp:1.54 --- movitz/image.lisp:1.53 Wed Jul 28 03:00:33 2004 +++ movitz/image.lisp Wed Jul 28 17:13:00 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.53 2004/07/28 10:00:33 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.54 2004/07/29 00:13:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -119,16 +119,21 @@ :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) ;; function global constants - (unbound-function - :binary-type word - :binary-tag :global-function - :map-binary-read-delayed 'movitz-word - :map-binary-write 'movitz-intern) +;;; (unbound-function +;;; :binary-type word +;;; :binary-tag :global-function +;;; :map-binary-read-delayed 'movitz-word +;;; :map-binary-write 'movitz-intern) ;; per thread parameters (dynamic-env :binary-type lu32 :initform 0) ;; More per-thread parameters + (unwind-protect-tag + :binary-type word + :map-binary-read-delayed 'movitz-word + :map-binary-write 'movitz-read-and-intern + :initform 'muerte::unwind-protect-tag) (restart-tag :binary-type word :map-binary-read-delayed 'movitz-word @@ -141,18 +146,8 @@ :binary-type word ; in order for the bound instruction to work. :initform #x100000) ;; - (unbound-value - :binary-type word - :map-binary-read-delayed 'movitz-word - :map-binary-write 'movitz-read-and-intern - :initform 'muerte::unbound) - (unwind-protect-tag - :binary-type word - :map-binary-read-delayed 'movitz-word - :map-binary-write 'movitz-read-and-intern - :initform 'muerte::unwind-protect-tag) (boolean-one :binary-type :label) - (not-nil ; not-nil, t-symbol and null-cons must be consecutive. + (not-nil ; not-nil, t-symbol and not-not-nil must be consecutive. :binary-type word :initform nil :map-binary-write 'movitz-read-and-intern @@ -163,13 +158,21 @@ :initarg :t-symbol :map-binary-write 'movitz-intern :map-binary-read-delayed 'movitz-word) - (null-cons - :binary-type movitz-nil - :initarg :null-cons) - (null-sym - :binary-type movitz-nil-symbol + (not-not-nil + :binary-type word + :initform nil + :map-binary-write 'movitz-read-and-intern + :map-binary-read-delayed 'movitz-word) + ;; (null-cons :binary-type :label) + (null-symbol + :binary-type movitz-symbol :reader movitz-run-time-context-null-symbol - :initarg :null-sym) + :initarg :null-symbol) + (unbound-value + :binary-type word + :map-binary-read-delayed 'movitz-word + :map-binary-write 'movitz-read-and-intern + :initform 'muerte::unbound) ;; primitive functions global constants (dynamic-find-binding :map-binary-write 'movitz-intern-code-vector @@ -480,7 +483,7 @@ :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function)) - (:slot-align null-cons -1)) + (:slot-align null-symbol -5)) (defun atomically-status-simple-pf (pf-name reset-status-p &rest registers) (bt:enum-value 'movitz::atomically-status @@ -511,15 +514,17 @@ (defun global-constant-offset (slot-name) (check-type slot-name symbol) - - (slot-offset 'movitz-run-time-context - (intern (symbol-name slot-name) :movitz))) + (let ((slot-name (find-symbol (symbol-name slot-name) :movitz))) + (assert slot-name) + (if (not (eq slot-name 'unbound-function)) + (slot-offset 'movitz-run-time-context slot-name) + (+ (slot-offset 'movitz-run-time-context 'null-symbol) + (slot-offset 'movitz-symbol 'function-value))))) (defun make-movitz-run-time-context () (make-instance 'movitz-run-time-context :t-symbol (movitz-read 't) - :null-cons *movitz-nil* - :null-sym (movitz-nil-sym *movitz-nil*))) + :null-symbol *movitz-nil*)) (defclass image () ((ds-segment-base @@ -560,6 +565,9 @@ :accessor image-symbol-hash-key-counter) (nil-word :accessor image-nil-word) + (nil-object + :initarg :nil-object + :accessor image-nil-object) (t-symbol :accessor image-t-symbol) (bootblock @@ -639,7 +647,7 @@ () "The MOVITZ-HEAP-OBJECT-OTHER type ~A is malformed!" (type-of object)) (etypecase object - (movitz-nil + (movitz-null (image-nil-word image)) (movitz-heap-object (+ (movitz-object-offset object) @@ -778,6 +786,7 @@ (defun make-movitz-image (start-address) (let ((*image* (make-instance 'symbolic-image + :nil-object (make-movitz-nil) :start-address start-address :movitz-features '(:movitz) :function-code-sizes @@ -785,8 +794,8 @@ (copy-hash-table (function-code-sizes *image*)) (make-hash-table :test #'equal))))) (setf (image-nil-word *image*) - (1+ (- (slot-offset 'movitz-run-time-context 'null-cons) - (slot-offset 'movitz-run-time-context 'run-time-context-start)))) + (+ 5 (- (slot-offset 'movitz-run-time-context 'null-symbol) + (slot-offset 'movitz-run-time-context 'run-time-context-start)))) (format t "~&;; NIL value: #x~X.~%" (image-nil-word *image*)) (assert (eq :null (extract-tag (image-nil-word *image*))) () "NIL value #x~X has tag ~D, but it must be ~D." @@ -914,10 +923,13 @@ ;; do (warn "sp: ~S ~S" symbol plist) do (let ((x (movitz-read symbol))) (typecase x + (movitz-null) (movitz-symbol (setf (movitz-plist x) - (movitz-read (translate-program plist :cl :muerte.cl)))) - (movitz-nil) + (movitz-read (translate-program (loop for (property value) on plist by #'cddr + unless (member property '(special constantp)) + append (list property value)) + :cl :muerte.cl)))) (t (warn "not a symbol for plist: ~S has ~S" symbol plist))))) ;; pull in global properties (loop for var in (image-compile-time-variables *image*) @@ -1479,7 +1491,7 @@ (defun movitz-make-upload-form (object &optional (quotep t)) "Not completed." (typecase object - ((or movitz-nil null) "()") + ((or movitz-null null) "()") (cons (format nil "(list~{ ~A~})" (mapcar #'movitz-make-upload-form object))) @@ -1547,7 +1559,7 @@ (symbol expr) (array expr) (cons (mapcar #'movitz-print expr)) - ((or movitz-nil movitz-run-time-context) nil) + ((or (satisfies movitz-null) movitz-run-time-context) nil) (movitz-fixnum (movitz-fixnum-value expr)) (movitz-std-instance expr)

1 0

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

29 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv21687 Modified Files: compiler.lisp Log Message: Re-arranged many details about *movitz-nil*, movitz-null, and how it relates to the cons and symbol binary-classes etc. This should now be slightly less messy, and slightly more efficient. Date: Wed Jul 28 17:12:54 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.86 movitz/compiler.lisp:1.87 --- movitz/compiler.lisp:1.86 Wed Jul 28 03:00:20 2004 +++ movitz/compiler.lisp Wed Jul 28 17:12:54 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.86 2004/07/28 10:00:20 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.87 2004/07/29 00:12:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -3679,7 +3679,7 @@ (case op (:movl (etypecase movitz-obj - (movitz-nil + (movitz-null (ecase (result-mode-type result-mode) (:lexical-binding (make-store-lexical result-mode :edi nil frame-map)) @@ -4369,7 +4369,7 @@ ,optional-ok-label))))) (when rest-var (let* ((rest-binding (movitz-binding rest-var env)) - (rest-position (function-argument-argnum rest-binding))) + #+ignore (rest-position (function-argument-argnum rest-binding))) #+ignore (assert (or (typep rest-binding 'hidden-rest-function-argument) (movitz-env-get rest-var 'dynamic-extent nil env)) @@ -4377,8 +4377,7 @@ "&REST variable ~S must be dynamic-extent." rest-var) ;; (setq need-normalized-ecx-p t) (append #+ignore (make-immediate-move rest-position :edx) - `(#+ignore - (:call (:edi ,(global-constant-offset 'restify-dynamic-extent))) + `(#+ignore (:call (:edi ,(global-constant-offset 'restify-dynamic-extent))) (:init-lexvar ,rest-binding :init-with-register :eax :init-with-type list))))) @@ -4796,8 +4795,8 @@ (t (error "Don't know ECX mode ~S." returns-provided))))) (:boolean-cf=1 (values (append code - `((:sbbl :ecx :ecx) - (:movl (:edi (:ecx 4) ,(global-constant-offset 'null-cons)) + `((:sbbl :ecx :ecx) ; T => -1, NIL => 0 + (:movl (:edi (:ecx 4) ,(global-constant-offset 'not-not-nil)) :eax))) :eax)) (#.+boolean-modes+ @@ -5632,7 +5631,7 @@ (if (eq movitz-obj (image-t-symbol *image*)) (make-indirect-reference :edi (global-constant-offset 't-symbol)) (etypecase movitz-obj - (movitz-nil :edi) + (movitz-null :edi) (movitz-immediate-object (movitz-immediate-value movitz-obj)) (movitz-heap-object (make-indirect-reference :esi (movitz-funobj-intern-constant funobj movitz-obj)))))))

1 0

[movitz-cvs] CVS update: movitz/compiler-types.lisp
by Frode Vatvedt Fjeld 29 Jul '04

29 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv20832 Modified Files: compiler-types.lisp Log Message: Re-arranged many details about *movitz-nil*, movitz-null, and how it relates to the cons and symbol binary-classes etc. This should now be slightly less messy, and slightly more efficient. Date: Wed Jul 28 17:12:49 2004 Author: ffjeld Index: movitz/compiler-types.lisp diff -u movitz/compiler-types.lisp:1.18 movitz/compiler-types.lisp:1.19 --- movitz/compiler-types.lisp:1.18 Fri Jul 9 09:10:26 2004 +++ movitz/compiler-types.lisp Wed Jul 28 17:12:48 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Sep 10 00:40:07 2003 ;;;; -;;;; $Id: compiler-types.lisp,v 1.18 2004/07/09 16:10:26 ffjeld Exp $ +;;;; $Id: compiler-types.lisp,v 1.19 2004/07/29 00:12:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -351,7 +351,7 @@ (let ((x (or (= -1 code) (and (member x members :test #'movitz-eql) t) (cond - ((typep x 'movitz-nil) + ((typep x 'movitz-null) (type-code-p 'symbol code)) ((basic-typep x 'fixnum) (or (type-code-p 'integer code)

1 0

[movitz-cvs] CVS update: movitz/procfs-image.lisp
by Frode Vatvedt Fjeld 29 Jul '04

29 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3698 Modified Files: procfs-image.lisp Log Message: Minor tweaks. Date: Wed Jul 28 17:00:59 2004 Author: ffjeld Index: movitz/procfs-image.lisp diff -u movitz/procfs-image.lisp:1.12 movitz/procfs-image.lisp:1.13 --- movitz/procfs-image.lisp:1.12 Wed Jul 28 03:00:40 2004 +++ movitz/procfs-image.lisp Wed Jul 28 17:00:59 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Aug 24 11:39:37 2001 ;;;; -;;;; $Id: procfs-image.lisp,v 1.12 2004/07/28 10:00:40 ffjeld Exp $ +;;;; $Id: procfs-image.lisp,v 1.13 2004/07/29 00:00:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -179,7 +179,7 @@ ((or movitz-funobj movitz-struct movitz-std-instance) object) (t (movitz-print object)))) - (t () (list :unknown-word word))))) + (t (c) (list :word-error word c))))) (defun backtrace (&key (reqs t) print-frames print-returns spartan) (format t "~&Backtracing from EIP = #x~X: " @@ -233,7 +233,7 @@ (unless (zerop (ldb (byte 2 0) address)) (warn "Non-aligned address to GET-WORD: #x~8,'0X." address)) (setf (image-stream-position *image* physicalp) address) - (read-binary 'word (image-stream *image*))) + (values (read-binary 'word (image-stream *image*)))) (defun do-stack-frame (frame-address count) (warn "Frame ~D: #x~8,'0X" count frame-address)

1 0

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

28 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv13377 Modified Files: typep.lisp Log Message: My previous fix in the deftype expander was flawed: We need to check the package of the second element of the form (the type-name), not the first (the operator, i.e. deftype). Also, on emarsden's suggestion, I added some with-standard-io-syntax wrappers around some symbol-name generators, just for consistency. Date: Wed Jul 28 07:50:26 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.34 movitz/losp/muerte/typep.lisp:1.35 --- movitz/losp/muerte/typep.lisp:1.34 Wed Jul 28 05:30:34 2004 +++ movitz/losp/muerte/typep.lisp Wed Jul 28 07:50:26 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.34 2004/07/28 12:30:34 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.35 2004/07/28 14:50:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -406,7 +406,8 @@ form))))) (defmacro define-typep (tname lambda &body body) - (let ((fname (format nil "~A-~A" 'typep tname))) + (let ((fname (with-standard-io-syntax + (format nil "~A-~A" 'typep tname)))) `(progn (eval-when (:compile-toplevel) (setf (gethash (intern ,(symbol-name tname)) @@ -426,10 +427,11 @@ (defun ,fname ,lambda ,@body))))) (defmacro deftype (&whole form name lambda &body body) - (let ((fname (intern (format nil "~A-~A" 'deftype name)))) + (let ((fname (intern (with-standard-io-syntax + (format nil "~A-~A" 'deftype name))))) `(progn (eval-when (:compile-toplevel) - (unless (eq (symbol-package (car ',form)) (find-package :common-lisp)) + (unless (eq (symbol-package (cadr ',form)) (find-package :common-lisp)) ,form) (setf (gethash (translate-program ',name :cl :muerte.cl) *compiler-derived-typespecs*)

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs July 2004