void PutLine(void)
{
CARDINAL i;
if (linePosition != 0) {
PutCh(CR);
newLine[linePosition] = 0;
i = 0;
while (newLine[i] != 0) WriteCh(newLine[i++]);
linePosition = 0;
}; /* if */
} /* End PutLine */
// (<name1> <name2> ... <namen>) --> <dir>/<name1>-<name2>-...<namen>.<ext>
static FObject LibraryNameFlat(FObject dir, FObject nam, FObject ext)
{
FObject out = MakeStringOutputPort();
WriteSimple(out, dir, 1);
WriteCh(out, PathCh);
while (PairP(nam))
{
FAssert(SymbolP(First(nam)) || IntegerP(First(nam)));
WriteSimple(out, First(nam), 1);
nam = Rest(nam);
if (nam != EmptyListObject)
WriteCh(out, '-');
}
FAssert(nam == EmptyListObject);
WriteStringC(out, ".");
WriteSimple(out, ext, 1);
return(GetOutputString(out));
}
int main(int argc, char * argv[])
#endif // FOMENT_UNIX
{
int_t pdx = 0;
int adx = 1;
while (adx < argc)
{
if (StringCompareS(argv[adx], "-A") == 0)
adx += 2;
else if (StringCompareS(argv[adx], "-I") == 0)
adx += 2;
else if (StringCompareS(argv[adx], "-X") == 0)
adx += 2;
else if (argv[adx][0] != '-')
{
pdx = adx;
break;
}
else if (StringCompareS(argv[adx], "-no-inline-procedures") == 0)
{
InlineProcedures = 0;
adx += 1;
}
else if (StringCompareS(argv[adx], "-no-inline-imports") == 0)
{
InlineImports = 0;
adx += 1;
}
else if (StringCompareS(argv[adx], "--validate-heap") == 0)
{
ValidateHeap = 1;
adx += 1;
}
#ifdef FOMENT_WINDOWS
else if (StringCompareS(argv[adx], "--section-table") == 0)
{
adx += 1;
if (adx < argc)
{
#ifdef FOMENT_32BIT
SectionTableBase = (void *) wcstol(argv[adx], 0, 16);
#endif // FOMENT_32BIT
#ifdef FOMENT_64BIT
SectionTableBase = (void *) _wcstoui64(argv[adx], 0, 16);
#endif // FOMENT_64BIT
adx += 1;
}
}
#endif // FOMENT_WINDOWS
else if (StringCompareS(argv[adx], "--random-seed") == 0)
{
adx += 1;
if (adx < argc)
{
RandomSeed = StringToInt(argv[adx]);
adx += 1;
}
}
else
break;
}
FThreadState ts;
try
{
SetupFoment(&ts);
if (pdx > 0)
{
AddToLibraryPath(argv[pdx]);
}
}
catch (FObject obj)
{
printf("Unexpected exception: SetupFoment: %p\n", obj);
WriteSimple(R.StandardOutput, obj, 0);
if (ValidateHeap)
{
FailedGC();
FailedExecute();
}
return(1);
}
FAssert(argc >= 1);
try
{
int adx = 1;
while (adx < argc)
{
if (StringCompareS(argv[adx], "-A") == 0)
{
adx += 1;
if (adx == argc)
return(MissingArgument(argv[adx - 1]));
FObject lp = R.LibraryPath;
for (;;)
{
FAssert(PairP(lp));
if (Rest(lp) == EmptyListObject)
break;
lp = Rest(lp);
}
// AsPair(lp)->Rest = MakePair(MakeStringS(argv[adx]), EmptyListObject);
SetRest(lp, MakePair(MakeStringS(argv[adx]), EmptyListObject));
adx += 1;
}
else if (StringCompareS(argv[adx], "-I") == 0)
{
adx += 1;
if (adx == argc)
return(MissingArgument(argv[adx - 1]));
R.LibraryPath = MakePair(MakeStringS(argv[adx]), R.LibraryPath);
adx += 1;
}
else if (StringCompareS(argv[adx], "-X") == 0)
{
adx += 1;
if (adx == argc)
return(MissingArgument(argv[adx - 1]));
R.LibraryExtensions = MakePair(MakeStringS(argv[adx]), R.LibraryExtensions);
adx += 1;
}
else if (StringCompareS(argv[adx], "-no-inline-procedures") == 0
|| StringCompareS(argv[adx], "-no-inline-imports") == 0
|| StringCompareS(argv[adx], "--validate-heap") == 0)
adx += 1;
#ifdef FOMENT_WINDOWS
else if (StringCompareS(argv[adx], "--section-table") == 0)
adx += 2;
#endif // FOMENT_WINDOWS
else if (StringCompareS(argv[adx], "--random-seed") == 0)
adx += 2;
else if (argv[adx][0] != '-')
return(ProgramMode(adx, argc, argv));
else
break;
}
R.LibraryPath = ReverseListModify(MakePair(MakeStringC("."), R.LibraryPath));
R.CommandLine = MakePair(MakeInvocation(adx, argv),
MakeCommandLine(argc - adx, argv + adx));
ExecuteThunk(R.InteractiveThunk);
ExitFoment();
return(0);
// return(RunRepl(GetInteractionEnv()));
}
catch (FObject obj)
{
if (ExceptionP(obj) == 0)
WriteStringC(R.StandardOutput, "exception: ");
WriteSimple(R.StandardOutput, obj, 0);
WriteCh(R.StandardOutput, '\n');
if (ValidateHeap)
{
FailedGC();
FailedExecute();
}
return(-1);
}
}
FObject CompileProgram(FObject nam, FObject port)
{
FAssert(TextualPortP(port) && InputPortOpenP(port));
WantIdentifiersPort(port, 1);
FDontWait dw;
FObject env = MakeEnvironment(nam, FalseObject);
FObject prog = EmptyListObject;
FObject body = EmptyListObject;
try
{
for (;;)
{
FObject obj = Read(port);
if (obj == EndOfFileObject)
break;
if (PairP(obj) && EqualToSymbol(First(obj), R.CondExpandSymbol))
{
FObject ce = CondExpand(MakeSyntacticEnv(R.Bedrock), obj, Rest(obj));
if (ce != EmptyListObject)
prog = CondExpandProgram(ce, prog);
}
else
prog = MakePair(obj, prog);
}
prog = ReverseListModify(prog);
while (prog != EmptyListObject)
{
FAssert(PairP(prog));
FObject obj = First(prog);
if (PairP(obj) == 0)
break;
if (EqualToSymbol(First(obj), R.ImportSymbol))
EnvironmentImport(env, obj);
else if (EqualToSymbol(First(obj), R.DefineLibrarySymbol))
CompileLibrary(obj);
else
break;
prog = Rest(prog);
}
if (R.LibraryStartupList != EmptyListObject)
{
body = MakePair(MakePair(BeginSyntax, ReverseListModify(R.LibraryStartupList)), body);
R.LibraryStartupList = EmptyListObject;
}
while (prog != EmptyListObject)
{
FAssert(PairP(prog));
body = CompileEvalExpr(First(prog), env, body);
prog = Rest(prog);
}
}
catch (FObject obj)
{
if (ExceptionP(obj) == 0)
WriteStringC(R.StandardOutput, "exception: ");
Write(R.StandardOutput, obj, 0);
WriteCh(R.StandardOutput, '\n');
}
FObject proc = CompileLambda(env, NoValueObject, EmptyListObject, ReverseListModify(body));
UndefinedList = EmptyListObject;
EqHashMapVisit(AsEnvironment(env)->HashMap, Visit, NoValueObject);
if (UndefinedList != EmptyListObject)
RaiseExceptionC(R.Syntax, "program", "identifier(s) used but never defined",
List(UndefinedList, nam));
return(proc);
}
