Archive
arFrString(String name)
{
static Table tbl = 0;
Archive ar;
FileName fn;
arDEBUG(dbOut, "Looking for archive \"%s\"\n", name);
if (tbl == 0)
tbl = tblNew((TblHashFun) strAHash, (TblEqFun) strAEqual);
if ((ar = (Archive) tblElt(tbl, (TblKey) name, (TblElt) 0)) != 0)
return ar;
if ((fn = fileRdFind(libSearchPath(), name, FTYPE_AR_INT)) != 0)
ar = arRead(fn);
else if (fileIsOpenable((fn = arFileNameFrPath(name)), "r")) {
ar = arRead(fn);
}
else {
comsgWarning(NULL, ALDOR_W_CantUseArchive, name);
ar = 0;
}
tblSetElt(tbl, (TblKey) name, (TblElt) ar);
return ar;
}
AbSyn
compFileFront(EmitInfo finfo, Stab stab, FILE *fin, int *plno)
{
FileName fn = emitSrcFile(finfo);
AbSyn ab;
FTypeNo ft = ftypeNo(fnameType(fn));
if (ft == FTYPENO_OLDABSYN) {
comsgWarning(NULL, ALDOR_W_OldTypeAbsyn, cmdName);
}
if ((ft == FTYPENO_ABSYN) || (ft == FTYPENO_OLDABSYN)) {
ab = compPhaseLoadAbSyn(finfo);
}
else {
SrcLineList sll;
TokenList tl;
sll = compPhaseInclude(finfo, fin, plno);
fintGetInitCompTime();
if (!compIsMoreAfterInclude(finfo)) { inclFree(sll); return 0; }
tl = compPhaseScan (finfo, sll);
tl = compPhaseSysCmd (finfo, tl);
tl = compPhaseLinear (finfo, tl);
ab = compPhaseParse (finfo, tl);
inclFree(sll);
listFreeDeeply(Token)(tl,tokFree);
if (comsgErrorCount()) return ab;
}
ab = compPhaseAbNorm (finfo, ab, false);
ab = compPhaseMacEx (finfo, ab);
if (comsgErrorCount()) return ab;
ab = compPhaseAbNorm (finfo, ab, true);
ab = compPhaseAbCheck(finfo, ab); /* creates the .ax file */
if (!compIsMoreAfterSyntax(finfo)) return ab;
compPhaseScoBind(finfo, stab, ab);
if (comsgErrorCount()) {
if (fintMode == FINT_LOOP) scoSetUndoState();
return ab;
}
compPhaseTInfer (finfo, stab, ab);
if (comsgErrorCount()) {
if (fintMode == FINT_LOOP) scoSetUndoState();
return ab;
}
return ab;
}
/*
* Create an explicit export: see gen0DefineRhs and gen0Lambda
* for more details on how we do this. The code in gf_fortran may
* also be helpful.
*/
void
gen0ImplicitExport(Syme syme, SymeList context, AbSyn ab)
{
TForm tf;
FoamTag repTag;
Foam lhs, rhs, def;
/* What is the Rep of this domain? */
tf = gen1ImplicitRepValue(context);
/* Get the FOAM type for this Rep */
if (tf)
repTag = gen1ImplicitType(tf);
else
{
/* Raise an error because we can't find Rep */
comsgWarning(ab, ALDOR_E_GenImpNoRep);
/* Non-fatal so continue */
repTag = FOAM_Word;
}
/* Get the rhs of the export definition */
rhs = gen1ImplicitExport(syme, repTag);
if (!rhs) return;
/* Create the FOAM for the lhs */
lhs = gen0ExtendSyme(syme);
/*
* If this is a domain export then record the foam loc/lex
* used to hold the value of this syme.
*/
if (gen0IsDomLevel(gen0State->tag) && gen0State->tag != GF_File)
gen0SymeSetInit(syme, lhs);
/* Create a definition */
def = foamNewDef(lhs, rhs);
/* Not sure if this hackery is needed anymore */
def->foamDef.hdr.defnId = symeDefnNum(syme);
/* Add the definition to the code stream */
gen0AddStmt(def, (AbSyn)NULL);
}
local void
arFilter(Archive ar)
{
ArEntry arent0 = arFindEntry(ar, arCurrentFileName);
ArEntryList alist;
Bool precede = true;
String tmp;
if (arent0 == NULL)
return;
if (arent0->lib == NULL)
return;
tmp = libGetFileId(arent0->lib);
if (!strEqual(tmp, arCurrentFileId))
return;
arDEBUG(dbOut, "arFilter:\n");
comsgWarning(NULL, ALDOR_W_OverRideLibraryFile, arToString(ar));
arent0->mark = false;
for (alist = ar->members; alist; alist = cdr(alist)) {
ArEntry arent = car(alist);
libLibrarySyme(arEntryLib(ar, arent));
if (!arUseExpanded)
arent->mark = false;
else if (arent == arent0)
precede = false;
else if (precede)
arent->mark = true;
else
arFilterMarkExpanded(ar, arent);
}
if (!arUseExpanded) arFilterScanMember(ar, arent0);
}
/*
* Compile files controlled by the argument vector and
* return the total error count.
*/
int
compFilesLoop(int argc, char **argv)
{
int i, iargc, totErrors, nErrors;
FileName fn;
Bool isSolo;
compInit();
iargc = cmdArguments(1, argc, argv);
argc -= iargc;
argv += iargc;
if (argc == 0) {
if (comsgOkBreakLoop())
bloopMsgFPrintf(osStdout, ALDOR_W_NoFiles, cmdName);
comsgWarning(NULL, ALDOR_W_NoFiles, cmdName);
}
emitDoneOptions(argc, argv);
ccGetReady();
isSolo = (cmdFileCount == 1);
compFinfov = (EmitInfo *) stoAlloc((unsigned) OB_Other,
(cmdFileCount+1) * sizeof(EmitInfo));
for (i = 0; i <= cmdFileCount; i += 1) compFinfov[i] = 0;
totErrors = 0;
for (i = 0; i < cmdFileCount; i++) {
fn = fnameParse(argv[i]);
compFinfov[i] = emitInfoNew(fn);
nErrors = 0;
if (!fileIsReadable(fn)) {
if (comsgOkBreakLoop())
bloopMsgFPrintf(osStdout, ALDOR_F_CantOpen, argv[i]);
comsgFatal(NULL, ALDOR_F_CantOpen, argv[i]);
}
switch (ftypeNo(fnameType(fn))) {
#if 0
case FTYPENO_C:
nErrors = compCFile(compFinfov[i]);
break;
#endif
case FTYPENO_OBJECT:
case FTYPENO_AR_OBJ:
case FTYPENO_AR_INT:
break;
case FTYPENO_FOAMEXPR:
case FTYPENO_INTERMED:
if (!isSolo) fprintf(osStdout, "\n%s:\n", argv[i]);
nErrors = compSavedFile(compFinfov[i]);
break;
default:
if (!ftypeEqual(fnameType(fn), "")) {
if (comsgOkBreakLoop())
bloopMsgFPrintf(osStdout,
ALDOR_F_BadFType,
argv[i],
fnameType(fn),
FTYPE_SRC);
comsgFatal(NULL, ALDOR_F_BadFType, argv[i],
fnameType(fn), FTYPE_SRC);
}
/* Fall through. */
case FTYPENO_NONE:
case FTYPENO_SRC:
case FTYPENO_INCLUDED:
case FTYPENO_ABSYN:
case FTYPENO_OLDABSYN:
if (!isSolo) fprintf(osStdout, "\n%s:\n", argv[i]);
nErrors = compSourceFile(compFinfov[i]);
break;
}
totErrors += nErrors;
fnameFree(fn);
}
if (cmdFileCount > 0 && totErrors == 0) {
compFinfov[cmdFileCount] = emitInfoNewAXLmain();
compAXLmainFile(compFinfov[cmdFileCount]);
emitLink(cmdFileCount + 1, compFinfov);
argc -= cmdFileCount;
argv += cmdFileCount;
emitInterp(argc, argv);
emitRun (argc, argv);
}
if (totErrors > 0) emitAllDone();
for (i = 0; i < cmdFileCount + 1; i++) emitInfoFree(compFinfov[i]);
stoFree((Pointer) compFinfov);
compFinfov = 0;
if (!isSolo) phGrandTotals(cmdVerboseFlag);
compFini();
return totErrors;
}
AbSyn
abPutUse(AbSyn absyn, AbUse context)
{
int i, argc;
AbSyn parent;
AbUse con1;
if (!absyn) return absyn;
parent = current;
current = absyn;
switch (abTag(absyn)) {
case AB_Id:
case AB_LitInteger:
case AB_LitFloat:
case AB_LitString:
break;
case AB_Apply:
con1 = abIsApplyOf(absyn, ssymJoin) || abIsAnyMap(absyn)
? AB_Use_Type
: AB_Use_Value;
for (i = 0; i < abArgc(absyn); i++)
abPutUse(abArgv(absyn)[i], con1);
if (isFunnyEquals(context, absyn, parent))
comsgWarning(absyn, ALDOR_W_FunnyEquals);
break;
case AB_Default:
abPutUse(absyn->abDefault.body, AB_Use_Default);
break;
case AB_Define:
abPutUse(absyn->abDefine.lhs, AB_Use_Define);
abPutUse(absyn->abDefine.rhs, AB_Use_Value);
break;
case AB_Assign:
abPutUse(absyn->abAssign.lhs, AB_Use_Assign);
abPutUse(absyn->abAssign.rhs, AB_Use_Value);
break;
case AB_Declare:
abPutUse(absyn->abDeclare.id, context);
abPutUse(absyn->abDeclare.type, AB_Use_Type);
if (isFunnyColon(context, absyn, parent))
comsgWarning(absyn, ALDOR_W_FunnyColon);
break;
case AB_Label:
abPutUse(absyn->abLabel.label, AB_Use_Label);
abPutUse(absyn->abLabel.expr, context);
break;
case AB_Lambda:
case AB_PLambda:
abPutUse(absyn->abLambda.param, AB_Use_Declaration);
abPutUse(absyn->abLambda.rtype, AB_Use_Type);
abPutUse(absyn->abLambda.body, AB_Use_RetValue);
break;
case AB_Generate:
abPutUse(absyn->abGenerate.count,AB_Use_Value);
abPutUse(absyn->abGenerate.body, AB_Use_NoValue);
break;
case AB_Reference:
/* No idea what sort of use this ought to be ... */
abPutUse(absyn->abReference.body, AB_Use_Value);
break;
case AB_Add:
abPutUse(absyn->abAdd.base, AB_Use_Type);
abPutUse(absyn->abAdd.capsule, AB_Use_Declaration);
break;
case AB_With:
abPutUse(absyn->abWith.base, AB_Use_Type);
abPutUse(absyn->abWith.within, AB_Use_Declaration);
break;
case AB_Where:
abPutUse(absyn->abWhere.context,AB_Use_Declaration);
abPutUse(absyn->abWhere.expr, context);
break;
case AB_If:
abPutUse(absyn->abIf.test, AB_Use_Value);
abPutUse(absyn->abIf.thenAlt, context);
abPutUse(absyn->abIf.elseAlt, context);
break;
case AB_Exit:
abPutUse(absyn->abExit.test, AB_Use_Value);
abPutUse(absyn->abExit.value, context);
break;
case AB_Test:
abPutUse(absyn->abTest.cond, AB_Use_Value);
break;
case AB_Repeat:
argc = abRepeatIterc(absyn);
for (i = 0; i < argc; i++)
abPutUse(absyn->abRepeat.iterv[i], AB_Use_Iterator);
abPutUse(absyn->abRepeat.body, AB_Use_NoValue);
break;
case AB_While:
abPutUse(absyn->abWhile.test, AB_Use_Value);
break;
case AB_For:
abPutUse(absyn->abFor.lhs, AB_Use_Assign);
abPutUse(absyn->abFor.whole, AB_Use_Value);
abPutUse(absyn->abFor.test, AB_Use_Value);
break;
case AB_Local:
for (i = 0; i < abArgc(absyn); i++)
abPutUse(absyn->abLocal.argv[i], AB_Use_Declaration);
break;
case AB_Free:
for (i = 0; i < abArgc(absyn); i++)
abPutUse(absyn->abFree.argv[i], AB_Use_Declaration);
break;
case AB_Foreign:
abPutUse(absyn->abForeign.what, AB_Use_Declaration);
abPutUse(absyn->abForeign.origin, AB_Use_Type);
break;
case AB_Builtin:
abPutUse(absyn->abBuiltin.what, AB_Use_Declaration);
break;
case AB_Import:
abPutUse(absyn->abImport.what, AB_Use_Declaration);
abPutUse(absyn->abImport.origin, AB_Use_Type);
break;
case AB_Inline:
abPutUse(absyn->abInline.what, AB_Use_Declaration);
abPutUse(absyn->abInline.origin, AB_Use_Type);
break;
case AB_Export:
abPutUse(absyn->abExport.what, AB_Use_Declaration);
abPutUse(absyn->abExport.destination, AB_Use_Type);
break;
case AB_Extend:
abPutUse(absyn->abExtend.body, AB_Use_Declaration);
break;
case AB_Qualify:
abPutUse(absyn->abQualify.what, AB_Use_Value);
abPutUse(absyn->abQualify.origin, AB_Use_Type);
break;
case AB_RestrictTo:
abPutUse(absyn->abRestrictTo.expr, AB_Use_Value);
abPutUse(absyn->abRestrictTo.type, AB_Use_Type);
break;
case AB_PretendTo:
abPutUse(absyn->abPretendTo.expr, AB_Use_Value);
abPutUse(absyn->abPretendTo.type, AB_Use_Type);
break;
case AB_Comma:
for (i = 0; i < abArgc(absyn); i++)
abPutUse(abArgv(absyn)[i], context);
break;
case AB_Sequence:
argc = abArgc(absyn);
con1 = AB_Use_NoValue;
if (context == AB_Use_Declaration || context == AB_Use_Default)
con1 = context;
for (i = 0; i < argc; i++) {
AbSyn si = abArgv(absyn)[i];
Bool ex = abTag(si) == AB_Exit;
Bool last = (i == argc - 1);
AbUse au;
au = (ex || last) ? context : con1;
abPutUse(si, au);
}
break;
default:
if (!abIsLeaf(absyn))
for (i = 0; i < abArgc(absyn); i++)
abPutUse(abArgv(absyn)[i],AB_Use_Value);
break;
}
abUse(absyn) = context;
current = parent;
return absyn;
}
