Bug Summary

File:src/gf_implicit.c
Warning:line 190, column 2
Value stored to 'index' 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 gf_implicit.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 gf_implicit.c
1/*****************************************************************************
2 *
3 * gf_implicit.c: Foam code generation for implicit exports
4 *
5 * Copyright (c) 1990-2007 Aldor Software Organization Ltd (Aldor.org).
6 *
7 ****************************************************************************/
8
9/*
10 * This file implements Foam code generation from symes for implicit
11 * domain exports. At the moment we only deal with array operations.
12 */
13
14#include "comsg.h"
15#include "gf_implicit.h"
16#include "lib.h"
17#include "optinfo.h"
18#include "strops.h"
19#include "symbol.h"
20#include "syme.h"
21#include "util.h"
22
23extern Bool genfoamDebug;
24extern Bool genfoamHashDebug;
25extern Bool genfoamConstDebug;
26
27
28/*****************************************************************************
29 *
30 * :: Local helper functions.
31 *
32 ****************************************************************************/
33
34localstatic Foam gen1ImplicitExport (Syme, FoamTag);
35localstatic void gen0ImplicitPANew (FoamList, FoamTag);
36localstatic void gen0ImplicitPAGet (FoamList, FoamTag, FoamTag);
37localstatic void gen0ImplicitPASet (FoamList, FoamTag);
38localstatic void gen0ImplicitPRGet (FoamList, FoamTag, FoamTag);
39localstatic void gen0ImplicitPRSet (FoamList, FoamTag);
40localstatic void gen0ImplicitPRSize (FoamList, FoamTag);
41localstatic FoamTag gen1ImplicitType (TForm);
42localstatic TForm gen1ImplicitRepValue (SymeList);
43localstatic Syme gen1ImplicitRep (SymeList);
44localstatic AbSyn ab0ImplicitExportArgs (TForm);
45localstatic AbSyn ab1ImplicitExportArg (Length);
46localstatic FoamList gen0ImplicitExportArgs (TForm);
47localstatic Foam gen1ImplicitExportArg (TForm, Length);
48localstatic Symbol gen0ImplicitArgName (Length);
49
50
51/*
52 * Create an explicit export: see gen0DefineRhs and gen0Lambda
53 * for more details on how we do this. The code in gf_fortran may
54 * also be helpful.
55 */
56void
57gen0ImplicitExport(Syme syme, SymeList context, AbSyn ab)
58{
59 TForm tf;
60 FoamTag repTag;
61 Foam lhs, rhs, def;
62
63
64 /* What is the Rep of this domain? */
65 tf = gen1ImplicitRepValue(context);
66
67
68 /* Get the FOAM type for this Rep */
69 if (tf)
70 repTag = gen1ImplicitType(tf);
71 else
72 {
73 /* Raise an error because we can't find Rep */
74 comsgWarning(ab, ALDOR_E_GenImpNoRep237);
75
76
77 /* Non-fatal so continue */
78 repTag = FOAM_Word;
79 }
80
81
82 /* Get the rhs of the export definition */
83 rhs = gen1ImplicitExport(syme, repTag);
84 if (!rhs) return;
85
86
87 /* Create the FOAM for the lhs */
88 lhs = gen0ExtendSyme(syme);
89
90
91 /*
92 * If this is a domain export then record the foam loc/lex
93 * used to hold the value of this syme.
94 */
95 if (gen0IsDomLevel(gen0State->tag)((gen0State->tag) >= GF_START_TYPE && (gen0State
->tag) <= GF_END_TYPE) && gen0State->tag != GF_File)
96 gen0SymeSetInit(syme, lhs);
97
98
99 /* Create a definition */
100 def = foamNewDef(lhs, rhs)foamNew(FOAM_Def, 2, lhs, rhs);
101
102
103 /* Not sure if this hackery is needed anymore */
104 def->foamDef.hdr.defnId = symeDefnNum(syme)((int) (SYFI_DefnNum < (8 * sizeof(int)) && !(((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->hasmask) & (1 << (SYFI_DefnNum
))) ? (symeFieldInfo[SYFI_DefnNum].def) : (((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_DefnNum))) ?
((((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_DefnNum))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_DefnNum
)] : (symeFieldInfo[SYFI_DefnNum].def)) : symeGetFieldFn(syme
,SYFI_DefnNum)));
105
106
107 /* Add the definition to the code stream */
108 gen0AddStmt(def, (AbSyn)NULL((void*)0));
109}
110
111
112localstatic Foam
113gen1ImplicitExport(Syme syme, FoamTag repTag)
114{
115 TForm tf, tfret;
116 AInt retfmt, index;
117 Foam foam, clos;
118 FoamTag retType;
119 AbSyn params, oldex, id;
120 FoamList pars;
121 Length i, gfTag;
122 GenFoamState saved;
123 Hash hash;
124
125
126 /* Paranoia */
127 assert(syme)do { if (!(syme)) _do_assert(("syme"),"gf_implicit.c",127); }
while (0);
128
129
130 /* Get the type of this syme */
131 tf = symeType(syme);
132 assert (tfIsMap(tf))do { if (!((((tf)->tag) == TF_Map))) _do_assert(("tfIsMap(tf)"
),"gf_implicit.c",132); } while (0);
133
134
135 /* Name of the export */
136 gen0ProgName = strCopy(symeString(syme)((((syme)->id))->str));
137
138
139 /* Type hash code */
140 hash = tfHash(tf);
141
142
143 /* Is this something we know about? */
144 for (i = gfTag = 0; i < GFI_LIMIT && !gfTag; i++) {
145 struct gf_impl_info *e = &gfImplicitInfoTable[i];
146
147 if (e->type != hash)
148 continue;
149 if (!strEqual(e->name, gen0ProgName))
150 continue;
151 gfTag = i + 1;
152 }
153
154
155 /* Did we recognise it? */
156 if (!gfTag) {
157 bug("[%s] %s#%ld not recognised\n",
158 "gen1ImplicitExport", gen0ProgName, hash);
159 return (Foam)NULL((void*)0);
160 }
161 else
162 gfTag--;
163
164
165 /* Note the function signature */
166 tfret = tfMapRet(tf)tfFollowArg(tf, 1);
167 retType = gen0Type(tfret, &retfmt);
168
169
170 /* Fake up a bit of absyn */
171 id = abNewId(sposNone, symIntern(gen0ProgName))abNew(AB_Id, sposNone,1, symProbe(gen0ProgName, 1 | 2));
172 abSetDefineIdx(id, symeDefnNum(syme)((int) (SYFI_DefnNum < (8 * sizeof(int)) && !(((((
syme)->kind == SYME_Trigger ? libGetAllSymes((syme)->lib
) : ((void*)0)), (syme))->hasmask) & (1 << (SYFI_DefnNum
))) ? (symeFieldInfo[SYFI_DefnNum].def) : (((((syme)->kind
== SYME_Trigger ? libGetAllSymes((syme)->lib) : ((void*)0
)), (syme))->locmask) & (1 << (SYFI_DefnNum))) ?
((((((syme)->kind == SYME_Trigger ? libGetAllSymes((syme)
->lib) : ((void*)0)), (syme))->locmask) & (1 <<
(SYFI_DefnNum))) ? ((syme)->fieldv)[symeIndex(syme,SYFI_DefnNum
)] : (symeFieldInfo[SYFI_DefnNum].def)) : symeGetFieldFn(syme
,SYFI_DefnNum))));
173
174
175 /* Not sure if we need this ... */
176 oldex = gen0ProgPushExporter(id);
177
178
179 /* Deal with const number */
180 /* gen0AddConst(symeConstNum(syme), gen0NumProgs); */
181 genSetConstNum(syme, abDefineIdx(id)((id)->abHdr.seman ? (id)->abHdr.seman->defnIdx : -1
), (UShort) gen0NumProgs, true1);
182
183
184 /* Create a closure for the function */
185 clos = gen0ProgClosEmpty();
186 foam = gen0ProgInitEmpty(gen0ProgName, id);
187
188
189 /* What format number are we using? */
190 index = gen0FormatNum;
Value stored to 'index' is never read
191
192
193 /* Save the current state */
194 saved = gen0ProgSaveState(PT_ExFn);
195
196
197 /*
198 * Deal with special return types. None of these
199 * ought to appear at the moment but there is no
200 * point in creating extra work for the future.
201 */
202 if (tfIsMulti(tfret)(((tfret)->tag) == TF_Multiple))
203 retfmt = gen0MultiFormatNumber(tfret);
204
205 if (tfIsGenerator(tfret)(((tfret)->tag) == TF_Generator))
206 foamProgSetGenerator(foam)((foam)->foamProg.infoBits |= (1 << 2));
207
208
209 /* Create the parameters for this function */
210 params = ab0ImplicitExportArgs(tfMapArg(tf)tfFollowArg(tf, 0));
211
212
213 /* Initialise the program state */
214 gen0State->type = tf;
215 gen0State->param = params;
216 gen0State->program = foam;
217
218
219 /* Not sure if we really need this ... see below */
220#ifdef PUSH_FORAMTS
221 gen0PushFormat(index);
222#endif
223
224
225 /* Create the parameter list */
226 pars = gen0ImplicitExportArgs(tfMapArg(tf)tfFollowArg(tf, 0));
227
228
229 /* Generate code for the body of this export */
230 switch (gfTag) {
231 case GFI_PackedArrayNew:
232 gen0ImplicitPANew(pars, repTag);
233 break;
234 case GFI_PackedArrayGet:
235 gen0ImplicitPAGet(pars, retType, repTag);
236 break;
237 case GFI_PackedArraySet:
238 gen0ImplicitPASet(pars, repTag);
239 break;
240 case GFI_PackedRecordSet:
241 gen0ImplicitPRSet(pars, repTag);
242 break;
243 case GFI_PackedRecordGet:
244 gen0ImplicitPRGet(pars, retType, repTag);
245 break;
246 case GFI_PackedRepSize:
247 gen0ImplicitPRSize(pars, repTag);
248 break;
249 default:
250 bug("[%s] GFI tag #" LENGTH_FMT"%lu" " not recognised\n",
251 "gen1ImplicitExport", gfTag);
252 }
253
254
255#ifdef PUSH_FORAMTS
256 gen0ProgAddStateFormat(index);
257 gen0ProgFiniEmpty(foam, retType, retfmt);
258#else
259 /*
260 * Finish off the FOAM creation. Note that we want to
261 * use a basic machine type for the return type of this
262 * function so that Fortran can understand the result.
263 * This means we use `rtype' in gen0ProgFiniEmpty()
264 * rather than `retType' which we would do normally.
265 */
266 gen0UseStackedFormat(int0((int) 0)); /* These two lines provide a format */
267 gen0ProgPushFormat(int0((int) 0)); /* for the lexical argument `op' */
268 gen0ProgFiniEmpty(foam, retType, retfmt);
269#endif
270
271
272 /* Optimisation bits */
273 /* foam->foamProg.infoBits = IB_INLINEME; */
274 foamOptInfo(foam)((foam)->hdr.info.opt) = optInfoNew(NULL((void*)0), foam, NULL((void*)0), false((int) 0));
275
276
277#if 0
278 /* Compute side-effects of this foam */
279 gen0ComputeSideEffects(foam);
280#endif
281
282
283 /* Restore the saved state before returning */
284 gen0ProgRestoreState(saved);
285 return clos;
286}
287
288
289/*
290 * Construct the body of PackedArrayNew: SInt -> Arr
291 */
292localstatic void
293gen0ImplicitPANew(FoamList pars, FoamTag repTag)
294{
295 Foam par, foam;
296
297
298 /* Extract the only parameter (array size) */
299 assert(pars)do { if (!(pars)) _do_assert(("pars"),"gf_implicit.c",299); }
while (0);
300 par = foamCopy(car(pars)((pars)->first)); pars = cdr(pars)((pars)->rest);
301 assert(!pars)do { if (!(!pars)) _do_assert(("!pars"),"gf_implicit.c",301);
} while (0);
302
303
304 /* Construct a new array */
305 foam = foamNewANew(repTag, par)foamNew(FOAM_ANew, 2, repTag, par);
306
307
308 /* Finally return the new array */
309 foam = foamNewReturn(foam)foamNew(FOAM_Return, 1, foam);
310 gen0AddStmt(foam, (AbSyn)NULL((void*)0));
311}
312
313
314/*
315 * Construct the body of PackedArrayGet: (Arr, SInt) -> %
316 */
317localstatic void
318gen0ImplicitPAGet(FoamList pars, FoamTag retType, FoamTag repTag)
319{
320 Foam parArr, parElt, foam;
321
322
323 /* Get the array */
324 assert(pars)do { if (!(pars)) _do_assert(("pars"),"gf_implicit.c",324); }
while (0);
325 parArr = foamCopy(car(pars)((pars)->first)); pars = cdr(pars)((pars)->rest);
326
327
328 /* Get the index */
329 assert(pars)do { if (!(pars)) _do_assert(("pars"),"gf_implicit.c",329); }
while (0);
330 parElt = foamCopy(car(pars)((pars)->first)); pars = cdr(pars)((pars)->rest);
331 assert(!pars)do { if (!(!pars)) _do_assert(("!pars"),"gf_implicit.c",331);
} while (0);
332
333
334 /* Construct an array access */
335 foam = foamNewAElt(repTag, parElt, parArr)foamNew(FOAM_AElt,3,(AInt)(repTag),parElt,parArr);
336
337
338 /* Cast to return type */
339 foam = foamNewCast(retType, foam)foamNew(FOAM_Cast, 2, retType, foam);
340
341
342 /* Return the array element selected */
343 foam = foamNewReturn(foam)foamNew(FOAM_Return, 1, foam);
344 gen0AddStmt(foam, (AbSyn)NULL((void*)0));
345}
346
347
348/*
349 * Construct the body of PackedArraySet: (Arr, SInt, %) -> %
350 */
351localstatic void
352gen0ImplicitPASet(FoamList pars, FoamTag repTag)
353{
354 Foam parArr, parElt, parVal, foam, cast;
355
356
357 /* Get the array */
358 assert(pars)do { if (!(pars)) _do_assert(("pars"),"gf_implicit.c",358); }
while (0);
359 parArr = foamCopy(car(pars)((pars)->first)); pars = cdr(pars)((pars)->rest);
360
361
362 /* Get the index */
363 assert(pars)do { if (!(pars)) _do_assert(("pars"),"gf_implicit.c",363); }
while (0);
364 parElt = foamCopy(car(pars)((pars)->first)); pars = cdr(pars)((pars)->rest);
365
366
367 /* Get the value */
368 assert(pars)do { if (!(pars)) _do_assert(("pars"),"gf_implicit.c",368); }
while (0);
369 parVal = foamCopy(car(pars)((pars)->first)); pars = cdr(pars)((pars)->rest);
370 assert(!pars)do { if (!(!pars)) _do_assert(("!pars"),"gf_implicit.c",370);
} while (0);
371
372
373 /* Cast to raw type */
374 cast = foamNewCast(repTag, foamCopy(parVal))foamNew(FOAM_Cast, 2, repTag, foamCopy(parVal));
375
376
377 /* Construct an array access */
378 foam = foamNewAElt(repTag, parElt, parArr)foamNew(FOAM_AElt,3,(AInt)(repTag),parElt,parArr);
379
380
381 /* Create the update */
382 foam = foamNewSet(foam, cast)foamNew(FOAM_Set, 2, foam, cast);
383 gen0AddStmt(foam, (AbSyn)NULL((void*)0));
384
385
386 /* Return the value inserted */
387 foam = foamNewReturn(parVal)foamNew(FOAM_Return, 1, parVal);
388 gen0AddStmt(foam, (AbSyn)NULL((void*)0));
389}
390
391
392/*
393 * Construct the body of PackedRecordGet: Ptr -> %
394 */
395localstatic void
396gen0ImplicitPRGet(FoamList pars, FoamTag retType, FoamTag repTag)
397{
398 Foam par, foam;
399
400
401 /* Get the pointer */
402 assert(pars)do { if (!(pars)) _do_assert(("pars"),"gf_implicit.c",402); }
while (0);
403 par = foamCopy(car(pars)((pars)->first)); pars = cdr(pars)((pars)->rest);
404 assert(!pars)do { if (!(!pars)) _do_assert(("!pars"),"gf_implicit.c",404);
} while (0);
405
406
407 /* Construct an array access */
408 foam = foamNewAElt(repTag, foamNewSInt(int0), par)foamNew(FOAM_AElt,3,(AInt)(repTag),foamNew(FOAM_SInt, 1, (AInt
)(((int) 0))),par);
409
410
411 /* Cast to return type */
412 foam = foamNewCast(retType, foam)foamNew(FOAM_Cast, 2, retType, foam);
413
414
415 /* Return the value extracted */
416 foam = foamNewReturn(foam)foamNew(FOAM_Return, 1, foam);
417 gen0AddStmt(foam, (AbSyn)NULL((void*)0));
418}
419
420
421/*
422 * Construct the body of PackedRecordSet: (Ptr, %) -> %
423 */
424localstatic void
425gen0ImplicitPRSet(FoamList pars, FoamTag repTag)
426{
427 Foam parPtr, parVal, foam, cast;
428
429
430 /* Get the pointer and cast to Arr */
431 assert(pars)do { if (!(pars)) _do_assert(("pars"),"gf_implicit.c",431); }
while (0);
432 parPtr = foamCopy(car(pars)((pars)->first)); pars = cdr(pars)((pars)->rest);
433 parPtr = foamNewCast(FOAM_Arr, parPtr)foamNew(FOAM_Cast, 2, FOAM_Arr, parPtr);
434
435
436 /* Get the value */
437 assert(pars)do { if (!(pars)) _do_assert(("pars"),"gf_implicit.c",437); }
while (0);
438 parVal = foamCopy(car(pars)((pars)->first)); pars = cdr(pars)((pars)->rest);
439 assert(!pars)do { if (!(!pars)) _do_assert(("!pars"),"gf_implicit.c",439);
} while (0);
440
441
442 /* Cast to raw type */
443 cast = foamNewCast(repTag, foamCopy(parVal))foamNew(FOAM_Cast, 2, repTag, foamCopy(parVal));
444
445
446 /* Construct an array access */
447 foam = foamNewAElt(repTag, foamNewSInt(int0), parPtr)foamNew(FOAM_AElt,3,(AInt)(repTag),foamNew(FOAM_SInt, 1, (AInt
)(((int) 0))),parPtr);
448
449
450 /* Create the update */
451 foam = foamNewSet(foam, cast)foamNew(FOAM_Set, 2, foam, cast);
452 gen0AddStmt(foam, (AbSyn)NULL((void*)0));
453
454
455 /* Return the value inserted */
456 foam = foamNewReturn(parVal)foamNew(FOAM_Return, 1, parVal);
457 gen0AddStmt(foam, (AbSyn)NULL((void*)0));
458}
459
460
461/*
462 * Construct the body of PackedRepSize: () -> SInt
463 */
464localstatic void
465gen0ImplicitPRSize(FoamList pars, FoamTag repTag)
466{
467 Foam foam;
468 FoamBValTag bvTag;
469
470
471 /* Check that there are no parameters */
472 assert(!pars)do { if (!(!pars)) _do_assert(("!pars"),"gf_implicit.c",472);
} while (0);
473
474#if UseTypeTag
475 /* Work out which TypeTag* call we ought to use */
476 switch (repTag)
477 {
478#if 0
479 case FOAM_Int8 : bvTag = FOAM_BVal_TypeInt8; break;
480 case FOAM_Int16 : bvTag = FOAM_BVal_TypeInt16; break;
481 case FOAM_Int32 : bvTag = FOAM_BVal_TypeInt32; break;
482 case FOAM_Int64 : bvTag = FOAM_BVal_TypeInt64; break;
483 case FOAM_Int128 : bvTag = FOAM_BVal_TypeInt128; break;
484#endif
485 case FOAM_Nil : bvTag = FOAM_BVal_TypeNil; break;
486 case FOAM_Char : bvTag = FOAM_BVal_TypeChar; break;
487 case FOAM_Bool : bvTag = FOAM_BVal_TypeBool; break;
488 case FOAM_Byte : bvTag = FOAM_BVal_TypeByte; break;
489 case FOAM_HInt : bvTag = FOAM_BVal_TypeHInt; break;
490 case FOAM_SInt : bvTag = FOAM_BVal_TypeSInt; break;
491 case FOAM_BInt : bvTag = FOAM_BVal_TypeBInt; break;
492 case FOAM_SFlo : bvTag = FOAM_BVal_TypeSFlo; break;
493 case FOAM_DFlo : bvTag = FOAM_BVal_TypeDFlo; break;
494 case FOAM_Word : bvTag = FOAM_BVal_TypeWord; break;
495 case FOAM_Clos : bvTag = FOAM_BVal_TypeClos; break;
496 case FOAM_Ptr : bvTag = FOAM_BVal_TypePtr; break;
497 case FOAM_Rec : bvTag = FOAM_BVal_TypeRec; break;
498 case FOAM_Arr : bvTag = FOAM_BVal_TypeArr; break;
499 case FOAM_TR : bvTag = FOAM_BVal_TypeTR; break;
500 default : bvTag = FOAM_BVal_TypeWord; break;
501 }
502
503
504 /* Create a call to get the type tag */
505 foam = foamNew(FOAM_BCall, 1, bvTag);
506
507
508 /* Pass this to the builtin size computer */
509 foam = foamNew(FOAM_BCall, 2, FOAM_BVal_RawRepSize, foam);
510#else
511 /* Work out which SizeOf* call we ought to use */
512 switch (repTag)
513 {
514#if 0
515 case FOAM_Int8 : bvTag = FOAM_BVal_SizeOfInt8; break;
516 case FOAM_Int16 : bvTag = FOAM_BVal_SizeOfInt16; break;
517 case FOAM_Int32 : bvTag = FOAM_BVal_SizeOfInt32; break;
518 case FOAM_Int64 : bvTag = FOAM_BVal_SizeOfInt64; break;
519 case FOAM_Int128 : bvTag = FOAM_BVal_SizeOfInt128; break;
520#endif
521 case FOAM_Nil : bvTag = FOAM_BVal_SizeOfNil; break;
522 case FOAM_Char : bvTag = FOAM_BVal_SizeOfChar; break;
523 case FOAM_Bool : bvTag = FOAM_BVal_SizeOfBool; break;
524 case FOAM_Byte : bvTag = FOAM_BVal_SizeOfByte; break;
525 case FOAM_HInt : bvTag = FOAM_BVal_SizeOfHInt; break;
526 case FOAM_SInt : bvTag = FOAM_BVal_SizeOfSInt; break;
527 case FOAM_BInt : bvTag = FOAM_BVal_SizeOfBInt; break;
528 case FOAM_SFlo : bvTag = FOAM_BVal_SizeOfSFlo; break;
529 case FOAM_DFlo : bvTag = FOAM_BVal_SizeOfDFlo; break;
530 case FOAM_Word : bvTag = FOAM_BVal_SizeOfWord; break;
531 case FOAM_Clos : bvTag = FOAM_BVal_SizeOfClos; break;
532 case FOAM_Ptr : bvTag = FOAM_BVal_SizeOfPtr; break;
533 case FOAM_Rec : bvTag = FOAM_BVal_SizeOfRec; break;
534 case FOAM_Arr : bvTag = FOAM_BVal_SizeOfArr; break;
535 case FOAM_TR : bvTag = FOAM_BVal_SizeOfTR; break;
536 default : bvTag = FOAM_BVal_SizeOfWord; break;
537 }
538
539
540 /* Create a call to get the type tag */
541 foam = foamNew(FOAM_BCall, 1, bvTag);
542#endif
543
544
545 /* Return the result of the function call */
546 foam = foamNewReturn(foam)foamNew(FOAM_Return, 1, foam);
547 gen0AddStmt(foam, (AbSyn)NULL((void*)0));
548}
549
550
551localstatic FoamTag
552gen1ImplicitType(TForm tf)
553{
554 FoamTag result;
555
556
557 /* Get the FOAM type for this tform */
558 result = gen0Type(tf, (AInt *)NULL((void*)0));
559
560
561 /* Filter out things we can't handle */
562 switch (result)
563 {
564 /* Start with the cases we can handle */
565#if 0
566 case FOAM_Int8 : /* Fall through */
567 case FOAM_Int16 : /* Fall through */
568 case FOAM_Int32 : /* Fall through */
569 case FOAM_Int64 : /* Fall through */
570 case FOAM_Int128 : /* Fall through */
571#endif
572 case FOAM_Nil : /* Fall through */
573 case FOAM_Char : /* Fall through */
574 case FOAM_Bool : /* Fall through */
575 case FOAM_Byte : /* Fall through */
576 case FOAM_HInt : /* Fall through */
577 case FOAM_SInt : /* Fall through */
578 case FOAM_BInt : /* Fall through */
579 case FOAM_SFlo : /* Fall through */
580 case FOAM_DFlo : /* Fall through */
581 case FOAM_Word : /* Fall through */
582 case FOAM_Clos : /* Fall through */
583 case FOAM_Ptr : break;
584
585
586 /* These are the ones we cannot handle */
587 case FOAM_Rec : /* Fall through */
588 case FOAM_RRec : /* Fall through */
589 case FOAM_Arr : /* Fall through */
590 case FOAM_TR : /* Fall through */
591 default : result = FOAM_Word; break;
592 }
593
594
595 /* Return the tag */
596 return result;
597}
598
599
600/*
601 * Extract the value of the Rep syme. Assumes that
602 * there is only one Rep and that it is a type-valued
603 * constant.
604 */
605localstatic TForm
606gen1ImplicitRepValue(SymeList symes)
607{
608 Syme syme;
609 TForm result;
610
611
612 /* Get the Rep syme */
613 syme = gen1ImplicitRep(symes);
614
615
616 /* Drop out if we failed to find Rep */
617 if (!syme) return (TForm)NULL((void*)0);
618
619
620 /* Get the type of the syme */
621 result = symeType(syme);
622
623
624 /* Probably a define: get its value */
625 switch (tfTag(result)((result)->tag))
626 {
627 case TF_Assign:
628 result = tfAssignVal(result)tfFollowArg(result, 1);
629 break;
630 case TF_Define:
631 result = tfDefineVal(result)tfFollowArg(result, 1);
632 break;
633 default:
634 break;
635 }
636
637
638 /* Return the type */
639 return result;
640}
641
642
643/*
644 * Extract the Rep syme
645 */
646localstatic Syme
647gen1ImplicitRep(SymeList symes)
648{
649 /* Assume that there is only one Rep */
650 for (;symes;symes = cdr(symes)((symes)->rest))
651 {
652 Syme syme = car(symes)((symes)->first);
653
654 if (strEqual(symeString(syme)((((syme)->id))->str), "Rep"))
655 return syme;
656 }
657 return (Syme)NULL((void*)0);
658}
659
660
661/*
662 * Invent some absyn for the parameter list of a function.
663 */
664localstatic AbSyn
665ab0ImplicitExportArgs(TForm tf)
666{
667 /* How many parameters does this function have? */
668 Length numargs = tfIsMulti(tf)(((tf)->tag) == TF_Multiple) ? tfMultiArgc(tf) : 1;
669
670
671 /* Deal with single and multiple arguments separately */
672 if (numargs > 1)
673 {
674 /* Multiple arguments: (Comma ...) */
675 Length i;
676 AbSynList lst = listNil(AbSyn)((AbSynList) 0);
677
678
679 /* Create each argument */
680 for (i = 0; i < numargs; i++)
681 {
682 AbSyn arg = ab1ImplicitExportArg(i);
683 lst = listCons(AbSyn)(AbSyn_listPointer->Cons)(arg, lst);
684 }
685
686
687 /* Make sure that the list is in the right order */
688 lst = listNReverse(AbSyn)(AbSyn_listPointer->NReverse)(lst);
689
690
691 /* Return the absyn for the parameter list */
692 return abNewCommaL(sposNone, lst)abNewOfList(AB_Comma, sposNone,lst);
693 }
694 else
695 return ab1ImplicitExportArg((Length)0);
696}
697
698
699localstatic AbSyn
700ab1ImplicitExportArg(Length i)
701{
702 /* Create absyn for single argument */
703 Symbol sym;
704 AbSyn type, param;
705
706
707 /* Construct a name for this parameter. */
708 sym = gen0ImplicitArgName(i);
709
710
711 /* Create the absyn for the name and type */
712 param = abNewId(sposNone, sym)abNew(AB_Id, sposNone,1, sym);
713 type = abNewId(sposNone, symIntern("Word"))abNew(AB_Id, sposNone,1, symProbe("Word", 1 | 2));
714
715
716 /* Return the parameter declaration */
717 return abNewDeclare(sposNone, param, type)abNew(AB_Declare, sposNone,2, param,type);
718}
719
720
721/*
722 * Construct the parameter list for the function
723 */
724localstatic FoamList
725gen0ImplicitExportArgs(TForm tf)
726{
727 Foam par;
728 FoamList lst = listNil(Foam)((FoamList) 0);
729 Length i, numargs;
730
731
732 /* How many parameters does this function have? */
733 numargs = tfIsMulti(tf)(((tf)->tag) == TF_Multiple) ? tfMultiArgc(tf) : 1;
734
735
736 /* Deal with single and multiple arguments separately */
737 if (numargs > 1)
738 {
739 /* Process each argument */
740 for (i = 0;i < numargs;i++)
741 {
742 /* Get the next argument */
743 TForm t = tfMultiArgN(tf, i)tfFollowArg(tf, i);
744
745 par = gen1ImplicitExportArg(t, (Length)i);
746 lst = listCons(Foam)(Foam_listPointer->Cons)(par, lst);
747 }
748 }
749 else if (numargs == 1)
750 {
751 /* A single argument */
752 par = gen1ImplicitExportArg(tf, (Length)0);
753 lst = listCons(Foam)(Foam_listPointer->Cons)(par, lst);
754 }
755
756
757 /* Reverse the list and return it */
758 lst = listNReverse(Foam)(Foam_listPointer->NReverse)(lst);
759 return lst;
760}
761
762
763localstatic Foam
764gen1ImplicitExportArg(TForm tf, Length i)
765{
766 FoamTag fmtype;
767 Foam decl;
768 Symbol sym;
769 String symstr;
770
771
772 /* What was the name of this parameter? */
773 sym = gen0ImplicitArgName(i);
774 symstr = strCopy(symString(sym)((sym)->str));
775
776
777 /* What is the type of this argument? */
778 fmtype = gen0Type(tf, NULL((void*)0));
779
780
781 /* Create a declaration for this parameter */
782 decl = foamNewDecl(fmtype, symstr, emptyFormatSlot)foamNew(FOAM_Decl,4,(AInt)(fmtype),symstr, (AInt) (0x7FFF), 4
);
783
784
785 /* Add the new parameter to the FOAM prog */
786 gen0AddParam(decl);
787
788
789 /* Return the FOAM for this parameter */
790 return foamNewPar(i)foamNew(FOAM_Par, 1, (AInt)(i));
791}
792
793
794/*
795 * We need to invent names for parameters for the wrapper
796 * functions. We do this based on the argument number.
797 */
798localstatic Symbol
799gen0ImplicitArgName(Length i)
800{
801 char num[40];
802
803 (void)sprintf(num, "%s%d", "x", (int) i);
804 return symIntern(num)symProbe(num, 1 | 2);
805}
806
807
808/*
809 * Although not perfect, this table allows us to check if a given
810 * syme is an implicit export that we know about. It also gives us
811 * a tag to be used when deciding which FOAM body to constuct.
812 */
813struct gf_impl_info gfImplicitInfoTable[] =
814{
815 { GFI_PackedArrayNew, "PackedArrayNew", (Hash)( 230929250L) },
816 { GFI_PackedArrayGet, "PackedArrayGet", (Hash)( 504190320L) },
817 { GFI_PackedArraySet, "PackedArraySet", (Hash)( 7666178L) },
818 { GFI_PackedRecordSet, "PackedRecordSet", (Hash)( 278278893L) },
819 { GFI_PackedRecordGet, "PackedRecordGet", (Hash)( 632591839L) },
820 { GFI_PackedRepSize, "PackedRepSize", (Hash)( 932039034L) },
821};