www.pudn.com > byyl.rar > Plparser.pas
unit plparser;
interface
uses pcommon,plscan;
{ Pass2 : THE PL PARSER -- PLPARSER.PAS }
const
MaxLabel = 1000;
MaxLevel = 10;
type
OperationPart=(Add2,And2,Arrow2,Assign2,Bar2,Call2,constant2,Divide2,
EndProc2,EndProg2,Equal2,Fi2,Greater2,Index2,Less2,Minus2,
Modulo2,Multiply2,Not2,Or2,Proc2,Prog2,Read2,Subtract2,
Value2,Variable2,Write2,DefAddr2,DefArg2);
procedure pass2;
implementation
procedure Pass2;
const
NoName = 0;
MaxVarAccessTable = 20;
type
Symbols = set of SymbolType;
SymbolTables = array [0..42] of SymbolType;
NameClass = ( Constantx, ArrayType, Variable, Procedur, Undefined);
VariableType = ( Integer2, Boolean2,ArrayType2,CommonType2);
VarAccessTable = array [1..MaxVarAccessTable] of VariableType;
Classes = set of NameClass;
VariableTypes = set of VariableType;
Pointer = ^ ObjectRecord;
ObjectRecord = record
Name: integer;
Previous: Pointer;
case Kind: NameClass of
Constantx: (ConstValue: integer; ConstType: VariableType);
ArrayType: (Bound: integer; ArrLevel,ArrDispl:integer;
ElementType: VariableType);
Variable: (VarLevel, VarDispl: integer; VarType: VariableType);
Procedur: (ProcLevel, ProcLabel: integer)
end;
BlockRecord = record
TempLength, MaxTemp,CurLen: integer;
LastObject: Pointer
end;
BlockTable = array [0..MaxLevel] of BlockRecord;
var
Symbol: SymbolType;
SymbolOrd, Argument, BlockLevel: integer;
SymbolTable: SymbolTables;
VarAccTypeTable,ExprTypeTable: VarAccessTable;
Block: BlockTable;
AddSymbols, ConstantSymbols,
TermSymbols, FactorSymbols, TypeSymbols,
LongSymbols, MultiplySymbols,
RelationSymbols, SelectorSymbols,
definitionSymbols, AndOrSymbols,
StatementSymbols, ExpressionSymbols : Symbols;
Variables: Classes;
LabelNo: integer;
{ INPUT }
procedure NextSymbol;
begin
Read(Input1, SymbolOrd);
Symbol := SymbolTable[SymbolOrd];
while Symbol = NewLine1 do
begin
Read(Input1, LineNo);
NewLine(LineNo);
Read(Input1, SymbolOrd);
Symbol := SymbolTable[SymbolOrd]
end;
if Symbol in LongSymbols then Read(Input1, Argument)
end;
{ OUTPUT }
procedure Emit1(Op: OperationPart);
begin
Emit(ord(Op))
end;
procedure Emit2(Op: OperationPart; Arg: integer);
begin
Emit(ord(Op));
Emit(Arg)
end;
procedure Emit3(Op: OperationPart; Arg1, Arg2: integer);
begin
Emit(ord(Op));
Emit(Arg1);
Emit(Arg2)
end;
{ SCOPE ANALYSIS }
procedure Search(Name,LevelNo:integer; var Found:Boolean;
var Object0:Pointer );
var
More: Boolean;
begin
More := true; Object0 := Block[LevelNo].LastObject;
while More do
if Object0 = nil then
begin
More := false;
Found := false
end
else
if Object0^.Name = Name then
begin
More := false;
Found := true
end
else Object0 := Object0^.Previous
end;
procedure Define(Name: integer; Kind: NameClass; var Object0: Pointer);
var
Found: Boolean; Other: Pointer;
begin
if Name <> NoName then
begin
Search(Name, BlockLevel, Found, Other);
if Found then Error(Ambiguous3)
end;
New(Object0);
Object0^.Name := Name;
Object0^.Previous := Block[BlockLevel].LastObject;
Object0^.Kind := Kind;
Block[BlockLevel].LastObject := Object0
end;
procedure Find(Name: integer; var Object0: Pointer);
var
More, Found: Boolean; LevelNo: integer;
begin
More := true; LevelNo := BlockLevel;
while More do
begin
Search(Name, LevelNo, Found, Object0);
if Found or (LevelNo = 0) then More := false
else LevelNo := LevelNo - 1
end;
if not Found then
begin
Error(Undefined3);
Define(Name, Undefined, Object0)
end
end;
procedure NewBlock;
var
Current: BlockRecord;
begin
TestLimit(BlockLevel, MaxLevel);
BlockLevel := BlockLevel + 1;
Current.CurLen := 0;
Current.TempLength := 0;
Current.MaxTemp := 0;
Current.LastObject := nil;
Block[BlockLevel] := Current
end;
procedure EndBlock;
begin
BlockLevel := BlockLevel - 1
end;
procedure StandardBlock;
begin
BlockLevel := -1;
NewBlock;
end;
{ TYPE ANALYSIS }
procedure CheckTypes(var Type1: VariableType; Type2: VariableType);
begin
if (Type1 <> Type2) then
begin
if (Type1 <> CommonType2) and (Type2 <> CommonType2) then
Error(Type3);
Type1:=CommonType2;
end;
end;
procedure TypeError(var Typex: VariableType);
begin
if Typex <> CommonType2 then
begin
Error(Type3);
Typex := CommonType2;
end
end;
procedure KindError(Object0: Pointer);
begin
if Object0^.Kind <> Undefined then Error(Kind3)
end;
{ LABELS }
procedure NewLabel(var No: integer);
begin
TestLimit(LabelNo, MaxLabel);
LabelNo := LabelNo + 1;
No := LabelNo
end;
{ TEMPORARIES }
procedure Push(Length: integer);
begin
Block[BlockLevel].TempLength:=Block[BlockLevel].TempLength+Length;
if Block[BlockLevel].MaxTemp < Block[BlockLevel].TempLength then
Block[BlockLevel].MaxTemp := Block[BlockLevel].TempLength
end;
procedure Pop(Length: integer);
begin
Block[BlockLevel].TempLength:=Block[BlockLevel].TempLength-Length
end;
{ INITIALIZATION }
procedure Initialize;
begin
AddSymbols := [ Minus1, Plus1 ];
AndOrSymbols := [ And1, Or1 ];
ConstantSymbols := [ Name1, Numeral1, False1, True1 ];
DefinitionSymbols := [ Const1, Integer1, Boolean1, Proc1 ];
ExpressionSymbols:=[LeftParenthesis1,Minus1,Name1,
Not1,Numeral1,Plus1,False1,True1];
FactorSymbols := [ LeftParenthesis1, Name1, Not1, Numeral1, False1, True1 ];
LongSymbols := [ Name1, Numeral1 ];
MultiplySymbols := [ Asterisk1, Div1, Mod1 ];
RelationSymbols:=[ Equal1, Greater1, Less1 ];
SelectorSymbols := [ LeftBracket1 ];
StatementSymbols := [ Call1, Do1, If1, Name1, Skip1,
Read1, Write1 ];
TermSymbols := FactorSymbols;
TypeSymbols := [ Integer1, Boolean1 ];
Variables := [ Variable, ArrayType ];
LabelNo := 0;
SymbolTable[0] := And1; SymbolTable[1] := Array1;
SymbolTable[2] := Arrow1; SymbolTable[3] := Asterisk1;
SymbolTable[4] := Becomes1; SymbolTable[5] := Begin1;
SymbolTable[6] := Boolean1; SymbolTable[7] := Bracket1;
SymbolTable[8] := Call1; SymbolTable[9] := Comma1;
SymbolTable[10] := Const1; SymbolTable[11] := Div1;
SymbolTable[12] := Do1; SymbolTable[13] := End1;
SymbolTable[14] := EndText1; SymbolTable[15] := Equal1;
SymbolTable[16] := False1; SymbolTable[17] := Fi1;
SymbolTable[18] := Greater1; SymbolTable[19] := If1;
SymbolTable[20] := Integer1; SymbolTable[21] := LeftBracket1;
SymbolTable[22] := LeftParenthesis1; SymbolTable[23] := Less1;
SymbolTable[24] := Minus1; SymbolTable[25] := Mod1;
SymbolTable[26] := Name1; SymbolTable[27] := Newline1;
SymbolTable[28] := Not1; SymbolTable[29] := Numeral1;
SymbolTable[30] := Od1; SymbolTable[31] := Or1;
SymbolTable[32] := Period1; SymbolTable[33] := Plus1;
SymbolTable[34] := Proc1; SymbolTable[35] := Read1;
SymbolTable[36] := RightBracket1; SymbolTable[37] := RightParenthesis1;
SymbolTable[38] := Semicolon1; SymbolTable[39] := Skip1;
SymbolTable[40] := True1; SymbolTable[41] := Unknown1;
SymbolTable[42] := Write1;
end;
{ SYNTAX ANALYSIS }
procedure SyntaxError(Stop: Symbols);
begin
Error(Syntax3);
while not (Symbol in Stop) do
NextSymbol
end;
procedure SyntaxCheck(Stop: Symbols);
begin
if not (Symbol in Stop) then SyntaxError(Stop)
end;
procedure Expect(s: SymbolType; Stop: Symbols);
begin
if Symbol = s then NextSymbol
else SyntaxError(Stop);
SyntaxCheck(Stop)
end;
procedure ExpectName(Var Name: integer; Stop: Symbols);
begin
if Symbol = Name1 then
begin
Name := Argument;
NextSymbol
end
else
begin
Name := NoName;
SyntaxError(Stop)
end;
SyntaxCheck(Stop)
end;
{ Constant ::= Numeral | False1 | True1 | ConstantName }
procedure Constant(var Value: integer;
var Typex:VariableType; Stop:Symbols);
var
Object0: Pointer;
begin
case Symbol of
Numeral1: begin
Value := Argument;
Typex := Integer2;
Expect(Numeral1,Stop)
end;
False1: begin
Value := ord(false);
Typex := Boolean2;
Expect(False1,Stop);
end;
True1: begin
Value := ord(true);
Typex := Boolean2;
Expect(True1,Stop);
end;
Name1: begin
Find(Argument, Object0);
if Object0 = nil then
begin
KindError(Object0);
Value := 0;
Typex := CommonType2;
end
else if Object0^.Kind = Constantx then
begin
Value := Object0^.ConstValue;
Typex := Object0^.constType
end
else
begin
KindError(Object0);
Value := 0;
Typex := CommonType2;
end;
Expect(Name1, Stop)
end;
else begin { case else }
SyntaxError(Stop);
Value := 0;
Typex := CommonType2
end
end { case }
end;
{ ConstantDefinition ::= "const" ConstantName ˇ°=ˇ± Constant }
procedure ConstantDefinition(Stop: Symbols);
var
Name, Value: integer; Constx: Pointer; Typex: VariableType;
begin
Expect(Const1, [Name1, Equal1] + ConstantSymbols + Stop);
ExpectName(Name, [Equal1] + ConstantSymbols + Stop);
Expect( Equal1, ConstantSymbols + Stop);
Constant(Value, Typex, Stop);
Define(Name,Constantx, Constx);
Constx^.ConstValue := Value;
Constx^.ConstType := Typex;
end;
{ VariableList ::= VariableName # "," VariableName # }
procedure VariableList(Kind: NameClass; var Number: integer;
var LastVar: Pointer; Stop: Symbols);
var
Name: integer;
begin
ExpectName(Name, [Comma1, Name1] + Stop);
Define(Name, Kind, LastVar);
Number:=Number+1;
while Symbol = Comma1 do
begin
Expect(Comma1, [Name1] + Stop);
VariableList(Kind, Number, LastVar, Stop);
end;
end;
{ VariableDefinition ::= VariableType VariableList |
VariableType "array" VariableList "[" Constant "]" }
{ VariableType ::= "integer" | "boolean" }
procedure VariableDefinition(var LastVar: Pointer;
var Length:integer;Stop: Symbols);
var
Number,value,i: integer; VarTypex,Typex: VariableType;
varlist:Pointer; temsymbol:SymbolType;
begin
temsymbol:=Symbol;
if temsymbol = Integer1 then VarTypex:=Integer2
else
if temsymbol =Boolean1 then VarTypex:=Boolean2
else VarTypex:=CommonType2;
Expect(temsymbol,[Name1, Array1]+ConstantSymbols+Stop);
if (Symbol = Array1) then
begin
Expect(Array1,[Name1, LeftBracket1, RightBracket1]+ConstantSymbols+Stop);
Number:=0;
VariableList(ArrayType,Number,varlist,
[LeftBracket1, RightBracket1]+ConstantSymbols+Stop);
Expect(LeftBracket1,[RightBracket1]+ConstantSymbols+Stop);
Constant(value,Typex,[RightBracket1]+ConstantSymbols+Stop);
Expect(RightBracket1,ConstantSymbols+Stop);
LastVar := varlist;
i:=Number;
while i > 0 do
begin
varlist^.ArrLevel:=BlockLevel;
varlist^.ArrDispl:=3+Block[Blocklevel].CurLen+(i-1)*value;
varlist^.Bound:=value;
varlist^.ElementType:=VarTypex;
varlist:=varlist^.Previous;
i:=i-1;
end;
Length:=Number*value;
end
else
begin
Number:=0;
VariableList(Variable,Number,varlist,Stop);
LastVar := varlist;
i:=Number;
while i > 0 do
begin
varlist^.VarLevel:=BlockLevel;
varlist^.VarDispl:=3+Block[BlockLevel].CurLen+(i-1);
varlist^.VarType:=VarTypex;
varlist:=varlist^.Previous;
i:=i-1;
end;
Length:=Number;
end;
Block[BlockLevel].CurLen:=Block[BlockLevel].CurLen+Length;
end;
{ ProcedureDefinition ::= ˇ°procˇ± ProcedureName ParProgram }
procedure PartProgram(BeginLabel, VarLabel: integer;
Stop: Symbols); forward;
procedure ProcedureDefinition(Stop: Symbols);
var
Name: integer; Proc: Pointer;
BeginLabel,VarLabel: integer;
begin
Expect(Proc1,[Name1,Begin1]+Stop);
ExpectName(Name, [Begin1] + Stop);
Define(Name, Procedur, Proc);
Proc^.ProcLevel := BlockLevel;
NewLabel(Proc^.ProcLabel);
NewLabel(VarLabel);
NewLabel(BeginLabel);
Emit2(DefAddr2,Proc^.ProcLabel);
Emit3(Proc2, VarLabel, BeginLabel);
PartProgram(BeginLabel,VarLabel,[Semicolon1]+Stop);
Emit1(EndProc2);
end;
{ IndexedSelector ::= ˇ°[ˇ° Expression ˇ°]ˇ± }
procedure Expression(var Typex: VariableType; Stop: Symbols); forward;
procedure IndexSelector(ArrVar:Pointer; Stop: Symbols);
var
ExprType: VariableType;
begin
Expect(LeftBracket1,[RightBracket1]+ExpressionSymbols + Stop);
Expression(ExprType, [RightBracket1] + Stop);
if ExprType = Integer2 then
begin
CheckTypes(ExprType, Integer2);
Emit3(Index2, ArrVar^.Bound, LineNo);
Pop(1);
end
else
begin
KindError(ArrVar);
end;
Expect(RightBracket1, Stop)
end;
{ VariableAccess ::= VariableName # IndexSelector #
IndexSelector ::= "[" Expression "]" }
procedure VariableAccess(var Typex:VariableType;Stop: Symbols);
var
Stop2: Symbols; Object0: Pointer; Level, Displ: integer;
begin
if Symbol = Name1 then
begin
Stop2 := SelectorSymbols + Stop;
Find(Argument, Object0);
Expect(Name1, Stop2);
if Object0^.Kind in Variables then
begin
if Object0^.Kind = Variable then
begin
Typex := Object0^.VarType;
Level := BlockLevel-Object0^.VarLevel;
Displ := Object0^.VarDispl;
Emit3(Variable2,Level,Displ);
end
else
begin
Typex := Object0^.ElementType;
Level := BlockLevel - Object0^.ArrLevel;
Displ := Object0^.ArrDispl;
Emit3(Variable2,Level,Displ);
IndexSelector(Object0,Stop);
end;
Push(1)
end
else
begin
KindError(Object0);
Typex := CommonType2;
end;
if Name1 = LeftBracket1 then
IndexSelector(Object0,ExpressionSymbols+[LeftBracket1]+Stop);
end
else
begin
SyntaxError(Stop);
Typex := commonType2;
end
end;
{ Factor ::= Constant|VariableAccess|ˇ±(ˇ° Expression ˇ°)ˇ±
|ˇ±~ˇ± Factor }
procedure Factor(var Typex: VariableType; Stop: Symbols);
var
Object0: Pointer; Value: integer;
begin
if Symbol in ConstantSymbols-[Name1] then
begin
Constant(Value, Typex, Stop);
Emit2(Constant2, Value);
Push(1)
end
else
if Symbol = Name1 then
begin
Find(Argument, Object0);
if Object0^.Kind = Constantx then
begin
Constant(Value, Typex, Stop);
Emit2(Constant2, Value);
Push(1)
end
else
if Object0^.Kind in Variables then
begin
VariableAccess(Typex,Stop);
Emit1(Value2);
Push(1)
end
else
begin
Typex := CommonType2;
Expect(Name1, Stop)
end
end
else
if Symbol = LeftParenthesis1 then
begin
Expect(LeftParenthesis1, [RightParenthesis1]
+ ExpressionSymbols + Stop);
Expression(Typex, [RightParenthesis1] + Stop);
Expect(RightParenthesis1, Stop)
end
else
if Symbol = Not1 then
begin
Expect(Not1, FactorSymbols + Stop);
Factor(Typex, Stop);
CheckTypes(Typex, Boolean2);
Emit1(Not2)
end
else
begin
SyntaxError(Stop);
Typex:= CommonType2
end
end;
{ Term ::= Factor # MultiplyingOperator Factor #
MultiplyingOperator ::= ˇ°*ˇ± | ˇ°/ˇ± | ˇ°\ˇ± }
procedure Term(var Typex: VariableType; Stop: Symbols);
var
Stop2: Symbols;Operator: SymbolType;Type2: VariableType;
begin
Stop2 := MultiplySymbols + Stop;
Factor(Typex, Stop2);
while Symbol in MultiplySymbols do
begin
Operator := Symbol;
Expect(Symbol, FactorSymbols + Stop2);
Factor(Type2, Stop2);
if Typex = Integer2 then
begin
CheckTypes(Typex, Type2);
if Operator = Asterisk1 then
Emit1(Multiply2)
else
if Operator = Div1 then Emit1(Divide2)
else
Emit1(Modulo2);
Pop(1)
end
else
TypeError(Typex)
end
end;
{ SimpleExpression ::= [ "-" ] Term # AddingOperator Term #
AddingOperator ::= ˇ°+ˇ± | ˇ°-ˇ° }
procedure SimpleExpression(var Typex: VariableType; Stop: Symbols);
var
Stop2: Symbols; Operator: SymbolType; Type2: VariableType;
begin
Stop2 := AddSymbols + Stop;
SyntaxCheck([Minus1] + TermSymbols + Stop2);
if Symbol = Minus1 then
begin
Operator := Symbol;
Expect(Symbol, TermSymbols + Stop2);
Term(Typex, Stop2);
CheckTypes(TYpex, Integer2);
if Operator = Minus1 then Emit1(Minus2)
end
else Term(Typex, Stop2);
while Symbol in AddSymbols do
begin
Operator := Symbol;
Expect(Symbol, TermSymbols + Stop2);
Term(Type2,Stop2);
if Typex = Integer2 then
begin
CheckTypes(Typex, Type2);
if Operator = Plus1 then Emit1(Add2)
else
Emit1(Subtract2);
Pop(1)
end
else TypeError(Typex);
end
end;
{ BasicExpression ::= SimpleExpression # RelationOperator SimpleExpression #
RelationOperator ::= "<" | "=" | ">" }
procedure BasicExpression(Var Typex:VariableType; Stop: Symbols);
var
Operator: SymbolType; Type2: VariableType;
begin
SimpleExpression(Typex,RelationSymbols+Stop);
while Symbol in RelationSymbols do
begin
Operator := Symbol;
Expect(Symbol,RelationSymbols+ExpressionSymbols+Stop);
SimpleExpression(Type2,RelationSymbols+Stop);
CheckTypes(Typex,Type2);
if Operator = Less1 then Emit1(Less2)
else
if Operator = Equal1 then Emit1(Equal2)
else
Emit1(Greater2);
Typex:=Boolean2;
end;
end;
{ Expression ::= BasicExpression # AndOrOperator BasicExpression #
AndOrOperator ::= ˇ°&ˇ± | ˇ°|ˇ± }
procedure Expression { var Typex: VariableType; Stop: Symbols } ;
var
Operator: SymbolType; Type2: VariableType;
begin
BasicExpression(Typex, AndOrSymbols + Stop);
while Symbol in AndOrSymbols do
begin
Operator := Symbol;
Expect(Symbol,AndOrSymbols+ExpressionSymbols+Stop);
BasicExpression(Type2,AndOrSymbols+Stop);
CheckTypes(Typex,Boolean2);
CheckTypes(Type2,Boolean2);
if Operator = And1 then Emit1(And2)
else Emit1(Or2);
end;
end;
{ ProcedureStatement ::= "call" ProcedureName }
procedure ProcedureStatement(Stop: Symbols);
var
Proc: Pointer;
begin
Expect(Call1,[Name1]+Stop);
Find(Argument,Proc);
Expect(Name1,Stop);
Emit3(Call2, BlockLevel - Proc^.ProcLevel, Proc^.ProcLabel);
Push(3);
Pop(3)
end;
{ ExpressionTable ::= Expression # "," ExpressionTable # }
procedure ExpressionTable(var num:integer; Stop:Symbols);
var
Typex: VariableType;
begin
Expression(Typex,[Comma1]+ExpressionSymbols+Stop);
num:=num+1;
ExprTypeTable[num]:=Typex;
while Symbol = Comma1 do
begin
Expect(Comma1,ExpressionSymbols+Stop);
ExpressionTable(num,Stop);
end;
end;
{ AssignmentStatement ::= VariableAccessTable ˇ°:=ˇ± ExpressionTable }
procedure VariableAccessTable(Var num:integer; Stop:Symbols); forward;
procedure AssignmentStatement(Stop: Symbols);
var
err:boolean; Length1,Length2,i: integer;
Typex:VariableType;
begin
VariableAccessTable(Length1, [Becomes1] + ExpressionSymbols + Stop);
Expect(Becomes1, ExpressionSymbols + Stop);
Length2:=0;
ExpressionTable(Length2, Stop);
if Length1 <> Length2 then TypeError(Typex)
else
begin
err:=false;
for i:=1 to Length1 do
if VarAccTypeTable[i] <> ExprTypeTable[i] then
begin
err:=true;
VarAccTypeTable[i]:=CommonType2;
ExprTypeTable[i]:=CommonType2;
end;
if err then Error(Type3)
else Emit2(Assign2, Length1);
end;
Pop(1 + Length1)
end;
{ WarningCommand ::= Expression "->" StatementPart }
procedure StatementPart(Stop: Symbols); forward;
procedure WarningCommand(Label2:integer; Stop:Symbols);
var
Typex:VariableType; Label1:integer;
begin
Expression(Typex,[Arrow1]+StatementSymbols+Stop);
if (Typex = Boolean2) then
begin
NewLabel(Label1);
Expect(Arrow1,StatementSymbols+Stop);
Emit2(Arrow2,Label1);
StatementPart(Stop);
Emit2(Bar2,Label2);
Emit2(DefAddr2,Label1);
end
else TypeError(Typex);
end;
{ WarningCommandTable ::= WarningCommand # "[]" WarningCommand # }
procedure WarningCommandTable(Label2:integer; Stop:Symbols);
begin
WarningCommand(Label2,[Bracket1]+Stop);
while Symbol = Bracket1 do
begin
Expect(Bracket1,ExpressionSymbols+Stop);
WarningCommand(Label2,[Bracket1]+Stop);
end
end;
{ IfStatement::= ˇ°ifˇ± WarningCommandTable ˇ°fiˇ± }
procedure Statement(Stop: Symbols); forward;
procedure IfStatement(Stop: Symbols);
var
Label2:integer;
begin
NewLabel(Label2);
Expect(If1,ExpressionSymbols+Stop);
WarningCommandTable(Label2,[Fi1] + Stop);
Expect(Fi1,Stop);
Emit2(Fi2, LineNo);
Emit2(DefAddr2,Label2);
Pop(1);
end;
{ DoStatement ::= "do" WarningCommandTabel "od" }
procedure DoStatement(Stop:Symbols);
var
Label2:integer;
begin
NewLabel(Label2);
Emit2(DefAddr2,Label2);
Expect(Do1,ExpressionSymbols+[Od1]+Stop);
WarningCommandTable(Label2,[Od1]+Stop);
Expect(Od1,Stop);
end;
{ VariableAccessTable ::= VariableAccess # "," VariableAccess # }
procedure VariableAccessTable(Var num:integer; Stop:Symbols);
var
Typex:VariableType;
begin
num:=0;
VariableAccess(Typex,[Comma1]+Stop);
num:=num+1;
VarAccTypeTable[num]:=Typex;
while Symbol = Comma1 do
begin
Expect(Comma1,[Name1]+Stop);
VariableAccess(Typex,[Comma1]+Stop);
num:=num+1;
VarAccTypeTable[num]:=Typex;
end;
end;
{ ReadStatement ::= "read" VariableAccessTable }
procedure ReadStatement(Stop:Symbols);
var
num,i:integer; err:boolean;
begin
Expect(Read1,[Name1]+Stop);
VariableAccessTable(num,Stop);
err:=false;
for i:=1 to num do
if VarAccTypeTable[i] <> Integer2 then
begin
err:=true;
VarAccTypeTable[i]:=CommonType2;
end;
if not err then Emit2(Read2,num)
else Error(Type3);
end;
{ WriteStatement ::="write" ExpressionTable }
procedure WriteStatement(Stop: Symbols);
var
num,i:integer; err:boolean;
begin
Expect(Write1,ExpressionSymbols+Stop);
num:=0;
ExpressionTable(num,Stop);
err:=false;
for i:=1 to num do
if ExprTypeTable[i] <> Integer2 then
begin
err:=true;
ExprTypeTable[i]:=CommonType2;
end;
if not err then Emit2(Write2,num)
else Error(Type3);
end;
{ Statement ::= EmptyStatement | ReadStatement | WriteStatement | AssignmentStatement |
ProcedureStatement | IfStatement | DoStatement }
{ EmptyStatement ::= "skip" }
procedure Statement { Stop: Symbols };
var
Object0: Pointer;
begin
if Symbol = Skip1 then Expect(Skip1,Stop)
else
if Symbol = Read1 then ReadStatement(Stop)
else
if Symbol = Write1 then WriteStatement(Stop)
else
if Symbol = Name1 then
begin
Find(Argument, Object0);
if Object0^.Kind in Variables then
AssignmentStatement(Stop)
else
if Object0^.Kind = Procedur then
ProcedureStatement(Stop)
else
begin
KindError(Object0);
Expect(Name1, Stop)
end
end
else
if Symbol = If1 then IfStatement(Stop)
else
if Symbol = Do1 then DoStatement(Stop)
else
if Symbol = Call1 then ProcedureStatement(Stop)
else
SyntaxCheck(Stop)
end;
{ DefinitionPart ::= # Definition ";" #}
{ Definition ::= ConstantDefinition | VariableDefinition | ProcDefinition }
procedure DefinitionPart(Var VarLength:integer; Stop:Symbols);
var
obj:Pointer;
begin
While Symbol in DefinitionSymbols do
begin
if Symbol = Const1 then
ConstantDefinition(DefinitionSymbols+Stop);
if Symbol in TypeSymbols then
VariableDefinition(obj,VarLength,DefinitionSymbols+Stop);
if Symbol = Proc1 then
ProcedureDefinition(DefinitionSymbols + Stop);
Expect(Semicolon1,[Semicolon1]+DefinitionSymbols+Stop);
end;
end;
{ StatementPart ::= # Statement ";" # }
procedure StatementPart(Stop: Symbols);
begin
while Symbol in StatementSymbols do
begin
Statement([Semicolon1]+Stop);
Expect(Semicolon1,StatementSymbols+Stop);
end;
end;
{ PartProgram ::= "begin" DefinitionPart StatementPart "end" }
procedure PartProgram(BeginLabel,VarLabel:integer; Stop:Symbols);
{BeginLabel,VarLabel:integer;Stop:Symbols}
var
VarLength: integer;
begin
NewBlock;
Expect(Begin1,[ Semicolon1, End1 ]+definitionSymbols+StatementSymbols+Stop );
DefinitionPart(VarLength,StatementSymbols+[Semicolon1,End1]+Stop);
Emit3(DefArg2,VarLabel,Block[BlockLevel].CurLen);
Emit2(DefAddr2,BeginLabel);
StatementPart([End1]+Stop);
Expect(End1,Stop);
EndBlock;
end;
{ Program ::= PartProgram ˇ°.ˇ± }
procedure Programx(Stop: Symbols);
var
VarLabel, BeginLabel: integer;
begin
NewLabel(VarLabel);
NewLabel(BeginLabel);
Emit3(Prog2, VarLabel, BeginLabel);
PartProgram(BeginLabel, VarLabel, [Period1] + Stop);
Emit1(EndProg2);
Expect(Period1, Stop)
end;
{ Pass2 : THE PL PARSER }
begin
Initialize;
NextSymbol;
StandardBlock;
Programx([EndText1])
end;
end.