Hash
symeTypeCode(Syme syme)
{
Hash h = 0;
h = symeHash(syme);
if (h) return h;
tfHashDEBUG(dbOut, "Hash: %s %pSyme %pTForm\n",
symeString(syme), syme, symeType(syme));
if (symeIsExport(syme) || symeIsParam(syme) || symeIsSelf(syme)) {
h = tfHash(symeType(syme));
symeHashArg(h, (Hash) symeKind(syme));
symeHashArg(h, symeDefLevel(syme)->hash);
}
else if (symeIsImport(syme)) {
h = tfHash(symeType(syme));
symeHashArg(h, tfHash(symeExporter(syme)));
}
else {
h = tfHash(symeType(syme));
symeHashArg(h, symeDefLevel(syme)->hash);
}
tfHashDEBUG(dbOut, "Hash: %s %pSyme = %d\n",
symeString(syme), syme, h);
return symeSetHash(syme, h);
}
Hash
gen0SymeTypeCode(Syme syme)
{
if (symeExtension(syme))
return gen0SymeTypeCode(symeExtension(syme));
else if (symeIsLazy(syme) && symeIsImport(syme))
return symeHash(syme);
else
return tfHash(symeType(symeOriginal(syme)));
}
local Foam
gen1ImplicitExport(Syme syme, FoamTag repTag)
{
TForm tf, tfret;
AInt retfmt, index;
Foam foam, clos;
FoamTag retType;
AbSyn params, oldex, id;
FoamList pars;
Length i, gfTag;
GenFoamState saved;
Hash hash;
/* Paranoia */
assert(syme);
/* Get the type of this syme */
tf = symeType(syme);
assert (tfIsMap(tf));
/* Name of the export */
gen0ProgName = strCopy(symeString(syme));
/* Type hash code */
hash = tfHash(tf);
/* Is this something we know about? */
for (i = gfTag = 0;(i < GFI_LIMIT) && !gfTag; i++)
{
struct gf_impl_info *e = &gfImplicitInfoTable[i];
if (e->type != hash) continue;
if (!strEqual(e->name, gen0ProgName)) continue;
gfTag = i + 1;
}
/* Did we recognise it? */
if (!gfTag)
{
bug("[%s] %s#%ld not recognised\n",
"gen1ImplicitExport", gen0ProgName, hash);
return (Foam)NULL;
}
else
gfTag--;
/* Note the function signature */
tfret = tfMapRet(tf);
retType = gen0Type(tfret, &retfmt);
/* Fake up a bit of absyn */
id = abNewId(sposNone, symIntern(gen0ProgName));
abSetDefineIdx(id, symeDefnNum(syme));
/* Not sure if we need this ... */
oldex = gen0ProgPushExporter(id);
/* Deal with const number */
/* gen0AddConst(symeConstNum(syme), gen0NumProgs); */
genSetConstNum(syme, abDefineIdx(id), (UShort) gen0NumProgs, true);
/* Create a closure for the function */
clos = gen0ProgClosEmpty();
foam = gen0ProgInitEmpty(gen0ProgName, id);
/* What format number are we using? */
index = gen0FormatNum;
/* Save the current state */
saved = gen0ProgSaveState(PT_ExFn);
/*
* Deal with special return types. None of these
* ought to appear at the moment but there is no
* point in creating extra work for the future.
*/
if (tfIsMulti(tfret))
retfmt = gen0MultiFormatNumber(tfret);
if (tfIsGenerator(tfret))
foamProgSetGenerator(foam);
/* Create the parameters for this function */
params = ab0ImplicitExportArgs(tfMapArg(tf));
/* Initialise the program state */
gen0State->type = tf;
gen0State->param = params;
gen0State->program = foam;
/* Not sure if we really need this ... see below */
#ifdef PUSH_FORAMTS
gen0PushFormat(index);
#endif
/* Create the parameter list */
pars = gen0ImplicitExportArgs(tfMapArg(tf));
/* Generate code for the body of this export */
switch (gfTag)
{
case GFI_PackedArrayNew:
gen0ImplicitPANew(pars, repTag);
break;
case GFI_PackedArrayGet:
gen0ImplicitPAGet(pars, repTag);
break;
case GFI_PackedArraySet:
gen0ImplicitPASet(pars, repTag);
break;
case GFI_PackedRecordSet:
gen0ImplicitPRSet(pars, repTag);
break;
case GFI_PackedRecordGet:
gen0ImplicitPRGet(pars, repTag);
break;
case GFI_PackedRepSize:
gen0ImplicitPRSize(pars, repTag);
break;
default:
bug("[%s] GFI tag #%d not recognised\n",
"gen1ImplicitExport", gfTag);
}
#ifdef PUSH_FORAMTS
gen0ProgAddFormat(index);
gen0ProgFiniEmpty(foam, retType, retfmt);
#else
/*
* Finish off the FOAM creation. Note that we want to
* use a basic machine type for the return type of this
* function so that Fortran can understand the result.
* This means we use `rtype' in gen0ProgFiniEmpty()
* rather than `retType' which we would do normally.
*/
gen0UseStackedFormat(int0); /* These two lines provide a format */
gen0ProgPushFormat(int0); /* for the lexical argument `op' */
gen0ProgFiniEmpty(foam, retType, retfmt);
#endif
/* Optimisation bits */
/* foam->foamProg.infoBits = IB_INLINEME; */
foamOptInfo(foam) = inlInfoNew(NULL, foam, NULL, false);
/* Compute side-effects of this foam */
/* gen0ComputeSideEffects(foam); */
/* Restore the saved state before returning */
gen0ProgRestoreState(saved);
return clos;
}
