/* * 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; }