static int16_t writeProc(void)
{
uint16_t fileNumber = 0;
TRACE(lstFile, "[writeProc]");
/* FORM: (1) Binary WRITE: WRITE(<fileNumber>);
* (2) Test WRITE: WRITE([<fileNumber>], arg1 [,arg2 [...]]) */
if (token != '(') error(eLPAREN); /* Skip over '(' */
else getToken();
/* Get file number */
if (token == sFILE) {
fileNumber = tknPtr->sParm.fileNumber;
getToken();
} /* end if */
if (token == ',') getToken();
/* Determine if this is a text or binary file */
if (!(files [fileNumber].defined)) error(eUNDEFILE);
else if (files [fileNumber].ftype == sCHAR)
writeText(fileNumber);
else {
pas_GenerateLevelReference(opLAS, files[fileNumber].flevel, files [fileNumber].faddr);
pas_GenerateDataOperation(opPUSH, files[fileNumber].fsize);
pas_GenerateIoOperation(xWRITE_BINARY, fileNumber);
} /* end else */
if (token != ')') error(eRPAREN);
else getToken();
return(fileNumber);
} /* end writeProc */
static void pas_ProcStatement(void)
{
STYPE *procPtr = tknPtr;
int size = 0;
TRACE(lstFile,"[pas_ProcStatement]");
/* FORM: procedure-method-statement =
* procedure-method-specifier [ actual-parameter-list ]
*
* Skip over the procedure-method-statement
*/
getToken();
/* Get the actual parameters (if any) associated with the procedure
* call.
*/
size = actualParameterList(procPtr);
/* Generate procedure call and stack adjustment (if required)
* Upon return from the procedure, the level stack pointer (LSP)
* may also be invalid. However, we rely on level level logic in
* pgen.c to manage this case (as well as the function call case).
*/
pas_GenerateProcedureCall(procPtr);
if (size)
{
pas_GenerateDataOperation(opINDS, -size);
}
}
static void pas_LabelStatement(void)
{
char labelName [8]; /* Label symbol table name */
STYPE *labelPtr; /* Pointer to Label Symbol */
TRACE(lstFile,"[pas_LabelStatement]");
/* FORM: <integer> : */
/* Verify that the integer is a label name */
(void)sprintf (labelName, "%ld", tknInt);
if (!(labelPtr = findSymbol(labelName)))
{
error(eUNDECLABEL);
}
else if(labelPtr->sKind != sLABEL)
{
error(eINVLABEL);
}
/* And also verify that the label symbol has not been previously
* defined.
*/
else if(!(labelPtr->sParm.l.unDefined))
{
error(eMULTLABEL);
}
else
{
/* Generate the label and indicate that it has been defined */
pas_GenerateDataOperation(opLABEL, labelPtr->sParm.l.label);
labelPtr->sParm.l.unDefined = false;
/* We have to assume that we got here via a goto statement.
* We don't have logic in place to track changes to the level
* stack pointer (LSP) register, so we have no choice but to
* invalidate that register now.
*/
pas_InvalidateCurrentStackLevel();
}
/* Skip over the label integer */
getToken();
/* Make sure that the label is followed by a colon */
if (token != ':') error (eCOLON);
else getToken();
}
static void pas_GotoStatement(void)
{
char labelname [8]; /* Label symbol table name */
STYPE *label_ptr; /* Pointer to Label Symbol */
TRACE(lstFile,"[pas_GotoStatement]");
/* FORM: GOTO <integer> */
/* Get the token after the goto reserved word. It should be an <integer> */
getToken();
if (token != tINT_CONST)
{
/* Token following the goto is not an integer */
error(eINVLABEL);
}
else
{
/* The integer label must be non-negative */
if (tknInt < 0)
{
error(eINVLABEL);
}
else
{
/* Find and verify the symbol associated with the label */
(void)sprintf (labelname, "%ld", tknInt);
if (!(label_ptr = findSymbol(labelname)))
{
error(eUNDECLABEL);
}
else if (label_ptr->sKind != sLABEL)
{
error(eINVLABEL);
}
else
{
/* Generate the branch to the label */
pas_GenerateDataOperation(opJMP, label_ptr->sParm.l.label);
}
}
/* Get the token after the <integer> value */
getToken();
}
}
void pas_RepeatStatement ()
{
uint16_t rpt_label = ++label;
TRACE(lstFile,"[pas_RepeatStatement]");
/* REPEAT <statement[;statement[statement...]]> UNTIL <expression> */
/* Generate top of loop label */
pas_GenerateDataOperation(opLABEL, rpt_label);
do
{
getToken();
/* Process <statement> */
statement();
}
while (token == ';');
/* Verify UNTIL follows */
if (token != tUNTIL) error (eUNTIL);
else getToken();
/* Generate UNTIL <expression> */
expression(exprBoolean, NULL);
/* Generate conditional branch to the top of loop */
pas_GenerateDataOperation(opJEQUZ, rpt_label);
/* NOTE: The current LSP setting will be correct after the repeat
* loop because we fall through from the bottom of the loop after
* executing the body at least once.
*/
}
static void oddFunc(void)
{
TRACE(lstFile,"[oddFunc]");
/* FORM: ODD (<simple integer expression>) */
checkLParen();
/* Process any ordinal expression */
expression(exprAnyOrdinal, NULL);
checkRParen();
pas_GenerateDataOperation(opPUSH, 1);
pas_GenerateSimple(opAND);
pas_GenerateSimple(opNEQZ);
} /* end oddFunc */
static int16_t readProc(void)
{
uint16_t fileNumber = 0;
TRACE(lstFile, "[readProc]");
/* FORM:
* (1) Binary READ: read '(' file-variable ')'
* (2) Test READ: read read-parameter-list
* FORM: read-parameter-list =
* '(' [ file-variable ',' ] variable-access { ',' variable-access } ')'
*/
if (token != '(') error (eLPAREN); /* Skip over '(' */
else getToken();
/* Get file number */
if (token == sFILE)
{
fileNumber = tknPtr->sParm.fileNumber;
getToken();
} /* end if */
if (token == ',') getToken();
/* Determine if this is a text or binary file */
if (!(files [fileNumber].defined)) error (eUNDEFILE);
else if (files [fileNumber].ftype == sCHAR)
{
readText (fileNumber);
}
else
{
pas_GenerateLevelReference(opLAS, files[fileNumber].flevel, files [fileNumber].faddr);
pas_GenerateDataOperation(opPUSH, files[fileNumber].fsize);
pas_GenerateIoOperation(xREAD_BINARY, fileNumber);
} /* end else */
if (token != ')') error (eRPAREN);
else getToken();
return (fileNumber);
} /* end readProc */
static void fileFunc(uint16_t opcode)
{
TRACE(lstFile,"[fileFunc]");
/* FORM: EOF|EOLN (<file number>) */
checkLParen();
if (token != sFILE)
{
error(eFILE);
}
else
{
pas_GenerateDataOperation(opINDS, sBOOLEAN_SIZE);
pas_GenerateIoOperation(opcode, tknPtr->sParm.fileNumber);
getToken();
checkRParen();
} /* end else */
} /* end fileFunc */
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_IfStatement(void)
{
uint16_t else_label = ++label;
uint16_t endif_label = else_label;
int32_t thenLSP;
int32_t elseLSP;
TRACE(lstFile,"[pas_IfStatement]");
/* FORM: IF <expression> THEN <statement> [ELSE <statement>] */
/* Skip over the IF token */
getToken();
/* Evaluate the boolean expression */
expression(exprBoolean, NULL);
/* Make sure that the boolean expression is followed by the THEN token */
if (token != tTHEN)
error (eTHEN);
else
{
/* Skip over the THEN token */
getToken();
/* Generate a conditional branch to the "else_label." This will be a
* branch to either the ENDIF or to the ELSE location (if present).
*/
pas_GenerateDataOperation(opJEQUZ, else_label);
/* Save the value of the Level Stack Pointer (LSP) here. This will be
* the value of the LSP at the ENDIF label if there is no ELSE <statement>
* presentl. We will compare the elseLSP to the thenLSP at that point.
*/
elseLSP = pas_GetCurrentStackLevel();
/* Parse the <statment> following the THEN token */
statement();
/* Save the LSP after generating the THEN <statement>. We will compare the
* elseLSP to the thenLSP below.
*/
thenLSP = pas_GetCurrentStackLevel();
/* Check for optional ELSE <statement> */
if (token == tELSE)
{
/* Change the ENDIF label. Now instead of branching to
* the ENDIF, the logic above will branch to the ELSE
* logic generated here.
*/
endif_label = ++label;
/* Skip over the ELSE token */
getToken();
/* Generate Jump to ENDIF label after the THEN <statement> */
pas_GenerateDataOperation(opJMP, endif_label);
/* Generate the ELSE label here. This is where we will go if
* the IF <expression> evaluates to false.
*/
pas_GenerateDataOperation(opLABEL, else_label);
/* Generate the ELSE <statement> then fall through to the
* ENDIF label.
*/
statement();
/* Save the LSP after generating the ELSE <statement>. We will
* compare elseLSP to the thenLSP below.
*/
elseLSP = pas_GetCurrentStackLevel();
}
/* Generate the ENDIF label here. Note that if no ELSE <statement>
* is present, this will be the same as the else_label.
*/
pas_GenerateDataOperation(opLABEL, endif_label);
/* We can get to this location through two of three pathes: (1) through the
* THEN <statement>, (2) from the IF <expression> if no ELSE <statement>
* is present, or (3) from the ELSE <statement>. If the LSP is different
* through these two pathes, then we will have to invalidate it.
*/
if (thenLSP != elseLSP)
{
pas_InvalidateCurrentStackLevel();
}
}
}
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();
}
}
}
static void pas_CaseStatement(void)
{
uint16_t this_case;
uint16_t next_case = ++label;
uint16_t end_case = ++label;
int32_t terminalLSP = -1;
bool bInvalidateLSP = false;
TRACE(lstFile,"[pas_CaseStatement]");
/* Process "CASE <expression> OF" */
/* Skip over the CASE token */
getToken();
/* Evaluate the CASE <expression> */
expression(exprAnyOrdinal, NULL);
/* Verify that CASE <expression> is followed with the OF token */
if (token != tOF) error (eOF);
else getToken();
/* Loop to process each case until END encountered */
for (;;)
{
this_case = next_case;
next_case = ++label;
/* Process NON-STANDARD ELSE <statement> END */
if (token == tELSE)
{
getToken();
/* Set ELSE statement label */
pas_GenerateDataOperation(opLABEL, this_case);
/* Evaluate ELSE statement */
statement();
/* Check the LSP after evaluating the ELSE <statement>. */
if (pas_CheckInvalidateLSP(&terminalLSP))
{
/* The LSP will be invalid at the end case label. Set
* a flag so that we can handle invalidation of the LSP when
* we get to the end case label.
*/
bInvalidateLSP = true;
}
/* Verify that END follows the ELSE <statement> */
if (token != tEND) error(eEND);
else getToken();
/* Terminate FOR loop */
break;
}
/* Process "<constant>[,<constant>[,...]] : <statement>"
* NOTE: We accept any kind of constant for the case selector; there
* really should be some check to assure that the constant is of the
* same type as the expression!
*/
else
{
/* Loop for each <constant> in the case list */
for(;;)
{
/* Verify that we have a constant */
if (!isConstant(token))
{
error(eINTCONST);
break;
}
/* Generate a comparison of the CASE expression and the constant.
*
* First duplicate the value to be compared (from the CASE <expression>)
* and push the comparison value (from the <constant>:)
*/
pas_GenerateSimple(opDUP);
pas_GenerateDataOperation(opPUSH, tknInt);
/* The kind of comparison we generate depends on if we have to
* jump over other case selector comparsions to the statement
* or if we can just fall through to the statement
*/
/* Skip over the constant */
getToken();
/* If there are multiple constants, they will be separated with
* commas.
*/
if (token == ',')
{
/* Generate jump to <statement> */
pas_GenerateDataOperation(opJEQUZ, this_case);
/* Skip over comma */
getToken();
}
else
{
/* else jump to the next case */
pas_GenerateDataOperation(opJNEQZ, next_case);
break;
}
}
/* Then process ... : <statement> */
/* Verify colon presence */
if (token != ':') error(eCOLON);
else getToken();
/* Set CASE label */
pas_GenerateDataOperation(opLABEL, this_case);
/* Evaluate <statement> */
statement();
/* Jump to exit CASE */
pas_GenerateDataOperation(opJMP, end_case);
/* Check the LSP after evaluating the case <statement>. */
if (pas_CheckInvalidateLSP(&terminalLSP))
{
/* If the LSP will be invalid at the end case label. Set
* a flag so that we can handle invalidation of the LSP when
* we get to the end case label.
*/
bInvalidateLSP = true;
}
}
/* Check if there are more statements. If not, verify END present */
if (token == ';')
{
getToken();
}
else if (token == tEND)
{
getToken();
break;
}
else
{
error (eEND);
break;
}
}
/* Generate ENDCASE label and Pop CASE <expression> from stack */
pas_GenerateDataOperation(opLABEL, end_case);
pas_GenerateDataOperation(opINDS, -sINT_SIZE);
/* We may have gotten to this point from many different case <statements>.
* The flag bInvalidateLSP will be set if the LSP is not the same for
* each of these pathes. Invalidating the LSP will force it to be reloaded
* when the next level stack access is done.
*/
if (bInvalidateLSP)
{
pas_InvalidateCurrentStackLevel();
}
}
static void pas_WhileStatement(void)
{
uint16_t while_label = ++label; /* Top of loop label */
uint16_t endwhile_label = ++label; /* End of loop label */
uint32_t nLspChanges;
int32_t topOfLoopLSP;
bool bCheckLSP = false;
TRACE(lstFile,"[pas_WhileStatement]");
/* Generate WHILE <expression> DO <statement> */
/* Skip over WHILE token */
getToken();
/* Set top of loop label */
pas_GenerateDataOperation(opLABEL, while_label);
/* Evaluate the WHILE <expression> */
nLspChanges = pas_GetNStackLevelChanges();
expression(exprBoolean, NULL);
/* Generate a conditional jump to the end of the loop */
pas_GenerateDataOperation(opJEQUZ, endwhile_label);
/* Save the level stack pointer (LSP) at the top of the
* loop. When first executed, this value will depend on
* logic prior to the loop or on values set in the
* WHILE <expression>. On subsequent loops, this value
* may be determined by logic within the loop body or
* have to restore this value when the loop terminates.
*/
topOfLoopLSP = pas_GetCurrentStackLevel();
/* Does the WHILE <expression> logic set the LSP? */
if (nLspChanges == pas_GetNStackLevelChanges())
{
/* Yes, then the value set in the WHILE <expression>
* is the one that will be in effect at the end_while
* label.
*/
bCheckLSP = true;
}
/* Verify that the DO token follows the expression */
if (token != tDO) error(eDO);
else getToken();
/* Generate the <statement> following the DO token */
statement();
/* Generate a branch to the top of the loop */
pas_GenerateDataOperation(opJMP, while_label);
/* Set the bottom of loop label */
pas_GenerateDataOperation(opLABEL, endwhile_label);
/* 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 while loop never executed. The flag bCheckLSP is
* set true if the conditional expression evaluation does not
* set the LSP. In the case, the current LSP will be either
* the LSP at the top of the loop (if he body was never executed)
* or the current LSP (the body executes at least once).
*/
if (bCheckLSP)
{
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();
}
}
else
{
/* Otherwise, make sure that the code generation logic knows
* the correct value of the LSP at this point.
*/
pas_SetCurrentStackLevel(topOfLoopLSP);
}
}
