movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[movitz-cvs] CVS update: movitz/losp/x86-pc/vga.lisp
by Frode Vatvedt Fjeld 16 Apr '04

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv13495 Modified Files: vga.lisp Log Message: Added some VGA register accessors. Date: Fri Apr 16 15:17:55 2004 Author: ffjeld Index: movitz/losp/x86-pc/vga.lisp diff -u movitz/losp/x86-pc/vga.lisp:1.3 movitz/losp/x86-pc/vga.lisp:1.4 --- movitz/losp/x86-pc/vga.lisp:1.3 Mon Jan 19 06:23:52 2004 +++ movitz/losp/x86-pc/vga.lisp Fri Apr 16 15:17:55 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 25 14:08:20 2001 ;;;; -;;;; $Id: vga.lisp,v 1.3 2004/01/19 11:23:52 ffjeld Exp $ +;;;; $Id: vga.lisp,v 1.4 2004/04/16 19:17:55 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -19,18 +19,18 @@ (in-package muerte.x86-pc) -(defun (setf vga-crt-controller-register) (value register) - (let* ((address-register (if (logbitp 0 (io-port #x3cc :unsigned-byte8)) #x3d4 #x3b4)) - (data-register (1+ address-register))) - (setf (io-port address-register :unsigned-byte8) register - (io-port data-register :unsigned-byte8) value))) - (defun vga-crt-controller-register (register) (let* ((address-register (if (logbitp 0 (io-port #x3cc :unsigned-byte8)) #x3d4 #x3b4)) (data-register (1+ address-register))) (setf (io-port address-register :unsigned-byte8) register) (io-port data-register :unsigned-byte8))) +(defun (setf vga-crt-controller-register) (value register) + (let* ((address-register (if (logbitp 0 (io-port #x3cc :unsigned-byte8)) #x3d4 #x3b4)) + (data-register (1+ address-register))) + (setf (io-port address-register :unsigned-byte8) register + (io-port data-register :unsigned-byte8) value))) + (defun vga-graphics-register (register) (setf (io-port #x3ce :unsigned-byte8) register) (io-port #x3cf :unsigned-byte8)) @@ -60,3 +60,17 @@ (#b01 (values #xa0000 #xaffff)) (#b10 (values #xb0000 #xb7fff)) (#b11 (values #xb8000 #xbffff)))) + +(defun vga-horizontal-display-end () + (1+ (vga-crt-controller-register 1))) + +(defun vga-vertical-display-end () + (let ((overflow (vga-crt-controller-register 7))) + (+ 1 + (vga-crt-controller-register #x12) + (if (logbitp 1 overflow) #x100 0) + (if (logbitp 6 overflow) #x200 0)))) + +(defun vga-character-height () + (1+ (ldb (byte 5 0) + (vga-crt-controller-register 9))))

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/textmode.lisp
by Frode Vatvedt Fjeld 16 Apr '04

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv19552 Modified Files: textmode.lisp Log Message: Changed the textmode parameters *screen* etc. to be "global variables". Re-wrote textmode-scroll-down. Various small fixes. Date: Fri Apr 16 15:17:22 2004 Author: ffjeld Index: movitz/losp/x86-pc/textmode.lisp diff -u movitz/losp/x86-pc/textmode.lisp:1.4 movitz/losp/x86-pc/textmode.lisp:1.5 --- movitz/losp/x86-pc/textmode.lisp:1.4 Wed Mar 31 21:15:21 2004 +++ movitz/losp/x86-pc/textmode.lisp Fri Apr 16 15:17:22 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Thu Nov 9 15:38:56 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: textmode.lisp,v 1.4 2004/04/01 02:15:21 ffjeld Exp $ +;;;; $Id: textmode.lisp,v 1.5 2004/04/16 19:17:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -23,16 +23,24 @@ (in-package muerte.x86-pc) -(defconstant *screen* #xb8000) -(defconstant *screen-width* 80) -(defconstant *screen-height* 24) -(defconstant *screen-stride* 80) - -(defparameter *cursor-x* (rem (vga-cursor-location) 80)) -(defparameter *cursor-y* (truncate (vga-cursor-location) 80)) -(defparameter *color* #x0700) +(define-global-variable *screen* + (vga-memory-map)) -(defparameter *simple-console-state* 'initialized) +(define-global-variable *cursor-x* + (rem (vga-cursor-location) 80)) + +(define-global-variable *cursor-y* + (truncate (vga-cursor-location) 80)) + +(define-global-variable *screen-width* + (vga-horizontal-display-end)) + +(define-global-variable *screen-height* + (truncate (vga-vertical-display-end) + (vga-character-height))) + +(define-global-variable *screen-stride* + (vga-horizontal-display-end)) (defun move-vga-cursor (x y) (let ((dest (+ x (* y *screen-stride*)))) @@ -59,91 +67,75 @@ value) (defun textmode-write-char (c) - (cond - #+ignore - ((and (not (eq 'initialized *simple-console-state*)) - (/= #xabba (memref-int #xb8000 0 0 :unsigned-byte16))) - (setf (memref-int #xb8000 0 0 :unsigned-byte16) #xabba - (memref-int #xb8000 0 1 :unsigned-byte16) 4 - (memref-int #xb8000 0 8 :unsigned-byte8) #x46 ; (char-code c) - (memref-int #xb8000 1 8 :unsigned-byte8) #xe0)) - #+ignore - ((not (eq 'initialized *simple-console-state*)) - (let ((pos (memref-int #xb8000 0 1 :unsigned-byte16))) - (when (< pos (* 80 25 2)) - (setf (memref-int #xb8000 0 (* 2 pos) :unsigned-byte8) (char-code c) - (memref-int #xb8000 1 (* 2 pos) :unsigned-byte8) #xe0 - (memref-int #xb8000 0 1 :unsigned-byte16) (1+ pos))))) - (t (case c - (#\newline - (setf *cursor-x* 0) - (cond - ((= *screen-height* *cursor-y*) - (textmode-scroll-down) - (move-vga-cursor 0 *cursor-y*)) - (t (incf *cursor-y*) - (move-vga-cursor 0 *cursor-y*)))) - (#\backspace - (if (/= 0 *cursor-x*) - (decf *cursor-x*) - (progn - (decf *cursor-y*) - (setf *cursor-x* (1- *screen-width*)))) - (move-vga-cursor *cursor-x* *cursor-y*)) - (#\return - (setf *cursor-x* 0) - (move-vga-cursor 0 *cursor-y*)) - (#\tab - (textmode-write-char #\space) - (do () ((zerop (rem *cursor-x* 8))) - (textmode-write-char #\space))) - (t (let ((x *cursor-x*) - (y *cursor-y*)) - (when (>= x *screen-width*) - (textmode-write-char #\newline) - (setf x *cursor-x* y *cursor-y*)) - (let ((index (+ x (* y *screen-stride*)))) - (setf (memref-int *screen* 0 index :unsigned-byte16 t) - (logior #x0700 (char-code c))) - (move-vga-cursor (setf *cursor-x* (1+ x)) y))))))) + (case c + (#\newline + (setf *cursor-x* 0) + (cond + ((>= (1+ *cursor-y*) *screen-height*) + (textmode-scroll-down) + (setf *cursor-y* (1- *screen-height*))) + (t (incf *cursor-y*))) + (move-vga-cursor 0 *cursor-y*)) + (#\backspace + (if (/= 0 *cursor-x*) + (decf *cursor-x*) + (progn + (decf *cursor-y*) + (setf *cursor-x* (1- *screen-width*)))) + (move-vga-cursor *cursor-x* *cursor-y*)) + (#\return + (setf *cursor-x* 0) + (move-vga-cursor 0 *cursor-y*)) + (#\tab + (textmode-write-char #\space) + (do () ((zerop (rem *cursor-x* 8))) + (textmode-write-char #\space))) + (t (let ((x *cursor-x*) + (y *cursor-y*)) + (when (>= x *screen-width*) + (textmode-write-char #\newline) + (setf x *cursor-x* y *cursor-y*)) + (let ((index (+ x (* y *screen-stride*)))) + (setf (memref-int *screen* 0 index :unsigned-byte16 t) + (logior #x0700 (char-code c))) + (move-vga-cursor (setf *cursor-x* (1+ x)) y))))) nil) +(defun textmode-copy-line (destination source count) + (check-type count (integer 0 511)) + (check-type source (unsigned-byte 20)) + (check-type destination (unsigned-byte 20)) + (with-inline-assembly (:returns :nothing) + (:compile-form (:result-mode :eax) source) + (:compile-form (:result-mode :ebx) destination) + (:compile-form (:result-mode :edx) count) + (:andl #x-16 :eax) + (:andl #x-16 :ebx) + (:andl #x-8 :edx) + (:shrl 2 :eax) + (:shrl 2 :ebx) + (:shrl 1 :edx) + (:jz 'end-copy-loop) + copy-loop + ((:gs-override) :movl (:eax :edx -4) :ecx) + ((:gs-override) :movl :ecx (:ebx :edx -4)) + (:subl 4 :edx) + (:ja 'copy-loop) + end-copy-loop)) + (defun textmode-scroll-down () - "Scroll the console down one line." (declare (special muerte.lib::*scroll-offset*)) (incf muerte.lib::*scroll-offset*) - (with-inline-assembly (:returns :nothing) - (:movl #xb8000 :eax) - (:movl #.(cl:+ #xb8000 160) :ebx) - (:movl #.(cl:* 80 24 1) :ecx) - copy-loop - ((:gs-override) :movw (:ebx) :dx) - ((:gs-override) :movw :dx (:eax)) - (:addl 2 :ebx) - (:addl 2 :eax) - (:subl 1 :ecx) - (:jnz 'copy-loop) - (:movl #.(cl:* 80 1) :ecx) - clear-loop - ((:gs-override) :movw #x0720 (:eax)) - (:addl 2 :eax) - (:subl 1 :ecx) - (:jnz 'clear-loop))) + (loop with stride = (* 2 *screen-stride*) + for y below *screen-height* + as src from (+ *screen* stride) by stride + as dst from *screen* by stride + do (textmode-copy-line dst src *screen-width*))) (defun textmode-clear-line (from-column line) (let ((dest (+ *screen* (* line 80 2) (* from-column 2)))) (dotimes (i (- 80 from-column)) - (setf (memref-int dest 0 i :unsigned-byte16 t) #x0720)) - #+ignore - (with-inline-assembly (:returns :nothing) - (:pushl :edi) - (:compile-form (:result-mode :eax) dest) - (:movl :eax :edi) - (:shrl #.movitz:+movitz-fixnum-shift+ :edi) - (:movl #.(cl:* 80 1) :ecx) - (:movw #x0720 :ax) - ((:repz) :stosw) - (:popl :edi)))) + (setf (memref-int dest 0 i :unsigned-byte16 t) #x0720)))) (defun write-word (word) (let ((dest (+ *screen* (* *cursor-x* 2) (* *cursor-y* 160)))) @@ -220,12 +212,12 @@ "This function can act as *terminal-io* without/before CLOS support." (declare (dynamic-extent args)) (case op + (muerte::stream-write-char + (textmode-write-char (car args))) (muerte::stream-fresh-line (when (plusp (cursor-column)) (textmode-write-char #\Newline) t)) - (muerte::stream-write-char - (textmode-write-char (car args))) (muerte::stream-read-char (loop when (muerte.x86-pc.keyboard:poll-char) return it)) (muerte::stream-read-char-no-hang

1 0

[movitz-cvs] CVS update: movitz/bootblock.lisp
by Frode Vatvedt Fjeld 16 Apr '04

16 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv26126 Modified Files: bootblock.lisp Log Message: Removed the video-initialization part of the bootloader, because it shouldn't be needed anymore. Date: Fri Apr 16 15:15:20 2004 Author: ffjeld Index: movitz/bootblock.lisp diff -u movitz/bootblock.lisp:1.7 movitz/bootblock.lisp:1.8 --- movitz/bootblock.lisp:1.7 Thu Apr 15 09:03:16 2004 +++ movitz/bootblock.lisp Fri Apr 16 15:15:20 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Mon Oct 9 20:47:19 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: bootblock.lisp,v 1.7 2004/04/15 13:03:16 ffjeld Exp $ +;;;; $Id: bootblock.lisp,v 1.8 2004/04/16 19:15:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -209,17 +209,6 @@ (movw 'entering :si) ; Print welcome message (call 'print) - (:movb #xf :ah) - (:int #x10) ; - (:andb #x7f :al) - (:cmpb #x3 :al) - (:je 'video-ok) - (:movw #x0083 :ax) ; set screen mode - (:int #x10) - (:movb 2 :ah) ; set cursor position - (:int #x10) - video-ok - ;; Read the cursor position into DH (row) and DL (column). (:movb 3 :ah) (:movb 0 :bh)

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7751 Modified Files: basic-macros.lisp Log Message: Added macro define-global-variable. Date: Fri Apr 16 14:55:07 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.10 movitz/losp/muerte/basic-macros.lisp:1.11 --- movitz/losp/muerte/basic-macros.lisp:1.10 Wed Apr 14 17:59:34 2004 +++ movitz/losp/muerte/basic-macros.lisp Fri Apr 16 14:55:07 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.10 2004/04/14 21:59:34 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.11 2004/04/16 18:55:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1040,6 +1040,12 @@ (:je 'boundp-done) (:stc) boundp-done))) + +(defmacro define-global-variable (name init-form &optional docstring) + "A global variable will be accessed by ignoring local bindings." + `(progn + (defparameter ,name ,init-form ,docstring) + (define-symbol-macro ,name (%symbol-global-value ',name)))) (require :muerte/setf)

1 0

[movitz-cvs] CVS update: movitz/losp/los0-gc.lisp
by Frode Vatvedt Fjeld 16 Apr '04

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv28476 Modified Files: los0-gc.lisp Log Message: Added los0-malloc-data-clumps, so that the los0 GC architecture now don't initialize non-pointer memory. Date: Fri Apr 16 10:44:42 2004 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.9 movitz/losp/los0-gc.lisp:1.10 --- movitz/losp/los0-gc.lisp:1.9 Thu Apr 15 11:23:31 2004 +++ movitz/losp/los0-gc.lisp Fri Apr 16 10:44:42 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Feb 21 17:48:32 2004 ;;;; -;;;; $Id: los0-gc.lisp,v 1.9 2004/04/15 15:23:31 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.10 2004/04/16 14:44:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -54,7 +54,7 @@ (defun space-cons-pointer () (aref (%run-time-context-slot 'nursery-space) 0)) -(define-primitive-function new-fast-cons () +(define-primitive-function los0-fast-cons () "Allocate a cons cell from nursery-space." (with-inline-assembly (:returns :eax) retry-cons @@ -72,29 +72,46 @@ (:movl :ecx (:edx 2)) (:ret))) -(defun new-malloc-clumps (clumps) - (check-type clumps (integer 0 1000)) - (with-inline-assembly (:returns :ebx) +(defun los0-malloc-clumps (clumps) + (check-type clumps (integer 0 4000)) + (with-inline-assembly (:returns :eax) retry - (:compile-form (:result-mode :eax) clumps) + (:compile-form (:result-mode :ebx) clumps) (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) (:movl (:edx 2) :ecx) - (:leal (:edx :ecx 8) :ebx) - (:leal ((:eax 2) :ecx) :ecx) - (:cmpl #x3fff4 :ecx) + (:leal ((:ebx 2) :ecx) :eax) + (:cmpl #x3fff4 :eax) (:jge '(:sub-program () (:compile-form (:result-mode :ignore) (stop-and-copy)) (:jmp 'retry))) - (:movl :ecx (:edx 2)) + (:movl :eax (:edx 2)) + (:movl #.(movitz:tag :infant-object) (:edx :ecx 6)) + (:leal (:edx :ecx 8) :eax) (:xorl :ecx :ecx) init-loop ; Now init eax number of clumps. - (:movl :edi (:ebx (:ecx 2) -6)) - (:movl :edi (:ebx (:ecx 2) -2)) + (:movl :edi (:eax (:ecx 2) -6)) + (:movl :edi (:eax (:ecx 2) -2)) (:addl 4 :ecx) - (:cmpl :eax :ecx) - (:jb 'init-loop) - (:movl #.(movitz:tag :infant-object) (:ebx -2)))) + (:cmpl :ebx :ecx) + (:jb 'init-loop))) + +(defun los0-malloc-data-clumps (clumps) + (check-type clumps (integer 0 4000)) + (with-inline-assembly (:returns :eax) + retry + (:compile-form (:result-mode :ebx) clumps) + (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) + (:movl (:edx 2) :ecx) + (:leal ((:ebx 2) :ecx) :eax) + (:cmpl #x3fff4 :eax) + (:jge '(:sub-program () + (:compile-form (:result-mode :ignore) + (stop-and-copy)) + (:jmp 'retry))) + (:movl :eax (:edx 2)) + (:movl #.(movitz:tag :infant-object) (:edx :ecx 6)) + (:leal (:edx :ecx 8) :eax))) (defun los0-handle-out-of-memory (exception interrupt-frame) (declare (ignore exception interrupt-frame)) @@ -104,20 +121,25 @@ (defun install-los0-consing () (setf (%run-time-context-slot 'nursery-space) (allocate-duo-space)) - (let ((conser (symbol-value 'new-fast-cons))) + (setf (exception-handler 113) + (lambda (exception interrupt-frame) + (declare (ignore exception interrupt-frame)) + (format t "~&;; Handling out-of-memory exception..") + (stop-and-copy))) + (let ((conser (symbol-value 'los0-fast-cons))) (check-type conser vector) (setf (%run-time-context-slot 'muerte::fast-cons) conser)) (let ((old-malloc (symbol-function 'muerte:malloc-clumps))) (setf (symbol-function 'muerte:malloc-clumps) - (symbol-function 'new-malloc-clumps)) - (setf (symbol-function 'new-malloc-clumps) + (symbol-function 'los0-malloc-clumps)) + (setf (symbol-function 'los0-malloc-clumps) old-malloc)) - (setf (exception-handler 113) - (lambda (exception interrupt-frame) - (declare (ignore exception interrupt-frame)) - (format t "~&;; Handling out-of-memory exception..") - (stop-and-copy))) + (let ((old-malloc-data (symbol-function 'muerte:malloc-data-clumps))) + (setf (symbol-function 'muerte:malloc-data-clumps) + (symbol-function 'los0-malloc-data-clumps)) + (setf (symbol-function 'los0-malloc-data-clumps) + old-malloc-data)) (values)) (defun install-old-consing () @@ -127,9 +149,14 @@ conser)) (let ((old-malloc (symbol-function 'muerte:malloc-clumps))) (setf (symbol-function 'muerte:malloc-clumps) - (symbol-function 'new-malloc-clumps)) - (setf (symbol-function 'new-malloc-clumps) + (symbol-function 'los0-malloc-clumps)) + (setf (symbol-function 'los0-malloc-clumps) old-malloc)) + (let ((old-malloc-data (symbol-function 'muerte:malloc-data-clumps))) + (setf (symbol-function 'muerte:malloc-data-clumps) + (symbol-function 'los0-malloc-data-clumps)) + (setf (symbol-function 'los0-malloc-data-clumps) + old-malloc-data)) (values)) (defun object-in-space-p (space object)

1 0

[movitz-cvs] CVS update: movitz/packages.lisp
by Frode Vatvedt Fjeld 16 Apr '04

16 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv8224 Modified Files: packages.lisp Log Message: Added symbol malloc-data-clumps. Date: Fri Apr 16 10:43:44 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.17 movitz/packages.lisp:1.18 --- movitz/packages.lisp:1.17 Thu Apr 15 15:56:59 2004 +++ movitz/packages.lisp Fri Apr 16 10:43:44 2004 @@ -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.17 2004/04/15 19:56:59 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.18 2004/04/16 14:43:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1141,6 +1141,7 @@ #:map-heap-words #:map-stack-words #:malloc-clumps + #:malloc-data-clumps #:malloc-cons-pointer #:malloc-buffer-start

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv2464 Modified Files: arrays.lisp Log Message: Allocate non-pointer memory for arrays specialized to (unsigned-byte 32). Date: Fri Apr 16 10:42:51 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.16 movitz/losp/muerte/arrays.lisp:1.17 --- movitz/losp/muerte/arrays.lisp:1.16 Wed Mar 31 21:09:58 2004 +++ movitz/losp/muerte/arrays.lisp Fri Apr 16 10:42:51 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.16 2004/04/01 02:09:58 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.17 2004/04/16 14:42:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -548,7 +548,7 @@ (replace array initial-contents))) array)) ((member element-type '(u32 (unsigned-byte 32)) :test #'equal) - (let ((array (malloc-words dimensions))) + (let ((array (malloc-data-words dimensions))) (setf (memref array #.(bt:slot-offset 'movitz::movitz-vector 'movitz::flags) 0 :unsigned-byte16) 0)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.lisp
by Frode Vatvedt Fjeld 16 Apr '04

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv9296 Modified Files: inspect.lisp Log Message: Added function malloc-data-words, and some minor edits. Date: Fri Apr 16 10:42:22 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.7 movitz/losp/muerte/inspect.lisp:1.8 --- movitz/losp/muerte/inspect.lisp:1.7 Wed Mar 31 21:11:48 2004 +++ movitz/losp/muerte/inspect.lisp Fri Apr 16 10:42:22 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.7 2004/04/01 02:11:48 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.8 2004/04/16 14:42:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -189,10 +189,9 @@ (structure-object (copy-structure old)))) -(defun malloc-words (words) - (malloc-clumps (1+ (truncate (1+ words) 2)))) - (defun malloc-clumps (clumps) + "Allocate general-purpose memory, i.e. including pointers. +The unit clump is 8 bytes, or two words." (let ((x (with-inline-assembly (:returns :eax :side-effects t) (:compile-form (:result-mode :ebx) clumps) (:shll 1 :ebx) @@ -204,8 +203,15 @@ x)) (defun malloc-data-clumps (clumps) - "Allocate clumps for non-pointer data (i.e. doesn't require initialization)." + "Allocate memory for non-pointer data (i.e. doesn't require initialization)." + ;; Never mind, this is the stupid default implementation. (malloc-clumps clumps)) + +(defun malloc-words (words) + (malloc-clumps (1+ (truncate (1+ words) 2)))) + +(defun malloc-data-words (words) + (malloc-data-clumps (1+ (truncate (1+ words) 2)))) (defun location-in-object-p (object location) "Is location inside object?"

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3021 Modified Files: special-operators.lisp Log Message: Commented out warning thats not really supposed to be there. Date: Fri Apr 16 06:24:54 2004 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.21 movitz/special-operators.lisp:1.22 --- movitz/special-operators.lisp:1.21 Thu Apr 15 09:06:18 2004 +++ movitz/special-operators.lisp Fri Apr 16 06:24:54 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.21 2004/04/15 13:06:18 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.22 2004/04/16 10:24:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -686,6 +686,7 @@ `((:cmpl :edi ,(single-value-register not-returns)))) :returns :boolean-zf=1)) ; TRUE iff result equal to :edi/NIL. (otherwise + #+ignore (warn "unable to deal intelligently with inlined-NOT not-returns: ~S for ~S from ~S" not-returns not-result-mode (not-values :producer)) (let ((label (make-symbol "not-label"))) @@ -716,7 +717,7 @@ result-mode (car sub-form-result-mode)) as last-form-p = (endp (cdr sub-form)) - ;; do (warn "progn rm: ~S" (car sub-form-result-mode)) + ;; do (warn "progn rm: ~S" (car sub-form-result-mode)) appending (compiler-values-bind (&code code &returns sub-returns-mode &functional-p no-sub-side-effects-p

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv5331 Modified Files: image.lisp Log Message: Fixed warning about multiboot header too far away. Date: Fri Apr 16 04:57:29 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.23 movitz/image.lisp:1.24 --- movitz/image.lisp:1.23 Thu Apr 15 09:04:51 2004 +++ movitz/image.lisp Fri Apr 16 04:57:29 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.23 2004/04/15 13:04:51 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.24 2004/04/16 08:57:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -890,7 +890,9 @@ (warn "Multiboot load-address #x~x is below the 1MB mark." load-address)) (when (> (+ mb-file-position (sizeof mb)) 8192) - (warn "Multiboot header at position ~D is above the 8KB mark.")) + (warn "Multiboot header at position ~D is above the 8KB mark, ~ +this image will not be Multiboot compatible." + (+ mb-file-position (sizeof mb)))) (assert (file-position stream mb-file-position) () "Couldn't set file-position for ~W to ~W." (pathname stream)

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