[movitz-cvs] CVS movitz/losp/muerte

[ffjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv17546

Modified Files:
	arrays.lisp 
Log Message:
Add the stack-vector type, because we need to be able to recognize a stack at GC-time.


--- /project/movitz/cvsroot/movitz/losp/muerte/arrays.lisp	2008/03/15 20:57:12	1.65
+++ /project/movitz/cvsroot/movitz/losp/muerte/arrays.lisp	2008/04/02 20:49:37	1.66
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Sun Feb 11 23:14:04 2001
 ;;;;                
-;;;; $Id: arrays.lisp,v 1.65 2008/03/15 20:57:12 ffjeld Exp $
+;;;; $Id: arrays.lisp,v 1.66 2008/04/02 20:49:37 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -194,11 +194,12 @@
       ((#.(bt:enum-value 'movitz::movitz-vector-element-type :any-t)
 	#.(bt:enum-value 'movitz::movitz-vector-element-type :indirects))
        (%shallow-copy-object vector (+ 2 length)))
-      ((#.(bt:enum-value 'movitz::movitz-vector-element-type :u32))
+      ((#.(bt:enum-value 'movitz::movitz-vector-element-type :u32)
+	  #.(bt:enum-value 'movitz::movitz-vector-element-type :stack))
        (%shallow-copy-non-pointer-object vector (+ 2 length)))
       ((#.(bt:enum-value 'movitz::movitz-vector-element-type :character)
-	#.(bt:enum-value 'movitz::movitz-vector-element-type :u8)
-	#.(bt:enum-value 'movitz::movitz-vector-element-type :code))
+	  #.(bt:enum-value 'movitz::movitz-vector-element-type :u8)
+	  #.(bt:enum-value 'movitz::movitz-vector-element-type :code))
        (%shallow-copy-non-pointer-object vector	(+ 2 (truncate (+ 3 length) 4))))
       ((#.(bt:enum-value 'movitz::movitz-vector-element-type :u16))
        (%shallow-copy-non-pointer-object vector (+ 2 (truncate (+ 1 length) 2))))
@@ -321,9 +322,9 @@
 		`(with-inline-assembly (:returns :eax)
 		   (:declare-label-set
 		    basic-vector-dispatcher
-		    ,(loop with x = (make-list 8 :initial-element 'unknown)
-			 for et in '(:any-t :character :u8 :u32 :code :bit)
-			 do (setf (elt x (bt:enum-value
+		    ,(loop with x = (make-list 9 :initial-element 'unknown)
+			for et in '(:any-t :character :u8 :u32 :stack :code :bit)
+			do (setf (elt x (bt:enum-value
 					  'movitz::movitz-vector-element-type
 					  et))
 			      et)
@@ -350,6 +351,7 @@
 		   (:jnever '(:sub-program (unknown)
 			      (:int 100)))
 		  :u32
+		  :stack
 		   (:movl (:eax :ebx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data))
 			  :ecx)
 		   (:call-local-pf box-u32-ecx)
@@ -949,13 +951,23 @@
       (setf (fill-pointer array) length)))
     (cond
      (initial-element
-      ;; (check-type initial-element (unsigned-byte 32))
+      (check-type initial-element (unsigned-byte 32))
       (dotimes (i length)
 	(setf (u32ref%unsafe array i) initial-element)))
      (initial-contents
       (replace array initial-contents)))
     array))
 
+(defun make-stack-vector (length)
+  (let ((vector (make-basic-vector%u32 length nil nil nil)))
+    (with-inline-assembly (:returns :nothing)
+      (:load-lexical (:lexical-binding vector) :eax)
+      (:movl #.(movitz:basic-vector-type-tag :stack)
+	     (:eax (:offset movitz-basic-vector type))))
+    (when (%basic-vector-has-fill-pointer-p vector)
+      (setf (fill-pointer vector) length))
+    vector))
+
 (defun make-basic-vector%u8 (length fill-pointer initial-element initial-contents)
   (check-type length (and fixnum (integer 0 *)))
   (let* ((words (+ 2 (truncate (+ length 3) 4)))