movitz-cvs May 2005

movitz-cvs@common-lisp.net

1 participants
103 discussions

[movitz-cvs] CVS update: movitz/image.lisp
by ffjeld＠common-lisp.net 05 May '05

05 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv23901 Modified Files: image.lisp Log Message: Cleaned up the exports from the muerte package, somewhat. Date: Thu May 5 17:16:39 2005 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.97 movitz/image.lisp:1.98 --- movitz/image.lisp:1.97 Thu May 5 15:21:40 2005 +++ movitz/image.lisp Thu May 5 17:16:38 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.97 2005/05/05 13:21:40 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.98 2005/05/05 15:16:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -572,8 +572,8 @@ muerte:run-time-context muerte.mop:standard-effective-slot-definition muerte.mop:funcallable-standard-class - muerte:basic-restart - muerte:illegal-object)) + muerte::basic-restart + muerte::illegal-object)) (defun class-object-offset (name) (let ((name (translate-program name :cl :muerte.cl)))

1 0

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

05 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv23883 Modified Files: special-operators.lisp Log Message: Cleaned up the exports from the muerte package, somewhat. Date: Thu May 5 17:16:34 2005 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.51 movitz/special-operators.lisp:1.52 --- movitz/special-operators.lisp:1.51 Wed Apr 27 01:45:48 2005 +++ movitz/special-operators.lisp Thu May 5 17:16:33 2005 @@ -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.51 2005/04/26 23:45:48 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.52 2005/05/05 15:16:33 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -283,7 +283,7 @@ (setf (movitz-symbol-value (movitz-read name)) code-vector) (when symtab-property (setf (movitz-env-get name :symtab) - (translate-program symtab :movitz :muerte))) + (muerte::translate-program symtab :movitz :muerte))) (compiler-values ())))))) (define-special-operator define-prototyped-function (&form form)

1 0

[movitz-cvs] CVS update: movitz/packages.lisp
by ffjeld＠common-lisp.net 05 May '05

05 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv23862 Modified Files: packages.lisp Log Message: Cleaned up the exports from the muerte package, somewhat. Date: Thu May 5 17:16:30 2005 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.47 movitz/packages.lisp:1.48 --- movitz/packages.lisp:1.47 Sat Apr 30 23:16:12 2005 +++ movitz/packages.lisp Thu May 5 17:16:29 2005 @@ -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.47 2005/04/30 21:16:12 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.48 2005/05/05 15:16:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1088,19 +1088,15 @@ (:use muerte.mop muerte.common-lisp) (:import-from common-lisp cl:nil) (:shadow get-setf-expansion) - (:export translate-program - decode-macro-lambda-list - with-inline-assembly - with-progn-results - make-named-function - without-function-prelude - numargs-case - movitz-accessor - simple-read-from-string + (:export #:translate-program + #:decode-macro-lambda-list + #:with-inline-assembly + #:make-named-function + #:without-function-prelude + #:numargs-case + #:simple-read-from-string #:read-key - print-word - fixnump below - print-unreadable-movitz-object + #:fixnump #:newline #:*print-safely* @@ -1119,17 +1115,9 @@ #:*backtrace-print-level* #:backtrace - #:stack-ref - #:with-each-dynamic-context - #:stack-frame-uplink - #:current-stack-frame - #:current-dynamic-context - #:stack-frame-funobj - #:stack-frame-call-site - #:stack-frame-ref - #:check-stack-limit #:dit-frame-ref - #:dit-frame-casf + #:check-stack-limit + #:current-stack-frame #:interrupt-default-handler #:exception-handler @@ -1157,51 +1145,41 @@ #:movitz-type-slot-offset - vector-element-type - vector-element-size - with-subvector-accessor - svref%unsafe - bvref-u16 - object-location - object-tag - location-in-object-p - inline-malloc - define-compile-time-variable - define-primitive-function - without-gc - with-stack-check - with-symbol-mutex - spin-wait-pause - char-whitespace-p - wrong-argument-count - throw-error - *debugger-function* - *debugger-invoked-stack-frame* - *debugger-condition* - *debugger-dynamic-context* - pprint-clumps - do-trace - do-untrace - malloc-initialize - clos-bootstrap - *forward-generic-function* - halt-cpu + #:object-location + #:object-tag + #:location-in-object-p + #:define-compile-time-variable + #:define-primitive-function + #:without-gc + #:with-stack-check + #:with-symbol-mutex + #:spin-wait-pause + #:char-whitespace-p + #:wrong-argument-count + #:throw-error + #:*debugger-function* + #:*debugger-invoked-stack-frame* + #:*debugger-condition* + #:*debugger-dynamic-context* + #:pprint-clumps + #:do-trace + #:do-untrace + #:malloc-initialize + #:clos-bootstrap + #:*forward-generic-function* + #:halt-cpu - find-restart-by-index - find-restart-from-context - map-active-restarts - with-basic-restart + #:find-restart-by-index + #:find-restart-from-context + #:map-active-restarts + #:with-basic-restart #:dynamic-variable-install #:dynamic-variable-uninstall #:code-vector - #:vector-u8 - #:vector-u16 - #:vector-u32 #:pointer #:basic-restart - #:illegal-object #:run-time-context #:run-time-context-class #:current-run-time-context @@ -1234,35 +1212,23 @@ device-clear-input device-finish-record - translate-program - decode-macro-lambda-list - decode-optional-formal - decode-keyword-formal - parse-declarations-and-body - parse-docstring-declarations-and-body - unfold-circular-list - compute-function-block-name + #:unfold-circular-list + #:translate-program + #:decode-macro-lambda-list + #:decode-optional-formal + #:decode-keyword-formal + #:parse-declarations-and-body + #:parse-docstring-declarations-and-body + #:compute-function-block-name - load-global-constant - load-global-constant-u32 - runtime-context-slot - movitz-accessor - halt-cpu + #:movitz-accessor #:%object-lispval #:%lispval-object #:objects-equalp - word-nibble - &edx - - #:un-backquote - #:backquote-comma - #:backquote-comma-at - #:backquote-comma-dot + #:&edx #:memref #:memref-int - #:memcopy - #:%copy-words #:io-port #:io-register8 @@ -1383,19 +1349,19 @@ #:*compiler-allow-untagged-word-bits* ) (:import-from muerte - #:translate-program - #:decode-macro-lambda-list - #:un-backquote - #:backquote-comma - #:backquote-comma-at - #:backquote-comma-dot - - #:decode-optional-formal - #:decode-keyword-formal - #:parse-declarations-and-body - #:parse-docstring-declarations-and-body - #:unfold-circular-list - #:compute-function-block-name + muerte::translate-program + muerte::decode-macro-lambda-list + muerte::un-backquote + muerte::backquote-comma + muerte::backquote-comma-at + muerte::backquote-comma-dot + + muerte::decode-optional-formal + muerte::decode-keyword-formal + muerte::parse-declarations-and-body + muerte::parse-docstring-declarations-and-body + muerte::unfold-circular-list + muerte::compute-function-block-name ))

1 0

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

05 May '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16813 Modified Files: primitive-functions.lisp Log Message: Fixed class-of for run-time-context objects. Date: Thu May 5 15:59:37 2005 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.63 movitz/losp/muerte/primitive-functions.lisp:1.64 --- movitz/losp/muerte/primitive-functions.lisp:1.63 Thu Feb 3 10:19:02 2005 +++ movitz/losp/muerte/primitive-functions.lisp Thu May 5 15:59:37 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.63 2005/02/03 09:19:02 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.64 2005/05/05 13:59:37 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -529,18 +529,31 @@ (:movl (:eax ,movitz:+other-type-offset+) :ecx) (:cmpb ,(movitz:tag :std-instance) :cl) (:jne 'not-std-instance) - (:movl (:eax ,(bt:slot-offset 'movitz::movitz-std-instance 'movitz::class)) :eax) + (,movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax ,(bt:slot-offset 'movitz::movitz-std-instance 'movitz::class)) :eax) (:ret) not-std-instance (:cmpw ,(+ (movitz:tag :funobj) (ash (bt:enum-value 'movitz::movitz-funobj-type :generic-function) 8)) :cx) (:jne 'not-std-gf-instance) - (:movl (:eax ,(bt:slot-offset 'movitz::movitz-funobj-standard-gf + (,movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax ,(bt:slot-offset 'movitz::movitz-funobj-standard-gf 'movitz::standard-gf-class)) :eax) (:ret) not-std-gf-instance + + (:cmpb ,(movitz:tag :run-time-context) :cl) + (:jne 'not-rtc) + (,movitz:*compiler-nonlocal-lispval-read-segment-prefix* + :movl (:eax (:offset movitz-run-time-context class + ,(- (movitz::image-nil-word movitz:*image*) + (movitz::tag :other)))) + :eax) + (:ret) + not-rtc + (:globally (:movl (:edi (:edi-offset classes)) :ebx)) (:cmpb ,(movitz:tag :bignum) :cl) (:jne 'not-bignum) @@ -571,8 +584,6 @@ (structure-object-class object)) (character (find-class 'character)) - (run-time-context - (find-class 'run-time-context)) (null (find-class 'null)) (cons

1 0

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

05 May '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv14081 Modified Files: packages.lisp Log Message: Removed global-properties from run-time-context. Put the hash-table of all packages in *packages* instead. Date: Thu May 5 15:21:52 2005 Author: ffjeld Index: movitz/losp/muerte/packages.lisp diff -u movitz/losp/muerte/packages.lisp:1.8 movitz/losp/muerte/packages.lisp:1.9 --- movitz/losp/muerte/packages.lisp:1.8 Sun Apr 17 20:18:18 2005 +++ movitz/losp/muerte/packages.lisp Thu May 5 15:21:50 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Aug 30 15:19:43 2001 ;;;; -;;;; $Id: packages.lisp,v 1.8 2005/04/17 18:18:18 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.9 2005/05/05 13:21:50 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -30,6 +30,8 @@ shadowing-symbols-list use-list) +(defvar *packages*) ; Set by dump-image. + (defun package-name (object) (package-object-name (find-package object))) @@ -42,9 +44,7 @@ (find-package-string (string name)))) (defun find-package-string (name &optional (start 0) (end (length name)) (key 'identity)) - (values (gethash-string name start end - (get-global-property :packages) - nil key))) + (values (gethash-string name start end *packages* nil key))) (defun assert-package (name) (or (find-package name) @@ -54,7 +54,7 @@ (let (pkgs) (maphash (lambda (k v) (pushnew v pkgs)) - (get-global-property :packages)) + *packages*) pkgs)) (defun find-symbol-string (name start end key &optional (package *package*)) @@ -117,7 +117,7 @@ (symbol-var (gensym)) (loop-tag (gensym)) (end-tag (gensym))) - `(with-hash-table-iterator (,next-package (get-global-property :packages)) + `(with-hash-table-iterator (,next-package *packages*) (do () (nil) (multiple-value-bind (,more-packages-var ,dummy ,package-var) (,next-package)

1 0

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

05 May '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv14053 Modified Files: basic-functions.lisp Log Message: Removed global-properties from run-time-context. Put the hash-table of all packages in *packages* instead. Date: Thu May 5 15:21:48 2005 Author: ffjeld Index: movitz/losp/muerte/basic-functions.lisp diff -u movitz/losp/muerte/basic-functions.lisp:1.17 movitz/losp/muerte/basic-functions.lisp:1.18 --- movitz/losp/muerte/basic-functions.lisp:1.17 Wed Apr 20 08:52:26 2005 +++ movitz/losp/muerte/basic-functions.lisp Thu May 5 15:21:46 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 18:41:57 2001 ;;;; -;;;; $Id: basic-functions.lisp,v 1.17 2005/04/20 06:52:26 ffjeld Exp $ +;;;; $Id: basic-functions.lisp,v 1.18 2005/05/05 13:21:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -326,9 +326,6 @@ (compiled-function x) (t (error "Not a function: ~S" x)))) - -(defun get-global-property (property) - (getf (load-global-constant global-properties) property)) (define-compiler-macro object-location (object) "The location is the object's address divided by fixnum-factor."

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by ffjeld＠common-lisp.net 05 May '05

05 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv14036 Modified Files: image.lisp Log Message: Removed global-properties from run-time-context. Put the hash-table of all packages in *packages* instead. Date: Thu May 5 15:21:40 2005 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.96 movitz/image.lisp:1.97 --- movitz/image.lisp:1.96 Thu May 5 15:02:37 2005 +++ movitz/image.lisp Thu May 5 15:21:40 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.96 2005/05/05 13:02:37 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.97 2005/05/05 13:21:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -428,13 +428,7 @@ :accessor movitz-run-time-context-interrupt-descriptor-table :initform (make-array 256 :initial-element 'muerte::default-interrupt-trampoline) :map-binary-read-delayed 'movitz-word - :map-binary-write 'map-interrupt-trampolines-to-idt) - (global-properties - :binary-type word - :initform nil - :accessor movitz-run-time-context-global-properties - :map-binary-write 'movitz-intern - :map-binary-read-delayed 'movitz-word)) + :map-binary-write 'map-interrupt-trampolines-to-idt)) (:slot-align null-symbol -5)) (defun atomically-continuation-simple-pf (pf-name) @@ -940,12 +934,8 @@ do (let ((mname (movitz-read var)) (mvalue (movitz-read (symbol-value var)))) (setf (movitz-symbol-value mname) mvalue))) - (setf (movitz-run-time-context-global-properties run-time-context) - (movitz-read (list :packages (make-packages-hash) - :trampoline-funcall%1op (find-primitive-function - 'muerte::trampoline-funcall%1op) - :trampoline-funcall%2op (find-primitive-function - 'muerte::trampoline-funcall%2op))))) + (setf (movitz-symbol-value (movitz-read 'muerte::*packages*)) + (movitz-read (make-packages-hash)))) (with-binary-file (stream path :check-stream t :direction :output

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by ffjeld＠common-lisp.net 05 May '05

05 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv12628 Modified Files: image.lisp Log Message: Removed toplevel-funobj from run-time-context. Date: Thu May 5 15:02:37 2005 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.95 movitz/image.lisp:1.96 --- movitz/image.lisp:1.95 Thu May 5 00:47:58 2005 +++ movitz/image.lisp Thu May 5 15:02:37 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.95 2005/05/04 22:47:58 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.96 2005/05/05 13:02:37 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -429,12 +429,6 @@ :initform (make-array 256 :initial-element 'muerte::default-interrupt-trampoline) :map-binary-read-delayed 'movitz-word :map-binary-write 'map-interrupt-trampolines-to-idt) - (toplevel-funobj - :binary-type word - :initform nil - :accessor movitz-run-time-context-toplevel-funobj - :map-binary-write 'movitz-intern - :map-binary-read-delayed 'movitz-word) (global-properties :binary-type word :initform nil @@ -885,7 +879,7 @@ (stable-sort (copy-list (image-load-time-funobjs *image*)) #'> :key #'third)) (let* ((toplevel-funobj (make-toplevel-funobj *image*))) (setf (image-toplevel-funobj *image*) toplevel-funobj - (movitz-run-time-context-toplevel-funobj (image-run-time-context *image*)) toplevel-funobj) + #+ignore ((movitz-run-time-context-toplevel-funobj (image-run-time-context *image*)) toplevel-funobj)) (format t "~&;; load-sequence:~%~<~A~>~%" (mapcar #'second (image-load-time-funobjs *image*))) (movitz-intern toplevel-funobj) (let ((init-code-address (+ (movitz-intern-code-vector (movitz-funobj-code-vector toplevel-funobj)) @@ -1056,7 +1050,8 @@ (file-start-position (file-position stream)) (pad-size 0)) (declare (special *record-all-funobjs*)) - (loop for p upfrom (- (image-start-address image) (image-ds-segment-base image)) by 8 + (loop with prev-obj + for p upfrom (- (image-start-address image) (image-ds-segment-base image)) by 8 until (>= p (image-cons-pointer image)) summing (let ((obj (image-memref image p nil))) @@ -1068,7 +1063,8 @@ (let ((pad-delta (- new-pos (file-position stream)))) (with-simple-restart (continue "Never mind.") (assert (<= 0 pad-delta 31) () - "pad-delta ~S for ~S, p: ~S, new-pos: ~S" pad-delta obj p new-pos)) + "pad-delta ~S for ~S (prev ~S), p: ~S, new-pos: ~S" + pad-delta obj prev-obj p new-pos)) (incf pad-size pad-delta)) (set-file-position stream new-pos obj)) ;; (warn "Dump at address #x~X, filepos #x~X: ~A" p (file-position stream) obj) @@ -1085,17 +1081,18 @@ (:code (incf code-vectors-numof) (incf code-vectors-size write-size)))) (movitz-funobj (incf funobjs-numof) - (incf funobjs-size write-size)) + (incf funobjs-size write-size)) (movitz-symbol (incf symbols-numof) - (incf symbols-size write-size) - (when (movitz-eql *movitz-nil* (movitz-symbol-package obj)) - (incf gensyms-numof))) + (incf symbols-size write-size) + (when (movitz-eql *movitz-nil* (movitz-symbol-package obj)) + (incf gensyms-numof))) (movitz-cons (incf conses-numof) - (incf conses-size write-size))) + (incf conses-size write-size))) (assert (= write-size (sizeof obj) (- (file-position stream) old-pos)) () "Inconsistent write-size(~D)/sizeof(~D)/file-position delta(~D) ~ for object ~S." write-size (sizeof obj) (- (file-position stream) old-pos) obj) + (setf prev-obj obj) write-size)))) finally (let ((total-size (file-position stream)) @@ -1582,7 +1579,9 @@ (defmethod make-toplevel-funobj ((*image* symbolic-image)) (declare (special *image*)) (let ((toplevel-code (loop for (funobj) in (image-load-time-funobjs *image*) - collect `(muerte::simple-funcall ,funobj)))) + collect `(muerte::simple-funcall ,funobj))) + ;; We need toplevel-funobj's identity in the code below. + (toplevel-funobj (make-instance 'movitz-funobj-pass1))) (make-compiled-funobj 'muerte::toplevel-function () '((muerte::without-function-prelude)) `(muerte.cl:progn @@ -1631,8 +1630,9 @@ (:pushl 0) (:pushl 0) (:movl :esp :ebp) - - (:globally (:movl (:edi (:edi-offset toplevel-funobj)) :esi)) + + (:movl '(:funcall ,(lambda () (movitz-intern toplevel-funobj))) + :esi) (:pushl :esi) (:pushl :edi) (:cmpl #x2badb002 :eax) @@ -1658,7 +1658,7 @@ ,@toplevel-code (muerte::halt-cpu)) - nil t))) + nil t :funobj toplevel-funobj))) (defun mkasm-write-word-eax-ebx () (let ((loop-label (make-symbol "write-word-loop"))

1 0

[movitz-cvs] CVS update: movitz/losp/ll-testing.lisp
by ffjeld＠common-lisp.net 05 May '05

05 May '05

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv28126 Modified Files: ll-testing.lisp Log Message: Make thread isn't really supposed to be here. Date: Thu May 5 12:28:53 2005 Author: ffjeld Index: movitz/losp/ll-testing.lisp diff -u movitz/losp/ll-testing.lisp:1.6 movitz/losp/ll-testing.lisp:1.7 --- movitz/losp/ll-testing.lisp:1.6 Sat Apr 30 00:36:49 2005 +++ movitz/losp/ll-testing.lisp Thu May 5 12:28:52 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Apr 14 08:18:43 2005 ;;;; -;;;; $Id: ll-testing.lisp,v 1.6 2005/04/29 22:36:49 ffjeld Exp $ +;;;; $Id: ll-testing.lisp,v 1.7 2005/05/05 10:28:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -139,34 +139,34 @@ :esi function))) stack) -(defun make-thread (&key (name (gensym "thread-")) (function #'invoke-debugger) (args '(nil))) - "Make a thread and initialize its stack to apply function to args." - (let* ((fs-index 8) ; a vacant spot in the global segment descriptor table.. - (fs (* 8 fs-index)) - (thread (muerte::clone-run-time-context :name name)) - (segment-descriptor-table (symbol-value 'muerte.init::*segment-descriptor-table*))) - (setf (segment-descriptor segment-descriptor-table fs-index) - (segment-descriptor segment-descriptor-table (truncate (segment-register :fs) 8))) - (setf (segment-descriptor-base-location segment-descriptor-table fs-index) - (+ (object-location thread) (muerte::location-physical-offset))) - (let ((cushion nil) - (stack (control-stack-init-for-yield (make-array 4094 :element-type '(unsigned-byte 32)) - function args))) - (multiple-value-bind (ebp esp) - (control-stack-fixate stack) - (setf (control-stack-fs stack) fs - (control-stack-ebp stack) ebp - (control-stack-esp stack) esp)) - (setf (%run-time-context-slot 'dynamic-env thread) 0 - (%run-time-context-slot 'stack-vector thread) stack - (%run-time-context-slot 'stack-top thread) (+ 2 (object-location stack) - (length stack)) - (%run-time-context-slot 'stack-bottom thread) (+ (object-location stack) 2 - (or cushion - (if (>= (length stack) 200) - 100 - 0)))) - (values thread)))) +;;;(defun make-thread (&key (name (gensym "thread-")) (function #'invoke-debugger) (args '(nil))) +;;; "Make a thread and initialize its stack to apply function to args." +;;; (let* ((fs-index 8) ; a vacant spot in the global segment descriptor table.. +;;; (fs (* 8 fs-index)) +;;; (thread (muerte::clone-run-time-context :name name)) +;;; (segment-descriptor-table (symbol-value 'muerte.init::*segment-descriptor-table*))) +;;; (setf (segment-descriptor segment-descriptor-table fs-index) +;;; (segment-descriptor segment-descriptor-table (truncate (segment-register :fs) 8))) +;;; (setf (segment-descriptor-base-location segment-descriptor-table fs-index) +;;; (+ (object-location thread) (muerte::location-physical-offset))) +;;; (let ((cushion nil) +;;; (stack (control-stack-init-for-yield (make-array 4094 :element-type '(unsigned-byte 32)) +;;; function args))) +;;; (multiple-value-bind (ebp esp) +;;; (control-stack-fixate stack) +;;; (setf (control-stack-fs stack) fs +;;; (control-stack-ebp stack) ebp +;;; (control-stack-esp stack) esp)) +;;; (setf (%run-time-context-slot 'dynamic-env thread) 0 +;;; (%run-time-context-slot 'stack-vector thread) stack +;;; (%run-time-context-slot 'stack-top thread) (+ 2 (object-location stack) +;;; (length stack)) +;;; (%run-time-context-slot 'stack-bottom thread) (+ (object-location stack) 2 +;;; (or cushion +;;; (if (>= (length stack) 200) +;;; 100 +;;; 0)))) +;;; (values thread)))) (defun stack-bootstrapper (&rest ignore) (declare (ignore ignore))

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by ffjeld＠common-lisp.net 04 May '05

04 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv2314 Modified Files: image.lisp Log Message: re-arranged movitz-run-time-context a bit. Date: Thu May 5 00:47:59 2005 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.94 movitz/image.lisp:1.95 --- movitz/image.lisp:1.94 Tue May 3 22:12:53 2005 +++ movitz/image.lisp Thu May 5 00:47:58 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.94 2005/05/03 20:12:53 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.95 2005/05/04 22:47:58 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -22,11 +22,6 @@ :initform :run-time-context) (padding :binary-type 3) - (name - :binary-type word - :initform :bootup - :map-binary-write 'movitz-read-and-intern - :map-binary-read-delayed 'movitz-word) (class :binary-type word :map-binary-write 'movitz-intern @@ -38,8 +33,14 @@ :map-binary-write 'movitz-read-and-intern :map-binary-read-delayed 'movitz-word :initarg :slots - :initform #() + :initform #(:init nil) :accessor run-time-context-slots) + (scratch1 + :binary-type word + :initform 0) + (scratch2 + :binary-type word + :initform 0) (fast-car :binary-type code-vector-word :initform nil @@ -58,12 +59,6 @@ :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) - (fast-cdddr - :binary-type code-vector-word - :initform nil - :map-binary-write 'movitz-intern-code-vector - :map-binary-read-delayed 'movitz-word-code-vector - :binary-tag :primitive-function) (fast-car-ebx :binary-type code-vector-word :initform nil @@ -118,11 +113,6 @@ :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) - ;; per thread parameters - (dynamic-env - :binary-type word - :initform 0) - ;; More per-thread parameters (unwind-protect-tag :binary-type word :map-binary-read-delayed 'movitz-word @@ -133,6 +123,11 @@ :map-binary-read-delayed 'movitz-word :map-binary-write 'movitz-read-and-intern :initform 'muerte::restart-protect-tag) + (new-unbound-value + :binary-type word + :map-binary-read-delayed 'movitz-word + :map-binary-write 'movitz-read-and-intern + :initform 'unbound) (stack-bottom ; REMEMBER BOCHS! :binary-type word :initform #x0ff000) @@ -162,11 +157,6 @@ :binary-type movitz-symbol :reader movitz-run-time-context-null-symbol :initarg :null-symbol) - (new-unbound-value - :binary-type word - :map-binary-read-delayed 'movitz-word - :map-binary-write 'movitz-read-and-intern - :initform 'unbound) ;; primitive functions global constants (pop-current-values :binary-type code-vector-word @@ -288,21 +278,37 @@ :binary-tag :global-function :map-binary-write 'movitz-intern :map-binary-read-delayed 'movitz-word) - (complicated-class-of - :binary-type word - :binary-tag :global-function - :map-binary-read-delayed 'movitz-word - :map-binary-write 'movitz-intern) (complicated-compare :binary-type word :binary-tag :global-function :map-binary-read-delayed 'movitz-word :map-binary-write 'movitz-intern) + (dynamic-env + :binary-type word + :initform 0) + (the-class-t + :binary-type word + :initform t + :map-binary-write (lambda (x type) + (declare (ignore type)) + (movitz-read-and-intern (funcall 'muerte::movitz-find-class x) + 'word)) + :map-binary-read-delayed 'movitz-word) + (copy-funobj + :binary-type word + ;; :accessor movitz-run-time-context-copy-funobj + :initform 'muerte::copy-funobj + :map-binary-write (lambda (name type) + (declare (ignore type)) + (movitz-intern (movitz-env-named-function name)))) + + (num-values :binary-type word ; Fixnum :initform 0) (values :binary-type #.(* 4 +movitz-multiple-values-limit+)) + (cons-pointer :binary-type code-vector-word :initform nil @@ -349,46 +355,6 @@ map)) 'word))) :map-binary-read-delayed 'movitz-word) - ;; Some well-known classes - (the-class-t - :binary-type word - :initform t - :map-binary-write (lambda (x type) - (declare (ignore type)) - (movitz-read-and-intern (funcall 'muerte::movitz-find-class x) - 'word)) - :map-binary-read-delayed 'movitz-word) - (exception-handlers - :binary-type word - :map-binary-write 'movitz-intern - :map-binary-read-delayed 'movitz-word - :initarg :exception-handlers - :accessor movitz-run-time-context-exception-handlers) - (interrupt-descriptor-table - :binary-type word - :accessor movitz-run-time-context-interrupt-descriptor-table - :initform (make-array 256 :initial-element 'muerte::default-interrupt-trampoline) - :map-binary-read-delayed 'movitz-word - :map-binary-write 'map-interrupt-trampolines-to-idt) - (toplevel-funobj - :binary-type word - :initform nil - :accessor movitz-run-time-context-toplevel-funobj - :map-binary-write 'movitz-intern - :map-binary-read-delayed 'movitz-word) - (global-properties - :binary-type word - :initform nil - :accessor movitz-run-time-context-global-properties - :map-binary-write 'movitz-intern - :map-binary-read-delayed 'movitz-word) - (copy-funobj - :binary-type word - ;; :accessor movitz-run-time-context-copy-funobj - :initform 'muerte::copy-funobj - :map-binary-write (lambda (name type) - (declare (ignore type)) - (movitz-intern (movitz-env-named-function name)))) (physical-address-offset :binary-type lu32 :initform (image-ds-segment-base *image*)) @@ -399,22 +365,10 @@ :map-binary-read-delayed (lambda (x type) (declare (ignore x type)) (movitz-read nil))) - (stack-vector - :binary-type word - :initform nil - :map-binary-write 'movitz-read-and-intern - :map-binary-read-delayed (lambda (x type) - (declare (ignore x type)) - (movitz-read nil))) (self :binary-type word :initform 6 :map-binary-read-delayed 'movitz-word) - (parent - :binary-type word - :initform nil - :map-binary-write 'movitz-read-and-intern - :map-binary-read-delayed 'movitz-word) (protect-non-pointer-area :binary-type lu32 :initform 3) @@ -436,12 +390,6 @@ :binary-type lu32 :initform 0) (non-pointers-end :binary-type :label) ; ========= NON-POINTER-END ======= - (scratch1 - :binary-type word - :initform 0) - (scratch2 - :binary-type word - :initform 0) (ret-trampoline :binary-type code-vector-word :map-binary-write 'movitz-intern-code-vector @@ -456,7 +404,43 @@ :binary-type code-vector-word :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector - :binary-tag :primitive-function)) + :binary-tag :primitive-function) + (complicated-class-of + :binary-type word + :binary-tag :global-function + :map-binary-read-delayed 'movitz-word + :map-binary-write 'movitz-intern) + (stack-vector + :binary-type word + :initform nil + :map-binary-write 'movitz-read-and-intern + :map-binary-read-delayed (lambda (x type) + (declare (ignore x type)) + (movitz-read nil))) + (exception-handlers + :binary-type word + :map-binary-write 'movitz-intern + :map-binary-read-delayed 'movitz-word + :initarg :exception-handlers + :accessor movitz-run-time-context-exception-handlers) + (interrupt-descriptor-table + :binary-type word + :accessor movitz-run-time-context-interrupt-descriptor-table + :initform (make-array 256 :initial-element 'muerte::default-interrupt-trampoline) + :map-binary-read-delayed 'movitz-word + :map-binary-write 'map-interrupt-trampolines-to-idt) + (toplevel-funobj + :binary-type word + :initform nil + :accessor movitz-run-time-context-toplevel-funobj + :map-binary-write 'movitz-intern + :map-binary-read-delayed 'movitz-word) + (global-properties + :binary-type word + :initform nil + :accessor movitz-run-time-context-global-properties + :map-binary-write 'movitz-intern + :map-binary-read-delayed 'movitz-word)) (:slot-align null-symbol -5)) (defun atomically-continuation-simple-pf (pf-name)

1 0

← Newer
1
...
5
6
7
8
9
10
11
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs May 2005