movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[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

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

28 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv19683 Modified Files: multiboot.lisp Log Message: Patch from Eric Marsden. Date: Wed Jul 28 07:23:37 2004 Author: ffjeld Index: movitz/multiboot.lisp diff -u movitz/multiboot.lisp:1.4 movitz/multiboot.lisp:1.5 --- movitz/multiboot.lisp:1.4 Thu Mar 25 17:42:45 2004 +++ movitz/multiboot.lisp Wed Jul 28 07:23:37 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Jun 12 12:14:12 2002 ;;;; -;;;; $Id: multiboot.lisp,v 1.4 2004/03/26 01:42:45 ffjeld Exp $ +;;;; $Id: multiboot.lisp,v 1.5 2004/07/28 14:23:37 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -43,7 +43,7 @@ :binary-type lu32 :initform 0 :map-binary-write (lambda (x type) - (declare (ignore x y)) + (declare (ignore x type)) (- (sizeof 'multiboot-header) 8))) (magic :accessor magic

1 0

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

28 Jul '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv20160 Modified Files: los0.lisp Log Message: The repl package was renamed, so the init defpackage form needs updating too. The other changes to this file is just my messing around with testing various bits and pieces. Date: Wed Jul 28 07:15:17 2004 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.19 movitz/losp/los0.lisp:1.20 --- movitz/losp/los0.lisp:1.19 Mon Jul 12 19:39:13 2004 +++ movitz/losp/los0.lisp Wed Jul 28 07:15:17 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 1 18:08:32 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: los0.lisp,v 1.19 2004/07/13 02:39:13 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.20 2004/07/28 14:15:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -28,17 +28,21 @@ (require :lib/repl) (defpackage muerte.init - (:use muerte.cl muerte muerte.lib - muerte.x86-pc - muerte.readline - muerte.toplevel - muerte.ethernet - muerte.ip6 - muerte.ip4 - muerte.mop + (:nicknames #:los0) + (:use #:common-lisp + #:muerte + #:muerte.lib + #:muerte.x86-pc + #:repl + #:muerte.readline + #:muerte.toplevel + #:muerte.ethernet + #:muerte.ip6 + #:muerte.ip4 + #:muerte.mop #+ignore muerte.x86-pc.serial)) -(require :los0-gc) +(require :los0-gc) ; Must come after defpackage. (in-package muerte.init) @@ -657,7 +661,7 @@ (loop while (= s0 (rtc-register :second))) (multiple-value-bind (c1-lo c1-hi) (read-time-stamp-counter) - (+ (ash (- c1-hi c0-hi) 20) + (+ (ash (- c1-hi c0-hi) 19) (ash (+ 512 (- c1-lo c0-lo)) -10)))))) (defun report-cpu-frequency () @@ -666,6 +670,13 @@ (format t "~&CPU frequency: ~D.~2,'0D MHz.~%" mhz (round khz 10))) (values)) +(defvar *a* #(#x1 #x2 #x3 #x4 #x5 #x6 #x7 #x8)) +(defvar *b* #(#x5 #xa #xf #x14 #x19 #x1e #x23 #x28 #x1400 #x1e00 #x2800 #x3200 + #x3c00 #x4600 #x5000 #xa00 #x50 #x64 #x78 #x8c #xa0 #x14 #x28 #x3c + #xc800 #xf001 #x1801 #x4000 #x2800 #x5000 #x7800 #xa000 #x230 #x280 + #x50 #xa0 #xf0 #x140 #x190 #x1e0 #x0 #xa001 #x4001 #xe002 #x8003 + #x2003 #xc004 #x6005 #x280 #x3c0 #x500 #x640)) + (defvar *cpu-frequency-mhz*) (defun init-nano-sleep () @@ -685,6 +696,10 @@ ;;;;; +(defvar div #xa65feaab511c61e33df38fdddaf03b59b6f25e1fa4de57e5cf00ae478a855dda4f3638d38bb00ac4af7d8414c3fb36e04fbdf3d3166712d43b421bfa757e85694ad27c48f396d03c8bce8da58db5b82039f35dcf857235c2f1c73b2226a361429190dcb5b6cd0edfb0ff6933900b02cecc0ce69274d8dae7c694804318d6d6b9) + +(defvar guess #x1dc19f99401de22d476c89943491fc187b80bcfa8293ec1cf69c1a81352f047e894e262d24116c82ad0be241c6c6216cab9b66d64417d43bf433db10114c0) + ;;;;;;;;;;;;;;; CL (defun install-internal-time (&optional (minimum-frequency 100)) @@ -753,7 +768,7 @@ (define-toplevel-command :bt (&rest args) (declare (dynamic-extent args)) - (apply #'backtrace args)) + (apply #'backtrace (mapcar #'eval args))) (define-toplevel-command :cpu-reset () (when (y-or-n-p "Really reset CPU?") @@ -782,7 +797,7 @@ (define-toplevel-command :z (&optional x-list) (flet ((do-print (x) - (format t "~&~Z => ~S" x x) + (format t "~&~Z" x) x)) (if x-list (do-print (eval x-list)) @@ -959,6 +974,9 @@ (with-simple-restart (abort "Abort to command level ~D." (1+ *repl-level*)) (read-eval-print))))) +(defun ub (x) + `(hello world ,x or . what)) + (defun random (limit) (etypecase limit (fixnum @@ -968,27 +986,57 @@ (dotimes (i (1- (muerte::%bignum-bigits x))) (setf (memref x 2 i :unsigned-byte32) (muerte::read-time-stamp-counter))) - (setf x (muerte::%bignum-canonicalize x)) + (setf x (muerte::bignum-canonicalize x)) (loop while (>= x limit) do (setf x (truncate x 2))) x)))) +(define-primitive-function test-irq-pf () + "" + (with-inline-assembly (:returns :nothing) + (:int 113) + (:ret))) + +(defun test-irq (&optional eax ebx ecx edx) + (setf (memref nil #x7f 20 :code-vector) (symbol-value 'test-irq-pf)) + (multiple-value-bind (p1 p2) + (with-inline-assembly (:returns :multiple-values) + (:load-lexical (:lexical-binding eax) :eax) + (:load-lexical (:lexical-binding ebx) :ebx) + (:load-lexical (:lexical-binding ecx) :ecx) + (:load-lexical (:lexical-binding edx) :edx) + (:pushl :eax) + (:pushl :ebx) + (:jecxz 'dont-call) + (:globally (:call (:edi (:edi-offset values) 80))) + dont-call + (:store-lexical (:lexical-binding eax) :eax :type t) + (:store-lexical (:lexical-binding ebx) :ebx :type t) + (:store-lexical (:lexical-binding ecx) :ecx :type t) + (:store-lexical (:lexical-binding edx) :edx :type t) + (:popl :ebx) + (:popl :eax) + (:movl 2 :ecx) + (:stc)) + (values eax ebx ecx edx p1 p2))) + (defun genesis () - #+ignore (let ((extended-memsize 0)) ;; Find out how much extended memory we have (setf (io-port #x70 :unsigned-byte8) #x18) (setf extended-memsize (* 256 (io-port #x71 :unsigned-byte8))) (setf (io-port #x70 :unsigned-byte8) #x17) (incf extended-memsize (io-port #x71 :unsigned-byte8)) - (format t "Extended memory: ~D KB" extended-memsize)) + (format t "Extended memory: ~D KB~%" extended-memsize) - (idt-init) - (install-los0-consing) + (idt-init) + (install-los0-consing :kb-size 50) + #+ignore + (install-los0-consing :kb-size (max 100 (truncate (- extended-memsize 1024 2048) 2)))) (setf *debugger-function* #'los0-debugger) (let ((*repl-readline-context* (make-readline-context :history-size 16)) - (*backtrace-stack-frame-barrier* (stack-frame-uplink (current-stack-frame))) + #+ignore (*backtrace-stack-frame-barrier* (stack-frame-uplink (current-stack-frame))) #+ignore (*error-no-condition-for-debugger* t) #+ignore (*debugger-function* #'los0-debugger) (*package* nil))

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-serv19181 Modified Files: typep.lisp Log Message: In the deftype expander, try to be a bit more clever about when to avoid (cl:deftype cl:whatever ..). The previous detection code apparently didn't work under sbcl or cmucl. Date: Wed Jul 28 05:30:35 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.33 movitz/losp/muerte/typep.lisp:1.34 --- movitz/losp/muerte/typep.lisp:1.33 Tue Jul 27 02:22:21 2004 +++ movitz/losp/muerte/typep.lisp Wed Jul 28 05:30:34 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.33 2004/07/27 09:22:21 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.34 2004/07/28 12:30:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -429,7 +429,7 @@ (let ((fname (intern (format nil "~A-~A" 'deftype name)))) `(progn (eval-when (:compile-toplevel) - (unless (eq (symbol-package ',name) (find-package :common-lisp)) + (unless (eq (symbol-package (car ',form)) (find-package :common-lisp)) ,form) (setf (gethash (translate-program ',name :cl :muerte.cl) *compiler-derived-typespecs*)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/run-time-context.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-serv9076 Modified Files: run-time-context.lisp Log Message: Change the name "constant-block" to "run-time-context" so as to be consistent. "Run-time-context" is the name that's I've been using in newer documentation and code. Date: Wed Jul 28 03:01:23 2004 Author: ffjeld Index: movitz/losp/muerte/run-time-context.lisp diff -u movitz/losp/muerte/run-time-context.lisp:1.10 movitz/losp/muerte/run-time-context.lisp:1.11 --- movitz/losp/muerte/run-time-context.lisp:1.10 Tue Jul 20 01:54:48 2004 +++ movitz/losp/muerte/run-time-context.lisp Wed Jul 28 03:01:23 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 12 18:33:02 2003 ;;;; -;;;; $Id: run-time-context.lisp,v 1.10 2004/07/20 08:54:48 ffjeld Exp $ +;;;; $Id: run-time-context.lisp,v 1.11 2004/07/28 10:01:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -48,7 +48,7 @@ (equal context '(current-run-time-context)))) form (let ((slot-name (movitz:movitz-eval slot-name env))) - (ecase (bt:binary-slot-type 'movitz::movitz-constant-block (intern (symbol-name slot-name) :movitz)) + (ecase (bt:binary-slot-type 'movitz::movitz-run-time-context (intern (symbol-name slot-name) :movitz)) (movitz:word `(with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) ,value) @@ -114,8 +114,8 @@ (defun clone-run-time-context (&key (parent (current-run-time-context)) (name :anonymous)) (check-type parent run-time-context) - (let ((context (malloc-pointer-words #.(cl:truncate (bt:sizeof 'movitz::movitz-constant-block) 4)))) - (memcopy context parent -6 0 0 #.(bt:sizeof 'movitz::movitz-constant-block) + (let ((context (malloc-pointer-words #.(cl:truncate (bt:sizeof 'movitz::movitz-run-time-context) 4)))) + (memcopy context parent -6 0 0 #.(bt:sizeof 'movitz::movitz-run-time-context) :unsigned-byte8) (setf (%run-time-context-slot 'name context) name (%run-time-context-slot 'self context) context)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/more-macros.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-serv8528 Modified Files: more-macros.lisp Log Message: Change the name "constant-block" to "run-time-context" so as to be consistent. "Run-time-context" is the name that's I've been using in newer documentation and code. Date: Wed Jul 28 03:01:16 2004 Author: ffjeld Index: movitz/losp/muerte/more-macros.lisp diff -u movitz/losp/muerte/more-macros.lisp:1.16 movitz/losp/muerte/more-macros.lisp:1.17 --- movitz/losp/muerte/more-macros.lisp:1.16 Tue Jul 20 16:51:15 2004 +++ movitz/losp/muerte/more-macros.lisp Wed Jul 28 03:01:16 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Jun 7 15:05:57 2002 ;;;; -;;;; $Id: more-macros.lisp,v 1.16 2004/07/20 23:51:15 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.17 2004/07/28 10:01:16 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -328,7 +328,8 @@ (equal context '(current-run-time-context)))) form (let ((slot-name (movitz::eval-form slot-name env))) - (ecase (bt:binary-slot-type 'movitz::movitz-constant-block (intern (symbol-name slot-name) :movitz)) + (ecase (bt:binary-slot-type 'movitz::movitz-run-time-context + (intern (symbol-name slot-name) :movitz)) (movitz::word `(with-inline-assembly (:returns :eax) (:locally (:movl (:edi (:edi-offset ,slot-name)) :eax))))

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