void allocLocal(TypePtr typePtr)
{
if(typePtr == IntegerTypePtr)
pushInteger(0);
else if(typePtr == RealTypePtr)
pushReal((float)0.0);
else if(typePtr == BooleanTypePtr)
pushByte(0);
else if(typePtr == CharTypePtr)
pushByte(0);
else
switch(typePtr->form)
{
case FRM_ENUM:
pushInteger(0);
break;
// NOTE: We currently are not supporting sub ranges, until
// we really want 'em...
// case FRM_SUBRANGE:
// allocLocal(typePtr->info.subrange.rangeTypePtr);
// break;
case FRM_ARRAY:
PSTR ptr = (PSTR)ABLStackMallocCallback(typePtr->size);
if(!ptr)
ABL_Fatal(0, " ABL: Unable to AblStackHeap->malloc local array ");
pushAddress((Address)ptr);
break;
}
}
int32_t WatchManager::init(int32_t max)
{
maxWatches = max;
numWatches = 0;
watches = (WatchPtr)ABLStackMallocCallback(max * sizeof(Watch));
if(!watches)
return(-1);
return(ABL_NO_ERR);
}
int32_t BreakPointManager::init(int32_t max)
{
maxBreakPoints = max;
numBreakPoints = 0;
breakPoints = (int32_t*)ABLStackMallocCallback(max * sizeof(int32_t));
if(!breakPoints)
return(-1);
return(ABL_NO_ERR);
}
void initModuleRegistry(int32_t maxModules)
{
//---------------------------------------------------------------------
// First, set the max number of modules that may be loaded into the ABL
// environment at a time...
MaxModules = maxModules;
//------------------------------
// Create the module registry...
ModuleRegistry = (ModuleEntryPtr)ABLStackMallocCallback(sizeof(ModuleEntry) * MaxModules);
if(!ModuleRegistry)
ABL_Fatal(0, " ABL: Unable to AblStackHeap->malloc Module Registry ");
memset(ModuleRegistry, 0, sizeof(ModuleEntry) * MaxModules);
//-------------------------------------------------
// Create the active (ABLModule) module registry...
ModuleInstanceRegistry = (ABLModulePtr*)ABLStackMallocCallback(sizeof(ABLModulePtr) * MaxModules);
if(!ModuleInstanceRegistry)
ABL_Fatal(0, " ABL: Unable to malloc AblStackHeap->Module Instance Registry ");
memset(ModuleInstanceRegistry, 0, sizeof(ABLModulePtr) * MaxModules);
}
long BreakPointManager::init (long max) {
maxBreakPoints = max;
numBreakPoints = 0;
breakPoints = (long*)ABLStackMallocCallback(max * sizeof(long));
if (!breakPoints)
return(-1);
return(ABL_NO_ERR);
}
void initLibraryRegistry(int32_t maxLibraries)
{
//-----------------------------------------------------------------------
// First, set the max number of libraries that may be loaded into the ABL
// environment at a time...
MaxLibraries = maxLibraries;
//--------------------------------------------------
// Create the active (ABLModule) library registry...
LibraryInstanceRegistry = (ABLModulePtr*)ABLStackMallocCallback(sizeof(ABLModulePtr) * MaxLibraries);
if(!LibraryInstanceRegistry)
ABL_Fatal(0, " ABL: Unable to malloc AblStackHeap->Library Instance Registry ");
memset(LibraryInstanceRegistry, 0, sizeof(ABLModulePtr) * MaxLibraries);
}
void execActualParams(SymTableNodePtr routineIdPtr)
{
//--------------------------
// Execute the parameters...
for(SymTableNodePtr formalIdPtr = (SymTableNodePtr)(routineIdPtr->defn.info.routine.params);
formalIdPtr != nullptr;
formalIdPtr = formalIdPtr->next)
{
TypePtr formalTypePtr = (TypePtr)(formalIdPtr->typePtr);
getCodeToken();
if(formalIdPtr->defn.key == DFN_VALPARAM)
{
//-------------------
// pass by value parameter...
TypePtr actualTypePtr = execExpression();
if((formalTypePtr == RealTypePtr) && (actualTypePtr == IntegerTypePtr))
{
//---------------------------------------------
// Real formal parameter, but integer actual...
tos->real = (float)(tos->integer);
}
//----------------------------------------------------------
// 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...
int32_t size = formalTypePtr->size;
PSTR src = tos->address;
PSTR dest = (PSTR)ABLStackMallocCallback((size_t)size);
if(!dest)
{
char err[255];
sprintf(err, " ABL: Unable to AblStackHeap->malloc actual array param in module %s)", CurModule->getName());
ABL_Fatal(0, err);
}
PSTR savePtr = dest;
memcpy(dest, src, size);
tos->address = savePtr;
}
}
else
{
//-------------------------------
// pass by reference parameter...
SymTableNodePtr idPtr = getCodeSymTableNodePtr();
execVariable(idPtr, USE_REFPARAM);
}
}
}
int32_t 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 = nullptr;
NumStateTransitions = 0;
//--------------------------------------------
// Point to this module's static data space...
StaticDataPtr = staticData;
OrderCompletionFlags = orderCallFlags;
//---------------------------------
// Init some important variables...
CurModuleIdPtr = nullptr;
CurRoutineIdPtr = nullptr;
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(nullptr);
//----------------
// Dynamic Link...
pushAddress(nullptr);
//------------------
// Return Address...
pushAddress(nullptr);
//initDebugger();
//----------
// Run it...
if(moduleParamList)
{
//------------------------------------------------------------------------------
// NOTE: Currently, parameter passing of arrays is not functioning. This MUST be
// done...
int32_t curParam = 0;
for(SymTableNodePtr formalIdPtr = (SymTableNodePtr)(moduleIdPtr->defn.info.routine.params);
formalIdPtr != nullptr;
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...
int32_t size = formalTypePtr->size;
PSTR dest = (PSTR)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);
}
PSTR src = tos->address;
PSTR 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);
}
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((puint8_t)name);
handle = moduleFile->readLong();
staticData = nullptr;
}
else
{
char tempName[1024];
moduleFile->readString((puint8_t)tempName);
//int32_t ignore = moduleFile->readLong();
}
char stateName[256];
memset(stateName, 0, 256);
moduleFile->readString((puint8_t)stateName);
prevState = nullptr;
if(strcmp(stateName, "NULLPrevState"))
prevState = findState(stateName);
memset(stateName, 0, 256);
moduleFile->readString((puint8_t)stateName);
state = nullptr;
if(strcmp(stateName, "NULLState"))
state = findState(stateName);
bool savedInitCalled = (moduleFile->readLong() == 1);
int32_t 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);
}
}
int32_t* sizeList = ModuleRegistry[handle].sizeStaticVars;
for(size_t i = 0; i < numStatics; i++)
if(sizeList[i] > 0)
{
if(fresh)
{
staticData[i].address = (PSTR)ABLStackMallocCallback(sizeList[i]);
if(!staticData)
{
char err[255];
sprintf(err, "ABL: Unable to AblStackHeap->malloc staticData address [Module %d]", id);
ABL_Fatal(0, err);
}
}
int32_t result = moduleFile->read((puint8_t)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;
int32_t result = moduleFile->read((puint8_t)&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)
{
int32_t numLongs = 1 + ModuleRegistry[handle].numOrderCalls / 32;
orderCallFlags = (uint32_t*)ABLStackMallocCallback(sizeof(uint32_t) * numLongs);
if(!orderCallFlags)
{
char err[255];
sprintf(err, "ABLModule.read: Unable to AblStackHeap->malloc orderCallFlags [Module %d]", id);
ABL_Fatal(0, err);
}
for(size_t 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 ");
int32_t 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 ");
}
}
}
int32_t ABLModule::init(int32_t moduleHandle)
{
if(moduleHandle == -1)
{
//----------
// Clean up!
return(-1);
}
id = NumModules++;
handle = moduleHandle;
staticData = nullptr;
int32_t 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);
}
int32_t* sizeList = ModuleRegistry[handle].sizeStaticVars;
for(size_t i = 0; i < numStatics; i++)
if(sizeList[i] > 0)
{
staticData[i].address = (PSTR)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)
{
int32_t numLongs = 1 + ModuleRegistry[handle].numOrderCalls / 32;
orderCallFlags = (uint32_t*)ABLStackMallocCallback(sizeof(uint32_t) * numLongs);
if(!orderCallFlags)
{
char err[255];
sprintf(err, "ABL: Unable to AblStackHeap->malloc orderCallFlags [Module %d]", id);
ABL_Fatal(0, err);
}
for(size_t 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 ");
int32_t 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 = nullptr;
state = startState;
}
//--------------------
// Can this ever fail?
return(ABL_NO_ERR);
}
PVOID Debugger::operator new(size_t mySize)
{
void* result = ABLStackMallocCallback(mySize);
return(result);
}
PVOID BreakPointManager::operator new(size_t mySize)
{
void* result = ABLStackMallocCallback(mySize);
return(result);
}
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);
}
void* WatchManager::operator new (size_t mySize) {
void *result = ABLStackMallocCallback(mySize);
return(result);
}
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;
}
}
