float* ABLi_peekRealPtr (void) {
getCodeToken();
SymTableNodePtr idPtr = getCodeSymTableNodePtr();
execVariable(idPtr, USE_REFPARAM);
return((float*)(&((StackItemPtr)tos->address)->real));
}
long* ABLi_peekIntegerPtr (void) {
getCodeToken();
SymTableNodePtr idPtr = getCodeSymTableNodePtr();
execVariable(idPtr, USE_REFPARAM);
return((long*)(&((StackItemPtr)tos->address)->integer));
}
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);
}
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);
}
}
}
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();
}
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);
}
