[movitz-cvs] CVS movitz

[ffjeld]

Update of /project/movitz/cvsroot/movitz
In directory clnet:/tmp/cvs-serv17802

Modified Files:
	image.lisp 
Log Message:
Add primitive function decode-keyargs-default to
run-time-context. Also, do some GC tweaking on #+allegro.


--- /project/movitz/cvsroot/movitz/image.lisp	2007/02/06 20:02:41	1.107
+++ /project/movitz/cvsroot/movitz/image.lisp	2007/02/18 14:53:07	1.108
@@ -9,7 +9,7 @@
 ;;;; Created at:    Sun Oct 22 00:22:43 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: image.lisp,v 1.107 2007/02/06 20:02:41 ffjeld Exp $
+;;;; $Id: image.lisp,v 1.108 2007/02/18 14:53:07 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -112,6 +112,22 @@
     :map-binary-write 'movitz-intern-code-vector
     :map-binary-read-delayed 'movitz-word-code-vector
     :binary-tag :primitive-function)
+
+   (keyword-search
+    :map-binary-write 'movitz-intern-code-vector
+    :map-binary-read-delayed 'movitz-word-code-vector
+    :binary-tag :primitive-function
+    :binary-type code-vector-word)
+   (decode-keyargs-default
+    :map-binary-write 'movitz-intern-code-vector
+    :map-binary-read-delayed 'movitz-word-code-vector
+    :binary-tag :primitive-function
+    :binary-type code-vector-word)
+   (decode-keyargs-foo
+    :map-binary-write 'movitz-intern-code-vector
+    :map-binary-read-delayed 'movitz-word-code-vector
+    :binary-tag :primitive-function
+    :binary-type code-vector-word)
    
    (fast-car
     :binary-type code-vector-word
@@ -195,11 +211,6 @@
     :binary-tag :primitive-function
     :map-binary-read-delayed 'movitz-word-code-vector
     :binary-type code-vector-word)
-   (keyword-search
-    :map-binary-write 'movitz-intern-code-vector
-    :map-binary-read-delayed 'movitz-word-code-vector
-    :binary-tag :primitive-function
-    :binary-type code-vector-word)
    (box-u32-ecx
     :binary-type code-vector-word
     :map-binary-write 'movitz-intern-code-vector
@@ -804,6 +815,7 @@
 
 (defun create-image (&rest init-args
 		     &key (init-file *default-image-init-file*)
+			  (gc t)
 			  ;; (start-address #x100000)
 			  &allow-other-keys)
   (psetq *image* (let ((*image* (apply #'make-movitz-image
@@ -813,6 +825,10 @@
 		     (movitz-compile-file init-file))
 		   *image*)
 	 *i* (when (boundp '*image*) *image*))
+  (when gc
+    #+allegro (setf (sys:gsgc-parameter :generation-spread) 8)
+    #+allegro (excl:gc :tenure)
+    #+allegro (excl:gc t))		; We just thrashed a lot of tenured objects.
   *image*)
 
 (defun set-file-position (stream position &optional who)