static void pas_Assignment(uint16_t storeOp, exprType assignType,
STYPE *varPtr, STYPE *typePtr)
{
TRACE(lstFile,"[pas_Assignment]");
/* FORM: <variable OR function identifer> := <expression> */
if (token != tASSIGN) error (eASSIGN);
else getToken();
expression(assignType, typePtr);
pas_GenerateStackReference(storeOp, varPtr);
}
static void writeText (uint16_t fileNumber)
{
exprType writeType;
STYPE *wPtr;
TRACE(lstFile, "[writeText]");
for (;;)
{
/* The general form is <expression>, <expression>, ... However,
* there are a few unique things that must be handled as special
* cases
*/
switch (token)
{
/* const strings -- either literal constants (tSTRING_CONST)
* or defined string constant symbols (sSTRING_CONST)
*/
case tSTRING_CONST :
{
/* Add the literal string constant to the RO data section
* and receive the offset to the data.
*/
uint32_t offset = poffAddRoDataString(poffHandle, tkn_strt);
/* Set the offset and size on the stack (order is important) */
pas_GenerateDataOperation(opLAC, (uint16_t)offset);
pas_GenerateDataOperation(opPUSH, strlen(tkn_strt));
pas_GenerateIoOperation(xWRITE_STRING, fileNumber);
pas_GenerateDataOperation(opINDS, -(sPTR_SIZE + sINT_SIZE));
stringSP = tkn_strt;
getToken();
}
break;
case sSTRING_CONST :
pas_GenerateDataOperation(opLAC, (uint16_t)tknPtr->sParm.s.offset);
pas_GenerateDataOperation(opPUSH, (uint16_t)tknPtr->sParm.s.size);
pas_GenerateIoOperation(xWRITE_STRING, fileNumber);
pas_GenerateDataOperation(opINDS, -(sPTR_SIZE + sINT_SIZE));
getToken();
break;
/* Array of type CHAR without indexing */
case sARRAY :
wPtr = tknPtr->sParm.v.parent;
if (((wPtr) && (wPtr->sKind == sTYPE)) &&
(wPtr->sParm.t.type == sCHAR) &&
(getNextCharacter(true) != '['))
{
pas_GenerateStackReference(opLAS, wPtr);
pas_GenerateDataOperation(opPUSH, wPtr->sParm.v.size);
pas_GenerateIoOperation(xWRITE_STRING, fileNumber);
pas_GenerateDataOperation(opINDS, -(sPTR_SIZE + sINT_SIZE));
break;
} /* end if */
/* Otherwise, we fall through to process the ARRAY like any */
/* expression */
default :
writeType = expression(exprUnknown, NULL);
switch (writeType)
{
case exprInteger :
pas_GenerateIoOperation(xWRITE_INT, fileNumber);
pas_GenerateDataOperation(opINDS, -sINT_SIZE);
break;
case exprBoolean :
error(eNOTYET);
break;
case exprChar :
pas_GenerateIoOperation(xWRITE_CHAR, fileNumber);
pas_GenerateDataOperation(opINDS, -sINT_SIZE);
break;
case exprReal :
pas_GenerateIoOperation(xWRITE_REAL, fileNumber);
pas_GenerateDataOperation(opINDS, -sREAL_SIZE);
break;
case exprString :
case exprStkString :
pas_GenerateIoOperation(xWRITE_STRING, fileNumber);
pas_GenerateDataOperation(opINDS, -sRSTRING_SIZE);
break;
default :
error(eWRITEPARM);
break;
} /* end switch */
break;
} /* end switch */
if (token == ',') getToken();
else return;
} /* end for */
} /* end writeText */
static void readText (uint16_t fileNumber)
{
STYPE *rPtr;
TRACE(lstFile, "[readText]");
/* The general form is <VAR parm>, <VAR parm>,... */
for (;;)
{
switch (token)
{
/* SPECIAL CASE: Array of type CHAR without indexing */
case sARRAY :
rPtr = tknPtr->sParm.v.parent;
if (((rPtr) && (rPtr->sKind == sTYPE)) &&
(rPtr->sParm.t.type == sCHAR) &&
(getNextCharacter(true) != '['))
{
pas_GenerateStackReference(opLAS, rPtr);
pas_GenerateDataOperation(opPUSH, rPtr->sParm.v.size);
pas_GenerateIoOperation(xREAD_STRING, fileNumber);
pas_GenerateDataOperation(opINDS, -(sPTR_SIZE+sINT_SIZE));
} /* end if */
/* Otherwise, we fall through to process the ARRAY like any */
/* expression */
default :
switch (varParm(exprUnknown, NULL))
{
case exprIntegerPtr :
pas_GenerateIoOperation(xREAD_INT, fileNumber);
pas_GenerateDataOperation(opINDS, -sPTR_SIZE);
break;
case exprCharPtr :
pas_GenerateIoOperation(xREAD_CHAR, fileNumber);
pas_GenerateDataOperation(opINDS, -sPTR_SIZE);
break;
case exprRealPtr :
pas_GenerateIoOperation(xREAD_REAL, fileNumber);
pas_GenerateDataOperation(opINDS, -sPTR_SIZE);
break;
default :
error(eINVARG);
break;
} /* end switch */
break;
} /* end switch */
if (token == ',') getToken();
else return;
} /* end for */
} /* end readText */
static void pas_StringAssignment(STYPE *varPtr, STYPE *typePtr)
{
exprType stringKind;
TRACE(lstFile,"[pas_StringAssignment]");
/* FORM: <variable OR function identifer> := <expression> */
/* Verify that the assignment token follows the indentifier */
if (token != tASSIGN) error (eASSIGN);
else getToken();
/* Get the expression after assignment token. We'll take any kind
* of string expression. This is a hack to handle calls to system
* functions that return exprCString pointers that must be converted
* to exprString records upon assignment.
*/
stringKind = expression(exprAnyString, typePtr);
/* Place the address of the destination string structure instance on the
* stack.
*/
pas_GenerateStackReference(opLAS, varPtr);
/* Check if this is an assignment to a global allocated string, or
* to a stack reference to an allocated string.
*/
if (varPtr->sKind == sRSTRING)
{
/* It is an assignment to a string reference --
* Generate a runtime library call to copy the destination
* string string into the pascal string instance. The particular
* runtime call will account for any necesary string type conversion.
*/
if ((stringKind == exprString) || (stringKind == exprStkString))
{
/* It is a pascal string type. Current stack representation is:
*
* TOS(0)=address of dest string reference
* TOS(1)=length of source string
* TOS(2)=pointer to source string
*/
pas_BuiltInFunctionCall(lbSTR2RSTR);
}
else if (stringKind == exprCString)
{
/* It is a 32-bit C string point. Current stack representation is:
*
* TOS(0)=address of dest string reference
* TOS(1)=MS 16-bits of 32-bit C source string pointer
* TOS(2)=LS 16-bits of 32-bit C source string pointer
*/
pas_BuiltInFunctionCall(lbCSTR2RSTR);
}
}
else
{
/* It is an assignment to a allocated Pascal string --
* Generate a runtime library call to copy the destination
* string string into the pascal string instance. The particular
* runtime call will account for any necesary string type conversion.
*/
if ((stringKind == exprString) || (stringKind == exprStkString))
{
/* It is a pascal string type. Current stack representation is:
*
* TOS(0)=address of dest string hdr
* TOS(1)=length of source string
* TOS(2)=pointer to source string
*/
pas_BuiltInFunctionCall(lbSTR2STR);
}
else if (stringKind == exprCString)
{
/* It is a 32-bit C string point. Current stack representation is:
*
* TOS(0)=address of dest string hdr
* TOS(1)=MS 16-bits of 32-bit C source string pointer
* TOS(2)=LS 16-bits of 32-bit C source string pointer
*/
pas_BuiltInFunctionCall(lbCSTR2STR);
}
}
/* else ... type mismatch error already reported by expression() */
}
static void pas_SimpleAssignment(STYPE *varPtr, uint8_t assignFlags)
{
STYPE *typePtr;
TRACE(lstFile,"[pas_SimpleAssignment]");
/* FORM: <variable OR function identifer> := <expression> */
typePtr = varPtr->sParm.v.parent;
switch (varPtr->sKind)
{
/* Check if we have reduce the complex assignment to a simple
* assignment yet
*/
case sINT :
if ((assignFlags & INDEXED_ASSIGNMENT) != 0)
{
if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
{
pas_GenerateStackReference(opLDSX, varPtr);
pas_Assignment(opSTI, exprInteger, varPtr, typePtr);
} /* end if */
else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
pas_Assignment(opSTSX, exprIntegerPtr, varPtr, typePtr);
else
pas_Assignment(opSTSX, exprInteger, varPtr, typePtr);
} /* end if */
else
{
if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
{
pas_GenerateStackReference(opLDS, varPtr);
pas_Assignment(opSTI, exprInteger, varPtr, typePtr);
} /* end if */
else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
pas_Assignment(opSTS, exprIntegerPtr, varPtr, typePtr);
else
pas_Assignment(opSTS, exprInteger, varPtr, typePtr);
} /* end else */
break;
case sCHAR :
if ((assignFlags & INDEXED_ASSIGNMENT) != 0)
{
if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
{
pas_GenerateStackReference(opLDSX, varPtr);
pas_Assignment(opSTIB, exprChar, varPtr, typePtr);
} /* end if */
else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
pas_Assignment(opSTSX, exprCharPtr, varPtr, typePtr);
else
pas_Assignment(opSTSXB, exprChar, varPtr, typePtr);
} /* end if */
else
{
if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
{
pas_GenerateStackReference(opLDS, varPtr);
pas_Assignment(opSTIB, exprChar, varPtr, typePtr);
} /* end if */
else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
pas_Assignment(opSTS, exprCharPtr, varPtr, typePtr);
else
pas_Assignment(opSTSB, exprChar, varPtr, typePtr);
} /* end else */
break;
case sBOOLEAN :
if ((assignFlags & INDEXED_ASSIGNMENT) != 0)
{
if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
{
pas_GenerateStackReference(opLDSX, varPtr);
pas_Assignment(opSTI, exprBoolean, varPtr, NULL);
} /* end if */
else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
pas_Assignment(opSTSX, exprBooleanPtr, varPtr, typePtr);
else
pas_Assignment(opSTSX, exprBoolean, varPtr, NULL);
} /* end if */
else
{
if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
{
pas_GenerateStackReference(opLDS, varPtr);
pas_Assignment(opSTI, exprBoolean, varPtr, NULL);
} /* end if */
else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
pas_Assignment(opSTS, exprBooleanPtr, varPtr, typePtr);
else
pas_Assignment(opSTS, exprBoolean, varPtr, NULL);
} /* end else */
break;
case sREAL :
if ((assignFlags & INDEXED_ASSIGNMENT) != 0)
{
if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
{
pas_GenerateStackReference(opLDSX, varPtr);
pas_LargeAssignment(opSTIM, exprReal, varPtr, typePtr);
} /* end if */
else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
pas_Assignment(opSTSX, exprRealPtr, varPtr, typePtr);
else
pas_LargeAssignment(opSTSXM, exprReal, varPtr, typePtr);
} /* end if */
else
{
if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
{
pas_GenerateStackReference(opLDS, varPtr);
pas_LargeAssignment(opSTIM, exprReal, varPtr, typePtr);
} /* end if */
else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
pas_Assignment(opSTS, exprRealPtr, varPtr, typePtr);
else
pas_LargeAssignment(opSTSM, exprReal, varPtr, typePtr);
} /* end else */
break;
case sSCALAR :
if ((assignFlags & INDEXED_ASSIGNMENT) != 0)
{
if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
{
pas_GenerateStackReference(opLDSX, varPtr);
pas_Assignment(opSTI, exprScalar, varPtr, typePtr);
} /* end if */
else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
pas_Assignment(opSTSX, exprScalarPtr, varPtr, typePtr);
else
pas_Assignment(opSTSX, exprScalar, varPtr, typePtr);
} /* end if */
else
{
if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
{
pas_GenerateStackReference(opLDS, varPtr);
pas_Assignment(opSTI, exprScalar, varPtr, typePtr);
} /* end if */
else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
pas_Assignment(opSTS, exprScalarPtr, varPtr, typePtr);
else
pas_Assignment(opSTS, exprScalar, varPtr, typePtr);
} /* end else */
break;
case sSET_OF :
if ((assignFlags & INDEXED_ASSIGNMENT) != 0)
{
if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
{
pas_GenerateStackReference(opLDSX, varPtr);
pas_Assignment(opSTI, exprSet, varPtr, typePtr);
} /* end if */
else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
pas_Assignment(opSTSX, exprSetPtr, varPtr, typePtr);
else
pas_Assignment(opSTSX, exprSet, varPtr, typePtr);
} /* end if */
else
{
if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
{
pas_GenerateStackReference(opLDS, varPtr);
pas_Assignment(opSTI, exprSet, varPtr, typePtr);
} /* end if */
else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
pas_Assignment(opSTS, exprSetPtr, varPtr, typePtr);
else
pas_Assignment(opSTS, exprSet, varPtr, typePtr);
} /* end else */
break;
/* NOPE... recurse until it becomes a simple assignment */
case sSUBRANGE :
varPtr->sKind = typePtr->sParm.t.subType;
pas_SimpleAssignment(varPtr, assignFlags);
break;
case sRECORD :
/* FORM: <record identifier>.<field> := <expression>
* OR: <record pointer identifier> := <pointer expression>
*/
/* Check if this is a pointer to a record */
if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
{
if (token == '.') error(ePOINTERTYPE);
if ((assignFlags & INDEXED_ASSIGNMENT) != 0)
pas_Assignment(opSTSX, exprRecordPtr, varPtr, typePtr);
else
pas_Assignment(opSTS, exprRecordPtr, varPtr, typePtr);
} /* end if */
else if (((assignFlags & ADDRESS_DEREFERENCE) != 0) &&
((assignFlags & VAR_PARM_ASSIGNMENT) == 0))
error(ePOINTERTYPE);
/* Check if a period separates the RECORD identifier from the
* record field identifier
*/
else if (token == '.')
{
/* Skip over the period */
getToken();
/* Verify that a field identifier associated with this record
* follows the period.
*/
if ((token != sRECORD_OBJECT) ||
(tknPtr->sParm.r.record != typePtr))
error(eRECORDOBJECT);
else
{
/* Modify the variable so that it has the characteristics of the
* the field but with level and offset associated with the record
*/
typePtr = tknPtr->sParm.r.parent;
varPtr->sKind = typePtr->sParm.t.type;
varPtr->sParm.v.parent = typePtr;
/* Special case: The record is a VAR parameter. */
if (assignFlags == (INDEXED_ASSIGNMENT | ADDRESS_DEREFERENCE | VAR_PARM_ASSIGNMENT))
{
pas_GenerateDataOperation(opPUSH, tknPtr->sParm.r.offset);
pas_GenerateSimple(opADD);
} /* end if */
else
varPtr->sParm.v.offset += tknPtr->sParm.r.offset;
getToken();
pas_SimpleAssignment(varPtr, assignFlags);
} /* end else if */
} /* end else */
/* It must be a RECORD assignment */
else
{
/* Special case: The record is a VAR parameter. */
if (assignFlags == (INDEXED_ASSIGNMENT | ADDRESS_DEREFERENCE | VAR_PARM_ASSIGNMENT))
{
pas_GenerateStackReference(opLDS, varPtr);
pas_GenerateSimple(opADD);
pas_LargeAssignment(opSTIM, exprRecord, varPtr, typePtr);
} /* end if */
else
pas_LargeAssignment(opSTSM, exprRecord, varPtr, typePtr);
} /* end else */
break;
case sRECORD_OBJECT :
/* FORM: <field> := <expression>
* NOTE: This must have been preceeded with a WITH statement
* defining the RECORD type
*/
if (!withRecord.parent)
error(eINVTYPE);
else if ((assignFlags && (ADDRESS_DEREFERENCE | ADDRESS_ASSIGNMENT)) != 0)
error(ePOINTERTYPE);
else if ((assignFlags && INDEXED_ASSIGNMENT) != 0)
error(eARRAYTYPE);
/* Verify that a field identifier is associated with the RECORD
* specified by the WITH statement.
*/
else if (varPtr->sParm.r.record != withRecord.parent)
error(eRECORDOBJECT);
else
{
int16_t tempOffset;
/* Now there are two cases to consider: (1) the withRecord is a
* pointer to a RECORD, or (2) the withRecord is the RECORD itself
*/
if (withRecord.pointer)
{
/* If the pointer is really a VAR parameter, then other syntax
* rules will apply
*/
if (withRecord.varParm)
assignFlags |= (INDEXED_ASSIGNMENT | ADDRESS_DEREFERENCE | VAR_PARM_ASSIGNMENT);
else
assignFlags |= (INDEXED_ASSIGNMENT | ADDRESS_DEREFERENCE);
pas_GenerateDataOperation(opPUSH, (varPtr->sParm.r.offset + withRecord.index));
tempOffset = withRecord.offset;
} /* end if */
else
{
tempOffset = varPtr->sParm.r.offset + withRecord.offset;
} /* end else */
/* Modify the variable so that it has the characteristics of the
* the field but with level and offset associated with the record
* NOTE: We have to be careful here because the structure
* associated with sRECORD_OBJECT is not the same as for
* variables!
*/
typePtr = varPtr->sParm.r.parent;
varPtr->sKind = typePtr->sParm.t.type;
varPtr->sLevel = withRecord.level;
varPtr->sParm.v.size = typePtr->sParm.t.asize;
varPtr->sParm.v.offset = tempOffset;
varPtr->sParm.v.parent = typePtr;
pas_SimpleAssignment(varPtr, assignFlags);
} /* end else */
break;
case sPOINTER :
/* FORM: <pointer identifier>^ := <expression>
* OR: <pointer identifier> := <pointer expression>
*/
if (token == '^') /* value assignment? */
{
getToken();
assignFlags |= ADDRESS_DEREFERENCE;
} /* end if */
else
assignFlags |= ADDRESS_ASSIGNMENT;
varPtr->sKind = typePtr->sParm.t.type;
pas_SimpleAssignment(varPtr, assignFlags);
break;
case sVAR_PARM :
if (assignFlags != 0) error(eVARPARMTYPE);
assignFlags |= (ADDRESS_DEREFERENCE | VAR_PARM_ASSIGNMENT);
varPtr->sKind = typePtr->sParm.t.type;
pas_SimpleAssignment(varPtr, assignFlags);
break;
case sARRAY :
/* FORM: <array identifier> := <expression>
* OR: <pointer array identifier>[<index>]^ := <expression>
* OR: <pointer array identifier>[<index>] := <pointer expression>
* OR: <record array identifier>[<index>].<field identifier> := <expression>
* OR: etc., etc., etc.
*/
if (assignFlags != 0) error(eARRAYTYPE);
assignFlags |= INDEXED_ASSIGNMENT;
arrayIndex(typePtr->sParm.t.asize);
varPtr->sKind = typePtr->sParm.t.type;
varPtr->sParm.v.size = typePtr->sParm.t.asize;
pas_SimpleAssignment(varPtr, assignFlags);
break;
default :
error(eINVTYPE);
break;
}
}
static void pas_ForStatement(void)
{
STYPE *varPtr;
uint16_t forLabel = ++label;
uint16_t endForLabel = ++label;
uint16_t jmpOp;
uint16_t modOp;
int32_t topOfLoopLSP;
TRACE(lstFile,"[pas_ForStatement]");
/* FOR <assigment statement> <TO, DOWNTO> <expression> DO <statement> */
/* Skip over the FOR token */
getToken();
/* Get and verify the left side of the assignment. */
if ((token != sINT) && (token != sSUBRANGE))
error(eINTVAR);
else
{
/* Save the token associated with the left side of the assignment
* and evaluate the integer assignment.
*/
varPtr = tknPtr;
getToken();
/* Generate the assignment to the integer variable */
pas_Assignment(opSTS, exprInteger, tknPtr, tknPtr->sParm.v.parent);
/* Determine if this is a TO or a DOWNTO loop and set up the opCodes
* to generate appropriately.
*/
if (token == tDOWNTO)
{
jmpOp = opJGT;
modOp = opDEC;
getToken();
}
else if (token == tTO)
{
jmpOp = opJLT;
modOp = opINC;
getToken();
}
else
error (eTOorDOWNTO);
/* Evaluate <expression> DO */
expression(exprInteger, varPtr->sParm.v.parent);
/* Verify that the <expression> is followed by the DO token */
if (token != tDO) error (eDO);
else getToken();
/* Generate top of loop label */
pas_GenerateDataOperation(opLABEL, forLabel);
/* Generate the top of loop comparison. Duplicate the end of loop
* value, push the current value, and perform the comparison.
*/
pas_GenerateSimple(opDUP);
pas_GenerateStackReference(opLDS, varPtr);
pas_GenerateDataOperation(jmpOp, endForLabel);
/* Save the level stack pointer (LSP) at the top of the FOR
* loop. When first executed, this value will depend on
* logic prior to the loop body. On subsequent loops, this
* value may be determined by logic within the loop body.
*/
topOfLoopLSP = pas_GetCurrentStackLevel();
/* Evaluate the for statement <statement> */
statement();
/* Generate end of loop logic: Load the variable, modify the
* variable, store the variable, and jump unconditionally to the
* top of the loop.
*/
pas_GenerateStackReference(opLDS, varPtr);
pas_GenerateSimple(modOp);
pas_GenerateStackReference(opSTS, varPtr);
pas_GenerateDataOperation(opJMP, forLabel);
/* Generate the end of loop label. This is where the conditional
* branch at the top of the loop will come to.
*/
pas_GenerateDataOperation(opLABEL, endForLabel);
pas_GenerateDataOperation(opINDS, -sINT_SIZE);
/* We always get here from the check at the top of the loop.
* Normally this will be from the branch from the bottom of
* the loop to the top of the loop. Then from the conditional
* branch at the top of the loop to here.
*
* But, we need to allow for the special case when the body
* of the for loop never executed. In this case, the LSP at
* the first time into the loop may differ from the LSP at
* subsequent times into the loop. If this is the case, then
* will will have to invalidate the LSP.
*/
if (topOfLoopLSP != pas_GetCurrentStackLevel())
{
/* In thise case, there is uncertainty in the value of the
* LSP and we must invalidate it. It will be reset to the
* correct the next time that a level stack reference is
* performed.
*/
pas_InvalidateCurrentStackLevel();
}
}
}
