[movitz-cvs] CVS update: movitz/compiler.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv10403

Modified Files:
	compiler.lisp 
Log Message:
Added variables *compiler-nonlocal-lispval-read-segment-prefix*
and *compiler-nonlocal-lispval-write-segment-prefix*, which are the
instruction prefixes the compiler should add when writing (potential)
pointer values to (potentially) nonlocal cells.

Also, changed make-compiled-primitive to also return the code-vectors
symtab.

Date: Tue Aug 10 05:56:12 2004
Author: ffjeld

Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.91 movitz/compiler.lisp:1.92
--- movitz/compiler.lisp:1.91	Mon Aug  9 07:39:31 2004
+++ movitz/compiler.lisp	Tue Aug 10 05:56:12 2004
@@ -8,7 +8,7 @@
 ;;;; Created at:    Wed Oct 25 12:30:49 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: compiler.lisp,v 1.91 2004/08/09 14:39:31 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.92 2004/08/10 12:56:12 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -45,8 +45,15 @@
 run-time context.")
 
 (defvar *compiler-physical-segment-prefix* '(:gs-override)
-  "Use this instruction prefix when accessing a physical memory location
-(i.e. typically some memory-mapped hardware device).")
+  "Use this instruction prefix when accessing a physical memory location (i.e. typically some memory-mapped hardware device).")
+
+(defvar *compiler-nonlocal-lispval-read-segment-prefix* '(:fs-override)
+  "Use this segment prefix when reading a lispval at (potentially)
+non-local locations.")
+
+(defvar *compiler-nonlocal-lispval-write-segment-prefix* '(:fs-override)
+  "Use this segment prefix when writing a lispval at (potentially)
+non-local locations.")
 
 (defvar *compiler-allow-untagged-word-bits* 0
   "Allow (temporary) untagged values of this bit-size to exist, because
@@ -102,18 +109,20 @@
 		      :result-mode :ignore))
 	 ;; (ignmore (format t "~{~S~%~}" body-code))
 	 (resolved-code (finalize-code body-code nil nil))
-	 (function-code (ia-x86:read-proglist resolved-code))
-	 (code-vector (ia-x86:proglist-encode :octet-vector
-					      :32-bit
-					      #x00000000
-					      function-code
-					      :symtab-lookup
-					      #'(lambda (label)
-						  (case label
-						    (:nil-value (image-nil-word *image*)))))))
-    (make-movitz-vector (length code-vector)
-			:element-type 'code
-			:initial-contents code-vector)))
+	 (function-code (ia-x86:read-proglist resolved-code)))
+    (multiple-value-bind (code-vector symtab)
+	(ia-x86:proglist-encode :octet-vector
+				:32-bit
+				#x00000000
+				function-code
+				:symtab-lookup
+				#'(lambda (label)
+				    (case label
+				      (:nil-value (image-nil-word *image*)))))
+      (values (make-movitz-vector (length code-vector)
+				  :element-type 'code
+				  :initial-contents code-vector)
+	      symtab))))
 
 (defun register-function-code-size (funobj)
   (let* ((name (movitz-print (movitz-funobj-name funobj)))