#| -*-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
(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))))
(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))
;; 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)))
(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)
#| -*-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
(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) " */"))
(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) ";"))