movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

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

08 May '05

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv25156 Modified Files: los0.lisp Log Message: *** empty log message *** Date: Sun May 8 03:20:02 2005 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.44 movitz/losp/los0.lisp:1.45 --- movitz/losp/los0.lisp:1.44 Thu May 5 22:51:12 2005 +++ movitz/losp/los0.lisp Sun May 8 03:20:02 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.44 2005/05/05 20:51:12 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.45 2005/05/08 01:20:02 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -44,7 +44,8 @@ ;; #:muerte.ip6 #:muerte.ip4 #:muerte.mop - #:muerte.x86-pc.serial)) + #:muerte.x86-pc.serial + #:threading)) (require :los0-gc) ; Must come after defpackage. @@ -1365,7 +1366,7 @@ (setf *package* (find-package "INIT")) (when muerte::*multiboot-data* (set-textmode +vga-state-90x30+)) - + (cond ((not (cpu-featurep :tsc)) (warn "This CPU has no time-stamp-counter. Timer-related functions will not work.")) @@ -1379,6 +1380,10 @@ *standard-input* s *terminal-io* s *debug-io* s))) + + (setf threading:*segment-descriptor-table-manager* + (make-instance 'threading:segment-descriptor-table-manager)) + ;;; (ignore-errors ;;; (setf (symbol-function 'write-char) ;;; (muerte.x86-pc.serial::make-serial-write-char :baudrate 38400))

1 0

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

08 May '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv25129 Modified Files: segments.lisp Log Message: For the segment-descriptor-table accessors, use "selectors" (as in the quantities loaded into segment registers) rather than indexes. Date: Sun May 8 03:19:42 2005 Author: ffjeld Index: movitz/losp/muerte/segments.lisp diff -u movitz/losp/muerte/segments.lisp:1.13 movitz/losp/muerte/segments.lisp:1.14 --- movitz/losp/muerte/segments.lisp:1.13 Sat Apr 30 00:36:05 2005 +++ movitz/losp/muerte/segments.lisp Sun May 8 03:19:41 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu May 8 14:25:06 2003 ;;;; -;;;; $Id: segments.lisp,v 1.13 2005/04/29 22:36:05 ffjeld Exp $ +;;;; $Id: segments.lisp,v 1.14 2005/05/08 01:19:41 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -162,13 +162,26 @@ (:cr3 (set-creg :cr3)) (:cr4 (set-creg :cr4))) value)) + +;; + +(defun (setf global-segment-descriptor-table) (table) + "Install <table> as the GDT. +NB! you need ensure that the table object isn't garbage-collected." + (check-type table (vector (unsigned-byte 32))) + (let ((limit (1- (* 2 (length table)))) + (base (+ 2 (+ (object-location table) + (location-physical-offset))))) + (%lgdt base limit) + table)) -(defun segment-descriptor-base-location (table index) +(defun segment-descriptor-base-location (table selector) (check-type table (and vector (not simple-vector))) (eval-when (:compile-toplevel) (assert (= 4 movitz::+movitz-fixnum-factor+))) ;; XXX This fails for locations above 2GB. - (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)))) + (let ((offset (+ (logand selector #xfff8) + (movitz-type-slot-offset 'movitz-basic-vector 'data)))) (logior (ash (memref table (+ 7 offset) :type :unsigned-byte8) 22) (ash (memref table (+ 4 offset) :type :unsigned-byte8) @@ -176,11 +189,12 @@ (ash (memref table (+ 2 offset) :type :unsigned-byte16) -2)))) -(defun (setf segment-descriptor-base-location) (base-location table index) +(defun (setf segment-descriptor-base-location) (base-location table selector) (check-type table (and vector (not simple-vector))) (eval-when (:compile-toplevel) (assert (= 4 movitz::+movitz-fixnum-factor+))) - (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)))) + (let ((offset (+ (logand #xfff8 selector) + (movitz-type-slot-offset 'movitz-basic-vector 'data)))) (setf (memref table (+ 7 offset) :type :unsigned-byte8) (ldb (byte 8 22) base-location)) (setf (memref table (+ 4 offset) :type :unsigned-byte8) @@ -189,66 +203,91 @@ (ash (ldb (byte 14 0) base-location) 2)) base-location)) -(defun segment-descriptor-limit (table index) +(defun segment-descriptor-limit (table selector) (check-type table (and vector (not simple-vector))) - (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)))) + (let ((offset (+ (logand #xfff8 selector) + (movitz-type-slot-offset 'movitz-basic-vector 'data)))) (dpb (memref table (+ 6 offset) :type :unsigned-byte8) (byte 4 16) (memref table (+ 0 offset) :type :unsigned-byte16)))) -(defun (setf segment-descriptor-limit) (limit table index) +(defun (setf segment-descriptor-limit) (limit table selector) (check-type table (and vector (not simple-vector))) - (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)))) + (let ((offset (+ (logand #xfff8 selector) + (movitz-type-slot-offset 'movitz-basic-vector 'data)))) (setf (memref table (+ 6 offset) :type :unsigned-byte8) (ldb (byte 4 16) limit)) (setf (memref table (+ 0 offset) :type :unsigned-byte8) (ldb (byte 16 0) limit)) limit)) -(defun segment-descriptor-type-s-dpl-p (table index) +(defun segment-descriptor-type-s-dpl-p (table selector) "Access bits 40-47 of the segment descriptor." (check-type table (and vector (not simple-vector))) - (memref table (+ 5 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)) + (memref table (+ 5 (logand #xfff8 selector) + (movitz-type-slot-offset 'movitz-basic-vector 'data)) :type :unsigned-byte8)) -(defun (setf segment-descriptor-type-s-dpl-p) (bits table index) +(defun (setf segment-descriptor-type-s-dpl-p) (bits table selector) "Access bits 40-47 of the segment descriptor." (check-type table (and vector (not simple-vector))) - (setf (memref table (+ 5 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)) + (setf (memref table (+ 5 (logand #xfff8 selector) + (movitz-type-slot-offset 'movitz-basic-vector 'data)) :type :unsigned-byte8) bits)) -(defun segment-descriptor-avl-x-db-g (table index) +(defun segment-descriptor-avl-x-db-g (table selector) "Access bits 52-55 of the segment descriptor." (check-type table (and vector (not simple-vector))) (ldb (byte 4 4) - (memref table (+ 6 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)) + (memref table (+ 6 (logand #xfff8 selector) + (movitz-type-slot-offset 'movitz-basic-vector 'data)) :type :unsigned-byte8))) -(defun (setf segment-descriptor-avl-x-db-g) (bits table index) +(defun (setf segment-descriptor-avl-x-db-g) (bits table selector) "Access bits 52-55 of the segment descriptor." (check-type table (and vector (not simple-vector))) (setf (ldb (byte 4 4) - (memref table (+ 6 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)) + (memref table (+ 6 (logand #xfff8 selector) + (movitz-type-slot-offset 'movitz-basic-vector 'data)) :type :unsigned-byte8)) bits)) -(defun segment-descriptor (table index) +(defun segment-descriptor (table selector) "Access entire segment descriptor as a 64-bit integer." (check-type table (and vector (not simple-vector))) - (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)))) + (let ((offset (+ (logand #xfff8 selector) + (movitz-type-slot-offset 'movitz-basic-vector 'data)))) (logior (ash (memref table offset :index 1 :type :unsigned-byte32) 32) (ash (memref table offset :index 0 :type :unsigned-byte32) 0)))) -(defun (setf segment-descriptor) (value table index) +(defun (setf segment-descriptor) (value table selector) "Access entire segment descriptor as a 64-bit integer." (check-type table (and vector (not simple-vector))) - (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)))) + (let ((offset (+ (logand #xfff8 selector) + (movitz-type-slot-offset 'movitz-basic-vector 'data)))) (setf (memref table offset :index 1 :type :unsigned-byte32) (ldb (byte 32 32) value)) (setf (memref table offset :index 0 :type :unsigned-byte32) (ldb (byte 32 0) value)) value)) +(defun dump-global-segment-table (&key table entries nofill) + "Dump contents of the current global (segment) descriptor table into a vector." + (multiple-value-bind (gdt-base gdt-limit) + (%sgdt) + (let* ((gdt-entries (/ (1+ gdt-limit) 8)) + (entries (or entries gdt-entries))) + (check-type entries (integer 1 8192)) + (let ((table (or table + (make-array (* 2 entries) + :element-type '(unsigned-byte 32) + :initial-element 0)))) + (check-type table (vector (unsigned-byte 32))) + (unless nofill + (loop for i upfrom 0 below (* 2 gdt-entries) + do (setf (aref table i) + (memref gdt-base 0 :index i :type :unsigned-byte32 :physicalp t)))) + table))))

1 0

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

08 May '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv25088 Modified Files: interrupt.lisp Log Message: *** empty log message *** Date: Sun May 8 03:18:43 2005 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.43 movitz/losp/muerte/interrupt.lisp:1.44 --- movitz/losp/muerte/interrupt.lisp:1.43 Thu May 5 22:51:27 2005 +++ movitz/losp/muerte/interrupt.lisp Sun May 8 03:18:43 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.43 2005/05/05 20:51:27 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.44 2005/05/08 01:18:43 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -304,8 +304,7 @@ (case vector (0 (error 'division-by-zero)) (3 (break "Break instruction at ~@Z." $eip)) - (4 (warn "into ~@Z" $eax) - (if (not (eq (load-global-constant new-unbound-value) + (4 (if (not (eq (load-global-constant new-unbound-value) (dereference $eax))) (error "Primitive overflow assertion failed.") (let ((name (dereference $ebx)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/hash-tables.lisp
by ffjeld＠common-lisp.net 08 May '05

08 May '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv25068 Modified Files: hash-tables.lisp Log Message: *** empty log message *** Date: Sun May 8 03:18:29 2005 Author: ffjeld Index: movitz/losp/muerte/hash-tables.lisp diff -u movitz/losp/muerte/hash-tables.lisp:1.5 movitz/losp/muerte/hash-tables.lisp:1.6 --- movitz/losp/muerte/hash-tables.lisp:1.5 Fri May 6 22:53:36 2005 +++ movitz/losp/muerte/hash-tables.lisp Sun May 8 03:18:29 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Feb 19 19:09:05 2001 ;;;; -;;;; $Id: hash-tables.lisp,v 1.5 2005/05/06 20:53:36 ffjeld Exp $ +;;;; $Id: hash-tables.lisp,v 1.6 2005/05/08 01:18:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -60,8 +60,7 @@ (when index (do ((length (array-dimension bucket 0))) ((>= index length) nil) - (unless (eq (svref bucket index) - '--no-hash-key--) + (unless (eq (svref bucket index) '--no-hash-key--) (return (+ index 2))) (incf index 2))))

1 0

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

08 May '05

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv25040 Modified Files: ll-testing.lisp Log Message: *** empty log message *** Date: Sun May 8 03:18:02 2005 Author: ffjeld Index: movitz/losp/ll-testing.lisp diff -u movitz/losp/ll-testing.lisp:1.8 movitz/losp/ll-testing.lisp:1.9 --- movitz/losp/ll-testing.lisp:1.8 Thu May 5 17:16:45 2005 +++ movitz/losp/ll-testing.lisp Sun May 8 03:18:02 2005 @@ -10,42 +10,32 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Apr 14 08:18:43 2005 ;;;; -;;;; $Id: ll-testing.lisp,v 1.8 2005/05/05 15:16:45 ffjeld Exp $ +;;;; $Id: ll-testing.lisp,v 1.9 2005/05/08 01:18:02 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ (provide :ll-testing) (in-package muerte) -(defun dump-global-segment-table (&key table entries nofill) - "Dump contents of the current global (segment) descriptor table into a vector." - (multiple-value-bind (gdt-base gdt-limit) - (%sgdt) - (let* ((gdt-entries (/ (1+ gdt-limit) 8)) - (entries (or entries gdt-entries))) - (check-type entries (integer 1 8192)) - (let ((table (or table - (make-array (* 2 entries) - :element-type '(unsigned-byte 32) - :initial-element 0)))) - (check-type table (vector (unsigned-byte 32))) - (unless nofill - (loop for i upfrom 0 below (* 2 gdt-entries) - do (setf (aref table i) - (memref gdt-base 0 :index i :type :unsigned-byte32 :physicalp t)))) - table)))) +;;;(defun dump-global-segment-table (&key table entries nofill) +;;; "Dump contents of the current global (segment) descriptor table into a vector." +;;; (multiple-value-bind (gdt-base gdt-limit) +;;; (%sgdt) +;;; (let* ((gdt-entries (/ (1+ gdt-limit) 8)) +;;; (entries (or entries gdt-entries))) +;;; (check-type entries (integer 1 8192)) +;;; (let ((table (or table +;;; (make-array (* 2 entries) +;;; :element-type '(unsigned-byte 32) +;;; :initial-element 0)))) +;;; (check-type table (vector (unsigned-byte 32))) +;;; (unless nofill +;;; (loop for i upfrom 0 below (* 2 gdt-entries) +;;; do (setf (aref table i) +;;; (memref gdt-base 0 :index i :type :unsigned-byte32 :physicalp t)))) +;;; table)))) + -(defun install-global-segment-table (table &optional entries) - "Install <table> as the GDT. -NB! ensure that the table object isn't garbage-collected." - (check-type table (vector (unsigned-byte 32))) - (let ((entries (or entries (truncate (length table) 2)))) - (check-type entries (integer 0 *)) - (let ((limit (1- (* 8 entries))) - (base (+ 2 (+ (object-location table) - (location-physical-offset))))) - (%lgdt base limit) - (values table limit)))) (defun format-segment-table (table &key (start 0) (end (truncate (length table) 2)))

1 0

[movitz-cvs] CVS update: movitz/storage-types.lisp
by ffjeld＠common-lisp.net 08 May '05

08 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv25004 Modified Files: storage-types.lisp Log Message: *** empty log message *** Date: Sun May 8 03:17:05 2005 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.51 movitz/storage-types.lisp:1.52 --- movitz/storage-types.lisp:1.51 Sat Apr 30 23:15:43 2005 +++ movitz/storage-types.lisp Sun May 8 03:17:05 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: storage-types.lisp,v 1.51 2005/04/30 21:15:43 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.52 2005/05/08 01:17:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -992,7 +992,7 @@ (defconstant +undefined-hash-key+ - 'muerte::hash-table-undefined-key) + 'muerte::--no-hash-key--) (defun movitz-sxhash (object) "Must match the SXHASH function in :cl/hash-tables."

1 0

[movitz-cvs] CVS update: movitz/packages.lisp
by ffjeld＠common-lisp.net 08 May '05

08 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv24971 Modified Files: packages.lisp Log Message: *** empty log message *** Date: Sun May 8 03:16:41 2005 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.48 movitz/packages.lisp:1.49 --- movitz/packages.lisp:1.48 Thu May 5 17:16:29 2005 +++ movitz/packages.lisp Sun May 8 03:16:40 2005 @@ -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.48 2005/05/05 15:16:29 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.49 2005/05/08 01:16:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1116,6 +1116,9 @@ #:backtrace #:dit-frame-ref + #:stack-frame-ref + #:stack-frame-uplink + #:stack-frame-funobj #:check-stack-limit #:current-stack-frame #:interrupt-default-handler @@ -1148,6 +1151,7 @@ #:object-location #:object-tag #:location-in-object-p + #:location-physical-offset #:define-compile-time-variable #:define-primitive-function #:without-gc

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by ffjeld＠common-lisp.net 08 May '05

08 May '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv24945 Modified Files: compiler.lisp Log Message: *** empty log message *** Date: Sun May 8 03:16:27 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.138 movitz/compiler.lisp:1.139 --- movitz/compiler.lisp:1.138 Thu May 5 00:47:38 2005 +++ movitz/compiler.lisp Sun May 8 03:16:26 2005 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.138 2005/05/04 22:47:38 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.139 2005/05/08 01:16:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1378,7 +1378,7 @@ (let* ((muerte.cl::*compile-file-pathname* path) (*package* (find-package :muerte)) (funobj (make-instance 'movitz-funobj-pass1 - :name (intern (format nil "file-~A" path) :muerte) + :name (intern (format nil "~A" path) :muerte) :lambda-list (movitz-read nil))) (funobj-env (make-local-movitz-environment nil funobj :type 'funobj-env

1 0

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

06 May '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv12933 Modified Files: hash-tables.lisp Log Message: Let's call it --no-hash-key--. Date: Fri May 6 22:53:36 2005 Author: ffjeld Index: movitz/losp/muerte/hash-tables.lisp diff -u movitz/losp/muerte/hash-tables.lisp:1.4 movitz/losp/muerte/hash-tables.lisp:1.5 --- movitz/losp/muerte/hash-tables.lisp:1.4 Mon Oct 11 15:52:37 2004 +++ movitz/losp/muerte/hash-tables.lisp Fri May 6 22:53:36 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: Mon Feb 19 19:09:05 2001 ;;;; -;;;; $Id: hash-tables.lisp,v 1.4 2004/10/11 13:52:37 ffjeld Exp $ +;;;; $Id: hash-tables.lisp,v 1.5 2005/05/06 20:53:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -44,7 +44,7 @@ (equal (values #'equal #'sxhash))) (make-hash-table-object :test test - :bucket (make-array (* 2 size) :initial-element '#.movitz::+undefined-hash-key+) + :bucket (make-array (* 2 size) :initial-element '--no-hash-key--) :sxhash sxhash))) (defun hash-table-count (hash-table) @@ -53,7 +53,7 @@ (count 0) (i 0 (+ i 2))) ((>= i length) count) - (unless (eq (svref bucket i) '#.movitz::+undefined-hash-key+) + (unless (eq (svref bucket i) '--no-hash-key--) (incf count)))) (defun hash-table-iterator (bucket index) @@ -61,7 +61,7 @@ (do ((length (array-dimension bucket 0))) ((>= index length) nil) (unless (eq (svref bucket index) - '#.movitz::+undefined-hash-key+) + '--no-hash-key--) (return (+ index 2))) (incf index 2)))) @@ -130,7 +130,7 @@ (do () (nil) (let ((k (svref%unsafe bucket i2))) (cond - ((eq '#.movitz::+undefined-hash-key+ k) + ((eq k '--no-hash-key--) (return (values default nil))) ((funcall test key k) (return (values (svref%unsafe bucket (1+ i2)) t))))) @@ -147,7 +147,7 @@ (do () (nil) (let ((k (svref%unsafe bucket i2))) (cond - ((eq '#.movitz::+undefined-hash-key+ k) + ((eq k '--no-hash-key--) (return nil)) ((eq key0 (car k)) (return (svref%unsafe bucket (1+ i2)))))) @@ -165,7 +165,7 @@ (do () (nil) (let ((k (svref%unsafe bucket i2))) (cond - ((eq '#.movitz::+undefined-hash-key+ k) + ((eq k '--no-hash-key--) (return nil)) ((and (eq key0 (car k)) (eq key1 (cadr k))) (return (svref%unsafe bucket (1+ i2)))))) @@ -183,7 +183,7 @@ ((>= c bucket-length) (error "Hash-table bucket is full, needs rehashing, which isn't implemented.")) (let ((k (svref%unsafe bucket index2))) - (when (or (eq '#.movitz::+undefined-hash-key+ k) + (when (or (eq k '--no-hash-key--) (funcall test k key)) (return (setf (svref%unsafe bucket index2) key (svref%unsafe bucket (1+ index2)) value)))) @@ -197,7 +197,7 @@ (index2 (rem (* 2 (sxhash-subvector key-string start end 8)) bucket-length) (rem (+ 2 index2) bucket-length))) - ((eq '#.movitz::+undefined-hash-key+ + ((eq '--no-hash-key-- (svref%unsafe bucket index2)) (values default nil)) (when ;; (string= key-string (svref bucket index2) :start1 start :end1 end)) @@ -221,19 +221,19 @@ (i 0 (+ i 2))) ((>= i bucket-length) nil) (let ((x (svref bucket index2))) - (when (or (eq '#.movitz::+undefined-hash-key+ x) + (when (or (eq x '--no-hash-key--) (funcall (hash-table-test hash-table) x key)) - (setf (svref bucket index2) '#.movitz::+undefined-hash-key+) + (setf (svref bucket index2) '--no-hash-key--) ;; Now we must rehash any entries that might have been ;; displaced by the one we have now removed. (do ((i (rem (+ index2 2) bucket-length) (rem (+ i 2) bucket-length))) ((= i index2)) (let ((k (svref bucket i))) - (when (eq x '#.movitz::+undefined-hash-key+) + (when (eq x '--no-hash-key--) (return)) (let ((v (svref bucket (1+ i)))) - (setf (svref bucket i) '#.movitz::+undefined-hash-key+) ; remove + (setf (svref bucket i) '--no-hash-key--) ; remove (setf (gethash k hash-table) v)))) ; insert (hopefully this is safe..) (return t))))) @@ -242,7 +242,7 @@ (bucket-length (length bucket)) (i 0 (+ i 2))) ((>= i bucket-length) hash-table) - (setf (svref bucket i) '#.movitz::+undefined-hash-key+))) + (setf (svref bucket i) '--no-hash-key--))) (defun maphash (function hash-table) (with-hash-table-iterator (get-next-entry hash-table)

1 0

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

06 May '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv18309 Modified Files: los-closette.lisp Log Message: Right you were.. Date: Fri May 6 17:39:44 2005 Author: ffjeld Index: movitz/losp/muerte/los-closette.lisp diff -u movitz/losp/muerte/los-closette.lisp:1.32 movitz/losp/muerte/los-closette.lisp:1.33 --- movitz/losp/muerte/los-closette.lisp:1.32 Thu May 5 22:51:36 2005 +++ movitz/losp/muerte/los-closette.lisp Fri May 6 17:39:44 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.32 2005/05/05 20:51:36 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.33 2005/05/06 15:39:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -222,7 +222,7 @@ (case class-name ((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)) + (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)))

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