/*
* We need to invent names for parameters for the wrapper
* functions. We do this based on the argument number.
*/
local Symbol
gen0ImplicitArgName(Length i)
{
char num[40];
(void)sprintf(num, "%s%d", "x", (int) i);
return symIntern(num);
}
local SExpr
gliPlainGlo(Foam foam)
{
Foam decl = gl0GetDecl(foam);
String str = decl->foamGDecl.id;
return sxiFrSymbol(symIntern(str));
}
Syme
uniqueMeaning(Stab stab, String s)
{
SymeList symesForString = stabGetMeanings(stab, ablogTrue(), symIntern(s));
testIsNull("", cdr(symesForString));
Syme d = car(symesForString);
return d;
}
/* statement */
Symbol
statement(char *name, Expr *x)
{
Symbol s;
/* error guard */
if (x == NULL) return NULL;
/* if name not given, make one up */
if (name == NULL) name = nameGen();
/* the parsed object is a rule (expression to evaluate) */
if (x->op != NOP) {
if (symLookup(&rules, name)) {
synerr();
fprintf(stderr, "rule \"%s\" multiply defined\n", name);
freeExpr(x);
return NULL;
}
else {
if (errs == 0) {
postExpr(x);
s = symIntern(&rules, name);
}
else return NULL;
}
}
/* the parsed object is a non-rule */
else {
if ( (s = symLookup(&vars, name)) )
freeExpr(symValue(s));
else
s = symIntern(&vars, name);
}
symValue(s) = x;
return s;
}
void dstructInit(void)
{
Expr *x;
double zero = 0.0;
/* not-a-number initialization */
mynan = zero / zero;
/* set up symbol tables */
symSetTable(&hosts);
symSetTable(&metrics);
symSetTable(&rules);
symSetTable(&vars);
/* set yp inter-sample interval (delta) symbol */
symDelta = symIntern(&vars, "delta");
x = newExpr(OP_VAR, NULL,NULL, -1, -1, -1, 1, SEM_NUMVAR);
x->smpls[0].ptr = δ
x->valid = 1;
symValue(symDelta) = x;
/* set up time symbols */
symMinute = symIntern(&vars, "minute");
x = newExpr(OP_VAR, NULL,NULL, -1, -1, -1, 1, SEM_NUMVAR);
x->smpls[0].ptr = &minute;
x->valid = 1;
symValue(symMinute) = x;
symHour = symIntern(&vars, "hour");
x = newExpr(OP_VAR, NULL,NULL, -1, -1, -1, 1, SEM_NUMVAR);
x->smpls[0].ptr = &hour;
x->valid = 1;
symValue(symHour) = x;
symDay = symIntern(&vars, "day");
x = newExpr(OP_VAR, NULL,NULL, -1, -1, -1, 1, SEM_NUMVAR);
x->smpls[0].ptr = &day;
x->valid = 1;
symValue(symDay) = x;
symMonth = symIntern(&vars, "month");
x = newExpr(OP_VAR, NULL,NULL, -1, -1, -1, 1, SEM_NUMVAR);
x->smpls[0].ptr = &month;
x->valid = 1;
symValue(symMonth) = x;
symYear = symIntern(&vars, "year");
x = newExpr(OP_VAR, NULL,NULL, -1, -1, -1, 1, SEM_NUMVAR);
x->smpls[0].ptr = &year;
x->valid = 1;
symValue(symYear) = x;
symWeekday = symIntern(&vars, "day_of_week");
x = newExpr(OP_VAR, NULL,NULL, -1, -1, -1, 1, SEM_NUMVAR);
x->smpls[0].ptr = &weekday;
x->valid = 1;
symValue(symWeekday) = x;
}
local AbSyn
ab1ImplicitExportArg(Length i)
{
/* Create absyn for single argument */
Symbol sym;
AbSyn type, param;
/* Construct a name for this parameter. */
sym = gen0ImplicitArgName(i);
/* Create the absyn for the name and type */
param = abNewId(sposNone, sym);
type = abNewId(sposNone, symIntern("Word"));
/* Return the parameter declaration */
return abNewDeclare(sposNone, param, type);
}
/*
* Create the symbol for an identifier, given the level, index and string
*/
local SExpr
gl0Id(FoamTag tag, int idx, String str)
{
String buf;
if (*str)
switch (tag) {
case FOAM_Glo: buf = strPrintf("G-%s", str); break;
case FOAM_Const: buf = strPrintf("C%d-%s", idx, str); break;
case FOAM_Par: buf = strPrintf("P%d-%s", idx, str); break;
case FOAM_Loc: buf = strPrintf("T%d-%s", idx, str); break;
default: bugBadCase(tag); NotReached(buf = 0);
}
else
switch (tag) {
case FOAM_Glo: bugBadCase(tag); NotReached(buf = 0); break;
case FOAM_Const: buf = strPrintf("C%d", idx); break;
case FOAM_Par: buf = strPrintf("P%d", idx); break;
case FOAM_Loc: buf = strPrintf("T%d", idx); break;
default: bugBadCase(tag); NotReached(buf = 0);
}
return sxiFrSymbol(symIntern(buf));
}
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;
}
/* fetch expression */
Expr *
fetchExpr(char *mname,
StringArray hnames,
StringArray inames,
Interval times)
{
Expr *x;
Metric *marr, *m;
int fsz, dsz;
int sum;
int i;
/* calculate samplecounts for fetch and delay */
if (times.t1 == 0) {
fsz = times.t2 - times.t1 + 1;
dsz = 0;
}
else {
fsz = times.t1 + 1;
dsz = times.t2 - times.t1 + 1;
}
/* default host */
if (hnames.n == 0) {
hnames.n = 1;
}
/* construct Metrics array */
marr = m = (Metric *) zalloc(hnames.n * sizeof(Metric));
sum = 0;
for (i = 0; i < hnames.n; i++) {
m->mname = symIntern(&metrics, mname);
if (hnames.ss) {
/* Explicitly specified host name, but is it a
hostname or a connection-string? Depends on
whether we're in archive-mode or not! In
archive-mode, it's a host name, which we resolve
to the archive file name by a search; if in
live-mode, it's a connection string. */
if (archives) {
m->hname = symIntern(&hosts, hnames.ss[i]);
Archive *a = archives;
while (a) { /* find archive for host */
if (strcmp(a->hname, hnames.ss[i]) == 0)
break;
a = a->next;
}
if (a)
m->hconn = symIntern(&hosts, a->fname);
else
m->hconn = symIntern(&hosts, "unknown archive");
}
else {
m->hconn = symIntern(&hosts, hnames.ss[i]);
/* We don't know the host name yet. We don't really want to
connect at this time just to fish it out. See newContext. */
m->hname = symIntern(&hosts, "");
}
}
else {
m->hconn = symIntern(&hosts, dfltHostConn);
m->hname = symIntern(&hosts, ""); /* Filled in at newContext. */
}
m->desc.sem = SEM_UNKNOWN;
m->m_idom = -1;
if (inames.n > 0) {
m->specinst = inames.n;
m->iids = alloc(inames.n * sizeof(int));
m->inames = inames.ss;
}
else {
m->specinst = 0;
m->iids = NULL;
m->inames = NULL;
}
if (errs == 0) {
int sts = initMetric(m);
if (sts < 0) errs++;
if (m->m_idom > 0)
sum += m->m_idom;
}
m++;
}
if (sum == 0)
sum = -1;
/* error exit */
if (errs) {
m = marr;
for (i = 0; i < hnames.n; i++) {
if (m->iids) free(m->iids);
m++;
}
free(marr);
return NULL;
}
/* construct fetch node */
x = newExpr(CND_FETCH, NULL, NULL, hnames.n, sum, fsz, fsz, SEM_UNKNOWN);
newRingBfr(x);
x->metrics = marr;
findEval(x);
instFetchExpr(x);
/* patch in fetch node reference in each Metric */
m = marr;
for (i = 0; i < hnames.n; i++) {
m->expr = x;
m++;
}
/* construct delay node */
if (dsz) {
x = newExpr(CND_DELAY, x, NULL, x->hdom, x->e_idom, dsz, dsz, SEM_UNKNOWN);
newRingBfr(x);
findEval(x);
}
return x;
}
void
ssymInit(void)
{
static Bool isInit = false;
if (isInit) return;
/*
* Symbols for Foam types.
*/
ssymArr = symIntern("Arr");
ssymBInt = symIntern("BInt");
ssymBool = symIntern("Bool");
ssymByte = symIntern("XByte");
ssymChar = symIntern("Char");
ssymDFlo = symIntern("DFlo");
ssymHInt = symIntern("HInt");
ssymNil = symIntern("Nil");
ssymPtr = symIntern("Ptr");
ssymSFlo = symIntern("SFlo");
ssymSInt = symIntern("SInt");
/*
* Symbols for Aldor types we care about.
*/
ssymBoolean = symIntern("Boolean");
ssymCategory = symIntern("Category");
ssymCross = symIntern("Cross");
ssymDelayed = symIntern("Delayed");
ssymEnum = symIntern("Enumeration");
ssymExit = symIntern("Exit");
ssymGenerator = symIntern("Generator");
ssymJoin = symIntern("Join");
ssymLiteral = symIntern("Literal");
ssymMachineInteger= symIntern("MachineInteger");
ssymMap = symIntern("Map");
ssymMeet = symIntern("Meet");
ssymPackedMap = symIntern("PackedMap");
ssymPointer = symIntern("Pointer");
ssymRaw = symIntern("Raw");
ssymRawRecord = symIntern("RawRecord");
ssymRecord = symIntern("Record");
ssymReference = symIntern("Ref");
ssymSelf = symIntern("%");
ssymSelfSelf = symIntern("%%");
ssymTest = symIntern("Test");
ssymTextWriter = symIntern("TextWriter");
ssymTrailingArray = symIntern("TrailingArray");
ssymThird = symIntern("Third");
ssymTuple = symIntern("Tuple");
ssymType = symIntern("Type");
ssymUnion = symIntern("Union");
ssymVariable = symIntern("?");
/*
* Symbols for operation names we care about.
*/
ssymArrow = symIntern("->");
ssymApply = symIntern("apply");
ssymBrace = symIntern("brace");
ssymBracket = symIntern("bracket");
ssymCoerce = symIntern("coerce");
ssymEquals = symIntern("=");
ssymNotEquals = symIntern("~=");
ssymPackedArrow = symIntern("->*");
ssymPrint = symIntern("<<");
ssymSetBang = symIntern("set!");
ssymTheCase = symIntern("case");
ssymTheDispose = symIntern("dispose!");
ssymTheExplode = symIntern("explode");
ssymTheFloat = symIntern("float");
ssymTheInteger = symIntern("integer");
ssymTheJava = symIntern("java");
ssymTheJavaDecoder= symIntern("avaj");
ssymTheGenerator = symIntern("generator");
ssymTheNew = symIntern("new");
ssymTheRawRecord = symIntern("rawrecord");
ssymTheRecord = symIntern("record");
ssymTheStdout = symIntern("stdout");
ssymTheString = symIntern("string");
ssymTheTest = symIntern("test");
ssymTheTrailingArray= symIntern("trailing");
ssymTheUnion = symIntern("union");
/*
* Symbols naming function interfaces.
*/
ssymBasic = symIntern("Basic");
ssymBuiltin = symIntern("Builtin");
ssymForeign = symIntern("Foreign");
ssymC = symIntern("C");
ssymFortran = symIntern("Fortran");
ssymJava = symIntern("Java");
ssymLisp = symIntern("Lisp");
ssymMachine = symIntern("Machine");
/*
* Symbols of attributes we like to know about. This is
* mainly used for Fortran-specific types.
*/
ssymFtnSInt = symIntern("FortranInteger");
ssymFtnSFlo = symIntern("FortranReal");
ssymFtnDFlo = symIntern("FortranDouble");
ssymFtnSCpx = symIntern("FortranComplexReal");
ssymFtnDCpx = symIntern("FortranComplexDouble");
ssymFtnBool = symIntern("FortranLogical");
ssymFtnXStr = symIntern("FortranString");
ssymFtnFSA = symIntern("FortranFStringArray");
ssymFtnFStr = symIntern("FortranFString");
ssymFtnChar = symIntern("FortranCharacter");
ssymFtnArry = symIntern("FortranArray");
/*
* Symbols for implicit category stuff
*/
ssymImplPAOps = symIntern("DenseStorageCategory");
/*
* Symbols for Foam arrays and records.
*/
ssymArrNew = symIntern("ArrNew");
ssymArrElt = symIntern("ArrElt");
ssymArrSet = symIntern("ArrSet");
ssymArrDispose = symIntern("ArrDispose");
ssymRawRecNew = symIntern("RawRecNew");
ssymRawRecSet = symIntern("RawRecSet");
ssymRawRecElt = symIntern("RawRecElt");
ssymRecNew = symIntern("RecNew");
ssymRecElt = symIntern("RecElt");
ssymRecSet = symIntern("RecSet");
ssymTRNew = symIntern("TRNew");
ssymTRElt = symIntern("TRElt");
ssymIRElt = symIntern("IRElt");
ssymRawRecDispose= symIntern("RawRecDispose");
ssymRecDispose = symIntern("RecDispose");
ssymBIntDispose = symIntern("BIntDispose");
isInit = true;
}
