TypePtr execSubscripts(TypePtr typePtr)
{
//----------------------------------------
// Loop to execute bracketed subscripts...
while (codeToken == TKN_LBRACKET)
{
do
{
getCodeToken();
execExpression();
int32_t subscriptValue = tos->integer;
pop();
//-------------------------
// Range check the index...
if ((subscriptValue < 0) || (subscriptValue >= typePtr->info.array.elementCount))
runtimeError(ABL_ERR_RUNTIME_VALUE_OUT_OF_RANGE);
tos->address += (subscriptValue * typePtr->info.array.elementTypePtr->size);
if (codeToken == TKN_COMMA)
typePtr = typePtr->info.array.elementTypePtr;
} while (codeToken == TKN_COMMA);
getCodeToken();
if (codeToken == TKN_LBRACKET)
typePtr = typePtr->info.array.elementTypePtr;
}
return (typePtr->info.array.elementTypePtr);
}
void execRepeatStatement(void)
{
PSTR loopStartLocation = codeSegmentPtr;
int32_t iterations = 0;
do
{
getCodeToken();
if(codeToken != TKN_UNTIL)
do
{
execStatement();
if(ExitWithReturn)
return;
}
while(codeToken != TKN_UNTIL);
//---------------------------
// Check for infinite loop...
iterations++;
if(iterations == MaxLoopIterations)
runtimeError(ABL_ERR_RUNTIME_INFINITE_LOOP);
//-------------------------------
// Eval the boolean expression...
getCodeToken();
execExpression();
if(tos->integer == 0)
codeSegmentPtr = loopStartLocation;
//--------------------------
// Grab the boolean value...
pop();
}
while(codeSegmentPtr == loopStartLocation);
}
void execTransStatement(void)
{
getCodeToken();
getCodeToken();
SymTableNodePtr idPtr = getCodeSymTableNodePtr();
transState(idPtr);
getCodeToken();
}
void execStdPrint (void) {
//---------------------------
// Grab the opening LPAREN...
getCodeToken();
//----------------------------
// Get parameter expression...
getCodeToken();
TypePtr paramTypePtr = execExpression();
char buffer[20];
char* s = buffer;
if (paramTypePtr == IntegerTypePtr)
sprintf(buffer, "%d", tos->integer);
else if (paramTypePtr == BooleanTypePtr)
sprintf(buffer, "%s", tos->integer ? "true" : "false");
else if (paramTypePtr == CharTypePtr)
sprintf(buffer, "%c", tos->byte);
else if (paramTypePtr == RealTypePtr)
sprintf(buffer, "%.4f", tos->real);
else if ((paramTypePtr->form == FRM_ARRAY) && (paramTypePtr->info.array.elementTypePtr == CharTypePtr))
s = (char*)tos->address;
pop();
if (debugger) {
char message[512];
sprintf(message, "PRINT: \"%s\"", s);
debugger->print(message);
sprintf(message, " MODULE %s", CurModule->getName());
debugger->print(message);
sprintf(message, " FILE %s", CurModule->getSourceFile(FileNumber));
debugger->print(message);
sprintf(message, " LINE %d", execLineNumber);
debugger->print(message);
}
/* else if (TACMAP) {
aChatWindow* chatWin = TACMAP->getChatWindow();
if (chatWin)
chatWin->processChatString(0, s, -1);
else {
#ifdef _DEBUG
OutputDebugString(s);
#endif
}
}
*/ else {
#ifdef _DEBUG
ABLDebugPrintCallback(s);
#endif
}
//-----------------------
// Grab closing RPAREN...
getCodeToken();
}
void execSwitchStatement (void) {
getCodeToken();
char* branchTableLocation = getCodeAddressMarker();
getCodeToken();
TypePtr switchExpressionTypePtr = execExpression();
long switchExpressionValue;
if ((switchExpressionTypePtr == IntegerTypePtr) || (switchExpressionTypePtr->form == FRM_ENUM))
switchExpressionValue = tos->integer;
else
switchExpressionValue = tos->byte;
pop();
//---------------------------------------------------------
// Now, search the branch table for the expression value...
codeSegmentPtr = branchTableLocation;
getCodeToken();
long caseLabelCount = getCodeInteger();
bool done = false;
char* caseBranchLocation = NULL;
while (!done && caseLabelCount--) {
long caseLabelValue = getCodeInteger();
caseBranchLocation = getCodeAddress();
done = (caseLabelValue == switchExpressionValue);
}
//-----------------------------------------------
// If found, go to the aprropriate branch code...
if (caseLabelCount >= 0) {
codeSegmentPtr = caseBranchLocation;
getCodeToken();
if (codeToken != TKN_END_CASE)
do {
execStatement();
if (ExitWithReturn)
return;
} while (codeToken != TKN_END_CASE);
//----------------------------------
// Grab the end case and semi-colon...
getCodeToken();
getCodeToken();
codeSegmentPtr = getCodeAddressMarker();
getCodeToken();
}
else {
//-----------------------------------------------------------------
// Since the branch table is located at the end of the case blocks,
// the code directly after the switch statement follows our
// current code location, already. Just grab the endswitch
// and semi-colon...
getCodeToken();
getCodeToken();
}
}
void execOrderReturn (long returnVal) {
//-----------------------------
// Assignment to function id...
StackFrameHeaderPtr headerPtr = (StackFrameHeaderPtr)stackFrameBasePtr;
long delta = level - CurRoutineIdPtr->level - 1;
while (delta-- > 0)
headerPtr = (StackFrameHeaderPtr)headerPtr->staticLink.address;
if (CurRoutineIdPtr->defn.info.routine.flags & ROUTINE_FLAG_STATE) {
//----------------------------------
// Return in a state function, so...
if (debugger)
debugger->traceDataStore(CurRoutineIdPtr, CurRoutineIdPtr->typePtr, (StackItemPtr)headerPtr, CurRoutineIdPtr->typePtr);
ExitWithReturn = true;
ExitFromTacOrder = true;
if (returnVal == 0) {
//----------------------------------------------------------
// Use the "eject" code only if called for a failed Order...
codeSegmentPtr = (char*)ExitStateCodeSegment;
getCodeToken();
}
}
else {
//-------------------------------------------------------------------------
// All Order functions (TacticalOrder/GeneralOrder/ActionOrder) must return
// an integer error code, so we assume the return type is IntegerTypePtr...
StackItemPtr targetPtr = (StackItemPtr)headerPtr;
targetPtr->integer = returnVal;
//----------------------------------------------------------------------
// Preserve the return value, in case we need it for the calling user...
memcpy(&returnValue, targetPtr, sizeof(StackItem));
if (debugger)
debugger->traceDataStore(CurRoutineIdPtr, CurRoutineIdPtr->typePtr, (StackItemPtr)headerPtr, CurRoutineIdPtr->typePtr);
ExitWithReturn = true;
ExitFromTacOrder = true;
if (returnVal == 0) {
//----------------------------------------------------------
// Use the "eject" code only if called for a failed Order...
codeSegmentPtr = (char*)ExitOrderCodeSegment;
getCodeToken();
}
}
}
void execIfStatement(void)
{
getCodeToken();
PSTR falseLocation = getCodeAddressMarker();
//-------------------------------
// Eval the boolean expression. Note that, unlike C/C++, the expression
// must be true(1) or false(0). In C/C++, an expression is true if it's
// non-zero. Not the case in ABL using this current implementation. Do we
// want to change this?
getCodeToken();
execExpression();
bool test = (tos->integer == 1);
pop();
if(test)
{
//---------------------------
// execute the TRUE branch...
getCodeToken();
if((codeToken != TKN_END_IF) && (codeToken != TKN_ELSE))
do
{
execStatement();
if(ExitWithReturn)
return;
}
while((codeToken != TKN_END_IF) && (codeToken != TKN_ELSE));
if(codeToken == TKN_ELSE)
{
getCodeToken();
codeSegmentPtr = getCodeAddressMarker();
getCodeToken();
}
}
else
{
//----------------------------
// Execute the FALSE branch...
codeSegmentPtr = falseLocation;
getCodeToken();
if(codeToken == TKN_ELSE)
{
getCodeToken();
getCodeAddressMarker();
getCodeToken();
if(codeToken != TKN_END_IF)
do
{
execStatement();
if(ExitWithReturn)
return;
}
while(codeToken != TKN_END_IF);
}
}
getCodeToken();
}
void Debugger::assignVariable(void)
{
getToken();
#if 0
if(curToken == TKN_SEMICOLON)
print("Need a variable.\n");
else if(curToken == TKN_IDENTIFIER)
{
//----------------------------------
// Parse the assignment statement...
SymTableNodePtr idPtr = nullptr;
searchAndFindAllSymTables(idPtr);
assigmentStatement(idPtr);
if(errorCount > 0)
return;
//-------------------
// Now, execute it...
PSTR savedCodeSegmentPtr = codeSegmentPtr;
int32_t savedCodeToken = codeToken;
codeSegmentPtr = codeBuffer + 1;
getCodeToken();
idPtr = getSymTableCodePtr();
execAssignmentStatement(idPtr);
//----------------------------
// Restore the code segment...
codeSegmentPtr = savedCodeSegmentPtr;
codeToken = savedCodeToken;
}
#endif
}
long* ABLi_peekIntegerPtr (void) {
getCodeToken();
SymTableNodePtr idPtr = getCodeSymTableNodePtr();
execVariable(idPtr, USE_REFPARAM);
return((long*)(&((StackItemPtr)tos->address)->integer));
}
float* ABLi_peekRealPtr (void) {
getCodeToken();
SymTableNodePtr idPtr = getCodeSymTableNodePtr();
execVariable(idPtr, USE_REFPARAM);
return((float*)(&((StackItemPtr)tos->address)->real));
}
void execWhileStatement (void) {
getCodeToken();
char* loopEndLocation = getCodeAddressMarker();
char* testLocation = codeSegmentPtr;
bool loopDone = false;
long iterations = 0;
do {
//-------------------------------
// Eval the boolean expression...
getCodeToken();
execExpression();
if (tos->integer == 0) {
codeSegmentPtr = loopEndLocation;
loopDone = true;
}
//-------------------------
// Get the boolean value...
pop();
//----------------------------------
// If TRUE, execute the statement...
if (!loopDone) {
getCodeToken();
if (codeToken != TKN_END_WHILE)
do {
execStatement();
if (ExitWithReturn)
return;
} while (codeToken != TKN_END_WHILE);
codeSegmentPtr = testLocation;
//---------------------------
// Check for infinite loop...
iterations++;
if (iterations == MaxLoopIterations)
runtimeError(ABL_ERR_RUNTIME_INFINITE_LOOP);
}
} while (!loopDone);
getCodeToken();
}
void execTransBackStatement(void)
{
SymTableNodePtr prevState = CurModule->getPrevState();
if(!prevState)
runtimeError(ABL_ERR_RUNTIME_NULL_PREVSTATE);
transState(prevState);
getCodeToken();
}
void execAssignmentStatement(SymTableNodePtr idPtr)
{
StackItemPtr targetPtr;
TypePtr targetTypePtr;
TypePtr expressionTypePtr;
//--------------------------
// Assignment to variable...
targetTypePtr = execVariable(idPtr, USE_TARGET);
targetPtr = (StackItemPtr)tos->address;
//------------------------------
// Pop off the target address...
pop();
//------------------------
// Pop the size, if nec...
//if (targetTypePtr->form == FRM_ARRAY)
// pop();
//---------------------------------------------------------------
// Routine execExpression() leaves the expression value on top of
// stack...
getCodeToken();
expressionTypePtr = execExpression();
//--------------------------
// Now, do the assignment...
if((targetTypePtr == RealTypePtr) && (expressionTypePtr == IntegerTypePtr))
{
//-------------------------
// integer assigned to real
targetPtr->real = (float)(tos->integer);
}
else if(targetTypePtr->form == FRM_ARRAY)
{
//-------------------------
// Copy the array/record...
PSTR dest = (PSTR)targetPtr;
PSTR src = tos->address;
int32_t size = targetTypePtr->size;
memcpy(dest, src, size);
}
else if((targetTypePtr == IntegerTypePtr) || (targetTypePtr->form == FRM_ENUM))
{
//------------------------------------------------------
// Range check assignment to integer or enum subrange...
targetPtr->integer = tos->integer;
}
else if(targetTypePtr == CharTypePtr)
targetPtr->byte = tos->byte;
else
{
//-----------------------
// Assign real to real...
targetPtr->real = tos->real;
}
//-----------------------------
// Grab the expression value...
pop();
if(debugger)
debugger->traceDataStore(idPtr, idPtr->typePtr, targetPtr, targetTypePtr);
}
TypePtr execStandardRoutineCall (SymTableNodePtr routineIdPtr, bool skipOrder) {
long key = routineIdPtr->defn.info.routine.key;
switch (key) {
case RTN_RETURN:
execStdReturn();
return(NULL);
case RTN_PRINT:
execStdPrint();
return(NULL);
case RTN_CONCAT:
return(execStdConcat());
default: {
if (key >= NumStandardFunctions) {
char err[255];
sprintf(err, " ABL: Undefined ABL RoutineKey in %s:%d", CurModule->getName(), execLineNumber);
ABL_Fatal(0, err);
}
if (FunctionInfoTable[key].numParams > 0)
getCodeToken();
SkipOrder = skipOrder;
if (FunctionCallbackTable[key])
(*FunctionCallbackTable[key])();
else
{
char err[255];
sprintf(err, " ABL: Undefined ABL RoutineKey %d in %s:%d", key, CurModule->getName(), execLineNumber);
ABL_Fatal(key,err);
}
getCodeToken();
switch (FunctionInfoTable[key].returnType) {
case RETURN_TYPE_NONE:
return(NULL);
case RETURN_TYPE_INTEGER:
return(IntegerTypePtr);
case RETURN_TYPE_REAL:
return(RealTypePtr);
case RETURN_TYPE_BOOLEAN:
return(BooleanTypePtr);
}
}
}
return(NULL);
}
bool ABLi_popBoolean (void) {
getCodeToken();
execExpression();
long val = tos->integer;
pop();
return(val == 1);
}
long ABLi_popInteger (void) {
getCodeToken();
execExpression();
long val = tos->integer;
pop();
return(val);
}
char ABLi_popChar (void) {
getCodeToken();
execExpression();
char val = (char)tos->integer;
pop();
return(val);
}
float ABLi_popReal (void) {
getCodeToken();
execExpression();
float val = tos->real;
pop();
return(val);
}
TypePtr execStdConcat (void) {
//-------------------
// Grab the LPAREN...
getCodeToken();
//--------------------------
// Get destination string...
getCodeToken();
execExpression();
char* dest = (char*)tos->address;
pop();
//----------------------
// Get item to append...
getCodeToken();
TypePtr paramTypePtr = execExpression();
char buffer[20];
if (paramTypePtr == IntegerTypePtr) {
sprintf(buffer, "%d", tos->integer);
strcat(dest, buffer);
}
else if (paramTypePtr == CharTypePtr) {
sprintf(buffer, "%c", tos->byte);
strcat(dest, buffer);
}
else if (paramTypePtr == RealTypePtr) {
sprintf(buffer, "%.2f", tos->real);
strcat(dest, buffer);
}
else if (paramTypePtr == BooleanTypePtr) {
sprintf(buffer, "%s", tos->integer ? "true" : "false");
strcat(dest, buffer);
}
else if ((paramTypePtr->form == FRM_ARRAY) && (paramTypePtr->info.array.elementTypePtr == CharTypePtr))
strcat(dest, (char*)tos->address);
tos->integer = 0;
getCodeToken();
return(IntegerTypePtr);
}
char* ABLi_popBooleanPtr (void) {
//--------------------------
// Get destination string...
getCodeToken();
execExpression();
char* charPtr = (char*)tos->address;
pop();
return(charPtr);
}
float ABLi_popIntegerReal (void) {
getCodeToken();
TypePtr paramTypePtr = execExpression();
float val = 0.0;
if (paramTypePtr == IntegerTypePtr)
val = (float)tos->integer;
else
val = tos->real;
pop();
return(val);
}
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);
}
}
}
TypePtr execConstant(SymTableNodePtr idPtr)
{
TypePtr typePtr = idPtr->typePtr;
if ((typePtr == IntegerTypePtr) || (typePtr->form == FRM_ENUM))
pushInteger(idPtr->defn.info.constant.value.integer);
else if (typePtr == RealTypePtr)
pushReal(idPtr->defn.info.constant.value.real);
else if (typePtr == CharTypePtr)
pushInteger(idPtr->defn.info.constant.value.character);
else if (typePtr->form == FRM_ARRAY)
pushAddress(idPtr->defn.info.constant.value.stringPtr);
if (debugger)
debugger->traceDataFetch(idPtr, typePtr, tos);
getCodeToken();
return (typePtr);
}
long ABLi_popAnything (ABLStackItem* value) {
getCodeToken();
TypePtr paramTypePtr = execExpression();
long type = -1;
if (paramTypePtr == IntegerTypePtr) {
value->type = type = ABL_STACKITEM_INTEGER;
value->data.integer = tos->integer;
}
else if (paramTypePtr == BooleanTypePtr) {
value->type = type = ABL_STACKITEM_BOOLEAN;
value->data.boolean = (tos->integer ? true : false);
}
else if (paramTypePtr == CharTypePtr) {
value->type = type = ABL_STACKITEM_CHAR;
value->data.character = tos->byte;
}
else if (paramTypePtr == RealTypePtr) {
value->type = type = ABL_STACKITEM_REAL;
value->data.real = tos->real;
}
else if (paramTypePtr->form == FRM_ARRAY) {
if (paramTypePtr->info.array.elementTypePtr == CharTypePtr) {
value->type = type = ABL_STACKITEM_CHAR_PTR;
value->data.characterPtr = (char*)tos->address;
}
else if (paramTypePtr->info.array.elementTypePtr == IntegerTypePtr) {
value->type = type = ABL_STACKITEM_INTEGER_PTR;
value->data.integerPtr = (long*)tos->address;
}
else if (paramTypePtr->info.array.elementTypePtr == RealTypePtr) {
value->type = type = ABL_STACKITEM_REAL_PTR;
value->data.realPtr = (float*)tos->address;
}
else if (paramTypePtr->info.array.elementTypePtr == BooleanTypePtr) {
value->type = type = ABL_STACKITEM_BOOLEAN_PTR;
value->data.booleanPtr = (bool*)tos->address;
}
}
pop();
return(type);
}
void execute(SymTableNodePtr routineIdPtr)
{
SymTableNodePtr thisRoutineIdPtr = CurRoutineIdPtr;
CurRoutineIdPtr = routineIdPtr;
routineEntry(routineIdPtr);
//----------------------------------------------------
// Now, search this module for the function we want...
if(CallModuleInit)
{
CallModuleInit = false;
SymTableNodePtr initFunctionIdPtr = searchSymTable("init", ModuleRegistry[CurModule->getHandle()].moduleIdPtr->defn.info.routine.localSymTable);
if(initFunctionIdPtr)
{
execRoutineCall(initFunctionIdPtr, false);
//-------------------------------------------------------------------------
// Since we're calling the function directly, we need to compensate for the
// codeSegmentPtr being incremented by 1 in the normal execRoutineCall...
codeSegmentPtr--;
}
}
if(routineIdPtr->defn.info.routine.flags & ROUTINE_FLAG_FSM)
{
NewStateSet = true;
static char stateList[60][256];
strcpy(SetStateDebugStr, "--");
while(NewStateSet)
{
NumStateTransitions++;
sprintf(stateList[NumStateTransitions], "%s (%s)", CurModule->getState()->name, SetStateDebugStr);
if(NumStateTransitions == 50)
{
UserFile* userFile = UserFile::getNewFile();
char errStr[512];
if(userFile)
{
int32_t err = userFile->open("endless.log");
if(!err)
{
//char s[1024];
//sprintf(s, "Current Date: %s\n", GetTime());
//userFile->write(s);
userFile->write(ModuleRegistry[CurModule->getHandle()].fileName);
for(size_t i = 1; i < 51; i++)
userFile->write(stateList[i]);
userFile->write(" ");
if(ABLEndlessStateCallback)
(*ABLEndlessStateCallback)(userFile);
userFile->close();
}
}
sprintf(errStr, " ABL endless state loop in %s [%s:%s] ", ModuleRegistry[CurModule->getHandle()].fileName, CurModule->getState()->name, CurModule->getPrevState()->name);
#if 0
ABL_Fatal(NumStateTransitions, errStr);
#else
NewStateSet = false;
#endif
}
else
{
NewStateSet = false;
SymTableNodePtr curState = CurModule->getState();
if(!curState)
ABL_Fatal(0, " ABL.execute: nullptr state in FSM ");
execRoutineCall(curState, false);
codeSegmentPtr--;
}
//---------------------------------------------
// In case we exited with a return statement...
ExitWithReturn = false;
ExitFromTacOrder = false;
}
}
else
{
getCodeToken();
execStatement();
//---------------------------------------------
// In case we exited with a return statement...
ExitWithReturn = false;
ExitFromTacOrder = false;
}
routineExit(routineIdPtr);
CurRoutineIdPtr = thisRoutineIdPtr;
}
void execStatement(void)
{
if(codeToken == TKN_STATEMENT_MARKER)
{
execLineNumber = getCodeStatementMarker();
execStatementCount++;
statementStartPtr = codeSegmentPtr;
if(debugger)
debugger->traceStatementExecution();
getCodeToken();
}
switch(codeToken)
{
case TKN_IDENTIFIER:
{
SymTableNodePtr idPtr = getCodeSymTableNodePtr();
ABL_Assert(idPtr != nullptr, 0, " oops ");
if(idPtr->defn.key == DFN_FUNCTION)
{
bool skipOrder = false;
uint8_t orderDWord = 0;
uint8_t orderBitMask = 0;
if((idPtr->defn.info.routine.flags & ROUTINE_FLAG_ORDER) && CurModule->getOrderCallFlags())
{
orderDWord = getCodeByte();
orderBitMask = getCodeByte();
skipOrder = !CurModule->isLibrary() && CurModule->getOrderCallFlag(orderDWord, orderBitMask);
}
TypePtr returnType = execRoutineCall(idPtr, skipOrder);
if(idPtr->defn.info.routine.flags & ROUTINE_FLAG_ORDER)
{
if(AutoReturnFromOrders)
{
//-----------------------------------------------------------------
// We called an Order function, and we're in an Orders/State block,
// so do we continue the flow of orders or stop here?
int32_t returnVal = tos->integer;
pop();
if(returnVal == 0)
execOrderReturn(returnVal);
else if(CurModule->getOrderCallFlags())
{
CurModule->setOrderCallFlag(orderDWord, orderBitMask);
}
}
}
else if(returnType)
{
//------------------------------------------
// In case this routine returns a value, pop
// the return value off the stack...
pop();
}
}
else
execAssignmentStatement(idPtr);
}
break;
case TKN_CODE:
{
bool wasAutoReturnFromOrders = AutoReturnFromOrders;
AutoReturnFromOrders = ((CurRoutineIdPtr->defn.info.routine.flags & (ROUTINE_FLAG_ORDER + ROUTINE_FLAG_STATE)) != 0);
getCodeToken();
TokenCodeType endToken = TKN_END_FUNCTION;
if(CurRoutineIdPtr->defn.info.routine.flags & ROUTINE_FLAG_ORDER)
endToken = TKN_END_ORDER;
else if(CurRoutineIdPtr->defn.info.routine.flags & ROUTINE_FLAG_STATE)
endToken = TKN_END_STATE;
TokenCodeType endTokenFinal = TKN_END_MODULE;
if(CurLibrary)
endTokenFinal = TKN_END_LIBRARY;
else if(CurRoutineIdPtr->defn.info.routine.flags & ROUTINE_FLAG_FSM)
endTokenFinal = TKN_END_FSM;
while((codeToken != endToken) && (codeToken != endTokenFinal) && !NewStateSet)
execStatement();
if(NewStateSet)
return;
getCodeToken();
AutoReturnFromOrders = wasAutoReturnFromOrders;
}
break;
case TKN_FOR:
execForStatement();
break;
case TKN_IF:
execIfStatement();
break;
case TKN_REPEAT:
execRepeatStatement();
break;
case TKN_WHILE:
execWhileStatement();
break;
case TKN_SWITCH:
execSwitchStatement();
break;
case TKN_TRANS:
execTransStatement();
break;
case TKN_TRANS_BACK:
execTransBackStatement();
break;
case TKN_SEMICOLON:
case TKN_ELSE:
case TKN_UNTIL:
break;
default:
//runtimeError(ABL_ERR_RUNTIME_UNIMPLEMENTED_FEATURE);
NODEFAULT;
}
while(codeToken == TKN_SEMICOLON)
getCodeToken();
}
TypePtr execFactor(void)
{
TypePtr resultTypePtr = nullptr;
switch (codeToken)
{
case TKN_IDENTIFIER:
{
SymTableNodePtr idPtr = getCodeSymTableNodePtr();
if (idPtr->defn.key == DFN_FUNCTION)
{
SymTableNodePtr thisRoutineIdPtr = CurRoutineIdPtr;
resultTypePtr = execRoutineCall(idPtr, false);
CurRoutineIdPtr = thisRoutineIdPtr;
}
else if (idPtr->defn.key == DFN_CONST)
resultTypePtr = execConstant(idPtr);
else
resultTypePtr = execVariable(idPtr, USE_EXPR);
}
break;
case TKN_NUMBER:
{
SymTableNodePtr numberPtr = getCodeSymTableNodePtr();
if (numberPtr->typePtr == IntegerTypePtr)
{
pushInteger(numberPtr->defn.info.constant.value.integer);
resultTypePtr = IntegerTypePtr;
}
else
{
pushReal(numberPtr->defn.info.constant.value.real);
resultTypePtr = RealTypePtr;
}
getCodeToken();
}
break;
case TKN_STRING:
{
SymTableNodePtr nodePtr = getCodeSymTableNodePtr();
int32_t length = strlen(nodePtr->name);
if (length > 1)
{
//-----------------------------------------------------------------------
// Remember, the double quotes are on the back and front of the
// string...
pushAddress(nodePtr->info);
resultTypePtr = nodePtr->typePtr;
}
else
{
//----------------------------------------------
// Just push the one character in this string...
pushByte(nodePtr->name[0]);
resultTypePtr = CharTypePtr;
}
getCodeToken();
}
break;
case TKN_NOT:
getCodeToken();
resultTypePtr = execFactor();
//--------------------------------------
// Following flips 1 to 0, and 0 to 1...
tos->integer = 1 - tos->integer;
break;
case TKN_LPAREN:
getCodeToken();
resultTypePtr = execExpression();
getCodeToken();
break;
}
return (resultTypePtr);
}
TypePtr execTerm(void)
{
StackItemPtr operand1Ptr;
StackItemPtr operand2Ptr;
TypePtr type2Ptr;
TokenCodeType op;
TypePtr resultTypePtr = execFactor();
//----------------------------------------------
// Process the factors separated by operators...
while ((codeToken == TKN_STAR) || (codeToken == TKN_FSLASH) || (codeToken == TKN_DIV) ||
(codeToken == TKN_MOD) || (codeToken == TKN_AND))
{
op = codeToken;
getCodeToken();
type2Ptr = execFactor();
operand1Ptr = tos - 1;
operand2Ptr = tos;
if (op == TKN_AND)
{
operand1Ptr->integer = operand1Ptr->integer && operand2Ptr->integer;
resultTypePtr = BooleanTypePtr;
}
else
switch (op)
{
case TKN_STAR:
if ((resultTypePtr == IntegerTypePtr) && (type2Ptr == IntegerTypePtr))
{
//-----------------------------
// Both operands are integer...
operand1Ptr->integer = operand1Ptr->integer * operand2Ptr->integer;
resultTypePtr = IntegerTypePtr;
}
else
{
//----------------------------------------------------------------
// Both operands are real, or one is real and the other
// integer...
promoteOperandsToReal(operand1Ptr, resultTypePtr, operand2Ptr, type2Ptr);
operand1Ptr->real = operand1Ptr->real * operand2Ptr->real;
resultTypePtr = RealTypePtr;
}
break;
case TKN_FSLASH:
//--------------------------------------------------------------------
// Both operands are real, or one is real and the other an
// integer. We probably want this same token to be used for
// integers, as opposed to using the DIV token...
if ((resultTypePtr == IntegerTypePtr) && (type2Ptr == IntegerTypePtr))
{
//-----------------------------
// Both operands are integer...
if (operand2Ptr->integer == 0)
{
#ifdef _DEBUG
runtimeError(ABL_ERR_RUNTIME_DIVISION_BY_ZERO);
#else
// HACK!!!!!!!!!!!!
operand1Ptr->integer = 0;
#endif
}
else
operand1Ptr->integer = operand1Ptr->integer / operand2Ptr->integer;
resultTypePtr = IntegerTypePtr;
}
else
{
//----------------------------------------------------------------
// Both operands are real, or one is real and the other
// integer...
promoteOperandsToReal(operand1Ptr, resultTypePtr, operand2Ptr, type2Ptr);
if (operand2Ptr->real == 0.0)
#ifdef _DEBUG
runtimeError(ABL_ERR_RUNTIME_DIVISION_BY_ZERO);
#else
// HACK!!!!!!!!!!!!
operand1Ptr->real = 0.0;
#endif
else
operand1Ptr->real = operand1Ptr->real / operand2Ptr->real;
resultTypePtr = RealTypePtr;
}
break;
case TKN_DIV:
case TKN_MOD:
//-----------------------------
// Both operands are integer...
if (operand2Ptr->integer == 0)
#ifdef _DEBUG
runtimeError(ABL_ERR_RUNTIME_DIVISION_BY_ZERO);
#else
// HACK!!!!!!!!!!!!
operand1Ptr->integer = 0;
#endif
else
{
if (op == TKN_DIV)
operand1Ptr->integer = operand1Ptr->integer / operand2Ptr->integer;
else
operand1Ptr->integer = operand1Ptr->integer % operand2Ptr->integer;
}
resultTypePtr = IntegerTypePtr;
break;
}
TypePtr execDeclaredRoutineCall(SymTableNodePtr routineIdPtr, bool skipOrder)
{
if(skipOrder)
{
StackItemPtr curStackFrameBase = tos;
//----------------------------------------
// Push parameter values onto the stack...
getCodeToken();
if(codeToken == TKN_LPAREN)
{
execActualParams(routineIdPtr);
getCodeToken();
}
getCodeToken();
tos = curStackFrameBase;
pushInteger(1);
return((TypePtr)(routineIdPtr->typePtr));
}
int32_t oldLevel = level; // level of caller
int32_t newLevel = routineIdPtr->level + 1; // level of callee
CallStackLevel++;
//-------------------------------------------
// First, set up the stack frame of callee...
StackItemPtr newStackFrameBasePtr = tos + 1;
bool isLibraryCall = (routineIdPtr->library && (routineIdPtr->library != CurRoutineIdPtr->library));
if(isLibraryCall)
pushStackFrameHeader(-1, -1);
else
pushStackFrameHeader(oldLevel, newLevel);
//----------------------------------------
// Push parameter values onto the stack...
getCodeToken();
if(codeToken == TKN_LPAREN)
{
execActualParams(routineIdPtr);
getCodeToken();
}
//-------------------------------------------------
// Set the return address in the new stack frame...
level = newLevel;
stackFrameBasePtr = newStackFrameBasePtr;
StackFrameHeaderPtr headerPtr = (StackFrameHeaderPtr)stackFrameBasePtr;
headerPtr->returnAddress.address = codeSegmentPtr - 1;
//---------------------------------------------------------
// If we're calling a library function, we need to set some
// module-specific info...
ABLModulePtr PrevModule = nullptr;
if(isLibraryCall)
{
PrevModule = CurModule;
CurModule = routineIdPtr->library;
CurModuleHandle = CurModule->getHandle();
if(debugger)
debugger->setModule(CurModule);
StaticDataPtr = CurModule->getStaticData();
CallModuleInit = !CurModule->getInitCalled();
CurModule->setInitCalled(true);
// routineEntry(ModuleRegistry[CurModule->getHandle()].moduleIdPtr);
}
if(ProfileLog)
{
int32_t functionStartTime = ABLGetTimeCallback();
execute(routineIdPtr);
int32_t functionExecTime = ABLGetTimeCallback() - functionStartTime;
if(functionExecTime > ProfileLogFunctionTimeLimit)
{
char s[512];
sprintf_s(s, _countof(s), "[%08d] ", NumExecutions);
for(size_t i = 0; i < CallStackLevel; i++)
strcat(s, " ");
char s1[512];
sprintf_s(s1, _countof(s1), "%s (%d)\n", routineIdPtr->name, functionExecTime);
strcat(s, s1);
ABL_AddToProfileLog(s);
}
}
else
execute(routineIdPtr);
//----------------------------------------------------------------
// If we're calling a library function, reset some module-specific
// info...
if(isLibraryCall)
{
// routineExit(ModuleRegistry[CurModule->getHandle()].moduleIdPtr);
CurModule = PrevModule;
CurModuleHandle = CurModule->getHandle();
if(debugger)
debugger->setModule(CurModule);
StaticDataPtr = CurModule->getStaticData();
}
//-------------------------------------------------------
// Return from the callee, and grab the first token after
// the return...
level = oldLevel;
getCodeToken();
CallStackLevel--;
return((TypePtr)(routineIdPtr->typePtr));
}
void execForStatement(void)
{
getCodeToken();
//---------------------------------------
// Grab address of the end of the loop...
PSTR loopEndLocation = getCodeAddressMarker();
//--------------------------------------------------------
// Get the address of the control variable's stack item...
getCodeToken();
SymTableNodePtr controlIdPtr = getCodeSymTableNodePtr();
TypePtr controlTypePtr = execVariable(controlIdPtr, USE_TARGET);
StackItemPtr targetPtr = (StackItemPtr)tos->address;
//------------------------------------
// Control variable address...
pop();
//-------------------------------
// Eval the initial expression...
getCodeToken();
execExpression();
int32_t initialValue;
if(controlTypePtr == IntegerTypePtr)
initialValue = tos->integer;
else
initialValue = tos->byte;
//---------------------
// The initial value...
pop();
int32_t deltaValue;
if(codeToken == TKN_TO)
deltaValue = 1;
else
deltaValue = -1;
//----------------------------------
// Now, eval the final expression...
getCodeToken();
execExpression();
int32_t finalValue;
if(controlTypePtr == IntegerTypePtr)
finalValue = tos->integer;
else
finalValue = tos->byte;
//-------------------
// The final value...
pop();
//----------------------------
// Address of start of loop...
PSTR loopStartLocation = codeSegmentPtr;
int32_t controlValue = initialValue;
//-----------------------------
// Now, execute the FOR loop...
int32_t iterations = 0;
if(deltaValue == 1)
while(controlValue <= finalValue)
{
if(controlTypePtr == IntegerTypePtr)
targetPtr->integer = controlValue;
else
targetPtr->byte = (uint8_t)controlValue;
getCodeToken();
if(codeToken != TKN_END_FOR)
do
{
execStatement();
if(ExitWithReturn)
return;
}
while(codeToken != TKN_END_FOR);
//---------------------------
// Check for infinite loop...
if(++iterations == MaxLoopIterations)
runtimeError(ABL_ERR_RUNTIME_INFINITE_LOOP);
controlValue++;
codeSegmentPtr = loopStartLocation;
}
else
while(controlValue >= finalValue)
{
if(controlTypePtr == IntegerTypePtr)
targetPtr->integer = controlValue;
else
targetPtr->byte = (uint8_t)controlValue;
getCodeToken();
if(codeToken != TKN_END_FOR)
do
{
execStatement();
if(ExitWithReturn)
return;
}
while(codeToken != TKN_END_FOR);
//---------------------------
// Check for infinite loop...
if(++iterations == MaxLoopIterations)
runtimeError(ABL_ERR_RUNTIME_INFINITE_LOOP);
controlValue--;
codeSegmentPtr = loopStartLocation;
}
codeSegmentPtr = loopEndLocation;
getCodeToken();
}
