static exprType sqrFunc(void) { exprType sqrType; TRACE(lstFile,"[sqrFunc]"); /* FORM: SQR (<simple integer OR real expression>) */ checkLParen(); sqrType = expression(exprUnknown, NULL); /* Process any expression */ if (sqrType == exprInteger) { pas_GenerateSimple(opDUP); pas_GenerateSimple(opMUL); } /* end if */ else if (sqrType == exprReal) pas_GenerateFpOperation(fpSQR); else error(eINVARG); checkRParen(); return sqrType; } /* end sqrFunc */
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 exprType predFunc(void) { exprType predType; TRACE(lstFile,"[predFunc]"); /* FORM: PRED (<simple integer expression>) */ checkLParen(); /* Process any ordinal expression */ predType = expression(exprAnyOrdinal, NULL); checkRParen(); pas_GenerateSimple(opDEC); return predType; } /* end predFunc */
static exprType succFunc(void) { exprType succType; TRACE(lstFile,"[succFunc]"); /* FORM: SUCC (<simple integer expression>) */ checkLParen(); /* Process any ordinal expression */ succType = expression(exprAnyOrdinal, NULL); checkRParen(); pas_GenerateSimple(opINC); return succType; } /* end succFunc */
static exprType absFunc(void) { exprType absType; TRACE(lstFile,"[absFunc]"); /* FORM: ABS (<simple integer/real expression>) */ checkLParen(); absType = expression(exprUnknown, NULL); if (absType == exprInteger) pas_GenerateSimple(opABS); else if (absType == exprReal) pas_GenerateFpOperation(fpABS); else error(eINVARG); checkRParen(); return absType; } /* end absFunc */
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(); } }
void statement(void) { STYPE *symPtr; /* Save Symbol Table pointer to token */ TRACE(lstFile,"[statement"); /* Generate file/line number pseudo-operation to facilitate P-Code testing */ pas_GenerateLineNumber(FP->include, FP->line); /* We will push the string stack pointer at the beginning of each * statement and pop the string stack pointer at the end of each * statement. Subsequent optimization logic will scan the generated * pcode to ascertain if the push and pops were necessary. They * would be necessary if expression parsing generated temporary usage * of string stack storage. In this case, the push will save the * value before the temporary usage and the pop will release the * temporaray storage. */ pas_GenerateSimple(opPUSHS); /* Process the statement according to the type of the leading token */ switch (token) { /* Simple assignment statements */ case sINT : symPtr = tknPtr; getToken(); pas_Assignment(opSTS, exprInteger, symPtr, symPtr->sParm.v.parent); break; case sCHAR : symPtr = tknPtr; getToken(); pas_Assignment(opSTSB, exprChar, symPtr, symPtr->sParm.v.parent); break; case sBOOLEAN : symPtr = tknPtr; getToken(); pas_Assignment(opSTSB, exprBoolean, symPtr, NULL); break; case sREAL : symPtr = tknPtr; getToken(); pas_LargeAssignment(opSTSM, exprReal, symPtr, symPtr->sParm.v.parent); break; case sSCALAR : symPtr = tknPtr; getToken(); pas_Assignment(opSTS, exprScalar, symPtr, symPtr->sParm.v.parent); break; case sSET_OF : symPtr = tknPtr; getToken(); pas_Assignment(opSTS, exprSet, symPtr, symPtr->sParm.v.parent); break; case sSTRING : case sRSTRING : symPtr = tknPtr; getToken(); pas_StringAssignment(symPtr, symPtr->sParm.v.parent); break; /* Complex assignments statements */ case sSUBRANGE : case sRECORD : case sRECORD_OBJECT : case sPOINTER : case sVAR_PARM : case sARRAY : pas_ComplexAssignment(); break; /* Branch, Call and Label statements */ case sPROC : pas_ProcStatement(); break; case tGOTO : pas_GotoStatement(); break; case tINT_CONST : pas_LabelStatement(); break; /* Conditional Statements */ case tIF : pas_IfStatement(); break; case tCASE : pas_CaseStatement(); break; /* Loop Statements */ case tREPEAT : pas_RepeatStatement(); break; case tWHILE : pas_WhileStatement(); break; case tFOR : pas_ForStatement(); break; /* Other Statements */ case tBEGIN : compoundStatement(); break; case tWITH : pas_WithStatement(); break; /* None of the above, try standard procedures */ default : builtInProcedure(); break; } /* end switch */ /* Generate the POPS that matches the PUSHS generated at the begining * of this function (see comments above). */ pas_GenerateSimple(opPOPS); TRACE(lstFile,"]"); } /* end statement */