From: Chris Hanson 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) ";"))