movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

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

06 May '05

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv5838 Modified Files: threading.lisp Log Message: Started work on segment-descriptor-manager that will hand out segment selectors to interested parties. Date: Fri May 6 09:04:43 2005 Author: ffjeld Index: movitz/losp/lib/threading.lisp diff -u movitz/losp/lib/threading.lisp:1.3 movitz/losp/lib/threading.lisp:1.4 --- movitz/losp/lib/threading.lisp:1.3 Thu May 5 22:52:21 2005 +++ movitz/losp/lib/threading.lisp Fri May 6 08:59:03 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.3 2005/05/05 20:52:21 ffjeld Exp $ +;;;; $Id: threading.lisp,v 1.4 2005/05/06 06:59:03 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -24,6 +24,27 @@ )) (in-package muerte) + +(defclass segment-descriptor-manager () + ((table + :accessor segment-descriptor-table + :initarg :table + :initform (dump-global-segment-table :entries 32)) + (range-start + :initarg :range-start + :accessor range-start + :initform (1+ (ceiling (reduce #'max '(:cs :ds :es :ss :fs) + :key #'segment-register) + 8))))) + +(defmethod allocate-segment-selector ((manager segment-descriptor-manager) &optional errorp) + (loop with table = (segment-descriptor-table manager) + for s from (range-start manager) below (/ (length table) 2) + do (when (zerop (ldb (byte 1 0) (segment-descriptor-avl-x-db-g table s))) + (setf (ldb (byte 1 0) (segment-descriptor-avl-x-db-g table s)) 1) + (return (* 8 s))) + finally (when errorp + (error "Unable to allocate a segment selector.")))) (defclass thread (run-time-context) ((segment-selector

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/debugger.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-serv20059 Modified Files: debugger.lisp Log Message: Changed order of arguments for %run-time-context-slot, new signature is (context slot-name), where nil may be used as a designator for (current-run-time-context). Date: Thu May 5 22:52:46 2005 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.39 movitz/losp/x86-pc/debugger.lisp:1.40 --- movitz/losp/x86-pc/debugger.lisp:1.39 Mon Apr 25 00:13:54 2005 +++ movitz/losp/x86-pc/debugger.lisp Thu May 5 22:52:45 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 22 10:09:18 2002 ;;;; -;;;; $Id: debugger.lisp,v 1.39 2005/04/24 22:13:54 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.40 2005/05/05 20:52:45 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -460,7 +460,7 @@ (loop with location = (truncate eip 4) for (slot-name type) in (slot-value (class-of context) 'slot-map) do (when (eq type 'code-vector-word) - (let ((code-vector (%run-time-context-slot slot-name))) + (let ((code-vector (%run-time-context-slot nil slot-name))) (when (location-in-object-p code-vector location) (return (values slot-name (code-vector-offset code-vector eip)))))))) @@ -629,7 +629,7 @@ thereis (match-funobj (method-function m) instruction-location (1- limit)))))))) (or (loop for (slot-name type) in (slot-value (class-of (current-run-time-context)) 'slot-map) do (when (and (eq type 'code-vector-word) - (location-in-object-p (%run-time-context-slot slot-name) + (location-in-object-p (%run-time-context-slot nil slot-name) instruction-location)) (return (values slot-name :run-time-context)))) (with-hash-table-iterator (hashis *setf-namespace*)

1 0

[movitz-cvs] CVS update: movitz/losp/lib/malloc-init.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-serv20034 Modified Files: malloc-init.lisp Log Message: Changed order of arguments for %run-time-context-slot, new signature is (context slot-name), where nil may be used as a designator for (current-run-time-context). Date: Thu May 5 22:52:40 2005 Author: ffjeld Index: movitz/losp/lib/malloc-init.lisp diff -u movitz/losp/lib/malloc-init.lisp:1.6 movitz/losp/lib/malloc-init.lisp:1.7 --- movitz/losp/lib/malloc-init.lisp:1.6 Mon Oct 11 15:52:01 2004 +++ movitz/losp/lib/malloc-init.lisp Thu May 5 22:52:40 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: Wed Jan 9 15:57:22 2002 ;;;; -;;;; $Id: malloc-init.lisp,v 1.6 2004/10/11 13:52:01 ffjeld Exp $ +;;;; $Id: malloc-init.lisp,v 1.7 2005/05/05 20:52:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -19,7 +19,7 @@ (in-package muerte.lib) -(let* ((stack-vector (%run-time-context-slot 'muerte::stack-vector)) +(let* ((stack-vector (%run-time-context-slot nil 'muerte::stack-vector)) ;; We assume the kernel static are ends with the stack-vector. (kernel-end-location (+ 2 (muerte:object-location stack-vector) (array-dimension stack-vector 0)))

1 0

[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-serv20012 Modified Files: threading.lisp Log Message: Changed order of arguments for %run-time-context-slot, new signature is (context slot-name), where nil may be used as a designator for (current-run-time-context). Date: Thu May 5 22:52:21 2005 Author: ffjeld Index: movitz/losp/lib/threading.lisp diff -u movitz/losp/lib/threading.lisp:1.2 movitz/losp/lib/threading.lisp:1.3 --- movitz/losp/lib/threading.lisp:1.2 Thu May 5 17:21:59 2005 +++ movitz/losp/lib/threading.lisp Thu May 5 22:52:21 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.2 2005/05/05 15:21:59 ffjeld Exp $ +;;;; $Id: threading.lisp,v 1.3 2005/05/05 20:52:21 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -26,7 +26,8 @@ (in-package muerte) (defclass thread (run-time-context) - () + ((segment-selector + :initform :segment-selector)) (:metaclass run-time-context-class)) (defmacro control-stack-ebp (stack) @@ -109,11 +110,11 @@ (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) + (setf (%run-time-context-slot thread 'dynamic-env) 0 + (%run-time-context-slot thread 'stack-vector) stack + (%run-time-context-slot thread 'stack-top) (+ 2 (object-location stack) (length stack)) - (%run-time-context-slot 'stack-bottom thread) (+ (object-location stack) 2 + (%run-time-context-slot thread 'stack-bottom) (+ (object-location stack) 2 (or cushion (if (>= (length stack) 200) 100 @@ -123,8 +124,8 @@ (defun yield (target-rtc &optional value) (declare (dynamic-extent values)) (assert (not (eq target-rtc (current-run-time-context)))) - (let ((my-stack (%run-time-context-slot 'stack-vector)) - (target-stack (%run-time-context-slot 'stack-vector target-rtc))) + (let ((my-stack (%run-time-context-slot nil 'stack-vector)) + (target-stack (%run-time-context-slot target-rtc 'stack-vector))) (assert (not (eq my-stack target-stack))) (let ((fs (control-stack-fs target-stack)) (esp (control-stack-esp target-stack)) @@ -137,8 +138,8 @@ ;; Push eflags for later.. (setf (memref (decf esp) 0) (eflags)) ;; Store EBP and ESP so we can get to them after the switch - (setf (%run-time-context-slot 'scratch1 target-rtc) ebp - (%run-time-context-slot 'scratch2 target-rtc) esp) + (setf (%run-time-context-slot target-rtc 'scratch1) ebp + (%run-time-context-slot target-rtc 'scratch2) esp) ;; Enable someone to yield back here.. (setf (control-stack-fs my-stack) (segment-register :fs) (control-stack-ebp my-stack) (muerte::asm-register :ebp)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/more-macros.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-serv19993 Modified Files: more-macros.lisp Log Message: Changed order of arguments for %run-time-context-slot, new signature is (context slot-name), where nil may be used as a designator for (current-run-time-context). Date: Thu May 5 22:52:11 2005 Author: ffjeld Index: movitz/losp/muerte/more-macros.lisp diff -u movitz/losp/muerte/more-macros.lisp:1.26 movitz/losp/muerte/more-macros.lisp:1.27 --- movitz/losp/muerte/more-macros.lisp:1.26 Thu May 5 20:08:20 2005 +++ movitz/losp/muerte/more-macros.lisp Thu May 5 22:52:10 2005 @@ -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.26 2005/05/05 18:08:20 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.27 2005/05/05 20:52:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -318,14 +318,15 @@ ,format-control ,@format-arguments) ,@body)) -(define-compiler-macro %run-time-context-slot (&whole form &environment env slot-name - &optional (context '(current-run-time-context))) - (if (not (and (movitz:movitz-constantp slot-name env))) +(define-compiler-macro %run-time-context-slot (&whole form &environment env context slot-name) + (if (not (movitz:movitz-constantp slot-name env)) form (let* ((slot-name (movitz::eval-form slot-name env)) (slot-type (bt:binary-slot-type 'movitz::movitz-run-time-context (intern (symbol-name slot-name) :movitz)))) - (if (equal context '(current-run-time-context)) + (if (or (and (movitz:movitz-constantp context env) + (eq nil (movitz:movitz-eval context env))) + (equal context '(current-run-time-context))) (ecase slot-type (movitz::word `(with-inline-assembly (:returns :eax) @@ -359,26 +360,31 @@ ,(- (movitz:tag :other)))) :ecx)))))))) -(define-compiler-macro (setf %run-time-context-slot) (&whole form &environment env value slot-name - &optional (context '(current-run-time-context))) - (if (not (and (movitz:movitz-constantp slot-name env) - (equal context '(current-run-time-context)))) +(define-compiler-macro (setf %run-time-context-slot) (&whole form &environment env value context slot-name) + (if (not (movitz:movitz-constantp slot-name env)) form - (let ((slot-name (movitz:movitz-eval slot-name env))) - (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) - (:locally (:movl :eax (:edi (:edi-offset ,slot-name)))))) - (movitz:lu32 - `(with-inline-assembly (:returns :untagged-fixnum-ecx) - (:compile-form (:result-mode :untagged-fixnum-ecx) ,value) - (:locally (:movl :ecx (:edi (:edi-offset ,slot-name)))))) - (movitz:code-vector-word - `(with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) ,value) - (:leal (:eax ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data)) :ecx) - (:locally (:movl :ecx (:edi (:edi-offset ,slot-name)))))))))) + (let* ((slot-name (movitz::eval-form slot-name env)) + (slot-type (bt:binary-slot-type 'movitz::movitz-run-time-context + (intern (symbol-name slot-name) :movitz)))) + (if (or (and (movitz:movitz-constantp context env) + (eq nil (movitz:movitz-eval context env))) + (equal context '(current-run-time-context))) + (ecase slot-type + (movitz:word + `(with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) ,value) + (:locally (:movl :eax (:edi (:edi-offset ,slot-name)))))) + (movitz:lu32 + `(with-inline-assembly (:returns :untagged-fixnum-ecx) + (:compile-form (:result-mode :untagged-fixnum-ecx) ,value) + (:locally (:movl :ecx (:edi (:edi-offset ,slot-name)))))) + (movitz:code-vector-word + `(with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) ,value) + (:leal (:eax ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data)) :ecx) + (:locally (:movl :ecx (:edi (:edi-offset ,slot-name))))))) + ;; FIXME + form)))) (define-compiler-macro read-time-stamp-counter () `(with-inline-assembly-case ()

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.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-serv19977 Modified Files: inspect.lisp Log Message: Changed order of arguments for %run-time-context-slot, new signature is (context slot-name), where nil may be used as a designator for (current-run-time-context). Date: Thu May 5 22:52:03 2005 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.52 movitz/losp/muerte/inspect.lisp:1.53 --- movitz/losp/muerte/inspect.lisp:1.52 Thu May 5 00:46:44 2005 +++ movitz/losp/muerte/inspect.lisp Thu May 5 22:52:02 2005 @@ -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.52 2005/05/04 22:46:44 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.53 2005/05/05 20:52:02 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -53,11 +53,6 @@ (dit-frame-casf stack frame)) (t (stack-frame-ref stack frame 0)))) -;;;(defun stack-vector-designator (stack) -;;; (etypecase stack -;;; (null (%run-time-context-slot 'stack-vector)) -;;; (vector stack))) - (define-compiler-macro current-stack-frame () `(with-inline-assembly (:returns :eax) (:leal ((:ebp ,(truncate movitz::+movitz-fixnum-factor+ 4))) @@ -322,7 +317,11 @@ (std-instance (and (typep y 'std-instance) (test std-instance-class) - (test std-instance-slots))))))))) + (test std-instance-slots))) + (run-time-context + (and (typep y 'run-time-context) + (test %run-time-context-slot 'slots) + (test %run-time-context-slot 'class))))))))) (define-compiler-macro %lispval-object (integer &environment env) "Return the object that is wrapped in the 32-bit integer lispval."

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/scavenge.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-serv19956 Modified Files: scavenge.lisp Log Message: Changed order of arguments for %run-time-context-slot, new signature is (context slot-name), where nil may be used as a designator for (current-run-time-context). Date: Thu May 5 22:51:55 2005 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.49 movitz/losp/muerte/scavenge.lisp:1.50 --- movitz/losp/muerte/scavenge.lisp:1.49 Wed Mar 9 08:24:16 2005 +++ movitz/losp/muerte/scavenge.lisp Thu May 5 22:51:55 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Mar 29 14:54:08 2004 ;;;; -;;;; $Id: scavenge.lisp,v 1.49 2005/03/09 07:24:16 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.50 2005/05/05 20:51:55 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -84,6 +84,19 @@ (assert (evenp scan) () "Scanned struct-header ~S at odd location #x~X." x scan) (setf *scan-last* (%word-offset scan #.(movitz:tag :other)))) + ((scavenge-typep x :run-time-context) + (assert (evenp scan) () + "Scanned run-time-context-header ~S at odd location #x~X." + (memref scan 0 :type :unsigned-byte32) scan) + (incf scan) + (let ((non-lispvals #.(cl:truncate (cl:+ -4 (bt:slot-offset 'movitz::movitz-run-time-context + 'movitz::pointer-start) + (movitz::image-nil-word movitz:*image*)) + 4)) + (end (+ scan #.(movitz::movitz-type-word-size 'movitz::movitz-run-time-context)))) + (incf scan non-lispvals) + (map-lisp-vals function scan (1+ end)) + (setf scan end))) ((scavenge-typep x :funobj) (assert (evenp scan) () "Scanned funobj-header ~S at odd location #x~X." @@ -213,7 +226,9 @@ (defun scavenge-find-pf (function location) (loop for (slot-name type) in (slot-value (class-of (current-run-time-context)) 'slot-map) do (when (eq type 'code-vector-word) - (let ((it (scavenge-match-code-vector function (%run-time-context-slot slot-name) location))) + (let ((it (scavenge-match-code-vector function + (%run-time-context-slot nil slot-name) + location))) (when it (return it)))))) (defun scavenge-find-code-vector (function location casf-funobj esi &optional primitive-function-p edx) @@ -234,7 +249,9 @@ (scavenge-match-code-vector function x location))))))) (cond ((scavenge-match-code-vector function (symbol-value 'ret-trampoline) location)) - ((scavenge-match-code-vector function (%run-time-context-slot 'dynamic-jump-next) location)) + ((scavenge-match-code-vector function + (%run-time-context-slot nil 'dynamic-jump-next) + location)) ((eq 0 casf-funobj) (let ((dit-code-vector (symbol-value 'default-interrupt-trampoline))) (cond

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/restarts.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-serv19940 Modified Files: restarts.lisp Log Message: Changed order of arguments for %run-time-context-slot, new signature is (context slot-name), where nil may be used as a designator for (current-run-time-context). Date: Thu May 5 22:51:51 2005 Author: ffjeld Index: movitz/losp/muerte/restarts.lisp diff -u movitz/losp/muerte/restarts.lisp:1.5 movitz/losp/muerte/restarts.lisp:1.6 --- movitz/losp/muerte/restarts.lisp:1.5 Fri Nov 12 15:52:24 2004 +++ movitz/losp/muerte/restarts.lisp Thu May 5 22:51:51 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 Oct 28 09:27:13 2003 ;;;; -;;;; $Id: restarts.lisp,v 1.5 2004/11/12 14:52:24 ffjeld Exp $ +;;;; $Id: restarts.lisp,v 1.6 2005/05/05 20:51:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -33,12 +33,12 @@ (restart-bind ,rest-specs ,@body)))))) (defun dynamic-context->basic-restart (context) - (assert (< (%run-time-context-slot 'stack-bottom) + (assert (< (%run-time-context-slot nil 'stack-bottom) context - (%run-time-context-slot 'stack-top))) + (%run-time-context-slot nil 'stack-top))) (assert (eq (load-global-constant restart-tag) (stack-frame-ref nil context 1 :lisp))) - (let ((x (- (%run-time-context-slot 'stack-top) context))) + (let ((x (- (%run-time-context-slot nil 'stack-top) context))) (assert (below x #x1000000)) (with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) x)

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-serv19917 Modified Files: primitive-functions.lisp Log Message: Changed order of arguments for %run-time-context-slot, new signature is (context slot-name), where nil may be used as a designator for (current-run-time-context). Date: Thu May 5 22:51:45 2005 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.64 movitz/losp/muerte/primitive-functions.lisp:1.65 --- movitz/losp/muerte/primitive-functions.lisp:1.64 Thu May 5 15:59:37 2005 +++ movitz/losp/muerte/primitive-functions.lisp Thu May 5 22:51:43 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.64 2005/05/05 13:59:37 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.65 2005/05/05 20:51:43 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -360,7 +360,7 @@ (defun malloc-cons-pointer () "Return current cons-pointer in 8-byte units since buffer-start." - (let ((x (%run-time-context-slot 'nursery-space))) + (let ((x (%run-time-context-slot nil 'nursery-space))) (when (typep x 'vector) (truncate (aref x 0) 8))) #+ignore

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/los-closette.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-serv19896 Modified Files: los-closette.lisp Log Message: Changed order of arguments for %run-time-context-slot, new signature is (context slot-name), where nil may be used as a designator for (current-run-time-context). Date: Thu May 5 22:51:38 2005 Author: ffjeld Index: movitz/losp/muerte/los-closette.lisp diff -u movitz/losp/muerte/los-closette.lisp:1.31 movitz/losp/muerte/los-closette.lisp:1.32 --- movitz/losp/muerte/los-closette.lisp:1.31 Wed May 4 10:00:42 2005 +++ movitz/losp/muerte/los-closette.lisp Thu May 5 22:51:36 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Jul 23 14:29:10 2002 ;;;; -;;;; $Id: los-closette.lisp,v 1.31 2005/05/04 08:00:42 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.32 2005/05/05 20:51:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -220,11 +220,11 @@ (check-type class (or null class)) #+ignore (case class-name - ((t) (setf (%run-time-context-slot 'the-class-t) class)) - (null (setf (%run-time-context-slot 'the-class-null) class)) - (symbol (setf (%run-time-context-slot 'the-class-symbol) class)) - (fixnum (setf (%run-time-context-slot 'the-class-fixnum) class)) - (cons (setf (%run-time-context-slot 'the-class-cons) class))) + ((t) (setf (%run-time-context-slot nil 'the-class-t) class)) + (null (setf (%run-time-context-slot nil 'the-class-null) class)) + (symbol (setf (%run-time-context-slot 'nil the-class-symbol) class)) + (fixnum (setf (%run-time-context-slot nil 'the-class-fixnum) class)) + (cons (setf (%run-time-context-slot nil 'the-class-cons) class))) (let ((map (load-global-constant classes))) (when (member class-name (svref map 0)) (setf (svref map (1+ (position class-name (svref map 0))))

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