From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 9 Oct 2006 06:48:32 +0000 (+0000)
Subject: Clean up output a little to simplify porting to new microcode.
X-Git-Tag: 20090517-FFI~899
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=09df7f4247764120c3c7297844e9f450bfe9fe18;p=mit-scheme.git

Clean up output a little to simplify porting to new microcode.
---

diff --git a/v7/src/compiler/machines/C/cout.scm b/v7/src/compiler/machines/C/cout.scm
index 9e74e83e6..f350bc4f5 100644
--- a/v7/src/compiler/machines/C/cout.scm
+++ b/v7/src/compiler/machines/C/cout.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: cout.scm,v 1.30 2006/10/08 01:27:47 cph Exp $
+$Id: cout.scm,v 1.31 2006/10/09 06:48:27 cph Exp $
 
 Copyright 1993,1998,2006 Massachusetts Institute of Technology
 
@@ -181,31 +181,19 @@ USA.
 	  (begin
 	    (if (not (< *invoke-interface* 5))
 		(error "Utilities take at most 4 args:" *invoke-interface*))
-	    (values
-	     (c:group (c:decl 'int 'utlarg_code)
-		      (c:decl 'long 'utlarg_1)
-		      (c:decl 'long 'utlarg_2)
-		      (c:decl 'long 'utlarg_3)
-		      (c:decl 'long 'utlarg_4))
-	     (c:group*
-	      (list-tail (list (c:group (c:label 'invoke_interface_0)
-					(c:= 'utlarg_1 0))
-			       (c:group (c:label 'invoke_interface_1)
-					(c:= 'utlarg_2 0))
-			       (c:group (c:label 'invoke_interface_2)
-					(c:= 'utlarg_3 0))
-			       (c:group (c:label 'invoke_interface_3)
-					(c:= 'utlarg_4 0))
-			       (c:group (c:label 'invoke_interface_4)
-					(c:scall "INVOKE_INTERFACE_CODE")))
-			 *invoke-interface*))))))
+	    (values (c:line "INVOKE_INTERFACE_DECLS")
+		    (c:exdent
+		     (c:line (vector-ref '#("INVOKE_INTERFACE_TARGET_0"
+					    "INVOKE_INTERFACE_TARGET_1"
+					    "INVOKE_INTERFACE_TARGET_2"
+					    "INVOKE_INTERFACE_TARGET_3"
+					    "INVOKE_INTERFACE_TARGET_4")
+					 *invoke-interface*)))))))
 
     (define (subroutine-information-2)
       (if *used-invoke-primitive*
-	  (values (c:group (c:decl 'sobj 'primitive)
-			   (c:decl 'long 'primitive_nargs))
-		  (c:group (c:label 'invoke_primitive)
-			   (c:scall "INVOKE_PRIMITIVE_CODE")))
+	  (values (c:line "INVOKE_PRIMITIVE_DECLS")
+		  (c:exdent (c:line "INVOKE_PRIMITIVE_TARGET")))
 	  (values (c:group)
 		  (c:group))))
 
@@ -472,7 +460,7 @@ USA.
 	       (c:page)
 	       (c:data-section data-generator
 			       (c:line)
-			       (declare-data handle "NO_SUBBLOCKS" data-name)))
+			       (declare-data-no-subblocks handle data-name)))
       (c:group (c:code-section code-fn
 			       (c:line)
 			       (declare-subcodes decl-code-name code-blocks))
@@ -521,6 +509,10 @@ USA.
   ;; This must be a single line!
   (c:line (c:call "DECLARE_COMPILED_CODE" (c:string handle) ntags decl proc)))
 
+(define (declare-data-no-subblocks handle proc)
+  ;; This must be a single line!
+  (c:line (c:call "DECLARE_COMPILED_DATA_NS" (c:string handle) proc)))
+
 (define (declare-data handle decl proc)
   ;; This must be a single line!
   (c:line (c:call "DECLARE_COMPILED_DATA" (c:string handle) decl proc)))
@@ -972,13 +964,11 @@ USA.
   (c:scall "DECLARE_SUBCODE"
 	   (c:string (fake-block/tag block))
 	   (fake-block/ntags block)
-	   "NO_SUBBLOCKS"
 	   (fake-block/c-proc block)))
 
 (define (fake-block->data-decl block)
   (c:scall "DECLARE_SUBDATA"
 	   (c:string (fake-block/tag block))
-	   "NO_SUBBLOCKS"
 	   (fake-block/d-proc block)))
 
 (define (fake-block->c-code block)
diff --git a/v7/src/compiler/machines/C/cutl.scm b/v7/src/compiler/machines/C/cutl.scm
index 80c955c7f..57ffe08a6 100644
--- a/v7/src/compiler/machines/C/cutl.scm
+++ b/v7/src/compiler/machines/C/cutl.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: cutl.scm,v 1.6 2006/10/08 01:27:53 cph Exp $
+$Id: cutl.scm,v 1.7 2006/10/09 06:48:32 cph Exp $
 
 Copyright 1993,2006 Massachusetts Institute of Technology
 
@@ -201,7 +201,9 @@ USA.
 	(else (error:not-c:group group 'C:WRITE-GROUP))))
 
 (define (c:label-line? line)
-  (string-prefix? "DEFLABEL " (c:line-text line)))
+  (or (string-prefix? "DEFLABEL " (c:line-text line))
+      (string-prefix? "INVOKE_INTERFACE_TARGET_" (c:line-text line))
+      (string=? "INVOKE_PRIMITIVE_TARGET" (c:line-text line))))
 
 (define (c:comment . content)
   (string-append "/* " (c:line-items content) " */"))
@@ -277,7 +279,7 @@ USA.
   (c:line "goto " (c:var label) ";"))
 
 (define (c:label label)
-  (c:exdent (c:scall "DEFLABEL" label)))
+  (c:exdent (c:line (c:call "DEFLABEL" label))))
 
 (define (c:return expr)
   (c:line "return " (c:pexpr expr) ";"))