MostAlignedType *
compStoreError(int errnum)
{
int stoerr;
switch (errnum) {
case StoErr_OutOfMemory:
stoerr = ALDOR_F_StoOutOfMemory;
break;
case StoErr_UsedNonalloc:
stoerr = ALDOR_F_StoUsedNonalloc;
break;
case StoErr_CantBuild:
stoerr = ALDOR_F_StoCantBuild;
break;
case StoErr_FreeBad:
stoerr = ALDOR_F_StoFreeBad;
break;
default:
bugBadCase(errnum);
NotReached(stoerr = 0);
}
if (comsgOkBreakLoop())
bloopMsgFPrintf(osStdout, stoerr);
comsgFatal(NULL, stoerr);
NotReached(return 0);
}
/*
* Get the declaration object for a global, parameter or local.
*/
local Foam
gl0GetDecl(Foam foam)
{
int ix;
Foam decl;
switch (foamTag(foam)) {
case FOAM_Glo:
ix = foam->foamGlo.index;
decl = glvDGlo->foamDDecl.argv[ix];
break;
case FOAM_Const:
ix = foam->foamConst.index;
decl = glvDConst->foamDDecl.argv[ix];
break;
case FOAM_Par:
ix = foam->foamPar.index;
decl = glvDPar->foamDDecl.argv[ix];
break;
case FOAM_Loc:
ix = foam->foamLoc.index;
decl = glvDLoc->foamDDecl.argv[ix];
break;
default:
bugBadCase(foamTag(foam));
NotReached(decl = 0);
}
assert(foamTag(decl) == FOAM_Decl || foamTag(decl) == FOAM_GDecl);
return decl;
}
String
ftypeString(FTypeNo ftype)
{
switch (ftype) {
case FTYPENO_SRC: return FTYPE_SRC;
case FTYPENO_INCLUDED: return FTYPE_INCLUDED;
case FTYPENO_ABSYN: return FTYPE_ABSYN;
case FTYPENO_OLDABSYN: return FTYPE_OLDABSYN;
case FTYPENO_INTERMED: return FTYPE_INTERMED;
case FTYPENO_FOAMEXPR: return FTYPE_FOAMEXPR;
case FTYPENO_SYMEEXPR: return FTYPE_SYMEEXPR;
case FTYPENO_LOCK: return FTYPE_LOCK;
case FTYPENO_LISP: return FTYPE_LISP;
case FTYPENO_C: return FTYPE_C;
case FTYPENO_JAVA: return FTYPE_JAVA;
case FTYPENO_CPP: return FTYPE_CPP;
case FTYPENO_H: return FTYPE_H;
case FTYPENO_OBJECT: return FTYPE_OBJECT;
case FTYPENO_AR_OBJ: return FTYPE_AR_OBJ;
case FTYPENO_AR_INT: return FTYPE_AR_INT;
case FTYPENO_MSG: return FTYPE_MSG;
case FTYPENO_EXEC: return FTYPE_EXEC;
case FTYPENO_AXLMAINC: return FTYPE_AXLMAINC;
case FTYPENO_NONE: return "";
default:
bugBadCase(ftype);
NotReached(return "");
}
}
void
tcCheck(TConst tc)
{
Bool result;
AbLogic known;
extern AbLogic abCondKnown;
listPush(TConst, tc, tcStack);
switch (tcTag(tc)) {
case TC_Satisfies:
known = abCondKnown;
abCondKnown = tcKnown(tc);
result = tfSatisfies1(tc->ab0, tcArgv(tc)[0], tcArgv(tc)[1]);
abCondKnown = known;
break;
default:
bugBadCase(tcTag(tc));
NotReached(result = false);
}
listPop(TConst, tc, tcStack, tcEq);
if (!result) {
if (DEBUG(tc)) {
tcPrint(dbOut, tc);
fnewline(dbOut);
}
tiTopFns()->terrorTypeConstFailed(tc);
}
}
/* generate lisp for a name. */
local SExpr
gl0IdName(Foam foam)
{
switch (foamTag(foam)) {
default: bugBadCase(foamTag(foam));
case FOAM_Glo: return gliGlo(foam);
case FOAM_Const: return gliConst(foam);
case FOAM_Par: return gliPar(foam);
case FOAM_Loc: return gliLoc(foam);
case FOAM_Lex: return gliLex(foam);
}
}
/*
* 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));
}
int
tcPrint(FILE *f, TConst tc)
{
int cc = 0;
cc += fprintf(f, "(const[%d]: ", (int) tcSerial(tc));
switch (tcTag(tc)) {
case TC_Satisfies:
cc += tfPrint(f, tcArgv(tc)[0]);
cc += fprintf(f, " satisfies ");
cc += tfPrint(f, tcArgv(tc)[1]);
break;
default:
bugBadCase(tcTag(tc));
}
if (tcParent(tc))
cc += tcPrint(f, tcParent(tc));
cc += fprintf(f, ")");
return cc;
}
local SExpr
gl0IdPlainName(Foam foam)
{
if (foamTag(foam) != FOAM_Glo) bugBadCase(foamTag(foam));
return gliPlainGlo(foam);
}
local SExpr
gliExpr(Foam foam)
{
SExpr sx = sxNil;
switch (foamTag(foam)) {
case FOAM_Prog:
bugBadCase(FOAM_Prog);
break;
case FOAM_NOp:
case FOAM_Nil:
sx = GL_Nil;
break;
case FOAM_CCall: {
sx = gl0ExprOf(GL_CCall, 1, foam);
break;
}
case FOAM_OCall: {
sx = gl0OpenCall(foam);
break;
}
case FOAM_BVal: {
FoamTag op = foam->foamBVal.builtinTag;
sx = gl0ExprOf(foamBValSExpr(op), 1, foam);
break;
}
case FOAM_BCall: {
FoamTag op = foam->foamBCall.op;
sx = gl0ExprOf(foamBValSExpr(op), 1, foam);
break;
}
case FOAM_PCall:
sx = gliPCall(foam);
break;
case FOAM_If:
sx = gliIf(foam);
break;
case FOAM_Set:
sx = gliSet(foam);
break;
case FOAM_Def:
sx = gliDef(foam);
break;
case FOAM_PushEnv:
sx = gliPushEnv(foam);
break;
case FOAM_PopEnv:
sx = GL_Nil;
break;
case FOAM_EEnv:
sx = gliEEnv(foam);
break;
case FOAM_Seq:
sx = gl0ExprOf(GL_Progn, int0, foam);
break;
case FOAM_Par:
case FOAM_Loc:
case FOAM_Glo:
case FOAM_Const:
sx = gliId(foam);
break;
case FOAM_Lex:
sx = gliLex(foam);
break;
case FOAM_Return:
sx = lisp2(GL_ReturnBlock, glvFunName,
gliExpr(foam->foamReturn.value));
break;
case FOAM_Cast:
sx = gliExpr(foam->foamCast.expr);
break;
case FOAM_Clos:
sx = gl0ExprOf(GL_Clos, int0, foam);
break;
case FOAM_Env:
sx = gliEnv(foam);
break;
case FOAM_EInfo:
sx = gliEInfo(foam);
break;
case FOAM_PRef:
sx = gliPRef(foam);
break;
case FOAM_Arr:
sx = gliArr(foam);
break;
case FOAM_CEnv:
sx = gl0ExprOf(GL_ClosEnv, int0, foam);
break;
case FOAM_CProg:
sx = gl0ExprOf(GL_ClosFun, int0, foam);
break;
case FOAM_Values:
if (foamArgc(foam) == 0)
sx = sxNil;
else
sx = gl0ExprOf(GL_Values, int0, foam);
break;
case FOAM_MFmt:
sx = gliExpr(foam->foamMFmt.value);
break;
case FOAM_EElt:
sx = gliEElt(foam);
break;
case FOAM_Char: /* XXX: Should be fixed elsewhere */
sx = lisp2(GL_The, GL_Char,
(foam->foamChar.CharData=='\0')
? GL_NUL
: sxiFrChar(foam->foamChar.CharData));
break;
case FOAM_Bool:
sx = lisp2(GL_The, GL_Bool, (foam->foamBool.BoolData ?
GL_T : GL_Nil));
break;
case FOAM_Byte:
sx = lisp2(GL_The, GL_Byte,
sxiFrInteger(foam->foamByte.ByteData));
break;
case FOAM_SInt:
sx = lisp2(GL_The, GL_SInt,
sxiFrInteger(foam->foamSInt.SIntData));
break;
case FOAM_HInt:
sx = lisp2(GL_The, GL_HInt,
sxiFrInteger(foam->foamHInt.HIntData));
break;
case FOAM_BInt:
sx = lisp2(GL_The, GL_BInt,
sxiFrBigInteger(foam->foamBInt.BIntData));
break;
case FOAM_SFlo:
sx = lisp2(GL_The, GL_SFlo, sxiFrSFloat(foamToSFlo(foam)));
break;
case FOAM_DFlo:
sx = lisp2(GL_The, GL_DFlo, sxiFrDFloat(foamToDFlo(foam)));
break;
case FOAM_Goto:
sx = lisp1(GL_Go,
lispId(strPrintf("Lab%d", foam->foamGoto.label)));
glvHasGoto = 1;
break;
case FOAM_Label:
sx = lispId(strPrintf("Lab%d", foam->foamGoto.label));
break;
case FOAM_Select:
sx = gliSelect(foam);
break;
case FOAM_ANew:
sx = gliANew(foam);
break;
case FOAM_RNew:
sx = gliRNew(foam);
break;
case FOAM_AElt:
sx = gliAElt(foam);
break;
case FOAM_RElt:
sx = gliRElt(foam);
break;
case FOAM_Free:
sx = lisp1(GL_FoamFree, gliExpr(foam->foamFree.place));
break;
case FOAM_EEnsure:
sx = lisp1(GL_FoamEEnsure, gliExpr(foam->foamEEnsure.env));
break;
default:
printf("unhandled foamTag = %s\n",
foamInfo(foamTag(foam)).str);
sx = lispId("unhandled!");
break;
}
return sx;
}
SExpr
compSExprError(SrcPos spos, int errnum, va_list argp)
{
Msg msg;
switch (errnum) {
case SX_ErrPackageExists:
msg = ALDOR_F_SxPackageExists;
break;
case SX_ErrInternNeeds:
msg = ALDOR_F_SxInternNeeds;
break;
case SX_ErrNumDenNeeds:
msg = ALDOR_F_SxNumDenNeeds;
break;
case SX_ErrNReverseNeeds:
msg = ALDOR_F_SxNReverseNeeds;
break;
case SX_ErrBadArgumentTo:
msg = ALDOR_F_SxBadArgumentTo;
break;
case SX_ErrReadEOF:
msg = ALDOR_F_SxReadEOF;
break;
case SX_ErrBadPunct:
msg = ALDOR_F_SxBadPunct;
break;
case SX_ErrBadChar:
msg = ALDOR_F_SxBadChar;
break;
case SX_ErrMacroIlleg:
msg = ALDOR_F_SxMacroIlleg;
break;
case SX_ErrMacroUndef:
msg = ALDOR_F_SxMacroUndef;
break;
case SX_ErrMacroUnimp:
msg = ALDOR_F_SxMacroUnimp;
break;
case SX_ErrCantMacroArg:
msg = ALDOR_F_SxCantMacroArg;
break;
case SX_ErrMustMacroArg:
msg = ALDOR_F_SxMustMacroArg;
break;
case SX_ErrBadFeatureForm:
msg = ALDOR_F_SxBadFeatureForm;
break;
case SX_ErrTooManyElts:
msg = ALDOR_F_SxTooManyElts;
break;
case SX_ErrCantShare:
msg = ALDOR_F_SxCantShare;
break;
case SX_ErrAlreadyShare:
msg = ALDOR_F_SxAlreadyShare;
break;
case SX_ErrBadCharName:
msg = ALDOR_F_SxBadCharName;
break;
case SX_ErrBadComplexNum:
msg = ALDOR_F_SxBadComplexNum;
break;
case SX_ErrBadToken:
msg = ALDOR_F_SxBadToken;
break;
case SX_ErrBadPotNum:
msg = ALDOR_F_SxBadPotNum;
break;
case SX_ErrBadUninterned:
msg = ALDOR_F_SxBadUninterned;
break;
default:
bugBadCase(errnum);
NotReached(msg = 0);
}
comsgVFatal(abNewNothing(spos), msg, argp);
NotReached(return 0);
}
