3 (* Data Segment
- initialized data
segment (constants
) *)
4 structure DataSegment
: sig
5 val reset
: unit
-> unit (* reset symbol
and constant tables between code generations
*)
6 val add
: Sexpr
-> string (* register a new constant
*)
7 val emit
: unit
-> string (* emit code for all constants
*)
8 val symbols
: (string*string) list (* fetch all constant symbols
*)
10 (* new_name
- generate unique names
*)
13 "sc_undef", "sc_void", "sc_nil", "sc_false_data", "sc_true_data"]
14 val (names
:string list ref
) = ref initial_names
17 fun is_new name
= not (List.exists (fn n
=> n
=name
) (!names
)) (* allocate new distinct name
*)
18 fun add name
= names
:= name
:: !names (* add names to the table
of existing ones
*)
20 (* if the name is not
in the table
, register
and return it
,
21 otherwise
, add an increasing number to it until a distinct name is found
*)
27 let fun subname name i
=
28 let val name
' = name ^
(Int.toString i
)
29 in if is_new name
' then
33 subname
name (i
+ 1) end
37 (* list
of constants
*)
38 val consts
= ref
[] : (string*Sexpr
) list ref
;
40 (* convert the collected consts to global variables
in C
*)
42 (* table
of symbol names
and representations
;
44 - maintain a single representation for all occurences
of a symbol
45 - register symbols
in run
-time symbol table for symbol
->string and string->symbol
*)
46 val (symbols
: (string*string) list ref
) = ref
[]
48 (* return existing name for singletons
, otherwise generate a new one
;
49 the singletons are hardcoded once
and forever
, so that they are eq? comparable
*)
54 |
Bool false => "sc_false"
55 |
Bool true => "sc_true"
56 | Symbol s
=> (* symbols must be eq? comparable
*)
57 (case List.find (fn sc
=> (#
1 sc
)=s
) (!symbols
)
59 | NONE
=> let val name
= new_name ("sc_symbol")
60 in symbols
:= (s
, name
) :: (!symbols
);
63 | _
=> (* anything
else is just new constant every time
*)
65 of (Pair _
) => "sc_pair"
66 |
(Vector _
) => "sc_vector"
67 |
(String _
) => "sc_string"
68 |
(Number _
) => "sc_number"
69 |
(Char _
) => "sc_char"))
71 (* generate code for a single constant
:
74 constant definition
- a value
of SchemeObject
type *)
76 fun const_code (name
, scheme_type
, data_name
, data_variant
, data_value
) =
77 "SchemeObjectData " ^ data_name ^
" = {" ^
"." ^ data_variant ^
" = {" ^ data_value ^
"}};\n" ^
78 "SchemeObject " ^ name ^
" = {" ^ scheme_type ^
", &" ^ data_name ^
"};\n"
80 (* symbol representation is written once for every symbol
*)
82 val (written_symbols
: string list ref
) = ref
[]
84 fun emit_const (name
, value
) =
86 of Pair (a
,d
) => emit_pair (name
, a
, d
)
87 |
Vector es
=> emit_vector (name
, es
)
88 | Symbol s
=> (* the same symbol may appear several times
, but must be emitted only once
*)
89 if (List.exists (fn n
=>n
=name
) (!written_symbols
))
91 else ( written_symbols
:= name
:: (!written_symbols
)
92 ; emit_symbol (name
, s
) )
93 |
String s
=> emit_string (name
, s
)
94 | Number i
=> emit_number (name
, i
)
95 |
Char c
=> emit_char (name
, c
)
96 | _
=> "" (* singletons
*)
98 and emit_pair (name
, a
, d
) =
100 val a_name
= const_name (a
)
101 val d_name
= const_name (d
)
102 val data_name
= new_name (name ^
"_data")
103 (* recusrively define car
and cdr
*)
104 val a_code
= emit_const (a_name
, a
)
105 val d_code
= emit_const (d_name
, d
)
106 in (a_code ^ d_code ^
(const_code (name
, "SCHEME_PAIR", data_name
,
107 "spd", "&" ^ a_name ^
", &" ^ d_name
))) end
109 (* generates names
and statements for a list
of constants
.
110 returns a list
of names
and a (matching
) list
of statements
*)
111 and sexprs_to_stmts
[] names stmts
= (names
,stmts
)
112 |
sexprs_to_stmts (em
:: rest
) names stmts
=
113 let val name
= const_name
em (* generate name
*)
114 val stmt
= emit_const (name
,em
) (* generate code
*)
116 sexprs_to_stmts
rest (names @
[name
]) (stmts @
[stmt
])
119 and emit_vector (name
, es
) =
121 (* generate names
and statements for the vector elements
*)
122 val (em_names
,em_stmts
) = sexprs_to_stmts es
[] []
123 (* generate name
,statement for the array that holds the elements
*)
124 val arr_name
= new_name (name^
"_arr")
125 val arr_stmt
= "SchemeObject* "^arr_name^
"[] = {&"^
126 (String.concatWith
", &" em_names
)^
"};\n"
127 val data_name
= new_name (name^
"_data")
129 (String.concat em_stmts
)^
131 const_code (name
, "SCHEME_VECTOR", data_name
, "svd",
132 (Int.toString (List.length es
))^
", "^arr_name
)
135 and emit_symbol (name
, s
) =
136 let val data_name
= new_name (name ^
"_data")
137 val syment_name
= new_name (name ^
"_syment")
138 in ("SymbolEntry "^syment_name^
" = {\""^
(String.toCString s
)^
"\",0,NULL};\n"^
139 const_code (name
, "SCHEME_SYMBOL", data_name
, "smd",
143 and stringToCArray s
=
144 if String.size s
= 0 then
148 (String.concatWith
","
149 (List.map (Int.toString
o Char.ord
)
150 (String.explode s
)))^
153 and emit_string (name
, s
) =
155 val data_name
= new_name (name ^
"_data")
156 val arr_name
= new_name (name ^
"_arr")
157 val arr_stmt
= "char "^arr_name^
"[] = "^
(stringToCArray s
)^
";\n"
160 (const_code (name
, "SCHEME_STRING", data_name
, "ssd",
161 (Int.toString (String.size s
))^
", "^arr_name
))
164 and emit_number (name
, i
) =
165 let val data_name
= new_name (name ^
"_data")
166 in (const_code (name
, "SCHEME_INT", data_name
, "sid",
167 "(int)" ^
(if i
<0 then "-"^
(Int.toString (~i
))
168 else (Int.toString i
))))
171 and emit_char (name
, c
) =
172 let val data_name
= new_name (name ^
"_data")
173 in (const_code (name
, "SCHEME_CHAR", data_name
,
174 "scd", "(char)" ^
(Int.toString (Char.ord c
)))) end
179 ; written_symbols
:= [] )
182 let val name
= const_name x
183 in consts
:= (name
, x
) :: (!consts
) (* repeated symbols are detected
in emit_const
*)
187 "SchemeObject sc_undef = {-1, NULL};\n" ^
188 "SchemeObject sc_void = {SCHEME_VOID, NULL};\n" ^
189 "SchemeObject sc_nil = {SCHEME_NIL, NULL};\n" ^
190 "SchemeObjectData sc_false_data = {.sbd = {0}};\n" ^
191 "SchemeObject sc_false = {SCHEME_BOOL, &sc_false_data};\n" ^
192 "SchemeObjectData sc_true_data = {.sbd = {1}};\n" ^
193 "SchemeObject sc_true = {SCHEME_BOOL, &sc_true_data};\n" ^
194 String.concat (map
emit_const (List.rev (!consts
)))
196 (* freeze the symbols
*)
197 val symbols
= !symbols
199 end; (* DataSegment
*)
201 structure ErrType
= struct
204 | ArgsCount
of string * int
207 | UndefinedSymbol
of string;
209 fun toString None
= "\"\""
210 |
toString (ArgsCount (proc
,formals
)) = "MSG_ERR_ARGCOUNT(\""^
211 (String.toCString proc
)^
"\","^
212 (intToCString formals
)^
")"
213 | toString AppNonProc
= "MSG_ERR_APPNONPROC"
214 | toString NotAPair
= "MSG_ERR_NOTPAIR"
215 |
toString (UndefinedSymbol name
) = "\"Symbol "^
(String.toCString name
)^
" not defined\""
218 structure CodeSegment (* : sig
221 val reset
: unit
-> unit
;
222 val add
: StatementType
-> unit
;
223 val emit
: unit
-> string;
225 datatype StatementType
=
229 | Assertion
of string * ErrType
.Type
230 | Error
of ErrType
.Type
231 | ErrorIf
of string * ErrType
.Type
233 | BranchIf
of string * string
234 | Set
of string * string
238 | Statement
of string;
240 fun statementToString (Statement stmt
) = "\t"^stmt^
";"
241 |
statementToString (Set (n
,v
)) = "\t"^n^
" = "^v^
";"
242 |
statementToString (Branch l
) = "\tgoto "^l^
";"
243 |
statementToString (BranchIf (c
,l
)) = "\tif ("^c^
") goto "^l^
";"
244 |
statementToString (Comment s
) = "\t/* "^s^
" */"
245 |
statementToString (Debug s
) = "" (* "\tfprintf(stderr,\"DEBUG: "^
(String.toCString s
)^
"\\n\");" *)
246 |
statementToString (Label s
) = s^
":"
247 |
statementToString (Assertion (p
,e
)) = "\tASSERT_ALWAYS("^p^
","^
(ErrType
.toString e
)^
");"
248 |
statementToString (Error e
) = "\tfprintf(stderr,"^
(ErrType
.toString e
)^
"); exit(-1);"
249 |
statementToString (ErrorIf (p
,e
)) = "\tif ("^p^
") {fprintf(stderr,"^
(ErrType
.toString e
)^
"); fprintf(stderr,\"%s %d\\n\",__FILE__,__LINE__); exit(-1);}"
250 |
statementToString (Push s
) = "\tpush("^s^
");"
251 |
statementToString (Pop s
) = "\t"^s^
" = pop();"
252 | statementToString Return
= "\tRETURN();"
255 val statements
= ref
[] : StatementType list ref
;
260 fun add stmt
= statements
:= !statements @
[stmt
];
264 (String.concatWith
"\n" (List.map
statementToString (!statements
)))^
267 end; (* CodeSegment
*)
269 structure Program
: sig
270 val reset
: unit
-> unit
;
271 val gen
: Expr
-> int -> unit
;
272 val emit
: int * int -> string;
275 fun makeLabeler prefix
=
279 fn () => (number
:= !number
+ 1
280 ;prefix^
(Int.toString (!number
)))
283 val makeLabelElse
= makeLabeler
"else";
284 val makeLabelEndif
= makeLabeler
"endIf";
285 val makeLabelEndOr
= makeLabeler
"endOr";
286 val makeLabelSkipBody
= makeLabeler
"skipBody";
287 val makeLabelBody
= makeLabeler
"body";
288 val makeLabelRet
= makeLabeler
"ret";
289 val makeLabelApp
= makeLabeler
"app";
291 val CSadd
= CodeSegment
.add
;
294 (CSadd (CodeSegment
.Comment
"<push an initial activation frame>")
295 ;CSadd (CodeSegment
.Comment
"no arguments")
296 ;CSadd (CodeSegment
.Push
"0")
297 ;CSadd (CodeSegment
.Comment
"no enviroment")
298 ;CSadd (CodeSegment
.Push
"(int)NULL")
299 ;CSadd (CodeSegment
.Comment
"no return address (yet. will be set later)")
300 ;CSadd (CodeSegment
.Push
"(int)NULL")
301 ;CSadd (CodeSegment
.Push
"fp")
302 ;CSadd (CodeSegment
.Set ("fp","sp"))
303 ;CSadd (CodeSegment
.Comment
"</push an initial activation frame>")
307 (CSadd (CodeSegment
.Comment
"<pop the initial activation frame>")
308 ;CSadd (CodeSegment
.Pop
"fp")
309 ;CSadd (CodeSegment
.Comment
"</pop the initial activation frame>")
313 (DataSegment
.reset ()
314 ;CodeSegment
.reset ()
318 fun maprtl f l
= map
f (List.rev l
);
320 fun genDebug (App (VarFree name
,_
)) = CSadd (CodeSegment
.Debug ("Applying free-var "^name
))
321 |
genDebug (AppTP (VarFree name
,_
)) = CSadd (CodeSegment
.Debug ("Applying free-var "^name
))
322 |
genDebug (App (VarParam (name
,_
),_
)) = CSadd (CodeSegment
.Debug ("Applying param "^name
))
323 |
genDebug (AppTP (VarParam (name
,_
),_
)) = CSadd (CodeSegment
.Debug ("Applying param "^name
))
324 |
genDebug (App (VarBound (name
,_
,_
),_
)) = CSadd (CodeSegment
.Debug ("Applying bound-var "^name
))
325 |
genDebug (AppTP (VarBound (name
,_
,_
),_
)) = CSadd (CodeSegment
.Debug ("Applying bound-var "^name
))
329 (* Generate code for a given expression
330 THE INVARIANT
: r_res contains the value
of the
331 expression after execution
333 fun genExpr (Const se
) absDepth
=
335 val lblConst
= DataSegment
.add se
337 CSadd (CodeSegment
.Set ("r_res","(int)&"^lblConst
))
339 |
genExpr (Var _
) absDepth
= raise Match (* shouldn
't be here
*)
340 |
genExpr (VarFree name
) absDepth
=
342 val lblElse
= makeLabelElse ()
343 val lblEndif
= makeLabelEndif ()
344 in (* probe for symbol
in runtime data
-structure *)
345 (CSadd (CodeSegment
.Set ("r_res","(int)probeSymbolDefined(\""^name^
"\",topLevel)"))
346 ;CSadd (CodeSegment
.BranchIf ("r_res==0",lblElse
))
347 ;CSadd (CodeSegment
.BranchIf ("! ((SymbolEntry*)r_res)->isDefined",lblElse
))
348 ;CSadd (CodeSegment
.Set ("r_res","(int)((SymbolEntry*)r_res)->sob"))
349 ;CSadd (CodeSegment
.Branch lblEndif
)
350 ;CSadd (CodeSegment
.Label lblElse
)
351 ;CSadd (CodeSegment
.Error (ErrType
.UndefinedSymbol name
))
352 ;CSadd (CodeSegment
.Label lblEndif
)
355 |
genExpr (VarParam (name
,ndx
)) absDepth
=
356 (CSadd (CodeSegment
.Assertion ("("^
(intToCString ndx
)^
">=0) & ("^
(intToCString ndx
)^
"<ST_ARG_COUNT())",ErrType
.None
))
357 ;CSadd (CodeSegment
.Set ("r_res",("ST_ARG("^
(intToCString ndx
)^
")")))
359 |
genExpr (VarBound (name
,major
,minor
)) absDepth
=
360 CSadd (CodeSegment
.Set ("r_res",("((int**)ST_ENV())["^
(intToCString major
)^
"]["^
(intToCString minor
)^
"]")))
361 |
genExpr (If (test
,dit
,dif
)) absDepth
=
363 val lblElse
= makeLabelElse ()
364 val lblEndif
= makeLabelEndif ()
365 val lblFalse
= DataSegment
.add (Bool false)
367 (genExpr test absDepth
368 ;CSadd (CodeSegment
.BranchIf ("(SchemeObject*)r_res==&"^lblFalse
,lblElse
))
369 ;genExpr dit absDepth
370 ;CSadd (CodeSegment
.Branch lblEndif
)
371 ;CSadd (CodeSegment
.Label lblElse
)
372 ;genExpr dif absDepth
373 ;CSadd (CodeSegment
.Label lblEndif
)
376 |
genExpr (abs
as Abs _
) absDepth
= genAbs abs absDepth
377 |
genExpr (abs
as AbsOpt _
) absDepth
= genAbs abs absDepth
378 |
genExpr (abs
as AbsVar _
) absDepth
= genAbs abs absDepth
379 |
genExpr (App (proc
,args
)) absDepth
=
380 (genDebug (App (proc
,args
));
382 val lblRet
= makeLabelRet ()
383 val lblApp
= makeLabelApp ()
385 (* for each arg
in args (backwards
) do:
387 push r_res to stack
*)
388 ((maprtl (fn arg
=> (genExpr arg absDepth
;
389 CSadd (CodeSegment
.Push
"r_res")))
391 (* push
length(args
) to stack
*)
392 ;CSadd (CodeSegment
.Push (intToCString (List.length args
)))
394 ;genExpr proc absDepth
395 (* if r_res is not a closure
then: error
*)
396 ;CSadd (CodeSegment
.BranchIf ("IS_SOB_CLOSURE(r_res)",lblApp
))
397 ;CSadd (CodeSegment
.Error ErrType
.AppNonProc
)
398 ;CSadd (CodeSegment
.Label lblApp
)
399 (* push proc
.env to stack
*)
400 ;CSadd (CodeSegment
.Push
"(int)SOB_CLOSURE_ENV(r_res)")
401 (* push return address
*)
402 ;CSadd (CodeSegment
.Push ("(int)&&"^lblRet
))
404 ;CSadd (CodeSegment
.Branch
"*(SOB_CLOSURE_CODE(r_res))")
406 ;CSadd (CodeSegment
.Label lblRet
)
407 (* restore sp
- discard
:
408 - enviroment
pointer (at sp
-1)
409 - n
, the number
of arguments (at sp
-2)
411 ;CSadd (CodeSegment
.Set ("sp","sp-2-stack[sp-2]"))
415 |
genExpr (AppTP (proc
,args
)) absDepth
=
416 (genDebug (AppTP (proc
,args
));
417 (* for each arg
in args (backwards
) do:
419 push r_res to stack
*)
420 ((maprtl (fn arg
=> (genExpr arg absDepth
;
421 CSadd (CodeSegment
.Push
"r_res")))
423 (* push
length(args
) to stack
*)
424 ;CSadd (CodeSegment
.Push (intToCString (List.length args
)))
426 ;genExpr proc absDepth
427 (* if r_res is not a closure
then: error
*)
428 ;CSadd (CodeSegment
.ErrorIf ("! IS_SOB_CLOSURE(r_res)",ErrType
.AppNonProc
))
429 (* push proc
.env to stack
*)
430 ;CSadd (CodeSegment
.Push
"(int)SOB_CLOSURE_ENV(r_res)")
431 (* push return
address (of current activation frame
) *)
432 ;CSadd (CodeSegment
.Push
"ST_RET()")
433 (* override current activation frame
*)
434 ;CSadd (CodeSegment
.Statement ("shiftActFrmDown()"))
436 ;CSadd (CodeSegment
.Branch
"*(SOB_CLOSURE_CODE(r_res))")
437 (* restore sp
- discard
:
438 - enviroment
pointer (at sp
-1)
439 - n
, the number
of arguments (at sp
-2)
441 ;CSadd (CodeSegment
.Set ("sp","sp-2-stack[sp-2]")) (* todo
: remove? its a tail call
- we would never get back here
*)
444 |
genExpr (Seq
[]) absDepth
= ()
445 |
genExpr (Seq (e
:: rest
)) absDepth
= (genExpr e absDepth
; genExpr (Seq rest
) absDepth
)
446 |
genExpr (Or preds
) absDepth
=
448 val lblEndOr
= makeLabelEndOr ()
450 (genOrPreds lblEndOr preds absDepth
451 ;CSadd (CodeSegment
.Label lblEndOr
)
454 |
genExpr (Set ((VarFree name
),value
)) absDepth
=
455 (* Set on VarFree is just the same
as Def on VarFree
*)
456 genExpr (Def ((VarFree name
),value
)) absDepth
457 |
genExpr (Set ((VarParam (name
,ndx
)),value
)) absDepth
=
458 let val lblVoid
= DataSegment
.add Void
460 (genExpr value absDepth
461 ;CSadd (CodeSegment
.Assertion ("("^
(intToCString ndx
)^
">=0) & ("^
(intToCString ndx
)^
"<ST_ARG_COUNT())",ErrType
.None
))
462 ;CSadd (CodeSegment
.Set (("ST_ARG("^
(intToCString ndx
)^
")"),"r_res"))
463 ;CSadd (CodeSegment
.Set ("r_res","(int)&"^lblVoid
))
466 |
genExpr (Set ((VarBound (name
,major
,minor
)),value
)) absDepth
=
467 let val lblVoid
= DataSegment
.add Void
469 (genExpr value absDepth
470 ;CSadd (CodeSegment
.Set (("((int**)ST_ENV())["^
(intToCString major
)^
"]["^
(intToCString minor
)^
"]"),"r_res"))
471 ;CSadd (CodeSegment
.Set ("r_res","(int)&"^lblVoid
))
474 |
genExpr (Def ((VarFree name
),value
)) absDepth
=
475 let val lblVoid
= DataSegment
.add Void
477 (CSadd (CodeSegment
.Debug ("binding symbol: "^name
))
478 ;genExpr value absDepth
479 ;CSadd (CodeSegment
.Set ("r[0]","(int)getSymbol(\""^name^
"\",topLevel)"))
480 ;CSadd (CodeSegment
.Set ("((SymbolEntry*)r[0])->isDefined","1"))
481 ;CSadd (CodeSegment
.Set ("((SymbolEntry*)r[0])->sob","(SchemeObject*)r_res"))
482 ;CSadd (CodeSegment
.Set ("r_res","(int)&"^lblVoid
))
485 |
genExpr (Def (_
,_
)) absDepth
= raise Match (* shouldn
't be here
*)
486 and genOrPreds _
[] absDepth
= ()
487 | genOrPreds
lblEndOr (p
:: rest
) absDepth
=
489 val lblFalse
= DataSegment
.add (Bool false)
492 ;CSadd (CodeSegment
.BranchIf ("(SchemeObject*)r_res!=&"^lblFalse
,lblEndOr
))
493 ;genOrPreds lblEndOr rest absDepth
496 and genAbs abs absDepth
=
498 val formalParams
= case abs
of
499 Abs (params
,_
) => List.length params
500 |
AbsOpt (params
,_
,_
) => List.length params
+ 1
502 | _
=> raise Match (* shouldn
't be here
*)
503 val body
= case abs
of
505 |
AbsOpt (_
,_
,body
) => body
506 |
AbsVar (_
,body
) => body
507 | _
=> raise Match (* shouldn
't be here
*)
508 val lblSkipBody
= makeLabelSkipBody ()
509 val lblBody
= makeLabelBody ()
511 (* 1. extend enviroment
*)
512 (CSadd (CodeSegment
.Set ("r[0]","(int)extendEnviroment( (int**)"^
513 (if absDepth
=0 then "NULL"
516 (intToCString absDepth
)^
518 (* 2. prepare code
*)
519 ;CSadd (CodeSegment
.Branch lblSkipBody
)
520 ;CSadd (CodeSegment
.Label lblBody
)
522 ;CSadd (CodeSegment
.Push
"fp")
523 ;CSadd (CodeSegment
.Set ("fp","sp"))
524 (* fix stack
if needed
*)
527 |
(AbsOpt _
) => CSadd (CodeSegment
.Statement ("prepareStackForAbsOpt("^
(intToCString formalParams
)^
")"))
528 |
(AbsVar _
) => CSadd (CodeSegment
.Statement ("prepareStackForAbsOpt("^
(intToCString formalParams
)^
")"))
529 | _
=> raise Match (* shouldn
't be here
*)
530 (* verify number
of actual arguments
*)
531 ;CSadd (CodeSegment
.ErrorIf ("ST_ARG_COUNT()!="^
(intToCString formalParams
),
532 (ErrType
.ArgsCount ("user-procedure",formalParams
))))
534 ;genExpr
body (absDepth
+1)
536 ;CSadd (CodeSegment
.Pop ("fp"))
537 ;CSadd CodeSegment
.Return
538 ;CSadd (CodeSegment
.Label lblSkipBody
)
539 (* 3. create closure
*)
540 ;CSadd (CodeSegment
.Set ("r_res","(int)makeSchemeClosure((void*)r[0],&&"^lblBody^
")"))
545 fun gen expr absDepth
=
547 val lblRet
= makeLabelRet ()
549 (* Set return address
- the initial frame contains a dummy
550 return address
. Here we set it to instruction after `expr`
.
551 In
case of several expressions compiled one after the other
,
552 we could pop the initial activation
frame (it was pushed
in
553 addProlog
) and push a new one
. But since the only thing that
554 changes is the return address
, we just hack it
.
556 (CSadd (CodeSegment
.Comment
"set return address")
557 ;CSadd (CodeSegment
.Set ("ST_RET()","(int)&&"^lblRet
))
558 (* Compile the expression
*)
559 ;genExpr expr absDepth
560 (* Don
't forget the return address
.. *)
561 ;CSadd (CodeSegment
.Label lblRet
)
566 fun emit (nregs
,stacksize
) =
568 "/* COMP091 Scheme->C Compiler Generated Code */\n\n" ^
569 "#include \"scheme.h\"\n" ^
570 "#include \"assertions.h\"\n" ^
571 "#include \"arch.h\"\n" ^
572 "#include \"rtemgr.h\"\n" ^
573 "#include \"strings.h\"\n" ^
574 "extern SymbolNode *topLevel;\n"^
575 "\n/* Data Segment */\n" ^
576 (DataSegment
.emit ()) ^
577 "\n/* Code Segment */\n" ^
578 "void schemeCompiledFunction() {\n" ^
579 "\t#include \"builtins.c\"\n\n"^
580 "\tinitArchitecture("^
Int.toString(stacksize
)^
","^
Int.toString(nregs
)^
");\n" ^
582 (CodeSegment
.emit ()) ^