TType *TCodeGenerator::EmitSimpleExpression(void)
{
TType *pOperandType; // ptr to operand's type
TType *pResultType; // ptr to result type
TTokenCode op; // operator
TTokenCode unaryOp = tcPlus; // unary operator
//--Unary + or -
if (TokenIn(token, tlUnaryOps)) {
unaryOp = token;
GetToken();
}
//--Emit code for the first term.
pResultType = EmitTerm();
//--If there was a unary operator, negate in integer value in ax
//--with the neg instruction, or negate a real value in dx:ax
//--by calling _FloatNegate.
if (unaryOp == tcMinus) {
if (pResultType->Base() == pIntegerType) Emit1(neg, Reg(ax))
else if (pResultType == pRealType) {
EmitPushOperand(pResultType);
Emit1(call, NameLit(FLOAT_NEGATE));
Emit2(add, Reg(sp), IntegerLit(4));
}
}
//--Loop to execute subsequent additive operators and terms.
while (TokenIn(token, tlAddOps)) {
op = token;
pResultType = pResultType->Base();
EmitPushOperand(pResultType);
GetToken();
pOperandType = EmitTerm()->Base();
//--Perform the operation, and push the resulting value
//--onto the stack.
if (op == tcOR) {
//--boolean OR boolean => boolean
//--ax = ax OR dx
Emit1(pop, Reg(dx));
Emit2(or, Reg(ax), Reg(dx));
pResultType = pBooleanType;
}
else if ((pResultType == pIntegerType) &&
(pOperandType == pIntegerType)) {
//--integer +|- integer => integer
Emit1(pop, Reg(dx));
if (op == tcPlus) Emit2(add, Reg(ax), Reg(dx))
else {
Emit2(sub, Reg(dx), Reg(ax));
Emit2(mov, Reg(ax), Reg(dx));
}
pResultType = pIntegerType;
}
else {
static void StatementList(void)
{
while( TokenIn(statement_start) )
{
Statement();
}
}
void TParser::ParseFOR(void)
{
TType *pControlType; // ptr to the control id's type object
//--Append a placeholder for the location of the token that
//--follows the FOR statement. Remember the location of this
//--placeholder.
int atFollowLocationMarker = PutLocationMarker();
//--<id>
GetTokenAppend();
if (token == tcIdentifier) {
//--Verify the definition and type of the control id.
TSymtabNode *pControlId = Find(pToken->String());
if (pControlId->defn.how != dcUndefined) {
pControlType = pControlId->pType->Base();
}
else {
pControlId->defn.how = dcVariable;
pControlType = pControlId->pType = pIntegerType;
}
if ( (pControlType != pIntegerType)
&& (pControlType != pCharType)
&& (pControlType->form != fcEnum)) {
Error(errIncompatibleTypes);
pControlType = pIntegerType;
}
icode.Put(pControlId);
GetTokenAppend();
}
else Error(errMissingIdentifier);
//-- :=
Resync(tlColonEqual, tlExpressionStart);
CondGetTokenAppend(tcColonEqual, errMissingColonEqual);
//--<expr-1>
CheckAssignmentTypeCompatible(pControlType, ParseExpression(),
errIncompatibleTypes);
//--TO or DOWNTO
Resync(tlTODOWNTO, tlExpressionStart);
if (TokenIn(token, tlTODOWNTO)) GetTokenAppend();
else Error(errMissingTOorDOWNTO);
//--<expr-2>
CheckAssignmentTypeCompatible(pControlType, ParseExpression(),
errIncompatibleTypes);
//--DO
Resync(tlDO, tlStatementStart);
CondGetTokenAppend(tcDO, errMissingDO);
//--<stmt>
ParseStatement();
FixupLocationMarker(atFollowLocationMarker);
}
static void ReturnStatement(void)
{
SkipToken(tRETURN);
if( TokenIn(expr_start) )
{
Expr();
setlocal_label[setlocal_num++] = vm_genI(op_setlocal,0);
}
return_label[return_num++] = vm_genI(op_rts,0);
}
void TParser::ParseStatementList(TTokenCode terminator)
{
//--Loop to parse statements and to check for and skip semicolons.
do {
ParseStatement();
if (TokenIn(token, tlStatementStart)) {
Error(errMissingSemicolon);
}
else while (token == tcSemicolon) GetTokenAppend();
} while ((token != terminator) && (token != tcEndOfFile));
}
static Int32 SimpleExpr(void)
{
Int32 type,tok;
if( Token==tADD )
{
NextToken();
type=Term();
}
else if( Token==tSUB )
{
NextToken();
type=Term();
vm_gen0(op_neg);
}
else
{
type=Term();
}
while( TokenIn(addop_set) )
{
tok = Token;
NextToken();
Term();
switch(tok)
{
case tADD: vm_gen0(op_add); break;
case tSUB: vm_gen0(op_sub); break;
case tOR: vm_gen0(op_or); break;
default: break;
}
}
return type;
}
void TParser::ParseCaseBranch(const TType *pExprType,
TCaseItem *&pCaseItemList)
{
int caseLabelFlag; // true if another CASE label, else false
//--<case-label-list>
do {
ParseCaseLabel(pExprType, pCaseItemList);
if (token == tcComma) {
//--Saw comma, look for another CASE label.
GetTokenAppend();
if (TokenIn(token, tlCaseLabelStart)) caseLabelFlag = true;
else {
Error(errMissingConstant);
caseLabelFlag = false;
}
}
else caseLabelFlag = false;
} while (caseLabelFlag);
//-- :
Resync(tlColon, tlStatementStart);
CondGetTokenAppend(tcColon, errMissingColon);
//--Loop to set the branch statement location into each CASE item
//--for this branch.
for (TCaseItem *pItem = pCaseItemList;
pItem && (pItem->atBranchStmt == 0);
pItem = pItem->next) {
pItem->atBranchStmt = icode.CurrentLocation() - 1;
}
//--<stmt>
ParseStatement();
}
static Int32 Term(void)
{
Int32 type,tok;
type=Factor();
while( TokenIn(mulop_set) )
{
tok = Token;
NextToken();
Factor();
switch(tok)
{
case tMUL: vm_gen0(op_mul); break;
case tDIV: vm_gen0(op_div); break;
case tAND: vm_gen0(op_and); break;
case tMOD: vm_gen0(op_mod); break;
default: break;
}
}
return type;
}
TType *TCodeGenerator::EmitExpression(void)
{
TType *pOperand1Type; // ptr to first operand's type
TType *pOperand2Type; // ptr to second operand's type
TType *pResultType; // ptr to result type
TTokenCode op; // operator
TInstruction jumpOpcode; // jump instruction opcode
int jumpLabelIndex; // assembly jump label index
//--Emit code for the first simple expression.
pResultType = EmitSimpleExpression();
//--If we now see a relational operator,
//--emit code for the second simple expression.
if (TokenIn(token, tlRelOps)) {
EmitPushOperand(pResultType);
op = token;
pOperand1Type = pResultType->Base();
GetToken();
pOperand2Type = EmitSimpleExpression()->Base();
//--Perform the operation, and push the resulting value
//--onto the stack.
if ( ((pOperand1Type == pIntegerType) &&
(pOperand2Type == pIntegerType))
|| ((pOperand1Type == pCharType) &&
(pOperand2Type == pCharType))
|| (pOperand1Type->form == fcEnum)) {
//--integer <op> integer
//--boolean <op> boolean
//--char <op> char
//--enum <op> enum
//--Compare dx (operand 1) to ax (operand 2).
Emit1(pop, Reg(dx));
Emit2(cmp, Reg(dx), Reg(ax));
}
else if ((pOperand1Type == pRealType) ||
(pOperand2Type == pRealType)) {
//--real <op> real
//--real <op> integer
//--integer <op> real
//--Convert the integer operand to real.
//--Call _FloatCompare to do the comparison, which
//--returns -1 (less), 0 (equal), or +1 (greater).
EmitPushOperand(pOperand2Type);
EmitPromoteToReal(pOperand1Type, pOperand2Type);
Emit1(call, NameLit(FLOAT_COMPARE));
Emit2(add, Reg(sp), IntegerLit(8));
Emit2(cmp, Reg(ax), IntegerLit(0));
}
else {
//--string <op> string
//--Compare the string pointed to by si (operand 1)
//--to the string pointed to by di (operand 2).
Emit1(pop, Reg(di));
Emit1(pop, Reg(si));
Emit2(mov, Reg(ax), Reg(ds));
Emit2(mov, Reg(es), Reg(ax));
Emit0(cld);
Emit2(mov, Reg(cx),
IntegerLit(pOperand1Type->array.elmtCount));
Emit0(repe_cmpsb);
}
Emit2(mov, Reg(ax), IntegerLit(1)); // default: load 1
switch (op) {
case tcLt: jumpOpcode = jl; break;
case tcLe: jumpOpcode = jle; break;
case tcEqual: jumpOpcode = je; break;
case tcNe: jumpOpcode = jne; break;
case tcGe: jumpOpcode = jge; break;
case tcGt: jumpOpcode = jg; break;
}
jumpLabelIndex = ++asmLabelIndex;
Emit1(jumpOpcode, Label(STMT_LABEL_PREFIX, jumpLabelIndex));
Emit2(sub, Reg(ax), Reg(ax)); // load 0 if false
EmitStatementLabel(jumpLabelIndex);
pResultType = pBooleanType;
}
return pResultType;
}
static void ClassDefinition(void)
{
char *name;
Int32 label,l1;
Int32 field_num=0;
SymPtr clas,clas_init;
SkipToken(tCLASS);
MatchToken(tCONST);
name = GetIdent();
clas = SymAdd(name);
clas->kind = CLASS_KIND;
NextToken();
in_class=TRUE;
base_class=clas;
cur_scope=SYM_PUBLIC;
/* clas->super=NULL; */
/* super_class=NULL; */
clas->super=SymFind("Object");
super_class=clas->super;
if( Token==tLSS )
{
SkipToken(tLSS);
MatchToken(tCONST);
name = GetIdent();
clas->super = SymFind(name);
if( clas->super==NULL )
{
compileError("super class not found");
return;
}
super_class = clas->super;
field_num = clas->super->nlocs;
NextToken();
}
SymEnterScope();
/* default class constructor prologue */
l1 = vm_genI(op_link,0);
clas_init = SymAdd(NEW);
clas_init->kind = FUNCTION_KIND;
clas_init->object.u.ival = l1;
clas_init->flags |= SYM_PUBLIC;
/* class fields and functions */
while( TokenIn(class_statements) )
{
if( Token==tPUBLIC )
{
PublicStatement();
}
else if( Token==tPROTECTED )
{
ProtectedStatement();
}
else if( Token==tPRIVATE )
{
PrivateStatement();
}
else if( Token==tDEF )
{
label = vm_genI(op_jmp,0);
MethodDefinition();
vm_patch(label,vm_addr());
}
else
{
local_num = field_num++;
AssignmentStatement();
}
if( Token==tSEMI ) SkipToken(tSEMI);
}
clas->nlocs = field_num;
/* default class constructor epilogue */
vm_gen0(op_nop);
vm_genI(op_rts,2);
SymExitScope(clas);
/* end of class */
in_class=FALSE;
base_class=NULL;
super_class=NULL;
SkipToken(tEND);
if( Token==tSEMI ) SkipToken(tSEMI);
}
void TParser::ParseCaseLabel(const TType *pExprType,
TCaseItem *&pCaseItemList)
{
TType *pLabelType; // ptr to the CASE label's type object
int signFlag = false; // true if unary sign, else false
//--Allocate a new CASE item and insert it at the head of the list.
TCaseItem *pCaseItem = new TCaseItem(pCaseItemList);
//--Unary + or -
if (TokenIn(token, tlUnaryOps)) {
signFlag = true;
GetTokenAppend();
}
switch (token) {
//--Identifier: Must be a constant whose type matches that
//-- of the CASE expression.
case tcIdentifier: {
TSymtabNode *pLabelId = Find(pToken->String());
icode.Put(pLabelId);
if (pLabelId->defn.how != dcUndefined) {
pLabelType = pLabelId->pType->Base();
}
else {
pLabelId->defn.how = dcConstant;
SetType(pLabelId->pType, pDummyType);
pLabelType = pDummyType;
}
if (pExprType != pLabelType) Error(errIncompatibleTypes);
//--Only an integer constant can have a unary sign.
if (signFlag && (pLabelType != pIntegerType)) {
Error(errInvalidConstant);
}
//--Set the label value into the CASE item.
if ((pLabelType == pIntegerType) ||
(pLabelType->form == fcEnum)) {
pCaseItem->labelValue = signFlag
? -pLabelId->defn.constant.value.integer
: pLabelId->defn.constant.value.integer;
}
else {
pCaseItem->labelValue = pLabelId->defn.constant
.value.character;
}
GetTokenAppend();
break;
}
//--Number: Both the label and the CASE expression
//-- must be integer.
case tcNumber: {
if (pToken->Type() != tyInteger) Error(errInvalidConstant);
if (pExprType != pIntegerType) Error(errIncompatibleTypes);
TSymtabNode *pNode = SearchAll(pToken->String());
if (!pNode) {
pNode = EnterLocal(pToken->String());
pNode->pType = pIntegerType;
pNode->defn.constant.value.integer =
pToken->Value().integer;
}
icode.Put(pNode);
//--Set the label value into the CASE item.
pCaseItem->labelValue = signFlag
? -pNode->defn.constant.value.integer
: pNode->defn.constant.value.integer;
GetTokenAppend();
break;
}
//--String: Must be a single character without a unary sign.
//-- (Note that the string length includes the quotes.)
//-- The CASE expression type must be character.
case tcString: {
if (signFlag || (strlen(pToken->String()) != 3)) {
Error(errInvalidConstant);
}
if (pExprType != pCharType) Error(errIncompatibleTypes);
TSymtabNode *pNode = SearchAll(pToken->String());
if (!pNode) {
pNode = EnterLocal(pToken->String());
pNode->pType = pCharType;
pNode->defn.constant.value.character =
pToken->String()[1];
}
icode.Put(pNode);
//--Set the label value into the CASE item.
pCaseItem->labelValue = pToken->String()[1];
GetTokenAppend();
break;
}
}
}
void TParser::ParseCASE(void)
{
TCaseItem *pCaseItemList; // ptr to list of CASE items
int caseBranchFlag; // true if another CASE branch,
// else false
pCaseItemList = NULL;
//--Append placeholders for the location of the token that
//--follows the CASE statement and of the CASE branch table.
//--Remember the locations of these placeholders.
int atFollowLocationMarker = PutLocationMarker();
int atBranchTableLocationMarker = PutLocationMarker();
//--<expr>
GetTokenAppend();
TType *pExprType = ParseExpression()->Base();
//--Verify the type of the CASE expression.
if ( (pExprType != pIntegerType)
&& (pExprType != pCharType)
&& (pExprType->form != fcEnum)) {
Error(errIncompatibleTypes);
}
//--OF
Resync(tlOF, tlCaseLabelStart);
CondGetTokenAppend(tcOF, errMissingOF);
//--Loop to parse CASE branches.
caseBranchFlag = TokenIn(token, tlCaseLabelStart);
while (caseBranchFlag) {
if (TokenIn(token, tlCaseLabelStart)) {
ParseCaseBranch(pExprType, pCaseItemList);
}
if (token == tcSemicolon) {
GetTokenAppend();
caseBranchFlag = true;
}
else if (TokenIn(token, tlCaseLabelStart)) {
Error(errMissingSemicolon);
caseBranchFlag = true;
}
else caseBranchFlag = false;
}
//--Append the branch table to the intermediate code.
FixupLocationMarker(atBranchTableLocationMarker);
TCaseItem *pItem = pCaseItemList;
TCaseItem *pNext;
do {
PutCaseItem(pItem->labelValue, pItem->atBranchStmt);
pNext = pItem->next;
delete pItem;
pItem = pNext;
} while (pItem);
PutCaseItem(0, 0); // end of table
//--END
Resync(tlEND, tlStatementStart);
CondGetTokenAppend(tcEND, errMissingEND);
FixupLocationMarker(atFollowLocationMarker);
}
