Bug Summary

File:src/genfoam.c
Warning:line 6220, column 2
Value stored to 'iterSize' is never read

Annotated Source Code

Press '?' to see keyboard shortcuts

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 genfoam.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 genfoam.c
1
2/*****************************************************************************
3 *
4 * genfoam.c: Foam code generation.
5 *
6 * Copyright (c) 1990-2007 Aldor Software Organization Ltd (Aldor.org).
7 *
8 ****************************************************************************/
9
10/*
11 * This file implements Foam code generation from fully type-analyzed AbSyn
12 * trees for an entire file.
13 *
14 * To Do:
15 * Use hash function from domains for non-type constructor args.
16 * Treat arg and return types as Multi in gen0TypeHash.
17 * Completely compute side-effects for functions and all sub-expressions
18 * once only. Get rid of potential exponential process in
19 * dead var elimination.
20 * Ensure type analysis puts embed tags on assignments (it doesn't now).
21 * Compute environment level usage (prog's DEnv) after all foam
22 * generation and optimization is done, not in genfoam.c.
23 * Use Aldor-level code and callbacks for iterators.
24 * Clean up storage leaks.
25 *
26 */
27
28#include "compcfg.h"
29#include "debug.h"
30#include "fluid.h"
31#include "format.h"
32#include "fortran.h"
33#include "genfoam.h"
34#include "gf_add.h"
35#include "gf_cgener.h"
36#include "gf_excpt.h"
37#include "gf_fortran.h"
38#include "gf_gener.h"
39#include "genstyle.h"
40#include "gf_imps.h"
41#include "gf_java.h"
42#include "gf_prog.h"
43#include "gf_reference.h"
44#include "gf_rtime.h"
45#include "gf_syme.h"
46#include "gf_util.h"
47#include "of_util.h"
48#include "optfoam.h"
49#include "optinfo.h"
50#include "opttools.h"
51#include "scobind.h"
52#include "sefo.h"
53#include "simpl.h"
54#include "spesym.h"
55#include "stab.h"
56#include "store.h"
57#include "tform.h"
58#include "util.h"
59#include "fint.h"
60#include "lib.h"
61#include "tfsat.h"
62#include "ablogic.h"
63#include "abpretty.h"
64#include "comsg.h"
65#include "strops.h"
66#include "fbox.h"
67
68Bool genfDebug = false((int) 0);
69Bool genfHashDebug = false((int) 0);
70
71extern Bool genfExportDebug; /* (from gf_add.c) */
72#define genfExportDEBUGif (!genfExportDebug) { } else afprintf DEBUG_IF(genfExport)if (!genfExportDebug) { } else afprintf
73#define genfEnvDEBUGif (!genfEnvDebug) { } else afprintf DEBUG_IF(genfEnv)if (!genfEnvDebug) { } else afprintf
74
75CREATE_LIST (DomainCache)struct DomainCache_listOpsStruct const *DomainCache_listPointer
= (struct DomainCache_listOpsStruct const *) &ptrlistOps
;
76CREATE_LIST (VarPool)struct VarPool_listOpsStruct const *VarPool_listPointer = (struct
VarPool_listOpsStruct const *) &ptrlistOps
;
77CREATE_LIST (FoamSig)struct FoamSig_listOpsStruct const *FoamSig_listPointer = (struct
FoamSig_listOpsStruct const *) &ptrlistOps
;
78
79/*****************************************************************************
80 *
81 * :: Standard code generators.
82 *
83 ****************************************************************************/
84
85localstatic Foam genFoam (AbSyn);
86localstatic Foam genApply (AbSyn);
87localstatic Foam genAssert (AbSyn);
88localstatic Foam genAssign (AbSyn);
89localstatic Foam genAnd (AbSyn);
90localstatic Foam genOr (AbSyn);
91localstatic Foam genDefine (AbSyn);
92localstatic Foam genExcept (AbSyn);
93localstatic Foam genId (AbSyn);
94localstatic Foam genIf (AbSyn);
95localstatic Foam genRepeat (AbSyn);
96localstatic Foam genReturn (AbSyn);
97localstatic Foam genLabel (AbSyn);
98localstatic Foam genGoto (AbSyn);
99localstatic Foam genSequence (AbSyn);
100localstatic Foam genLit (AbSyn);
101localstatic Foam genCollect (AbSyn);
102localstatic Foam genPretend (AbSyn);
103localstatic Foam genMulti (AbSyn);
104localstatic Foam genNever (AbSyn);
105localstatic Foam genWhere (AbSyn);
106localstatic Foam genExport (AbSyn);
107localstatic Foam genSelect (AbSyn);
108localstatic Foam genForeignImport (AbSyn);
109localstatic Foam genForeignExport (AbSyn);
110localstatic Foam genRestrict (AbSyn);
111
112/*****************************************************************************
113 *
114 * :: Local helper functions.
115 *
116 ****************************************************************************/
117
118/* !!! No longer used !!! */
119#if 0
120localstatic AInt gen0ProtoFrString (String);
121localstatic Bool gen0IsParamReference (TForm, int);
122localstatic String gen0FortranFieldName (TForm, int);
123localstatic int gen0GetNumFortranModArgs (TForm);
124localstatic Bool gen0FortranHasFnParamArg (TForm);
125localstatic AInt gen0FortranMFmtNumber (TFormList);
126#endif
127
128localstatic Bool gen0AbSynHasConstHash (AbSyn);
129localstatic Bool gen0AbSynHasConstHash0 (AbSyn);
130localstatic Foam gen0ApplySyme (FoamTag, Syme, SImpl, Length, Foam **);
131localstatic Foam gen0ApplyBuiltin (Syme, Length, Foam **);
132localstatic Foam gen0ApplyForeign (FoamTag, Syme, Length, Foam **);
133localstatic Foam gen0ApplyImplicitSyme (FoamTag, Syme, Length, AbSyn *, Foam);
134localstatic Foam gen0AssignLhs (AbSyn, Foam);
135localstatic AbSyn * gen0MakeImplicitArgs (Length, AbSyn, AbSynGetter);
136localstatic AInt gen0BuiltinImport (String, String);
137localstatic Foam gen0BuiltinExporter (Foam, Syme);
138localstatic Foam gen0CCall (FoamTag, Syme, Length, Foam **);
139localstatic Bool gen0CompareFormats (Foam, Foam);
140localstatic Foam gen0CrossToMulti (Foam, TForm);
141localstatic Foam gen0CrossToUnary (Foam, TForm);
142localstatic Foam gen0CrossToTuple (Foam, TForm);
143localstatic Foam gen0Define (AbSyn);
144localstatic Foam gen0DefineRhs (AbSyn, AbSyn, AbSyn);
145localstatic Foam gen0Embed (Foam, AbSyn, TForm, AbEmbed);
146localstatic Foam gen0EmbedExit (Foam, AbSyn, TForm);
147localstatic Foam gen0NilValue (TForm);
148localstatic Symbol gen0ExportingTo (AbSyn absyn);
149localstatic void gen0ExportToBuiltin (AbSyn fun);
150localstatic void gen0ExportToC (AbSyn fun);
151localstatic Foam gen0Extend (AbSyn);
152localstatic void gen0FindDefsAll (AbSyn, Stab);
153localstatic int gen0FoamLevel (AInt level);
154localstatic FoamTag gen0FoamType (Foam foam);
155localstatic void gen0ForIter (AbSyn, FoamList *, FoamList *);
156localstatic void gen0CForIter (AbSyn, FoamList *, FoamList *);
157localstatic void gen0FreeTemp (Foam);
158localstatic void gen0GenFoamInit (void);
159localstatic void gen0GenFoamFini (void);
160localstatic Syme gen0FindImportedSyme (Syme, AInt, Bool);
161localstatic Bool gen0GetImportedSyme (Syme, AInt, Bool);
162localstatic void gen0SetImportedSyme (Syme, AInt);
163localstatic Foam gen0GetRealFormat (AInt);
164localstatic Foam gen0ImplicitSet (AbSyn);
165localstatic void gen0InitState (Stab, int);
166localstatic Foam gen0InnerSyme (Syme, AInt);
167localstatic Bool gen0IsDomainInit (Foam foam);
168localstatic Bool gen0IsDef (AbSyn);
169localstatic Bool gen0IsImplicitSet (AbSyn lhs);
170localstatic Bool gen0IsInnerVar (Syme syme, AInt level);
171localstatic Bool gen0IsMultiEvaluable (Foam);
172localstatic Bool gen0IsResultCachable (AbSyn, TForm);
173localstatic void gen0Iter (AbSyn, FoamList *, FoamList *);
174localstatic Foam gen0Lambda (AbSyn, Syme, AbSyn);
175localstatic Symbol gen0MachineType (TForm);
176localstatic Foam * gen0MakeApplyArgs (Syme syme, AbSyn, Length *);
177localstatic Foam gen0EmbedApply (int, AbSyn *, AbSyn, AbEmbed);
178localstatic void gen0MakeBuiltinExports (void);
179localstatic Foam gen0MakeExtend (Syme, TForm);
180localstatic Foam gen0MakeExtendLambda (Syme, TForm);
181localstatic Foam gen0MakeExtendBase (Syme);
182localstatic void gen0MakeExtendParents (Syme, SymeList);
183localstatic void gen0MakeExtendParent (Syme, Syme, Length, Foam);
184localstatic Foam gen0MakeExtendApply (TForm, Foam);
185localstatic AbSyn gen0AbTypeArg (AbSyn);
186localstatic void gen0MarkParamsDeep (Stab, AbSyn);
187localstatic int gen0MaxLevel (AbSyn);
188localstatic Foam gen0MultiAssign (FoamTag, AbSyn, Foam);
189localstatic Foam gen0MultiToCross (Foam, TForm);
190localstatic Foam gen0MultiToTuple (Foam);
191localstatic Foam gen0MultiToUnary (Foam);
192localstatic Foam gen0OCall (FoamTag, Syme, Length, Foam **);
193localstatic void gen0PatchEEltFormats (Foam);
194localstatic void gen0PatchFormatNums (Foam);
195localstatic Foam gen0RawToUnary (Foam, AbSyn);
196localstatic String gen0RecFieldName (TForm, int);
197localstatic String gen0RecFieldName (TForm, int);
198localstatic Foam gen0RenewConstants (FoamList, int);
199localstatic Foam gen0RenewDefs (FoamList, int);
200localstatic Foam gen0Sequence (TForm, AbSyn *, Length, Length);
201localstatic void gen0SetTemp (Foam, Foam);
202localstatic Foam gen0SetValue (Foam, AbSyn);
203localstatic Foam gen0SpecialOp (FoamTag, Syme, Length, AbSyn *, Foam *);
204localstatic Syme gen0SymeCopyImport (Syme);
205localstatic Foam gen0SymeGeneric (Syme);
206localstatic Foam gen0SymeImport (Syme);
207localstatic Foam gen0TempValue (AbSyn);
208localstatic Foam gen0TempValueMode (TForm);
209localstatic Foam gen0UnaryToMulti (Foam);
210localstatic Foam gen0UnaryToCross (Foam, TForm);
211localstatic Foam gen0UnaryToRaw (Foam, AbSyn);
212localstatic Foam gen0UnaryToTuple (Foam);
213localstatic AInt gen0CrossFormatNumber (TForm tf);
214localstatic AInt gen0TrailingFormatNumber(TForm tf);
215localstatic SlotUsageList gen0UnusedFormats (AIntList);
216localstatic void gen0UseFormat (AInt level, int slot);
217localstatic void gen0UseStateFormat (GenFoamState, AInt);
218localstatic void gen0VarsList (Stab, SymeList);
219localstatic void gen0VarsParam (Syme, Stab);
220localstatic void gen0VarsLex (Syme, Stab);
221localstatic void gen0VarsFluid (Syme);
222localstatic void gen0VarsImport (Syme, Stab);
223localstatic void gen0VarsExport (Syme, Stab);
224localstatic void gen0VarsForeign (Syme);
225localstatic Foam gen0ForeignValue (Syme);
226localstatic Foam gen0ForeignWrapValue (Syme);
227localstatic Foam gen0ForeignWrapFn (Syme);
228localstatic void gen0FreeFortranActualArgTmps(void);
229localstatic Foam genFoamArg (AbSyn *, Foam *, int);
230localstatic void gen0GetGlobalDefs (void);
231localstatic SymeList gen0GetExporterSymes (Stab, Sefo, SymeList);
232localstatic SymeList gen0GetBoundSymes (Stab);
233localstatic void gen0AddLexLevels1 (Foam, AInt, int, FoamList);
234localstatic int gen0StateOffset (int, int);
235localstatic AInt gen0FindFormat (AInt);
236localstatic AInt gen0FindConst (AInt);
237
238localstatic AInt gen0FindGlobalFluid (Syme);
239localstatic void gen0AddLocalFluid (AbSyn);
240
241localstatic void gen0DbgAssignment (AbSyn);
242localstatic void gen0DbgFnEntry (AbSyn);
243localstatic Foam gen0DbgFnExit (AbSyn, Foam);
244localstatic Foam gen0DbgFnReturn (AbSyn, Foam);
245
246/* Code for the new runtime debugging system */
247localstatic Foam gen1DbgFnBody (AbSyn);
248localstatic void gen1DbgFnEntry (TForm, Syme, AbSyn);
249localstatic void gen1DbgFnExit (AbSyn);
250localstatic void gen1DbgFnReturn (AbSyn, TForm, Foam);
251localstatic void gen1DbgDoParam (String, AInt, Syme, AInt);
252localstatic void gen1DbgDoAssign (String, AInt, Syme, Foam, AInt, AInt);
253localstatic void gen1DbgFnStep (AbSyn);
254
255localstatic Bool gen0IsOpenCallable(Syme syme, SImpl impl);
256
257localstatic AInt gen0FortranSigFormatNumber (TForm, Bool);
258localstatic String gen0TypeString (Sefo);
259localstatic FoamTag gen0TfMapType(Syme syme, TForm mapTf, FoamTag argFoamTag, AInt *newFmt);
260
261localstatic Foam genGenerate(AbSyn absyn);
262localstatic Foam genYield(AbSyn absyn);
263/*
264 * The following are used store information for flattening programs.
265 */
266
267AIntList gen0BuiltinExports;
268static int numLexicals;
269
270
271String gen0FileName;
272FoamList gen0GlobalList, gen0FluidList, gen0FormatList;
273FoamList gen0DeclList, gen0ProgList;
274AIntList gen0ConstList;
275AIntList gen0RealConstList;
276int gen0NumGlobals;
277int gen0RealFormatNum;
278int gen0NumProgs;
279int gen0FwdProgNum;
280int gen0FormatNum;
281int gloInitIdx;
282
283static AIntList formatPlaceList, formatRealList;
284static int gen0IterateLabel;
285static int gen0BreakLabel;
286static Bool gen0ValueMode; /* indicate when in value mode. */
287
288int gen0GenerFormat;
289int gen0GenerRetFormat;
290
291int gen0LazyFunFormat;
292FoamSigList gen0LazySigList;
293AIntList gen0LazyConstTypeList;
294AIntList gen0LazyConstDefnList;
295
296static FoamSigList gen0ForeignFnValues;
297static SymeList gen0ForeignFnGlobals;
298
299String gen0DefName; /* Similar to gen0ProgName */
300String gen0ProgName;
301GenFoamState gen0State;
302
303static AbSyn gen0FortranFnResult = NULL((void*)0);
304static FoamList gen0FortranActualArgTmps = listNil(Foam)((FoamList) 0);
305
306static GenType gen0GenType;
307
308/* Flags for options */
309Bool gen0InAxiomAx = false((int) 0);
310Bool gen0DebugWanted = false((int) 0); /* Old style */
311Bool gen0DebuggerWanted = false((int) 0); /* New style */
312Bool gen0SmallHashCodes = false((int) 0);
313
314/* 2 flavours of gen0AbType. The first returns the natural type
315 * of an absyn, the second also allows for embeddings.
316 */
317TForm
318gen0AbType(AbSyn ab)
319{
320 return tfDefineeType(abGetCategory(ab));
321}
322
323TForm
324gen0AbContextType(AbSyn ab)
325{
326 TForm tf = gen0AbType(ab);
327 AbEmbed embed = abTContext(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->embed : 0);
328
329 return tfsEmbedResult(tf, embed);
330}
331
332#define gen0FoamNewBreak()foamNew(FOAM_Goto, 1, (AInt)(gen0BreakLabel)) foamNewGoto(gen0BreakLabel)foamNew(FOAM_Goto, 1, (AInt)(gen0BreakLabel))
333#define gen0FoamNewIterate()foamNew(FOAM_Goto, 1, (AInt)(gen0IterateLabel)) foamNewGoto(gen0IterateLabel)foamNew(FOAM_Goto, 1, (AInt)(gen0IterateLabel))
334
335void
336genSetAxiomAx(Bool flag)
337{
338 gen0InAxiomAx = flag;
339}
340
341void
342genSetDebugWanted(Bool flag)
343{
344 gen0DebugWanted = flag;
345}
346
347void
348genSetDebuggerWanted(Bool flag)
349{
350 gen0DebuggerWanted = flag;
351}
352
353void
354genSetSmallHashCodes(Bool flag)
355{
356 gen0SmallHashCodes = flag;
357}
358
359/******************************************************************************
360 *
361 * :: Top-level entry point.
362 *
363 *****************************************************************************/
364
365Foam
366generateFoam(Stab stab0, AbSyn absyn, String initName)
367{
368 Scope("generateFoam")String scopeName = ("generateFoam"); int fluidLevel0 = (scopeLevel
++, fluidLevel)
;
369
370 Foam foam, clos, constants, def,
371 globals, lexicals, formats, defs, decl, fluids;
372 int index, gloNOpIdx, gloRuntimeIdx;
373 AbLogic fluid(gfCondKnown)fluidSave_gfCondKnown = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(gfCondKnown
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_gfCondKnown
, fluidStack[fluidLevel].size = sizeof(gfCondKnown), fluidLevel
++, (gfCondKnown) )
; /* COND-DEF */
374
375 /* COND-DEF */
376 gfCondKnown = gfCondKnown ? ablogCopy(gfCondKnown) : ablogTrue();
377
378 gen0GenFoamInit();
379
380 gen0FileName = initName;
381
382 gen0ProgName = gen0FileName;
383 gen0DefName = strCopy(gen0ProgName);
384
385
386 /* Walk absyn for open callable funcs and lexically deep references. */
387 gen0FindDefsAll(absyn, stab0);
388
389 /* Declare the globals for the top-level prog. */
390
391 /* Once called, never again */
392 decl = foamNewGDecl(FOAM_Clos, strCopy(gen0ProgName), FOAM_Nil,foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy(gen0ProgName),
FOAM_Nil,4, (AInt)(FOAM_GDecl_Export),(AInt)(FOAM_Proto_Init
))
393 emptyFormatSlot,foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy(gen0ProgName),
FOAM_Nil,4, (AInt)(FOAM_GDecl_Export),(AInt)(FOAM_Proto_Init
))
394 FOAM_GDecl_Export, FOAM_Proto_Init)foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy(gen0ProgName),
FOAM_Nil,4, (AInt)(FOAM_GDecl_Export),(AInt)(FOAM_Proto_Init
))
;
395 gloInitIdx = gen0AddGlobal(decl);
396
397 decl = foamNewGDecl(FOAM_Clos, strCopy("noOperation"), FOAM_Nil,foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy("noOperation")
, FOAM_Nil,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Foam
))
398 emptyFormatSlot,foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy("noOperation")
, FOAM_Nil,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Foam
))
399 FOAM_GDecl_Import,FOAM_Proto_Foam)foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy("noOperation")
, FOAM_Nil,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Foam
))
;
400 gloNOpIdx = gen0AddGlobal(decl);
401
402
403 /* Set up this level */
404
405 clos = gen0ProgClosEmpty();
406 foam = gen0ProgInitEmpty(gen0ProgName, absyn);
407
408 index = gen0FormatNum--;
409 gen0InitState(stab0, index);
410
411 gen0ProgAddParams(int0((int) 0), NULL((void*)0));
412 gen0Vars(stab0);
413
414 gen0State->program = foam;
415
416 /* Add the inits for the globals for the top-level prog. */
417
418 /* This can go once support for lazy gets of runtime functions is in... */
419
420 if (!genIsRuntime()(gen0IsRuntime)) {
421 decl = foamNewGDecl(FOAM_Clos, gen0InitialiserName("runtime"),foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),(strCopy("runtime")), FOAM_Nil
,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Init))
422 FOAM_Nil,foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),(strCopy("runtime")), FOAM_Nil
,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Init))
423 emptyFormatSlot,foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),(strCopy("runtime")), FOAM_Nil
,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Init))
424 FOAM_GDecl_Import,foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),(strCopy("runtime")), FOAM_Nil
,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Init))
425 FOAM_Proto_Init)foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),(strCopy("runtime")), FOAM_Nil
,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Init))
;
426 gloRuntimeIdx = gen0AddGlobal(decl);
427 gen0AddInit(foamNew(FOAM_CCall, 2, FOAM_NOp,
428 foamNewGlo(gloRuntimeIdx)foamNew(FOAM_Glo, 1, (AInt)(gloRuntimeIdx))));
429 gen0AddInit(foamNewSet(foamNewGlo(gloInitIdx),foamNew(FOAM_Set, 2, foamNew(FOAM_Glo, 1, (AInt)(gloInitIdx))
, foamNew(FOAM_Glo, 1, (AInt)(gloNOpIdx)))
430 foamNewGlo(gloNOpIdx))foamNew(FOAM_Set, 2, foamNew(FOAM_Glo, 1, (AInt)(gloInitIdx))
, foamNew(FOAM_Glo, 1, (AInt)(gloNOpIdx)))
);
431 }
432
433 if (!genIsRuntime()(gen0IsRuntime))
434 gen0StringsInit();
435
436 if (genIsRuntime()(gen0IsRuntime))
437 gen0StdLazyGetsCreate();
438
439 /* !! Should call AddExportedSymes on body */
440 gen0FindUncondSymes(absyn, listNil(Syme)((SymeList) 0));
441
442
443 gen0DefSequence(absyn);
444
445 if (genIsRuntime()(gen0IsRuntime)) {
446 gen0AddStmt(foamNewSet(foamNewGlo(gloInitIdx),foamNew(FOAM_Set, 2, foamNew(FOAM_Glo, 1, (AInt)(gloInitIdx))
, foamNew(FOAM_Glo, 1, (AInt)(gloNOpIdx)))
447 foamNewGlo(gloNOpIdx))foamNew(FOAM_Set, 2, foamNew(FOAM_Glo, 1, (AInt)(gloInitIdx))
, foamNew(FOAM_Glo, 1, (AInt)(gloNOpIdx)))
, NULL((void*)0));
448 }
449
450 if (!genIsRuntime()(gen0IsRuntime))
451 gen0StringsFini();
452
453 gen0IssueLazyFunctions();
454 gen0IssueGVectFns();
455
456 gen0AddStmt(foamNewReturn(foamNew(FOAM_Values, int0))foamNew(FOAM_Return, 1, foamNew(FOAM_Values, ((int) 0))), NULL((void*)0));
457
458 gen0ProgAddStateFormat(index);
459 gen0IssueDCache();
460 gen0ProgFiniEmpty(foam, FOAM_NOp, int0((int) 0));
461
462 foamOptInfo(foam)((foam)->hdr.info.opt) = optInfoNew(NULL((void*)0), foam, NULL((void*)0), false((int) 0));
463
464 /* construct the unit */
465 constants = gen0RenewConstants(gen0DeclList, gen0NumProgs);
466
467 def = foamNewDef(foamNewGlo(gloInitIdx), clos)foamNew(FOAM_Def, 2, foamNew(FOAM_Glo, 1, (AInt)(gloInitIdx))
, clos)
;
468 gen0ProgList = listCons(Foam)(Foam_listPointer->Cons)(def, gen0ProgList);
469 gen0NumProgs++;
470
471 gen0GetGlobalDefs();
472 gen0MakeBuiltinExports();
473 defs = gen0RenewDefs(gen0ProgList, gen0NumProgs);
474
475 /* Fixup defns of globals... */
476
477 gen0GlobalList = listNReverse(Foam)(Foam_listPointer->NReverse)(gen0GlobalList);
478 globals = foamNewOfList1(FOAM_DDecl,
479 (AInt) FOAM_DDecl_Global,
480 gen0GlobalList);
481 lexicals = foamNewEmptyDDecl(FOAM_DDecl_LocalEnv)foamNew(FOAM_DDecl, 1, (AInt) FOAM_DDecl_LocalEnv);
482 fluids = foamNewOfList1(FOAM_DDecl, FOAM_DDecl_Fluid, gen0FluidList);
483 gen0FormatList = listNReverse(Foam)(Foam_listPointer->NReverse)(gen0FormatList);
484
485 gen0FormatList = listCons(Foam)(Foam_listPointer->Cons)(foamNewEmptyDDecl(FOAM_DDecl_Local)foamNew(FOAM_DDecl, 1, (AInt) FOAM_DDecl_Local),
486 gen0FormatList);
487 gen0FormatList = listCons(Foam)(Foam_listPointer->Cons)(fluids, gen0FormatList);
488 gen0FormatList = listCons(Foam)(Foam_listPointer->Cons)(lexicals, gen0FormatList);
489 gen0FormatList = listCons(Foam)(Foam_listPointer->Cons)(constants, gen0FormatList);
490 gen0FormatList = listCons(Foam)(Foam_listPointer->Cons)(globals, gen0FormatList);
491
492
493 formats = foamNewOfList(FOAM_DFmt, gen0FormatList);
494 foam = foamNewUnit(formats, defs)foamNew(FOAM_Unit,2,formats,defs);
495
496 if (fintMode == FINT_LOOP2)
497 gen0KillSymeConstNums();
498
499 /* Tidy up */
500 gen0GenFoamFini();
501 assert(foamAudit(foam))do { if (!(foamAudit(foam))) _do_assert(("foamAudit(foam)"),"genfoam.c"
,501); } while (0)
;
502
503 /* COND-DEF */
504 ablogFree(gfCondKnown);
505
506 Return(foam){ fluidUnwind(fluidLevel0, ((int) 0)); return foam;; };
507}
508
509/*
510 * !! This function does not appear to be used anymore !!
511 */
512#if 0
513localstatic AInt
514gen0ProtoFrString(String proto)
515{
516 if (!proto) return FOAM_Proto_C;
517 else if (!strcasecmp(proto, "C")) return FOAM_Proto_C;
518 else if (!strcasecmp(proto, "Lisp")) return FOAM_Proto_Lisp;
519 else if (!strcasecmp(proto, "Fortran")) return FOAM_Proto_Fortran;
520
521 return FOAM_Proto_C;
522}
523#endif
524
525localstatic void
526gen0GenFoamInit()
527{
528 /* initialise globals */
529 gen0GenerFormat = 0;
530 gen0GenerRetFormat = 0;
531 gen0TupleFormat = 0;
532 gen0ArrayFormat = 0;
533 gen0UnionFormat = 0;
534 gen0CCheckFormat = 0;
535 gen0LazyFunFormat = 0;
536 gen0State = 0;
537
538 gen0BuiltinExports = listNil(AInt)((AIntList) 0);
539 gen0FormatList = listNil(Foam)((FoamList) 0);
540 gen0ProgList = listNil(Foam)((FoamList) 0);
541 gen0DeclList = listNil(Foam)((FoamList) 0);
542 gen0GlobalList = listNil(Foam)((FoamList) 0);
543 gen0FluidList = listNil(Foam)((FoamList) 0);
544 gen0ConstList = listNil(AInt)((AIntList) 0);
545 gen0RealConstList = listNil(AInt)((AIntList) 0);
546 gen0NumGlobals = 0;
547 gen0FwdProgNum = SYME_NUMBER_UNASSIGNED(0x7FFF) - 1;
548 gen0NumProgs = 0;
549 numLexicals = 0;
550 gen0FormatNum = -1;
551
552 gen0LazySigList = listNil(FoamSig)((FoamSigList) 0);
553 gen0LazyConstTypeList = listNil(AInt)((AIntList) 0);
554 gen0LazyConstDefnList = listNil(AInt)((AIntList) 0);
555 gen0ForeignFnValues = listNil(FoamSig)((FoamSigList) 0);
556 gen0ForeignFnGlobals = listNil(Syme)((SymeList) 0);
557
558 gen0InitConstTable(scobindMaxDef());
559 formatPlaceList = listNil(AInt)((AIntList) 0);
560 formatRealList = listNil(AInt)((AIntList) 0);
561 gen0RealFormatNum = FOAM_FORMAT_START5;
562
563 gen0InitGVectTable();
564 gfjInit();
565}
566
567localstatic void
568gen0GenFoamFini()
569{
570 listFree(AInt)(AInt_listPointer->Free)(gen0BuiltinExports);
571 listFree(Foam)(Foam_listPointer->Free)(gen0FormatList);
572 listFree(Foam)(Foam_listPointer->Free)(gen0ProgList);
573 listFree(Foam)(Foam_listPointer->Free)(gen0DeclList);
574 listFree(Foam)(Foam_listPointer->Free)(gen0GlobalList);
575 listFree(Foam)(Foam_listPointer->Free)(gen0FluidList);
576 listFree(AInt)(AInt_listPointer->Free)(gen0ConstList);
577 listFree(AInt)(AInt_listPointer->Free)(gen0RealConstList);
578 listFree(FoamSig)(FoamSig_listPointer->Free)(gen0ForeignFnValues);
579 listFree(Syme)(Syme_listPointer->Free)(gen0ForeignFnGlobals);
580
581 listFree(FoamSig)(FoamSig_listPointer->Free)(gen0LazySigList);
582 listFree(AInt)(AInt_listPointer->Free)(gen0LazyConstTypeList);
583 listFree(AInt)(AInt_listPointer->Free)(gen0LazyConstDefnList);
584 listFree(AInt)(AInt_listPointer->Free)(formatPlaceList);
585 listFree(AInt)(AInt_listPointer->Free)(formatRealList);
586
587 gen0FiniGVectTable();
588 gfjFini();
589}
590
591void
592genFoamStmt(AbSyn absyn)
593{
594 Scope("genFoamStmt")String scopeName = ("genFoamStmt"); int fluidLevel0 = (scopeLevel
++, fluidLevel)
;
595 Foam foam;
596 Bool fluid(gen0ValueMode)fluidSave_gen0ValueMode = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(gen0ValueMode
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_gen0ValueMode
, fluidStack[fluidLevel].size = sizeof(gen0ValueMode), fluidLevel
++, (gen0ValueMode) )
;
597 FoamList fluid(gen0FortranActualArgTmps)fluidSave_gen0FortranActualArgTmps = ( fluidStack = (fluidLevel
==fluidLimit) ? fluidGrow() : fluidStack, fluidStack[fluidLevel
].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel
, fluidStack[fluidLevel].pglobal = (Pointer) &(gen0FortranActualArgTmps
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_gen0FortranActualArgTmps
, fluidStack[fluidLevel].size = sizeof(gen0FortranActualArgTmps
), fluidLevel++, (gen0FortranActualArgTmps) )
;
598
599 gen0ValueMode = false((int) 0);
600 gen0FortranActualArgTmps = NULL((void*)0);
601
602
603 /* New-style debugging hook */
604 if (gen0DebuggerWanted)
605 gen1DbgFnStep(absyn);
606
607 foam = genFoam(absyn);
608 if (foam) {
609 while (foamTag(foam)((foam)->hdr.tag) == FOAM_Cast) {
610 Foam tmp = foam;
611 foam = foam->foamCast.expr;
612 foamFreeNode(tmp);
613 }
614 gen0AddStmt(foam, absyn);
615 }
616
617 if (gen0FortranActualArgTmps) gen0FreeFortranActualArgTmps();
618
619 ReturnNothing{ fluidUnwind(fluidLevel0, ((int) 0)); return;; };
620}
621
622Foam
623genFoamVal(AbSyn absyn)
624{
625 Scope("genFoamVal")String scopeName = ("genFoamVal"); int fluidLevel0 = (scopeLevel
++, fluidLevel)
;
626 Foam foam;
627 Bool fluid(gen0ValueMode)fluidSave_gen0ValueMode = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(gen0ValueMode
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_gen0ValueMode
, fluidStack[fluidLevel].size = sizeof(gen0ValueMode), fluidLevel
++, (gen0ValueMode) )
;
628
629 gen0ValueMode = true1;
630 foam = genFoam(absyn);
631 if (foam && absyn)
632 foamPos(foam)((foam)->hdr.pos) = abPos(absyn)(spstackFirst((absyn)->abHdr.pos));
633 if (!foam)
634 foam = foamNewNil()foamNew(FOAM_Nil, (int) 0);
635
636 Return(foam){ fluidUnwind(fluidLevel0, ((int) 0)); return foam;; };
637}
638
639Foam
640genFoamValAs(TForm tf, AbSyn ab)
641{
642 Foam foam = genFoamVal(ab);
643 return gen0EmbedExit(foam, ab, tf);
644}
645
646localstatic Foam
647gen0EmbedExit(Foam foam, AbSyn ab, TForm tf)
648{
649 if (tfIsExit(gen0AbType(ab))(((gen0AbType(ab))->tag) == TF_Exit)) {
650 if (tfIsMulti(tf)(((tf)->tag) == TF_Multiple) && tfMultiArgc(tf) > 0) {
651 if (foam != NULL((void*)0) && foamHasSideEffect(foam))
652 gen0AddStmt(foam, ab);
653
654 return gen0NilValue(tf);
655 }
656 else {
657 FoamTag expectedType = gen0Type(tf, NULL((void*)0));
658 if (expectedType != FOAM_Word && foam != NULL((void*)0)) {
659 foam = foamNewCast(expectedType, foam)foamNew(FOAM_Cast, 2, expectedType, foam);
660 }
661 return foam;
662 }
663 }
664 else {
665 return foam;
666 }
667}
668
669localstatic Foam
670gen0NilValue(TForm tf)
671{
672 tf = tfIgnoreExceptions(tf);
673 if (!tfIsMulti(tf)(((tf)->tag) == TF_Multiple)) {
674 return foamNewNil()foamNew(FOAM_Nil, (int) 0);
675 }
676 else {
677 Foam fakeValue = foamNewEmpty(FOAM_Values, tfMultiArgc(tf));
678 int i;
679
680 for (i = 0; i < tfMultiArgc(tf); i++) {
681 FoamTag type = gen0Type(tfMultiArgN(tf, i)tfFollowArg(tf, i), NULL((void*)0));
682 fakeValue->foamValues.argv[i] = foamNewCast(type, foamNewNil())foamNew(FOAM_Cast, 2, type, foamNew(FOAM_Nil, (int) 0));
683 }
684 return fakeValue;
685 }
686}
687
688
689Foam
690genFoamType(AbSyn ab)
691{
692 AbEmbed tc = abTContext(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->embed : 0);
693 Foam val;
694
695 abSetTContext(ab, AB_Embed_Identity(((AbEmbed) 1) << 0));
696 val = genFoamVal(ab);
697 abSetTContext(ab, tc);
698
699 return val;
700}
701
702Foam
703genFoamCast(Foam foam, AbSyn ab, FoamTag type)
704{
705 if (type != gen0Type(gen0AbContextType(ab), NULL((void*)0)))
706 foam = foamNewCast(type, foam)foamNew(FOAM_Cast, 2, type, foam);
707
708 return foam;
709}
710
711Foam
712genFoamBit(AbSyn ab)
713{
714 return genFoamCast(genFoamVal(ab), ab, FOAM_Bool);
715}
716
717/*****************************************************************************
718 *
719 * :: Main recursive entry point.
720 *
721 ****************************************************************************/
722
723localstatic Foam
724genFoam(AbSyn absyn)
725{
726 static int genDepth = 0;
727 Foam foam = 0;
728 AbSynTag tag;
729 String msg;
730
731 if (!absyn) return NULL((void*)0);
732
733 tag = abTag(absyn)((absyn)->abHdr.tag);
734
735 genDepth += 1;
736
737 if (DEBUG(genf)genfDebug) {
738 fprintf(dbOut, "%*sGenerating %s from ",
739 genDepth, "", abInfo(tag)abInfoTable[(tag) - AB_START].str);
740 sposPrint(dbOut, abPos(absyn)(spstackFirst((absyn)->abHdr.pos)));
741 fprintf(dbOut, "\n");
742 }
743
744 switch (tag) {
745 case AB_Apply:
746 foam = genApply(absyn);
747 break;
748 case AB_Assert:
749 foam = genAssert(absyn);
750 break;
751 case AB_Assign:
752 foam = genAssign(absyn);
753 break;
754 case AB_Id:
755 foam = genId(absyn);
756 break;
757 case AB_LitInteger:
758 case AB_LitFloat:
759 case AB_LitString:
760 foam = genLit(absyn);
761 break;
762 case AB_If:
763 foam = genIf(absyn);
764 break;
765 case AB_Try:
766 foam = genTry(absyn);
767 break;
768 case AB_Raise:
769 foam = gen0Raise(absyn);
770 break;
771 case AB_Generate:
772 foam = genGenerate(absyn);
773 break;
774 case AB_Collect:
775 foam = genCollect(absyn);
776 break;
777 case AB_Lambda:
778 case AB_PLambda:
779 foam = gen0Lambda(absyn, NULL((void*)0), NULL((void*)0));
780 break;
781 case AB_Do:
782 foam = genFoam(absyn->abDo.expr);
783 break;
784 case AB_Sequence:
785 foam = genSequence(absyn);
786 break;
787 case AB_Define:
788 foam = genDefine(absyn);
789 break;
790 case AB_Label:
791 foam = genLabel(absyn);
792 break;
793 case AB_Goto:
794 foam = genGoto(absyn);
795 break;
796 case AB_Not:
797 foam = foamNotThis(genFoamBit(absyn->abNot.expr));
798 foam = foamNewCast(FOAM_Word, foam)foamNew(FOAM_Cast, 2, FOAM_Word, foam);
799 break;
800 case AB_Or:
801 foam = genOr(absyn);
802 break;
803 case AB_And:
804 foam = genAnd(absyn);
805 break;
806 case AB_Reference:
807 foam = genReference(absyn);
808 break;
809 case AB_Repeat:
810 foam = genRepeat(absyn);
811 break;
812 case AB_Yield:
813 foam = genYield(absyn);
814 break;
815 case AB_Add:
816 foam = genAdd(absyn);
817 break;
818 case AB_Return:
819 genReturn(absyn);
820 break;
821 case AB_Break:
822 gen0AddStmt(gen0FoamNewBreak()foamNew(FOAM_Goto, 1, (AInt)(gen0BreakLabel)), absyn);
823 break;
824 case AB_Iterate:
825 gen0AddStmt(gen0FoamNewIterate()foamNew(FOAM_Goto, 1, (AInt)(gen0IterateLabel)), absyn);
826 break;
827 case AB_Never:
828 genNever(absyn);
829 break;
830 case AB_CoerceTo:
831 foam = genImplicit(absyn, absyn->abCoerceTo.expr,
832 gen0Type(gen0AbType(absyn), NULL((void*)0)));
833 break;
834 case AB_PretendTo:
835 foam = genPretend(absyn);
836 break;
837 case AB_RestrictTo:
838 foam = genRestrict(absyn);
839 break;
840 case AB_Qualify:
841 foam = genFoam(absyn->abQualify.what);
842 break;
843 case AB_Except:
844 foam = genExcept(absyn);
845 break;
846 case AB_Test:
847 foam = genImplicit(absyn, absyn->abTest.cond, FOAM_Bool);
848 break;
849 case AB_Local: {
850 int i;
851 for (i=0; i<abArgc(absyn)((absyn)->abHdr.argc); i++)
852 genFoamStmt(absyn->abLocal.argv[i]);
853 break;
854 }
855 case AB_Fluid: {
856 int i;
857 for (i=0; i<abArgc(absyn)((absyn)->abHdr.argc); i++) {
858 if (abTag(absyn->abFluid.argv[i])((absyn->abFluid.argv[i])->abHdr.tag) == AB_Assign)
859 gen0AddLocalFluid(
860 absyn->abFluid.argv[i]->abAssign.lhs);
861 genFoamStmt(absyn->abFluid.argv[i]);
862 }
863 break;
864 }
865 case AB_Free: {
866 int i;
867 for (i=0; i<abArgc(absyn)((absyn)->abHdr.argc); i++)
868 genFoamStmt(absyn->abFree.argv[i]);
869 break;
870 }
871 case AB_Comma:
872 foam = genMulti(absyn);
873 break;
874 case AB_Where:
875 foam = genWhere(absyn);
876 break;
877 case AB_Declare:
878 if (gen0ValueMode)
879 foam = genFoamVal(absyn->abDeclare.id);
880 break;
881 case AB_Builtin:
882 case AB_Import:
883 case AB_Nothing:
884 case AB_Inline:
885 break;
886 case AB_ForeignImport:
887 genForeignImport(absyn);
888 break;
889 case AB_ForeignExport:
890 genForeignExport(absyn);
891 break;
892 case AB_Has:
893 foam = genHas(absyn);
894 break;
895 case AB_With:
896 foam = genWith(absyn);
897 break;
898 case AB_Default:
899 genFoamStmt(absyn->abDefault.body);
900 break;
901 case AB_Export:
902 genExport(absyn);
903 break;
904 case AB_Extend:
905 genFoam(absyn->abExtend.body);
906 break;
907 case AB_Select:
908 foam = genSelect(absyn);
909 break;
910 default:
911 msg = strPrintf("unsupported absyn (%s) found by genFoam",
912 abInfo(abTag(absyn))abInfoTable[(((absyn)->abHdr.tag)) - AB_START].str);
913 comsgFatal(absyn, ALDOR_F_Bug365, msg);
914#if 0
915 sposPrint(stdoutstdout, abPos(absyn)(spstackFirst((absyn)->abHdr.pos)));
916 fprintf (stdoutstdout, " abTag = %s\n", abInfo(abTag(absyn))abInfoTable[(((absyn)->abHdr.tag)) - AB_START].str);
917 bug("genFoam");
918#endif
919 }
920
921 if (foam && abEmbedArg(absyn)(((absyn)->abHdr.seman ? (absyn)->abHdr.seman->embed
: 0) & (~((((AbEmbed) 1) << 12) | (((AbEmbed) 1) <<
13))))
)
922 foam = gen0Embed(foam, absyn, gen0AbType(absyn),
923 abEmbedArg(absyn)(((absyn)->abHdr.seman ? (absyn)->abHdr.seman->embed
: 0) & (~((((AbEmbed) 1) << 12) | (((AbEmbed) 1) <<
13))))
);
924 genDepth -= 1;
925
926 return foam;
927}
928
929/*****************************************************************************
930 *
931 * :: Specific generators.
932 *
933 ****************************************************************************/
934
935/*
936 * Generate code for export to Builtin.
937*/
938localstatic Foam
939genExport(AbSyn absyn)
940{
941 AbSyn what = absyn->abExport.what;
942 Symbol sym = gen0ExportingTo(absyn->abExport.destination);
943 int i, argc;
944 AbSyn *argv;
945
946 if (!sym) return 0;
947
948 AB_SEQ_ITER(what, argc, argv){ switch (((what)->abHdr.tag)) { case AB_Nothing: argc = 0
; argv = 0; break; case AB_Sequence: argc = ((what)->abHdr
.argc); argv = ((what)->abGen.data.argv); break; default: argc
= 1; argv = &what; break; }; }
;
949
950 for (i = 0; i < argc; i += 1) {
951 AbSyn ab = argv[i];
952 genFoamStmt(ab);
953 if (sym == ssymBuiltin)
954 gen0ExportToBuiltin(ab);
955 else if (sym == ssymC)
956 gen0ExportToC(ab);
957 else if (sym == ssymFortran)
958 gen0ExportToFortran(ab);
959 }
960 return 0;
961}
962
963localstatic Symbol
964gen0ExportingTo(AbSyn absyn)
965{
966 if (abIsApplyOf(absyn, ssymForeign)(((absyn)->abHdr.tag == (AB_Apply)) && (((((absyn)
->abApply.op))->abHdr.tag == (AB_Id)) && ((((absyn
)->abApply.op))->abId.sym)==(ssymForeign)))
&&
967 abApplyArgc(absyn)(((absyn)->abHdr.argc)-1) == 1) {
968 AbSyn fType = abApplyArg(absyn, int0)((absyn)->abApply.argv[((int) 0)]);
969 if (abTag(fType)((fType)->abHdr.tag) == AB_Id) {
970 return fType->abId.sym;
971 }
972 else if (abTag(fType)((fType)->abHdr.tag) == AB_Apply &&
973 abIsId(abApplyOp(fType))((((fType)->abApply.op))->abHdr.tag == (AB_Id))) {
974 return abIdSym(abApplyOp(fType))((((fType)->abApply.op))->abId.sym);
975 }
976 else
977 return NULL((void*)0);
978 }
979 else
980 return NULL((void*)0);
981}
982
983/*
984 * Create a global variable binding for exporting to Builtin.
985 */
986localstatic void
987gen0ExportToBuiltin(AbSyn absyn)
988{
989 AbSyn name = abDefineeId(absyn);
990 Syme syme = abSyme(name)((name)->abHdr.seman ? (name)->abHdr.seman->syme : 0
)
;
991 TForm tf;
992 FoamTag rtype;
993 Foam decl;
994 int index, progId;
995
996 assert(syme)do { if (!(syme)) _do_assert(("syme"),"genfoam.c",996); } while
(0)
;
997 tf = symeType(syme);
998
999 rtype = tfIsMap(tf)(((tf)->tag) == TF_Map) ? gen0Type(tfMapRet(tf)tfFollowArg(tf, 1), NULL((void*)0)) : FOAM_Nil;
1000 decl = foamNewGDecl(gen0Type(tf, NULL), strCopy(symeString(syme)),foamNew(FOAM_GDecl,6,(AInt)(gen0Type(tf, ((void*)0))),strCopy
(((((syme)->id))->str)), rtype,4, (AInt)(FOAM_GDecl_Export
),(AInt)(FOAM_Proto_Foam))
1001 rtype,foamNew(FOAM_GDecl,6,(AInt)(gen0Type(tf, ((void*)0))),strCopy
(((((syme)->id))->str)), rtype,4, (AInt)(FOAM_GDecl_Export
),(AInt)(FOAM_Proto_Foam))
1002 emptyFormatSlot,foamNew(FOAM_GDecl,6,(AInt)(gen0Type(tf, ((void*)0))),strCopy
(((((syme)->id))->str)), rtype,4, (AInt)(FOAM_GDecl_Export
),(AInt)(FOAM_Proto_Foam))
1003 FOAM_GDecl_Export,foamNew(FOAM_GDecl,6,(AInt)(gen0Type(tf, ((void*)0))),strCopy
(((((syme)->id))->str)), rtype,4, (AInt)(FOAM_GDecl_Export
),(AInt)(FOAM_Proto_Foam))
1004 FOAM_Proto_Foam)foamNew(FOAM_GDecl,6,(AInt)(gen0Type(tf, ((void*)0))),strCopy
(((((syme)->id))->str)), rtype,4, (AInt)(FOAM_GDecl_Export
),(AInt)(FOAM_Proto_Foam))
;
1005
1006 index = gen0AddGlobal(decl);
1007
1008 if (!tfIsMap(tf)(((tf)->tag) == TF_Map))
1009 progId = 0;
1010 else if (genIsRuntime()(gen0IsRuntime)) {
1011 Foam glo = foamNewGlo(index)foamNew(FOAM_Glo, 1, (AInt)(index));
1012 progId = 0;
1013 gen0AddStmt(foamNewSet(glo, gen0Syme(syme))foamNew(FOAM_Set, 2, glo, gen0Syme(syme)), absyn);
1014 }
1015 else {
1016 Foam glo = foamNewGlo(index)foamNew(FOAM_Glo, 1, (AInt)(index));
1017 Foam clos = gen0BuiltinExporter(glo, syme);
1018 progId = clos->foamClos.prog->foamConst.index;
1019 gen0AddStmt(foamNewSet(glo, gen0Syme(syme))foamNew(FOAM_Set, 2, glo, gen0Syme(syme)), absyn);
1020 }
1021 gen0BuiltinExports = listCons(AInt)(AInt_listPointer->Cons)(index, gen0BuiltinExports);
1022 gen0BuiltinExports = listCons(AInt)(AInt_listPointer->Cons)(progId, gen0BuiltinExports);
1023}
1024
1025/*
1026 * Create a global variable binding for exporting to C.
1027 */
1028localstatic void
1029gen0ExportToC(AbSyn absyn)
1030{
1031 AbSyn name = abDefineeId(absyn);
1032 Syme syme = abSyme(name)((name)->abHdr.seman ? (name)->abHdr.seman->syme : 0
)
;
1033 TForm tf;
1034 FoamTag rtype;
1035 AInt init = gloInitIdx;
1036 Foam decl;
1037 AInt index;
1038
1039 assert(syme)do { if (!(syme)) _do_assert(("syme"),"genfoam.c",1039); } while
(0)
;
1040 tf = symeType(syme);
1041 rtype = tfIsMap(tf)(((tf)->tag) == TF_Map) ? gen0Type(tfMapRet(tf)tfFollowArg(tf, 1), NULL((void*)0)) : FOAM_Nil;
1042
1043 if (!(gen0State->tag == GF_File &&
1044 stabLevelNo(gen0State->stab)(((gen0State->stab)->first)->lexicalLevel) == 1)) {
1045 AbSyn exporter = gen0ProgGetExporter();
1046 if (exporter && abHasTag(exporter, AB_Id)((exporter)->abHdr.tag == (AB_Id))) {
1047 Syme xsyme = abSyme(exporter)((exporter)->abHdr.seman ? (exporter)->abHdr.seman->
syme : 0)
;
1048 if (xsyme && gen0FoamKind(xsyme)((((FoamTag) (SYFI_FoamKind < (8 * sizeof(int)) &&
!(((((xsyme)->kind == SYME_Trigger ? libGetAllSymes((xsyme
)->lib) : ((void*)0)), (xsyme))->hasmask) & (1 <<
(SYFI_FoamKind))) ? (symeFieldInfo[SYFI_FoamKind].def) : (((
((xsyme)->kind == SYME_Trigger ? libGetAllSymes((xsyme)->
lib) : ((void*)0)), (xsyme))->locmask) & (1 << (
SYFI_FoamKind))) ? ((((((xsyme)->kind == SYME_Trigger ? libGetAllSymes
((xsyme)->lib) : ((void*)0)), (xsyme))->locmask) & (
1 << (SYFI_FoamKind))) ? ((xsyme)->fieldv)[symeIndex
(xsyme,SYFI_FoamKind)] : (symeFieldInfo[SYFI_FoamKind].def)) :
symeGetFieldFn(xsyme,SYFI_FoamKind))) != FOAM_LIMIT) ? ((FoamTag
) (SYFI_FoamKind < (8 * sizeof(int)) && !(((((xsyme
)->kind == SYME_Trigger ? libGetAllSymes((xsyme)->lib) :
((void*)0)), (xsyme))->hasmask) & (1 << (SYFI_FoamKind
))) ? (symeFieldInfo[SYFI_FoamKind].def) : (((((xsyme)->kind
== SYME_Trigger ? libGetAllSymes((xsyme)->lib) : ((void*)
0)), (xsyme))->locmask) & (1 << (SYFI_FoamKind))
) ? ((((((xsyme)->kind == SYME_Trigger ? libGetAllSymes((xsyme
)->lib) : ((void*)0)), (xsyme))->locmask) & (1 <<
(SYFI_FoamKind))) ? ((xsyme)->fieldv)[symeIndex(xsyme,SYFI_FoamKind
)] : (symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn(xsyme
,SYFI_FoamKind))) : ((FoamTag) (SYFI_FoamKind < (8 * sizeof
(int)) && !(((((symeOriginal(xsyme))->kind == SYME_Trigger
? libGetAllSymes((symeOriginal(xsyme))->lib) : ((void*)0)
), (symeOriginal(xsyme)))->hasmask) & (1 << (SYFI_FoamKind
))) ? (symeFieldInfo[SYFI_FoamKind].def) : (((((symeOriginal(
xsyme))->kind == SYME_Trigger ? libGetAllSymes((symeOriginal
(xsyme))->lib) : ((void*)0)), (symeOriginal(xsyme)))->locmask
) & (1 << (SYFI_FoamKind))) ? ((((((symeOriginal(xsyme
))->kind == SYME_Trigger ? libGetAllSymes((symeOriginal(xsyme
))->lib) : ((void*)0)), (symeOriginal(xsyme)))->locmask
) & (1 << (SYFI_FoamKind))) ? ((symeOriginal(xsyme)
)->fieldv)[symeIndex(symeOriginal(xsyme),SYFI_FoamKind)] :
(symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn(symeOriginal
(xsyme),SYFI_FoamKind))))
== FOAM_Glo)
1049 init = gen0VarIndex(abSyme(exporter))((((UShort) ((((((((exporter)->abHdr.seman ? (exporter)->
abHdr.seman->syme : 0))->kind == SYME_Trigger ? libGetAllSymes
((((exporter)->abHdr.seman ? (exporter)->abHdr.seman->
syme : 0))->lib) : ((void*)0)), (((exporter)->abHdr.seman
? (exporter)->abHdr.seman->syme : 0)))->locmask) &
(1 << (SYFI_VarIndex))) ? ((((exporter)->abHdr.seman
? (exporter)->abHdr.seman->syme : 0))->fieldv)[symeIndex
(((exporter)->abHdr.seman ? (exporter)->abHdr.seman->
syme : 0),SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def
))) != (0x7FFF)) ? ((UShort) ((((((((exporter)->abHdr.seman
? (exporter)->abHdr.seman->syme : 0))->kind == SYME_Trigger
? libGetAllSymes((((exporter)->abHdr.seman ? (exporter)->
abHdr.seman->syme : 0))->lib) : ((void*)0)), (((exporter
)->abHdr.seman ? (exporter)->abHdr.seman->syme : 0))
)->locmask) & (1 << (SYFI_VarIndex))) ? ((((exporter
)->abHdr.seman ? (exporter)->abHdr.seman->syme : 0))
->fieldv)[symeIndex(((exporter)->abHdr.seman ? (exporter
)->abHdr.seman->syme : 0),SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))) : ((UShort) ((((((symeOriginal(((exporter
)->abHdr.seman ? (exporter)->abHdr.seman->syme : 0))
)->kind == SYME_Trigger ? libGetAllSymes((symeOriginal(((exporter
)->abHdr.seman ? (exporter)->abHdr.seman->syme : 0))
)->lib) : ((void*)0)), (symeOriginal(((exporter)->abHdr
.seman ? (exporter)->abHdr.seman->syme : 0))))->locmask
) & (1 << (SYFI_VarIndex))) ? ((symeOriginal(((exporter
)->abHdr.seman ? (exporter)->abHdr.seman->syme : 0))
)->fieldv)[symeIndex(symeOriginal(((exporter)->abHdr.seman
? (exporter)->abHdr.seman->syme : 0)),SYFI_VarIndex)] :
(symeFieldInfo[SYFI_VarIndex].def))))
;
1050 }
1051 }
1052
1053 /*!! Assumes export to C is exporting a function! */
1054 decl = foamNewGDecl(FOAM_Clos, strCopy(symeString(syme)),foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy(((((syme)->
id))->str)), rtype,init, (AInt)(FOAM_GDecl_Export),(AInt)(
FOAM_Proto_C))
1055 rtype, init, FOAM_GDecl_Export,foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy(((((syme)->
id))->str)), rtype,init, (AInt)(FOAM_GDecl_Export),(AInt)(
FOAM_Proto_C))
1056 FOAM_Proto_C)foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy(((((syme)->
id))->str)), rtype,init, (AInt)(FOAM_GDecl_Export),(AInt)(
FOAM_Proto_C))
;
1057
1058 index = gen0AddGlobal(decl);
1059 gen0BuiltinExports = listCons(AInt)(AInt_listPointer->Cons)(index, gen0BuiltinExports);
1060 gen0BuiltinExports = listCons(AInt)(AInt_listPointer->Cons)(int0((int) 0), gen0BuiltinExports);
1061
1062 gen0AddStmt(foamNewSet(foamNewGlo(index), gen0Syme(syme))foamNew(FOAM_Set, 2, foamNew(FOAM_Glo, 1, (AInt)(index)), gen0Syme
(syme))
, absyn);
1063}
1064
1065
1066/*
1067 * Generate Foreign inclusion hints.
1068 */
1069localstatic Foam
1070genForeignImport(AbSyn absyn)
1071{
1072 AbSyn origin = absyn->abForeignImport.origin;
1073 ForeignOrigin forg;
1074 Foam decl;
1075
1076 /*
1077 * Skip Foreign(Builtin): it was invented by the compiler
1078 * in abnImport() as a useful way of getting qualified
1079 * imports. However, we don't want forgFrAbSyn complaining
1080 * that it isn't a valid protocol (it isn't).
1081 */
1082 if (abIsTheId(origin, ssymBuiltin)(((origin)->abHdr.tag == (AB_Id)) && ((origin)->
abId.sym)==(ssymBuiltin))
) return (Foam)NULL((void*)0);
1083
1084
1085 /* Where are these imports coming from? */
1086 forg = forgFrAbSyn(origin);
1087
1088
1089 /* If they don't specify include files then do nothing */
1090 if (!forg->file) return (Foam)NULL((void*)0);
1091
1092
1093 /* Java stuff doesn't count */
1094 if (foamProtoBase(forg->protocol)((foamProtoInfoTable[(int)(forg->protocol)-(int)FOAM_PROTO_START
]).base)
== FOAM_Proto_Java)
1095 return (Foam) NULL((void*)0);
1096
1097 /* Global declaration */
1098 decl = foamNewGDecl(FOAM_Word, strCopy(forg->file),foamNew(FOAM_GDecl,6,(AInt)(FOAM_Word),strCopy(forg->file)
, FOAM_Nil,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Include
))
1099 FOAM_Nil, emptyFormatSlot,foamNew(FOAM_GDecl,6,(AInt)(FOAM_Word),strCopy(forg->file)
, FOAM_Nil,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Include
))
1100 FOAM_GDecl_Import, FOAM_Proto_Include)foamNew(FOAM_GDecl,6,(AInt)(FOAM_Word),strCopy(forg->file)
, FOAM_Nil,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Include
))
;
1101
1102 gen0AddGlobal(decl);
1103 return (Foam)NULL((void*)0);
1104}
1105
1106/*
1107 * Generate Foreign inclusion hints.
1108 */
1109localstatic Foam
1110genForeignExport(AbSyn absyn)
1111{
1112 AbSyn what = absyn->abForeignExport.what;
1113 AbSyn dest = absyn->abForeignExport.dest;
1114 AbSyn *argv;
1115 Symbol sym = gen0ExportingTo(dest);
1116 int argc, i;
1117
1118 AB_SEQ_ITER(what, argc, argv){ switch (((what)->abHdr.tag)) { case AB_Nothing: argc = 0
; argv = 0; break; case AB_Sequence: argc = ((what)->abHdr
.argc); argv = ((what)->abGen.data.argv); break; default: argc
= 1; argv = &what; break; }; }
;
1119
1120 for (i = 0; i < argc; i += 1) {
1121 AbSyn ab = argv[i];
1122 genFoamStmt(ab);
1123 if (sym == ssymBuiltin)
1124 gen0ExportToBuiltin(ab);
1125 else if (sym == ssymC)
1126 gen0ExportToC(ab);
1127 else if (sym == ssymFortran)
1128 gen0ExportToFortran(ab);
1129 else if (sym == ssymJava)
1130 gfjExportToJava(ab, dest);
1131 else
1132 comsgFatal(ab, ALDOR_F_Bug365, "Export not implemented");
1133 }
1134 return 0;
1135
1136}
1137
1138localstatic Foam
1139genNever(AbSyn absyn)
1140{
1141 assert(abUse(absyn) != AB_Use_Elided)do { if (!(((absyn)->abHdr.use) != AB_Use_Elided)) _do_assert
(("abUse(absyn) != AB_Use_Elided"),"genfoam.c",1141); } while
(0)
;
1142
1143 gen0AddStmt(foamNew(FOAM_BCall, 2,
1144 FOAM_BVal_Halt,
1145 foamNewSInt(FOAM_Halt_NeverReached)foamNew(FOAM_SInt, 1, (AInt)(FOAM_Halt_NeverReached))),
1146 absyn);
1147 return (Foam)NULL((void*)0);
1148}
1149
1150localstatic Foam
1151genAssert(AbSyn absyn)
1152{
1153 AbSyn test = absyn->abAssert.test;
1154 Foam call;
1155 String file, text;
1156 int l1, line;
1157
1158 if (optIsIgnoreAssertsWanted())
1159 return NULL((void*)0);
1160
1161 /* !!! We should try and record where this assertion is */
1162 l1 = gen0State->labelNo++;
1163 gen0AddStmt(foamNewIf(genFoamBit(absyn->abAssert.test), l1)foamNew(FOAM_If, 2, genFoamBit(absyn->abAssert.test), l1), absyn);
1164
1165 file = fnameName(sposFile(abPos(test)))((sposFile((spstackFirst((test)->abHdr.pos))))->partv[1
])
;
1166 line = sposLine(abPos(test)(spstackFirst((test)->abHdr.pos)));
1167 text = abPretty(test);
1168 call = gen0BuiltinCCall(FOAM_NOp, "rtAssertMessage", "runtime",
1169 3, gen0CharArray(file),
1170 foamNewSInt(line)foamNew(FOAM_SInt, 1, (AInt)(line)),
1171 gen0CharArray(text));
1172 gen0AddStmt(call, absyn);
1173 gen0AddStmt(foamNew(FOAM_BCall, 2,
1174 FOAM_BVal_Halt,
1175 foamNewSInt(FOAM_Halt_AssertFailed)foamNew(FOAM_SInt, 1, (AInt)(FOAM_Halt_AssertFailed))),
1176 absyn);
1177 gen0AddStmt(foamNewLabel(l1)foamNew(FOAM_Label, 1, (AInt)(l1)), absyn);
1178
1179 return NULL((void*)0);
1180}
1181
1182/*
1183 * Generate code for multiple values.
1184 */
1185localstatic Foam
1186genMulti(AbSyn absyn)
1187{
1188 Foam values, var, val;
1189 AInt type, fmt;
1190 int i;
1191
1192 if (gen0ValueMode) {
1193 values = foamNewEmpty(FOAM_Values, abArgc(absyn)((absyn)->abHdr.argc));
1194 for (i = 0; i < abArgc(absyn)((absyn)->abHdr.argc); i++) {
1195 TForm tfi = abTUnique(abArgv(absyn)[i])((((absyn)->abGen.data.argv)[i])->abHdr.type.unique);
1196 val = genFoamVal(abArgv(absyn)((absyn)->abGen.data.argv)[i]);
1197 type = gen0Type(tfi, &fmt);
1198 /* NB: Poss issue here (fix: var = gen0TempLex0(type, fmt);) */
1199 var = gen0TempLocal0(type, fmt);
1200 values->foamValues.argv[i] = var;
1201 gen0AddStmt(foamNewSet(foamCopy(var), val)foamNew(FOAM_Set, 2, foamCopy(var), val), NULL((void*)0));
1202 }
1203 return values;
1204 }
1205 else {
1206 for (i = 0; i < abArgc(absyn)((absyn)->abHdr.argc); i++)
1207 genFoamStmt(absyn->abComma.argv[i]);
1208 values = NULL((void*)0);
1209 }
1210 return values;
1211}
1212
1213/*
1214 * Create a tuple.
1215 */
1216Foam
1217gen0MakeTuple(Length argc, AbSyn *argv, AbSyn absyn)
1218{
1219 Length i;
1220 AbSyn abi;
1221 Foam vars[2], tupl, elts, elt;
1222
1223 gen0MakeEmptyTuple(foamNewSInt(argc)foamNew(FOAM_SInt, 1, (AInt)(argc)), vars, absyn);
1224 tupl = vars[0];
1225 elts = vars[1];
1226
1227 for (i = 0; i < argc; i += 1) {
1228 abi = gen0AbTypeArg(argv[i]);
1229 elt = genFoamCast(genFoamVal(abi), abi, FOAM_Word);
1230 gen0AddStmt(gen0ASet(elts, (AInt) i, FOAM_Word, elt)foamNew(FOAM_Set, 2, foamNew(FOAM_AElt,3,(AInt)(FOAM_Word),foamNew
(FOAM_SInt, 1, (AInt)((AInt) i)),foamCopy(elts)), elt)
, absyn);
1231 }
1232
1233 /*!! This should be a callout to tuple$Tuple(S) */
1234 return tupl;
1235}
1236
1237localstatic AbSyn
1238gen0AbTypeArg(AbSyn ab)
1239{
1240 Bool changed = true1;
1241
1242 while (changed)
1243 switch (abTag(ab)((ab)->abHdr.tag)) {
1244 case AB_Declare:
1245 ab = ab->abDeclare.type;
1246 break;
1247 case AB_Define:
1248 ab = ab->abDefine.lhs;
1249 break;
1250 default:
1251 changed = false((int) 0);
1252 break;
1253 }
1254
1255 return ab;
1256}
1257
1258
1259/*
1260 * Create a tuple.
1261 */
1262Foam
1263gen0MakeCross(Length argc, AbSyn *argv, AbSyn op)
1264{
1265 TForm tf = tfMapArgN(gen0AbContextType(op), int0((int) 0));
1266 AbSyn elt;
1267 AInt cfmt, ftype;
1268 Foam t;
1269 Length i;
1270
1271
1272 tf = tfDefineeType(tf);
1273 assert(tfIsCross(tf))do { if (!((((tf)->tag) == TF_Cross))) _do_assert(("tfIsCross(tf)"
),"genfoam.c",1273); } while (0)
;
1274
1275 ftype = gen0Type(tf, &cfmt);
1276 cfmt = gen0CrossFormatNumber(tf);
1277 t = gen0TempLocal0(FOAM_Rec, cfmt);
1278
1279 gen0SetTemp(t, foamNewRNew(cfmt)foamNew(FOAM_RNew, 1, cfmt));
1280
1281 for (i = 0; i < argc; i += 1) {
1282 elt = gen0AbTypeArg(argv[i]);
1283 gen0AddStmt(foamNewSet(foamNewRElt(cfmt, foamCopy(t), i),foamNew(FOAM_Set, 2, foamNew(FOAM_RElt,3,(AInt)(cfmt),foamCopy
(t),(AInt)(i)), genFoamVal(elt))
1284 genFoamVal(elt))foamNew(FOAM_Set, 2, foamNew(FOAM_RElt,3,(AInt)(cfmt),foamCopy
(t),(AInt)(i)), genFoamVal(elt))
, op);
1285 }
1286
1287 /*!! This should be a callout to tuple$Tuple(S) */
1288 return foamNewCast(FOAM_Word, t)foamNew(FOAM_Cast, 2, FOAM_Word, t);
1289}
1290
1291/*
1292 * Generate code for labelled expressions.
1293 */
1294localstatic Foam
1295genLabel(AbSyn absyn)
1296{
1297 Syme syme = abSyme(absyn->abLabel.label)((absyn->abLabel.label)->abHdr.seman ? (absyn->abLabel
.label)->abHdr.seman->syme : 0)
;
1298
1299 assert(syme)do { if (!(syme)) _do_assert(("syme"),"genfoam.c",1299); } while
(0)
;
1300 if (symeDVMark(syme)((UShort) (SYFI_DVMark < (8 * sizeof(int)) && !(((
((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->hasmask) & (1 << (SYFI_DVMark
))) ? (symeFieldInfo[SYFI_DVMark].def) : (((((syme)->kind ==
SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0)),
(syme))->locmask) & (1 << (SYFI_DVMark))) ? (((
(((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_DVMark
))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_DVMark)] : (symeFieldInfo
[SYFI_DVMark].def)) : symeGetFieldFn(syme,SYFI_DVMark)))
> 0)
1301 gen0AddStmt(foamNewLabel(gen0VarIndex(syme))foamNew(FOAM_Label, 1, (AInt)(((((UShort) ((((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_VarIndex))) ?
((syme)->fieldv)[symeIndex(syme,SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))) != (0x7FFF)) ? ((UShort) ((((((syme)->
kind == SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void
*)0)), (syme))->locmask) & (1 << (SYFI_VarIndex)
)) ? ((syme)->fieldv)[symeIndex(syme,SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))) : ((UShort) ((((((symeOriginal(syme))->
kind == SYME_Trigger ? libGetAllSymes((symeOriginal(syme))->
lib) : ((void*)0)), (symeOriginal(syme)))->locmask) & (
1 << (SYFI_VarIndex))) ? ((symeOriginal(syme))->fieldv
)[symeIndex(symeOriginal(syme),SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))))))
, absyn);
1302
1303 return genFoam(absyn->abLabel.expr);
1304}
1305
1306/*
1307 * Generate code for a gotos.
1308 */
1309localstatic Foam
1310genGoto(AbSyn absyn)
1311{
1312 Syme syme = abSyme(absyn->abGoto.label)((absyn->abGoto.label)->abHdr.seman ? (absyn->abGoto
.label)->abHdr.seman->syme : 0)
;
1313
1314 assert(syme)do { if (!(syme)) _do_assert(("syme"),"genfoam.c",1314); } while
(0)
;
1315 gen0AddStmt(foamNewGoto(gen0VarIndex(syme))foamNew(FOAM_Goto, 1, (AInt)(((((UShort) ((((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_VarIndex))) ?
((syme)->fieldv)[symeIndex(syme,SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))) != (0x7FFF)) ? ((UShort) ((((((syme)->
kind == SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void
*)0)), (syme))->locmask) & (1 << (SYFI_VarIndex)
)) ? ((syme)->fieldv)[symeIndex(syme,SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))) : ((UShort) ((((((symeOriginal(syme))->
kind == SYME_Trigger ? libGetAllSymes((symeOriginal(syme))->
lib) : ((void*)0)), (symeOriginal(syme)))->locmask) & (
1 << (SYFI_VarIndex))) ? ((symeOriginal(syme))->fieldv
)[symeIndex(symeOriginal(syme),SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))))))
, absyn);
1316
1317 return 0;
1318}
1319
1320/*
1321 * Generate code for where clauses.
1322 */
1323localstatic Foam
1324genWhere(AbSyn absyn)
1325{
1326 Foam foam, lexicals, push, envVar;
1327 FoamList pushEnvPlace;
1328 FoamList lowerSavedLines;
1329 int index, nindex;
1330 Bool flag;
1331
1332 index = gen0FormatNum--;
1333
1334 flag = gen0AddImportPlace(&lowerSavedLines);
1335
1336 /* Save a place for a PushEnv, if needed. */
1337 gen0AddStmt(foamNewNOp()foamNew(FOAM_NOp, (int) 0), absyn);
1338 pushEnvPlace = gen0State->lines;
1339 envVar = gen0Temp(FOAM_Env)gen0Temp0(FOAM_Env, 4);
1340
1341 gen0State->envVarStack =
1342 listCons(Foam)(Foam_listPointer->Cons)(envVar, gen0State->envVarStack);
1343 gen0State->envFormatStack =
1344 listCons(AInt)(AInt_listPointer->Cons)(index, gen0State->envFormatStack);
1345 gen0State->envLexPools =
1346 listCons(VarPool)(VarPool_listPointer->Cons)(gen0State->lexPool,
1347 gen0State->envLexPools);
1348 gen0State->lexPool = vpNew(fboxNew(foamNewEmptyDDecl(FOAM_DDecl_LocalEnv)foamNew(FOAM_DDecl, 1, (AInt) FOAM_DDecl_LocalEnv)));
1349
1350 gen0State->importPlacePrev =
1351 listCons(AInt)(AInt_listPointer->Cons)((AInt) gen0State->importPlace,
1352 gen0State->importPlacePrev);
1353
1354 gen0State->importPlace = NULL((void*)0);
1355
1356 gen0State->whereNest++;
1357 gen0Vars(abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
);
1358
1359 genFoamStmt(absyn->abWhere.context);
1360 foam = genFoamVal(absyn->abWhere.expr);
1361 gen0State->whereNest--;
1362
1363 /* Create the lexicals. */
1364 lexicals = fboxMake(gen0State->lexPool->fbox);
1365 /* always push an env, as we don't track usage of where envs */
1366 nindex = gen0RealFormatNum++;
1367 gen0FormatList = listCons(Foam)(Foam_listPointer->Cons)(lexicals, gen0FormatList);
1368 push = foamNewSet(foamCopy(envVar),foamNew(FOAM_Set, 2, foamCopy(envVar), foamNew(FOAM_PushEnv,2
,nindex,foamCopy(((((gen0State->envVarStack)->rest))->
first))))
1369 foamNewPushEnv(nindex,foamNew(FOAM_Set, 2, foamCopy(envVar), foamNew(FOAM_PushEnv,2
,nindex,foamCopy(((((gen0State->envVarStack)->rest))->
first))))
1370 foamCopy(car(cdr(gen0State->envVarStack)))))foamNew(FOAM_Set, 2, foamCopy(envVar), foamNew(FOAM_PushEnv,2
,nindex,foamCopy(((((gen0State->envVarStack)->rest))->
first))))
;
1371 foamFree(car(pushEnvPlace)((pushEnvPlace)->first));
1372 car(pushEnvPlace)((pushEnvPlace)->first) = push;
1373 foamProgUnsetLeaf(gen0State->program)((gen0State->program)->foamProg.infoBits &= ~(1 <<
1))
;
1374
1375 /* Restore environment state. */
1376 gen0State->lexPool = car(gen0State->envLexPools)((gen0State->envLexPools)->first);
1377 gen0State->importPlace = (FoamList*)
1378 car(gen0State->importPlacePrev)((gen0State->importPlacePrev)->first);
1379 gen0State->importPlacePrev = cdr(gen0State->importPlacePrev)((gen0State->importPlacePrev)->rest);
1380
1381 if (flag) gen0ResetImportPlace(lowerSavedLines);
1382
1383 gen0AddFormat(index, nindex);
1384
1385 gen0State->envVarStack = cdr(gen0State->envVarStack)((gen0State->envVarStack)->rest);
1386 gen0State->envFormatStack = cdr(gen0State->envFormatStack)((gen0State->envFormatStack)->rest);
1387 gen0State->envLexPools = cdr(gen0State->envLexPools)((gen0State->envLexPools)->rest);
1388
1389 return foam;
1390}
1391
1392localstatic Foam
1393genPretend(AbSyn absyn)
1394{
1395 AbSyn expr = absyn->abPretendTo.expr;
1396 FoamTag type = gen0Type(gen0AbType(absyn), NULL((void*)0));
1397
1398 return genFoamCast(genFoamVal(expr), expr, type);
1399}
1400
1401localstatic Foam
1402genRestrict(AbSyn absyn)
1403{
1404 AbSyn expr = absyn->abRestrictTo.expr;
1405
1406 if (abTag(expr)((expr)->abHdr.tag) == AB_Add) {
1407 return gen0AddBody0(expr, abStab(expr)((expr)->abHdr.seman ? (expr)->abHdr.seman->stab : 0
)
,
1408 absyn->abRestrictTo.type);
1409 }
1410 else
1411 return genFoamVal(expr);
1412}
1413
1414localstatic Foam
1415genExcept(AbSyn absyn)
1416{
1417 /*
1418 * This is maybe a bit too simple, esp. if hashcodes
1419 * change under excepts.
1420 */
1421 return genFoamVal(absyn->abExcept.type);
1422}
1423
1424
1425Foam
1426genImplicit(AbSyn absyn, AbSyn val, FoamTag type)
1427{
1428 Syme syme = abImplicitSyme(absyn)(((absyn)->abHdr.seman ? (absyn)->abHdr.seman->implicit
: 0) ? ((((absyn)->abHdr.seman ? (absyn)->abHdr.seman->
implicit : 0))->abHdr.seman ? (((absyn)->abHdr.seman ? (
absyn)->abHdr.seman->implicit : 0))->abHdr.seman->
syme : 0) : 0)
;
1429 AbSyn *argv = NULL((void*)0);
1430 Foam foam;
1431 if (!syme) {
1432 foam = genFoamVal(val);
1433 if (gen0Type(gen0AbContextType(val), NULL((void*)0)) != type)
1434 foam = foamNewCast(type, foam)foamNew(FOAM_Cast, 2, type, foam);
1435 return foam;
1436 }
1437
1438 argv = gen0MakeImplicitArgs(1, val, abThisArgf);
1439 foam = gen0ApplyImplicitSyme(type, syme, 1, argv, NULL((void*)0));
1440 return gen0ApplyReturn(absyn, syme, gen0AbType(absyn), foam);
1441}
1442
1443localstatic FoamTag gen0CSigType(TForm tf, AInt *fmt);
1444localstatic FoamTag gen0CSigTypeTypedef(Syme syme, AInt *fmt);
1445
1446localstatic Foam
1447genApply(AbSyn absyn)
1448{
1449 AbSyn op = abApplyOp(absyn)((absyn)->abApply.op), *argv = abApplyArgv(absyn)((absyn)->abApply.argv);
1450 TForm tf = gen0AbType(absyn);
1451 Foam foam, *vals, *argloc;
1452 FoamTag type;
1453 Length i, valc;
1454 Bool packed = tfIsPackedMap(gen0AbType(op))(((gen0AbType(op))->tag) == TF_PackedMap);
1455
1456 if (abTag(op)((op)->abHdr.tag) == AB_Qualify && abTag(op->abQualify.what)((op->abQualify.what)->abHdr.tag) == AB_Id)
1457 op = op->abQualify.what;
1458
1459/* printf("BDS: entered genApply\n"); */
1460 if (packed && !tfIsMulti(tf)(((tf)->tag) == TF_Multiple)) tf = tfRawType(tf);
1461/* printf("BDS: done in genApply\n"); */
1462
1463 type = gen0Type(tf, NULL((void*)0));
1464
1465 if (gen0IsSpecialType(absyn))
1466 return gen0ApplySpecialType(absyn);
1467
1468 if (abImplicitSyme(absyn)(((absyn)->abHdr.seman ? (absyn)->abHdr.seman->implicit
: 0) ? ((((absyn)->abHdr.seman ? (absyn)->abHdr.seman->
implicit : 0))->abHdr.seman ? (((absyn)->abHdr.seman ? (
absyn)->abHdr.seman->implicit : 0))->abHdr.seman->
syme : 0) : 0)
) {
1469 Syme syme = abImplicitSyme(absyn)(((absyn)->abHdr.seman ? (absyn)->abHdr.seman->implicit
: 0) ? ((((absyn)->abHdr.seman ? (absyn)->abHdr.seman->
implicit : 0))->abHdr.seman ? (((absyn)->abHdr.seman ? (
absyn)->abHdr.seman->implicit : 0))->abHdr.seman->
syme : 0) : 0)
;
1470 Length argc = abApplyArgc(absyn)(((absyn)->abHdr.argc)-1) + 1;
1471 argv = gen0MakeImplicitArgs(argc, absyn, abArgf);
1472 foam = gen0ApplyImplicitSyme(type, syme, argc, argv, NULL((void*)0));
1473 return gen0ApplyReturn(absyn, syme, tf, foam);
1474 }
1475 else {
1476 /* Generate code for the arguments. */
1477 vals = gen0MakeApplyArgs(abSyme(op)((op)->abHdr.seman ? (op)->abHdr.seman->syme : 0), absyn, &valc);
1478
1479 /* Fill in the operator and leave room for the arguments. */
1480 if (abTag(op)((op)->abHdr.tag) == AB_Id) {
1481 Syme syme = abSyme(op)((op)->abHdr.seman ? (op)->abHdr.seman->syme : 0);
1482
1483 if (symeIsSpecial(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) & (0x0002))
) {
1484 foam = gen0SpecialOp(type, syme, valc, argv, vals);
1485 valc = 0; /* args have been filled in */
1486 argloc = NULL((void*)0);
1487 }
1488 else {
1489 foam = gen0ApplySyme(type, syme, abSymeImpl(op)((op)->abHdr.seman ? (op)->abHdr.seman->impl : 0),
1490 valc, &argloc);
1491 }
1492 }
1493 else {
1494 Foam opFoam = genFoamVal(op);
1495 if (!gen0IsMultiEvaluable(opFoam)) {
1496 Foam loc = gen0TempLocal(FOAM_Clos)gen0TempLocal0(FOAM_Clos, 4);
1497 gen0AddStmt(foamNewSet(foamCopy(loc), opFoam)foamNew(FOAM_Set, 2, foamCopy(loc), opFoam), op);
1498 opFoam = loc;
1499 }
1500 foam = gen0CCallFrFoam(type, opFoam, valc, &argloc);
1501 }
1502
1503 /* Fill in the arguments. */
1504 for (i = 0; i < valc; i += 1) argloc[i] = vals[i];
1505 stoFree(vals);
1506
1507 foam = gen0ApplyReturn(absyn, abSyme(op)((op)->abHdr.seman ? (op)->abHdr.seman->syme : 0), tf, foam);
1508 return foam;
1509 }
1510}
1511
1512/*
1513 * Args are:
1514 * ab: For source code posn
1515 * syme: possibly null symbol meaning
1516 * tf: return type
1517 * foam: the generated call
1518 */
1519Foam
1520gen0ApplyReturn(AbSyn ab, Syme syme, TForm tf, Foam foam)
1521{
1522 /* Explode multiple return values. */
1523 if (tfIsMulti(tf)(((tf)->tag) == TF_Multiple) && !tfIsNone(tf)((((tf)->tag) == TF_Multiple) && tfMultiArgc(tf) ==
0)
&& foamTag(foam)((foam)->hdr.tag) != FOAM_Values) {
1524 Foam stmt;
1525
1526 foam = gen1ApplyReturn(ab, syme, tf, foam, &stmt);
1527 gen0AddStmt(stmt, ab);
1528 }
1529 /* Fixup fortran calls. */
1530 /* We should do the argument mangling when generating the args,
1531 * not at this late stage
1532 */
1533 if (syme && symeIsForeign(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Foreign)
&&
1534 symeForeign(syme)((ForeignOrigin) (SYFI_Foreign < (8 * sizeof(int)) &&
!(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->hasmask) & (1 <<
(SYFI_Foreign))) ? (symeFieldInfo[SYFI_Foreign].def) : (((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_Foreign
))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes((
syme)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_Foreign))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_Foreign
)] : (symeFieldInfo[SYFI_Foreign].def)) : symeGetFieldFn(syme
,SYFI_Foreign)))
->protocol == FOAM_Proto_Fortran) {
1535 /*
1536 * Handle a call to a Fortran routine which has modifiable
1537 * dummy arguments or which has a complex result/fn parameter
1538 * and the value of the expression is required
1539 */
1540 foam = gen0ModifyFortranCall(syme, foam, gen0FortranFnResult,
1541 gen0ValueMode);
1542 }
1543
1544 return(foam);
1545}
1546
1547Foam
1548gen1ApplyReturn(AbSyn ab, Syme syme, TForm tf, Foam foam, Foam *f)
1549{
1550 /*
1551 * Use this routine if you don't want to add statements
1552 * to the current closure. Make sure that you pass a
1553 * valid pointer for `f' otherwise you're in trouble.
1554 * Note that we don't do any argument mangling so you
1555 * can't use this if your function has been imported
1556 * from a language like Fortran.
1557 */
1558 int i;
1559 Foam locs = foamNewEmpty(FOAM_Values, tfMultiArgc(tf));
1560 Foam *argv = locs->foamValues.argv;
1561
1562 /* Explode multiple return values. */
1563 for (i = 0; i < foamArgc(locs)((locs)->hdr.argc); i += 1) {
1564 TForm tfi = tfMultiArgN(tf, i)tfFollowArg(tf, i);
1565 FoamTag tag;
1566 AInt fmt;
1567 tag = gen0Type(tfi, &fmt);
1568 argv[i] = gen0TempLocal0(tag, fmt);
1569 }
1570 foam = foamNewMFmt(gen0MultiFormatNumber(tf), foam)foamNew(FOAM_MFmt, 2, gen0MultiFormatNumber(tf), foam);
1571 *f = foamNewSet(foamCopy(locs), foam)foamNew(FOAM_Set, 2, foamCopy(locs), foam);
1572 return locs;
1573}
1574
1575
1576Bool
1577gen0IsFortranCall(AbSyn ab)
1578{
1579 if (abIsApply(ab)((ab)->abHdr.tag == (AB_Apply)) && abTag(abApplyOp(ab))((((ab)->abApply.op))->abHdr.tag) == AB_Id &&
1580 symeIsForeign(abSyme(abApplyOp(ab)))(((((((((ab)->abApply.op))->abHdr.seman ? (((ab)->abApply
.op))->abHdr.seman->syme : 0))->kind == SYME_Trigger
? libGetAllSymes((((((ab)->abApply.op))->abHdr.seman ?
(((ab)->abApply.op))->abHdr.seman->syme : 0))->lib
) : ((void*)0)), (((((ab)->abApply.op))->abHdr.seman ? (
((ab)->abApply.op))->abHdr.seman->syme : 0)))->kind
) == SYME_Foreign)
&&
1581 symeForeign(abSyme(abApplyOp(ab)))((ForeignOrigin) (SYFI_Foreign < (8 * sizeof(int)) &&
!(((((((((ab)->abApply.op))->abHdr.seman ? (((ab)->
abApply.op))->abHdr.seman->syme : 0))->kind == SYME_Trigger
? libGetAllSymes((((((ab)->abApply.op))->abHdr.seman ?
(((ab)->abApply.op))->abHdr.seman->syme : 0))->lib
) : ((void*)0)), (((((ab)->abApply.op))->abHdr.seman ? (
((ab)->abApply.op))->abHdr.seman->syme : 0)))->hasmask
) & (1 << (SYFI_Foreign))) ? (symeFieldInfo[SYFI_Foreign
].def) : (((((((((ab)->abApply.op))->abHdr.seman ? (((ab
)->abApply.op))->abHdr.seman->syme : 0))->kind ==
SYME_Trigger ? libGetAllSymes((((((ab)->abApply.op))->
abHdr.seman ? (((ab)->abApply.op))->abHdr.seman->syme
: 0))->lib) : ((void*)0)), (((((ab)->abApply.op))->
abHdr.seman ? (((ab)->abApply.op))->abHdr.seman->syme
: 0)))->locmask) & (1 << (SYFI_Foreign))) ? (((
(((((((ab)->abApply.op))->abHdr.seman ? (((ab)->abApply
.op))->abHdr.seman->syme : 0))->kind == SYME_Trigger
? libGetAllSymes((((((ab)->abApply.op))->abHdr.seman ?
(((ab)->abApply.op))->abHdr.seman->syme : 0))->lib
) : ((void*)0)), (((((ab)->abApply.op))->abHdr.seman ? (
((ab)->abApply.op))->abHdr.seman->syme : 0)))->locmask
) & (1 << (SYFI_Foreign))) ? ((((((ab)->abApply.
op))->abHdr.seman ? (((ab)->abApply.op))->abHdr.seman
->syme : 0))->fieldv)[symeIndex(((((ab)->abApply.op)
)->abHdr.seman ? (((ab)->abApply.op))->abHdr.seman->
syme : 0),SYFI_Foreign)] : (symeFieldInfo[SYFI_Foreign].def))
: symeGetFieldFn(((((ab)->abApply.op))->abHdr.seman ? (
((ab)->abApply.op))->abHdr.seman->syme : 0),SYFI_Foreign
)))
->protocol == FOAM_Proto_Fortran)
1582 return true1;
1583 else
1584 return false((int) 0);
1585}
1586
1587
1588localstatic Foam *
1589gen0MakeApplyArgs(Syme syme, AbSyn absyn, Length *valc)
1590{
1591 AbSyn op, *argv, abi;
1592 Length i, argc;
1593 TForm opTf, tfret;
1594 Foam *vals;
1595 Bool ftnfixedret = false((int) 0);
1596 int extraArg = 0;
1597 FortranType ftnType = 0;
1598
1599 op = abApplyOp(absyn)((absyn)->abApply.op);
1600 opTf = gen0AbContextType(op);
1601
1602 /*
1603 * We need to communicate the length of string values returned
1604 * by Fortran functions which have return type FixedString.
1605 * Once we have created the foam it may be too late so we create
1606 * an extra first argument to the function call here into which
1607 * we pass the foam representing the string length. Later when
1608 * the gen0ModifyFortranCall() code is moved further upstream
1609 * this problem will go away.
1610 */
1611 if (gen0IsFortranCall(absyn))
1612 {
1613 /* Extract the return type */
1614 tfret = tfMapRet(opTf)tfFollowArg(opTf, 1);
1615 ftnType = ftnTypeFrDomTForm(tfret);
1616
1617
1618 /* Treat Char and Character in the same way */
1619 if (!ftnType && (gen0Type(tfret, NULL((void*)0)) == FOAM_Char))
1620 ftnType = FTN_Character;
1621
1622
1623 /* Do we need an extra argument for string length? */
1624 switch (ftnType)
1625 {
1626 case FTN_XLString:
1627 /*
1628 * Warn the user about returning String
1629 * values from a Fortran function. This
1630 * ought to be done much earlier when the
1631 * original import statement is parsed.
1632 */
1633 comsgWarning(absyn, ALDOR_W_FtnVarStringRet10);
1634 /* Fall through */
1635 case FTN_Character:
1636 /* Fall through */
1637 case FTN_String:
1638 extraArg = 1;
1639 break;
1640 default:
1641 break;
1642 }
1643
1644
1645 /* Is the return value a fixed-length string? */
1646 ftnfixedret = (ftnType == FTN_String);
1647 }
1648
1649 argc = abApplyArgc(absyn)(((absyn)->abHdr.argc)-1);
1650 argv = abApplyArgv(absyn)((absyn)->abApply.argv);
1651
1652 *valc = tfMapArgc(opTf) + extraArg;
1653 vals = (Foam *) stoAlloc(OB_Other0, (*valc) * sizeof(Foam));
1654
1655 if (abEmbedApply(op)(((op)->abHdr.seman ? (op)->abHdr.seman->embed : 0) &
((((AbEmbed) 1) << 12) | (((AbEmbed) 1) << 13)))
) {
1656 assert(*valc == 1)do { if (!(*valc == 1)) _do_assert(("*valc == 1"),"genfoam.c"
,1656); } while (0)
;
1657 assert(!ftnfixedret)do { if (!(!ftnfixedret)) _do_assert(("!ftnfixedret"),"genfoam.c"
,1657); } while (0)
;
1658 vals[0] = gen0EmbedApply(argc, argv, op, abEmbedApply(op)(((op)->abHdr.seman ? (op)->abHdr.seman->embed : 0) &
((((AbEmbed) 1) << 12) | (((AbEmbed) 1) << 13)))
);
1659 }
1660 else if (argc == 1 && *valc == 0) {
1661 genFoamStmt(argv[0]);
1662 }
1663 else if (argc == 1 && tfIsMulti(gen0AbContextType(tfMapSelectArg(opTf, absyn, 0)))(((gen0AbContextType(tfMapSelectArg(opTf, absyn, 0)))->tag
) == TF_Multiple)
) {
1664 assert(!extraArg)do { if (!(!extraArg)) _do_assert(("!extraArg"),"genfoam.c",1664
); } while (0)
;
1665 Foam val = genFoamVal(argv[0]);
1666 assert(foamTag(val) == FOAM_Values)do { if (!(((val)->hdr.tag) == FOAM_Values)) _do_assert(("foamTag(val) == FOAM_Values"
),"genfoam.c",1666); } while (0)
;
1667 assert(foamArgc(val) == *valc)do { if (!(((val)->hdr.argc) == *valc)) _do_assert(("foamArgc(val) == *valc"
),"genfoam.c",1667); } while (0)
;
1668 for (i = 0; i < *valc; i += 1)
1669 vals[i] = val->foamValues.argv[i];
1670 }
1671 else if (ftnfixedret)
1672 {
1673 /*
1674 * We have a call to a function imported from
1675 * Fortran which returns a FixedString value.
1676 */
1677 AbSyn ab;
1678 TForm tfret = tfMapRet(opTf)tfFollowArg(opTf, 1);
1679
1680 /* <paranoia> */
1681 assert(tfIsAbSyn(tfret))do { if (!(( TF_ABSYN_START <= (((tfret)->tag)) &&
(((tfret)->tag)) < TF_ABSYN_LIMIT))) _do_assert(("tfIsAbSyn(tfret)"
),"genfoam.c",1681); } while (0)
; /* TF_Syntax || TF_General */
1682 ab = tfGetExpr(tfret)((tfret)->__absyn);
1683 assert(abTag(ab) == AB_Apply)do { if (!(((ab)->abHdr.tag) == AB_Apply)) _do_assert(("abTag(ab) == AB_Apply"
),"genfoam.c",1683); } while (0)
;
1684 assert(abArgc(ab) == 2)do { if (!(((ab)->abHdr.argc) == 2)) _do_assert(("abArgc(ab) == 2"
),"genfoam.c",1684); } while (0)
;
1685 ab = abArgv(ab)((ab)->abGen.data.argv)[1];
1686 assert(ab)do { if (!(ab)) _do_assert(("ab"),"genfoam.c",1686); } while (
0)
;
1687 /* </paranoia> */
1688
1689 vals[0] = genFoamVal(ab);
1690 for (i = 1; i < *valc; i += 1) {
1691 abi = tfMapSelectArg(opTf, absyn, i-1);
1692 assert(abi)do { if (!(abi)) _do_assert(("abi"),"genfoam.c",1692); } while
(0)
;
1693 vals[i] = genFoamVal(abi);
1694 }
1695 }
1696 else if (extraArg)
1697 {
1698 /*
1699 * We have a call to a function imported from
1700 * Fortran which returns a Character or String
1701 * result. For Character result then the Fortran
1702 * function really returns a String of length 1
1703 * otherwise it returns a String with length
1704 * that we cannot compute. Use length 0.
1705 */
1706 int len = (ftnType == FTN_Character) ? 1 : 0;
1707 vals[0] = foamNewSInt(len)foamNew(FOAM_SInt, 1, (AInt)(len));
1708 for (i = 1; i < *valc; i += 1) {
1709 abi = tfMapSelectArg(opTf, absyn, i-1);
1710 assert(abi)do { if (!(abi)) _do_assert(("abi"),"genfoam.c",1710); } while
(0)
;
1711 vals[i] = genFoamVal(abi);
1712 }
1713 }
1714 else {
1715 for (i = 0; i < *valc; i += 1) {
1716 FoamTag exprType = gen0Type(tfMapArgN(opTf, i), NULL((void*)0));
1717 FoamTag paramType = gen0TfMapType(syme, opTf, exprType, NULL((void*)0));
1718 abi = tfMapSelectArg(opTf, absyn, i);
1719 assert(abi)do { if (!(abi)) _do_assert(("abi"),"genfoam.c",1719); } while
(0)
;
1720 vals[i] = foamCastIfNeeded(paramType, exprType, genFoamVal(abi));
1721 }
1722 }
1723
1724 return vals;
1725}
1726
1727localstatic Foam
1728gen0EmbedApply(int argc, AbSyn *argv, AbSyn op, AbEmbed embed)
1729{
1730 Foam val;
1731 switch (embed) {
1732 case AB_Embed_ApplyMultiToTuple(((AbEmbed) 1) << 12):
1733 val = gen0MakeTuple(argc, argv, op);
1734 break;
1735 case AB_Embed_ApplyMultiToCross(((AbEmbed) 1) << 13):
1736 val = gen0MakeCross(argc, argv, op);
1737 break;
1738 default:
1739 bugBadCase(embed)bug("Bad case %d (line %d in file %s).", (int) embed, 1739, "genfoam.c"
)
;
1740 val = NULL((void*)0);
1741 break;
1742 }
1743 return val;
1744}
1745
1746/*
1747 * Build a call to a function given by its symbol meaning.
1748 * The args are filled in later.
1749 */
1750localstatic Foam
1751gen0ApplySyme(FoamTag type, Syme syme, SImpl impl,
1752 Length argc, Foam **pargv)
1753{
1754 Foam foam;
1755 Foam *args;
1756 AInt mtype;
1757
1758 mtype = gen0TfMapType(syme, symeType(syme), type, NULL((void*)0));
1759 if (symeIsBuiltin(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Builtin)
)
1760 foam = gen0ApplyBuiltin(syme, argc, &args);
1761
1762 else if (symeIsForeign(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Foreign)
)
1763 foam = gen0ApplyForeign(type, syme, argc, &args);
1764 else if (symeIsImport(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Import)
) {
1765 foam = gen0CCall(mtype, syme, argc, &args);
1766 }
1767 else if (gen0IsOpenCallable(syme, impl) &&
1768 listIsSingleton(gen0State->envFormatStack)((gen0State->envFormatStack) && !((gen0State->envFormatStack
)->rest))
)
1769 foam = gen0OCall(type, syme, argc, &args);
1770 else
1771 foam = gen0CCall(mtype, syme, argc, &args);
1772
1773 if (type != mtype)
1774 foam = foamNewCast(type, foam)foamNew(FOAM_Cast, 2, type, foam);
1775
1776 *pargv = args;
1777 return foam;
1778}
1779
1780localstatic Bool
1781gen0IsOpenCallable(Syme syme, SImpl impl)
1782{
1783
1784/*
1785 * #define isOpenCallable(syme) \
1786 * (fintMode != FINT_LOOP && !gen0IsCatInner() && symeClosure(syme) && \
1787 * (symeIsLexConst(syme) || symeIsExtend(syme) || symeIsExport(syme)))
1788 */
1789 if (fintMode == FINT_LOOP2)
1790 return false((int) 0);
1791 if (gen0IsCatInner())
1792 return false((int) 0);
1793 if (!symeClosure(syme)((Foam) (SYFI_Closure < (8 * sizeof(int)) && !((((
(syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->hasmask) & (1 << (SYFI_Closure
))) ? (symeFieldInfo[SYFI_Closure].def) : (((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_Closure))) ?
((((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_Closure))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_Closure
)] : (symeFieldInfo[SYFI_Closure].def)) : symeGetFieldFn(syme
,SYFI_Closure)))
)
1794 return false((int) 0);
1795
1796 if (!impl || !implIsLocal(impl)((impl)->implGen.hdr.tag == SIMPL_Local))
1797 return false((int) 0);
1798
1799 if (symeIsLexConst(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_LexConst)
)
1800 return true1;
1801 if (symeIsExtend(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Extend)
)
1802 return true1;
1803 if (symeIsExport(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Export)
)
1804 return true1;
1805
1806 return false((int) 0);
1807}
1808
1809
1810/*
1811 * Build a call to a builtin function. The args are filled in later.
1812 */
1813localstatic Foam
1814gen0ApplyBuiltin(Syme syme, Length argc, Foam **pargv)
1815{
1816 Foam foam;
1817
1818 foam = foamNewEmpty(FOAM_BCall, OpSlot1 + argc);
1819 foam->foamBCall.op = symeBuiltin(syme)((FoamBValTag) (SYFI_Builtin < (8 * sizeof(int)) &&
!(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->hasmask) & (1 <<
(SYFI_Builtin))) ? (symeFieldInfo[SYFI_Builtin].def) : (((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_Builtin
))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes((
syme)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_Builtin))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_Builtin
)] : (symeFieldInfo[SYFI_Builtin].def)) : symeGetFieldFn(syme
,SYFI_Builtin)))
;
1820
1821 *pargv = foam->foamBCall.argv;
1822
1823 return foam;
1824}
1825
1826/*
1827 * Build a call to a foreign function. The args are filled in later.
1828 */
1829localstatic Foam
1830gen0ApplyForeign(FoamTag type, Syme syme, Length argc, Foam **pargv)
1831{
1832 Foam foam;
1833 FoamTag objTag = type;
1834
1835 /* printf("BDS: Inside gen0ApplyForeign\n"); */
1836
1837 foam = foamNewEmpty(FOAM_PCall, TypeSlot1 + OpSlot1 + ProtoSlot1 + argc);
1838 foam->foamPCall.type = objTag;
1839 foam->foamPCall.op = gen0ForeignValue(syme);
1840 foam->foamPCall.protocol = symeForeign(syme)((ForeignOrigin) (SYFI_Foreign < (8 * sizeof(int)) &&
!(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->hasmask) & (1 <<
(SYFI_Foreign))) ? (symeFieldInfo[SYFI_Foreign].def) : (((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_Foreign
))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes((
syme)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_Foreign))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_Foreign
)] : (symeFieldInfo[SYFI_Foreign].def)) : symeGetFieldFn(syme
,SYFI_Foreign)))
->protocol;
1841
1842 *pargv = foam->foamPCall.argv;
1843
1844 return foam;
1845}
1846
1847/*
1848 * Build an open call. The args are filled in later.
1849 */
1850localstatic Foam
1851gen0OCall(FoamTag type, Syme syme, Length argc, Foam **pargv)
1852{
1853 Foam clos = foamCopy(symeClosure(syme)((Foam) (SYFI_Closure < (8 * sizeof(int)) && !((((
(syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->hasmask) & (1 << (SYFI_Closure
))) ? (symeFieldInfo[SYFI_Closure].def) : (((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_Closure))) ?
((((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_Closure))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_Closure
)] : (symeFieldInfo[SYFI_Closure].def)) : symeGetFieldFn(syme
,SYFI_Closure)))
), foam;
1854 int opLevel = symeDefLevelNo(syme)(symeDefLevel(syme)->lexicalLevel);
1855 int closLevel = clos->foamClos.env->foamEnv.level;
1856 int envLevel = gen0FoamLevel(opLevel + closLevel);
1857
1858 foam = foamNewEmpty(FOAM_OCall, TypeSlot1 + OpSlot1 + EnvSlot1 + argc);
1859 foam->foamOCall.type = type;
1860 foam->foamOCall.op = clos->foamClos.prog;
1861 foam->foamOCall.env = foamNewEnv(envLevel)foamNew(FOAM_Env, 1, (AInt)(envLevel));
1862
1863 if (envLevel == 0) foamProgUnsetLeaf(gen0State->program)((gen0State->program)->foamProg.infoBits &= ~(1 <<
1))
;
1864 if (suVal(listElt(SlotUsage)(gen0State->formatUsage, envLevel))( ((SlotUsage_listPointer->Elt)(gen0State->formatUsage,
envLevel) & 2) == 2 ? (((SlotUsage_listPointer->Elt)(
gen0State->formatUsage, envLevel)) >> 2): *(int*) 0)
== emptyFormatSlot4)
1865 gen0UseFormat(envLevel, envUsedSlot0);
1866
1867 *pargv = foam->foamOCall.argv;
1868 return foam;
1869}
1870
1871/*
1872 * Build a closed call. The args are filled in later.
1873 */
1874localstatic Foam
1875gen0CCall(FoamTag type, Syme syme, Length argc, Foam **pargv)
1876{
1877 Foam *argloc;
1878 Foam foam;
1879
1880 foam = gen0CCallFrFoam(type, gen0ExtendSyme(syme), argc, &argloc);
1881 if (tfIsDomainMap(symeType(syme)))
1882 foamPure(foam)((foam)->hdr.info.pure) = true1;
1883
1884 *pargv = argloc;
1885
1886/*
1887 printf("BDS: inside gen0CCall\n");
1888 foamPrint(stdout,foam);
1889*/
1890
1891 return foam;
1892}
1893
1894/*
1895 * This is an export so we can get to it from export.c. It is
1896 * after all quite a useful function.
1897 */
1898Foam
1899gen0CCallFrFoam(FoamTag type, Foam op, Length argc, Foam **pargv)
1900{
1901 Foam foam;
1902
1903 foam = foamNewEmpty(FOAM_CCall, TypeSlot1 + OpSlot1 + argc);
1904 foam->foamCCall.type = type;
1905 foam->foamCCall.op = op;
1906
1907 *pargv = foam->foamCCall.argv;
1908 return foam;
1909}
1910
1911localstatic Foam
1912gen0ApplyImplicitSyme(FoamTag type, Syme syme, Length argc,
1913 AbSyn *argv, Foam vals)
1914{
1915 AbSyn abtmp;
1916 TForm tf;
1917 Foam foam, *argloc;
1918 Length i, tfargc;
1919
1920 if (symeIsSpecial(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) & (0x0002))
) {
1921 foam = gen0SpecialOp(type, syme, argc, argv, NULL((void*)0));
1922 stoFree(argv);
1923 return foam;
1924 }
1925 /* Gross! */
1926 tf = symeType(syme);
1927 tfFollow(tf)((tf) = tfFollowFn(tf));
1928 assert(tfIsAnyMap(tf))do { if (!(((((tf)->tag) == TF_Map) || (((tf)->tag) == TF_PackedMap
)))) _do_assert(("tfIsAnyMap(tf)"),"genfoam.c",1928); } while
(0)
;
1929
1930 tfargc = tfMapArgc(tf);
1931 foam = gen0ApplySyme(type, syme, NULL((void*)0), tfargc, &argloc);
1932
1933 abtmp = abNewEmpty(AB_Apply, argc + 1);
1934 abtmp->abApply.op = NULL((void*)0);
1935
1936 for (i = 0; i < argc; i += 1) {
1937 abtmp->abApply.argv[i] = argv[i];
1938 }
1939 for (i = 0; i < tfargc; i += 1) {
1940 AbSyn argi = tfMapSelectArg(tf, abtmp, i);
1941 argloc[i] = genFoamVal(argi);
1942 }
1943 /* Should check vals here for additional arguments ... */
1944 abFreeNode(abtmp);
1945 stoFree(argv);
1946 return foam;
1947}
1948
1949localstatic AbSyn *
1950gen0MakeImplicitArgs(Length argc, AbSyn ab, AbSynGetter argf)
1951{
1952 AbSyn *argv = (AbSyn*) stoAlloc(OB_Other0, argc*sizeof(AbSyn));
1953 int i;
1954
1955 for (i=0; i<argc; i++)
1956 argv[i] = (*argf)(ab, i);
1957
1958 return argv;
1959}
1960
1961/*****************************************************************************
1962 *
1963 * :: Generate code for application of special operations.
1964 *
1965 ****************************************************************************/
1966
1967localstatic TForm gen0SpecialKeyType (TForm);
1968localstatic TForm gen0SpecialArgType (Syme, Length);
1969localstatic TForm gen0SpecialRetType (Syme);
1970localstatic AInt gen0RawRecordIndex (TForm, TForm);
1971localstatic AInt gen0RecordIndex (TForm, TForm);
1972localstatic AInt gen0UnionIndex (TForm, TForm);
1973localstatic AInt gen0TrailingIndex (TForm, TForm);
1974localstatic AInt gen0UnionCaseIndex (TForm, AbSyn);
1975localstatic AInt gen0EnumIndex (TForm, Symbol);
1976localstatic Bool gen0IsEnumLit (Syme);
1977
1978localstatic Foam gen0SpecialUnhandled (Syme);
1979
1980localstatic Foam gen0ArrayNew (Syme, Length, AbSyn *, Foam *);
1981localstatic Foam gen0ArrayElt (FoamTag, Length, AbSyn *, Foam *);
1982localstatic Foam gen0ArraySet (FoamTag, Length, AbSyn *, Foam *);
1983localstatic Foam gen0ArrayDispose (Length, AbSyn *, Foam *);
1984
1985localstatic Foam gen0RawRecordNew (TForm, Length, AbSyn *, Foam *);
1986localstatic Foam gen0RawRecordExplode (TForm, Length, AbSyn *, Foam *);
1987localstatic Foam gen0RawRecordElt (Syme, TForm, Length, AbSyn *, Foam *);
1988localstatic Foam gen0RawRecordSet (Syme, TForm, Length, AbSyn *, Foam *);
1989localstatic Foam gen1RawRecordSet (TForm, Foam, Foam, Foam, AInt);
1990localstatic Foam gen0RawRecordDispose (Length, AbSyn *, Foam *);
1991localstatic Foam gen1RawRecordFormat (TForm);
1992
1993localstatic Foam gen0RecordNew (TForm, Length, AbSyn *, Foam *);
1994localstatic Foam gen0RecordExplode (TForm, Length, AbSyn *, Foam *);
1995localstatic Foam gen0RecordElt (Syme, TForm, Length, AbSyn *, Foam *);
1996localstatic Foam gen0RecordSet (Syme, TForm, Length, AbSyn *, Foam *);
1997localstatic Foam gen0RecordDispose (Length, AbSyn *, Foam *);
1998
1999localstatic Foam gen0BIntDispose (Length, AbSyn *, Foam *);
2000
2001localstatic Foam gen0UnionNew (Syme, TForm, Length, AbSyn *, Foam *);
2002localstatic Foam gen0UnionCase (TForm, Length, AbSyn *, Foam *);
2003localstatic Foam gen0UnionCaseBool (TForm, Length, AbSyn *, Foam *);
2004localstatic Foam gen0UnionElt (FoamTag,TForm,Length,AbSyn *, Foam *);
2005localstatic Foam gen0UnionSet (FoamTag,TForm,Length,AbSyn *, Foam *);
2006localstatic Foam gen0UnionDispose (Length, AbSyn *, Foam *);
2007
2008localstatic Foam gen0EnumEqual (AbSyn *, Foam *);
2009localstatic Foam gen0EnumNotEqual (AbSyn *, Foam *);
2010
2011localstatic Foam gen0TrailingNew (Syme, TForm, Length, AbSyn *, Foam *);
2012localstatic Foam gen0TrailingDispose (Syme, TForm, Length, AbSyn *, Foam *);
2013localstatic Foam gen0TrailingElt (Syme, TForm, Length, AbSyn *, Foam *);
2014localstatic Foam gen0TrailingSet (Syme, TForm, Length, AbSyn *, Foam *);
2015
2016localstatic Foam
2017gen0SpecialOp(FoamTag type, Syme syme, Length argc, AbSyn *argv, Foam *vals)
2018{
2019 Symbol sym = symeId(syme)((syme)->id);
2020 Foam foam = NULL((void*)0);
2021
2022 /* Arrays. */
2023
2024 if (sym == ssymArrNew)
2025 foam = gen0ArrayNew(syme, argc, argv, vals);
2026
2027 else if (sym == ssymArrElt)
2028 foam = gen0ArrayElt(type, argc, argv, vals);
2029
2030 else if (sym == ssymArrSet)
2031 foam = gen0ArraySet(type, argc, argv, vals);
2032
2033 else if (sym == ssymArrDispose)
2034 foam = gen0ArrayDispose(argc, argv, vals);
2035
2036 /* Big Integers. */
2037
2038 else if (sym == ssymBIntDispose)
2039 foam = gen0BIntDispose(argc, argv, vals);
2040
2041 /* Raw Records. */
2042 else if (sym == ssymRawRecNew || sym == ssymTheRawRecord) {
2043 TForm key = gen0SpecialRetType(syme);
2044 if (tfIsRawRecord(key)(((key)->tag) == TF_RawRecord))
2045 foam = gen0RawRecordNew(key, argc, argv, vals);
2046 }
2047
2048 else if (sym == ssymRawRecElt) {
2049 TForm key = gen0SpecialArgType(syme, argc);
2050 if (tfIsRawRecord(key)(((key)->tag) == TF_RawRecord))
2051 foam = gen0RawRecordElt(syme, key, argc, argv, vals);
2052 }
2053
2054 else if (sym == ssymRawRecSet) {
2055 TForm key = gen0SpecialArgType(syme, argc);
2056 if (tfIsRawRecord(key)(((key)->tag) == TF_RawRecord))
2057 foam = gen0RawRecordSet(syme, key, argc, argv, vals);
2058 }
2059
2060 else if (sym == ssymRawRecDispose) {
2061 TForm key = gen0SpecialArgType(syme, argc);
2062 if (tfIsRawRecord(key)(((key)->tag) == TF_RawRecord))
2063 foam = gen0RawRecordDispose(argc, argv, vals);
2064 }
2065
2066 /* Records. */
2067 else if (sym == ssymRecNew || sym == ssymTheRecord) {
2068 TForm key = gen0SpecialRetType(syme);
2069 if (tfIsRecord(key)(((key)->tag) == TF_Record))
2070 foam = gen0RecordNew(key, argc, argv, vals);
2071 }
2072
2073 else if (sym == ssymRecElt) {
2074 TForm key = gen0SpecialArgType(syme, argc);
2075 if (tfIsRecord(key)(((key)->tag) == TF_Record))
2076 foam = gen0RecordElt(syme, key, argc, argv, vals);
2077 }
2078
2079 else if (sym == ssymRecSet) {
2080 TForm key = gen0SpecialArgType(syme, argc);
2081 if (tfIsRecord(key)(((key)->tag) == TF_Record))
2082 foam = gen0RecordSet(syme, key, argc, argv, vals);
2083 }
2084
2085 else if (sym == ssymRecDispose) {
2086 TForm key = gen0SpecialArgType(syme, argc);
2087 if (tfIsRecord(key)(((key)->tag) == TF_Record))
2088 foam = gen0RecordDispose(argc, argv, vals);
2089 }
2090
2091 /* Unions. */
2092
2093 else if (sym == ssymTheUnion) {
2094 TForm key = gen0SpecialRetType(syme);
2095 if (tfIsUnion(key)(((key)->tag) == TF_Union))
2096 foam = gen0UnionNew(syme, key, argc, argv, vals);
2097 }
2098
2099 else if (sym == ssymTheCase) {
2100 TForm key = gen0SpecialArgType(syme, argc);
2101 if (tfIsUnion(key)(((key)->tag) == TF_Union))
2102 foam = gen0UnionCase(key, argc, argv, vals);
2103 }
2104
2105 /* TrailingArrays. */
2106 else if (sym == ssymTheTrailingArray) {
2107 TForm key = gen0SpecialArgType(syme, argc);
2108 if (tfIsTrailingArray(key)(((key)->tag) == TF_TrailingArray))
2109 foam = gen0TrailingNew(syme, key, argc, argv, vals);
2110 }
2111 /* Enumerations. */
2112
2113 else if (sym == ssymEquals) {
2114 TForm key = gen0SpecialArgType(syme, argc);
2115 if (tfIsEnum(key)(((key)->tag) == TF_Enumerate))
2116 foam = gen0EnumEqual(argv, vals);
2117 }
2118
2119 else if (sym == ssymNotEquals) {
2120 TForm key = gen0SpecialArgType(syme, argc);
2121 if (tfIsEnum(key)(((key)->tag) == TF_Enumerate))
2122 foam = gen0EnumNotEqual(argv, vals);
2123 }
2124
2125 /* Generators. */
2126
2127 else if (sym == ssymTheGenerator)
2128 foam = genFoamArg(argv, vals, int0((int) 0));
2129
2130 /* bracket, explode, apply, set!, dispose!. */
2131
2132 else if (sym == ssymBracket) {
2133 TForm key = gen0SpecialRetType(syme);
2134 if (tfIsRecord(key)(((key)->tag) == TF_Record))
2135 foam = gen0RecordNew(key, argc, argv, vals);
2136 else if (tfIsRawRecord(key)(((key)->tag) == TF_RawRecord))
2137 foam = gen0RawRecordNew(key, argc, argv, vals);
2138 else if (tfIsUnion(key)(((key)->tag) == TF_Union))
2139 foam = gen0UnionNew(syme, key, argc, argv, vals);
2140 if (tfIsTrailingArray(key)(((key)->tag) == TF_TrailingArray))
2141 foam = gen0TrailingNew(syme, key, argc, argv, vals);
2142 }
2143
2144 else if (sym == ssymTheExplode) {
2145 TForm key = gen0SpecialArgType(syme, argc);
2146 if (tfIsRecord(key)(((key)->tag) == TF_Record))
2147 foam = gen0RecordExplode(key, argc, argv, vals);
2148 else if (tfIsRawRecord(key)(((key)->tag) == TF_RawRecord))
2149 foam = gen0RawRecordExplode(key, argc, argv, vals);
2150 }
2151
2152 else if (sym == ssymApply) {
2153 TForm key = gen0SpecialArgType(syme, argc);
2154 if (tfIsRecord(key)(((key)->tag) == TF_Record))
2155 foam = gen0RecordElt(syme, key, argc, argv, vals);
2156 else if (tfIsRawRecord(key)(((key)->tag) == TF_RawRecord))
2157 foam = gen0RawRecordElt(syme, key, argc, argv, vals);
2158 else if (tfIsUnion(key)(((key)->tag) == TF_Union))
2159 foam = gen0UnionElt(type, key, argc, argv, vals);
2160 else if (tfIsTrailingArray(key)(((key)->tag) == TF_TrailingArray))
2161 foam = gen0TrailingElt(syme, key, argc, argv, vals);
2162 }
2163
2164 else if (sym == ssymSetBang) {
2165 TForm key = gen0SpecialArgType(syme, argc);
2166 if (tfIsRecord(key)(((key)->tag) == TF_Record))
2167 foam = gen0RecordSet(syme, key, argc, argv, vals);
2168 else if (tfIsRawRecord(key)(((key)->tag) == TF_RawRecord))
2169 foam = gen0RawRecordSet(syme, key, argc, argv, vals);
2170 else if (tfIsUnion(key)(((key)->tag) == TF_Union))
2171 foam = gen0UnionSet(type, key, argc, argv, vals);
2172 else if (tfIsTrailingArray(key)(((key)->tag) == TF_TrailingArray))
2173 foam = gen0TrailingSet(syme, key, argc, argv, vals);
2174 }
2175
2176 else if (sym == ssymTheDispose) {
2177 TForm key = gen0SpecialArgType(syme, argc);
2178 if (tfIsRecord(key)(((key)->tag) == TF_Record))
2179 foam = gen0RecordDispose(argc, argv, vals);
2180 else if (tfIsRawRecord(key)(((key)->tag) == TF_RawRecord))
2181 foam = gen0RawRecordDispose(argc, argv, vals);
2182 else if (tfIsUnion(key)(((key)->tag) == TF_Union))
2183 foam = gen0UnionDispose(argc, argv, vals);
2184 else if (tfIsTrailingArray(key)(((key)->tag) == TF_TrailingArray))
2185 foam = gen0TrailingDispose(syme, key, argc, argv, vals);
2186 }
2187
2188 if (foam == NULL((void*)0))
2189 foam = gen0SpecialUnhandled(syme);
2190
2191 return gen0SetValue(foam, argv[0]);
2192}
2193
2194
2195/*****************************************************************************
2196 *
2197 * :: Specific generators for special operations.
2198 *
2199 ****************************************************************************/
2200
2201/* Helper functions. */
2202
2203localstatic Foam
2204genFoamArg(AbSyn *argv, Foam *vals, int index)
2205{
2206 if (vals && vals[index])
2207 return vals[index];
2208
2209 return genFoamVal(argv[index]);
2210}
2211
2212localstatic TForm
2213gen0SpecialKeyType(TForm tf)
2214{
2215 SymeList xsymes;
2216 TFormTag tag = TF_Unknown;
2217 TFormList args = listNil(TForm)((TFormList) 0);
2218 TForm ntf;
2219 Length i, argc;
2220
2221 tfFollow(tf)((tf) = tfFollowFn(tf));
2222 if (tfIsRecord(tf)(((tf)->tag) == TF_Record) || tfIsRawRecord(tf)(((tf)->tag) == TF_RawRecord) || tfIsUnion(tf)(((tf)->tag) == TF_Union) ||
2223 tfIsEnum(tf)(((tf)->tag) == TF_Enumerate) || tfIsTrailingArray(tf)(((tf)->tag) == TF_TrailingArray))
2224 return tf;
2225
2226 for (xsymes = tfGetDomExports(tf); xsymes; xsymes = cdr(xsymes)((xsymes)->rest)) {
2227 Syme xsyme = car(xsymes)((xsymes)->first);
2228 Symbol sym = symeId(xsyme)((xsyme)->id);
2229 TFormTag ntag;
2230 TForm arg = NULL((void*)0);
2231
2232 if (!symeIsSpecial(xsyme)(((((xsyme)->kind == SYME_Trigger ? libGetAllSymes((xsyme)
->lib) : ((void*)0)), (xsyme))->bits) & (0x0002))
) continue;
2233
2234 if (sym == ssymTheRecord)
2235 ntag = TF_Record;
2236 else if (sym == ssymTheRawRecord)
2237 ntag = TF_RawRecord;
2238 else if (sym == ssymTheUnion)
2239 ntag = TF_Union;
2240 else if (sym == ssymTheTrailingArray)
2241 ntag = TF_TrailingArray;
2242 else if (tfIsSelf(symeType(xsyme))(((((symeType(xsyme))->tag) == TF_General) && ((((
symeType(xsyme))->__absyn))->abHdr.tag) == AB_Id) &&
(((symeType(xsyme))->__absyn)->abId.sym) == (ssymSelf)
)
)
2243 ntag = TF_Enumerate;
2244 else
2245 ntag = TF_Unknown;
2246
2247 if (ntag == TF_Unknown)
2248 ;
2249 else if (tag == TF_Unknown)
2250 tag = ntag;
2251 else if (tag != ntag)
2252 /* Seen two of record/union/enum!? */
2253 return tfUnknown;
2254
2255 /* We assume the special symes stay in order. */
2256 if (tag == TF_Record && sym == ssymApply)
2257 arg = tfMapRet(symeType(xsyme))tfFollowArg(symeType(xsyme), 1);
2258 if (tag == TF_RawRecord && sym == ssymApply)
2259 arg = tfMapRet(symeType(xsyme))tfFollowArg(symeType(xsyme), 1);
2260 if (tag == TF_Union && sym == ssymTheUnion)
2261 arg = tfMapArgN(symeType(xsyme), int0((int) 0));
2262 if (tag == TF_Enumerate && tfIsSelf(symeType(xsyme))(((((symeType(xsyme))->tag) == TF_General) && ((((
symeType(xsyme))->__absyn))->abHdr.tag) == AB_Id) &&
(((symeType(xsyme))->__absyn)->abId.sym) == (ssymSelf)
)
)
2263 arg = tfDeclare(abFrSyme(xsyme), tfType);
2264
2265 if (arg) args = listCons(TForm)(TForm_listPointer->Cons)(arg, args);
2266 }
2267
2268 args = listNReverse(TForm)(TForm_listPointer->NReverse)(args);
2269 argc = listLength(TForm)(TForm_listPointer->_Length)(args);
2270
2271 ntf = tfNewEmpty(tag, argc);
2272 for (i = 0; i < argc; i += 1, args = cdr(args)((args)->rest))
2273 tfArgv(ntf)((ntf)->argv)[i] = car(args)((args)->first);
2274
2275 return ntf;
2276}
2277
2278localstatic TForm
2279gen0SpecialArgType(Syme syme, Length argc)
2280{
2281 TForm tf = tfDefineeType(symeType(syme));
2282 TForm key = tfMapMultiArgN(tf, argc, int0((int) 0));
2283 return gen0SpecialKeyType(key);
2284}
2285
2286localstatic TForm
2287gen0SpecialRetType(Syme syme)
2288{
2289 TForm tf = tfDefineeType(symeType(syme));
2290 TForm key = tfMapRet(tf)tfFollowArg(tf, 1);
2291 return gen0SpecialKeyType(key);
2292}
2293
2294localstatic AInt
2295gen0RawRecordIndex(TForm whole, TForm part)
2296{
2297 Symbol sym = tfEnumId(part, int0((int) 0));
2298 AInt i;
2299
2300 for (i = 0; i < tfRawRecordArgc(whole); i += 1)
2301 if (sym == tfDefineeSymbol(tfRawRecordArgN(whole, i)tfFollowArg(whole, i)))
2302 return i;
2303
2304 bug("gen0RawRecordIndex: accessor not in record");
2305 return -1;
2306}
2307
2308localstatic AInt
2309gen0RecordIndex(TForm whole, TForm part)
2310{
2311 Symbol sym = tfEnumId(part, int0((int) 0));
2312 AInt i;
2313
2314 for (i = 0; i < tfRecordArgc(whole); i += 1)
2315 if (sym == tfDefineeSymbol(tfRecordArgN(whole, i)tfFollowArg(whole, i)))
2316 return i;
2317
2318 bug("gen0RecordIndex: accessor not in record");
2319 return -1;
2320}
2321
2322localstatic AInt
2323gen0UnionIndex(TForm whole, TForm part)
2324{
2325 AInt i;
2326 Symbol sym = tfDefineeSymbol(part);
2327 for (i = 0; i < tfUnionArgc(whole); i += 1)
2328 if ((!sym || tfCompoundId(whole,i) == sym)
2329 && tfEqual(part, tfUnionArgN(whole, i)tfFollowArg(whole, i)))
2330 return i;
2331
2332 bug("gen0UnionIndex: branch not in union");
2333 return -1;
2334}
2335
2336localstatic AInt
2337gen0UnionCaseIndex(TForm whole, AbSyn part)
2338{
2339 Symbol sym = part->abId.sym;
2340 AInt i;
2341
2342 for (i = 0; i < tfUnionArgc(whole); i += 1)
2343 if (sym == tfDefineeSymbol(tfUnionArgN(whole, i)tfFollowArg(whole, i)))
2344 return i;
2345
2346 bug("gen0UnionCaseIndex: branch not in union");
2347 return -1;
2348}
2349
2350localstatic AInt
2351gen0EnumIndex(TForm whole, Symbol sym)
2352{
2353 AInt i;
2354
2355 for (i = 0; i < tfEnumArgc(whole); i += 1)
2356 if (sym == tfEnumId(whole, i))
2357 return i;
2358
2359 bug("gen0EnumIndex: case not in enumeration");
2360 return -1;
2361}
2362
2363localstatic AInt
2364gen0TrailingIndex(TForm whole, TForm tf)
2365{
2366 AInt i;
2367 int argc = tfAsMultiArgc(whole);
2368 Symbol sym = tfEnumId(tf, int0((int) 0));
2369 for (i = 0; i < argc; i += 1)
2370 if (sym == tfDefineeSymbol(tfAsMultiArgN(whole, argc, i)))
2371 return i;
2372
2373 bug("gen0TrailingIndex: label not in record");
2374 return -1;
2375}
2376
2377localstatic Bool
2378gen0IsEnumLit(Syme syme)
2379{
2380 /* SpecialKeyType may be costly, so avoid if poss */
2381 return symeIsImport(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Import)
&&
2382 symeIsSpecial(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) & (0x0002))
&&
2383 !tfIsMap(symeType(syme))(((symeType(syme))->tag) == TF_Map) &&
2384 tfIsEnum(gen0SpecialKeyType(symeType(syme)))(((gen0SpecialKeyType(symeType(syme)))->tag) == TF_Enumerate
)
;
2385}
2386
2387localstatic Foam
2388gen0SpecialUnhandled(Syme syme)
2389{
2390 fprintf(stderrstderr,
2391 "Implementation restriction: unhandled special symbol meaning");
2392 fnewline(stderrstderr);
2393 fprintf(stderrstderr, " %s : ", symeString(syme)((((syme)->id))->str));
2394 tfPrettyPrint(stderrstderr, symeType(syme));
2395 fnewline(stderrstderr);
2396
2397 bugUnimpl(symeString(syme))bug("Unimplemented %s (line %d in file %s).", ((((syme)->id
))->str), 2397, "genfoam.c")
;
2398 return NULL((void*)0);
2399}
2400
2401/* Arrays. */
2402
2403localstatic Foam
2404gen0ArrayNew(Syme syme, Length argc, AbSyn *argv, Foam *vals)
2405{
2406 TForm tf = tfDefineeType(symeType(syme));
2407 TForm tfi = tfMapMultiArgN(tf, argc, int0((int) 0));
2408 FoamTag type = gen0Type(tfi, NULL((void*)0));
2409 Foam value = genFoamArg(argv, vals, 1);
2410
2411 return foamNewANew(type, value)foamNew(FOAM_ANew, 2, type, value);
2412}
2413
2414localstatic Foam
2415gen0ArrayElt(FoamTag type, Length argc, AbSyn *argv, Foam *vals)
2416{
2417 Foam whole = genFoamArg(argv, vals, int0((int) 0));
2418 Foam index = genFoamArg(argv, vals, 1);
2419
2420 return foamNewAElt(type, index, whole)foamNew(FOAM_AElt,3,(AInt)(type),index,whole);
2421}
2422
2423localstatic Foam
2424gen0ArraySet(FoamTag type, Length argc, AbSyn *argv, Foam *vals)
2425{
2426 Foam whole = genFoamArg(argv, vals, int0((int) 0));
2427 Foam index = genFoamArg(argv, vals, 1);
2428 Foam value = genFoamArg(argv, vals, 2);
2429
2430 return foamNewSet(foamNewAElt(type, index, whole), value)foamNew(FOAM_Set, 2, foamNew(FOAM_AElt,3,(AInt)(type),index,whole
), value)
;
2431}
2432
2433localstatic Foam
2434gen0ArrayDispose(Length argc, AbSyn *argv, Foam *vals)
2435{
2436 Foam value = genFoamArg(argv, vals, int0((int) 0));
2437
2438 return foamNewFree(value)foamNew(FOAM_Free, 1, value);
2439}
2440
2441
2442/* Big Integers. */
2443
2444localstatic Foam
2445gen0BIntDispose(Length argc, AbSyn *argv, Foam *vals)
2446{
2447 Foam value = genFoamArg(argv, vals, int0((int) 0));
2448
2449 return foamNewFree(value)foamNew(FOAM_Free, 1, value);
2450}
2451
2452
2453/* Raw Records. */
2454
2455/*
2456 * PackedRepSize: () -> SInt;
2457 */
2458localstatic Bool
2459tfIsPackedRepSize(TForm tf)
2460{
2461 /* Follow substitutions */
2462 tfFollow(tf)((tf) = tfFollowFn(tf));
2463
2464
2465 /*
2466 * Type checking - must be nullary map returning a
2467 * SInt$Machine. We probably ought to be using tfSat():
2468 * since we don't we don't check the return type.
2469 */
2470 if (!tfIsAnyMap(tf)((((tf)->tag) == TF_Map) || (((tf)->tag) == TF_PackedMap
))
) return false((int) 0);
2471 if (tfMapArgc(tf) != 0) return false((int) 0);
2472
2473
2474 /* Looks like the correct type */
2475 return true1;
2476}
2477
2478
2479/*
2480 * PackedRecordGet: Ptr -> %
2481 */
2482localstatic Bool
2483tfIsPackedRecordGet(TForm tf)
2484{
2485 /* Follow substitutions */
2486 tfFollow(tf)((tf) = tfFollowFn(tf));
2487
2488
2489 /*
2490 * Type checking - must be unary map to self. We probably
2491 * ought to be using tfSat() but since we aren't we ignore
2492 * the argument type.
2493 */
2494 if (!tfIsAnyMap(tf)((((tf)->tag) == TF_Map) || (((tf)->tag) == TF_PackedMap
))
) return false((int) 0);
2495 if (tfMapArgc(tf) != 1) return false((int) 0);
2496 if (!tfIsSelf(tfMapRet(tf))(((((tfFollowArg(tf, 1))->tag) == TF_General) && (
(((tfFollowArg(tf, 1))->__absyn))->abHdr.tag) == AB_Id)
&& (((tfFollowArg(tf, 1))->__absyn)->abId.sym)
== (ssymSelf))
) return false((int) 0);
2497
2498
2499 /* Looks like the correct type */
2500 return true1;
2501}
2502
2503
2504/*
2505 * PackedRecordSet: (Ptr, %) -> %
2506 */
2507localstatic Bool
2508tfIsPackedRecordSet(TForm tf)
2509{
2510 /* Follow substitutions */
2511 tfFollow(tf)((tf) = tfFollowFn(tf));
2512
2513
2514 /*
2515 * Type checking - must be a binary map from a Ptr
2516 * and self to self. We probably ought to be using
2517 * tfSat() but since we aren't we ignore the type
2518 * of the first argument.
2519 */
2520 if (!tfIsAnyMap(tf)((((tf)->tag) == TF_Map) || (((tf)->tag) == TF_PackedMap
))
) return false((int) 0);
2521 if (tfMapArgc(tf) != 2) return false((int) 0);
2522 if (!tfIsSelf(tfMapArgN(tf, 1))(((((tfMapArgN(tf, 1))->tag) == TF_General) && (((
(tfMapArgN(tf, 1))->__absyn))->abHdr.tag) == AB_Id) &&
(((tfMapArgN(tf, 1))->__absyn)->abId.sym) == (ssymSelf
))
) return false((int) 0);
2523 if (!tfIsSelf(tfMapRet(tf))(((((tfFollowArg(tf, 1))->tag) == TF_General) && (
(((tfFollowArg(tf, 1))->__absyn))->abHdr.tag) == AB_Id)
&& (((tfFollowArg(tf, 1))->__absyn)->abId.sym)
== (ssymSelf))
) return false((int) 0);
2524
2525
2526 /* Looks like the correct type */
2527 return true1;
2528}
2529
2530
2531localstatic Foam
2532gen0RawRecordNew(TForm key, Length argc, AbSyn *argv, Foam *vals)
2533{
2534 AInt i;
2535 Foam format, whole, fmt, foam;
2536
2537
2538 /* Create the raw record format/index */
2539 format = gen1RawRecordFormat(key);
2540
2541
2542 /* Create a temporary for the index */
2543 fmt = gen0Temp(FOAM_Word)gen0Temp0(FOAM_Word, 4);
2544
2545
2546 /* Store the index in a temporary */
2547 gen0AddStmt(foamNewSet(foamCopy(fmt), format)foamNew(FOAM_Set, 2, foamCopy(fmt), format), (AbSyn)NULL((void*)0));
2548
2549
2550 /* Create a local for the record pointer */
2551 whole = gen0Temp(FOAM_RRec)gen0Temp0(FOAM_RRec, 4);
2552
2553
2554 /* Create the uninitialised raw record */
2555 foam = foamNewRRNew(foamCopy(fmt), argc)foamNew(FOAM_RRNew, 2, (AInt)argc, foamCopy(fmt));
2556 foam = foamNewSet(foamCopy(whole), foam)foamNew(FOAM_Set, 2, foamCopy(whole), foam);
2557 gen0AddStmt(foam, (AbSyn)NULL((void*)0));
2558
2559
2560 /* Fill in each of the fields */
2561 for (i = 0; i < argc; i++)
2562 {
2563 Foam rrec = foamCopy(whole);
2564 Foam rfmt = foamCopy(fmt);
2565 Foam value = genFoamArg(argv, vals, i);
2566 Foam set = gen1RawRecordSet(key, rrec, rfmt, value, i);
2567 gen0AddStmt(set, NULL((void*)0));
2568 }
2569
2570 return foamCopy(whole);
2571}
2572
2573
2574localstatic Foam
2575gen1RawRecordFormat(TForm key)
2576{
2577 AInt i, fmtc;
2578 FoamList fmts;
2579
2580
2581 /* Create the dynamic format */
2582 fmtc = tfArgc(key)((key)->argc);
2583 fmts = listNil(Foam)((FoamList) 0);
2584
2585
2586 /* Build the format list in reverse order */
2587 for (i = (fmtc - 1); i >= 0 ; i--)
2588 {
2589 Syme op;
2590 Foam call, *ignored;
2591 TForm tf = tfArgv(key)((key)->argv)[i];
2592
2593
2594 /* Get the actual type */
2595 tf = tfDefineeType(tf);
2596
2597
2598 /* Look for PackedRepSize: () -> SInt */
2599 op = tfGetDomImport(tf, "PackedRepSize", tfIsPackedRepSize);
2600
2601
2602 /* Did we find it? */
2603 if (!op)
2604 {
2605 AbSyn ab = abNewNothing(sposNone)abNew(AB_Nothing, sposNone,0 );
2606 String msg = strPrintf("%s: %s is missing export %s",
2607 "gen1RawRecordFormat",
2608 abPretty(tfToAbSyn(tf)),
2609 "PackedRepSize");
2610 comsgFatal(ab, ALDOR_F_Bug365, msg);
2611#if 0
2612 String dom = abPretty(tfToAbSyn(tf));
2613 bug("gen1RawRecordFormat: %s is missing export %s",
2614 dom, "PackedRepSize");
2615 strFree(dom);
2616#endif
2617 }
2618
2619
2620 /* Apply this export to get the type */
2621 call = gen0ExtendSyme(op);
2622 call = gen0CCallFrFoam(FOAM_SInt, call, (Length)0, &ignored);
2623
2624
2625 /* Prepend onto the list of formats */
2626 listPush(Foam, call, fmts)(fmts = (Foam_listPointer->Cons)(call, fmts));
2627 }
2628
2629
2630 /* The dynamic format must be a multi */
2631 return foamNewRRFmt(foamNewOfList(FOAM_Values, fmts))foamNew(FOAM_RRFmt,1,foamNewOfList(FOAM_Values, fmts));
2632}
2633
2634
2635localstatic Foam
2636gen0RawRecordElt(Syme syme, TForm key, Length argc, AbSyn *argv, Foam *vals)
2637{
2638 AInt field;
2639 TForm tf, elt;
2640 Foam rrec, call, format, *fp;
2641 Syme op;
2642 SymeList symes;
2643
2644
2645 /* Create the raw record format */
2646 format = gen1RawRecordFormat(key);
2647
2648
2649 /* Get the type of the map application */
2650 tf = tfDefineeType(symeType(syme));
2651
2652
2653 /* Extract the type of the argument */
2654 elt = tfMapMultiArgN(tf, argc, 1);
2655
2656
2657 /* Find the field for this type */
2658 field = gen0RawRecordIndex(key, elt);
2659
2660
2661 /* Get the raw record value being dereferenced */
2662 rrec = genFoamArg(argv, vals, int0((int) 0));
2663
2664
2665 /* Get the field type from the key */
2666 tf = tfDefineeType(tfArgv(key)((key)->argv)[field]);
2667
2668
2669 /* Look for PackedRecordGet: Ptr -> % */
2670 op = tfGetDomImport(tf, "PackedRecordGet", tfIsPackedRecordGet);
2671
2672
2673 /* Did we find the export? */
2674 if (!op)
2675 {
2676 AbSyn ab = abNewNothing(sposNone)abNew(AB_Nothing, sposNone,0 );
2677 String msg = strPrintf("%s: %s is missing export %s",
2678 "gen0RawRecordElt",
2679 abPretty(tfToAbSyn(tf)),
2680 "PackedRecordGet");
2681 comsgFatal(ab, ALDOR_F_Bug365, msg);
2682#if 0
2683 String dom = abPretty(tfToAbSyn(tf));
2684
2685 bug("gen0RawRecordElt: %s is missing export %s",
2686 dom, "PackedRecordGet");
2687 strFree(dom);
2688#endif
2689 }
2690
2691
2692 /* Convert the export into an import */
2693 symes = listSingleton(Syme)(Syme_listPointer->Singleton)(op);
2694 symes = symeListSubstSelf(stabFile(), tf, symes);
2695 op = car(symes)((symes)->first);
2696
2697
2698 /* Apply this export to get the domain value */
2699 call = gen0ExtendSyme(op);
2700 call = gen0CCallFrFoam(FOAM_Word, call, 1, &fp);
2701 *fp = foamNewRRElt(rrec, field, format)foamNew(FOAM_RRElt,3,(AInt)(field),format,rrec);
2702
2703
2704 /* Return the call */
2705 return call;
2706}
2707
2708
2709localstatic Foam
2710gen0RawRecordSet(Syme syme, TForm key, Length argc, AbSyn *argv, Foam *vals)
2711{
2712 AInt field;
2713 TForm tf, elt;
2714 Foam rrec, value, format;
2715
2716
2717 /* Create the raw record format */
2718 format = gen1RawRecordFormat(key);
2719
2720
2721 /* Get the type of the map application */
2722 tf = tfDefineeType(symeType(syme));
2723
2724
2725 /* Extract the type of the argument */
2726 elt = tfMapMultiArgN(tf, argc, 1);
2727
2728
2729 /* Find the field for this type */
2730 field = gen0RawRecordIndex(key, elt);
2731
2732
2733 /* Get the raw record value being dereferenced */
2734 rrec = genFoamArg(argv, vals, int0((int) 0));
2735
2736
2737 /* Get the value being stored */
2738 value = genFoamArg(argv, vals, 2);
2739
2740
2741 /* Generate the update */
2742 return gen1RawRecordSet(key, rrec, format, value, field);
2743}
2744
2745
2746localstatic Foam
2747gen1RawRecordSet(TForm key, Foam rrec, Foam fmt, Foam value, AInt field)
2748{
2749 Foam call, *fp;
2750 TForm tf;
2751 Syme op;
2752 SymeList symes;
2753
2754
2755 /* Get the field type from the key */
2756 tf = tfDefineeType(tfArgv(key)((key)->argv)[field]);
2757
2758
2759 /* Look for PackedRecordSet: (Ptr, %) -> % */
2760 op = tfGetDomImport(tf, "PackedRecordSet", tfIsPackedRecordSet);
2761
2762
2763 /* Did we find the export? */
2764 if (!op)
2765 {
2766 AbSyn ab = abNewNothing(sposNone)abNew(AB_Nothing, sposNone,0 );
2767 String msg = strPrintf("%s: %s is missing export %s",
2768 "gen1RawRecordSet",
2769 abPretty(tfToAbSyn(tf)),
2770 "PackedRecordSet");
2771 comsgFatal(ab, ALDOR_F_Bug365, msg);
2772#if 0
2773 String dom = abPretty(tfToAbSyn(tf));
2774
2775 bug("gen1RawRecordSet: %s is missing export %s",
2776 dom, "PackedRecordSet");
2777 strFree(dom);
2778#endif
2779 }
2780
2781
2782 /* Convert the export into an import */
2783 symes = listSingleton(Syme)(Syme_listPointer->Singleton)(op);
2784 symes = symeListSubstSelf(stabFile(), tf, symes);
2785 op = car(symes)((symes)->first);
2786
2787
2788 /* Apply this export to get the domain value */
2789 call = gen0ExtendSyme(op);
2790 call = gen0CCallFrFoam(FOAM_Word, call, 2, &fp);
2791
2792
2793 /* Fill in the argument slots */
2794 fp[0] = foamNewRRElt(rrec, field, fmt)foamNew(FOAM_RRElt,3,(AInt)(field),fmt,rrec);
2795 fp[1] = value;
2796
2797
2798 /* Return the call to do the update */
2799 return call;
2800}
2801
2802
2803localstatic Foam
2804gen0RawRecordExplode(TForm key, Length argc, AbSyn *argv, Foam *vals)
2805{
2806 Foam tvals = gen0TempFrDDecl(int0((int) 0), true1);
2807
2808 /*
2809 * Not implemented yet!
2810 */
2811 (void)fprintf(dbOut, "*** gen0RawRecordExplode unimplemented\n");
2812 return tvals;
2813}
2814
2815
2816localstatic Foam
2817gen0RawRecordDispose(Length argc, AbSyn *argv, Foam *vals)
2818{
2819 Foam value = genFoamArg(argv, vals, int0((int) 0));
2820
2821 return foamNewFree(value)foamNew(FOAM_Free, 1, value);
2822}
2823
2824
2825/* Records. */
2826
2827localstatic Foam
2828gen0RecordNew(TForm key, Length argc, AbSyn *argv, Foam *vals)
2829{
2830 AInt format = gen0RecordFormatNumber(key);
2831 AInt index;
2832 Foam whole = gen0Temp0(FOAM_Rec, format);
2833
2834 gen0AddStmt(gen0RNew(whole, format)foamNew(FOAM_Set, 2, foamCopy(whole), foamNew(FOAM_RNew, 1, format
))
, NULL((void*)0));
2835 for (index = 0; index < argc; index += 1) {
2836 TForm tf = tfRecordArgN(key, index)tfFollowArg(key, index);
2837 Foam value = genFoamArg(argv, vals, index);
2838 FoamTag type = gen0Type(tf, NULL((void*)0));
2839 if (type != FOAM_Word)
2840 value = foamNewCast(type, value)foamNew(FOAM_Cast, 2, type, value);
2841 gen0AddStmt(gen0RSet(whole, format, index, value)foamNew(FOAM_Set, 2, foamNew(FOAM_RElt,3,(AInt)(format),foamCopy
(whole),(AInt)(index)), value)
, NULL((void*)0));
2842 }
2843
2844 return foamCopy(whole);
2845}
2846
2847localstatic Foam
2848gen0RecordElt(Syme syme, TForm key, Length argc, AbSyn *argv, Foam *vals)
2849{
2850 TForm tf = tfDefineeType(symeType(syme));
2851 TForm elt = tfMapMultiArgN(tf, argc, 1);
2852
2853 AInt format = gen0RecordFormatNumber(key);
2854 AInt index = gen0RecordIndex(key, elt);
2855 Foam whole = foamNewCast(FOAM_Rec, genFoamArg(argv, vals, int0))foamNew(FOAM_Cast, 2, FOAM_Rec, genFoamArg(argv, vals, ((int)
0)))
;
2856
2857 return foamNewRElt(format, whole, index)foamNew(FOAM_RElt,3,(AInt)(format),whole,(AInt)(index));
2858}
2859
2860localstatic Foam
2861gen0RecordSet(Syme syme, TForm key, Length argc, AbSyn *argv, Foam *vals)
2862{
2863 TForm tf = tfDefineeType(symeType(syme));
2864 TForm elt = tfMapMultiArgN(tf, argc, 1);
2865
2866 AInt format = gen0RecordFormatNumber(key);
2867 AInt index = gen0RecordIndex(key, elt);
2868 Foam whole = genFoamArg(argv, vals, int0((int) 0));
2869 Foam value = genFoamArg(argv, vals, 2);
2870
2871 return foamNewSet(foamNewRElt(format, whole, index), value)foamNew(FOAM_Set, 2, foamNew(FOAM_RElt,3,(AInt)(format),whole
,(AInt)(index)), value)
;
2872}
2873
2874localstatic Foam
2875gen0RecordExplode(TForm key, Length argc, AbSyn *argv, Foam *vals)
2876{
2877 AInt format = gen0RecordFormatNumber(key);
2878 Foam whole = gen0TempLocal0(FOAM_Rec, format);
2879 Foam tvals = gen0TempFrDDecl(format, true1);
2880 int i;
2881
2882 gen0AddStmt(foamNewSet(whole, foamNewCast(FOAM_Rec, genFoamArg(argv, vals, int0)))foamNew(FOAM_Set, 2, whole, foamNew(FOAM_Cast, 2, FOAM_Rec, genFoamArg
(argv, vals, ((int) 0))))
, NULL((void*)0));
2883
2884 whole = gen0MakeMultiEvaluable(FOAM_Rec, format, whole);
2885
2886 for (i = 0; i < foamArgc(tvals)((tvals)->hdr.argc); i++) {
2887 Foam lhs = foamCopy(tvals->foamValues.argv[i]);
2888 Foam rhs = foamNewRElt(format, foamCopy(whole), (AInt) i)foamNew(FOAM_RElt,3,(AInt)(format),foamCopy(whole),(AInt)((AInt
) i))
;
2889 gen0AddStmt(foamNewSet(lhs, rhs)foamNew(FOAM_Set, 2, lhs, rhs), NULL((void*)0));
2890 }
2891
2892 return tvals;
2893}
2894
2895
2896localstatic Foam
2897gen0RecordDispose(Length argc, AbSyn *argv, Foam *vals)
2898{
2899 Foam value = genFoamArg(argv, vals, int0((int) 0));
2900
2901 return foamNewFree(value)foamNew(FOAM_Free, 1, value);
2902}
2903
2904/* Unions. */
2905
2906localstatic Foam
2907gen0UnionNew(Syme syme, TForm key, Length argc, AbSyn *argv, Foam *vals)
2908{
2909 TForm tf = tfDefineeType(symeType(syme));
2910 TForm elt = tfMapMultiArgN(tf, argc, int0((int) 0));
2911
2912 AInt format = gen0MakeUnionFormat();
2913 Foam index = foamNewSInt(gen0UnionIndex(key, elt))foamNew(FOAM_SInt, 1, (AInt)(gen0UnionIndex(key, elt)));
2914 Foam value = genFoamArg(argv, vals, int0((int) 0));
2915 Foam whole = gen0Temp0(FOAM_Rec, format);
2916
2917 if (gen0Type(elt, NULL((void*)0)) != FOAM_Word)
2918 value = foamNewCast(FOAM_Word, value)foamNew(FOAM_Cast, 2, FOAM_Word, value);
2919
2920 gen0AddStmt(gen0RNew(whole, format)foamNew(FOAM_Set, 2, foamCopy(whole), foamNew(FOAM_RNew, 1, format
))
, NULL((void*)0));
2921 gen0AddStmt(gen0RSet(whole, format, (AInt) 0, index)foamNew(FOAM_Set, 2, foamNew(FOAM_RElt,3,(AInt)(format),foamCopy
(whole),(AInt)((AInt) 0)), index)
, NULL((void*)0));
2922 gen0AddStmt(gen0RSet(whole, format, (AInt) 1, value)foamNew(FOAM_Set, 2, foamNew(FOAM_RElt,3,(AInt)(format),foamCopy
(whole),(AInt)((AInt) 1)), value)
, NULL((void*)0));
2923
2924 return foamNewCast(FOAM_Word, foamCopy(whole))foamNew(FOAM_Cast, 2, FOAM_Word, foamCopy(whole));
2925}
2926
2927localstatic Foam
2928gen0UnionElt(FoamTag type, TForm key, Length argc, AbSyn *argv, Foam *vals)
2929{
2930 AInt l = gen0State->labelNo++;
2931 AInt format = gen0MakeUnionFormat();
2932 Foam whole = genFoamArg(argv, vals, int0((int) 0));
2933 Foam stmt, foam;
2934 Foam myVals[2];
2935
2936 whole = gen0MakeMultiEvaluable(FOAM_Rec, format, foamNewCast(FOAM_Rec, whole)foamNew(FOAM_Cast, 2, FOAM_Rec, whole));
2937 myVals[0] = foamCopy(whole);
2938 myVals[1] = NULL((void*)0);
2939
2940 stmt = foamNewIf(gen0UnionCaseBool(key, argc, argv, myVals), l)foamNew(FOAM_If, 2, gen0UnionCaseBool(key, argc, argv, myVals
), l)
;
2941 gen0AddStmt(stmt, NULL((void*)0));
2942 stmt = foamNew(FOAM_BCall, 2, FOAM_BVal_Halt,
2943 foamNewSInt(FOAM_Halt_BadUnionCase)foamNew(FOAM_SInt, 1, (AInt)(FOAM_Halt_BadUnionCase)));
2944 gen0AddStmt(stmt, NULL((void*)0));
2945 gen0AddStmt(foamNewLabel(l)foamNew(FOAM_Label, 1, (AInt)(l)), NULL((void*)0));
2946
2947 foam = foamNewRElt(format, foamCopy(whole), (AInt) 1)foamNew(FOAM_RElt,3,(AInt)(format),foamCopy(whole),(AInt)((AInt
) 1))
;
2948
2949 if (type != FOAM_Word)
2950 foam = foamNewCast(type, foam)foamNew(FOAM_Cast, 2, type, foam);
2951
2952 return foam;
2953}
2954
2955localstatic Foam
2956gen0UnionCase(TForm key, Length argc, AbSyn *argv, Foam *vals)
2957{
2958 Foam foam = gen0UnionCaseBool(key, argc, argv, vals);
2959 return foamNewCast(FOAM_Word, foam)foamNew(FOAM_Cast, 2, FOAM_Word, foam);
2960}
2961
2962localstatic Foam
2963gen0UnionCaseBool(TForm key, Length argc, AbSyn *argv, Foam *vals)
2964{
2965 AInt format = gen0MakeUnionFormat();
2966 AInt index = gen0UnionCaseIndex(key, argv[1]);
2967 Foam whole = genFoamArg(argv, vals, int0((int) 0));
2968 Foam foam = foamNewEmpty(FOAM_BCall, 3);
2969
2970 foam->foamBCall.op = FOAM_BVal_SIntEQ;
2971 foam->foamBCall.argv[0] = foamNewRElt(format,foamNew(FOAM_RElt,3,(AInt)(format),foamNew(FOAM_Cast, 2, FOAM_Rec
, whole),(AInt)((AInt) 0))
2972 foamNewCast(FOAM_Rec, whole), (AInt) 0)foamNew(FOAM_RElt,3,(AInt)(format),foamNew(FOAM_Cast, 2, FOAM_Rec
, whole),(AInt)((AInt) 0))
;
2973 foam->foamBCall.argv[1] = foamNewSInt(index)foamNew(FOAM_SInt, 1, (AInt)(index));
2974
2975 return foam;
2976}
2977
2978localstatic Foam
2979gen0UnionSet(FoamTag type, TForm key, Length argc, AbSyn *argv, Foam *vals)
2980{
2981 AInt format = gen0MakeUnionFormat();
2982 Foam whole = genFoamArg(argv, vals, int0((int) 0));
2983 Foam index = foamNewSInt(gen0UnionCaseIndex(key, argv[1]))foamNew(FOAM_SInt, 1, (AInt)(gen0UnionCaseIndex(key, argv[1])
))
;
2984 Foam value = genFoamArg(argv, vals, 2);
2985
2986 whole = gen0MakeMultiEvaluable(FOAM_Rec, format, foamNewCast(FOAM_Rec, whole)foamNew(FOAM_Cast, 2, FOAM_Rec, whole));
2987
2988 gen0AddStmt(gen0RSet(whole, format, (AInt) 0, index)foamNew(FOAM_Set, 2, foamNew(FOAM_RElt,3,(AInt)(format),foamCopy
(whole),(AInt)((AInt) 0)), index)
, NULL((void*)0));
2989 gen0AddStmt(gen0RSet(whole, format, (AInt) 1, value)foamNew(FOAM_Set, 2, foamNew(FOAM_RElt,3,(AInt)(format),foamCopy
(whole),(AInt)((AInt) 1)), value)
, NULL((void*)0));
2990
2991 return foamNewRElt(format, foamCopy(whole), (AInt) 1)foamNew(FOAM_RElt,3,(AInt)(format),foamCopy(whole),(AInt)((AInt
) 1))
;
2992}
2993
2994localstatic Foam
2995gen0UnionDispose(Length argc,AbSyn *argv, Foam *vals)
2996{
2997 Foam value = genFoamArg(argv, vals, int0((int) 0));
2998
2999 return foamNewFree(value)foamNew(FOAM_Free, 1, value);
3000}
3001
3002/* Enumerations. */
3003
3004localstatic Foam
3005gen0EnumEqual(AbSyn *argv, Foam *vals)
3006{
3007 Foam arg0 = genFoamArg(argv, vals, int0((int) 0));
3008 Foam arg1 = genFoamArg(argv, vals, 1);
3009 Foam foam = foamNewEmpty(FOAM_BCall, 3);
3010
3011 foam->foamBCall.op = FOAM_BVal_SIntEQ;
3012 foam->foamBCall.argv[0] = arg0;
3013 foam->foamBCall.argv[1] = arg1;
3014
3015 return foamNewCast(FOAM_Word, foam)foamNew(FOAM_Cast, 2, FOAM_Word, foam);
3016}
3017
3018localstatic Foam
3019gen0EnumNotEqual(AbSyn *argv, Foam *vals)
3020{
3021 Foam arg0 = genFoamArg(argv, vals, int0((int) 0));
3022 Foam arg1 = genFoamArg(argv, vals, 1);
3023 Foam foam = foamNewEmpty(FOAM_BCall, 3);
3024
3025 foam->foamBCall.op = FOAM_BVal_SIntNE;
3026 foam->foamBCall.argv[0] = arg0;
3027 foam->foamBCall.argv[1] = arg1;
3028
3029 return foamNewCast(FOAM_Word, foam)foamNew(FOAM_Cast, 2, FOAM_Word, foam);
3030}
3031
3032/* TrailingArrays. */
3033
3034localstatic Foam
3035gen0TrailingNew(Syme syme, TForm key, Length argc, AbSyn *argv, Foam *vals)
3036{
3037 TForm tf = symeType(syme);
3038 AInt format = gen0TrailingFormatNumber(key);
3039 Foam arg0 = genFoamArg(argv, vals, int0((int) 0)); /* size */
3040 Foam arg1 = genFoamArg(argv, vals, 1); /* hdr */
3041 Foam arg2 = genFoamArg(argv, vals, 2); /* proto */
3042 Foam whole, hdr, proto, sz;
3043 int i, iargc, aargc;
3044 iargc = tfAsMultiArgc(tfTrailingIArg(key)tfFollowArg(key,((int) 0)));
3045 aargc = tfAsMultiArgc(tfTrailingAArg(key)tfFollowArg(key,1));
3046
3047 whole = gen0Temp0(FOAM_TR, format);
3048 sz = foamNewCast(FOAM_SInt, arg0)foamNew(FOAM_Cast, 2, FOAM_SInt, arg0);
3049 hdr = gen0CrossToMulti(arg1, tfDefineeMaybeType(tfMapArgN(tf, 1)));
3050 proto = gen0CrossToMulti(arg2, tfDefineeMaybeType(tfMapArgN(tf, 2)));
3051
3052 /* Idea is to generate:
3053 * tr := TRNew(fmt, sz)
3054 * tr.x := argx
3055 * -- ... and maybe initialize the trailing part as well...
3056 */
3057 gen0AddStmt(foamNewSet(foamCopy(whole), foamNewTRNew(format, sz))foamNew(FOAM_Set, 2, foamCopy(whole), foamNew(FOAM_TRNew, 2, format
, sz))
, NULL((void*)0));
3058 for (i=0; i < iargc; i++) {
3059 gen0AddStmt(foamNewSet(foamNewIRElt(format, foamCopy(whole), i),foamNew(FOAM_Set, 2, foamNew(FOAM_IRElt,3,(AInt)(format),foamCopy
(whole),(AInt)(i)), hdr->foamValues.argv[i])
3060 hdr->foamValues.argv[i])foamNew(FOAM_Set, 2, foamNew(FOAM_IRElt,3,(AInt)(format),foamCopy
(whole),(AInt)(i)), hdr->foamValues.argv[i])
, NULL((void*)0));
3061 }
3062 return foamNewCast(FOAM_Word, whole)foamNew(FOAM_Cast, 2, FOAM_Word, whole);
3063}
3064
3065localstatic Foam
3066gen0TrailingDispose(Syme syme, TForm key, Length argc, AbSyn *argv, Foam *vals)
3067{
3068 Foam value = genFoamArg(argv, vals, int0((int) 0));
3069
3070 return foamNewFree(value)foamNew(FOAM_Free, 1, value);
3071}
3072
3073localstatic Foam
3074gen0TrailingElt(Syme syme, TForm key, Length argc, AbSyn *argv, Foam *vals)
3075{
3076 TForm tf = tfDefineeType(symeType(syme));
3077 AInt format = gen0TrailingFormatNumber(key);
3078 Foam whole = genFoamArg(argv, vals, int0((int) 0));
3079 Foam foam = NULL((void*)0);
3080 AInt idx;
3081
3082 whole = foamNewCast(FOAM_TR, whole)foamNew(FOAM_Cast, 2, FOAM_TR, whole);
3083 if (argc == 2) {
3084 TForm elt = tfMapMultiArgN(tf, argc, 1);
3085 TForm xtf = tfTrailingIArg(key)tfFollowArg(key,((int) 0));
3086 idx = gen0TrailingIndex(xtf, elt);
3087 foam = foamNewIRElt(format, whole, idx)foamNew(FOAM_IRElt,3,(AInt)(format),whole,(AInt)(idx));
3088 }
3089 else if (argc == 3) {
3090 TForm elt = tfMapMultiArgN(tf, argc, 2);
3091 TForm xtf = tfTrailingAArg(key)tfFollowArg(key,1);
3092 Foam arg1 = genFoamArg(argv, vals, 1);
3093 idx = gen0TrailingIndex(xtf, elt);
3094 arg1 = foamNewCast(FOAM_SInt, arg1)foamNew(FOAM_Cast, 2, FOAM_SInt, arg1);
3095 arg1 = foamNew(FOAM_BCall, 2, FOAM_BVal_SIntPrev, arg1);
3096 foam = foamNewTRElt(format, whole, arg1, idx)foamNew(FOAM_TRElt,4,format,whole,arg1,idx);
3097 }
3098 else {
3099 tf = NULL((void*)0);
3100 bug("badly formed special operation");
3101 }
3102
3103 return foam;
3104}
3105
3106localstatic Foam
3107gen0TrailingSet(Syme syme, TForm key, Length argc, AbSyn *argv, Foam *vals)
3108{
3109 TForm tf = tfDefineeType(symeType(syme));
3110 AInt format = gen0TrailingFormatNumber(key);
3111 Foam whole = genFoamArg(argv, vals, int0((int) 0));
3112 Foam ref, val;
3113 AInt idx;
3114
3115 whole = foamNewCast(FOAM_TR, whole)foamNew(FOAM_Cast, 2, FOAM_TR, whole);
3116 if (argc == 3) {
3117 TForm elt = tfMapMultiArgN(tf, argc, 1);
3118 TForm xtf = tfTrailingIArg(key)tfFollowArg(key,((int) 0));
3119 Foam arg1 = genFoamArg(argv, vals, 2);
3120 idx = gen0TrailingIndex(xtf, elt);
3121 val = gen0MakeMultiEvaluable(FOAM_TR, format, arg1);
3122 ref = foamNewIRElt(format, whole, idx)foamNew(FOAM_IRElt,3,(AInt)(format),whole,(AInt)(idx));
3123 }
3124 else if (argc == 4) {
3125 TForm elt = tfMapMultiArgN(tf, argc, 2);
3126 TForm xtf = tfTrailingAArg(key)tfFollowArg(key,1);
3127 Foam arg1 = genFoamArg(argv, vals, 1);
3128 Foam arg2 = genFoamArg(argv, vals, 3);
3129 idx = gen0TrailingIndex(xtf, elt);
3130 arg1 = foamNewCast(FOAM_SInt, arg1)foamNew(FOAM_Cast, 2, FOAM_SInt, arg1);
3131 arg1 = foamNew(FOAM_BCall, 2, FOAM_BVal_SIntPrev, arg1);
3132 val = gen0MakeMultiEvaluable(FOAM_TR, format, arg2);
3133 ref = foamNewTRElt(format, whole, arg1, idx)foamNew(FOAM_TRElt,4,format,whole,arg1,idx);
3134 }
3135 else {
3136 tf = NULL((void*)0);
3137 val = ref = NULL((void*)0);
3138 bug("badly formed special operation");
3139 }
3140
3141 gen0AddStmt(foamNewSet(ref, val)foamNew(FOAM_Set, 2, ref, val), NULL((void*)0));
3142 return foamCopy(val);
3143}
3144
3145/*****************************************************************************
3146 *
3147 * :: End of specific generators for special operations.
3148 *
3149 ****************************************************************************/
3150
3151/*
3152 * Return the format number of a given record type.
3153 */
3154AInt
3155gen0RecordFormatNumber(TForm tf)
3156{
3157 Foam ddecl;
3158 Length i, argc;
3159 AInt fmt0 = emptyFormatSlot4;
3160
3161 if (!tfIsRecord(tf)(((tf)->tag) == TF_Record)) {
3162 return emptyFormatSlot4;
3163 }
3164 argc = tfRecordArgc(tf);
3165
3166 /* Generate the format. */
3167 ddecl = foamNewEmpty(FOAM_DDecl, argc + 1);
3168 ddecl->foamDDecl.usage = FOAM_DDecl_Record;
3169 for (i = 0; i < argc; i += 1) {
3170 TForm tfi = tfRecordArgN(tf, i)tfFollowArg(tf, i);
3171 String s = gen0RecFieldName(tf, i);
3172 FoamTag tag = gen0Type(tfi, &fmt0);
3173 ddecl->foamDDecl.argv[i] =
3174 foamNewDecl(tag, strCopy(s), fmt0)foamNew(FOAM_Decl,4,(AInt)(tag),strCopy(s), (AInt) (0x7FFF), fmt0
)
;
3175 }
3176
3177 return gen0AddRealFormat(ddecl);
3178}
3179
3180/*
3181 * Return the format number of a given multi type.
3182 */
3183AInt
3184gen0MultiFormatNumber(TForm tf)
3185{
3186 Foam ddecl;
3187 Length i, argc;
3188 AInt fmt0 = emptyFormatSlot4;
3189
3190 assert (tfIsMulti(tf))do { if (!((((tf)->tag) == TF_Multiple))) _do_assert(("tfIsMulti(tf)"
),"genfoam.c",3190); } while (0)
;
3191 argc = tfMultiArgc(tf);
3192
3193 /* Generate the format. */
3194 ddecl = foamNewEmpty(FOAM_DDecl, argc + 1);
3195 ddecl->foamDDecl.usage = FOAM_DDecl_Multi;
3196 for (i = 0; i < argc; i += 1) {
3197 TForm tfi = tfMultiArgN(tf, i)tfFollowArg(tf, i);
3198 String s = "";
3199 FoamTag tag = gen0Type(tfi, &fmt0);
3200 ddecl->foamDDecl.argv[i] =
3201 foamNewDecl(tag, strCopy(s), fmt0)foamNew(FOAM_Decl,4,(AInt)(tag),strCopy(s), (AInt) (0x7FFF), fmt0
)
;
3202 }
3203
3204 return gen0AddRealFormat(ddecl);
3205}
3206
3207/*
3208 * Return the format number of a non-void catch block.
3209 */
3210AInt
3211gen0CatchFormatNumber(TForm try, TForm exn)
3212{
3213 Foam ddecl;
3214 FoamTag tag;
3215 AInt fmt = emptyFormatSlot4;
3216 AInt empty = emptyFormatSlot4;
3217
3218
3219 /* Generate the format. */
3220 ddecl = foamNewEmpty(FOAM_DDecl, 3 + 1);
3221 ddecl->foamDDecl.usage = FOAM_DDecl_Multi;
3222
3223
3224 /* The first argument is a Bool */
3225 ddecl->foamDDecl.argv[0] =
3226 foamNewDecl(FOAM_Bool, strCopy(""), empty)foamNew(FOAM_Decl,4,(AInt)(FOAM_Bool),strCopy(""), (AInt) (0x7FFF
), empty)
;
3227
3228
3229 /* The second argument is the try-block */
3230 if (tfIsMulti(try)(((try)->tag) == TF_Multiple)) {
3231 tag = FOAM_Word;
3232 fmt = gen0MultiFormatNumber(try);
3233 }
3234 else
3235 tag = gen0Type(try, &fmt);
3236 ddecl->foamDDecl.argv[1] = foamNewDecl(tag, strCopy(""), fmt)foamNew(FOAM_Decl,4,(AInt)(tag),strCopy(""), (AInt) (0x7FFF),
fmt)
;
3237
3238
3239 /* The final argument is the handler */
3240 if (tfIsMulti(exn)(((exn)->tag) == TF_Multiple)) {
3241 tag = FOAM_Word;
3242 fmt = gen0MultiFormatNumber(exn);
3243 }
3244 else
3245 tag = gen0Type(exn, &fmt);
3246 ddecl->foamDDecl.argv[2] = foamNewDecl(tag, strCopy(""), fmt)foamNew(FOAM_Decl,4,(AInt)(tag),strCopy(""), (AInt) (0x7FFF),
fmt)
;
3247
3248 return gen0AddRealFormat(ddecl);
3249}
3250
3251/*
3252 * Return the format number of a void catch block.
3253 */
3254AInt
3255gen0VoidCatchFormatNumber(TForm exn)
3256{
3257 Foam ddecl;
3258 FoamTag tag;
3259 AInt fmt = emptyFormatSlot4;
3260 AInt empty = emptyFormatSlot4;
3261
3262
3263 /* Generate the format. */
3264 ddecl = foamNewEmpty(FOAM_DDecl, 2 + 1);
3265 ddecl->foamDDecl.usage = FOAM_DDecl_Multi;
3266
3267
3268 /* The first argument is a Bool */
3269 ddecl->foamDDecl.argv[0] =
3270 foamNewDecl(FOAM_Bool, strCopy(""), empty)foamNew(FOAM_Decl,4,(AInt)(FOAM_Bool),strCopy(""), (AInt) (0x7FFF
), empty)
;
3271
3272
3273 /* The final argument is the handler */
3274 if (tfIsMulti(exn)(((exn)->tag) == TF_Multiple)) {
3275 tag = FOAM_Word;
3276 fmt = gen0MultiFormatNumber(exn);
3277 }
3278 else
3279 tag = gen0Type(exn, &fmt);
3280 ddecl->foamDDecl.argv[1] = foamNewDecl(tag, strCopy(""), fmt)foamNew(FOAM_Decl,4,(AInt)(tag),strCopy(""), (AInt) (0x7FFF),
fmt)
;
3281
3282 return gen0AddRealFormat(ddecl);
3283}
3284
3285/*
3286 * Return the format number of a C arguments format.
3287 *
3288 * The dummy arguments come first with a decl at the
3289 * end for the function result.
3290 *
3291 * Hacked from gen0FortranSigFormatNumber()
3292 */
3293AInt
3294gen0CSigFormatNumber(TForm tf)
3295{
3296 Foam ddecl;
3297 Length i, argc, retc;
3298 char buffer[120];
3299
3300 assert (tfIsMap(tf))do { if (!((((tf)->tag) == TF_Map))) _do_assert(("tfIsMap(tf)"
),"genfoam.c",3300); } while (0)
;
3301 argc = tfMapArgc(tf);
3302
3303 /* Generate the format. */
3304 retc = tfMapRetc(tf);
3305 ddecl = foamNewEmpty(FOAM_DDecl, 1 + argc + 1 + retc);
3306 ddecl->foamDDecl.usage = FOAM_DDecl_CSig;
3307
3308 /* Process the arguments */
3309 for (i = 0; i < argc; i++) {
3310 AInt fmt;
3311 char *str;
3312 FoamTag type;
3313 TForm tfi = tfMapArgN(tf, i);
3314
3315 /* Skip any declaration */
3316 if (tfIsDeclare(tfi)(((tfi)->tag) == TF_Declare)) tfi = tfDeclareType(tfi)tfFollowArg(tfi, 0);
3317
3318 /* Get the foam type */
3319 type = gen0CSigType(tfi, &fmt);
3320
3321 /* Create a suitable declaration */
3322 str = aStrPrintf("P%d", (int) i);
3323 ddecl->foamDDecl.argv[i] = foamNewDecl(type, str, fmt)foamNew(FOAM_Decl,4,(AInt)(type),str, (AInt) (0x7FFF), fmt);
3324 }
3325
3326 /* Process any multiple return values */
3327 ddecl->foamDDecl.argv[argc + 0] = foamNewDecl(FOAM_Nil, strCopy(""), emptyFormatSlot)foamNew(FOAM_Decl,4,(AInt)(FOAM_Nil),strCopy(""), (AInt) (0x7FFF
), 4)
;
3328
3329 for (i = 0; i < retc; i++) {
3330 TForm tfi = tfMapRetN(tf, i);
3331 AInt fmt;
3332 FoamTag type;
3333 char *str;
3334
3335 if (tfIsDeclare(tfi)(((tfi)->tag) == TF_Declare)) tfi = tfDeclareType(tfi)tfFollowArg(tfi, 0);
3336
3337 type = gen0CSigType(tfi, &fmt);
3338 str = aStrPrintf("R%d", (int) i);
3339 ddecl->foamDDecl.argv[argc + 1 + i] = foamNewDecl(type, str, fmt)foamNew(FOAM_Decl,4,(AInt)(type),str, (AInt) (0x7FFF), fmt);
3340 }
3341
3342 return gen0AddRealFormat(ddecl);
3343}
3344
3345localstatic FoamTag
3346gen0CSigType(TForm tf, AInt *fmt)
3347{
3348 if (!tfIsId(tf)((((tf)->tag) == TF_General) && ((((tf)->__absyn
))->abHdr.tag) == AB_Id)
) {
3349 return gen0Type(tf, fmt);
3350 }
3351 Syme syme = tfIdSyme(tf)((((tf)->__absyn))->abHdr.seman ? (((tf)->__absyn))->
abHdr.seman->syme : 0)
;
3352 if (syme == NULL((void*)0)) {
3353 return gen0Type(tf, fmt);
3354 }
3355 if (symeIsForeign(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Foreign)
&&
3356 symeForeign(syme)((ForeignOrigin) (SYFI_Foreign < (8 * sizeof(int)) &&
!(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->hasmask) & (1 <<
(SYFI_Foreign))) ? (symeFieldInfo[SYFI_Foreign].def) : (((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_Foreign
))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes((
syme)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_Foreign))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_Foreign
)] : (symeFieldInfo[SYFI_Foreign].def)) : symeGetFieldFn(syme
,SYFI_Foreign)))
->protocol == FOAM_Proto_C) {
3357 return gen0CSigTypeTypedef(syme, fmt);
3358 }
3359 return gen0Type(tf, fmt);
3360}
3361
3362localstatic FoamTag
3363gen0CSigTypeTypedef(Syme syme, AInt *fmt)
3364{
3365 Foam decl = foamNewDecl(FOAM_CObj, strCopy(symeString(syme)), emptyFormatSlot)foamNew(FOAM_Decl,4,(AInt)(FOAM_CObj),strCopy(((((syme)->id
))->str)), (AInt) (0x7FFF), 4)
;
3366 AInt typeDDeclId = gen0AddRealFormat(foamNewDDecl(FOAM_DDecl_CType, decl, NULL((void*)0)));
3367 *fmt = typeDDeclId;
3368 return FOAM_CObj;
3369}
3370
3371/*
3372 * Return the format number of a C arguments format.
3373 *
3374 * The dummy arguments come first with a decl at the
3375 * end for the function result.
3376 *
3377 * Hacked from gen0FortranSigFormatNumber()
3378 */
3379AInt
3380gen0CPackedSigFormatNumber(TForm tf)
3381{
3382 Foam ddecl;
3383 Length i, argc, retc;
3384
3385 assert (tfIsPackedMap(tf))do { if (!((((tf)->tag) == TF_PackedMap))) _do_assert(("tfIsPackedMap(tf)"
),"genfoam.c",3385); } while (0)
;
3386 argc = tfMapArgc(tf);
3387
3388 /* Generate the format. */
3389 retc = tfMapRetc(tf);
3390
3391 ddecl = foamNewEmpty(FOAM_DDecl, 1 + argc + 1 + retc);
3392 ddecl->foamDDecl.usage = FOAM_DDecl_CSig;
3393
3394
3395 /* Process the arguments */
3396 for (i = 0; i < argc; i++) {
3397 AInt fmt;
3398 char *str;
3399 FoamTag type;
3400 TForm tfi = tfMapArgN(tf, i);
3401
3402 /* Skip any declaration */
3403 if (tfIsDeclare(tfi)(((tfi)->tag) == TF_Declare)) tfi = tfDeclareType(tfi)tfFollowArg(tfi, 0);
3404
3405/* printf("BDS: Getting Raw Type in gen0CPackedSigFormatNumber\n"); */
3406 tfi = tfRawType(tfi);
3407
3408 /* Get the foam type */
3409 type = gen0Type(tfi, &fmt);
3410
3411
3412 /* Create a suitable declaration */
3413 str = aStrPrintf("P%d", (int) i);
3414 ddecl->foamDDecl.argv[i] = foamNewDecl(type, str, fmt)foamNew(FOAM_Decl,4,(AInt)(type),str, (AInt) (0x7FFF), fmt);
3415 }
3416
3417 ddecl->foamDDecl.argv[argc + 0] = foamNewDecl(FOAM_Nil, strCopy(""), emptyFormatSlot)foamNew(FOAM_Decl,4,(AInt)(FOAM_Nil),strCopy(""), (AInt) (0x7FFF
), 4)
;
3418 if (retc == 1) {
3419 TForm tfr;
3420 FoamTag type;
3421 AInt fmt;
3422
3423 tfr = tfRawType(tfMapRet(tf)tfFollowArg(tf, 1));
3424 type = gen0Type(tfr, &fmt);
3425 ddecl->foamDDecl.argv[argc+1] = foamNewDecl(type, strCopy(""), fmt)foamNew(FOAM_Decl,4,(AInt)(type),strCopy(""), (AInt) (0x7FFF)
, fmt)
;
3426 }
3427 /* Process any multiple return values */
3428 else {
3429 for (i = 0; i < retc; i++) {
3430 char *str;
3431 FoamTag rtype = FOAM_Ptr; /* Always a pointer */
3432 AInt fmt = emptyFormatSlot4;
3433 str = aStrPrintf("R%d", (int) i);
3434 ddecl->foamDDecl.argv[argc + 1 + i] = foamNewDecl(rtype, str, fmt)foamNew(FOAM_Decl,4,(AInt)(rtype),str, (AInt) (0x7FFF), fmt);
3435 }
3436 }
3437 return gen0AddRealFormat(ddecl);
3438}
3439
3440/*
3441 * Return the format number of a Fortran arguments format.
3442 *
3443 * The dummy arguments come first with a decl at the
3444 * end for the function result.
3445 *
3446 * Note that this and gen0FortranSigExportNumber() are
3447 * mutually recursive.
3448 */
3449AInt
3450gen0FortranSigFormatNumber(TForm tf, Bool modargs)
3451{
3452 Foam ddecl;
3453 Length i, argc;
3454 AInt fmt0 = emptyFormatSlot4;
3455
3456 assert (tfIsMap(tf))do { if (!((((tf)->tag) == TF_Map))) _do_assert(("tfIsMap(tf)"
),"genfoam.c",3456); } while (0)
;
3457 argc = tfMapArgc(tf);
3458
3459 /* Generate the format. */
3460 ddecl = foamNewEmpty(FOAM_DDecl, argc + 2);
3461 ddecl->foamDDecl.usage = FOAM_DDecl_FortranSig;
3462 for (i = 0; i < argc + 1; i++) {
3463 TForm tfi;
3464 String namefield, tstr;
3465 FoamTag type;
3466 Bool isRefArg;
3467 FortranType ftype;
3468
3469 if (i == (argc + 1) - 1) {
3470 /* Generate a decl for the return type */
3471 tfi = tfMapRet(tf)tfFollowArg(tf, 1);
3472 isRefArg = false((int) 0);
3473 } else {
3474 tfi = tfMapArgN(tf, i);
3475
3476 /* Skip any declaration */
3477 if (tfIsDeclare(tfi)(((tfi)->tag) == TF_Declare))
3478 tfi = tfDeclareType(tfi)tfFollowArg(tfi, 0);
3479
3480 isRefArg = tfIsReferenceFn(tfi);
3481 if (isRefArg) tfi = tfReferenceArg(tfi)tfFollowArg(tfi, 0);
3482 }
3483 type = gen0Type(tfi, NULL((void*)0));
3484 if (tfIsDefine(tfi)(((tfi)->tag) == TF_Define)) tfi = tfDefineDecl(tfi)tfFollowArg(tfi, 0);
3485 if (tfIsDeclare(tfi)(((tfi)->tag) == TF_Declare)) tfi = tfDeclareType(tfi)tfFollowArg(tfi, 0);
3486 ftype = ftnTypeFrDomTForm(tfi);
3487 if (ftype) {
3488 /*
3489 * We store the Fortran category attribute
3490 * which this domain has since that doesn't
3491 * change with macros etc. Really we ought
3492 * to be able to pick up the original TForm
3493 * rather than trying to pick it out of a
3494 * piece of text in the FOAM.
3495 */
3496 tstr = ftnNameFrType(ftype);
3497 if (isRefArg) {
3498 if (modargs)
3499 namefield = strlConcat(MODIFIABLEARG"[Modifiable]", ":", tstr, NULL((void*)0));
3500 else
3501 namefield = strlConcat(":", tstr, NULL((void*)0));
3502 strFree(tstr);
3503 }
3504 else
3505 namefield = tstr;
3506 ddecl->foamDDecl.argv[i] = foamNewDecl(type, namefield, fmt0)foamNew(FOAM_Decl,4,(AInt)(type),namefield, (AInt) (0x7FFF), fmt0
)
;
3507 }
3508 else if (type == FOAM_Word) {
3509 tstr = gen0TypeString(tfGetExpr(tfi)((tfi)->__absyn));
3510 if (isRefArg) {
3511 if (modargs)
3512 namefield = strlConcat(MODIFIABLEARG"[Modifiable]", ":", tstr, NULL((void*)0));
3513 else
3514 namefield = strlConcat(":", tstr, NULL((void*)0));
3515 strFree(tstr);
3516 }
3517 else
3518 namefield = tstr;
3519 ddecl->foamDDecl.argv[i] = foamNewDecl(type, namefield, fmt0)foamNew(FOAM_Decl,4,(AInt)(type),namefield, (AInt) (0x7FFF), fmt0
)
;
3520 }
3521 else if (type == FOAM_Clos)
3522 /* Generate a separate format for procedure parameters */
3523 ddecl->foamDDecl.argv[i] = foamNewDecl(FOAM_Clos, strCopy(""), gen0FortranSigExportNumber(tfi))foamNew(FOAM_Decl,4,(AInt)(FOAM_Clos),strCopy(""), (AInt) (0x7FFF
), gen0FortranSigExportNumber(tfi))
;
3524 else {
3525 if (isRefArg) {
3526 if (modargs) {
3527 namefield = strCopy(MODIFIABLEARG"[Modifiable]");
3528 }
3529 else
3530 namefield = strCopy("");
3531 }
3532 else
3533 namefield = strCopy("");
3534 ddecl->foamDDecl.argv[i] = foamNewDecl(type, namefield, fmt0)foamNew(FOAM_Decl,4,(AInt)(type),namefield, (AInt) (0x7FFF), fmt0
)
;
3535 }
3536 }
3537
3538 return gen0AddRealFormat(ddecl);
3539}
3540
3541/*
3542 * Similar to gen0FortranSigFormatNumber() except that
3543 * we only generate FOAM_Word argument types unless it
3544 * is a function argument. This is because all the code
3545 * to do the Fortran argument unpacking for an exported
3546 * Aldor function is created at the genFoam() stage
3547 * instead of during genC(). We do, however, need to take
3548 * extra care with String arguments and return types.
3549 *
3550 * Note that this and gen0FortranSigFormatNumber() are
3551 * mutually recursive.
3552 */
3553AInt
3554gen0FortranSigExportNumber(TForm tf)
3555{
3556 Foam ddecl;
3557 Length i, argc;
3558 AInt argfmt, fmt0 = emptyFormatSlot4;
3559
3560 assert (tfIsMap(tf))do { if (!((((tf)->tag) == TF_Map))) _do_assert(("tfIsMap(tf)"
),"genfoam.c",3560); } while (0)
;
3561 argc = tfMapArgc(tf);
3562
3563 /* Generate the format. */
3564 ddecl = foamNewEmpty(FOAM_DDecl, argc + 2);
3565 ddecl->foamDDecl.usage = FOAM_DDecl_FortranSig;
3566
3567 for (i = 0; i < argc + 1; i++)
3568 {
3569 TForm tfi;
3570 FoamTag type;
3571 Foam decl;
3572 FortranType ftype;
3573 Bool isRefArg;
3574
3575 if (i == (argc + 1) - 1)
3576 {
3577 /* Generate a decl for the return type */
3578 tfi = tfMapRet(tf)tfFollowArg(tf, 1);
3579 isRefArg = false((int) 0);
3580 }
3581 else
3582 {
3583 tfi = tfMapArgN(tf, i);
3584
3585 /* Skip any declaration */
3586 if (tfIsDeclare(tfi)(((tfi)->tag) == TF_Declare))
3587 tfi = tfDeclareType(tfi)tfFollowArg(tfi, 0);
3588
3589
3590 /* Unpack references */
3591 isRefArg = tfIsReferenceFn(tfi);
3592 if (isRefArg)
3593 tfi = tfReferenceArg(tfi)tfFollowArg(tfi, 0);
3594 }
3595
3596 type = gen0Type(tfi, NULL((void*)0));
3597 if (tfIsDefine(tfi)(((tfi)->tag) == TF_Define)) tfi = tfDefineDecl(tfi)tfFollowArg(tfi, 0);
3598 if (tfIsDeclare(tfi)(((tfi)->tag) == TF_Declare)) tfi = tfDeclareType(tfi)tfFollowArg(tfi, 0);
3599 ftype = ftnTypeFrDomTForm(tfi);
3600
3601
3602 /* Generate a separate format for procedure parameters */
3603 if ((ftype == FTN_XLString) || (ftype == FTN_String))
3604 {
3605 String tstr = ftnNameFrType(ftype);
3606 if (isRefArg)
3607 tstr = strlConcat(MODIFIABLEARG"[Modifiable]", ":", tstr, NULL((void*)0));
3608 decl = foamNewDecl(type, tstr, fmt0)foamNew(FOAM_Decl,4,(AInt)(type),tstr, (AInt) (0x7FFF), fmt0);
3609 }
3610 else if (type == FOAM_Clos)
3611 {
3612 argfmt = gen0FortranSigFormatNumber(tfi, false((int) 0));
3613 decl = foamNewDecl(FOAM_Clos, strCopy(""), argfmt)foamNew(FOAM_Decl,4,(AInt)(FOAM_Clos),strCopy(""), (AInt) (0x7FFF
), argfmt)
;
3614 }
3615 else if (i == (argc + 1) - 1)
3616 {
3617 /* Return type */
3618 String tstr = ftnNameFrType(ftype);
3619 decl = foamNewDecl(type, tstr, fmt0)foamNew(FOAM_Decl,4,(AInt)(type),tstr, (AInt) (0x7FFF), fmt0);
3620 }
3621 else
3622 decl = foamNewDecl(FOAM_Word, strCopy(""), fmt0)foamNew(FOAM_Decl,4,(AInt)(FOAM_Word),strCopy(""), (AInt) (0x7FFF
), fmt0)
;
3623
3624 ddecl->foamDDecl.argv[i] = decl;
3625 }
3626
3627 return gen0AddRealFormat(ddecl);
3628}
3629
3630String
3631gen0TypeString(Sefo sefo)
3632{
3633 Length i;
3634 String s1, s2, s3 = NULL((void*)0);
3635
3636 if (abIsLeaf(sefo)(((sefo)->abHdr.tag) < AB_NODE_START))
3637 {
3638 AbSynTag tag = abTag(sefo)((sefo)->abHdr.tag);
3639
3640 if (abIsSymTag(tag)( (tag) < AB_SYM_LIMIT))
3641 s1 = symString(abLeafSym(sefo))((((sefo)->abGen.data.sym))->str);
3642 else if (abIsStrTag(tag)( AB_STR_START <= (tag) && (tag) < AB_STR_LIMIT
)
)
3643 s1 = abLeafStr(sefo)((sefo)->abGen.data.str);
3644 else
3645 s1 = "?";
3646
3647 return strCopy(s1);
3648 }
3649 else if (abIsApply(sefo)((sefo)->abHdr.tag == (AB_Apply)))
3650 {
3651 /*
3652 * Treat Ref(T) differently. This code is disgusting
3653 * and will fail if the domain Ref has been renamed
3654 * by use of definitions (A == Ref). How about checking
3655 * tfIsReferenceFn() ...
3656 */
3657 AbSyn op = abApplyOp(sefo)((sefo)->abApply.op);
3658 if (abIsId(op)((op)->abHdr.tag == (AB_Id)))
3659 {
3660 if (!strcmp(symString(abIdSym(op))((((op)->abId.sym))->str),
3661 symString(ssymReference)((ssymReference)->str)))
3662 {
3663 /* It's a reference */
3664 for (i = 1; i < abArgc(sefo)((sefo)->abHdr.argc); i += 1) {
3665 s1 = gen0TypeString(abArgv(sefo)((sefo)->abGen.data.argv)[i]);
3666 if (s3) {
3667 s2 = strConcat(s3, ".");
3668 s2 = strConcat(s2, s1);
3669 strFree(s1);
3670 strFree(s3);
3671 s3 = s2;
3672 }
3673 else
3674 s3 = s1;
3675 }
3676 return s3;
3677 }
3678 /* Fall through ... */
3679 }
3680 /* Fall through ... */
3681 }
3682
3683
3684 /* Any other type ... */
3685 for (i = 0; i < abArgc(sefo)((sefo)->abHdr.argc); i += 1) {
3686 s1 = gen0TypeString(abArgv(sefo)((sefo)->abGen.data.argv)[i]);
3687 if (s3) {
3688 s2 = strConcat(s3, ".");
3689 s2 = strConcat(s2, s1);
3690 strFree(s1);
3691 strFree(s3);
3692 s3 = s2;
3693 }
3694 else
3695 s3 = s1;
3696 }
3697 return s3;
3698}
3699
3700/*
3701 * !! This function does not appear to be used anymore !!
3702 */
3703#if 0
3704AInt
3705gen0FortranMFmtNumber(TFormList returntypes)
3706{
3707 Foam ddecl;
3708 TForm tf;
3709 Length i, argc;
3710 AInt fmt0 = emptyFormatSlot4;
3711
3712 argc = listLength(TForm)(TForm_listPointer->_Length)(returntypes);
3713 ddecl = foamNewEmpty(FOAM_DDecl, argc + 1);
3714 ddecl->foamDDecl.usage = FOAM_DDecl_Multi;
3715 for (i = 0; i < argc; i++, returntypes = listFreeCons(TForm)(TForm_listPointer->FreeCons)(returntypes)) {
3716 tf = car(returntypes)((returntypes)->first);
3717 ddecl->foamDDecl.argv[i] =
3718 foamNewDecl(gen0Type(tf, NULL), strCopy(""), fmt0)foamNew(FOAM_Decl,4,(AInt)(gen0Type(tf, ((void*)0))),strCopy(
""), (AInt) (0x7FFF), fmt0)
;
3719 }
3720
3721 return gen0AddRealFormat(ddecl);
3722}
3723#endif
3724
3725/* s/b extern */
3726localstatic AInt
3727gen0CrossFormatNumber(TForm tf)
3728{
3729 Foam ddecl;
3730 Length i, argc;
3731 AInt fmt0 = emptyFormatSlot4;
3732
3733 assert (tfIsCross(tf))do { if (!((((tf)->tag) == TF_Cross))) _do_assert(("tfIsCross(tf)"
),"genfoam.c",3733); } while (0)
;
3734 argc = tfCrossArgc(tf);
3735
3736 /* Generate the format. */
3737 ddecl = foamNewEmpty(FOAM_DDecl, argc + 1);
3738 /* DDecl_Record for now, should be DDecl_Cross */
3739 ddecl->foamDDecl.usage = FOAM_DDecl_Record;
3740 for (i = 0; i < argc; i += 1) {
3741 TForm tfi = tfCrossArgN(tf, i)tfFollowArg(tf, i);
3742 FoamTag tag = gen0Type(tfi, &fmt0);
3743 ddecl->foamDDecl.argv[i] =
3744 foamNewDecl(tag, strCopy(""), fmt0)foamNew(FOAM_Decl,4,(AInt)(tag),strCopy(""), (AInt) (0x7FFF),
fmt0)
;
3745 }
3746
3747 return gen0AddRealFormat(ddecl);
3748}
3749
3750localstatic AInt
3751gen0TrailingFormatNumber(TForm tf)
3752{
3753 TForm atf, itf;
3754 Foam ddecl;
3755 Length i, aargc, iargc;
3756 AInt fmt0 = emptyFormatSlot4;
3757
3758 assert (tfIsTrailingArray(tf))do { if (!((((tf)->tag) == TF_TrailingArray))) _do_assert(
("tfIsTrailingArray(tf)"),"genfoam.c",3758); } while (0)
;
3759
3760 itf = tfTrailingIArg(tf)tfFollowArg(tf,((int) 0));
3761 atf = tfTrailingAArg(tf)tfFollowArg(tf,1);
3762 aargc = tfAsMultiArgc(atf);
3763 iargc = tfAsMultiArgc(itf);
3764
3765 /* Generate the format. */
3766 ddecl = foamNewEmpty(FOAM_DDecl, iargc + aargc + 2);
3767
3768 ddecl->foamDDecl.usage = FOAM_DDecl_TrailingArray;
3769 ddecl->foamDDecl.argv[0] = foamNewDecl(FOAM_NOp, strCopy(""), iargc)foamNew(FOAM_Decl,4,(AInt)(FOAM_NOp),strCopy(""), (AInt) (0x7FFF
), iargc)
;
3770
3771 for (i = 0; i < iargc; i += 1) {
3772 TForm tfi = tfAsMultiArgN(itf, iargc, i);
3773 Syme id = tfDefineeSyme(tfi);
3774 String s = id ? symeString(id)((((id)->id))->str) : "";
3775 FoamTag tag = gen0Type(tfi, &fmt0);
3776 ddecl->foamDDecl.argv[i + 1] =
3777 foamNewDecl(tag, strCopy(s), fmt0)foamNew(FOAM_Decl,4,(AInt)(tag),strCopy(s), (AInt) (0x7FFF), fmt0
)
;
3778 }
3779
3780 for (i = 0; i < aargc; i += 1) {
3781 TForm tfi = tfAsMultiArgN(atf, aargc, i);
3782 Syme id = tfDefineeSyme(tfi);
3783 String s = id ? symeString(id)((((id)->id))->str) : "";
3784 FoamTag tag = gen0Type(tfi, &fmt0);
3785 ddecl->foamDDecl.argv[iargc + 1 + i] =
3786 foamNewDecl(tag, strCopy(s), fmt0)foamNew(FOAM_Decl,4,(AInt)(tag),strCopy(s), (AInt) (0x7FFF), fmt0
)
;
3787 }
3788
3789 return gen0AddRealFormat(ddecl);
3790}
3791
3792AInt
3793gen0MFmtNumberForSig(int sz, FoamTag *types)
3794{
3795 Foam ddecl;
3796 String s = "";
3797 int i;
3798
3799 ddecl = foamNewEmpty(FOAM_DDecl, sz+1);
3800 ddecl->foamDDecl.usage = FOAM_DDecl_Multi;
3801
3802 for (i=0; i<sz ; i++) {
3803 ddecl->foamDDecl.argv[i] =
3804 foamNewDecl(types? types[i]: FOAM_Word,foamNew(FOAM_Decl,4,(AInt)(types? types[i]: FOAM_Word),strCopy
(s), (AInt) (0x7FFF), 4)
3805 strCopy(s), emptyFormatSlot)foamNew(FOAM_Decl,4,(AInt)(types? types[i]: FOAM_Word),strCopy
(s), (AInt) (0x7FFF), 4)
;
3806 }
3807 return gen0AddRealFormat(ddecl);
3808}
3809
3810/*
3811 * Create a field name for a Foam record.
3812 */
3813localstatic String
3814gen0RecFieldName(TForm tf, int i)
3815{
3816 TForm f = tfRecordArgN(tf, i)tfFollowArg(tf, i);
3817 Syme syme = tfDefineeSyme(f);
3818 return syme ? strCopy(symeString(syme)((((syme)->id))->str)) : strPrintf("rf%d", i);
3819}
3820
3821/*
3822 * Create a field name for a Fortran format.
3823 */
3824/*
3825 * !! This function does not appear to be used anymore !!
3826 */
3827#if 0
3828localstatic String
3829gen0FortranFieldName(TForm tf, int i)
3830{
3831 TForm f = tfMapArgN(tf, i);
3832 Syme syme = tfDefineeSyme(f);
3833 return syme ? strCopy(symeString(syme)((((syme)->id))->str)) : strCopy("");
3834}
3835#endif
3836
3837
3838/*
3839 * Detection of modifiable (reference) parameters
3840 */
3841/*
3842 * !! This function does not appear to be used anymore !!
3843 */
3844#if 0
3845localstatic Bool
3846gen0IsParamReference(TForm tf, int i)
3847{
3848 TForm tfa = tfMapArgN(tf, i);
3849
3850 /* Skip any declaration */
3851 if (tfIsDeclare(tfa)(((tfa)->tag) == TF_Declare))
3852 tfa = tfDeclareType(tfa)tfFollowArg(tfa, 0);
3853
3854
3855 return tfIsReferenceFn(tfa);
3856}
3857#endif
3858
3859/*
3860 * Generate Foam for an assignment.
3861 */
3862localstatic Foam
3863genAssign(AbSyn absyn)
3864{
3865 AbSyn lhs = absyn->abAssign.lhs;
3866 AbSyn rhs = absyn->abAssign.rhs;
3867 Foam rhsFoam, foam;
3868
3869 if (gen0IsFortranCall(rhs))
3870 gen0FortranFnResult = lhs;
3871
3872 if (gen0IsImplicitSet(lhs))
3873 return gen0ImplicitSet(absyn);
3874
3875 /*
3876 * This next line must never appear before code which
3877 * generates foam for the RHS, eg. gen0ImplicitSet().
3878 * Otherwise we end up with two identical foam blocks
3879 * for the RHS. This is not only inefficient but if
3880 * the RHS has side-effects then it is plain wrong.
3881 */
3882 rhsFoam = genFoamVal(rhs);
3883
3884
3885 if (abTag(lhs)((lhs)->abHdr.tag) == AB_Declare)
3886 lhs = lhs->abDeclare.id;
3887 if (abTag(lhs)((lhs)->abHdr.tag) == AB_Comma)
3888 return gen0MultiAssign(FOAM_Set, lhs, rhsFoam);
3889 if (gen0IsFortranCall(rhs))
3890 gen0FortranFnResult = 0;
3891
3892 foam = gen0AssignLhs(lhs, rhsFoam);
3893
3894 if (gen0DebugWanted) gen0DbgAssignment(lhs);
3895
3896 return foam;
3897}
3898
3899localstatic Foam
3900gen0AssignLhs(AbSyn lhs, Foam rhsFoam)
3901{
3902 Foam foam;
3903#if 0
3904 if (gen0IsImplicitSet(lhs)) {
3905 gen0ImplicitSet(gen0Type(gen0AbType(lhs), NULL((void*)0)), lhs, rhsFoam);
3906 /* !!! Fixme ??? */
3907 foam = NULL((void*)0);
3908 return;
3909 }
3910#endif
3911 foam = foamNewSet(genId(abDefineeId(lhs)),foamNew(FOAM_Set, 2, genId(abDefineeId(lhs)), rhsFoam)
3912 rhsFoam)foamNew(FOAM_Set, 2, genId(abDefineeId(lhs)), rhsFoam);
3913 foam = gen0SetValue(foam, lhs);
3914
3915 return foam;
3916}
3917
3918
3919localstatic Bool
3920gen0IsImplicitSet(AbSyn lhs)
3921{
3922 if (abTag(lhs)((lhs)->abHdr.tag) != AB_Apply)
3923 return false((int) 0);
3924 return (abImplicitSyme(lhs)(((lhs)->abHdr.seman ? (lhs)->abHdr.seman->implicit :
0) ? ((((lhs)->abHdr.seman ? (lhs)->abHdr.seman->implicit
: 0))->abHdr.seman ? (((lhs)->abHdr.seman ? (lhs)->
abHdr.seman->implicit : 0))->abHdr.seman->syme : 0) :
0)
!= 0);
3925}
3926
3927
3928localstatic Foam
3929gen0ImplicitSet(AbSyn absyn)
3930{
3931 AbSyn lhs = absyn->abAssign.lhs;
3932 AbSyn rhs = absyn->abAssign.rhs;
3933 AbSyn *argv;
3934 FoamTag type = gen0Type(gen0AbContextType(rhs), NULL((void*)0));
3935 Syme syme = abImplicitSyme(lhs)(((lhs)->abHdr.seman ? (lhs)->abHdr.seman->implicit :
0) ? ((((lhs)->abHdr.seman ? (lhs)->abHdr.seman->implicit
: 0))->abHdr.seman ? (((lhs)->abHdr.seman ? (lhs)->
abHdr.seman->implicit : 0))->abHdr.seman->syme : 0) :
0)
;
3936 Length argc = abApplyArgc(lhs)(((lhs)->abHdr.argc)-1) + 2;
3937 Foam foam;
3938
3939 argv = gen0MakeImplicitArgs(argc, absyn, abSetArgf);
3940 foam = gen0ApplyImplicitSyme(type, syme, argc, argv, NULL((void*)0));
3941 foam = gen0ApplyReturn(absyn, syme, gen0AbType(absyn), foam);
3942 return gen0SetValue(foam, lhs);
3943}
3944
3945/*
3946 * Generate code for tuple assignemnts.
3947 *
3948 * !!!FIXME!!! If invoked from gen0Define then we ought to ensure
3949 * that gen0SymeSetInit() is invoked on each lhs target.
3950 */
3951localstatic Foam
3952gen0MultiAssign(FoamTag set, AbSyn lhs, Foam rhsFoam)
3953{
3954 Foam temps;
3955 int i, argc = abArgc(lhs)((lhs)->abHdr.argc);
3956
3957 assert(foamTag(rhsFoam) == FOAM_Values)do { if (!(((rhsFoam)->hdr.tag) == FOAM_Values)) _do_assert
(("foamTag(rhsFoam) == FOAM_Values"),"genfoam.c",3957); } while
(0)
;
3958 assert(argc == foamArgc(rhsFoam))do { if (!(argc == ((rhsFoam)->hdr.argc))) _do_assert(("argc == foamArgc(rhsFoam)"
),"genfoam.c",3958); } while (0)
;
3959
3960 /* Create temporaries so that (a,b) := (b,a) will work */
3961 temps = foamNewEmpty(FOAM_Values, argc);
3962 for(i = 0; i < argc; i++) {
3963 FoamTag tag;
3964 AInt fmt;
3965 tag = gen0Type(gen0AbType(abArgv(lhs)((lhs)->abGen.data.argv)[i]), &fmt);
3966 temps->foamValues.argv[i] = gen0TempLocal0(tag, fmt);
3967
3968 gen0AddStmt(foamNew(set, 2,
3969 foamCopy(temps->foamValues.argv[i]),
3970 rhsFoam->foamValues.argv[i]), lhs);
3971 }
3972 /* Copy the temporary results into the targets */
3973 for(i=0; i < argc; i++) {
3974 AbSyn lhsi = abArgv(lhs)((lhs)->abGen.data.argv)[i];
3975 AbSyn id = abDefineeId(lhsi);
3976 Syme syme = abSyme(id)((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0);
3977 Foam lhsFoam = genId(id);
3978 Foam rhsFoam = foamCopy(temps->foamValues.argv[i]);
3979 Foam def = foamNew(set, 2, lhsFoam, rhsFoam);
3980
3981 /* Note the export slot to be initialised if exporting */
3982 if (gen0IsDomLevel(gen0State->tag)((gen0State->tag) >= GF_START_TYPE && (gen0State
->tag) <= GF_END_TYPE)
&& gen0State->tag != GF_File)
3983 gen0SymeSetInit(syme, lhsFoam);
3984
3985 /* Create the actual definition */
3986 gen0AddStmt(def, lhs);
3987
3988 /* Link between definitions and const values */
3989 if (set==FOAM_Def) def->foamDef.hdr.defnId = abDefineIdx(id)((id)->abHdr.seman ? (id)->abHdr.seman->defnIdx : -1
)
;
3990
3991 /* FIXME: deal with domains defs here (see gen0Define) */
3992 }
3993 if (!gen0ValueMode) {
3994 /*
3995 for(i = 0; i < argc; i++)
3996 gen0FreeTemp(temps->foamValues.argv[i]);
3997 */
3998 foamFree(temps);
3999
4000 return 0;
4001 }
4002 else
4003 return temps;
4004}
4005
4006
4007/*
4008 * Utility function for getting a safe
4009 * return value from a foam assignment
4010 */
4011localstatic Foam
4012gen0SetValue(Foam set, AbSyn absyn)
4013{
4014 Foam lhs;
4015 if (!set || (foamTag(set)((set)->hdr.tag) != FOAM_Set && foamTag(set)((set)->hdr.tag) != FOAM_Def))
4016 return set;
4017 lhs = set->foamSet.lhs;
4018 if (!gen0ValueMode) {
4019 gen0AddStmt(set, absyn);
4020 return 0;
4021 }
4022 if (!foamHasSideEffect(lhs)) {
4023 gen0AddStmt(set, absyn);
4024 return foamCopy(lhs);
4025 }
4026 /**!! Need code to factor out side-effecting part and set to a local */
4027 if (!gen0ValueMode) {
4028 gen0AddStmt(set, absyn);
4029 return 0;
4030 }
4031 gen0AddStmt(set, absyn);
4032 return foamCopy(lhs);
4033}
4034
4035/*
4036 * Generate Foam for a constant definition.
4037 */
4038localstatic Foam
4039genDefine(AbSyn absyn)
4040{
4041 Syme syme = NULL((void*)0);
4042 Foam result;
4043
4044 if (abTag(absyn->abDefine.lhs)((absyn->abDefine.lhs)->abHdr.tag) != AB_Comma) {
4045 AbSyn lhs = abDefineeId(absyn);
4046 syme = abSyme(lhs)((lhs)->abHdr.seman ? (lhs)->abHdr.seman->syme : 0);
4047 }
4048
4049 if (syme && symeExtension(syme))
4050 result = gen0Extend(absyn);
4051 else
4052 result = gen0Define(absyn);
4053
4054 return result;
4055}
4056
4057/*
4058 * Generate Foam for a constant definition.
4059 */
4060localstatic Foam
4061gen0Define(AbSyn absyn)
4062{
4063 AbSyn lhs = absyn->abDefine.lhs;
4064 AbSyn rhs = absyn->abDefine.rhs;
4065 AbSyn id = NULL((void*)0), type = NULL((void*)0);
4066 AbEmbed embed;
4067 Foam rhsFoam, def, res;
4068 Foam lhsFoam = (Foam)NULL((void*)0);
4069 Foam condFoam = (Foam)NULL((void*)0);
4070 Syme syme;
4071
4072 if (abTag(lhs)((lhs)->abHdr.tag) != AB_Comma) {
4073 id = abDefineeId(lhs);
4074 type = abDefineeTypeOrElse(lhs, NULL((void*)0));
4075 }
4076
4077 rhsFoam = gen0DefineRhs(id, type, rhs);
4078
4079 /* This will go once we have the embed tags right */
4080 if (abTContext(rhs)((rhs)->abHdr.seman ? (rhs)->abHdr.seman->embed : 0) == AB_Embed_Fail((AbEmbed) 0)) {
4081 embed = tfSatEmbedType(abTUnique(rhs)((rhs)->abHdr.type.unique), abTUnique(lhs)((lhs)->abHdr.type.unique));
4082 rhsFoam = gen0Embed(rhsFoam, rhs, gen0AbType(rhs), embed);
4083 }
4084
4085 if (abTag(lhs)((lhs)->abHdr.tag) == AB_Comma)
4086 return gen0MultiAssign(FOAM_Def, lhs, rhsFoam);
4087
4088 syme = abSyme(id)((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0);
4089
4090
4091 if (symeIsExport(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Export)
|| symeIsExtend(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Extend)
) {
4092 /*
4093 * If conditional exports weren't bad enough, some
4094 * people write code with conditional defaults. We
4095 * have to deal with conditional exports first even
4096 * if they are defaults: we may need to fix this so
4097 * that conditional defaults are more robust.
4098 */
4099 if (!symeUnconditional(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) & (0x0020))
&&
4100 gen0IsDomLevel(gen0State->tag)((gen0State->tag) >= GF_START_TYPE && (gen0State
->tag) <= GF_END_TYPE)
&&
4101 (gen0State->tag != GF_File))
4102 {
4103 /* Check for previously computed value */
4104 condFoam = gen0SymeCond(syme);
4105
4106
4107 /* Cache export value if not found */
4108 if (!condFoam) {
4109 /* Type of the export */
4110 AInt type = gen0Type(symeType(syme), NULL((void*)0));
4111
4112
4113 /* Create a temporary for the export value */
4114 condFoam = gen0Temp(type)gen0Temp0(type, 4);
4115
4116
4117 /* Stash DefnId for gen0TypeAddExportSlot */
4118 condFoam->foamGen.hdr.defnId = abDefineIdx(id)((id)->abHdr.seman ? (id)->abHdr.seman->defnIdx : -1
)
;
4119
4120
4121 /* Associate foam with syme/condition */
4122 gen0SymeSetCond(syme, condFoam);
4123 }
4124
4125
4126#if 0
4127 /* Debugging output */
4128 (void)fprintf(dbOut, "+++ [%d] ",
4129 condFoam->foamGen.hdr.defnId);
4130 foamPrintDb(condFoam);
4131 (void)fprintf(dbOut, " ");
4132 symePrintDb(syme);
4133 (void)fprintf(dbOut, " ");
4134 ablogPrintDb(gfCondKnown);
4135#endif
4136 }
4137 else if (symeHasDefault(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) & (0x0080))
) {
4138 /*
4139 * Check that the default bit was not
4140 * mis-inherited.
4141 */
4142 assert(gen0State->tag == GF_Default ||do { if (!(gen0State->tag == GF_Default || gen0State->tag
== GF_DefaultCat)) _do_assert(("gen0State->tag == GF_Default || gen0State->tag == GF_DefaultCat"
),"genfoam.c",4143); } while (0)
4143 gen0State->tag == GF_DefaultCat)do { if (!(gen0State->tag == GF_Default || gen0State->tag
== GF_DefaultCat)) _do_assert(("gen0State->tag == GF_Default || gen0State->tag == GF_DefaultCat"
),"genfoam.c",4143); } while (0)
;
4144 lhsFoam = gen0SymeInit(syme);
4145
4146 if (!lhsFoam) {
4147 AInt type = gen0Type(symeType(syme), NULL((void*)0));
4148 lhsFoam = gen0Temp(type)gen0Temp0(type, 4);
4149 }
4150 }
4151 }
4152
4153
4154 /* Did we get any foam for the LHS? */
4155 if (!lhsFoam) lhsFoam = genFoamVal(lhs);
4156
4157
4158 /* Note the export slot to be initialised if exporting */
4159 if (gen0IsDomLevel(gen0State->tag)((gen0State->tag) >= GF_START_TYPE && (gen0State
->tag) <= GF_END_TYPE)
&& gen0State->tag != GF_File)
4160 gen0SymeSetInit(syme, lhsFoam);
4161
4162
4163 /* Use local instead of export slot if conditional */
4164 if (condFoam) lhsFoam = foamCopy(condFoam);
4165
4166
4167 /* Create the export or conditional definition */
4168 def = foamNewDef(lhsFoam, rhsFoam)foamNew(FOAM_Def, 2, lhsFoam, rhsFoam);
4169
4170
4171 /* Link between definitions and const values */
4172 def->foamDef.hdr.defnId = abDefineIdx(id)((id)->abHdr.seman ? (id)->abHdr.seman->defnIdx : -1
)
;
4173
4174
4175 /* Decide where to put the definition */
4176 if (gen0IsDomainInit(rhsFoam)) {
4177 gen0AddInit(def);
4178 res = NULL((void*)0);
4179 /* Stamp the domain with its hash code (if appropriate) */
4180 if (symeHashNum(syme)((int) (SYFI_HashNum < (8 * sizeof(int)) && !(((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->hasmask) & (1 << (SYFI_HashNum
))) ? (symeFieldInfo[SYFI_HashNum].def) : (((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_HashNum))) ?
((((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_HashNum))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_HashNum
)] : (symeFieldInfo[SYFI_HashNum].def)) : symeGetFieldFn(syme
,SYFI_HashNum)))
&& (foamTag(rhsFoam)((rhsFoam)->hdr.tag) == FOAM_Clos)) {
4181 AInt hash = symeHashNum(syme)((int) (SYFI_HashNum < (8 * sizeof(int)) && !(((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->hasmask) & (1 << (SYFI_HashNum
))) ? (symeFieldInfo[SYFI_HashNum].def) : (((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_HashNum))) ?
((((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_HashNum))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_HashNum
)] : (symeFieldInfo[SYFI_HashNum].def)) : symeGetFieldFn(syme
,SYFI_HashNum)))
;
4182 Foam dom = foamCopy(lhsFoam);
4183
4184 /* Don't use gen0AddStmt() ... */
4185 gen0AddInit(gen0RtSetProgHash(dom, hash));
4186 }
4187 }
4188 else
4189 res = gen0SetValue(def, absyn);
4190
4191 return res;
4192}
4193
4194localstatic Foam
4195gen0DefineRhs(AbSyn id, AbSyn type, AbSyn rhs)
4196{
4197 Scope("gen0Define")String scopeName = ("gen0Define"); int fluidLevel0 = (scopeLevel
++, fluidLevel)
;
4198
4199 String fluid(gen0ProgName)fluidSave_gen0ProgName = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(gen0ProgName
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_gen0ProgName
, fluidStack[fluidLevel].size = sizeof(gen0ProgName), fluidLevel
++, (gen0ProgName) )
;
4200 String fluid(gen0DefName)fluidSave_gen0DefName = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(gen0DefName
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_gen0DefName
, fluidStack[fluidLevel].size = sizeof(gen0DefName), fluidLevel
++, (gen0DefName) )
;
4201 Syme syme = NULL((void*)0);
4202 AbSyn oldex;
4203 Stab stab = abStab(rhs)((rhs)->abHdr.seman ? (rhs)->abHdr.seman->stab : 0);
4204 Foam rhsFoam;
4205
4206 if (id) syme = abSyme(id)((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0);
4207
4208 if (abIsAnyLambda(rhs)(((rhs)->abHdr.tag == (AB_Lambda)) || ((rhs)->abHdr.tag
== (AB_PLambda)))
) {
4209 if (type) type = abMapRet(type)((type)->abApply.argv[1]);
4210 gen0ProgName = strCopy(symeString(syme)((((syme)->id))->str));
4211 oldex = gen0ProgPushExporter(id);
4212
4213 /* patch up ConstNum(syme) */
4214 gen0AddConst(symeConstNum(syme)(((AInt) (SYFI_ConstInfo < (8 * sizeof(int)) && !(
((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->hasmask) & (1 << (SYFI_ConstInfo
))) ? (symeFieldInfo[SYFI_ConstInfo].def) : (((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_ConstInfo)))
? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme
)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_ConstInfo))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_ConstInfo
)] : (symeFieldInfo[SYFI_ConstInfo].def)) : symeGetFieldFn(syme
,SYFI_ConstInfo))) & 0xFFFF)
, gen0NumProgs);
4215 genSetConstNum(syme, abDefineIdx(id)((id)->abHdr.seman ? (id)->abHdr.seman->defnIdx : -1
)
, (UShort) gen0NumProgs, true1);
4216
4217 rhsFoam = gen0Lambda(rhs, syme, type);
4218 gen0ProgPopExporter(oldex);
4219 }
4220 else if (abTag(rhs)((rhs)->abHdr.tag) == AB_Add) {
4221 gen0ProgName = gen0FileName;
4222 gen0DefName = strCopy(syme ? symeString(syme)((((syme)->id))->str) : gen0ProgName);
4223 if (genIsRuntime()(gen0IsRuntime)) {
4224 gen0Vars(stab);
4225 rhsFoam = genFoamVal(rhs->abAdd.capsule);
4226 }
4227 else {
4228 oldex = gen0ProgPushExporter(id);
4229 rhsFoam = gen0AddBody0(rhs, stab, type);
4230 gen0ProgPopExporter(oldex);
4231 }
4232 }
4233 else if (syme && tfIsCategoryType(symeType(syme))) {
4234 gen0ProgName = strCopy(symeString(syme)((((syme)->id))->str));
4235 gen0DefName = strCopy(gen0ProgName);
4236 oldex = gen0ProgPushExporter(id);
4237 rhsFoam = gen0MakeDefaultPackage(rhs, stab, true1, syme);
4238 gen0ProgPopExporter(oldex);
4239 }
4240 else {
4241 gen0ProgName = gen0FileName;
4242 rhsFoam = genFoamVal(rhs);
4243 }
4244
4245 if (syme && gen0AbSynHasConstHash(rhs))
4246 symeSetHashNum(syme, strHash(symeString(syme)))(symeSetFieldVal = ((AInt) (strHash(((((syme)->id))->str
)))), (((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme
)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_HashNum))) ? (((syme)->fieldv)[symeIndex(syme,SYFI_HashNum
)] = (symeSetFieldVal)) : !((syme)->full) && symeSetFieldVal
== (symeFieldInfo[SYFI_HashNum].def) ? symeSetFieldVal : symeSetFieldFn
(syme,SYFI_HashNum,symeSetFieldVal))
;
4247
4248 Return(rhsFoam){ fluidUnwind(fluidLevel0, ((int) 0)); return rhsFoam;; };
4249}
4250
4251
4252localstatic Bool
4253gen0IsDomainInit(Foam foam)
4254{
4255 Foam arg;
4256 if (foamTag(foam)((foam)->hdr.tag) == FOAM_Clos &&
4257 foamTag(foam->foamClos.prog)((foam->foamClos.prog)->hdr.tag) == FOAM_Const &&
4258 foamTag(foam->foamClos.env)((foam->foamClos.env)->hdr.tag) == FOAM_Env)
4259 return true1;
4260 if (foamTag(foam)((foam)->hdr.tag) != FOAM_CCall ||
4261 foamArgc(foam)((foam)->hdr.argc) != 3 ||
4262 foamTag(foam->foamCCall.op)((foam->foamCCall.op)->hdr.tag) != FOAM_Glo)
4263 return false((int) 0);
4264 arg = foam->foamCCall.argv[0];
4265 return (foamTag(arg)((arg)->hdr.tag) == FOAM_Clos &&
4266 foamTag(arg->foamClos.prog)((arg->foamClos.prog)->hdr.tag) == FOAM_Const &&
4267 foamTag(arg->foamClos.env)((arg->foamClos.env)->hdr.tag) == FOAM_Env);
4268}
4269
4270/*
4271 * Generate Foam for a domain extension.
4272 */
4273localstatic Foam
4274gen0Extend(AbSyn absyn)
4275{
4276 AbSyn lhs = abDefineeId(absyn);
4277 Syme syme = abSyme(lhs)((lhs)->abHdr.seman ? (lhs)->abHdr.seman->syme : 0), extension;
4278 SymeList extendee;
4279 Foam result;
4280
4281 assert(syme)do { if (!(syme)) _do_assert(("syme"),"genfoam.c",4281); } while
(0)
;
4282 extension = symeExtension(syme);
4283 assert(extension && symeIsExtend(extension))do { if (!(extension && (((((extension)->kind == SYME_Trigger
? libGetAllSymes((extension)->lib) : ((void*)0)), (extension
))->kind) == SYME_Extend))) _do_assert(("extension && symeIsExtend(extension)"
),"genfoam.c",4283); } while (0)
;
4284 extendee = symeExtendee(extension);
4285 assert(listMemq(Syme)(extendee, syme))do { if (!((Syme_listPointer->Memq)(extendee, syme))) _do_assert
(("listMemq(Syme)(extendee, syme)"),"genfoam.c",4285); } while
(0)
;
4286
4287 symeListSetExtension(extendee, NULL((void*)0));
4288
4289 result = gen0Define(absyn);
4290 if (symeHashNum(syme)((int) (SYFI_HashNum < (8 * sizeof(int)) && !(((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->hasmask) & (1 << (SYFI_HashNum
))) ? (symeFieldInfo[SYFI_HashNum].def) : (((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_HashNum))) ?
((((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_HashNum))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_HashNum
)] : (symeFieldInfo[SYFI_HashNum].def)) : symeGetFieldFn(syme
,SYFI_HashNum)))
) symeSetHashNum(extension, symeHashNum(syme))(symeSetFieldVal = ((AInt) (((int) (SYFI_HashNum < (8 * sizeof
(int)) && !(((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->hasmask) & (1
<< (SYFI_HashNum))) ? (symeFieldInfo[SYFI_HashNum].def
) : (((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme
)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_HashNum))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_HashNum))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_HashNum)] : (symeFieldInfo[SYFI_HashNum].def)) : symeGetFieldFn
(syme,SYFI_HashNum))))), (((((extension)->kind == SYME_Trigger
? libGetAllSymes((extension)->lib) : ((void*)0)), (extension
))->locmask) & (1 << (SYFI_HashNum))) ? (((extension
)->fieldv)[symeIndex(extension,SYFI_HashNum)] = (symeSetFieldVal
)) : !((extension)->full) && symeSetFieldVal == (symeFieldInfo
[SYFI_HashNum].def) ? symeSetFieldVal : symeSetFieldFn(extension
,SYFI_HashNum,symeSetFieldVal))
;
4291 symeListSetExtension(extendee, extension);
4292
4293 if (syme == car(listLastCons(Syme)(extendee))(((Syme_listPointer->LastCons)(extendee))->first)) {
4294 Foam val = gen0MakeExtend(extension, symeType(extension));
4295 Foam dom = gen0Syme(extension);
4296 Foam def = foamNewDef(dom, val)foamNew(FOAM_Def, 2, dom, val);
4297 if (gen0IsDomainInit(val)) {
4298 gen0AddInit(def);
4299 result = NULL((void*)0);
4300 /* Stamp the extension with its hash code */
4301 if (symeHashNum(extension)((int) (SYFI_HashNum < (8 * sizeof(int)) && !(((((
extension)->kind == SYME_Trigger ? libGetAllSymes((extension
)->lib) : ((void*)0)), (extension))->hasmask) & (1 <<
(SYFI_HashNum))) ? (symeFieldInfo[SYFI_HashNum].def) : (((((
extension)->kind == SYME_Trigger ? libGetAllSymes((extension
)->lib) : ((void*)0)), (extension))->locmask) & (1 <<
(SYFI_HashNum))) ? ((((((extension)->kind == SYME_Trigger
? libGetAllSymes((extension)->lib) : ((void*)0)), (extension
))->locmask) & (1 << (SYFI_HashNum))) ? ((extension
)->fieldv)[symeIndex(extension,SYFI_HashNum)] : (symeFieldInfo
[SYFI_HashNum].def)) : symeGetFieldFn(extension,SYFI_HashNum)
))
&&
4302 (foamTag(val)((val)->hdr.tag) == FOAM_Clos)) {
4303 AInt hash = symeHashNum(extension)((int) (SYFI_HashNum < (8 * sizeof(int)) && !(((((
extension)->kind == SYME_Trigger ? libGetAllSymes((extension
)->lib) : ((void*)0)), (extension))->hasmask) & (1 <<
(SYFI_HashNum))) ? (symeFieldInfo[SYFI_HashNum].def) : (((((
extension)->kind == SYME_Trigger ? libGetAllSymes((extension
)->lib) : ((void*)0)), (extension))->locmask) & (1 <<
(SYFI_HashNum))) ? ((((((extension)->kind == SYME_Trigger
? libGetAllSymes((extension)->lib) : ((void*)0)), (extension
))->locmask) & (1 << (SYFI_HashNum))) ? ((extension
)->fieldv)[symeIndex(extension,SYFI_HashNum)] : (symeFieldInfo
[SYFI_HashNum].def)) : symeGetFieldFn(extension,SYFI_HashNum)
))
;
4304 Foam ext = foamCopy(dom);
4305
4306 gen0AddInit(gen0RtSetProgHash(ext, hash));
4307 }
4308 }
4309 else
4310 result = gen0SetValue(def, absyn);
4311 }
4312
4313 return result;
4314}
4315
4316/*
4317 * Generate code for the function to create a (possibly parameterized)
4318 * extension domain.
4319 */
4320localstatic Foam
4321gen0MakeExtend(Syme syme, TForm tf)
4322{
4323 if (tfIsMap(tf)(((tf)->tag) == TF_Map))
4324 return gen0MakeExtendLambda(syme, tf);
4325 else
4326 return gen0MakeExtendBase(syme);
4327}
4328
4329/*
4330 * Generate code for the function to create a parameterized extension domain.
4331 */
4332localstatic Foam
4333gen0MakeExtendLambda(Syme syme, TForm tf)
4334{
4335 Foam *paramv;
4336 Foam foam, clos, var;
4337 FoamTag retType;
4338 AInt index;
4339 TForm tfret;
4340 Stab stab;
4341 RTCacheInfo cache;
4342 int i;
4343
4344 assert(tfIsMap(tf))do { if (!((((tf)->tag) == TF_Map))) _do_assert(("tfIsMap(tf)"
),"genfoam.c",4344); } while (0)
;
4345
4346 tfret = tfMapRet(tf)tfFollowArg(tf, 1);
4347 retType = gen0Type(tfret, NULL((void*)0));
4348
4349 stab = gen0State->stab;
4350 if (tfMapArgc(tf) > 0) {
4351 /* This is just a really cheezy way to get a stab. */
4352 assert(tfSymes(tf))do { if (!(((tf)->symes))) _do_assert(("tfSymes(tf)"),"genfoam.c"
,4352); } while (0)
;
4353 stab = listCons(StabLevel)(StabLevel_listPointer->Cons)(symeDefLevel(car(tfSymes(tf))((((tf)->symes))->first)),
4354 stab);
4355 }
4356
4357 cache = gen0CacheMakeEmpty(NULL((void*)0));
4358 clos = gen0ProgClosEmpty();
4359 foam = gen0ProgInitEmpty(gen0ProgName, NULL((void*)0));
4360
4361 index = gen0FormatNum;
4362 gen0ProgPushState(stab, GF_Lambda);
4363
4364 if (tfIsMulti(tfret)(((tfret)->tag) == TF_Multiple))
4365 foam->foamProg.format = gen0MultiFormatNumber(tfret);
4366
4367 gen0State->type = tf;
4368 gen0State->program = foam;
4369
4370 gen0PushFormat(index);
4371
4372 gen0Vars(stab);
4373 var = gen0Temp(FOAM_Word)gen0Temp0(FOAM_Word, 4);
4374
4375 paramv = (Foam*) stoAlloc(OB_Other0, sizeof(Foam)*tfMapArgc(tf));
4376 for (i=0; i<tfMapArgc(tf); i++) {
4377 TForm ntf = tfMapArgN(tf, i);
4378 paramv[i] = genFoamVal(abDefineeId(tfExpr(ntf)tfToAbSyn(ntf)));
4379 if (gen0Type(ntf, NULL((void*)0)) != FOAM_Word) {
4380 paramv[i] = foamNewCast(FOAM_Word, paramv[i])foamNew(FOAM_Cast, 2, FOAM_Word, paramv[i]);
4381 }
4382 }
4383 gen0CacheCheck(cache, tfMapArgc(symeType(syme)), paramv);
4384
4385 gen0AddStmt(foamNewSet(var, gen0MakeExtend(syme, tfret))foamNew(FOAM_Set, 2, var, gen0MakeExtend(syme, tfret)), NULL((void*)0));
4386 var = gen0CacheReturn(cache, foamCopy(var));
4387 gen0AddStmt(foamNewReturn(var)foamNew(FOAM_Return, 1, var), NULL((void*)0));
4388 gen0ProgAddStateFormat(index);
4389 gen0IssueDCache();
4390 gen0ProgFiniEmpty(foam, retType, int0((int) 0));
4391
4392 foamOptInfo(foam)((foam)->hdr.info.opt) = optInfoNew(gen0State->stab, foam, NULL((void*)0), false((int) 0));
4393 foamProgSetGetter(foam)((foam)->foamProg.infoBits |= (1 << 3));
4394
4395 gen0ProgPopState();
4396 if (gen0IsDomainInit(clos))
4397 gen0AddInit(cache->init);
4398 else
4399 gen0AddStmt(cache->init, cache->ab);
4400 gen0CacheKill(cache);
4401
4402 return clos;
4403}
4404
4405/*
4406 * Generate code for the function to create an extension domain.
4407 */
4408localstatic Foam
4409gen0MakeExtendBase(Syme syme)
4410{
4411 Foam foam, clos;
4412 AInt index;
4413 Length argc;
4414 String argv[1];
4415
4416 argc = 1;
4417 argv[0] = "domain";
4418
4419 assert(!genIsRuntime())do { if (!(!(gen0IsRuntime))) _do_assert(("!genIsRuntime()"),
"genfoam.c",4419); } while (0)
;
4420
4421 clos = gen0ProgClosEmpty();
4422 foam = gen0ProgInitEmpty("extend0", NULL((void*)0));
4423
4424 index = gen0FormatNum;
4425 gen0ProgPushState(gen0State->stab, GF_Add0);
4426
4427 gen0PushFormat(index);
4428
4429 gen0ProgAddParams(argc, argv);
4430
4431 gen0State->program = foam;
4432 gen0State->program->foamProg.infoBits = IB_SIDE(1 << 0);
4433
4434 gen0MakeExtendParents(syme, symeExtendee(syme));
4435#if 0
4436 gen0AddStmt(foamNewReturn(foamNewCast(FOAM_Clos, foamNewPar(int0)))foamNew(FOAM_Return, 1, foamNew(FOAM_Cast, 2, FOAM_Clos, foamNew
(FOAM_Par, 1, (AInt)(((int) 0)))))
, NULL((void*)0));
4437#endif
4438 gen0AddStmt(foamNewReturn(foamNewCast(FOAM_Clos, foamNewNil()))foamNew(FOAM_Return, 1, foamNew(FOAM_Cast, 2, FOAM_Clos, foamNew
(FOAM_Nil, (int) 0)))
, NULL((void*)0));
4439
4440 gen0ProgAddStateFormat(index);
4441 gen0IssueDCache();
4442 gen0ProgFiniEmpty(foam, FOAM_Clos, int0((int) 0));
4443
4444 foamOptInfo(foam)((foam)->hdr.info.opt) = optInfoNew(gen0State->stab, foam, NULL((void*)0), false((int) 0));
4445 foamProgSetGetter(foam)((foam)->foamProg.infoBits |= (1 << 3));
4446
4447 gen0ProgPopState();
4448
4449 foam = gen0BuiltinCCall(FOAM_Word, "extendMake", "runtime", 1, clos);
4450 return foam;
4451}
4452
4453/*
4454 * Helper functions for gen0MakeExtend.
4455 */
4456localstatic void
4457gen0MakeExtendParents(Syme syme, SymeList symes)
4458{
4459 Foam pars, result;
4460 Length i, argc = listLength(Syme)(Syme_listPointer->_Length)(symes);
4461
4462 /* Create the foam array for the parent vector. */
4463 pars = gen0TempLocal0(FOAM_Arr, FOAM_Word);
4464 gen0AddStmt(gen0ANew(pars, FOAM_Word, argc)foamNew(FOAM_Set, 2, foamCopy(pars), foamNew(FOAM_ANew, 2, FOAM_Word
, foamNew(FOAM_SInt, 1, (AInt)(argc))))
, NULL((void*)0));
4465
4466 /* Fill the slots in the foam array. */
4467 for (i = argc - 1; symes; i -= 1, symes = cdr(symes)((symes)->rest))
4468 gen0MakeExtendParent(syme, car(symes)((symes)->first), i, pars);
4469
4470 /* Create the Aldor array for the domain parents. */
4471 pars = gen0MakeArray(foamNewSInt(argc)foamNew(FOAM_SInt, 1, (AInt)(argc)), pars, NULL((void*)0));
4472
4473 result = gen0BuiltinCCall(FOAM_Word, "extendFill!", "runtime", 2,
4474 foamNewPar(int0)foamNew(FOAM_Par, 1, (AInt)(((int) 0))), pars);
4475 gen0AddStmt(result, NULL((void*)0));
4476}
4477
4478localstatic void
4479gen0MakeExtendParent(Syme syme, Syme parent, Length i, Foam pars)
4480{
4481 Foam par = gen0MakeExtendApply(symeType(syme), gen0Syme(parent));
4482
4483 gen0AddStmt(gen0ASet(pars, i, FOAM_Word, par)foamNew(FOAM_Set, 2, foamNew(FOAM_AElt,3,(AInt)(FOAM_Word),foamNew
(FOAM_SInt, 1, (AInt)(i)),foamCopy(pars)), par)
, NULL((void*)0));
4484}
4485
4486localstatic Foam
4487gen0MakeExtendApply(TForm tf, Foam foam)
4488{
4489 Foam call;
4490 Length i, j, k, argc;
4491
4492 if (!tfIsMap(tf)(((tf)->tag) == TF_Map)) {
4493 if (gen0Type(tf, NULL((void*)0)) != FOAM_Word)
4494 foam = foamNewCast(FOAM_Word, foam)foamNew(FOAM_Cast, 2, FOAM_Word, foam);
4495 return foam;
4496 }
4497
4498 argc = tfMapArgc(tf);
4499
4500 call = foamNewEmpty(FOAM_CCall, TypeSlot1+OpSlot1 + argc);
4501 call->foamCCall.type = gen0Type(tfMapRet(tf)tfFollowArg(tf, 1), NULL((void*)0));
4502 call->foamCCall.op = foam;
4503
4504 for (i = TypeSlot1+OpSlot1, j = 0; j < argc; i += 1, j += 1) {
4505 TForm tfj = tfMapArgN(tf, j);
4506 Syme syme = NULL((void*)0);
4507 if (tfIsMeet(tfj)(((tfj)->tag) == TF_Meet))
4508 for (k = 0; !syme && k < tfMeetArgc(tfj)((tfj)->argc); k += 1)
4509 syme = tfDefineeSyme(tfMeetArgv(tfj)((tfj)->argv)[k]);
4510 else
4511 syme = tfDefineeSyme(tfj);
4512 assert(syme)do { if (!(syme)) _do_assert(("syme"),"genfoam.c",4512); } while
(0)
;
4513 call->foamGen.argv[i].code = gen0Syme(syme);
4514 }
4515
4516 return gen0MakeExtendApply(tfMapRet(tf)tfFollowArg(tf, 1), call);
4517}
4518
4519/*
4520 * Generate Foam for an identifier.
4521 */
4522localstatic Foam
4523genId(AbSyn absyn)
4524{
4525 return gen0ExtendSyme(abSyme(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->syme :
0)
);
4526}
4527
4528/*
4529 * Generate Foam for a literal.
4530 */
4531localstatic Foam
4532genLit(AbSyn absyn)
4533{
4534 Syme syme = abSyme(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->syme :
0)
;
4535 FoamTag type = gen0Type(gen0AbType(absyn), NULL((void*)0));
4536 String str = abLeafStr(absyn)((absyn)->abGen.data.str);
4537 Foam *argloc;
4538 Foam foam = gen0ApplySyme(type, syme,
4539 abSymeImpl(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->impl :
0)
, 1, &argloc);
4540
4541 argloc[0] = foamNewCast(FOAM_Word,gen0CharArray(str))foamNew(FOAM_Cast, 2, FOAM_Word, gen0CharArray(str));
4542
4543 return foam;
4544}
4545
4546localstatic Bool
4547gen0IsInnerVar(Syme syme, AInt level)
4548{
4549 GenFoamState s;
4550 if (level != 0)
4551 return false((int) 0);
4552 s = gen0NthState(level);
4553 return symeDefLevelNo(syme)(symeDefLevel(syme)->lexicalLevel) > stabLevelNo(s->stab)(((s->stab)->first)->lexicalLevel);
4554}
4555
4556/*!!
4557 * This is only needed because symes aren't shared between add bodys and
4558 * decls for domain return values.
4559 */
4560localstatic int
4561gen0ParamIndex(Syme param)
4562{
4563 StabLevel stab = symeDefLevel(param);
4564 int i = 0, j=0, me=-1;
4565 Syme syme;
4566 SymeList l;
4567
4568 assert (stab)do { if (!(stab)) _do_assert(("stab"),"genfoam.c",4568); } while
(0)
;
4569 for(i = 0, l = stab->boundSymes; l; l = cdr(l)((l)->rest), i++) {
4570 syme = car(l)((l)->first);
4571 if (symeIsParam(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Param)
)
4572 j++;
4573 if (symeId(param)((param)->id)==symeId(syme)((syme)->id))
4574 me = j;
4575 }
4576 assert(me>=0)do { if (!(me>=0)) _do_assert(("me>=0"),"genfoam.c",4576
); } while (0)
;
4577
4578 return j-me;
4579}
4580
4581/*
4582 * Generate Foam for the Syme of an identifier.
4583 */
4584
4585extern Bool genfEnvDebug;
4586
4587Foam
4588gen0ExtendSyme(Syme syme)
4589{
4590 while (symeExtensionFirst(syme)) syme = symeExtensionFirst(syme);
4591 return gen0Syme(syme);
4592}
4593
4594Foam
4595gen0Syme(Syme syme)
4596{
4597 Foam foam;
4598
4599 switch (symeKind(syme)((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind)
) {
4600 case SYME_Param:
4601 case SYME_LexConst:
4602 case SYME_LexVar:
4603 case SYME_Export:
4604 case SYME_Extend:
4605 foam = gen0SymeGeneric(syme);
4606 break;
4607
4608 case SYME_Foreign: {
4609 assert(gen0FoamKind(syme) == FOAM_Glo)do { if (!(((((FoamTag) (SYFI_FoamKind < (8 * sizeof(int))
&& !(((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->hasmask) & (1
<< (SYFI_FoamKind))) ? (symeFieldInfo[SYFI_FoamKind].def
) : (((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme
)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_FoamKind))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_FoamKind))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_FoamKind)] : (symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn
(syme,SYFI_FoamKind))) != FOAM_LIMIT) ? ((FoamTag) (SYFI_FoamKind
< (8 * sizeof(int)) && !(((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
hasmask) & (1 << (SYFI_FoamKind))) ? (symeFieldInfo
[SYFI_FoamKind].def) : (((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_FoamKind))) ? ((((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_FoamKind))) ? ((syme)->fieldv
)[symeIndex(syme,SYFI_FoamKind)] : (symeFieldInfo[SYFI_FoamKind
].def)) : symeGetFieldFn(syme,SYFI_FoamKind))) : ((FoamTag) (
SYFI_FoamKind < (8 * sizeof(int)) && !(((((symeOriginal
(syme))->kind == SYME_Trigger ? libGetAllSymes((symeOriginal
(syme))->lib) : ((void*)0)), (symeOriginal(syme)))->hasmask
) & (1 << (SYFI_FoamKind))) ? (symeFieldInfo[SYFI_FoamKind
].def) : (((((symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_FoamKind))) ? ((((((
symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_FoamKind))) ? ((symeOriginal
(syme))->fieldv)[symeIndex(symeOriginal(syme),SYFI_FoamKind
)] : (symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn(symeOriginal
(syme),SYFI_FoamKind)))) == FOAM_Glo)) _do_assert(("gen0FoamKind(syme) == FOAM_Glo"
),"genfoam.c",4609); } while (0)
;
4610 if (tfIsMap(symeType(syme))(((symeType(syme))->tag) == TF_Map)) {
4611 foam = gen0ForeignWrapValue(syme);
4612 } else
4613 foam = foamNew(gen0FoamKind(syme)((((FoamTag) (SYFI_FoamKind < (8 * sizeof(int)) &&
!(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->hasmask) & (1 <<
(SYFI_FoamKind))) ? (symeFieldInfo[SYFI_FoamKind].def) : (((
((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_FoamKind
))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes((
syme)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_FoamKind))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_FoamKind
)] : (symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn(syme
,SYFI_FoamKind))) != FOAM_LIMIT) ? ((FoamTag) (SYFI_FoamKind <
(8 * sizeof(int)) && !(((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
hasmask) & (1 << (SYFI_FoamKind))) ? (symeFieldInfo
[SYFI_FoamKind].def) : (((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_FoamKind))) ? ((((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_FoamKind))) ? ((syme)->fieldv
)[symeIndex(syme,SYFI_FoamKind)] : (symeFieldInfo[SYFI_FoamKind
].def)) : symeGetFieldFn(syme,SYFI_FoamKind))) : ((FoamTag) (
SYFI_FoamKind < (8 * sizeof(int)) && !(((((symeOriginal
(syme))->kind == SYME_Trigger ? libGetAllSymes((symeOriginal
(syme))->lib) : ((void*)0)), (symeOriginal(syme)))->hasmask
) & (1 << (SYFI_FoamKind))) ? (symeFieldInfo[SYFI_FoamKind
].def) : (((((symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_FoamKind))) ? ((((((
symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_FoamKind))) ? ((symeOriginal
(syme))->fieldv)[symeIndex(symeOriginal(syme),SYFI_FoamKind
)] : (symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn(symeOriginal
(syme),SYFI_FoamKind))))
, 1,
4614 (AInt) gen0VarIndex(syme)((((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) != (0x7FFF
)) ? ((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) : ((UShort
) ((((((symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_VarIndex))) ? ((symeOriginal
(syme))->fieldv)[symeIndex(symeOriginal(syme),SYFI_VarIndex
)] : (symeFieldInfo[SYFI_VarIndex].def))))
);
4615 break;
4616 }
4617 case SYME_Fluid:
4618 foam = foamNewFluid(gen0VarIndex(syme))foamNew(FOAM_Fluid, 1, (AInt)(((((UShort) ((((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_VarIndex))) ?
((syme)->fieldv)[symeIndex(syme,SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))) != (0x7FFF)) ? ((UShort) ((((((syme)->
kind == SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void
*)0)), (syme))->locmask) & (1 << (SYFI_VarIndex)
)) ? ((syme)->fieldv)[symeIndex(syme,SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))) : ((UShort) ((((((symeOriginal(syme))->
kind == SYME_Trigger ? libGetAllSymes((symeOriginal(syme))->
lib) : ((void*)0)), (symeOriginal(syme)))->locmask) & (
1 << (SYFI_VarIndex))) ? ((symeOriginal(syme))->fieldv
)[symeIndex(symeOriginal(syme),SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))))))
;
4619 foamProgSetUsesFluid(gen0State->program)((gen0State->program)->foamProg.infoBits |= (1 <<
5))
;
4620 break;
4621 case SYME_Library:
4622 bug("Invalid use of library");
4623 NotReached(foam = 0){(void)bug("Not supposed to reach line %d in file: %s\n",4623
, "genfoam.c");}
;
4624 break;
4625
4626 case SYME_Archive:
4627 bug("Invalid use of archive");
4628 NotReached(foam = 0){(void)bug("Not supposed to reach line %d in file: %s\n",4628
, "genfoam.c");}
;
4629 break;
4630
4631 case SYME_Import:
4632 foam = gen0SymeImport(syme);
4633 break;
4634
4635 case SYME_Builtin:
4636 foam = foamNewBVal(symeBuiltin(syme))foamNew(FOAM_BVal, 1, (AInt)(((FoamBValTag) (SYFI_Builtin <
(8 * sizeof(int)) && !(((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
hasmask) & (1 << (SYFI_Builtin))) ? (symeFieldInfo[
SYFI_Builtin].def) : (((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_Builtin))) ? ((((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_Builtin))) ? ((syme)->fieldv
)[symeIndex(syme,SYFI_Builtin)] : (symeFieldInfo[SYFI_Builtin
].def)) : symeGetFieldFn(syme,SYFI_Builtin)))))
;
4637 break;
4638
4639 case SYME_Temp:
4640 foam = foamCopy(symeFoam(syme)((Foam) (SYFI_Foam < (8 * sizeof(int)) && !(((((syme
)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib) :
((void*)0)), (syme))->hasmask) & (1 << (SYFI_Foam
))) ? (symeFieldInfo[SYFI_Foam].def) : (((((syme)->kind ==
SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0)),
(syme))->locmask) & (1 << (SYFI_Foam))) ? (((((
(syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_Foam
))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_Foam)] : (symeFieldInfo
[SYFI_Foam].def)) : symeGetFieldFn(syme,SYFI_Foam)))
);
4641 break;
4642
4643 default:
4644 bugUnimpl("syme kind in genFoam")bug("Unimplemented %s (line %d in file %s).", "syme kind in genFoam"
, 4644, "genfoam.c")
;
4645 NotReached(foam = 0){(void)bug("Not supposed to reach line %d in file: %s\n",4645
, "genfoam.c");}
;
4646 }
4647
4648 if (symeKind(syme)((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind)
!= SYME_Temp && !foamSyme(foam)((foam)->hdr.syme))
4649 foamSyme(foam)((foam)->hdr.syme) = syme;
4650
4651 symeSetUsed(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) |= (0x0040))
;
4652 return foam;
4653}
4654
4655localstatic Syme
4656gen0SymeCopyImport(Syme syme)
4657{
4658 TForm tf;
4659
4660 assert(symeIsExport(syme) || symeIsExtend(syme))do { if (!((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->kind) == SYME_Export
) || (((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme
)->lib) : ((void*)0)), (syme))->kind) == SYME_Extend)))
_do_assert(("symeIsExport(syme) || symeIsExtend(syme)"),"genfoam.c"
,4660); } while (0)
;
4661 assert(symeLib(syme))do { if (!(((syme)->lib))) _do_assert(("symeLib(syme)"),"genfoam.c"
,4661); } while (0)
;
4662
4663 tf = tfLibrary(libLibrarySyme(symeLib(syme)((syme)->lib)));
4664 syme = symeCopy(syme);
4665 symeSetKind(syme, SYME_Import)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) = (SYME_Import))
;
4666 symeSetExporter(syme, tf)(symeSetFieldVal = ((AInt) (tf)), (((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_Exporter))) ? (((syme)->fieldv
)[symeIndex(syme,SYFI_Exporter)] = (symeSetFieldVal)) : !((syme
)->full) && symeSetFieldVal == (symeFieldInfo[SYFI_Exporter
].def) ? symeSetFieldVal : symeSetFieldFn(syme,SYFI_Exporter,
symeSetFieldVal))
;
4667 return syme;
4668}
4669
4670localstatic Foam
4671gen0SymeGeneric(Syme syme)
4672{
4673 FoamTag kind = gen0FoamKind(syme)((((FoamTag) (SYFI_FoamKind < (8 * sizeof(int)) &&
!(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->hasmask) & (1 <<
(SYFI_FoamKind))) ? (symeFieldInfo[SYFI_FoamKind].def) : (((
((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_FoamKind
))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes((
syme)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_FoamKind))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_FoamKind
)] : (symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn(syme
,SYFI_FoamKind))) != FOAM_LIMIT) ? ((FoamTag) (SYFI_FoamKind <
(8 * sizeof(int)) && !(((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
hasmask) & (1 << (SYFI_FoamKind))) ? (symeFieldInfo
[SYFI_FoamKind].def) : (((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_FoamKind))) ? ((((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_FoamKind))) ? ((syme)->fieldv
)[symeIndex(syme,SYFI_FoamKind)] : (symeFieldInfo[SYFI_FoamKind
].def)) : symeGetFieldFn(syme,SYFI_FoamKind))) : ((FoamTag) (
SYFI_FoamKind < (8 * sizeof(int)) && !(((((symeOriginal
(syme))->kind == SYME_Trigger ? libGetAllSymes((symeOriginal
(syme))->lib) : ((void*)0)), (symeOriginal(syme)))->hasmask
) & (1 << (SYFI_FoamKind))) ? (symeFieldInfo[SYFI_FoamKind
].def) : (((((symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_FoamKind))) ? ((((((
symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_FoamKind))) ? ((symeOriginal
(syme))->fieldv)[symeIndex(symeOriginal(syme),SYFI_FoamKind
)] : (symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn(symeOriginal
(syme),SYFI_FoamKind))))
;
4674 AInt level;
4675
4676 if (kind == FOAM_LIMIT) {
4677 if ((symeIsExport(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Export)
|| symeIsExtend(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Extend)
) && symeLib(syme)((syme)->lib))
4678 return gen0SymeImport(gen0SymeCopyImport(syme));
4679
4680 /*!! Scobind needs to share param symes in cat forms */
4681 else if (symeIsParam(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Param)
) {
4682 kind = FOAM_Lex;
4683 gen0SetFoamKind(syme, kind);
4684 /*!! Assumes params are in order in symTab. */
4685 gen0SetVarIndex(syme, gen0ParamIndex(syme))(symeSetFieldVal = ((AInt) (gen0ParamIndex(syme))), (((((syme
)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib) :
((void*)0)), (syme))->locmask) & (1 << (SYFI_VarIndex
))) ? (((syme)->fieldv)[symeIndex(syme,SYFI_VarIndex)] = (
symeSetFieldVal)) : !((syme)->full) && symeSetFieldVal
== (symeFieldInfo[SYFI_VarIndex].def) ? symeSetFieldVal : symeSetFieldFn
(syme,SYFI_VarIndex,symeSetFieldVal))
;
4686 }
4687
4688 else if (symeIsLexVar(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_LexVar)
&& symeIsSelf(syme)(((syme)->id) == ssymSelf) &&
4689 gen0IsDomLevel(gen0State->tag)((gen0State->tag) >= GF_START_TYPE && (gen0State
->tag) <= GF_END_TYPE)
)
4690 return gen0LocalSelf();
4691
4692 else {
4693 bug("gen0Syme: syme unallocated by gen0Vars");
4694 NotReached(return NULL){(void)bug("Not supposed to reach line %d in file: %s\n",4694
, "genfoam.c");}
;
4695 }
4696 }
4697
4698 if (kind != FOAM_Lex) {
4699 assert(kind != FOAM_Nil)do { if (!(kind != FOAM_Nil)) _do_assert(("kind != FOAM_Nil")
,"genfoam.c",4699); } while (0)
;
4700 return foamNew(kind, 1, (AInt) gen0VarIndex(syme)((((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) != (0x7FFF
)) ? ((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) : ((UShort
) ((((((symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_VarIndex))) ? ((symeOriginal
(syme))->fieldv)[symeIndex(symeOriginal(syme),SYFI_VarIndex
)] : (symeFieldInfo[SYFI_VarIndex].def))))
);
4701 }
4702
4703 if (DEBUG(genfEnv)genfEnvDebug) {
4704 fprintf(dbOut, "GenSyme: %-8s stablev: %lu stabLamLev:%lu symeDefLev: %lu symeDefLamLev: %lu ",
4705 symeString(syme)((((syme)->id))->str),
4706 !gen0State->stab ? 0 : stabLevelNo(gen0State->stab)(((gen0State->stab)->first)->lexicalLevel),
4707 !gen0State->stab ? 0 : stabLambdaLevelNo(gen0State->stab)(((gen0State->stab)->first)->lambdaLevel),
4708 symeDefLevelNo(syme)(symeDefLevel(syme)->lexicalLevel),
4709 symeDefLambdaLevelNo(syme)(symeDefLevel(syme)->lambdaLevel));
4710 }
4711
4712 if (!gen0State->stab)
4713 level = 0;
4714 else {
4715 level = stabLambdaLevelNo(gen0State->stab)(((gen0State->stab)->first)->lambdaLevel) -
4716 symeDefLambdaLevelNo(syme)(symeDefLevel(syme)->lambdaLevel);
4717 if (gen0IsInnerVar(syme, level)) {
4718 genfEnvDEBUGif (!genfEnvDebug) { } else afprintf(dbOut, "Inner\n");
4719 return gen0InnerSyme(syme, level);
4720 }
4721 }
4722
4723 level = gen0FoamLevel(symeDefLevelNo(syme)(symeDefLevel(syme)->lexicalLevel));
4724 gen0UseStackedFormat(level);
4725 if (DEBUG(genfEnv)genfEnvDebug) {
4726 afprintf(dbOut, "sym: %s Lev:%d %pAIntList %pSlotUsageList\n", symeString(syme)((((syme)->id))->str), (int)level, gen0State->formatStack, gen0State->formatUsage);
4727 }
4728 return foamNewLex(level, gen0VarIndex(syme))foamNew(FOAM_Lex, 2, (AInt)(level), (AInt)(((((UShort) ((((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_VarIndex
))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))) != (0x7FFF)) ? ((UShort) ((((((syme)->
kind == SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void
*)0)), (syme))->locmask) & (1 << (SYFI_VarIndex)
)) ? ((syme)->fieldv)[symeIndex(syme,SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))) : ((UShort) ((((((symeOriginal(syme))->
kind == SYME_Trigger ? libGetAllSymes((symeOriginal(syme))->
lib) : ((void*)0)), (symeOriginal(syme)))->locmask) & (
1 << (SYFI_VarIndex))) ? ((symeOriginal(syme))->fieldv
)[symeIndex(symeOriginal(syme),SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))))))
;
4729}
4730
4731localstatic Foam
4732gen0SymeImport(Syme syme)
4733{
4734 AInt symeLexLevel, level, env;
4735 int idx;
4736 Foam ref, foam;
4737
4738 if (gen0IsEnumLit(syme)) {
4739 TForm key = gen0SpecialKeyType(symeType(syme));
4740 return foamNewSInt(gen0EnumIndex(key, symeId(syme)))foamNew(FOAM_SInt, 1, (AInt)(gen0EnumIndex(key, ((syme)->id
))))
;
4741 }
4742
4743 symeLexLevel = gen0GetImportLexLevel(syme);
4744 level = gen0FoamImportLevel(symeLexLevel);
4745 gen0UseStackedFormat(level);
4746 if (!gen0GetImportedSyme(syme, level, false((int) 0))) {
4747 if (symeUnused(syme)(((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_UsedDepth))) ? ((syme)->fieldv)[symeIndex(
syme,SYFI_UsedDepth)] : (symeFieldInfo[SYFI_UsedDepth].def)))
== (0x7FFF))
) stabUseMeaning(gen0State->stab, syme);
4748 gen0VarsImport(syme, gen0State->stab);
4749 }
4750 if (!symeImportInit(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) & (0x0008))
) {
4751 gen0SetImportedSyme(syme, level);
4752 gen0InitImport(syme);
4753 }
4754
4755 idx = (gen0State->whereNest) ?
4756 gen0State->whereNest -
4757 (symeLexLevel - gen0State->stabLevel) : 0;
4758
4759 if (symeLexLevel < gen0State->stabLevel)
4760 idx = gen0State->whereNest;
4761
4762 if (gen0NthState(level) == gen0State &&
4763 gen0State->whereNest &&
4764 idx != gen0State->whereNest) {
4765 env = listElt(AInt)(AInt_listPointer->Elt)(gen0State->envFormatStack, idx);
4766 ref = foamCopy(listElt(Foam)(Foam_listPointer->Elt)(gen0State->envVarStack, idx));
4767 foam = foamNewEElt(env, ref, int0, gen0VarIndex(syme))foamNew(FOAM_EElt,4,(AInt)(env),ref,(AInt)(((int) 0)),(AInt)(
((((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) != (0x7FFF
)) ? ((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) : ((UShort
) ((((((symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_VarIndex))) ? ((symeOriginal
(syme))->fieldv)[symeIndex(symeOriginal(syme),SYFI_VarIndex
)] : (symeFieldInfo[SYFI_VarIndex].def))))))
;
4768 }
4769 else {
4770 assert(level >= 0)do { if (!(level >= 0)) _do_assert(("level >= 0"),"genfoam.c"
,4770); } while (0)
;
4771 foam = foamNewLex(level, gen0VarIndex(syme))foamNew(FOAM_Lex, 2, (AInt)(level), (AInt)(((((UShort) ((((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_VarIndex
))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))) != (0x7FFF)) ? ((UShort) ((((((syme)->
kind == SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void
*)0)), (syme))->locmask) & (1 << (SYFI_VarIndex)
)) ? ((syme)->fieldv)[symeIndex(syme,SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))) : ((UShort) ((((((symeOriginal(syme))->
kind == SYME_Trigger ? libGetAllSymes((symeOriginal(syme))->
lib) : ((void*)0)), (symeOriginal(syme)))->locmask) & (
1 << (SYFI_VarIndex))) ? ((symeOriginal(syme))->fieldv
)[symeIndex(symeOriginal(syme),SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))))))
;
4772 }
4773
4774 foamSyme(foam)((foam)->hdr.syme) = syme;
4775
4776 if (gen0IsLazyConst(symeType(syme)))
4777 foam = gen0LazyValue(foam, syme);
4778
4779 return foam;
4780}
4781
4782localstatic Foam
4783gen0InnerSyme(Syme syme, AInt funLevel)
4784{
4785 GenFoamState s = gen0NthState(funLevel);
4786 int envLevel = symeDefLevelNo(syme)(symeDefLevel(syme)->lexicalLevel) - stabLevelNo(s->stab)(((s->stab)->first)->lexicalLevel);
4787 int format = listElt(AInt)(AInt_listPointer->Elt)(s->envFormatStack,
4788 s->whereNest-envLevel);
4789 Foam env;
4790
4791 gen0UseStackedFormat(funLevel);
4792 env = foamCopy(listElt(Foam)(Foam_listPointer->Elt)(s->envVarStack, s->whereNest-envLevel));
4793 if (foamTag(env)((env)->hdr.tag)==FOAM_Env) {
4794 env->foamLex.level = funLevel;
4795 return foamNewEElt(format, env, int0, gen0VarIndex(syme))foamNew(FOAM_EElt,4,(AInt)(format),env,(AInt)(((int) 0)),(AInt
)(((((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) != (0x7FFF
)) ? ((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) : ((UShort
) ((((((symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_VarIndex))) ? ((symeOriginal
(syme))->fieldv)[symeIndex(symeOriginal(syme),SYFI_VarIndex
)] : (symeFieldInfo[SYFI_VarIndex].def))))))
;
4796 } else
4797 return foamNewEElt(format,env,int0, gen0VarIndex(syme))foamNew(FOAM_EElt,4,(AInt)(format),env,(AInt)(((int) 0)),(AInt
)(((((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) != (0x7FFF
)) ? ((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) : ((UShort
) ((((((symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_VarIndex))) ? ((symeOriginal
(syme))->fieldv)[symeIndex(symeOriginal(syme),SYFI_VarIndex
)] : (symeFieldInfo[SYFI_VarIndex].def))))))
;
4798}
4799
4800/*
4801 * Generate a Foam character array from a string.
4802 */
4803Foam
4804gen0CharArray(String s)
4805{
4806 Length len, i;
4807 Foam foam;
4808
4809 len = strLength(s);
4810 foam = foamNewEmpty(FOAM_Arr, TypeSlot1 + len);
4811
4812 foam->foamArr.baseType = FOAM_Char;
4813
4814 for (i = 0; i < len; i++) foam->foamArr.eltv[i] = s[i];
4815
4816 return foam;
4817}
4818
4819/*
4820 * Generate Foam for a balanced if.
4821 */
4822localstatic Foam
4823genIf(AbSyn absyn)
4824{
4825 Bool flag;
4826 FoamList topLines;
4827 int l1 = gen0State->labelNo++, l2 = gen0State->labelNo++;
4828 /*
4829 * We need to take embeddings into account so we use
4830 * gen0AbContextType() instead of gen0AbType().
4831 */
4832 Foam t = gen0TempValueMode(gen0AbContextType(absyn));
4833
4834 flag = gen0AddImportPlace(&topLines);
4835
4836 gen0AddStmt(foamNewIf(genFoamBit(absyn->abIf.test), l1)foamNew(FOAM_If, 2, genFoamBit(absyn->abIf.test), l1), absyn);
4837 gen0SetTemp(t, gen0TempValue(absyn->abIf.elseAlt));
4838 gen0AddStmt(foamNewGoto(l2)foamNew(FOAM_Goto, 1, (AInt)(l2)), absyn);
4839 gen0AddStmt(foamNewLabel(l1)foamNew(FOAM_Label, 1, (AInt)(l1)), absyn);
4840 gen0SetTemp(t, gen0TempValue(absyn->abIf.thenAlt));
4841 gen0AddStmt(foamNewLabel(l2)foamNew(FOAM_Label, 1, (AInt)(l2)), absyn);
4842
4843 if (flag) gen0ResetImportPlace(topLines);
4844 return t;
4845
4846}
4847
4848/*
4849 * Generate Foam for a Select.
4850 * The idea is to generate massively dull code, and
4851 * then use the optimiser to insert the relevant
4852 * clevernesses.
4853 */
4854
4855localstatic Foam gen0SelectCase(AbSyn test, AbSyn id);
4856
4857localstatic Foam
4858genSelect(AbSyn absyn)
4859{
4860 FoamList topLines;
4861 AbSyn seq;
4862 Syme tmpSym;
4863 Foam key;
4864 Foam t;
4865 AInt kfmt, kt, argc;
4866 Bool flag;
4867 int exitLabel, nextLabel;
4868 int i;
4869
4870 seq = absyn->abSelect.alternatives;
4871 kt = gen0Type(gen0AbType(absyn->abSelect.testPart), &kfmt);
4872 key = gen0Temp0(kt, kfmt);
4873 gen0SetTemp(key, genFoamVal(absyn->abSelect.testPart));
4874 t = gen0TempValueMode(gen0AbType(absyn));
4875
4876 tmpSym = symeNewTemp(ssymTheCase,
4877 gen0AbType(absyn->abSelect.testPart),
4878 car(gen0State->stab)((gen0State->stab)->first));
4879
4880 symeSetFoam(tmpSym, key)(symeSetFieldVal = ((AInt) (key)), (((((tmpSym)->kind == SYME_Trigger
? libGetAllSymes((tmpSym)->lib) : ((void*)0)), (tmpSym))->
locmask) & (1 << (SYFI_Foam))) ? (((tmpSym)->fieldv
)[symeIndex(tmpSym,SYFI_Foam)] = (symeSetFieldVal)) : !((tmpSym
)->full) && symeSetFieldVal == (symeFieldInfo[SYFI_Foam
].def) ? symeSetFieldVal : symeSetFieldFn(tmpSym,SYFI_Foam,symeSetFieldVal
))
;
4881
4882 /* sb. temporary */
4883 exitLabel = gen0State->labelNo++;
4884
4885 flag = gen0AddImportPlace(&topLines);
4886
4887 argc = abArgc(seq)((seq)->abHdr.argc);
4888
4889 /* Generate code for each of the cases */
4890 for (i = 0; (i < argc) && abIsExit(seq->abSequence.argv[i])((seq->abSequence.argv[i])->abHdr.tag == (AB_Exit)); i++) {
4891 AbSyn item = seq->abSequence.argv[i];
4892 AbSyn tmp;
4893 Foam call;
4894
4895 /* Allocate a label */
4896 nextLabel = gen0State->labelNo++;
4897
4898 tmp = abFrSyme(tmpSym);
4899 call = gen0SelectCase(item->abExit.test, tmp);
4900
4901 gen0AddStmt(foamNewIf(foamNotThis(foamNewCast(FOAM_Bool, call)),foamNew(FOAM_If, 2, foamNotThis(foamNew(FOAM_Cast, 2, FOAM_Bool
, call)), nextLabel)
4902 nextLabel)foamNew(FOAM_If, 2, foamNotThis(foamNew(FOAM_Cast, 2, FOAM_Bool
, call)), nextLabel)
,
4903 item);
4904 gen0SetTemp(t, gen0TempValue(item->abExit.value));
4905 gen0AddStmt(foamNewGoto(exitLabel)foamNew(FOAM_Goto, 1, (AInt)(exitLabel)), absyn);
4906 gen0AddStmt(foamNewLabel(nextLabel)foamNew(FOAM_Label, 1, (AInt)(nextLabel)), absyn);
4907 }
4908
4909 foamFree(key);
4910
4911
4912 /*
4913 * Emit code for statements between the last case and the
4914 * statement representing the default value of the select.
4915 */
4916 for ( ; i < abArgc(seq)((seq)->abHdr.argc) - 1; i++)
4917 genFoamStmt(seq->abSequence.argv[i]);
4918
4919
4920 /* Emit code for the default value of the select if needed */
4921 if (i == abArgc(seq)((seq)->abHdr.argc) - 1)
4922 gen0SetTemp(t, gen0TempValue(seq->abSequence.argv[i]));
4923
4924 if (flag) gen0ResetImportPlace(topLines);
4925
4926 gen0AddStmt(foamNewLabel(exitLabel)foamNew(FOAM_Label, 1, (AInt)(exitLabel)), absyn);
4927 symeFree(tmpSym);
4928 return t;
4929}
4930
4931localstatic Foam
4932gen0SelectCase(AbSyn test, AbSyn id)
4933{
4934 AbSyn app;
4935 Foam foam;
4936
4937 assert(abTag(test) == AB_Test)do { if (!(((test)->abHdr.tag) == AB_Test)) _do_assert(("abTag(test) == AB_Test"
),"genfoam.c",4937); } while (0)
;
4938 app = abNewApply2(sposNone, abImplicit(test), id, test->abTest.cond)abNew(AB_Apply, sposNone,3, ((test)->abHdr.seman ? (test)->
abHdr.seman->implicit : 0),id,test->abTest.cond)
;
4939
4940 foam = genFoamVal(app);
4941
4942 return foam;
4943}
4944
4945/*
4946 * Generate Foam for a Sequence.
4947 */
4948localstatic Foam
4949genSequence(AbSyn absyn)
4950{
4951 Length i = 0, argc = abArgc(absyn)((absyn)->abHdr.argc);
4952 AbSyn *argv = abArgv(absyn)((absyn)->abGen.data.argv);
4953
4954 assert(abTag(absyn) == AB_Sequence)do { if (!(((absyn)->abHdr.tag) == AB_Sequence)) _do_assert
(("abTag(absyn) == AB_Sequence"),"genfoam.c",4954); } while (
0)
;
4955 return gen0Sequence(gen0AbType(absyn), argv, argc, i);
4956}
4957
4958/*
4959 * Generate code for a sequence of definitions at the top-level of
4960 * a library (.ao file).
4961 */
4962
4963void
4964gen0DefSequence(AbSyn absyn)
4965{
4966 Length argc, i = 0;
4967 AbSyn *argv;
4968 Bool save = gen0ValueMode;
4969
4970 if (abTag(absyn)((absyn)->abHdr.tag) == AB_Sequence) {
4971 argc = abArgc(absyn)((absyn)->abHdr.argc);
4972 argv = abArgv(absyn)((absyn)->abGen.data.argv);
4973 }
4974 else {
4975 argc = 1;
4976 argv = &absyn;
4977 }
4978
4979 gen0ValueMode = false((int) 0);
4980 gen0Sequence(gen0AbType(absyn), argv, argc, i);
4981 gen0ValueMode = save;
4982}
4983
4984
4985/*
4986 * Generate sequence code, where there may be exits in the sequence.
4987 */
4988
4989localstatic Foam
4990gen0Sequence(TForm tf, AbSyn *argv, Length argc, Length i)
4991{
4992 FoamList topLines; /* Initialised when flag == true */
4993 Length j;
4994 Bool flag = false((int) 0);
4995
4996 for (j = i; j < argc; j += 1) {
4997 AbSyn s = argv[j];
4998
4999 if (abTag(s)((s)->abHdr.tag) == AB_Exit) {
5000 AbSyn test = s->abExit.test;
5001 AbSyn val = s->abExit.value;
5002 Foam t = gen0TempValueMode(tf);
5003 int l1 = gen0State->labelNo++,
5004 l2 = gen0State->labelNo++;
5005
5006 /* New-style debugging hook */
5007 if (gen0DebuggerWanted) gen1DbgFnStep(s);
5008
5009 if (flag) gen0ResetImportPlace(topLines);
5010 flag = gen0AddImportPlace(&topLines);
5011 gen0AddStmt(foamNewIf(genFoamBit(test), l1)foamNew(FOAM_If, 2, genFoamBit(test), l1), s);
5012 gen0SetTemp(t, gen0Sequence(tf, argv, argc, j + 1));
5013 gen0AddStmt(foamNewGoto(l2)foamNew(FOAM_Goto, 1, (AInt)(l2)), s);
5014 gen0AddStmt(foamNewLabel(l1)foamNew(FOAM_Label, 1, (AInt)(l1)), s);
5015 gen0SetTemp(t, gen0TempValue(val));
5016 gen0AddStmt(foamNewLabel(l2)foamNew(FOAM_Label, 1, (AInt)(l2)), s);
5017 if (flag) gen0ResetImportPlace(topLines);
5018 return t;
5019 }
5020
5021 if (j == argc - 1) {
5022 Foam result = gen0TempValue(s);
5023 if (gen0ValueMode)
5024 result = gen0EmbedExit(result, s, tf);
5025 if (flag) gen0ResetImportPlace(topLines);
5026 return result;
5027 }
5028
5029 genFoamStmt(s);
5030 if (gen0IsDef(s)) {
5031 if (flag) gen0ResetImportPlace(topLines);
5032 flag = gen0AddImportPlace(&topLines);
5033 }
5034 }
5035
5036 assert(gen0ValueMode == false)do { if (!(gen0ValueMode == ((int) 0))) _do_assert(("gen0ValueMode == false"
),"genfoam.c",5036); } while (0)
;
5037 return NULL((void*)0);
5038}
5039
5040/* Find forms to generate at the top of add bodies. */
5041localstatic Bool
5042gen0IsDef(AbSyn absyn)
5043{
5044 return (abTag(absyn)((absyn)->abHdr.tag) == AB_Define);
5045}
5046
5047
5048/*
5049 * Generate Foam for a program.
5050 */
5051localstatic Foam
5052gen0Lambda(AbSyn absyn, Syme syme, AbSyn defaults)
5053{
5054 AbSyn fbody, params, ret;
5055 TForm tf, tfret, retStmtType;
5056 Foam foam, clos, val = NULL((void*)0);
5057 RTCacheInfo cache = NULL((void*)0);
5058 FoamTag retType;
5059 AInt index, retfmt;
5060 Bool isconst, packed = abHasTag(absyn, AB_PLambda)((absyn)->abHdr.tag == (AB_PLambda));
5061
5062 fbody = absyn->abLambda.body;
5063 params = absyn->abLambda.param;
5064 while (abTag(fbody)((fbody)->abHdr.tag) == AB_Label)
5065 fbody = fbody->abLabel.expr;
5066
5067 tf = gen0AbType(absyn);
5068 assert(tfIsAnyMap(tf))do { if (!(((((tf)->tag) == TF_Map) || (((tf)->tag) == TF_PackedMap
)))) _do_assert(("tfIsAnyMap(tf)"),"genfoam.c",5068); } while
(0)
;
5069
5070 tfret = tfIgnoreExceptions(tfMapRet(tf)tfFollowArg(tf, 1));
5071/* printf("BDS: entered gen0Lambda\n"); */
5072 if (packed && !tfIsMulti(tfret)(((tfret)->tag) == TF_Multiple)) tfret = tfRawType(tfret);
5073/* printf("BDS: done in gen0Lambda\n"); */
5074 retType = gen0Type(tfret, &retfmt);
5075
5076 if (gen0IsResultCachable(fbody, tf))
5077 cache = gen0CacheMakeEmpty(fbody);
5078
5079 clos = gen0ProgClosEmpty();
5080 foam = gen0ProgInitEmpty(gen0ProgName, absyn);
5081
5082 index = gen0FormatNum;
5083 gen0ProgPushState(abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
, GF_Lambda);
5084
5085 if (tfIsMulti(tfret)(((tfret)->tag) == TF_Multiple))
5086 retfmt = gen0MultiFormatNumber(tfret);
5087
5088 if (tfIsGenerator(tfret)(((tfret)->tag) == TF_Generator))
5089 foamProgSetGenerator(foam)((foam)->foamProg.infoBits |= (1 << 2));
5090
5091 gen0State->type = tf;
5092 gen0State->param = params;
5093 gen0State->program = foam;
5094
5095 gen0PushFormat(index);
5096
5097 gen0Vars(abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
);
5098
5099 if (gen0ProgGetExporter())
5100 gen0ProgAddExporterArgs(params);
5101
5102
5103 /* Debugger hooks enabled with -Wdebug */
5104 if (gen0DebugWanted) gen0DbgFnEntry(absyn);
5105
5106
5107 /* Debugger hooks enabled with -Wdebugger */
5108 if (gen0DebuggerWanted) gen1DbgFnEntry(tf, syme, absyn);
5109
5110
5111 /* Domain caching */
5112 if (cache) {
5113 int i;
5114 Foam *paramv = (Foam*)stoAlloc(OB_Other0, abArgc(params)((params)->abHdr.argc)*sizeof(Foam));
5115 for (i=0; i<abArgc(params)((params)->abHdr.argc); i++) {
5116 TForm ntf = tfMapArgN(tf, i);
5117 paramv[i] = genFoamVal(abDefineeId(params->abComma.argv[i]));
5118 if (gen0Type(ntf, NULL((void*)0)) != FOAM_Word) {
5119 paramv[i] = foamNewCast(FOAM_Word, paramv[i])foamNew(FOAM_Cast, 2, FOAM_Word, paramv[i]);
5120 }
5121 }
5122 gen0CacheCheck(cache, abArgc(params)((params)->abHdr.argc), paramv);
5123 stoFree(paramv);
5124 }
5125
5126 if (abIsAnyLambda(fbody)(((fbody)->abHdr.tag == (AB_Lambda)) || ((fbody)->abHdr
.tag == (AB_PLambda)))
) {
5127 if (defaults) defaults = abMapRet(defaults)((defaults)->abApply.argv[1]);
5128 /*
5129 * We used to pass the syme down to gen0Lambda() but
5130 * this causes problems. The trouble is that given the
5131 * curried domain Dom(A)(B), we store the hash code for
5132 * Dom in the closure for Dom(A). Also, when we compute
5133 * the hash code, we can't see A, only A -> B -> ???
5134 * and B -> ???.
5135 *
5136 * Note that this temporary fix forces us to construct
5137 * Dom(A)(B) and apply domainHash!() at runtime when we
5138 * could have computed it from Dom(A).
5139 *
5140 * See bugs 1072 and 892 for more details.
5141 */
5142 val = gen0Lambda(fbody, (Syme)NULL((void*)0), defaults);
5143 assert(foamTag(val) != FOAM_Nil)do { if (!(((val)->hdr.tag) != FOAM_Nil)) _do_assert(("foamTag(val) != FOAM_Nil"
),"genfoam.c",5143); } while (0)
;
5144 }
5145 else if (abTag(fbody)((fbody)->abHdr.tag) == AB_Add) {
5146 if (genIsRuntime()(gen0IsRuntime) && syme) {
5147 gen0Vars(abStab(fbody)((fbody)->abHdr.seman ? (fbody)->abHdr.seman->stab :
0)
);
5148 genFoamStmt(fbody->abAdd.capsule);
5149 }
5150 else {
5151 val = gen0AddBody0(fbody, abStab(fbody)((fbody)->abHdr.seman ? (fbody)->abHdr.seman->stab :
0)
, defaults);
5152 assert(foamTag(val) != FOAM_Nil)do { if (!(((val)->hdr.tag) != FOAM_Nil)) _do_assert(("foamTag(val) != FOAM_Nil"
),"genfoam.c",5152); } while (0)
;
5153 }
5154 }
5155 else if (tfIsCategoryMap(tf)) {
5156 foamProgSetGetter(gen0State->program)((gen0State->program)->foamProg.infoBits |= (1 <<
3))
;
5157 val = gen0MakeDefaultPackage(fbody, abStab(fbody)((fbody)->abHdr.seman ? (fbody)->abHdr.seman->stab :
0)
, true1, syme);
5158 assert(foamTag(val) != FOAM_Nil)do { if (!(((val)->hdr.tag) != FOAM_Nil)) _do_assert(("foamTag(val) != FOAM_Nil"
),"genfoam.c",5158); } while (0)
;
5159 }
5160 else if (tfMapRetc(tf) == 0) {
5161 genFoamStmt(fbody);
5162 }
5163 else {
5164 if (gen0DebuggerWanted)
5165 val = gen1DbgFnBody(fbody);
5166 else
5167 val = genFoamValAs(tfMapRet(tf)tfFollowArg(tf, 1), fbody);
5168 if (foamTag(val)((val)->hdr.tag) == FOAM_Nil && gen0ProgHasReturn())
5169 val = NULL((void*)0);
5170 }
5171
5172 if (tfSatDom(tfret) && gen0AbSynHasConstHash(fbody))
5173 foamProgSetGetter(gen0State->program)((gen0State->program)->foamProg.infoBits |= (1 <<
3))
;
5174
5175 if (val && cache) val = gen0CacheReturn(cache, val);
5176
5177 if (gen0ProgGetExporter())
5178 gen0ProgPopExporterArgs();
5179
5180 ret = fbody;
5181 while (abTag(ret)((ret)->abHdr.tag) == AB_Sequence && abArgc(ret)((ret)->abHdr.argc) > 0)
5182 ret = ret->abSequence.argv[abArgc(ret)((ret)->abHdr.argc) - 1];
5183 retStmtType = gen0AbContextType(ret);
5184
5185 if (val && !tfEqual(retStmtType, tfret)) {
5186 AbEmbed embed = tfSatEmbedType(retStmtType, tfret);
5187 val = gen0Embed(val, ret, retStmtType, embed);
5188 }
5189
5190 /* Debugger hooks enabled with -Wdebug */
5191 if (gen0DebugWanted) val = gen0DbgFnExit(absyn, val);
5192
5193
5194 /* Debugger hooks enabled with -Wdebugger. */
5195 if (gen0DebuggerWanted)
5196 {
5197 if (val)
5198 gen1DbgFnReturn(fbody, retStmtType, val);
5199 else
5200 gen1DbgFnExit(fbody);
5201 }
5202
5203
5204 if (!val && !gen0ProgHasReturn()) {
5205 val = gen0NilValue(tfMapRet(tf)tfFollowArg(tf, 1));
5206 }
5207
5208 if (val) gen0AddStmt(foamNewReturn(val)foamNew(FOAM_Return, 1, val), absyn);
5209
5210 gen0ProgAddStateFormat(index);
5211 gen0IssueDCache();
5212 gen0ProgFiniEmpty(foam, retType, retfmt);
5213
5214 /* foam->foamProg.infoBits = IB_SIDE | IB_LEAF; */
5215 foamOptInfo(foam)((foam)->hdr.info.opt) = optInfoNew(gen0State->stab, foam,
5216 syme, false((int) 0));
5217 if (foam->foamProg.levels->foamDEnv.argv[0] != emptyFormatSlot4)
5218 foamProgUnsetLeaf(foam)((foam)->foamProg.infoBits &= ~(1 << 1));
5219 gen0ComputeSideEffects(foam);
5220 gen0ProgPopState();
5221
5222 if (cache) {
5223 if (gen0IsDomainInit(clos))
5224 gen0AddInit(cache->init);
5225 else
5226 gen0AddStmt(cache->init, cache->ab);
5227 gen0CacheKill(cache);
5228 }
5229
5230 isconst = gen0AbSynHasConstHash(fbody);
5231 if (syme && isconst) {
5232 AInt hashCode = strHash(symeString(syme)((((syme)->id))->str));
5233 symeSetHashNum(syme, hashCode)(symeSetFieldVal = ((AInt) (hashCode)), (((((syme)->kind ==
SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0)),
(syme))->locmask) & (1 << (SYFI_HashNum))) ? ((
(syme)->fieldv)[symeIndex(syme,SYFI_HashNum)] = (symeSetFieldVal
)) : !((syme)->full) && symeSetFieldVal == (symeFieldInfo
[SYFI_HashNum].def) ? symeSetFieldVal : symeSetFieldFn(syme,SYFI_HashNum
,symeSetFieldVal))
;
5234 /* DO NOT use gen0RtSetProgHash() here */
5235 }
5236
5237 /*
5238 * Functions that return types need to have a constant
5239 * hash code if they are going to be used safely. Warn
5240 * the user about non-const type-returning functions.
5241 */
5242 if (!isconst) {
5243 TForm tf = gen0AbType(fbody);
5244
5245 if (tfSatDom(tf))
5246 comsgWarning(absyn, ALDOR_W_GenDomFunNotConst238);
5247 else if (tfSatCat(tf))
5248 comsgWarning(absyn, ALDOR_W_GenCatFunNotConst239);
5249 }
5250 return clos;
5251}
5252
5253/*
5254 * Ensure that single-statement function bodies get step events.
5255 */
5256localstatic Foam
5257gen1DbgFnBody(AbSyn fbody)
5258{
5259 /* Sequences get step events already. */
5260 if (abTag(fbody)((fbody)->abHdr.tag) != AB_Sequence)
5261 {
5262 gen1DbgFnStep(fbody);
5263 return genFoamVal(fbody);
5264 }
5265 else
5266 return genFoamVal(fbody);
5267}
5268
5269
5270localstatic Foam
5271genReturn(AbSyn ab)
5272{
5273 AbSyn val = ab->abReturn.value;
5274 Foam ret;
5275
5276 if (tfMapRetc(gen0State->type) == 0) {
5277 genFoamStmt(val);
5278 ret = foamNew(FOAM_Values, int0((int) 0));
5279 }
5280 else {
5281 ret = genFoamValAs(tfMapRet(gen0State->type)tfFollowArg(gen0State->type, 1), val);
5282
5283 /* Old style debugger hook */
5284 if (gen0DebugWanted)
5285 ret = gen0DbgFnReturn(ab, ret);
5286
5287 /* New style debugger hook */
5288 if (gen0DebuggerWanted)
5289 gen1DbgFnReturn(ab, tfMapRet(gen0State->type)tfFollowArg(gen0State->type, 1), ret);
5290 }
5291
5292 gen0AddStmt(foamNewReturn(ret)foamNew(FOAM_Return, 1, ret), ab);
5293 return NULL((void*)0);
5294}
5295
5296localstatic Bool
5297gen0AbSynHasConstHash(AbSyn ab)
5298{
5299 TForm tf = gen0AbType(ab);
5300
5301 if (tfSatDom(tf) || tfSatCat(tf))
5302 return gen0AbSynHasConstHash0(ab);
5303 return false((int) 0);
5304}
5305
5306
5307localstatic Bool
5308gen0AbSynHasConstHash0(AbSyn ab)
5309{
5310 TForm tf;
5311 AbSyn abi;
5312 int i;
5313
5314 switch (abTag(ab)((ab)->abHdr.tag)) {
5315 case AB_Sequence:
5316 for (i = 0; i<abArgc(ab)((ab)->abHdr.argc); i++) {
5317 abi = ab->abSequence.argv[i];
5318 if (abTag(abi)((abi)->abHdr.tag) == AB_Exit) {
5319 tf = gen0AbType(abi);
5320 /* !! Multiple? */
5321 if (!tfIsExit(tf)(((tf)->tag) == TF_Exit) && !tfIsMulti(tf)(((tf)->tag) == TF_Multiple))
5322 return false((int) 0);
5323 }
5324 }
5325 return gen0AbSynHasConstHash(ab->abSequence.argv[abArgc(ab)((ab)->abHdr.argc)-1]);
5326 break;
5327 case AB_If:
5328 assert(ab->abIf.elseAlt)do { if (!(ab->abIf.elseAlt)) _do_assert(("ab->abIf.elseAlt"
),"genfoam.c",5328); } while (0)
;
5329 return gen0AbSynHasConstHash(ab->abIf.thenAlt)
5330 && gen0AbSynHasConstHash(ab->abIf.elseAlt);
5331 break;
5332 case AB_Add:
5333 case AB_With:
5334 return true1;
5335 break;
5336 /* AB_Repeat is a possibility, but not a very useful one */
5337 case AB_Apply:
5338 return abIsJoin(ab)(((ab)->abHdr.tag == (AB_Apply)) && (((((ab)->abApply
.op))->abHdr.tag == (AB_Id)) && ((((ab)->abApply
.op))->abId.sym)==(ssymJoin)))
;
5339 break;
5340 case AB_Where:
5341 return gen0AbSynHasConstHash(ab->abWhere.expr);
5342 case AB_Define:
5343 /*
5344 * We ought to check that the RHS is a singleton and
5345 * then pass the result to gen0AbSynHasConstHash().
5346 */
5347 return false((int) 0);
5348 case AB_Id:
5349 /*
5350 * We ought to check to see if the identifier is a
5351 * parameter that is not used as a local and treat
5352 * it as having a constant hash. Not only that but
5353 * we ought to trace identifiers back through local
5354 * definitions to check that their value has a const
5355 * hash. I've no idea how to do this so users will
5356 * just have to use with, add or Join to get domains
5357 * and categories with constant hash.
5358 */
5359 return false((int) 0);
5360 default:
5361 return false((int) 0);
5362 }
5363}
5364
5365
5366/*
5367 * Create an empty format usage stack of the same length as l.
5368 */
5369localstatic SlotUsageList
5370gen0UnusedFormats(AIntList l)
5371{
5372 SlotUsageList r = listNil(SlotUsage)((SlotUsageList) 0);
5373 for(; l != listNil(AInt)((AIntList) 0); l = cdr(l)((l)->rest))
5374 r = listCons(SlotUsage)(SlotUsage_listPointer->Cons)(suFrFormat(emptyFormatSlot)(((4) << 2) | 2), r);
5375 return r;
5376}
5377
5378/*
5379 * Return the Foam type given a type form.
5380 */
5381localstatic FoamTag gen0TypeGenerator(GenType genType);
5382
5383FoamTag
5384gen0Type(TForm tf, AInt *pfmt)
5385{
5386 Symbol sym;
5387 FoamTag tag;
5388 int pass;
5389 Bool done = false((int) 0);
5390 AInt fmt = emptyFormatSlot4;
5391
5392 tag = FOAM_Word; /* Default */
5393
5394 if (tfIsDefinedType(tf)) {
5395 tf = tfDefinedVal(tf);
5396 }
5397 tf = tfIgnoreExceptions(tf);
5398
5399 for (pass = 0;(pass < 2) && !done; pass++)
5400 {
5401 tf = pass ? tfDefineeBaseType(tf) : tfDefineeType(tf);
5402 if (tfIsRaw(tf)(((tf)->tag) == TF_Raw)) tf = tfRawType(tfRawArg(tf)tfFollowArg(tf, 0));
5403
5404 done = true1;
5405
5406 if (tfIsWith(tf)(((tf)->tag) == TF_With)) tag = FOAM_Word;
5407 else if (tfIsAnyMap(tf)((((tf)->tag) == TF_Map) || (((tf)->tag) == TF_PackedMap
))
) tag = FOAM_Clos;
5408 else if (tfIsGenerator(tf)(((tf)->tag) == TF_Generator)) tag = gen0TypeGenerator(gfGenTypeDefault());
5409 else if (tfIsXGenerator(tf)(((tf)->tag) == TF_XGenerator)) tag = gen0TypeGenerator(gfGenTypeAlt());
5410 else if (tfIsMulti(tf)(((tf)->tag) == TF_Multiple)) tag = FOAM_NOp;
5411 else if (tfIsRecord(tf)(((tf)->tag) == TF_Record)) {
5412 tag = FOAM_Rec;
5413 fmt = gen0RecordFormatNumber(tf);
5414 }
5415 else if (tfIsTuple(tf)(((tf)->tag) == TF_Tuple)) {
5416 tag = FOAM_Word;
5417 }
5418 else if (tfIsCross(tf)(((tf)->tag) == TF_Cross)) {
5419 tag = FOAM_Word;
5420 }
5421 else if (tfIsEnum(tf)(((tf)->tag) == TF_Enumerate)) {
5422 tag = FOAM_SInt;
5423 }
5424 else if (tfIsUnknown(tf)(((tf)->tag) == TF_Unknown)) tag = FOAM_Word;
5425 else if ((sym = gen0MachineType(tf)) == NULL((void*)0)) {
5426 tag = FOAM_Word;
5427 }
5428 else if (sym == ssymBool) tag = FOAM_Bool;
5429 else if (sym == ssymByte) tag = FOAM_Byte;
5430 else if (sym == ssymHInt) tag = FOAM_HInt;
5431 else if (sym == ssymSInt) tag = FOAM_SInt;
5432 else if (sym == ssymBInt) tag = FOAM_BInt;
5433 else if (sym == ssymChar) tag = FOAM_Char;
5434 else if (sym == ssymSFlo) tag = FOAM_SFlo;
5435 else if (sym == ssymDFlo) tag = FOAM_DFlo;
5436 else if (sym == ssymNil) tag = FOAM_Nil;
5437 else if (sym == ssymPtr) tag = FOAM_Ptr;
5438 else if (sym == ssymArr) {
5439 tag = FOAM_Arr;
5440 /* Something of a bug here as we don't know
5441 the element type for the array. Use 0
5442 rather than emptyFormatSlot as that is
5443 FOAM_HInt */
5444 fmt = 0;
5445 }
5446 else {
5447 /* Try a second time using the normalised type */
5448 done = false((int) 0);
5449 }
5450
5451 /*!! assert(tag == tfFoamType(tf)); */
5452#if 0
5453 if (tag != tfFoamType(tf)((tf)->raw)) {
5454 if (tag == FOAM_Word && tfFoamType(tf)((tf)->raw) == FOAM_LIMIT)
5455 /*!! Probably OK. */;
5456 else if (tfFoamType(tf)((tf)->raw) == FOAM_LIMIT) {
5457 fprintf(dbOut, "tf w/o foam type\n");
5458 tformPrintDb(tf);
5459 fnewline(dbOut);
5460 }
5461 else {
5462 fprintf(dbOut, "tf w/ different foam type\n");
5463 fprintf(dbOut, "tag = %d, foamType = %d\n",
5464 tag, tfFoamType(tf)((tf)->raw));
5465 tformPrintDb(tf);
5466 fnewline(dbOut);
5467 }
5468 }
5469#endif
5470 }
5471
5472 if (pfmt) *pfmt = fmt;
5473
5474 return tag;
5475}
5476
5477localstatic FoamTag
5478gen0TypeGenerator(GenType genType)
5479{
5480 switch (genType) {
5481 case GENTYPE_Function:
5482 return FOAM_Clos;
5483 case GENTYPE_Coroutine:
5484 return FOAM_Word;
5485 default:
5486 bug("Not reached");
5487 return FOAM_NOp;
5488 }
5489}
5490
5491
5492localstatic Symbol
5493gen0MachineType(TForm tf)
5494{
5495 AbSyn absyn;
5496 Syme syme;
5497
5498 if (tf == NULL((void*)0)) return NULL((void*)0);
5499 if (!tfHasExpr(tf)((tf)->__absyn != 0)) return NULL((void*)0);
5500
5501 absyn = gen0EqualMods(tfGetExpr(tf)((tf)->__absyn));
5502
5503 syme = abSyme(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->syme :
0)
;
5504 if (syme == NULL((void*)0)) return NULL((void*)0);
5505
5506 switch (symeKind(syme)((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind)
) {
5507 case SYME_Export:
5508 tf = tfDefineeType(symeType(syme));
5509 if (tfIsType(tf)(((tf)->tag) == TF_Type))
5510 return symeId(syme)((syme)->id);
5511 break;
5512 case SYME_Import:
5513 tf = tfDefineeType(symeExporter(syme));
5514 if (tfIsTheId(tf, ssymMachine)(((((tf)->tag) == TF_General) && ((((tf)->__absyn
))->abHdr.tag) == AB_Id) && (((tf)->__absyn)->
abId.sym) == (ssymMachine))
)
5515 return symeId(syme)((syme)->id);
5516 if (tfIsTheId(tf, ssymBasic)(((((tf)->tag) == TF_General) && ((((tf)->__absyn
))->abHdr.tag) == AB_Id) && (((tf)->__absyn)->
abId.sym) == (ssymBasic))
)
5517 return symeId(syme)((syme)->id);
5518 break;
5519 default:
5520 break;
5521 }
5522 return NULL((void*)0);
5523}
5524
5525
5526localstatic Bool
5527gen0IsResultCachable(AbSyn body, TForm tf)
5528{
5529 if (gen0AbSynHasConstHash(body))
5530 return true1;
5531
5532 return false((int) 0);
5533}
5534
5535/*
5536 * Extract the declarations for lexicals, locals, globals and parameters
5537 * from the list of symes in a function body.
5538 */
5539
5540void
5541gen0Vars(Stab stab)
5542{
5543 SymeList symes;
5544 AbSynList labels, la;
5545
5546 if (!stab)
5547 return;
5548
5549 labels = stabGetLevelLabels(stab)(((stab)->first)->labelsInScope);
5550
5551 for (la = labels; la; la = cdr(la)((la)->rest)) {
5552 Syme syme = abSyme(car(la))((((la)->first))->abHdr.seman ? (((la)->first))->
abHdr.seman->syme : 0)
;
5553 if (symeDVMark(syme)((UShort) (SYFI_DVMark < (8 * sizeof(int)) && !(((
((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->hasmask) & (1 << (SYFI_DVMark
))) ? (symeFieldInfo[SYFI_DVMark].def) : (((((syme)->kind ==
SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0)),
(syme))->locmask) & (1 << (SYFI_DVMark))) ? (((
(((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_DVMark
))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_DVMark)] : (symeFieldInfo
[SYFI_DVMark].def)) : symeGetFieldFn(syme,SYFI_DVMark)))
> 0)
5554 gen0SetVarIndex(syme, gen0State->labelNo++)(symeSetFieldVal = ((AInt) (gen0State->labelNo++)), (((((syme
)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib) :
((void*)0)), (syme))->locmask) & (1 << (SYFI_VarIndex
))) ? (((syme)->fieldv)[symeIndex(syme,SYFI_VarIndex)] = (
symeSetFieldVal)) : !((syme)->full) && symeSetFieldVal
== (symeFieldInfo[SYFI_VarIndex].def) ? symeSetFieldVal : symeSetFieldFn
(syme,SYFI_VarIndex,symeSetFieldVal))
;
5555 }
5556
5557 symes = gen0GetBoundSymes(stab);
5558 gen0VarsList(stab, symes);
5559 listFree(Syme)(Syme_listPointer->Free)(symes);
5560}
5561
5562localstatic void
5563gen0VarsList(Stab stab, SymeList symes)
5564{
5565 for (; symes; symes = cdr(symes)((symes)->rest)) {
5566 Syme syme = car(symes)((symes)->first);
5567
5568 switch (symeKind(syme)((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind)
) {
5569 case SYME_Param:
5570 gen0VarsParam(syme, stab);
5571 break;
5572 case SYME_LexVar:
5573 case SYME_LexConst:
5574 gen0VarsLex(syme, stab);
5575 break;
5576 case SYME_Fluid:
5577 gen0VarsFluid(syme);
5578 break;
5579 case SYME_Import:
5580 gen0VarsImport(syme, stab);
5581 break;
5582 case SYME_Extend:
5583 case SYME_Export:
5584 gen0VarsExport(syme, stab);
5585 break;
5586 case SYME_Foreign:
5587 gen0VarsForeign(syme);
5588 break;
5589 case SYME_Builtin:
5590 case SYME_Library:
5591 case SYME_Archive:
5592 break;
5593 default:
5594 bugBadCase(symeKind(syme))bug("Bad case %d (line %d in file %s).", (int) ((((syme)->
kind == SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void
*)0)), (syme))->kind), 5594, "genfoam.c")
;
5595 break;
5596 }
5597 }
5598}
5599
5600localstatic AbSyn
5601gen0PLambdaParam(Syme syme)
5602{
5603 AbSyn param = gen0State->param;
5604 AbSyn *argv;
5605 Length i, argc;
5606
5607 /* printf("BDS: Entered gen0PLambdaParam\n"); */
5608
5609 AB_COMMA_ITER(param, argc, argv){ switch (((param)->abHdr.tag)) { case AB_Nothing: argc = 0
; argv = 0; break; case AB_Comma: argc = ((param)->abHdr.argc
); argv = ((param)->abGen.data.argv); break; default: argc
= 1; argv = &param; break; }; }
;
5610
5611 for (i = 0; i < argc; i += 1) {
5612 AbSyn argi = abDefineeId(argv[i]);
5613 if (syme == abSyme(argi)((argi)->abHdr.seman ? (argi)->abHdr.seman->syme : 0
)
)
5614 return argi;
5615 }
5616
5617 assert(false)do { if (!(((int) 0))) _do_assert(("false"),"genfoam.c",5617)
; } while (0)
;
5618 return NULL((void*)0);
5619}
5620
5621localstatic void
5622gen0VarsParam(Syme syme, Stab stab)
5623{
5624 TForm tf = symeType(syme);
5625 String name = strCopy(symeString(syme)((((syme)->id))->str));
5626 FoamTag type;
5627 Foam decl;
5628 AInt index;
5629 FoamTag kind;
5630 AInt fmtSlot = emptyFormatSlot4;
5631 AInt paramFmtSlot = emptyFormatSlot4;
5632 Bool packed = tfIsPackedMap(gen0State->type)(((gen0State->type)->tag) == TF_PackedMap);
5633 FoamTag paramType;
5634
5635 assert(symeIsParam(syme))do { if (!((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->kind) == SYME_Param
))) _do_assert(("symeIsParam(syme)"),"genfoam.c",5635); } while
(0)
;
5636
5637/*
5638 printf("BDS: gen0VarsParam: name is '%s'\n",name);
5639 printf("BDS: gen0VarsParam: packed is '%d'\n",packed);
5640*/
5641
5642/* printf("BDS: entered gen0VarsParam\n"); */
5643 type = packed ? gen0Type(tfRawType(tf), NULL((void*)0)) : gen0Type(tf, &fmtSlot);
5644 paramType = gen0TfMapType(NULL((void*)0), gen0State->type, type, &paramFmtSlot);
5645/* printf("BDS: done in gen0VarsParam\n"); */
5646
5647 decl = foamNewDecl(paramType, name, paramFmtSlot)foamNew(FOAM_Decl,4,(AInt)(paramType),name, (AInt) (0x7FFF), paramFmtSlot
)
;
5648 index = gen0AddParam(decl);
5649 kind = FOAM_Par;
5650
5651 if (packed) {
5652 FoamTag ntype = gen0Type(tf, NULL((void*)0));
5653 Foam ndecl = foamNewDecl(ntype, strCopy(name), fmtSlot)foamNew(FOAM_Decl,4,(AInt)(ntype),strCopy(name), (AInt) (0x7FFF
), fmtSlot)
;
5654 Foam par = foamNewPar(index)foamNew(FOAM_Par, 1, (AInt)(index));
5655 AbSyn id = gen0PLambdaParam(syme);
5656
5657 /* printf("BDS: gen0VarsParam: packed: name is '%s'\n",name); */
5658
5659 index = gen0AddLex(ndecl);
5660 kind = FOAM_Lex;
5661
5662 par = gen0RawToUnary(par, id);
5663 gen0AddStmt(foamNewSet(foamNewLex(int0, index), foamCastIfNeeded(type, paramType, par))foamNew(FOAM_Set, 2, foamNew(FOAM_Lex, 2, (AInt)(((int) 0)), (
AInt)(index)), foamCastIfNeeded(type, paramType, par))
, NULL((void*)0));
5664 if (gen0State->program)
5665 foamProgUnsetLeaf(gen0State->program)((gen0State->program)->foamProg.infoBits &= ~(1 <<
1))
;
5666 gen0State->hasTemps = true1;
5667 }
5668
5669 else if (symeUsedDeeply(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) & (0x0004))
) {
5670 Foam par = foamNewPar(index)foamNew(FOAM_Par, 1, (AInt)(index));
5671
5672 index = gen0AddLex(foamNewDecl(type, strCopy(name), emptyFormatSlot)foamNew(FOAM_Decl,4,(AInt)(type),strCopy(name), (AInt) (0x7FFF
), 4)
);
5673 kind = FOAM_Lex;
5674
5675 gen0AddInit(foamNewSet(foamNewLex(int0, index), foamCastIfNeeded(type, paramType, par))foamNew(FOAM_Set, 2, foamNew(FOAM_Lex, 2, (AInt)(((int) 0)), (
AInt)(index)), foamCastIfNeeded(type, paramType, par))
);
5676 if (gen0State->program)
5677 foamProgUnsetLeaf(gen0State->program)((gen0State->program)->foamProg.infoBits &= ~(1 <<
1))
;
5678 gen0State->hasTemps = true1;
5679 }
5680 else if (type != paramType) {
5681 Foam par = foamNewPar(index)foamNew(FOAM_Par, 1, (AInt)(index));
5682 index = gen0AddLocal(foamNewDecl(type, strCopy(name), emptyFormatSlot)foamNew(FOAM_Decl,4,(AInt)(type),strCopy(name), (AInt) (0x7FFF
), 4)
);
5683 kind = FOAM_Loc;
5684 par = foamCastIfNeeded(type, paramType, par);
5685
5686 gen0AddInit(foamNewSet(foamNewLoc(index), par)foamNew(FOAM_Set, 2, foamNew(FOAM_Loc, 1, (AInt)(index)), par
)
);
5687 gen0State->hasTemps = true1;
5688 }
5689
5690 if (gen0InGener(gen0State->progType)((gen0State->progType) == PT_Gener))
5691 foamFixed(decl)((decl)->hdr.info.fixed) = true1;
5692
5693 gen0SetVarIndex(syme, index)(symeSetFieldVal = ((AInt) (index)), (((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_VarIndex))) ? (((syme)->fieldv
)[symeIndex(syme,SYFI_VarIndex)] = (symeSetFieldVal)) : !((syme
)->full) && symeSetFieldVal == (symeFieldInfo[SYFI_VarIndex
].def) ? symeSetFieldVal : symeSetFieldFn(syme,SYFI_VarIndex,
symeSetFieldVal))
;
5694 gen0SetFoamKind(syme, kind);
5695}
5696
5697localstatic FoamTag
5698gen0TfMapType(Syme syme, TForm mapTf, FoamTag argFoamTag, AInt *newFmt)
5699{
5700 AInt dummy;
5701 if (newFmt == NULL((void*)0))
5702 newFmt = &dummy;
5703
5704 if (syme && (symeIsBuiltin(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Builtin)
|| symeIsForeign(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Foreign)
))
5705 return argFoamTag;
5706
5707 *newFmt = emptyFormatSlot4;
5708 switch (argFoamTag) {
5709 case FOAM_Rec:
5710 return FOAM_Word;
5711 case FOAM_Clos:
5712 return FOAM_Word;
5713 case FOAM_Arr:
5714 *newFmt = 0;
5715 return FOAM_Arr;
5716 default:
5717 return argFoamTag;
5718 }
5719}
5720
5721
5722localstatic void
5723gen0VarsLex(Syme syme, Stab stab)
5724{
5725 FoamTag type;
5726 AInt fmt;
5727 String name = strCopy(symeString(syme)((((syme)->id))->str));
5728 Foam decl;
5729 AInt index;
5730 FoamTag kind;
5731 int fmtSlot = emptyFormatSlot4;
5732 Bool isGlobal = false((int) 0);
5733
5734 type = gen0Type(symeType(syme), &fmt);
5735 assert(symeIsLexVar(syme) || symeIsLexConst(syme))do { if (!((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->kind) == SYME_LexVar
) || (((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme
)->lib) : ((void*)0)), (syme))->kind) == SYME_LexConst)
)) _do_assert(("symeIsLexVar(syme) || symeIsLexConst(syme)"),
"genfoam.c",5735); } while (0)
;
5736
5737 if (type == FOAM_Rec || type == FOAM_Arr) fmtSlot = fmt;
5738
5739 decl = foamNewDecl(type, name, fmtSlot)foamNew(FOAM_Decl,4,(AInt)(type),name, (AInt) (0x7FFF), fmtSlot
)
;
5740
5741 if (fintMode == FINT_LOOP2 &&
5742 gen0State->tag == GF_File && stabLevelNo(stab)(((stab)->first)->lexicalLevel) == 1) {
5743 decl = foamNewGDecl(type, name, FOAM_Nil, fmtSlot,foamNew(FOAM_GDecl,6,(AInt)(type),name, FOAM_Nil,fmtSlot, (AInt
)(FOAM_GDecl_Export),(AInt)(FOAM_Proto_Foam))
5744 FOAM_GDecl_Export, FOAM_Proto_Foam)foamNew(FOAM_GDecl,6,(AInt)(type),name, FOAM_Nil,fmtSlot, (AInt
)(FOAM_GDecl_Export),(AInt)(FOAM_Proto_Foam))
;
5745 decl->foamDecl.id = gen0GlobalName(gen0FileName, syme);
5746 isGlobal = true1;
5747 }
5748 else
5749 decl = foamNewDecl(type, name, fmtSlot)foamNew(FOAM_Decl,4,(AInt)(type),name, (AInt) (0x7FFF), fmtSlot
)
;
5750
5751 if (isGlobal) {
5752 index = gen0AddGlobal(decl);
5753 kind = FOAM_Glo;
5754 }
5755 else if (symeUsedDeeply(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) & (0x0004))
) {
5756 index = gen0AddLex(decl);
5757 kind = FOAM_Lex;
5758 }
5759 else {
5760 index = gen0AddLocal(decl);
5761 kind = FOAM_Loc;
5762 }
5763
5764 if (gen0InGener(gen0State->progType)((gen0State->progType) == PT_Gener))
5765 foamFixed(decl)((decl)->hdr.info.fixed) = true1;
5766
5767 gen0SetVarIndex(syme, index)(symeSetFieldVal = ((AInt) (index)), (((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_VarIndex))) ? (((syme)->fieldv
)[symeIndex(syme,SYFI_VarIndex)] = (symeSetFieldVal)) : !((syme
)->full) && symeSetFieldVal == (symeFieldInfo[SYFI_VarIndex
].def) ? symeSetFieldVal : symeSetFieldFn(syme,SYFI_VarIndex,
symeSetFieldVal))
;
5768 gen0SetFoamKind(syme, kind);
5769}
5770
5771localstatic void
5772gen0VarsFluid(Syme syme)
5773{
5774 FoamTag type = gen0Type(symeType(syme), NULL((void*)0));
5775 String name = strCopy(symeString(syme)((((syme)->id))->str));
5776 Foam decl;
5777 AInt index;
5778 int fmtSlot = emptyFormatSlot4;
5779
5780 assert(symeIsFluid(syme))do { if (!((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->kind) == SYME_Fluid
))) _do_assert(("symeIsFluid(syme)"),"genfoam.c",5780); } while
(0)
;
5781
5782 if (type == FOAM_Rec)
5783 fmtSlot = gen0RecordFormatNumber(symeType(syme));
5784
5785 decl = foamNewDecl(type, name, fmtSlot)foamNew(FOAM_Decl,4,(AInt)(type),name, (AInt) (0x7FFF), fmtSlot
)
;
5786 index = gen0FindGlobalFluid(syme);
5787
5788 gen0SetVarIndex(syme, index)(symeSetFieldVal = ((AInt) (index)), (((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_VarIndex))) ? (((syme)->fieldv
)[symeIndex(syme,SYFI_VarIndex)] = (symeSetFieldVal)) : !((syme
)->full) && symeSetFieldVal == (symeFieldInfo[SYFI_VarIndex
].def) ? symeSetFieldVal : symeSetFieldFn(syme,SYFI_VarIndex,
symeSetFieldVal))
;
5789 gen0SetFoamKind(syme, FOAM_Fluid);
5790}
5791
5792localstatic void
5793gen0VarsImport(Syme syme, Stab stab)
5794{
5795 String name;
5796 TForm tf;
5797 FoamTag type;
5798 Foam decl;
5799 AInt index, sl, l;
5800 int fmtSlot = emptyFormatSlot4;
5801 Sefo sefo;
5802 SymeList symes;
5803
5804 assert(symeIsImport(syme))do { if (!((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->kind) == SYME_Import
))) _do_assert(("symeIsImport(syme)"),"genfoam.c",5804); } while
(0)
;
5805 if (symeUnused(syme)(((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_UsedDepth))) ? ((syme)->fieldv)[symeIndex(
syme,SYFI_UsedDepth)] : (symeFieldInfo[SYFI_UsedDepth].def)))
== (0x7FFF))
|| gen0IsEnumLit(syme)) return;
5806
5807 sl = gen0GetImportLexLevel(syme);
5808 l = gen0FoamImportLevel(sl);
5809 if (gen0GetImportedSyme(syme, l, true1)) return;
5810
5811 name = strCopy(symeString(syme)((((syme)->id))->str));
5812 tf = symeType(syme);
5813
5814 type = gen0IsLazyConst(tf) ? FOAM_Word : gen0Type(tf, NULL((void*)0));
5815 if (type == FOAM_Rec) fmtSlot = gen0RecordFormatNumber(tf);
5816
5817 decl = foamNewDecl(type, name, fmtSlot)foamNew(FOAM_Decl,4,(AInt)(type),name, (AInt) (0x7FFF), fmtSlot
)
;
5818 if (!otSymeIsFoamConst(syme))
5819 foamSyme(decl)((decl)->hdr.syme) = syme;
5820
5821 index = gen0AddLexNth(decl, l, gen0StateOffset(sl, l));
5822
5823 gen0SetVarIndex(syme, index)(symeSetFieldVal = ((AInt) (index)), (((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_VarIndex))) ? (((syme)->fieldv
)[symeIndex(syme,SYFI_VarIndex)] = (symeSetFieldVal)) : !((syme
)->full) && symeSetFieldVal == (symeFieldInfo[SYFI_VarIndex
].def) ? symeSetFieldVal : symeSetFieldFn(syme,SYFI_VarIndex,
symeSetFieldVal))
;
5824 gen0SetFoamKind(syme, FOAM_Lex);
5825
5826 sefo = tfExpr(symeExporter(syme))tfToAbSyn(symeExporter(syme));
5827 symes = gen0GetExporterSymes(stab, sefo, listNil(Syme)((SymeList) 0));
5828 gen0VarsList(stab, symes);
5829 listFree(Syme)(Syme_listPointer->Free)(symes);
5830}
5831
5832localstatic void
5833gen0VarsExport(Syme syme, Stab stab)
5834{
5835 TForm tf = symeType(syme);
5836 FoamTag type = gen0Type(tf, NULL((void*)0));
5837 String name = strCopy(symeString(syme)((((syme)->id))->str));
5838 Foam decl;
5839 AInt index;
5840 FoamTag kind;
5841 int fmtSlot = emptyFormatSlot4;
5842
5843 assert(symeIsExport(syme) || symeIsExtend(syme))do { if (!((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->kind) == SYME_Export
) || (((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme
)->lib) : ((void*)0)), (syme))->kind) == SYME_Extend)))
_do_assert(("symeIsExport(syme) || symeIsExtend(syme)"),"genfoam.c"
,5843); } while (0)
;
5844
5845 if (symeDefLevel(syme) != car(stab)((stab)->first))
5846 return;
5847
5848 if (symeIsSelf(syme)(((syme)->id) == ssymSelf) && gen0DebugWanted &&
5849 symeUnused(syme)(((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_UsedDepth))) ? ((syme)->fieldv)[symeIndex(
syme,SYFI_UsedDepth)] : (symeFieldInfo[SYFI_UsedDepth].def)))
== (0x7FFF))
) {
5850 stabUseMeaning(stab, syme);
5851 symeSetUsed(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) |= (0x0040))
;
5852 }
5853
5854 if (type == FOAM_Rec)
5855 fmtSlot = gen0RecordFormatNumber(symeType(syme));
5856
5857 if (gen0State->tag == GF_File && stabLevelNo(stab)(((stab)->first)->lexicalLevel) == 1) {
5858 decl = foamNewGDecl(type, NULL, FOAM_Nil, fmtSlot,foamNew(FOAM_GDecl,6,(AInt)(type),((void*)0), FOAM_Nil,fmtSlot
, (AInt)(FOAM_GDecl_Export),(AInt)(FOAM_Proto_Foam))
5859 FOAM_GDecl_Export, FOAM_Proto_Foam)foamNew(FOAM_GDecl,6,(AInt)(type),((void*)0), FOAM_Nil,fmtSlot
, (AInt)(FOAM_GDecl_Export),(AInt)(FOAM_Proto_Foam))
;
5860 decl->foamGDecl.id = gen0GlobalName(gen0FileName, syme);
5861 index = gen0AddGlobal(decl);
5862 kind = FOAM_Glo;
5863 }
5864 else {
5865 decl = foamNewDecl(type, name, fmtSlot)foamNew(FOAM_Decl,4,(AInt)(type),name, (AInt) (0x7FFF), fmtSlot
)
;
5866 index = gen0AddLex(decl);
5867 kind = FOAM_Lex;
5868 if (gen0State->tag == GF_Default ||
5869 gen0State->tag == GF_DefaultCat)
5870 foamSyme(decl)((decl)->hdr.syme) = syme;
5871 }
5872
5873 if (gen0InAxiomAx &&
5874 (tfSatType(tf) || (tfIsMap(tf)(((tf)->tag) == TF_Map) && tfSatType(tfMapRet(tf)tfFollowArg(tf, 1)))))
5875 symeSetHashNum(syme, strHash(symeString(syme)))(symeSetFieldVal = ((AInt) (strHash(((((syme)->id))->str
)))), (((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme
)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_HashNum))) ? (((syme)->fieldv)[symeIndex(syme,SYFI_HashNum
)] = (symeSetFieldVal)) : !((syme)->full) && symeSetFieldVal
== (symeFieldInfo[SYFI_HashNum].def) ? symeSetFieldVal : symeSetFieldFn
(syme,SYFI_HashNum,symeSetFieldVal))
;
5876
5877 gen0SetVarIndex(syme, index)(symeSetFieldVal = ((AInt) (index)), (((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_VarIndex))) ? (((syme)->fieldv
)[symeIndex(syme,SYFI_VarIndex)] = (symeSetFieldVal)) : !((syme
)->full) && symeSetFieldVal == (symeFieldInfo[SYFI_VarIndex
].def) ? symeSetFieldVal : symeSetFieldFn(syme,SYFI_VarIndex,
symeSetFieldVal))
;
5878 gen0SetFoamKind(syme, kind);
5879}
5880
5881localstatic void
5882gen0VarsForeign(Syme syme)
5883{
5884 TForm tf = symeType(syme);
5885 FoamTag type = gen0Type(tf, NULL((void*)0)), rtype;
5886 ForeignOrigin forg = symeForeign(syme)((ForeignOrigin) (SYFI_Foreign < (8 * sizeof(int)) &&
!(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->hasmask) & (1 <<
(SYFI_Foreign))) ? (symeFieldInfo[SYFI_Foreign].def) : (((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_Foreign
))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes((
syme)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_Foreign))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_Foreign
)] : (symeFieldInfo[SYFI_Foreign].def)) : symeGetFieldFn(syme
,SYFI_Foreign)))
;
5887 int fmtSlot;
5888 Foam decl;
5889 AInt index;
5890 String name;
5891
5892 assert(symeIsForeign(syme))do { if (!((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->kind) == SYME_Foreign
))) _do_assert(("symeIsForeign(syme)"),"genfoam.c",5892); } while
(0)
;
5893
5894 if (symeUnused(syme)(((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_UsedDepth))) ? ((syme)->fieldv)[symeIndex(
syme,SYFI_UsedDepth)] : (symeFieldInfo[SYFI_UsedDepth].def)))
== (0x7FFF))
) return;
5895
5896 if (tfIsMap(tf)(((tf)->tag) == TF_Map))
5897 rtype = gen0Type(tfMapRet(tf)tfFollowArg(tf, 1), NULL((void*)0));
5898 else if (tfIsPackedMap(tf)(((tf)->tag) == TF_PackedMap))
5899 {
5900/* printf("BDS: Entered gen0VarsForeign\n"); */
5901 rtype = gen0Type(tfRawType(tfMapRet(tf)tfFollowArg(tf, 1)), NULL((void*)0));
5902/* printf("BDS: done in gen0VarsForeign\n"); */
5903 }
5904 else
5905 rtype = FOAM_Nil;
5906
5907 if (forg->file)
5908 name = strPrintf("%s-%s", symeString(syme)((((syme)->id))->str), forg->file);
5909 else
5910 name = strCopy(symeString(syme)((((syme)->id))->str));
5911
5912 if (type == FOAM_Rec)
5913 fmtSlot = gen0RecordFormatNumber(tf);
5914 else if (tfIsMap(tf)(((tf)->tag) == TF_Map) && (forg->protocol == FOAM_Proto_C))
5915 fmtSlot = gen0CSigFormatNumber(tf);
5916 else if (forg->protocol == FOAM_Proto_Fortran)
5917 fmtSlot = gen0FortranSigFormatNumber(tf, true1);
5918 else if (tfIsPackedMap(tf)(((tf)->tag) == TF_PackedMap))
5919 {
5920/* printf("BDS: gen0VarsForeign landed in new else if case for Packed Map\n"); */
5921 if (forg->protocol == FOAM_Proto_C)
5922 {
5923/* printf("BDS: Landed in FOAM_Proto_C\n"); */
5924 fmtSlot = gen0CPackedSigFormatNumber(tf);
5925 }
5926 else
5927 {
5928/* printf("BDS: Landed in some other protocol\n"); */
5929 fmtSlot = emptyFormatSlot4;
5930 }
5931 }
5932 else
5933 fmtSlot = emptyFormatSlot4;
5934
5935 decl = foamNewGDecl(type, name, rtype, fmtSlot,foamNew(FOAM_GDecl,6,(AInt)(type),name, rtype,fmtSlot, (AInt)
(FOAM_GDecl_Import),(AInt)(forg->protocol))
5936 FOAM_GDecl_Import, forg->protocol)foamNew(FOAM_GDecl,6,(AInt)(type),name, rtype,fmtSlot, (AInt)
(FOAM_GDecl_Import),(AInt)(forg->protocol))
;
5937
5938 index = gen0AddGlobal(decl);
5939
5940 gen0SetVarIndex(syme, index)(symeSetFieldVal = ((AInt) (index)), (((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_VarIndex))) ? (((syme)->fieldv
)[symeIndex(syme,SYFI_VarIndex)] = (symeSetFieldVal)) : !((syme
)->full) && symeSetFieldVal == (symeFieldInfo[SYFI_VarIndex
].def) ? symeSetFieldVal : symeSetFieldFn(syme,SYFI_VarIndex,
symeSetFieldVal))
;
5941 gen0SetFoamKind(syme, FOAM_Glo);
5942}
5943
5944/* gen0Vars could build a list..*/
5945localstatic void
5946gen0GetGlobalDefs()
5947{
5948 Stab stab = gen0State->stab;
5949 SymeList ls, symes;
5950 Foam foam;
5951
5952 symes = gen0GetBoundSymes(stab);
5953
5954 for (ls = symes; ls ; ls = cdr(ls)((ls)->rest)) {
5955 Syme syme = car(ls)((ls)->first);
5956
5957 if (symeIsExport(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Export)
|| symeIsExtend(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Extend)
) {
5958 FoamTag type = gen0Type(symeType(syme), NULL((void*)0));
5959 assert(gen0FoamKind(syme) == FOAM_Glo)do { if (!(((((FoamTag) (SYFI_FoamKind < (8 * sizeof(int))
&& !(((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->hasmask) & (1
<< (SYFI_FoamKind))) ? (symeFieldInfo[SYFI_FoamKind].def
) : (((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme
)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_FoamKind))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_FoamKind))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_FoamKind)] : (symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn
(syme,SYFI_FoamKind))) != FOAM_LIMIT) ? ((FoamTag) (SYFI_FoamKind
< (8 * sizeof(int)) && !(((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
hasmask) & (1 << (SYFI_FoamKind))) ? (symeFieldInfo
[SYFI_FoamKind].def) : (((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_FoamKind))) ? ((((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_FoamKind))) ? ((syme)->fieldv
)[symeIndex(syme,SYFI_FoamKind)] : (symeFieldInfo[SYFI_FoamKind
].def)) : symeGetFieldFn(syme,SYFI_FoamKind))) : ((FoamTag) (
SYFI_FoamKind < (8 * sizeof(int)) && !(((((symeOriginal
(syme))->kind == SYME_Trigger ? libGetAllSymes((symeOriginal
(syme))->lib) : ((void*)0)), (symeOriginal(syme)))->hasmask
) & (1 << (SYFI_FoamKind))) ? (symeFieldInfo[SYFI_FoamKind
].def) : (((((symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_FoamKind))) ? ((((((
symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_FoamKind))) ? ((symeOriginal
(syme))->fieldv)[symeIndex(symeOriginal(syme),SYFI_FoamKind
)] : (symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn(symeOriginal
(syme),SYFI_FoamKind)))) == FOAM_Glo)) _do_assert(("gen0FoamKind(syme) == FOAM_Glo"
),"genfoam.c",5959); } while (0)
;
5960 foam = foamNewCast(type, foamNewNil())foamNew(FOAM_Cast, 2, type, foamNew(FOAM_Nil, (int) 0));
5961
5962 foam = foamNewDef(foamNewGlo(gen0VarIndex(syme)),foam)foamNew(FOAM_Def, 2, foamNew(FOAM_Glo, 1, (AInt)(((((UShort) (
(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_VarIndex
))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))) != (0x7FFF)) ? ((UShort) ((((((syme)->
kind == SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void
*)0)), (syme))->locmask) & (1 << (SYFI_VarIndex)
)) ? ((syme)->fieldv)[symeIndex(syme,SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))) : ((UShort) ((((((symeOriginal(syme))->
kind == SYME_Trigger ? libGetAllSymes((symeOriginal(syme))->
lib) : ((void*)0)), (symeOriginal(syme)))->locmask) & (
1 << (SYFI_VarIndex))) ? ((symeOriginal(syme))->fieldv
)[symeIndex(symeOriginal(syme),SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def)))))), foam)
;
5963 gen0ProgList = listCons(Foam)(Foam_listPointer->Cons)(foam, gen0ProgList);
5964 gen0NumProgs++;
5965 }
5966 }
5967
5968 listFree(Syme)(Syme_listPointer->Free)(symes);
5969}
5970
5971localstatic SymeList
5972gen0GetExporterSymes(Stab stab, Sefo sefo, SymeList symes)
5973{
5974 Syme syme = abSyme(sefo)((sefo)->abHdr.seman ? (sefo)->abHdr.seman->syme : 0
)
;
5975
5976 if (syme && gen0FoamKind(syme)((((FoamTag) (SYFI_FoamKind < (8 * sizeof(int)) &&
!(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->hasmask) & (1 <<
(SYFI_FoamKind))) ? (symeFieldInfo[SYFI_FoamKind].def) : (((
((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_FoamKind
))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes((
syme)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_FoamKind))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_FoamKind
)] : (symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn(syme
,SYFI_FoamKind))) != FOAM_LIMIT) ? ((FoamTag) (SYFI_FoamKind <
(8 * sizeof(int)) && !(((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
hasmask) & (1 << (SYFI_FoamKind))) ? (symeFieldInfo
[SYFI_FoamKind].def) : (((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_FoamKind))) ? ((((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_FoamKind))) ? ((syme)->fieldv
)[symeIndex(syme,SYFI_FoamKind)] : (symeFieldInfo[SYFI_FoamKind
].def)) : symeGetFieldFn(syme,SYFI_FoamKind))) : ((FoamTag) (
SYFI_FoamKind < (8 * sizeof(int)) && !(((((symeOriginal
(syme))->kind == SYME_Trigger ? libGetAllSymes((symeOriginal
(syme))->lib) : ((void*)0)), (symeOriginal(syme)))->hasmask
) & (1 << (SYFI_FoamKind))) ? (symeFieldInfo[SYFI_FoamKind
].def) : (((((symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_FoamKind))) ? ((((((
symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_FoamKind))) ? ((symeOriginal
(syme))->fieldv)[symeIndex(symeOriginal(syme),SYFI_FoamKind
)] : (symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn(symeOriginal
(syme),SYFI_FoamKind))))
== FOAM_LIMIT) {
5977 if ((symeIsExtend(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Extend)
|| symeIsExport(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Export)
) &&
5978 symeLib(syme)((syme)->lib))
5979 syme = gen0SymeCopyImport(syme);
5980
5981 if (symeIsImport(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Import)
&& !gen0IsEnumLit(syme)) {
5982 stabUseMeaning(stab, syme);
5983 if (!listMemq(Syme)(Syme_listPointer->Memq)(symes, syme))
5984 symes = listCons(Syme)(Syme_listPointer->Cons)(syme, symes);
5985 }
5986 }
5987
5988 else if (!abIsLeaf(sefo)(((sefo)->abHdr.tag) < AB_NODE_START)) {
5989 Length i;
5990 for (i = 0; i < abArgc(sefo)((sefo)->abHdr.argc); i += 1) {
5991 Sefo argi = abArgv(sefo)((sefo)->abGen.data.argv)[i];
5992 symes = gen0GetExporterSymes(stab, argi, symes);
5993 }
5994 }
5995
5996 return symes;
5997}
5998
5999localstatic SymeList
6000gen0GetBoundSymes(Stab stab)
6001{
6002 SymeList ls, symes;
6003
6004 symes = listReverse(Syme)(Syme_listPointer->Reverse)(stabGetBoundSymes(stab)(((stab)->first)->boundSymes));
6005
6006 for (ls = symes; ls; ls = cdr(ls)((ls)->rest)) {
6007 Syme syme = car(ls)((ls)->first);
6008
6009 if (symeIsExtend(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Extend)
&& !symeLib(syme)((syme)->lib)) {
6010 SymeList xsymes = symeExtendee(syme);
6011 for (; xsymes; xsymes = cdr(xsymes)((xsymes)->rest)) {
6012 Syme xsyme = car(xsymes)((xsymes)->first);
6013 if (!listMemq(Syme)(Syme_listPointer->Memq)(symes, xsyme))
6014 symes = listCons(Syme)(Syme_listPointer->Cons)(xsyme, symes);
6015 }
6016 }
6017 }
6018
6019 return symes;
6020}
6021
6022/*
6023 * Return the inner most lexical level used by the type of syme.
6024 */
6025
6026static SefoList *gen0MaxLevList;
6027static int gen0MaxLevLevel;
6028
6029int
6030gen0GetImportLexLevel(Syme syme)
6031{
6032 assert (symeIsImport(syme))do { if (!((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->kind) == SYME_Import
))) _do_assert(("symeIsImport(syme)"),"genfoam.c",6032); } while
(0)
;
6033 return gen0MaxLevel(tfExpr(symeExporter(syme))tfToAbSyn(symeExporter(syme)));
6034}
6035
6036int
6037gen0GetSefoLexLevel(Sefo sf)
6038{
6039 return gen0MaxLevel(sf);
6040}
6041
6042SefoList
6043gen0GetSefoInnerSefos(Sefo sf)
6044{
6045 SefoList sl = listNil(Sefo)((SefoList) 0);
6046
6047 gen0MaxLevList = &sl;
6048 gen0MaxLevLevel = gen0State->stabLevel;
6049 gen0MaxLevel(sf);
6050 gen0MaxLevList = NULL((void*)0);
6051 return sl;
6052}
6053
6054/* Initializing max = 1 prevents imports from floating out too far. */
6055localstatic int
6056gen0MaxLevel(AbSyn ab)
6057{
6058 int i, level, max = 1;
6059
6060 switch (abTag(ab)((ab)->abHdr.tag)) {
6061 case AB_Id:
6062 case AB_LitInteger:
6063 case AB_LitFloat:
6064 case AB_LitString:
6065 {
6066 Syme syme = abSyme(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->syme : 0);
6067 if (!syme) break;
6068 while (symeExtensionFirst(syme)) syme = symeExtensionFirst(syme);
6069 if (symeLib(syme)((syme)->lib) && (symeIsExport(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Export)
||
6070 symeIsExtend(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Extend)
))
6071 level = 1;
6072 else if (symeIsImport(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Import)
6073 && tfIsLibrary(symeExporter(syme)))
6074 level = 1;
6075 else {
6076 level = symeDefLevelNo(syme)(symeDefLevel(syme)->lexicalLevel);
6077 if (symeIsExtend(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Extend)
&& !symeIsSelf(syme)(((syme)->id) == ssymSelf))
6078 level += 1;
6079 }
6080 if (level > max) max = level;
6081 if (gen0MaxLevList && level >= gen0MaxLevLevel)
6082 *gen0MaxLevList = listCons(Sefo)(Sefo_listPointer->Cons)(ab, *gen0MaxLevList);
6083 break;
6084 }
6085 case AB_Comma:
6086 case AB_Apply:
6087 for (i = 0; i < abArgc(ab)((ab)->abHdr.argc); i += 1) {
6088 level = gen0MaxLevel(abArgv(ab)((ab)->abGen.data.argv)[i]);
6089 if (level > max) max = level;
6090 }
6091 break;
6092 case AB_Declare:
6093 level = gen0MaxLevel(ab->abDeclare.type);
6094 if (level > max) max = level;
6095 break;
6096 case AB_PretendTo:
6097 level = gen0MaxLevel(ab->abPretendTo.expr);
6098 if (level > max) max = level;
6099 break;
6100 default:
6101 /* If we see something unrecognized, use the current level. */
6102 /*!! gen0State->stab may not be quite right here. */
6103 level = stabLevelNo(gen0State->stab)(((gen0State->stab)->first)->lexicalLevel);
6104 if (level > max) max = level;
6105 if (gen0MaxLevList && level >= gen0MaxLevLevel)
6106 *gen0MaxLevList = listCons(Sefo)(Sefo_listPointer->Cons)(ab, *gen0MaxLevList);
6107 break;
6108 }
6109 return max;
6110}
6111
6112/*
6113 * Turn the list of constant decls into a DDecl.
6114 */
6115localstatic Foam
6116gen0RenewConstants(FoamList decls, int numProgs)
6117{
6118 int i;
6119 Foam newConstants;
6120
6121 newConstants = foamNewEmpty(FOAM_DDecl, numProgs + 1);
6122 newConstants->foamDDecl.usage = FOAM_DDecl_Consts;
6123
6124 for (i = numProgs-1; i >= 0; i--, decls = cdr(decls)((decls)->rest))
6125 newConstants->foamDDecl.argv[i] = car(decls)((decls)->first);
6126
6127 return newConstants;
6128}
6129
6130/*
6131 * Turn list of programs into a DDef.
6132 */
6133localstatic Foam
6134gen0RenewDefs(FoamList progs, int numProgs)
6135{
6136 int i;
6137 Foam newDefs;
6138
6139 newDefs = foamNewEmpty(FOAM_DDef, numProgs);
6140
6141 for (i = numProgs-1; i >= 0; i--, progs = cdr(progs)((progs)->rest)) {
6142 if (foamTag(car(progs))((((progs)->first))->hdr.tag) == FOAM_Prog) {
6143 newDefs->foamDDef.argv[i] =
6144 foamNewDef(foamNewConst(i), car(progs))foamNew(FOAM_Def, 2, foamNew(FOAM_Const, 1, (AInt)(i)), ((progs
)->first))
;
6145 gen0PatchFormatNums(car(progs)((progs)->first));
6146 } else
6147 newDefs->foamDDef.argv[i] = car(progs)((progs)->first);
6148 }
6149 return newDefs;
6150}
6151
6152localstatic Foam
6153genOr(AbSyn absyn)
6154{
6155 int i, l1 = gen0State->labelNo++, l2 = gen0State->labelNo++;
6156 Foam t;
6157
6158 t = gen0Temp(FOAM_Bool)gen0Temp0(FOAM_Bool, 4);
6159 gen0AddStmt(foamNewSet(foamCopy(t), foamNewBool(false))foamNew(FOAM_Set, 2, foamCopy(t), foamNew(FOAM_Bool, 1, (AInt
)(((int) 0))))
, absyn);
6160 for (i = 0; i < abArgc(absyn)((absyn)->abHdr.argc); i += 1)
6161 gen0AddStmt(foamNewIf(genFoamBit(abArgv(absyn)[i]),l1)foamNew(FOAM_If, 2, genFoamBit(((absyn)->abGen.data.argv)[
i]), l1)
,absyn);
6162 gen0AddStmt(foamNewGoto(l2)foamNew(FOAM_Goto, 1, (AInt)(l2)), absyn);
6163 gen0AddStmt(foamNewLabel(l1)foamNew(FOAM_Label, 1, (AInt)(l1)), absyn);
6164 gen0AddStmt(foamNewSet(foamCopy(t), foamNewBool(true))foamNew(FOAM_Set, 2, foamCopy(t), foamNew(FOAM_Bool, 1, (AInt
)(1)))
, absyn);
6165 gen0AddStmt(foamNewLabel(l2)foamNew(FOAM_Label, 1, (AInt)(l2)), absyn);
6166 return foamNewCast(FOAM_Word, t)foamNew(FOAM_Cast, 2, FOAM_Word, t);
6167}
6168
6169localstatic Foam
6170genAnd(AbSyn absyn)
6171{
6172 int i, l1 = gen0State->labelNo++, l2 = gen0State->labelNo++;
6173 Foam t;
6174
6175 t = gen0Temp(FOAM_Bool)gen0Temp0(FOAM_Bool, 4);
6176 gen0AddStmt(foamNewSet(foamCopy(t), foamNewBool(true))foamNew(FOAM_Set, 2, foamCopy(t), foamNew(FOAM_Bool, 1, (AInt
)(1)))
, absyn);
6177 for (i = 0; i < abArgc(absyn)((absyn)->abHdr.argc); i += 1) {
6178 Foam test = genFoamBit(abArgv(absyn)((absyn)->abGen.data.argv)[i]);
6179 gen0AddStmt(foamNewIf(foamNotThis(test),l1)foamNew(FOAM_If, 2, foamNotThis(test), l1), absyn);
6180 }
6181 gen0AddStmt(foamNewGoto(l2)foamNew(FOAM_Goto, 1, (AInt)(l2)), absyn);
6182 gen0AddStmt(foamNewLabel(l1)foamNew(FOAM_Label, 1, (AInt)(l1)), absyn);
6183 gen0AddStmt(foamNewSet(foamCopy(t), foamNewBool(false))foamNew(FOAM_Set, 2, foamCopy(t), foamNew(FOAM_Bool, 1, (AInt
)(((int) 0))))
, absyn);
6184 gen0AddStmt(foamNewLabel(l2)foamNew(FOAM_Label, 1, (AInt)(l2)), absyn);
6185 return foamNewCast(FOAM_Word, t)foamNew(FOAM_Cast, 2, FOAM_Word, t);
6186}
6187
6188/*
6189 * Generate code for repeat loops.
6190 */
6191localstatic Foam
6192genRepeat(AbSyn absyn)
6193{
6194 Scope("genRepeat")String scopeName = ("genRepeat"); int fluidLevel0 = (scopeLevel
++, fluidLevel)
;
6195 FoamList topLines;
6196 FoamList itl = listNil(Foam)((FoamList) 0), forl = listNil(Foam)((FoamList) 0), l;
6197 int gen0BodyLabel;
6198 int fluid(gen0IterateLabel)fluidSave_gen0IterateLabel = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(gen0IterateLabel
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_gen0IterateLabel
, fluidStack[fluidLevel].size = sizeof(gen0IterateLabel), fluidLevel
++, (gen0IterateLabel) )
;
6199 int fluid(gen0BreakLabel)fluidSave_gen0BreakLabel = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(gen0BreakLabel
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_gen0BreakLabel
, fluidStack[fluidLevel].size = sizeof(gen0BreakLabel), fluidLevel
++, (gen0BreakLabel) )
;
6200 int iterSize, i;
6201 Bool flag;
6202
6203 if (abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
)
6204 gen0Vars(abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
); /* put vars in outer level */
6205
6206 gen0BodyLabel = gen0State->labelNo++;
6207 gen0IterateLabel = gen0State->labelNo++;
6208 gen0BreakLabel = gen0State->labelNo++;
6209
6210 flag = gen0AddImportPlace(&topLines);
6211
6212 /* Generate the code for the iterators, but do not add it yet. */
6213 iterSize = abRepeatIterc(absyn)(((absyn)->abHdr.argc)-1);
6214 for (i = 0; i < iterSize; i++)
6215 gen0Iter(absyn->abRepeat.iterv[i], &forl, &itl);
6216
6217 l = forl = listNReverse(Foam)(Foam_listPointer->NReverse)(forl);
6218
6219 /* Add for-iterator initializations. */
6220 iterSize = listLength(Foam)(Foam_listPointer->_Length)(forl);
Value stored to 'iterSize' is never read
6221 for(i = 0; forl != listNil(Foam)((FoamList) 0); i++, forl = cdr(forl)((forl)->rest))
6222 gen0AddStmt(car(forl)((forl)->first), absyn);
6223 listFree(Foam)(Foam_listPointer->Free)(l);
6224
6225 /* Add goto the iterator steppers at the end of the loop. */
6226 gen0AddStmt(foamNewGoto(gen0IterateLabel)foamNew(FOAM_Goto, 1, (AInt)(gen0IterateLabel)), absyn);
6227
6228 /* Add the body. */
6229 gen0AddStmt(foamNewLabel(gen0BodyLabel)foamNew(FOAM_Label, 1, (AInt)(gen0BodyLabel)), absyn);
6230 genFoamStmt(absyn->abRepeat.body);
6231
6232 /* Add the iterator steppers. */
6233 gen0AddStmt(foamNewLabel(gen0IterateLabel)foamNew(FOAM_Label, 1, (AInt)(gen0IterateLabel)), absyn);
6234
6235 l = itl = listNReverse(Foam)(Foam_listPointer->NReverse)(itl);
6236 iterSize = listLength(Foam)(Foam_listPointer->_Length)(itl);
6237
6238 for(i = 0; i<iterSize; i++, itl = cdr(itl)((itl)->rest)) {
6239 gen0AddStmt(car(itl)((itl)->first), absyn);
6240 }
6241 listFree(Foam)(Foam_listPointer->Free)(l);
6242
6243 /* Add goto the body. */
6244 gen0AddStmt(foamNewGoto(gen0BodyLabel)foamNew(FOAM_Goto, 1, (AInt)(gen0BodyLabel)), absyn);
6245
6246 /* Add the break label. */
6247 gen0AddStmt(foamNewLabel(gen0BreakLabel)foamNew(FOAM_Label, 1, (AInt)(gen0BreakLabel)), absyn);
6248
6249
6250 if (flag) gen0ResetImportPlace(topLines);
6251
6252 Return(NULL){ fluidUnwind(fluidLevel0, ((int) 0)); return ((void*)0);; };
6253}
6254
6255localstatic Foam
6256genGenerate(AbSyn absyn)
6257{
6258 Scope("Generate")String scopeName = ("Generate"); int fluidLevel0 = (scopeLevel
++, fluidLevel)
;
6259 Foam foam;
6260 GenType fluid(gen0GenType)fluidSave_gen0GenType = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(gen0GenType
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_gen0GenType
, fluidStack[fluidLevel].size = sizeof(gen0GenType), fluidLevel
++, (gen0GenType) )
;
6261 gen0GenType = gfGenTypeGenerator(absyn);
6262
6263 if (gen0GenType == GENTYPE_Coroutine)
6264 foam = gen0CGenerate(absyn);
6265 else if (gen0GenType == GENTYPE_Function)
6266 foam = gen0Generate(absyn);
6267 else
6268 bug("Unknown generator type");
6269
6270 Return(foam){ fluidUnwind(fluidLevel0, ((int) 0)); return foam;; };
6271}
6272
6273localstatic Foam
6274genYield(AbSyn absyn)
6275{
6276 Foam foam;
6277 if (gen0GenType)
6278 foam = gen0CYield(absyn);
6279 else
6280 foam = gen0Yield(absyn);
6281
6282 return foam;
6283}
6284/*
6285 * Generate an exit test and for-loop initialization for a single iterator.
6286 */
6287localstatic void
6288gen0Iter(AbSyn absyn, FoamList *forl, FoamList *itl)
6289{
6290 FoamList olines = gen0State->lines;
6291 Foam test;
6292
6293 switch (abTag(absyn)((absyn)->abHdr.tag)) {
6294 case AB_While:
6295 gen0State->lines = *itl;
6296 test = foamNotThis(genFoamBit(absyn->abWhile.test));
6297 test = foamNewIf(test, gen0BreakLabel)foamNew(FOAM_If, 2, test, gen0BreakLabel);
6298 *itl = listCons(Foam)(Foam_listPointer->Cons)(test, gen0State->lines);
6299 break;
6300 case AB_For:
6301 if (gfGenTypeFor(absyn) == GENTYPE_Coroutine)
6302 gen0CForIter(absyn, forl, itl);
6303 else if (gfGenTypeFor(absyn) == GENTYPE_Function)
6304 gen0ForIter(absyn, forl, itl);
6305 else
6306 bug("Unknown generator");
6307 *itl = gen0State->lines;
6308 break;
6309 default:
6310 bugUnimpl("Unimplemented iterator")bug("Unimplemented %s (line %d in file %s).", "Unimplemented iterator"
, 6310, "genfoam.c")
;
6311 break;
6312 }
6313
6314 gen0State->lines = olines;
6315 return;
6316}
6317
6318/*
6319 * Generate an exit test and initialization code for a single for-iterator.
6320 */
6321localstatic void
6322gen0ForIter(AbSyn absyn, FoamList *forl, FoamList *itl)
6323{
6324 AbSyn id;
6325 Foam iterVars, doneFun, stepFun, valueFun, boundFun;
6326 Foam call;
6327
6328 gen0State->lines = *forl;
6329 iterVars = gen0GenLiftedGener(absyn, absyn->abFor.whole);
6330 *forl = gen0State->lines;
6331 gen0State->lines = *itl;
6332
6333 assert(foamTag(iterVars) == FOAM_Values)do { if (!(((iterVars)->hdr.tag) == FOAM_Values)) _do_assert
(("foamTag(iterVars) == FOAM_Values"),"genfoam.c",6333); } while
(0)
;
6334 doneFun = iterVars->foamValues.argv[0];
6335 stepFun = iterVars->foamValues.argv[1];
6336 valueFun = iterVars->foamValues.argv[2];
6337 boundFun = iterVars->foamValues.argv[3];
6338
6339 /* step the generator */
6340 call = foamNewEmpty(FOAM_CCall, 2);
6341 call->foamCCall.type = FOAM_NOp;
6342 call->foamCCall.op = foamCopy(stepFun);
6343 gen0AddStmt(call, absyn);
6344
6345 /* Have we finished */
6346 call = foamNewEmpty(FOAM_CCall, 2);
6347 call->foamCCall.type = FOAM_Word;
6348 call->foamCCall.op = foamCopy(doneFun);
6349 gen0AddStmt(foamNewIf(foamNewCast(FOAM_Bool, call), gen0BreakLabel)foamNew(FOAM_If, 2, foamNew(FOAM_Cast, 2, FOAM_Bool, call), gen0BreakLabel
)
,
6350 absyn);
6351
6352 /* Snarf the value...*/
6353 /* -- PAB
6354 id = abDefineeId(absyn);
6355 call = foamNewEmpty(FOAM_CCall, 2);
6356 call->foamCCall.type = gen0Type(gen0AbContextType(id), NULL);
6357 call->foamCCall.op = foamCopy(valueFun);
6358 gen0AddStmt(foamNewSet(genFoamVal(id), call), absyn);
6359 */
6360 if (abTag(absyn->abFor.lhs)((absyn->abFor.lhs)->abHdr.tag) == AB_Comma) {
6361 call = foamNewEmpty(FOAM_CCall, 2);
6362 call->foamCCall.type = FOAM_Word;
6363 call->foamCCall.op = foamCopy(valueFun);
6364 call = gen0CrossToMulti(foamNewCast(FOAM_Rec, call)foamNew(FOAM_Cast, 2, FOAM_Rec, call),
6365 tfDefineeMaybeType(tfGeneratorArg(gen0AbContextType(absyn))tfFollowArg(gen0AbContextType(absyn), 0)));
6366 gen0MultiAssign(FOAM_Set, absyn->abFor.lhs, call);
6367 }
6368 else {
6369 FoamTag type;
6370 id = abDefineeId(absyn);
6371 call = foamNewEmpty(FOAM_CCall, 2);
6372 type = gen0Type(gen0AbContextType(id), NULL((void*)0));
6373 call->foamCCall.type = FOAM_Word;
6374 call->foamCCall.op = foamCopy(valueFun);
6375 if (type != FOAM_Word)
6376 call = foamNewCast(type, call)foamNew(FOAM_Cast, 2, type, call);
6377 gen0AddStmt(foamNewSet(genFoamVal(id), call)foamNew(FOAM_Set, 2, genFoamVal(id), call), absyn);
6378 }
6379
6380 if (!abIsNothing(absyn->abFor.test)((absyn->abFor.test)->abHdr.tag == (AB_Nothing))) {
6381 int l1 = gen0State->labelNo++;
6382 Foam test = genFoamBit(absyn->abFor.test);
6383 gen0AddStmt(foamNewIf(test, l1)foamNew(FOAM_If, 2, test, l1), absyn);
6384 gen0AddStmt(foamNewGoto(gen0IterateLabel)foamNew(FOAM_Goto, 1, (AInt)(gen0IterateLabel)), absyn);
6385 gen0AddStmt(foamNewLabel(l1)foamNew(FOAM_Label, 1, (AInt)(l1)), absyn);
6386 }
6387
6388 return;
6389}
6390
6391extern void
6392gen0CForIter(AbSyn absyn, FoamList *forl, FoamList *itl)
6393{
6394 Foam gen;
6395 Foam hasNext, next, whole;
6396 FoamTag type;
6397 AbSyn id;
6398
6399 hasNext = gen0Temp(FOAM_Bool)gen0Temp0(FOAM_Bool, 4);
6400 next = gen0Temp(FOAM_Word)gen0Temp0(FOAM_Word, 4);
6401 whole = gen0Temp(FOAM_GenIter)gen0Temp0(FOAM_GenIter, 4);
6402
6403 gen0State->lines = *forl;
6404 gen = foamNewCast(FOAM_Gener, genImplicit(absyn, absyn->abFor.whole, FOAM_Word))foamNew(FOAM_Cast, 2, FOAM_Gener, genImplicit(absyn, absyn->
abFor.whole, FOAM_Word))
;
6405 gen0AddStmt(foamNewSet(foamCopy(whole), foamNewGenIter(gen))foamNew(FOAM_Set, 2, foamCopy(whole), foamNew(FOAM_GenIter, 1
, gen))
, NULL((void*)0));
6406 *forl = gen0State->lines;
6407 gen0State->lines = *itl;
6408
6409 /* Finished? */
6410 gen0AddStmt(foamNewGenerStep(gen0BreakLabel, foamCopy(whole))foamNew(FOAM_GenerStep, 2, gen0BreakLabel, foamCopy(whole)), absyn);
6411
6412 if (abTag(absyn->abFor.lhs)((absyn->abFor.lhs)->abHdr.tag) == AB_Comma) {
6413 Foam val = foamNewGenerValue(foamCopy(whole))foamNew(FOAM_GenerValue, 1, foamCopy(whole));
6414 Foam mval = gen0CrossToMulti(val,
6415 tfDefineeMaybeType(tfXGeneratorArg(gen0AbContextType(absyn))tfFollowArg(gen0AbContextType(absyn), 0)));
6416 gen0MultiAssign(FOAM_Set, absyn->abFor.lhs, mval);
6417 }
6418 else {
6419 gen0AddStmt(foamNewSet(foamCopy(next), foamNewGenerValue(foamCopy(whole)))foamNew(FOAM_Set, 2, foamCopy(next), foamNew(FOAM_GenerValue,
1, foamCopy(whole)))
, NULL((void*)0));
6420 id = abDefineeId(absyn);
6421 type = gen0Type(gen0AbContextType(id), NULL((void*)0));
6422 if (type != FOAM_Word)
6423 next = foamNewCast(type, foamCopy(next))foamNew(FOAM_Cast, 2, type, foamCopy(next));
6424 gen0AddStmt(foamNewSet(genFoamVal(id), foamCopy(next))foamNew(FOAM_Set, 2, genFoamVal(id), foamCopy(next)), absyn);
6425 }
6426 if (!abIsNothing(absyn->abFor.test)((absyn->abFor.test)->abHdr.tag == (AB_Nothing))) {
6427 int l1 = gen0State->labelNo++;
6428 Foam test = genFoamBit(absyn->abFor.test);
6429 gen0AddStmt(foamNewIf(test, l1)foamNew(FOAM_If, 2, test, l1), absyn);
6430 gen0AddStmt(foamNewGoto(gen0IterateLabel)foamNew(FOAM_Goto, 1, (AInt)(gen0IterateLabel)), absyn);
6431 gen0AddStmt(foamNewLabel(l1)foamNew(FOAM_Label, 1, (AInt)(l1)), absyn);
6432 }
6433 foamFree(whole);
6434 foamFree(hasNext);
6435 foamFree(next);
6436}
6437
6438
6439/*****************************************************************************
6440 *
6441 * :: gen0FindDefs
6442 *
6443 ****************************************************************************/
6444
6445/*
6446 * Find all the definitions in the absyn, and create foam closures
6447 * for defines of programs, also marks symes when used deeply.
6448 * This function can traverse the absyn in any order.
6449 */
6450
6451/*
6452 * !!should replace lhs with exporter
6453 */
6454typedef AInt GFindDefMask;
6455
6456#define GFindDef_None0 0
6457
6458#define GFindDef_HighLevel(1 << 0) (1 << 0)
6459#define GFindDef_Generator(1 << 1) (1 << 1)
6460
6461#define gfdSetHighLevel(mask)( (mask) | (1 << 0)) ( (mask) | GFindDef_HighLevel(1 << 0))
6462#define gfdSetGenerator(mask)( (mask) | (1 << 1)) ( (mask) | GFindDef_Generator(1 << 1))
6463
6464#define gfdHighLevel(mask)( (mask) & (1 << 0)) ( (mask) & GFindDef_HighLevel(1 << 0))
6465#define gfdGenerator(mask)( (mask) & (1 << 1)) ( (mask) & GFindDef_Generator(1 << 1))
6466
6467localstatic void gen0FindDefs(AbSyn, AbSyn, Stab, GFindDefMask);
6468localstatic void gen0FindDefsSyme(Stab stab, Syme syme, GFindDefMask mask);
6469localstatic void gen0FindDefsDefine(AbSyn absyn, Stab stab, GFindDefMask mask);
6470
6471localstatic void
6472gen0FindDefsAll(AbSyn absyn, Stab stab0)
6473{
6474 gen0FindDefs(absyn, NULL((void*)0), stab0, GFindDef_None0);
6475}
6476
6477localstatic void
6478gen0FindDefs(AbSyn absyn, AbSyn lhs, Stab stab, GFindDefMask mask)
6479{
6480 Length i, argc = abArgc(absyn)((absyn)->abHdr.argc);
6481
6482 switch (abTag(absyn)((absyn)->abHdr.tag)) {
6483 case AB_Add: {
6484 AbSyn lhs = absyn->abAdd.base;
6485 AbSyn rhs = absyn->abAdd.capsule;
6486
6487 stab = abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
;
6488
6489 gen0FindDefs(lhs, NULL((void*)0), stab, mask);
6490 gen0FindDefs(rhs, NULL((void*)0), stab, mask);
6491 break;
6492 }
6493 case AB_Define: {
6494 gen0FindDefsDefine(absyn, stab, mask);
6495 break;
6496 }
6497 case AB_RestrictTo: {
6498 AbSyn expr = absyn->abRestrictTo.expr;
6499 AbSyn type = absyn->abRestrictTo.type;
6500
6501 gen0FindDefs(expr, NULL((void*)0), stab, mask);
6502 if (abHasTag(expr, AB_Add)((expr)->abHdr.tag == (AB_Add)) && tfIsCategory(gen0AbType(type))(((gen0AbType(type))->tag) == TF_Category))
6503 gen0FindDefs(type, NULL((void*)0), stab, gfdSetHighLevel(mask)( (mask) | (1 << 0)));
6504 break;
6505 }
6506 case AB_Generate: {
6507 AbSyn count = absyn->abGenerate.count;
6508 AbSyn body = absyn->abGenerate.body;
6509 gen0FindDefs(count, NULL((void*)0), stab, gfdSetHighLevel(mask)( (mask) | (1 << 0)));
6510 gen0FindDefs(body, NULL((void*)0), stab, gfdSetHighLevel(mask)( (mask) | (1 << 0)));
6511 break;
6512 }
6513 case AB_Reference: {
6514 AbSyn body = absyn->abReference.body;
6515
6516 /* Mark our parameter as being used deeply */
6517 gen0FindDefs(body, NULL((void*)0), stab, gfdSetHighLevel(mask)( (mask) | (1 << 0)));
6518 break;
6519 }
6520 case AB_Collect: {
6521 AbSyn *argv = absyn->abCollect.iterv;
6522 AbSyn body = absyn->abCollect.body;
6523 for (i = 0; i < argc - 1; i += 1) {
6524 gen0FindDefs(argv[i], NULL((void*)0), stab, gfdSetHighLevel(mask)( (mask) | (1 << 0)));
6525 }
6526 gen0FindDefs(body, NULL((void*)0), stab, gfdSetHighLevel(mask)( (mask) | (1 << 0)));
6527 break;
6528 }
6529 case AB_Id: {
6530 Syme syme = abSyme(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->syme :
0)
;
6531 gen0FindDefsSyme(stab, syme, mask);
6532 break;
6533 }
6534 case AB_Where: {
6535 AbSyn ctxt = absyn->abWhere.context;
6536 AbSyn expr = absyn->abWhere.expr;
6537
6538 stab = abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
;
6539
6540 gen0FindDefs(ctxt, NULL((void*)0), abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
, mask);
6541 gen0FindDefs(expr, NULL((void*)0), abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
, mask);
6542 break;
6543 }
6544 case AB_With: {
6545 AbSyn lhs = absyn->abWith.base;
6546 AbSyn rhs = absyn->abWith.within;
6547
6548 gen0FindDefs(lhs, NULL((void*)0), stab, mask);
6549 gen0FindDefs(rhs, NULL((void*)0), stab, mask);
6550 break;
6551 }
6552 case AB_Lambda:
6553 case AB_PLambda: {
6554 AbSyn fbody;
6555 Bool markParams = false((int) 0);
6556
6557 fbody = absyn->abLambda.body;
6558 while (abTag(fbody)((fbody)->abHdr.tag) == AB_Label)
6559 fbody = fbody->abLabel.expr;
6560
6561 if (abTag(fbody)((fbody)->abHdr.tag) == AB_Add || abTag(fbody)((fbody)->abHdr.tag) == AB_With ||
6562 abIsAnyLambda(fbody)(((fbody)->abHdr.tag == (AB_Lambda)) || ((fbody)->abHdr
.tag == (AB_PLambda)))
)
6563 markParams = true1;
6564
6565 if (lhs) {
6566 Syme syme = abSyme(lhs)((lhs)->abHdr.seman ? (lhs)->abHdr.seman->syme : 0);
6567 symeSetConstNum(syme, gen0FwdProgNum);
6568 if (symeDefLevelNo(syme)(symeDefLevel(syme)->lexicalLevel) == stabLevelNo(stab)(((stab)->first)->lexicalLevel)) {
6569 Foam foam = foamNewConst(gen0FwdProgNum)foamNew(FOAM_Const, 1, (AInt)(gen0FwdProgNum));
6570 foamSyme(foam)((foam)->hdr.syme) = syme;
6571 foam = foamNewClos(foamNewEnv(int0), foam)foamNew(FOAM_Clos,2, foamNew(FOAM_Env, 1, (AInt)(((int) 0))),
foam)
;
6572 symeSetClosure(syme, foam)(symeSetFieldVal = ((AInt) (foam)), (((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_Closure))) ? (((syme)->fieldv
)[symeIndex(syme,SYFI_Closure)] = (symeSetFieldVal)) : !((syme
)->full) && symeSetFieldVal == (symeFieldInfo[SYFI_Closure
].def) ? symeSetFieldVal : symeSetFieldFn(syme,SYFI_Closure,symeSetFieldVal
))
;
6573 }
6574 if (!markParams) {
6575 TForm ret = tfMapRet(symeType(syme))tfFollowArg(symeType(syme), 1);
6576 markParams = tfSatCat(ret) || tfSatDom(ret);
6577 }
6578 }
6579
6580 gen0FwdProgNum -= 1;
6581
6582 if (markParams) gen0MarkParamsDeep(stab,absyn->abLambda.param);
6583 gen0FindDefs(fbody, NULL((void*)0), abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
, mask);
6584
6585 break;
6586 }
6587 case AB_Apply: {
6588 AbSyn *argv = abArgv(absyn)((absyn)->abGen.data.argv);
6589 AbSyn impl = abImplicit(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->implicit
: 0)
;
6590 Syme syme = abSyme(argv[0])((argv[0])->abHdr.seman ? (argv[0])->abHdr.seman->syme
: 0)
;
6591 Bool isForeign = false((int) 0);
6592
6593 if (syme && symeIsForeign(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Foreign)
&&
6594 symeForeign(syme)((ForeignOrigin) (SYFI_Foreign < (8 * sizeof(int)) &&
!(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->hasmask) & (1 <<
(SYFI_Foreign))) ? (symeFieldInfo[SYFI_Foreign].def) : (((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_Foreign
))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes((
syme)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_Foreign))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_Foreign
)] : (symeFieldInfo[SYFI_Foreign].def)) : symeGetFieldFn(syme
,SYFI_Foreign)))
->protocol == FOAM_Proto_Fortran)
6595 isForeign = true1;
6596
6597 if (abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
)
6598 stab = abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
;
6599
6600 if (impl) gen0FindDefs(impl, NULL((void*)0), stab, mask);
6601
6602
6603 for (i = 0; i < argc; i += 1)
6604 {
6605 /*
6606 * We want to check to see if this argument is a
6607 * function which is being passed to a foreign import.
6608 * If so then it will be lexically deep in the wrapper
6609 * that surrounds it (see gf_fortran.c) and we need
6610 * to note this here.
6611 */
6612 Bool isDeep = false((int) 0);
6613 TForm tfi = abTUnique(argv[i])((argv[i])->abHdr.type.unique);
6614
6615
6616 /*
6617 * At the moment we don't type check the origin
6618 * field of imports so tfi may be NULL.
6619 */
6620 if (tfi)
6621 {
6622 Bool isFunArg = tfIsAnyMap(tfi)((((tfi)->tag) == TF_Map) || (((tfi)->tag) == TF_PackedMap
))
;
6623 isDeep = i && isForeign && isFunArg;
6624 }
6625
6626 gen0FindDefs(argv[i], NULL((void*)0), stab, isDeep ? gfdSetHighLevel(mask)( (mask) | (1 << 0)) : mask);
6627 }
6628 break;
6629 }
6630 case AB_Try: {
6631 AbSyn id = absyn->abTry.id;
6632 AbSyn expr = absyn->abTry.expr;
6633 AbSyn except = absyn->abTry.except;
6634 AbSyn always = absyn->abTry.always;
6635
6636 gen0FindDefs(id, lhs, stab, mask);
6637 gen0FindDefs(expr, lhs, stab, gfdSetHighLevel(mask)( (mask) | (1 << 0)));
6638 gen0FindDefs(except, lhs, stab, mask);
6639 gen0FindDefs(always, lhs, stab, mask);
6640 break;
6641 }
6642 case AB_Export: {
6643 AbSyn what = absyn->abExport.what;
6644 AbSyn from = absyn->abExport.origin;
6645 AbSyn dest = absyn->abExport.destination;
6646
6647 if (abTag(dest)((dest)->abHdr.tag) == AB_Apply)
6648 gen0FindDefs(what, lhs, stab, gfdSetHighLevel(mask)( (mask) | (1 << 0)));
6649 else
6650 gen0FindDefs(what, lhs, stab, mask);
6651 gen0FindDefs(dest, lhs, stab, mask);
6652 gen0FindDefs(from, lhs, stab, mask);
6653 break;
6654 }
6655 case AB_Label: {
6656 AbSyn expr = absyn->abLabel.expr;
6657 gen0FindDefs(expr, lhs, stab, mask);
6658 break;
6659 }
6660 default:
6661 if (abImplicitSyme(absyn)(((absyn)->abHdr.seman ? (absyn)->abHdr.seman->implicit
: 0) ? ((((absyn)->abHdr.seman ? (absyn)->abHdr.seman->
implicit : 0))->abHdr.seman ? (((absyn)->abHdr.seman ? (
absyn)->abHdr.seman->implicit : 0))->abHdr.seman->
syme : 0) : 0)
!= NULL((void*)0)) {
6662 gen0FindDefs(abImplicit(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->implicit
: 0)
, NULL((void*)0), stab, mask);
6663
6664 }
6665 if (!abIsLeaf(absyn)(((absyn)->abHdr.tag) < AB_NODE_START))
6666 for (i = 0; i < argc; i += 1)
6667 gen0FindDefs(abArgv(absyn)((absyn)->abGen.data.argv)[i], NULL((void*)0),
6668 stab, mask);
6669 break;
6670 }
6671}
6672
6673localstatic void
6674gen0FindDefsDefine(AbSyn absyn, Stab stab, GFindDefMask mask)
6675{
6676 AbSyn *argv;
6677 AbSyn lhs;
6678 AbSyn rhs;
6679 AbSyn id;
6680 int argc, i;
6681
6682 assert(abTag(absyn) == AB_Define)do { if (!(((absyn)->abHdr.tag) == AB_Define)) _do_assert(
("abTag(absyn) == AB_Define"),"genfoam.c",6682); } while (0)
;
6683 lhs = absyn->abDefine.lhs;
6684 rhs = absyn->abDefine.rhs;
6685
6686 if (abTag(lhs)((lhs)->abHdr.tag) == AB_Comma) {
6687 argv = lhs->abComma.argv;
6688 argc = abArgc(lhs)((lhs)->abHdr.argc);
6689 id = NULL((void*)0);
6690 }
6691 else {
6692 argv = &lhs;
6693 argc = 1;
6694 id = abDefineeId(lhs);
6695 }
6696 gen0FindDefs(rhs, id, stab, mask);
6697
6698 for (i = 0; i < argc; i++) {
6699 AbSyn lhs = argv[i];
6700 AbSyn type = abDefineeTypeOrElse(lhs, NULL((void*)0));
6701
6702 if (!type)
6703 break;
6704
6705 if (abIsAnyMap(type)(((((type)->abHdr.tag == (AB_Apply)) && (((((type)
->abApply.op))->abHdr.tag == (AB_Id)) && ((((type
)->abApply.op))->abId.sym)==(ssymArrow))) && ((
(type)->abHdr.argc)-1) == 2) || ((((type)->abHdr.tag ==
(AB_Apply)) && (((((type)->abApply.op))->abHdr
.tag == (AB_Id)) && ((((type)->abApply.op))->abId
.sym)==(ssymPackedArrow))) && (((type)->abHdr.argc
)-1) == 2))
)
6706 type = abMapRet(type)((type)->abApply.argv[1]);
6707
6708 if (abTag(type)((type)->abHdr.tag) == AB_With &&
6709 (abIsNotNothing(type->abWith.base)!((type->abWith.base)->abHdr.tag == (AB_Nothing)) ||
6710 gen0HasDefaults(type)))
6711 gen0FindDefs(type, NULL((void*)0), stab, gfdSetHighLevel(mask)( (mask) | (1 << 0)));
6712 else if (tfIsCategoryType(gen0AbType(type)))
6713 gen0FindDefs(type, NULL((void*)0), stab, gfdSetHighLevel(mask)( (mask) | (1 << 0)));
6714 else
6715 gen0FindDefs(type, NULL((void*)0), stab, mask);
6716 }
6717}
6718
6719localstatic void
6720gen0FindDefsSyme(Stab stab, Syme syme, GFindDefMask mask)
6721{
6722 Stab tstab;
6723 Buffer buf;
6724 String suffix = "";
6725
6726 if (!syme) return;
6727
6728 if (genfEnvDebug) {
6729 buf = bufNew();
6730 bufPrintf(buf, "%s [%d]", symeString(syme)((((syme)->id))->str), symeDefLambdaLevelNo(syme)(symeDefLevel(syme)->lambdaLevel));
6731 tstab = stab;
6732 while (tstab && stabHasMeaning(tstab, syme)) {
6733 bufPrintf(buf, " .. (%d, %d, %d, %s)", stabSerialNo(tstab)(((tstab)->first)->serialNo), stabLevelNo(tstab)(((tstab)->first)->lexicalLevel), stabLambdaLevelNo(tstab)(((tstab)->first)->lambdaLevel),
6734 "Normal" /*car(tstab)->isGenerator ? "Gen" : "Normal"*/);
6735 tstab = cdr(tstab)((tstab)->rest);
6736 }
6737 }
6738 if (!symeUsed(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) & (0x0040))
) {
6739 stabUseMeaning(stab, syme);
6740 symeSetUsed(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) |= (0x0040))
;
6741 suffix = ".. local";
6742 }
6743
6744 if (gfdHighLevel(mask)( (mask) & (1 << 0)) ||
6745 stabLambdaLevelNo(stab)(((stab)->first)->lambdaLevel) != symeDefLambdaLevelNo(syme)(symeDefLevel(syme)->lambdaLevel)) {
6746 stabUseMeaning(stab, syme);
6747 symeSetUsed(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) |= (0x0040))
;
6748 symeSetUsedDeeply(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) |= (0x0004))
;
6749 suffix = ".. deep";
6750 }
6751
6752 if (genfEnvDebug) {
6753 afprintf(dbOut, "FindDefsSyme: %s %s\n", bufLiberate(buf), suffix);
6754 }
6755}
6756
6757
6758localstatic void
6759gen0MarkParamsDeep(Stab stab, AbSyn param)
6760{
6761 AbSyn *argv = abArgvAs(AB_Comma, param)(((param)->abHdr.tag == (AB_Comma)) ? ((param)->abGen.data
.argv) : &(param))
;
6762 Length i, argc = abArgcAs(AB_Comma, param)(((param)->abHdr.tag == (AB_Comma)) ? ((param)->abHdr.argc
) : 1)
;
6763
6764 for (i = 0; i < argc; i += 1) {
6765 Syme syme = abSyme(abDefineeId(argv[i]))((abDefineeId(argv[i]))->abHdr.seman ? (abDefineeId(argv[i
]))->abHdr.seman->syme : 0)
;
6766 if (syme) {
6767 symeSetUsedDeeply(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) |= (0x0004))
;
6768 stabUseMeaning(stab, syme);
6769 }
6770 }
6771}
6772
6773/*****************************************************************************
6774 *
6775 * :: Temporaries
6776 *
6777 ****************************************************************************/
6778
6779/*
6780 * Temp to make re-evaluation side-effect free
6781 */
6782Foam
6783gen0MakeMultiEvaluable(int type, int fmt, Foam foam)
6784{
6785 Foam new;
6786
6787 if (gen0IsMultiEvaluable(foam))
6788 return foam;
6789 else {
6790 new = gen0Temp0(type, fmt);
6791 gen0AddStmt(foamNewSet(new, foam)foamNew(FOAM_Set, 2, new, foam), NULL((void*)0));
6792 return foamCopy(new);
6793 }
6794}
6795
6796
6797/*
6798 * Create a temporary variable if needed.
6799 */
6800
6801localstatic Foam
6802gen0TempValueMode(TForm tf)
6803{
6804 int i;
6805 Foam vals;
6806
6807 if (!gen0ValueMode)
6808 return NULL((void*)0);
6809
6810 if (!tfIsMulti(tf)(((tf)->tag) == TF_Multiple)) {
6811 AInt fmt;
6812 FoamTag type;
6813 type = gen0Type(tf, &fmt);
6814
6815 return gen0TempLocal0(type, fmt);
6816 }
6817 vals = foamNewEmpty(FOAM_Values, tfMultiArgc(tf));
6818 for (i = 0; i < tfMultiArgc(tf); i += 1) {
6819 AInt fmt, tag;
6820 tag = gen0Type(tfMultiArgN(tf, i)tfFollowArg(tf, i), &fmt);
6821 vals->foamValues.argv[i] =
6822 gen0TempLocal0(tag, fmt);
6823 }
6824 return vals;
6825}
6826
6827localstatic Foam
6828gen0TempValue(AbSyn absyn)
6829{
6830 if (gen0ValueMode && gen0AbType(absyn) != tfExit)
6831 return genFoamVal(absyn);
6832 else {
6833 genFoamStmt(absyn);
6834 return NULL((void*)0);
6835 }
6836}
6837
6838localstatic void
6839gen0SetTemp(Foam t, Foam foam)
6840{
6841 Length i;
6842
6843 if (t == NULL((void*)0) || foam == NULL((void*)0))
6844 return;
6845
6846 if (foamTag(t)((t)->hdr.tag) != FOAM_Values) {
6847 gen0AddStmt(foamNewSet(foamCopyNode(t), foam)foamNew(FOAM_Set, 2, foamCopyNode(t), foam), NULL((void*)0));
6848 return;
6849 }
6850 if (foamTag(foam)((foam)->hdr.tag) == FOAM_Nil) return;
6851
6852 assert(foamTag(foam) == FOAM_Values)do { if (!(((foam)->hdr.tag) == FOAM_Values)) _do_assert((
"foamTag(foam) == FOAM_Values"),"genfoam.c",6852); } while (0
)
;
6853 for (i = 0; i < foamArgc(t)((t)->hdr.argc); i += 1)
6854 gen0AddStmt(foamNewSet(foamCopyNode(t->foamValues.argv[i]),foamNew(FOAM_Set, 2, foamCopyNode(t->foamValues.argv[i]), foam
->foamValues.argv[i])
6855 foam->foamValues.argv[i])foamNew(FOAM_Set, 2, foamCopyNode(t->foamValues.argv[i]), foam
->foamValues.argv[i])
, NULL((void*)0));
6856}
6857
6858/*
6859 * Create a temporary variable given foam_type and fmt number
6860 * The fmt number is used creating the decl.
6861 * If the format isn't meaningfull, you can use the gen0Temp macro.
6862 */
6863Foam
6864gen0Temp0(int type, int fmt)
6865{
6866 int i;
6867
6868 gen0State->hasTemps = true1;
6869 if (!gen0InDeep(gen0State->progType)((gen0State->progType) >= PT_DeepStart)) {
6870 i = vpNewVar0(gen0State->localPool, type, fmt);
6871 return foamNewLoc(i)foamNew(FOAM_Loc, 1, (AInt)(i));
6872 }
6873 else {
6874 return gen0TempLex0(type, fmt);
6875 }
6876}
6877
6878/*
6879 * Free up a temporary variable for possible re-use
6880 */
6881localstatic void
6882gen0FreeTemp(Foam var)
6883{
6884 if (!var)
6885 return;
6886 if (foamTag(var)((var)->hdr.tag) == FOAM_Loc)
6887 vpFreeVar(gen0State->localPool, (int) var->foamLoc.index);
6888 else
6889 vpFreeVar(gen0State->lexPool, (int) var->foamLex.index);
6890}
6891
6892/*
6893 * Create a local temporary variable.
6894 */
6895
6896Foam
6897gen0TempFrTForm(TForm tf, Bool isLocal)
6898{
6899/* FoamTag type = gen0Type(tf, NULL);*/
6900
6901 return NULL((void*)0);
6902}
6903
6904Foam
6905gen0TempLocal0(int type, int fmt)
6906{
6907 int i;
6908 gen0State->hasTemps = true1;
6909 i = vpNewVar0(gen0State->localPool, type, fmt);
6910 return foamNewLoc(i)foamNew(FOAM_Loc, 1, (AInt)(i));
6911}
6912
6913Foam
6914gen0TempFrDDecl(AInt id, Bool isLocal)
6915{
6916 Foam ddecl, vals;
6917 Length i;
6918
6919 ddecl = gen0GetRealFormat(gen0FindFormat(id));
6920 vals = foamNewEmpty(FOAM_Values, foamDDeclArgc(ddecl)(((ddecl)->hdr.argc) - (1)));
6921 for (i = 0; i < foamDDeclArgc(ddecl)(((ddecl)->hdr.argc) - (1)); i += 1) {
6922 FoamTag type = ddecl->foamDDecl.argv[i]->foamDecl.type;
6923 vals->foamValues.argv[i] =
6924 isLocal ? gen0TempLocal(type)gen0TempLocal0(type, 4) : gen0Temp(type)gen0Temp0(type, 4);
6925 }
6926 return vals;
6927}
6928
6929/*
6930 * Create a local temporary variable.
6931 */
6932Foam
6933gen0TempLex0(int type, int fmt)
6934{
6935 int i;
6936
6937 gen0State->hasTemps = true1;
6938 i = vpNewVar0(gen0State->lexPool, type, fmt);
6939 /* Over-defensive, but saves hassle */
6940 gen0UseStackedFormat(int0((int) 0));
6941 /* since env vars are created this way, we should be OK */
6942 if ( listIsSingleton(gen0State->envFormatStack)((gen0State->envFormatStack) && !((gen0State->envFormatStack
)->rest))
)
6943 return foamNewLex(int0, i)foamNew(FOAM_Lex, 2, (AInt)(((int) 0)), (AInt)(i));
6944 else
6945 return foamNewEElt(car(gen0State->envFormatStack),foamNew(FOAM_EElt,4,(AInt)(((gen0State->envFormatStack)->
first)),foamCopy(((gen0State->envVarStack)->first)),(AInt
)(((int) 0)),(AInt)(i))
6946 foamCopy(car(gen0State->envVarStack)),foamNew(FOAM_EElt,4,(AInt)(((gen0State->envFormatStack)->
first)),foamCopy(((gen0State->envVarStack)->first)),(AInt
)(((int) 0)),(AInt)(i))
6947 int0, i)foamNew(FOAM_EElt,4,(AInt)(((gen0State->envFormatStack)->
first)),foamCopy(((gen0State->envVarStack)->first)),(AInt
)(((int) 0)),(AInt)(i))
;
6948}
6949
6950Foam
6951gen0TempLexNth(int type, int wn)
6952{
6953 VarPool vp;
6954 int i;
6955
6956 if (wn == 0)
6957 vp = gen0State->lexPool;
6958 else
6959 vp = listElt(VarPool)(VarPool_listPointer->Elt)(gen0State->envLexPools, wn - 1);
6960
6961 i = vpNewVar(vp, type)vpNewVar0((vp), (type), (4));
6962
6963 return gen0NewLex(wn, i);
6964}
6965
6966/* Called when potentially in where clause, and level is 0 */
6967Foam
6968gen0NewLex(int idx, int offset)
6969{
6970 Foam foam;
6971
6972 if (gen0State->whereNest && idx != gen0State->whereNest) {
6973 AInt fmt = listElt(AInt)(AInt_listPointer->Elt)(gen0State->envFormatStack, idx);
6974 Foam var = listElt(Foam)(Foam_listPointer->Elt)(gen0State->envVarStack, idx);
6975 foam = foamNewEElt(fmt, foamCopy(var), int0, offset)foamNew(FOAM_EElt,4,(AInt)(fmt),foamCopy(var),(AInt)(((int) 0
)),(AInt)(offset))
;
6976 }
6977 else
6978 foam = foamNewLex(int0, offset)foamNew(FOAM_Lex, 2, (AInt)(((int) 0)), (AInt)(offset));
6979
6980 return foam;
6981}
6982
6983/*****************************************************************************
6984 *
6985 * :: Collect statements
6986 *
6987 ****************************************************************************/
6988/*
6989 * Generate a generator for a collect form.
6990 * E for a in b... ==> generate for a in b... repeat yield E
6991 *
6992 * (GCompose La.if T(a) then One(Ea) else [])
6993 */
6994localstatic Foam
6995genCollect(AbSyn absyn)
6996{
6997 AbSyn iter, body, repeat;
6998 int i;
6999
7000 body = abNewYield(abPos(absyn), absyn->abCollect.body)abNew(AB_Yield, (spstackFirst((absyn)->abHdr.pos)),1, absyn
->abCollect.body)
;
7001
7002 repeat = abNewEmpty(AB_Repeat, abArgc(absyn)((absyn)->abHdr.argc));
7003 abSetStab(repeat, abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
);
7004 repeat->abRepeat.body = body;
7005 for(i=1; i< abArgc(absyn)((absyn)->abHdr.argc); i++)
7006 abArgv(repeat)((repeat)->abGen.data.argv)[i] = abArgv(absyn)((absyn)->abGen.data.argv)[i];
7007
7008 if (tfIsXGenerator(abTUnique(absyn))(((((absyn)->abHdr.type.unique))->tag) == TF_XGenerator
)
) {
7009 iter = abNewXGenerate(abPos(absyn), abNewNothing(sposNone), repeat)abNewMod(AB_Generate, (spstackFirst((absyn)->abHdr.pos)),1
,2, abNew(AB_Nothing, sposNone,0 ),repeat)
;
7010 }
7011 else {
7012 iter = abNewGenerate(abPos(absyn), abNewNothing(sposNone), repeat)abNew(AB_Generate, (spstackFirst((absyn)->abHdr.pos)),2, abNew
(AB_Nothing, sposNone,0 ),repeat)
;
7013 }
7014 abSetStab(iter, abStab(absyn)((absyn)->abHdr.seman ? (absyn)->abHdr.seman->stab :
0)
);
7015
7016 abTUnique(body)((body)->abHdr.type.unique) = tfExit;
7017 abTUnique(repeat)((repeat)->abHdr.type.unique) = tfNone()tfMulti(0);
7018 abTUnique(iter)((iter)->abHdr.type.unique) = gen0AbType(absyn);
7019
7020 abState(body)((body)->abHdr.state) = AB_State_HasUnique;
7021 abState(repeat)((repeat)->abHdr.state) = AB_State_HasUnique;
7022 abState(iter)((iter)->abHdr.state) = AB_State_HasUnique;
7023
7024 return genFoam(iter);
7025}
7026
7027/*
7028 * Bump the lexical level numbers for a body of a generator function.
7029 */
7030
7031void
7032gen0IncLexLevels(Foam foam, AInt inc)
7033{
7034 FoamTag tag = foamTag (foam)((foam)->hdr.tag);
7035
7036 assert(foam)do { if (!(foam)) _do_assert(("foam"),"genfoam.c",7036); } while
(0)
;
7037
7038 foamIter(foam, arg, gen0IncLexLevels(*arg, inc)){ { 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 *arg = (Foam *) ((foam)->foamGen.argv
)+_i; { gen0IncLexLevels(*arg, inc); }; } } }; }
;
7039
7040 switch (tag) {
7041 case FOAM_Lex:
7042 foam->foamLex.level += inc;
7043 break;
7044 case FOAM_Env:
7045 foam->foamEnv.level += inc;
7046 break;
7047 default:
7048 break;
7049 }
7050
7051}
7052
7053void
7054gen0AddLexLevels(Foam foam, int dist)
7055{
7056 if (gen0State->whereNest==0)
7057 gen0IncLexLevels(foam, dist);
7058 else {
7059 gen0AddLexLevels1(foam, dist, gen0State->whereNest,
7060 gen0State->envVarStack);
7061 }
7062}
7063
7064localstatic void
7065gen0AddLexLevels1(Foam foam, AInt dist, int wN, FoamList envStack)
7066{
7067 switch (foamTag(foam)((foam)->hdr.tag)) {
7068 case FOAM_Lex:
7069 if (foam->foamLex.level < 0)
7070 foam->foamLex.level+=dist;
7071 else
7072 foam->foamLex.level+=dist+wN;
7073 break;
7074 case FOAM_Env:
7075 if (foam->foamEnv.level < 0)
7076 foam->foamEnv.level+=dist;
7077 else
7078 foam->foamEnv.level+=dist+wN;
7079 break;
7080 /* !Warning: Changes the type of a node... */
7081 case FOAM_EElt: { int pos;
7082 listFind(Foam)(Foam_listPointer->Find)(envStack, foam->foamEElt.ref, foamEqual, &pos);
7083 if (pos == -1)
7084 gen0AddLexLevels1(foam->foamEElt.ref,
7085 dist, wN, envStack);
7086 else {
7087 int off = foam->foamEElt.lex;
7088
7089 foam->hdr.tag = FOAM_Lex;
7090 foam->hdr.argc = 2;
7091 foam->foamLex.level = pos+dist;
7092 foam->foamLex.index = off;
7093 }
7094 break;
7095 }
7096 default:
7097 foamIter(foam, arg,{ { 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 *arg = (Foam *) ((foam)->foamGen.argv
)+_i; { gen0AddLexLevels1(*arg, dist, wN, envStack); }; } } }
; }
7098 gen0AddLexLevels1(*arg, dist, wN, envStack)){ { 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 *arg = (Foam *) ((foam)->foamGen.argv
)+_i; { gen0AddLexLevels1(*arg, dist, wN, envStack); }; } } }
; }
;
7099 }
7100}
7101
7102/*
7103 * Replace format number place holders with the real format numbers.
7104 */
7105localstatic void
7106gen0PatchFormatNums(Foam prog)
7107{
7108 Foam levels = prog->foamProg.levels;
7109 Length i;
7110
7111 if (foamTag(prog)((prog)->hdr.tag) != FOAM_Prog)
7112 return;
7113
7114 for (i = 0; i < foamArgc(levels)((levels)->hdr.argc); i += 1) {
7115 AInt nindex = gen0FindFormat(levels->foamDEnv.argv[i]);
7116 if (nindex >= 0) levels->foamDEnv.argv[i] = nindex;
7117 }
7118
7119 gen0PatchEEltFormats(prog);
7120}
7121
7122localstatic void
7123gen0PatchEEltFormats(Foam foam)
7124{
7125 assert(foam)do { if (!(foam)) _do_assert(("foam"),"genfoam.c",7125); } while
(0)
;
7126
7127 foamIter(foam, arg, gen0PatchEEltFormats(*arg)){ { 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 *arg = (Foam *) ((foam)->foamGen.argv
)+_i; { gen0PatchEEltFormats(*arg); }; } } }; }
;
7128
7129 if (foamTag(foam)((foam)->hdr.tag) == FOAM_EElt) {
7130 AInt nindex = gen0FindFormat(foam->foamEElt.env);
7131 if (nindex >= 0) foam->foamEElt.env = nindex;
7132 }
7133 if (foamTag(foam)((foam)->hdr.tag) == FOAM_Const && foam->foamConst.index > gen0NumProgs)
7134 foam->foamConst.index = gen0FindConst(foam->foamConst.index);
7135}
7136
7137void
7138gen0AddFormat(AInt index, AInt nindex)
7139{
7140 formatPlaceList = listCons(AInt)(AInt_listPointer->Cons)(index, formatPlaceList);
7141 formatRealList = listCons(AInt)(AInt_listPointer->Cons)(nindex, formatRealList);
7142}
7143
7144localstatic AInt
7145gen0FindFormat(AInt index)
7146{
7147 Length pos;
7148
7149 if (index >= 0)
7150 return index;
7151
7152 pos = listPosq(AInt)(AInt_listPointer->Posq)(formatPlaceList, index);
7153 if (pos == -1)
7154 return index;
7155
7156 return listElt(AInt)(AInt_listPointer->Elt)(formatRealList, pos);
7157}
7158
7159void
7160gen0AddConst(AInt old, AInt new)
7161{
7162 gen0ConstList = listCons(AInt)(AInt_listPointer->Cons)(old, gen0ConstList);
7163 gen0RealConstList = listCons(AInt)(AInt_listPointer->Cons)(new, gen0RealConstList);
7164}
7165
7166localstatic AInt
7167gen0FindConst(AInt old)
7168{
7169 Length pos;
7170
7171 pos = listPosq(AInt)(AInt_listPointer->Posq)(gen0ConstList, old);
7172 assert(pos != -1)do { if (!(pos != -1)) _do_assert(("pos != -1"),"genfoam.c",7172
); } while (0)
;
7173
7174 return listElt(AInt)(AInt_listPointer->Elt)(gen0RealConstList, pos);
7175}
7176
7177/*
7178 * Functions manipulating the state of code generation for a single lambda.
7179 */
7180GenFoamState
7181gen0NewState(Stab stab, int format, GenFoamTag tag)
7182{
7183 GenFoamState s = (GenFoamState) stoAlloc(OB_Other0,
7184 sizeof(struct gfs));
7185
7186 s->tag = tag;
7187 s->stabLevel = (stab ? stabLevelNo(stab)(((stab)->first)->lexicalLevel) : -1);
7188 s->foamLevel = (gen0State ? gen0State->foamLevel + 1 : 0);
7189 s->stab = stab;
7190 s->localPool = vpNew(fboxNew(foamNewEmptyDDecl(FOAM_DDecl_Local)foamNew(FOAM_DDecl, 1, (AInt) FOAM_DDecl_Local)));
7191 s->lexPool = vpNew(fboxNew(foamNewEmptyDDecl(FOAM_DDecl_LocalEnv)foamNew(FOAM_DDecl, 1, (AInt) FOAM_DDecl_LocalEnv)));
7192 s->envLexPools = listNil(VarPool)((VarPoolList) 0);
7193 s->params = fboxNew(foamNewEmptyDDecl(FOAM_DDecl_Param)foamNew(FOAM_DDecl, 1, (AInt) FOAM_DDecl_Param));
7194 s->formatStack = listNil(AInt)((AIntList) 0);
7195 s->formatUsage = listNil(SlotUsage)((SlotUsageList) 0);
7196 s->fluidsUsed = listNil(AInt)((AIntList) 0);
7197 s->program = NULL((void*)0);
7198 s->yieldCount = 0;
7199 s->progType = PT_Std;
7200 s->labelNo = 0;
7201 s->yieldLabels = listNil(AInt)((AIntList) 0);
7202 s->yieldPlace = 0;
7203 s->yieldValueVar = NULL((void*)0);
7204 s->lines = listNil(Foam)((FoamList) 0);
7205 s->inits = listNil(Foam)((FoamList) 0);
7206 s->importPlace = NULL((void*)0);
7207 s->importPlacePrev = NULL((void*)0);
7208 s->funImportList = listNil(Syme)((SymeList) 0);
7209 s->domImportList = listNil(TForm)((TFormList) 0);
7210 s->domList = listNil(Foam)((FoamList) 0);
7211 s->hasTemps = false((int) 0);
7212 s->envVarStack = listCons(Foam)(Foam_listPointer->Cons)(foamNewEnv(int0)foamNew(FOAM_Env, 1, (AInt)(((int) 0))), listNil(Foam)((FoamList) 0));
7213 s->envFormatStack= listCons(AInt)(AInt_listPointer->Cons)(format, listNil(AInt)((AIntList) 0));
7214 s->whereNest = 0;
7215 s->type = NULL((void*)0);
7216 s->param = NULL((void*)0);
7217 s->exporter = NULL((void*)0);
7218 s->parent = gen0State;
7219 s->base = NULL((void*)0);
7220 s->domCache = listNil(DomainCache)((DomainCacheList) 0);
7221 s->dbgContext = (Foam)NULL((void*)0);
7222 return s;
7223}
7224
7225localstatic void
7226gen0InitState(Stab stab, int index)
7227{
7228 GenFoamState s = gen0NewState(stab, index, GF_File);
7229
7230 s->formatUsage = listCons(SlotUsage)(SlotUsage_listPointer->Cons)(suFrFormat(emptyFormatSlot)(((4) << 2) | 2), listNil(SlotUsage)((SlotUsageList) 0));
7231 s->formatStack = listCons(AInt)(AInt_listPointer->Cons)(index, listNil(AInt)((AIntList) 0));
7232
7233 gen0State = s;
7234}
7235
7236GenFoamState
7237gen0NthState(AInt n)
7238{
7239 GenFoamState s = gen0State, prev=0;
7240
7241 n+=s->whereNest;
7242 while(n > 0) {
7243 assert(s != 0)do { if (!(s != 0)) _do_assert(("s != 0"),"genfoam.c",7243); }
while (0)
;
7244 n -= s->whereNest;
7245 prev=s;
7246 s = s->parent;
7247 n -= 1;
7248 }
7249 if (n < 0 && prev->whereNest) return prev;
7250 assert(s != 0)do { if (!(s != 0)) _do_assert(("s != 0"),"genfoam.c",7250); }
while (0)
;
7251 return s;
7252}
7253
7254localstatic int
7255gen0StateOffset(int symeLevel, int foamLevel)
7256{
7257 GenFoamState s = gen0NthState(foamLevel);
7258 int idx;
7259
7260 idx = s->whereNest ? s->whereNest - (symeLevel - s->stabLevel) : 0;
7261 if (idx > s->whereNest) idx = s->whereNest;
7262 return idx;
7263}
7264
7265int
7266gen0AddGlobal(Foam decl)
7267{
7268 FoamList glst;
7269 AInt idx = 0;
7270 /* Merge identical globals */
7271 /* If we import something already exported, or export something
7272 already imported then make it an export */
7273 glst = gen0GlobalList;
7274 while (glst) {
7275 Foam odecl = car(glst)((glst)->first);
7276 if (odecl->foamGDecl.type == decl->foamGDecl.type
7277 && odecl->foamGDecl.format == decl->foamGDecl.format
7278 && odecl->foamGDecl.protocol == decl->foamGDecl.protocol
7279 && strEqual(odecl->foamGDecl.id, decl->foamGDecl.id)) {
7280 if (decl->foamGDecl.dir == FOAM_GDecl_Export)
7281 odecl->foamGDecl.dir = FOAM_GDecl_Export;
7282 foamFree(decl);
7283 return gen0NumGlobals - idx - 1;
7284 } else {
7285 glst = cdr(glst)((glst)->rest);
7286 idx++;
7287 }
7288 }
7289
7290 gen0GlobalList = listCons(Foam)(Foam_listPointer->Cons)(decl, gen0GlobalList);
7291 return gen0NumGlobals++;
7292}
7293
7294Foam
7295gen0GetGlobal(AInt n)
7296{
7297 assert (n < gen0NumGlobals)do { if (!(n < gen0NumGlobals)) _do_assert(("n < gen0NumGlobals"
),"genfoam.c",7297); } while (0)
;
7298 return listElt(Foam)(Foam_listPointer->Elt)(gen0GlobalList, gen0NumGlobals - (n+1));
7299}
7300
7301void
7302gen0PushFormat(int index)
7303{
7304 GenFoamState s = gen0State;
7305
7306 s->formatStack = listCons(AInt)(AInt_listPointer->Cons)(index, s->formatStack);
7307 s->formatUsage = gen0UnusedFormats(s->formatStack);
7308}
7309
7310int
7311gen0RootEnv()
7312{
7313 return gen0FoamLevel(1);
7314}
7315
7316/* genXXLevel fns wrong currently, but work in most common cases */
7317localstatic int
7318gen0FoamLevel(AInt level)
7319{
7320 GenFoamState s = gen0State;
7321 int i = 0, whereNest = -s->whereNest;
7322
7323 while (s) {
7324 /* Return value should only be fudged if we have a where,
7325 o/w runtime gets clobbered */
7326 whereNest+=s->whereNest;
7327 if (s->stab && gen0IsDomLevel(s->tag)((s->tag) >= GF_START_TYPE && (s->tag) <=
GF_END_TYPE)
&&
7328 s->stabLevel <= level)
7329 return i + (s->whereNest
7330 ? /*whereNest*/ - (level - s->stabLevel) : 0);
7331 if ((!s->parent || (s->stab && s->parent->stab && s->stabLevel
7332 != s->parent->stabLevel)) &&
7333 s->stabLevel <= level)
7334 return i + (s->whereNest
7335 ? /*whereNest*/ - (level - s->stabLevel) : 0);
7336
7337 s = s->parent;
7338 i++;
7339 i += s->whereNest;
7340 }
7341 bug("level " AINT_FMT"%ld" " not found\n", level);
7342 return 0;
7343}
7344
7345localstatic Bool
7346gen0IsLambdaLevel(GenFoamState s, AInt level)
7347{
7348 return s && s->tag == GF_Lambda &&
7349 s->stab && s->stabLevel <= level;
7350}
7351
7352int
7353gen0FoamImportLevel(AInt level)
7354{
7355 GenFoamState s = gen0State;
7356 int i = 0, whereNest = -s->whereNest;
7357
7358 while (s) {
7359 whereNest += s->whereNest;
7360 if (s->stab && gen0IsDomLevel(s->tag)((s->tag) >= GF_START_TYPE && (s->tag) <=
GF_END_TYPE)
&&
7361 s->stabLevel <= level)
7362 return i - (s->whereNest ? (level - s->stabLevel) : 0);
7363
7364 if ((! s->parent || (s->stab && s->parent->stab &&
7365 s->stabLevel != s->parent->stabLevel)) &&
7366 s->stabLevel <= level)
7367 return i - (s->whereNest ? (level - s->stabLevel) : 0);
7368
7369 if ((s->tag == GF_Default || s->tag == GF_DefaultCat)
7370 && gen0IsLambdaLevel(s->parent, level)) {
7371 return i;
7372 }
7373 if (s->tag == GF_Add1 &&
7374 gen0IsLambdaLevel(s->parent->parent, level)) {
7375 return i;
7376 }
7377
7378 s = s->parent;
7379 i++;
7380 i+= s->whereNest;
7381 }
7382 bug("level not found!");
7383 return 0;
7384}
7385
7386localstatic void
7387gen0UseStateFormat(GenFoamState s, AInt level)
7388{
7389 AIntList ls = s->formatStack;
7390 SlotUsageList lu = s->formatUsage;
7391 Bool used;
7392 while(level > 0) {
7393 assert(ls != 0)do { if (!(ls != 0)) _do_assert(("ls != 0"),"genfoam.c",7393)
; } while (0)
;
7394 assert(lu != 0)do { if (!(lu != 0)) _do_assert(("lu != 0"),"genfoam.c",7394)
; } while (0)
;
7395 ls = cdr(ls)((ls)->rest);
7396 lu = cdr(lu)((lu)->rest);
7397 level--;
7398 }
7399 assert(ls != 0)do { if (!(ls != 0)) _do_assert(("ls != 0"),"genfoam.c",7399)
; } while (0)
;
7400 assert(lu != 0)do { if (!(lu != 0)) _do_assert(("lu != 0"),"genfoam.c",7400)
; } while (0)
;
7401 used = suIsUsed(car(lu))( (((lu)->first)) & 1);
7402 car(lu)((lu)->first) = suFrFormat(car(ls))(((((ls)->first)) << 2) | 2);
7403 car(lu)((lu)->first) = suSetUse(car(lu))( (((lu)->first)) | 1);
7404}
7405
7406void
7407gen0UseStackedFormat(AInt level)
7408{
7409 gen0UseStateFormat(gen0State, level);
7410}
7411
7412localstatic void
7413gen0UseFormat(AInt level, int slot)
7414{
7415 SlotUsageList l = gen0State->formatUsage;
7416 while(level > 0) {
7417 assert(l != 0)do { if (!(l != 0)) _do_assert(("l != 0"),"genfoam.c",7417); }
while (0)
;
7418 l = cdr(l)((l)->rest);
7419 level -= 1;
7420 }
7421 assert(l != 0)do { if (!(l != 0)) _do_assert(("l != 0"),"genfoam.c",7421); }
while (0)
;
7422 car(l)((l)->first) = suFrFormat(slot)(((slot) << 2) | 2);
7423}
7424
7425localstatic Syme
7426gen0FindImportedSyme(Syme syme, AInt level, Bool add)
7427{
7428 GenFoamState s = gen0NthState(level);
7429 SymeList l = s->funImportList;
7430 Syme osyme = NULL((void*)0);
7431
7432 for (; !osyme && l; l = cdr(l)((l)->rest))
7433 if (symeEqual(syme, car(l)((l)->first)))
7434 osyme = car(l)((l)->first);
7435
7436 if (!osyme && add) {
7437 symeClrImportInit(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) &= ~(0x0008))
;
7438 s->funImportList = listCons(Syme)(Syme_listPointer->Cons)(syme, s->funImportList);
7439 }
7440
7441 return osyme;
7442}
7443
7444localstatic Bool
7445gen0GetImportedSyme(Syme syme, AInt level, Bool add)
7446{
7447 Syme osyme = gen0FindImportedSyme(syme, level, add);
7448
7449 if (osyme && osyme != syme) {
7450 gen0SetVarIndex(syme, gen0VarIndex(osyme))(symeSetFieldVal = ((AInt) (((((UShort) ((((((osyme)->kind
== SYME_Trigger ? libGetAllSymes((osyme)->lib) : ((void*)
0)), (osyme))->locmask) & (1 << (SYFI_VarIndex))
) ? ((osyme)->fieldv)[symeIndex(osyme,SYFI_VarIndex)] : (symeFieldInfo
[SYFI_VarIndex].def))) != (0x7FFF)) ? ((UShort) ((((((osyme)->
kind == SYME_Trigger ? libGetAllSymes((osyme)->lib) : ((void
*)0)), (osyme))->locmask) & (1 << (SYFI_VarIndex
))) ? ((osyme)->fieldv)[symeIndex(osyme,SYFI_VarIndex)] : (
symeFieldInfo[SYFI_VarIndex].def))) : ((UShort) ((((((symeOriginal
(osyme))->kind == SYME_Trigger ? libGetAllSymes((symeOriginal
(osyme))->lib) : ((void*)0)), (symeOriginal(osyme)))->locmask
) & (1 << (SYFI_VarIndex))) ? ((symeOriginal(osyme)
)->fieldv)[symeIndex(symeOriginal(osyme),SYFI_VarIndex)] :
(symeFieldInfo[SYFI_VarIndex].def)))))), (((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_VarIndex))) ?
(((syme)->fieldv)[symeIndex(syme,SYFI_VarIndex)] = (symeSetFieldVal
)) : !((syme)->full) && symeSetFieldVal == (symeFieldInfo
[SYFI_VarIndex].def) ? symeSetFieldVal : symeSetFieldFn(syme,
SYFI_VarIndex,symeSetFieldVal))
;
7451 gen0SetFoamKind(syme, gen0FoamKind(osyme)((((FoamTag) (SYFI_FoamKind < (8 * sizeof(int)) &&
!(((((osyme)->kind == SYME_Trigger ? libGetAllSymes((osyme
)->lib) : ((void*)0)), (osyme))->hasmask) & (1 <<
(SYFI_FoamKind))) ? (symeFieldInfo[SYFI_FoamKind].def) : (((
((osyme)->kind == SYME_Trigger ? libGetAllSymes((osyme)->
lib) : ((void*)0)), (osyme))->locmask) & (1 << (
SYFI_FoamKind))) ? ((((((osyme)->kind == SYME_Trigger ? libGetAllSymes
((osyme)->lib) : ((void*)0)), (osyme))->locmask) & (
1 << (SYFI_FoamKind))) ? ((osyme)->fieldv)[symeIndex
(osyme,SYFI_FoamKind)] : (symeFieldInfo[SYFI_FoamKind].def)) :
symeGetFieldFn(osyme,SYFI_FoamKind))) != FOAM_LIMIT) ? ((FoamTag
) (SYFI_FoamKind < (8 * sizeof(int)) && !(((((osyme
)->kind == SYME_Trigger ? libGetAllSymes((osyme)->lib) :
((void*)0)), (osyme))->hasmask) & (1 << (SYFI_FoamKind
))) ? (symeFieldInfo[SYFI_FoamKind].def) : (((((osyme)->kind
== SYME_Trigger ? libGetAllSymes((osyme)->lib) : ((void*)
0)), (osyme))->locmask) & (1 << (SYFI_FoamKind))
) ? ((((((osyme)->kind == SYME_Trigger ? libGetAllSymes((osyme
)->lib) : ((void*)0)), (osyme))->locmask) & (1 <<
(SYFI_FoamKind))) ? ((osyme)->fieldv)[symeIndex(osyme,SYFI_FoamKind
)] : (symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn(osyme
,SYFI_FoamKind))) : ((FoamTag) (SYFI_FoamKind < (8 * sizeof
(int)) && !(((((symeOriginal(osyme))->kind == SYME_Trigger
? libGetAllSymes((symeOriginal(osyme))->lib) : ((void*)0)
), (symeOriginal(osyme)))->hasmask) & (1 << (SYFI_FoamKind
))) ? (symeFieldInfo[SYFI_FoamKind].def) : (((((symeOriginal(
osyme))->kind == SYME_Trigger ? libGetAllSymes((symeOriginal
(osyme))->lib) : ((void*)0)), (symeOriginal(osyme)))->locmask
) & (1 << (SYFI_FoamKind))) ? ((((((symeOriginal(osyme
))->kind == SYME_Trigger ? libGetAllSymes((symeOriginal(osyme
))->lib) : ((void*)0)), (symeOriginal(osyme)))->locmask
) & (1 << (SYFI_FoamKind))) ? ((symeOriginal(osyme)
)->fieldv)[symeIndex(symeOriginal(osyme),SYFI_FoamKind)] :
(symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn(symeOriginal
(osyme),SYFI_FoamKind))))
);
7452 if (symeImportInit(osyme)(((((osyme)->kind == SYME_Trigger ? libGetAllSymes((osyme)
->lib) : ((void*)0)), (osyme))->bits) & (0x0008))
)
7453 symeSetImportInit(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) |= (0x0008))
;
7454 else
7455 symeClrImportInit(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) &= ~(0x0008))
;
7456 }
7457
7458 return osyme != NULL((void*)0);
7459}
7460
7461localstatic void
7462gen0SetImportedSyme(Syme syme, AInt level)
7463{
7464 Syme osyme = gen0FindImportedSyme(syme, level, false((int) 0));
7465
7466 assert(osyme)do { if (!(osyme)) _do_assert(("osyme"),"genfoam.c",7466); } while
(0)
;
7467 symeSetImportInit(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) |= (0x0008))
;
7468 symeSetImportInit(osyme)(((((osyme)->kind == SYME_Trigger ? libGetAllSymes((osyme)
->lib) : ((void*)0)), (osyme))->bits) |= (0x0008))
;
7469}
7470
7471
7472Bool
7473genIsConst(Syme syme)
7474{
7475 return syme && !symeHasDefault(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) & (0x0080))
;
7476}
7477
7478Bool
7479genIsLocalConst(Syme syme)
7480{
7481 return syme && !symeHasDefault(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->bits) & (0x0080))
&& symeIsLocalConst(syme)(symeConstLib(syme) == ((void*)0));
7482}
7483
7484Bool
7485genIsVar(Foam foam)
7486{
7487 switch (foamTag(foam)((foam)->hdr.tag)) {
7488 case FOAM_Par:
7489 case FOAM_Loc:
7490 case FOAM_Glo:
7491 case FOAM_Lex:
7492 case FOAM_RElt:
7493 case FOAM_RRElt:
7494 case FOAM_IRElt:
7495 case FOAM_TRElt:
7496 case FOAM_EElt:
7497 return 1;
7498 default:
7499 return 0;
7500 }
7501}
7502
7503
7504String
7505gen0GlobalName(String libname, Syme syme)
7506{
7507 Syme ext0 = symeExtension(syme);
7508 String g;
7509
7510 symeSetExtension(syme, NULL)symeXSetExtension(syme, (AInt) ((void*)0));
7511 if (genIsRuntime()(gen0IsRuntime) && !symeIsImport(syme)(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->kind) == SYME_Import)
)
7512 g = strCopy(symeString(syme)((((syme)->id))->str));
7513 else {
7514 Hash h = gen0SymeTypeCode(syme);
7515 g = strPrintf("%s_%s_%09d", libname, symeString(syme)((((syme)->id))->str), h);
7516 }
7517 symeSetExtension(syme, ext0)symeXSetExtension(syme, (AInt) ext0);
7518
7519 return g;
7520}
7521
7522/* Reverse of above */
7523void
7524genGlobalInfo(Foam glo, String *pname, String *porig, int *phash)
7525{
7526 String name = glo->foamDecl.id;
7527 String nameStart, nameEnd;
7528
7529 *porig = strCopy("");
7530 *pname = name;
7531 *phash = 0;
7532
7533 if (glo->foamGDecl.protocol != FOAM_Proto_Foam)
7534 return;
7535
7536 nameStart = strchr(name, '_');
7537
7538 if (!nameStart)
7539 return;
7540
7541 nameStart++;
7542 nameEnd = strrchr(nameStart, '_');
7543 assert(nameEnd)do { if (!(nameEnd)) _do_assert(("nameEnd"),"genfoam.c",7543)
; } while (0)
;
7544
7545 *porig = strnCopy(name, nameStart - name - 1);
7546 *pname = strnCopy(nameStart, nameEnd - nameStart);
7547 *phash = atoi(nameEnd+1);
7548}
7549
7550
7551/* Try to compute the side effect bit correctly . */
7552void
7553gen0ComputeSideEffects(Foam prog)
7554{
7555 /*!! Needs beefing up */
7556 Foam body = prog->foamProg.body;
7557 Foam last;
7558 if (foamArgc(body)((body)->hdr.argc) == 0) {
7559 foamProgUnsetSide(prog)((prog)->foamProg.infoBits &= ~(1 << 0));
7560 return;
7561 }
7562 if (foamArgc(body)((body)->hdr.argc) > 1) { /*!!*/
7563 foamProgSetSide(prog)((prog)->foamProg.infoBits |= (1 << 0));
7564 return;
7565 }
7566 last = body->foamSeq.argv[foamArgc(body)((body)->hdr.argc)-1];
7567 if (foamTag(last)((last)->hdr.tag) != FOAM_Return) {
7568 foamProgSetSide(prog)((prog)->foamProg.infoBits |= (1 << 0));
7569 return;
7570 }
7571 last = last->foamReturn.value;
7572 if (foamTag(last)((last)->hdr.tag) != FOAM_BCall) {
7573 foamProgSetSide(prog)((prog)->foamProg.infoBits |= (1 << 0));
7574 return;
7575 }
7576 if (foamBValInfo(last->foamBCall.op)(foamBValInfoTable[(int)(last->foamBCall.op)-(int)FOAM_BVAL_START
])
.hasSideFx)
7577 foamProgSetSide(prog)((prog)->foamProg.infoBits |= (1 << 0));
7578 else
7579 foamProgUnsetSide(prog)((prog)->foamProg.infoBits &= ~(1 << 0));
7580 return;
7581}
7582
7583/*
7584 * Returns true if foam can evaluated multiple times w/o a call.
7585 */
7586localstatic Bool
7587gen0IsMultiEvaluable(Foam foam)
7588{
7589 if (foamTag(foam)((foam)->hdr.tag) == FOAM_Cast)
7590 return gen0IsMultiEvaluable(foam->foamCast.expr);
7591 return foamIsRef(foam) || foamTag(foam)((foam)->hdr.tag) < FOAM_DATA_LIMIT;
7592}
7593
7594localstatic Foam
7595gen0Embed(Foam val, AbSyn ab, TForm tf, AbEmbed embed)
7596{
7597 /* Deal with delta-equality of cross/multis */
7598 tf = tfDefineeMaybeType(tf);
7599
7600 switch (embed) {
7601 case AB_Embed_Identity(((AbEmbed) 1) << 0):
7602 return val;
7603 case AB_Embed_CrossToTuple(((AbEmbed) 1) << 1):
7604 return gen0CrossToTuple(val, tf);
7605 case AB_Embed_CrossToMulti(((AbEmbed) 1) << 2):
7606 return gen0CrossToMulti(val, tf);
7607 case AB_Embed_CrossToUnary(((AbEmbed) 1) << 3):
7608 return gen0CrossToUnary(val, tf);
7609 case AB_Embed_MultiToTuple(((AbEmbed) 1) << 4):
7610 return gen0MultiToTuple(val);
7611 case AB_Embed_MultiToCross(((AbEmbed) 1) << 5):
7612 return gen0MultiToCross(val, tf);
7613 case AB_Embed_MultiToUnary(((AbEmbed) 1) << 6):
7614 return gen0MultiToUnary(val);
7615 case AB_Embed_UnaryToTuple(((AbEmbed) 1) << 7):
7616 return gen0UnaryToTuple(val);
7617 case AB_Embed_UnaryToCross(((AbEmbed) 1) << 8):
7618 return gen0UnaryToCross(val, tf);
7619 case AB_Embed_UnaryToMulti(((AbEmbed) 1) << 9):
7620 return gen0UnaryToMulti(val);
7621 case AB_Embed_UnaryToRaw(((AbEmbed) 1) << 10):
7622 return gen0UnaryToRaw(val, ab);
7623 case AB_Embed_RawToUnary(((AbEmbed) 1) << 11):
7624 return gen0RawToUnary(val, ab);
7625 default:
7626 bugBadCase(embed)bug("Bad case %d (line %d in file %s).", (int) embed, 7626, "genfoam.c"
)
;
7627 NotReached(return val){(void)bug("Not supposed to reach line %d in file: %s\n",7627
, "genfoam.c");}
;
7628 }
7629}
7630
7631localstatic Foam
7632gen0CrossToMulti(Foam val, TForm tf)
7633{
7634 Foam values;
7635 Foam t;
7636 int i, size;
7637 AInt cfmt, ftype;
7638
7639 size = tfCrossArgc(tf);
7640 ftype = gen0Type(tf, &cfmt);
7641 cfmt = gen0CrossFormatNumber(tf);
7642 t = gen0TempLocal0(FOAM_Rec, cfmt);
7643 gen0SetTemp(t, foamNewCast(FOAM_Rec, val)foamNew(FOAM_Cast, 2, FOAM_Rec, val));
7644 values = foamNewEmpty(FOAM_Values, size);
7645 for (i = 0; i < size ; i++)
7646 values->foamValues.argv[i] = foamNewRElt(cfmt, foamCopy(t), i)foamNew(FOAM_RElt,3,(AInt)(cfmt),foamCopy(t),(AInt)(i));
7647
7648 foamFree(t);
7649 return values;
7650}
7651
7652localstatic Foam
7653gen0CrossToUnary(Foam val, TForm tf)
7654{
7655 AInt cfmt = gen0CrossFormatNumber(tf);
7656
7657 return foamNewRElt(cfmt, val, int0)foamNew(FOAM_RElt,3,(AInt)(cfmt),val,(AInt)(((int) 0)));
7658}
7659
7660localstatic Foam
7661gen0CrossToTuple(Foam val, TForm tf)
7662{
7663 Foam vars[2], tupl, elts, relt;
7664 AInt cfmt, ftype;
7665 Foam t;
7666 int i;
7667
7668 ftype = gen0Type(tf, &cfmt);
7669 cfmt = gen0CrossFormatNumber(tf);
7670 t = gen0TempLocal0(FOAM_Rec, cfmt);
7671
7672 gen0SetTemp(t, foamNewCast(FOAM_Rec, val)foamNew(FOAM_Cast, 2, FOAM_Rec, val));
7673 gen0MakeEmptyTuple(foamNewSInt(tfCrossArgc(tf))foamNew(FOAM_SInt, 1, (AInt)(tfCrossArgc(tf))), vars, NULL((void*)0));
7674 tupl = vars[0];
7675 elts = vars[1];
7676
7677 for (i=0; i < tfCrossArgc(tf); i++) {
7678 relt = foamNewRElt(cfmt, foamCopy(t), i)foamNew(FOAM_RElt,3,(AInt)(cfmt),foamCopy(t),(AInt)(i));
7679 gen0AddStmt(gen0ASet(elts, i, FOAM_Word, relt)foamNew(FOAM_Set, 2, foamNew(FOAM_AElt,3,(AInt)(FOAM_Word),foamNew
(FOAM_SInt, 1, (AInt)(i)),foamCopy(elts)), relt)
, NULL((void*)0));
7680 }
7681
7682 return tupl;
7683}
7684
7685localstatic Foam
7686gen0MultiToTuple(Foam val)
7687{
7688 Length i, argc = foamArgc(val)((val)->hdr.argc);
7689 Foam vars[2], tupl, elts, elt;
7690
7691 assert(foamTag(val) == FOAM_Values)do { if (!(((val)->hdr.tag) == FOAM_Values)) _do_assert(("foamTag(val) == FOAM_Values"
),"genfoam.c",7691); } while (0)
;
7692 gen0MakeEmptyTuple(foamNewSInt(argc)foamNew(FOAM_SInt, 1, (AInt)(argc)), vars, NULL((void*)0));
7693 tupl = vars[0];
7694 elts = vars[1];
7695
7696 for (i = 0; i < argc; i += 1) {
7697 elt = val->foamValues.argv[i];
7698 gen0AddStmt(gen0ASet(elts, (AInt) i, FOAM_Word, elt)foamNew(FOAM_Set, 2, foamNew(FOAM_AElt,3,(AInt)(FOAM_Word),foamNew
(FOAM_SInt, 1, (AInt)((AInt) i)),foamCopy(elts)), elt)
, NULL((void*)0));
7699 }
7700
7701 return tupl;
7702}
7703
7704localstatic Foam
7705gen0MultiToCross(Foam val, TForm tf)
7706{
7707 TForm ctf = tfCrossFrMulti(tf);
7708 Length i, argc = foamArgc(val)((val)->hdr.argc);
7709 AInt cfmt;
7710 Foam t;
7711 Foam elt;
7712
7713 assert(foamTag(val) == FOAM_Values)do { if (!(((val)->hdr.tag) == FOAM_Values)) _do_assert(("foamTag(val) == FOAM_Values"
),"genfoam.c",7713); } while (0)
;
7714
7715 cfmt = gen0CrossFormatNumber(ctf);
7716 t = gen0TempLocal0(FOAM_Rec, cfmt);
7717
7718 gen0SetTemp(t, foamNewRNew(cfmt)foamNew(FOAM_RNew, 1, cfmt));
7719
7720 for (i = 0; i < argc; i += 1) {
7721 elt = val->foamValues.argv[i];
7722 gen0AddStmt(foamNewSet(foamNewRElt(cfmt, foamCopy(t), i),foamNew(FOAM_Set, 2, foamNew(FOAM_RElt,3,(AInt)(cfmt),foamCopy
(t),(AInt)(i)), elt)
7723 elt)foamNew(FOAM_Set, 2, foamNew(FOAM_RElt,3,(AInt)(cfmt),foamCopy
(t),(AInt)(i)), elt)
, NULL((void*)0));
7724 }
7725
7726 return foamNewCast(FOAM_Word, t)foamNew(FOAM_Cast, 2, FOAM_Word, t);
7727}
7728
7729localstatic Foam
7730gen0MultiToUnary(Foam val)
7731{
7732 assert (foamTag(val) == FOAM_Values)do { if (!(((val)->hdr.tag) == FOAM_Values)) _do_assert(("foamTag(val) == FOAM_Values"
),"genfoam.c",7732); } while (0)
;
7733 assert (foamArgc(val) == 1)do { if (!(((val)->hdr.argc) == 1)) _do_assert(("foamArgc(val) == 1"
),"genfoam.c",7733); } while (0)
;
7734 return val->foamValues.argv[0];
7735}
7736
7737localstatic Foam
7738gen0UnaryToTuple(Foam val)
7739{
7740 Foam vars[2], tupl, elts;
7741 FoamTag type = gen0FoamType(val);
7742 if (type != FOAM_Word)
7743 val = foamNewCast(FOAM_Word, val)foamNew(FOAM_Cast, 2, FOAM_Word, val);
7744
7745 gen0MakeEmptyTuple(foamNewSInt(1)foamNew(FOAM_SInt, 1, (AInt)(1)), vars, NULL((void*)0));
7746 tupl = vars[0];
7747 elts = vars[1];
7748
7749 gen0AddStmt(gen0ASet(elts, (AInt) 0, FOAM_Word, val)foamNew(FOAM_Set, 2, foamNew(FOAM_AElt,3,(AInt)(FOAM_Word),foamNew
(FOAM_SInt, 1, (AInt)((AInt) 0)),foamCopy(elts)), val)
, NULL((void*)0));
7750 return tupl;
7751}
7752
7753localstatic Foam
7754gen0UnaryToMulti(Foam val)
7755{
7756 Foam values;
7757
7758 values = foamNewEmpty(FOAM_Values, 1);
7759 values->foamValues.argv[0] = val;
7760 return values;
7761}
7762
7763localstatic Foam
7764gen0UnaryToCross(Foam val, TForm tf)
7765{
7766 TForm ctf;
7767 AInt cfmt, ftype;
7768 Foam t;
7769
7770 ctf = tfCross(1, tf);
7771 ftype = gen0Type(tf, &cfmt);
7772 cfmt = gen0CrossFormatNumber(ctf);
7773 t = gen0TempLocal0(FOAM_Rec, cfmt);
7774
7775 gen0AddStmt(foamNewSet(foamCopy(t), foamNewRNew(cfmt))foamNew(FOAM_Set, 2, foamCopy(t), foamNew(FOAM_RNew, 1, cfmt)
)
, NULL((void*)0));
7776 gen0AddStmt(foamNewSet(foamNewRElt(cfmt, foamCopy(t), int0), val)foamNew(FOAM_Set, 2, foamNew(FOAM_RElt,3,(AInt)(cfmt),foamCopy
(t),(AInt)(((int) 0))), val)
, NULL((void*)0));
7777
7778 return foamNewCast(FOAM_Rec, t)foamNew(FOAM_Cast, 2, FOAM_Rec, t);
7779}
7780
7781
7782localstatic Foam
7783gen0UnaryToRaw(Foam val, AbSyn ab)
7784{
7785 AbSyn imp = abImplicit(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->implicit : 0
)
;
7786/* BDS: */
7787/* BDS: This is the bug for pack0.sh */
7788/* BDS: */
7789/* Orig FoamTag raw = gen0Type(gen0AbType(imp), NULL); */
7790 FoamTag raw = gen0Type(gen0AbType(imp), NULL((void*)0));
7791 Syme syme = abSyme(abApplyOp(imp))((((imp)->abApply.op))->abHdr.seman ? (((imp)->abApply
.op))->abHdr.seman->syme : 0)
;
7792 Foam foam, *argloc;
7793
7794/* printf("BDS: Inside gen0UnaryToRaw\n"); */
7795
7796 foam = gen0ApplySyme(raw, syme, abSymeImpl(abApplyOp(imp))((((imp)->abApply.op))->abHdr.seman ? (((imp)->abApply
.op))->abHdr.seman->impl : 0)
, 1, &argloc);
7797 /* BDS This foamPrint may cause a crash because argloc isn't initialized */
7798/* foamPrint(stdout,foam); */
7799
7800
7801/* BDS: */
7802/* BDS: This is the bug for pack0.sh */
7803/* BDS: */
7804/* argloc[0] = genFoamCast(val, ab, FOAM_Word); */
7805/* argloc[0] = genFoamCast(val, ab, raw); */
7806/* argloc[0] = genFoamCast(val, ab, raw); */
7807 /*
7808 * In its original form, this code was casting the value to a word
7809 * without considering its type. However, no cast should be
7810 * performed because it is raw's job to perform the conversion
7811 * to the raw data type.
7812 */
7813 argloc[0] = val;
7814
7815/*
7816 printf("BDS: About to finish in gen0UnaryToRaw\n");
7817 foamPrint(stdout,foam);
7818*/
7819
7820 return foam;
7821}
7822
7823localstatic Foam
7824gen0RawToUnary(Foam val, AbSyn ab)
7825{
7826 AbSyn imp = abImplicit(ab)((ab)->abHdr.seman ? (ab)->abHdr.seman->implicit : 0
)
;
7827 FoamTag raw = gen0Type(gen0AbType(abApplyArg(imp, int0)((imp)->abApply.argv[((int) 0)])), NULL((void*)0));
7828 Syme syme = abSyme(abApplyOp(imp))((((imp)->abApply.op))->abHdr.seman ? (((imp)->abApply
.op))->abHdr.seman->syme : 0)
;
7829 Foam foam, *argloc;
7830
7831/* printf("BDS: Inside gen0RawToUnary\n"); */
7832
7833 foam = gen0ApplySyme(FOAM_Word, syme, abSymeImpl(abApplyOp(imp))((((imp)->abApply.op))->abHdr.seman ? (((imp)->abApply
.op))->abHdr.seman->impl : 0)
,
7834 1, &argloc);
7835 argloc[0] = genFoamCast(val, ab, raw);
7836
7837/* printf("BDS: Done in gen0RawToUnary\n"); */
7838
7839 return foam;
7840}
7841
7842localstatic FoamTag
7843gen0FoamType(Foam foam)
7844{
7845 Foam decl;
7846 switch(foamTag(foam)((foam)->hdr.tag)) {
7847 case FOAM_Loc:
7848 decl = fboxNth(gen0State->localPool->fbox,
7849 (AInt) foam->foamLoc.index);
7850 break;
7851 case FOAM_Par:
7852 decl = fboxNth(gen0State->params, (int) foam->foamPar.index);
7853 break;
7854 case FOAM_Lex: {
7855 GenFoamState s = gen0NthState(foam->foamLex.level);
7856 decl = fboxNth(s->lexPool->fbox, (int) foam->foamLex.index);
7857 break; }
7858 case FOAM_Glo:
7859 decl = gen0GetGlobal(foam->foamGlo.index);
7860 break;
7861
7862 case FOAM_RRElt:
7863 return FOAM_Word;
7864
7865 case FOAM_RElt: {
7866 AInt fmt = foam->foamRElt.format;
7867 AInt slot = foam->foamRElt.field;
7868 Foam ddecl = gen0GetRealFormat(fmt);
7869
7870 assert(slot < foamArgc(ddecl))do { if (!(slot < ((ddecl)->hdr.argc))) _do_assert(("slot < foamArgc(ddecl)"
),"genfoam.c",7870); } while (0)
;
7871 return ddecl->foamDDecl.argv[slot]->foamDecl.type;
7872 }
7873
7874 case FOAM_IRElt: {
7875 AInt fmt = foam->foamIRElt.format;
7876 AInt slot = foam->foamIRElt.field;
7877 Foam ddecl = gen0GetRealFormat(fmt);
7878
7879 return foamTRDDeclIDecl(ddecl, slot)((ddecl)->foamDDecl.argv[1+(slot)])->foamDecl.type;
7880 }
7881
7882 case FOAM_TRElt: {
7883 AInt fmt = foam->foamTRElt.format;
7884 AInt slot = foam->foamTRElt.field;
7885 Foam ddecl = gen0GetRealFormat(fmt);
7886
7887 return foamTRDDeclTDecl(ddecl,slot)((ddecl)->foamDDecl.argv [1+ ((ddecl)->foamDDecl.argv[0
]->foamDecl.format) + (slot)])
->foamDecl.type;
7888 }
7889
7890 default:
7891 return foamExprType(foam, NULL((void*)0), NULL((void*)0), NULL((void*)0), NULL((void*)0), NULL((void*)0));
7892 }
7893 return decl->foamDecl.type;
7894}
7895
7896Foam
7897gen0BuiltinCCall(FoamTag type, String funName, String libName, Length argc, ...)
7898{
7899 va_list argp;
7900 Foam fn, call;
7901 AInt glNo;
7902 int i;
7903
7904 if (1/*strEqual(libName, "boot")*/) {
7905 va_list argp;
7906 Foam ccall;
7907 int i;
7908
7909 ccall = foamNewEmpty(FOAM_CCall, argc + 2);
7910 ccall->foamCCall.type = type;
7911 ccall->foamCCall.op = foamNewGlo(gen0BuiltinImport(funName, libName))foamNew(FOAM_Glo, 1, (AInt)(gen0BuiltinImport(funName, libName
)))
;
7912
7913 va_start(argp, argc)__builtin_va_start(argp, argc);
7914 for(i=0; i< argc; i++)
7915 ccall->foamCCall.argv[i] = va_arg(argp, Foam)__builtin_va_arg(argp, Foam);
7916 va_end(argp)__builtin_va_end(argp);
7917 return ccall;
7918 }
7919 glNo = gen0BuiltinImport(funName, libName);
7920 fn = gen0GetLazyBuiltin(libName, glNo, argc, 1);
7921 call = foamNew(FOAM_CCall, argc + 2);
7922 call->foamCCall.type = FOAM_Word;
7923 call->foamCCall.op = fn;
7924
7925 va_start(argp, argc)__builtin_va_start(argp, argc);
7926 for (i=0; i<argc ; i++) {
7927 call->foamCCall.argv[i] = va_arg(argp, Foam)__builtin_va_arg(argp, Foam);
7928 }
7929
7930 return foamNewCast(type, call)foamNew(FOAM_Cast, 2, type, call);
7931}
7932
7933Foam
7934gen0LazyBuiltinCCall(String funName, String libName,
7935 Length nOutArgs, Length argc, ...)
7936{
7937 va_list argp;
7938 Foam fn, call;
7939 AInt glNo;
7940 int i;
7941
7942 glNo = gen0BuiltinImport(funName, libName);
7943 fn = gen0GetLazyBuiltin(libName, glNo, argc, nOutArgs);
7944 call = foamNew(FOAM_CCall, argc + 2);
7945 call->foamCCall.type = (nOutArgs == 1) ? FOAM_Word : FOAM_NOp;
7946 call->foamCCall.op = fn;
7947
7948 va_start(argp, argc)__builtin_va_start(argp, argc);
7949 for (i=0; i<argc ; i++) {
7950 call->foamCCall.argv[i] = va_arg(argp, Foam)__builtin_va_arg(argp, Foam);
7951 }
7952
7953 return call;
7954}
7955
7956localstatic AInt
7957gen0BuiltinImport(String fun, String lib)
7958{
7959 int i;
7960 FoamList l;
7961 Foam decl;
7962
7963 /*!! Possible conflicts with imported foreign function names */
7964 for(i=0, l = gen0GlobalList; l; i++, l = cdr(l)((l)->rest))
7965 if (strEqual(fun, car(l)((l)->first)->foamGDecl.id))
7966 return (AInt) (gen0NumGlobals - i - 1);
7967 decl = foamNewGDecl(FOAM_Clos, strCopy(fun), FOAM_Nil,foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy(fun), FOAM_Nil
,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Foam))
7968 emptyFormatSlot,foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy(fun), FOAM_Nil
,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Foam))
7969 FOAM_GDecl_Import, FOAM_Proto_Foam)foamNew(FOAM_GDecl,6,(AInt)(FOAM_Clos),strCopy(fun), FOAM_Nil
,4, (AInt)(FOAM_GDecl_Import),(AInt)(FOAM_Proto_Foam))
;
7970 assert(gen0GetRuntimeCallInfo(decl))do { if (!(gen0GetRuntimeCallInfo(decl))) _do_assert(("gen0GetRuntimeCallInfo(decl)"
),"genfoam.c",7970); } while (0)
;
7971 return (AInt) gen0AddGlobal(decl);
7972}
7973
7974localstatic void
7975gen0MakeBuiltinExports()
7976{
7977 AIntList l = listNReverse(AInt)(AInt_listPointer->NReverse)(gen0BuiltinExports);
7978
7979 while (l) {
7980 Foam def, val;
7981 int glId, progId;
7982 glId = car(l)((l)->first);
7983 progId = car(cdr(l))((((l)->rest))->first);
7984 l = cdr(cdr(l))((((l)->rest))->rest);
7985
7986 if (progId == 0)
7987 val = foamNewCast(FOAM_Clos, foamNewNil())foamNew(FOAM_Cast, 2, FOAM_Clos, foamNew(FOAM_Nil, (int) 0));
7988 else
7989 val = foamNewClos(foamNewEnv(int0), foamNewConst(progId))foamNew(FOAM_Clos,2, foamNew(FOAM_Env, 1, (AInt)(((int) 0))),
foamNew(FOAM_Const, 1, (AInt)(progId)))
;
7990 def = foamNewDef(foamNewGlo(glId), val)foamNew(FOAM_Def, 2, foamNew(FOAM_Glo, 1, (AInt)(glId)), val);
7991 gen0ProgList = listCons(Foam)(Foam_listPointer->Cons)(def, gen0ProgList);
7992
7993 gen0NumProgs++;
7994 }
7995}
7996
7997Bool
7998gen0IsCatDefForm(GenFoamState s)
7999{
8000 return (s->tag == GF_DefaultCat);
8001}
8002
8003Bool
8004gen0IsCatInner()
8005{
8006 GenFoamState s = gen0State;
8007
8008 while (s->tag != GF_File) {
8009 if (s->tag == GF_DefaultCat || s->tag == GF_Default)
8010 return true1;
8011 s = s->parent;
8012 }
8013
8014 return false((int) 0);
8015}
8016
8017localstatic AInt
8018gen0FindGlobalFluid(Syme syme)
8019{
8020 FoamList l = gen0FluidList;
8021 Foam new;
8022 int i=0;
8023 /* Should use syme equality... */
8024 while (l) {
8025 if (strEqual(car(l)((l)->first)->foamDecl.id, symeString(syme)((((syme)->id))->str)))
8026 return i;
8027 l = cdr(l)((l)->rest);
8028 i++;
8029 }
8030 new = foamNewDecl(gen0Type(symeType(syme), NULL), strCopy(symeString(syme)),foamNew(FOAM_Decl,4,(AInt)(gen0Type(symeType(syme), ((void*)0
))),strCopy(((((syme)->id))->str)), (AInt) (0x7FFF), 4)
8031 emptyFormatSlot)foamNew(FOAM_Decl,4,(AInt)(gen0Type(symeType(syme), ((void*)0
))),strCopy(((((syme)->id))->str)), (AInt) (0x7FFF), 4)
;
8032 gen0FluidList = listNConcat(Foam)(Foam_listPointer->NConcat)(gen0FluidList,
8033 listCons(Foam)(Foam_listPointer->Cons)(new, listNil(Foam)((FoamList) 0)));
8034 return i;
8035}
8036
8037localstatic void
8038gen0AddLocalFluid(AbSyn id)
8039{
8040 AIntList l = gen0State->fluidsUsed;
8041 Syme syme;
8042 String msg;
8043
8044 switch (abTag(id)((id)->abHdr.tag)) {
8045 case AB_Declare:
8046 id = id->abDeclare.id;
8047 break;
8048 case AB_Id:
8049 break;
8050 default:
8051 msg = "unexpected absyn in gen0AddLocalFluid";
8052 comsgFatal(id, ALDOR_F_Bug365, msg);
8053#if 0
8054 abWrSExpr(dbOut, id, SXRW_Default);
8055 bug("unexpected absyn in addFluid\n");
8056#endif
8057 }
8058 syme = abSyme(id)((id)->abHdr.seman ? (id)->abHdr.seman->syme : 0);
8059 if (listMemq(AInt)(AInt_listPointer->Memq)(l, gen0VarIndex(syme)((((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) != (0x7FFF
)) ? ((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) : ((UShort
) ((((((symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_VarIndex))) ? ((symeOriginal
(syme))->fieldv)[symeIndex(symeOriginal(syme),SYFI_VarIndex
)] : (symeFieldInfo[SYFI_VarIndex].def))))
)) return;
8060
8061 gen0State->fluidsUsed =
8062 listCons(AInt)(AInt_listPointer->Cons)(gen0VarIndex(syme)((((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) != (0x7FFF
)) ? ((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) : ((UShort
) ((((((symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_VarIndex))) ? ((symeOriginal
(syme))->fieldv)[symeIndex(symeOriginal(syme),SYFI_VarIndex
)] : (symeFieldInfo[SYFI_VarIndex].def))))
, gen0State->fluidsUsed);
8063 return;
8064}
8065
8066localstatic Foam
8067gen0BuiltinExporter(Foam glo, Syme syme)
8068{
8069 GenFoamState saved;
8070 TForm tf = symeType(syme);
8071 Foam foam, clos, call, result, tmp;
8072 FoamTag retType;
8073 int retFmt, i;
8074
8075 if (!tfIsMap(tf)(((tf)->tag) == TF_Map) || genIsRuntime()(gen0IsRuntime))
8076 return gen0Syme(syme);
8077
8078 retType = gen0Type(tfMapRet(tf)tfFollowArg(tf, 1), NULL((void*)0));
8079 retFmt = retType == FOAM_NOp ? gen0MultiFormatNumber(tfMapRet(tf)tfFollowArg(tf, 1)) : 0;
8080
8081 clos = gen0ProgClosEmpty();
8082 foam = gen0ProgInitEmpty(strCopy("builtinWrapper"), NULL((void*)0));
8083
8084 saved = gen0ProgSaveState(PT_ExFn);
8085
8086 for (i=0; i < tfMapArgc(tf); i++)
8087 gen0AddParam(foamNewDecl(gen0Type(tfMapArgN(tf, i), NULL),foamNew(FOAM_Decl,4,(AInt)(gen0Type(tfMapArgN(tf, i), ((void*
)0))),strCopy(""), (AInt) (0x7FFF), 4)
8088 strCopy(""),foamNew(FOAM_Decl,4,(AInt)(gen0Type(tfMapArgN(tf, i), ((void*
)0))),strCopy(""), (AInt) (0x7FFF), 4)
8089 emptyFormatSlot)foamNew(FOAM_Decl,4,(AInt)(gen0Type(tfMapArgN(tf, i), ((void*
)0))),strCopy(""), (AInt) (0x7FFF), 4)
);
8090
8091 gen0AddStmt(foamNew(FOAM_CCall, 2, FOAM_NOp,
8092 foamNewGlo(gloInitIdx)foamNew(FOAM_Glo, 1, (AInt)(gloInitIdx))), NULL((void*)0));
8093 call = foamNewEmpty(FOAM_CCall, 2 + tfMapArgc(tf));
8094 call->foamCCall.type = gen0Type(tfMapRet(tf)tfFollowArg(tf, 1), NULL((void*)0));
8095 call->foamCCall.op = foamCopy(glo);
8096
8097 for (i=0; i < tfMapArgc(tf); i++)
8098 call->foamCCall.argv[i] = foamNewPar(i)foamNew(FOAM_Par, 1, (AInt)(i));
8099
8100 if (tfMapRetc(tf) == 0) {
8101 gen0AddStmt(call, NULL((void*)0));
8102 result = foamNewEmpty(FOAM_Values, 0);
8103 }
8104 else if (retFmt == 0)
8105 result = call;
8106 else {
8107 tmp = gen0TempFrDDecl(retFmt, true1);
8108 gen0AddStmt(foamNewSet(tmp, foamNewMFmt(retFmt, call))foamNew(FOAM_Set, 2, tmp, foamNew(FOAM_MFmt, 2, retFmt, call)
)
, NULL((void*)0));
8109 result = foamCopy(tmp);
8110 }
8111
8112 gen0AddStmt(foamNewReturn(result)foamNew(FOAM_Return, 1, result), NULL((void*)0));
8113
8114 gen0ProgPushFormat(emptyFormatSlot4);
8115 gen0ProgFiniEmpty(foam, retType, int0((int) 0));
8116 gen0AddLexLevels(foam, 1);
8117 foam->foamProg.format = retFmt;
8118 foam->foamProg.levels = foamNew(FOAM_DEnv, 1, int0((int) 0));
8119 foamOptInfo(foam)((foam)->hdr.info.opt) = optInfoNew(NULL((void*)0), foam, NULL((void*)0), false((int) 0));
8120 gen0ProgRestoreState(saved);
8121
8122 return clos;
8123}
8124
8125
8126localstatic Foam
8127gen0ForeignValue(Syme syme)
8128{
8129 /* printf("BDS: Inside gen0ForeignValue\n"); */
8130
8131 return foamNew(gen0FoamKind(syme)((((FoamTag) (SYFI_FoamKind < (8 * sizeof(int)) &&
!(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->hasmask) & (1 <<
(SYFI_FoamKind))) ? (symeFieldInfo[SYFI_FoamKind].def) : (((
((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->
lib) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_FoamKind
))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes((
syme)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_FoamKind))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_FoamKind
)] : (symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn(syme
,SYFI_FoamKind))) != FOAM_LIMIT) ? ((FoamTag) (SYFI_FoamKind <
(8 * sizeof(int)) && !(((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
hasmask) & (1 << (SYFI_FoamKind))) ? (symeFieldInfo
[SYFI_FoamKind].def) : (((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_FoamKind))) ? ((((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_FoamKind))) ? ((syme)->fieldv
)[symeIndex(syme,SYFI_FoamKind)] : (symeFieldInfo[SYFI_FoamKind
].def)) : symeGetFieldFn(syme,SYFI_FoamKind))) : ((FoamTag) (
SYFI_FoamKind < (8 * sizeof(int)) && !(((((symeOriginal
(syme))->kind == SYME_Trigger ? libGetAllSymes((symeOriginal
(syme))->lib) : ((void*)0)), (symeOriginal(syme)))->hasmask
) & (1 << (SYFI_FoamKind))) ? (symeFieldInfo[SYFI_FoamKind
].def) : (((((symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_FoamKind))) ? ((((((
symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_FoamKind))) ? ((symeOriginal
(syme))->fieldv)[symeIndex(symeOriginal(syme),SYFI_FoamKind
)] : (symeFieldInfo[SYFI_FoamKind].def)) : symeGetFieldFn(symeOriginal
(syme),SYFI_FoamKind))))
, 1,
8132 (AInt) gen0VarIndex(syme)((((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) != (0x7FFF
)) ? ((UShort) ((((((syme)->kind == SYME_Trigger ? libGetAllSymes
((syme)->lib) : ((void*)0)), (syme))->locmask) & (1
<< (SYFI_VarIndex))) ? ((syme)->fieldv)[symeIndex(syme
,SYFI_VarIndex)] : (symeFieldInfo[SYFI_VarIndex].def))) : ((UShort
) ((((((symeOriginal(syme))->kind == SYME_Trigger ? libGetAllSymes
((symeOriginal(syme))->lib) : ((void*)0)), (symeOriginal(syme
)))->locmask) & (1 << (SYFI_VarIndex))) ? ((symeOriginal
(syme))->fieldv)[symeIndex(symeOriginal(syme),SYFI_VarIndex
)] : (symeFieldInfo[SYFI_VarIndex].def))))
);
8133}
8134
8135localstatic Foam
8136gen0ForeignWrapValue(Syme syme)
8137{
8138 /* printf("BDS: Inside gen0ForeignWrapValue\n"); */
8139
8140 if (symeClosure(syme)((Foam) (SYFI_Closure < (8 * sizeof(int)) && !((((
(syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->hasmask) & (1 << (SYFI_Closure
))) ? (symeFieldInfo[SYFI_Closure].def) : (((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_Closure))) ?
((((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_Closure))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_Closure
)] : (symeFieldInfo[SYFI_Closure].def)) : symeGetFieldFn(syme
,SYFI_Closure)))
)
8141 return foamCopy(symeClosure(syme)((Foam) (SYFI_Closure < (8 * sizeof(int)) && !((((
(syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->hasmask) & (1 << (SYFI_Closure
))) ? (symeFieldInfo[SYFI_Closure].def) : (((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_Closure))) ?
((((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_Closure))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_Closure
)] : (symeFieldInfo[SYFI_Closure].def)) : symeGetFieldFn(syme
,SYFI_Closure)))
);
8142 else
8143 return gen0ForeignWrapFn(syme);
8144}
8145
8146localstatic Foam
8147gen0ForeignWrapFn(Syme syme)
8148{
8149 Scope("gen0ForeignWrapFn")String scopeName = ("gen0ForeignWrapFn"); int fluidLevel0 = (
scopeLevel++, fluidLevel)
;
8150 GenFoamState saved;
8151 TForm tf = symeType(syme);
8152 Foam foam, clos, call;
8153 FoamTag retType;
8154 int retFmt = 0;
8155 int i;
8156 Bool fluid(gen0ValueMode)fluidSave_gen0ValueMode = ( fluidStack = (fluidLevel==fluidLimit
) ? fluidGrow() : fluidStack, fluidStack[fluidLevel].scopeName
= scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel,
fluidStack[fluidLevel].pglobal = (Pointer) &(gen0ValueMode
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_gen0ValueMode
, fluidStack[fluidLevel].size = sizeof(gen0ValueMode), fluidLevel
++, (gen0ValueMode) )
;
8157 FoamList fluid(gen0FortranActualArgTmps)fluidSave_gen0FortranActualArgTmps = ( fluidStack = (fluidLevel
==fluidLimit) ? fluidGrow() : fluidStack, fluidStack[fluidLevel
].scopeName = scopeName, fluidStack[fluidLevel].scopeLevel = scopeLevel
, fluidStack[fluidLevel].pglobal = (Pointer) &(gen0FortranActualArgTmps
), fluidStack[fluidLevel].pstack = (Pointer) &fluidSave_gen0FortranActualArgTmps
, fluidStack[fluidLevel].size = sizeof(gen0FortranActualArgTmps
), fluidLevel++, (gen0FortranActualArgTmps) )
;
8158
8159 retType = gen0Type(tfMapRet(tf)tfFollowArg(tf, 1), NULL((void*)0));
8160
8161 gen0ValueMode = !tfIsNone(tfMapRet(tf))((((tfFollowArg(tf, 1))->tag) == TF_Multiple) && tfMultiArgc
(tfFollowArg(tf, 1)) == 0)
;
8162
8163 if (gen0ValueMode && (retType == FOAM_NOp))
8164 retFmt = gen0MultiFormatNumber(tfMapRet(tf)tfFollowArg(tf, 1));
8165
8166 clos = gen0ProgClosEmpty();
8167 foam = gen0ProgInitEmpty(strCopy("foreignWrapper"), NULL((void*)0));
8168
8169 saved = gen0ProgSaveState(PT_ExFn);
8170
8171 for (i=0; i < tfMapArgc(tf); i++)
8172 gen0AddParam(foamNewDecl(gen0Type(tfMapArgN(tf, i), NULL),foamNew(FOAM_Decl,4,(AInt)(gen0Type(tfMapArgN(tf, i), ((void*
)0))),strCopy(""), (AInt) (0x7FFF), 4)
8173 strCopy(""),foamNew(FOAM_Decl,4,(AInt)(gen0Type(tfMapArgN(tf, i), ((void*
)0))),strCopy(""), (AInt) (0x7FFF), 4)
8174 emptyFormatSlot)foamNew(FOAM_Decl,4,(AInt)(gen0Type(tfMapArgN(tf, i), ((void*
)0))),strCopy(""), (AInt) (0x7FFF), 4)
);
8175
8176 call = foamNewEmpty(FOAM_PCall,
8177 tfMapArgc(tf) + TypeSlot1 + OpSlot1 + ProtoSlot1);
8178 call->foamPCall.protocol = symeForeign(syme)((ForeignOrigin) (SYFI_Foreign < (8 * sizeof(int)) &&
!(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->hasmask) & (1 <<
(SYFI_Foreign))) ? (symeFieldInfo[SYFI_Foreign].def) : (((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_Foreign
))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes((
syme)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_Foreign))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_Foreign
)] : (symeFieldInfo[SYFI_Foreign].def)) : symeGetFieldFn(syme
,SYFI_Foreign)))
->protocol;
8179 call->foamPCall.type = retType;
8180 call->foamPCall.op = gen0ForeignValue(syme);
8181
8182 for (i=0; i < tfMapArgc(tf); i++)
8183 call->foamPCall.argv[i] = foamNewPar(i)foamNew(FOAM_Par, 1, (AInt)(i));
8184
8185 if (symeForeign(syme)((ForeignOrigin) (SYFI_Foreign < (8 * sizeof(int)) &&
!(((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->hasmask) & (1 <<
(SYFI_Foreign))) ? (symeFieldInfo[SYFI_Foreign].def) : (((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->locmask) & (1 << (SYFI_Foreign
))) ? ((((((syme)->kind == SYME_Trigger ? libGetAllSymes((
syme)->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_Foreign))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_Foreign
)] : (symeFieldInfo[SYFI_Foreign].def)) : symeGetFieldFn(syme
,SYFI_Foreign)))
->protocol == FOAM_Proto_Fortran) {
8186 call = gen0ModifyFortranCall(syme, call, gen0FortranFnResult,
8187 gen0ValueMode);
8188 }
8189
8190 if (gen0FortranActualArgTmps)
8191 gen0FreeFortranActualArgTmps();
8192
8193 gen0FortranActualArgTmps = NULL((void*)0);
8194
8195 if (gen0ValueMode && (retType == FOAM_NOp))
8196 {
8197 /* Special care with multi return values */
8198 Foam tmp = gen0TempFrDDecl(retFmt, true1);
8199
8200 call = foamNewSet(tmp, foamNewMFmt(retFmt, call))foamNew(FOAM_Set, 2, tmp, foamNew(FOAM_MFmt, 2, retFmt, call)
)
;
8201 gen0AddStmt(call, NULL((void*)0));
8202
8203 call = gen0TempFrDDecl(retFmt, true1);
8204 for (i=0; i < foamArgc(tmp)((tmp)->hdr.argc); i++)
8205 {
8206 Foam lhs = foamCopy(call->foamValues.argv[i]);
8207 Foam rhs = foamCopy(tmp->foamValues.argv[i]);
8208 gen0AddStmt(foamNewSet(lhs, rhs)foamNew(FOAM_Set, 2, lhs, rhs), NULL((void*)0));
8209 }
8210 }
8211
8212 if (!gen0ValueMode) /* Void functions also need attention */
8213 call = foamNew(FOAM_Values, (Length)0);
8214
8215 gen0AddStmt(foamNewReturn(call)foamNew(FOAM_Return, 1, call), NULL((void*)0));
8216
8217 gen0ProgFiniEmpty(foam, retType, int0((int) 0));
8218
8219 gen0ProgRestoreState(saved);
8220 foam->foamProg.format = retFmt;
8221 foamOptInfo(foam)((foam)->hdr.info.opt) = optInfoNew(NULL((void*)0), foam, NULL((void*)0), false((int) 0));
8222
8223 symeSetClosure(syme, clos)(symeSetFieldVal = ((AInt) (clos)), (((((syme)->kind == SYME_Trigger
? libGetAllSymes((syme)->lib) : ((void*)0)), (syme))->
locmask) & (1 << (SYFI_Closure))) ? (((syme)->fieldv
)[symeIndex(syme,SYFI_Closure)] = (symeSetFieldVal)) : !((syme
)->full) && symeSetFieldVal == (symeFieldInfo[SYFI_Closure
].def) ? symeSetFieldVal : symeSetFieldFn(syme,SYFI_Closure,symeSetFieldVal
))
;
8224 Return(foamCopy(clos)){ fluidUnwind(fluidLevel0, ((int) 0)); return foamCopy(clos);
; }
;
8225}
8226
8227
8228localstatic void
8229gen0FreeFortranActualArgTmps(void)
8230{
8231 FoamList l;
8232
8233 l = gen0FortranActualArgTmps;
8234 for (; gen0FortranActualArgTmps; gen0FortranActualArgTmps = cdr(gen0FortranActualArgTmps)((gen0FortranActualArgTmps)->rest))
8235 gen0FreeTemp(car(gen0FortranActualArgTmps)((gen0FortranActualArgTmps)->first));
8236 listFree(Foam)(Foam_listPointer->Free)(l);
8237}
8238
8239
8240AInt
8241gen0StdDeclFormat(Length size, String *names, FoamTag *types, AInt *fmts)
8242{
8243 Foam decl, ddecl;
8244 Length i;
8245
8246 ddecl = foamNewEmpty(FOAM_DDecl, size + 1);
8247 ddecl->foamDDecl.usage = FOAM_DDecl_Record;
8248
8249 for (i = 0; i < size; i += 1) {
8250 decl = foamNewDecl(types[i], strCopy(names[i]), fmts[i])foamNew(FOAM_Decl,4,(AInt)(types[i]),strCopy(names[i]), (AInt
) (0x7FFF), fmts[i])
;
8251 foamFixed(decl)((decl)->hdr.info.fixed) = true1;
8252 ddecl->foamDDecl.argv[i] = decl;
8253 }
8254
8255 return gen0AddRealFormat(ddecl);
8256}
8257
8258void
8259gen0SetDDeclUsage(AInt fmtNo, FoamDDeclTag usage)
8260{
8261 Foam ddecl;
8262
8263 ddecl = gen0GetRealFormat(gen0FindFormat(fmtNo));
8264 ddecl->foamDDecl.usage = (AInt) usage;
8265}
8266
8267/*
8268 * Get the foam format for a real format number.
8269 */
8270localstatic Foam
8271gen0GetRealFormat(AInt fmt0)
8272{
8273 FoamList fl;
8274 AInt fmt;
8275
8276 fmt = gen0RealFormatNum - 1;
8277 for (fl = gen0FormatList; fl; fmt -= 1, fl = cdr(fl)((fl)->rest))
8278 if (fmt == fmt0)
8279 return car(fl)((fl)->first);
8280 assert(false)do { if (!(((int) 0))) _do_assert(("false"),"genfoam.c",8280)
; } while (0)
;
8281 return NULL((void*)0);
8282}
8283
8284/*
8285 * Add a real format to the list.
8286 * Use an existing format if available.
8287 */
8288AInt
8289gen0AddRealFormat(Foam ddecl)
8290{
8291 FoamList fl;
8292 AInt fmt;
8293
8294 /* See if the format is already on the list. */
8295 fmt = gen0RealFormatNum - 1;
8296 for (fl = gen0FormatList; fl; fmt -= 1, fl = cdr(fl)((fl)->rest))
8297 if (gen0CompareFormats(ddecl, car(fl)((fl)->first))) {
8298 foamFree(ddecl);
8299 return fmt;
8300 }
8301
8302 /* Otherwise just use the one we constructed. */
8303 gen0FormatList = listCons(Foam)(Foam_listPointer->Cons)(ddecl, gen0FormatList);
8304 return gen0RealFormatNum++;
8305}
8306
8307/*
8308 * Compare Foam formats.
8309 */
8310localstatic Bool
8311gen0CompareFormats(Foam dd1, Foam dd2)
8312{
8313 FoamDDeclTag usage;
8314 Length i, argc;
8315
8316 assert(foamTag(dd1) == FOAM_DDecl)do { if (!(((dd1)->hdr.tag) == FOAM_DDecl)) _do_assert(("foamTag(dd1) == FOAM_DDecl"
),"genfoam.c",8316); } while (0)
;
8317 assert(foamTag(dd2) == FOAM_DDecl)do { if (!(((dd2)->hdr.tag) == FOAM_DDecl)) _do_assert(("foamTag(dd2) == FOAM_DDecl"
),"genfoam.c",8317); } while (0)
;
8318
8319 if (dd1->foamDDecl.usage != dd2->foamDDecl.usage)
8320 return false((int) 0);
8321
8322 usage = dd1->foamDDecl.usage;
8323
8324 argc = foamDDeclArgc(dd1)(((dd1)->hdr.argc) - (1));
8325 if (foamDDeclArgc(dd2)(((dd2)->hdr.argc) - (1)) != argc)
8326 return false((int) 0);
8327
8328 for (i = 0; i < argc; i += 1) {
8329 Foam d1 = dd1->foamDDecl.argv[i];
8330 Foam d2 = dd2->foamDDecl.argv[i];
8331 FoamTag t1 = d1->foamDecl.type;
8332
8333 if (t1 != d2->foamDecl.type)
8334 return false((int) 0);
8335
8336 /*
8337 * We MUST check signatures of functions
8338 * otherwise we get problems with the
8339 * foreign Fortran interface.
8340 */
8341 if (t1 == FOAM_Clos
8342 || usage == FOAM_DDecl_CSig
8343 || usage == FOAM_DDecl_CType
8344 || usage == FOAM_DDecl_JavaClass
8345 || usage == FOAM_DDecl_JavaSig)
8346 { /* Can't merge if different signatures ... */
8347 AInt f1 = d1->foamDecl.format;
8348 AInt f2 = d2->foamDecl.format;
8349 if (f1 != f2)
8350 return false((int) 0);
8351 }
8352
8353 if (!strEqual(d1->foamDecl.id, d2->foamDecl.id))
8354 return false((int) 0);
8355 }
8356
8357 return true1;
8358}
8359
8360/*****************************************************************************
8361 *
8362 * :: Debugging (old style)
8363 *
8364 ****************************************************************************/
8365
8366localstatic Foam gen0DbgFnExit0 (int, Foam);
8367localstatic void gen0DbgAssign0 (int, Syme, Bool);
8368
8369localstatic void
8370gen0DbgAssignment(AbSyn lhs)
8371{
8372 Syme id;
8373 int lineNo;
8374 Foam type;
8375
8376 if (abTag(lhs)((lhs)->abHdr.tag) != AB_Id)
8377 return;
8378 assert(gen0DebugWanted)do { if (!(gen0DebugWanted)) _do_assert(("gen0DebugWanted"),"genfoam.c"
,8378); } while (0)
;
8379 id = abSyme(lhs)((lhs)->abHdr.seman ? (lhs)->abHdr.seman->syme : 0);
8380 lineNo = sposLine(abPos(lhs)(spstackFirst((lhs)->abHdr.pos)));
8381 type = gen0GetDomainLex(symeType(id));
8382
8383 gen0DbgAssign0(lineNo, id, false((int) 0));
8384}
8385
8386localstatic void
8387gen0DbgFnEntry(AbSyn fn)
8388{
8389 AbSyn body, params, *argv;
8390 Syme self;
8391 Foam type;
8392 String name;
8393 Bool inDom;
8394 int lineNo, argc, i;
8395
8396 assert(abIsAnyLambda(fn))do { if (!((((fn)->abHdr.tag == (AB_Lambda)) || ((fn)->
abHdr.tag == (AB_PLambda))))) _do_assert(("abIsAnyLambda(fn)"
),"genfoam.c",8396); } while (0)
;
8397 assert(gen0DebugWanted)do { if (!(gen0DebugWanted)) _do_assert(("gen0DebugWanted"),"genfoam.c"
,8397); } while (0)
;
8398
8399 self = gen0LocalSelfSyme();
8400 body = fn->abLambda.body;
8401 params = fn->abLambda.param;
8402
8403 if (self != NULL((void*)0)) {
8404 type = gen0Syme(self);
8405 inDom = true1;
8406 }
8407 else {
8408 type = foamNewSInt(23)foamNew(FOAM_SInt, 1, (AInt)(23));
8409 inDom = false((int) 0);
8410 }
8411
8412 if (abTag(body)((body)->abHdr.tag) == AB_Label)
8413 name = symString(abIdSym(body->abLabel.label))((((body->abLabel.label)->abId.sym))->str);
8414 else
8415 name = "<unknown>";
8416
8417 lineNo = sposLine(abPos(fn)(spstackFirst((fn)->abHdr.pos)));
8418 gen0DebugIssueStmt(GenDebugFnEntry, name,
8419 lineNo, type, foamNewSInt(inDom)foamNew(FOAM_SInt, 1, (AInt)(inDom)),
8420 foamNewBool(true)foamNew(FOAM_Bool, 1, (AInt)(1)));
8421
8422 AB_COMMA_ITER(params, argc, argv){ switch (((params)->abHdr.tag)) { case AB_Nothing: argc =
0; argv = 0; break; case AB_Comma: argc = ((params)->abHdr
.argc); argv = ((params)->abGen.data.argv); break; default
: argc = 1; argv = &params; break; }; }
;
8423
8424 for (i=0; i<argc; i++) {
8425 Syme syme = abSyme(abDefineeId(argv[i]))((abDefineeId(argv[i]))->abHdr.seman ? (abDefineeId(argv[i
]))->abHdr.seman->syme : 0)
;
8426 gen0DbgAssign0(lineNo, syme, true1);
8427 }
8428}
8429
8430localstatic Foam
8431gen0DbgFnReturn(AbSyn ab, Foam value)
8432{
8433 return gen0DbgFnExit0(sposLine(abPos(ab)(spstackFirst((ab)->abHdr.pos))), value);
8434}
8435
8436localstatic Foam
8437gen0DbgFnExit(AbSyn fn, Foam value)
8438{
8439 return gen0DbgFnExit0(sposLine(abEnd(fn)), value);
8440}
8441
8442localstatic void
8443gen0DbgAssign0(int line, Syme syme, Bool isParam)
8444{
8445 TForm tf = symeType(syme);
8446
8447 /* Ignore types we don't like */
8448 if (tfSatCat(tf) || tfSatDom(tf) || gen0Type(tf, NULL((void*)0)) != FOAM_Word)
8449 return;
8450#if 0
8451 gen0DebugIssueStmt(GenDebugAssign,
8452 symeString(syme)((((syme)->id))->str),
8453 line,
8454 gen0GetDomainLex(tf),
8455 gen0Syme(syme),
8456 foamNewBool(isParam)foamNew(FOAM_Bool, 1, (AInt)(isParam)));
8457#endif
8458}
8459
8460localstatic Foam
8461gen0DbgFnExit0(int line, Foam value)
8462{
8463 TForm tf = gen0State->type;
8464 Foam type, flag, v;
8465
8466 /* Ignore types we don't like */
8467 if (tfIsAnyMap(tf)((((tf)->tag) == TF_Map) || (((tf)->tag) == TF_PackedMap
))
) tf = tfMapRet(tf)tfFollowArg(tf, 1);
8468 if (tfSatCat(tf) || tfSatDom(tf) || gen0Type(tf, NULL((void*)0)) != FOAM_Word ||
8469 tfAsMultiArgc(tf) != 1) {
8470 type = foamNewSInt(int0)foamNew(FOAM_SInt, 1, (AInt)(((int) 0)));
8471 flag = foamNewBool(false)foamNew(FOAM_Bool, 1, (AInt)(((int) 0)));
8472 gen0DebugIssueStmt(GenDebugFnExit, "",
8473 line, type, foamNewSInt(int0)foamNew(FOAM_SInt, 1, (AInt)(((int) 0))), flag);
8474 }
8475 else {
8476 type = gen0GetDomainLex(tf);
8477 flag = foamNewBool(true)foamNew(FOAM_Bool, 1, (AInt)(1));
8478 v = gen0TempLocal(FOAM_Word)gen0TempLocal0(FOAM_Word, 4);
8479 gen0AddStmt(foamNewSet(foamCopy(v), value)foamNew(FOAM_Set, 2, foamCopy(v), value), NULL((void*)0));
8480 gen0DebugIssueStmt(GenDebugFnExit, "",
8481 line, type, foamCopy(v), flag);
8482 value = v;
8483 }
8484
8485 return value;
8486}
8487
8488/*****************************************************************************
8489 *
8490 * :: Debugging (new style)
8491 *
8492 ****************************************************************************/
8493
8494localstatic void
8495gen1DbgFnEntry(TForm tf, Syme syme, AbSyn fn)
8496{
8497 AbSyn *argv;
8498 Foam call, result, exporter, type;
8499 String file, name;
8500 SrcPos pos;
8501 int line, argc, i;
8502 Bool inDom = false((int) 0);
8503 Syme self = (Syme)0;
8504 AbSyn body = fn->abLambda.body;
8505 AbSyn params = fn->abLambda.param;
8506
8507
8508 /* Safety checks */
8509 assert(abIsAnyLambda(fn))do { if (!((((fn)->abHdr.tag == (AB_Lambda)) || ((fn)->
abHdr.tag == (AB_PLambda))))) _do_assert(("abIsAnyLambda(fn)"
),"genfoam.c",8509); } while (0)
;
8510 assert(gen0DebuggerWanted)do { if (!(gen0DebuggerWanted)) _do_assert(("gen0DebuggerWanted"
),"genfoam.c",8510); } while (0)
;
8511
8512
8513 /* What is the name of this function? */
8514 if (abTag(body)((body)->abHdr.tag) == AB_Label)
8515 {
8516 AbSyn label = body->abLabel.label;
8517 Symbol sym = abIdSym(label)((label)->abId.sym);
8518 name = symString(sym)((sym)->str);
8519 }
8520 else
8521 name = "<unknown>";
8522
8523
8524 /* Find % (works if this is a domain constructor) */
8525 if ((self = gen0LocalSelfSyme()) != NULL((void*)0))
8526 inDom = true1;
8527
8528
8529 /*
8530 * Cobble together a domain value (or nothing). If we can't
8531 * find a domain then we ought to use the library instead.
8532 */
8533 exporter = inDom ? gen0Syme(self) : foamNewSInt(0L)foamNew(FOAM_SInt, 1, (AInt)(0L));
8534
8535
8536 /* We cannot reliably compute a type value yet */
8537 type = foamNewCast(FOAM_Word, foamNewSInt(0L))foamNew(FOAM_Cast, 2, FOAM_Word, foamNew(FOAM_SInt, 1, (AInt)
(0L)))
;
8538
8539
8540 /* Jump to the function body */
8541 while (abTag(body)((body)->abHdr.tag) == AB_Label)
8542 body = body->abLabel.expr;
8543
8544
8545 /*
8546 * Find the start of the function. We assume that there are no
8547 * nested sequences in the body.
8548 */
8549 if ((abTag(body)((body)->abHdr.tag) == AB_Sequence) && abArgc(body)((body)->abHdr.argc))
8550 body = abArgv(body)((body)->abGen.data.argv)[0];
8551
8552
8553 /* Get the source code position */
8554 pos = abPos(body)(spstackFirst((body)->abHdr.pos));
8555 line = sposLine(pos);
8556 file = fnameUnparse(sposFile(pos));
8557
8558
8559 /* Obtain a consistent view of the parameters */
8560 AB_COMMA_ITER(params, argc, argv){ switch (((params)->abHdr.tag)) { case AB_Nothing: argc =
0; argv = 0; break; case AB_Comma: argc = ((params)->abHdr
.argc); argv = ((params)->abGen.data.argv); break; default
: argc = 1; argv = &params; break; }; }
;
8561
8562 /* Generate a call to the debugger function-entry hook */
8563 result = gen0TempLocal(FOAM_Word)gen0TempLocal0(FOAM_Word, 4);
8564 call = gen0DbgEnter(file, line, exporter, name, type, argc);
8565 gen0AddStmt(foamNewSet(foamCopy(result), call)foamNew(FOAM_Set, 2, foamCopy(result), call), body);
8566
8567
8568 /* Store the function context */
8569 gen0State->dbgContext = foamCopy(result);
8570
8571
8572 /* Declare and assign the parameters to this function */
8573 for (i = 0; i < argc; i++)
8574 {
8575 AbSyn param = abDefineeId(argv[i]);
8576 Syme syme = abSyme(param)((param)->abHdr.seman ? (param)->abHdr.seman->syme :
0)
;
8577
8578 gen1DbgDoParam(file, line, syme, i);
8579 }
8580
8581
8582 /* Finally tell the debugger that we are "in" */
8583 gen0AddStmt(gen0DbgInside(foamCopy(result)), body);
8584}
8585
8586localstatic void
8587gen1DbgFnExit(AbSyn body)
8588{
8589 String file;
8590 SrcPos pos;
8591 int line;
8592 Foam decl;
8593
8594
8595 /* Do nothing if there is no function context */
8596 if (!(gen0State->dbgContext)) return;
8597
8598
8599 /* Obtain a local copy of the function context */
8600 decl = foamCopy(gen0State->dbgContext);
8601
8602
8603 /*
8604 * Find the end of the function. We assume that there are no
8605 * nested sequences in the body.
8606 */
8607 if ((abTag(body)((body)->abHdr.tag) == AB_Sequence) && abArgc(body)((body)->abHdr.argc))
8608 body = abArgv(body)((body)->abGen.data.argv)[abArgc(body)((body)->abHdr.argc) - 1];
8609
8610
8611 /* Get the source code position. */
8612 pos = abPos(body)(spstackFirst((body)->abHdr.pos));
8613 line = sposLine(pos);
8614 file = fnameUnparse(sposFile(pos));
8615
8616
8617 /* Generate the debug call statement */
8618 gen0AddStmt(gen0DbgExit(file, line, decl), body);
8619}
8620
8621localstatic void
8622gen1DbgFnReturn(AbSyn body, TForm tf, Foam value)
8623{
8624 String file;
8625 SrcPos pos;
8626 int line;
8627 Foam decl, type;
8628
8629
8630 /* Do nothing if there is no function context */
8631 if (!(gen0State->dbgContext)) return;
8632
8633
8634 /* Obtain a local copy of the function context */
8635 decl = foamCopy(gen0State->dbgContext);
8636
8637
8638 /*
8639 * Find the end of the function. We assume that there are no
8640 * nested sequences in the body. Note that if we are called
8641 * from gen0Return() body is the return statement itself.
8642 */
8643 if ((abTag(body)((body)->abHdr.tag) == AB_Sequence) && abArgc(body)((body)->abHdr.argc))
8644 body = abArgv(body)((body)->abGen.data.argv)[abArgc(body)((body)->abHdr.argc) - 1];
8645
8646
8647 /* Get the source code position. */
8648 pos = abPos(body)(spstackFirst((body)->abHdr.pos));
8649 line = sposLine(pos);
8650 file = fnameUnparse(sposFile(pos));
8651
8652
8653 /* Try and get a handle on the type of this value */
8654 if (tfSatCat(tf) || tfSatDom(tf))
8655 type = foamNewCast(FOAM_Word, foamNewSInt(0L))foamNew(FOAM_Cast, 2, FOAM_Word, foamNew(FOAM_SInt, 1, (AInt)
(0L)))
;
8656 else if (gen0Type(tf, NULL((void*)0)) != FOAM_Word)
8657 type = foamNewCast(FOAM_Word, foamNewSInt(0L))foamNew(FOAM_Cast, 2, FOAM_Word, foamNew(FOAM_SInt, 1, (AInt)
(0L)))
;
8658 else if (tfAsMultiArgc(tf) != 1)
8659 type = foamNewCast(FOAM_Word, foamNewSInt(0L))foamNew(FOAM_Cast, 2, FOAM_Word, foamNew(FOAM_SInt, 1, (AInt)
(0L)))
;
8660 else
8661 type = gen0GetDomainLex(tf);
8662
8663
8664 /* Generate the debug call statement */
8665 gen0AddStmt(gen0DbgReturn(file, line, decl, type, value), body);
8666}
8667
8668localstatic void
8669gen1DbgDoParam(String file, AInt line, Syme syme, AInt pno)
8670{
8671 Foam par;
8672
8673
8674 /* Do nothing if there is no function context */
8675 if (!(gen0State->dbgContext)) return;
8676
8677
8678 /* Which parameter is this? */
8679 par = foamNewPar(pno)foamNew(FOAM_Par, 1, (AInt)(pno));
8680
8681
8682 /* Generate the debug call */
8683 gen1DbgDoAssign(file, line, syme, par, (AInt)DbgDepthParam, pno);
8684}
8685
8686localstatic void
8687gen1DbgDoAssign(String file, AInt line, Syme syme, Foam value,
8688 AInt depth, AInt vno)
8689{
8690 Foam decl, type, call;
8691 TForm tf = symeType(syme);
8692 String name = symString(symeId(syme))((((syme)->id))->str);
8693
8694
8695 /* Do nothing if there is no function context */
8696 if (!(gen0State->dbgContext)) return;
8697
8698
8699 /* Obtain a local copy of the function context */
8700 decl = foamCopy(gen0State->dbgContext);
8701
8702
8703 /* Try and get a handle on the type of this value */
8704 if (tfSatCat(tf) || tfSatDom(tf))
8705 type = foamNewCast(FOAM_Word, foamNewSInt(0L))foamNew(FOAM_Cast, 2, FOAM_Word, foamNew(FOAM_SInt, 1, (AInt)
(0L)))
;
8706 else if (gen0Type(tf, NULL((void*)0)) != FOAM_Word)
8707 type = foamNewCast(FOAM_Word, foamNewSInt(0L))foamNew(FOAM_Cast, 2, FOAM_Word, foamNew(FOAM_SInt, 1, (AInt)
(0L)))
;
8708 else if (tfAsMultiArgc(tf) != 1)
8709 type = foamNewCast(FOAM_Word, foamNewSInt(0L))foamNew(FOAM_Cast, 2, FOAM_Word, foamNew(FOAM_SInt, 1, (AInt)
(0L)))
;
8710 else
8711 type = gen0GetDomainLex(tf);
8712
8713
8714 /* Create the debug call */
8715 call = gen0DbgAssign(file, line, decl, name, type, value, depth, vno);
8716 gen0AddStmt(call, (AbSyn)NULL((void*)0));
8717}
8718
8719localstatic void
8720gen1DbgFnStep(AbSyn stmt)
8721{
8722 String file;
8723 SrcPos pos;
8724 int line;
8725 Foam decl;
8726
8727
8728 /* Obtain a local copy of the function context (if any) */
8729 decl = gen0State->dbgContext;
8730 decl = decl ? foamCopy(decl) : foamNewSInt(0L)foamNew(FOAM_SInt, 1, (AInt)(0L));
8731
8732
8733 /* Get the source code position. */
8734 pos = abPos(stmt)(spstackFirst((stmt)->abHdr.pos));
8735 line = sposLine(pos);
8736 file = fnameUnparse(sposFile(pos));
8737
8738
8739 /* Generate the debug call statement */
8740 gen0AddStmt(gen0DbgStep(file, line, decl), stmt);
8741}
8742