May 2005 - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

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

05 May '05

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv24227 Modified Files: threading.lisp Log Message: *** empty log message *** Date: Thu May 5 17:21:59 2005 Author: ffjeld Index: movitz/losp/lib/threading.lisp diff -u movitz/losp/lib/threading.lisp:1.1 movitz/losp/lib/threading.lisp:1.2 --- movitz/losp/lib/threading.lisp:1.1 Fri Apr 29 00:05:02 2005 +++ movitz/losp/lib/threading.lisp Thu May 5 17:21:59 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Apr 28 08:30:01 2005 ;;;; -;;;; $Id: threading.lisp,v 1.1 2005/04/28 22:05:02 ffjeld Exp $ +;;;; $Id: threading.lisp,v 1.2 2005/05/05 15:21:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -18,11 +18,16 @@ (defpackage threading (:use cl muerte) - (:export make-thread + (:export thread + make-thread yield )) -(in-package threading) +(in-package muerte) + +(defclass thread (run-time-context) + () + (:metaclass run-time-context-class)) (defmacro control-stack-ebp (stack) `(stack-frame-ref ,stack 0 0)) @@ -46,6 +51,18 @@ (control-stack-push function stack)) stack) +(defun control-stack-fixate (stack) + (let ((stack-base (+ 2 (object-location stack)))) + (do ((frame (control-stack-ebp stack))) + ((zerop (stack-frame-uplink stack frame))) + (assert (typep (stack-frame-funobj stack frame) 'function)) + (let ((previous-frame frame)) + (setf frame (stack-frame-uplink stack frame)) + (incf (stack-frame-ref stack previous-frame 0) + stack-base))) + (values (+ (control-stack-ebp stack) stack-base) + (+ (control-stack-esp stack) stack-base)))) + (defun stack-bootstrapper (&rest ignore) "Control stacks are initialized with this function as their initial frame." (declare (ignore ignore)) @@ -57,7 +74,7 @@ (check-type args list) (apply function args))) (error "Nothing left to do for ~S." (current-run-time-context)) - (loop (halt-cpu))) + (loop (halt-cpu))) ; just to make sure (defun control-stack-init-for-yield (stack function args) "Make it so that a yield to stack will cause function to be applied to args." @@ -79,7 +96,7 @@ (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*))) + (segment-descriptor-table nil #+ignore (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) @@ -114,8 +131,8 @@ (ebp (control-stack-ebp target-stack))) (assert (location-in-object-p target-stack esp)) (assert (location-in-object-p target-stack ebp)) - (assert (eq (stack-frame-funobj nil ebp) - (asm-register :esi)) () + (assert (eq (muerte::stack-frame-funobj nil ebp) + (muerte::asm-register :esi)) () "Will not yield to a non-yield frame.") ;; Push eflags for later.. (setf (memref (decf esp) 0) (eflags)) @@ -124,8 +141,8 @@ (%run-time-context-slot 'scratch2 target-rtc) esp) ;; Enable someone to yield back here.. (setf (control-stack-fs my-stack) (segment-register :fs) - (control-stack-ebp my-stack) (asm-register :ebp) - (control-stack-esp my-stack) (asm-register :esp)) + (control-stack-ebp my-stack) (muerte::asm-register :ebp) + (control-stack-esp my-stack) (muerte::asm-register :esp)) (with-inline-assembly (:returns :eax) (:load-lexical (:lexical-binding fs) :untagged-fixnum-ecx) (:load-lexical (:lexical-binding value) :eax) @@ -133,4 +150,4 @@ (:movw :cx :fs) (:locally (:movl (:edi (:edi-offset scratch1)) :ebp)) (:locally (:movl (:edi (:edi-offset scratch2)) :esp)) - (:popfl))))) \ No newline at end of file + (:popfl)))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/los-closette-compiler.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-serv24091 Modified Files: los-closette-compiler.lisp Log Message: Cleaned up the exports from the muerte package, somewhat. Date: Thu May 5 17:17:37 2005 Author: ffjeld Index: movitz/losp/muerte/los-closette-compiler.lisp diff -u movitz/losp/muerte/los-closette-compiler.lisp:1.16 movitz/losp/muerte/los-closette-compiler.lisp:1.17 --- movitz/losp/muerte/los-closette-compiler.lisp:1.16 Tue May 3 21:49:25 2005 +++ movitz/losp/muerte/los-closette-compiler.lisp Thu May 5 17:17:35 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Aug 29 13:15:11 2002 ;;;; -;;;; $Id: los-closette-compiler.lisp,v 1.16 2005/05/03 19:49:25 ffjeld Exp $ +;;;; $Id: los-closette-compiler.lisp,v 1.17 2005/05/05 15:17:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -613,9 +613,15 @@ (defun movitz-make-instance-run-time-context (metaclass &rest all-keys &key name direct-superclasses direct-slots size slot-map plist &allow-other-keys) (declare (ignore all-keys)) (let ((class (std-allocate-instance metaclass))) - (when size (setf (std-slot-value class 'size) size)) - (setf (std-slot-value class 'slot-map) slot-map - (std-slot-value class 'plist) plist) + (setf (std-slot-value class 'size) + (or size (bt:sizeof 'movitz::movitz-run-time-context))) + (setf (std-slot-value class 'slot-map) + (or slot-map + (movitz::slot-map 'movitz::movitz-run-time-context + (cl:+ (bt:slot-offset 'movitz::movitz-run-time-context + 'movitz::run-time-context-start) + 0)))) + (setf (std-slot-value class 'plist) plist) (setf (movitz-class-name class) name) (setf (class-direct-subclasses class) ()) (setf (class-direct-methods class) ())

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/run-time-context.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-serv24054 Modified Files: run-time-context.lisp Log Message: Cleaned up the exports from the muerte package, somewhat. Date: Thu May 5 17:17:22 2005 Author: ffjeld Index: movitz/losp/muerte/run-time-context.lisp diff -u movitz/losp/muerte/run-time-context.lisp:1.21 movitz/losp/muerte/run-time-context.lisp:1.22 --- movitz/losp/muerte/run-time-context.lisp:1.21 Thu May 5 00:47:17 2005 +++ movitz/losp/muerte/run-time-context.lisp Thu May 5 17:17:22 2005 @@ -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.21 2005/05/04 22:47:17 ffjeld Exp $ +;;;; $Id: run-time-context.lisp,v 1.22 2005/05/05 15:17:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -27,14 +27,8 @@ (defclass run-time-context (t) ((name :initarg :name - :initform :anonymous :accessor run-time-context-name)) - (:metaclass run-time-context-class) - (:size #.(bt:sizeof 'movitz::movitz-run-time-context)) - (:slot-map #.(movitz::slot-map 'movitz::movitz-run-time-context - (cl:+ (bt:slot-offset 'movitz::movitz-run-time-context - 'movitz::run-time-context-start) - 0)))) + (:metaclass run-time-context-class)) (defmethod slot-value-using-class ((class run-time-context-class) object (slot standard-effective-slot-definition)) @@ -103,7 +97,8 @@ (defmethod print-object ((x run-time-context) stream) (print-unreadable-object (x stream :type t :identity t) - (format stream "~S" (run-time-context-name x))) + (when (slot-boundp x 'name) + (format stream "~S" (run-time-context-name x)))) x) ;;;

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/cpu-id.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-serv24040 Modified Files: cpu-id.lisp Log Message: Cleaned up the exports from the muerte package, somewhat. Date: Thu May 5 17:17:16 2005 Author: ffjeld Index: movitz/losp/muerte/cpu-id.lisp diff -u movitz/losp/muerte/cpu-id.lisp:1.10 movitz/losp/muerte/cpu-id.lisp:1.11 --- movitz/losp/muerte/cpu-id.lisp:1.10 Wed Mar 9 08:18:14 2005 +++ movitz/losp/muerte/cpu-id.lisp Thu May 5 17:17:15 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Apr 15 22:47:13 2002 ;;;; -;;;; $Id: cpu-id.lisp,v 1.10 2005/03/09 07:18:14 ffjeld Exp $ +;;;; $Id: cpu-id.lisp,v 1.11 2005/05/05 15:17:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -248,7 +248,7 @@ (defun load-idt (idt-vector) (assert (= #.(bt:enum-value 'movitz::movitz-vector-element-type :u32) - (muerte:vector-element-type idt-vector))) + (vector-element-type idt-vector))) (let ((limit (- (* (length idt-vector) 4) 1))) ;; (format t "Load-idt: ~Z / ~D~%" idt-vector limit)

1 0

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

05 May '05

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv24020 Modified Files: interrupt.lisp Log Message: Cleaned up the exports from the muerte package, somewhat. Date: Thu May 5 17:17:12 2005 Author: ffjeld Index: movitz/losp/x86-pc/interrupt.lisp diff -u movitz/losp/x86-pc/interrupt.lisp:1.10 movitz/losp/x86-pc/interrupt.lisp:1.11 --- movitz/losp/x86-pc/interrupt.lisp:1.10 Tue Aug 10 14:59:36 2004 +++ movitz/losp/x86-pc/interrupt.lisp Thu May 5 17:17:12 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001-2004, +;;;; Copyright (C) 2001-2005, ;;;; Department of Computer Science, University of Tromso, Norway. ;;;; ;;;; For distribution policy, see the accompanying file COPYING. @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri May 4 18:08:50 2001 ;;;; -;;;; $Id: interrupt.lisp,v 1.10 2004/08/10 12:59:36 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.11 2005/05/05 15:17:12 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -22,7 +22,7 @@ (defun idt-init () (init-pic8259 32 40) (setf (pic8259-irq-mask) #xffff) - (load-idt (load-global-constant interrupt-descriptor-table)) + (load-idt (muerte::load-global-constant muerte::interrupt-descriptor-table)) nil) (defun timer-init ()

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/textmode-console.lisp
by ffjeld＠common-lisp.net 05 May '05

05 May '05

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv24004 Modified Files: textmode-console.lisp Log Message: Cleaned up the exports from the muerte package, somewhat. Date: Thu May 5 17:17:06 2005 Author: ffjeld Index: movitz/losp/x86-pc/textmode-console.lisp diff -u movitz/losp/x86-pc/textmode-console.lisp:1.4 movitz/losp/x86-pc/textmode-console.lisp:1.5 --- movitz/losp/x86-pc/textmode-console.lisp:1.4 Sun Nov 14 23:58:16 2004 +++ movitz/losp/x86-pc/textmode-console.lisp Thu May 5 17:17:06 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001, 2003-2004, +;;;; Copyright (C) 2001, 2003-2005, ;;;; Department of Computer Science, University of Tromso, Norway. ;;;; ;;;; For distribution policy, see the accompanying file COPYING. @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Jul 8 15:13:24 2003 ;;;; -;;;; $Id: textmode-console.lisp,v 1.4 2004/11/14 22:58:16 ffjeld Exp $ +;;;; $Id: textmode-console.lisp,v 1.5 2005/05/05 15:17:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -66,23 +66,23 @@ nil)) (defmethod (setf console-char) (character (console vga-text-console) x y) - (when (and (below x (console-width console)) - (below y (console-height console))) + (when (and (< x (console-width console)) + (< y (console-height console))) (let ((index (+ x (* y (stride console))))) (setf (memref-int (base console) :index index :type :unsigned-byte16) (logior (ash (color console) 8) (char-code character))))) character) (defmethod console-char ((console vga-text-console) x y) - (when (and (below x (console-width console)) - (below y (console-height console))) + (when (and (< x (console-width console)) + (< y (console-height console))) (let* ((index (+ x (* y (stride console)))) (code (memref-int (base console) :index index :type :unsigned-byte16))) (code-char (ldb (byte 8 0) code))))) (defmethod put-string ((console vga-text-console) string x y &optional (start 0) (end (length string))) - (when (below y (console-height console)) + (when (< y (console-height console)) (loop with color = (ash (color console) 8) with base = (base console) for cursor upfrom (+ x (* y (stride console))) for column from x below (console-width console) @@ -93,7 +93,7 @@ string) (defmethod clear-line ((console vga-text-console) x y) - (when (below y (console-height console)) + (when (< y (console-height console)) (loop with base = (base console) for index upfrom (+ x (* y (stride console))) for column from x below (console-width console)

1 0

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

05 May '05

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv23981 Modified Files: misc.lisp Log Message: Cleaned up the exports from the muerte package, somewhat. Date: Thu May 5 17:16:59 2005 Author: ffjeld Index: movitz/losp/lib/misc.lisp diff -u movitz/losp/lib/misc.lisp:1.7 movitz/losp/lib/misc.lisp:1.8 --- movitz/losp/lib/misc.lisp:1.7 Wed Nov 24 15:20:49 2004 +++ movitz/losp/lib/misc.lisp Thu May 5 17:16:59 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001, 2003-2004, +;;;; Copyright (C) 2001, 2003-2005, ;;;; Department of Computer Science, University of Tromso, Norway. ;;;; ;;;; For distribution policy, see the accompanying file COPYING. @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon May 12 17:13:31 2003 ;;;; -;;;; $Id: misc.lisp,v 1.7 2004/11/24 14:20:49 ffjeld Exp $ +;;;; $Id: misc.lisp,v 1.8 2005/05/05 15:16:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -22,7 +22,7 @@ (defun checksum-octets (packet &optional (start 0) (end (length packet))) "Generate sum of 16-bit big-endian words for a sequence of octets." (typecase packet - (muerte:vector-u8 + ((simple-array (unsigned-byte 8)) (assert (<= 0 start end (length packet))) (with-inline-assembly (:returns :eax) (:compile-form (:result-mode :ebx) packet) @@ -49,7 +49,7 @@ end-checksum-loop (:shll #.movitz:+movitz-fixnum-shift+ :eax) (:cld))) - (t (muerte:with-subvector-accessor (packet-ref packet start end) + (t (muerte::with-subvector-accessor (packet-ref packet start end) (cond ((or (and (evenp start) (evenp end)) (and (oddp start) (oddp end)))

1 0

[movitz-cvs] CVS update: movitz/losp/los0.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-serv23962 Modified Files: los0.lisp Log Message: Cleaned up the exports from the muerte package, somewhat. Date: Thu May 5 17:16:54 2005 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.41 movitz/losp/los0.lisp:1.42 --- movitz/losp/los0.lisp:1.41 Tue May 3 22:13:07 2005 +++ movitz/losp/los0.lisp Thu May 5 17:16:54 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 1 18:08:32 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: los0.lisp,v 1.41 2005/05/03 20:13:07 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.42 2005/05/05 15:16:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -28,7 +28,8 @@ (require :lib/net/ip4) (require :lib/repl) -(require :ll-testing) +;; (require :ll-testing) +(require :lib/threading) (defpackage muerte.init (:nicknames #:los0) @@ -1040,7 +1041,7 @@ (define-toplevel-command :restart (&optional (r 0) &rest args) (declare (dynamic-extent args)) (let* ((context (or *debugger-dynamic-context* - (current-dynamic-context))) + (muerte::current-dynamic-context))) (restart (typecase r (integer (find-restart-by-index r context)) @@ -1099,7 +1100,7 @@ (defun los0-debugger (condition) (without-interrupts - (let ((*debugger-dynamic-context* (current-dynamic-context)) + (let ((*debugger-dynamic-context* (muerte::current-dynamic-context)) (*standard-output* *debug-io*) (*standard-input* *debug-io*) (*debugger-condition* condition) @@ -1245,11 +1246,11 @@ (:shrl 2 :ecx) ((:gs-override) :addb 1 (:ecx 158)) ((:gs-override) :movb #x40 (:ecx 159))) - (do ((frame (stack-frame-uplink nil (current-stack-frame)) - (stack-frame-uplink nil frame))) + (do ((frame (muerte::stack-frame-uplink nil (muerte::current-stack-frame)) + (muerte::stack-frame-uplink nil frame))) ((plusp frame)) (when (eq (with-inline-assembly (:returns :eax) (:movl :esi :eax)) - (stack-frame-funobj nil frame)) + (muerte::stack-frame-funobj nil frame)) (error "Double interrupt."))) ;;; (dolist (range muerte::%memory-map-roots%) ;;; (map-header-vals (lambda (x type) @@ -1260,7 +1261,7 @@ (declare (ignore foo)) x) nil - (current-stack-frame)) + (muerte::current-stack-frame)) (with-inline-assembly (:returns :nothing) (:compile-form (:result-mode :ecx) muerte.x86-pc::*screen*) (:shrl 2 :ecx) @@ -1337,9 +1338,9 @@ (idt-init) - (setf *segment-descriptor-table* ; Ensure we have a GDT with 16 entries, in static-space. - (muerte::install-global-segment-table - (muerte::dump-global-segment-table :entries 16))) +;;; (setf *segment-descriptor-table* ; Ensure we have a GDT with 16 entries, in static-space. +;;; (muerte::install-global-segment-table +;;; (muerte::dump-global-segment-table :entries 16))) (install-los0-consing :kb-size 500) #+ignore @@ -1665,7 +1666,7 @@ (%symbol-global-value name)) (setf (%symbol-global-value name) (memref env 8))))))) - (install-shallow-env (load-global-constant dynamic-env :thread-local t)))) + (install-shallow-env (%run-time-context-slot 'muerte::dynamic-env)))) (values)) (defun deinstall-shallow-binding (&key quiet) @@ -1679,7 +1680,7 @@ (install muerte::dynamic-unwind-next) (install muerte::dynamic-variable-store) (install muerte::dynamic-variable-lookup)) - (loop for env = (load-global-constant dynamic-env :thread-local t) + (loop for env = (%run-time-context-slot 'muerte::dynamic-env) then (memref env 12) while (plusp env) do (let ((name (memref env 0)))

1 0

[movitz-cvs] CVS update: movitz/losp/los0-gc.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-serv23942 Modified Files: los0-gc.lisp Log Message: Cleaned up the exports from the muerte package, somewhat. Date: Thu May 5 17:16:49 2005 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.50 movitz/losp/los0-gc.lisp:1.51 --- movitz/losp/los0-gc.lisp:1.50 Sat Apr 30 00:37:08 2005 +++ movitz/losp/los0-gc.lisp Thu May 5 17:16:48 2005 @@ -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.50 2005/04/29 22:37:08 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.51 2005/05/05 15:16:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -333,17 +333,11 @@ (defparameter *x* #4000(nil)) ; Have this in static space. -(defparameter *xx* #4000(nil)) ; Have this in static space. +;;;(defparameter *xx* #4000(nil)) ; Have this in static space. (defparameter *code-vector-foo* 0) (defvar *old-code-vectors* #250()) (defvar *new-code-vectors* #250()) - -(defun debug (location x) - (setf (dummy x) - (let ((new (shallow-copy x))) - (warn "[~S] Migrating code-vector ~Z => ~Z." location x new) - new))) (defun stop-and-copy (&optional evacuator) (setf (fill-pointer *x*) 0)

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-serv23925 Modified Files: ll-testing.lisp Log Message: Cleaned up the exports from the muerte package, somewhat. Date: Thu May 5 17:16:46 2005 Author: ffjeld Index: movitz/losp/ll-testing.lisp diff -u movitz/losp/ll-testing.lisp:1.7 movitz/losp/ll-testing.lisp:1.8 --- movitz/losp/ll-testing.lisp:1.7 Thu May 5 12:28:52 2005 +++ movitz/losp/ll-testing.lisp Thu May 5 17:16:45 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.7 2005/05/05 10:28:52 ffjeld Exp $ +;;;; $Id: ll-testing.lisp,v 1.8 2005/05/05 15:16:45 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -93,18 +93,6 @@ (error "Stack stop.") (format *terminal-io* "~&Stack-stopper halt.") (loop (halt-cpu))) - -(defun control-stack-fixate (stack) - (let ((stack-base (+ 2 (object-location stack)))) - (do ((frame (control-stack-ebp stack))) - ((zerop (stack-frame-uplink stack frame))) - (assert (typep (stack-frame-funobj stack frame) 'function)) - (let ((previous-frame frame)) - (setf frame (stack-frame-uplink stack frame)) - (incf (stack-frame-ref stack previous-frame 0) - stack-base))) - (values (+ (control-stack-ebp stack) stack-base) - (+ (control-stack-esp stack) stack-base)))) (defun alloc-context (segment-descriptor-table) (let* ((fs-index 8)

1 0