Clean up output a little to simplify porting to new microcode.
authorChris Hanson <org/chris-hanson/cph>
Mon, 9 Oct 2006 06:48:32 +0000 (06:48 +0000)
committerChris Hanson <org/chris-hanson/cph>
Mon, 9 Oct 2006 06:48:32 +0000 (06:48 +0000)
v7/src/compiler/machines/C/cout.scm
v7/src/compiler/machines/C/cutl.scm

index 9e74e83e653aeb83e379c72844100ab195d3d7a5..f350bc4f5d6fee039df50a4c41663424ede5df60 100644 (file)
@@ -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)
index 80c955c7fcbf77c5b1f99500b455a8b0950c120b..57ffe08a6e0a7765f18a3d20062af6fbef462e97 100644 (file)
@@ -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))))
 \f
 (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) ";"))