long ABLModule::execute (ABLParamPtr moduleParamList, SymTableNodePtr functionIdPtr) {
CurModule = this;
if (debugger)
debugger->setModule(this);
//--------------------------
// Execute the ABL module...
SymTableNodePtr moduleIdPtr = ModuleRegistry[handle].moduleIdPtr;
if (moduleIdPtr->defn.info.routine.flags & ROUTINE_FLAG_FSM)
CurFSM = this;
else
CurFSM = NULL;
NumStateTransitions = 0;
//--------------------------------------------
// Point to this module's static data space...
StaticDataPtr = staticData;
OrderCompletionFlags = orderCallFlags;
//---------------------------------
// Init some important variables...
CurModuleIdPtr = NULL;
CurRoutineIdPtr = NULL;
FileNumber = -1;
errorCount = 0;
execStatementCount = 0;
NumExecutions++;
NewStateSet = false;
//------------------
// Init the stack...
stackFrameBasePtr = tos = (stack + eternalOffset);
//---------------------------------------
// Initialize the module's stack frame...
level = 1;
CallStackLevel = 0;
stackFrameBasePtr = tos + 1;
//-------------------------
// Function return value...
pushInteger(0);
//---------------
// Static Link...
pushAddress(NULL);
//----------------
// Dynamic Link...
pushAddress(NULL);
//------------------
// Return Address...
pushAddress(NULL);
//initDebugger();
//----------
// Run it...
if (moduleParamList) {
//------------------------------------------------------------------------------
// NOTE: Currently, parameter passing of arrays is not functioning. This MUST be
// done...
long curParam = 0;
for (SymTableNodePtr formalIdPtr = (SymTableNodePtr)(moduleIdPtr->defn.info.routine.params);
formalIdPtr != NULL;
formalIdPtr = formalIdPtr->next) {
TypePtr formalTypePtr = (TypePtr)(formalIdPtr->typePtr);
if (formalIdPtr->defn.key == DFN_VALPARAM) {
if (formalTypePtr == RealTypePtr) {
if (moduleParamList[curParam].type == ABL_PARAM_INTEGER) {
//---------------------------------------------
// Real formal parameter, but integer actual...
pushReal((float)(moduleParamList[curParam].integer));
}
else if (moduleParamList[curParam].type == ABL_PARAM_REAL)
pushReal(moduleParamList[curParam].real);
}
else if (formalTypePtr == IntegerTypePtr) {
if (moduleParamList[curParam].type== ABL_PARAM_INTEGER)
pushInteger(moduleParamList[curParam].integer);
else
return(0);
}
//----------------------------------------------------------
// Formal parameter is an array or record, so make a copy...
if ((formalTypePtr->form == FRM_ARRAY)/* || (formalTypePtr->form == FRM_RECORD)*/) {
//------------------------------------------------------------------------------
// The following is a little inefficient, but is kept this way to keep it clear.
// Once it's verified to work, optimize...
long size = formalTypePtr->size;
char* dest = (char*)ABLStackMallocCallback((size_t)size);
if (!dest) {
char err[255];
sprintf(err, "ABL: Unable to AblStackHeap->malloc array parameter [Module %d]", id);
ABL_Fatal(0, err);
}
char* src = tos->address;
char* savePtr = dest;
memcpy(dest, src, size);
tos->address = savePtr;
}
}
else {
//-------------------------------
// pass by reference parameter...
if (formalTypePtr == RealTypePtr)
pushAddress((Address)&(moduleParamList[curParam].real));
else if (formalTypePtr == IntegerTypePtr)
pushAddress((Address)&(moduleParamList[curParam].integer));
else
return(0);
}
curParam++;
}
}
CurModuleHandle = handle;
CallModuleInit = !initCalled;
initCalled = true;
::executeChild(moduleIdPtr, functionIdPtr);
memcpy(&returnVal, &returnValue, sizeof(StackItem));
//-----------
// Summary...
return(execStatementCount);
}
long ABLModule::init (long moduleHandle) {
if (moduleHandle == -1) {
//----------
// Clean up!
return(-1);
}
id = NumModules++;
handle = moduleHandle;
staticData = NULL;
long numStatics = ModuleRegistry[handle].numStaticVars;
if (numStatics) {
staticData = (StackItemPtr)ABLStackMallocCallback(sizeof(StackItem) * numStatics);
if (!staticData) {
char err[255];
sprintf(err, "ABL: Unable to AblStackHeap->malloc staticData [Module %d]", id);
ABL_Fatal(0, err);
}
long* sizeList = ModuleRegistry[handle].sizeStaticVars;
for (long i = 0; i < numStatics; i++)
if (sizeList[i] > 0) {
staticData[i].address = (char*)ABLStackMallocCallback(sizeList[i]);
if (!staticData) {
char err[255];
sprintf(err, "ABL: Unable to AblStackHeap->malloc staticData address [Module %d]", id);
ABL_Fatal(0, err);
}
}
else
staticData[i].integer = 0;
}
if (ModuleRegistry[handle].numOrderCalls) {
long numLongs = 1 + ModuleRegistry[handle].numOrderCalls / 32;
orderCallFlags = (unsigned long*)ABLStackMallocCallback(sizeof(unsigned long) * numLongs);
if (!orderCallFlags) {
char err[255];
sprintf(err, "ABL: Unable to AblStackHeap->malloc orderCallFlags [Module %d]", id);
ABL_Fatal(0, err);
}
for (long i = 0; i < numLongs; i++)
orderCallFlags[i] = 0;
}
ModuleRegistry[handle].numInstances++;
initCalled = false;
//------------------------------------------------------
// This Active Module is now on the instance registry...
ModuleInstanceRegistry[NumModuleInstances++] = this;
if (debugger) {
watchManager = new WatchManager;
if (!watchManager)
ABL_Fatal(0, " Unable to AblStackHeap->malloc WatchManager ");
long result = watchManager->init(MaxWatchesPerModule);
if (result != ABL_NO_ERR)
ABL_Fatal(0, " Unable to AblStackHeap->malloc WatchManager ");
breakPointManager = new BreakPointManager;
if (!breakPointManager)
ABL_Fatal(0, " Unable to AblStackHeap->malloc BreakPointManager ");
result = breakPointManager->init(MaxBreakPointsPerModule);
if (result != ABL_NO_ERR)
ABL_Fatal(0, " Unable to AblStackHeap->malloc BreakPointManager ");
}
if (ModuleRegistry[handle].moduleIdPtr->defn.info.routine.flags & ROUTINE_FLAG_FSM) {
//--------------------------------
// Always starts in START state...
SymTableNodePtr startState = searchSymTable("start", ModuleRegistry[handle].moduleIdPtr->defn.info.routine.localSymTable);
if (!startState) {
char err[255];
sprintf(err, "ABL: FSM has no Start state [%s]", CurModule->getName());
ABL_Fatal(0, err);
}
prevState = NULL;
state = startState;
}
//--------------------
// Can this ever fail?
return(ABL_NO_ERR);
}
void ABLModule::read (ABLFile* moduleFile) {
//----------------------------------------------------------------------------
// If this is called on a newly init'd module, then it will do all appropriate
// memory alloc, etc. If it's being called on a module that's already been
// setup (via a call to init(moduleHandle)), then it simply loads the
// module's data...
bool fresh = (id == -1);
if (fresh) {
id = NumModules++;
moduleFile->readString((unsigned char*)name);
handle = moduleFile->readLong();
staticData = NULL;
}
else {
char tempName[1024];
moduleFile->readString((unsigned char*)tempName);
long ignore = moduleFile->readLong();
}
char stateName[256];
memset(stateName,0,256);
moduleFile->readString((unsigned char*)stateName);
prevState = NULL;
if (strcmp(stateName, "NULLPrevState"))
prevState = findState(stateName);
memset(stateName,0,256);
moduleFile->readString((unsigned char*)stateName);
state = NULL;
if (strcmp(stateName, "NULLState"))
state = findState(stateName);
bool savedInitCalled = (moduleFile->readLong() == 1);
long numStatics = ModuleRegistry[handle].numStaticVars;
if (numStatics) {
if (fresh) {
staticData = (StackItemPtr)ABLStackMallocCallback(sizeof(StackItem) * numStatics);
if (!staticData) {
char err[255];
sprintf(err, "ABL: Unable to AblStackHeap->malloc staticData [Module %d]", id);
ABL_Fatal(0, err);
}
}
long* sizeList = ModuleRegistry[handle].sizeStaticVars;
for (long i = 0; i < numStatics; i++)
if (sizeList[i] > 0) {
if (fresh) {
staticData[i].address = (char*)ABLStackMallocCallback(sizeList[i]);
if (!staticData) {
char err[255];
sprintf(err, "ABL: Unable to AblStackHeap->malloc staticData address [Module %d]", id);
ABL_Fatal(0, err);
}
}
long result = moduleFile->read((unsigned char*)staticData[i].address, sizeList[i]);
if (!result) {
char err[255];
sprintf(err, "ABL: Unable to read staticData.address [Module %d]", id);
ABL_Fatal(0, err);
}
}
else {
staticData[i].integer = 0;
long result = moduleFile->read((unsigned char*)&staticData[i], sizeof(StackItem));
if (!result) {
char err[255];
sprintf(err, "ABL: Unable to read staticData [Module %d]", id);
ABL_Fatal(0, err);
}
}
}
if (ModuleRegistry[handle].numOrderCalls) {
long numLongs = 1 + ModuleRegistry[handle].numOrderCalls / 32;
orderCallFlags = (unsigned long*)ABLStackMallocCallback(sizeof(unsigned long) * numLongs);
if (!orderCallFlags) {
char err[255];
sprintf(err, "ABLModule.read: Unable to AblStackHeap->malloc orderCallFlags [Module %d]", id);
ABL_Fatal(0, err);
}
for (long i = 0; i < numLongs; i++)
orderCallFlags[i] = 0;
}
if (fresh) {
ModuleRegistry[handle].numInstances++;
initCalled = savedInitCalled;
//------------------------------------------------------
// This Active Module is now on the instance registry...
ModuleInstanceRegistry[NumModuleInstances++] = this;
if (debugger) {
watchManager = new WatchManager;
if (!watchManager)
ABL_Fatal(0, " Unable to AblStackHeap->malloc WatchManager ");
long result = watchManager->init(MaxWatchesPerModule);
if (result != ABL_NO_ERR)
ABL_Fatal(0, " Unable to AblStackHeap->malloc WatchManager ");
breakPointManager = new BreakPointManager;
if (!breakPointManager)
ABL_Fatal(0, " Unable to AblStackHeap->malloc BreakPointManager ");
result = breakPointManager->init(MaxBreakPointsPerModule);
if (result != ABL_NO_ERR)
ABL_Fatal(0, " Unable to AblStackHeap->malloc BreakPointManager ");
}
}
}
void varOrFieldDeclarations (SymTableNodePtr routineIdPtr, long offset) {
bool varFlag = (routineIdPtr != NULL);
SymTableNodePtr idPtr = NULL;
SymTableNodePtr firstIdPtr = NULL;
SymTableNodePtr lastIdPtr = NULL;
SymTableNodePtr prevLastIdPtr = NULL;
long totalSize = 0;
while ((curToken == TKN_IDENTIFIER) || (curToken == TKN_ETERNAL) || (curToken == TKN_STATIC)) {
VariableType varType = VAR_TYPE_NORMAL;
if ((curToken == TKN_ETERNAL) || (curToken == TKN_STATIC)) {
if (curToken == TKN_ETERNAL)
varType = VAR_TYPE_ETERNAL;
else
varType = VAR_TYPE_STATIC;
getToken();
if (curToken != TKN_IDENTIFIER)
syntaxError(ABL_ERR_SYNTAX_MISSING_IDENTIFIER);
}
firstIdPtr = NULL;
//------------------------------
// Process the variable type...
TypePtr typePtr = doType();
//------------------------------------------------------------------
// Since we haven't really assigned it here, decrement its
// numInstances. Every variable in this list will set it properly...
typePtr->numInstances--;
long size = typePtr->size;
//-------------------------------------------------------
// Now that we've read the type, read in the variable (or
// possibly list of variables) declared of this type.
// Loop to process every variable (and field, if records
// are being implemented:) in sublist...
while (curToken == TKN_IDENTIFIER) {
if (varFlag) {
//---------------------------------------------
// We're working with a variable declaration...
if (varType == VAR_TYPE_ETERNAL) {
long curLevel = level;
level = 0;
searchAndEnterThisTable (idPtr, SymTableDisplay[0]);
level = curLevel;
}
else
searchAndEnterLocalSymTable(idPtr);
idPtr->library = CurLibrary;
idPtr->defn.key = DFN_VAR;
}
else
syntaxError(ABL_ERR_SYNTAX_NO_RECORD_TYPES);
idPtr->labelIndex = 0;
//------------------------------------------
// Now, link Id's together into a sublist...
if (!firstIdPtr) {
firstIdPtr = lastIdPtr = idPtr;
if (varFlag && (varType != VAR_TYPE_ETERNAL) && (routineIdPtr->defn.info.routine.locals == NULL))
routineIdPtr->defn.info.routine.locals = idPtr;
}
else {
lastIdPtr->next = idPtr;
lastIdPtr = idPtr;
}
getToken();
ifTokenGet(TKN_COMMA);
}
//--------------------------------------------------------------------------
// Assign the offset and the type to all variable or field Ids in sublist...
for (idPtr = firstIdPtr; idPtr != NULL; idPtr = idPtr->next) {
idPtr->typePtr = setType(typePtr);
if (varFlag) {
idPtr->defn.info.data.varType = varType;
switch (varType) {
case VAR_TYPE_NORMAL:
totalSize += size;
idPtr->defn.info.data.offset = offset++;
break;
case VAR_TYPE_ETERNAL: {
idPtr->defn.info.data.offset = eternalOffset;
//-----------------------------------
// Initialize the variable to zero...
StackItemPtr dataPtr = (StackItemPtr)stack + eternalOffset;
if (typePtr->form == FRM_ARRAY) {
dataPtr->address = (Address)ABLStackMallocCallback((size_t)size);
if (!dataPtr->address)
ABL_Fatal(0, " ABL: Unable to AblStackHeap->malloc eternal array ");
memset(dataPtr->address, 0, size);
EternalVariablesSizes[eternalOffset] = size;
}
else {
dataPtr->integer = 0;
EternalVariablesSizes[eternalOffset] = 0;
}
eternalOffset++;
}
break;
case VAR_TYPE_STATIC: {
if (NumStaticVariables == MaxStaticVariables)
syntaxError(ABL_ERR_SYNTAX_TOO_MANY_STATIC_VARS);
idPtr->defn.info.data.offset = NumStaticVariables;
if (typePtr->form == FRM_ARRAY)
StaticVariablesSizes[NumStaticVariables] = size;
else
StaticVariablesSizes[NumStaticVariables] = 0;
NumStaticVariables++;
}
break;
}
analyzeVarDecl(idPtr);
}
else {
//----------------
// record field...
idPtr->defn.info.data.varType = VAR_TYPE_NORMAL;
idPtr->defn.info.data.offset = offset;
offset += size;
}
}
//--------------------------------------------------
// Now, link this sublist to the previous sublist...
if (varType != VAR_TYPE_ETERNAL) {
if (prevLastIdPtr != NULL)
prevLastIdPtr->next = firstIdPtr;
prevLastIdPtr = lastIdPtr;
}
//---------------------
// Error synchronize...
if (varFlag)
synchronize(followVariablesList, declarationStartList, statementStartList);
if (curToken == TKN_SEMICOLON)
getToken();
else if (varFlag && (tokenIn(declarationStartList) || tokenIn(statementStartList)))
syntaxError(ABL_ERR_SYNTAX_MISSING_SEMICOLON);
}
synchronize(followVarBlockList, NULL, NULL);
if (varFlag) {
//----------------------------------------------------------------
// If the following error occurs too frequently, simply make the
// totalLocalSize field an unsigned long instead, and dramatically
// increase the totalSize limit here...
if (totalSize > 32000)
syntaxError(ABL_ERR_SYNTAX_TOO_MANY_LOCAL_VARIABLES);
routineIdPtr->defn.info.routine.totalLocalSize = (unsigned short)totalSize;
}
}
void ABLi_loadEnvironment (ABLFile* ablFile, bool malloc) {
long numLibs = ablFile->readLong();
long numModsRegistered = ablFile->readLong();
long numMods = ablFile->readLong();
for (long i = 0; i < numLibs; i++) {
unsigned char fileName[1024];
long result = ablFile->readString(fileName);
if (!result) {
char err[255];
sprintf(err, "ABLi_loadEnvironment: Unable to read filename [Module %d]", i);
ABL_Fatal(0, err);
}
if (malloc) {
long numErrors, numLinesProcessed;
ABLModulePtr library = ABLi_loadLibrary((char*)fileName, &numErrors, &numLinesProcessed, NULL, false, false);
if (!library) {
char err[255];
sprintf(err, "ABLi_loadEnvironment: Unable to load library [Module %d]", i);
ABL_Fatal(0, err);
}
}
}
for (i = 0; i < (numModsRegistered - numLibs); i++) {
unsigned char fileName[1024];
long result = ablFile->readString(fileName);
if (!result) {
char err[255];
sprintf(err, "ABLi_loadEnvironment: Unable to read filename [Module %d]", i);
ABL_Fatal(0, err);
}
long numErrors, numLinesProcessed;
if (malloc) {
long handle = ABLi_preProcess((char*)fileName, &numErrors, &numLinesProcessed);
if (handle < 0) {
char err[255];
sprintf(err, "ABLi_loadEnvironment: Unable to preprocess [Module %d]", i);
ABL_Fatal(0, err);
}
}
}
long mark = ablFile->readLong();
for (i = 0; i < eternalOffset; i++) {
StackItemPtr dataPtr = (StackItemPtr)stack + i;
if (EternalVariablesSizes[i] > 0)
ablFile->read((unsigned char*)dataPtr->address, EternalVariablesSizes[i]);
else
ablFile->read((unsigned char*)dataPtr, sizeof(StackItem));
}
for (i = 0; i < numLibs; i++) {
ABLModulePtr library = LibraryInstanceRegistry[i];
library->read(ablFile);
}
for (i = 0; i < (numMods - numLibs); i++) {
ABLModulePtr module = NULL;
if (malloc)
module = new ABLModule;
else
module = ModuleInstanceRegistry[numLibs + i];
module->read(ablFile);
}
}
TypePtr doType (void) {
switch (curToken) {
case TKN_IDENTIFIER: {
SymTableNodePtr idPtr;
searchAllSymTables(idPtr);
if (!idPtr) {
syntaxError(ABL_ERR_SYNTAX_UNDEFINED_IDENTIFIER);
return(NULL);
}
else if (idPtr->defn.key == DFN_TYPE) {
//----------------------------------------------------------
// NOTE: Array types should be parsed in this case if a left
// bracket follows the type identifier.
TypePtr elementType = setType(identifierType(idPtr));
if (curToken == TKN_LBRACKET) {
//--------------
// Array type...
TypePtr typePtr = createType();
if (!typePtr)
ABL_Fatal(0, " ABL: Unable to AblStackHeap->malloc array type ");
TypePtr elementTypePtr = typePtr;
do {
getToken();
if (tokenIn(indexTypeStartList)) {
elementTypePtr->form = FRM_ARRAY;
elementTypePtr->size = 0;
elementTypePtr->typeIdPtr = NULL;
//----------------------------------------------
// All array indices must be integer, for now...
elementTypePtr->info.array.indexTypePtr = setType(IntegerTypePtr);
//------------------------
// Read the index count...
switch (curToken) {
case TKN_NUMBER:
if (curLiteral.type == LIT_INTEGER)
elementTypePtr->info.array.elementCount = curLiteral.value.integer;
else {
elementTypePtr->form = FRM_NONE;
elementTypePtr->size = 0;
elementTypePtr->typeIdPtr = NULL;
elementTypePtr->info.array.indexTypePtr = NULL;
syntaxError(ABL_ERR_SYNTAX_INVALID_INDEX_TYPE);
}
getToken();
break;
case TKN_IDENTIFIER: {
SymTableNodePtr idPtr;
searchAllSymTables(idPtr);
if (idPtr == NULL)
syntaxError(ABL_ERR_SYNTAX_UNDEFINED_IDENTIFIER);
else if (idPtr->defn.key == DFN_CONST) {
if (idPtr->typePtr == IntegerTypePtr)
elementTypePtr->info.array.elementCount = idPtr->defn.info.constant.value.integer;
else {
elementTypePtr->form = FRM_NONE;
elementTypePtr->size = 0;
elementTypePtr->typeIdPtr = NULL;
elementTypePtr->info.array.indexTypePtr = NULL;
syntaxError(ABL_ERR_SYNTAX_INVALID_INDEX_TYPE);
}
}
else {
elementTypePtr->form = FRM_NONE;
elementTypePtr->size = 0;
elementTypePtr->typeIdPtr = NULL;
elementTypePtr->info.array.indexTypePtr = NULL;
syntaxError(ABL_ERR_SYNTAX_INVALID_INDEX_TYPE);
}
getToken();
}
break;
default:
elementTypePtr->form = FRM_NONE;
elementTypePtr->size = 0;
elementTypePtr->typeIdPtr = NULL;
elementTypePtr->info.array.indexTypePtr = NULL;
syntaxError(ABL_ERR_SYNTAX_INVALID_INDEX_TYPE);
getToken();
}
}
else {
elementTypePtr->form = FRM_NONE;
elementTypePtr->size = 0;
elementTypePtr->typeIdPtr = NULL;
elementTypePtr->info.array.indexTypePtr = NULL;
syntaxError(ABL_ERR_SYNTAX_INVALID_INDEX_TYPE);
getToken();
}
synchronize(followDimensionList, NULL, NULL);
//--------------------------------
// Create an array element type...
if (curToken == TKN_COMMA) {
elementTypePtr = elementTypePtr->info.array.elementTypePtr = createType();
if (!elementTypePtr)
ABL_Fatal(0, " ABL: Unable to AblStackHeap->malloc array element Type ");
}
} while (curToken == TKN_COMMA);
ifTokenGetElseError(TKN_RBRACKET, ABL_ERR_SYNTAX_MISSING_RBRACKET);
elementTypePtr->info.array.elementTypePtr = elementType;
typePtr->size = arraySize(typePtr);
elementType = typePtr;
}
return(elementType);
}
else {
syntaxError(ABL_ERR_SYNTAX_NOT_A_TYPE_IDENTIFIER);
return(NULL);
}
}
break;
case TKN_LPAREN:
return(enumerationType());
default:
syntaxError(ABL_ERR_SYNTAX_INVALID_TYPE);
return(NULL);
}
}
void doConst (SymTableNodePtr constantIdPtr) {
TokenCodeType sign = TKN_PLUS;
bool sawSign = false;
if ((curToken == TKN_PLUS) || (curToken == TKN_MINUS)) {
sign = curToken;
sawSign = true;
getToken();
}
//----------------------------------
// Numeric constant: real or integer
if (curToken == TKN_NUMBER) {
if (curLiteral.type == LIT_INTEGER) {
if (sign == TKN_PLUS)
constantIdPtr->defn.info.constant.value.integer = curLiteral.value.integer;
else
constantIdPtr->defn.info.constant.value.integer = -(curLiteral.value.integer);
constantIdPtr->typePtr = setType(IntegerTypePtr);
}
else {
if (sign == TKN_PLUS)
constantIdPtr->defn.info.constant.value.real = curLiteral.value.real;
else
constantIdPtr->defn.info.constant.value.real = -(curLiteral.value.real);
constantIdPtr->typePtr = setType(RealTypePtr);
}
}
else if (curToken == TKN_IDENTIFIER) {
SymTableNodePtr idPtr = NULL;
searchAllSymTables(idPtr);
if (!idPtr)
syntaxError(ABL_ERR_SYNTAX_UNDEFINED_IDENTIFIER);
else if (idPtr->defn.key != DFN_CONST)
syntaxError(ABL_ERR_SYNTAX_NOT_A_CONSTANT_IDENTIFIER);
else if (idPtr->typePtr == IntegerTypePtr) {
if (sign == TKN_PLUS)
constantIdPtr->defn.info.constant.value.integer = idPtr->defn.info.constant.value.integer;
else
constantIdPtr->defn.info.constant.value.integer = -(idPtr->defn.info.constant.value.integer);
constantIdPtr->typePtr = setType(IntegerTypePtr);
}
else if (idPtr->typePtr == CharTypePtr) {
if (sawSign)
syntaxError(ABL_ERR_SYNTAX_INVALID_CONSTANT);
constantIdPtr->defn.info.constant.value.character = idPtr->defn.info.constant.value.character;
constantIdPtr->typePtr = setType(CharTypePtr);
}
else if (idPtr->typePtr == RealTypePtr) {
if (sign == TKN_PLUS)
constantIdPtr->defn.info.constant.value.real = idPtr->defn.info.constant.value.real;
else
constantIdPtr->defn.info.constant.value.real = -(idPtr->defn.info.constant.value.real);
constantIdPtr->typePtr = setType(RealTypePtr);
}
else if (((Type*)(idPtr->typePtr))->form == FRM_ENUM) {
if (sawSign)
syntaxError(ABL_ERR_SYNTAX_INVALID_CONSTANT);
constantIdPtr->defn.info.constant.value.integer = idPtr->defn.info.constant.value.integer;
constantIdPtr->typePtr = setType(idPtr->typePtr);
}
else if (((TypePtr)(idPtr->typePtr))->form == FRM_ARRAY) {
if (sawSign)
syntaxError(ABL_ERR_SYNTAX_INVALID_CONSTANT);
constantIdPtr->defn.info.constant.value.stringPtr = idPtr->defn.info.constant.value.stringPtr;
constantIdPtr->typePtr = setType(idPtr->typePtr);
}
}
else if (curToken == TKN_STRING) {
if (sawSign)
syntaxError(ABL_ERR_SYNTAX_INVALID_CONSTANT);
if (strlen(curLiteral.value.string) == 1) {
constantIdPtr->defn.info.constant.value.character = curLiteral.value.string[0];
constantIdPtr->typePtr = setType(CharTypePtr);
}
else {
long length = strlen(curLiteral.value.string);
constantIdPtr->defn.info.constant.value.stringPtr = (char*)ABLSymbolMallocCallback(length + 1);
if (!constantIdPtr->defn.info.constant.value.stringPtr)
ABL_Fatal(0, " ABL: Unable to AblSymbolHeap->malloc array string constant ");
strcpy(constantIdPtr->defn.info.constant.value.stringPtr, curLiteral.value.string);
constantIdPtr->typePtr = makeStringType(length);
}
}
else {
constantIdPtr->typePtr = NULL;
syntaxError(ABL_ERR_SYNTAX_INVALID_CONSTANT);
}
getToken();
}
void initSymTable (void) {
//---------------------------------
// Init the level-0 symbol table...
SymTableDisplay[0] = NULL;
//----------------------------------------------------------------------
// Set up the basic variable types as identifiers in the symbol table...
SymTableNodePtr integerIdPtr;
enterNameLocalSymTable(integerIdPtr, "integer");
SymTableNodePtr charIdPtr;
enterNameLocalSymTable(charIdPtr, "char");
SymTableNodePtr realIdPtr;
enterNameLocalSymTable(realIdPtr, "real");
SymTableNodePtr booleanIdPtr;
enterNameLocalSymTable(booleanIdPtr, "boolean");
SymTableNodePtr falseIdPtr;
enterNameLocalSymTable(falseIdPtr, "false");
SymTableNodePtr trueIdPtr;
enterNameLocalSymTable(trueIdPtr, "true");
//------------------------------------------------------------------
// Now, create the basic variable TYPEs, and point their identifiers
// to their proper type definition...
IntegerTypePtr = createType();
if (!IntegerTypePtr)
ABL_Fatal(0, " ABL: Unable to AblSymTableHeap->malloc Integer Type ");
CharTypePtr = createType();
if (!CharTypePtr)
ABL_Fatal(0, " ABL: Unable to AblSymTableHeap->malloc Char Type ");
RealTypePtr = createType();
if (!RealTypePtr)
ABL_Fatal(0, " ABL: Unable to AblSymTableHeap->malloc Real Type ");
BooleanTypePtr = createType();
if (!BooleanTypePtr)
ABL_Fatal(0, " ABL: Unable to AblSymTableHeap->malloc Boolean Type ");
integerIdPtr->defn.key = DFN_TYPE;
integerIdPtr->typePtr = IntegerTypePtr;
IntegerTypePtr->form = FRM_SCALAR;
IntegerTypePtr->size = sizeof(long);
IntegerTypePtr->typeIdPtr = integerIdPtr;
charIdPtr->defn.key = DFN_TYPE;
charIdPtr->typePtr = CharTypePtr;
CharTypePtr->form = FRM_SCALAR;
CharTypePtr->size = sizeof(char);
CharTypePtr->typeIdPtr = charIdPtr;
realIdPtr->defn.key = DFN_TYPE;
realIdPtr->typePtr = RealTypePtr;
RealTypePtr->form = FRM_SCALAR;
RealTypePtr->size = sizeof(float);
RealTypePtr->typeIdPtr = realIdPtr;
booleanIdPtr->defn.key = DFN_TYPE;
booleanIdPtr->typePtr = BooleanTypePtr;
BooleanTypePtr->form = FRM_ENUM;
BooleanTypePtr->size = sizeof(long);
BooleanTypePtr->typeIdPtr = booleanIdPtr;
//----------------------------------------------------
// Set up the FALSE identifier for the boolean type...
BooleanTypePtr->info.enumeration.max = 1;
((TypePtr)(booleanIdPtr->typePtr))->info.enumeration.constIdPtr = falseIdPtr;
falseIdPtr->defn.key = DFN_CONST;
falseIdPtr->defn.info.constant.value.integer = 0;
falseIdPtr->typePtr = BooleanTypePtr;
//----------------------------------------------------
// Set up the TRUE identifier for the boolean type...
falseIdPtr->next = trueIdPtr;
trueIdPtr->defn.key = DFN_CONST;
trueIdPtr->defn.info.constant.value.integer = 1;
trueIdPtr->typePtr = BooleanTypePtr;
//-------------------------------------------
// Set up the standard, built-in functions...
//(char* name, long routineKey, bool isOrder, char* paramList, char* returnType, void* callback);
enterStandardRoutine("return", RTN_RETURN, false, NULL, NULL, NULL);
enterStandardRoutine("print", RTN_PRINT, false, NULL, NULL, NULL);
enterStandardRoutine("concat", RTN_CONCAT, false, NULL, NULL, NULL);
enterStandardRoutine("getstatehandle", RTN_GET_STATE_HANDLE, false, NULL, NULL, NULL);
//-----------------------------------
// Honor Bound-specific extensions...
//-----------------------------------
initStandardRoutines();
}
void enterStandardRoutine (char* name, long routineKey, bool isOrder, char* paramList, char* returnType, void (*callback)(void)) {
long tableIndex = routineKey;
if (tableIndex == -1) {
if (NumStandardFunctions == MAX_STANDARD_FUNCTIONS)
ABL_Fatal(0, " ABL.enterStandardRoutine: Too Many Standard Functions ");
tableIndex = NumStandardFunctions++;
}
SymTableNodePtr routineIdPtr;
enterNameLocalSymTable(routineIdPtr, name);
routineIdPtr->defn.key = DFN_FUNCTION;
routineIdPtr->defn.info.routine.key = (RoutineKey)tableIndex;
routineIdPtr->defn.info.routine.flags = isOrder ? ROUTINE_FLAG_ORDER : 0;
routineIdPtr->defn.info.routine.params = NULL;
routineIdPtr->defn.info.routine.localSymTable = NULL;
routineIdPtr->library = NULL;
routineIdPtr->typePtr = NULL;
FunctionInfoTable[tableIndex].numParams = 0;
if (paramList) {
FunctionInfoTable[tableIndex].numParams = strlen(paramList);
if (FunctionInfoTable[tableIndex].numParams > MAX_FUNCTION_PARAMS)
ABL_Fatal(0, " ABL.enterStandardRoutine: Too Many Standard Function Params ");
for (long i = 0; i < FunctionInfoTable[tableIndex].numParams; i++)
switch (paramList[i]) {
case '?':
FunctionInfoTable[tableIndex].params[i] = PARAM_TYPE_ANYTHING;
break;
case 'c':
FunctionInfoTable[tableIndex].params[i] = PARAM_TYPE_CHAR;
break;
case 'i':
FunctionInfoTable[tableIndex].params[i] = PARAM_TYPE_INTEGER;
break;
case 'r':
FunctionInfoTable[tableIndex].params[i] = PARAM_TYPE_REAL;
break;
case 'b':
FunctionInfoTable[tableIndex].params[i] = PARAM_TYPE_BOOLEAN;
break;
case '*':
FunctionInfoTable[tableIndex].params[i] = PARAM_TYPE_INTEGER_REAL;
break;
case 'C':
FunctionInfoTable[tableIndex].params[i] = PARAM_TYPE_CHAR_ARRAY;
break;
case 'I':
FunctionInfoTable[tableIndex].params[i] = PARAM_TYPE_INTEGER_ARRAY;
break;
case 'R':
FunctionInfoTable[tableIndex].params[i] = PARAM_TYPE_REAL_ARRAY;
break;
case 'B':
FunctionInfoTable[tableIndex].params[i] = PARAM_TYPE_BOOLEAN_ARRAY;
break;
default: {
char err[255];
sprintf(err, " ABL.enterStandardRoutine: bad param type (%c) for (%s)", paramList[i], name);
ABL_Fatal(0, err);
}
}
}
FunctionInfoTable[tableIndex].returnType = RETURN_TYPE_NONE;
if (returnType)
switch (returnType[0]) {
//case 'c':
// FunctionInfoTable[NumStandardFunctions].returnType = RETURN_TYPE_CHAR;
// break;
case 'i':
FunctionInfoTable[tableIndex].returnType = RETURN_TYPE_INTEGER;
break;
case 'r':
FunctionInfoTable[tableIndex].returnType = RETURN_TYPE_REAL;
break;
case 'b':
FunctionInfoTable[tableIndex].returnType = RETURN_TYPE_BOOLEAN;
break;
default: {
char err[255];
sprintf(err, " ABL.enterStandardRoutine: bad return type for (%s)", name);
ABL_Fatal(0, err);
}
}
FunctionCallbackTable[tableIndex] = callback;
}
TypePtr caseLabel (CaseItemPtr& caseItemHead, CaseItemPtr& caseItemTail, long& caseLabelCount) {
CaseItemPtr newCaseItem = (CaseItemPtr)ABLStackMallocCallback(sizeof(CaseItem));
if (!newCaseItem)
ABL_Fatal(0, " ABL: Unable to AblStackHeap->malloc case item ");
if (caseItemHead) {
caseItemTail->next = newCaseItem;
caseItemTail = newCaseItem;
}
else
caseItemHead = caseItemTail = newCaseItem;
newCaseItem->next = NULL;
caseLabelCount++;
TokenCodeType sign = TKN_PLUS;
bool sawSign = false;
if ((curToken == TKN_PLUS) || (curToken == TKN_MINUS)) {
sign = curToken;
sawSign = true;
getToken();
}
if (curToken == TKN_NUMBER) {
SymTableNodePtr thisNode = searchSymTable(tokenString, SymTableDisplay[1]);
if (!thisNode)
thisNode = enterSymTable(tokenString, &SymTableDisplay[1]);
crunchSymTableNodePtr(thisNode);
if (curLiteral.type == LIT_INTEGER)
newCaseItem->labelValue = (sign == TKN_PLUS) ? curLiteral.value.integer : -curLiteral.value.integer;
else
syntaxError(ABL_ERR_SYNTAX_INVALID_CONSTANT);
return(IntegerTypePtr);
}
else if (curToken == TKN_IDENTIFIER) {
SymTableNodePtr idPtr;
searchAllSymTables(idPtr);
crunchSymTableNodePtr(idPtr);
if (!idPtr) {
syntaxError(ABL_ERR_SYNTAX_UNDEFINED_IDENTIFIER);
return(&DummyType);
}
else if (idPtr->defn.key != DFN_CONST) {
syntaxError(ABL_ERR_SYNTAX_NOT_A_CONSTANT_IDENTIFIER);
return(&DummyType);
}
else if (idPtr->typePtr == IntegerTypePtr) {
newCaseItem->labelValue = (sign == TKN_PLUS ? idPtr->defn.info.constant.value.integer : -idPtr->defn.info.constant.value.integer);
return(IntegerTypePtr);
}
else if (idPtr->typePtr == CharTypePtr) {
if (sawSign)
syntaxError(ABL_ERR_SYNTAX_INVALID_CONSTANT);
newCaseItem->labelValue = idPtr->defn.info.constant.value.character;
return(CharTypePtr);
}
else if (idPtr->typePtr->form == FRM_ENUM) {
if (sawSign)
syntaxError(ABL_ERR_SYNTAX_INVALID_CONSTANT);
newCaseItem->labelValue = idPtr->defn.info.constant.value.integer;
return(idPtr->typePtr);
}
else
return(&DummyType);
}
else if (curToken == TKN_STRING) {
// STRING/CHAR TYPE...
}
else {
syntaxError(ABL_ERR_SYNTAX_INVALID_CONSTANT);
return(&DummyType);
}
return(&DummyType);
}
