genc.c

Bug Summary

File:	src/genc.c
Warning:	line 1103, column 4 Value stored to 'tokInclFile' is never read

Annotated Source Code

Press '?' to see keyboard shortcuts

Show analyzer invocation

clang -cc1 -cc1 -triple x86_64-unknown-linux-gnu -analyze -disable-free -clear-ast-before-backend -disable-llvm-verifier -discard-value-names -main-file-name genc.c -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -mrelocation-model pic -pic-level 2 -pic-is-pie -mframe-pointer=all -fmath-errno -ffp-contract=on -fno-rounding-math -mconstructor-aliases -funwind-tables=2 -target-cpu x86-64 -tune-cpu generic -debugger-tuning=gdb -fdebug-compilation-dir=/home/kfp/aldor/aldor/aldor/src -fcoverage-compilation-dir=/home/kfp/aldor/aldor/aldor/src -resource-dir /usr/local/lib/clang/18 -D PACKAGE_NAME="aldor" -D PACKAGE_TARNAME="aldor" -D PACKAGE_VERSION="1.4.0" -D PACKAGE_STRING="aldor 1.4.0" -D PACKAGE_BUGREPORT="aldor@xinutec.org" -D PACKAGE_URL="" -D PACKAGE="aldor" -D VERSION="1.4.0" -D YYTEXT_POINTER=1 -D HAVE_STDIO_H=1 -D HAVE_STDLIB_H=1 -D HAVE_STRING_H=1 -D HAVE_INTTYPES_H=1 -D HAVE_STDINT_H=1 -D HAVE_STRINGS_H=1 -D HAVE_SYS_STAT_H=1 -D HAVE_SYS_TYPES_H=1 -D HAVE_UNISTD_H=1 -D STDC_HEADERS=1 -D HAVE_LIBREADLINE=1 -D HAVE_READLINE_READLINE_H=1 -D HAVE_READLINE_HISTORY=1 -D HAVE_READLINE_HISTORY_H=1 -D USE_GLOOP_SHELL=1 -D GENERATOR_COROUTINES=0 -D HAVE_DLFCN_H=1 -D LT_OBJDIR=".libs/" -I . -D VCSVERSION="2c53e759f1e00e345f8b172e7139debda72fda13" -internal-isystem /usr/local/lib/clang/18/include -internal-isystem /usr/local/include -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/14/../../../../x86_64-linux-gnu/include -internal-externc-isystem /usr/include/x86_64-linux-gnu -internal-externc-isystem /include -internal-externc-isystem /usr/include -O0 -Wno-empty-body -Wno-enum-compare -Wno-missing-field-initializers -Wno-unused -Wno-unused-parameter -Wno-error=format -Wno-error=type-limits -Wno-error=strict-aliasing -Wno-sign-compare -Wno-error=shift-negative-value -Wno-error=clobbered -std=c99 -ferror-limit 19 -fgnuc-version=4.2.1 -fskip-odr-check-in-gmf -analyzer-output=html -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /tmp/scan-build-2026-01-15-223856-845667-1 -x c genc.c

1	/*****************************************************************************
2	*
3	* genc.c: Foam-to-C translation.
4	*
5	* Copyright (c) 1990-2007 Aldor Software Organization Ltd (Aldor.org).
6	*
7	****************************************************************************/
8
9	#include "bigint.h"
10	#include "comsg.h"
11	#include "compcfg.h"
12	#include "csig.h"
13	#include "debug.h"
14	#include "fluid.h"
15	#include "fortran.h"
16	#include "genc.h"
17	#include "gencr.h"
18	#include "gf_util.h"
19	#include "of_killp.h"
20	#include "of_rrfmt.h"
21	#include "optfoam.h"
22	#include "store.h"
23	#include "syme.h"
24	#include "util.h"
25
26	/*
27	* The following naming conventions are used in this file:
28	* gcc -- function: Foam -> CCode
29	* gc0 -- utility function
30	* gcv -- variable associated with genC
31	*/
32
33	/*****************************************************************************
34	*
35	* :: Local C code generation structures.
36	*
37	****************************************************************************/
38
39	typedef struct {
40	int pos;
41	int argc;
42	CCode *stmt;
43	} *Cstmts;
44
45	struct CList {
46	CCode type;
47	int lsize;
48	struct Clocals *locs;
49	};
50
51	typedef struct {
52	int pos;
53	int argc;
54	struct CList *list;
55	} *Ldecls;
56
57	struct Clocals {
58	int index;
59	CCode loc;
60	struct Clocals *next;
61	};
62
63	struct Cdecls {
64	int index;
65	CCode decl;
66	struct Cdecls *next;
67	};
68
69	struct ccBVal_info {
70	FoamBValTag tag;
71	CCodeTag cfun;
72	AInt special;
73	String str; /* name of function call */
74	String macro; /* name of macro which returns a value */
75	};
76
77	struct ccListHdrFiles {
78	char *fname;
79	struct ccListHdrFiles *next;
80	};
81
82	static struct ccListHdrFiles *ccHdrFileList = 0;
83
84	typedef enum { GC_NoCall, GC_OCall, GC_CCall } GcNesting;
85	extern struct ccBVal_info ccBValInfoTable[];
86
87	extern Bool ccFortran; /* See ccomp.c */
88
89
90	#define ccBValInfo(tag)(ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]) (ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START])
91	#define ccBValCFun(tag)((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).cfun) (ccBValInfo(tag)(ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).cfun)
92	#define ccBValSpec(tag)((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).special) (ccBValInfo(tag)(ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).special)
93	#define ccBValStr(tag)((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).str) (ccBValInfo(tag)(ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).str)
94	#define ccBValMacro(tag)((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).macro) (ccBValInfo(tag)(ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).macro)
95
96	/*****************************************************************************
97	*
98	* :: Global variables used for C code generation.
99	*
100	****************************************************************************/
101
102	static Foam gcvProg; /* Prog being translated */
103	static int gcvLvl; /* Unit/Prog depth */
104	static Foam gcvGlo; /* Unit globals */
105	static Foam gcvConst; /* Unit constants */
106	static Foam gcvFluids; /* Unit Fluids */
107	static Foam gcvFmt; /* Unit formats */
108	static Foam gcvPar; /* Prog parameters */
109	static Foam gcvLoc; /* Prog locals */
110	static Foam gcvLocFluids; /* Prog fluids */
111	static AIntList gcvFluidList; /* Fluids used */
112	static Foam gcvLFmtStk; /* Prog lexical format stack */
113	static Foam gcvDefs; /* Unit definitions */
114	static FoamList gcvLexStk = 0; /* Unit/Prog lexicals stack */
115	static Bool gcvIsLeaf; /* True iff prog is a leaf proc */
116	static Bool gcvIsCoroutine; /* True iff prog is a coroutine */
117	static int gcvIdChars[CHAR_MAX127]; /* Array of special print chars */
118	static int gcvIdCharc[CHAR_MAX127]; /* Array of special print lengths */
119	static int gcvNLocs = 0; /* Number of locals */
120	static int gcvNStmts = 0; /* Number of statements */
121	static int gcvNBInts = 0; /* Counter for global big ints */
122	static int gcvNRRFmt = 0; /* Counter for global RRFmts */
123	static int gcvisInitConst = 0; /* True if prog is constant 0 */
124	static int gcvisStmtFCall = 0; /* True if stmt is a function call */
125	static GcNesting gcvCallNesting; /* Depth of nesting of foam-level calls*/
126	static CCodeList gcvNestUsed; /* Vars used in nesting */
127	static CCodeList gcvNestFree; /* Vars used in nesting */
128	static CCode gcvSpec; /* Prog name specifier */
129	static Cstmts gcvStmts; /* List of statements in a C prog */
130	static Ldecls gcvNewLocs; /* Lists of locals by type */
131	struct Clocals gcvLocals = 0; / List of locals declared in a prog */
132	static CCodeList gcvGloCC; /* List of global C variables */
133	static CCodeList gcvPreProcCC; /* List of C preprocessor statements */
134
135	/* Used in the inizialization */
136	static CCodeList gcvExportedGloInitCC;
137	static CCodeList gcvImportedGloInitCC;
138	static CCodeList gcvInitFunDeclsCC;
139	static CCodeList gcvInitFunCalls0CC;
140	static CCodeList gcvInitFunCalls1CC;
141	static CCodeList gcvInitProgCC;
142
143	static CCodeList gcvDefCC; /* List of defined C variables */
144	static CCodeList gcvBIntCC; /* List of bigints for init prog */
145	static CCodeList gcvRRFmtCC; /* List of RRFmts for init prog */
146	static char gcvFloatBuf[MAX_FLOAT_SIZE512]; /* Buffer to hold float data */
147	/static int gcvSMax = 2000;/ /* Maximum number of C statements */
148	static int gcvSMax = 0; /* Maximum number of C statements */
149	static int gcvIdLen = 30; /* Maximum length of C identifier */
150	static Bool gcvIdHash = true1; /* Are global id hash codes used */
151
152	static Table gcvRRFmtTable; /* Table of globalised RRFmts */
153
154	/* Tracking Fortran functional parameters */
155	static int gcvNFtnPar;
156	static Table gcvFtnTable;
157
158
159	/*****************************************************************************
160	*
161	* :: Functions which convert Foam code into C code.
162	*
163	****************************************************************************/
164
165	localstatic CCodeList gccUnit (Foam, String); /* Return a C code unit */
166	localstatic CCode gccDef (Foam); /* Return C code for a definition */
167	localstatic CCode gccCmd (Foam); /* Generate C code for commands */
168	localstatic CCode gccExpr (Foam); /* Generate C code for expressions */
169	localstatic CCode gccVal (Foam); /* Generate C code for values */
170	localstatic CCode gccRef (Foam); /* Generate C code for references */
171	localstatic CCode gccClos (Foam); /* Create a closure */
172	localstatic CCode gccId (Foam); /* Create an identifier */
173	localstatic CCode gccProgId (Foam); /* (see func. definition) */
174	localstatic CCode gccGetVar (Foam); /* Return a C variable */
175	localstatic CCode gccEnvParam (void); /* Declare an environment parameter */
176	localstatic CCode gccEnv0Param (void); /* Declare an environment parameter (for coroutines) */
177	localstatic CCode gccUnhandled (Foam); /* No implementation for this foam */
178	localstatic CCode gccArr (Foam); /* Return an array */
179	localstatic CCode gccArrNew (Foam); /* Create a new array */
180	localstatic CCode gccRecNew (Foam); /* Create a new record */
181	localstatic CCode gccRRecNew (Foam); /* Create a new raw record */
182	localstatic CCode gccRRFmt (Foam); /* Create raw record index fr fmt */
183	localstatic CCode gccTRNew (Foam); /* Create a new record */
184	localstatic CCode gccRec (Foam); /* Return a record */
185	localstatic CCode gccRRElt (Foam); /* Element of a raw record */
186	localstatic CCode gccRElt (Foam); /* Element of a record */
187	localstatic CCode gccIRElt (Foam); /* Element of a trailing array */
188	localstatic CCode gccTRElt (Foam); /* Element of a trailing array */
189	localstatic CCode gccAElt (Foam); /* Element of an array */
190	localstatic CCode gccReturn (Foam); /* Create a function return call */
191	localstatic CCode gccSeq (Foam); /* Return a sequence of statements */
192	localstatic CCode gccMFmt (Foam); /* Generate multi-value call */
193	localstatic CCode gccReturnValues (Foam); /* Return multiple values */
194	localstatic CCode gccValues (Foam); /* Generate multiple values */
195	localstatic CCode gccIf (Foam); /* Generate an if statement */
196	localstatic CCode gccGenIter (Foam); /* Generate a new iterator */
197	localstatic CCode gccGenerStep (Foam); /* Generate a step */
198	localstatic CCode gccGenerValue (Foam); /* Generate a value from an iterator */
199	localstatic CCode gccEnv (Foam); /* Generate an Env reference */
200	localstatic CCode gccSelect (Foam); /* Generate a switch statement */
201	localstatic CCode gccBInt (Foam); /* Generate a big integer */
202	localstatic CCode gccPushEnv (Foam); /* Push environment onto the stack */
203	localstatic CCode gccEEnv (Foam); /* Return an outer environment */
204	localstatic CCode gccEInfo (Foam); /* Information slot of an environment */
205	localstatic CCode gccPRef (Foam); /* Information slot of a prog */
206	localstatic CCode gccPCallId (Foam); /* Foreign function call */
207	localstatic CCode gccFortranPCall (Foam , int, Foam, CCodeList );
208	/* Generate code for a Fortran PCall */
209	localstatic CCode gccDef0List (Foam); /* Return C code for init prog */
210	localstatic CCode gc0Protect (Foam);
211	localstatic CCode gc0Throw (Foam);
212
213	/*****************************************************************************
214	*
215	* :: Miscellaneous C code generating functions.
216	*
217	****************************************************************************/
218
219	localstatic CCodeList gc0ExternDecls (String name);
220	localstatic CCode gc0GloDecl (int);
221	localstatic void gc0ConstDecl (int);
222	localstatic CCode gc0FluidDecl (int);
223	localstatic void gc0LexDecl (int);
224	localstatic void gc0LFmtDecl (int, Foam);
225	localstatic void gc0LFmtDef (int);
226
227	localstatic CCode gc0GetterDecl (String);
228	localstatic CCode gc0ArgcDecl (void);
229	localstatic CCode gc0ArgvDecl (void);
230	localstatic CCode gc0MainDecl (void);
231	localstatic CCode gc0MainDef (String);
232	localstatic void gc0AddExtraModules (void);
233	localstatic CCode gc0ClosInit (Foam, Foam);
234	localstatic CCode gc0Set (Foam, Foam);
235	localstatic CCode gc0SetValues (Foam, Foam);
236	localstatic CCode gc0FortranSet (Foam, Foam, FoamTag, FoamTag);
237	localstatic CCode gc0SetCatch (Foam, Foam);
238	localstatic CCode gc0Prog (Foam, Foam);
239	localstatic CCode gc0Compound (Foam, Foam, Foam, int, int, int);
240	localstatic CCode gc0Compress (CCode);
241	localstatic CCode gc0Param (Foam, Foam);
242	localstatic CCode gc0LocRef (Foam, int);
243	localstatic Foam gc0KillPointers (Foam foam);
244
245	localstatic CCode gc0ExportCDef (String, Foam, int, int);
246	localstatic CCode gc0ExportToFortran(String, Foam, Foam, FtnFunParam, int);
247	localstatic CCode gc0ExportFtnString(CCode, Bool, CCodeList , CCodeList ,
248	CCodeList , CCodeList , int , int );
249	localstatic CCodeList gc0ExportInit (String, Foam, int);
250	localstatic CCode gc0FunFoamCall (Foam, int);
251	localstatic CCode gc0FunCCall0 (Foam, int);
252	localstatic CCode gc0FunOCall0 (Foam, int);
253	localstatic CCode gc0FunPCall0 (Foam, int);
254	localstatic CCode gc0FiCFun (FoamTag, int, FoamTag *, CCode, int);
255	localstatic CCode gc0UnNestCall (CCode, CCode);
256	localstatic CCode gc0GetTmp (CCode);
257	localstatic CCode gc0FunBCall (Foam, int);
258
259	localstatic CCode gc0SeqStmt (Foam, int);
260	localstatic CCode gc0Cop (FoamBValTag, Foam, CCodeTag);
261	localstatic CCode gc0Builtin (FoamBValTag, Foam);
262	localstatic CCode gc0FCall (FoamBValTag, Foam);
263	localstatic CCode gc0SIntMod (Foam, CCodeTag);
264
265	localstatic CCode gc0SubExpr (Foam, CCode);
266	localstatic Bool gc0NeedBothCasts(FoamTag, FoamTag);
267	localstatic CCode gc0TryCast (FoamTag, Foam);
268	localstatic CCode gc0Cast (FoamTag, Foam);
269	localstatic CCode gc0TypeId (AInt, AInt);
270	localstatic String gc0CTypeId (AInt fmt);
271
272	localstatic CCode gc0IdDecl (Foam, FoamTag, Foam, int, int);
273	localstatic CCode gc0IdCDecl (Foam, CCode);
274	localstatic CCode gc0IdCRetDecl (Foam);
275	localstatic void gc0IdFortranDecl(Foam, CCode , CCode );
276	localstatic CCode gc0GloIdDecl (Foam, int);
277	localstatic CCode gc0FluidSet (Foam, Foam);
278	localstatic CCode gc0FluidRef (Foam);
279	localstatic CCode gc0PushFluid (void);
280	localstatic CCode gc0PopFluid (void);
281	localstatic CCode gc0GetFluid (AInt);
282	localstatic CCode gc0AddFluid (AInt);
283	localstatic CCode gc0MultVarId (String, int, String);
284	localstatic CCode gc0VarId (String, int);
285
286	localstatic CCode gc0RRFmt (CCode, Foam);
287
288	localstatic CCodeList gc0Levels (int, int, int, int, int);
289	localstatic CCode gc0LexRef (int, int);
290	localstatic CCode gc0EnvNext (int, int);
291	localstatic CCode gc0EnvMake (int);
292	localstatic CCode gc0EnvPush (int);
293	localstatic CCode gc0EnvLevel (int, int);
294	localstatic CCode gc0EnvRef (int);
295	localstatic CCode gc0EEltNext (Foam, int);
296	localstatic CCode gc0EEnv (CCode, int);
297
298	localstatic CCode gc0GenModuleInitFun (String, Bool, int);
299	localstatic CCode gc0DeclModuleInitFun (String, int);
300
301	localstatic CCode gc0SpecialSFloWord (Foam,AInt,CCode);
302
303	/*****************************************************************************
304	*
305	* :: Other miscellaneous utility functions.
306	*
307	****************************************************************************/
308
309	localstatic String gc0StompOffIncludeFile(String str, FoamProtoTag p);
310	localstatic void gc0CheckBVals (void);
311	localstatic FoamTag gc0ExprType (Foam foam);
312	localstatic Foam gc0GetDecl (Foam);
313	localstatic int gc0IsDecl (Foam);
314	localstatic int gc0ValidIdInBuf (Buffer, String);
315	localstatic int gc0IdHashInBuf (Buffer, String);
316	localstatic void gc0InitSpecialChars (void);
317	localstatic void gc0AddDecl (CCode, int);
318	localstatic void gc0AddLocal (CCode, int, int);
319	localstatic void gc0CreateGloList (String);
320	localstatic void gc0CreateLocList (Foam);
321	localstatic void gc0AddUnSortedLocal (CCode);
322	localstatic void gc0NewStmtInit (void);
323	localstatic void gc0AddTopLevelStmt (Cstmts, CCode);
324	localstatic void gc0NewLocsInit (void);
325	localstatic void gc0NewLocals (CCode);
326	extern int gc0NumVals (Foam);
327	localstatic int gc0MaxLevel (int);
328	localstatic int gc0IsNewHeader (String);
329	localstatic void gc0AddHeaderIfNeeded (String);
330
331	localstatic CCode gc0ModuleInitFun (String, int);
332	localstatic CCode gc0ListOf (CCodeTag, CCodeList);
333	localstatic void gc0AddLineFun (CCodeList *, CCode);
334	localstatic Bool gc0IsReturn (CCode);
335	localstatic CCode gc0Decl (Foam, CCode);
336
337	localstatic void gc0InitDeclList();
338	localstatic CCodeList gc0FiniDeclList();
339
340	localstatic Bool gc0IsModifiableFortranArg (Foam);
341	localstatic String gc0GetFortranArgName (Foam);
342	localstatic int gc0GetNumModFortranArgs (Foam);
343	localstatic String gc0GenFortranName (String);
344	localstatic FortranType gc0GetFortranType (Foam);
345	localstatic Foam gc0GetFortranRetFm (Foam);
346	localstatic FortranType gc0GetFortranRetType (Foam);
347	localstatic CCode gccFtnXLstring(Foam, FortranType, Bool, CCode*);
348	localstatic CCode gccFtnStringArray(Foam, CCode *);
349	localstatic CCode gccFtnFnParam(Foam, FtnFunParam, CCode *);
350
351	localstatic void gc0FtnExFunPar(String, Foam, Foam, AInt, AInt);
352
353	localstatic FtnFunParam gc0FtnFunParam(String, AInt);
354	localstatic CCode gc0FtnFunClosDeclare(FtnFunParam);
355	localstatic CCode gc0FtnFunClosDefine(FtnFunParam);
356	localstatic CCode gc0FtnFunDeclare(FtnFunParam, CCode);
357	localstatic void ftnFunParamInit(void);
358	localstatic void ftnFunParamFinish(void);
359	localstatic Hash ftnFunParamHash(FtnFunParam);
360	localstatic Bool ftnFunParamEqual(FtnFunParam, FtnFunParam);
361	localstatic void ftnFunParamFree(FtnFunParam);
362
363	localstatic Foam gc0AddExplicitReturn(Foam);
364
365	/*****************************************************************************
366	*
367	* :: Useful C code macros.
368	*
369	****************************************************************************/
370
371	#define NOT_SET(-1) (-1)
372	#define NOT_CHANGED(-2) (-2)
373	#define NOT_PRINTABLE(-3) (-3)
374
375	#define gcFiWord"FiWord" "FiWord"
376	#define gcFiArb"FiArb" "FiArb"
377	#define gcFiPtr"FiPtr" "FiPtr"
378	#define gcFiBool"FiBool" "FiBool"
379	#define gcFiByte"FiByte" "FiByte"
380	#define gcFiHInt"FiHInt" "FiHInt"
381	#define gcFiSInt"FiSInt" "FiSInt"
382	#define gcFiChar"FiChar" "FiChar"
383	#define gcFiArr"FiArr" "FiArr"
384	#define gcFiRec"FiRec" "FiRec"
385	#define gcFiRRec"FiRRec" "FiRRec"
386	#define gcFiProg"FiProg" "FiProg"
387	#define gcFiFun"FiFun" "FiFun"
388	#define gcFiBInt"FiBInt" "FiBInt"
389	#define gcFiSFlo"FiSFlo" "FiSFlo"
390	#define gcFiDFlo"FiDFlo" "FiDFlo"
391	#define gcFiEnv"FiEnv" "FiEnv"
392	#define gcFiClos"FiClos" "FiClos"
393	#define gcFiGener"FiGener" "FiGener"
394	#define gcFiGenIter"FiGenIter" "FiGenIter"
395	#define gcFiComplexSF"FiComplexSF" "FiComplexSF"
396	#define gcFiComplexDF"FiComplexDF" "FiComplexDF"
397	#define gcFiFluid"FiFluid" "FiFluid"
398	#define gcFiFluidStack"FiFluidStack" "FiFluidStack"
399	#define gcFiFluidStackLVar"localStack" "localStack"
400	#define gcFiFluidStackGVar"fiGlobalFluidStack" "fiGlobalFluidStack"
401	#define gcFiNil"fiNil" "fiNil" /* The Nil value */
402	#define gcFmtName"Fmt" "Fmt"
403	#define gcTFmtName"TFmt" "TFmt"
404	#define gcFmtType"PFmt" "PFmt"
405	#define gcFiInitModulePrefix"INIT_" "INIT_"
406	#define gcFiTRTail"tail" "tail"
407
408	#define gc0AddLine(cc, c)gc0AddLineFun(&(cc), c) gc0AddLineFun(&(cc), c)
409
410	#define ccoStatAsst(ccl, ccr)ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccl,ccr)) ccoStat(ccoAsst(ccl, ccr))ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccl,ccr))
411	#define ccoTypeIdOf(s)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe(s, 1 \| 2))) ccoTypedefId(ccoIdOf(s))ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe(s, 1 \| 2)))
412
413	#define gcFiNARY"fiNARY" "fiNARY"
414	#define gcFiNew(s,f)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiNew", 1 \| 2)), ccoNew(CCO_StructRef,1,gc0VarId(s,f))) ccoFCall(ccoIdOf("fiNew"), ccoStructRef(gc0VarId(s,f)))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiNew", 1 \| 2)), ccoNew(CCO_StructRef,1,gc0VarId(s,f)))
415	#define gcFi0New(s,f,t)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fi0New", 1 \| 2)) ,ccoNew(CCO_Many,2,ccoNew(CCO_StructRef,1,gc0VarId(s,f)),ccoNew (CCO_Id,1,symProbe(t, 1 \| 2)))) ccoFCall(ccoIdOf("fi0New"), \ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fi0New", 1 \| 2)) ,ccoNew(CCO_Many,2,ccoNew(CCO_StructRef,1,gc0VarId(s,f)),ccoNew (CCO_Id,1,symProbe(t, 1 \| 2))))
416	ccoMany2(ccoStructRef(gc0VarId(s,f)), ccoIdOf(t)))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fi0New", 1 \| 2)) ,ccoNew(CCO_Many,2,ccoNew(CCO_StructRef,1,gc0VarId(s,f)),ccoNew (CCO_Id,1,symProbe(t, 1 \| 2))))
417	#define gcFi0RecNew(s,f,t)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fi0RecNew", 1 \| 2 )),ccoNew(CCO_Many,2,ccoNew(CCO_StructRef,1,gc0VarId(s,f)),ccoNew (CCO_Id,1,symProbe(t, 1 \| 2)))) ccoFCall(ccoIdOf("fi0RecNew"), \ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fi0RecNew", 1 \| 2 )),ccoNew(CCO_Many,2,ccoNew(CCO_StructRef,1,gc0VarId(s,f)),ccoNew (CCO_Id,1,symProbe(t, 1 \| 2))))
418	ccoMany2(ccoStructRef(gc0VarId(s,f)), ccoIdOf(t)))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fi0RecNew", 1 \| 2 )),ccoNew(CCO_Many,2,ccoNew(CCO_StructRef,1,gc0VarId(s,f)),ccoNew (CCO_Id,1,symProbe(t, 1 \| 2))))
419
420	#define gcFiNARYNew(s1, s2,f,n)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiNARYNew", 1 \| 2 )),ccoNew(CCO_Many,3,ccoNew(CCO_StructRef,1,gc0VarId(s1,f)),ccoNew (CCO_StructRef,1,gc0VarId(s2,f)),n)) ccoFCall(ccoIdOf("fiNARYNew"), \ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiNARYNew", 1 \| 2 )),ccoNew(CCO_Many,3,ccoNew(CCO_StructRef,1,gc0VarId(s1,f)),ccoNew (CCO_StructRef,1,gc0VarId(s2,f)),n))
421	ccoMany3(ccoStructRef(gc0VarId(s1,f)), \ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiNARYNew", 1 \| 2 )),ccoNew(CCO_Many,3,ccoNew(CCO_StructRef,1,gc0VarId(s1,f)),ccoNew (CCO_StructRef,1,gc0VarId(s2,f)),n))
422	ccoStructRef(gc0VarId(s2,f)), \ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiNARYNew", 1 \| 2 )),ccoNew(CCO_Many,3,ccoNew(CCO_StructRef,1,gc0VarId(s1,f)),ccoNew (CCO_StructRef,1,gc0VarId(s2,f)),n))
423	n))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiNARYNew", 1 \| 2 )),ccoNew(CCO_Many,3,ccoNew(CCO_StructRef,1,gc0VarId(s1,f)),ccoNew (CCO_StructRef,1,gc0VarId(s2,f)),n))
424	#define gcFiEnvPush(s,e)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvPush", 1 \| 2 )),ccoNew(CCO_Many,2,s,e)) ccoFCall(ccoIdOf("fiEnvPush"), ccoMany2(s, e))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvPush", 1 \| 2 )),ccoNew(CCO_Many,2,s,e))
425	#define gcFiEnvNext(c)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvNext", 1 \| 2 )),c) ccoFCall(ccoIdOf("fiEnvNext"), c)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvNext", 1 \| 2 )),c)
426	#define gcFiEnvLevel(c)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvLevel", 1 \| 2)),c) ccoFCall(ccoIdOf("fiEnvLevel"), c)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvLevel", 1 \| 2)),c)
427	#define gcFiEnvInfo(e)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvInfo", 1 \| 2 )),e) ccoFCall(ccoIdOf("fiEnvInfo"), e)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvInfo", 1 \| 2 )),e)
428	#define gcFiProgHashCode(e)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiProgHashCode", 1 \| 2)),e) ccoFCall(ccoIdOf("fiProgHashCode"), e)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiProgHashCode", 1 \| 2)),e)
429	#define gcFiEEnsure(e)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvEnsure", 1 \| 2)),e) ccoFCall(ccoIdOf("fiEnvEnsure"), e)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvEnsure", 1 \| 2)),e)
430	#define gcFiFree(o)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiFree", 1 \| 2)) ,o) ccoFCall(ccoIdOf("fiFree"), o)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiFree", 1 \| 2)) ,o)
431	#define gcFiHalt(hc)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiHalt", 1 \| 2)) ,ccoNew(CCO_Cast,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiSInt", 1 \| 2))),hc)) ccoFCall(ccoIdOf("fiHalt"), ccoCast(ccoTypeIdOf(gcFiSInt), hc))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiHalt", 1 \| 2)) ,ccoNew(CCO_Cast,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiSInt", 1 \| 2))),hc))
432
433	#define gcFiGetFluid(name)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiGetFluid", 1 \| 2)),name) ccoFCall(ccoIdOf("fiGetFluid"), name)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiGetFluid", 1 \| 2)),name)
434	#define gcFiAddFluid(name)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiAddFluid", 1 \| 2)),name) ccoFCall(ccoIdOf("fiAddFluid"), name)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiAddFluid", 1 \| 2)),name)
435	#define gcFiFluidValue(id)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiFluidValue", 1 \| 2)),id) ccoFCall(ccoIdOf("fiFluidValue"), id)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiFluidValue", 1 \| 2)),id)
436	#define gcFiSetFluid(id, value)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiSetFluid", 1 \| 2)),ccoNew(CCO_Many,2,id,value)) ccoFCall(ccoIdOf("fiSetFluid"), ccoMany2(id, value))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiSetFluid", 1 \| 2)),ccoNew(CCO_Many,2,id,value))
437
438	#define FOREIGN_INCLUDE_SEPARATOR'-' '-'
439
440	/* These two are no longer used - see gc0FtnFunParam() */
441	#define gcFortranFnParamSuffix"_fnparam" "_fnparam"
442	#define gcFortranClosSuffix"_Clos" "_Clos"
443
444	/* Names of globals/statics for Fortran functional parameters */
445	#define gcFortranPar("GFtnPar") ("GFtnPar")
446	#define gcFortranClo("GFtnClo") ("GFtnClo")
447
448	#define gcFiNMaxEnvLevel5 5
449	#define gcFiNMaxCCall5 5
450	#define gcFiEnvLevelN(i,c)ccoNew(CCO_FCall,2,gc0VarId("fiEnvLevel", i),c) ccoFCall(gc0VarId("fiEnvLevel", i), c)ccoNew(CCO_FCall,2,gc0VarId("fiEnvLevel", i),c)
451	#define gcFiCCallN(i,c)ccoNew(CCO_FCall,2,gc0VarId("fiCCall", i),c) ccoFCall(gc0VarId("fiCCall", i), c)ccoNew(CCO_FCall,2,gc0VarId("fiCCall", i),c)
452
453	#define isMacro(f)(((f) == FOAM_BVal \|\| (f) == FOAM_BCall)) (((f) == FOAM_BVal \|\| (f) == FOAM_BCall))
454
455	#define isStmt(p)(((p) != FOAM_Select) && ((p) != FOAM_Return) && ((p) != FOAM_Seq) && ((p) != FOAM_If) && ((p ) != FOAM_GenerStep) && ((p) != FOAM_Label) && ((p) != FOAM_Goto) && ((p) != FOAM_NOp)) (((p) != FOAM_Select) && \
456	((p) != FOAM_Return) && \
457	((p) != FOAM_Seq) && \
458	((p) != FOAM_If) && \
459	((p) != FOAM_GenerStep) && \
460	((p) != FOAM_Label) && \
461	((p) != FOAM_Goto) && \
462	((p) != FOAM_NOp))
463
464	/*
465	* These macros should be moved to other files, e.g. foam.h and ccode.h
466	* TODO: ^^^^^
467	*/
468
469	#define gc0EmptyEnv(x)((x == 4) \|\| ((((gcvFmt->foamDFmt.argv[x])->hdr.argc) - (1)) == 0)) ((x == emptyFormatSlot4) \|\| \
470	(foamDDeclArgc(gcvFmt->foamDFmt.argv[x])(((gcvFmt->foamDFmt.argv[x])->hdr.argc) - (1)) == 0))
471
472	#define gc0EmptyFormat(fmt)(((fmt == 4) \|\| ((((gcvFmt->foamDFmt.argv[fmt])->hdr.argc ) - (1)) == 0)) \|\| (fmt) == 0 \|\| ((((gcvFmt->foamDFmt.argv [fmt])->hdr.argc) - (1)) < 1)) \
473	(gc0EmptyEnv(fmt)((fmt == 4) \|\| ((((gcvFmt->foamDFmt.argv[fmt])->hdr.argc ) - (1)) == 0)) \|\| (fmt) == envUsedSlot0 \|\| \
474	(foamDDeclArgc(gcvFmt->foamDFmt.argv[fmt])(((gcvFmt->foamDFmt.argv[fmt])->hdr.argc) - (1)) < 1))
475
476	#define ccIdInfo(tag)(ccSpecCharIdTable[tag]) (ccSpecCharIdTable[tag])
477	#define ccIdChar(tag)((ccSpecCharIdTable[tag]).ch) (ccIdInfo(tag)(ccSpecCharIdTable[tag]).ch)
478	#define ccIdStr(tag)((ccSpecCharIdTable[tag]).str) (ccIdInfo(tag)(ccSpecCharIdTable[tag]).str)
479
480	#define USE_MACROS
481
482	#define gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax) (gcvSMax > 0 && gcvNStmts > gcvSMax)
483
484	void
485	genCSetSMax(int n)
486	{
487	gcvSMax = n;
488	if (gcvSMax < 0) gcvSMax = 1;
489	}
490
491	#define gc0UnderIdLen(buf,i)(gcvIdLen == 0 \|\| bufPosition(buf) + gcvIdCharc[i] <= gcvIdLen ) \
492	(gcvIdLen == 0 \|\| bufPosition(buf) + gcvIdCharc[i] <= gcvIdLen)
493
494	void
495	genCSetIdLen(int n)
496	{
497	gcvIdLen = n;
498	if (gcvIdLen < 0) gcvIdLen = 1;
499	}
500
501	void
502	genCSetIdHash(Bool flag)
503	{
504	gcvIdHash = flag;
505	}
506
507
508	/*****************************************************************************
509	*
510	* :: Developer options (-Wtrace-cfuns)
511	*
512	****************************************************************************/
513
514	static Bool gc0TraceFuns = false((int) 0);
515
516	void gencSetTraceFuns(Bool flag)
517	{
518	gc0TraceFuns = flag;
519	}
520
521	Bool
522	gencTraceFuns(void)
523	{
524	return gc0TraceFuns;
525	}
526
527	/*****************************************************************************
528	*
529	* :: Top level entry point for C generation.
530	* First generate a C code tree, then write it to the file.
531	*
532	****************************************************************************/
533
534	CCodeList
535	genC(Foam foam, String name)
536	{
537	CCodeList ccode;
538
539	gc0CheckBVals();
540
541	ccode = gccUnit(foam, name);
542
543	return ccode;
544	}
545
546	/*****************************************************************************
547	*
548	* :: Generate a list of C code trees from a given Foam Unit.
549	*
550	****************************************************************************/
551
552	localstatic CCodeList
553	gccUnit(Foam foam, String name)
554	{
555	CCodeList ccode;
556
557	if (foamUnitHasCoroutine(foam)) {
558	foam = gcrRewriteUnit(foam);
559	}
560	assert(foamTag(foam) == FOAM_Unit)do { if (!(((foam)->hdr.tag) == FOAM_Unit)) _do_assert(("foamTag(foam) == FOAM_Unit" ),"genc.c",560); } while (0);
561
562	gcvLvl = 0;
563	gcvGlo = foamUnitGlobals(foam)((((foam)->foamUnit.formats)->foamGen.argv)[0].code);
564	gcvConst = foamUnitConstants(foam)((((foam)->foamUnit.formats)->foamGen.argv)[1].code);
565	gcvFluids = foamUnitFluids(foam)((((foam)->foamUnit.formats)->foamGen.argv)[3].code);
566	gcvFmt = foam->foamUnit.formats;
567	gcvLexStk = listCons(Foam)(Foam_listPointer->Cons)(foamUnitLexicals(foam)((((foam)->foamUnit.formats)->foamGen.argv)[2].code), listNil(Foam)((FoamList) 0));
568
569	gc0InitSpecialChars();
570	gcvDefs = foam->foamUnit.defs;
571	assert(foamTag(gcvDefs) == FOAM_DDef)do { if (!(((gcvDefs)->hdr.tag) == FOAM_DDef)) _do_assert( ("foamTag(gcvDefs) == FOAM_DDef"),"genc.c",571); } while (0);
572
573	ccode = gc0ExternDecls(name);
574
575	return ccode;
576	}
577
578	/*****************************************************************************
579	*
580	* :: Create declarations and definitions for each node of the C code tree
581	* and break the C code tree into a list of trees if the C unit becomes
582	* excessively large.
583	*
584	****************************************************************************/
585
586	localstatic CCodeList
587	gc0ExternDecls(String name)
588	{
589	int i, n, stmtCounter, listLen;
590	int nLexs, nLFmts, nDefs = 0, nStmts = 0;
591	int nBrothers = 0;
592	CCode ccExtD, ccExtH, c, ccglo, ccd, ccrest, ccdefs, def0c;
593	CCode ccGloDefs;
594	CCode ccPreProc;
595	CCodeList allcode = listNil(CCode)((CCodeList) 0);
596	CCodeList code = listNil(CCode)((CCodeList) 0);
597	CCodeList hcode = listNil(CCode)((CCodeList) 0);
598	CCodeList decls;
599	CCodeList constDefs = listNil(CCode)((CCodeList) 0);
600	CCodeList gloDefs = listNil(CCode)((CCodeList) 0);
601
602	gcvGloCC = listNil(CCode)((CCodeList) 0);
603	gcvPreProcCC = listNil(CCode)((CCodeList) 0);
604	gcvDefCC = listNil(CCode)((CCodeList) 0);
605	gcvBIntCC = listNil(CCode)((CCodeList) 0);
606	gcvRRFmtCC = listNil(CCode)((CCodeList) 0);
607	gcvInitProgCC = listNil(CCode)((CCodeList) 0);
608
609	/* Table of RRFmts which in gcvRRFmtCC */
610	gcvRRFmtTable = tblNew((TblHashFun)foamHash, (TblEqFun)foamEqual);
611
612	gcvExportedGloInitCC = listNil(CCode)((CCodeList) 0);
613	gcvImportedGloInitCC = listNil(CCode)((CCodeList) 0);
614	gcvInitFunDeclsCC = listNil(CCode)((CCodeList) 0);
615	gcvInitFunCalls0CC = listNil(CCode)((CCodeList) 0);
616	gcvInitFunCalls1CC = listNil(CCode)((CCodeList) 0);
617
618	/* Initialise Fortran functional parameter tracking */
619	ftnFunParamInit();
620
621	nLexs = foamDDeclArgc(listElt(Foam)(gcvLexStk, gcvLvl))((((Foam_listPointer->Elt)(gcvLexStk, gcvLvl))->hdr.argc ) - (1));
622	nLFmts = foamArgc(gcvFmt)((gcvFmt)->hdr.argc) - FOAM_FORMAT_START5;
623
624	/* Guess num stmts here. */
625	for (i = 0; i < foamArgc(gcvDefs)((gcvDefs)->hdr.argc); i++) {
626	Foam fdef = gcvDefs->foamDDef.argv[i], prog;
627	prog = fdef->foamDef.rhs;
628	if (foamTag(prog)((prog)->hdr.tag) == FOAM_Prog) {
629	nStmts += foamArgc(prog->foamProg.body)((prog->foamProg.body)->hdr.argc);
630	nDefs += 1;
631	}
632	else {
633	nStmts += 1;
634	}
635	}
636	gcvNStmts = nStmts;
637
638	/* Define globals */
639	gc0CreateGloList(name);
640	gc0AddExtraModules();
641
642	gc0InitDeclList();
643
644	gc0LexDecl(nLexs);
645
646	/* Create typedefs for each C structure we create */
647	for (i=FOAM_FORMAT_START5; i < FOAM_FORMAT_START5+nLFmts; i++) {
648	switch ((gcvFmt->foamDFmt.argv[i])->foamDDecl.usage) {
649	/* Some formats must not have a typedef */
650	case FOAM_DDecl_FortranSig: /FALLTHROUGH/
651	case FOAM_DDecl_CSig: /FALLTHROUGH/
652	case FOAM_DDecl_JavaClass: /FALLTHROUGH/
653	case FOAM_DDecl_CType: /FALLTHROUGH/
654	break;
655	default:
656	gc0LFmtDef(i);
657	}
658	}
659
660	/*
661	* Now generate the structure declarations. Note that this
662	* loop is NOT independent of the previous loop so don't
663	* try merging them! We must generate the typedefs before
664	* the structures that they refer to.
665	*/
666	for (i=FOAM_FORMAT_START5; i < FOAM_FORMAT_START5+nLFmts; i++) {
667	switch ((gcvFmt->foamDFmt.argv[i])->foamDDecl.usage) {
668	/* Some formats must not have a typedef */
669	case FOAM_DDecl_FortranSig: /FALLTHROUGH/
670	case FOAM_DDecl_CSig: /FALLTHROUGH/
671	case FOAM_DDecl_CType: /FALLTHROUGH/
672	case FOAM_DDecl_JavaClass: /FALLTHROUGH/
673	case FOAM_DDecl_JavaSig: /FALLTHROUGH/
674	break;
675	default:
676	gc0LFmtDecl(i, foamArgv(gcvFmt)((gcvFmt)->foamGen.argv)[i].code);
677	}
678	}
679
680	/* Declare all constants */
681	for (i = 0; i < foamDDeclArgc(gcvConst)(((gcvConst)->hdr.argc) - (1)); i++) {
682	gc0ConstDecl(i);
683	}
684
685	decls = gc0FiniDeclList();
686
687	/* Preprocessor lines, e.g. #includes */
688	gcvPreProcCC = listNReverse(CCode)(CCode_listPointer->NReverse)(gcvPreProcCC);
689	ccPreProc = gc0ListOf(CCO_Many, gcvPreProcCC);
690	listLen = listLength(CCode)(CCode_listPointer->_Length)(gcvPreProcCC);
691
692	for (i = 0; i < listLen; i++)
693	gc0AddLine(hcode, ccoArgv(ccPreProc)[i])gc0AddLineFun(&(hcode), ((ccPreProc)->ccoNode.argv)[i] );
694
695	ccrest = gc0ListOf(CCO_Many, decls);
696	listLen = listLength(CCode)(CCode_listPointer->_Length)(decls);
697	for (i = 0; i < listLen; i++)
698	gc0AddLine(hcode, ccoArgv(ccrest)[i])gc0AddLineFun(&(hcode), ((ccrest)->ccoNode.argv)[i]);
699
700	ccdefs = ccoNewNode(CCO_Many, nDefs - 1);
701
702	n = 0;
703	stmtCounter = 0;
704	/* Do all bar the last stage... */
705	while (nStmts > gcvSMax && gcvSMax > 0) {
706	for (i = n; i < nDefs - 1 && stmtCounter < gcvSMax; i++) {
707	Foam f = foamArgv(gcvDefs)((gcvDefs)->foamGen.argv)[i+1].code, prog;
708
709	prog = f->foamDef.rhs;
710	if (foamTag(prog)((prog)->hdr.tag) == FOAM_Prog) {
711	Foam body = prog->foamProg.body;
712	stmtCounter += foamArgc(body)((body)->hdr.argc) + 1;
713	}
714	else
715	stmtCounter++;
716
717	ccoArgv(ccdefs)((ccdefs)->ccoNode.argv)[i] = gccDef(f);
718
719	gc0AddLine(code, ccoArgv(ccdefs)[i])gc0AddLineFun(&(code), ((ccdefs)->ccoNode.argv)[i]);
720	}
721	n = i;
722
723	nBrothers += 1;
724	gc0AddLine(code, gc0GenModuleInitFun(name, false, nBrothers))gc0AddLineFun(&(code), gc0GenModuleInitFun(name, ((int) 0 ), nBrothers));
725	code = listNReverse(CCode)(CCode_listPointer->NReverse)(code);
726
727	ccExtD = gc0ListOf(CCO_Many, code);
728
729	listFree(CCode)(CCode_listPointer->Free)(code);
730
731	code = listNil(CCode)((CCodeList) 0);
732	gc0AddLine(allcode, ccoUnit(ccExtD))gc0AddLineFun(&(allcode), ccoNew(CCO_Unit,1,ccExtD));
733	stmtCounter = 0;
734	nStmts -= gcvSMax;
735	}
736
737
738	for (i = n; i < nDefs - 1; i++)
739	ccoArgv(ccdefs)((ccdefs)->ccoNode.argv)[i] = gccDef(foamArgv(gcvDefs)((gcvDefs)->foamGen.argv)[i+1].code);
740
741	for (i = nDefs - 1; i < foamArgc(gcvDefs)((gcvDefs)->hdr.argc) - 1; i++) {
742	c = gccDef(gcvDefs->foamDDef.argv[i+1]);
743	if (c)
744	gc0AddLine(gloDefs, c)gc0AddLineFun(&(gloDefs), c);
745	}
746
747	/* First constant (initialization) */
748	def0c = gccDef0List(gcvDefs->foamDDef.argv[0]);
749
750	/* Declarations for globals */
751	gcvGloCC = listNReverse(CCode)(CCode_listPointer->NReverse)(gcvGloCC);
752	ccglo = gc0ListOf(CCO_Many, gcvGloCC);
753	for (i = 0; i < listLength(CCode)(CCode_listPointer->_Length)(gcvGloCC); i++)
754	gc0AddLine(hcode, ccoArgv(ccglo)[i])gc0AddLineFun(&(hcode), ((ccglo)->ccoNode.argv)[i]);
755
756	hcode = listNReverse(CCode)(CCode_listPointer->NReverse)(hcode);
757
758	ccExtH = gc0ListOf(CCO_Many, hcode);
759
760	if (!gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax))
761	gc0AddLine(code, ccoUnit(ccExtH))gc0AddLineFun(&(code), ccoNew(CCO_Unit,1,ccExtH));
762
763	/* Define globals in the same module where const 0 is defined*/
764
765	gcvDefCC = listNReverse(CCode)(CCode_listPointer->NReverse)(gcvDefCC);
766	ccd = gc0ListOf(CCO_Many, gcvDefCC);
767	gc0AddLine(code, ccoUnit(ccd))gc0AddLineFun(&(code), ccoNew(CCO_Unit,1,ccd));
768
769	for (i = 1; i <= nBrothers; i++) {
770	gc0AddLine(gcvInitFunDeclsCC, gc0DeclModuleInitFun(name, i))gc0AddLineFun(&(gcvInitFunDeclsCC), gc0DeclModuleInitFun( name, i));
771	}
772
773	gc0AddLine(code, def0c)gc0AddLineFun(&(code), def0c);
774
775	for (i = n; i < nDefs - 1; i++)
776	gc0AddLine(code, ccoArgv(ccdefs)[i])gc0AddLineFun(&(code), ((ccdefs)->ccoNode.argv)[i]);
777
778	gc0AddLine(code, gc0GenModuleInitFun(name, true, nBrothers))gc0AddLineFun(&(code), gc0GenModuleInitFun(name, 1, nBrothers ));
779
780	/* doing this ensures that the definition of the
781	* initialisation proc and the proc itself appear in the same
782	* file
783	* !! bug: if we have more than 1
784	* (def (glo x) (clos a b))
785	* at top level, this won't work.
786	*/
787	ccGloDefs = gc0ListOf(CCO_Many, gloDefs);
788
789	gc0AddLine(code, ccGloDefs)gc0AddLineFun(&(code), ccGloDefs);
790	code = listNReverse(CCode)(CCode_listPointer->NReverse)(code);
791
792	ccExtD = gc0ListOf(CCO_Many, code);
793	listFree(CCode)(CCode_listPointer->Free)(code);
794	gc0AddLine(allcode, ccoUnit(ccExtD))gc0AddLineFun(&(allcode), ccoNew(CCO_Unit,1,ccExtD));
795	allcode = listNReverse(CCode)(CCode_listPointer->NReverse)(allcode);
796
797	if (gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax))
798	gc0AddLine(allcode, ccoUnit(ccExtH))gc0AddLineFun(&(allcode), ccoNew(CCO_Unit,1,ccExtH));
799
800	/* Finalise Fortran functional parameter tracking */
801	ftnFunParamFinish();
802
803	listFree(CCode)(CCode_listPointer->Free)(constDefs);
804	listFree(CCode)(CCode_listPointer->Free)(gloDefs);
805
806	listFree(CCode)(CCode_listPointer->Free)(gcvDefCC);
807	listFree(CCode)(CCode_listPointer->Free)(gcvGloCC);
808	listFree(CCode)(CCode_listPointer->Free)(gcvPreProcCC);
809	listFree(CCode)(CCode_listPointer->Free)(gcvBIntCC);
810	listFree(CCode)(CCode_listPointer->Free)(gcvRRFmtCC);
811	listFree(CCode)(CCode_listPointer->Free)(gcvExportedGloInitCC);
812	listFree(CCode)(CCode_listPointer->Free)(gcvImportedGloInitCC);
813
814	tblFreeDeeply(gcvRRFmtTable, (TblFreeKeyFun)foamFree,
815	(TblFreeEltFun)ccoFree);
816
817	return allcode;
818	}
819
820	localstatic void
821	gc0AddExtraModules()
822	{
823	Foam decl;
824	CCode cco;
825	decl = foamNewGDecl(FOAM_Clos, strCopy("rtexns"),foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy("rtexns"), FOAM_Nil ,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Init))
826	FOAM_Nil,foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy("rtexns"), FOAM_Nil ,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Init))
827	emptyFormatSlot,foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy("rtexns"), FOAM_Nil ,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Init))
828	FOAM_GDecl_Import,foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy("rtexns"), FOAM_Nil ,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Init))
829	FOAM_Proto_Init)foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy("rtexns"), FOAM_Nil ,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Init));
830	cco = gc0GloIdDecl(decl, -1);
831	ccoFree(cco);
832	}
833
834
835	/*****************************************************************************
836	*
837	* :: Top level entry point for axlmain.c code generation.
838	*
839	****************************************************************************/
840
841	CCode
842	genAXLmainC(String name)
843	{
844	CCode ccode;
845	CCodeList code = listNil(CCode)((CCodeList) 0);
846
847	gc0InitSpecialChars();
848
849
850	gc0AddLine(code, ccoDecl(ccoType(ccoExtern(),gc0AddLineFun(&(code), ccoNew(CCO_Decl,2,ccoNew(CCO_Type, 2,ccoNew(CCO_Extern,0),ccoNew(CCO_Id,1,symProbe("int", 1 \| 2) )),ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0), name), ((int) 0))))
851	ccoIdOf("int")),gc0AddLineFun(&(code), ccoNew(CCO_Decl,2,ccoNew(CCO_Type, 2,ccoNew(CCO_Extern,0),ccoNew(CCO_Id,1,symProbe("int", 1 \| 2) )),ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0), name), ((int) 0))))
852	ccoFCall(gc0MultVarId(gcFiInitModulePrefix,gc0AddLineFun(&(code), ccoNew(CCO_Decl,2,ccoNew(CCO_Type, 2,ccoNew(CCO_Extern,0),ccoNew(CCO_Id,1,symProbe("int", 1 \| 2) )),ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0), name), ((int) 0))))
853	int0, name),gc0AddLineFun(&(code), ccoNew(CCO_Decl,2,ccoNew(CCO_Type, 2,ccoNew(CCO_Extern,0),ccoNew(CCO_Id,1,symProbe("int", 1 \| 2) )),ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0), name), ((int) 0))))
854	int0)))gc0AddLineFun(&(code), ccoNew(CCO_Decl,2,ccoNew(CCO_Type, 2,ccoNew(CCO_Extern,0),ccoNew(CCO_Id,1,symProbe("int", 1 \| 2) )),ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0), name), ((int) 0))));
855
856	name = gen0InitialiserName(name)(strCopy(name));
857
858	gc0AddLine(code, gc0GetterDecl(name))gc0AddLineFun(&(code), gc0GetterDecl(name));
859	gc0AddLine(code, gc0ArgcDecl())gc0AddLineFun(&(code), gc0ArgcDecl());
860	gc0AddLine(code, gc0ArgvDecl())gc0AddLineFun(&(code), gc0ArgvDecl());
861	gc0AddLine(code, gc0MainDecl())gc0AddLineFun(&(code), gc0MainDecl());
862
863	gc0AddLine(code, gc0MainDef(name))gc0AddLineFun(&(code), gc0MainDef(name));
864
865	code = listNReverse(CCode)(CCode_listPointer->NReverse)(code);
866	ccode = gc0ListOf(CCO_Many, code);
867	listFree(CCode)(CCode_listPointer->Free)(code);
868
869	ccode = ccoUnit(ccode)ccoNew(CCO_Unit,1,ccode);
870
871	return ccode;
872	}
873
874	/*****************************************************************************
875	*
876	* :: Functions generating the module initialization function.
877	*
878	****************************************************************************/
879
880	localstatic CCode
881	gc0DeclModuleInitFun(String name, int n)
882	{
883	return ccoDecl(ccoType(ccoExtern(), ccoTypeIdOf("int")),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("int", 1 \| 2)))),ccoNew (CCO_FCall,2,gc0ModuleInitFun(name, n),((int) 0)))
884	ccoFCall(gc0ModuleInitFun(name, n), int0))ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("int", 1 \| 2)))),ccoNew (CCO_FCall,2,gc0ModuleInitFun(name, n),((int) 0)));
885	}
886
887	/* Given the name of the module, it returns a function that provide the
888	* module initialization operation, such as the declarations for exported and
889	* imported globals.
890	* <main> says if it is the main module of a set of split.In this case it must
891	* generate also the call to the module init fun. for each brother.
892	* If main is true => <n> is the number of brothers
893	* If main is false => <n> is the progressive number of splitted file.
894	*/
895	localstatic CCode
896	gc0GenModuleInitFun(String name, int main, int n)
897	{
898	CCode ccode;
899	CCodeList code = listNil(CCode)((CCodeList) 0);
900	int modNum;
901	CCodeList impGloInitCC;
902
903	impGloInitCC = (main ? listCopy(CCode)(CCode_listPointer->Copy)(gcvImportedGloInitCC) :
904	listCopyDeeply(CCode)(CCode_listPointer->CopyDeeply)(gcvImportedGloInitCC,
905	ccoCopy));
906
907	modNum = (main ? int0((int) 0) : n);
908
909	if (main) {
910	code = impGloInitCC;
911
912	gc0AddLine(code,gc0AddLineFun(&(code), ccoNew(CCO_If,3,ccoNew(CCO_Id,1,symProbe ("fiFileInitializer", 1 \| 2)),ccoNew(CCO_Compound,1,gc0ListOf (CCO_Many, gcvInitFunCalls0CC)),ccoNew(CCO_Compound,1,gc0ListOf (CCO_Many, gcvInitFunCalls1CC))))
913	ccoIf(ccoIdOf("fiFileInitializer"),gc0AddLineFun(&(code), ccoNew(CCO_If,3,ccoNew(CCO_Id,1,symProbe ("fiFileInitializer", 1 \| 2)),ccoNew(CCO_Compound,1,gc0ListOf (CCO_Many, gcvInitFunCalls0CC)),ccoNew(CCO_Compound,1,gc0ListOf (CCO_Many, gcvInitFunCalls1CC))))
914	ccoCompound(gc0ListOf(CCO_Many,gc0AddLineFun(&(code), ccoNew(CCO_If,3,ccoNew(CCO_Id,1,symProbe ("fiFileInitializer", 1 \| 2)),ccoNew(CCO_Compound,1,gc0ListOf (CCO_Many, gcvInitFunCalls0CC)),ccoNew(CCO_Compound,1,gc0ListOf (CCO_Many, gcvInitFunCalls1CC))))
915	gcvInitFunCalls0CC)),gc0AddLineFun(&(code), ccoNew(CCO_If,3,ccoNew(CCO_Id,1,symProbe ("fiFileInitializer", 1 \| 2)),ccoNew(CCO_Compound,1,gc0ListOf (CCO_Many, gcvInitFunCalls0CC)),ccoNew(CCO_Compound,1,gc0ListOf (CCO_Many, gcvInitFunCalls1CC))))
916	ccoCompound(gc0ListOf(CCO_Many,gc0AddLineFun(&(code), ccoNew(CCO_If,3,ccoNew(CCO_Id,1,symProbe ("fiFileInitializer", 1 \| 2)),ccoNew(CCO_Compound,1,gc0ListOf (CCO_Many, gcvInitFunCalls0CC)),ccoNew(CCO_Compound,1,gc0ListOf (CCO_Many, gcvInitFunCalls1CC))))
917	gcvInitFunCalls1CC))))gc0AddLineFun(&(code), ccoNew(CCO_If,3,ccoNew(CCO_Id,1,symProbe ("fiFileInitializer", 1 \| 2)),ccoNew(CCO_Compound,1,gc0ListOf (CCO_Many, gcvInitFunCalls0CC)),ccoNew(CCO_Compound,1,gc0ListOf (CCO_Many, gcvInitFunCalls1CC))));
918
919	code = listConcat(CCode)(CCode_listPointer->Concat)(code,
920	listCopy(CCode)(CCode_listPointer->Copy)(gcvExportedGloInitCC));
921
922	listFree(CCode)(CCode_listPointer->Free)(gcvInitFunCalls0CC);
923	listFree(CCode)(CCode_listPointer->Free)(gcvInitFunCalls1CC);
924
925	}
926	else {
927	code = impGloInitCC;
928	gc0AddLine(gcvInitFunCalls0CC,gc0AddLineFun(&(gcvInitFunCalls0CC), ccoNew(CCO_Stat,1,ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiFileInitializer", 1 \| 2)),ccoNew(CCO_StringVal,1,symProbe("<children>", 1 \| 2 )))))
929	ccoStat(ccoFCall(ccoIdOf("fiFileInitializer"),gc0AddLineFun(&(gcvInitFunCalls0CC), ccoNew(CCO_Stat,1,ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiFileInitializer", 1 \| 2)),ccoNew(CCO_StringVal,1,symProbe("<children>", 1 \| 2 )))))
930	ccoStringVal(symIntern("<children>")))))gc0AddLineFun(&(gcvInitFunCalls0CC), ccoNew(CCO_Stat,1,ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiFileInitializer", 1 \| 2)),ccoNew(CCO_StringVal,1,symProbe("<children>", 1 \| 2 )))));
931	/* Here I need to know the name of the file */
932
933	gc0AddLine(gcvInitFunCalls1CC,gc0AddLineFun(&(gcvInitFunCalls1CC), ccoNew(CCO_Stat,1,ccoNew (CCO_FCall,2,gc0ModuleInitFun(name, modNum),((int) 0))))
934	ccoStat(ccoFCall(gc0ModuleInitFun(name, modNum),gc0AddLineFun(&(gcvInitFunCalls1CC), ccoNew(CCO_Stat,1,ccoNew (CCO_FCall,2,gc0ModuleInitFun(name, modNum),((int) 0))))
935	int0)))gc0AddLineFun(&(gcvInitFunCalls1CC), ccoNew(CCO_Stat,1,ccoNew (CCO_FCall,2,gc0ModuleInitFun(name, modNum),((int) 0))));
936	}
937
938	gc0AddLine(code,gc0AddLineFun(&(code), ccoNew(CCO_Comment,1,ccoNew(CCO_StringVal ,1,symProbe("---------------------------", 1 \| 2))))
939	ccoComment(ccoStringOf("---------------------------")))gc0AddLineFun(&(code), ccoNew(CCO_Comment,1,ccoNew(CCO_StringVal ,1,symProbe("---------------------------", 1 \| 2))));
940
941	/* Add prog initializations */
942	code = listConcat(CCode)(CCode_listPointer->Concat)(code, gcvInitProgCC);
943	gcvInitProgCC = listNil(CCode)((CCodeList) 0);
944
945	gc0AddLine(code, ccoReturn(ccoIntOf(int0)))gc0AddLineFun(&(code), ccoNew(CCO_Return,1,ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2))));
946
947	code = listNReverse(CCode)(CCode_listPointer->NReverse)(code);
948
949	/*** Generate the following code:
950	* static int initialized; = 0
951	* if (initialized)
952	* return 0;
953	* else
954	* initialized = 1
955	*/
956	gc0AddLine(code, ccoStat(ccoIf(ccoIdOf("initialized"),gc0AddLineFun(&(code), ccoNew(CCO_Stat,1,ccoNew(CCO_If,3, ccoNew(CCO_Id,1,symProbe("initialized", 1 \| 2)),ccoNew(CCO_Return ,1,ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2))),ccoNew(CCO_Asst,2,ccoNew(CCO_Id,1,symProbe("initialized" , 1 \| 2)),ccoNew(CCO_Id,1,symProbe("1", 1 \| 2))))))
957	ccoReturn(ccoIntOf(int0)),gc0AddLineFun(&(code), ccoNew(CCO_Stat,1,ccoNew(CCO_If,3, ccoNew(CCO_Id,1,symProbe("initialized", 1 \| 2)),ccoNew(CCO_Return ,1,ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2))),ccoNew(CCO_Asst,2,ccoNew(CCO_Id,1,symProbe("initialized" , 1 \| 2)),ccoNew(CCO_Id,1,symProbe("1", 1 \| 2))))))
958	ccoAsst(ccoIdOf("initialized"),gc0AddLineFun(&(code), ccoNew(CCO_Stat,1,ccoNew(CCO_If,3, ccoNew(CCO_Id,1,symProbe("initialized", 1 \| 2)),ccoNew(CCO_Return ,1,ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2))),ccoNew(CCO_Asst,2,ccoNew(CCO_Id,1,symProbe("initialized" , 1 \| 2)),ccoNew(CCO_Id,1,symProbe("1", 1 \| 2))))))
959	ccoIdOf("1")))))gc0AddLineFun(&(code), ccoNew(CCO_Stat,1,ccoNew(CCO_If,3, ccoNew(CCO_Id,1,symProbe("initialized", 1 \| 2)),ccoNew(CCO_Return ,1,ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2))),ccoNew(CCO_Asst,2,ccoNew(CCO_Id,1,symProbe("initialized" , 1 \| 2)),ccoNew(CCO_Id,1,symProbe("1", 1 \| 2))))));
960	gc0AddLine(code, ccoDecl(ccoType(ccoStatic(), ccoIdOf("int")),gc0AddLineFun(&(code), ccoNew(CCO_Decl,2,ccoNew(CCO_Type, 2,ccoNew(CCO_Static,0),ccoNew(CCO_Id,1,symProbe("int", 1 \| 2) )),ccoNew(CCO_Asst,2,ccoNew(CCO_Id,1,symProbe("initialized", 1 \| 2)),ccoNew(CCO_Id,1,symProbe("0", 1 \| 2)))))
961	ccoAsst(ccoIdOf("initialized"),gc0AddLineFun(&(code), ccoNew(CCO_Decl,2,ccoNew(CCO_Type, 2,ccoNew(CCO_Static,0),ccoNew(CCO_Id,1,symProbe("int", 1 \| 2) )),ccoNew(CCO_Asst,2,ccoNew(CCO_Id,1,symProbe("initialized", 1 \| 2)),ccoNew(CCO_Id,1,symProbe("0", 1 \| 2)))))
962	ccoIdOf("0"))))gc0AddLineFun(&(code), ccoNew(CCO_Decl,2,ccoNew(CCO_Type, 2,ccoNew(CCO_Static,0),ccoNew(CCO_Id,1,symProbe("int", 1 \| 2) )),ccoNew(CCO_Asst,2,ccoNew(CCO_Id,1,symProbe("initialized", 1 \| 2)),ccoNew(CCO_Id,1,symProbe("0", 1 \| 2)))));
963
964	if (main) {
965	gc0AddLine(code, gc0ListOf(CCO_Many, gcvInitFunDeclsCC))gc0AddLineFun(&(code), gc0ListOf(CCO_Many, gcvInitFunDeclsCC ));
966	listFree(CCode)(CCode_listPointer->Free)(gcvInitFunDeclsCC);
967	}
968
969	ccode = gc0ListOf(CCO_Many, code);
970	ccode = ccoFDef(ccoType(ccoExtern(), ccoTypeIdOf("int")),ccoNew(CCO_FDef,4,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("int", 1 \| 2)))),gc0ModuleInitFun (name, modNum),((void*)0),ccoNew(CCO_Compound,1,ccode))
971	gc0ModuleInitFun(name, modNum),ccoNew(CCO_FDef,4,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("int", 1 \| 2)))),gc0ModuleInitFun (name, modNum),((void*)0),ccoNew(CCO_Compound,1,ccode))
972	NULL, ccoCompound(ccode))ccoNew(CCO_FDef,4,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("int", 1 \| 2)))),gc0ModuleInitFun (name, modNum),((void*)0),ccoNew(CCO_Compound,1,ccode));
973
974	listFree(CCode)(CCode_listPointer->Free)(code);
975
976	return ccode;
977	}
978
979	/*****************************************************************************
980	*
981	* :: Functions generating C code declarations.
982	*
983	****************************************************************************/
984
985	/*****************************************************************************
986	*
987	* :: Create a C code tree of type 'tag' from the list of C code l.
988	*
989	****************************************************************************/
990
991	localstatic CCode
992	gc0ListOf(CCodeTag tag, CCodeList l)
993	{
994	CCode new;
995	CCodeList t;
996	int i, n;
997
998
999	for (n = 0, t = l; t; t = cdr(t)((t)->rest))
1000	if (car(t)((t)->first)) n++;
1001
1002	new = ccoNewNode(tag, n);
1003
1004	for (i = 0, t = l; t; t = cdr(t)((t)->rest))
1005	if (car(t)((t)->first)) ccoArgv(new)((new)->ccoNode.argv)[i++] = car(t)((t)->first);
1006
1007	return new;
1008	}
1009
1010	/*****************************************************************************
1011	*
1012	* :: Create a C declaration for main and global variables for argc + argv;
1013	*
1014	****************************************************************************/
1015
1016	localstatic CCode
1017	gc0GetterDecl(String name)
1018	{
1019	return ccoDecl(ccoType(ccoStatic(), ccoTypeIdOf(gcFiClos)),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2)))) ,ccoNew(CCO_PreStar,1,gc0MultVarId("pG", ((int) 0), name)))
1020	ccoPreStar(gc0MultVarId("pG", int0, name)))ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2)))) ,ccoNew(CCO_PreStar,1,gc0MultVarId("pG", ((int) 0), name)));
1021	}
1022
1023	localstatic CCode
1024	gc0ArgcDecl(void)
1025	{
1026	return ccoDecl(ccoType(ccoExtern(), ccoTypeIdOf("int")),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("int", 1 \| 2)))),ccoNew (CCO_Id,1,symProbe("mainArgc", 1 \| 2)))
1027	ccoIdOf("mainArgc"))ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("int", 1 \| 2)))),ccoNew (CCO_Id,1,symProbe("mainArgc", 1 \| 2)));
1028	}
1029
1030	localstatic CCode
1031	gc0ArgvDecl(void)
1032	{
1033	return ccoDecl(ccoType(ccoExtern(), ccoTypeIdOf("char")),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("char", 1 \| 2)))),ccoNew (CCO_PreStar,1,ccoNew(CCO_PreStar,1,ccoNew(CCO_Id,1,symProbe( "mainArgv", 1 \| 2)))))
1034	ccoPreStar(ccoPreStar(ccoIdOf("mainArgv"))))ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("char", 1 \| 2)))),ccoNew (CCO_PreStar,1,ccoNew(CCO_PreStar,1,ccoNew(CCO_Id,1,symProbe( "mainArgv", 1 \| 2)))));
1035	}
1036
1037	localstatic CCode
1038	gc0MainDecl(void)
1039	{
1040	return ccoDecl(ccoType(ccoExtern(), ccoTypeIdOf("int")),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("int", 1 \| 2)))),ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("main", 1 \| 2)),(CCode) ((void*)0)))
1041	ccoFCall(ccoIdOf("main"), (CCode) NULL))ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("int", 1 \| 2)))),ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("main", 1 \| 2)),(CCode) ((void*)0)));
1042	}
1043
1044	/*****************************************************************************
1045	*
1046	* :: Create a global variable C declaration from the Foam declaration given
1047	* at position 'idx' in the Foam globals Decl tree.
1048	*
1049	****************************************************************************/
1050
1051	localstatic CCode
1052	gc0GloDecl(int idx)
1053	{
1054	Foam decl;
1055	CCode cco;
1056	String buf;
1057
1058	decl = gcvGlo->foamDDecl.argv[idx];
1059	assert(foamTag(decl) == FOAM_GDecl)do { if (!(((decl)->hdr.tag) == FOAM_GDecl)) _do_assert(("foamTag(decl) == FOAM_GDecl" ),"genc.c",1059); } while (0);
1060	switch (decl->foamGDecl.protocol) {
1061	case FOAM_Proto_Foam:
1062	case FOAM_Proto_C:
1063	case FOAM_Proto_Fortran:
1064	case FOAM_Proto_Other:
1065	case FOAM_Proto_Init:
1066	cco = gc0GloIdDecl(decl, idx);
1067	break;
1068	default:
1069	buf = strPrintf("Cannot declare %s of protocol %s.",
1070	decl->foamGDecl.id,
1071	foamProtoStr(decl->foamGDecl.protocol)((foamProtoInfoTable[(int)(decl->foamGDecl.protocol)-(int) FOAM_PROTO_START]).str));
1072	cco = ccoCppLine(ccoIdOf("warning"), ccoStringOf(buf))ccoNew(CCO_CppLine,2,ccoNew(CCO_Id,1,symProbe("warning", 1 \| 2 )),ccoNew(CCO_StringVal,1,symProbe(buf, 1 \| 2)));
1073	}
1074	return cco;
1075	}
1076
1077	/*****************************************************************************
1078	*
1079	* :: Create a list of global variable declarations from the global
1080	* section of the Foam DDecl, and prototype exported globals.
1081	*
1082	****************************************************************************/
1083
1084	localstatic void
1085	gc0CreateGloList(String name)
1086	{
1087	int i, j, n;
1088
1089	n = foamDDeclArgc(gcvGlo)(((gcvGlo)->hdr.argc) - (1));
1090
1091	for (i = 0; i < n; i++) {
1092	Foam gdecl = gcvGlo->foamDDecl.argv[i];
1093
1094	if (gdecl->foamGDecl.protocol == FOAM_Proto_C) {
1095	char *tokInclFile;
1096	char *tokDecl = strCopy(gdecl->foamGDecl.id);
1097	char sep[2];
1098
1099	sep[0] = FOREIGN_INCLUDE_SEPARATOR'-';
1100	sep[1] = 0;
1101
1102	tokDecl = strCopy(gdecl->foamGDecl.id);
1103	tokInclFile = strtok(tokDecl, sep); /* throw away the first part */
	Value stored to 'tokInclFile' is never read
1104
1105	tokInclFile = strtok(NULL((void)0), sep); / get the first include file */
1106
1107	if (tokInclFile) {
1108	for (;tokInclFile;) { /* get the remaining include files */
1109	gc0AddHeaderIfNeeded(tokInclFile);
1110	tokInclFile = strtok(NULL((void*)0), sep);
1111
1112	}
1113	}
1114
1115	else {
1116	gc0AddLine(gcvGloCC,gc0AddLineFun(&(gcvGloCC), gc0GloIdDecl(gdecl, i))
1117	gc0GloIdDecl(gdecl, i))gc0AddLineFun(&(gcvGloCC), gc0GloIdDecl(gdecl, i));
1118	}
1119	strFree(tokDecl);
1120	}
1121	else if (gdecl->foamGDecl.protocol == FOAM_Proto_Include) {
1122	char *tokInclFile;
1123	char *tokDecl;
1124	char sep[2];
1125
1126	sep[0] = FOREIGN_INCLUDE_SEPARATOR'-';
1127	sep[1] = 0;
1128	tokDecl = strCopy(gdecl->foamGDecl.id);
1129	tokInclFile = strtok(tokDecl, sep); /* the first header */
1130	if (tokInclFile) {
1131	for (;tokInclFile;) { /* get the remaining include files */
1132	gc0AddHeaderIfNeeded(tokInclFile);
1133	tokInclFile = strtok(NULL((void*)0), sep);
1134
1135	}
1136	}
1137	}
1138	else if (gdecl->foamGDecl.protocol == FOAM_Proto_Fortran) {
1139	Foam argformat = gcvFmt->foamDFmt.argv[gdecl->foamGDecl.format];
1140	Foam arg;
1141	FortranType argtype;
1142	int fno = 0;
1143
1144	gc0AddLine(gcvGloCC, gc0GloDecl(i))gc0AddLineFun(&(gcvGloCC), gc0GloDecl(i));
1145	/* Don't check the function result decl */
1146	for (j = 0; j < ((foamArgc(argformat)((argformat)->hdr.argc)-1)-1); j++) {
1147	arg = argformat->foamDDecl.argv[j];
1148
1149	argtype = gc0GetFortranType(arg);
1150	if ((argtype == FTN_XLString) \|\|
1151	(argtype == FTN_String))
1152	{
1153	gc0AddHeaderIfNeeded("<string.h>");
1154	}
1155	else if (argtype == FTN_FnParam) {
1156	gc0FtnExFunPar(name,arg,gdecl,fno,i);
1157	fno++;
1158	}
1159
1160	}
1161	}
1162	else
1163	gc0AddLine(gcvGloCC, gc0GloDecl(i))gc0AddLineFun(&(gcvGloCC), gc0GloDecl(i));
1164
1165	/* Handle Exports to C/Fortran */
1166
1167	if (foamGDeclIsExportOf(FOAM_Proto_C, gdecl)
1168	\|\| foamGDeclIsExportOf(FOAM_Proto_Fortran, gdecl)) {
1169	Foam fakedecl;
1170	CCode cco;
1171
1172	fakedecl = foamCopy(gdecl);
1173	fakedecl->foamGDecl.protocol = FOAM_Proto_Foam;
1174	cco = gc0GloIdDecl(fakedecl, i);
1175	gc0AddLine(gcvGloCC, cco)gc0AddLineFun(&(gcvGloCC), cco);
1176	foamFreeNode(fakedecl);
1177	if (gdecl->foamGDecl.protocol == FOAM_Proto_C) {
1178	for (j = 0; j < foamArgc(gcvDefs)((gcvDefs)->hdr.argc); j++) {
1179	Foam fdecl = foamArgv(gcvDefs)((gcvDefs)->foamGen.argv)[j].code;
1180	Foam ccdecl = gc0GetDecl(fdecl->foamDef.lhs);
1181
1182	if (strEqual(gdecl->foamGDecl.id, ccdecl->foamDecl.id))
1183	{
1184	if (foamTag(fdecl->foamDef.lhs)((fdecl->foamDef.lhs)->hdr.tag) == FOAM_Const) {
1185	cco = gc0ExportCDef(name, gdecl, i, j);
1186	gc0AddLine(gcvDefCC, cco)gc0AddLineFun(&(gcvDefCC), cco);
1187	}
1188	break;
1189	}
1190	}
1191	}
1192	else {
1193	Foam ffmt = gcvFmt->foamDFmt.argv[gdecl->foamGDecl.format];
1194
1195	cco = gc0ExportToFortran(name, gdecl, ffmt, NULL((void*)0), i);
1196	gc0AddLine(gcvDefCC, cco)gc0AddLineFun(&(gcvDefCC), cco);
1197	}
1198	}
1199	}
1200	if (ccHdrFileList) {
1201	stoFree(ccHdrFileList);
1202	ccHdrFileList = NULL((void*)0);
1203	}
1204	}
1205
1206	localstatic void
1207	gc0FtnExFunPar(String name, Foam arg, Foam gdecl, AInt n, AInt nglo)
1208	{
1209	CCode ccdef;
1210	String fn = gdecl->foamGDecl.id;
1211	FtnFunParam info = gc0FtnFunParam(fn, n);
1212	Foam pfmt = gcvFmt->foamDFmt.argv[arg->foamDecl.format];
1213
1214	if (gdecl->foamGDecl.dir == FOAM_GDecl_Export)
1215	bug("gc0FtnExFunPar: Export to Fortran has function parameter");
1216
1217	(void)gc0FtnFunClosDeclare(info);
1218	(void)gc0FtnFunClosDefine(info);
1219	ccdef = gc0ExportToFortran(name, gdecl, pfmt, info, nglo);
1220	gc0AddLine(gcvDefCC, ccdef)gc0AddLineFun(&(gcvDefCC), ccdef);
1221	gc0AddHeaderIfNeeded("<string.h>"); /* Why??? */
1222	}
1223
1224	localstatic int
1225	gc0IsNewHeader(char *name)
1226	{
1227	struct ccListHdrFiles *l;
1228	int isnew = 1;
1229
1230	l = ccHdrFileList;
1231	while (l) {
1232	if (!strcmp(l->fname, name)) {
1233	isnew = 0;
1234	break;
1235	}
1236	else {
1237	l = l->next;
1238	}
1239	}
1240	if (isnew) {
1241	struct ccListHdrFiles *lhf;
1242
1243	lhf = (struct ccListHdrFiles *) stoAlloc(OB_Other0,
1244	sizeof(*lhf));
1245	lhf->fname = strAlloc(strlen(name));
1246	strcpy(lhf->fname, name);
1247	lhf->next = ccHdrFileList;
1248	ccHdrFileList = lhf;
1249	}
1250	return isnew;
1251	}
1252
1253	localstatic void
1254	gc0AddHeaderIfNeeded(String fname)
1255	{
1256	CCode cppline;
1257	if (!gc0IsNewHeader(fname)) return;
1258	if (*fname == '<')
1259	cppline = ccoCppLine(ccoIdOf("include"), ccoIdOf(fname))ccoNew(CCO_CppLine,2,ccoNew(CCO_Id,1,symProbe("include", 1 \| 2 )),ccoNew(CCO_Id,1,symProbe(fname, 1 \| 2)));
1260	else
1261	cppline = ccoCppLine(ccoIdOf("include"), ccoStringOf(fname))ccoNew(CCO_CppLine,2,ccoNew(CCO_Id,1,symProbe("include", 1 \| 2 )),ccoNew(CCO_StringVal,1,symProbe(fname, 1 \| 2)));
1262
1263	gc0AddLine(gcvPreProcCC, cppline)gc0AddLineFun(&(gcvPreProcCC), cppline);
1264	}
1265
1266	/*****************************************************************************
1267	*
1268	* :: Create a fluid C code declaration from the Foam declaration given
1269	* at position 'i' in the Foam fluid variable tree.
1270	*
1271	****************************************************************************/
1272
1273	localstatic CCode
1274	gc0FluidDecl(int i)
1275	{
1276	Foam decl;
1277
1278	decl = gcvFluids->foamDDecl.argv[i];
1279
1280	return ccoDecl(ccoTypeIdOf(gcFiFluid),ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiFluid", 1 \| 2))),gc0MultVarId("F", i, decl->foamDecl.id ))
1281	gc0MultVarId("F", i, decl->foamDecl.id))ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiFluid", 1 \| 2))),gc0MultVarId("F", i, decl->foamDecl.id ));
1282	}
1283
1284	/*****************************************************************************
1285	*
1286	* :: Structure generation
1287	*
1288	****************************************************************************/
1289
1290	localstatic CCodeList gc0DeclList(int n, Foam *argv);
1291
1292	static CCodeList gc0DeclStmts;
1293
1294	/*
1295	* Create a constant C code declaration from the Foam declaration given
1296	* at position 'idx' in the Foam constant Decl tree.
1297	*/
1298
1299	localstatic void
1300	gc0ConstDecl(int idx)
1301	{
1302	Foam progDef, val, decl;
1303	CCode ccType, ccName, ccProgName;
1304	CCode ccProto, ccClass;
1305	String str;
1306
1307	progDef = foamArgv(gcvDefs)((gcvDefs)->foamGen.argv)[idx].code;
1308	assert(foamTag(progDef) == FOAM_Def)do { if (!(((progDef)->hdr.tag) == FOAM_Def)) _do_assert(( "foamTag(progDef) == FOAM_Def"),"genc.c",1308); } while (0);
1309
1310	val = progDef->foamDef.rhs;
1311	if (foamTag(val)((val)->hdr.tag) != FOAM_Prog) return ;
1312
1313	decl = gcvConst->foamDDecl.argv[idx];
1314	str = decl->foamDecl.id;
1315	if (gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax)) {
1316	if (idx) {
1317	Foam fn = gcvConst->foamDDecl.argv[0];
1318	str = strPrintf("%s_%s", fn->foamDecl.id,
1319	decl->foamDecl.id);
1320	}
1321	ccClass = ccoExtern()ccoNew(CCO_Extern,0);
1322	ccType = ccoType(ccoExtern(),ccoIdOf("FiProg"))ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew(CCO_Id,1,symProbe ("FiProg", 1 \| 2)));
1323	}
1324	else {
1325	ccClass = ccoStatic()ccoNew(CCO_Static,0);
1326	ccType = ccoType(ccoStatic(),ccoIdOf("FiProg"))ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew(CCO_Id,1,symProbe ("FiProg", 1 \| 2)));
1327	}
1328
1329	ccName = gc0MultVarId("C", idx, str);
1330	ccProgName = gc0MultVarId("CF", idx, str);
1331	ccProto = ccoFCall(ccProgName, gc0Param(val,ccoNew(CCO_FCall,2,ccProgName,gc0Param(val, val->foamProg. params))
1332	val->foamProg.params))ccoNew(CCO_FCall,2,ccProgName,gc0Param(val, val->foamProg. params));
1333	gc0AddLine(gc0DeclStmts, ccoDecl(ccType, ccName))gc0AddLineFun(&(gc0DeclStmts), ccoNew(CCO_Decl,2,ccType,ccName ));
1334	gc0AddLine(gc0DeclStmts, ccoDecl(ccoType(ccClass, gc0TypeId(val->foamProg.retType, val->foamProg.format)), ccProto))gc0AddLineFun(&(gc0DeclStmts), ccoNew(CCO_Decl,2,ccoNew(CCO_Type ,2,ccClass,gc0TypeId(val->foamProg.retType, val->foamProg .format)),ccProto));
1335	}
1336
1337	localstatic void
1338	gc0InitDeclList()
1339	{
1340	gc0DeclStmts = listNil(CCode)((CCodeList) 0);
1341	}
1342
1343	localstatic CCodeList
1344	gc0FiniDeclList()
1345	{
1346	CCodeList ret = listNReverse(CCode)(CCode_listPointer->NReverse)(gc0DeclStmts);
1347	gc0DeclStmts = listNil(CCode)((CCodeList) 0);
1348	return ret;
1349	}
1350
1351	localstatic void
1352	gc0LexDecl(int num)
1353	{
1354	CCodeList code = listNil(CCode)((CCodeList) 0);
1355	CCode ccLexFmt;
1356	Foam ddecl;
1357
1358	if (!num) return;
1359
1360	ddecl = listElt(Foam)(Foam_listPointer->Elt)(gcvLexStk,gcvLvl);
1361	code = gc0DeclList(foamDDeclArgc(ddecl)(((ddecl)->hdr.argc) - (1)), &ddecl->foamDDecl.argv[0]);
1362	ccLexFmt = gc0ListOf(CCO_Many, code);
1363	listFree(CCode)(CCode_listPointer->Free)(code);
1364	ccLexFmt = ccoStructDef(gc0VarId(gcFmtName, lexesSlot),ccoNew(CCO_StructDef,2,gc0VarId("Fmt", 2),ccLexFmt)
1365	ccLexFmt)ccoNew(CCO_StructDef,2,gc0VarId("Fmt", 2),ccLexFmt);
1366	gc0AddLine(gc0DeclStmts, ccoStat(ccLexFmt))gc0AddLineFun(&(gc0DeclStmts), ccoNew(CCO_Stat,1,ccLexFmt ));
1367	}
1368
1369	localstatic void
1370	gc0LFmtDecl(int idx, Foam ddecl)
1371	{
1372	CCode ccLFmt;
1373	CCodeList code = listNil(CCode)((CCodeList) 0);
1374	/* Trailing arrays are just downright odd */
1375	if (ddecl->foamDDecl.usage == FOAM_DDecl_TrailingArray) {
1376	CCodeList hdr = gc0DeclList(foamTRDDeclIDeclN(ddecl)((ddecl)->foamDDecl.argv[0]->foamDecl.format)
1377	, &foamTRDDeclIDecl(ddecl, int0)((ddecl)->foamDDecl.argv[1+(((int) 0))]));
1378	CCodeList tail = gc0DeclList(foamTRDDeclTDeclN(ddecl)((((ddecl)->hdr.argc) - (1)) - (1+((ddecl)->foamDDecl.argv [0]->foamDecl.format))),
1379	&foamTRDDeclTDecl(ddecl, int0)((ddecl)->foamDDecl.argv [1+ ((ddecl)->foamDDecl.argv[0 ]->foamDecl.format) + (((int) 0))]));
1380
1381	if (tail) {
1382	CCode tl = gc0VarId(gcTFmtName"TFmt", idx);
1383	CCode rhs = ccoARef(ccoIdOf(gcFiTRTail), ccoIdOf(gcFiNARY))ccoNew(CCO_ARef,2,ccoNew(CCO_Id,1,symProbe("tail", 1 \| 2)),ccoNew (CCO_Id,1,symProbe("fiNARY", 1 \| 2)));
1384	CCode def = ccoStructDef(tl, gc0ListOf(CCO_Many, tail))ccoNew(CCO_StructDef,2,tl,gc0ListOf(CCO_Many, tail));
1385	gc0AddLine(gc0DeclStmts, ccoStat(def))gc0AddLineFun(&(gc0DeclStmts), ccoNew(CCO_Stat,1,def));
1386	tail = listSingleton(CCode)(CCode_listPointer->Singleton)(ccoDecl(ccoStructRef(ccoCopy(tl)),ccoNew(CCO_Decl,2,ccoNew(CCO_StructRef,1,ccoCopy(tl)),rhs)
1387	rhs)ccoNew(CCO_Decl,2,ccoNew(CCO_StructRef,1,ccoCopy(tl)),rhs));
1388	}
1389	code = listNConcat(CCode)(CCode_listPointer->NConcat)(hdr, tail);
1390	}
1391	/* Empty structs are tweaked to always have at least one member */
1392	else if (foamDDeclArgc(ddecl)(((ddecl)->hdr.argc) - (1)) == 0) {
1393	CCode ccName, ccDecl;
1394	ccName = gc0MultVarId("X", int0((int) 0), "empty");
1395	ccDecl = ccoDecl(ccoTypeIdOf(gcFiPtr), ccName)ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiPtr", 1 \| 2))),ccName);
1396	gc0AddLine(code, ccDecl)gc0AddLineFun(&(code), ccDecl);
1397	}
1398	else {
1399	code = gc0DeclList(foamDDeclArgc(ddecl)(((ddecl)->hdr.argc) - (1)), &ddecl->foamDDecl.argv[0]);
1400	}
1401	ccLFmt = gc0ListOf(CCO_Many, code);
1402	listFree(CCode)(CCode_listPointer->Free)(code);
1403	gc0AddLine(gc0DeclStmts, ccoStat(ccoStructDef(gc0VarId(gcFmtName, idx),gc0AddLineFun(&(gc0DeclStmts), ccoNew(CCO_Stat,1,ccoNew(CCO_StructDef ,2,gc0VarId("Fmt", idx),ccLFmt)))
1404	ccLFmt)))gc0AddLineFun(&(gc0DeclStmts), ccoNew(CCO_Stat,1,ccoNew(CCO_StructDef ,2,gc0VarId("Fmt", idx),ccLFmt)));
1405	}
1406
1407	/*
1408	* Create a format C code typedef of a structure reference for the format
1409	* number 'idx', e.g. typedef struct Fmt<idx> *PFmt<idx>
1410	*/
1411
1412	localstatic void
1413	gc0LFmtDef(int idx)
1414	{
1415	gc0AddLine(gc0DeclStmts,gc0AddLineFun(&(gc0DeclStmts), ccoNew(CCO_Decl,2,ccoNew(CCO_Type ,2,ccoNew(CCO_Typedef,0),ccoNew(CCO_StructRef,1,gc0VarId("Fmt" , idx))),ccoNew(CCO_PreStar,1,gc0VarId("PFmt", idx))))
1416	ccoDecl(ccoType(ccoTypedef(),gc0AddLineFun(&(gc0DeclStmts), ccoNew(CCO_Decl,2,ccoNew(CCO_Type ,2,ccoNew(CCO_Typedef,0),ccoNew(CCO_StructRef,1,gc0VarId("Fmt" , idx))),ccoNew(CCO_PreStar,1,gc0VarId("PFmt", idx))))
1417	ccoStructRef(gc0VarId(gcFmtName, idx))),gc0AddLineFun(&(gc0DeclStmts), ccoNew(CCO_Decl,2,ccoNew(CCO_Type ,2,ccoNew(CCO_Typedef,0),ccoNew(CCO_StructRef,1,gc0VarId("Fmt" , idx))),ccoNew(CCO_PreStar,1,gc0VarId("PFmt", idx))))
1418	ccoPreStar(gc0VarId(gcFmtType, idx))))gc0AddLineFun(&(gc0DeclStmts), ccoNew(CCO_Decl,2,ccoNew(CCO_Type ,2,ccoNew(CCO_Typedef,0),ccoNew(CCO_StructRef,1,gc0VarId("Fmt" , idx))),ccoNew(CCO_PreStar,1,gc0VarId("PFmt", idx))));
1419	}
1420
1421
1422
1423	localstatic CCodeList
1424	gc0DeclList(int n, Foam *argv)
1425	{
1426	Foam decl;
1427	CCodeList code = listNil(CCode)((CCodeList) 0);
1428	CCode ccDecl, ccName;
1429	int fmt, i;
1430
1431	for (i = 0; i < n; i++) {
1432	decl = argv[i];
1433	fmt = decl->foamDecl.format;
1434	ccName = gc0MultVarId("X", i, decl->foamDecl.id);
1435	ccDecl = gc0Decl(decl, ccName);
1436	gc0AddLine(code, ccDecl)gc0AddLineFun(&(code), ccDecl);
1437	}
1438
1439	return listNReverse(CCode)(CCode_listPointer->NReverse)(code);
1440	}
1441
1442	/*****************************************************************************
1443	*
1444	* :: Create the C definition of an export to C global Foam function, 'gdecl',
1445	* with index 'nglo', and the index 'nprog' to a Foam program definition.
1446	*
1447	****************************************************************************/
1448
1449	localstatic CCode
1450	gc0ExportCDef(String name, Foam gdecl, int nglo, int nprog)
1451	{
1452	CCode ccType, ccName, ccParams, ccArgs, ccBody, ccLast, tmpParams, ccGlo;
1453	CCodeList fnbody = listNil(CCode)((CCodeList) 0);
1454	Foam cprog = foamArgv(gcvDefs)((gcvDefs)->foamGen.argv)[nprog].code;
1455	Foam ccdecl = cprog->foamDef.rhs;
1456	Foam params = ccdecl->foamProg.params;
1457	FoamTag *argTypes;
1458
1459	int i, ix, nparams, nargs;
1460
1461	ccType = gc0TypeId(ccdecl->foamProg.retType, ccdecl->foamProg.format);
1462	ccGlo = gc0MultVarId("G", nglo, gdecl->foamDecl.id);
1463	tmpParams = gc0Param(ccdecl, params);
1464	ccParams = ccoNewNode(CCO_Many, ccoArgc(tmpParams)((tmpParams)->ccoNode.argc)-1);
1465
1466	/* Env variable is first in parameter list, but it is omitted here. */
1467	for (i = 0; i < ccoArgc(tmpParams)((tmpParams)->ccoNode.argc)-1; i++)
1468	ccoArgv(ccParams)((ccParams)->ccoNode.argv)[i] = ccoArgv(tmpParams)((tmpParams)->ccoNode.argv)[i+1];
1469	ccName = ccoIdOf(gdecl->foamDecl.id)ccoNew(CCO_Id,1,symProbe(gdecl->foamDecl.id, 1 \| 2));
1470	nparams = foamDDeclArgc(params)(((params)->hdr.argc) - (1));
1471	nargs = ccoArgc(ccParams)((ccParams)->ccoNode.argc);
1472	ccArgs = ccoNewNode(CCO_Many, nargs + 2);
1473	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[0] = gc0TypeId(ccdecl->foamProg.retType, emptyFormatSlot4);
1474	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[1] = ccoCopy(ccGlo);
1475
1476	argTypes = (FoamTag ) stoAlloc(OB_Other0, sizeof(FoamTag)nparams);
1477
1478	for (i = 2, ix = 0; ix < nparams; i++, ix++) {
1479	Foam decl = params->foamDDecl.argv[ix];
1480	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[i] = gc0MultVarId("P", ix, decl->foamDecl.id);
1481	argTypes[ix] = decl->foamDecl.type;
1482	}
1483
1484	for (ix = 0; i < nargs + 2; i++, ix++)
1485	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[i] = gc0MultVarId("R", ix, "");
1486
1487	ccLast = gc0FiCFun(ccdecl->foamProg.retType,
1488	nparams,
1489	argTypes,
1490	ccArgs,
1491	ccdecl->foamProg.format);
1492
1493	stoFree(argTypes);
1494
1495	fnbody = gc0ExportInit(name, gdecl, nglo);
1496	if (ccdecl->foamProg.retType == FOAM_NOp)
1497	/* void or multiple value return */
1498	gc0AddLine(fnbody, ccoStat(ccLast))gc0AddLineFun(&(fnbody), ccoNew(CCO_Stat,1,ccLast));
1499	else
1500	gc0AddLine(fnbody, ccoReturn(ccoCast(ccoCopy(ccType), ccLast)))gc0AddLineFun(&(fnbody), ccoNew(CCO_Return,1,ccoNew(CCO_Cast ,2,ccoCopy(ccType),ccLast)));
1501	fnbody = listNReverse(CCode)(CCode_listPointer->NReverse)(fnbody);
1502	ccBody = ccoCompound(gc0ListOf(CCO_Many, fnbody))ccoNew(CCO_Compound,1,gc0ListOf(CCO_Many, fnbody));
1503	listFree(CCode)(CCode_listPointer->Free)(fnbody);
1504
1505	return ccoFDef(ccType, ccName, ccParams, ccBody)ccoNew(CCO_FDef,4,ccType,ccName,ccParams,ccBody);
1506	}
1507
1508	/* Args are:
1509	* name: Name of this function
1510	* gdecl: decl for export
1511	* argsformat: Fortran DDecl of arguments
1512	* fnparam_name: name of closure (if applicable)
1513	* nglo: Global number
1514	*
1515	* Result is a function `name' suitable for calling from fortran,
1516	* which calls an aldor function.
1517	* The code below needs a good solid kick.
1518	*/
1519	localstatic CCode
1520	gc0ExportToFortran(String name, Foam gdecl, Foam argsformat,
1521	FtnFunParam fnpar, int nglo)
1522	{
1523	CCode ccClos;
1524	CCode ccType, ccName, ccParams, ccBody, ccCmplxArgName;
1525	CCode ccCmplxType, ccResTmpCast, cctmp, cctmp1;
1526	CCodeList fndefparams, fndefexecs, fndefbody;
1527	CCodeList fndefafter = listNil(CCode)((CCodeList) 0);
1528	CCodeList fndefmainparams = listNil(CCode)((CCodeList) 0);
1529	CCodeList fndefchrlenparams = listNil(CCode)((CCodeList) 0);
1530	CCodeList fndefdecls = listNil(CCode)((CCodeList) 0);
1531	CCodeList wordtmps = listNil(CCode)((CCodeList) 0);
1532
1533	CCode ccResTmp, ccArgs, ccArgName, ccFiCCall, ccResType;
1534	CCode ccStringArgName;
1535	CCode ccStringLenName, ccStringLenType;
1536	FoamTag *argTypes;
1537
1538	int i;
1539	int nxlargs = foamDDeclArgc(argsformat)(((argsformat)->hdr.argc) - (1)) - 1;
1540	int ntmps = 0;
1541	int nchrargs = 0;
1542	char num[20];
1543	String varname, argname;
1544
1545	FortranType argtype;
1546
1547	String cmplxfns = compCfgLookupString("fortran-cmplx-fns");
1548	Bool cmplxfirstarg = false((int) 0);
1549	Bool stringfirstarg = false((int) 0);
1550	Bool hasReturn = true1;
1551	FoamTag fmrestype = (argsformat->foamDDecl.argv[nxlargs])->foamDecl.type;
1552	FortranType ftnrestype = gc0GetFortranRetType(argsformat);
1553
1554	if (ftnrestype && (ftnrestype != FTN_Machine))
1555	fmrestype = gen0FtnMachineType(ftnrestype);
1556
1557	ccType = NULL((void*)0);
1558	ccCmplxType = NULL((void*)0);
1559	ccCmplxArgName = NULL((void*)0);
1560	ccResTmp = NULL((void*)0);
1561	ccResType = NULL((void*)0);
1562
1563
1564	/* Hack */
1565	if (fmrestype == FOAM_Char)
1566	ftnrestype = FTN_Character;
1567
1568	/* Deal with return value. SEE gc0IdFortranDecl() ... */
1569	ccStringArgName = 0;
1570	ccStringLenName = 0;
1571	switch (ftnrestype) {
1572	case FTN_Boolean:
1573	/* Fall through */
1574	case FTN_SingleInteger:
1575	ccType = ccoTypeIdOf(gcFiSInt)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiSInt", 1 \| 2)));
1576	ccResType = ccoCopy(ccType);
1577	break;
1578	case FTN_FSingle:
1579	ccType = ccoTypeIdOf(gcFiSFlo)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiSFlo", 1 \| 2)));
1580	ccResType = ccoCopy(ccType);
1581	break;
1582	case FTN_FDouble:
1583	ccType = ccoTypeIdOf(gcFiDFlo)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiDFlo", 1 \| 2)));
1584	ccResType = ccoCopy(ccType);
1585	break;
1586	case FTN_Character:
1587	/* Fall through */
1588	case FTN_String:
1589	/*
1590	* Unless the user is doing something silly with pretend
1591	* then it is safe to assume that the length of the string
1592	* will be the same as the length specified by its type.
1593	* This in turn ought to correspond to the size used by
1594	* the Fortran function otherwise the Fortran RTS will
1595	* barf. The end result is that we can pretend that it is
1596	* a normal Aldor String.
1597	*/
1598	/* Fall through */
1599	case FTN_XLString:
1600	/*
1601	* String return values are implemented in Fortran
1602	* by passing them as the first argument immediately
1603	* followed by the string length. Other parameters
1604	* come after this pair.
1605	*/
1606	stringfirstarg = true1;
1607	hasReturn = false((int) 0);
1608	ccStringLenName = ccoIdOf("STRINGRESLEN")ccoNew(CCO_Id,1,symProbe("STRINGRESLEN", 1 \| 2));
1609	ccStringArgName = ccoIdOf("STRINGRESULT")ccoNew(CCO_Id,1,symProbe("STRINGRESULT", 1 \| 2));
1610	ccStringLenType = ccoTypeIdOf(gcFiSInt)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiSInt", 1 \| 2)));
1611
1612
1613	/* Add the two new parameters to the list */
1614	gc0AddLine(fndefmainparams,gc0AddLineFun(&(fndefmainparams), ccoNew(CCO_Param,3,ccStringArgName ,ccoNew(CCO_Char,0),ccoNew(CCO_PreStar,1,ccoCopy(ccStringArgName ))))
1615	ccoParam(ccStringArgName,gc0AddLineFun(&(fndefmainparams), ccoNew(CCO_Param,3,ccStringArgName ,ccoNew(CCO_Char,0),ccoNew(CCO_PreStar,1,ccoCopy(ccStringArgName ))))
1616	ccoChar(),gc0AddLineFun(&(fndefmainparams), ccoNew(CCO_Param,3,ccStringArgName ,ccoNew(CCO_Char,0),ccoNew(CCO_PreStar,1,ccoCopy(ccStringArgName ))))
1617	ccoPreStar(ccoCopy(ccStringArgName))))gc0AddLineFun(&(fndefmainparams), ccoNew(CCO_Param,3,ccStringArgName ,ccoNew(CCO_Char,0),ccoNew(CCO_PreStar,1,ccoCopy(ccStringArgName ))));
1618	gc0AddLine(fndefmainparams,gc0AddLineFun(&(fndefmainparams), ccoNew(CCO_Param,3,ccStringLenName ,ccStringLenType,ccoCopy(ccStringLenName)))
1619	ccoParam(ccStringLenName,gc0AddLineFun(&(fndefmainparams), ccoNew(CCO_Param,3,ccStringLenName ,ccStringLenType,ccoCopy(ccStringLenName)))
1620	ccStringLenType,gc0AddLineFun(&(fndefmainparams), ccoNew(CCO_Param,3,ccStringLenName ,ccStringLenType,ccoCopy(ccStringLenName)))
1621	ccoCopy(ccStringLenName)))gc0AddLineFun(&(fndefmainparams), ccoNew(CCO_Param,3,ccStringLenName ,ccStringLenType,ccoCopy(ccStringLenName)));
1622	ccResType = gc0TypeId(FOAM_Word, emptyFormatSlot4);
1623	break;
1624	case FTN_FDComplex:
1625	/* Fall through */
1626	case FTN_FSComplex:
1627	ccCmplxType = ccoTypeIdOf(ftnrestype == FTN_FSComplex ? gcFiComplexSF : gcFiComplexDF)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe(ftnrestype == FTN_FSComplex ? "FiComplexSF" : "FiComplexDF", 1 \| 2)));
1628	if (!cmplxfns)
1629	comsgFatal(NULL((void*)0), ALDOR_F_NoFCmplxProperty272, "fortran-cmplx-fns");
1630	else if (strEqual(cmplxfns, "return-void")) {
1631	cmplxfirstarg = true1;
1632	hasReturn = false((int) 0);
1633	ccCmplxArgName = ccoIdOf("CMPLXRESULT")ccoNew(CCO_Id,1,symProbe("CMPLXRESULT", 1 \| 2));
1634	gc0AddLine(fndefmainparams,gc0AddLineFun(&(fndefmainparams), ccoNew(CCO_Param,3,ccCmplxArgName ,ccCmplxType,ccoNew(CCO_PreStar,1,ccoCopy(ccCmplxArgName))))
1635	ccoParam(ccCmplxArgName,gc0AddLineFun(&(fndefmainparams), ccoNew(CCO_Param,3,ccCmplxArgName ,ccCmplxType,ccoNew(CCO_PreStar,1,ccoCopy(ccCmplxArgName))))
1636	ccCmplxType,gc0AddLineFun(&(fndefmainparams), ccoNew(CCO_Param,3,ccCmplxArgName ,ccCmplxType,ccoNew(CCO_PreStar,1,ccoCopy(ccCmplxArgName))))
1637	ccoPreStar(ccoCopy(ccCmplxArgName))))gc0AddLineFun(&(fndefmainparams), ccoNew(CCO_Param,3,ccCmplxArgName ,ccCmplxType,ccoNew(CCO_PreStar,1,ccoCopy(ccCmplxArgName))));
1638	}
1639	else if (strEqual(cmplxfns, "return-struct"))
1640	ccType = ccCmplxType;
1641	else if (strEqual(cmplxfns, "disallowed"))
1642	bug("gc0ExportToFortran: A function returning a complex result is exported/passed to Fortran");
1643	else
1644	comsgFatal(NULL((void*)0), ALDOR_F_BadFCmplxValue273, cmplxfns);
1645	ccResType = gc0TypeId(FOAM_Word, emptyFormatSlot4);
1646	break;
1647	default:
1648	switch (fmrestype) {
1649	case FOAM_NOp:
1650	hasReturn = false((int) 0);
1651	break;
1652	case FOAM_Bool :
1653	/* Fall through */
1654	case FOAM_SInt :
1655	ccType = ccoTypeIdOf(gcFiSInt)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiSInt", 1 \| 2)));
1656	ccResType = ccoCopy(ccType);
1657	break;
1658	default:
1659	ccType = gc0TypeId(fmrestype, emptyFormatSlot4);
1660	ccResType = ccoCopy(ccType);
1661	break;
1662	}
1663	}
1664
1665
1666	/* If no return value then the function type is void */
1667	if (!hasReturn)
1668	ccType = gc0TypeId(FOAM_NOp, emptyFormatSlot4);
1669
1670
1671	/* Temporary for return value */
1672	(void)sprintf(num, "%d", ntmps++);
1673	varname = strConcat("T", num);
1674	ccResTmp = ccoIdOf(varname)ccoNew(CCO_Id,1,symProbe(varname, 1 \| 2));
1675	strFree(varname);
1676
1677
1678	/* Add initialiser or declaration */
1679	if (fnpar)
1680	{
1681	/* Function being passed as parameter to Fortran */
1682	ccName = gc0FtnFunDeclare(fnpar, ccType);
1683	ccClos = gc0FtnFunClosure(fnpar)((fnpar)->clos);
1684	fndefexecs = listNil(CCode)((CCodeList) 0);
1685	}
1686	else
1687	{
1688	ccName = ccoIdOf(gc0GenFortranName(gdecl->foamDecl.id))ccoNew(CCO_Id,1,symProbe(gc0GenFortranName(gdecl->foamDecl .id), 1 \| 2));
1689	ccClos = gc0MultVarId("G", nglo, gdecl->foamDecl.id);
1690	fndefexecs = gc0ExportInit(name, gdecl, nglo);
1691	}
1692
1693	/* Arguments: first two are fakes (function type and name) */
1694	ccArgs = ccoNewNode(CCO_Many, nxlargs + 2);
1695	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[0] = gc0TypeId(fmrestype, emptyFormatSlot4);
1696	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[1] = ccoCopy(ccClos);
1697
1698	argTypes = (FoamTag ) stoAlloc(OB_Other0, nxlargs sizeof(FoamTag));
1699
1700	for (i = 0; i < nxlargs; i++) {
1701	Foam decl = argsformat->foamDDecl.argv[i];
1702	CCode ccParam;
1703	Bool modifiablearg = gc0IsModifiableFortranArg(decl);
1704	argname = gc0GetFortranArgName(decl);
1705	ccArgName = gc0MultVarId("P", i, argname);
1706	argtype = gc0GetFortranType(decl);
1707
1708
1709	/* Construct parameter list */
1710	/*
1711	* How many of these cases are now obsolete - we ought to
1712	* only ever find FOAM_Word arguments since our function
1713	* ought to have been wrapped up for us during genfoam.
1714	* We do get FTN_XLString though ...
1715	*/
1716	switch (argtype) {
1717	case FTN_Boolean:
1718	case FTN_Machine:
1719	case FTN_SingleInteger:
1720	argTypes[i] = decl->foamDecl.type;
1721	cctmp = gc0TypeId(argTypes[i], emptyFormatSlot4);
1722	ccParam = ccoParam(ccArgName, cctmp,ccoNew(CCO_Param,3,ccArgName,cctmp,ccoCopy(ccArgName))
1723	ccoCopy(ccArgName))ccoNew(CCO_Param,3,ccArgName,cctmp,ccoCopy(ccArgName));
1724	break;
1725	case FTN_FSingle:
1726	argTypes[i] = FOAM_Word;
1727	cctmp = gc0TypeId(FOAM_SFlo, emptyFormatSlot4);
1728	ccParam = ccoParam(ccArgName, cctmp,ccoNew(CCO_Param,3,ccArgName,cctmp,ccoCopy(ccArgName))
1729	ccoCopy(ccArgName))ccoNew(CCO_Param,3,ccArgName,cctmp,ccoCopy(ccArgName));
1730	break;
1731	case FTN_FDouble:
1732	argTypes[i] = FOAM_Word;
1733	cctmp = gc0TypeId(FOAM_DFlo, emptyFormatSlot4);
1734	ccParam = ccoParam(ccArgName, cctmp,ccoNew(CCO_Param,3,ccArgName,cctmp,ccoCopy(ccArgName))
1735	ccoCopy(ccArgName))ccoNew(CCO_Param,3,ccArgName,cctmp,ccoCopy(ccArgName));
1736	break;
1737	default:
1738	argTypes[i] = decl->foamDecl.type;
1739	cctmp = gc0TypeId(argTypes[i], emptyFormatSlot4);
1740	ccParam = ccoParam(ccArgName, cctmp,ccoNew(CCO_Param,3,ccArgName,cctmp,ccoCopy(ccArgName))
1741	ccoCopy(ccArgName))ccoNew(CCO_Param,3,ccArgName,cctmp,ccoCopy(ccArgName));
1742	}
1743	gc0AddLine(fndefmainparams, ccParam)gc0AddLineFun(&(fndefmainparams), ccParam);
1744
1745
1746	/* Fill in the body */
1747	switch (argtype) {
1748	case FTN_Character:
1749	/* Fall through: see gf_fortran.c */
1750	case FTN_String:
1751	/* Fall through */
1752	case FTN_XLString:
1753	/* String parameters are special */
1754	cctmp = gc0ExportFtnString(
1755	ccArgName,
1756	modifiablearg,
1757	&wordtmps,
1758	&fndefchrlenparams,
1759	&fndefexecs,
1760	&fndefafter,
1761	&nchrargs,
1762	&ntmps);
1763	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[i+2] = cctmp;
1764	if (fnpar) gc0AddHeaderIfNeeded("<string.h>");
1765	break;
1766	case FTN_FSComplex:
1767	case FTN_FDComplex:
1768	case FTN_Array:
1769	case FTN_Word:
1770	case FTN_FSingle:
1771	case FTN_FDouble:
1772	case FTN_Boolean:
1773	case FTN_Machine:
1774	case FTN_SingleInteger:
1775	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[i+2] = gc0MultVarId("P", i, argname);
1776	break;
1777	case FTN_FnParam:
1778	if (fnpar)
1779	bug(
1780	"gc0ExportToFortran: A Fortran routine function parameter itself has a function parameter");
1781	else
1782	bug(
1783	"gc0ExportToFortran: Export to Fortran has a function parameter");
1784	break;
1785	default:
1786	bug("unknown type in make-arglist");
1787	break;
1788	}
1789	strFree(argname);
1790
1791	}
1792
1793	fndefchrlenparams = listNReverse(CCode)(CCode_listPointer->NReverse)(fndefchrlenparams);
1794	fndefmainparams = listNReverse(CCode)(CCode_listPointer->NReverse)(fndefmainparams);
1795	fndefparams = listNConcat(CCode)(CCode_listPointer->NConcat)(fndefmainparams, fndefchrlenparams);
1796	ccParams = gc0ListOf(CCO_Many, fndefparams);
1797	listFree(CCode)(CCode_listPointer->Free)(fndefmainparams);
1798
1799	if (hasReturn)
1800	{
1801	ccFiCCall = gc0FiCFun(fmrestype, nxlargs, argTypes,
1802	ccArgs, emptyFormatSlot4);
1803	}
1804	else
1805	{
1806	ccFiCCall = gc0FiCFun(FOAM_NOp, nxlargs, argTypes,
1807	ccArgs, emptyFormatSlot4);
1808	}
1809
1810
1811	stoFree(argTypes);
1812	argTypes = NULL((void*)0);
1813
1814	switch (ftnrestype) {
1815	case FTN_Character:
1816	/*
1817	* Store the result of our Aldor function in a
1818	* temporary variable (ccResTmp).
1819	*/
1820	cctmp = ccoAsst(ccoCopy(ccResTmp), ccFiCCall)ccoNew(CCO_Asst,2,ccoCopy(ccResTmp),ccFiCCall);
1821	gc0AddLine(fndefexecs, ccoStat(cctmp))gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,cctmp));
1822
1823
1824	/*
1825	* Characters are passed as strings of length 1 so
1826	* we generate the following code:
1827	*
1828	* T = foo( ... );
1829	* (char )STRINGRESULT = (char)T;
1830	*/
1831	cctmp = ccoCopy(ccStringArgName);
1832	cctmp = ccoCast(ccoPostStar(ccoChar()), cctmp)ccoNew(CCO_Cast,2,ccoNew(CCO_PostStar,1,ccoNew(CCO_Char,0)),cctmp );
1833	cctmp = ccoPreStar(cctmp)ccoNew(CCO_PreStar,1,cctmp);
1834	cctmp1 = ccoCast(ccoChar(), ccoCopy(ccResTmp))ccoNew(CCO_Cast,2,ccoNew(CCO_Char,0),ccoCopy(ccResTmp));
1835	cctmp = ccoAsst(cctmp, cctmp1)ccoNew(CCO_Asst,2,cctmp,cctmp1);
1836	gc0AddLine(fndefexecs, ccoStat(cctmp))gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,cctmp));
1837	break;
1838	case FTN_String:
1839	/* Fall through (see earlier explanation) */
1840	case FTN_XLString:
1841	/*
1842	* Store the result of our Aldor function in a
1843	* temporary variable (ccResTmp).
1844	*/
1845	cctmp = ccoAsst(ccoCopy(ccResTmp), ccFiCCall)ccoNew(CCO_Asst,2,ccoCopy(ccResTmp),ccFiCCall);
1846	gc0AddLine(fndefexecs, ccoStat(cctmp))gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,cctmp));
1847
1848
1849	/*
1850	* Copy the result string into the pointer passed to us
1851	* by the Fortran RTS. This assumes that they are NUL
1852	* terminated (normal for Aldor strings) or that they
1853	* are at least as long as Fortran wants them to be.
1854	*
1855	* We generate the following code:
1856	*
1857	* T = foo( ... );
1858	* strncpy((char )STRINGRESULT,(char )T,STRINGRESLEN);
1859	*/
1860	cctmp = ccoCopy(ccStringArgName);
1861	cctmp = ccoCast(ccoPostStar(ccoChar()), cctmp)ccoNew(CCO_Cast,2,ccoNew(CCO_PostStar,1,ccoNew(CCO_Char,0)),cctmp );
1862	cctmp1 = ccoCast(ccoPostStar(ccoChar()), ccoCopy(ccResTmp))ccoNew(CCO_Cast,2,ccoNew(CCO_PostStar,1,ccoNew(CCO_Char,0)),ccoCopy (ccResTmp));
1863	cctmp = ccoMany3(cctmp, cctmp1, ccoCopy(ccStringLenName))ccoNew(CCO_Many,3,cctmp,cctmp1,ccoCopy(ccStringLenName));
1864	cctmp = ccoStat(ccoFCall(ccoIdOf("strncpy"), cctmp))ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("strncpy", 1 \| 2)),cctmp));
1865	gc0AddLine(fndefexecs, cctmp)gc0AddLineFun(&(fndefexecs), cctmp);
1866
1867
1868	/* We ought to add a NUL terminator */
1869	break;
1870	case FTN_FSComplex:
1871	case FTN_FDComplex:
1872	cctmp = ccoAsst(ccoCopy(ccResTmp), ccFiCCall)ccoNew(CCO_Asst,2,ccoCopy(ccResTmp),ccFiCCall);
1873	gc0AddLine(fndefexecs, ccoStat(cctmp))gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,cctmp));
1874	cctmp = ccoPostStar(ccoCopy(ccCmplxType))ccoNew(CCO_PostStar,1,ccoCopy(ccCmplxType));
1875	ccResTmpCast = ccoParen(ccoCast(cctmp, ccoCopy(ccResTmp)))ccoNew(CCO_Paren,1,ccoNew(CCO_Cast,2,cctmp,ccoCopy(ccResTmp)) );
1876	if (cmplxfirstarg) {
1877	gc0AddLine(fndefexecs, ccoStat(ccoAsst(ccoPointsTo(ccoCopy(ccCmplxArgName),gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,ccoNew(CCO_Asst ,2,ccoNew(CCO_PointsTo,2,ccoCopy(ccCmplxArgName),ccoNew(CCO_Id ,1,symProbe("real", 1 \| 2))),ccoNew(CCO_PointsTo,2,ccResTmpCast ,ccoNew(CCO_Id,1,symProbe("real", 1 \| 2))))))
1878	ccoIdOf("real")),gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,ccoNew(CCO_Asst ,2,ccoNew(CCO_PointsTo,2,ccoCopy(ccCmplxArgName),ccoNew(CCO_Id ,1,symProbe("real", 1 \| 2))),ccoNew(CCO_PointsTo,2,ccResTmpCast ,ccoNew(CCO_Id,1,symProbe("real", 1 \| 2))))))
1879	ccoPointsTo(ccResTmpCast,gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,ccoNew(CCO_Asst ,2,ccoNew(CCO_PointsTo,2,ccoCopy(ccCmplxArgName),ccoNew(CCO_Id ,1,symProbe("real", 1 \| 2))),ccoNew(CCO_PointsTo,2,ccResTmpCast ,ccoNew(CCO_Id,1,symProbe("real", 1 \| 2))))))
1880	ccoIdOf("real")))))gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,ccoNew(CCO_Asst ,2,ccoNew(CCO_PointsTo,2,ccoCopy(ccCmplxArgName),ccoNew(CCO_Id ,1,symProbe("real", 1 \| 2))),ccoNew(CCO_PointsTo,2,ccResTmpCast ,ccoNew(CCO_Id,1,symProbe("real", 1 \| 2))))));
1881	gc0AddLine(fndefexecs, ccoStat(ccoAsst(ccoPointsTo(ccoCopy(ccCmplxArgName),gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,ccoNew(CCO_Asst ,2,ccoNew(CCO_PointsTo,2,ccoCopy(ccCmplxArgName),ccoNew(CCO_Id ,1,symProbe("imag", 1 \| 2))),ccoNew(CCO_PointsTo,2,ccoCopy(ccResTmpCast ),ccoNew(CCO_Id,1,symProbe("imag", 1 \| 2))))))
1882	ccoIdOf("imag")),gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,ccoNew(CCO_Asst ,2,ccoNew(CCO_PointsTo,2,ccoCopy(ccCmplxArgName),ccoNew(CCO_Id ,1,symProbe("imag", 1 \| 2))),ccoNew(CCO_PointsTo,2,ccoCopy(ccResTmpCast ),ccoNew(CCO_Id,1,symProbe("imag", 1 \| 2))))))
1883	ccoPointsTo(ccoCopy(ccResTmpCast),gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,ccoNew(CCO_Asst ,2,ccoNew(CCO_PointsTo,2,ccoCopy(ccCmplxArgName),ccoNew(CCO_Id ,1,symProbe("imag", 1 \| 2))),ccoNew(CCO_PointsTo,2,ccoCopy(ccResTmpCast ),ccoNew(CCO_Id,1,symProbe("imag", 1 \| 2))))))
1884	ccoIdOf("imag")))))gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,ccoNew(CCO_Asst ,2,ccoNew(CCO_PointsTo,2,ccoCopy(ccCmplxArgName),ccoNew(CCO_Id ,1,symProbe("imag", 1 \| 2))),ccoNew(CCO_PointsTo,2,ccoCopy(ccResTmpCast ),ccoNew(CCO_Id,1,symProbe("imag", 1 \| 2))))));
1885	}
1886	else
1887	{
1888	gc0AddLine(fndefexecs, ccoStat(ccoAsst(ccoCopy(ccResTmp),gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,ccoNew(CCO_Asst ,2,ccoCopy(ccResTmp),ccoNew(CCO_PreStar,1,ccResTmpCast))))
1889	ccoPreStar(ccResTmpCast))))gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,ccoNew(CCO_Asst ,2,ccoCopy(ccResTmp),ccoNew(CCO_PreStar,1,ccResTmpCast))));
1890	}
1891	break;
1892	default:
1893	if (hasReturn)
1894	{
1895	gc0AddLine(fndefexecs, ccoStat(ccoAsst(ccoCopy(ccResTmp),gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,ccoNew(CCO_Asst ,2,ccoCopy(ccResTmp),ccoNew(CCO_Cast,2,ccoCopy(ccType),ccFiCCall ))))
1896	ccoCast(ccoCopy(ccType), ccFiCCall))))gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,ccoNew(CCO_Asst ,2,ccoCopy(ccResTmp),ccoNew(CCO_Cast,2,ccoCopy(ccType),ccFiCCall ))));
1897	}
1898	else
1899	{
1900	gc0AddLine(fndefexecs, ccoStat(ccFiCCall))gc0AddLineFun(&(fndefexecs), ccoNew(CCO_Stat,1,ccFiCCall) );
1901	ccResTmp = (CCode)NULL((void)0); / Temp not used */
1902	}
1903	break;
1904	}
1905
1906	if (ccResTmp)
1907	{
1908	/* Declare the temporary */
1909	cctmp = ccoDecl(ccoCopy(ccResType), ccoCopy(ccResTmp))ccoNew(CCO_Decl,2,ccoCopy(ccResType),ccoCopy(ccResTmp));
1910	gc0AddLine(fndefdecls, cctmp)gc0AddLineFun(&(fndefdecls), cctmp);
1911
1912	/* Add a return statement if required */
1913	if (hasReturn)
1914	gc0AddLine(fndefafter, ccoReturn(ccResTmp))gc0AddLineFun(&(fndefafter), ccoNew(CCO_Return,1,ccResTmp ));
1915	}
1916
1917	if (wordtmps) {
1918	wordtmps = listNReverse(CCode)(CCode_listPointer->NReverse)(wordtmps);
1919	gc0AddLine(fndefdecls, ccoDecl(gc0TypeId(FOAM_Word, emptyFormatSlot),gc0AddLineFun(&(fndefdecls), ccoNew(CCO_Decl,2,gc0TypeId( FOAM_Word, 4),gc0ListOf(CCO_Many, wordtmps)))
1920	gc0ListOf(CCO_Many, wordtmps)))gc0AddLineFun(&(fndefdecls), ccoNew(CCO_Decl,2,gc0TypeId( FOAM_Word, 4),gc0ListOf(CCO_Many, wordtmps)));
1921	listFree(CCode)(CCode_listPointer->Free)(wordtmps);
1922	}
1923
1924	fndefdecls = listNReverse(CCode)(CCode_listPointer->NReverse)(fndefdecls);
1925	fndefexecs = listNReverse(CCode)(CCode_listPointer->NReverse)(fndefexecs);
1926	fndefafter = listNReverse(CCode)(CCode_listPointer->NReverse)(fndefafter);
1927
1928	fndefbody = listNConcat(CCode)(CCode_listPointer->NConcat)(fndefdecls, fndefexecs);
1929	fndefbody = listNConcat(CCode)(CCode_listPointer->NConcat)(fndefbody, fndefafter);
1930	ccBody = ccoCompound(gc0ListOf(CCO_Many, fndefbody))ccoNew(CCO_Compound,1,gc0ListOf(CCO_Many, fndefbody));
1931	listFree(CCode)(CCode_listPointer->Free)(fndefbody);
1932
1933	if (fnpar)
1934	ccType = ccoType(ccoCopy(gc0FtnFunClass(fnpar)), ccType)ccoNew(CCO_Type,2,ccoCopy(((fnpar)->class)),ccType);
1935
1936	return ccoFDef(ccType, ccName, ccParams, ccBody)ccoNew(CCO_FDef,4,ccType,ccName,ccParams,ccBody);
1937	}
1938
1939	localstatic CCode
1940	gc0ExportFtnString(CCode ccArg, Bool mod,
1941	CCodeList tmps, CCodeList chrlens,
1942	CCodeList execs, CCodeList after,
1943	int nchrargs, int ntmps)
1944	{
1945	char num[100];
1946	String varname;
1947	CCode cctmp, cctmp1;
1948	CCode ccStringTmp, ccChrLenArg, ccStringLen;
1949
1950
1951	/* Get the name of the string length argument */
1952	(void)sprintf(num, "%d", *nchrargs);
1953	nchrargs = nchrargs + 1;
1954	varname = strConcat("CHRLEN", num);
1955	ccChrLenArg = ccoIdOf(varname)ccoNew(CCO_Id,1,symProbe(varname, 1 \| 2));
1956	strFree(varname);
1957
1958
1959	/* Declare the the string temporary variable */
1960	(void)sprintf(num, "%d", *ntmps);
1961	ntmps = ntmps + 1;
1962	varname = strConcat("T", num);
1963	ccStringTmp = ccoIdOf(varname)ccoNew(CCO_Id,1,symProbe(varname, 1 \| 2));
1964	gc0AddLine(tmps, ccStringTmp)gc0AddLineFun(&(tmps), ccStringTmp);
1965	strFree(varname);
1966
1967
1968	/* Add the declaration for the string length argument */
1969	cctmp = ccoTypeIdOf("int")ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("int", 1 \| 2) ));
1970	cctmp1 = ccoCopy(ccChrLenArg);
1971	cctmp = ccoParam(ccChrLenArg, cctmp, cctmp1)ccoNew(CCO_Param,3,ccChrLenArg,cctmp,cctmp1);
1972	gc0AddLine(chrlens, cctmp)gc0AddLineFun(&(chrlens), cctmp);
1973
1974
1975	/* Create a new string: fiARRNEW_Char() */
1976	ccStringLen = ccoPlus(ccoCopy(ccChrLenArg), ccoIdOf("1"))ccoNew(CCO_Plus,2,ccoCopy(ccChrLenArg),ccoNew(CCO_Id,1,symProbe ("1", 1 \| 2)));
1977	cctmp = gc0TypeId(FOAM_Word, emptyFormatSlot4);
1978	cctmp = ccoMany3(ccoCopy(ccStringTmp), cctmp, ccStringLen)ccoNew(CCO_Many,3,ccoCopy(ccStringTmp),cctmp,ccStringLen);
1979	cctmp = ccoStat(ccoFCall(ccoIdOf("fiARRNEW_Char"), cctmp))ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiARRNEW_Char", 1 \| 2)),cctmp));
1980	gc0AddLine(execs, cctmp)gc0AddLineFun(&(execs), cctmp);
1981
1982
1983	/* Copy the Fortran string into the temporary */
1984	cctmp = ccoCast(ccoPostStar(ccoChar()), ccoCopy(ccStringTmp))ccoNew(CCO_Cast,2,ccoNew(CCO_PostStar,1,ccoNew(CCO_Char,0)),ccoCopy (ccStringTmp));
1985	cctmp1 = ccoCast(ccoPostStar(ccoChar()), ccoCopy(ccArg))ccoNew(CCO_Cast,2,ccoNew(CCO_PostStar,1,ccoNew(CCO_Char,0)),ccoCopy (ccArg));
1986	cctmp = ccoMany3(cctmp, cctmp1, ccoCopy(ccChrLenArg))ccoNew(CCO_Many,3,cctmp,cctmp1,ccoCopy(ccChrLenArg));
1987	cctmp = ccoStat(ccoFCall(ccoIdOf("strncpy"), cctmp))ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("strncpy", 1 \| 2)),cctmp));
1988	gc0AddLine(execs, cctmp)gc0AddLineFun(&(execs), cctmp);
1989
1990
1991	/* Append the NUL terminator */
1992	cctmp = ccoCast(ccoPostStar(ccoChar()), ccoCopy(ccStringTmp))ccoNew(CCO_Cast,2,ccoNew(CCO_PostStar,1,ccoNew(CCO_Char,0)),ccoCopy (ccStringTmp));
1993	cctmp = ccoARef(ccoParen(cctmp), ccoCopy(ccChrLenArg))ccoNew(CCO_ARef,2,ccoNew(CCO_Paren,1,cctmp),ccoCopy(ccChrLenArg ));
1994	cctmp1 = ccoCast(ccoChar(), ccoIdOf("0"))ccoNew(CCO_Cast,2,ccoNew(CCO_Char,0),ccoNew(CCO_Id,1,symProbe ("0", 1 \| 2)));
1995	cctmp = ccoStat(ccoAsst(cctmp, cctmp1))ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,cctmp,cctmp1));
1996	gc0AddLine(execs, cctmp)gc0AddLineFun(&(execs), cctmp);
1997
1998
1999	/* Create after-call code to write the string back? */
2000	if (mod)
2001	{
2002	cctmp = ccoCast(ccoPostStar(ccoChar()), ccoCopy(ccArg))ccoNew(CCO_Cast,2,ccoNew(CCO_PostStar,1,ccoNew(CCO_Char,0)),ccoCopy (ccArg));
2003	cctmp1 = ccoCast(ccoPostStar(ccoChar()), ccoCopy(ccStringTmp))ccoNew(CCO_Cast,2,ccoNew(CCO_PostStar,1,ccoNew(CCO_Char,0)),ccoCopy (ccStringTmp));
2004	cctmp = ccoMany3(cctmp, cctmp1, ccoCopy(ccChrLenArg))ccoNew(CCO_Many,3,cctmp,cctmp1,ccoCopy(ccChrLenArg));
2005	cctmp = ccoStat(ccoFCall(ccoIdOf("strncpy"), cctmp))ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("strncpy", 1 \| 2)),cctmp));
2006	gc0AddLine(after, cctmp)gc0AddLineFun(&(after), cctmp);
2007	}
2008
2009
2010	/* Return the parameter */
2011	return ccoCopy(ccStringTmp);
2012	}
2013
2014
2015	localstatic CCodeList
2016	gc0ExportInit(String name, Foam gdecl, int nglo)
2017	{
2018	AInt init;
2019	Foam ginit, ginit0;
2020	CCode ccInit, ccInit0, ccGlo, ccCall;
2021	CCodeList stmts = listNil(CCode)((CCodeList) 0);
2022
2023	if (gdecl->foamGDecl.protocol == FOAM_Proto_Fortran)
2024	init = (AInt) 0;
2025	else
2026	init = gdecl->foamDecl.format;
2027	ginit = gcvGlo->foamDDecl.argv[init];
2028	ginit0 = gcvGlo->foamDDecl.argv[0];
2029	ccInit = gc0MultVarId("G", nglo, ginit->foamDecl.id);
2030	ccInit0 = gc0MultVarId("G", nglo, ginit0->foamDecl.id);
2031	ccGlo = gc0MultVarId("G", nglo, gdecl->foamDecl.id);
2032	if (init == 0) {
2033	ccCall = ccoFCall(gc0MultVarId(gcFiInitModulePrefix,ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0), name),((int ) 0))
2034	int0, name),ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0), name),((int ) 0))
2035	int0)ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0), name),((int ) 0));
2036	gc0AddLine(stmts, ccoStat(ccCall))gc0AddLineFun(&(stmts), ccoNew(CCO_Stat,1,ccCall));
2037	ccCall = gcFiCCallN(int0,ccoNew(CCO_FCall,2,gc0VarId("fiCCall", ((int) 0)),ccoNew(CCO_Many ,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2))),ccoCopy(ccInit0)))
2038	ccoMany2(ccoTypeIdOf(gcFiClos),ccoNew(CCO_FCall,2,gc0VarId("fiCCall", ((int) 0)),ccoNew(CCO_Many ,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2))),ccoCopy(ccInit0)))
2039	ccoCopy(ccInit0)))ccoNew(CCO_FCall,2,gc0VarId("fiCCall", ((int) 0)),ccoNew(CCO_Many ,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2))),ccoCopy(ccInit0)));
2040	}
2041	else {
2042	CCode n = gc0MultVarId("G", nglo, "domainPrepare!");
2043
2044	static Bool initPrepare = false((int) 0);
2045	if (!initPrepare) {
2046	CCode type = ccoType(ccoExtern(),ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew(CCO_TypedefId,1 ,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2))))
2047	ccoTypeIdOf(gcFiClos))ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew(CCO_TypedefId,1 ,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2))));
2048	gc0AddLine(gcvGloCC, ccoDecl(type, ccoCopy(n)))gc0AddLineFun(&(gcvGloCC), ccoNew(CCO_Decl,2,type,ccoCopy (n)));
2049	initPrepare = true1;
2050	}
2051
2052	ccCall = ccoFCall(gc0MultVarId(gcFiInitModulePrefix,ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0), name),((int ) 0))
2053	int0, name),ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0), name),((int ) 0))
2054	int0)ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0), name),((int ) 0));
2055	gc0AddLine(stmts, ccoStat(ccCall))gc0AddLineFun(&(stmts), ccoNew(CCO_Stat,1,ccCall));
2056	ccCall = gcFiCCallN(int0,ccoNew(CCO_FCall,2,gc0VarId("fiCCall", ((int) 0)),ccoNew(CCO_Many ,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2))),ccoCopy(ccInit0)))
2057	ccoMany2(ccoTypeIdOf(gcFiClos),ccoNew(CCO_FCall,2,gc0VarId("fiCCall", ((int) 0)),ccoNew(CCO_Many ,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2))),ccoCopy(ccInit0)))
2058	ccoCopy(ccInit0)))ccoNew(CCO_FCall,2,gc0VarId("fiCCall", ((int) 0)),ccoNew(CCO_Many ,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2))),ccoCopy(ccInit0)));
2059	gc0AddLine(stmts, ccoStat(ccCall))gc0AddLineFun(&(stmts), ccoNew(CCO_Stat,1,ccCall));
2060	ccCall = gcFiCCallN(1,ccoNew(CCO_FCall,2,gc0VarId("fiCCall", 1),ccoNew(CCO_Many,3,ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("void", 1 \| 2))),n, ccoCopy(ccInit)))
2061	ccoMany3(ccoTypeIdOf("void"), n,ccoNew(CCO_FCall,2,gc0VarId("fiCCall", 1),ccoNew(CCO_Many,3,ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("void", 1 \| 2))),n, ccoCopy(ccInit)))
2062	ccoCopy(ccInit)))ccoNew(CCO_FCall,2,gc0VarId("fiCCall", 1),ccoNew(CCO_Many,3,ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("void", 1 \| 2))),n, ccoCopy(ccInit)));
2063	}
2064	gc0AddLine(stmts, ccoIf(ccoLNot(ccGlo),gc0AddLineFun(&(stmts), ccoNew(CCO_If,3,ccoNew(CCO_LNot,1 ,ccGlo),ccoNew(CCO_Stat,1,ccCall),((void*)0)))
2065	ccoStat(ccCall), NULL))gc0AddLineFun(&(stmts), ccoNew(CCO_If,3,ccoNew(CCO_LNot,1 ,ccGlo),ccoNew(CCO_Stat,1,ccCall),((void*)0)));
2066	return stmts;
2067	}
2068
2069	/*
2070	* Passing Aldor functions to Fortran is tricky: the functions here
2071	* are used to create and access an object which takes care of all
2072	* the nasty details.
2073	*/
2074	localstatic FtnFunParam
2075	gc0FtnFunParam(String name, AInt i)
2076	{
2077	FtnFunParam new, result;
2078
2079
2080	/* Create a new structure */
2081	new = (FtnFunParam)stoAlloc(OB_Other0, sizeof(*result));
2082
2083
2084	/* Fill in the basic details */
2085	gc0FtnFunBase(new)((new)->base) = strCopy(name);
2086	gc0FtnFunNumber(new)((new)->num) = i;
2087
2088
2089	/* Check to see if already known */
2090	result = (FtnFunParam)tblElt(gcvFtnTable, (TblKey)new, (TblElt)0);
2091	if (result) return result;
2092
2093
2094	/* We've never seen this function/parameter before */
2095	if (gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax))
2096	{
2097	/* Need to make it global */
2098	String base = gc0FtnFunBase(new)((new)->base);
2099	String par = gcFortranPar("GFtnPar");
2100	String clo = gcFortranClo("GFtnClo");
2101
2102	gc0FtnFunName(new)((new)->fun) = gc0MultVarId(par, gcvNFtnPar, base);
2103	gc0FtnFunClosure(new)((new)->clos) = gc0MultVarId(clo, gcvNFtnPar, base);
2104	gc0FtnFunClass(new)((new)->class) = ccoExtern()ccoNew(CCO_Extern,0);
2105	}
2106	else
2107	{
2108	/* We can make it local */
2109	String null = (String)NULL((void*)0);
2110	String base = gc0FtnFunBase(new)((new)->base);
2111	String par = strlConcat(gcFortranPar("GFtnPar"), "_", base, null);
2112	String clo = strlConcat(gcFortranClo("GFtnClo"), "_", base, null);
2113
2114	gc0FtnFunName(new)((new)->fun) = gc0VarId(par, gcvNFtnPar);
2115	gc0FtnFunClosure(new)((new)->clos) = gc0VarId(clo, gcvNFtnPar);
2116	gc0FtnFunClass(new)((new)->class) = ccoStatic()ccoNew(CCO_Static,0);
2117	}
2118
2119
2120	/* Store this information in our table as key and value */
2121	tblSetElt(gcvFtnTable, (TblKey)new, (TblElt)new);
2122
2123
2124	/* Increment the counter */
2125	gcvNFtnPar++;
2126
2127
2128	/* Return the information */
2129	return new;
2130	}
2131
2132	localstatic CCode
2133	gc0FtnFunClosDeclare(FtnFunParam info)
2134	{
2135	CCode class = gc0FtnFunClass(info)((info)->class);
2136	CCode name = gc0FtnFunClosure(info)((info)->clos);
2137	CCode ctype = ccoTypeIdOf(gcFiClos)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2)));
2138	CCode dtype = ccoType(ccoCopy(class), ccoCopy(ctype))ccoNew(CCO_Type,2,ccoCopy(class),ccoCopy(ctype));
2139
2140	gc0AddLine(gcvGloCC, ccoDecl(dtype, ccoCopy(name)))gc0AddLineFun(&(gcvGloCC), ccoNew(CCO_Decl,2,dtype,ccoCopy (name)));
2141	return ccoCopy(name);
2142	}
2143
2144	localstatic CCode
2145	gc0FtnFunClosDefine(FtnFunParam info)
2146	{
2147	CCode name = gc0FtnFunClosure(info)((info)->clos);
2148	CCode ctype = ccoTypeIdOf(gcFiClos)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2)));
2149
2150	/*
2151	* We only need a definition if splitting files. Also we
2152	* must NOT include a storage class with the definition.
2153	*/
2154	if (gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax))
2155	gc0AddLine(gcvDefCC, ccoDecl(ccoCopy(ctype), ccoCopy(name)))gc0AddLineFun(&(gcvDefCC), ccoNew(CCO_Decl,2,ccoCopy(ctype ),ccoCopy(name)));
2156
2157
2158	/* Return closure name for convenience. */
2159	return ccoCopy(name);
2160	}
2161
2162	localstatic CCode
2163	gc0FtnFunDeclare(FtnFunParam info, CCode type)
2164	{
2165	CCode class = gc0FtnFunClass(info)((info)->class);
2166	CCode name = gc0FtnFunName(info)((info)->fun);
2167	CCode dtype = ccoType(ccoCopy(class), ccoCopy(type))ccoNew(CCO_Type,2,ccoCopy(class),ccoCopy(type));
2168	CCode dname = ccoFCall(ccoCopy(name), int0)ccoNew(CCO_FCall,2,ccoCopy(name),((int) 0));
2169
2170	gc0AddLine(gcvGloCC, ccoDecl(dtype, dname))gc0AddLineFun(&(gcvGloCC), ccoNew(CCO_Decl,2,dtype,dname) );
2171	return ccoCopy(name);
2172	}
2173
2174	localstatic void
2175	ftnFunParamInit(void)
2176	{
2177	/*
2178	* Create a new hash table for tracking functions
2179	* passed as parameters to Fortran functions.
2180	*/
2181	TblHashFun hasher = (TblHashFun)ftnFunParamHash;
2182	TblEqFun comper = (TblEqFun)ftnFunParamEqual;
2183
2184	gcvNFtnPar = int0((int) 0);
2185	gcvFtnTable = tblNew(hasher, comper);
2186	}
2187
2188	localstatic void
2189	ftnFunParamFinish(void)
2190	{
2191	/* Kill the hash table for tracking functional parameters */
2192	TblFreeKeyFun keykiller = (TblFreeKeyFun)NULL((void*)0);
2193	TblFreeEltFun valkiller = (TblFreeEltFun)ftnFunParamFree;
2194
2195	tblFreeDeeply(gcvFtnTable, keykiller, valkiller);
2196	}
2197
2198	localstatic Hash
2199	ftnFunParamHash(FtnFunParam info)
2200	{
2201	/* Hash on name and parameter number */
2202	return strHash(gc0FtnFunBase(info)((info)->base) + gc0FtnFunNumber(info)((info)->num));
2203	}
2204
2205	localstatic Bool
2206	ftnFunParamEqual(FtnFunParam p1, FtnFunParam p2)
2207	{
2208	/* Quick check on parameter number */
2209	if (gc0FtnFunNumber(p1)((p1)->num) != gc0FtnFunNumber(p2)((p2)->num)) return false((int) 0);
2210
2211
2212	/* Only equal if base names are equal */
2213	return strEqual(gc0FtnFunBase(p1)((p1)->base), gc0FtnFunBase(p2)((p2)->base));
2214	}
2215
2216	localstatic void
2217	ftnFunParamFree(FtnFunParam info)
2218	{
2219	/* The base name is definitely unaliased */
2220	strFree(gc0FtnFunBase(info)((info)->base));
2221
2222
2223	/*
2224	* The other fields may be aliased: wipe the
2225	* structure clean so that the garbage collector
2226	* will not mistake them for live pointers.
2227	*/
2228	gc0FtnFunNumber(info)((info)->num) = int0((int) 0);
2229	gc0FtnFunBase(info)((info)->base) = (String)NULL((void*)0);
2230	gc0FtnFunName(info)((info)->fun) = (CCode)NULL((void*)0);
2231	gc0FtnFunClosure(info)((info)->clos) = (CCode)NULL((void*)0);
2232	gc0FtnFunClosure(info)((info)->clos) = (CCode)NULL((void*)0);
2233
2234
2235	/* Free the whole structure */
2236	stoFree(info);
2237	}
2238
2239	/*****************************************************************************
2240	*
2241	* :: Code to generate programs, closures and definitions.
2242	*
2243	****************************************************************************/
2244
2245	/*****************************************************************************
2246	*
2247	* :: Create a C code program definition for the initialization constant prog
2248	* given by 'foam'.
2249	*
2250	****************************************************************************/
2251
2252	localstatic CCode
2253	gccDef0List(Foam foam)
2254	{
2255	CCode cc;
2256
2257	gcvisInitConst = 1;
2258	cc = gccDef(foam);
2259	gcvisInitConst = 0;
2260	return cc;
2261	}
2262
2263	/*****************************************************************************
2264	*
2265	* :: Create a C program definition for constants,
2266	* or else a closure initialization or assignment statement.
2267	*
2268	****************************************************************************/
2269
2270	localstatic CCode
2271	gccDef(Foam foam)
2272	{
2273	Foam ref, val;
2274	CCode cc;
2275
2276	assert(foamTag(foam) == FOAM_Def)do { if (!(((foam)->hdr.tag) == FOAM_Def)) _do_assert(("foamTag(foam) == FOAM_Def" ),"genc.c",2276); } while (0);
2277
2278	ref = foam->foamDef.lhs;
2279	val = foam->foamDef.rhs;
2280
2281	switch (foamTag(ref)((ref)->hdr.tag)) {
2282	case FOAM_Const:
2283	if (foamTag(val)((val)->hdr.tag) != FOAM_Prog) return 0;
2284	cc = gc0Prog(ref, val);
2285	ccoPos(cc)((cc)->ccoHdr.pos) = foamPos(val)((val)->hdr.pos);
2286	break;
2287	default:
2288	if (gcvLvl == 0) cc = gc0ClosInit(ref, val);
2289	else cc = gc0Set(ref, val);
2290	break;
2291	}
2292
2293	return cc;
2294	}
2295
2296	/*****************************************************************************
2297	*
2298	* :: Create a C function definition for a Foam program given by 'foam',
2299	* and referenced by 'ref' .
2300	*
2301	****************************************************************************/
2302
2303	localstatic Bool gc0ProgIsC(Foam foam);
2304	localstatic Bool gc0FoamIsJavaPCall(Foam foam);
2305	localstatic CCode gc0ProgBody(Foam ref, Foam prog);
2306	localstatic CCode gc0ProgBodyC(Foam ref, Foam prog);
2307	localstatic CCode gc0ProgBodyOther(Foam ref, Foam prog);
2308
2309	localstatic CCode
2310	gc0Prog(Foam ref, Foam foam)
2311	{
2312	Scope("gc0Prog")String scopeName = ("gc0Prog"); int fluidLevel0 = (scopeLevel ++, fluidLevel);
2313	int type, progFmt;
2314	Foam params, locals, lexicals;
2315	Foam fluids;
2316	CCode ccBody, ccParams, ccLeft, ccRight;
2317	CCodeList codeProg = listNil(CCode)((CCodeList) 0);
2318	CCode ccSpec;
2319	AInt format;
2320	int fluid(gcvLvl)fluidSave_gcvLvl = ( fluidStack = (fluidLevel==fluidLimit) ? fluidGrow () : fluidStack, fluidStack[fluidLevel].scopeName = scopeName , fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[ fluidLevel].pglobal = (Pointer) &(gcvLvl), fluidStack[fluidLevel ].pstack = (Pointer) &fluidSave_gcvLvl, fluidStack[fluidLevel ].size = sizeof(gcvLvl), fluidLevel++, (gcvLvl) );
2321	FoamList fluid(gcvLexStk)fluidSave_gcvLexStk = ( fluidStack = (fluidLevel==fluidLimit) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(gcvLexStk), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_gcvLexStk , fluidStack[fluidLevel].size = sizeof(gcvLexStk), fluidLevel ++, (gcvLexStk) );
2322	Foam fluid(gcvPar)fluidSave_gcvPar = ( fluidStack = (fluidLevel==fluidLimit) ? fluidGrow () : fluidStack, fluidStack[fluidLevel].scopeName = scopeName , fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[ fluidLevel].pglobal = (Pointer) &(gcvPar), fluidStack[fluidLevel ].pstack = (Pointer) &fluidSave_gcvPar, fluidStack[fluidLevel ].size = sizeof(gcvPar), fluidLevel++, (gcvPar) ), fluid(gcvLoc)fluidSave_gcvLoc = ( fluidStack = (fluidLevel==fluidLimit) ? fluidGrow () : fluidStack, fluidStack[fluidLevel].scopeName = scopeName , fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[ fluidLevel].pglobal = (Pointer) &(gcvLoc), fluidStack[fluidLevel ].pstack = (Pointer) &fluidSave_gcvLoc, fluidStack[fluidLevel ].size = sizeof(gcvLoc), fluidLevel++, (gcvLoc) );
2323	Foam fluid(gcvLFmtStk)fluidSave_gcvLFmtStk = ( fluidStack = (fluidLevel==fluidLimit ) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel, fluidStack[fluidLevel].pglobal = (Pointer) &(gcvLFmtStk) , fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_gcvLFmtStk , fluidStack[fluidLevel].size = sizeof(gcvLFmtStk), fluidLevel ++, (gcvLFmtStk) );
2324	Foam decl = gc0GetDecl(ref);
2325	CCode retval;
2326
2327	assert(foamTag(foam) == FOAM_Prog)do { if (!(((foam)->hdr.tag) == FOAM_Prog)) _do_assert(("foamTag(foam) == FOAM_Prog" ),"genc.c",2327); } while (0);
2328
2329	/* We have to leave the pointer crushing until now */
2330	foam = gc0KillPointers(foam);
2331
2332	progFmt = foamProgIndex(foam)((foam)->foamProg.levels->foamDEnv.argv[0]);
2333	type = foam->foamProg.retType;
2334	format = foam->foamProg.format;
2335	params = foam->foamProg.params;
2336	locals = foam->foamProg.locals;
2337	lexicals = foamArgv(gcvFmt)((gcvFmt)->foamGen.argv)[progFmt].code;
2338	fluids = foam->foamProg.fluids;
2339
2340	gcvProg = foam;
2341	gcvLvl = gcvLvl+1;
2342	gcvPar = params;
2343	gcvLoc = locals;
2344	gcvLocFluids = fluids;
2345	gcvLFmtStk = foam->foamProg.levels;
2346	gcvLexStk = listCons(Foam)(Foam_listPointer->Cons)(lexicals, gcvLexStk);
2347
2348	if (gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax)) {
2349	gcvSpec = gc0TypeId(type, format);
2350	ccSpec = ccoTypeIdOf(gcFiProg)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiProg", 1 \| 2)));
2351	}
2352	else {
2353	gcvSpec = ccoType(ccoStatic(), gc0TypeId(type, format))ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),gc0TypeId(type, format ));
2354	ccSpec = ccoType(ccoStatic(), ccoTypeIdOf(gcFiProg))ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew(CCO_TypedefId,1 ,ccoNew(CCO_Id,1,symProbe("FiProg", 1 \| 2))));
2355	}
2356	ccParams = gc0Param(foam, params);
2357	gcvIsLeaf = foamProgIsLeaf(foam)((foam)->foamProg.infoBits & (1 << 1));
2358	gcvIsCoroutine = foamProgIsCoroutine(foam)((foam)->foamProg.infoBits & (1 << 7));
2359
2360	ccBody = gc0ProgBody(ref, foam);
2361
2362	listFreeCons(Foam)(Foam_listPointer->FreeCons)(gcvLexStk);
2363
2364	ccLeft = gc0MultVarId("tmp", ref->foamConst.index, decl->foamDecl.id);
2365	if (!gcvIsLeaf && gcvIsCoroutine) {
2366	AInt fmtEnv0 = foam->foamProg.levels->foamDEnv.argv[0];
2367	ccRight = ccoInit(ccoMany5(ccoCast(ccoIdOf("FiFun"),ccoNew(CCO_Init,1,ccoNew(CCO_Many,5,ccoNew(CCO_Cast,2,ccoNew( CCO_Id,1,symProbe("FiFun", 1 \| 2)),gccProgId(ref)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_Sizeof ,1,ccoNew(CCO_Type,2,ccoNew(CCO_StructRef,1,gc0VarId("Fmt", fmtEnv0 )),((void*)0)))))
2368	gccProgId(ref)),ccoNew(CCO_Init,1,ccoNew(CCO_Many,5,ccoNew(CCO_Cast,2,ccoNew( CCO_Id,1,symProbe("FiFun", 1 \| 2)),gccProgId(ref)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_Sizeof ,1,ccoNew(CCO_Type,2,ccoNew(CCO_StructRef,1,gc0VarId("Fmt", fmtEnv0 )),((void*)0)))))
2369	ccoIntOf(int0),ccoNew(CCO_Init,1,ccoNew(CCO_Many,5,ccoNew(CCO_Cast,2,ccoNew( CCO_Id,1,symProbe("FiFun", 1 \| 2)),gccProgId(ref)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_Sizeof ,1,ccoNew(CCO_Type,2,ccoNew(CCO_StructRef,1,gc0VarId("Fmt", fmtEnv0 )),((void*)0)))))
2370	ccoIntOf(int0),ccoNew(CCO_Init,1,ccoNew(CCO_Many,5,ccoNew(CCO_Cast,2,ccoNew( CCO_Id,1,symProbe("FiFun", 1 \| 2)),gccProgId(ref)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_Sizeof ,1,ccoNew(CCO_Type,2,ccoNew(CCO_StructRef,1,gc0VarId("Fmt", fmtEnv0 )),((void*)0)))))
2371	ccoIntOf(int0),ccoNew(CCO_Init,1,ccoNew(CCO_Many,5,ccoNew(CCO_Cast,2,ccoNew( CCO_Id,1,symProbe("FiFun", 1 \| 2)),gccProgId(ref)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_Sizeof ,1,ccoNew(CCO_Type,2,ccoNew(CCO_StructRef,1,gc0VarId("Fmt", fmtEnv0 )),((void*)0)))))
2372	ccoSizeof(ccoType(ccoStructRef(gc0VarId(gcFmtName, fmtEnv0)), NULL))ccoNew(CCO_Init,1,ccoNew(CCO_Many,5,ccoNew(CCO_Cast,2,ccoNew( CCO_Id,1,symProbe("FiFun", 1 \| 2)),gccProgId(ref)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_Sizeof ,1,ccoNew(CCO_Type,2,ccoNew(CCO_StructRef,1,gc0VarId("Fmt", fmtEnv0 )),((void*)0)))))
2373	))ccoNew(CCO_Init,1,ccoNew(CCO_Many,5,ccoNew(CCO_Cast,2,ccoNew( CCO_Id,1,symProbe("FiFun", 1 \| 2)),gccProgId(ref)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_Sizeof ,1,ccoNew(CCO_Type,2,ccoNew(CCO_StructRef,1,gc0VarId("Fmt", fmtEnv0 )),((void*)0)))));
2374	}
2375	else {
2376	ccRight = ccoInit(ccoMany5(ccoCast(ccoIdOf("FiFun"),ccoNew(CCO_Init,1,ccoNew(CCO_Many,5,ccoNew(CCO_Cast,2,ccoNew( CCO_Id,1,symProbe("FiFun", 1 \| 2)),gccProgId(ref)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2))))
2377	gccProgId(ref)),ccoNew(CCO_Init,1,ccoNew(CCO_Many,5,ccoNew(CCO_Cast,2,ccoNew( CCO_Id,1,symProbe("FiFun", 1 \| 2)),gccProgId(ref)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2))))
2378	ccoIntOf(int0),ccoNew(CCO_Init,1,ccoNew(CCO_Many,5,ccoNew(CCO_Cast,2,ccoNew( CCO_Id,1,symProbe("FiFun", 1 \| 2)),gccProgId(ref)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2))))
2379	ccoIntOf(int0),ccoNew(CCO_Init,1,ccoNew(CCO_Many,5,ccoNew(CCO_Cast,2,ccoNew( CCO_Id,1,symProbe("FiFun", 1 \| 2)),gccProgId(ref)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2))))
2380	ccoIntOf(int0),ccoNew(CCO_Init,1,ccoNew(CCO_Many,5,ccoNew(CCO_Cast,2,ccoNew( CCO_Id,1,symProbe("FiFun", 1 \| 2)),gccProgId(ref)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2))))
2381	ccoIntOf(int0)))ccoNew(CCO_Init,1,ccoNew(CCO_Many,5,ccoNew(CCO_Cast,2,ccoNew( CCO_Id,1,symProbe("FiFun", 1 \| 2)),gccProgId(ref)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2))));
2382	}
2383
2384	gc0AddLine(codeProg, ccoDecl(ccoType(ccoStatic(),gc0AddLineFun(&(codeProg), ccoNew(CCO_Decl,2,ccoNew(CCO_Type ,2,ccoNew(CCO_Static,0),ccoNew(CCO_StructRef,1,ccoNew(CCO_Id, 1,symProbe("_FiProg", 1 \| 2)))),ccoNew(CCO_Asst,2,ccLeft,ccRight )))
2385	ccoStructRef(ccoIdOf("_FiProg"))),gc0AddLineFun(&(codeProg), ccoNew(CCO_Decl,2,ccoNew(CCO_Type ,2,ccoNew(CCO_Static,0),ccoNew(CCO_StructRef,1,ccoNew(CCO_Id, 1,symProbe("_FiProg", 1 \| 2)))),ccoNew(CCO_Asst,2,ccLeft,ccRight )))
2386	ccoAsst(ccLeft, ccRight)))gc0AddLineFun(&(codeProg), ccoNew(CCO_Decl,2,ccoNew(CCO_Type ,2,ccoNew(CCO_Static,0),ccoNew(CCO_StructRef,1,ccoNew(CCO_Id, 1,symProbe("_FiProg", 1 \| 2)))),ccoNew(CCO_Asst,2,ccLeft,ccRight )));
2387	if (gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax))
2388	gc0AddLine(codeProg, ccoDecl(ccSpec, gccId(ref)))gc0AddLineFun(&(codeProg), ccoNew(CCO_Decl,2,ccSpec,gccId (ref)));
2389
2390	gc0AddLine(gcvInitProgCC, ccoStat(ccoAsst(gccId(ref),gc0AddLineFun(&(gcvInitProgCC), ccoNew(CCO_Stat,1,ccoNew( CCO_Asst,2,gccId(ref),ccoNew(CCO_PreAnd,1,ccoCopy(ccLeft)))))
2391	ccoPreAnd(ccoCopy(ccLeft)))))gc0AddLineFun(&(gcvInitProgCC), ccoNew(CCO_Stat,1,ccoNew( CCO_Asst,2,gccId(ref),ccoNew(CCO_PreAnd,1,ccoCopy(ccLeft)))));
2392
2393	retval = ccoMany2(ccoFDef(gcvSpec, gccProgId(ref), ccParams, ccBody),ccoNew(CCO_Many,2,ccoNew(CCO_FDef,4,gcvSpec,gccProgId(ref),ccParams ,ccBody),gc0ListOf(CCO_Many, codeProg))
2394	gc0ListOf(CCO_Many, codeProg))ccoNew(CCO_Many,2,ccoNew(CCO_FDef,4,gcvSpec,gccProgId(ref),ccParams ,ccBody),gc0ListOf(CCO_Many, codeProg));
2395	Return(retval){ fluidUnwind(fluidLevel0, ((int) 0)); return retval;; };
2396	}
2397
2398	localstatic Foam
2399	gc0KillPointers(Foam foam)
2400	{
2401	if (!optIsKillPointersWanted()) {
2402	return foam;
2403	}
2404
2405	foam = foamCopy(foam);
2406	killProgPointers(foam);
2407	if (DEBUG(phase)phaseDebug) {
2408	stoAudit();
2409	}
2410	return foam;
2411	}
2412
2413
2414	localstatic CCode
2415	gc0ProgBody(Foam ref, Foam prog)
2416	{
2417	if (!gc0ProgIsC(prog)) {
2418	return gc0ProgBodyOther(ref, prog);
2419	}
2420	else {
2421	return gc0ProgBodyC(ref, prog);
2422	}
2423	}
2424
2425	localstatic CCode
2426	gc0ProgBodyC(Foam ref, Foam foam)
2427	{
2428	Foam locals = foam->foamProg.locals;
2429	Foam body = foam->foamProg.body;
2430	AInt progFmt = foamProgIndex(foam)((foam)->foamProg.levels->foamDEnv.argv[0]);
2431
2432	CCode ccBody = ccoCompound(gc0Compound(locals, body, ref, progFmt,ccoNew(CCO_Compound,1,gc0Compound(locals, body, ref, progFmt, gcvIsLeaf, gcvIsCoroutine))
2433	gcvIsLeaf, gcvIsCoroutine))ccoNew(CCO_Compound,1,gc0Compound(locals, body, ref, progFmt, gcvIsLeaf, gcvIsCoroutine));
2434	return ccBody;
2435	}
2436
2437	localstatic CCode
2438	gc0ProgBodyOther(Foam ref, Foam prog)
2439	{
2440	return ccoCompound(ccoStat(gcFiHalt(ccoIdOf("100"))))ccoNew(CCO_Compound,1,ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew (CCO_Id,1,symProbe("fiHalt", 1 \| 2)),ccoNew(CCO_Cast,2,ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiSInt", 1 \| 2))), ccoNew(CCO_Id,1,symProbe("100", 1 \| 2))))));
2441	}
2442
2443	localstatic Bool
2444	gc0ProgIsC(Foam foam)
2445	{
2446	int i;
2447	if (foam->foamProg.retType == FOAM_JavaObj) {
2448	return false((int) 0);
2449	}
2450
2451	for (int i=0; i<foamDDeclArgc(foam->foamProg.params)(((foam->foamProg.params)->hdr.argc) - (1)); i++) {
2452	Foam param = foam->foamProg.params->foamDDecl.argv[i];
2453	if (param->foamDecl.type == FOAM_JavaObj) {
2454	return false((int) 0);
2455	}
2456	}
2457
2458	for (int i=0; i<foamDDeclArgc(foam->foamProg.locals)(((foam->foamProg.locals)->hdr.argc) - (1)); i++) {
2459	Foam param = foam->foamProg.locals->foamDDecl.argv[i];
2460	if (param->foamDecl.type == FOAM_JavaObj) {
2461	return false((int) 0);
2462	}
2463	}
2464	if (foamFindFirst(gc0FoamIsJavaPCall, foam->foamProg.body) != NULL((void*)0)) {
2465	return false((int) 0);
2466	}
2467
2468	return true1;
2469	}
2470
2471	localstatic Bool
2472	gc0FoamIsJavaPCall(Foam foam)
2473	{
2474	if (foamTag(foam)((foam)->hdr.tag) != FOAM_PCall)
2475	return false((int) 0);
2476
2477	return foam->foamPCall.protocol == FOAM_Proto_Java
2478	\|\| foam->foamPCall.protocol == FOAM_Proto_JavaConstructor
2479	\|\| foam->foamPCall.protocol == FOAM_Proto_JavaMethod;
2480	}
2481
2482
2483	/*****************************************************************************
2484	*
2485	* :: Create the C program parameters list for the Foam program 'foam',
2486	* using the Foam parameters list 'params'.
2487	*
2488	****************************************************************************/
2489
2490	localstatic CCode
2491	gc0Param(Foam foam, Foam params)
2492	{
2493	CCodeList code = listNil(CCode)((CCodeList) 0);
2494	CCode ccParams, ccName, ccDecl, ccSpec;
2495	int i;
2496	Foam decl;
2497	Bool isCoroutine, isLeaf;
2498
2499	assert(foamTag(params) == FOAM_DDecl)do { if (!(((params)->hdr.tag) == FOAM_DDecl)) _do_assert( ("foamTag(params) == FOAM_DDecl"),"genc.c",2499); } while (0);
2500	assert(foamTag(foam) == FOAM_Prog)do { if (!(((foam)->hdr.tag) == FOAM_Prog)) _do_assert(("foamTag(foam) == FOAM_Prog" ),"genc.c",2500); } while (0);
2501	isCoroutine = foamProgIsCoroutine(foam)((foam)->foamProg.infoBits & (1 << 7));
2502	isLeaf = foamProgIsLeaf(foam)((foam)->foamProg.infoBits & (1 << 1));
2503
2504	gc0AddLine(code, gccEnvParam())gc0AddLineFun(&(code), gccEnvParam());
2505	if (isCoroutine && !isLeaf) {
2506	gc0AddLine(code, gccEnv0Param())gc0AddLineFun(&(code), gccEnv0Param());
2507	}
2508
2509	for (i = 0; i < foamDDeclArgc(params)(((params)->hdr.argc) - (1)); i++) {
2510	int fmt, typ;
2511	decl = params->foamDDecl.argv[i];
2512	fmt = decl->foamDecl.format;
2513	typ = decl->foamDecl.type;
2514
2515	ccName = gc0MultVarId("P", i, decl->foamDecl.id);
2516	ccDecl = gc0Decl(decl, ccoCopy(ccName));
2517
2518	gc0AddLine(code, ccoParam(ccName, ccoArgv(ccDecl)[0], ccoArgv(ccDecl)[1]))gc0AddLineFun(&(code), ccoNew(CCO_Param,3,ccName,((ccDecl )->ccoNode.argv)[0],((ccDecl)->ccoNode.argv)[1]));
2519	}
2520	if (foam->foamProg.retType == FOAM_NOp
2521	&& foam->foamProg.format != 0
2522	&& foam->foamProg.format != emptyFormatSlot4) {
2523	Foam ddecl;
2524	int n;
2525	DEBUG_DECL(int rn)int rn;
2526	ddecl = gcvFmt->foamDFmt.argv[foam->foamProg.format];
2527	n = foamDDeclArgc(ddecl)(((ddecl)->hdr.argc) - (1));
2528	assert( (rn = gc0NumVals(foam->foamProg.body)) == 0do { if (!((rn = gc0NumVals(foam->foamProg.body)) == 0 \|\| n == rn)) _do_assert(("(rn = gc0NumVals(foam->foamProg.body)) == 0 \|\| n == rn" ),"genc.c",2529); } while (0)
2529	\|\| n == rn)do { if (!((rn = gc0NumVals(foam->foamProg.body)) == 0 \|\| n == rn)) _do_assert(("(rn = gc0NumVals(foam->foamProg.body)) == 0 \|\| n == rn" ),"genc.c",2529); } while (0); /* !! paranoid */
2530	for (i = 0; i < n; i++) {
2531	Foam decl = ddecl->foamDDecl.argv[i];
2532	ccName = gc0MultVarId("R", i, "");
2533	ccSpec = ccoPostStar(gc0TypeId(decl->foamDecl.type,ccoNew(CCO_PostStar,1,gc0TypeId(decl->foamDecl.type, decl-> foamDecl.format))
2534	decl->foamDecl.format))ccoNew(CCO_PostStar,1,gc0TypeId(decl->foamDecl.type, decl-> foamDecl.format));
2535	ccDecl = ccoCopy(ccName);
2536	gc0AddLine(code, ccoParam(ccName, ccSpec, ccDecl))gc0AddLineFun(&(code), ccoNew(CCO_Param,3,ccName,ccSpec,ccDecl ));
2537	}
2538	}
2539	code = listNReverse(CCode)(CCode_listPointer->NReverse)(code);
2540	ccParams = gc0ListOf(CCO_Many, code);
2541	listFree(CCode)(CCode_listPointer->Free)(code);
2542
2543	return ccParams;
2544	}
2545
2546	/*****************************************************************************
2547	*
2548	* :: Create the declaration for the parent environment parameter.
2549	*
2550	****************************************************************************/
2551
2552	localstatic CCode
2553	gccEnvParam()
2554	{
2555	return ccoParam(ccoIdOf("e1"),ccoNew(CCO_Param,3,ccoNew(CCO_Id,1,symProbe("e1", 1 \| 2)),gc0TypeId (FOAM_Env, ((int) 0)),ccoNew(CCO_Id,1,symProbe("e1", 1 \| 2)))
2556	gc0TypeId(FOAM_Env, int0), ccoIdOf("e1"))ccoNew(CCO_Param,3,ccoNew(CCO_Id,1,symProbe("e1", 1 \| 2)),gc0TypeId (FOAM_Env, ((int) 0)),ccoNew(CCO_Id,1,symProbe("e1", 1 \| 2)));
2557	}
2558
2559	localstatic CCode
2560	gccEnv0Param()
2561	{
2562	return ccoParam(ccoIdOf("e0"),ccoNew(CCO_Param,3,ccoNew(CCO_Id,1,symProbe("e0", 1 \| 2)),gc0TypeId (FOAM_Env, ((int) 0)),ccoNew(CCO_Id,1,symProbe("e0", 1 \| 2)))
2563	gc0TypeId(FOAM_Env, int0), ccoIdOf("e0"))ccoNew(CCO_Param,3,ccoNew(CCO_Id,1,symProbe("e0", 1 \| 2)),gc0TypeId (FOAM_Env, ((int) 0)),ccoNew(CCO_Id,1,symProbe("e0", 1 \| 2)));
2564	}
2565
2566	/*****************************************************************************
2567	*
2568	* :: Return the number of multiple-return values defined in the body of the
2569	* Foam program 'body'.
2570	*
2571	****************************************************************************/
2572
2573	int
2574	gc0NumVals(Foam body)
2575	{
2576	Foam *argv;
2577	Length i, argc;
2578
2579	if (foamTag(body)((body)->hdr.tag) == FOAM_Seq) {
2580	argc = foamArgc(body)((body)->hdr.argc);
2581	argv = &body->foamSeq.argv[0];
2582	}
2583	else {
2584	argc = 1;
2585	argv = &body;
2586	}
2587
2588	for (i = 0; i < argc; i++) {
2589	Foam foam = argv[i];
2590	if (foamTag(foam)((foam)->hdr.tag) == FOAM_Return) {
2591	assert(foamTag(foam->foamReturn.value) == FOAM_Values)do { if (!(((foam->foamReturn.value)->hdr.tag) == FOAM_Values )) _do_assert(("foamTag(foam->foamReturn.value) == FOAM_Values" ),"genc.c",2591); } while (0);
2592	return foamArgc(foam->foamReturn.value)((foam->foamReturn.value)->hdr.argc);
2593	}
2594	}
2595	return 0;
2596	}
2597
2598	/*****************************************************************************
2599	*
2600	* :: Create the C code for the Foam program 'body', with local variables
2601	* 'locals', program reference 'ref', program format 'fmt', and whether
2602	* the program is a leaf node, 'leaf'.
2603	*
2604	****************************************************************************/
2605
2606	localstatic CCode
2607	gc0Compound(Foam locals, Foam body, Foam ref, int fmt, int leaf, int isCoroutine)
2608	{
2609	CCodeList code = listNil(CCode)((CCodeList) 0);
2610	CCodeList cmpd = listNil(CCode)((CCodeList) 0);
2611	CCodeList ccLevels, tmp;
2612	CCode ccCmpd, ccBody;
2613	struct Clocals *locList;
2614	AIntList fl;
2615	int i, numLexs, maxLevel;
2616	Foam nbody;
2617
2618	gcvNLocs = 0;
2619	gcvLocals = NULL((void*)0);
2620	gcvFluidList = listNil(AInt)((AIntList) 0);
2621	numLexs = foamArgc(gcvLFmtStk)((gcvLFmtStk)->hdr.argc);
2622
2623	gcvNestFree = listNil(CCode)((CCodeList) 0);
2624	gcvNestUsed = listNil(CCode)((CCodeList) 0);
2625	gcvCallNesting = GC_NoCall;
2626
2627	gc0CreateLocList(locals);
2628	assert(foamDDeclArgc(locals) == gcvNLocs)do { if (!((((locals)->hdr.argc) - (1)) == gcvNLocs)) _do_assert (("foamDDeclArgc(locals) == gcvNLocs"),"genc.c",2628); } while (0);
2629
2630	/*
2631	* Some compilers (eg MSVC++ 6.0) need an explicit return
2632	* instruction after code that does not return (e.g fiHalt).
2633	*/
2634	nbody = gc0AddExplicitReturn(body);
2635
2636	gc0NewStmtInit();
2637	gccCmd(nbody);
2638
2639	maxLevel = gc0MaxLevel(numLexs);
2640
2641	while (gcvLocals) {
2642	locList = gcvLocals->next;
2643	gc0AddLine(code, gcvLocals->loc)gc0AddLineFun(&(code), gcvLocals->loc);
2644	stoFree((Pointer) gcvLocals);
2645	gcvLocals = locList;
2646	}
2647	if (gcvFluidList) {
2648	for (fl = gcvFluidList; fl; fl=cdr(fl)((fl)->rest)) {
2649	gc0AddLine(code, gc0FluidDecl(car(fl)))gc0AddLineFun(&(code), gc0FluidDecl(((fl)->first)));
2650	}
2651	gc0AddLine(code, gc0PushFluid())gc0AddLineFun(&(code), gc0PushFluid());
2652	}
2653	ccLevels = gc0Levels(numLexs, maxLevel, leaf, isCoroutine, fmt);
2654	tmp = ccLevels;
2655	while (tmp) {
2656	gc0AddLine(code, car(tmp))gc0AddLineFun(&(code), ((tmp)->first));
2657	tmp = cdr(tmp)((tmp)->rest);
2658	}
2659	listFree(CCode)(CCode_listPointer->Free)(ccLevels);
2660
2661	/*
2662	* If bigints or RRFmts exist, create their initialisations
2663	* in the init prog.
2664	*/
2665	if (gcvisInitConst) {
2666	if (gcvNBInts) {
2667	CCode ccbints;
2668	gcvBIntCC = listNReverse(CCode)(CCode_listPointer->NReverse)(gcvBIntCC);
2669	ccbints = gc0ListOf(CCO_Many, gcvBIntCC);
2670	for (i = 0; i < listLength(CCode)(CCode_listPointer->_Length)(gcvBIntCC); i++)
2671	gc0AddLine(cmpd, ccoArgv(ccbints)[i])gc0AddLineFun(&(cmpd), ((ccbints)->ccoNode.argv)[i]);
2672	}
2673
2674	if (gcvNRRFmt) {
2675	CCode ccfmts;
2676	gcvRRFmtCC = listNReverse(CCode)(CCode_listPointer->NReverse)(gcvRRFmtCC);
2677	ccfmts = gc0ListOf(CCO_Many, gcvRRFmtCC);
2678	for (i = 0; i < listLength(CCode)(CCode_listPointer->_Length)(gcvRRFmtCC); i++)
2679	gc0AddLine(cmpd, ccoArgv(ccfmts)[i])gc0AddLineFun(&(cmpd), ((ccfmts)->ccoNode.argv)[i]);
2680	}
2681	}
2682	if (gcvFluidList) {
2683	for (fl = gcvFluidList; fl; fl=cdr(fl)((fl)->rest)) {
2684	gc0AddLine(cmpd, gc0GetFluid(car(fl)))gc0AddLineFun(&(cmpd), gc0GetFluid(((fl)->first)));
2685	}
2686	for (i=0; i < foamArgc(gcvLocFluids)((gcvLocFluids)->hdr.argc); i++) {
2687	gc0AddLine(cmpd,gc0AddLineFun(&(cmpd), gc0AddFluid(gcvLocFluids->foamDFluid .argv[i]))
2688	gc0AddFluid(gcvLocFluids->foamDFluid.argv[i]))gc0AddLineFun(&(cmpd), gc0AddFluid(gcvLocFluids->foamDFluid .argv[i]));
2689	}
2690	}
2691
2692	/* Hack to announce function entry */
2693	if (gencTraceFuns()) {
2694	/*
2695	* Activated by -Wtrace-cfuns: we generate code to
2696	* print out the name of this function immediately
2697	* on entry. This is a very low-level debug option
2698	* that is sometimes helpful (especially if gets are
2699	* being traced in runtime.as).
2700	*/
2701	String fname;
2702	CCode cchack = gccProgId(ref);
2703
2704
2705	/* We assume that gccProgId returns a CCO_Id */
2706	assert(cchack->ccoHdr.tag == CCO_Id)do { if (!(cchack->ccoHdr.tag == CCO_Id)) _do_assert(("cchack->ccoHdr.tag == CCO_Id" ),"genc.c",2706); } while (0);
2707
2708
2709	/*
2710	* We rely on the fact that ccoId and ccoStringVal
2711	* have exactly the same representation. Rather than
2712	* do anything clever we flip the tags and add some
2713	* extra details around the function name.
2714	*/
2715	cchack->ccoHdr.tag = CCO_StringVal;
2716	fname = symString(cchack->ccoToken.symbol)((cchack->ccoToken.symbol)->str);
2717	fname = strConcat("\n[* ", strConcat(fname, " *]\n"));
2718	cchack->ccoToken.symbol = symIntern(fname)symProbe(fname, 1 \| 2);
2719	gc0AddLine(cmpd, ccoStat(ccoFCall(ccoIdOf("puts"), cchack)))gc0AddLineFun(&(cmpd), ccoNew(CCO_Stat,1,ccoNew(CCO_FCall ,2,ccoNew(CCO_Id,1,symProbe("puts", 1 \| 2)),cchack)));
2720	strFree(fname);
2721	}
2722
2723	assert(gcvStmts->pos <= gcvStmts->argc)do { if (!(gcvStmts->pos <= gcvStmts->argc)) _do_assert (("gcvStmts->pos <= gcvStmts->argc"),"genc.c",2723); } while (0);
2724	for (i = 0; i < gcvStmts->pos; i++)
2725	gc0AddLine(cmpd, gcvStmts->stmt[i])gc0AddLineFun(&(cmpd), gcvStmts->stmt[i]);
2726
2727	if (gcvFluidList && !gc0IsReturn(car(cmpd)((cmpd)->first)))
2728	gc0AddLine(cmpd, gc0PopFluid())gc0AddLineFun(&(cmpd), gc0PopFluid());
2729	cmpd = listNReverse(CCode)(CCode_listPointer->NReverse)(cmpd);
2730	ccCmpd = gc0ListOf(CCO_Many, cmpd);
2731	listFree(CCode)(CCode_listPointer->Free)(cmpd);
2732
2733	for (i = 0; i < ccoArgc(ccCmpd)((ccCmpd)->ccoNode.argc); i++)
2734	gc0AddLine(code, ccoArgv(ccCmpd)[i])gc0AddLineFun(&(code), ((ccCmpd)->ccoNode.argv)[i]);
2735	code = listNReverse(CCode)(CCode_listPointer->NReverse)(code);
2736	ccBody = gc0ListOf(CCO_Many, code);
2737	listFree(CCode)(CCode_listPointer->Free)(code);
2738	listFree(CCode)(CCode_listPointer->Free)(gcvNestFree);
2739	listFree(CCode)(CCode_listPointer->Free)(gcvNestUsed);
2740	stoFree((Pointer) (gcvStmts->stmt));
2741	stoFree((Pointer) (gcvStmts));
2742
2743	/* Release the modified body (if modified) */
2744	if (nbody != body) foamFree(nbody);
2745
2746	return gc0Compress(ccBody);
2747	}
2748
2749	localstatic Bool
2750	gc0IsReturn(CCode cc)
2751	{
2752	Bool changed = true1;
2753
2754	while (changed) {
2755	switch (ccoTag(cc)((cc)->ccoHdr.tag)) {
2756	case CCO_Compound:
2757	cc = ccoArgv(cc)((cc)->ccoNode.argv)[0];
2758	break;
2759	case CCO_Many:
2760	cc = ccoArgv(cc)((cc)->ccoNode.argv)[ccoArgc(cc)((cc)->ccoNode.argc)-1];
2761	break;
2762	default:
2763	changed = false((int) 0);
2764	break;
2765	}
2766	}
2767
2768	return ccoTag(cc)((cc)->ccoHdr.tag) == CCO_Return;
2769	}
2770
2771	/*****************************************************************************
2772	*
2773	* :: Compress program labels and local variable declarations from the
2774	* C code given by 'cc' and return the new C code body.
2775	*
2776	****************************************************************************/
2777
2778	localstatic CCodeList gc0DirtyStackFrame(CCode, int, CCodeList);
2779
2780	localstatic CCode
2781	gc0Compress(CCode cc)
2782	{
2783	CCodeList code = listNil(CCode)((CCodeList) 0);
2784	CCode current = NULL((void)0), top = NULL((void)0);
2785	CCode newCmpd, ccTmp;
2786	int i, num;
2787
2788	gc0NewLocsInit();
2789	num = ccoArgc(cc)((cc)->ccoNode.argc);
2790	for (i = 0; i < num; i++) {
2791	while (ccoTag(ccoArgv(cc)[i])((((cc)->ccoNode.argv)[i])->ccoHdr.tag) == CCO_Decl) {
2792	ccTmp = ccoCopy(ccoArgv(cc)((cc)->ccoNode.argv)[i]);
2793	gc0AddDecl(ccTmp, i);
2794	i++;
2795	}
2796	if ((ccoTag(ccoArgv(cc)[i])((((cc)->ccoNode.argv)[i])->ccoHdr.tag) == CCO_Label) && !top) {
2797	top = &ccoArgv(cc)((cc)->ccoNode.argv)[i];
2798	current = &ccoArgv(top)((top)->ccoNode.argv)[1];
2799	}
2800	else {
2801	if (ccoTag(ccoArgv(cc)[i])((((cc)->ccoNode.argv)[i])->ccoHdr.tag) == CCO_Label) {
2802	*current = ccoCopy(ccoArgv(cc)((cc)->ccoNode.argv)[i]);
2803	current = &ccoArgv(current)((current)->ccoNode.argv)[1];
2804	ccoArgv(cc)((cc)->ccoNode.argv)[i] = NULL((void*)0);
2805	}
2806	else {
2807	if (current) {
2808	*current = ccoCopy(ccoArgv(cc)((cc)->ccoNode.argv)[i]);
2809	current = NULL((void*)0);
2810	ccoArgv(cc)((cc)->ccoNode.argv)[i] = NULL((void*)0);
2811	}
2812	top = NULL((void*)0);
2813	}
2814	}
2815	}
2816	gc0NewLocals(cc);
2817
2818	code = gc0DirtyStackFrame(cc, num, code);
2819
2820	code = listNReverse(CCode)(CCode_listPointer->NReverse)(code);
2821	newCmpd = gc0ListOf(CCO_Many, code);
2822	listFree(CCode)(CCode_listPointer->Free)(code);
2823	return newCmpd;
2824	}
2825
2826	localstatic CCodeList
2827	gc0DirtyStackFrame(CCode cc, int num, CCodeList code)
2828	{
2829	int i;
2830
2831	for (i = 0; i < num; i++)
2832	if (ccoArgv(cc)((cc)->ccoNode.argv)[i] != 0) gc0AddLine(code, ccoArgv(cc)[i])gc0AddLineFun(&(code), ((cc)->ccoNode.argv)[i]);
2833
2834	return code;
2835	}
2836
2837	/*****************************************************************************
2838	*
2839	* :: Code to generate program statements.
2840	*
2841	****************************************************************************/
2842
2843	/*****************************************************************************
2844	*
2845	* :: Return the C code of the Foam command, 'foam', identified by Foam tag.
2846	*
2847	****************************************************************************/
2848
2849	localstatic CCode
2850	gccCmd(Foam foam)
2851	{
2852	CCode cc;
2853
2854	switch (foamTag(foam)((foam)->hdr.tag)) {
2855	case FOAM_Def:
2856	cc = gccDef(foam);
2857	break;
2858	case FOAM_Goto:
2859	cc = ccoGoto(gc0VarId("L", foam->foamGoto.label))ccoNew(CCO_Goto,1,gc0VarId("L", foam->foamGoto.label));
2860	break;
2861	case FOAM_GenerStep:
2862	cc = gccGenerStep(foam);
2863	break;
2864	case FOAM_If:
2865	cc = gccIf(foam);
2866	break;
2867	case FOAM_Select:
2868	cc = gccSelect(foam);
2869	break;
2870	case FOAM_Return:
2871	cc = gccReturn(foam->foamReturn.value);
2872	break;
2873	case FOAM_Set:
2874	cc = gc0Set(foam->foamSet.lhs, foam->foamSet.rhs);
2875	break;
2876	case FOAM_Loose:
2877	/cc = ccoAsst(gccRef(foam->foamLoose.loc), ccoIdOf("DEAD"));/
2878	cc = ccoAsst(gccRef(foam->foamLoose.loc), ccoIdOf("0"))ccoNew(CCO_Asst,2,gccRef(foam->foamLoose.loc),ccoNew(CCO_Id ,1,symProbe("0", 1 \| 2)));
2879	break;
2880	case FOAM_EEnsure:
2881	cc = gcFiEEnsure(gccExpr(foam->foamEEnsure.env))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvEnsure", 1 \| 2)),gccExpr(foam->foamEEnsure.env));
2882	break;
2883	case FOAM_Free:
2884	cc = gcFiFree(gc0TryCast(FOAM_Ptr, foam->foamFree.place))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiFree", 1 \| 2)) ,gc0TryCast(FOAM_Ptr, foam->foamFree.place));
2885	break;
2886	case FOAM_PopEnv:
2887	cc = ccoIdOf(";")ccoNew(CCO_Id,1,symProbe(";", 1 \| 2));
2888	break;
2889	case FOAM_Seq:
2890	cc = gccSeq(foam);
2891	break;
2892	case FOAM_Yield:
2893	bug("FOAM_Yield: should not be here");
2894	break;
2895	case FOAM_NOp:
2896	cc = ccoStat(ccoIdOf(";"))ccoNew(CCO_Stat,1,ccoNew(CCO_Id,1,symProbe(";", 1 \| 2)));
2897	break;
2898	case FOAM_Cast:
2899	/*
2900	* If a single result value Set generated for a Fortran
2901	* routine which has one modifiable argument (and no
2902	* function result) is optimised out a cast is generated
2903	* when using -O casting to the type of the result value.
2904	* This clashes with the void result type specified in the
2905	* extern declaration for the routine.
2906	*/
2907	if (foamTag(foam->foamCast.expr)((foam->foamCast.expr)->hdr.tag) == FOAM_PCall &&
2908	foam->foamCast.expr->foamPCall.protocol == FOAM_Proto_Fortran)
2909	cc = gccExpr(foam->foamCast.expr);
2910	else
2911	cc = gccExpr(foam);
2912	break;
2913	default:
2914	cc = gccExpr(foam);
2915	break;
2916	}
2917	return cc;
2918	}
2919
2920	/*****************************************************************************
2921	*
2922	* :: Return the C code if statement from the Foam code if statement.
2923	*
2924	****************************************************************************/
2925
2926	localstatic CCode
2927	gccIf(Foam foam)
2928	{
2929	CCode ccTest, ccThen;
2930
2931	ccTest = gccExpr(foam->foamIf.test);
2932	ccThen = ccoGoto(gc0VarId("L", foam->foamIf.label))ccoNew(CCO_Goto,1,gc0VarId("L", foam->foamIf.label));
2933	return ccoIf(ccTest, ccThen, NULL)ccoNew(CCO_If,3,ccTest,ccThen,((void*)0));
2934	}
2935
2936	/*****************************************************************************
2937	*
2938	* :: Return 'switch..case' C code from Foam 'select' code 'foam'.
2939	*
2940	****************************************************************************/
2941
2942	localstatic CCode
2943	gccSelect(Foam foam)
2944	{
2945	int i;
2946	CCode ccSel, ccLabel;
2947	CCodeList code = listNil(CCode)((CCodeList) 0);
2948
2949	for (i = 0; i < foamArgc(foam)((foam)->hdr.argc)-1; i++) {
2950	ccLabel = gc0VarId("L", foam->foamSelect.argv[i]);
2951	gc0AddLine(code, ccoCase(ccoIntOf(i), ccoGoto(ccLabel)))gc0AddLineFun(&(code), ccoNew(CCO_Case,2,ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",i), 1 \| 2)),ccoNew(CCO_Goto,1,ccLabel )));
2952	}
2953	code = listNReverse(CCode)(CCode_listPointer->NReverse)(code);
2954	ccSel = gc0ListOf(CCO_Many, code);
2955	listFree(CCode)(CCode_listPointer->Free)(code);
2956	ccSel = ccoCompound(ccSel)ccoNew(CCO_Compound,1,ccSel);
2957	return ccoSwitch(gccExpr(foam->foamSelect.op), ccSel)ccoNew(CCO_Switch,2,gccExpr(foam->foamSelect.op),ccSel);
2958	}
2959
2960	/*****************************************************************************
2961	*
2962	* :: Return a C code 'return' statement for the given Foam node, 'foam'.
2963	*
2964	****************************************************************************/
2965
2966	localstatic CCode
2967	gccReturn(Foam foam)
2968	{
2969	FoamTag fTag = foamTag(foam)((foam)->hdr.tag);
2970	int retFmt;
2971	CCode ret;
2972
2973	retFmt = gcvProg->foamProg.format;
2974
2975	if (fTag == FOAM_Cast && foamTag(foam->foamCast.expr)((foam->foamCast.expr)->hdr.tag) != FOAM_BVal
2976	&& foamTag(foam->foamCast.expr)((foam->foamCast.expr)->hdr.tag) != FOAM_BCall
2977	&& foam->foamCast.type != FOAM_Rec)
2978	ret = ccoReturn(gccExpr(foam))ccoNew(CCO_Return,1,gccExpr(foam));
2979	else if (fTag == FOAM_Values)
2980	ret = gccReturnValues(foam);
2981	else if (gcvProg->foamProg.retType==FOAM_NOp)
2982	ret = ccoNewNode(CCO_Return, int0((int) 0));
2983	else if (ccoArgc(gcvSpec)((gcvSpec)->ccoNode.argc) > 1)
2984	ret = ccoReturn(gc0SubExpr(foam,ccoNew(CCO_Return,1,gc0SubExpr(foam, ccoCopy(((gcvSpec)->ccoNode .argv)[1])))
2985	ccoCopy(ccoArgv(gcvSpec)[1])))ccoNew(CCO_Return,1,gc0SubExpr(foam, ccoCopy(((gcvSpec)->ccoNode .argv)[1])));
2986	else
2987	ret = ccoReturn(gc0SubExpr(foam, ccoCopy(gcvSpec)))ccoNew(CCO_Return,1,gc0SubExpr(foam, ccoCopy(gcvSpec)));
2988
2989	if (foamProgUsesFluids(gcvProg)((gcvProg)->foamProg.infoBits & (1 << 5))) {
2990	return ccoNew(CCO_Compound, 1, ccoMany2(gc0PopFluid(), ret)ccoNew(CCO_Many,2,gc0PopFluid(),ret));
2991	}
2992	else return ret;
2993	}
2994
2995	/*****************************************************************************
2996	*
2997	* :: Return a C code 'return' statement for a multiple-value return
2998	* Foam node, 'foam'. Create the C statement with the return variables.
2999	*
3000	****************************************************************************/
3001
3002	localstatic CCode
3003	gccReturnValues(Foam foam)
3004	{
3005	int i;
3006
3007	for (i = 0; i < foamArgc(foam)((foam)->hdr.argc); i++) {
3008	CCode lhs = ccoPreStar(gc0MultVarId("R",i,""))ccoNew(CCO_PreStar,1,gc0MultVarId("R",i,""));
3009	#if 0 /* Using `word ' as return object /
3010	CCode rhs = gc0SubExpr(foam->foamValues.argv[i],
3011	ccoTypeIdOf(gcFiWord)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiWord", 1 \| 2))));
3012	#endif
3013	CCode rhs = gccExpr(foam->foamValues.argv[i]);
3014	gc0AddTopLevelStmt(gcvStmts, ccoStat(ccoAsst(lhs, rhs))ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,lhs,rhs)));
3015	}
3016	return ccoNewNode(CCO_Return, int0((int) 0));
3017	}
3018
3019
3020	/*****************************************************************************
3021	*
3022	* :: Return C code function which pushes the environment format given
3023	* from 'foam' onto the parent environment stack.
3024	*
3025	****************************************************************************/
3026
3027	localstatic CCode
3028	gccPushEnv(Foam foam)
3029	{
3030	CCode cc, cc1;
3031	int format = foam->foamPushEnv.format;
3032
3033	cc1 = gccExpr(foam->foamPushEnv.parent);
3034	if (gc0EmptyFormat(format)(((format == 4) \|\| ((((gcvFmt->foamDFmt.argv[format])-> hdr.argc) - (1)) == 0)) \|\| (format) == 0 \|\| ((((gcvFmt->foamDFmt .argv[format])->hdr.argc) - (1)) < 1)))
3035	cc = gcFiEnvPush(ccoIdOf(gcFiNil), cc1)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvPush", 1 \| 2 )),ccoNew(CCO_Many,2,ccoNew(CCO_Id,1,symProbe("fiNil", 1 \| 2) ),cc1));
3036	else
3037	cc = gcFiEnvPush(gcFi0New(gcFmtName, format, "CENSUS_EnvLevel"), cc1)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvPush", 1 \| 2 )),ccoNew(CCO_Many,2,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fi0New", 1 \| 2)),ccoNew(CCO_Many,2,ccoNew(CCO_StructRef,1,gc0VarId ("Fmt",format)),ccoNew(CCO_Id,1,symProbe("CENSUS_EnvLevel", 1 \| 2)))),cc1));
3038	return cc;
3039	}
3040
3041	/*****************************************************************************
3042	*
3043	* :: Return the C code statements created from the sequence of Foam nodes
3044	* given by 'foam'.
3045	*
3046	****************************************************************************/
3047
3048	localstatic CCode
3049	gccSeq(Foam foam)
3050	{
3051	int i, nSeq;
3052	Foam seqFoam;
3053	CCode ccSeq;
3054
3055	nSeq = foamArgc(foam)((foam)->hdr.argc);
3056	ccSeq = ccoNewNode(CCO_Many, nSeq);
3057	for (i = 0; i < nSeq; i++) {
3058	gcvisStmtFCall = 0;
3059	seqFoam = foamArgv(foam)((foam)->foamGen.argv)[i].code;
3060	/* These automatically generate a statement. */
3061	if (!isStmt(foamTag(seqFoam))(((((seqFoam)->hdr.tag)) != FOAM_Select) && ((((seqFoam )->hdr.tag)) != FOAM_Return) && ((((seqFoam)->hdr .tag)) != FOAM_Seq) && ((((seqFoam)->hdr.tag)) != FOAM_If ) && ((((seqFoam)->hdr.tag)) != FOAM_GenerStep) && ((((seqFoam)->hdr.tag)) != FOAM_Label) && ((((seqFoam )->hdr.tag)) != FOAM_Goto) && ((((seqFoam)->hdr .tag)) != FOAM_NOp))) {
3062	ccoArgv(ccSeq)((ccSeq)->ccoNode.argv)[i] = gc0SeqStmt(foam, i);
3063	if (foamTag(seqFoam)((seqFoam)->hdr.tag) != FOAM_Seq)
3064	gc0AddTopLevelStmt(gcvStmts, ccoArgv(ccSeq)((ccSeq)->ccoNode.argv)[i]);
3065	}
3066	else {
3067	ccoArgv(ccSeq)((ccSeq)->ccoNode.argv)[i] = ccoStat(gccCmd(seqFoam))ccoNew(CCO_Stat,1,gccCmd(seqFoam));
3068	gc0AddTopLevelStmt(gcvStmts, ccoArgv(ccSeq)((ccSeq)->ccoNode.argv)[i]);
3069	}
3070	ccoPos(ccoArgv(ccSeq)[i])((((ccSeq)->ccoNode.argv)[i])->ccoHdr.pos) = foamPos(seqFoam)((seqFoam)->hdr.pos);
3071	while (gcvNestUsed) {
3072	gcvNestFree = listCons(CCode)(CCode_listPointer->Cons)(car(gcvNestUsed)((gcvNestUsed)->first),
3073	gcvNestFree);
3074	gcvNestUsed = cdr(gcvNestUsed)((gcvNestUsed)->rest);
3075	}
3076
3077	}
3078	return ccSeq;
3079	}
3080
3081	/*****************************************************************************
3082	*
3083	* :: Return the C code for the Foam expression 'foam'.
3084	*
3085	****************************************************************************/
3086
3087	localstatic CCode
3088	gccExpr(Foam foam)
3089	{
3090	CCode cc;
3091
3092	switch (foamTag(foam)((foam)->hdr.tag)) {
3093	case FOAM_BVal:
3094	cc = gc0Builtin(foam->foamBVal.builtinTag, foam);
3095	break;
3096	case FOAM_Label:
3097	cc = ccoLabel(gc0VarId("L", foam->foamLabel.label),ccoNew(CCO_Label,2,gc0VarId("L", foam->foamLabel.label),ccoNew (CCO_Stat,1,((void*)0)))
3098	ccoStat(NULL))ccoNew(CCO_Label,2,gc0VarId("L", foam->foamLabel.label),ccoNew (CCO_Stat,1,((void*)0)));
3099	break;
3100	case FOAM_Cast:
3101	cc = gc0Cast(foam->foamCast.type, foam->foamCast.expr);
3102	break;
3103	case FOAM_ANew:
3104	cc = gccArrNew(foam);
3105	break;
3106	case FOAM_TRNew:
3107	cc = gccTRNew(foam);
3108	break;
3109	case FOAM_RRFmt:
3110	cc = gccRRFmt(foam);
3111	break;
3112	case FOAM_RRNew:
3113	cc = gccRRecNew(foam);
3114	break;
3115	case FOAM_RNew:
3116	cc = gccRecNew(foam);
3117	break;
3118	case FOAM_BCall:
3119	cc = gc0FunBCall(foam, emptyFormatSlot4);
3120	break;
3121	case FOAM_CCall:
3122	cc = gc0FunFoamCall(foam, emptyFormatSlot4);
3123	break;
3124	case FOAM_OCall:
3125	cc = gc0FunFoamCall(foam, emptyFormatSlot4);
3126	break;
3127	case FOAM_PCall:
3128	cc = gc0FunFoamCall(foam, emptyFormatSlot4);
3129	break;
3130	case FOAM_MFmt:
3131	cc = gccMFmt(foam);
3132	break;
3133	case FOAM_Values:
3134	cc = gccValues(foam);
3135	break;
3136	case FOAM_Throw:
3137	cc = gc0Throw(foam);
3138	break;
3139	default:
3140	cc = gccVal(foam);
3141	break;
3142	}
3143	return cc;
3144	}
3145
3146	/*****************************************************************************
3147	*
3148	* :: Return the C function to create a new array of the size and type
3149	* specified by the Foam array, 'foam'.
3150	*
3151	****************************************************************************/
3152
3153	localstatic CCode
3154	gccArrNew(Foam foam)
3155	{
3156	CCode ccArrIndex, ccFunName, ccCall;
3157
3158	ccArrIndex = gccExpr(foam->foamANew.size);
3159	ccFunName = ccoIdOf(strConcat("fiArrNew_",ccoNew(CCO_Id,1,symProbe(strConcat("fiArrNew_", ((foamInfoTable [(int)(foam->foamANew.eltType)-(int)FOAM_START]).str)), 1 \| 2))
3160	foamStr(foam->foamANew.eltType)))ccoNew(CCO_Id,1,symProbe(strConcat("fiArrNew_", ((foamInfoTable [(int)(foam->foamANew.eltType)-(int)FOAM_START]).str)), 1 \| 2));
3161	ccCall = ccoFCall(ccFunName, ccArrIndex)ccoNew(CCO_FCall,2,ccFunName,ccArrIndex);
3162	return ccoCast(gc0TypeId(FOAM_Ptr, emptyFormatSlot), ccCall)ccoNew(CCO_Cast,2,gc0TypeId(FOAM_Ptr, 4),ccCall);
3163	}
3164
3165	/*****************************************************************************
3166	*
3167	* :: Return the C function to create a new structure from the format specified
3168	* by the Foam record, 'foam'.
3169	*
3170	****************************************************************************/
3171
3172	localstatic CCode
3173	gccRecNew(Foam foam)
3174	{
3175	int fmt;
3176
3177	fmt = foam->foamRNew.format;
3178	return gcFi0RecNew(gcFmtName, fmt, "CENSUS_Rec")ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fi0RecNew", 1 \| 2 )),ccoNew(CCO_Many,2,ccoNew(CCO_StructRef,1,gc0VarId("Fmt",fmt )),ccoNew(CCO_Id,1,symProbe("CENSUS_Rec", 1 \| 2))));
3179	}
3180
3181	/*****************************************************************************
3182	*
3183	* :: Return the C function to create a new raw record.
3184	*
3185	****************************************************************************/
3186
3187	localstatic CCode
3188	gccRRecNew(Foam foam)
3189	{
3190	AInt argc;
3191	CCode ccFmt, ccArgs;
3192
3193
3194	/* Get the format of this record */
3195	ccFmt = gccExpr(foam->foamRRNew.fmt);
3196
3197
3198	/* How many fields in the record? */
3199	argc = foam->foamRRNew.argc;
3200
3201
3202	/* Create the arguments for fiRawRecordNew */
3203	ccArgs = ccoMany2(gccExpr(foamNewSInt(argc)), ccFmt)ccoNew(CCO_Many,2,gccExpr(foamNew(FOAM_SInt, 1, (AInt)(argc)) ),ccFmt);
3204	return ccoFCall(ccoIdOf("fiRawRecordNew"), ccArgs)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiRawRecordNew", 1 \| 2)),ccArgs);
3205	}
3206
3207
3208	localstatic CCode
3209	gccRRFmt(Foam foam)
3210	{
3211	Foam format;
3212	AInt argc, i;
3213	CCode ccArgs, ccFmt;
3214	CCodeList arglist;
3215
3216
3217	/* Get the format of this record */
3218	format = foam->foamRRFmt.fmt;
3219
3220
3221	/* Must be a FOAM_Values */
3222	assert(foamTag(format) == FOAM_Values)do { if (!(((format)->hdr.tag) == FOAM_Values)) _do_assert (("foamTag(format) == FOAM_Values"),"genc.c",3222); } while ( 0);
3223
3224
3225	/* How many fields in the record? */
3226	argc = foamArgc(format)((format)->hdr.argc);
3227
3228
3229	/* Convert the values into a list */
3230	arglist = listNil(CCode)((CCodeList) 0);
3231	for (i = argc - 1;i >= 0; i--)
3232	{
3233	Foam arg = (format->foamValues.argv)[i];
3234	listPush(CCode, gccExpr(arg), arglist)(arglist = (CCode_listPointer->Cons)(gccExpr(arg), arglist ));
3235	}
3236	listPush(CCode, gccExpr(foamNewSInt(argc)), arglist)(arglist = (CCode_listPointer->Cons)(gccExpr(foamNew(FOAM_SInt , 1, (AInt)(argc))), arglist));
3237	ccArgs = gc0ListOf(CCO_Many, arglist);
3238
3239
3240	/* Generate the call to fiRawRecordValues */
3241	ccFmt = ccoFCall(ccoIdOf("fiRawRecordValues"), ccArgs)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiRawRecordValues" , 1 \| 2)),ccArgs);
3242
3243
3244	/* Can we globalise this format creation? */
3245	if (rrRRFmtIsIndependent(foam))
3246	ccFmt = gc0RRFmt(ccFmt, foam);
3247
3248
3249	/* Return the format */
3250	return ccFmt;
3251	}
3252
3253
3254	/* Store RRFmt in a C global for this module */
3255	localstatic CCode
3256	gc0RRFmt(CCode ccFmt, Foam rrfmt)
3257	{
3258	CCode cctype, ccdecl, ccset, ccname;
3259
3260
3261	/* Can we reuse a global? */
3262	ccname = (CCode)tblElt(gcvRRFmtTable, (TblKey)rrfmt, (TblElt)0);
3263	if (ccname) return ccoCopy(ccname);
3264
3265
3266	/* Create a new global */
3267	if (gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax))
3268	{
3269	String id = gcvConst->foamDDecl.argv[0]->foamDecl.id;
3270	ccname = gc0MultVarId("GRRFmt", gcvNRRFmt, id);
3271
3272
3273	/* extern FiWord GRRFmt0; */
3274	cctype = ccoType(ccoExtern(), ccoTypeIdOf(gcFiWord))ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew(CCO_TypedefId,1 ,ccoNew(CCO_Id,1,symProbe("FiWord", 1 \| 2))));
3275	ccdecl = ccoDecl(cctype, ccoCopy(ccname))ccoNew(CCO_Decl,2,cctype,ccoCopy(ccname));
3276
3277
3278	/* Add to the globals declaration list */
3279	gc0AddLine(gcvGloCC, ccdecl)gc0AddLineFun(&(gcvGloCC), ccdecl);
3280
3281
3282	/* FiWord GRRFmt0 = fiRawRecordValues(...); */
3283	cctype = ccoTypeIdOf(gcFiWord)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiWord", 1 \| 2)));
3284	}
3285	else
3286	{
3287	/* static FiWord GRRFmt0 = fiRawRecordValues(...); */
3288	ccname = gc0VarId("GRRFmt", gcvNRRFmt);
3289	cctype = ccoType(ccoStatic(), ccoTypeIdOf(gcFiWord))ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew(CCO_TypedefId,1 ,ccoNew(CCO_Id,1,symProbe("FiWord", 1 \| 2))));
3290	}
3291
3292
3293	/* Create a simple declaration for global */
3294	ccdecl = ccoDecl(cctype, ccoCopy(ccname))ccoNew(CCO_Decl,2,cctype,ccoCopy(ccname));
3295	gc0AddLine(gcvDefCC, ccdecl)gc0AddLineFun(&(gcvDefCC), ccdecl);
3296
3297
3298	/* Add its initialisation to the module init */
3299	ccset = ccoStatAsst(ccoCopy(ccname), ccFmt)ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccoCopy(ccname),ccFmt));
3300	gc0AddLine(gcvRRFmtCC, ccset)gc0AddLineFun(&(gcvRRFmtCC), ccset);
3301
3302
3303	/* Record the global in our table */
3304	tblSetElt(gcvRRFmtTable, (TblKey)foamCopy(rrfmt), (TblElt)ccname);
3305
3306
3307	/* We have added another RRFmt global */
3308	gcvNRRFmt++;
3309
3310
3311	/* Return the reference to the global */
3312	return ccoCopy(ccname);
3313	}
3314
3315
3316	/*****************************************************************************
3317	*
3318	* :: Return the function call of the Foam PCall, 'foam'.
3319	*
3320	****************************************************************************/
3321
3322	localstatic CCode
3323	gccPCallId(Foam foam)
3324	{
3325	#ifdef NEED_FUN_CAST
3326	CCode ccType;
3327
3328	ccType = ccoFCall(ccoFCall(gc0TypeId(foam->foamPCall.type, emptyFormatSlot),ccoNew(CCO_FCall,2,ccoNew(CCO_FCall,2,gc0TypeId(foam->foamPCall .type, 4),ccoNew(CCO_Id,1,symProbe("*", 1 \| 2))),((int) 0))
3329	ccoIdOf("")), int0)ccoNew(CCO_FCall,2,ccoNew(CCO_FCall,2,gc0TypeId(foam->foamPCall .type, 4),ccoNew(CCO_Id,1,symProbe("", 1 \| 2))),((int) 0));
3330	return ccoParen(gc0SubExpr(foam->foamPCall.op, ccType))ccoNew(CCO_Paren,1,gc0SubExpr(foam->foamPCall.op, ccType));
3331	#else
3332	return gccExpr(foam->foamPCall.op);
3333	#endif
3334	}
3335
3336
3337	/*
3338	* TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO
3339	* TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO
3340	* TODO
3341	* TODO This should be restructured so that the cases for the types are
3342	* TODO handled completely in single blocks. As is, the logic to prove
3343	* TODO that all variables have proper values as we separate and join
3344	* TODO is to complicated for most compilers and people.
3345	* TODO See the "Just to silence the compiler..." comment. SMW Sept 01.
3346	* TODO
3347	* TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO
3348	* TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO
3349	*/
3350
3351
3352	/*
3353	* This code doesn't worry about the final type for XL Word
3354	* pointer arguments i.e. whether they are FiWord, PFmt or FiChar
3355	* In addition we don't convert Fortran strings into Aldor strings
3356	* after a Fortran PCall. Thus if Fortran modifies a string
3357	* argument then it will not be NULL terminated unless the
3358	* Fortran routine does something special. We ought to do the
3359	* same thing as in FOAM whereby we store the function result
3360	* in a temporary, perform any special actions like patching
3361	* Fortran strings and then returning the temporary.
3362	*/
3363	localstatic CCode
3364	gccFortranPCall(Foam resultvar, int numresultvars, Foam foam, CCodeList closnulls)
3365	{
3366	Foam gdecl, argformat, fargfmt, farg, fargnocast;
3367	CCode ccTmp, ccArg, ccType, ccName, ccCast, ccChrTmp;
3368	CCode ccLenArg;
3369	CCode ccChrlen = NULL((void*)0), ccArgs;
3370	CCodeList argslist;
3371	CCodeList mainargs = listNil(CCode)((CCodeList) 0);
3372	CCodeList chrlenargs = listNil(CCode)((CCodeList) 0);
3373	CCodeList closnullifys = listNil(CCode)((CCodeList) 0);
3374	int fnparamno = 0;
3375	int extraArg = 0;
3376	int i;
3377	String cmplxfns = compCfgLookupString("fortran-cmplx-fns");
3378	FtnFunParam fnparam;
3379	String tmpstr;
3380	FortranType restype, argtype;
3381	Length argc = foamArgc(foam)((foam)->hdr.argc)-3;
3382	FoamTag resvartype;
3383	FoamTag fmtype;
3384	AInt resvarfmt;
3385	Bool modifiablearg;
3386	Foam fnresultdecl;
3387
3388
3389	/* Just to silence the compiler... */
3390	ccType = NULL((void*)0);
3391	ccName = NULL((void*)0);
3392	ccChrTmp = NULL((void*)0);
3393	ccArg = NULL((void*)0);
3394	ccLenArg = NULL((void*)0);
3395	resvartype = FOAM_Nil;
3396	resvarfmt = 0;
3397
3398	/* deal with result type... */
3399	gdecl = gc0GetDecl(foam->foamPCall.op);
3400	argformat = gcvFmt->foamDFmt.argv[gdecl->foamGDecl.format];
3401	fnresultdecl = gc0GetFortranRetFm(argformat);
3402
3403	restype = gc0GetFortranRetType(argformat);
3404	if (restype && (restype != FTN_Machine))
3405	fmtype = gen0FtnMachineType(restype);
3406	else
3407	fmtype = fnresultdecl->foamDecl.type;
3408
3409
3410	/* Char and Character are equivalent */
3411	if (fmtype == FOAM_Char)
3412	restype = FTN_Character;
3413
3414
3415	/* Only allow 0 or 1 return value now ... */
3416	assert(!numresultvars \|\| (numresultvars == 1))do { if (!(!numresultvars \|\| (numresultvars == 1))) _do_assert (("!numresultvars \|\| (numresultvars == 1)"),"genc.c",3416); } while (0);
3417
3418	switch (restype) {
3419	case FTN_Character:
3420	/*
3421	* Our hack in gen0MakeApplyArgs() has provided
3422	* us with the string length as the first argument
3423	* to this function. We just need to add the buffer.
3424	*/
3425	ccType = ccoPostStar(ccoChar())ccoNew(CCO_PostStar,1,ccoNew(CCO_Char,0));
3426	ccChrTmp = gc0GetTmp(ccType);
3427	if (numresultvars)
3428	ccName = gccRef(resultvar[numresultvars-1]);
3429	else
3430	ccName = gc0GetTmp(ccType);
3431
3432
3433	/* Add the string pointer */
3434	ccTmp = ccoCast(ccoCopy(ccType), ccoCopy(ccChrTmp))ccoNew(CCO_Cast,2,ccoCopy(ccType),ccoCopy(ccChrTmp));
3435	mainargs = listCons(CCode)(CCode_listPointer->Cons)(ccTmp, mainargs);
3436
3437
3438	/* How long is the return value? */
3439	ccLenArg = gc0GetTmp(ccoTypeIdOf(gcFiSInt)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiSInt", 1 \| 2))));
3440	farg = foam->foamPCall.argv[0];
3441	ccTmp = ccoAsst(ccoCopy(ccLenArg), gccExpr(farg))ccoNew(CCO_Asst,2,ccoCopy(ccLenArg),gccExpr(farg));
3442	gc0AddTopLevelStmt(gcvStmts, ccoStat(ccTmp)ccoNew(CCO_Stat,1,ccTmp));
3443
3444
3445	/*
3446	* We need to allocate a buffer for the result
3447	* irrespective of whether or not the caller
3448	* wants to use it.
3449	*/
3450	ccTmp = ccoPlus(ccoCopy(ccLenArg), ccoIdOf("1"))ccoNew(CCO_Plus,2,ccoCopy(ccLenArg),ccoNew(CCO_Id,1,symProbe( "1", 1 \| 2)));
3451	ccArg = ccoCast(ccoCopy(ccType), ccoCopy(ccChrTmp))ccoNew(CCO_Cast,2,ccoCopy(ccType),ccoCopy(ccChrTmp));
3452	ccTmp = ccoMany3(ccArg, ccoCopy(ccType), ccTmp)ccoNew(CCO_Many,3,ccArg,ccoCopy(ccType),ccTmp);
3453	ccTmp = ccoFCall(ccoIdOf("fiARRNEW_Char"), ccTmp)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiARRNEW_Char", 1 \| 2)),ccTmp);
3454	gc0AddTopLevelStmt(gcvStmts, ccoStat(ccTmp)ccoNew(CCO_Stat,1,ccTmp));
3455
3456
3457	/* We have an extra dummy argument */
3458	extraArg = 1;
3459	break;
3460	case FTN_String:
3461	case FTN_XLString:
3462	/*
3463	* Our hack in gen0MakeApplyArgs() has provided
3464	* us with the string length as the first argument
3465	* to this function. We just need to add the buffer.
3466	*/
3467	ccType = ccoPostStar(ccoChar())ccoNew(CCO_PostStar,1,ccoNew(CCO_Char,0));
3468	if (numresultvars)
3469	ccName = gccRef(resultvar[numresultvars - 1]);
3470	else
3471	ccName = gc0GetTmp(ccType);
3472
3473
3474	/* Add the string pointer */
3475	ccTmp = ccoCast(ccoCopy(ccType), ccoCopy(ccName))ccoNew(CCO_Cast,2,ccoCopy(ccType),ccoCopy(ccName));
3476	mainargs = listCons(CCode)(CCode_listPointer->Cons)(ccTmp, mainargs);
3477
3478
3479	/* How long is the return value? */
3480	ccLenArg = gc0GetTmp(ccoTypeIdOf(gcFiSInt)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiSInt", 1 \| 2))));
3481	farg = foam->foamPCall.argv[0];
3482	ccTmp = ccoAsst(ccoCopy(ccLenArg), gccExpr(farg))ccoNew(CCO_Asst,2,ccoCopy(ccLenArg),gccExpr(farg));
3483	gc0AddTopLevelStmt(gcvStmts, ccoStat(ccTmp)ccoNew(CCO_Stat,1,ccTmp));
3484
3485
3486	/*
3487	* We need to allocate a buffer for the result
3488	* irrespective of whether or not the caller
3489	* wants to use it.
3490	*/
3491	ccTmp = ccoPlus(ccoCopy(ccLenArg), ccoIdOf("1"))ccoNew(CCO_Plus,2,ccoCopy(ccLenArg),ccoNew(CCO_Id,1,symProbe( "1", 1 \| 2)));
3492	ccArg = ccoCast(ccoCopy(ccType), ccoCopy(ccName))ccoNew(CCO_Cast,2,ccoCopy(ccType),ccoCopy(ccName));
3493	ccTmp = ccoMany3(ccArg, ccoCopy(ccType), ccTmp)ccoNew(CCO_Many,3,ccArg,ccoCopy(ccType),ccTmp);
3494	ccTmp = ccoFCall(ccoIdOf("fiARRNEW_Char"), ccTmp)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiARRNEW_Char", 1 \| 2)),ccTmp);
3495	gc0AddTopLevelStmt(gcvStmts, ccoStat(ccTmp)ccoNew(CCO_Stat,1,ccTmp));
3496
3497
3498	/* We have an extra dummy argument */
3499	extraArg = 1;
3500	break;
3501	case FTN_FSComplex:
3502	/* Fall through */
3503	case FTN_FDComplex:
3504	if (!cmplxfns)
3505	comsgFatal(NULL((void*)0), ALDOR_F_NoFCmplxProperty272, "fortran-cmplx-fns");
3506	else if (strEqual(cmplxfns, "return-void")) {
3507	ccType = ccoTypeIdOf(restype == FTN_FSComplex ?ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe(restype == FTN_FSComplex ? "FiComplexSF" : "FiComplexDF", 1 \| 2)))
3508	gcFiComplexSF : gcFiComplexDF)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe(restype == FTN_FSComplex ? "FiComplexSF" : "FiComplexDF", 1 \| 2)));
3509	if (numresultvars)
3510	mainargs = listCons(CCode)(CCode_listPointer->Cons)(ccoCast(ccoPostStar(ccType),ccoNew(CCO_Cast,2,ccoNew(CCO_PostStar,1,ccType),gccRef(resultvar [numresultvars-1]))
3511	gccRef(resultvar[numresultvars-1]))ccoNew(CCO_Cast,2,ccoNew(CCO_PostStar,1,ccType),gccRef(resultvar [numresultvars-1])),
3512	mainargs);
3513	else {
3514	ccName = gc0GetTmp(ccType);
3515	mainargs = listCons(CCode)(CCode_listPointer->Cons)(ccoPreAnd(ccName)ccoNew(CCO_PreAnd,1,ccName), mainargs);
3516	}
3517	}
3518	else if (strEqual(cmplxfns, "disallowed"))
3519	bug("gccFortranPCall : Fortran function returning a complex result detected");
3520	else if (!strEqual(cmplxfns, "return-struct"))
3521	comsgFatal(NULL((void*)0), ALDOR_F_BadFCmplxValue273, cmplxfns);
3522	break;
3523	default:
3524	break;
3525	}
3526
3527
3528	/* We need to add some extra statements after the PCall */
3529	switch (restype) {
3530	case FTN_Character:
3531	/* Pull out the char result */
3532	ccTmp = ccoCast(ccoCopy(ccType), ccoCopy(ccChrTmp))ccoNew(CCO_Cast,2,ccoCopy(ccType),ccoCopy(ccChrTmp));
3533	ccCast = ccoARef(ccoParen(ccTmp), ccoIdOf("0"))ccoNew(CCO_ARef,2,ccoNew(CCO_Paren,1,ccTmp),ccoNew(CCO_Id,1,symProbe ("0", 1 \| 2)));
3534	ccTmp = ccoCast(ccoChar(), ccoCopy(ccCast))ccoNew(CCO_Cast,2,ccoNew(CCO_Char,0),ccoCopy(ccCast));
3535	ccTmp = ccoAsst(ccoCopy(ccName), ccTmp)ccoNew(CCO_Asst,2,ccoCopy(ccName),ccTmp);
3536
3537	closnullifys = listCons(CCode)(CCode_listPointer->Cons)(ccTmp, closnullifys);
3538	break;
3539	case FTN_XLString:
3540	/*
3541	* Kill the string return value because we
3542	* don't know how long it is. They need to
3543	* use FixedString() instead.
3544	*
3545	* Generate the code:
3546	*
3547	* (char *)ccName[ccLen] = (char)0
3548	*/
3549	ccTmp = ccoCast(ccoCopy(ccType), ccoCopy(ccName))ccoNew(CCO_Cast,2,ccoCopy(ccType),ccoCopy(ccName));
3550	ccCast = ccoARef(ccoParen(ccTmp), ccoCopy(ccLenArg))ccoNew(CCO_ARef,2,ccoNew(CCO_Paren,1,ccTmp),ccoCopy(ccLenArg) );
3551	ccTmp = ccoCast(ccoChar(), ccoIdOf("0"))ccoNew(CCO_Cast,2,ccoNew(CCO_Char,0),ccoNew(CCO_Id,1,symProbe ("0", 1 \| 2)));
3552	ccTmp = ccoAsst(ccCast, ccTmp)ccoNew(CCO_Asst,2,ccCast,ccTmp);
3553
3554	closnullifys = listCons(CCode)(CCode_listPointer->Cons)(ccTmp, closnullifys);
3555	break;
3556	default:
3557	break;
3558	}
3559
3560
3561	/*
3562	* The FOAM generation deals with passing values by reference.
3563	* Those arguments which need to be passed to Fortran as a
3564	* pointer will have been stored in a record for us already.
3565	* Thus all we have to do here is take care of any special
3566	* parameters such as String and function values.
3567	*/
3568	/* for (i = 0; i < argc; i++) { */
3569	for (i = 0; i < argc; i++) {
3570	if (extraArg && !i)
3571	{
3572	/* Here's one I prepared earlier ... */
3573	assert(ccLenArg)do { if (!(ccLenArg)) _do_assert(("ccLenArg"),"genc.c",3573); } while (0);
3574	ccArg = ccoCopy(ccLenArg);
3575	mainargs = listCons(CCode)(CCode_listPointer->Cons)(ccArg, mainargs);
3576	continue;
3577	}
3578
3579
3580	fargfmt = argformat->foamDDecl.argv[i-extraArg];
3581	modifiablearg = gc0IsModifiableFortranArg(fargfmt);
3582	argtype = gc0GetFortranType(fargfmt);
3583	farg = foam->foamPCall.argv[i];
3584	fargnocast = (foamTag(farg)((farg)->hdr.tag) == FOAM_Cast) ?
3585	farg->foamCast.expr : farg;
3586	fmtype = fargfmt->foamDecl.type;
3587
3588
3589	/* Char and Character are treated in the same way */
3590	if (fmtype == FOAM_Char)
3591	argtype = FTN_Character;
3592
3593
3594	switch (argtype) {
3595	case FTN_Character:
3596	/* Fall through */
3597	case FTN_String:
3598	/* Fall through */
3599	case FTN_XLString:
3600	ccArg = gccFtnXLstring(farg, argtype, modifiablearg, &ccChrlen);
3601	chrlenargs = listCons(CCode)(CCode_listPointer->Cons)(ccChrlen, chrlenargs);
3602	break;
3603	case FTN_StringArray:
3604	ccArg = gccFtnStringArray(farg, &ccChrlen);
3605	chrlenargs = listCons(CCode)(CCode_listPointer->Cons)(ccChrlen, chrlenargs);
3606	break;
3607	case FTN_FnParam:
3608	tmpstr = gdecl->foamGDecl.id;
3609	fnparam = gc0FtnFunParam(tmpstr, fnparamno++);
3610	ccArg = gccFtnFnParam(farg, fnparam, &ccTmp);
3611	closnullifys = listCons(CCode)(CCode_listPointer->Cons)(ccTmp, closnullifys);
3612	break;
3613	case FTN_Array:
3614	case FTN_Word:
3615	case FTN_Machine:
3616	case FTN_Boolean:
3617	case FTN_SingleInteger:
3618	case FTN_FDouble:
3619	case FTN_FSingle:
3620	case FTN_FSComplex:
3621	case FTN_FDComplex:
3622	ccArg = gccExpr(farg);
3623	break;
3624	default: bug("gccFortranPCall: bad case");
3625	}
3626
3627
3628	/*
3629	* Fortran doesn't use NUL terminated strings but
3630	* Aldor usually does (and definitely does at this
3631	* low-level). We need to add an extra statement for
3632	* each String/Character/FixedString argument to be
3633	* executed after the Fortran function returns.
3634	* The statement simply terminates the string so
3635	* that other code can work safely. We generate:
3636	*
3637	* (char *)ccArg[ccLen] = (char)0
3638	*/
3639	switch (argtype) {
3640	case FTN_String:
3641	/* Fall through */
3642	case FTN_XLString:
3643	/*
3644	* Kill the string return value because we
3645	* don't know how long it is. They need to
3646	* use FixedString() instead.
3647	*
3648	* Generate the code:
3649	*
3650	* (char *)ccName[ccLen] = (char)0
3651	*/
3652	ccTmp = ccoPostStar(ccoChar())ccoNew(CCO_PostStar,1,ccoNew(CCO_Char,0));
3653	ccTmp = ccoCast(ccoCopy(ccTmp), ccoCopy(ccArg))ccoNew(CCO_Cast,2,ccoCopy(ccTmp),ccoCopy(ccArg));
3654	ccCast = ccoARef(ccoParen(ccTmp), ccoCopy(ccChrlen))ccoNew(CCO_ARef,2,ccoNew(CCO_Paren,1,ccTmp),ccoCopy(ccChrlen) );
3655	ccTmp = ccoCast(ccoChar(), ccoIdOf("0"))ccoNew(CCO_Cast,2,ccoNew(CCO_Char,0),ccoNew(CCO_Id,1,symProbe ("0", 1 \| 2)));
3656	ccTmp = ccoAsst(ccCast, ccTmp)ccoNew(CCO_Asst,2,ccCast,ccTmp);
3657
3658	closnullifys = listCons(CCode)(CCode_listPointer->Cons)(ccTmp, closnullifys);
3659	break;
3660	default:
3661	break;
3662	}
3663	mainargs = listCons(CCode)(CCode_listPointer->Cons)(ccArg, mainargs);
3664	}
3665	mainargs = listNReverse(CCode)(CCode_listPointer->NReverse)(mainargs);
3666	chrlenargs = listNReverse(CCode)(CCode_listPointer->NReverse)(chrlenargs);
3667	argslist = listNConcat(CCode)(CCode_listPointer->NConcat)(mainargs, chrlenargs);
3668	ccArgs = gc0ListOf(CCO_Many, argslist);
3669	listFree(CCode)(CCode_listPointer->Free)(argslist);
3670	if (closnullifys) {
3671	closnullifys = listNReverse(CCode)(CCode_listPointer->NReverse)(closnullifys);
3672	*closnulls = closnullifys;
3673	}
3674	return ccoFCall(gccExpr(foam->foamPCall.op), ccArgs)ccoNew(CCO_FCall,2,gccExpr(foam->foamPCall.op),ccArgs);
3675	}
3676
3677	localstatic CCode
3678	gccFtnXLstring(Foam farg, FortranType type, Bool modifiablearg, CCode *ccChrlen)
3679	{
3680	Foam fargnocast;
3681	CCode ccArgStr;
3682	CCode ccType, ccCast1, ccCast2;
3683	CCode ccTmp, ccTmpLen, ccTmpStr, ccTmpLenPlus;
3684	FoamTag fargcast = (FoamTag)0;
3685
3686
3687	/* Obtain a version of the argument without a cast */
3688	if (foamTag(farg)((farg)->hdr.tag) == FOAM_Cast)
3689	{
3690	fargcast = farg->foamCast.type;
3691	fargnocast = farg->foamCast.expr;
3692	}
3693	else
3694	fargnocast = farg;
3695
3696
3697	/* Safety checks */
3698	assert(ccChrlen)do { if (!(ccChrlen)) _do_assert(("ccChrlen"),"genc.c",3698); } while (0);
3699	assert(genIsVar(fargnocast))do { if (!(genIsVar(fargnocast))) _do_assert(("genIsVar(fargnocast)" ),"genc.c",3699); } while (0);
3700
3701
3702	/*
3703	* If the argument is an expression rather than an
3704	* identifier then we store it in a temporary. This
3705	* code assumes that all modifiable arguments reach
3706	* us as an lvalue (eg a temporary). Hopefully this
3707	* is a reasonable assumption since the FOAM creator
3708	* needs to know which lvalue is going to be modified
3709	* so that it can update the reference after the call.
3710	*
3711	* ccArgStr = ccArg;
3712	*/
3713	if (modifiablearg)
3714	{
3715	/* Copy the argument */
3716	ccArgStr = gccRef(fargnocast);
3717
3718
3719	/* We may need to cast this to something else */
3720	if (fargcast)
3721	{
3722	ccTmp = gc0TypeId(fargcast, emptyFormatSlot4);
3723	ccArgStr = ccoCast(ccTmp, ccArgStr)ccoNew(CCO_Cast,2,ccTmp,ccArgStr);
3724	}
3725	}
3726	else
3727	{
3728	ccType = gc0TypeId(FOAM_Word, emptyFormatSlot4);
3729	ccArgStr = gc0GetTmp(ccType);
3730	ccTmp = ccoCopy(gccExpr(farg));
3731	ccTmp = ccoAsst(ccoCopy(ccArgStr), ccTmp)ccoNew(CCO_Asst,2,ccoCopy(ccArgStr),ccTmp);
3732	gc0AddTopLevelStmt(gcvStmts, ccoStat(ccTmp)ccoNew(CCO_Stat,1,ccTmp));
3733	}
3734
3735
3736	/*
3737	* Always pass a copy of the string: string literals
3738	* are usually stored in a read-only segment of the
3739	* process and we will cause a seg-fault if Fortran
3740	* tries to modify the value passed to it. Note that
3741	* Fortran will hopefully give us an unaliased copy
3742	* of the string on return.
3743	*
3744	* For character we generate the code:
3745	*
3746	* ccTmpLen = 1;
3747	* fiARRNEW_Char(ccTmpStr, FOAM_Word, ccTmpLen+1);
3748	* strncpy((char )ccTmpStr, (char )ccArgStr, ccTmpLen);
3749	* ((char *)ccTmpStr)[ccTmpLen] = (char)0;
3750	*
3751	* while for real strings we generate:
3752	*
3753	* ccTmpLen = strlen((char *)ccArgStr);
3754	* fiARRNEW_Char(ccTmpStr, FOAM_Word, ccTmpLen+1);
3755	* strncpy((char )ccTmpStr, (char )ccArgStr, ccTmpLen);
3756	* ((char *)ccTmpStr)[ccTmpLen] = (char)0;
3757	*/
3758	ccType = gc0TypeId(FOAM_SInt, emptyFormatSlot4);
3759	ccTmpLen = gc0GetTmp(ccType);
3760
3761	if (type != FTN_Character)
3762	{
3763	ccTmp = ccoPostStar(ccoChar())ccoNew(CCO_PostStar,1,ccoNew(CCO_Char,0));
3764	ccTmp = ccoCast(ccTmp, ccoCopy(ccArgStr))ccoNew(CCO_Cast,2,ccTmp,ccoCopy(ccArgStr));
3765	ccTmp = ccoFCall(ccoIdOf("strlen"), ccTmp)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("strlen", 1 \| 2)) ,ccTmp);
3766	}
3767	else
3768	ccTmp = ccoIdOf("1")ccoNew(CCO_Id,1,symProbe("1", 1 \| 2));
3769
3770	ccTmp = ccoAsst(ccoCopy(ccTmpLen), ccTmp)ccoNew(CCO_Asst,2,ccoCopy(ccTmpLen),ccTmp);
3771	gc0AddTopLevelStmt(gcvStmts, ccoStat(ccTmp)ccoNew(CCO_Stat,1,ccTmp));
3772
3773
3774	/* Compute ccTmpLen + 1 */
3775	ccTmpLenPlus = ccoPlus(ccoCopy(ccTmpLen), ccoIdOf("1"))ccoNew(CCO_Plus,2,ccoCopy(ccTmpLen),ccoNew(CCO_Id,1,symProbe( "1", 1 \| 2)));
3776
3777
3778	/* Allocate a buffer for the string */
3779	ccType = gc0TypeId(FOAM_Word, emptyFormatSlot4);
3780	ccTmpStr = gc0GetTmp(ccType);
3781	ccTmp = ccoCopy(ccTmpLenPlus);
3782	ccTmp = ccoMany3(ccoCopy(ccTmpStr), ccoCopy(ccType), ccTmp)ccoNew(CCO_Many,3,ccoCopy(ccTmpStr),ccoCopy(ccType),ccTmp);
3783	ccTmp = ccoFCall(ccoIdOf("fiARRNEW_Char"), ccTmp)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiARRNEW_Char", 1 \| 2)),ccTmp);
3784	gc0AddTopLevelStmt(gcvStmts, ccoStat(ccTmp)ccoNew(CCO_Stat,1,ccTmp));
3785
3786
3787	/* Copy our argument across */
3788	ccTmp = ccoPostStar(ccoChar())ccoNew(CCO_PostStar,1,ccoNew(CCO_Char,0));
3789	ccCast1 = ccoCast(ccoCopy(ccTmp), ccoCopy(ccTmpStr))ccoNew(CCO_Cast,2,ccoCopy(ccTmp),ccoCopy(ccTmpStr));
3790	ccCast2 = ccoCast(ccoCopy(ccTmp), ccoCopy(ccArgStr))ccoNew(CCO_Cast,2,ccoCopy(ccTmp),ccoCopy(ccArgStr));
3791	ccTmp = ccoMany3(ccCast1, ccCast2, ccoCopy(ccTmpLen))ccoNew(CCO_Many,3,ccCast1,ccCast2,ccoCopy(ccTmpLen));
3792	ccTmp = ccoFCall(ccoIdOf("strncpy"), ccTmp)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("strncpy", 1 \| 2) ),ccTmp);
3793	gc0AddTopLevelStmt(gcvStmts, ccoStat(ccTmp)ccoNew(CCO_Stat,1,ccTmp));
3794
3795
3796	if (modifiablearg)
3797	{
3798	/*
3799	* Update the temporary variable used for the
3800	* reference with the pointer to the new string
3801	* value. This may be modified by Fortran and
3802	* can then be written back to the reference.
3803	* We can only do this here before the call is
3804	* actually made if different temporaries were
3805	* used for each string ...
3806	*/
3807	ccTmp = ccoAsst(ccoCopy(ccArgStr), ccoCopy(ccTmpStr))ccoNew(CCO_Asst,2,ccoCopy(ccArgStr),ccoCopy(ccTmpStr));
3808	gc0AddTopLevelStmt(gcvStmts, ccoStat(ccTmp)ccoNew(CCO_Stat,1,ccTmp));
3809	}
3810
3811
3812	*ccChrlen = ccoCopy(ccTmpLen);
3813	return ccoCopy(ccTmpStr);
3814	}
3815
3816	localstatic CCode
3817	gccFtnStringArray(Foam foam, CCode *ccChrlen)
3818	{
3819	Foam arr, len;
3820	CCode ccarr, cclen;
3821
3822
3823	/* Must be a FOAM_Values with two elements */
3824	assert(foamTag(foam) == FOAM_Values)do { if (!(((foam)->hdr.tag) == FOAM_Values)) _do_assert(( "foamTag(foam) == FOAM_Values"),"genc.c",3824); } while (0);
3825	assert(foamArgc(foam) == 2)do { if (!(((foam)->hdr.argc) == 2)) _do_assert(("foamArgc(foam) == 2" ),"genc.c",3825); } while (0);
3826	assert(ccChrlen)do { if (!(ccChrlen)) _do_assert(("ccChrlen"),"genc.c",3826); } while (0);
3827
3828
3829	/* Split into two components: data and length */
3830	arr = foam->foamValues.argv[0];
3831	len = foam->foamValues.argv[1];
3832
3833
3834	/* Convert both parts into C */
3835	ccarr = gccExpr(arr);
3836	cclen = gccExpr(len);
3837
3838
3839	/* Tell our caller about the length */
3840	*ccChrlen = ccoCopy(cclen);
3841
3842
3843	/* Return the data component */
3844	return ccoCopy(ccarr);
3845	}
3846
3847
3848	localstatic CCode
3849	gccFtnFnParam(Foam farg, FtnFunParam info, CCode *pClos)
3850	{
3851	char num[20];
3852	CCode ccTmp;
3853	CCode ccClos = gc0FtnFunClosure(info)((info)->clos);
3854
3855
3856	/* Make sure we don't recurse */
3857	(void)sprintf(num, "%d", FOAM_Halt_BadFortranRecursion);
3858	ccTmp = gcFiHalt(ccoIdOf(num))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiHalt", 1 \| 2)) ,ccoNew(CCO_Cast,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiSInt", 1 \| 2))),ccoNew(CCO_Id,1,symProbe(num, 1 \| 2))));
3859	ccTmp = ccoIf(ccoCopy(ccClos), ccTmp, NULL)ccoNew(CCO_If,3,ccoCopy(ccClos),ccTmp,((void*)0));
3860	gc0AddTopLevelStmt(gcvStmts, ccoStat(ccTmp)ccoNew(CCO_Stat,1,ccTmp));
3861
3862
3863	/* Store the function pointer in a temporary at the top level */
3864	ccTmp = ccoStat(ccoAsst(ccoCopy(ccClos), gccExpr(farg)))ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccoCopy(ccClos),gccExpr(farg )));
3865	gc0AddTopLevelStmt(gcvStmts, ccTmp);
3866
3867
3868	/* Construct the code to nullify this function pointer */
3869	if (pClos) *pClos = ccoAsst(ccoCopy(ccClos), ccoIdOf("NULL"))ccoNew(CCO_Asst,2,ccoCopy(ccClos),ccoNew(CCO_Id,1,symProbe("NULL" , 1 \| 2)));
3870
3871
3872	/* Return the name of the wrapper function (to be created) */
3873	return ccoCopy(gc0FtnFunName(info)((info)->fun));
3874	}
3875
3876
3877	/*****************************************************************************
3878	*
3879	* :: Return the C function call of the multiple format Foam, 'foam'.
3880	*
3881	****************************************************************************/
3882
3883	localstatic CCode
3884	gccMFmt(Foam foam)
3885	{
3886	CCode cc;
3887	int fmt = foam->foamMFmt.format;
3888	Foam expr = foam->foamMFmt.value;
3889
3890	if (fmt == emptyFormatSlot4)
3891	bug("MFmt used with empty format!");
3892
3893	switch (foamTag(expr)((expr)->hdr.tag)) {
3894	case FOAM_BCall:
3895	cc = gc0FunBCall(expr, fmt);
3896	break;
3897	case FOAM_CCall:
3898	cc = gc0FunFoamCall(expr, fmt);
3899	break;
3900	case FOAM_OCall:
3901	cc = gc0FunFoamCall(expr, fmt);
3902	break;
3903	case FOAM_PCall:
3904	cc = gc0FunFoamCall(expr, fmt);
3905	break;
3906	case FOAM_Catch:
3907	/* Only allowed (Set (Values ...) (MFmt f (Catch ...))) */
3908	bug("gccMFmt: Catch in MFmt missed by gc0Set");
3909	NotReached(cc = 0){(void)bug("Not supposed to reach line %d in file: %s\n",3909 , "genc.c");};
3910	break;
3911	default:
3912	bugBadCase(foamTag(expr))bug("Bad case %d (line %d in file %s).", (int) ((expr)->hdr .tag), 3912, "genc.c");
3913	NotReached(cc = 0){(void)bug("Not supposed to reach line %d in file: %s\n",3913 , "genc.c");};
3914	break;
3915	}
3916	return cc;
3917	}
3918
3919	localstatic CCode
3920	gccValues(Foam foam)
3921	{
3922	return gccUnhandled(foam);
3923	}
3924
3925	/*****************************************************************************
3926	*
3927	* :: Return the C code of the given Foam value, 'foam'.
3928	*
3929	****************************************************************************/
3930
3931	localstatic CCode
3932	gccVal(Foam foam)
3933	{
3934	CCode cc;
3935
3936	switch (foamTag(foam)((foam)->hdr.tag)) {
3937	case FOAM_Nil:
3938	cc = ccoIdOf(gcFiNil)ccoNew(CCO_Id,1,symProbe("fiNil", 1 \| 2));
3939	break;
3940	case FOAM_Char:
3941	case FOAM_Bool:
3942	case FOAM_Byte:
3943	case FOAM_HInt:
3944	case FOAM_SInt:
3945	cc = ccoIntOf(foamArgv(foam)[0].data)ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",((foam)->foamGen .argv)[0].data), 1 \| 2));
3946	break;
3947	case FOAM_BInt:
3948	cc = gccBInt(foam);
3949	break;
3950	case FOAM_SFlo:
3951	cc = ccoFloatOf(gcvFloatBuf, foamToSFlo(foam))ccoNew(CCO_FloatVal,1,symProbe(DFloatSprint(gcvFloatBuf,((foam )->foamSFlo.SFloData)), 1 \| 2));
3952	break;
3953	case FOAM_DFlo:
3954	cc = ccoFloatOf(gcvFloatBuf, foamToDFlo(foam))ccoNew(CCO_FloatVal,1,symProbe(DFloatSprint(gcvFloatBuf,((foam )->foamDFlo.DFloData)), 1 \| 2));
3955	break;
3956	case FOAM_Arr:
3957	cc = gccArr(foam);
3958	break;
3959	case FOAM_Rec:
3960	cc = gccRec(foam);
3961	break;
3962	case FOAM_Prog:
3963	cc = gc0Prog(foamArgv(foam)((foam)->foamGen.argv)[0].code, foamArgv(foam)((foam)->foamGen.argv)[1].code);
3964	break;
3965	case FOAM_Clos:
3966	cc = gccClos(foam);
3967	break;
3968	case FOAM_Ptr:
3969	cc = gccVal(foam->foamPtr.val);
3970	break;
3971	case FOAM_Protect:
3972	cc = gc0Protect(foam);
3973	break;
3974	case FOAM_PushEnv:
3975	cc = gccPushEnv(foam);
3976	break;
3977	default:
3978	cc = gccRef(foam);
3979	break;
3980	}
3981	return cc;
3982	}
3983
3984	/*****************************************************************************
3985	*
3986	* :: Return the C code to create big integers from the big integer data
3987	* given in 'foam'.
3988	*
3989	****************************************************************************/
3990
3991	/*
3992	* !! Since bintIsSmall may be different for different machines,
3993	* the code generated is not strictly portable
3994	*/
3995
3996	localstatic CCode
3997	gccBInt(Foam foam)
3998	{
3999	CCode globint, globdata, globval, globstmt,
4000	globAName, globBName;
4001	BInt bint;
4002	Length i, size, isNeg;
4003	int isize;
4004	String px;
4005
4006	/*
4007	* FIXME: keep a table indexed by BInt with a value that will
4008	* allow globAName and globBName to be recreated. We will only
4009	* create unique names for each distinct value rather than for
4010	* all values irrespective of their uniqueness. The idea is to
4011	* reduce the number of globals we create.
4012	*/
4013
4014	bint = foam->foamBInt.BIntData ;
4015	if (gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax)) {
4016	Foam decl = gcvConst->foamDDecl.argv[0];
4017	globAName = gc0MultVarId("GA", gcvNBInts, decl->foamDecl.id);
4018	globBName = gc0MultVarId("GB", gcvNBInts, decl->foamDecl.id);
4019	}
4020	else {
4021	globAName = gc0VarId("GA", gcvNBInts);
4022	globBName = gc0VarId("GB", gcvNBInts);
4023	}
4024	/*
4025	* Append the bigint variable to global variable list.
4026	*/
4027	if (gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax)) {
4028	CCode defbint;
4029	defbint = ccoDecl(ccoTypeIdOf(gcFiBInt), ccoCopy(globBName))ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiBInt", 1 \| 2))),ccoCopy(globBName));
4030	gc0AddLine(gcvDefCC, defbint)gc0AddLineFun(&(gcvDefCC), defbint);
4031	globint = ccoDecl(ccoType(ccoExtern(), ccoTypeIdOf(gcFiBInt)),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiBInt", 1 \| 2)))) ,ccoCopy(globBName))
4032	ccoCopy(globBName))ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiBInt", 1 \| 2)))) ,ccoCopy(globBName));
4033	}
4034	else
4035	globint = ccoDecl(ccoType(ccoStatic(), ccoTypeIdOf(gcFiBInt)),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiBInt", 1 \| 2)))) ,ccoCopy(globBName))
4036	ccoCopy(globBName))ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiBInt", 1 \| 2)))) ,ccoCopy(globBName));
4037	gc0AddLine(gcvGloCC, globint)gc0AddLineFun(&(gcvGloCC), globint);
4038
4039	if (bintIsNeg(bint))
4040	isNeg = 1;
4041	else
4042	isNeg = 0;
4043
4044	if (bintIsSmall(bint)) {
4045	size = 1;
4046	px = strPrintf("0x%0lX", bintSmall(bint));
4047	globval = ccoIdOf(px)ccoNew(CCO_Id,1,symProbe(px, 1 \| 2));
4048	if (gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax))
4049	globdata = ccoDecl(ccoTypeIdOf("long"),ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("long", 1 \| 2))),ccoNew(CCO_Asst,2,ccoCopy(globAName),globval ))
4050	ccoAsst(ccoCopy(globAName),ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("long", 1 \| 2))),ccoNew(CCO_Asst,2,ccoCopy(globAName),globval ))
4051	globval))ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("long", 1 \| 2))),ccoNew(CCO_Asst,2,ccoCopy(globAName),globval ));
4052	else
4053	globdata = ccoDecl(ccoType(ccoStatic(),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("long", 1 \| 2)))),ccoNew (CCO_Asst,2,ccoCopy(globAName),globval))
4054	ccoTypeIdOf("long")),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("long", 1 \| 2)))),ccoNew (CCO_Asst,2,ccoCopy(globAName),globval))
4055	ccoAsst(ccoCopy(globAName),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("long", 1 \| 2)))),ccoNew (CCO_Asst,2,ccoCopy(globAName),globval))
4056	globval))ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("long", 1 \| 2)))),ccoNew (CCO_Asst,2,ccoCopy(globAName),globval));
4057	}
4058	else {
4059	U16 *data;
4060	bintToPlacevS(bint, &isize, &data);
4061	globval = ccoNewNode(CCO_Many, isize);
4062	for (i = 0; i < isize; i++) {
4063	px = strPrintf("0x%0X", data[i]);
4064	ccoArgv(globval)((globval)->ccoNode.argv)[i] = ccoIdOf(px)ccoNew(CCO_Id,1,symProbe(px, 1 \| 2));
4065	}
4066	bintReleasePlacevS(data);
4067
4068	if (gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax))
4069	globdata = ccoDecl(ccoTypeIdOf("FiBIntS"),ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiBIntS", 1 \| 2))),ccoNew(CCO_Asst,2,ccoNew(CCO_ARef,2,ccoCopy (globAName),((void*)0)),ccoNew(CCO_Init,1,globval)))
4070	ccoAsst(ccoARef(ccoCopy(globAName),ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiBIntS", 1 \| 2))),ccoNew(CCO_Asst,2,ccoNew(CCO_ARef,2,ccoCopy (globAName),((void*)0)),ccoNew(CCO_Init,1,globval)))
4071	NULL),ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiBIntS", 1 \| 2))),ccoNew(CCO_Asst,2,ccoNew(CCO_ARef,2,ccoCopy (globAName),((void*)0)),ccoNew(CCO_Init,1,globval)))
4072	ccoInit(globval)))ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiBIntS", 1 \| 2))),ccoNew(CCO_Asst,2,ccoNew(CCO_ARef,2,ccoCopy (globAName),((void*)0)),ccoNew(CCO_Init,1,globval)));
4073	else
4074	globdata = ccoDecl(ccoType(ccoStatic(),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiBIntS", 1 \| 2))) ),ccoNew(CCO_Asst,2,ccoNew(CCO_ARef,2,ccoCopy(globAName),((void *)0)),ccoNew(CCO_Init,1,globval)))
4075	ccoTypeIdOf("FiBIntS")),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiBIntS", 1 \| 2))) ),ccoNew(CCO_Asst,2,ccoNew(CCO_ARef,2,ccoCopy(globAName),((void *)0)),ccoNew(CCO_Init,1,globval)))
4076	ccoAsst(ccoARef(ccoCopy(globAName),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiBIntS", 1 \| 2))) ),ccoNew(CCO_Asst,2,ccoNew(CCO_ARef,2,ccoCopy(globAName),((void *)0)),ccoNew(CCO_Init,1,globval)))
4077	NULL),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiBIntS", 1 \| 2))) ),ccoNew(CCO_Asst,2,ccoNew(CCO_ARef,2,ccoCopy(globAName),((void *)0)),ccoNew(CCO_Init,1,globval)))
4078	ccoInit(globval)))ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiBIntS", 1 \| 2))) ),ccoNew(CCO_Asst,2,ccoNew(CCO_ARef,2,ccoCopy(globAName),((void *)0)),ccoNew(CCO_Init,1,globval)));
4079	}
4080	/*
4081	* Append the bigint data initialization to global variable list.
4082	*/
4083	gc0AddLine(gcvDefCC, globdata)gc0AddLineFun(&(gcvDefCC), globdata);
4084
4085	/*
4086	* Create assignment statement for the initialization prog C0.
4087	*/
4088	if (bintIsSmall(bint))
4089	#ifdef USE_MACROS
4090	globstmt = ccoStat(ccoFCall(ccoIdOf("fiBINT_FR_INT"),ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiBINT_FR_INT", 1 \| 2)),ccoNew(CCO_Many,3,ccoCopy(globBName ),ccoNew(CCO_Id,1,symProbe("FiBInt", 1 \| 2)),ccoCopy(globAName ))))
4091	ccoMany3(ccoCopy(globBName),ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiBINT_FR_INT", 1 \| 2)),ccoNew(CCO_Many,3,ccoCopy(globBName ),ccoNew(CCO_Id,1,symProbe("FiBInt", 1 \| 2)),ccoCopy(globAName ))))
4092	ccoIdOf(gcFiBInt),ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiBINT_FR_INT", 1 \| 2)),ccoNew(CCO_Many,3,ccoCopy(globBName ),ccoNew(CCO_Id,1,symProbe("FiBInt", 1 \| 2)),ccoCopy(globAName ))))
4093	ccoCopy(globAName))))ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiBINT_FR_INT", 1 \| 2)),ccoNew(CCO_Many,3,ccoCopy(globBName ),ccoNew(CCO_Id,1,symProbe("FiBInt", 1 \| 2)),ccoCopy(globAName ))));
4094	#else
4095	globstmt = ccoStatAsst(ccoCopy(globBName),ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccoCopy(globBName),ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBIntFrInt", 1 \| 2)), ccoCopy(globAName))))
4096	ccoFCall(ccoIdOf("fiBIntFrInt"),ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccoCopy(globBName),ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBIntFrInt", 1 \| 2)), ccoCopy(globAName))))
4097	ccoCopy(globAName)))ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccoCopy(globBName),ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBIntFrInt", 1 \| 2)), ccoCopy(globAName))));
4098	#endif
4099	else
4100	globstmt = ccoStatAsst(ccoCopy(globBName),ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccoCopy(globBName),ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBIntFrPlacev", 1 \| 2 )),ccoNew(CCO_Many,3,ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL" ,isNeg), 1 \| 2)),ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL" ,isize), 1 \| 2)),ccoCopy(globAName)))))
4101	ccoFCall(ccoIdOf("fiBIntFrPlacev"),ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccoCopy(globBName),ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBIntFrPlacev", 1 \| 2 )),ccoNew(CCO_Many,3,ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL" ,isNeg), 1 \| 2)),ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL" ,isize), 1 \| 2)),ccoCopy(globAName)))))
4102	ccoMany3(ccoIntOf(isNeg),ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccoCopy(globBName),ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBIntFrPlacev", 1 \| 2 )),ccoNew(CCO_Many,3,ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL" ,isNeg), 1 \| 2)),ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL" ,isize), 1 \| 2)),ccoCopy(globAName)))))
4103	ccoIntOf(isize),ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccoCopy(globBName),ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBIntFrPlacev", 1 \| 2 )),ccoNew(CCO_Many,3,ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL" ,isNeg), 1 \| 2)),ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL" ,isize), 1 \| 2)),ccoCopy(globAName)))))
4104	ccoCopy(globAName))))ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccoCopy(globBName),ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBIntFrPlacev", 1 \| 2 )),ccoNew(CCO_Many,3,ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL" ,isNeg), 1 \| 2)),ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL" ,isize), 1 \| 2)),ccoCopy(globAName)))));
4105	gc0AddLine(gcvBIntCC, globstmt)gc0AddLineFun(&(gcvBIntCC), globstmt);
4106	gcvNBInts++;
4107	return ccoCopy(globBName);
4108	}
4109
4110	/*****************************************************************************
4111	*
4112	* :: Return the C code to create a string from a Foam array, given in 'foam'.
4113	*
4114	****************************************************************************/
4115
4116	localstatic CCode
4117	gccArr(Foam foam)
4118	{
4119	String str = foamArrToString(foam);
4120
4121	return ccoStringOf(str)ccoNew(CCO_StringVal,1,symProbe(str, 1 \| 2));
4122	}
4123
4124	/*****************************************************************************
4125	*
4126	* :: Return the C code function which creates a new structure whose format
4127	* and fields are given by the Foam record, 'foam'.
4128	*
4129	****************************************************************************/
4130
4131	localstatic CCode
4132	gccRRElt(Foam foam)
4133	{
4134	CCode ccRec, ccFmt, ccElt, ccArgs;
4135
4136	/* Now generate the record access */
4137	ccRec = gccExpr(foam->foamRRElt.data);
4138	ccFmt = gccExpr(foam->foamRRElt.fmt);
4139	ccElt = gccExpr(foamNewSInt(foam->foamRRElt.field)foamNew(FOAM_SInt, 1, (AInt)(foam->foamRRElt.field)));
4140	ccArgs = ccoMany3(ccRec, ccElt, ccFmt)ccoNew(CCO_Many,3,ccRec,ccElt,ccFmt);
4141
4142	return ccoFCall(ccoIdOf("fiRawRecordElt"), ccArgs)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiRawRecordElt", 1 \| 2)),ccArgs);
4143	}
4144
4145	localstatic CCode
4146	gccRec(Foam foam)
4147	{
4148	CCodeList code = listNil(CCode)((CCodeList) 0);
4149	int fmt, nfields, i;
4150	CCode ccRecFill;
4151	String newFmtName;
4152
4153	fmt = foam->foamRec.format;
4154	nfields = foamArgc(foam)((foam)->hdr.argc) - 1;
4155	for (i = 0; i < nfields; i++)
4156	gc0AddLine(code, gccVal(foam->foamRec.eltv[i]))gc0AddLineFun(&(code), gccVal(foam->foamRec.eltv[i]));
4157	code = listNReverse(CCode)(CCode_listPointer->NReverse)(code);
4158	ccRecFill = gc0ListOf(CCO_Many, code);
4159	listFree(CCode)(CCode_listPointer->Free)(code);
4160	newFmtName = strPrintf("fiRecNew%s", gcFmtName"Fmt");
4161	return ccoFCall(gc0VarId(newFmtName, fmt), ccRecFill)ccoNew(CCO_FCall,2,gc0VarId(newFmtName, fmt),ccRecFill);
4162	}
4163
4164	/*****************************************************************************
4165	*
4166	* :: Return the C code function which creates a new closure of the
4167	* environment and program given by the Foam closure 'foam'.
4168	*
4169	****************************************************************************/
4170
4171	localstatic CCode
4172	gccClos(Foam foam)
4173	{
4174	Foam env, prog;
4175
4176	assert(foamTag(foam) == FOAM_Clos)do { if (!(((foam)->hdr.tag) == FOAM_Clos)) _do_assert(("foamTag(foam) == FOAM_Clos" ),"genc.c",4176); } while (0);
4177	env = foam->foamClos.env;
4178	prog = foam->foamClos.prog;
4179	return ccoFCall(ccoIdOf("fiClosMake"), ccoMany2(gccVal(env),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiClosMake", 1 \| 2)),ccoNew(CCO_Many,2,gccVal(env),gccExpr(prog)))
4180	gccExpr(prog)))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiClosMake", 1 \| 2)),ccoNew(CCO_Many,2,gccVal(env),gccExpr(prog)));
4181	}
4182
4183
4184	/*****************************************************************************
4185	*
4186	* :: Generators
4187	*
4188	****************************************************************************/
4189
4190	localstatic CCode
4191	gccGener(Foam foam)
4192	{
4193	Foam env, prog, init;
4194	CCode stmt;
4195	AInt fmt;
4196	env = foam->foamGener.env;
4197	prog = foam->foamGener.prog;
4198	fmt = foam->foamGener.fmt;
4199
4200	return ccoFCall(ccoIdOf("fiGenerNew"),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiGenerNew", 1 \| 2)),ccoNew(CCO_Many,3,gccVal(env),ccoNew(CCO_Sizeof,1,ccoNew (CCO_Type,2,ccoNew(CCO_StructRef,1,gc0VarId("Fmt", fmt)),((void *)0))),gccVal(prog)))
4201	ccoMany3(gccVal(env),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiGenerNew", 1 \| 2)),ccoNew(CCO_Many,3,gccVal(env),ccoNew(CCO_Sizeof,1,ccoNew (CCO_Type,2,ccoNew(CCO_StructRef,1,gc0VarId("Fmt", fmt)),((void *)0))),gccVal(prog)))
4202	ccoSizeof(ccoType(ccoStructRef(gc0VarId(gcFmtName, fmt)), NULL)),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiGenerNew", 1 \| 2)),ccoNew(CCO_Many,3,gccVal(env),ccoNew(CCO_Sizeof,1,ccoNew (CCO_Type,2,ccoNew(CCO_StructRef,1,gc0VarId("Fmt", fmt)),((void *)0))),gccVal(prog)))
4203	gccVal(prog)))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiGenerNew", 1 \| 2)),ccoNew(CCO_Many,3,gccVal(env),ccoNew(CCO_Sizeof,1,ccoNew (CCO_Type,2,ccoNew(CCO_StructRef,1,gc0VarId("Fmt", fmt)),((void *)0))),gccVal(prog)));
4204	}
4205
4206
4207	localstatic CCode
4208	gccGenerValue(Foam foam)
4209	{
4210	return ccoFCall(ccoIdOf("fiGenerValue"), gccExpr(foam->foamGenerValue.gener))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiGenerValue", 1 \| 2)),gccExpr(foam->foamGenerValue.gener));
4211	}
4212
4213
4214	localstatic CCode
4215	gccGenerStep(Foam foam)
4216	{
4217	CCode stmt, branch;
4218	// FIXME: Double evaluation of generator..
4219	stmt = ccoStat(ccoFCall(ccoIdOf("fiGenerStep"), gccExpr(foam->foamGenerStep.gener)))ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiGenerStep", 1 \| 2)),gccExpr(foam->foamGenerStep.gener) ));
4220	branch = ccoIf(ccoEQ(ccoFCall(ccoIdOf("fiGenerStepIndex"),ccoNew(CCO_If,3,ccoNew(CCO_EQ,2,ccoNew(CCO_FCall,2,ccoNew(CCO_Id ,1,symProbe("fiGenerStepIndex", 1 \| 2)),gccExpr(foam->foamGenerStep .gener)),ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",-1L), 1 \| 2))),ccoNew(CCO_Goto,1,gc0VarId("L", foam->foamGenerStep .label)),((void*)0))
4221	gccExpr(foam->foamGenerStep.gener)),ccoNew(CCO_If,3,ccoNew(CCO_EQ,2,ccoNew(CCO_FCall,2,ccoNew(CCO_Id ,1,symProbe("fiGenerStepIndex", 1 \| 2)),gccExpr(foam->foamGenerStep .gener)),ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",-1L), 1 \| 2))),ccoNew(CCO_Goto,1,gc0VarId("L", foam->foamGenerStep .label)),((void*)0))
4222	ccoIntOf(-1L)),ccoNew(CCO_If,3,ccoNew(CCO_EQ,2,ccoNew(CCO_FCall,2,ccoNew(CCO_Id ,1,symProbe("fiGenerStepIndex", 1 \| 2)),gccExpr(foam->foamGenerStep .gener)),ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",-1L), 1 \| 2))),ccoNew(CCO_Goto,1,gc0VarId("L", foam->foamGenerStep .label)),((void*)0))
4223	ccoGoto(gc0VarId("L", foam->foamGenerStep.label)), NULL)ccoNew(CCO_If,3,ccoNew(CCO_EQ,2,ccoNew(CCO_FCall,2,ccoNew(CCO_Id ,1,symProbe("fiGenerStepIndex", 1 \| 2)),gccExpr(foam->foamGenerStep .gener)),ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",-1L), 1 \| 2))),ccoNew(CCO_Goto,1,gc0VarId("L", foam->foamGenerStep .label)),((void*)0));
4224
4225	return ccoMany2(stmt, branch)ccoNew(CCO_Many,2,stmt,branch);
4226	}
4227
4228	localstatic CCode
4229	gccGenIter(Foam foam)
4230	{
4231	return ccoFCall(ccoIdOf("fiGenStartIter"), gccExpr(foam->foamGenIter.gener))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiGenStartIter", 1 \| 2)),gccExpr(foam->foamGenIter.gener));
4232	}
4233
4234	/*****************************************************************************
4235	*
4236	* :: Return the C code for the Foam reference, 'foam'.
4237	*
4238	****************************************************************************/
4239
4240	localstatic CCode
4241	gccRef(Foam foam)
4242	{
4243	CCode cc;
4244
4245	switch (foamTag(foam)((foam)->hdr.tag)) {
4246	case FOAM_AElt:
4247	cc = gccAElt(foam);
4248	break;
4249	case FOAM_RElt:
4250	cc = gccRElt(foam);
4251	break;
4252	case FOAM_RRElt:
4253	cc = gccRRElt(foam);
4254	break;
4255	case FOAM_IRElt:
4256	cc = gccIRElt(foam);
4257	break;
4258	case FOAM_TRElt:
4259	cc = gccTRElt(foam);
4260	break;
4261	case FOAM_Fluid:
4262	cc = gc0FluidRef(foam);
4263	break;
4264	case FOAM_EElt:
4265	case FOAM_Const:
4266	case FOAM_Glo:
4267	case FOAM_Par:
4268	case FOAM_Loc:
4269	case FOAM_Lex:
4270	case FOAM_Env:
4271	cc = gccId(foam);
4272	break;
4273	case FOAM_EEnv:
4274	cc = gccEEnv(foam);
4275	break;
4276	case FOAM_EInfo:
4277	cc = gccEInfo(foam);
4278	break;
4279	case FOAM_PRef:
4280	cc = gccPRef(foam);
4281	break;
4282	case FOAM_CEnv:
4283	cc = ccoPointsTo(gc0SubExpr(foam->foamCEnv.env,ccoNew(CCO_PointsTo,2,gc0SubExpr(foam->foamCEnv.env, ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2)))) ,ccoNew(CCO_Id,1,symProbe("env", 1 \| 2)))
4284	ccoTypeIdOf(gcFiClos)),ccoNew(CCO_PointsTo,2,gc0SubExpr(foam->foamCEnv.env, ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2)))) ,ccoNew(CCO_Id,1,symProbe("env", 1 \| 2)))
4285	ccoIdOf("env"))ccoNew(CCO_PointsTo,2,gc0SubExpr(foam->foamCEnv.env, ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2)))) ,ccoNew(CCO_Id,1,symProbe("env", 1 \| 2)));
4286	break;
4287	case FOAM_CProg:
4288	cc = ccoPointsTo(gc0SubExpr(foam->foamCProg.prog,ccoNew(CCO_PointsTo,2,gc0SubExpr(foam->foamCProg.prog, ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2)))) ,ccoNew(CCO_Id,1,symProbe("prog", 1 \| 2)))
4289	ccoTypeIdOf(gcFiClos)),ccoNew(CCO_PointsTo,2,gc0SubExpr(foam->foamCProg.prog, ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2)))) ,ccoNew(CCO_Id,1,symProbe("prog", 1 \| 2)))
4290	ccoIdOf("prog"))ccoNew(CCO_PointsTo,2,gc0SubExpr(foam->foamCProg.prog, ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2)))) ,ccoNew(CCO_Id,1,symProbe("prog", 1 \| 2)));
4291	break;
4292	case FOAM_Catch:
4293	cc = gccId(foam->foamCatch.ref);
4294	break;
4295	case FOAM_GenerValue:
4296	cc = gccGenerValue(foam);
4297	break;
4298	case FOAM_GenIter:
4299	cc = gccGenIter(foam);
4300	break;
4301	case FOAM_Gener:
4302	cc = gccGener(foam);
4303	break;
4304	default:
4305	bugBadCase(foamTag(foam))bug("Bad case %d (line %d in file %s).", (int) ((foam)->hdr .tag), 4305, "genc.c");
4306	NotReached(return 0){(void)bug("Not supposed to reach line %d in file: %s\n",4306 , "genc.c");};
4307	}
4308	return cc;
4309	}
4310
4311	/*****************************************************************************
4312	*
4313	* :: Return the C code to reference an array element indicated in 'foam'.
4314	*
4315	****************************************************************************/
4316
4317	localstatic CCode
4318	gccAElt(Foam foam)
4319	{
4320	CCode arrExpr;
4321	Foam lhs;
4322	Bool wasCast = false((int) 0);
4323
4324	lhs = foam->foamAElt.expr;
4325	if (foamTag(lhs)((lhs)->hdr.tag) == FOAM_Cast) {
4326	assert(lhs->foamCast.type == FOAM_Arr)do { if (!(lhs->foamCast.type == FOAM_Arr)) _do_assert(("lhs->foamCast.type == FOAM_Arr" ),"genc.c",4326); } while (0);
4327	lhs = lhs->foamCast.expr;
4328	wasCast = true1;
4329	}
4330	arrExpr = gccExpr(lhs);
4331	if (gc0IsDecl(lhs)) {
4332	Foam decl = gc0GetDecl(lhs);
4333	int fmt = decl->foamDecl.format;
4334	if (fmt != foam->foamAElt.baseType \|\| decl->foamDecl.type != FOAM_Arr)
4335	arrExpr = gc0SubExpr(lhs,
4336	ccoPostStar(gc0TypeId(ccoNew(CCO_PostStar,1,gc0TypeId( foam->foamAElt.baseType, 4 ))
4337	foam->foamAElt.baseType, emptyFormatSlot))ccoNew(CCO_PostStar,1,gc0TypeId( foam->foamAElt.baseType, 4 )));
4338	}
4339	else if (foamTag(lhs)((lhs)->hdr.tag) == FOAM_AElt)
4340	arrExpr = gc0SubExpr(lhs, ccoPostStar(gc0TypeId(ccoNew(CCO_PostStar,1,gc0TypeId( foam->foamAElt.baseType, 4 ))
4341	foam->foamAElt.baseType, emptyFormatSlot))ccoNew(CCO_PostStar,1,gc0TypeId( foam->foamAElt.baseType, 4 )));
4342	else if (wasCast)
4343	arrExpr = gc0SubExpr(lhs, ccoPostStar(gc0TypeId(ccoNew(CCO_PostStar,1,gc0TypeId( foam->foamAElt.baseType, 4 ))
4344	foam->foamAElt.baseType, emptyFormatSlot))ccoNew(CCO_PostStar,1,gc0TypeId( foam->foamAElt.baseType, 4 )));
4345
4346	return ccoARef(arrExpr, gccExpr(foam->foamAElt.index))ccoNew(CCO_ARef,2,arrExpr,gccExpr(foam->foamAElt.index));
4347	}
4348
4349	/*****************************************************************************
4350	*
4351	* :: Return the C code to reference an structure field, using the Foam
4352	* record element, 'foam'.
4353	*
4354	****************************************************************************/
4355
4356	localstatic CCode
4357	gccRElt(Foam foam)
4358	{
4359	CCode ccName, ccField;
4360	Foam decl, lhs;
4361
4362	decl = gc0GetDecl(foam);
4363	lhs = foam->foamRElt.expr;
4364	if (foamTag(lhs)((lhs)->hdr.tag) == FOAM_Cast)
4365	lhs = lhs->foamCast.expr;
4366	ccField = gc0MultVarId("X", foam->foamRElt.field, decl->foamDecl.id);
4367	ccName = gccExpr(lhs);
4368	if (gc0IsDecl(lhs)) {
4369	Foam ldecl = gc0GetDecl(lhs);
4370	int fmt = ldecl->foamDecl.format;
4371	if (fmt && fmt != foam->foamRElt.format)
4372	ccName = ccoCast(gc0VarId(gcFmtType,ccoNew(CCO_Cast,2,gc0VarId("PFmt", foam->foamRElt.format), ccName)
4373	foam->foamRElt.format),ccoNew(CCO_Cast,2,gc0VarId("PFmt", foam->foamRElt.format), ccName)
4374	ccName)ccoNew(CCO_Cast,2,gc0VarId("PFmt", foam->foamRElt.format), ccName);
4375	}
4376	else
4377	ccName = ccoCast(gc0VarId(gcFmtType,ccoNew(CCO_Cast,2,gc0VarId("PFmt", foam->foamRElt.format), ccName)
4378	foam->foamRElt.format), ccName)ccoNew(CCO_Cast,2,gc0VarId("PFmt", foam->foamRElt.format), ccName);
4379	return ccoPointsTo(ccName, ccField)ccoNew(CCO_PointsTo,2,ccName,ccField);
4380	}
4381
4382	localstatic CCode
4383	gccIRElt(Foam foam)
4384	{
4385	CCode ccName, ccField;
4386	Foam decl, lhs;
4387
4388	decl = gc0GetDecl(foam);
4389	lhs = foam->foamIRElt.expr;
4390	if (foamTag(lhs)((lhs)->hdr.tag) == FOAM_Cast)
4391	lhs = lhs->foamCast.expr;
4392	ccField = gc0MultVarId("X", foam->foamIRElt.field, decl->foamDecl.id);
4393	ccName = gccExpr(lhs);
4394	if (gc0IsDecl(lhs)) {
4395	Foam ldecl = gc0GetDecl(lhs);
4396	int fmt = ldecl->foamDecl.format;
4397	if (fmt && fmt != foam->foamIRElt.format)
4398	ccName = ccoCast(gc0VarId(gcFmtType,ccoNew(CCO_Cast,2,gc0VarId("PFmt", foam->foamIRElt.format) ,ccName)
4399	foam->foamIRElt.format),ccoNew(CCO_Cast,2,gc0VarId("PFmt", foam->foamIRElt.format) ,ccName)
4400	ccName)ccoNew(CCO_Cast,2,gc0VarId("PFmt", foam->foamIRElt.format) ,ccName);
4401	}
4402	else
4403	ccName = ccoCast(gc0VarId(gcFmtType,ccoNew(CCO_Cast,2,gc0VarId("PFmt", foam->foamIRElt.format) ,ccName)
4404	foam->foamIRElt.format), ccName)ccoNew(CCO_Cast,2,gc0VarId("PFmt", foam->foamIRElt.format) ,ccName);
4405
4406	return ccoPointsTo(ccName, ccField)ccoNew(CCO_PointsTo,2,ccName,ccField);
4407	}
4408
4409	localstatic CCode
4410	gccTRElt(Foam foam)
4411	{
4412	CCode ccName, ccField, ccIdx;
4413	Foam decl, lhs;
4414
4415	decl = gc0GetDecl(foam);
4416	lhs = foam->foamTRElt.expr;
4417	if (foamTag(lhs)((lhs)->hdr.tag) == FOAM_Cast)
4418	lhs = lhs->foamCast.expr;
4419	ccField = gc0MultVarId("X", foam->foamTRElt.field, decl->foamDecl.id);
4420	ccName = gccExpr(lhs);
4421	if (gc0IsDecl(lhs)) {
4422	Foam ldecl = gc0GetDecl(lhs);
4423	int fmt = ldecl->foamDecl.format;
4424	if (fmt && fmt != foam->foamTRElt.format)
4425	ccName = ccoCast(gc0VarId(gcFmtType,ccoNew(CCO_Cast,2,gc0VarId("PFmt", foam->foamTRElt.format) ,ccName)
4426	foam->foamTRElt.format),ccoNew(CCO_Cast,2,gc0VarId("PFmt", foam->foamTRElt.format) ,ccName)
4427	ccName)ccoNew(CCO_Cast,2,gc0VarId("PFmt", foam->foamTRElt.format) ,ccName);
4428	}
4429	else
4430	ccName = ccoCast(gc0VarId(gcFmtType,ccoNew(CCO_Cast,2,gc0VarId("PFmt", foam->foamTRElt.format) ,ccName)
4431	foam->foamTRElt.format), ccName)ccoNew(CCO_Cast,2,gc0VarId("PFmt", foam->foamTRElt.format) ,ccName);
4432	ccIdx = gccExpr(foam->foamTRElt.index);
4433	return ccoDot(ccoARef(ccoPointsTo(ccName, ccoIdOf(gcFiTRTail)), ccIdx),ccoNew(CCO_Dot,2,ccoNew(CCO_ARef,2,ccoNew(CCO_PointsTo,2,ccName ,ccoNew(CCO_Id,1,symProbe("tail", 1 \| 2))),ccIdx),ccField)
4434	ccField)ccoNew(CCO_Dot,2,ccoNew(CCO_ARef,2,ccoNew(CCO_PointsTo,2,ccName ,ccoNew(CCO_Id,1,symProbe("tail", 1 \| 2))),ccIdx),ccField);
4435
4436	}
4437
4438	localstatic CCode
4439	gccTRNew(Foam foam)
4440	{
4441	int fmt = foam->foamTRNew.format;
4442	CCode sz = gccExpr(foam->foamTRNew.size);
4443	CCode cco;
4444
4445	cco = gcFiNARYNew(gcFmtName, gcTFmtName, fmt, sz)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiNARYNew", 1 \| 2 )),ccoNew(CCO_Many,3,ccoNew(CCO_StructRef,1,gc0VarId("Fmt",fmt )),ccoNew(CCO_StructRef,1,gc0VarId("TFmt",fmt)),sz));
4446
4447	return cco;
4448	}
4449
4450	localstatic CCode
4451	gccEEnv(Foam foam)
4452	{
4453	return gc0EEnv(gccExpr(foam->foamEEnv.env), foam->foamEEnv.level);
4454	}
4455
4456	localstatic CCode
4457	gccEInfo(Foam foam)
4458	{
4459	return gcFiEnvInfo(gccExpr(foam->foamEInfo.env))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvInfo", 1 \| 2 )),gccExpr(foam->foamEInfo.env));
4460	}
4461
4462	localstatic CCode
4463	gccPRef(Foam foam)
4464	{
4465	assert (foam->foamPRef.idx == 0)do { if (!(foam->foamPRef.idx == 0)) _do_assert(("foam->foamPRef.idx == 0" ),"genc.c",4465); } while (0);
4466	return gcFiProgHashCode(gccExpr(foam->foamPRef.prog))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiProgHashCode", 1 \| 2)),gccExpr(foam->foamPRef.prog));
4467	}
4468
4469	/*
4470	* Return an identifier.
4471	*/
4472
4473	localstatic CCode
4474	gccId(Foam foam)
4475	{
4476	CCode cc;
4477
4478	switch (foamTag(foam)((foam)->hdr.tag)) {
4479	case FOAM_Glo:
4480	case FOAM_Const:
4481	case FOAM_Par:
4482	case FOAM_Loc:
4483	cc = gccGetVar(foam);
4484	break;
4485	case FOAM_Fluid:
4486	cc = gccGetVar(foam);
4487	break;
4488	case FOAM_Lex:
4489	cc = ccoPointsTo(gc0VarId("l", foam->foamLex.level),ccoNew(CCO_PointsTo,2,gc0VarId("l", foam->foamLex.level),gccGetVar (foam))
4490	gccGetVar(foam))ccoNew(CCO_PointsTo,2,gc0VarId("l", foam->foamLex.level),gccGetVar (foam));
4491	break;
4492	case FOAM_EElt:
4493	{
4494	CCode id, next;
4495	id = gc0VarId(gcFmtType"PFmt", foam->foamEElt.env);
4496	next = gc0EEltNext(foam->foamEElt.ref, foam->foamEElt.level);
4497	cc = ccoPointsTo(ccoCast(ccoTypedefId(id), next),ccoNew(CCO_PointsTo,2,ccoNew(CCO_Cast,2,ccoNew(CCO_TypedefId, 1,id),next),gccGetVar(foam))
4498	gccGetVar(foam))ccoNew(CCO_PointsTo,2,ccoNew(CCO_Cast,2,ccoNew(CCO_TypedefId, 1,id),next),gccGetVar(foam));
4499	break;
4500	}
4501	case FOAM_Env:
4502	cc = gccEnv(foam);
4503	break;
4504	default:
4505	cc = gccExpr(foam);
4506	break;
4507	}
4508	return cc;
4509	}
4510
4511	localstatic CCode
4512	gccEnv(Foam foam)
4513	{
4514	CCode cc;
4515	int level = foam->foamEnv.level;
4516
4517	if (gcvIsLeaf && level == 0 &&
4518	(gcvLFmtStk->foamDEnv.argv[level] == emptyFormatSlot4
4519	\|\| gcvLFmtStk->foamDEnv.argv[level] == envUsedSlot0)) {
4520	bugWarning("Odd env usage..");
4521	cc = gcFiEnvPush(ccoIntOf(int0),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvPush", 1 \| 2 )),ccoNew(CCO_Many,2,ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL" ,((int) 0)), 1 \| 2)),gc0VarId("e", level+1)))
4522	gc0VarId("e", level+1))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvPush", 1 \| 2 )),ccoNew(CCO_Many,2,ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL" ,((int) 0)), 1 \| 2)),gc0VarId("e", level+1)));
4523	}
4524	else
4525	cc = gc0VarId("e", level);
4526	/* !! Because sometimes usage info is lost */
4527	if (gc0EmptyEnv(gcvLFmtStk->foamDEnv.argv[level])((gcvLFmtStk->foamDEnv.argv[level] == 4) \|\| ((((gcvFmt-> foamDFmt.argv[gcvLFmtStk->foamDEnv.argv[level]])->hdr.argc ) - (1)) == 0)) && level!=0) {
4528	bugWarning("Lost usage info..");
4529	gcvLFmtStk = foamCopy(gcvLFmtStk);
4530	gcvLFmtStk->foamDEnv.argv[level] = envUsedSlot0;
4531	}
4532	return cc;
4533	}
4534
4535	/* Given a constant, it returns the name of the corresponding function.
4536	* In example, for constant 2 it returns CF2_....
4537	* This identifier should be used only:
4538	* - to declare/define the function
4539	* - to initialize the corresponding prog
4540	*/
4541	localstatic CCode
4542	gccProgId(Foam foam)
4543	{
4544	int idx = foam->foamConst.index;
4545	String tag = "CF";
4546	Foam decl = gc0GetDecl(foam);
4547
4548	assert(foamTag(foam) == FOAM_Const)do { if (!(((foam)->hdr.tag) == FOAM_Const)) _do_assert(("foamTag(foam) == FOAM_Const" ),"genc.c",4548); } while (0);
4549
4550	if (gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax)) {
4551	if (idx) {
4552	String s;
4553	Foam fn = gcvConst->foamDDecl.argv[0];
4554
4555	s = strPrintf("%s_%s", fn->foamDecl.id,
4556	decl->foamDecl.id);
4557	return gc0MultVarId(tag, idx, s);
4558	}
4559	else
4560	return gc0MultVarId(tag, idx, decl->foamDecl.id);
4561	}
4562	else
4563	return gc0MultVarId(tag, idx, decl->foamDecl.id);
4564
4565
4566	}
4567
4568	/*
4569	* Get a variable identifier.
4570	*/
4571	localstatic CCode
4572	gccGetVar(Foam foam)
4573	{
4574	Foam decl = gc0GetDecl(foam);
4575	CCode ccode;
4576	String s, s0;
4577	int idx;
4578
4579	s = s0 = decl->foamDecl.id;
4580
4581	switch (foamTag(foam)((foam)->hdr.tag)) {
4582	case FOAM_Glo:
4583	idx = foam->foamGlo.index;
4584	switch (foamProtoBase(decl->foamGDecl.protocol)((foamProtoInfoTable[(int)(decl->foamGDecl.protocol)-(int) FOAM_PROTO_START]).base)) {
4585	case FOAM_Proto_Foam:
4586	case FOAM_Proto_Init:
4587
4588	if (!foamGDeclIsExport(decl)) {
4589	ccode = gc0MultVarId("pG", idx, s);
4590	ccode = ccoParen(ccoPreStar(ccode))ccoNew(CCO_Paren,1,ccoNew(CCO_PreStar,1,ccode));
4591	}
4592	else
4593	ccode = gc0MultVarId("G", idx, s);
4594	break;
4595	case FOAM_Proto_C:
4596	if (strchr(s, FOREIGN_INCLUDE_SEPARATOR'-')) {
4597	s = strCopy(s);
4598	s = gc0StompOffIncludeFile(s, FOAM_Proto_C);
4599	}
4600	if (foamGDeclIsExport(decl))
4601	ccode = gc0MultVarId("G", idx, s);
4602	else
4603	ccode = ccoIdOf(s)ccoNew(CCO_Id,1,symProbe(s, 1 \| 2));
4604	break;
4605	case FOAM_Proto_Fortran:
4606	if (foamGDeclIsExport(decl))
4607	ccode = gc0MultVarId("G", idx, s);
4608	else {
4609	s = gc0GenFortranName(s);
4610	ccode = ccoIdOf(s)ccoNew(CCO_Id,1,symProbe(s, 1 \| 2));
4611	}
4612	break;
4613	case FOAM_Proto_Java:
4614	ccode = gc0MultVarId("J", idx, "java");
4615	break;
4616	case FOAM_Proto_Other:
4617	ccode = ccoIdOf(s)ccoNew(CCO_Id,1,symProbe(s, 1 \| 2));
4618	break;
4619	default:
4620	comsgFatal(NULL((void*)0), ALDOR_F_ProtoNotSupported275, "C",
4621	foamProtoInfo(decl->foamGDecl.protocol)(foamProtoInfoTable[(int)(decl->foamGDecl.protocol)-(int)FOAM_PROTO_START ]).str);
4622	NotReached(return 0){(void)bug("Not supposed to reach line %d in file: %s\n",4622 , "genc.c");};
4623	}
4624	break;
4625	case FOAM_Const:
4626	idx = foam->foamConst.index;
4627	if (gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax) && idx)
4628	s = strPrintf("%s_%s",
4629	gcvConst->foamDDecl.argv[0]->foamDecl.id,
4630	decl->foamDecl.id
4631	);
4632	ccode = gc0MultVarId("C", foam->foamConst.index, s);
4633	break;
4634	case FOAM_Par:
4635	ccode = gc0MultVarId("P", foam->foamPar.index, s);
4636	break;
4637	case FOAM_Loc:
4638	ccode = gc0MultVarId("T", foam->foamLoc.index, s);
4639	break;
4640	case FOAM_Lex:
4641	ccode = gc0MultVarId("X", foam->foamLex.index, s);
4642	break;
4643	case FOAM_EElt:
4644	ccode = gc0MultVarId("X", foam->foamEElt.lex, s);
4645	break;
4646	case FOAM_Fluid:
4647	ccode = gc0MultVarId("F", foam->foamFluid.index, s);
4648	break;
4649	default:
4650	bugBadCase(foamTag(foam))bug("Bad case %d (line %d in file %s).", (int) ((foam)->hdr .tag), 4650, "genc.c");
4651	NotReached(return 0){(void)bug("Not supposed to reach line %d in file: %s\n",4651 , "genc.c");};
4652	}
4653	if (s0 != s) strFree(s);
4654
4655	return ccode;
4656	}
4657
4658	localstatic CCode
4659	gccUnhandled(Foam foam)
4660	{
4661	String buf;
4662
4663	bugWarning("foamTag: %s is unhandled.\n", foamStr(foamTag(foam))((foamInfoTable [(int)(((foam)->hdr.tag))-(int)FOAM_START] ).str));
4664	buf = strPrintf("foamTag: %s is unhandled.", foamStr(foamTag(foam))((foamInfoTable [(int)(((foam)->hdr.tag))-(int)FOAM_START] ).str));
4665	return ccoComment(ccoIdOf(buf))ccoNew(CCO_Comment,1,ccoNew(CCO_Id,1,symProbe(buf, 1 \| 2)));
4666	}
4667
4668	/*****************************************************************************
4669	*
4670	* :: Functions for determining environment levels
4671	*
4672	****************************************************************************/
4673
4674	localstatic CCodeList
4675	gc0Levels(int nLexs, int maxLev, int isLeaf, int isCoroutine, int fmt)
4676	{
4677	CCodeList code = listNil(CCode)((CCodeList) 0);
4678	int i, level;
4679
4680	// Declarations
4681	for (i = 0; i < nLexs; i++) {
4682	level = gcvLFmtStk->foamDEnv.argv[i];
4683	if (!gc0EmptyEnv(level)((level == 4) \|\| ((((gcvFmt->foamDFmt.argv[level])->hdr .argc) - (1)) == 0)) && level != envUsedSlot0)
4684	if (foamArgc(gcvFmt->foamDFmt.argv[level])((gcvFmt->foamDFmt.argv[level])->hdr.argc) > 0)
4685	gc0AddLine(code, gc0LexRef(level, i))gc0AddLineFun(&(code), gc0LexRef(level, i));
4686	if (!gc0EmptyEnv(level)((level == 4) \|\| ((((gcvFmt->foamDFmt.argv[level])->hdr .argc) - (1)) == 0)) && i > 1)
4687	gc0AddLine(code, gc0EnvRef(i))gc0AddLineFun(&(code), gc0EnvRef(i));
4688	if (i == 0 && !gc0EmptyEnv(level)((level == 4) \|\| ((((gcvFmt->foamDFmt.argv[level])->hdr .argc) - (1)) == 0)) && !isCoroutine)
4689	gc0AddLine(code, gc0EnvRef(i))gc0AddLineFun(&(code), gc0EnvRef(i));
4690
4691	if (gc0EmptyEnv(level)((level == 4) \|\| ((((gcvFmt->foamDFmt.argv[level])->hdr .argc) - (1)) == 0)) && i > 1 && i <= maxLev)
4692	gc0AddLine(code, gc0EnvRef(i))gc0AddLineFun(&(code), gc0EnvRef(i));
4693	}
4694
4695	if (!isLeaf && !isCoroutine) {
4696	// Declare env0
4697	if (gc0EmptyEnv(fmt)((fmt == 4) \|\| ((((gcvFmt->foamDFmt.argv[fmt])->hdr.argc ) - (1)) == 0)))
4698	gc0AddLine(code, gc0EnvRef(int0))gc0AddLineFun(&(code), gc0EnvRef(((int) 0)));
4699	}
4700
4701	// Definitions
4702	if (!isLeaf && !isCoroutine) {
4703	if (!gc0EmptyEnv(fmt)((fmt == 4) \|\| ((((gcvFmt->foamDFmt.argv[fmt])->hdr.argc ) - (1)) == 0)) && fmt != envUsedSlot0)
4704	if (foamArgc(foamArgv(gcvFmt)[fmt].code)((((gcvFmt)->foamGen.argv)[fmt].code)->hdr.argc) > 0)
4705	gc0AddLine(code, gc0EnvMake(fmt))gc0AddLineFun(&(code), gc0EnvMake(fmt)); // l0 = alloc(lvl)
4706	gc0AddLine(code, gc0EnvPush(fmt))gc0AddLineFun(&(code), gc0EnvPush(fmt)); // e0 = push(l0, e1)
4707	}
4708	if (!isLeaf && isCoroutine) {
4709	gc0AddLine(code, gc0EnvLevel(0, gcvLFmtStk->foamDEnv.argv[0]))gc0AddLineFun(&(code), gc0EnvLevel(0, gcvLFmtStk->foamDEnv .argv[0])); // l0 = car(e0)
4710	}
4711	for (i = 1; i <= maxLev; i++) {
4712	level = gcvLFmtStk->foamDEnv.argv[i];
4713	if (i != 1)
4714	gc0AddLine(code, gc0EnvNext(i, i-1))gc0AddLineFun(&(code), gc0EnvNext(i, i-1)); // eN = cdr(eN-1)
4715	if (!gc0EmptyEnv(level)((level == 4) \|\| ((((gcvFmt->foamDFmt.argv[level])->hdr .argc) - (1)) == 0)) && level != envUsedSlot0)
4716	gc0AddLine(code, gc0EnvLevel(i, level))gc0AddLineFun(&(code), gc0EnvLevel(i, level)); // lN = car(eN)
4717	}
4718	code = listNReverse(CCode)(CCode_listPointer->NReverse)(code);
4719	return code;
4720	}
4721
4722	localstatic CCode
4723	gc0LexRef(int fmt, int i)
4724	{
4725	return ccoDecl(ccoTypedefId(gc0VarId(gcFmtType, fmt)),ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,gc0VarId("PFmt", fmt )),gc0VarId("l", i))
4726	gc0VarId("l", i))ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,gc0VarId("PFmt", fmt )),gc0VarId("l", i));
4727	}
4728
4729	localstatic CCode
4730	gc0EnvRef(int i)
4731	{
4732	return ccoDecl(ccoTypeIdOf(gcFiEnv), gc0VarId("e", i))ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiEnv", 1 \| 2))),gc0VarId("e", i));
4733	}
4734
4735	localstatic CCode
4736	gc0LocRef(Foam locals, int i)
4737	{
4738	Foam decl;
4739
4740	decl = locals->foamDDecl.argv[i];
4741	return gc0IdDecl(locals, FOAM_Loc, decl, int0((int) 0), i);
4742	}
4743
4744	localstatic CCode
4745	gc0EnvMake(int fmt)
4746	{
4747	if (gc0EmptyFormat(fmt)(((fmt == 4) \|\| ((((gcvFmt->foamDFmt.argv[fmt])->hdr.argc ) - (1)) == 0)) \|\| (fmt) == 0 \|\| ((((gcvFmt->foamDFmt.argv [fmt])->hdr.argc) - (1)) < 1))) return ccoIdOf(gcFiNil)ccoNew(CCO_Id,1,symProbe("fiNil", 1 \| 2));
4748	return ccoStatAsst(gc0VarId("l", int0),ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,gc0VarId("l", ((int) 0)), ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fi0New", 1 \| 2)) ,ccoNew(CCO_Many,2,ccoNew(CCO_StructRef,1,gc0VarId("Fmt",fmt) ),ccoNew(CCO_Id,1,symProbe("CENSUS_EnvLevel", 1 \| 2))))))
4749	gcFi0New(gcFmtName, fmt, "CENSUS_EnvLevel"))ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,gc0VarId("l", ((int) 0)), ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fi0New", 1 \| 2)) ,ccoNew(CCO_Many,2,ccoNew(CCO_StructRef,1,gc0VarId("Fmt",fmt) ),ccoNew(CCO_Id,1,symProbe("CENSUS_EnvLevel", 1 \| 2))))));
4750	}
4751
4752	localstatic CCode
4753	gc0EnvPush(int fmt)
4754	{
4755	CCode ccEnvPush;
4756
4757	if (gcvIsLeaf)
4758	ccEnvPush = ccoCast(ccoTypeIdOf(gcFiEnv),ccoNew(CCO_Cast,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiEnv", 1 \| 2))),ccoNew(CCO_Init,1,ccoNew(CCO_Many,2,ccoNew (CCO_Id,1,symProbe("fiNil", 1 \| 2)),gc0VarId("e", 1))))
4759	ccoInit(ccoMany2(ccoIdOf(gcFiNil),ccoNew(CCO_Cast,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiEnv", 1 \| 2))),ccoNew(CCO_Init,1,ccoNew(CCO_Many,2,ccoNew (CCO_Id,1,symProbe("fiNil", 1 \| 2)),gc0VarId("e", 1))))
4760	gc0VarId("e", 1))))ccoNew(CCO_Cast,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiEnv", 1 \| 2))),ccoNew(CCO_Init,1,ccoNew(CCO_Many,2,ccoNew (CCO_Id,1,symProbe("fiNil", 1 \| 2)),gc0VarId("e", 1))));
4761	else if (gc0EmptyFormat(fmt)(((fmt == 4) \|\| ((((gcvFmt->foamDFmt.argv[fmt])->hdr.argc ) - (1)) == 0)) \|\| (fmt) == 0 \|\| ((((gcvFmt->foamDFmt.argv [fmt])->hdr.argc) - (1)) < 1)))
4762	ccEnvPush = gcFiEnvPush(ccoIdOf(gcFiNil), gc0VarId("e", 1))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvPush", 1 \| 2 )),ccoNew(CCO_Many,2,ccoNew(CCO_Id,1,symProbe("fiNil", 1 \| 2) ),gc0VarId("e", 1)));
4763	else
4764	ccEnvPush = gcFiEnvPush(gc0VarId("l", int0), gc0VarId("e", 1))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvPush", 1 \| 2 )),ccoNew(CCO_Many,2,gc0VarId("l", ((int) 0)),gc0VarId("e", 1 )));
4765	return ccoStatAsst(gc0VarId("e", int0), ccEnvPush)ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,gc0VarId("e", ((int) 0)), ccEnvPush));
4766	}
4767
4768	localstatic CCode
4769	gc0EnvNext(int id, int count)
4770	{
4771	CCode cc = 0;
4772	int i;
4773
4774	if (count == 1 && id > 2) {
4775	for (i = 1; i < id; i++)
4776	cc = gcFiEnvNext(gc0VarId("e", id-2))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvNext", 1 \| 2 )),gc0VarId("e", id-2));
4777	}
4778	else
4779	cc = gcFiEnvNext(gc0VarId("e", id-1))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvNext", 1 \| 2 )),gc0VarId("e", id-1));
4780	return ccoStatAsst(gc0VarId("e", id), cc)ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,gc0VarId("e", id),cc));
4781	}
4782
4783	localstatic CCode
4784	gc0EnvLevel(int id, int level)
4785	{
4786	return ccoStatAsst(gc0VarId("l", id),ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,gc0VarId("l", id),ccoNew( CCO_Cast,2,ccoNew(CCO_TypedefId,1,gc0VarId("PFmt", level)),ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvLevel", 1 \| 2)),gc0VarId ("e", id)))))
4787	ccoCast(ccoTypedefId(gc0VarId(gcFmtType, level)),ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,gc0VarId("l", id),ccoNew( CCO_Cast,2,ccoNew(CCO_TypedefId,1,gc0VarId("PFmt", level)),ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvLevel", 1 \| 2)),gc0VarId ("e", id)))))
4788	gcFiEnvLevel(gc0VarId("e", id))))ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,gc0VarId("l", id),ccoNew( CCO_Cast,2,ccoNew(CCO_TypedefId,1,gc0VarId("PFmt", level)),ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvLevel", 1 \| 2)),gc0VarId ("e", id)))));
4789	}
4790
4791	/*****************************************************************************
4792	*
4793	* :: C code generating utility functions.
4794	*
4795	****************************************************************************/
4796
4797	/*
4798	* Create a main function definition and global variables for the arguments.
4799	*/
4800
4801	localstatic CCode
4802	gc0MainDef(String name)
4803	{
4804	CCode ccParm, ccBody, ccInitProg;
4805	CCode flag, var, stmt, call;
4806	CCodeList stmts;
4807	String ftnInitFn = (String)NULL((void*)0);
4808
4809
4810	/* Check if we need any Fortran I/O initialising code */
4811	if (ccFortran)
4812	{
4813	/*
4814	* We are compiling with a Fortran RTS so check if
4815	* we need to invoke an I/O initialisation function
4816	*/
4817	ftnInitFn = compCfgLookupString("fortran-io-init-fun");
4818	if (ftnInitFn) { if (!ftnInitFn) ftnInitFn = (String)NULL((void)0); }
4819	}
4820
4821
4822	ccInitProg = gc0MultVarId("pG", int0((int) 0), name);
4823
4824	ccParm = ccoMany2(ccoNew(CCO_Many,2,ccoNew(CCO_Param,3,ccoNew(CCO_Id,1,symProbe ("argc", 1 \| 2)),ccoNew(CCO_Int,0),ccoNew(CCO_Id,1,symProbe("argc" , 1 \| 2))),ccoNew(CCO_Param,3,ccoNew(CCO_Id,1,symProbe("argv" , 1 \| 2)),ccoNew(CCO_Char,0),ccoNew(CCO_PreStar,1,ccoNew(CCO_PreStar ,1,ccoNew(CCO_Id,1,symProbe("argv", 1 \| 2))))))
4825	ccoParam(ccoIdOf("argc"), ccoInt(),ccoNew(CCO_Many,2,ccoNew(CCO_Param,3,ccoNew(CCO_Id,1,symProbe ("argc", 1 \| 2)),ccoNew(CCO_Int,0),ccoNew(CCO_Id,1,symProbe("argc" , 1 \| 2))),ccoNew(CCO_Param,3,ccoNew(CCO_Id,1,symProbe("argv" , 1 \| 2)),ccoNew(CCO_Char,0),ccoNew(CCO_PreStar,1,ccoNew(CCO_PreStar ,1,ccoNew(CCO_Id,1,symProbe("argv", 1 \| 2))))))
4826	ccoIdOf("argc")),ccoNew(CCO_Many,2,ccoNew(CCO_Param,3,ccoNew(CCO_Id,1,symProbe ("argc", 1 \| 2)),ccoNew(CCO_Int,0),ccoNew(CCO_Id,1,symProbe("argc" , 1 \| 2))),ccoNew(CCO_Param,3,ccoNew(CCO_Id,1,symProbe("argv" , 1 \| 2)),ccoNew(CCO_Char,0),ccoNew(CCO_PreStar,1,ccoNew(CCO_PreStar ,1,ccoNew(CCO_Id,1,symProbe("argv", 1 \| 2))))))
4827	ccoParam(ccoIdOf("argv"), ccoChar(),ccoNew(CCO_Many,2,ccoNew(CCO_Param,3,ccoNew(CCO_Id,1,symProbe ("argc", 1 \| 2)),ccoNew(CCO_Int,0),ccoNew(CCO_Id,1,symProbe("argc" , 1 \| 2))),ccoNew(CCO_Param,3,ccoNew(CCO_Id,1,symProbe("argv" , 1 \| 2)),ccoNew(CCO_Char,0),ccoNew(CCO_PreStar,1,ccoNew(CCO_PreStar ,1,ccoNew(CCO_Id,1,symProbe("argv", 1 \| 2))))))
4828	ccoPreStar(ccoPreStar(ccoIdOf("argv")))))ccoNew(CCO_Many,2,ccoNew(CCO_Param,3,ccoNew(CCO_Id,1,symProbe ("argc", 1 \| 2)),ccoNew(CCO_Int,0),ccoNew(CCO_Id,1,symProbe("argc" , 1 \| 2))),ccoNew(CCO_Param,3,ccoNew(CCO_Id,1,symProbe("argv" , 1 \| 2)),ccoNew(CCO_Char,0),ccoNew(CCO_PreStar,1,ccoNew(CCO_PreStar ,1,ccoNew(CCO_Id,1,symProbe("argv", 1 \| 2))))));
4829
4830	/*
4831	* FiBool flag;
4832	* FiWord var;
4833	* mainArgc = argc;
4834	* mainArgv = argv;
4835	* fiInitialiseFpu();
4836	* <fortran-io-init-fn>();
4837	* INIT__0_YYY();
4838	* fiImportGlobal("G_XXXXX_try", pG_XXXXX_YYY);
4839	* fiBlock(T1, T2, T3, fiCCall0(FiClos, *pG_XXXXX_YYY));
4840	* if (!T1) fiUnhandledException(T3)
4841	* return 0;
4842	*/
4843	stmts = listNil(CCode)((CCodeList) 0);
4844	flag = ccoIdOf("flag")ccoNew(CCO_Id,1,symProbe("flag", 1 \| 2));
4845	var = ccoIdOf("var")ccoNew(CCO_Id,1,symProbe("var", 1 \| 2));
4846	stmt = ccoDecl(ccoTypeIdOf(gcFiBool), flag)ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiBool", 1 \| 2))),flag);
4847	stmts = listCons(CCode)(CCode_listPointer->Cons)(stmt, stmts);
4848	stmt = ccoDecl(ccoTypeIdOf(gcFiWord), var)ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiWord", 1 \| 2))),var);
4849	stmts = listCons(CCode)(CCode_listPointer->Cons)(stmt, stmts);
4850	stmt = ccoStatAsst(ccoIdOf("mainArgc"), ccoIdOf("argc"))ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccoNew(CCO_Id,1,symProbe( "mainArgc", 1 \| 2)),ccoNew(CCO_Id,1,symProbe("argc", 1 \| 2))) );
4851	stmts = listCons(CCode)(CCode_listPointer->Cons)(stmt, stmts);
4852	stmt = ccoStatAsst(ccoIdOf("mainArgv"), ccoIdOf("argv"))ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccoNew(CCO_Id,1,symProbe( "mainArgv", 1 \| 2)),ccoNew(CCO_Id,1,symProbe("argv", 1 \| 2))) );
4853	stmts = listCons(CCode)(CCode_listPointer->Cons)(stmt, stmts);
4854	stmt = ccoStat(ccoFCall(ccoIdOf("fiInitialiseFpu"), ccoMany0()))ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiInitialiseFpu", 1 \| 2)),ccoNew(CCO_Many,0)));
4855	stmts = listCons(CCode)(CCode_listPointer->Cons)(stmt, stmts);
4856
4857	if (ftnInitFn)
4858	{
4859	stmt = ccoStat(ccoFCall(ccoIdOf(ftnInitFn), ccoMany0()))ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe (ftnInitFn, 1 \| 2)),ccoNew(CCO_Many,0)));
4860	stmts = listCons(CCode)(CCode_listPointer->Cons)(stmt, stmts);
4861	}
4862
4863	stmt = ccoStat(ccoFCall(gc0MultVarId(gcFiInitModulePrefix,ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", (( int) 0), name),((int) 0)))
4864	int0, name), int0))ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", (( int) 0), name),((int) 0)));
4865	stmts = listCons(CCode)(CCode_listPointer->Cons)(stmt, stmts);
4866	stmt = ccoStat(ccoFCall(ccoIdOf("fiImportGlobal"),ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiImportGlobal", 1 \| 2)),ccoNew(CCO_Many,2,ccoNew(CCO_StringVal ,1,gc0MultVarId("G", ((int) 0), name) ->ccoToken.symbol),ccoCopy (ccInitProg))))
4867	ccoMany2(ccoStringVal(gc0MultVarId("G", int0, name)ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiImportGlobal", 1 \| 2)),ccoNew(CCO_Many,2,ccoNew(CCO_StringVal ,1,gc0MultVarId("G", ((int) 0), name) ->ccoToken.symbol),ccoCopy (ccInitProg))))
4868	->ccoToken.symbol),ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiImportGlobal", 1 \| 2)),ccoNew(CCO_Many,2,ccoNew(CCO_StringVal ,1,gc0MultVarId("G", ((int) 0), name) ->ccoToken.symbol),ccoCopy (ccInitProg))))
4869	ccoCopy(ccInitProg))))ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiImportGlobal", 1 \| 2)),ccoNew(CCO_Many,2,ccoNew(CCO_StringVal ,1,gc0MultVarId("G", ((int) 0), name) ->ccoToken.symbol),ccoCopy (ccInitProg))));
4870	stmts = listCons(CCode)(CCode_listPointer->Cons)(stmt, stmts);
4871	call = gcFiCCallN(int0, ccoMany2(ccoIdOf(gcFiWord),ccoNew(CCO_FCall,2,gc0VarId("fiCCall", ((int) 0)),ccoNew(CCO_Many ,2,ccoNew(CCO_Id,1,symProbe("FiWord", 1 \| 2)),ccoNew(CCO_PreStar ,1,ccInitProg)))
4872	ccoPreStar(ccInitProg)))ccoNew(CCO_FCall,2,gc0VarId("fiCCall", ((int) 0)),ccoNew(CCO_Many ,2,ccoNew(CCO_Id,1,symProbe("FiWord", 1 \| 2)),ccoNew(CCO_PreStar ,1,ccInitProg)));
4873
4874	stmt = ccoStat(ccoFCall(ccoIdOf("fiBlock"),ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiBlock", 1 \| 2)),ccoNew(CCO_Many,4,ccoCopy(flag),ccoCopy(var ),ccoCopy(var),call)))
4875	ccoMany4(ccoCopy(flag),ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiBlock", 1 \| 2)),ccoNew(CCO_Many,4,ccoCopy(flag),ccoCopy(var ),ccoCopy(var),call)))
4876	ccoCopy(var),ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiBlock", 1 \| 2)),ccoNew(CCO_Many,4,ccoCopy(flag),ccoCopy(var ),ccoCopy(var),call)))
4877	ccoCopy(var),ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiBlock", 1 \| 2)),ccoNew(CCO_Many,4,ccoCopy(flag),ccoCopy(var ),ccoCopy(var),call)))
4878	call)))ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiBlock", 1 \| 2)),ccoNew(CCO_Many,4,ccoCopy(flag),ccoCopy(var ),ccoCopy(var),call)));
4879	stmts = listCons(CCode)(CCode_listPointer->Cons)(stmt, stmts);
4880	stmt = ccoStat(ccoIf(ccoLNot(ccoCopy(flag)),ccoNew(CCO_Stat,1,ccoNew(CCO_If,3,ccoNew(CCO_LNot,1,ccoCopy(flag )),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiUnhandledException" , 1 \| 2)),ccoNew(CCO_Many,1,ccoCopy(var))),((void*)0)))
4881	ccoFCall(ccoIdOf("fiUnhandledException"),ccoNew(CCO_Stat,1,ccoNew(CCO_If,3,ccoNew(CCO_LNot,1,ccoCopy(flag )),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiUnhandledException" , 1 \| 2)),ccoNew(CCO_Many,1,ccoCopy(var))),((void*)0)))
4882	ccoMany1(ccoCopy(var))),ccoNew(CCO_Stat,1,ccoNew(CCO_If,3,ccoNew(CCO_LNot,1,ccoCopy(flag )),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiUnhandledException" , 1 \| 2)),ccoNew(CCO_Many,1,ccoCopy(var))),((void*)0)))
4883	NULL))ccoNew(CCO_Stat,1,ccoNew(CCO_If,3,ccoNew(CCO_LNot,1,ccoCopy(flag )),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiUnhandledException" , 1 \| 2)),ccoNew(CCO_Many,1,ccoCopy(var))),((void*)0)));
4884
4885	stmts = listCons(CCode)(CCode_listPointer->Cons)(stmt, stmts);
4886	stmt = ccoReturn(ccoIntOf(int0))ccoNew(CCO_Return,1,ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL" ,((int) 0)), 1 \| 2)));
4887	stmts = listCons(CCode)(CCode_listPointer->Cons)(stmt, stmts);
4888	stmts = listNReverse(CCode)(CCode_listPointer->NReverse)(stmts);
4889
4890	ccBody = gc0ListOf(CCO_Many, stmts);
4891
4892	listFree(CCode)(CCode_listPointer->Free)(stmts);
4893
4894	return ccoFDef(ccoType(ccoExtern(), ccoTypeIdOf("int")),ccoNew(CCO_FDef,4,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("int", 1 \| 2)))),ccoNew (CCO_Id,1,symProbe("main", 1 \| 2)),ccParm,ccoNew(CCO_Compound ,1,ccBody))
4895	ccoIdOf("main"),ccoNew(CCO_FDef,4,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("int", 1 \| 2)))),ccoNew (CCO_Id,1,symProbe("main", 1 \| 2)),ccParm,ccoNew(CCO_Compound ,1,ccBody))
4896	ccParm,ccoNew(CCO_FDef,4,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("int", 1 \| 2)))),ccoNew (CCO_Id,1,symProbe("main", 1 \| 2)),ccParm,ccoNew(CCO_Compound ,1,ccBody))
4897	ccoCompound(ccBody))ccoNew(CCO_FDef,4,ccoNew(CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew (CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("int", 1 \| 2)))),ccoNew (CCO_Id,1,symProbe("main", 1 \| 2)),ccParm,ccoNew(CCO_Compound ,1,ccBody));
4898	}
4899
4900	localstatic CCode
4901	gc0ClosInit(Foam ref, Foam val)
4902	{
4903	Foam prog, decl, tmp;
4904	CCode ccClos, ccLeft, ccRight, type;
4905
4906	decl = gc0GetDecl(ref);
4907
4908	if (foamTag(val)((val)->hdr.tag) != FOAM_Clos) {
4909	int fmt = decl->foamDecl.format;
4910
4911	type = gc0TypeId(decl->foamDecl.type, fmt);
4912	tmp = val;
4913	while (foamTag(tmp)((tmp)->hdr.tag) == FOAM_Cast)
4914	tmp = tmp->foamCast.expr;
4915	return ccoDecl(type,foamTag(tmp)==FOAM_NilccoNew(CCO_Decl,2,type,((tmp)->hdr.tag)==FOAM_Nil ? gccId( ref) : ccoNew(CCO_Asst,2,gccId(ref),gccExpr(val)))
4916	? gccId(ref)ccoNew(CCO_Decl,2,type,((tmp)->hdr.tag)==FOAM_Nil ? gccId( ref) : ccoNew(CCO_Asst,2,gccId(ref),gccExpr(val)))
4917	: ccoAsst(gccId(ref), gccExpr(val)))ccoNew(CCO_Decl,2,type,((tmp)->hdr.tag)==FOAM_Nil ? gccId( ref) : ccoNew(CCO_Asst,2,gccId(ref),gccExpr(val)));
4918	}
4919	prog = val->foamClos.prog;
4920	ccClos = ccoNewNode(CCO_Many, 2);
4921
4922	ccLeft = gc0MultVarId("tmpClos", int0((int) 0), decl->foamDecl.id);
4923	ccRight = ccoInit(ccoMany2(ccoIntOf(int0),ccoNew(CCO_Init,1,ccoNew(CCO_Many,2,ccoNew(CCO_IntVal,1,symProbe (strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_Cast,2,ccoNew (CCO_Id,1,symProbe("FiProg", 1 \| 2)),ccoNew(CCO_PreAnd,1,gc0MultVarId ("tmp", prog->foamConst.index, gc0GetDecl(prog)->foamDecl .id)))))
4924	ccoCast(ccoIdOf("FiProg"),ccoNew(CCO_Init,1,ccoNew(CCO_Many,2,ccoNew(CCO_IntVal,1,symProbe (strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_Cast,2,ccoNew (CCO_Id,1,symProbe("FiProg", 1 \| 2)),ccoNew(CCO_PreAnd,1,gc0MultVarId ("tmp", prog->foamConst.index, gc0GetDecl(prog)->foamDecl .id)))))
4925	ccoPreAnd(gc0MultVarId("tmp",ccoNew(CCO_Init,1,ccoNew(CCO_Many,2,ccoNew(CCO_IntVal,1,symProbe (strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_Cast,2,ccoNew (CCO_Id,1,symProbe("FiProg", 1 \| 2)),ccoNew(CCO_PreAnd,1,gc0MultVarId ("tmp", prog->foamConst.index, gc0GetDecl(prog)->foamDecl .id)))))
4926	prog->foamConst.index,ccoNew(CCO_Init,1,ccoNew(CCO_Many,2,ccoNew(CCO_IntVal,1,symProbe (strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_Cast,2,ccoNew (CCO_Id,1,symProbe("FiProg", 1 \| 2)),ccoNew(CCO_PreAnd,1,gc0MultVarId ("tmp", prog->foamConst.index, gc0GetDecl(prog)->foamDecl .id)))))
4927	gc0GetDecl(prog)->foamDecl.id)))))ccoNew(CCO_Init,1,ccoNew(CCO_Many,2,ccoNew(CCO_IntVal,1,symProbe (strPrintf("%ldL",((int) 0)), 1 \| 2)),ccoNew(CCO_Cast,2,ccoNew (CCO_Id,1,symProbe("FiProg", 1 \| 2)),ccoNew(CCO_PreAnd,1,gc0MultVarId ("tmp", prog->foamConst.index, gc0GetDecl(prog)->foamDecl .id)))));
4928
4929	ccoArgv(ccClos)((ccClos)->ccoNode.argv)[0] = ccoDecl(ccoType(ccoStatic(),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_StructRef,1,ccoNew(CCO_Id,1,symProbe("_FiClos", 1 \| 2))) ),ccoNew(CCO_Asst,2,ccLeft,ccRight))
4930	ccoStructRef(ccoIdOf("_FiClos"))),ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_StructRef,1,ccoNew(CCO_Id,1,symProbe("_FiClos", 1 \| 2))) ),ccoNew(CCO_Asst,2,ccLeft,ccRight))
4931	ccoAsst(ccLeft, ccRight))ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccoNew(CCO_Static,0),ccoNew (CCO_StructRef,1,ccoNew(CCO_Id,1,symProbe("_FiClos", 1 \| 2))) ),ccoNew(CCO_Asst,2,ccLeft,ccRight));
4932
4933	ccoArgv(ccClos)((ccClos)->ccoNode.argv)[1] = ccoDecl(ccoTypeIdOf(gcFiClos),ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiClos", 1 \| 2))),ccoNew(CCO_Asst,2,gccId(ref),ccoNew(CCO_PreAnd ,1,gc0MultVarId("tmpClos", ((int) 0), decl->foamDecl.id))) )
4934	ccoAsst(gccId(ref),ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiClos", 1 \| 2))),ccoNew(CCO_Asst,2,gccId(ref),ccoNew(CCO_PreAnd ,1,gc0MultVarId("tmpClos", ((int) 0), decl->foamDecl.id))) )
4935	ccoPreAnd(gc0MultVarId("tmpClos", int0,ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiClos", 1 \| 2))),ccoNew(CCO_Asst,2,gccId(ref),ccoNew(CCO_PreAnd ,1,gc0MultVarId("tmpClos", ((int) 0), decl->foamDecl.id))) )
4936	decl->foamDecl.id))))ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiClos", 1 \| 2))),ccoNew(CCO_Asst,2,gccId(ref),ccoNew(CCO_PreAnd ,1,gc0MultVarId("tmpClos", ((int) 0), decl->foamDecl.id))) );
4937	return ccClos;
4938	}
4939
4940	localstatic CCode
4941	gc0Set(Foam foamLHS, Foam foamRHS)
4942	{
4943	AInt typeCastExpr = -1;
4944
4945	FoamBValTag tag = 0;
4946
4947	gcvisStmtFCall = 0;
4948	if (foamTag(foamRHS)((foamRHS)->hdr.tag) == FOAM_BVal)
4949	tag = foamRHS->foamBVal.builtinTag;
4950	if (foamTag(foamRHS)((foamRHS)->hdr.tag) == FOAM_BCall)
4951	tag = foamBValInfo(foamRHS->foamBCall.op)(foamBValInfoTable[(int)(foamRHS->foamBCall.op)-(int)FOAM_BVAL_START ]).tag;
4952	if (foamTag(foamRHS)((foamRHS)->hdr.tag) == FOAM_Cast) {
4953	Foam fc = foamRHS->foamCast.expr; /* what's being cast */
4954
4955	typeCastExpr = gc0ExprType(fc); /* deduce its FOAM type */
4956
4957	if (foamTag(fc)((fc)->hdr.tag) == FOAM_BVal) {
4958	tag = fc->foamBVal.builtinTag;
4959	if (ccBValMacro(tag)((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).macro) != 0)
4960	foamRHS = fc;
4961	}
4962	if (foamTag(fc)((fc)->hdr.tag) == FOAM_BCall) {
4963	tag = foamBValInfo(fc->foamBCall.op)(foamBValInfoTable[(int)(fc->foamBCall.op)-(int)FOAM_BVAL_START ]).tag;
4964	/* fprintf(stderr,"%s\tcast to %s\n",foamInfoTable[typeCastExpr].str,foamInfoTable[gc0ExprType(foamLHS)].str); */
4965	if ((ccBValMacro(tag)((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).macro) != 0) && (typeCastExpr != FOAM_SFlo))
4966	foamRHS = fc;
4967	}
4968	/* A modifiable argument variable on the lhs can cause a cast. */
4969	if (foamTag(fc)((fc)->hdr.tag) == FOAM_PCall &&
4970	fc->foamPCall.protocol == FOAM_Proto_Fortran)
4971	return gc0FortranSet(foamLHS, fc, (FoamTag)foamRHS->foamCast.type, (FoamTag)typeCastExpr);
4972	}
4973	if (tag && ccBValMacro(tag)((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).macro) != 0)
4974	gcvisStmtFCall = 1;
4975
4976	if (foamTag(foamRHS)((foamRHS)->hdr.tag) == FOAM_Catch) {
4977	/* The old way: (Set (Values ...) (Catch ...)) */
4978	bug("gc0Set: old-style set-catch");
4979	return gc0SetCatch(foamLHS, foamRHS);
4980	}
4981	else if (foamTag(foamRHS)((foamRHS)->hdr.tag) == FOAM_MFmt &&
4982	foamTag(foamRHS->foamMFmt.value)((foamRHS->foamMFmt.value)->hdr.tag) == FOAM_Catch) {
4983	/* The new way: (Set (Values ...) (MFmt f (Catch ...))) */
4984	return gc0SetCatch(foamLHS, foamRHS->foamMFmt.value);
4985	}
4986	else if (foamTag(foamLHS)((foamLHS)->hdr.tag) == FOAM_Fluid) {
4987	return gc0FluidSet(foamLHS, foamRHS);
4988	}
4989	else if (foamTag(foamLHS)((foamLHS)->hdr.tag) == FOAM_Values)
4990	return gc0SetValues(foamLHS, foamRHS);
4991	else if (foamTag(foamRHS)((foamRHS)->hdr.tag) == FOAM_PCall &&
4992	foamRHS->foamPCall.protocol == FOAM_Proto_Fortran)
4993	return gc0FortranSet(foamLHS, foamRHS, FOAM_NOp, FOAM_NOp);
4994	else {
4995	CCode ccArg, ccType, ccSpecial;
4996	AInt typeLhs = gc0ExprType(foamLHS);
4997
4998	ccArg = gccRef(foamLHS);
4999	if (ccoTag(ccArg)((ccArg)->ccoHdr.tag) == CCO_Cast)
5000	ccArg = ccoArgv(ccArg)((ccArg)->ccoNode.argv)[1];
5001	ccType = gc0TypeId(typeLhs, emptyFormatSlot4);
5002	if (gc0IsDecl(foamLHS)) {
5003	Foam decl = gc0GetDecl(foamLHS);
5004	int fmt = decl->foamDecl.format;
5005	int typ = decl->foamDecl.type;
5006
5007	if (typ == FOAM_Rec) {
5008	if (fmt && fmt != emptyFormatSlot4)
5009	ccType = ccoTypedefId(gc0VarId(gcFmtType,ccoNew(CCO_TypedefId,1,gc0VarId("PFmt", fmt))
5010	fmt))ccoNew(CCO_TypedefId,1,gc0VarId("PFmt", fmt));
5011	}
5012	else if (typ == FOAM_Arr)
5013	ccType = ccoPostStar(gc0TypeId(fmt, emptyFormatSlot))ccoNew(CCO_PostStar,1,gc0TypeId(fmt, 4));
5014	}
5015	else if (foamTag(foamLHS)((foamLHS)->hdr.tag) == FOAM_AElt)
5016	ccType = gc0TypeId(foamLHS->foamAElt.baseType, emptyFormatSlot4);
5017	#ifdef USE_MACROS
5018	if (tag && gcvisStmtFCall) {
5019	CCode ccArgs,ccSpecial;
5020	int argc, i, ix;
5021
5022	ccSpecial = gc0SpecialSFloWord(foamRHS,typeCastExpr,ccArg);
5023	if (ccSpecial) return ccSpecial;
5024
5025	argc = foamBValInfo(tag)(foamBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).argCount;
5026	ccArgs = ccoNewNode(CCO_Many, argc+2);
5027	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[0] = ccArg;
5028	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[1] = ccType;
5029	for (i = 2, ix = 0; ix < argc; i++, ix++)
5030	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[i] = gccExpr(foamRHS->foamBCall.argv[ix]);
5031	return ccoFCall(ccoIdOf(ccBValMacro(tag)), ccArgs)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe(((ccBValInfoTable [(int)(tag)-(int)FOAM_BVAL_START]).macro), 1 \| 2)),ccArgs);
5032	}
5033	#endif
5034	if (foamTag(foamRHS)((foamRHS)->hdr.tag) == FOAM_RNew)
5035	return ccoAsst(ccArg, gccExpr(foamRHS))ccoNew(CCO_Asst,2,ccArg,gccExpr(foamRHS));
5036	else if (foamTag(foamRHS)((foamRHS)->hdr.tag) == FOAM_ANew) {
5037	CCode ccArrIndex, ccFunName;
5038
5039	ccArrIndex = gccExpr(foamRHS->foamANew.size);
5040	ccFunName = ccoIdOf(strConcat("fiARRNEW_",ccoNew(CCO_Id,1,symProbe(strConcat("fiARRNEW_", ((foamInfoTable [(int)(foamRHS->foamANew.eltType)-(int)FOAM_START]).str)) , 1 \| 2))
5041	foamStr(foamRHS->foamANew.eltType)))ccoNew(CCO_Id,1,symProbe(strConcat("fiARRNEW_", ((foamInfoTable [(int)(foamRHS->foamANew.eltType)-(int)FOAM_START]).str)) , 1 \| 2));
5042	return ccoFCall(ccFunName, ccoMany3(ccArg,ccoNew(CCO_FCall,2,ccFunName,ccoNew(CCO_Many,3,ccArg,ccType,ccArrIndex ))
5043	ccType,ccoNew(CCO_FCall,2,ccFunName,ccoNew(CCO_Many,3,ccArg,ccType,ccArrIndex ))
5044	ccArrIndex))ccoNew(CCO_FCall,2,ccFunName,ccoNew(CCO_Many,3,ccArg,ccType,ccArrIndex ));
5045	}
5046	else if ((ccSpecial = gc0SpecialSFloWord(foamRHS,typeCastExpr,ccArg)) != NULL((void*)0) ) return ccSpecial;
5047
5048	else
5049	return ccoAsst(ccArg, gc0SubExpr(foamRHS, ccType))ccoNew(CCO_Asst,2,ccArg,gc0SubExpr(foamRHS, ccType));
5050	}
5051	}
5052
5053	localstatic CCode
5054	gc0SpecialSFloWord(Foam foamRHS, AInt typeCastExpr, CCode ccArg)
5055	{
5056	if (foamTag(foamRHS)((foamRHS)->hdr.tag) == FOAM_Cast &&
5057	foamRHS->foamCast.type == FOAM_SFlo &&
5058	typeCastExpr == FOAM_Word) {
5059
5060	CCode cc = ccoMany2(ccArg,ccoNew(CCO_Many,2,ccArg,gc0SubExpr(foamRHS->foamCast.expr, ((void*)0)))
5061	gc0SubExpr(foamRHS->foamCast.expr, NULL))ccoNew(CCO_Many,2,ccArg,gc0SubExpr(foamRHS->foamCast.expr, ((void*)0)));
5062
5063	return ccoFCall(ccoIdOf("fiSFLO_FR_WORD"), cc)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiSFLO_FR_WORD", 1 \| 2)),cc);
5064	}
5065	else if (foamTag(foamRHS)((foamRHS)->hdr.tag) == FOAM_Cast &&
5066	foamRHS->foamCast.type == FOAM_Word &&
5067	typeCastExpr == FOAM_SFlo) {
5068
5069	CCode cc = ccoMany2(ccArg,ccoNew(CCO_Many,2,ccArg,gc0SubExpr(foamRHS->foamCast.expr, ((void*)0)))
5070	gc0SubExpr(foamRHS->foamCast.expr, NULL))ccoNew(CCO_Many,2,ccArg,gc0SubExpr(foamRHS->foamCast.expr, ((void*)0)));
5071
5072	return ccoFCall(ccoIdOf("fiWORD_FR_SFLO"), cc)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiWORD_FR_SFLO", 1 \| 2)),cc);
5073	}
5074	else return NULL((void*)0);
5075	}
5076
5077	localstatic CCode
5078	gc0SetValues(Foam foamLHS, Foam foamRHS)
5079	{
5080	int i, num, args;
5081	CCode ccRhs, ccArgs, cc;
5082	CCodeList code = listNil(CCode)((CCodeList) 0);
5083
5084	/* This is legal (if nasty) so deal with it */
5085	if (foamTag(foamRHS)((foamRHS)->hdr.tag) == FOAM_MFmt &&
5086	foamTag(foamRHS->foamMFmt.value)((foamRHS->foamMFmt.value)->hdr.tag) == FOAM_Values)
5087	foamRHS = foamRHS->foamMFmt.value;
5088
5089	if (foamTag(foamRHS)((foamRHS)->hdr.tag) == FOAM_Values) {
5090	/* Assume lhs + rhs are independent */
5091	for (i=0; i<foamArgc(foamLHS)((foamLHS)->hdr.argc); i++) {
5092	cc = gc0Set(foamLHS->foamValues.argv[i],
5093	foamRHS->foamValues.argv[i]);
5094	gc0AddTopLevelStmt(gcvStmts, ccoStat(cc)ccoNew(CCO_Stat,1,cc));
5095	}
5096	return NULL((void*)0);
5097	}
5098
5099	if (foamTag(foamRHS)((foamRHS)->hdr.tag) == FOAM_MFmt &&
5100	foamTag(foamRHS->foamMFmt.value)((foamRHS->foamMFmt.value)->hdr.tag) == FOAM_PCall &&
5101	foamRHS->foamMFmt.value->foamPCall.protocol == FOAM_Proto_Fortran)
5102	bug("gc0SetValues: Fortran call returning MFmt (not supported)");
5103	/* return gc0FortranSet(foamLHS, foamRHS); */
5104
5105	ccRhs = gccExpr(foamRHS);
5106	args = ccoArgc(ccoArgv(ccRhs)[1])((((ccRhs)->ccoNode.argv)[1])->ccoNode.argc);
5107	ccArgs = ccoArgv(ccRhs)((ccRhs)->ccoNode.argv)[1];
5108	for (i = 0; i < args; i++)
5109	gc0AddLine(code, ccoArgv(ccArgs)[i])gc0AddLineFun(&(code), ((ccArgs)->ccoNode.argv)[i]);
5110	num = foamArgc(foamLHS)((foamLHS)->hdr.argc);
5111	for (i = 0; i < num; i++) {
5112	if (foamTag(foamLHS->foamValues.argv[i])((foamLHS->foamValues.argv[i])->hdr.tag) == FOAM_Fluid)
5113	bug("Fluid multi: Not supported.");
5114	gc0AddLine(code, ccoPreAnd(gccRef(foamLHS->foamValues.argv[i])))gc0AddLineFun(&(code), ccoNew(CCO_PreAnd,1,gccRef(foamLHS ->foamValues.argv[i])));
5115	}
5116	code = listNReverse(CCode)(CCode_listPointer->NReverse)(code);
5117	ccoArgv(ccRhs)((ccRhs)->ccoNode.argv)[1] = gc0ListOf(CCO_Many, code);
5118	listFree(CCode)(CCode_listPointer->Free)(code);
5119	return ccRhs;
5120	}
5121
5122	localstatic CCode
5123	gc0FortranSet(Foam foamLHS, Foam foamRHS, FoamTag lhsType, FoamTag rhsType)
5124	{
5125	Foam gdecl, argformat, pcall, lastresultvar, *resultvars;
5126	int i, numresultvars, listl, modargs;
5127	String cmplxfns = compCfgLookupString("fortran-cmplx-fns");
5128	FortranType restype;
5129	CCode ccType, ccCastType, ccFortranSet;
5130	FoamTag resvartype, fmtype;
5131	AInt resvarfmt;
5132	CCodeList l, closnullifys = listNil(CCode)((CCodeList) 0);
5133	Foam fnresultdecl;
5134
5135	ccFortranSet = NULL((void*)0);
5136
5137	if (foamTag(foamLHS)((foamLHS)->hdr.tag) == FOAM_Values) {
5138	bug("Fortran function call with multiple return values");
5139	numresultvars = foamArgc(foamLHS)((foamLHS)->hdr.argc);
5140	pcall = foamRHS->foamMFmt.value;
5141	resultvars = foamLHS->foamValues.argv;
5142	lastresultvar = foamLHS->foamValues.argv[foamArgc(foamLHS)((foamLHS)->hdr.argc)-1];
5143	}
5144	else {
5145	numresultvars = 1;
5146	pcall = foamRHS;
5147	resultvars = &foamLHS;
5148	lastresultvar = foamLHS;
5149	}
5150	gdecl = gc0GetDecl(pcall->foamPCall.op);
5151	argformat = gcvFmt->foamDFmt.argv[gdecl->foamGDecl.format];
5152	fnresultdecl = gc0GetFortranRetFm(argformat);
5153	modargs = gc0GetNumModFortranArgs(argformat);
5154	restype = gc0GetFortranRetType(argformat);
5155
5156	if (foamTag(foamLHS)((foamLHS)->hdr.tag) == FOAM_Values && numresultvars < modargs)
5157	bug("Fortran Set Values has the wrong number of lhs variables");
5158
5159
5160	/* Char and Character are equivalent */
5161	if (restype && (restype != FTN_Machine))
5162	fmtype = gen0FtnMachineType(restype);
5163	else
5164	fmtype = fnresultdecl->foamDecl.type;
5165
5166
5167	/* Hack */
5168	if (fmtype == FOAM_Char)
5169	restype = FTN_Character;
5170
5171
5172	/* Strings, characters and complex numbers are special ... */
5173	switch (restype)
5174	{
5175	case FTN_Character:
5176	/* Fall through */
5177	case FTN_String:
5178	/* Fall through */
5179	case FTN_XLString:
5180	ccFortranSet = gccFortranPCall(resultvars, numresultvars, pcall, &closnullifys);
5181	break;
5182	case FTN_FSComplex:
5183	/* Fall through */
5184	case FTN_FDComplex:
5185	resvartype = (gc0GetDecl(lastresultvar))->foamDecl.type;
5186	resvarfmt = (gc0GetDecl(lastresultvar))->foamDecl.format;
5187	ccType = ccoTypeIdOf(restype == FTN_FSComplex ? gcFiComplexSF : gcFiComplexDF)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe(restype == FTN_FSComplex ? "FiComplexSF" : "FiComplexDF", 1 \| 2)));
5188	ccCastType = gc0TypeId(resvartype, resvarfmt);
5189
5190	gc0AddTopLevelStmt(gcvStmts,
5191	ccoStat(ccoFCall(ccoIdOf("fi_ALLOC"),ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fi_ALLOC", 1 \| 2)),ccoNew(CCO_Many,3,gccRef(lastresultvar), ccCastType,ccoNew(CCO_Sizeof,1,ccType))))
5192	ccoMany3(gccRef(lastresultvar),ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fi_ALLOC", 1 \| 2)),ccoNew(CCO_Many,3,gccRef(lastresultvar), ccCastType,ccoNew(CCO_Sizeof,1,ccType))))
5193	ccCastType,ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fi_ALLOC", 1 \| 2)),ccoNew(CCO_Many,3,gccRef(lastresultvar), ccCastType,ccoNew(CCO_Sizeof,1,ccType))))
5194	ccoSizeof(ccType))))ccoNew(CCO_Stat,1,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fi_ALLOC", 1 \| 2)),ccoNew(CCO_Many,3,gccRef(lastresultvar), ccCastType,ccoNew(CCO_Sizeof,1,ccType)))));
5195	if (!cmplxfns)
5196	comsgFatal(NULL((void*)0), ALDOR_F_NoFCmplxProperty272, "fortran-cmplx-fns");
5197	else if (strEqual(cmplxfns, "return-struct"))
5198	ccFortranSet = ccoAsst(ccoPreStar(ccoParen(ccoCast(ccoPostStar(ccoCopy(ccType)),ccoNew(CCO_Asst,2,ccoNew(CCO_PreStar,1,ccoNew(CCO_Paren,1,ccoNew (CCO_Cast,2,ccoNew(CCO_PostStar,1,ccoCopy(ccType)),gccRef(lastresultvar )))),gccFortranPCall(resultvars, numresultvars, pcall, &closnullifys ))
5199	gccRef(lastresultvar)))),ccoNew(CCO_Asst,2,ccoNew(CCO_PreStar,1,ccoNew(CCO_Paren,1,ccoNew (CCO_Cast,2,ccoNew(CCO_PostStar,1,ccoCopy(ccType)),gccRef(lastresultvar )))),gccFortranPCall(resultvars, numresultvars, pcall, &closnullifys ))
5200	gccFortranPCall(resultvars, numresultvars, pcall, &closnullifys))ccoNew(CCO_Asst,2,ccoNew(CCO_PreStar,1,ccoNew(CCO_Paren,1,ccoNew (CCO_Cast,2,ccoNew(CCO_PostStar,1,ccoCopy(ccType)),gccRef(lastresultvar )))),gccFortranPCall(resultvars, numresultvars, pcall, &closnullifys ));
5201	else if (strEqual(cmplxfns, "return-void"))
5202	ccFortranSet = gccFortranPCall(resultvars, numresultvars, pcall, &closnullifys);
5203	else if (strEqual(cmplxfns, "disallowed"))
5204	bug("gc0FortranSet: Fortran function returning a complex result detected");
5205	else
5206	comsgFatal(NULL((void*)0), ALDOR_F_BadFCmplxValue273, cmplxfns);
5207	break;
5208	default:
5209	{
5210	CCode cc = gccFortranPCall(resultvars, numresultvars, pcall, &closnullifys);
5211	CCode ccR = gccRef(lastresultvar);
5212
5213	if ((lhsType == FOAM_Word) && (rhsType == FOAM_SFlo))
5214	{
5215	cc = ccoMany2(ccR, cc)ccoNew(CCO_Many,2,ccR,cc);
5216	ccFortranSet = ccoFCall(ccoIdOf("fiWORD_FR_SFLO"), cc)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiWORD_FR_SFLO", 1 \| 2)),cc);
5217	}
5218	else
5219	ccFortranSet = ccoAsst(ccR, cc)ccoNew(CCO_Asst,2,ccR,cc);
5220	}
5221	}
5222
5223	if (closnullifys) {
5224	gc0AddTopLevelStmt(gcvStmts, ccoStat(ccFortranSet)ccoNew(CCO_Stat,1,ccFortranSet));
5225	listl = listLength(CCode)(CCode_listPointer->_Length)(closnullifys);
5226	l = closnullifys;
5227	for (i = 0; i < listl-1; closnullifys = cdr(closnullifys)((closnullifys)->rest), i++)
5228	gc0AddTopLevelStmt(gcvStmts, ccoStat(car(closnullifys))ccoNew(CCO_Stat,1,((closnullifys)->first)));
5229	ccFortranSet = car(closnullifys)((closnullifys)->first);
5230	listFree(CCode)(CCode_listPointer->Free)(l);
5231	}
5232	return ccFortranSet;
5233	}
5234
5235	localstatic CCode
5236	gc0SetCatch(Foam lhs, Foam rhs)
5237	{
5238	Foam flg, val, exn;
5239	Foam call = rhs->foamCatch.ref;
5240	CCode args, res, fcall;
5241
5242	assert(foamTag(call) == FOAM_Clos)do { if (!(((call)->hdr.tag) == FOAM_Clos)) _do_assert(("foamTag(call) == FOAM_Clos" ),"genc.c",5242); } while (0);
5243	args = ccoMany1(gccExpr(call->foamClos.env))ccoNew(CCO_Many,1,gccExpr(call->foamClos.env));
5244	fcall = ccoFCall(gccProgId(call->foamClos.prog), args)ccoNew(CCO_FCall,2,gccProgId(call->foamClos.prog),args);
5245
5246
5247	/* Does this catch-block return a value? */
5248	if (foamArgc(lhs)((lhs)->hdr.argc) == 3) {
5249	flg = lhs->foamValues.argv[0];
5250	val = lhs->foamValues.argv[1];
5251	exn = lhs->foamValues.argv[2];
5252
5253	res = ccoFCall(ccoIdOf("fiBlock"),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBlock", 1 \| 2) ),ccoNew(CCO_Many,4,gccExpr(flg),gccExpr(val),gccExpr(exn),fcall ))
5254	ccoMany4(gccExpr(flg), gccExpr(val), gccExpr(exn),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBlock", 1 \| 2) ),ccoNew(CCO_Many,4,gccExpr(flg),gccExpr(val),gccExpr(exn),fcall ))
5255	fcall))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBlock", 1 \| 2) ),ccoNew(CCO_Many,4,gccExpr(flg),gccExpr(val),gccExpr(exn),fcall ));
5256	}
5257	else {
5258	flg = lhs->foamValues.argv[0];
5259	exn = lhs->foamValues.argv[1];
5260
5261	res = ccoFCall(ccoIdOf("fiVoidBlock"),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiVoidBlock", 1 \| 2)),ccoNew(CCO_Many,3,gccExpr(flg),gccExpr(exn),fcall))
5262	ccoMany3(gccExpr(flg), gccExpr(exn), fcall))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiVoidBlock", 1 \| 2)),ccoNew(CCO_Many,3,gccExpr(flg),gccExpr(exn),fcall));
5263	}
5264
5265	return res;
5266	}
5267
5268
5269	localstatic CCode
5270	gc0SeqStmt(Foam foam, int n)
5271	{
5272	Foam seqFoam;
5273
5274	seqFoam = foamArgv(foam)((foam)->foamGen.argv)[n].code;
5275
5276	if (foamTag(seqFoam)((seqFoam)->hdr.tag) == FOAM_Seq) {
5277	gcvNStmts += (foamArgc(seqFoam)((seqFoam)->hdr.argc) - 1);
5278	gcvStmts->stmt = (CCode *) stoResize(gcvStmts->stmt,
5279	fullsizeof(struct ccoNode, 1,(sizeof(struct ccoNode) + (1) * sizeof(CCode) - 10 * sizeof(CCode ))
5280	CCode)(sizeof(struct ccoNode) + (1) * sizeof(CCode) - 10 * sizeof(CCode )) * (gcvNStmts));
5281	gcvStmts->argc = gcvNStmts;
5282	}
5283
5284	return gccCmd(seqFoam);
5285	}
5286
5287	localstatic CCode
5288	gc0FunBCall(Foam foam, int returnKind)
5289	{
5290	return gc0Builtin(foamBValInfo(foam->foamBCall.op)(foamBValInfoTable[(int)(foam->foamBCall.op)-(int)FOAM_BVAL_START ]).tag, foam);
5291	}
5292
5293	localstatic CCode
5294	gc0Builtin(FoamBValTag tag, Foam foam)
5295	{
5296	CCode cc;
5297	int ccTag;
5298
5299	ccTag = ccBValCFun(tag)((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).cfun);
5300	switch (ccTag) {
5301	case CCO_Id:
5302	case CCO_FloatVal:
5303	case CCO_IntVal:
5304	case CCO_CharVal:
5305	cc = ccoIdOf(ccBValStr(tag))ccoNew(CCO_Id,1,symProbe(((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START ]).str), 1 \| 2));
5306	break;
5307	case CCO_FCall:
5308	cc = gc0FCall(tag, foam);
5309	break;
5310	case CCO_Cast:
5311	cc = ccoCast(ccoTypeIdOf(ccBValStr(tag)),ccoNew(CCO_Cast,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe (((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).str), 1 \| 2))),gccExpr(foam->foamBCall.argv[0]))
5312	gccExpr(foam->foamBCall.argv[0]))ccoNew(CCO_Cast,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe (((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).str), 1 \| 2))),gccExpr(foam->foamBCall.argv[0]));
5313	break;
5314	default:
5315	cc = gc0Cop(tag, foam, ccTag);
5316	break;
5317	}
5318
5319	return cc;
5320	}
5321
5322	localstatic CCode
5323	gc0FCall(FoamBValTag tag, Foam foam)
5324	{
5325	CCode ccArgs;
5326
5327	if (ccBValSpec(tag)((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).special) == 0) {
5328	int i, argc;
5329	argc = foamBValInfo(tag)(foamBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).argCount;
5330	#ifdef USE_MACROS
5331	if (ccBValMacro(tag)((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).macro) && !gcvisStmtFCall) {
5332	CCode cc, ccName;
5333	int ix;
5334
5335	/* Create a temporary assignment variable. */
5336	ccName = gc0MultVarId("T", gcvNLocs, "");
5337	ccArgs = ccoNewNode(CCO_Many, argc+2);
5338	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[0] = ccoCopy(ccName);
5339	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[1] = gc0TypeId(gc0ExprType(foam), emptyFormatSlot4);
5340
5341	/* Update local variable list. */
5342	gc0AddUnSortedLocal(ccoDecl(gc0TypeId(gc0ExprType(foam), emptyFormatSlot),ccoNew(CCO_Decl,2,gc0TypeId(gc0ExprType(foam), 4),ccName)
5343	ccName)ccoNew(CCO_Decl,2,gc0TypeId(gc0ExprType(foam), 4),ccName));
5344
5345	for (i = 2, ix = 0; ix < argc; i++, ix++)
5346	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[i] = gccExpr(foam->foamBCall.argv[ix]);
5347	cc = ccoFCall(ccoIdOf(ccBValMacro(tag)), ccArgs)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe(((ccBValInfoTable [(int)(tag)-(int)FOAM_BVAL_START]).macro), 1 \| 2)),ccArgs);
5348	gc0AddTopLevelStmt(gcvStmts, ccoStat(cc)ccoNew(CCO_Stat,1,cc));
5349
5350	return ccName;
5351	}
5352	#else
5353	if (false((int) 0)) ;
5354	#endif
5355	else {
5356	ccArgs = ccoNewNode(CCO_Many, argc);
5357	for (i = 0; i < argc; i++) {
5358	FoamTag type;
5359	Foam val;
5360
5361	type = foamBValInfoTable[tag].argTypes[i];
5362	val = foam->foamBCall.argv[i];
5363
5364	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[i] = gc0TryCast(type, val);
5365	}
5366	}
5367	}
5368	else {
5369	switch(tag) {
5370	case FOAM_BVal_BIntIsEven:
5371	case FOAM_BVal_BIntIsOdd:
5372	ccArgs = ccoMany2(ccoNew(CCO_Many,2,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiBIntMod", 1 \| 2)),ccoNew(CCO_Many,2,gccExpr(foam->foamBCall .argv[0]),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBIntNew" , 1 \| 2)),ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",2), 1 \| 2))))),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBInt0" , 1 \| 2)),((int) 0)))
5373	ccoFCall(ccoIdOf("fiBIntMod"),ccoNew(CCO_Many,2,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiBIntMod", 1 \| 2)),ccoNew(CCO_Many,2,gccExpr(foam->foamBCall .argv[0]),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBIntNew" , 1 \| 2)),ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",2), 1 \| 2))))),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBInt0" , 1 \| 2)),((int) 0)))
5374	ccoMany2(gccExpr(foam->foamBCall.argv[0]),ccoNew(CCO_Many,2,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiBIntMod", 1 \| 2)),ccoNew(CCO_Many,2,gccExpr(foam->foamBCall .argv[0]),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBIntNew" , 1 \| 2)),ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",2), 1 \| 2))))),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBInt0" , 1 \| 2)),((int) 0)))
5375	ccoFCall(ccoIdOf("fiBIntNew"),ccoNew(CCO_Many,2,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiBIntMod", 1 \| 2)),ccoNew(CCO_Many,2,gccExpr(foam->foamBCall .argv[0]),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBIntNew" , 1 \| 2)),ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",2), 1 \| 2))))),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBInt0" , 1 \| 2)),((int) 0)))
5376	ccoIntOf(2)))),ccoNew(CCO_Many,2,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiBIntMod", 1 \| 2)),ccoNew(CCO_Many,2,gccExpr(foam->foamBCall .argv[0]),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBIntNew" , 1 \| 2)),ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",2), 1 \| 2))))),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBInt0" , 1 \| 2)),((int) 0)))
5377	ccoFCall(ccoIdOf("fiBInt0"), int0))ccoNew(CCO_Many,2,ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiBIntMod", 1 \| 2)),ccoNew(CCO_Many,2,gccExpr(foam->foamBCall .argv[0]),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBIntNew" , 1 \| 2)),ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",2), 1 \| 2))))),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBInt0" , 1 \| 2)),((int) 0)));
5378	break;
5379	case FOAM_BVal_BIntPrev:
5380	case FOAM_BVal_BIntNext:
5381	ccArgs = ccoMany2(gccExpr(foam->foamBCall.argv[0]),ccoNew(CCO_Many,2,gccExpr(foam->foamBCall.argv[0]),ccoNew( CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBInt1", 1 \| 2)),((int ) 0)))
5382	ccoFCall(ccoIdOf("fiBInt1"), int0))ccoNew(CCO_Many,2,gccExpr(foam->foamBCall.argv[0]),ccoNew( CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiBInt1", 1 \| 2)),((int ) 0)));
5383	break;
5384	default:
5385	bugBadCase(tag)bug("Bad case %d (line %d in file %s).", (int) tag, 5385, "genc.c" );
5386	NotReached(return 0){(void)bug("Not supposed to reach line %d in file: %s\n",5386 , "genc.c");};
5387	}
5388	}
5389	return ccoFCall(ccoIdOf(ccBValStr(tag)), ccArgs)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe(((ccBValInfoTable [(int)(tag)-(int)FOAM_BVAL_START]).str), 1 \| 2)),ccArgs);
5390	}
5391
5392	localstatic CCode
5393	gc0Cop(FoamBValTag tag, Foam foam, CCodeTag ctag)
5394	{
5395	CCode ccArgs;
5396	int argc, i;
5397
5398	if (ccBValSpec(tag)((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).special) == 0) {
5399	argc = foamBValInfo(tag)(foamBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).argCount;
5400	ccArgs = ccoNewNode(ctag, argc);
5401	for (i = 0; i < argc; i++)
5402	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[i] = gccExpr(foam->foamBCall.argv[i]);
5403	}
5404	else {
5405	if (ccBValSpec(tag)((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START]).special) == 1) /* !!! cast words to ptrs */
5406	ccArgs = ccoNew(ctag, 2,
5407	gccExpr(foam->foamBCall.argv[0]),
5408	ccoIdOf(ccBValStr(tag))ccoNew(CCO_Id,1,symProbe(((ccBValInfoTable[(int)(tag)-(int)FOAM_BVAL_START ]).str), 1 \| 2)));
5409	else {
5410	if ((tag == FOAM_BVal_SIntIsEven) \|\|
5411	(tag == FOAM_BVal_SIntIsOdd))
5412	ccArgs = ccoNew(ctag, 2,
5413	ccoMod(gccExpr(foam->foamBCall.argv[0]),ccoNew(CCO_Mod,2,gccExpr(foam->foamBCall.argv[0]),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",2), 1 \| 2)))
5414	ccoIntOf(2))ccoNew(CCO_Mod,2,gccExpr(foam->foamBCall.argv[0]),ccoNew(CCO_IntVal ,1,symProbe(strPrintf("%ldL",2), 1 \| 2))), ccoIntOf(int0)ccoNew(CCO_IntVal,1,symProbe(strPrintf("%ldL",((int) 0)), 1 \| 2)));
5415	else
5416	if ((tag == FOAM_BVal_SIntPlusMod) \|\|
5417	(tag == FOAM_BVal_SIntMinusMod) \|\|
5418	(tag == FOAM_BVal_SIntTimesMod))
5419	ccArgs = gc0SIntMod(foam, ctag);
5420	else
5421	ccArgs = gccUnhandled(foam);
5422	}
5423	}
5424
5425	return ccArgs;
5426	}
5427
5428	localstatic CCode
5429	gc0FunFoamCall(Foam foam, int returnKind)
5430	{
5431	FoamTag type;
5432	AInt oformat = emptyFormatSlot4;
5433	int idx;
5434	CCode call;
5435	GcNesting oldNest = gcvCallNesting;
5436	CCodeList prevUsed = gcvNestUsed;
5437	CCode retval;
5438
5439	switch (foamTag(foam)((foam)->hdr.tag)) {
5440	case FOAM_CCall:
5441	type = foam->foamCCall.type;
5442	gcvCallNesting = GC_CCall;
5443	call = gc0FunCCall0(foam, returnKind);
5444	break;
5445	case FOAM_OCall:
5446	type = foam->foamOCall.type;
5447	idx = foam->foamOCall.op->foamConst.index;
5448	/* !!!FIXME (use proper macros ... ) */
5449	oformat = gcvDefs->foamDDef.argv[idx]->foamDef.rhs->foamProg.format;
5450	if (gcvCallNesting < GC_OCall)
5451	gcvCallNesting = GC_OCall;
5452	call = gc0FunOCall0(foam, returnKind);
5453	break;
5454	case FOAM_PCall:
5455	type = foam->foamPCall.type;
5456	if (gcvCallNesting < GC_OCall)
5457	gcvCallNesting = GC_OCall;
5458	call = gc0FunPCall0(foam, returnKind);
5459	break;
5460	default:
5461	call = NULL((void*)0);
5462	type = FOAM_Word;
5463	bug("Unlikely call for gc0FunFoamCall");
5464	break;
5465	}
5466	gcvCallNesting = oldNest;
5467
5468	if (gcvCallNesting == GC_CCall) {
5469	while (gcvNestUsed != prevUsed) {
5470	gcvNestFree = listCons(CCode)(CCode_listPointer->Cons)(car(gcvNestUsed)((gcvNestUsed)->first),
5471	gcvNestFree);
5472	gcvNestUsed = cdr(gcvNestUsed)((gcvNestUsed)->rest);
5473	}
5474	retval = gc0UnNestCall(gc0TypeId(type, oformat), call);
5475	return retval;
5476	}
5477	else
5478	return call;
5479	}
5480
5481	localstatic CCode
5482	gc0FunCCall0(Foam foam, int returnFmt)
5483	{
5484	CCodeList code = listNil(CCode)((CCodeList) 0);
5485	CCode ccArgs, ccCall, ccId;
5486	FoamTag *argTypes;
5487	Foam cfoam;
5488	int i, argc;
5489
5490	assert(foamTag(foam) == FOAM_CCall)do { if (!(((foam)->hdr.tag) == FOAM_CCall)) _do_assert(("foamTag(foam) == FOAM_CCall" ),"genc.c",5490); } while (0);
5491
5492	argc = foamCCallArgc(foam)(((foam)->hdr.argc) - (2) );
5493	gc0AddLine(code, gc0TypeId(foam->foamCCall.type, emptyFormatSlot))gc0AddLineFun(&(code), gc0TypeId(foam->foamCCall.type, 4));
5494
5495	ccId = gccId(foam->foamCCall.op);
5496
5497	if (gc0ExprType(foam->foamCCall.op) != FOAM_Clos)
5498	gc0AddLine(code, ccoCast(ccoTypeIdOf(gcFiClos),gc0AddLineFun(&(code), ccoNew(CCO_Cast,2,ccoNew(CCO_TypedefId ,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2))),ccId))
5499	ccId))gc0AddLineFun(&(code), ccoNew(CCO_Cast,2,ccoNew(CCO_TypedefId ,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2))),ccId));
5500	else
5501	gc0AddLine(code, ccId)gc0AddLineFun(&(code), ccId);
5502
5503	argTypes = (FoamTag ) stoAlloc(OB_Other0, argc sizeof(FoamTag));
5504	for (i = 0; i < argc; i++) {
5505	cfoam = foam->foamCCall.argv[i];
5506	argTypes[i] = gc0ExprType(cfoam);
5507	gc0AddLine(code, gccExpr(cfoam))gc0AddLineFun(&(code), gccExpr(cfoam));
5508	}
5509	code = listNReverse(CCode)(CCode_listPointer->NReverse)(code);
5510	ccArgs = gc0ListOf(CCO_Many, code);
5511	listFree(CCode)(CCode_listPointer->Free)(code);
5512
5513	ccCall = gc0FiCFun(foam->foamCCall.type, argc, argTypes, ccArgs, returnFmt);
5514
5515	stoFree(argTypes);
5516
5517	return ccCall;
5518	}
5519
5520	localstatic CCode
5521	gc0FunOCall0(Foam foam, int returnKind)
5522	{
5523	CCodeList code = listNil(CCode)((CCodeList) 0);
5524	CCode ccArgs;
5525	Foam decl, pdecls;
5526	int i, idx, argc;
5527
5528	/* Call to function in the same unit */
5529	assert(foamTag(foam) == FOAM_OCall)do { if (!(((foam)->hdr.tag) == FOAM_OCall)) _do_assert(("foamTag(foam) == FOAM_OCall" ),"genc.c",5529); } while (0);
5530	assert(foamTag(foam->foamOCall.op) == FOAM_Const)do { if (!(((foam->foamOCall.op)->hdr.tag) == FOAM_Const )) _do_assert(("foamTag(foam->foamOCall.op) == FOAM_Const" ),"genc.c",5530); } while (0);
5531
5532	argc = foamOCallArgc(foam)(((foam)->hdr.argc) - (3));
5533	/* Which one? !!! FIXME use proper macros for gcvDefs ... */
5534	idx = foam->foamOCall.op->foamConst.index;
5535	assert(foamTag(gcvDefs->foamDDef.argv[idx]->foamDef.rhs) == FOAM_Prog)do { if (!(((gcvDefs->foamDDef.argv[idx]->foamDef.rhs)-> hdr.tag) == FOAM_Prog)) _do_assert(("foamTag(gcvDefs->foamDDef.argv[idx]->foamDef.rhs) == FOAM_Prog" ),"genc.c",5535); } while (0);
5536
5537
5538	/* Extract the parameter declarations for this call !!! FIXME gcvDefs */
5539	pdecls = gcvDefs->foamDDef.argv[idx]->foamDef.rhs->foamProg.params;
5540
5541	/* Generation code for each declaration */
5542	decl = foam->foamOCall.env;
5543	gc0AddLine(code, gccRef(decl))gc0AddLineFun(&(code), gccRef(decl));
5544	for (i = 0; i < argc; i++) {
5545	/* These are what the function expects */
5546	FoamTag expect = pdecls->foamDDecl.argv[i]->foamDecl.type;
5547	Foam farg = foam->foamOCall.argv[i];
5548
5549	gc0AddLine(code, gc0TryCast(expect, farg))gc0AddLineFun(&(code), gc0TryCast(expect, farg));
5550	}
5551
5552	code = listNReverse(CCode)(CCode_listPointer->NReverse)(code);
5553	ccArgs = gc0ListOf(CCO_Many, code);
5554	listFree(CCode)(CCode_listPointer->Free)(code);
5555	return ccoFCall(gccProgId(foam->foamOCall.op), ccArgs)ccoNew(CCO_FCall,2,gccProgId(foam->foamOCall.op),ccArgs);
5556	}
5557
5558	localstatic CCode gc0PCallCArgument(Foam op, int idx, Foam farg);
5559
5560	localstatic CCode
5561	gc0FunPCall0(Foam foam, int returnKind)
5562	{
5563	CCodeList l, code = listNil(CCode)((CCodeList) 0);
5564	CCode ccArgs, ccPCall;
5565	int i, listl, argc;
5566
5567	assert(foamTag(foam) == FOAM_PCall)do { if (!(((foam)->hdr.tag) == FOAM_PCall)) _do_assert(("foamTag(foam) == FOAM_PCall" ),"genc.c",5567); } while (0);
5568	argc = foamPCallArgc(foam)(((foam)->hdr.argc) - (3));
5569
5570	if (foam->foamPCall.protocol == FOAM_Proto_Fortran) {
5571	ccPCall = gccFortranPCall(NULL((void*)0),(int) 0, foam, &code);
5572	if (code) {
5573	/* Calls to Fortran routines that have fn parameters
5574	are always top level stmts */
5575	gc0AddTopLevelStmt(gcvStmts, ccoStat(ccPCall)ccoNew(CCO_Stat,1,ccPCall));
5576	listl = listLength(CCode)(CCode_listPointer->_Length)(code);
5577	l = code;
5578	for (i = 0; i < listl-1; code = cdr(code)((code)->rest), i++)
5579	gc0AddTopLevelStmt(gcvStmts, ccoStat(car(code))ccoNew(CCO_Stat,1,((code)->first)));
5580	ccPCall = car(code)((code)->first);
5581	listFree(CCode)(CCode_listPointer->Free)(l);
5582	}
5583	return ccPCall;
5584	}
5585	else if (foam->foamPCall.protocol == FOAM_Proto_C) {
5586	for (i = 0; i < argc; i++) {
5587	Foam farg = foam->foamPCall.argv[i];
5588	gc0AddLine(code, gc0PCallCArgument(foam->foamPCall.op, i, farg))gc0AddLineFun(&(code), gc0PCallCArgument(foam->foamPCall .op, i, farg));
5589	}
5590	code = listNReverse(CCode)(CCode_listPointer->NReverse)(code);
5591	}
5592	else {
5593	for (i = 0; i < argc; i++) {
5594	Foam farg = foam->foamPCall.argv[i];
5595	gc0AddLine(code, gccExpr(farg))gc0AddLineFun(&(code), gccExpr(farg));
5596	}
5597	code = listNReverse(CCode)(CCode_listPointer->NReverse)(code);
5598	}
5599	ccArgs = gc0ListOf(CCO_Many, code);
5600	listFree(CCode)(CCode_listPointer->Free)(code);
5601	return ccoFCall(gccPCallId(foam), ccArgs)ccoNew(CCO_FCall,2,gccPCallId(foam),ccArgs);
5602	}
5603
5604	localstatic CCode
5605	gc0PCallCArgument(Foam op, int idx, Foam farg)
5606	{
5607	Foam gdecl = gcvGlo->foamDDecl.argv[op->foamGlo.index];
5608	Foam sig, arg;
5609	AInt argTypeIdx;
5610
5611	if (gdecl->foamGDecl.protocol != FOAM_Proto_C) {
5612	return gccExpr(farg);
5613	}
5614	if (gdecl->foamGDecl.format == emptyFormatSlot4) {
5615	return gccExpr(farg);
5616	}
5617	sig = gcvFmt->foamDFmt.argv[gdecl->foamGDecl.format];
5618	argTypeIdx = sig->foamDDecl.argv[idx]->foamDecl.format;
5619	arg = gcvFmt->foamDFmt.argv[argTypeIdx];
5620	if (arg->foamDDecl.usage == FOAM_DDecl_CType) {
5621	String name = arg->foamDDecl.argv[0]->foamDecl.id;
5622	return ccoCast(ccoIdOf(name), gccExpr(farg))ccoNew(CCO_Cast,2,ccoNew(CCO_Id,1,symProbe(name, 1 \| 2)),gccExpr (farg));
5623	}
5624	else {
5625	return gccExpr(farg);
5626	}
5627	}
5628
5629
5630	/* This is a bit of a hack, since it assumes that the declaration
5631	* foo(FiWord, FiWord, etc);
5632	* generates the same calling convention as
5633	* foo();
5634	* Still, keeps code length down...
5635	*/
5636	localstatic Bool
5637	gc0TypeRequiresDecl(FoamTag tag, AInt fmt)
5638	{
5639	switch (tag) {
5640	case FOAM_SInt:
5641	case FOAM_Word:
5642	case FOAM_Ptr:
5643	case FOAM_Arr:
5644	case FOAM_Bool:
5645	case FOAM_NOp:
5646	case FOAM_Clos:
5647	case FOAM_BInt:
5648	case FOAM_Env:
5649	return false((int) 0);
5650	case FOAM_Rec:
5651	case FOAM_RRec:
5652	return false((int) 0);
5653
5654	case FOAM_Byte:
5655	case FOAM_SFlo:
5656	case FOAM_DFlo:
5657	case FOAM_HInt:
5658	case FOAM_Char:
5659	case FOAM_Arb:
5660	return true1;
5661	default:
5662	printf("%s\n", foamStr(tag)((foamInfoTable [(int)(tag)-(int)FOAM_START]).str));
5663	return true1;
5664	}
5665	}
5666
5667	/* This function makes a function call from ccArgs, where
5668	* ccArgs[0] = closure
5669	* ccArgs[1..n] = arguments.
5670	*
5671	* The arg types are given in typev, and the return format
5672	* is in retFmt. This should be reworked to take an
5673	* input and output ddecl, I guess.
5674	*
5675	* The return value references are dumped into the function
5676	* by gen0Set (or thereabouts), so this fn has to create
5677	* something of the form fn(args).
5678	*
5679	* The major complexity is that ANSI requires that if a function
5680	* is declared fully --- ie. not `int foo()', then any calls to foo
5681	* must ensure that the type of foo is known. Hence the creative use
5682	* of casting below.
5683	*
5684	* NB: ccArgc(ccArgs) may be more than argc --- if so, these values
5685	* are copied.
5686	*/
5687	localstatic CCode
5688	gc0FiCFun(FoamTag ret, int argc, FoamTag *typev, CCode ccArgs, int retFmt)
5689	{
5690	int i;
5691	CCode ccNary;
5692	CCode ccFunction;
5693	Foam ddecl = gcvFmt->foamDFmt.argv[retFmt];
5694	int nRets;
5695	Bool useProto = false((int) 0);
5696	CCode retval;
5697
5698	nRets = foamDDeclArgc(ddecl)(((ddecl)->hdr.argc) - (1));
5699
5700	/* First decide how lazy to be */
5701	if (retFmt != emptyFormatSlot4) useProto = true1;
5702	if (gc0TypeRequiresDecl(ret, retFmt)) useProto = true1;
5703
5704	for (i = 0 ; typev && i < argc; i++) {
5705	if (gc0TypeRequiresDecl(typev[i], emptyFormatSlot4)) useProto = true1;
5706	}
5707
5708	for (i = 0 ; i < nRets; i++) {
5709	if (gc0TypeRequiresDecl(ddecl->foamDDecl.argv[i]->foamDecl.type,
5710	ddecl->foamDDecl.argv[i]->foamDecl.format))
5711	useProto = true1;
5712	}
5713
5714	/* Now be lazy */
5715	if (!useProto) {
5716	if (argc <= gcFiNMaxCCall5) {
5717	ccFunction = gcFiCCallN(argc, ccArgs)ccoNew(CCO_FCall,2,gc0VarId("fiCCall", argc),ccArgs);
5718	return ccFunction;
5719	}
5720	else {
5721	ccFunction = ccoFCall(ccoIdOf("fiCFun"),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiCFun", 1 \| 2)) ,ccoNew(CCO_Many,2,((ccArgs)->ccoNode.argv)[0],((ccArgs)-> ccoNode.argv)[1]))
5722	ccoMany2(ccoArgv(ccArgs)[0],ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiCFun", 1 \| 2)) ,ccoNew(CCO_Many,2,((ccArgs)->ccoNode.argv)[0],((ccArgs)-> ccoNode.argv)[1]))
5723	ccoArgv(ccArgs)[1]))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiCFun", 1 \| 2)) ,ccoNew(CCO_Many,2,((ccArgs)->ccoNode.argv)[0],((ccArgs)-> ccoNode.argv)[1]));
5724	}
5725	}
5726	else {
5727	ccNary = ccoNewNode(CCO_Many, argc+ 1 + nRets);
5728	ccoArgv(ccNary)((ccNary)->ccoNode.argv)[0] = ccoParam(NULL, ccoTypeIdOf(gcFiEnv), NULL)ccoNew(CCO_Param,3,((void)0),ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id ,1,symProbe("FiEnv", 1 \| 2))),((void)0));
5729
5730	for (i = 0; i < argc; i++) {
5731	CCode ctype;
5732	/*
5733	* Lie like crazy because we've lost format
5734	* information and can't recover it. We get lucky
5735	* because if we need fmt info, then we have a
5736	* pointer type.
5737	*/
5738	if (gc0TypeRequiresDecl(typev[i], emptyFormatSlot4))
5739	ctype = gc0TypeId(typev[i], emptyFormatSlot4);
5740	else {
5741	ctype = ccoTypeIdOf(gcFiWord)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiWord", 1 \| 2)));
5742	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[i+2] = ccoCast(ccoTypeIdOf(gcFiWord),ccoNew(CCO_Cast,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiWord", 1 \| 2))),((ccArgs)->ccoNode.argv)[i+2])
5743	ccoArgv(ccArgs)[i+2])ccoNew(CCO_Cast,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiWord", 1 \| 2))),((ccArgs)->ccoNode.argv)[i+2]);
5744	}
5745	ccoArgv(ccNary)((ccNary)->ccoNode.argv)[i + 1] = ccoParam(NULL,ctype,NULL)ccoNew(CCO_Param,3,((void)0),ctype,((void)0));
5746	}
5747	for (i = 0; i < nRets ; i++) {
5748	Foam decl = ddecl->foamDDecl.argv[i];
5749
5750	ccoArgv(ccNary)((ccNary)->ccoNode.argv)[argc + i + 1] =
5751	ccoParam(NULL,ccoNew(CCO_Param,3,((void)0),ccoNew(CCO_PostStar,1,gc0TypeId (decl->foamDecl.type, decl->foamDecl.format)),((void)0 ))
5752	ccoPostStar(gc0TypeId(decl->foamDecl.type,ccoNew(CCO_Param,3,((void)0),ccoNew(CCO_PostStar,1,gc0TypeId (decl->foamDecl.type, decl->foamDecl.format)),((void)0 ))
5753	decl->foamDecl.format)),ccoNew(CCO_Param,3,((void)0),ccoNew(CCO_PostStar,1,gc0TypeId (decl->foamDecl.type, decl->foamDecl.format)),((void)0 ))
5754	NULL)ccoNew(CCO_Param,3,((void)0),ccoNew(CCO_PostStar,1,gc0TypeId (decl->foamDecl.type, decl->foamDecl.format)),((void)0 ));
5755	}
5756	ccFunction = ccoCast(ccoType(ccoArgv(ccArgs)[0],ccoNew(CCO_Cast,2,ccoNew(CCO_Type,2,((ccArgs)->ccoNode.argv )[0],ccoNew(CCO_FCall,2,ccoNew(CCO_PreStar,1,((void*)0)),ccNary )),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiRawCProg", 1 \| 2)),((ccArgs)->ccoNode.argv)[1]))
5757	ccoFCall(ccoPreStar(NULL), ccNary)),ccoNew(CCO_Cast,2,ccoNew(CCO_Type,2,((ccArgs)->ccoNode.argv )[0],ccoNew(CCO_FCall,2,ccoNew(CCO_PreStar,1,((void*)0)),ccNary )),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiRawCProg", 1 \| 2)),((ccArgs)->ccoNode.argv)[1]))
5758	ccoFCall(ccoIdOf("fiRawCProg"), ccoArgv(ccArgs)[1]))ccoNew(CCO_Cast,2,ccoNew(CCO_Type,2,((ccArgs)->ccoNode.argv )[0],ccoNew(CCO_FCall,2,ccoNew(CCO_PreStar,1,((void*)0)),ccNary )),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiRawCProg", 1 \| 2)),((ccArgs)->ccoNode.argv)[1]));
5759	}
5760
5761	i = 0;
5762	ccNary = ccoNewNode(CCO_Many, ccoArgc(ccArgs)((ccArgs)->ccoNode.argc) - 2 + 1);
5763	/* Env argument */
5764	ccoArgv(ccNary)((ccNary)->ccoNode.argv)[i++] = ccoPointsTo(ccoParen(ccoCopy(ccoArgv(ccArgs)[1])),ccoNew(CCO_PointsTo,2,ccoNew(CCO_Paren,1,ccoCopy(((ccArgs)-> ccoNode.argv)[1])),ccoNew(CCO_Id,1,symProbe("env", 1 \| 2)))
5765	ccoIdOf("env"))ccoNew(CCO_PointsTo,2,ccoNew(CCO_Paren,1,ccoCopy(((ccArgs)-> ccoNode.argv)[1])),ccoNew(CCO_Id,1,symProbe("env", 1 \| 2)));
5766	/* All the others... */
5767	for ( ; i < ccoArgc(ccNary)((ccNary)->ccoNode.argc); i++)
5768	ccoArgv(ccNary)((ccNary)->ccoNode.argv)[i] = ccoCopy(ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[i+1]);
5769
5770	retval = ccoFCall(ccFunction, ccNary)ccoNew(CCO_FCall,2,ccFunction,ccNary);
5771	return retval;
5772	}
5773
5774	localstatic CCode
5775	gc0UnNestCall(CCode type, CCode call)
5776	{
5777	CCode cc, ccName;
5778
5779	ccName = gc0GetTmp(type);
5780	cc = ccoAsst(ccName, call)ccoNew(CCO_Asst,2,ccName,call);
5781	gc0AddTopLevelStmt(gcvStmts, ccoStat(cc)ccoNew(CCO_Stat,1,cc));
5782	return ccoCopy(ccName);
5783	}
5784
5785	localstatic CCode
5786	gc0GetTmp(CCode type)
5787	{
5788	CCodeList vars, prev = NULL((void*)0);
5789	CCode ccVar = NULL((void*)0), ccName;
5790
5791	for (vars = gcvNestFree; vars ; vars = cdr(vars)((vars)->rest)) {
5792	assert(ccoTag(car(vars)) == CCO_Decl)do { if (!(((((vars)->first))->ccoHdr.tag) == CCO_Decl) ) _do_assert(("ccoTag(car(vars)) == CCO_Decl"),"genc.c",5792) ; } while (0);
5793	if (ccoTypeEqual(type, ccoArgv(car(vars))((((vars)->first))->ccoNode.argv)[0])) {
5794	ccVar = ccoCopy(car(vars)((vars)->first));
5795	if (!prev) gcvNestFree = cdr(gcvNestFree)((gcvNestFree)->rest);
5796	else
5797	setcdr(prev, cdr(vars))((prev)->rest = (((vars)->rest)));
5798	break;
5799	}
5800	prev = vars;
5801	}
5802	if (!ccVar) {
5803	ccVar = ccoDecl(type, gc0MultVarId("T", gcvNLocs, ""))ccoNew(CCO_Decl,2,type,gc0MultVarId("T", gcvNLocs, ""));
5804	gc0AddUnSortedLocal(ccVar);
5805	}
5806
5807	ccName = ccoArgv(ccVar)((ccVar)->ccoNode.argv)[1];
5808	gcvNestUsed = listCons(CCode)(CCode_listPointer->Cons)(ccVar, gcvNestUsed);
5809	return ccoCopy(ccName);
5810	}
5811
5812	localstatic CCode
5813	gc0Protect(Foam foam)
5814	{
5815	CCode res;
5816
5817	res = ccoFCall(ccoIdOf("fiProtect"),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiProtect", 1 \| 2 )),ccoNew(CCO_Many,3,gccRef(foam->foamProtect.val),gccExpr (foam->foamProtect.expr),gccExpr(foam->foamProtect.after )))
5818	ccoMany3(gccRef(foam->foamProtect.val),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiProtect", 1 \| 2 )),ccoNew(CCO_Many,3,gccRef(foam->foamProtect.val),gccExpr (foam->foamProtect.expr),gccExpr(foam->foamProtect.after )))
5819	gccExpr(foam->foamProtect.expr),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiProtect", 1 \| 2 )),ccoNew(CCO_Many,3,gccRef(foam->foamProtect.val),gccExpr (foam->foamProtect.expr),gccExpr(foam->foamProtect.after )))
5820	gccExpr(foam->foamProtect.after)))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiProtect", 1 \| 2 )),ccoNew(CCO_Many,3,gccRef(foam->foamProtect.val),gccExpr (foam->foamProtect.expr),gccExpr(foam->foamProtect.after )));
5821
5822	return res;
5823	}
5824
5825
5826	localstatic CCode
5827	gc0Throw(Foam foam)
5828	{
5829	return ccoFCall(ccoIdOf("fiUnwind"),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiUnwind", 1 \| 2 )),ccoNew(CCO_Many,2,gccExpr(foam->foamThrow.tag),gccExpr( foam->foamThrow.val)))
5830	ccoMany2(gccExpr(foam->foamThrow.tag),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiUnwind", 1 \| 2 )),ccoNew(CCO_Many,2,gccExpr(foam->foamThrow.tag),gccExpr( foam->foamThrow.val)))
5831	gccExpr(foam->foamThrow.val)))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiUnwind", 1 \| 2 )),ccoNew(CCO_Many,2,gccExpr(foam->foamThrow.tag),gccExpr( foam->foamThrow.val)));
5832	}
5833
5834
5835	localstatic CCode
5836	gc0EEnv(CCode env, int level)
5837	{
5838	CCode cc = env;
5839
5840	while (level-- > 0)
5841	cc = gcFiEnvNext(cc)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvNext", 1 \| 2 )),cc);
5842	return cc;
5843	}
5844
5845	/* "cc" == NULL -> No cast wanted. */
5846	localstatic CCode
5847	gc0SubExpr(Foam foam, CCode cc)
5848	{
5849	CCode ccNew, ccExpr;
5850
5851	if (foamTag(foam)((foam)->hdr.tag) == FOAM_Arr \|\| foamTag(foam)((foam)->hdr.tag) == FOAM_ANew)
5852	ccNew = ccoTypeIdOf(gcFiPtr)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiPtr", 1 \| 2 )));
5853	else
5854	ccNew = gc0TypeId(gc0ExprType(foam), emptyFormatSlot4);
5855	if (gc0IsDecl(foam)) {
5856	Foam decl = gc0GetDecl(foam);
5857	int fmt = decl->foamDecl.format;
5858	int typ = decl->foamDecl.type;
5859	if (foamTag(foam)((foam)->hdr.tag) == FOAM_Glo &&
5860	decl->foamGDecl.rtype == FOAM_Nil)
5861	ccNew = ccoTypeIdOf(gcFiPtr)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiPtr", 1 \| 2 )));
5862	if (typ == FOAM_Rec) {
5863	if (fmt && fmt != emptyFormatSlot4)
5864	ccNew = ccoTypedefId(gc0VarId(gcFmtType, fmt))ccoNew(CCO_TypedefId,1,gc0VarId("PFmt", fmt));
5865	}
5866	else if (typ == FOAM_Arr && fmt)
5867	ccNew = ccoTypeIdOf(gcFiPtr)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiPtr", 1 \| 2 )));
5868	}
5869	ccExpr = gccCmd(foam);
5870
5871	if (!cc)
5872	return ccExpr;
5873	if (!ccoTypeEqual(cc, ccNew) && (ccoTag(ccExpr)((ccExpr)->ccoHdr.tag) != CCO_Cast))
5874	return ccoCast(cc, ccExpr)ccoNew(CCO_Cast,2,cc,ccExpr);
5875	else if (!ccoTypeEqual(cc, ccNew) && (ccoTag(ccExpr)((ccExpr)->ccoHdr.tag) == CCO_Cast)) {
5876	ccoArgv(ccExpr)((ccExpr)->ccoNode.argv)[0] = cc;
5877	return ccExpr;
5878	}
5879	else
5880	return ccExpr;
5881	}
5882
5883	localstatic CCode
5884	gc0EEltNext(Foam env, int count)
5885	{
5886	CCode ccRef;
5887
5888	ccRef = gccExpr(env);
5889	while (count > gcFiNMaxEnvLevel5) {
5890	ccRef = gcFiEnvNext(ccRef)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiEnvNext", 1 \| 2 )),ccRef);
5891	count--;
5892	}
5893	return gcFiEnvLevelN(count, ccRef)ccoNew(CCO_FCall,2,gc0VarId("fiEnvLevel", count),ccRef);
5894	}
5895
5896	/*
5897	* Create the symbol for an identifier.
5898	*/
5899
5900	localstatic CCode
5901	gc0IdDecl(Foam foam, FoamTag tag, Foam decl, int lv, int idx)
5902	{
5903	CCode ccDecl, ccName;
5904	int t = decl->foamDecl.type;
5905	String str = decl->foamDecl.id;
5906
5907	assert(strLength(str) < 180)do { if (!(strLength(str) < 180)) _do_assert(("strLength(str) < 180" ),"genc.c",5907); } while (0);
5908
5909	switch (tag) {
5910	case FOAM_Const:
5911	if (gc0OverSMax()(gcvSMax > 0 && gcvNStmts > gcvSMax) && idx) {
5912	Foam fn = gcvConst->foamDDecl.argv[0];
5913	String s = strPrintf("%s_%s", fn->foamDecl.id, str);
5914	ccName = gc0MultVarId("C", idx, s);
5915	strFree(s);
5916	}
5917	else {
5918	ccName = gc0MultVarId("C", idx, str);
5919	}
5920	ccName = gc0MultVarId("C", idx, str);
5921	ccDecl = ccoDecl(gc0TypeId(t, emptyFormatSlot), ccName)ccoNew(CCO_Decl,2,gc0TypeId(t, 4),ccName);
5922	break;
5923	case FOAM_Par:
5924	ccName = gc0MultVarId("P", idx, str);
5925	ccDecl = gc0Decl(decl, ccName);
5926	break;
5927	case FOAM_Loc:
5928	ccName = gc0MultVarId("T", idx, str);
5929	ccDecl = gc0Decl(decl, ccName);
5930	break;
5931	case FOAM_Lex:
5932	case FOAM_EElt:
5933	bug("attempt to declare non-local");
5934	default:
5935	bugBadCase(tag)bug("Bad case %d (line %d in file %s).", (int) tag, 5935, "genc.c" );
5936	NotReached(return 0){(void)bug("Not supposed to reach line %d in file: %s\n",5936 , "genc.c");};
5937	}
5938	return ccDecl;
5939
5940	}
5941
5942	localstatic CCode
5943	gc0GloIdDecl(Foam decl, int idx)
5944	{
5945	CCode ccDecl, ccName, ccType;
5946	int t, p, fmt, dir;
5947	String str, s0;
5948	Bool imported, initialiser;
5949	CCode ccStorageClass, ccExternalName;
5950
5951	t = decl->foamGDecl.type;
5952	str = s0 = decl->foamGDecl.id;
5953	p = decl->foamGDecl.protocol;
5954	fmt = decl->foamGDecl.format;
5955	dir = decl->foamGDecl.dir;
5956
5957	if (p == FOAM_Proto_C && strchr(str, FOREIGN_INCLUDE_SEPARATOR'-'))
5958	return 0;
5959
5960	imported = (dir == FOAM_GDecl_Import);
5961	initialiser = (p == FOAM_Proto_Init);
5962	ccExternalName = NULL((void*)0);
5963
5964	if (imported && idx != -1 &&
5965	(p == FOAM_Proto_Foam \|\| p == FOAM_Proto_Init)) {
5966	ccName = gc0MultVarId("pG", idx, str);
5967	ccExternalName = gc0MultVarId("G", idx, str);
5968	}
5969	else if (p == FOAM_Proto_Foam \|\| p == FOAM_Proto_Init)
5970	ccName = gc0MultVarId("G", idx, str);
5971	else
5972	ccName = ccoIdOf(str)ccoNew(CCO_Id,1,symProbe(str, 1 \| 2));
5973
5974	if (p == FOAM_Proto_Foam \|\| p == FOAM_Proto_Init)
5975	ccType = gc0TypeId(t, fmt);
5976	else if (p == FOAM_Proto_Fortran)
5977	gc0IdFortranDecl(decl, &ccName, &ccType);
5978	else if (t != FOAM_Prog && t != FOAM_Clos)
5979	ccType = gc0TypeId(t, fmt);
5980	else if (imported && (p == FOAM_Proto_C)) {
5981	ccName = gc0IdCDecl(decl, ccName);
5982	ccType = gc0IdCRetDecl(decl);
5983	}
5984	else {
5985	/*
5986	* We need to be able to do better than this, especially
5987	* when exporting functions involving machine types such
5988	* as SInt/HInt. Perhaps when we create this global we
5989	* ought to store the signature somewhere safe so that it
5990	* can be used here?
5991	*/
5992	ccType = gc0TypeId(decl->foamGDecl.rtype, emptyFormatSlot4);
5993	ccName = ccoFCall(ccName, int0)ccoNew(CCO_FCall,2,ccName,((int) 0));
5994	}
5995
5996	if (idx != -1 && (p == FOAM_Proto_Foam \|\| p == FOAM_Proto_Init)) {
5997	if (imported) {
5998	gc0AddLine(gcvImportedGloInitCC,gc0AddLineFun(&(gcvImportedGloInitCC), ccoNew(CCO_Stat,1, ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiImportGlobal", 1 \| 2)),ccoNew(CCO_Many,2,ccoNew(CCO_StringVal,1,ccExternalName ->ccoToken.symbol),ccoCopy(ccName)))))
5999	ccoStat(ccoFCall(ccoIdOf("fiImportGlobal"),gc0AddLineFun(&(gcvImportedGloInitCC), ccoNew(CCO_Stat,1, ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiImportGlobal", 1 \| 2)),ccoNew(CCO_Many,2,ccoNew(CCO_StringVal,1,ccExternalName ->ccoToken.symbol),ccoCopy(ccName)))))
6000	ccoMany2(ccoStringVal(ccExternalName->ccoToken.symbol),gc0AddLineFun(&(gcvImportedGloInitCC), ccoNew(CCO_Stat,1, ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiImportGlobal", 1 \| 2)),ccoNew(CCO_Many,2,ccoNew(CCO_StringVal,1,ccExternalName ->ccoToken.symbol),ccoCopy(ccName)))))
6001	ccoCopy(ccName)))))gc0AddLineFun(&(gcvImportedGloInitCC), ccoNew(CCO_Stat,1, ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiImportGlobal", 1 \| 2)),ccoNew(CCO_Many,2,ccoNew(CCO_StringVal,1,ccExternalName ->ccoToken.symbol),ccoCopy(ccName)))));
6002	ccName = ccoPreStar(ccName)ccoNew(CCO_PreStar,1,ccName);
6003	}
6004	else
6005	gc0AddLine(gcvExportedGloInitCC,gc0AddLineFun(&(gcvExportedGloInitCC), ccoNew(CCO_Stat,1, ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiExportGlobal", 1 \| 2)),ccoNew(CCO_Many,2,ccoNew(CCO_StringVal,1,ccName-> ccoToken.symbol),ccoCopy(ccName)))))
6006	ccoStat(ccoFCall(ccoIdOf("fiExportGlobal"),gc0AddLineFun(&(gcvExportedGloInitCC), ccoNew(CCO_Stat,1, ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiExportGlobal", 1 \| 2)),ccoNew(CCO_Many,2,ccoNew(CCO_StringVal,1,ccName-> ccoToken.symbol),ccoCopy(ccName)))))
6007	ccoMany2(ccoStringVal(ccName->ccoToken.symbol),gc0AddLineFun(&(gcvExportedGloInitCC), ccoNew(CCO_Stat,1, ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiExportGlobal", 1 \| 2)),ccoNew(CCO_Many,2,ccoNew(CCO_StringVal,1,ccName-> ccoToken.symbol),ccoCopy(ccName)))))
6008	ccoCopy(ccName)))))gc0AddLineFun(&(gcvExportedGloInitCC), ccoNew(CCO_Stat,1, ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiExportGlobal", 1 \| 2)),ccoNew(CCO_Many,2,ccoNew(CCO_StringVal,1,ccName-> ccoToken.symbol),ccoCopy(ccName)))));
6009	}
6010
6011	if (initialiser && imported) {
6012	gc0AddLine(gcvInitFunCalls0CC,gc0AddLineFun(&(gcvInitFunCalls0CC), ccoNew(CCO_Stat,1,ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiFileInitializer", 1 \| 2)),ccoNew(CCO_StringVal,1,symProbe(str, 1 \| 2)))))
6013	ccoStat(ccoFCall(ccoIdOf("fiFileInitializer"),gc0AddLineFun(&(gcvInitFunCalls0CC), ccoNew(CCO_Stat,1,ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiFileInitializer", 1 \| 2)),ccoNew(CCO_StringVal,1,symProbe(str, 1 \| 2)))))
6014	ccoStringOf(str))))gc0AddLineFun(&(gcvInitFunCalls0CC), ccoNew(CCO_Stat,1,ccoNew (CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiFileInitializer", 1 \| 2)),ccoNew(CCO_StringVal,1,symProbe(str, 1 \| 2)))));
6015
6016	gc0AddLine(gcvInitFunCalls1CC,gc0AddLineFun(&(gcvInitFunCalls1CC), ccoNew(CCO_Stat,1,ccoNew (CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0), str),((int) 0)) ))
6017	ccoStat(ccoFCall(gc0MultVarId(gcFiInitModulePrefix, int0, str),gc0AddLineFun(&(gcvInitFunCalls1CC), ccoNew(CCO_Stat,1,ccoNew (CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0), str),((int) 0)) ))
6018	int0)))gc0AddLineFun(&(gcvInitFunCalls1CC), ccoNew(CCO_Stat,1,ccoNew (CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0), str),((int) 0)) ));
6019	gc0AddLine(gcvInitFunDeclsCC,gc0AddLineFun(&(gcvInitFunDeclsCC), ccoNew(CCO_Decl,2,ccoNew (CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew(CCO_Id,1,symProbe("int" , 1 \| 2))),ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0) , str),((int) 0))))
6020	ccoDecl(ccoType(ccoExtern(),gc0AddLineFun(&(gcvInitFunDeclsCC), ccoNew(CCO_Decl,2,ccoNew (CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew(CCO_Id,1,symProbe("int" , 1 \| 2))),ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0) , str),((int) 0))))
6021	ccoIdOf("int")),gc0AddLineFun(&(gcvInitFunDeclsCC), ccoNew(CCO_Decl,2,ccoNew (CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew(CCO_Id,1,symProbe("int" , 1 \| 2))),ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0) , str),((int) 0))))
6022	ccoFCall(gc0MultVarId(gcFiInitModulePrefix, int0, str), int0)))gc0AddLineFun(&(gcvInitFunDeclsCC), ccoNew(CCO_Decl,2,ccoNew (CCO_Type,2,ccoNew(CCO_Extern,0),ccoNew(CCO_Id,1,symProbe("int" , 1 \| 2))),ccoNew(CCO_FCall,2,gc0MultVarId("INIT_", ((int) 0) , str),((int) 0))));
6023	}
6024
6025	ccStorageClass = (imported &&
6026	(p == FOAM_Proto_Foam \|\| p == FOAM_Proto_Init) ?
6027	ccoStatic()ccoNew(CCO_Static,0) : ccoExtern()ccoNew(CCO_Extern,0));
6028	ccDecl = ccoDecl(ccoType(ccStorageClass, ccType), ccName)ccoNew(CCO_Decl,2,ccoNew(CCO_Type,2,ccStorageClass,ccType),ccName );
6029	if (s0 != str) strFree(str);
6030
6031	return ccDecl;
6032	}
6033
6034
6035	localstatic CCode
6036	gc0IdCRetDecl(Foam decl)
6037	{
6038	AInt fmt = decl->foamGDecl.format;
6039	Foam fndecl = gcvFmt->foamDFmt.argv[fmt];
6040	int retc = csigRetc(fndecl);
6041
6042	if (retc == 1) {
6043	Foam ret = csigRetN(fndecl, 0);
6044	return gc0TypeId(ret->foamDecl.type, ret->foamDecl.format);
6045	}
6046	else {
6047	return ccoVoid()ccoNew(CCO_Void,0);
6048	}
6049	}
6050
6051	localstatic CCode
6052	gc0IdCDecl(Foam decl, CCode ccName)
6053	{
6054	AInt i, argc, nargs, nrets;
6055	Foam fndecl;
6056	CCode ccArgs;
6057	AInt fmt = decl->foamGDecl.format;
6058
6059	/* Ignore things with no format */
6060	if (fmt == emptyFormatSlot4) return ccoFCall(ccoCopy(ccName), int0)ccoNew(CCO_FCall,2,ccoCopy(ccName),((int) 0));
6061
6062
6063	/* Get the true declaration */
6064	fndecl = gcvFmt->foamDFmt.argv[fmt];
6065	nargs = csigArgc(fndecl);
6066	ccArgs = ccoNewNode(CCO_Many, nargs);
6067
6068	/* Process each argument */
6069	for (i = 0; i < nargs; i++)
6070	{
6071	Foam arg = csigArgN(fndecl, i);
6072	FoamTag type = arg->foamDecl.type;
6073	AInt fmt = arg->foamDecl.format;
6074	String str = arg->foamDecl.id;
6075	CCode ccName = ccoIdOf(str)ccoNew(CCO_Id,1,symProbe(str, 1 \| 2));
6076	CCode ccDecl = gc0TypeId(type, fmt);
6077	ccoArgv(ccArgs)((ccArgs)->ccoNode.argv)[i] = ccoParam(ccName, ccDecl, ccoCopy(ccName))ccoNew(CCO_Param,3,ccName,ccDecl,ccoCopy(ccName));
6078	}
6079
6080	/* Return the full declaration */
6081	return ccoFCall(ccoCopy(ccName), ccArgs)ccoNew(CCO_FCall,2,ccoCopy(ccName),ccArgs);
6082	}
6083
6084	localstatic void
6085	gc0IdFortranDecl(Foam decl, CCode pName, CCode pType)
6086	{
6087	Foam fndecl = gcvFmt->foamDFmt.argv[decl->foamGDecl.format];
6088	Foam fnresultdecl = gc0GetFortranRetFm(fndecl);
6089	FortranType restype = gc0GetFortranType(fnresultdecl);
6090	FoamTag fmtype, rtag;
6091	String cmplxfns, str;
6092	CCode ccType, ccName;
6093
6094	if (restype && (restype != FTN_Machine))
6095	fmtype = gen0FtnMachineType(restype);
6096	else
6097	fmtype = fnresultdecl->foamDecl.type;
6098
6099	/* Char and Character are the same */
6100	if (fmtype == FOAM_Char)
6101	restype = FTN_Character;
6102
6103
6104	str = gc0GenFortranName(decl->foamGDecl.id);
6105	ccName = ccoIdOf(str)ccoNew(CCO_Id,1,symProbe(str, 1 \| 2));
6106
6107	switch (restype) {
6108	case FTN_Boolean:
6109	/* Fall through */
6110	case FTN_SingleInteger:
6111	ccType = ccoTypeIdOf(gcFiSInt)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiSInt", 1 \| 2)));
6112	break;
6113	case FTN_FSingle:
6114	ccType = ccoTypeIdOf(gcFiSFlo)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiSFlo", 1 \| 2)));
6115	break;
6116	case FTN_FDouble:
6117	ccType = ccoTypeIdOf(gcFiDFlo)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiDFlo", 1 \| 2)));
6118	break;
6119	case FTN_Character:
6120	/* Fall through */
6121	case FTN_String:
6122	/* Fall through */
6123	case FTN_XLString:
6124	/* String return values are passed as first argument */
6125	ccType = gc0TypeId(FOAM_NOp, emptyFormatSlot4);
6126	break;
6127	case FTN_FSComplex:
6128	case FTN_FDComplex:
6129	cmplxfns = compCfgLookupString("fortran-cmplx-fns");
6130	ccType = NULL((void*)0);
6131	if (!cmplxfns)
6132	comsgFatal(NULL((void*)0), ALDOR_F_NoFCmplxProperty272, "fortran-cmplx-fns");
6133	else if (strEqual(cmplxfns, "return-void"))
6134	ccType = gc0TypeId(FOAM_NOp, emptyFormatSlot4);
6135	else if (strEqual(cmplxfns, "return-struct"))
6136	ccType = ccoTypeIdOf(restype == FTN_FSComplex ? gcFiComplexSF : gcFiComplexDF)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe(restype == FTN_FSComplex ? "FiComplexSF" : "FiComplexDF", 1 \| 2)));
6137	else if (strEqual(cmplxfns, "disallowed"))
6138	bug("gc0GloIdDecl: Fortran function returning a complex result detected");
6139	else
6140	comsgFatal(NULL((void*)0), ALDOR_F_BadFCmplxValue273, cmplxfns);
6141	break;
6142	default:
6143	/* Fortran passes LOGICAL values as INTEGERs. */
6144	rtag = (fmtype == FOAM_Bool) ? FOAM_SInt : decl->foamGDecl.rtype;
6145	ccType = gc0TypeId(rtag, emptyFormatSlot4);
6146	break;
6147	}
6148	ccName = ccoFCall(ccName, int0)ccoNew(CCO_FCall,2,ccName,((int) 0));
6149
6150	*pName = ccName;
6151	*pType = ccType;
6152	}
6153
6154	localstatic String
6155	gc0StompOffIncludeFile(String str, FoamProtoTag p)
6156	{
6157	int i;
6158	if (p != FOAM_Proto_C) return str;
6159	for (i = 0; str[i]; i++)
6160	if (str[i] == FOREIGN_INCLUDE_SEPARATOR'-') {
6161	str[i] = 0;
6162	break;
6163	}
6164	return str;
6165	}
6166
6167
6168	/* Decide whether the application of two casts has any useful effect */
6169	/*
6170	* Pointers are not the same as words because the gcc compiler will
6171	* generate a warning if you attempt to pass a word in a context where
6172	* a pointer was expected.
6173	*/
6174	localstatic Bool
6175	gc0NeedBothCasts(FoamTag first, FoamTag second)
6176	{
6177	/* (FooType)(FooType)E is the same as (FooType)E */
6178	if (first == second) return false((int) 0);
6179
6180
6181	/* {Word,Ptr,Rec,Arr} and {Word,Ptr,Rec,Arr} are equivelent */
6182	switch (first)
6183	{
6184	case FOAM_Word: /* FALLTHROUGH */
6185	/* See Comment Above case FOAM_Ptr: FALLTHROUGH */
6186	case FOAM_Rec: /* FALLTHROUGH */
6187	case FOAM_Arr: /* FALLTHROUGH */
6188	switch (second)
6189	{
6190	case FOAM_Word: /FALLTHROUGH/
6191	/* See Comment Above case FOAM_Ptr: FALLTHROUGH*/
6192	case FOAM_Rec: /FALLTHROUGH/
6193	case FOAM_Arr: /FALLTHROUGH/
6194	return false((int) 0);
6195
6196	default:
6197	return true1;
6198	}
6199	break;
6200
6201	default:
6202	return true1;
6203	}
6204
6205
6206	/* Assume that we need both of the casts */
6207	return true1;
6208	}
6209
6210
6211	/*
6212	* gc0TryCast(type, foam) behaves exactly like gc0Cast(type, foam)
6213	* unless (foamTag(foam) == FOAM_Cast) && (foam->foamCast.type == type).
6214	* when it simply returns "foam".
6215	*/
6216	localstatic CCode
6217	gc0TryCast(FoamTag type, Foam foam)
6218	{
6219	/* We don't want to generate "(FiFoo)(FiFoo)someExpr" */
6220	if (foamTag(foam)((foam)->hdr.tag) == FOAM_Cast)
6221	{
6222	if (!gc0NeedBothCasts(type, foam->foamCast.type))
6223	return gccExpr(foam);
6224	}
6225	return gc0Cast(type, foam);
6226	}
6227
6228
6229	localstatic CCode
6230	gc0Cast(FoamTag toType, Foam foam)
6231	{
6232	CCode cc;
6233	FoamTag fromType = gc0ExprType(foam);
6234
6235	cc = gccExpr(foam);
6236
6237	if (toType == FOAM_Rec) toType = FOAM_Ptr;
6238
6239	if (fromType != FOAM_DFlo && toType == FOAM_DFlo) {
6240	if (fromType != FOAM_Word)
6241	cc = ccoCast(gc0TypeId(FOAM_Word, emptyFormatSlot), cc)ccoNew(CCO_Cast,2,gc0TypeId(FOAM_Word, 4),cc);
6242	cc = ccoCast(gc0TypeId(toType, emptyFormatSlot),ccoNew(CCO_Cast,2,gc0TypeId(toType, 4),ccoNew(CCO_FCall,2,ccoNew (CCO_Id,1,symProbe("fiUnBoxDFlo", 1 \| 2)),cc))
6243	ccoFCall(ccoIdOf("fiUnBoxDFlo"), cc))ccoNew(CCO_Cast,2,gc0TypeId(toType, 4),ccoNew(CCO_FCall,2,ccoNew (CCO_Id,1,symProbe("fiUnBoxDFlo", 1 \| 2)),cc));
6244	}
6245	else if (toType != FOAM_DFlo && fromType == FOAM_DFlo) {
6246	cc = ccoCast(gc0TypeId(toType, emptyFormatSlot),ccoNew(CCO_Cast,2,gc0TypeId(toType, 4),ccoNew(CCO_FCall,2,ccoNew (CCO_Id,1,symProbe("fiBoxDFlo", 1 \| 2)),cc))
6247	ccoFCall(ccoIdOf("fiBoxDFlo"), cc))ccoNew(CCO_Cast,2,gc0TypeId(toType, 4),ccoNew(CCO_FCall,2,ccoNew (CCO_Id,1,symProbe("fiBoxDFlo", 1 \| 2)),cc));
6248	if (toType != FOAM_Word)
6249	cc = ccoCast(gc0TypeId(toType, emptyFormatSlot), cc)ccoNew(CCO_Cast,2,gc0TypeId(toType, 4),cc);
6250	}
6251	else if (fromType != FOAM_SFlo && toType == FOAM_SFlo) {
6252	if (fromType != FOAM_Word)
6253	cc = ccoCast(gc0TypeId(FOAM_Word, emptyFormatSlot), cc)ccoNew(CCO_Cast,2,gc0TypeId(FOAM_Word, 4),cc);
6254	cc = ccoFCall(ccoIdOf("fiWordToSFlo"), cc)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiWordToSFlo", 1 \| 2)),cc);
6255	}
6256	else if (toType != FOAM_SFlo && fromType == FOAM_SFlo) {
6257	cc = ccoFCall(ccoIdOf("fiSFloToWord"), cc)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiSFloToWord", 1 \| 2)),cc);
6258	if (toType != FOAM_Word)
6259	cc = ccoCast(gc0TypeId(toType, emptyFormatSlot), cc)ccoNew(CCO_Cast,2,gc0TypeId(toType, 4),cc);
6260	}
6261	else {
6262	cc = ccoCast(gc0TypeId(toType, emptyFormatSlot), cc)ccoNew(CCO_Cast,2,gc0TypeId(toType, 4),cc);
6263	}
6264
6265	return cc;
6266	}
6267
6268	localstatic CCode
6269	gc0TypeId(AInt t, AInt fmt)
6270	{
6271	CCode cc;
6272
6273	switch (t) {
6274	case FOAM_NOp:
6275	cc = ccoTypeIdOf("void")ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("void", 1 \| 2 )));
6276	break;
6277	case FOAM_Nil:
6278	cc = ccoTypeIdOf(gcFiPtr)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiPtr", 1 \| 2 )));
6279	break;
6280	case FOAM_Char:
6281	cc = ccoTypeIdOf(gcFiChar)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiChar", 1 \| 2)));
6282	break;
6283	case FOAM_HInt:
6284	cc = ccoTypeIdOf(gcFiHInt)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiHInt", 1 \| 2)));
6285	break;
6286	case FOAM_Bool:
6287	cc = ccoTypeIdOf(gcFiBool)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiBool", 1 \| 2)));
6288	break;
6289	case FOAM_Byte:
6290	cc = ccoTypeIdOf(gcFiByte)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiByte", 1 \| 2)));
6291	break;
6292	case FOAM_SInt:
6293	cc = ccoTypeIdOf(gcFiSInt)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiSInt", 1 \| 2)));
6294	break;
6295	case FOAM_SFlo:
6296	cc = ccoTypeIdOf(gcFiSFlo)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiSFlo", 1 \| 2)));
6297	break;
6298	case FOAM_DFlo:
6299	cc = ccoTypeIdOf(gcFiDFlo)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiDFlo", 1 \| 2)));
6300	break;
6301	case FOAM_BInt:
6302	cc = ccoTypeIdOf(gcFiBInt)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiBInt", 1 \| 2)));
6303	break;
6304	case FOAM_RRec:
6305	cc = ccoTypeIdOf(gcFiRRec)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiRRec", 1 \| 2)));
6306	break;
6307	case FOAM_Rec:
6308	if (fmt == emptyFormatSlot4)
6309	cc = ccoTypeIdOf(gcFiPtr)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiPtr", 1 \| 2 )));
6310	else
6311	cc = ccoTypedefId(gc0VarId(gcFmtType, fmt))ccoNew(CCO_TypedefId,1,gc0VarId("PFmt", fmt));
6312	break;
6313	case FOAM_TR:
6314	if (fmt == emptyFormatSlot4)
6315	cc = ccoTypeIdOf(gcFiWord)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiWord", 1 \| 2)));
6316	else
6317	cc = ccoTypedefId(gc0VarId(gcFmtType, fmt))ccoNew(CCO_TypedefId,1,gc0VarId("PFmt", fmt));
6318	break;
6319	case FOAM_Arr:
6320	if (fmt == emptyFormatSlot4 \|\| fmt == FOAM_Nil)
6321	cc = ccoTypeIdOf(gcFiPtr)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiPtr", 1 \| 2 )));
6322	else
6323	cc = ccoPostStar(gc0TypeId(fmt, emptyFormatSlot))ccoNew(CCO_PostStar,1,gc0TypeId(fmt, 4));
6324	break;
6325	case FOAM_Env:
6326	cc = ccoTypeIdOf(gcFiEnv)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiEnv", 1 \| 2 )));
6327	break;
6328	case FOAM_Prog:
6329	cc = ccoTypeIdOf(gcFiProg)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiProg", 1 \| 2)));
6330	break;
6331	case FOAM_Clos:
6332	cc = ccoTypeIdOf(gcFiClos)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiClos", 1 \| 2)));
6333	break;
6334	case FOAM_Ptr:
6335	cc = ccoTypeIdOf(gcFiPtr)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiPtr", 1 \| 2 )));
6336	break;
6337	case FOAM_PRef:
6338	/* For now */
6339	cc = ccoTypeIdOf(gcFiSInt)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiSInt", 1 \| 2)));
6340	break;
6341	case FOAM_Word:
6342	cc = ccoTypeIdOf(gcFiWord)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiWord", 1 \| 2)));
6343	break;
6344	case FOAM_Arb:
6345	cc = ccoTypeIdOf(gcFiArb)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiArb", 1 \| 2 )));
6346	break;
6347	case FOAM_CObj:
6348	cc = ccoTypedefId(gc0CTypeId(fmt))ccoNew(CCO_TypedefId,1,gc0CTypeId(fmt));
6349	break;
6350	case FOAM_JavaObj:
6351	cc = ccoTypeIdOf(gcFiWord)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiWord", 1 \| 2)));
6352	break;
6353	case FOAM_GenIter:
6354	cc = ccoTypeIdOf(gcFiGenIter)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiGenIter", 1 \| 2)));
6355	break;
6356	case FOAM_Gener:
6357	cc = ccoTypeIdOf(gcFiGener)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiGener", 1 \| 2)));
6358	break;
6359	default:
6360	bugBadCase(t)bug("Bad case %d (line %d in file %s).", (int) t, 6360, "genc.c" );
6361	NotReached(return 0){(void)bug("Not supposed to reach line %d in file: %s\n",6361 , "genc.c");};
6362	}
6363	return cc;
6364	}
6365
6366	localstatic String
6367	gc0CTypeId(AInt fmt)
6368	{
6369	return strPrintf("QQ-%d", fmt);
6370	}
6371
6372
6373	localstatic CCode
6374	gc0SIntMod(Foam foam, CCodeTag ctag)
6375	{
6376	CCode cc, cc0, cc1;
6377
6378	/* Order of the temporaries relies on order of evaluation here. */
6379	cc0 = gccExpr(foam->foamBCall.argv[0]);
6380	cc1 = gccExpr(foam->foamBCall.argv[1]);
6381	cc = ccoNew(ctag, 2, cc0, cc1);
6382
6383	return ccoMod(cc, gccExpr(foam->foamBCall.argv[2]))ccoNew(CCO_Mod,2,cc,gccExpr(foam->foamBCall.argv[2]));
6384	}
6385
6386	static Buffer gcvVarIdBuf = 0;
6387
6388	localstatic CCode
6389	gc0VarId(String str, int id)
6390	{
6391	Buffer buf;
6392
6393	if (!gcvVarIdBuf) gcvVarIdBuf = bufNew();
6394	buf = gcvVarIdBuf;
6395
6396	bufStart(buf);
6397	gc0ValidIdInBuf(buf, str);
6398	bufPuti(buf, id);
6399
6400	return ccoIdOf(bufChars(buf))ccoNew(CCO_Id,1,symProbe(bufChars(buf), 1 \| 2));
6401	}
6402
6403	localstatic CCode
6404	gc0MultVarId(String strA, int id, String strB)
6405	{
6406	Buffer buf;
6407
6408	if (!gcvVarIdBuf) gcvVarIdBuf = bufNew();
6409	buf = gcvVarIdBuf;
6410
6411	bufStart(buf);
6412
6413	if ((strA[0] == 'G' && strA[1] == 0) \|\|
6414	(strA[0] == 'p' && strA[1] == 'G' && strA[2] == 0)) {
6415	bufAddn(buf, strA, strLength(strA));
6416	bufAdd1(buf, '_');
6417	if (gcvIdHash) {
6418	gc0IdHashInBuf(buf, strB);
6419	bufAdd1(buf,'_');
6420	}
6421	gc0ValidIdInBuf(buf, strB);
6422	}
6423	else {
6424	if (isalpha(strA[0])((*__ctype_b_loc ())[(int) ((strA[0]))] & (unsigned short int) _ISalpha) && strA[1] == 0)
6425	bufAdd1(buf, strA[0]);
6426	else {
6427	if (isdigit(strA[0])((*__ctype_b_loc ())[(int) ((strA[0]))] & (unsigned short int) _ISdigit))
6428	bufAdd1(buf, '_');
6429	gc0ValidIdInBuf(buf, strA);
6430	}
6431	bufPuti(buf, id);
6432	if (strcmp(strB, "")) {
6433	bufAdd1(buf, '_');
6434	gc0ValidIdInBuf(buf, strB);
6435	}
6436	}
6437	return ccoIdOf(bufChars(buf))ccoNew(CCO_Id,1,symProbe(bufChars(buf), 1 \| 2));
6438	}
6439
6440	localstatic CCode
6441	gc0FluidRef(Foam foam)
6442	{
6443	int i = foam->foamFluid.index;
6444	Foam decl = gcvFluids->foamDDecl.argv[i];
6445	CCode ref;
6446
6447	if (!listMemq(AInt)(AInt_listPointer->Memq)(gcvFluidList, (AInt)i))
6448	gcvFluidList=listCons(AInt)(AInt_listPointer->Cons)((AInt)i, gcvFluidList);
6449
6450	ref = gcFiFluidValue(gc0MultVarId("F", i, decl->foamDecl.id))ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiFluidValue", 1 \| 2)),gc0MultVarId("F", i, decl->foamDecl.id));
6451	return ccoCast(gc0TypeId(decl->foamDecl.type, emptyFormatSlot), ref)ccoNew(CCO_Cast,2,gc0TypeId(decl->foamDecl.type, 4),ref);
6452	}
6453
6454	localstatic CCode
6455	gc0FluidSet(Foam foamLHS, Foam foamRHS)
6456	{
6457	int i = foamLHS->foamFluid.index;
6458	Foam decl = gcvFluids->foamDDecl.argv[i];
6459	CCode rhs;
6460
6461	if (!listMemq(AInt)(AInt_listPointer->Memq)(gcvFluidList, (AInt)i))
6462	gcvFluidList=listCons(AInt)(AInt_listPointer->Cons)((AInt)i, gcvFluidList);
6463
6464	rhs = gc0SubExpr(foamRHS, ccoTypeIdOf(gcFiWord)ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe("FiWord", 1 \| 2))));
6465	return gcFiSetFluid(gc0MultVarId("F", i, decl->foamDecl.id), rhs)ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe("fiSetFluid", 1 \| 2)),ccoNew(CCO_Many,2,gc0MultVarId("F", i, decl->foamDecl .id),rhs));
6466	}
6467
6468	localstatic CCode
6469	gc0PushFluid()
6470	{
6471	return ccoDecl(ccoTypeIdOf(gcFiFluidStack),ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiFluidStack", 1 \| 2))),ccoNew(CCO_Asst,2,ccoNew(CCO_Id,1,symProbe ("localStack", 1 \| 2)),ccoNew(CCO_Id,1,symProbe("fiGlobalFluidStack" , 1 \| 2))))
6472	ccoAsst(ccoIdOf(gcFiFluidStackLVar),ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiFluidStack", 1 \| 2))),ccoNew(CCO_Asst,2,ccoNew(CCO_Id,1,symProbe ("localStack", 1 \| 2)),ccoNew(CCO_Id,1,symProbe("fiGlobalFluidStack" , 1 \| 2))))
6473	ccoIdOf(gcFiFluidStackGVar)))ccoNew(CCO_Decl,2,ccoNew(CCO_TypedefId,1,ccoNew(CCO_Id,1,symProbe ("FiFluidStack", 1 \| 2))),ccoNew(CCO_Asst,2,ccoNew(CCO_Id,1,symProbe ("localStack", 1 \| 2)),ccoNew(CCO_Id,1,symProbe("fiGlobalFluidStack" , 1 \| 2))));
6474	}
6475
6476	localstatic CCode
6477	gc0PopFluid()
6478	{
6479	return ccoStat(ccoAsst(ccoIdOf(gcFiFluidStackGVar),ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccoNew(CCO_Id,1,symProbe( "fiGlobalFluidStack", 1 \| 2)),ccoNew(CCO_Id,1,symProbe("localStack" , 1 \| 2))))
6480	ccoIdOf(gcFiFluidStackLVar)))ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,ccoNew(CCO_Id,1,symProbe( "fiGlobalFluidStack", 1 \| 2)),ccoNew(CCO_Id,1,symProbe("localStack" , 1 \| 2))));
6481
6482	}
6483
6484	localstatic CCode
6485	gc0GetFluid(AInt i)
6486	{
6487	Foam decl = gcvFluids->foamDDecl.argv[i];
6488
6489	return ccoStat(ccoAsst(gc0MultVarId("F", i, decl->foamDecl.id),ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,gc0MultVarId("F", i, decl ->foamDecl.id),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiGetFluid", 1 \| 2)),ccoNew(CCO_StringVal,1,symProbe(decl-> foamDecl.id, 1 \| 2)))))
6490	gcFiGetFluid(ccoStringOf(decl->foamDecl.id))))ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,gc0MultVarId("F", i, decl ->foamDecl.id),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiGetFluid", 1 \| 2)),ccoNew(CCO_StringVal,1,symProbe(decl-> foamDecl.id, 1 \| 2)))));
6491	}
6492
6493	localstatic CCode
6494	gc0AddFluid(AInt i)
6495	{
6496	Foam decl = gcvFluids->foamDDecl.argv[i];
6497
6498	return ccoStat(ccoAsst(gc0MultVarId("F", i, decl->foamDecl.id),ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,gc0MultVarId("F", i, decl ->foamDecl.id),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiAddFluid", 1 \| 2)),ccoNew(CCO_StringVal,1,symProbe(decl-> foamDecl.id, 1 \| 2)))))
6499	gcFiAddFluid(ccoStringOf(decl->foamDecl.id))))ccoNew(CCO_Stat,1,ccoNew(CCO_Asst,2,gc0MultVarId("F", i, decl ->foamDecl.id),ccoNew(CCO_FCall,2,ccoNew(CCO_Id,1,symProbe ("fiAddFluid", 1 \| 2)),ccoNew(CCO_StringVal,1,symProbe(decl-> foamDecl.id, 1 \| 2)))));
6500	}
6501
6502	/*****************************************************************************
6503	*
6504	* :: Miscellaneous utility functions.
6505	*
6506	****************************************************************************/
6507
6508	localstatic void
6509	gc0AddLineFun(CCodeList *pccl, CCode cco)
6510	{
6511	if (!cco) return;
6512
6513	pccl = listCons(CCode)(CCode_listPointer->Cons)(cco, pccl);
6514	}
6515
6516	/*
6517	* Given a piece of Foam code, return its Foam type.
6518	*/
6519
6520	localstatic FoamTag
6521	gc0ExprType(Foam foam)
6522	{
6523	if (foamTag(foam)((foam)->hdr.tag) == FOAM_Fluid)
6524	return FOAM_Word;
6525
6526	return foamExprType(foam, gcvProg, gcvFmt, NULL((void)0), NULL((void)0), NULL((void*)0));
6527	}
6528
6529	localstatic int
6530	gc0IsDecl(Foam foam)
6531	{
6532	int isDecl = 0;
6533
6534	switch (foamTag(foam)((foam)->hdr.tag)) {
6535	case FOAM_Glo:
6536	case FOAM_Const:
6537	case FOAM_Par:
6538	case FOAM_Loc:
6539	case FOAM_Lex:
6540	case FOAM_EElt:
6541	case FOAM_RElt:
6542	case FOAM_RRElt:
6543	case FOAM_IRElt:
6544	case FOAM_TRElt:
6545	case FOAM_Fluid:
6546	isDecl = 1;
6547	break;
6548	default:
6549	isDecl = 0;
6550	break;
6551	}
6552	return isDecl;
6553	}
6554
6555
6556	localstatic CCode
6557	gc0Decl(Foam decl, CCode name)
6558	{
6559	CCode ccType, ccDecl;
6560	int fmt = decl->foamDecl.format;
6561	switch (decl->foamDecl.type) {
6562	case FOAM_Rec:
6563	/* This should never happen, but it does (see bug1142),
6564	* so handle it here. The correct way to fix it is to
6565	* put format information into OCall statements, so the
6566	* foamExprType can predict the type properly.
6567	*/
6568	/assert(fmt && fmt != emptyFormatSlot);/
6569	if (!fmt \|\| fmt == emptyFormatSlot4) {
6570	ccType = gc0TypeId(FOAM_Ptr, emptyFormatSlot4);
6571	ccDecl = ccoDecl(ccType, name)ccoNew(CCO_Decl,2,ccType,name);
6572	}
6573	else {
6574	ccType = ccoTypedefId(gc0VarId(gcFmtType, fmt))ccoNew(CCO_TypedefId,1,gc0VarId("PFmt", fmt));
6575	ccDecl = ccoDecl(ccType, name)ccoNew(CCO_Decl,2,ccType,name);
6576	}
6577	break;
6578	case FOAM_Arr:
6579	ccType = gc0TypeId(fmt, emptyFormatSlot4);
6580	ccDecl = ccoDecl(ccType, ccoPreStar(name))ccoNew(CCO_Decl,2,ccType,ccoNew(CCO_PreStar,1,name));
6581	break;
6582	case FOAM_TR:
6583	ccType = ccoTypedefId(gc0VarId(gcFmtType, fmt))ccoNew(CCO_TypedefId,1,gc0VarId("PFmt", fmt));
6584	ccDecl = ccoDecl(ccType, name)ccoNew(CCO_Decl,2,ccType,name);
6585	break;
6586	default:
6587	ccType = gc0TypeId(decl->foamDecl.type, emptyFormatSlot4);
6588	ccDecl = ccoDecl(ccType, name)ccoNew(CCO_Decl,2,ccType,name);
6589	break;
6590	}
6591	return ccDecl;
6592	}
6593
6594	/*
6595	* Get the declaration object for a global, constant, parameter,
6596	* local, lexical, or environment.
6597	*/
6598
6599	localstatic Foam
6600	gc0GetDecl(Foam foam)
6601	{
6602	int ix;
6603	Foam decl;
6604
6605	switch (foamTag(foam)((foam)->hdr.tag)) {
6606	case FOAM_Glo:
6607	ix = foam->foamGlo.index;
6608	decl = gcvGlo->foamDDecl.argv[ix];
6609	break;
6610	case FOAM_Const:
6611	ix = foam->foamConst.index;
6612	decl = gcvConst->foamDDecl.argv[ix];
6613	break;
6614	case FOAM_Par:
6615	ix = foam->foamPar.index;
6616	decl = gcvPar->foamDDecl.argv[ix];
6617	break;
6618	case FOAM_Loc:
6619	ix = foam->foamLoc.index;
6620	decl = gcvLoc->foamDDecl.argv[ix];
6621	break;
6622	case FOAM_Fluid:
6623	ix = foam->foamFluid.index;
6624	decl = gcvFluids->foamDDecl.argv[ix];
6625	break;
6626	case FOAM_Lex: {
6627	int ind;
6628	Foam ddecl;
6629	ind = gcvLFmtStk->foamDEnv.argv[foam->foamLex.level];
6630	ddecl = gcvFmt->foamDFmt.argv[ind];
6631	assert(foamTag(ddecl) == FOAM_DDecl)do { if (!(((ddecl)->hdr.tag) == FOAM_DDecl)) _do_assert(( "foamTag(ddecl) == FOAM_DDecl"),"genc.c",6631); } while (0);
6632	ix = foam->foamLex.index;
6633	assert(ix < foamDDeclArgc(ddecl))do { if (!(ix < (((ddecl)->hdr.argc) - (1)))) _do_assert (("ix < foamDDeclArgc(ddecl)"),"genc.c",6633); } while (0);
6634	decl = ddecl->foamDDecl.argv[ix];
6635	break;
6636	}
6637	case FOAM_EElt: {
6638	Foam ddecl;
6639	ddecl = gcvFmt->foamDFmt.argv[foam->foamEElt.env];
6640	assert(foamTag(ddecl) == FOAM_DDecl)do { if (!(((ddecl)->hdr.tag) == FOAM_DDecl)) _do_assert(( "foamTag(ddecl) == FOAM_DDecl"),"genc.c",6640); } while (0);
6641	ix = foam->foamEElt.lex;
6642	decl = ddecl->foamDDecl.argv[ix];
6643	break;
6644	}
6645	case FOAM_RRElt: {
6646	decl = foamNewDecl(FOAM_Word, "_rawdata", FOAM_Word)foamNew(FOAM_Decl,4,(AInt)(FOAM_Word),"_rawdata", (AInt) (0x7FFF ), FOAM_Word);
6647	break;
6648	}
6649	case FOAM_RElt: {
6650	Foam ddecl;
6651	ddecl = gcvFmt->foamDFmt.argv[foam->foamRElt.format];
6652	assert(foamTag(ddecl) == FOAM_DDecl)do { if (!(((ddecl)->hdr.tag) == FOAM_DDecl)) _do_assert(( "foamTag(ddecl) == FOAM_DDecl"),"genc.c",6652); } while (0);
6653	ix = foam->foamRElt.field;
6654	decl = ddecl->foamDDecl.argv[ix];
6655	break;
6656	}
6657	case FOAM_IRElt: {
6658	Foam ddecl;
6659	ddecl = gcvFmt->foamDFmt.argv[foam->foamIRElt.format];
6660	assert(foamTag(ddecl) == FOAM_DDecl)do { if (!(((ddecl)->hdr.tag) == FOAM_DDecl)) _do_assert(( "foamTag(ddecl) == FOAM_DDecl"),"genc.c",6660); } while (0);
6661	ix = foam->foamIRElt.field;
6662	decl = foamTRDDeclIDecl(ddecl, ix)((ddecl)->foamDDecl.argv[1+(ix)]);
6663	break;
6664	}
6665	case FOAM_TRElt: {
6666	Foam ddecl;
6667	ddecl = gcvFmt->foamDFmt.argv[foam->foamTRElt.format];
6668	assert(foamTag(ddecl) == FOAM_DDecl)do { if (!(((ddecl)->hdr.tag) == FOAM_DDecl)) _do_assert(( "foamTag(ddecl) == FOAM_DDecl"),"genc.c",6668); } while (0);
6669	ix = foam->foamTRElt.field;
6670	decl = foamTRDDeclTDecl(ddecl, ix)((ddecl)->foamDDecl.argv [1+ ((ddecl)->foamDDecl.argv[0 ]->foamDecl.format) + (ix)]);
6671	break;
6672	}
6673	default:
6674	bugBadCase(foamTag(foam))bug("Bad case %d (line %d in file %s).", (int) ((foam)->hdr .tag), 6674, "genc.c");
6675	NotReached(return 0){(void)bug("Not supposed to reach line %d in file: %s\n",6675 , "genc.c");};
6676	}
6677	assert(foamTag(decl) == FOAM_Decl \|\| foamTag(decl) == FOAM_GDecl)do { if (!(((decl)->hdr.tag) == FOAM_Decl \|\| ((decl)->hdr .tag) == FOAM_GDecl)) _do_assert(("foamTag(decl) == FOAM_Decl \|\| foamTag(decl) == FOAM_GDecl" ),"genc.c",6677); } while (0);
6678	return decl;
6679	}
6680
6681	localstatic int
6682	gc0ValidIdInBuf(Buffer buf, String s)
6683	{
6684	int pos0;
6685	pos0 = bufPosition(buf);
6686	for ( ; s && gc0UnderIdLen(buf, (int)s)(gcvIdLen == 0 \|\| bufPosition(buf) + gcvIdCharc[(int)*s] <= gcvIdLen); s++) {
6687	int k = gcvIdChars[(int)*s];
6688	if (k == NOT_CHANGED(-2))
6689	bufAdd1(buf, *s);
6690	else if (k != NOT_PRINTABLE(-3))
6691	bufPuts(buf, ccIdStr(k)((ccSpecCharIdTable[k]).str));
6692	}
6693	bufAdd1(buf, char0((char) 0));
6694	bufBack1(buf);
6695	return bufPosition(buf) - pos0;
6696	}
6697
6698	#define VAR_HASH_MAX5 5
6699	#define VAR_HASH0x39AA3F9 0x39AA3F9 /* prevPrime(36*VAR_HASH_MAX) /
6700
6701	localstatic int
6702	gc0IdHashInBuf(Buffer buf, String s)
6703	{
6704	Hash hashNum;
6705	int ndig, alphnum[4 * bitsizeof(hashNum)(8 * sizeof(hashNum))];
6706	int pos0;
6707
6708	pos0 = bufPosition(buf);
6709	hashNum = strHash(s) % VAR_HASH0x39AA3F9;
6710	for (ndig = 0; hashNum; hashNum /= 36, ndig++)
6711	alphnum[ndig] = hashNum % 36;
6712
6713	while (ndig--) {
6714	char c;
6715
6716	if (alphnum[ndig] < 10)
6717	c = '0' + alphnum[ndig];
6718	else
6719	c = 'A' + (alphnum[ndig] - 10);
6720	bufAdd1(buf, c);
6721	}
6722	bufAdd1(buf, char0((char) 0));
6723	bufBack1(buf);
6724	return bufPosition(buf) - pos0;
6725	}
6726
6727	localstatic void
6728	gc0InitSpecialChars(void)
6729	{
6730	int i;
6731
6732	for (i = 0; i < CHAR_MAX127; i++) {
6733	if (isalnum(i)((*__ctype_b_loc ())[(int) ((i))] & (unsigned short int) _ISalnum )) {
6734	gcvIdChars[i] = NOT_CHANGED(-2);
6735	gcvIdCharc[i] = 1;
6736	}
6737	else {
6738	gcvIdChars[i] = NOT_PRINTABLE(-3);
6739	gcvIdCharc[i] = 0;
6740	}
6741	}
6742	for (i = 0; ccIdChar(i)((ccSpecCharIdTable[i]).ch) != 0; i++) {
6743	gcvIdChars[ccIdChar(i)((ccSpecCharIdTable[i]).ch)] = i;
6744	gcvIdCharc[ccIdChar(i)((ccSpecCharIdTable[i]).ch)] = strLength(ccIdStr(i)((ccSpecCharIdTable[i]).str));
6745	}
6746	return;
6747	}
6748
6749	localstatic void
6750	gc0CreateLocList(Foam foam)
6751	{
6752	int i;
6753
6754	for (i = 0; i < foamDDeclArgc(foam)(((foam)->hdr.argc) - (1)); i++) {
6755	gc0AddUnSortedLocal(gc0LocRef(foam, i));
6756	}
6757	return;
6758	}
6759
6760	localstatic void
6761	gc0AddUnSortedLocal(CCode ref)
6762	{
6763	struct Clocals *lst;
6764
6765	lst = gcvLocals;
6766	gcvLocals = (struct Clocals *)stoAlloc(OB_Other0,
6767	sizeof(*gcvLocals));
6768	gcvLocals->index = gcvNLocs++;
6769	gcvLocals->loc = ref;
6770	gcvLocals->next = lst;
6771	}
6772
6773
6774	localstatic void
6775	gc0NewLocsInit()
6776	{
6777	gcvNewLocs = (Ldecls) stoAlloc((int) OB_Other0,
6778	sizeof(*gcvNewLocs));
6779	gcvNewLocs->list = (struct CList *) stoAlloc((int) OB_Other0,
6780	sizeof(struct CList));
6781	gcvNewLocs->pos = 0;
6782	gcvNewLocs->list[gcvNewLocs->pos].type =
6783	(CCode) stoAlloc((int) OB_CCode11,
6784	fullsizeof(struct ccoNode, 1, CCode)(sizeof(struct ccoNode) + (1) * sizeof(CCode) - 10 * sizeof(CCode )));
6785	gcvNewLocs->list[gcvNewLocs->pos].lsize = 0;
6786	gcvNewLocs->list[gcvNewLocs->pos].locs = 0;
6787	gcvNewLocs->argc = 0;
6788	return;
6789	}
6790
6791	/*
6792	* The 'Cstmts' type is really just a total waste, but
6793	* then so is the rest of this file.
6794	*/
6795	localstatic void
6796	gc0NewStmtInit()
6797	{
6798	gcvStmts = (Cstmts) stoAlloc((int) OB_Other0, sizeof(*gcvStmts));
6799
6800	gcvStmts->stmt = (CCode *) stoAlloc((int) OB_Other0,
6801	sizeof(CCode) * gcvNStmts);
6802	gcvStmts->argc = gcvNStmts;
6803	gcvStmts->pos = 0;
6804	return;
6805	}
6806
6807	localstatic void
6808	gc0AddTopLevelStmt(Cstmts stmts, CCode stmt)
6809	{
6810	if (stmts->pos >= stmts->argc) {
6811	int newsz = stmts->argc+20;
6812	stmts->stmt = (CCode*)stoResize(stmts->stmt,
6813	sizeof(CCode) * newsz);
6814	stmts->argc = newsz;
6815	}
6816	stmts->stmt[stmts->pos++] = stmt;
6817	}
6818
6819	localstatic void
6820	gc0AddDecl(CCode cc, int indx)
6821	{
6822	int i, args, done;
6823
6824	args = gcvNewLocs->argc;
6825	if (!args) {
6826	gcvNewLocs->list[gcvNewLocs->pos].type = ccoArgv(cc)((cc)->ccoNode.argv)[0];
6827	gc0AddLocal(ccoArgv(cc)((cc)->ccoNode.argv)[1], gcvNewLocs->pos, indx);
6828	gcvNewLocs->argc++;
6829	gcvNewLocs->pos++;
6830	} else {
6831	done = 0;
6832	for (i = 0; i < args && !done; i++) {
6833	if (ccoTypeEqual(gcvNewLocs->list[i].type,
6834	ccoArgv(cc)((cc)->ccoNode.argv)[0])) {
6835	gc0AddLocal(ccoArgv(cc)((cc)->ccoNode.argv)[1], i, indx);
6836	done = 1;
6837	}
6838	}
6839	if (!done) {
6840	gcvNewLocs->argc++;
6841	gcvNewLocs->list = (struct CList ) stoResize(gcvNewLocs->list, sizeof(struct CList)(gcvNewLocs->argc));
6842	gcvNewLocs->list[gcvNewLocs->pos].type =
6843	(CCode) stoAlloc((int) OB_CCode11,
6844	fullsizeof(struct ccoNode, 1,(sizeof(struct ccoNode) + (1) * sizeof(CCode) - 10 * sizeof(CCode ))
6845	CCode)(sizeof(struct ccoNode) + (1) * sizeof(CCode) - 10 * sizeof(CCode )));
6846	gcvNewLocs->list[gcvNewLocs->pos].type = ccoArgv(cc)((cc)->ccoNode.argv)[0];
6847	gcvNewLocs->list[gcvNewLocs->pos].lsize = 0;
6848	gcvNewLocs->list[gcvNewLocs->pos].locs = 0;
6849	gc0AddLocal(ccoArgv(cc)((cc)->ccoNode.argv)[1], gcvNewLocs->pos, indx);
6850	gcvNewLocs->pos++;
6851	}
6852	}
6853	return;
6854	}
6855
6856	localstatic void
6857	gc0AddLocal(CCode cc, int indx, int loc)
6858	{
6859	struct Clocals *nlocs;
6860
6861	nlocs = gcvNewLocs->list[indx].locs;
6862	gcvNewLocs->list[indx].locs = (struct Clocals *)
6863	stoAlloc((int) OB_Other0, sizeof(*gcvNewLocs->list[indx].locs));
6864	gcvNewLocs->list[indx].lsize++;
6865	gcvNewLocs->list[indx].locs->index = loc;
6866	gcvNewLocs->list[indx].locs->loc = cc;
6867	gcvNewLocs->list[indx].locs->next = nlocs;
6868	return;
6869	}
6870
6871	localstatic void
6872	gc0NewLocals(CCode cc)
6873	{
6874	int i, n, size = 0;
6875	struct Clocals *nlocs;
6876	CCode ccNew;
6877
6878	for (i = 0; i < gcvNewLocs->argc; i++) {
6879	ccNew = ccoNewNode(CCO_Many, gcvNewLocs->list[i].lsize);
6880	size += gcvNewLocs->list[i].lsize;
6881	for (n = 0; n < gcvNewLocs->list[i].lsize; n++) {
6882	nlocs = gcvNewLocs->list[i].locs->next;
6883	ccoArgv(cc)((cc)->ccoNode.argv)[gcvNewLocs->list[i].locs->index] = 0;
6884	ccoArgv(ccNew)((ccNew)->ccoNode.argv)[n] = gcvNewLocs->list[i].locs->loc;
6885	stoFree((Pointer) gcvNewLocs->list[i].locs);
6886	gcvNewLocs->list[i].locs = nlocs;
6887	}
6888	ccoArgv(cc)((cc)->ccoNode.argv)[i] = ccoDecl(ccoCopy(gcvNewLocs->list[i].type),ccoNew(CCO_Decl,2,ccoCopy(gcvNewLocs->list[i].type),ccNew)
6889	ccNew)ccoNew(CCO_Decl,2,ccoCopy(gcvNewLocs->list[i].type),ccNew);
6890	stoFree((Pointer) gcvNewLocs->list[i].type);
6891	}
6892	stoFree((Pointer) (gcvNewLocs->list));
6893	stoFree((Pointer) (gcvNewLocs));
6894	return;
6895	}
6896
6897	localstatic int
6898	gc0MaxLevel(int numLexs)
6899	{
6900	int i, level, maxLevel = -1;
6901
6902	for (i = 1; i < numLexs; i++) {
6903	level = gcvLFmtStk->foamDEnv.argv[i];
6904	if (!gc0EmptyEnv(level)((level == 4) \|\| ((((gcvFmt->foamDFmt.argv[level])->hdr .argc) - (1)) == 0)) \|\| level == envUsedSlot0) maxLevel = i;
6905	}
6906	return maxLevel;
6907	}
6908
6909	localstatic CCode
6910	gc0ModuleInitFun(String modName, int n)
6911	{
6912	return gc0MultVarId(gcFiInitModulePrefix"INIT_", n, modName);
6913	}
6914
6915	void
6916	ccodeListPrintDb(CCodeList cl)
6917	{
6918	for (; cl; cl = cdr(cl)((cl)->rest))
6919	ccoPrintDb(car(cl)((cl)->first));
6920	}
6921
6922	localstatic Bool
6923	gc0IsModifiableFortranArg(Foam decl)
6924	{
6925	if (strncmp(decl->foamDecl.id, MODIFIABLEARG"[Modifiable]",
6926	strlen(MODIFIABLEARG"[Modifiable]")) == 0)
6927	return true1;
6928	else
6929	return false((int) 0);
6930	}
6931
6932	localstatic String
6933	gc0GetFortranArgName(Foam decl)
6934	{
6935	String sep, s;
6936
6937	/* Export/fn parameter arguments don't have MODIFIABLEARGs */
6938	if (decl->foamDecl.type == FOAM_Word) {
6939	if ((sep = strchr(decl->foamDecl.id,':'))) {
6940	*sep = '\0';
6941	s = strCopy(decl->foamDecl.id);
6942	*sep = ':';
6943	}
6944	else
6945	s = strCopy("");
6946	}
6947	else
6948	s = strCopy(decl->foamDecl.id);
6949	return s;
6950	}
6951
6952	localstatic FortranType
6953	gc0GetFortranType(Foam decl)
6954	{
6955	String s, s2;
6956	FortranType ftype;
6957
6958	if (decl->foamDecl.type == FOAM_Clos)
6959	return FTN_FnParam;
6960	else if (decl->foamDecl.type != FOAM_Word)
6961	return FTN_Machine;
6962	else {
6963	if (strncmp(decl->foamDecl.id, MODIFIABLEARG"[Modifiable]",
6964	strlen(MODIFIABLEARG"[Modifiable]")) == 0)
6965	s = decl->foamDecl.id + strlen(MODIFIABLEARG"[Modifiable]");
6966	else
6967	s = decl->foamDecl.id;
6968	s2 = strchr(s,':');
6969	if (s2) s = s2 + 1;
6970
6971	/* Check the category attribute */
6972	ftype = ftnTypeFrString(s);
6973
6974
6975	/* Did we recognise it? */
6976	if (ftype)
6977	return ftype;
6978	else
6979	return FTN_Word;
6980	}
6981	}
6982
6983	localstatic int
6984	gc0GetNumModFortranArgs(Foam argddecl)
6985	{
6986	Length i, argc = foamArgc(argddecl)((argddecl)->hdr.argc)-1;
6987	Foam *argv = argddecl->foamDDecl.argv;
6988	int numvarargs = 0;
6989
6990	/* argc-1 to avoid the function result decl */
6991	for (i = 0; i < argc-1; i++) {
6992	if (gc0IsModifiableFortranArg(argv[i]))
6993	numvarargs++;
6994	}
6995	return numvarargs;
6996	}
6997
6998	localstatic Foam
6999	gc0GetFortranRetFm(Foam argddecl)
7000	{
7001	return argddecl->foamDDecl.argv[(foamArgc(argddecl)((argddecl)->hdr.argc)-1)-1];
7002	}
7003
7004	localstatic FortranType
7005	gc0GetFortranRetType(Foam argddecl)
7006	{
7007	Foam fnresultdecl = gc0GetFortranRetFm(argddecl);
7008	return gc0GetFortranType(fnresultdecl);
7009	}
7010
7011	localstatic String
7012	gc0GenFortranName(String str)
7013	{
7014	String naming = compCfgLookupString("fortran-name-scheme");
7015
7016	if (!naming)
7017	comsgFatal(NULL((void*)0), ALDOR_F_NoFNameProperty270, "fortran-name-scheme");
7018	if (strEqual(naming, "underscore"))
7019	return strConcat(str, "_");
7020	else if (strEqual(naming, "no-underscore"))
7021	return strCopy(str);
7022	else if (strEqual(naming, "underscore-bug")) {
7023	if (strchr(str, '_'))
7024	return strConcat(str, "__");
7025	else
7026	return strConcat(str, "_");
7027	}
7028	else
7029	comsgFatal(NULL((void*)0), ALDOR_F_BadFNameValue271, naming);
7030
7031	return NULL((void*)0);
7032	}
7033
7034	/*
7035	* This function appends a redundant FOAM return instruction
7036	* after every fiHalt call. This is to get around a bug in
7037	* the MSVC++ 6.0 compiler which enters an infinite loop when
7038	* it tries to optimise a C function containing non-obvious
7039	* exits (e.g. calls to fiHalt or even exit).
7040	*/
7041	localstatic Foam
7042	gc0AddExplicitReturn(Foam foam)
7043	{
7044	FoamBValTag tag;
7045	Foam retval;
7046	FoamList newcode = listNil(Foam)((FoamList) 0);
7047	int nhalts = 0;
7048
7049
7050	/* Must be a sequence ... */
7051	assert(foamTag(foam) == FOAM_Seq)do { if (!(((foam)->hdr.tag) == FOAM_Seq)) _do_assert(("foamTag(foam) == FOAM_Seq" ),"genc.c",7051); } while (0);
7052
7053
7054	/* Must be in a gc0Prog */
7055	assert(gcvProg)do { if (!(gcvProg)) _do_assert(("gcvProg"),"genc.c",7055); } while (0);
7056
7057
7058	/* Count the number of halt instructions */
7059	foamIter(foam, pstmt,{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { if (((pstmt)->hdr.tag) != FOAM_BCall) continue ; tag = (foamBValInfoTable[(int)((*pstmt)->foamBCall.op)-( int)FOAM_BVAL_START]).tag; if (tag == FOAM_BVal_Halt) nhalts++ ; }; }; } } }; }
7060	{{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { if (((pstmt)->hdr.tag) != FOAM_BCall) continue ; tag = (foamBValInfoTable[(int)((*pstmt)->foamBCall.op)-( int)FOAM_BVAL_START]).tag; if (tag == FOAM_BVal_Halt) nhalts++ ; }; }; } } }; }
7061	/* Must be a BCall /{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { if (((pstmt)->hdr.tag) != FOAM_BCall) continue ; tag = (foamBValInfoTable[(int)((pstmt)->foamBCall.op)-( int)FOAM_BVAL_START]).tag; if (tag == FOAM_BVal_Halt) nhalts++ ; }; }; } } }; }
7062	if (foamTag(pstmt) != FOAM_BCall) continue;{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { if (((pstmt)->hdr.tag) != FOAM_BCall) continue ; tag = (foamBValInfoTable[(int)((pstmt)->foamBCall.op)-( int)FOAM_BVAL_START]).tag; if (tag == FOAM_BVal_Halt) nhalts++ ; }; }; } } }; }
7063
7064
7065	/* Get the tag of the call /{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { if (((pstmt)->hdr.tag) != FOAM_BCall) continue ; tag = (foamBValInfoTable[(int)((pstmt)->foamBCall.op)-( int)FOAM_BVAL_START]).tag; if (tag == FOAM_BVal_Halt) nhalts++ ; }; }; } } }; }
7066	tag = foamBValInfo((pstmt)->foamBCall.op).tag;{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { if (((pstmt)->hdr.tag) != FOAM_BCall) continue ; tag = (foamBValInfoTable[(int)((pstmt)->foamBCall.op)-( int)FOAM_BVAL_START]).tag; if (tag == FOAM_BVal_Halt) nhalts++ ; }; }; } } }; }
7067
7068
7069	/* Must be FOAM_BVal_Halt /{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { if (((pstmt)->hdr.tag) != FOAM_BCall) continue ; tag = (foamBValInfoTable[(int)((pstmt)->foamBCall.op)-( int)FOAM_BVAL_START]).tag; if (tag == FOAM_BVal_Halt) nhalts++ ; }; }; } } }; }
7070	if (tag == FOAM_BVal_Halt) nhalts++;{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { if (((pstmt)->hdr.tag) != FOAM_BCall) continue ; tag = (foamBValInfoTable[(int)((*pstmt)->foamBCall.op)-( int)FOAM_BVAL_START]).tag; if (tag == FOAM_BVal_Halt) nhalts++ ; }; }; } } }; }
7071	}){ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { if (((pstmt)->hdr.tag) != FOAM_BCall) continue ; tag = (foamBValInfoTable[(int)((*pstmt)->foamBCall.op)-( int)FOAM_BVAL_START]).tag; if (tag == FOAM_BVal_Halt) nhalts++ ; }; }; } } }; };
7072
7073
7074	/* If no halts, return unchanged */
7075	if (!nhalts) return foam;
7076
7077
7078	/* Compute a suitable return value */
7079	switch (gcvProg->foamProg.retType)
7080	{
7081	case FOAM_NOp:
7082	/* No return value or multiple return values */
7083	retval = foamNew(FOAM_Values, int0((int) 0));
7084	break;
7085	case FOAM_Bool:
7086	/* Return false */
7087	retval = foamNew(FOAM_BCall, 1, FOAM_BVal_BoolFalse);
7088	break;
7089	case FOAM_Char:
7090	/* Return space */
7091	retval = foamNew(FOAM_BCall, 1, FOAM_BVal_CharSpace);
7092	break;
7093	case FOAM_SFlo:
7094	/* Return 0.0 */
7095	retval = foamNew(FOAM_BCall, 1, FOAM_BVal_SFlo0);
7096	break;
7097	case FOAM_DFlo:
7098	/* Return 0.0 */
7099	retval = foamNew(FOAM_BCall, 1, FOAM_BVal_DFlo0);
7100	break;
7101	default:
7102	/* Return (0 pretend retType) */
7103	retval = foamNewCast(gcvProg->foamProg.retType,foamNew(FOAM_Cast, 2, gcvProg->foamProg.retType, foamNew(FOAM_BCall , 1, FOAM_BVal_SInt0))
7104	foamNew(FOAM_BCall, 1, FOAM_BVal_SInt0))foamNew(FOAM_Cast, 2, gcvProg->foamProg.retType, foamNew(FOAM_BCall , 1, FOAM_BVal_SInt0));
7105	break;
7106	}
7107
7108
7109	/* Convert the sequence into a statement list */
7110	foamIter(foam, pstmt,{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; }
7111	{{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; }
7112	Foam ret;{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; }
7113
7114
7115	/* Always add the statement to the list /{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((*pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; }
7116	newcode = listCons(Foam)(foamCopy(pstmt), newcode);{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((*pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; }
7117
7118
7119	/* Must be a BCall /{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((*pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; }
7120	if (foamTag(pstmt) != FOAM_BCall) continue;{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((*pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; }
7121
7122
7123	/* Get the tag of the call /{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((*pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; }
7124	tag = foamBValInfo((pstmt)->foamBCall.op).tag;{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((*pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; }
7125
7126
7127	/* Must be FOAM_BVal_Halt /{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((*pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; }
7128	if (tag != FOAM_BVal_Halt) continue;{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; }
7129
7130
7131	/* Create a new statement return /{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((*pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; }
7132	ret = foamNewReturn(foamCopy(retval));{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; }
7133
7134
7135	/* Add the explicit return /{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((*pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; }
7136	newcode = listCons(Foam)(ret, newcode);{ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; }
7137	}){ { String argf = (foamInfoTable [(int)(((foam)->hdr.tag)) -(int)FOAM_START]).argf; Length _i; for (_i = 0; _i < ((foam )->hdr.argc); _i++, argf++) { if (argf == '') argf--; if (argf == 'C') { Foam pstmt = (Foam ) ((foam)->foamGen. argv)+_i; { { Foam ret; newcode = (Foam_listPointer->Cons) (foamCopy(pstmt), newcode); if (((pstmt)->hdr.tag) != FOAM_BCall ) continue; tag = (foamBValInfoTable[(int)((pstmt)->foamBCall .op)-(int)FOAM_BVAL_START]).tag; if (tag != FOAM_BVal_Halt) continue ; ret = foamNew(FOAM_Return, 1, foamCopy(retval)); newcode = ( Foam_listPointer->Cons)(ret, newcode); }; }; } } }; };
7138
7139
7140	/* Reverse the instruction list */
7141	newcode = listNReverse(Foam)(Foam_listPointer->NReverse)(newcode);
7142
7143
7144	/* Return the modified code */
7145	return foamNewOfList(FOAM_Seq, newcode);
7146	}
7147
7148
7149	/***********************************************************************
7150	*
7151	* :: Table of builtin FOAM to C operations
7152	*
7153	***********************************************************************/
7154
7155	localstatic void
7156	gc0CheckBVals(void)
7157	{
7158	int i;
7159	for (i = FOAM_BVAL_START; i < FOAM_BVAL_LIMIT; i++)
7160	if (ccBValInfo(i)(ccBValInfoTable[(int)(i)-(int)FOAM_BVAL_START]).tag != i)
7161	bug("ccBValInfo is badly initialized at %s = %d.",
7162	ccBValStr(i)((ccBValInfoTable[(int)(i)-(int)FOAM_BVAL_START]).str), i);
7163	}
7164
7165	struct ccBVal_info ccBValInfoTable[] = {
7166	{FOAM_BVal_BoolFalse, CCO_IntVal, 1,"0", 0},
7167	{FOAM_BVal_BoolTrue, CCO_IntVal, 1,"1", 0},
7168	{FOAM_BVal_BoolNot, CCO_LNot, 0,0, 0},
7169	{FOAM_BVal_BoolAnd, CCO_And, 0,0, 0},
7170	{FOAM_BVal_BoolOr, CCO_Or, 0,0, 0},
7171	{FOAM_BVal_BoolEQ, CCO_EQ, 0,0, 0},
7172	{FOAM_BVal_BoolNE, CCO_NE, 0,0, 0},
7173
7174	{FOAM_BVal_CharSpace, CCO_CharVal, 1,"' '", 0},
7175	{FOAM_BVal_CharNewline, CCO_CharVal, 1,"'\\n'", 0},
7176	{FOAM_BVal_CharTab, CCO_CharVal, 1,"'\\t'", 0},
7177	{FOAM_BVal_CharMin, CCO_FCall, 0,"fiCharMin", "fiCHAR_MIN"},
7178	{FOAM_BVal_CharMax, CCO_FCall, 0,"fiCharMax", "fiCHAR_MAX"},
7179	{FOAM_BVal_CharIsDigit, CCO_FCall, 0,"fiCharIsDigit", "fiCHAR_IS_DIGIT"},
7180	{FOAM_BVal_CharIsLetter, CCO_FCall, 0,"fiCharIsLetter", "fiCHAR_IS_LETTER"},
7181	{FOAM_BVal_CharEQ, CCO_EQ, 0,0, 0},
7182	{FOAM_BVal_CharNE, CCO_NE, 0,0, 0},
7183	{FOAM_BVal_CharLT, CCO_LT, 0,0, 0},
7184	{FOAM_BVal_CharLE, CCO_LE, 0,0, 0},
7185	{FOAM_BVal_CharLower, CCO_FCall, 0,"fiCharLower", "fiCHAR_LOWER"},
7186	{FOAM_BVal_CharUpper, CCO_FCall, 0,"fiCharUpper", "fiCHAR_UPPER"},
7187	{FOAM_BVal_CharOrd, CCO_Cast, 0,gcFiSInt"FiSInt", 0},
7188	{FOAM_BVal_CharNum, CCO_Cast, 0,"char", 0},
7189
7190	{FOAM_BVal_SFlo0, CCO_FloatVal,1,"0.0", 0},
7191	{FOAM_BVal_SFlo1, CCO_FloatVal,1,"1.0", 0},
7192	{FOAM_BVal_SFloMin, CCO_FCall, 0,"fiSFloMin", "fiSFLO_MIN"},
7193	{FOAM_BVal_SFloMax, CCO_FCall, 0,"fiSFloMax", "fiSFLO_MAX"},
7194	{FOAM_BVal_SFloEpsilon, CCO_FCall, 0,"fiSFloEpsilon", "fiSFLO_EPSILON"},
7195	{FOAM_BVal_SFloIsZero, CCO_EQ, 1,"0.0", 0},
7196	{FOAM_BVal_SFloIsNeg, CCO_LT, 1,"0.0", 0},
7197	{FOAM_BVal_SFloIsPos, CCO_GT, 1,"0.0", 0},
7198	{FOAM_BVal_SFloEQ, CCO_EQ, 0,0, 0},
7199	{FOAM_BVal_SFloNE, CCO_NE, 0,0, 0},
7200	{FOAM_BVal_SFloLT, CCO_LT, 0,0, 0},
7201	{FOAM_BVal_SFloLE, CCO_LE, 0,0, 0},
7202	{FOAM_BVal_SFloNegate, CCO_PreMinus,0,0, 0},
7203	{FOAM_BVal_SFloPrev, CCO_FCall, 0,"fiSFloPrev", "fiSFLO_PREV"},
7204	{FOAM_BVal_SFloNext, CCO_FCall, 0,"fiSFloNext", "fiSFLO_NEXT"},
7205	{FOAM_BVal_SFloPlus, CCO_Plus, 0,0, 0},
7206	{FOAM_BVal_SFloMinus, CCO_Minus, 0,0, 0},
7207	{FOAM_BVal_SFloTimes, CCO_Star, 0,0, 0},
7208	{FOAM_BVal_SFloTimesPlus, CCO_FCall, 0,"fiSFloTimesPlus","fiSFLO_TIMES_PLUS"},
7209	{FOAM_BVal_SFloDivide, CCO_Div, 0,0, 0},
7210	{FOAM_BVal_SFloRPlus, CCO_FCall, 0,"fiSFloRPlus", "fiSFLO_R_PLUS"},
7211	{FOAM_BVal_SFloRMinus, CCO_FCall, 0,"fiSFloRMinus", "fiSFLO_R_MINUS"},
7212	{FOAM_BVal_SFloRTimes, CCO_FCall, 0,"fiSFloRTimes", "fiSFLO_R_TIMES"},
7213	{FOAM_BVal_SFloRTimesPlus,CCO_FCall, 0,"fiSFloRTimesPlus","fiSFLO_R_TIMES_PLUS"},
7214	{FOAM_BVal_SFloRDivide, CCO_FCall, 0,"fiSFloRDivide", "fiSFLO_R_DIVIDE"},
7215	{FOAM_BVal_SFloDissemble, CCO_FCall, 0,"fiSFloDissemble", 0},
7216	{FOAM_BVal_SFloAssemble, CCO_FCall, 0,"fiSFloAssemble", 0},
7217
7218	{FOAM_BVal_DFlo0, CCO_FloatVal,1,"0.0", 0},
7219	{FOAM_BVal_DFlo1, CCO_FloatVal,1,"1.0", 0},
7220	{FOAM_BVal_DFloMin, CCO_FCall, 0,"fiDFloMin", "fiDFLO_MIN"},
7221	{FOAM_BVal_DFloMax, CCO_FCall, 0,"fiDFloMax", "fiDFLO_MAX"},
7222	{FOAM_BVal_DFloEpsilon, CCO_FCall, 0,"fiDFloEpsilon", "fiDFLO_EPSILON"},
7223	{FOAM_BVal_DFloIsZero, CCO_EQ, 1,"0.0", 0},
7224	{FOAM_BVal_DFloIsNeg, CCO_LT, 1,"0.0", 0},
7225	{FOAM_BVal_DFloIsPos, CCO_GT, 1,"0.0", 0},
7226	{FOAM_BVal_DFloEQ, CCO_EQ, 0,0, 0},
7227	{FOAM_BVal_DFloNE, CCO_NE, 0,0, 0},
7228	{FOAM_BVal_DFloLT, CCO_LT, 0,0, 0},
7229	{FOAM_BVal_DFloLE, CCO_LE, 0,0, 0},
7230	{FOAM_BVal_DFloNegate, CCO_PreMinus,0,0, 0},
7231	{FOAM_BVal_DFloPrev, CCO_FCall, 0,"fiDFloPrev", "fiDFLO_PREV"},
7232	{FOAM_BVal_DFloNext, CCO_FCall, 0,"fiDFloNext", "fiDFLO_NEXT"},
7233	{FOAM_BVal_DFloPlus, CCO_Plus, 0,0, 0},
7234	{FOAM_BVal_DFloMinus, CCO_Minus, 0,0, 0},
7235	{FOAM_BVal_DFloTimes, CCO_Star, 0,0, 0},
7236	{FOAM_BVal_DFloTimesPlus, CCO_FCall, 0,"fiDFloTimesPlus","fiDFLO_TIMES_PLUS"},
7237	{FOAM_BVal_DFloDivide, CCO_Div, 0,0, 0},
7238	{FOAM_BVal_DFloRPlus, CCO_Plus, 0,"fiSFloRPlus", "fiDFLO_R_PLUS"},
7239	{FOAM_BVal_DFloRMinus, CCO_FCall, 0,"fiSFloRMinus", "fiDFLO_R_MINUS"},
7240	{FOAM_BVal_DFloRTimes, CCO_FCall, 0,"fiSFloRTimes", "fiDFLO_R_TIMES"},
7241	{FOAM_BVal_DFloRTimesPlus,CCO_FCall, 0,"fiDFloRTimesPlus","fiDFLO_R_TIMES_PLUS"},
7242	{FOAM_BVal_DFloRDivide, CCO_FCall, 0,"fiSFloRDivide", "fiDFLO_R_DIVIDE"},
7243	{FOAM_BVal_DFloDissemble, CCO_FCall, 0,"fiDFloDissemble", 0},
7244	{FOAM_BVal_DFloAssemble, CCO_FCall, 0,"fiDFloAssemble", 0},
7245
7246	{FOAM_BVal_Byte0, CCO_IntVal, 1,"0", 0},
7247	{FOAM_BVal_Byte1, CCO_IntVal, 1,"1", 0},
7248	{FOAM_BVal_ByteMin, CCO_Id, 1,"0", 0},
7249	{FOAM_BVal_ByteMax, CCO_FCall, 0,"fiByteMax", "fiBYTE_MAX"},
7250
7251	{FOAM_BVal_HInt0, CCO_IntVal, 1,"0", 0},
7252	{FOAM_BVal_HInt1, CCO_IntVal, 1,"1", 0},
7253	{FOAM_BVal_HIntMin, CCO_FCall, 0,"fiHIntMin", "fiHINT_MIN"},
7254	{FOAM_BVal_HIntMax, CCO_FCall, 0,"fiHIntMax", "fiHINT_MAX"},
7255
7256	{FOAM_BVal_SInt0, CCO_IntVal, 1,"0L", 0},
7257	{FOAM_BVal_SInt1, CCO_IntVal, 1,"1L", 0},
7258	{FOAM_BVal_SIntMin, CCO_FCall, 0,"fiSIntMin", "fiSINT_MIN"},
7259	{FOAM_BVal_SIntMax, CCO_FCall, 0,"fiSIntMax", "fiSINT_MAX"},
7260	{FOAM_BVal_SIntIsZero, CCO_EQ, 1,"0", 0},
7261	{FOAM_BVal_SIntIsNeg, CCO_LT, 1,"0", 0},
7262	{FOAM_BVal_SIntIsPos, CCO_GT, 1,"0", 0},
7263	{FOAM_BVal_SIntIsEven, CCO_EQ, 2,0, 0},
7264	{FOAM_BVal_SIntIsOdd, CCO_NE, 2,0, 0},
7265	{FOAM_BVal_SIntEQ, CCO_EQ, 0,0, 0},
7266	{FOAM_BVal_SIntNE, CCO_NE, 0,0, 0},
7267	{FOAM_BVal_SIntLT, CCO_LT, 0,0, 0},
7268	{FOAM_BVal_SIntLE, CCO_LE, 0,0, 0},
7269	{FOAM_BVal_SIntNegate, CCO_PreMinus,0,0, 0},
7270	{FOAM_BVal_SIntPrev, CCO_Minus, 1,"1L", 0},
7271	{FOAM_BVal_SIntNext, CCO_Plus, 1,"1L", 0},
7272	{FOAM_BVal_SIntPlus, CCO_Plus, 0,0, 0},
7273	{FOAM_BVal_SIntMinus, CCO_Minus, 0,0, 0},
7274	{FOAM_BVal_SIntTimes, CCO_Star, 0,0, 0},
7275	{FOAM_BVal_SIntTimesPlus,CCO_FCall, 0,"fiSIntTimesPlus","fiSINT_TIMES_PLUS"},
7276	{FOAM_BVal_SIntMod, CCO_Mod, 0,0, 0},
7277	{FOAM_BVal_SIntQuo, CCO_FCall, 0,"fiSIntQuo", "fiSINT_QUO"},
7278	{FOAM_BVal_SIntRem, CCO_FCall, 0,"fiSIntRem", "fiSINT_REM"},
7279	{FOAM_BVal_SIntDivide, CCO_FCall, 0,"fiSIntDivide", 0},
7280	{FOAM_BVal_SIntGcd, CCO_FCall, 0,"fiSIntGcd", "fiSINT_GCD"},
7281	{FOAM_BVal_SIntPlusMod, CCO_Plus, 2,0, 0},
7282	{FOAM_BVal_SIntMinusMod, CCO_Minus, 2,0, 0},
7283	{FOAM_BVal_SIntTimesMod, CCO_FCall, 0,"fiSIntTimesMod", "fiSINT_TIMES_MOD"},
7284	{FOAM_BVal_SIntTimesModInv,CCO_FCall, 0,"fiSIntTimesModInv","fiSINT_TIMES_MOD_INV"},
7285	{FOAM_BVal_SIntLength, CCO_FCall, 0,"fiSIntLength", "fiSINT_LENGTH"},
7286	{FOAM_BVal_SIntShiftUp, CCO_USh, 0,0, 0},
7287	{FOAM_BVal_SIntShiftDn, CCO_DSh, 0,0, 0},
7288	{FOAM_BVal_SIntBit, CCO_FCall, 0,"fiSIntBit", "fiSINT_BIT"},
7289	{FOAM_BVal_SIntNot, CCO_Not, 0,0, 0},
7290	{FOAM_BVal_SIntAnd, CCO_And, 0,0, 0},
7291	{FOAM_BVal_SIntOr, CCO_Or, 0,0, 0},
7292	{FOAM_BVal_SIntXOr, CCO_Xor, 0,0, 0},
7293	{FOAM_BVal_SIntHashCombine, CCO_FCall,0,"fiSIntHashCombine", "fiSINT_HASHCOMBINE"},
7294
7295	{FOAM_BVal_WordTimesDouble, CCO_FCall,0,"fiWordTimesDouble", 0},
7296	{FOAM_BVal_WordDivideDouble,CCO_FCall,0,"fiWordDivideDouble", 0},
7297	{FOAM_BVal_WordPlusStep, CCO_FCall,0,"fiWordPlusStep", 0},
7298	{FOAM_BVal_WordTimesStep, CCO_FCall,0,"fiWordTimesStep", 0},
7299
7300	{FOAM_BVal_BInt0, CCO_FCall, 0,"fiBInt0", "fiBINT_0"},
7301	{FOAM_BVal_BInt1, CCO_FCall, 0,"fiBInt1", "fiBINT_1"},
7302	{FOAM_BVal_BIntIsZero, CCO_FCall, 0,"fiBIntIsZero", "fiBINT_IS_ZERO"},
7303	{FOAM_BVal_BIntIsNeg, CCO_FCall, 0,"fiBIntIsNeg", "fiBINT_IS_NEG"},
7304	{FOAM_BVal_BIntIsPos, CCO_FCall, 0,"fiBIntIsPos", "fiBINT_IS_POS"},
7305	{FOAM_BVal_BIntIsEven, CCO_FCall, 1,"fiBIntEQ", "fiBINT_IS_EVEN"},
7306	{FOAM_BVal_BIntIsOdd, CCO_FCall, 1,"fiBIntNE", "fiBINT_IS_ODD"},
7307	{FOAM_BVal_BIntIsSingle, CCO_FCall, 0,"fiBIntIsSingle", "fiBINT_IS_SINGLE"},
7308	{FOAM_BVal_BIntEQ, CCO_FCall, 0,"fiBIntEQ", "fiBINT_EQ"},
7309	{FOAM_BVal_BIntNE, CCO_FCall, 0,"fiBIntNE", "fiBINT_NE"},
7310	{FOAM_BVal_BIntLT, CCO_FCall, 0,"fiBIntLT", "fiBINT_LT"},
7311	{FOAM_BVal_BIntLE, CCO_FCall, 0,"fiBIntLE", "fiBINT_LE"},
7312	{FOAM_BVal_BIntNegate, CCO_FCall, 0,"fiBIntNegate", "fiBINT_NEGATE"},
7313	{FOAM_BVal_BIntPrev, CCO_FCall, 1,"fiBIntMinus", "fiBINT_MINUS1"},
7314	{FOAM_BVal_BIntNext, CCO_FCall, 1,"fiBIntPlus", "fiBINT_PLUS1"},
7315	{FOAM_BVal_BIntPlus, CCO_FCall, 0,"fiBIntPlus", "fiBINT_PLUS"},
7316	{FOAM_BVal_BIntMinus, CCO_FCall, 0,"fiBIntMinus", "fiBINT_MINUS"},
7317	{FOAM_BVal_BIntTimes, CCO_FCall, 0,"fiBIntTimes", "fiBINT_TIMES"},
7318	{FOAM_BVal_BIntTimesPlus,CCO_FCall, 0,"fiBIntTimesPlus","fiBINT_TIMES_PLUS"},
7319	{FOAM_BVal_BIntMod, CCO_FCall, 0,"fiBIntMod", "fiBINT_MOD"},
7320	{FOAM_BVal_BIntQuo, CCO_FCall, 0,"fiBIntQuo", "fiBINT_QUO"},
7321	{FOAM_BVal_BIntRem, CCO_FCall, 0,"fiBIntRem", "fiBINT_REM"},
7322	{FOAM_BVal_BIntDivide, CCO_FCall, 0,"fiBIntDivide", 0},
7323	{FOAM_BVal_BIntGcd, CCO_FCall, 0,"fiBIntGcd", "fiBINT_GCD"},
7324	{FOAM_BVal_BIntSIPower, CCO_FCall, 0,"fiBIntSIPower", "fiBINT_SI_POWER"},
7325	{FOAM_BVal_BIntBIPower, CCO_FCall, 0,"fiBIntBIPower", "fiBINT_BI_POWER"},
7326	{FOAM_BVal_BIntPowerMod, CCO_FCall, 0,"fiBIntPowerMod", "fiBINT_POWER_MOD"},
7327	{FOAM_BVal_BIntLength, CCO_FCall, 0,"fiBIntLength", "fiBINT_LENGTH"},
7328	{FOAM_BVal_BIntShiftUp, CCO_FCall, 0,"fiBIntShiftUp", "fiBINT_SHIFT_UP"},
7329	{FOAM_BVal_BIntShiftDn, CCO_FCall, 0,"fiBIntShiftDn", "fiBINT_SHIFT_DN"},
7330	{FOAM_BVal_BIntShiftRem, CCO_FCall, 0,"fiBIntShiftRem", 0},
7331	{FOAM_BVal_BIntBit, CCO_FCall, 0,"fiBIntBit", "fiBINT_BIT"},
7332
7333	{FOAM_BVal_PtrNil, CCO_Id, 1,"fiPtrNil", 0},
7334	{FOAM_BVal_PtrIsNil, CCO_FCall, 0,"fiPtrIsNil", "fiPTR_IS_NIL"},
7335	{FOAM_BVal_PtrMagicEQ, CCO_FCall, 0,"fiPtrMagicEQ", "fiPTR_MAGIC_EQ"},
7336	{FOAM_BVal_PtrEQ, CCO_EQ, 0,0, 0},
7337	{FOAM_BVal_PtrNE, CCO_NE, 0,0, 0},
7338
7339	{FOAM_BVal_FormatSFlo, CCO_FCall, 0,"fiFormatSFlo", "fiFORMAT_SFLO"},
7340	{FOAM_BVal_FormatDFlo, CCO_FCall, 0,"fiFormatDFlo", "fiFORMAT_DFLO"},
7341	{FOAM_BVal_FormatSInt, CCO_FCall, 0,"fiFormatSInt", "fiFORMAT_SINT"},
7342	{FOAM_BVal_FormatBInt, CCO_FCall, 0,"fiFormatBInt", "fiFORMAT_BINT"},
7343
7344	{FOAM_BVal_ScanSFlo, CCO_FCall, 0,"fiScanSFlo", 0},
7345	{FOAM_BVal_ScanDFlo, CCO_FCall, 0,"fiScanDFlo", 0},
7346	{FOAM_BVal_ScanSInt, CCO_FCall, 0,"fiScanSInt", 0},
7347	{FOAM_BVal_ScanBInt, CCO_FCall, 0,"fiScanBInt", 0},
7348
7349	{FOAM_BVal_SFloToDFlo, CCO_FCall, 0,"fiSFloToDFlo", "fiSFLO_TO_DFLO"},
7350	{FOAM_BVal_DFloToSFlo, CCO_FCall, 0,"fiDFloToSFlo", "fiDFLO_TO_SFLO"},
7351	{FOAM_BVal_ByteToSInt, CCO_FCall, 0,"fiByteToSInt", "fiBYTE_TO_SINT"},
7352	{FOAM_BVal_SIntToByte, CCO_FCall, 0,"fiSIntToByte", "fiSINT_TO_BYTE"},
7353	{FOAM_BVal_HIntToSInt, CCO_FCall, 0,"fiHIntToSInt", "fiHINT_TO_SINT"},
7354	{FOAM_BVal_SIntToHInt, CCO_FCall, 0,"fiSIntToHInt", "fiSINT_TO_HINT"},
7355	{FOAM_BVal_SIntToBInt, CCO_FCall, 0,"fiSIntToBInt", "fiSINT_TO_BINT"},
7356	{FOAM_BVal_BIntToSInt, CCO_FCall, 0,"fiBIntToSInt", "fiBINT_TO_SINT"},
7357	{FOAM_BVal_SIntToSFlo, CCO_Cast, 0,gcFiSFlo"FiSFlo", "fiSINT_TO_SFLO"},
7358	{FOAM_BVal_SIntToDFlo, CCO_Cast, 0,gcFiDFlo"FiDFlo", "fiSINT_TO_DFLO"},
7359	{FOAM_BVal_BIntToSFlo, CCO_FCall, 0,"fiBIntToSFlo", "fiBINT_TO_SFLO"},
7360	{FOAM_BVal_BIntToDFlo, CCO_FCall, 0,"fiBIntToDFlo", "fiBINT_TO_DFLO"},
7361	{FOAM_BVal_PtrToSInt, CCO_FCall, 0,"fiPtrToSInt", "fiPTR_TO_SINT"},
7362	{FOAM_BVal_SIntToPtr, CCO_FCall, 0,"fiSIntToPtr", "fiSINT_TO_PTR"},
7363
7364	{FOAM_BVal_ArrToSFlo, CCO_FCall, 0,"fiArrToSFlo", "fiARR_TO_SFLO"},
7365	{FOAM_BVal_ArrToDFlo, CCO_FCall, 0,"fiArrToDFlo", "fiARR_TO_DFLO"},
7366	{FOAM_BVal_ArrToSInt, CCO_FCall, 0,"fiArrToSInt", "fiARR_TO_SINT"},
7367	{FOAM_BVal_ArrToBInt, CCO_FCall, 0,"fiArrToBInt", "fiARR_TO_BINT"},
7368
7369	{FOAM_BVal_PlatformRTE, CCO_FCall, 0,"fiPlatformRTE", 0},
7370	{FOAM_BVal_PlatformOS, CCO_FCall, 0,"fiPlatformOS", 0},
7371
7372	{FOAM_BVal_Halt, CCO_FCall, 0,"fiHalt", 0},
7373
7374	{FOAM_BVal_RoundZero, CCO_FCall, 0,"fiRoundZero", "FI_ROUND_ZERO"},
7375	{FOAM_BVal_RoundNearest, CCO_FCall, 0,"fiRoundNearest", "FI_ROUND_NEAREST"},
7376	{FOAM_BVal_RoundUp, CCO_FCall, 0,"fiRoundUp", "FI_ROUND_UP"},
7377	{FOAM_BVal_RoundDown, CCO_FCall, 0,"fiRoundDown", "FI_ROUND_DOWN"},
7378	{FOAM_BVal_RoundDontCare,CCO_FCall, 0,"fiRoundDontCare","FI_ROUND_DONT_CARE"},
7379
7380	{FOAM_BVal_SFloTruncate, CCO_FCall, 0,"fiSFloTruncate", 0},
7381	{FOAM_BVal_SFloFraction, CCO_FCall, 0,"fiSFloFraction", 0},
7382	{FOAM_BVal_SFloRound, CCO_FCall, 0,"fiSFloRound", 0},
7383
7384	{FOAM_BVal_DFloTruncate, CCO_FCall, 0,"fiDFloTruncate", 0},
7385	{FOAM_BVal_DFloFraction, CCO_FCall, 0,"fiDFloFraction", 0},
7386	{FOAM_BVal_DFloRound, CCO_FCall, 0,"fiDFloRound", 0},
7387
7388	{FOAM_BVal_StoForceGC, CCO_FCall, 0,"fiStoForceGC", 0},
7389	{FOAM_BVal_StoInHeap, CCO_FCall, 0,"fiStoInHeap", 0},
7390	{FOAM_BVal_StoIsWritable, CCO_FCall, 0,"fiStoIsWritable", 0},
7391	{FOAM_BVal_StoMarkObject, CCO_FCall, 0,"fiStoMarkObject", 0},
7392	{FOAM_BVal_StoRecode, CCO_FCall, 0,"fiStoRecode", 0},
7393	{FOAM_BVal_StoNewObject, CCO_FCall, 0,"fiStoNewObject", 0},
7394	{FOAM_BVal_StoATracer, CCO_FCall, 0,"fiStoATracer", 0},
7395	{FOAM_BVal_StoCTracer, CCO_FCall, 0,"fiStoCTracer", 0},
7396	{FOAM_BVal_StoShow, CCO_FCall, 0,"fiStoShow", 0},
7397	{FOAM_BVal_StoShowArgs, CCO_FCall, 0,"fiStoShowArgs", 0},
7398
7399	{FOAM_BVal_TypeInt8, CCO_FCall, 0,"fiTypeInt8", 0},
7400	{FOAM_BVal_TypeInt16, CCO_FCall, 0,"fiTypeInt16", 0},
7401	{FOAM_BVal_TypeInt32, CCO_FCall, 0,"fiTypeInt32", 0},
7402	{FOAM_BVal_TypeInt64, CCO_FCall, 0,"fiTypeInt64", 0},
7403	{FOAM_BVal_TypeInt128, CCO_FCall, 0,"fiTypeInt128", 0},
7404
7405	{FOAM_BVal_TypeNil, CCO_FCall, 0,"fiTypeNil", 0},
7406	{FOAM_BVal_TypeChar, CCO_FCall, 0,"fiTypeChar", 0},
7407	{FOAM_BVal_TypeBool, CCO_FCall, 0,"fiTypeBool", 0},
7408	{FOAM_BVal_TypeByte, CCO_FCall, 0,"fiTypeByte", 0},
7409	{FOAM_BVal_TypeHInt, CCO_FCall, 0,"fiTypeHInt", 0},
7410	{FOAM_BVal_TypeSInt, CCO_FCall, 0,"fiTypeSInt", 0},
7411	{FOAM_BVal_TypeBInt, CCO_FCall, 0,"fiTypeBInt", 0},
7412	{FOAM_BVal_TypeSFlo, CCO_FCall, 0,"fiTypeSFlo", 0},
7413	{FOAM_BVal_TypeDFlo, CCO_FCall, 0,"fiTypeDFlo", 0},
7414	{FOAM_BVal_TypeWord, CCO_FCall, 0,"fiTypeWord", 0},
7415	{FOAM_BVal_TypeClos, CCO_FCall, 0,"fiTypeClos", 0},
7416	{FOAM_BVal_TypePtr, CCO_FCall, 0,"fiTypePtr", 0},
7417	{FOAM_BVal_TypeRec, CCO_FCall, 0,"fiTypeRec", 0},
7418	{FOAM_BVal_TypeArr, CCO_FCall, 0,"fiTypeArr", 0},
7419	{FOAM_BVal_TypeTR, CCO_FCall, 0,"fiTypeTR", 0},
7420	{FOAM_BVal_RawRepSize, CCO_FCall, 0,"fiRawRepSize", 0},
7421	{FOAM_BVal_SizeOfInt8, CCO_FCall, 0,"fiSizeOfInt8", 0},
7422	{FOAM_BVal_SizeOfInt16, CCO_FCall, 0,"fiSizeOfInt16", 0},
7423	{FOAM_BVal_SizeOfInt32, CCO_FCall, 0,"fiSizeOfInt32", 0},
7424	{FOAM_BVal_SizeOfInt64, CCO_FCall, 0,"fiSizeOfInt64", 0},
7425	{FOAM_BVal_SizeOfInt128, CCO_FCall, 0,"fiSizeOfInt128", 0},
7426
7427	{FOAM_BVal_SizeOfNil, CCO_FCall, 0,"fiSizeOfNil", 0},
7428	{FOAM_BVal_SizeOfChar, CCO_FCall, 0,"fiSizeOfChar", 0},
7429	{FOAM_BVal_SizeOfBool, CCO_FCall, 0,"fiSizeOfBool", 0},
7430	{FOAM_BVal_SizeOfByte, CCO_FCall, 0,"fiSizeOfByte", 0},
7431	{FOAM_BVal_SizeOfHInt, CCO_FCall, 0,"fiSizeOfHInt", 0},
7432	{FOAM_BVal_SizeOfSInt, CCO_FCall, 0,"fiSizeOfSInt", 0},
7433	{FOAM_BVal_SizeOfBInt, CCO_FCall, 0,"fiSizeOfBInt", 0},
7434	{FOAM_BVal_SizeOfSFlo, CCO_FCall, 0,"fiSizeOfSFlo", 0},
7435	{FOAM_BVal_SizeOfDFlo, CCO_FCall, 0,"fiSizeOfDFlo", 0},
7436	{FOAM_BVal_SizeOfWord, CCO_FCall, 0,"fiSizeOfWord", 0},
7437	{FOAM_BVal_SizeOfClos, CCO_FCall, 0,"fiSizeOfClos", 0},
7438	{FOAM_BVal_SizeOfPtr, CCO_FCall, 0,"fiSizeOfPtr", 0},
7439	{FOAM_BVal_SizeOfRec, CCO_FCall, 0,"fiSizeOfRec", 0},
7440	{FOAM_BVal_SizeOfArr, CCO_FCall, 0,"fiSizeOfArr", 0},
7441	{FOAM_BVal_SizeOfTR, CCO_FCall, 0,"fiSizeOfTR", 0},
7442
7443	{FOAM_BVal_ListNil, CCO_FCall, 0,"fiListNil", "fiLIST_NIL"},
7444	{FOAM_BVal_ListEmptyP, CCO_FCall, 0,"fiListEmptyP", "fiLIST_EMPTYP"},
7445	{FOAM_BVal_ListHead, CCO_FCall, 0,"fiListHead", "fiLIST_HEAD"},
7446	{FOAM_BVal_ListTail, CCO_FCall, 0,"fiListTail", "fiLIST_TAIL"},
7447	{FOAM_BVal_ListCons, CCO_FCall, 0,"fiListCons", 0},
7448	{FOAM_BVal_NewExportTable, CCO_FCall, 0, "fiNewExportTable", 0},
7449	{FOAM_BVal_AddToExportTable, CCO_FCall, 0, "fiAddToExportTable", 0},
7450	{FOAM_BVal_FreeExportTable, CCO_FCall, 0, "fiFreeExportTable", 0},
7451	#if EDIT_1_0_n1_AB1
7452	/* This BVal must NEVER be seen by genc ... */
7453	{FOAM_BVal_ssaPhi, CCO_FCall, 0, "fiNonExistentFunction", 0},
7454	#endif
7455	};
7456
7457
7458	/*****************************************************************************
7459	*
7460	* :: Table of valid identifiers for special characters
7461	*
7462	****************************************************************************/
7463
7464	struct ccSpecCharId_info ccSpecCharIdTable[] = {
7465	{'!', "_BANG_"},
7466	{'\"', "_QUOTE_"},
7467	{'#', "_SHARP_"},
7468	{'$', "_DOLLR_"},
7469	{'%', "_PCENT_"},
7470	{'&', "_AMPER_"},
7471	{'\'', "_APOS_"},
7472	{'(', "_OPAREN_"},
7473	{')', "_CPAREN_"},
7474	{'*', "_STAR_"},
7475	{'+', "_PLUS_"},
7476	{',', "_COMMA_"},
7477	{'-', "_MINUS_"},
7478	{'.', "_DOT_"},
7479	{'/', "_SLASH_"},
7480	{':', "_COLON_"},
7481	{';', "_SEMI_"},
7482	{'<', "_LT_"},
7483	{'=', "_EQ_"},
7484	{'>', "_GT_"},
7485	{'?', "_QMARK_"},
7486	{'@', "_AT_"},
7487	{'[', "_OBRACK_"},
7488	{'\\', "_BSLSH_"},
7489	{']', "_CBRACK_"},
7490	{'^', "_HAT_"},
7491	{'_', "__"},
7492	{'`', "_GRAVE_"},
7493	{'{', "_OBRACE_"},
7494	{'\|', "_BAR_"},
7495	{'}', "_CBRACE_"},
7496	{'~', "_TILDE_"},
7497	{0, 0}
7498	};
7499
7500