local Archive
arNew(FileName fname, FILE *f)
{
Archive ar;
ar = (Archive) stoAlloc(OB_Archive, sizeof(*ar));
ar->name = fnameCopy(fname);
ar->hasFile = true;
ar->hasIntermed = false;
ar->file = f;
ar->format = 0;
ar->size = 0;
ar->item = 0;
ar->pos = 0;
ar->__next = 0;
ar->members = listNil(ArEntry);
ar->symes = listNil(Syme);
ar->names = strCopy(""); /* strCopy so we can strFree later */
return ar;
}
local SrcLineList
inclHandleLine(int lno, String fname)
{
if (INCLUDING(ifState)) {
fileState.lineNumber = lno - 1; /* The next line is 'lno' */
if (fname) {
fileState.curFile = fname;
/* rhx: We trust the programmer of the #line statement
in the .as file that the filename is correct.
If in an error case the file cannot be found the
compiler aborts with a (Fatal Error) message.
#1 (Fatal Error) Could not open file `dir/file.ext' with mode `r'.
It would actually be very helpful for a
programmer if we could abort the compilation
already here with an error message saying that
the filename appearing in the #line directive
cannot be found.
*/
fileState.curFname = fnameParse(fname);
}
sposGrowGloLineTbl(fileState.curFname, fileState.lineNumber,
inclSerialLineNo);
return listNil(SrcLine);
}
return listNil(SrcLine);
}
SymeList
symeTwins(Syme syme)
{
static SymeList symes0 = listNil(Syme);
SymeList symes;
if (symes0 == listNil(Syme))
symes0 = listCons(Syme)((Syme) NULL, symes0);
if (symeHasTrigger(syme) && symeHasLocal(syme, SYFI_Twins)) {
symeClrTrigger(syme);
libGetAllSymes(symeLib(syme));
}
/* Use symeFull(syme) as an implicit twin if present. */
symes = symeLocalTwins(syme);
if (symeFullTwin(syme)) {
Syme osyme = symeFull(syme);
if (symes == listNil(Syme)) {
setcar(symes0, osyme);
symes = symes0;
}
else if (!listMemq(Syme)(symes, osyme)) {
symes = listCons(Syme)(osyme, symes);
symeSetTwins(syme, symes);
}
}
return symes;
}
ErrorSet
errorSetNew(void)
{
ErrorSet errors = (ErrorSet) stoAlloc(OB_Other, sizeof(*errors));
errors->list = listNil(String);
errors->alloc = listNil(String);
return errors;
}
void
tcInit(void)
{
tcCount = 0;
tcSerialNum = 0;
tcStack = listNil(TConst);
if (DEBUG(tc)) {
tcList = listNil(TConst);
}
}
local SrcLineList
inclHandleUnassert(String property)
{
if (INCLUDING(ifState)) {
SrcLine sl = SysCmdLine(true);
INCL_Unassert(&localAssertList, property);
return addSysCmd(listNil(SrcLine), sl);
}
return listNil(SrcLine);
}
AbSynList
abqParseLines(StringList lines)
{
AbSynList result = listNil(AbSyn);
while (lines != listNil(String)) {
result = listCons(AbSyn)(abqParse(car(lines)), result);
lines = listFreeCons(String)(lines);
}
return listNReverse(AbSyn)(result);
}
local SrcLineList
inclHandleIncludeDir(String dname)
{
if (INCLUDING(ifState)) {
SrcLine sl = SysCmdLine(true);
if (scmdHandleIncludeDir(dname) == -1)
return botchSysCmd("includeDir");
return addSysCmd(listNil(SrcLine), sl);
}
return listNil(SrcLine);
}
static StringList
uclConstructOptList(String name, StringList given)
{
StringList res;
String flag;
String tmp;
Bool sep;
flag = cfgLookupString(name, uclOptions);
tmp = strConcat(name, "-sep");
sep = cfgLookupBoolean(tmp, uclOptions);
strFree(tmp);
res = listNil(String);
while (given) {
if (sep) {
res = listCons(String)(flag, res);
res = listCons(String)(car(given), res);
}
else {
tmp = strConcat(flag, car(given));
res = listCons(String)(tmp, res);
}
given = cdr(given);
}
return listNReverse(String)(res);
}
local SrcLineList
inclHandleElse(void)
{
SrcLine sl = SysCmdLine(true);
if (ifState == NoIf)
return addSysCmd(inclError(ALDOR_E_InclUnbalElse), sl);
else if (ifState == ActiveIf) {
ifState = InactiveIf;
return addSysCmd(listNil(SrcLine), sl);
}
else if (ifState == InactiveIf) {
ifState = ActiveIf;
return addSysCmd(listNil(SrcLine), sl);
}
return listNil(SrcLine);
}
static StringList
uclGetPostLinkOptions()
{
StringList res;
Bool flg;
res = listNil(String);
flg = cfgLookupBoolean("expand-libs", uclOptions);
if (flg) {
String ext = cfgLookupString("lib-ext", uclOptions);
res = uclExpandLibs(uclLibPath, uclLibraries, ext);
}
else {
/* -L */
res = listNConcat(String)(res, uclConstructOptList("libpath", uclLibPath));
/* -l */
res = listNConcat(String)(res, uclConstructOptList("library", uclLibraries));
}
if (uclFortran) {
StringList lst = cfgLookupStringList("fortran-libraries", uclOptions);
res = listNConcat(String)(res, lst);
}
return res;
}
/*
* Invent some absyn for the parameter list of a function.
*/
local AbSyn
ab0ImplicitExportArgs(TForm tf)
{
/* How many parameters does this function have? */
Length numargs = tfIsMulti(tf) ? tfMultiArgc(tf) : 1;
/* Deal with single and multiple arguments separately */
if (numargs > 1)
{
/* Multiple arguments: (Comma ...) */
Length i;
AbSynList lst = listNil(AbSyn);
/* Create each argument */
for (i = 0; i < numargs; i++)
{
AbSyn arg = ab1ImplicitExportArg(i);
lst = listCons(AbSyn)(arg, lst);
}
/* Make sure that the list is in the right order */
lst = listNReverse(AbSyn)(lst);
/* Return the absyn for the parameter list */
return abNewCommaL(sposNone, lst);
}
else
return ab1ImplicitExportArg((Length)0);
}
FreeVar
fvFrSymes(SymeList symes)
{
FreeVar fv;
if (symes == listNil(Syme))
fv = fvEmpty();
else if (cdr(symes) == listNil(Syme)) {
fv = fvSingleton(car(symes));
listFree(Syme)(symes);
}
else
fv = fvFrTheSymes(symes);
return fv;
}
static StringList
uclGetGeneralCompileOptions()
{
StringList res;
res = listNil(String);
/* -I */
res = listNConcat(String)(res, uclConstructOptList("include", uclIncludePath));
/* -D */
res = listNConcat(String)(res, uclConstructOptList("define", uclDefines));
/* -U */
res = listNConcat(String)(res, uclConstructOptList("undefine", uclUnDefines));
if (uclDebug)
res = listNConcat(String)(res, cfgLookupStringList(uclGetKeyName("debug"), uclOptions));
if (uclProfile)
res = listNConcat(String)(res, cfgLookupStringList(uclGetKeyName("profile"), uclOptions));
if (uclOptimize) {
if (!uclFloatNonStd)
res = listNConcat(String)(res, cfgLookupStringList(uclGetKeyName("optimize"),
uclOptions));
else
res = listNConcat(String)(res, cfgLookupStringList(uclGetKeyName("non-std-float"),
uclOptions));
}
if (uclOutputFile)
res = listNConcat(String)(res,
uclConstructOptList("output-name",
listSingleton(String)(uclOutputFile)));
return res;
}
local SrcLineList
inclHandleUnknown(void)
{
if (INCLUDING(ifState)) {
SrcLine sl = SysCmdLine(false);
return addSysCmd(listNil(SrcLine), sl);
}
else {
SrcPos spos = sposNew(fileState.curFname,
fileState.lineNumber,
inclSerialLineNo,
1);
scmdCheck(spos, curLineString);
}
return listNil(SrcLine);
}
SefoList
symeCondition(Syme syme)
{
/* Ignore the conditions if needed for syme equality tests. */
if (symePopConds(syme)) return listNil(Sefo);
return (SefoList) symeGetField(syme, SYFI_Condition);
}
local SrcLineList
inclHandleIf(String property)
{
Scope("inclHandleIf");
IfState fluid(ifState);
SrcLineList result = listNil(SrcLine);
if (INCLUDING(ifState)) {
SrcLine sl = SysCmdLine(true);
if (INCL_IsAssert(&localAssertList, property)) {
ifState = ActiveIf;
result = addSysCmd(inclFileContents(),sl);
}
else {
ifState = InactiveIf;
result = addSysCmd(inclFileContents(),sl);
}
}
else {
ifState = FormerlyActiveIf;
result = inclFileContents();
}
Return(result);
}
static void
ccPushArguments(StringList lst)
{
while (lst != listNil(String)) {
ccPushArgument(car(lst));
lst = cdr(lst);
}
}
TPoss
tpossMulti(Length argc, Pointer argv, TPossGetter get)
{
TPoss tp = tpossEmpty();
tposs0Multi(tp, argc, listNil(TForm), argc, argv, get);
return tp;
}
TPoss
tpossEmpty(void)
{
TPoss tp = tpossAlloc();
tp->possl = listNil(TForm);
tp->possc = 0;
tp->refc = 1;
return tp;
}
/*
* Handle the include directive if we are in an active section
*/
local SrcLineList
inclHandleInclude(String fname)
{
if (INCLUDING(ifState)) {
SrcLine sl = SysCmdLine(true);
return addSysCmd(inclFile(fname, false, false, NULL), sl);
}
return listNil(SrcLine);
}
/*
* Usage: showexports libName type-expression
* Example: showexports libaldor.al 'List(Integer)'
*/
int
main(int argc, char *argv[])
{
osInit();
sxiInit();
keyInit();
ssymInit();
dbInit();
stabInitGlobal();
tfInit();
foamInit();
optInit();
tinferInit();
pathInit();
sposInit();
ablogInit();
comsgInit();
macexInitFile();
comsgInit();
scobindInitFile();
stabInitFile();
fileAddLibraryDirectory(".");
String archive = argv[1];
String expression = argv[2];
scmdHandleLibrary("LIB", archive);
AbSyn ab = shexpParse(expression);
Stab stab = stabFile();
Syme syme = stabGetArchive(symInternConst("LIB"));
AbSyn arAbSyn = abNewId(sposNone, symInternConst("LIB"));
stabImportTForm(stab, tiGetTForm(stab, arAbSyn));
abPutUse(ab, AB_Use_Value);
scopeBind(stab, ab);
typeInfer(stab, ab);
TForm tf = tiGetTForm(stab, ab);
SymeList list = tfStabGetDomImports(stab, tf);
for (; list != listNil(Syme); list = cdr(list)) {
Syme syme = car(list);
aprintf("%s %d %d %s\n", symeString(syme),
symeDefnNum(syme), symeConstNum(syme), tfPretty(symeType(syme)));
}
scobindFiniFile();
stabFiniFile();
comsgFini();
macexFiniFile();
}
AbSyn
abqParseLinesAsSeq(StringList lines)
{
SrcLineList sll = listNil(SrcLine);
while (lines != listNil(String))
{
char *p = car(lines);
lines = cdr(lines);
int indent;
while (*p == ' ') { p++; indent++; }
String tmp = strConcat(p, "\n");
SrcLine line = slineNew(sposNone, indent, tmp);
strFree(tmp);
sll = listCons(SrcLine)(line, sll);
}
return abqParseSrcLines(listNReverse(SrcLine)(sll));
}
/*
* Conses (reversed) lines for the file.
*/
local SrcLineList
inclFileContents(void)
{
SrcLineList sll = listNil(SrcLine);
while (inclLine(&sll, (InclIsContinuedFun) NULL))
;
return sll;
}
static void
initState(String argv0)
{
uclIsCompileOnly = false;
uclIsLink = false;
uclOptimize = false;
uclDebug = false;
uclProfile = false;
uclFortran = false;
uclStdc = false;
uclFileList = listNil(String);
uclIncludePath = listNil(String);
uclDefines = listNil(String);
uclUnDefines = listNil(String);
uclOptFile = NULL;
cfgSetCondFunc(uclCheckCondition);
initPath(argv0);
}
VarPool
vpNew(FoamBox fbox)
{
VarPool newVP = (VarPool) stoAlloc(OB_Other, sizeof(struct varPool));
int i;
newVP->fbox = fbox;
for(i=0; i<FOAM_LIMIT; i++)
newVP->vars[i] = listNil(AInt);
return newVP;
}
local SrcLineList
inclHandleElseif(String property)
{
SrcLine sl = SysCmdLine(true);
if (ifState == NoIf)
return addSysCmd(inclError(ALDOR_E_InclUnbalElseif), sl);
if (ifState == InactiveIf) {
if (INCL_IsAssert(&localAssertList, property))
ifState = ActiveIf;
return addSysCmd(listNil(SrcLine), sl);
}
else {
if (ifState == ActiveIf) {
ifState = FormerlyActiveIf;
return addSysCmd(listNil(SrcLine), sl);
}
ifState = FormerlyActiveIf;
}
return listNil(SrcLine);
}
FreeVar
fvEmpty(void)
{
static FreeVar fv = 0;
if (fv == 0)
fv = fvFrTheSymes(listNil(Syme));
assert(fv);
return fv;
}
local SrcLineList
inclHandleEndif(void)
{
SrcLine sl = SysCmdLine(true);
sl->isEndifLine = true;
if (ifState == NoIf)
return addSysCmd(inclError(ALDOR_E_InclUnbalEndif), sl);
if (ifState == ActiveIf || ifState == InactiveIf)
return addSysCmd(listNil(SrcLine), sl);
return EndifLine;
}
TfCond
tfCondNew()
{
TfCond tfcond = (TfCond) stoAlloc(OB_Other, sizeof(*tfcond));
tfcond->conditions = listNil(TfCondElt);
tfcond->containsEmpty = false;
tfcond->known = ablogFalse();
return tfcond;
}