3 val namesPrefix
= ""; (* Prefix all generated names
with this
string *)
5 (* Data Segment
- initialized data
segment (constants
) *)
6 structure DataSegment
: sig
7 val reset
: unit
-> unit (* reset symbol
and constant tables between code generations
*)
8 val add
: Sexpr
-> string (* register a new constant
*)
9 val emitDeclerations
: unit
-> string (* emit code for all constants
*)
10 (*val symbols
: (string*string) list
ref (* fetch all constant symbols
*) *)
11 val emitInitializers
: unit
-> string;
13 (* new_name
- generate unique names
*)
16 "sc_undef", "sc_void", "sc_nil", "sc_false_data", "sc_true_data"]
17 val (names
:string list ref
) = ref initial_names
20 fun is_new name
= not (List.exists (fn n
=> n
=name
) (!names
)) (* allocate new distinct name
*)
21 fun add name
= names
:= name
:: !names (* add names to the table
of existing ones
*)
23 (* if the name is not
in the table
, register
and return it
,
24 otherwise
, add an increasing number to it until a distinct name is found
*)
26 let val name
= namesPrefix^name
32 let fun subname name i
=
33 let val name
' = name ^
(Int.toString i
)
34 in if is_new name
' then
38 subname
name (i
+ 1) end
43 (* list
of constants
*)
44 val consts
= ref
[] : (string*Sexpr
) list ref
;
46 (* convert the collected consts to global variables
in C
*)
48 (* table
of symbol names
and representations
;
50 - maintain a single representation for all occurences
of a symbol
51 - register symbols
in run
-time symbol table for symbol
->string and string->symbol
*)
52 val (symbols
: (string*string) list ref
) = ref
[]
54 (* return existing name for singletons
, otherwise generate a new one
;
55 the singletons are hardcoded once
and forever
, so that they are eq? comparable
*)
60 |
Bool false => "sc_false"
61 |
Bool true => "sc_true"
62 | Symbol s
=> (* symbols must be eq? comparable
*)
63 (case List.find (fn sc
=> (#
1 sc
)=s
) (!symbols
)
65 | NONE
=> let val name
= new_name ("sc_symbol")
66 in symbols
:= (s
, name
) :: (!symbols
);
69 | _
=> (* anything
else is just new constant every time
*)
71 of (Pair _
) => "sc_pair"
72 |
(Vector _
) => "sc_vector"
73 |
(String _
) => "sc_string"
74 |
(Number _
) => "sc_number"
75 |
(Char _
) => "sc_char"
76 | _
=> raise Match (* just to silence the compiler
*)))
78 (* generate code for a single constant
:
81 constant definition
- a value
of SchemeObject
type *)
83 fun const_code (name
, scheme_type
, data_name
, data_variant
, data_value
) =
84 "SchemeObjectData " ^ data_name ^
" = {" ^
"." ^ data_variant ^
" = {" ^ data_value ^
"}};\n" ^
85 "SchemeObject " ^ name ^
" = {" ^ scheme_type ^
", &" ^ data_name ^
"};\n"
87 (* symbol representation is written once for every symbol
*)
89 val (written_symbols
: string list ref
) = ref
[]
91 fun emit_const (name
, value
) =
93 of Pair (a
,d
) => emit_pair (name
, a
, d
)
94 |
Vector es
=> emit_vector (name
, es
)
95 | Symbol s
=> (* the same symbol may appear several times
, but must be emitted only once
*)
96 if (List.exists (fn n
=>n
=name
) (!written_symbols
))
98 else ( written_symbols
:= name
:: (!written_symbols
)
99 ; emit_symbol (name
, s
) )
100 |
String s
=> emit_string (name
, s
)
101 | Number i
=> emit_number (name
, i
)
102 |
Char c
=> emit_char (name
, c
)
103 | _
=> "" (* singletons
*)
105 and emit_pair (name
, a
, d
) =
107 val a_name
= const_name (a
)
108 val d_name
= const_name (d
)
109 val data_name
= new_name (name ^
"_data")
110 (* recusrively define car
and cdr
*)
111 val a_code
= emit_const (a_name
, a
)
112 val d_code
= emit_const (d_name
, d
)
113 in (a_code ^ d_code ^
(const_code (name
, "SCHEME_PAIR", data_name
,
114 "spd", "&" ^ a_name ^
", &" ^ d_name
))) end
116 (* generates names
and statements for a list
of constants
.
117 returns a list
of names
and a (matching
) list
of statements
*)
118 and sexprs_to_stmts
[] names stmts
= (names
,stmts
)
119 |
sexprs_to_stmts (em
:: rest
) names stmts
=
120 let val name
= const_name
em (* generate name
*)
121 val stmt
= emit_const (name
,em
) (* generate code
*)
123 sexprs_to_stmts
rest (names @
[name
]) (stmts @
[stmt
])
126 and emit_vector (name
, es
) =
128 (* generate names
and statements for the vector elements
*)
129 val (em_names
,em_stmts
) = sexprs_to_stmts es
[] []
130 (* generate name
,statement for the array that holds the elements
*)
131 val arr_name
= new_name (name^
"_arr")
132 val arr_stmt
= "SchemeObject* "^arr_name^
"[] = "^
133 (if (List.length em_names
)=0
135 else "{&"^
(String.concatWith
", &" em_names
)^
"}")^
137 val data_name
= new_name (name^
"_data")
139 (String.concat em_stmts
)^
141 const_code (name
, "SCHEME_VECTOR", data_name
, "svd",
142 (Int.toString (List.length es
))^
", "^arr_name
)
146 and emit_symbol (name
, s
) =
147 let val data_name
= new_name (name ^
"_data")
148 val syment_name
= new_name (name ^
"_syment")
149 in ("SymbolEntry "^syment_name^
" = {\""^
(String.toCString s
)^
"\",0,NULL};\n"^
150 const_code (name
, "SCHEME_SYMBOL", data_name
, "smd",
154 and emit_symbol (name
, s
) =
155 let val data_name
= new_name (name ^
"_data")
156 val syment_name
= new_name (name ^
"_syment")
158 const_code (name
, "SCHEME_SYMBOL", data_name
, "smd","NULL /* initialized later */")
161 and stringToCArray s
=
162 if String.size s
= 0 then
166 (String.concatWith
","
167 (List.map (Int.toString
o Char.ord
)
168 (String.explode s
)))^
171 and emit_string (name
, s
) =
173 val data_name
= new_name (name ^
"_data")
174 val arr_name
= new_name (name ^
"_arr")
175 val arr_stmt
= "char "^arr_name^
"[] = "^
(stringToCArray s
)^
";\n"
178 (const_code (name
, "SCHEME_STRING", data_name
, "ssd",
179 (Int.toString (String.size s
))^
", "^arr_name
))
182 and emit_number (name
, i
) =
183 let val data_name
= new_name (name ^
"_data")
184 in (const_code (name
, "SCHEME_INT", data_name
, "sid",
185 "(int)" ^
(if i
<0 then "-"^
(Int.toString (~i
))
186 else (Int.toString i
))))
189 and emit_char (name
, c
) =
190 let val data_name
= new_name (name ^
"_data")
191 in (const_code (name
, "SCHEME_CHAR", data_name
,
192 "scd", "(char)" ^
(Int.toString (Char.ord c
)))) end
197 ; written_symbols
:= [] )
200 let val name
= const_name x
201 in consts
:= (name
, x
) :: (!consts
) (* repeated symbols are detected
in emit_const
*)
204 (* Adds statements for initializing the constants
*)
205 fun emitInitializers () =
208 (map (fn (s
,name
)=>"\tSOB_SYMBOL_ENTRY(&"^name^
") = getSymbol(\""^
(String.toCString s
)^
"\",topLevel);")
211 fun emitDeclerations () =
212 "SchemeObject sc_undef = {-1, NULL};\n" ^
213 "SchemeObject sc_void = {SCHEME_VOID, NULL};\n" ^
214 "SchemeObject sc_nil = {SCHEME_NIL, NULL};\n" ^
215 "SchemeObjectData sc_false_data = {.sbd = {0}};\n" ^
216 "SchemeObject sc_false = {SCHEME_BOOL, &sc_false_data};\n" ^
217 "SchemeObjectData sc_true_data = {.sbd = {1}};\n" ^
218 "SchemeObject sc_true = {SCHEME_BOOL, &sc_true_data};\n" ^
219 String.concat (map
emit_const (List.rev (!consts
)))
221 (* freeze the symbols
*)
222 (* val symbols
= !symbols
*)
224 end; (* DataSegment
*)
226 structure ErrType
= struct
229 | ArgsCount
of string * int
232 | UndefinedSymbol
of string;
234 fun toString None
= "\"\""
235 |
toString (ArgsCount (proc
,formals
)) = "MSG_ERR_ARGCOUNT(\""^
236 (String.toCString proc
)^
"\","^
237 (intToCString formals
)^
")"
238 | toString AppNonProc
= "MSG_ERR_APPNONPROC"
239 | toString NotAPair
= "MSG_ERR_NOTPAIR"
240 |
toString (UndefinedSymbol name
) = "\"Symbol "^
(String.toCString name
)^
" not defined\""
243 structure CodeSegment (* : sig
246 val reset
: unit
-> unit
;
247 val add
: StatementType
-> unit
;
248 val emit
: unit
-> string;
250 datatype StatementType
=
254 | Assertion
of string * ErrType
.Type
255 | Error
of ErrType
.Type
256 | ErrorIf
of string * ErrType
.Type
258 | BranchIf
of string * string
259 | Set
of string * string
263 | Statement
of string;
265 fun statementToString (Statement stmt
) = "\t"^stmt^
";"
266 |
statementToString (Set (n
,v
)) = "\t"^n^
" = "^v^
";"
267 |
statementToString (Branch l
) = "\tgoto "^l^
";"
268 |
statementToString (BranchIf (c
,l
)) = "\tif ("^c^
") goto "^l^
";"
269 |
statementToString (Comment s
) = "\t/* "^s^
" */"
270 |
statementToString (Debug s
) = "" (* "\tfprintf(stderr,\"DEBUG: "^
(String.toCString s
)^
"\\n\");" *)
271 |
statementToString (Label s
) = s^
":"
272 |
statementToString (Assertion (p
,e
)) = "\tASSERT_ALWAYS("^p^
","^
(ErrType
.toString e
)^
");"
273 |
statementToString (Error e
) = "\tfprintf(stderr,"^
(ErrType
.toString e
)^
"); exit(-1);"
274 |
statementToString (ErrorIf (p
,e
)) = "\tif ("^p^
") {fprintf(stderr,"^
(ErrType
.toString e
)^
"); fprintf(stderr,\"%s %d\\n\",__FILE__,__LINE__); exit(-1);}"
275 |
statementToString (Push s
) = "\tpush("^s^
");"
276 |
statementToString (Pop s
) = "\t"^s^
" = pop();"
277 | statementToString Return
= "\tRETURN();"
280 val statements
= ref
[] : StatementType list ref
;
285 fun add stmt
= statements
:= !statements @
[stmt
];
289 (String.concatWith
"\n" (List.map
statementToString (!statements
)))^
292 end; (* CodeSegment
*)
294 structure Program
: sig
295 val reset
: unit
-> unit
;
296 val gen
: Expr
-> int -> unit
;
297 val emit
: int * int -> string;
300 fun makeLabeler prefix
=
304 fn () => (number
:= !number
+ 1
305 ;namesPrefix^prefix^
(Int.toString (!number
)))
308 val makeLabelElse
= makeLabeler
"else";
309 val makeLabelEndif
= makeLabeler
"endIf";
310 val makeLabelEndOr
= makeLabeler
"endOr";
311 val makeLabelSkipBody
= makeLabeler
"skipBody";
312 val makeLabelBody
= makeLabeler
"body";
313 val makeLabelRet
= makeLabeler
"ret";
314 val makeLabelApp
= makeLabeler
"app";
316 val CSadd
= CodeSegment
.add
;
319 (DataSegment
.reset ()
320 ;CodeSegment
.reset ()
323 fun maprtl f l
= map
f (List.rev l
);
325 fun genDebug (App (VarFree name
,_
)) = CSadd (CodeSegment
.Debug ("Applying free-var "^name
))
326 |
genDebug (AppTP (VarFree name
,_
)) = CSadd (CodeSegment
.Debug ("Applying free-var "^name
))
327 |
genDebug (App (VarParam (name
,_
),_
)) = CSadd (CodeSegment
.Debug ("Applying param "^name
))
328 |
genDebug (AppTP (VarParam (name
,_
),_
)) = CSadd (CodeSegment
.Debug ("Applying param "^name
))
329 |
genDebug (App (VarBound (name
,_
,_
),_
)) = CSadd (CodeSegment
.Debug ("Applying bound-var "^name
))
330 |
genDebug (AppTP (VarBound (name
,_
,_
),_
)) = CSadd (CodeSegment
.Debug ("Applying bound-var "^name
))
334 (* Generate code for a given expression
335 THE INVARIANT
: r_res contains the value
of the
336 expression after execution
338 fun genExpr (Const se
) absDepth
=
340 val lblConst
= DataSegment
.add se
342 CSadd (CodeSegment
.Set ("r_res","(int)&"^lblConst
))
344 |
genExpr (Var _
) absDepth
= raise Match (* shouldn
't be here
*)
345 |
genExpr (VarFree name
) absDepth
=
347 val lblElse
= makeLabelElse ()
348 val lblEndif
= makeLabelEndif ()
349 in (* probe for symbol
in runtime data
-structure *)
350 (CSadd (CodeSegment
.Set ("r_res","(int)probeSymbolDefined(\""^name^
"\",topLevel)"))
351 ;CSadd (CodeSegment
.BranchIf ("r_res==0",lblElse
))
352 ;CSadd (CodeSegment
.BranchIf ("! ((SymbolEntry*)r_res)->isDefined",lblElse
))
353 ;CSadd (CodeSegment
.Set ("r_res","(int)((SymbolEntry*)r_res)->sob"))
354 ;CSadd (CodeSegment
.Branch lblEndif
)
355 ;CSadd (CodeSegment
.Label lblElse
)
356 ;CSadd (CodeSegment
.Error (ErrType
.UndefinedSymbol name
))
357 ;CSadd (CodeSegment
.Label lblEndif
)
360 |
genExpr (VarParam (name
,ndx
)) absDepth
=
361 (CSadd (CodeSegment
.Assertion ("("^
(intToCString ndx
)^
">=0) & ("^
(intToCString ndx
)^
"<ST_ARG_COUNT())",ErrType
.None
))
362 ;CSadd (CodeSegment
.Set ("r_res",("ST_ARG("^
(intToCString ndx
)^
")")))
364 |
genExpr (VarBound (name
,major
,minor
)) absDepth
=
365 CSadd (CodeSegment
.Set ("r_res",("((int**)ST_ENV())["^
(intToCString major
)^
"]["^
(intToCString minor
)^
"]")))
366 |
genExpr (If (test
,dit
,dif
)) absDepth
=
368 val lblElse
= makeLabelElse ()
369 val lblEndif
= makeLabelEndif ()
370 val lblFalse
= DataSegment
.add (Bool false)
372 (genExpr test absDepth
373 ;CSadd (CodeSegment
.BranchIf ("(SchemeObject*)r_res==&"^lblFalse
,lblElse
))
374 ;genExpr dit absDepth
375 ;CSadd (CodeSegment
.Branch lblEndif
)
376 ;CSadd (CodeSegment
.Label lblElse
)
377 ;genExpr dif absDepth
378 ;CSadd (CodeSegment
.Label lblEndif
)
381 |
genExpr (abs
as Abs _
) absDepth
= genAbs abs absDepth
382 |
genExpr (abs
as AbsOpt _
) absDepth
= genAbs abs absDepth
383 |
genExpr (abs
as AbsVar _
) absDepth
= genAbs abs absDepth
384 |
genExpr (App (proc
,args
)) absDepth
=
385 (genDebug (App (proc
,args
));
387 val lblRet
= makeLabelRet ()
388 val lblApp
= makeLabelApp ()
390 (* for each arg
in args (backwards
) do:
392 push r_res to stack
*)
393 ((maprtl (fn arg
=> (genExpr arg absDepth
;
394 CSadd (CodeSegment
.Push
"r_res")))
396 (* push
length(args
) to stack
*)
397 ;CSadd (CodeSegment
.Push (intToCString (List.length args
)))
399 ;genExpr proc absDepth
400 (* if r_res is not a closure
then: error
*)
401 ;CSadd (CodeSegment
.BranchIf ("IS_SOB_CLOSURE(r_res)",lblApp
))
402 ;CSadd (CodeSegment
.Error ErrType
.AppNonProc
)
403 ;CSadd (CodeSegment
.Label lblApp
)
404 (* push proc
.env to stack
*)
405 ;CSadd (CodeSegment
.Push
"(int)SOB_CLOSURE_ENV(r_res)")
406 (* push return address
*)
407 ;CSadd (CodeSegment
.Push ("(int)&&"^lblRet
))
409 ;CSadd (CodeSegment
.Branch
"*(SOB_CLOSURE_CODE(r_res))")
411 ;CSadd (CodeSegment
.Label lblRet
)
412 (* restore sp
- discard
:
413 - enviroment
pointer (at sp
-1)
414 - n
, the number
of arguments (at sp
-2)
416 ;CSadd (CodeSegment
.Set ("sp","sp-2-stack[sp-2]"))
420 |
genExpr (AppTP (proc
,args
)) absDepth
=
421 (genDebug (AppTP (proc
,args
));
422 (* for each arg
in args (backwards
) do:
424 push r_res to stack
*)
425 ((maprtl (fn arg
=> (genExpr arg absDepth
;
426 CSadd (CodeSegment
.Push
"r_res")))
428 (* push
length(args
) to stack
*)
429 ;CSadd (CodeSegment
.Push (intToCString (List.length args
)))
431 ;genExpr proc absDepth
432 (* if r_res is not a closure
then: error
*)
433 ;CSadd (CodeSegment
.ErrorIf ("! IS_SOB_CLOSURE(r_res)",ErrType
.AppNonProc
))
434 (* push proc
.env to stack
*)
435 ;CSadd (CodeSegment
.Push
"(int)SOB_CLOSURE_ENV(r_res)")
436 (* push return
address (of current activation frame
) *)
437 ;CSadd (CodeSegment
.Push
"ST_RET()")
438 (* override current activation frame
*)
439 ;CSadd (CodeSegment
.Statement ("shiftActFrmDown()"))
441 ;CSadd (CodeSegment
.Branch
"*(SOB_CLOSURE_CODE(r_res))")
442 (* restore sp
- discard
:
443 - enviroment
pointer (at sp
-1)
444 - n
, the number
of arguments (at sp
-2)
446 ;CSadd (CodeSegment
.Set ("sp","sp-2-stack[sp-2]")) (* todo
: remove? its a tail call
- we would never get back here
*)
449 |
genExpr (Seq
[]) absDepth
= ()
450 |
genExpr (Seq (e
:: rest
)) absDepth
= (genExpr e absDepth
; genExpr (Seq rest
) absDepth
)
451 |
genExpr (Or preds
) absDepth
=
453 val lblEndOr
= makeLabelEndOr ()
455 (genOrPreds lblEndOr preds absDepth
456 ;CSadd (CodeSegment
.Label lblEndOr
)
459 |
genExpr (Set ((VarFree name
),value
)) absDepth
=
460 (* Set on VarFree is just the same
as Def on VarFree
*)
461 genExpr (Def ((VarFree name
),value
)) absDepth
462 |
genExpr (Set ((VarParam (name
,ndx
)),value
)) absDepth
=
463 let val lblVoid
= DataSegment
.add Void
465 (genExpr value absDepth
466 ;CSadd (CodeSegment
.Assertion ("("^
(intToCString ndx
)^
">=0) & ("^
(intToCString ndx
)^
"<ST_ARG_COUNT())",ErrType
.None
))
467 ;CSadd (CodeSegment
.Set (("ST_ARG("^
(intToCString ndx
)^
")"),"r_res"))
468 ;CSadd (CodeSegment
.Set ("r_res","(int)&"^lblVoid
))
471 |
genExpr (Set ((VarBound (name
,major
,minor
)),value
)) absDepth
=
472 let val lblVoid
= DataSegment
.add Void
474 (genExpr value absDepth
475 ;CSadd (CodeSegment
.Set (("((int**)ST_ENV())["^
(intToCString major
)^
"]["^
(intToCString minor
)^
"]"),"r_res"))
476 ;CSadd (CodeSegment
.Set ("r_res","(int)&"^lblVoid
))
479 |
genExpr (Def ((VarFree name
),value
)) absDepth
=
480 let val lblVoid
= DataSegment
.add Void
482 (CSadd (CodeSegment
.Debug ("binding symbol: "^name
))
483 ;genExpr value absDepth
484 ;CSadd (CodeSegment
.Set ("r[0]","(int)getSymbol(\""^name^
"\",topLevel)"))
485 ;CSadd (CodeSegment
.Set ("((SymbolEntry*)r[0])->isDefined","1"))
486 ;CSadd (CodeSegment
.Set ("((SymbolEntry*)r[0])->sob","(SchemeObject*)r_res"))
487 ;CSadd (CodeSegment
.Set ("r_res","(int)&"^lblVoid
))
490 |
genExpr (Def (_
,_
)) absDepth
= raise Match (* shouldn
't be here
*)
491 |
genExpr (Set (_
,_
)) absDepth
= raise Match (* shouldn
't be here
*)
492 and genOrPreds _
[] absDepth
= ()
493 | genOrPreds
lblEndOr (p
:: rest
) absDepth
=
495 val lblFalse
= DataSegment
.add (Bool false)
498 ;CSadd (CodeSegment
.BranchIf ("(SchemeObject*)r_res!=&"^lblFalse
,lblEndOr
))
499 ;genOrPreds lblEndOr rest absDepth
502 and genAbs abs absDepth
=
504 val formalParams
= case abs
of
505 Abs (params
,_
) => List.length params
506 |
AbsOpt (params
,_
,_
) => List.length params
+ 1
508 | _
=> raise Match (* shouldn
't be here
*)
509 val body
= case abs
of
511 |
AbsOpt (_
,_
,body
) => body
512 |
AbsVar (_
,body
) => body
513 | _
=> raise Match (* shouldn
't be here
*)
514 val lblSkipBody
= makeLabelSkipBody ()
515 val lblBody
= makeLabelBody ()
517 (* 1. extend enviroment
*)
518 (CSadd (CodeSegment
.Set ("r[0]","(int)extendEnviroment( (int**)"^
519 (if absDepth
=0 then "NULL"
522 (intToCString absDepth
)^
524 (* 2. prepare code
*)
525 ;CSadd (CodeSegment
.Branch lblSkipBody
)
526 ;CSadd (CodeSegment
.Label lblBody
)
528 ;CSadd (CodeSegment
.Push
"fp")
529 ;CSadd (CodeSegment
.Set ("fp","sp"))
530 (* fix stack
if needed
*)
533 |
(AbsOpt _
) => CSadd (CodeSegment
.Statement ("prepareStackForAbsOpt("^
(intToCString formalParams
)^
")"))
534 |
(AbsVar _
) => CSadd (CodeSegment
.Statement ("prepareStackForAbsOpt("^
(intToCString formalParams
)^
")"))
535 | _
=> raise Match (* shouldn
't be here
*)
536 (* verify number
of actual arguments
*)
537 ;CSadd (CodeSegment
.ErrorIf ("ST_ARG_COUNT()!="^
(intToCString formalParams
),
538 (ErrType
.ArgsCount ("user-procedure",formalParams
))))
540 ;genExpr
body (absDepth
+1)
542 ;CSadd (CodeSegment
.Pop ("fp"))
543 ;CSadd CodeSegment
.Return
544 ;CSadd (CodeSegment
.Label lblSkipBody
)
545 (* 3. create closure
*)
546 ;CSadd (CodeSegment
.Set ("r_res","(int)makeSchemeClosure((void*)r[0],&&"^lblBody^
")"))
551 fun gen expr absDepth
=
553 val lblRet
= makeLabelRet ()
555 (* Set return address
- the initial frame contains a dummy
556 return address
. Here we set it to instruction after `expr`
.
557 In
case of several expressions compiled one after the other
,
558 we could pop the initial activation
frame (it was pushed
in
559 addProlog
) and push a new one
. But since the only thing that
560 changes is the return address
, we just hack it
.
562 (CSadd (CodeSegment
.Comment
"set return address")
563 ;CSadd (CodeSegment
.Set ("ST_RET()","(int)&&"^lblRet
))
564 (* Compile the expression
*)
565 ;genExpr expr absDepth
566 (* Don
't forget the return address
.. *)
567 ;CSadd (CodeSegment
.Label lblRet
)
572 fun emit (nregs
,stacksize
) =
573 ("/* COMP091 Scheme->C Compiler Generated Code */\n\n" ^
574 "#include \"scheme.h\"\n" ^
575 "#include \"assertions.h\"\n" ^
576 "#include \"arch.h\"\n" ^
577 "#include \"rtemgr.h\"\n" ^
578 "#include \"strings.h\"\n" ^
579 "extern SymbolNode *topLevel;\n"^
580 "\n/* Data Segment Declerations */\n" ^
581 (DataSegment
.emitDeclerations ()) ^
582 "/* End of Data Segment Declerations */\n" ^
583 "#include \"initial.dseg\"\n"^
584 "\n/* Code Segment */\n" ^
585 "void schemeCompiledFunction() {\n" ^
586 "\t#include \"builtins.c\"\n\n"^
587 "\tinitArchitecture("^
Int.toString(stacksize
)^
","^
Int.toString(nregs
)^
");\n" ^
589 "\t/* Data Segment initialization */\n"^
590 (DataSegment
.emitInitializers ()) ^
"\n"^
591 "\t/* End of Data Segment initialization */\n"^
592 "\tPUSH_INITIAL_ACTFRM();\n"^
593 "\t#include \"initial.cseg\"\n"^
594 (CodeSegment
.emit ()) ^
596 "\tPOP_INITIAL_ACTFRM();\n"^