June 2004 - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

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

17 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3732 Modified Files: arrays.lisp Log Message: Starting to implement the new data-structure for vectors. Date: Thu Jun 17 02:49:13 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.23 movitz/losp/muerte/arrays.lisp:1.24 --- movitz/losp/muerte/arrays.lisp:1.23 Wed Jun 16 00:38:27 2004 +++ movitz/losp/muerte/arrays.lisp Thu Jun 17 02:49:13 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.23 2004/06/16 07:38:27 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.24 2004/06/17 09:49:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -98,24 +98,66 @@ (defun vector-fill-pointer (vector) (vector-fill-pointer vector)) +(define-compiler-macro %basic-vector-has-fill-pointer-p (vector) + "Does the basic-vector have a fill-pointer?" + `(with-inline-assembly (:returns :boolean-zf=1) + (:compile-form (:result-mode :eax) ,vector) + (:testl ,(logxor #xffffffff (1- (expt 2 14))) + (:eax ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements))))) + +(define-compiler-macro %basic-vector-fill-pointer (vector) + "Return the basic-vector's fill-pointer. The result is only valid if +%basic-vector-has-fill-pointer-p is true." + `(with-inline-assembly (:returns :register) + (:compile-form (:result-mode :register) ,vector) + (:movzxw ((:result-register) + ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements)) + (:result-register)))) (defun array-has-fill-pointer-p (array) - (etypecase array ; + (etypecase array + (basic-vector + (%basic-vector-has-fill-pointer-p array)) (vector t) (array nil))) (defun fill-pointer (vector) - (check-type vector vector) - (memref vector #.(bt:slot-offset 'movitz:movitz-vector 'movitz::fill-pointer) 0 - :unsigned-byte16)) + (etypecase vector + (basic-vector + (assert (%basic-vector-has-fill-pointer-p vector) (vector) + "Vector has no fill-pointer.") + (%basic-vector-fill-pointer vector)) + (vector + (memref vector #.(bt:slot-offset 'movitz:movitz-vector 'movitz::fill-pointer) 0 + :unsigned-byte16)))) (defun (setf fill-pointer) (new-fill-pointer vector) - (check-type vector vector) - (assert (<= new-fill-pointer (vector-dimension vector))) - (setf (memref vector #.(bt:slot-offset 'movitz::movitz-vector 'movitz::fill-pointer) 0 - :unsigned-byte16) - new-fill-pointer)) + (etypecase vector + (basic-vector + (macrolet + ((do-it () + `(with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ebx) new-fill-pointer vector) + (:testb ,movitz:+movitz-fixnum-zmask+ :al) + (:jnz 'illegal-fill-pointer) + (:movl (:ebx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements)) + :ecx) + (:testl ,(logxor #xffffffff (1- (expt 2 14))) :ecx) + (:jnz '(:sub-program () + (:compile-form (:result-mode :ignore) + (error "Vector has no fill-pointer.")))) + (:cmpl :eax :ecx) + (:jc '(:sub-program (illegal-fill-pointer) + (:compile-form (:result-mode :ignore) + (error "Illegal fill-pointer: ~W." new-fill-pointer)))) + (:movw :ax (:ebx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements)))))) + (do-it))) + (vector + (assert (<= new-fill-pointer (vector-dimension vector))) + (setf (memref vector #.(bt:slot-offset 'movitz::movitz-vector 'movitz::fill-pointer) 0 + :unsigned-byte16) + new-fill-pointer)))) (defun vector-aref%unsafe (vector index) "No type-checking of <vector> or <index>." @@ -571,6 +613,24 @@ (setf (aref array i) initial-element))) (initial-contents (replace array initial-contents))) + array)) + ((eq element-type :basic) + (check-type dimensions (and fixnum (integer 0 *))) + (let ((array (malloc-words dimensions))) + (setf (memref array #.(bt:slot-offset 'movitz::movitz-new-vector 'movitz::num-elements) + 0 :lisp) + dimensions) + (setf (memref array #.(bt:slot-offset 'movitz::movitz-vector 'movitz::type) + 0 :unsigned-byte16) + #.(movitz:basic-vector-type-tag :any-t)) + (when fill-pointer + (setf (fill-pointer array) fill-pointer)) + (cond + (initial-contents + (replace array initial-contents)) + (initial-element + (dotimes (i dimensions) + (setf (svref%unsafe array i) initial-element)))) array)) (t (let ((array (malloc-words dimensions))) (setf (memref array #.(bt:slot-offset 'movitz::movitz-vector 'movitz::flags)

1 0

[movitz-cvs] CVS update: movitz/storage-types.lisp
by Frode Vatvedt Fjeld 17 Jun '04

17 Jun '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3661 Modified Files: storage-types.lisp Log Message: Starting to implement the new data-structure for vectors. Date: Thu Jun 17 02:49:08 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.21 movitz/storage-types.lisp:1.22 --- movitz/storage-types.lisp:1.21 Wed Jun 16 00:42:50 2004 +++ movitz/storage-types.lisp Thu Jun 17 02:49:08 2004 @@ -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.21 2004/06/16 07:42:50 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.22 2004/06/17 09:49:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -68,13 +68,14 @@ :symbol 7 :vector #x1a - :defstruct #x20 + :basic-vector #x22 :funobj #x3a + :bignum #x4a + :defstruct #x20 :std-instance #x40 :run-time-context #x50 :illegal #x13 :infant-object #x23 - :bignum #x4a ;; :simple-vector #x20 ;; :character-vector @@ -375,12 +376,16 @@ (byte 8 8) (enum-value 'other-type-byte :vector))) -#+ignore -(define-binary-class movitz-new-vector (movitz-heap-object-other) +(defun basic-vector-type-tag (element-type) + (dpb (enum-value 'movitz-vector-element-type element-type) + (byte 8 8) + (enum-value 'other-type-byte :basic-vector))) + +(define-binary-class movitz-basic-vector (movitz-heap-object-other) ((type :binary-type other-type-byte :reader movitz-vector-type - :initform :new-vector) + :initform :basic-vector) (element-type :binary-type (define-enum movitz-vector-element-type (u8) :any-t 0 @@ -391,27 +396,12 @@ :bit 5) :initarg :element-type :reader movitz-vector-element-type) - (dummy - :binary-type :lu16) (fill-pointer :binary-type lu16 :initarg :fill-pointer :accessor movitz-vector-fill-pointer) - (flags - :accessor movitz-vector-flags - :initarg :flags - :initform nil - :binary-type (define-bitfield movitz-vector-flags (u8) - (((:bits) :fill-pointer-p 2 - :code-vector-p 3 - :std-instance-slots-p 4)))) - (alignment-power - :binary-lisp-type u8 ; align to 2^(high-nibble+3) + low-nibble - :initform 0 - :initarg :alignment-power - :reader movitz-vector-alignment-power) (num-elements - :binary-type lu16 + :binary-type word :initarg :num-elements :reader movitz-vector-num-elements) (data

1 0

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

17 Jun '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3551 Modified Files: packages.lisp Log Message: Starting to implement the new data-structure for vectors. Date: Thu Jun 17 02:49:03 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.26 movitz/packages.lisp:1.27 --- movitz/packages.lisp:1.26 Wed Jun 16 00:38:51 2004 +++ movitz/packages.lisp Thu Jun 17 02:49:03 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.26 2004/06/16 07:38:51 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.27 2004/06/17 09:49:03 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1327,10 +1327,12 @@ #:movitz-object-browser-properties #:movitz-heap-object + #:movitz-basic-vector #:movitz-vector #:movitz-vector-num-elements #:movitz-vector-element-type #:movitz-vector-symbolic-data + #:basic-vector-type-tag #:vector-type-tag #:movitz-symbol

1 0

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

16 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6136 Modified Files: scavenge.lisp Log Message: Changed the layout of vectors somewhat (this is a minor change, not the "proper" new layout that should come soon). This requires a re-compile of any images. And fixed some (somewhat related) bugs in the map-heap-words function. Date: Wed Jun 16 00:42:55 2004 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.10 movitz/losp/muerte/scavenge.lisp:1.11 --- movitz/losp/muerte/scavenge.lisp:1.10 Fri Jun 11 16:26:14 2004 +++ movitz/losp/muerte/scavenge.lisp Wed Jun 16 00:42:55 2004 @@ -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.10 2004/06/11 23:26:14 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.11 2004/06/16 07:42:55 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -59,12 +59,15 @@ ((scavenge-typep x :illegal) (error "Illegal word ~Z at ~S." x scan)) ((scavenge-typep x :bignum) - (assert (evenp scan)) + (assert (evenp scan) () + "Scanned #x~Z at odd address #x~X." x scan) ;; Just skip the bigits (let* ((bigits (word-upper16 x)) (delta (1+ (logand bigits -2)))) (incf scan delta))) ((scavenge-typep x :funobj) + (assert (evenp scan) () + "Scanned #x~Z at odd address #x~X." x scan) ;; Process code-vector pointer specially.. (let* ((funobj (%word-offset scan #.(movitz:tag :other))) (code-vector (funobj-code-vector funobj)) @@ -80,18 +83,26 @@ )) (incf scan (+ 7 num-jumpers)))) ; Don't scan the jumpers. ((scavenge-typep x :infant-object) + (assert (evenp scan) () + "Scanned #x~Z at odd address #x~X." x scan) (error "Scanning an infant object ~Z at ~S (end ~S)." x scan end-location)) ((or (scavenge-wide-typep x :vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u8)) (scavenge-wide-typep x :vector #.(bt:enum-value 'movitz:movitz-vector-element-type :character))) - (let ((len (word-upper16 x))) + (assert (evenp scan) () + "Scanned #x~Z at odd address #x~X." x scan) + (let ((len (memref scan (word-upper16 x) 0 :unsigned-byte16))) (incf scan (1+ (* 2 (truncate (+ 7 len) 8)))))) ((scavenge-wide-typep x :vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u16)) - (let ((len (word-upper16 x))) + (assert (evenp scan) () + "Scanned #x~Z at odd address #x~X." x scan) + (let ((len (memref scan (word-upper16 x) 0 :unsigned-byte16))) (incf scan (1+ (* 2 (truncate (+ 3 len) 4)))))) ((scavenge-wide-typep x :vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u32)) - (let ((len (word-upper16 x))) + (assert (evenp scan) () + "Scanned #x~Z at odd address #x~X." x scan) + (let ((len (memref scan (word-upper16 x) 0 :unsigned-byte16))) (incf scan (1+ (logand (1+ len) -2))))) ((eq x (fixnum-word 3)) (incf scan)

1 0

[movitz-cvs] CVS update: movitz/storage-types.lisp
by Frode Vatvedt Fjeld 16 Jun '04

16 Jun '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv6037 Modified Files: storage-types.lisp Log Message: Changed the layout of vectors somewhat (this is a minor change, not the "proper" new layout that should come soon). This requires a re-compile of any images. And fixed some (somewhat related) bugs in the map-heap-words function. Date: Wed Jun 16 00:42:50 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.20 movitz/storage-types.lisp:1.21 --- movitz/storage-types.lisp:1.20 Fri Jun 11 16:26:09 2004 +++ movitz/storage-types.lisp Wed Jun 16 00:42:50 2004 @@ -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.20 2004/06/11 23:26:09 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.21 2004/06/16 07:42:50 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -345,7 +345,7 @@ (num-elements :binary-type lu16 :initarg :num-elements - :reader movitz-vector-num-elements) + :reader movitz-vector-num-elements) (flags :accessor movitz-vector-flags :initarg :flags @@ -362,7 +362,7 @@ (fill-pointer :binary-type lu16 :initarg :fill-pointer - :accessor movitz-vector-fill-pointer) + :accessor movitz-vector-fill-pointer) (data :binary-lisp-type :label) ; data follows physically here (symbolic-data @@ -375,31 +375,51 @@ (byte 8 8) (enum-value 'other-type-byte :vector))) -;;;(define-binary-class movitz-new-vector (movitz-heap-object-other) -;;; ((length -;;; :binary-type u32 -;;; :initarg :length -;;; :accessor movitz-simple-vector-length) -;;; (type -;;; :binary-type other-type-byte -;;; :reader movitz-vector-type) -;;; #+ignore -;;; (element-type -;;; :binary-type (define-enum movitz-vector-element-type (u8) -;;; :any-t 0 -;;; :character 1 -;;; :u8 2 -;;; :u16 3 -;;; :u32 4 -;;; :bit 5) -;;; :initarg :element-type -;;; :reader movitz-vector-element-type) -;;; (data -;;; :binary-lisp-type :label) -;;; (symbolic-data -;;; :initarg :symbolic-data -;;; :accessor movitz-vector-symbolic-data)) -;;; (:slot-align type #.+other-type-offset+)) +#+ignore +(define-binary-class movitz-new-vector (movitz-heap-object-other) + ((type + :binary-type other-type-byte + :reader movitz-vector-type + :initform :new-vector) + (element-type + :binary-type (define-enum movitz-vector-element-type (u8) + :any-t 0 + :character 1 + :u8 2 + :u16 3 + :u32 4 + :bit 5) + :initarg :element-type + :reader movitz-vector-element-type) + (dummy + :binary-type :lu16) + (fill-pointer + :binary-type lu16 + :initarg :fill-pointer + :accessor movitz-vector-fill-pointer) + (flags + :accessor movitz-vector-flags + :initarg :flags + :initform nil + :binary-type (define-bitfield movitz-vector-flags (u8) + (((:bits) :fill-pointer-p 2 + :code-vector-p 3 + :std-instance-slots-p 4)))) + (alignment-power + :binary-lisp-type u8 ; align to 2^(high-nibble+3) + low-nibble + :initform 0 + :initarg :alignment-power + :reader movitz-vector-alignment-power) + (num-elements + :binary-type lu16 + :initarg :num-elements + :reader movitz-vector-num-elements) + (data + :binary-lisp-type :label) ; data follows physically here + (symbolic-data + :initarg :symbolic-data + :accessor movitz-vector-symbolic-data)) + (:slot-align type #.+other-type-offset+)) (defun movitz-type-word-size (type) (truncate (sizeof (intern (symbol-name type) :movitz)) 4))

1 0

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

16 Jun '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv3615 Modified Files: los0-gc.lisp Log Message: Various hacking and experimentation I did before the eurolisp-workshop. Date: Wed Jun 16 00:40:38 2004 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.17 movitz/losp/los0-gc.lisp:1.18 --- movitz/losp/los0-gc.lisp:1.17 Sat Jun 5 20:02:08 2004 +++ movitz/losp/los0-gc.lisp Wed Jun 16 00:40:38 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.17 2004/06/06 03:02:08 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.18 2004/06/16 07:40:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -267,6 +267,10 @@ (+ (object-location space) (array-dimension space 0))))) +(defun tenure () + (install-old-consing) + (install-los0-consing)) + (defun report-nursery (x location) "Write a message if x is inside newspace." (when (object-in-space-p (%run-time-context-slot 'nursery-space) x) @@ -286,7 +290,21 @@ find-location x location)) x)) -(defun stop-and-copy () +(defun kill-the-newborns () + (let* ((oldspace (%run-time-context-slot 'nursery-space)) + (newspace (space-other oldspace))) + (setf (%run-time-context-slot 'nursery-space) newspace) + (flet ((zap-oldspace (x location) + (declare (ignore location)) + (if (object-in-space-p oldspace x) + nil + x))) + (map-heap-words #'zap-oldspace 0 (malloc-end)) + (map-stack-words #'zap-oldspace (current-stack-frame)) + (initialize-space oldspace) + (values)))) + +(defun stop-and-copy (&optional evacuator) (let* ((space0 (%run-time-context-slot 'nursery-space)) (space1 (space-other space0))) (check-type space0 vector-u32) @@ -299,29 +317,30 @@ (values space1 space0)) ;; Ensure newspace is activated. (setf (%run-time-context-slot 'nursery-space) newspace) - ;; (assert (< #x200 (- (length newspace) (space-fresh-pointer newspace)))) ;; Evacuate-oldspace is to be mapped over every potential pointer. - (flet ((evacuate-oldspace (x location) - "If x is in oldspace, migrate it to newspace." - (declare (ignore location)) - (if (not (object-in-space-p oldspace x)) - x - (let ((forwarded-x (memref (object-location x) 0 1 :lisp))) - (if (object-in-space-p newspace forwarded-x) - forwarded-x - (let ((forward-x (shallow-copy x))) - (setf (memref (object-location x) 0 1 :lisp) forward-x) - forward-x)))))) + (let ((evacuator + (or evacuator + (lambda (x location) + "If x is in oldspace, migrate it to newspace." + (declare (ignore location)) + (if (not (object-in-space-p oldspace x)) + x + (let ((forwarded-x (memref (object-location x) 0 1 :lisp))) + (if (object-in-space-p newspace forwarded-x) + forwarded-x + (let ((forward-x (shallow-copy x))) + (setf (memref (object-location x) 0 1 :lisp) forward-x) + forward-x)))))))) ;; Scavenge roots - (map-heap-words #'evacuate-oldspace 0 (+ (malloc-buffer-start) + (map-heap-words evacuator 0 (+ (malloc-buffer-start) (* 2 (malloc-cons-pointer)))) - (map-stack-words #'evacuate-oldspace (current-stack-frame)) + (map-stack-words evacuator (current-stack-frame)) ;; Scan newspace, Cheney style. (loop with newspace-location = (+ 2 (object-location newspace)) with scan-pointer = 2 as fresh-pointer = (space-fresh-pointer newspace) while (< scan-pointer fresh-pointer) - do (map-heap-words #'evacuate-oldspace + do (map-heap-words evacuator (+ newspace-location scan-pointer) (+ newspace-location (space-fresh-pointer newspace))) (setf scan-pointer fresh-pointer))

1 0

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

16 Jun '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv29600 Modified Files: packages.lisp Log Message: Added a symbol. Date: Wed Jun 16 00:38:51 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.25 movitz/packages.lisp:1.26 --- movitz/packages.lisp:1.25 Tue Jun 8 13:07:02 2004 +++ movitz/packages.lisp Wed Jun 16 00:38:51 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.25 2004/06/08 20:07:02 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.26 2004/06/16 07:38:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1144,6 +1144,7 @@ #:malloc-data-clumps #:malloc-cons-pointer #:malloc-buffer-start + #:malloc-end #:%word-offset #:%run-time-context-slot

1 0

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

16 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv29247 Modified Files: arrays.lisp Log Message: Aref should complain about the vector's (array-dimension v 0), not (length v). Date: Wed Jun 16 00:38:27 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.22 movitz/losp/muerte/arrays.lisp:1.23 --- movitz/losp/muerte/arrays.lisp:1.22 Mon May 24 14:51:52 2004 +++ movitz/losp/muerte/arrays.lisp Wed Jun 16 00:38:27 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.22 2004/05/24 21:51:52 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.23 2004/06/16 07:38:27 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -207,7 +207,8 @@ (:cmpw (:eax ,(bt:slot-offset 'movitz:movitz-vector 'movitz::num-elements)) :bx) (:jae '(:sub-program () (:compile-form (:result-mode :ignore) - (error "Index ~D out of bounds ~D." index (length vector))))) + (error "Index ~D out of bounds ~D." + index (array-dimension vector 0))))) (:cmpl ,(movitz:vector-type-tag :any-t) :ecx) (:jne 'not-any-t)

1 0

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

16 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv27155 Modified Files: eval.lisp Log Message: Added when and unless. I really should add proper macros soon. Date: Wed Jun 16 00:37:17 2004 Author: ffjeld Index: movitz/losp/muerte/eval.lisp diff -u movitz/losp/muerte/eval.lisp:1.8 movitz/losp/muerte/eval.lisp:1.9 --- movitz/losp/muerte/eval.lisp:1.8 Fri Apr 23 06:00:30 2004 +++ movitz/losp/muerte/eval.lisp Wed Jun 16 00:37:17 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 19 21:15:12 2001 ;;;; -;;;; $Id: eval.lisp,v 1.8 2004/04/23 13:00:30 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.9 2004/06/16 07:37:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -72,6 +72,10 @@ (case (car form) (quote (cadr form)) (function (eval-function (second form) env)) + (when (when (eval-form (second form) env) + (eval-progn (cddr form) env))) + (unless (unless (eval-form (second form) env) + (eval-progn (cddr form) env))) (if (if (eval-form (second form) env) (eval-form (third form) env) (eval-form (fourth form) env)))

1 0

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

16 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv24670 Modified Files: primitive-functions.lisp Log Message: Added function malloc-end. Date: Wed Jun 16 00:35:52 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.22 movitz/losp/muerte/primitive-functions.lisp:1.23 --- movitz/losp/muerte/primitive-functions.lisp:1.22 Thu Jun 10 12:28:19 2004 +++ movitz/losp/muerte/primitive-functions.lisp Wed Jun 16 00:35:52 2004 @@ -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.22 2004/06/10 19:28:19 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.23 2004/06/16 07:35:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -472,6 +472,11 @@ (:jnz '(:sub-program () (:int 107))) (:shrl 1 :eax))) + +(defun malloc-end () + "Return the last location of the (dynamically allocated) heap area." + (+ (malloc-buffer-start) + (* 2 (malloc-cons-pointer)))) (define-primitive-function fast-cons () "Allocate a cons cell. Call with car in eax and cdr in ebx."

1 0