[movitz-cvs] CVS update: movitz/losp/los0.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Mon Oct 11 13:51:56 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp
In directory common-lisp.net:/tmp/cvs-serv30427
Modified Files:
los0.lisp
Log Message:
Changed the signature of memref and (setf memref) to use keywords also
for the index and type arguments.
Date: Mon Oct 11 15:51:56 2004
Author: ffjeld
Index: movitz/losp/los0.lisp
diff -u movitz/losp/los0.lisp:1.22 movitz/losp/los0.lisp:1.23
--- movitz/losp/los0.lisp:1.22 Tue Sep 21 15:11:08 2004
+++ movitz/losp/los0.lisp Mon Oct 11 15:51:55 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.22 2004/09/21 13:11:08 ffjeld Exp $
+;;;; $Id: los0.lisp,v 1.23 2004/10/11 13:51:55 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -151,6 +151,31 @@
'jumbo)
#+ignore
+(defun tagbodyxx (x)
+ (tagbody
+ (print 'hello)
+ haha
+ (unwind-protect
+ (when x (go hoho))
+ (warn "unwind.."))
+ (print 'world)
+ hoho
+ (print 'blrugh)))
+
+#+ignore
+(defun tagbodyxx (x)
+ (tagbody
+ (print 'hello)
+ haha
+ (unwind-protect
+ (funcall (lambda ()
+ (when x (go hoho))))
+ (warn "unwind.."))
+ (print 'world)
+ hoho
+ (print 'blrugh)))
+
+#+ignore
(defun kumbo (&key a b (c (jumbo 1 2 3)) d)
(print a)
(print b)
@@ -384,7 +409,7 @@
(defun xplus (x)
(typep x '(integer 0 *)))
-(defstruct xxx
+(defstruct (xxx :constructor (:constructor boa-make-xxx (x y z)))
x y (z 'init-z))
(defun test-struct ()
@@ -1035,7 +1060,7 @@
(muerte::positive-bignum
(let ((x (muerte::copy-bignum limit)))
(dotimes (i (1- (muerte::%bignum-bigits x)))
- (setf (memref x 2 i :unsigned-byte32)
+ (setf (memref x 2 :index i :type :unsigned-byte32)
(muerte::read-time-stamp-counter)))
(setf x (muerte::bignum-canonicalize x))
(loop while (>= x limit)
@@ -1049,7 +1074,6 @@
(: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)
@@ -1078,18 +1102,30 @@
(1+ x)))
(defparameter *timer-stack* nil)
+(defparameter *timer-prevstack* nil)
(defparameter *timer-esi* nil)
(defparameter *timer-frame* #100())
+(defparameter *timer-base* 2)
+(defparameter *timer-variation* 1000)
+
+(defun test-format (&optional timeout (x #xab))
+ (let ((fasit (format nil "~2,'0X" x)))
+ (test-timer timeout)
+ (format t "~&Fasit: ~S" fasit)
+ (loop
+ (let ((x (format nil "~2,'0X" x)))
+ (assert (string= fasit x) ()
+ "Failed tesT. Fasit: ~S, X: ~S" fasit x)))))
(defun test-clc (&optional timeout)
(test-timer timeout)
(loop
(funcall (find-symbol (string :test-clc) :clc))))
-(defun test-timer (&optional timeout)
+(defun test-timer (&optional timeout (base *timer-base*) (variation *timer-variation*))
(setf (exception-handler 32)
(lambda (exception-vector exception-frame)
- (declare (ignore exception-vector #+ignore exception-frame))
+ (declare (ignore exception-vector exception-frame))
;;; (loop with f = *timer-frame*
;;; for o from 20 downto -36 by 4 as i upfrom 0
;;; do (setf (aref f i) (memref exception-frame o 0 :lisp)))
@@ -1102,14 +1138,13 @@
;;; (vector-push funobj ts)
;;; (vector-push offset ts)
;;; (vector-push code-vector ts))))
- (muerte::cli)
+ ;; (muerte::cli)
(pic8259-end-of-interrupt 0)
(with-inline-assembly (:returns :nothing)
(:compile-form (:result-mode :ecx) muerte.x86-pc::*screen*)
(:shrl 2 :ecx)
((:gs-override) :addb 1 (:ecx 158))
((:gs-override) :movb #x40 (:ecx 159)))
- (setf *timer-esi* (muerte::dit-frame-ref nil exception-frame :esi :unsigned-byte32))
(do ((frame (stack-frame-uplink nil (current-stack-frame))
(stack-frame-uplink nil frame)))
((plusp frame))
@@ -1127,21 +1162,22 @@
x)
nil
(current-stack-frame))
- (setf *timer-stack* (muerte::copy-current-control-stack))
- (setf (pit8253-timer-mode 0) +pit8253-mode-single-timeout+
- (pit8253-timer-count 0) (or timeout (+ 5 (random 2000))))
(with-inline-assembly (:returns :nothing)
(:compile-form (:result-mode :ecx) muerte.x86-pc::*screen*)
(:shrl 2 :ecx)
- ((:gs-override) :movb #x20 (:ecx 159)))
- (muerte::sti)
- ))
+ ((:gs-override) :movb #x20 (:ecx 159)))
+ (setf *timer-prevstack* *timer-stack*
+ *timer-stack* (muerte::copy-current-control-stack))
+ (setf (pit8253-timer-mode 0) +pit8253-mode-single-timeout+
+ (pit8253-timer-count 0) (or timeout (+ base (random variation))))
+
+ #+ignore (muerte::sti)))
(with-inline-assembly (:returns :nothing)
(:compile-form (:result-mode :ecx) muerte.x86-pc::*screen*)
(:shrl 2 :ecx)
((:gs-override) :movw #x4646 (:ecx 158)))
(setf (pit8253-timer-mode 0) +pit8253-mode-single-timeout+
- (pit8253-timer-count 0) (or timeout (+ 10 (random 1000))))
+ (pit8253-timer-count 0) (or timeout (+ base (random variation))))
(setf (pic8259-irq-mask) #xfffe)
(pic8259-end-of-interrupt 0)
(with-inline-assembly (:returns :nothing) (:sti))
@@ -1179,6 +1215,12 @@
(incf (memref-int muerte.x86-pc::*screen* 0 80 :unsigned-byte16 t)))))
(incf (memref-int muerte.x86-pc::*screen* 0 160 :unsigned-byte16 t))))))
+(defun mumbojumbo ()
+ (with-inline-assembly (:returns :multiple-values)
+ (:leave)
+ (:movl (:ebp -4) :esi)
+ (:break)
+ (:ret)))
(defun genesis ()
(let ((extended-memsize 0))
@@ -1190,11 +1232,12 @@
(format t "Extended memory: ~D KB~%" extended-memsize)
(idt-init)
- (install-los0-consing :kb-size 500)
#+ignore
+ (install-los0-consing :kb-size 500)
(install-los0-consing :kb-size (max 100 (truncate (- extended-memsize 1024 2048) 2))))
(setf *debugger-function* #'los0-debugger)
+ (clos-bootstrap)
(let ((*repl-readline-context* (make-readline-context :history-size 16))
#+ignore (*backtrace-stack-frame-barrier* (stack-frame-uplink (current-stack-frame)))
#+ignore (*error-no-condition-for-debugger* t)
@@ -1208,7 +1251,6 @@
;; (muerte:asm :int 49)
(setf *package* (find-package "INIT"))
- (clos-bootstrap)
(when muerte::*multiboot-data*
(set-textmode +vga-state-90x30+))
@@ -1228,7 +1270,7 @@
(let ((* nil) (** nil) (*** nil)
(/ nil) (// nil) (/// nil)
(+ nil) (++ nil) (+++ nil))
- (format t "~&Movitz image Los0 build ~D [~Z]." *build-number* (cons 1 2))
+ (format t "~&Movitz image Los0 build ~D." *build-number*)
(loop
(catch :top-level-repl ; If restarts don't work, you can throw this..
(with-simple-restart (abort "Abort to the top command level.")
More information about the Movitz-cvs
mailing list