1 | program compiler(input, output);
|
---|
2 |
|
---|
3 | {pl/0 compiler with code generation}
|
---|
4 | label
|
---|
5 | 99;
|
---|
6 |
|
---|
7 | const
|
---|
8 | ReservedWordsCount = 11;
|
---|
9 | IdentifierTableSize = 100;
|
---|
10 | MaxNumberDigitsCount = 14; {max. no. of digits in numbers}
|
---|
11 | MaxIdentifierLength = 10;
|
---|
12 | MaxAddress = 2047;
|
---|
13 | MaxBlockLevel = 3;
|
---|
14 | MaxCodeIndex = 200; {size of code array}
|
---|
15 |
|
---|
16 | type
|
---|
17 | TSymbolKind = (skNul, skIdentifier, skNumber, skPlus, skMinus, skTimes, skSlash, skOdd,
|
---|
18 | skEqual, skNotEqual, skLess, skLessOrEqual, skGreater, skGreaterOrEqual,
|
---|
19 | skLeftParenthesis, skRightParenthesis, skComma, skSemicolon,
|
---|
20 | skPeriod, skBecomes, skBegin, skEnd, skIf, skThen,
|
---|
21 | skWhile, skDo, skCall, skConst, skVar, skProcedure, skWrite, skRead);
|
---|
22 | TIdentifier = packed array [1..MaxIdentifierLength] of Char;
|
---|
23 | TObjectKind = (okConstant, okVariable, okProcedure);
|
---|
24 | TSymbolSet = set of TSymbolKind;
|
---|
25 | TFunction = (fnLoadConstant, fnOperation, fnLoadVariable, fnStoreVariable, fnCall,
|
---|
26 | fnIncrementTopStack, fnJump, fnJumpConditional, fnWrite, fnRead);
|
---|
27 | { lit 0,a : load constant a
|
---|
28 | opr 0,a : execute operation a
|
---|
29 | lod l,a : load varible l,a
|
---|
30 | sto l,a : store varible l,a
|
---|
31 | cal l,a : call procedure a at level l
|
---|
32 | int 0,a : increment t-register by a
|
---|
33 | jmp 0,a : jump to a
|
---|
34 | jpc 0,a : jump conditional to a }
|
---|
35 | TOperation = (opReturn, opNegative, opAdd, opSubtract, opMultiply, opDivide, opOdd,
|
---|
36 | opEqual, opNotEqual, opLess, opGreater, opGreaterOrEqual, opLessOrEqual);
|
---|
37 |
|
---|
38 | TInstruction = packed record
|
---|
39 | Func: TFunction;
|
---|
40 | Level: 0..MaxBlockLevel;
|
---|
41 | Address: 0..MaxAddress; {displacement address}
|
---|
42 | end;
|
---|
43 |
|
---|
44 | TSymbol = record
|
---|
45 | Name: TIdentifier;
|
---|
46 | case ObjectKind: TObjectKind of
|
---|
47 | okConstant: (Value: Integer);
|
---|
48 | okVariable, okProcedure: (Level, Address: Integer);
|
---|
49 | end;
|
---|
50 |
|
---|
51 | TError = (erUnexpectedAssignmentOperator, erExpectedNumber, erExpectEqualOperator,
|
---|
52 | erExpectedIdentifier,
|
---|
53 | erExpectedSemicolon, er6, er7, er8, erMissingPeriod, erExpectedSemicolonAfterStatement,
|
---|
54 | erSymbolNotFound, erAssignmentToNonVariable, erExpectedEqualOperator,
|
---|
55 | erExpectedProcedureName, erIdentifierIsNotProcedureName, erExpectedThen,
|
---|
56 | erExpectedEnd, erExpectedDo, er19, erExpectedLogicOperator, erCantReferenceProcedureSymbol,
|
---|
57 | er22, er23, er24, er25, er26,
|
---|
58 | er27, er28, er29, erNumberOutOfRange, er31, erMaximumBlockLevelReached,
|
---|
59 | erExpectedVariableName);
|
---|
60 |
|
---|
61 | TBlock = record
|
---|
62 | DataAllocationIndex: Integer; {data allocation index}
|
---|
63 | InitialSymbolTableIndex: Integer; {initial SymbolTable index}
|
---|
64 | InitialCodeIndex: Integer; {initial Code index}
|
---|
65 | Level: Integer;
|
---|
66 | SymbolTableIndex: Integer;
|
---|
67 | end;
|
---|
68 |
|
---|
69 | var
|
---|
70 | LastChar: Char;
|
---|
71 | LastSymbol: TSymbolKind;
|
---|
72 | LastIdentifier: TIdentifier;
|
---|
73 | LastNumber: Integer;
|
---|
74 | CharacterCount: Integer;
|
---|
75 | LineLength: Integer;
|
---|
76 | ErrorCount: Integer;
|
---|
77 | CodeAllocationIndex: Integer;
|
---|
78 | Line: array [1..81] of Char;
|
---|
79 | Code: array [0..MaxCodeIndex] of TInstruction;
|
---|
80 | ReservedWords: array [1..ReservedWordsCount] of TIdentifier;
|
---|
81 | WordSymbols: array [1..ReservedWordsCount] of TSymbolKind;
|
---|
82 | SingleCharSymbols: array [Char] of TSymbolKind;
|
---|
83 | Mnemonic: array [TFunction] of packed array [1..5] of Char;
|
---|
84 | DeclarationBeginSymbolSet: TSymbolSet;
|
---|
85 | StatementBeginSymbolSet: TSymbolSet;
|
---|
86 | FactorBeginSymbolSet: TSymbolSet;
|
---|
87 | SymbolTable: array [0..IdentifierTableSize] of TSymbol;
|
---|
88 | SourceFile: Text;
|
---|
89 |
|
---|
90 | procedure Error(ErrorCode: TError);
|
---|
91 | begin
|
---|
92 | WriteLn(' ****', ' ': CharacterCount - 1, '^', Integer(ErrorCode): 2);
|
---|
93 | ErrorCount := ErrorCount + 1;
|
---|
94 | end;
|
---|
95 |
|
---|
96 | procedure GetCharacter;
|
---|
97 | begin
|
---|
98 | if CharacterCount = LineLength then begin
|
---|
99 | if Eof(SourceFile) then begin
|
---|
100 | Write(' program incomplete');
|
---|
101 | goto 99;
|
---|
102 | end;
|
---|
103 | LineLength := 0;
|
---|
104 | CharacterCount := 0;
|
---|
105 | Write(CodeAllocationIndex: 5, ' ');
|
---|
106 | while not Eoln(SourceFile) do begin
|
---|
107 | LineLength := LineLength + 1;
|
---|
108 | Read(SourceFile, LastChar);
|
---|
109 | Write(LastChar);
|
---|
110 | if LastChar in ['A'..'Z'] then
|
---|
111 | LastChar := Chr(Ord(LastChar) - Ord('A') + Ord('a'));
|
---|
112 | Line[LineLength] := LastChar;
|
---|
113 | end;
|
---|
114 | WriteLn;
|
---|
115 | ReadLn(SourceFile);
|
---|
116 | LineLength := LineLength + 1;
|
---|
117 | Line[LineLength] := ' ';
|
---|
118 | end;
|
---|
119 | CharacterCount := CharacterCount + 1;
|
---|
120 | LastChar := Line[CharacterCount];
|
---|
121 | end;
|
---|
122 |
|
---|
123 | function SearchReservedWord(Identifier: TIdentifier): Integer;
|
---|
124 | var
|
---|
125 | I: Integer;
|
---|
126 | J: Integer;
|
---|
127 | K: Integer;
|
---|
128 | begin
|
---|
129 | I := 1;
|
---|
130 | J := ReservedWordsCount;
|
---|
131 | repeat
|
---|
132 | K := (I + J) div 2;
|
---|
133 | if Identifier <= ReservedWords[K] then J := K - 1;
|
---|
134 | if Identifier >= ReservedWords[K] then I := K + 1;
|
---|
135 | until I > J;
|
---|
136 | if I - 1 > J then SearchReservedWord := K
|
---|
137 | else SearchReservedWord := 0;
|
---|
138 | end;
|
---|
139 |
|
---|
140 |
|
---|
141 | procedure GetSymbol;
|
---|
142 | var
|
---|
143 | I, K: Integer;
|
---|
144 | Identifier: TIdentifier;
|
---|
145 | kk: Integer;
|
---|
146 | begin
|
---|
147 | while LastChar = ' ' do GetCharacter;
|
---|
148 | if LastChar in ['a'..'z'] then begin
|
---|
149 | {identifier or reserved ReservedWords}
|
---|
150 | K := 0;
|
---|
151 | repeat
|
---|
152 | if K < MaxIdentifierLength then begin
|
---|
153 | K := K + 1;
|
---|
154 | Identifier[K] := LastChar;
|
---|
155 | end;
|
---|
156 | GetCharacter;
|
---|
157 | until not (LastChar in ['a'..'z', '0'..'9']);
|
---|
158 | kk := MaxIdentifierLength;
|
---|
159 | if K >= kk then kk := K
|
---|
160 | else repeat
|
---|
161 | Identifier[kk] := ' ';
|
---|
162 | kk := kk - 1
|
---|
163 | until kk = K;
|
---|
164 | LastIdentifier := Identifier;
|
---|
165 | I := SearchReservedWord(Identifier);
|
---|
166 | if I > 0 then LastSymbol := WordSymbols[I]
|
---|
167 | else LastSymbol := skIdentifier;
|
---|
168 | end else
|
---|
169 | if LastChar in ['0'..'9'] then begin
|
---|
170 | {skNumber}
|
---|
171 | K := 0;
|
---|
172 | LastNumber := 0;
|
---|
173 | LastSymbol := skNumber;
|
---|
174 | repeat
|
---|
175 | LastNumber := 10 * LastNumber + (Ord(LastChar) - Ord('0'));
|
---|
176 | K := K + 1;
|
---|
177 | GetCharacter
|
---|
178 | until not (LastChar in ['0'..'9']);
|
---|
179 | if K > MaxNumberDigitsCount then Error(erNumberOutOfRange);
|
---|
180 | end else
|
---|
181 | if LastChar = ':' then begin
|
---|
182 | GetCharacter;
|
---|
183 | if LastChar = '=' then begin
|
---|
184 | LastSymbol := skBecomes;
|
---|
185 | GetCharacter;
|
---|
186 | end
|
---|
187 | else LastSymbol := skNul;
|
---|
188 | end else begin
|
---|
189 | LastSymbol := SingleCharSymbols[LastChar];
|
---|
190 | GetCharacter;
|
---|
191 | { Check two characters symbols }
|
---|
192 | if LastSymbol = skLess then begin
|
---|
193 | if LastChar = '=' then begin
|
---|
194 | LastSymbol := skLessOrEqual;
|
---|
195 | GetCharacter;
|
---|
196 | end
|
---|
197 | end else
|
---|
198 | if LastSymbol = skGreater then begin
|
---|
199 | if LastChar = '=' then begin
|
---|
200 | LastSymbol := skGreaterOrEqual;
|
---|
201 | GetCharacter;
|
---|
202 | end;
|
---|
203 | end;
|
---|
204 | end;
|
---|
205 | end;
|
---|
206 |
|
---|
207 | procedure Generate(AFunc: TFunction; ALevel, AAddress: Integer);
|
---|
208 | begin
|
---|
209 | if CodeAllocationIndex > MaxCodeIndex then begin
|
---|
210 | Write(' program too long');
|
---|
211 | goto 99;
|
---|
212 | end;
|
---|
213 | with Code[CodeAllocationIndex] do begin
|
---|
214 | Func := AFunc;
|
---|
215 | Level := ALevel;
|
---|
216 | Address := AAddress;
|
---|
217 | end;
|
---|
218 | CodeAllocationIndex := CodeAllocationIndex + 1;
|
---|
219 | end;
|
---|
220 |
|
---|
221 | procedure Test(s1, s2: TSymbolSet; ErrorCode: TError);
|
---|
222 | begin
|
---|
223 | if not (LastSymbol in s1) then begin
|
---|
224 | Error(ErrorCode);
|
---|
225 | s1 := s1 + s2;
|
---|
226 | while not (LastSymbol in s1) do
|
---|
227 | GetSymbol;
|
---|
228 | end;
|
---|
229 | end;
|
---|
230 |
|
---|
231 | function SearchSymbol(Identifier: TIdentifier; SymbolTableIndex: Integer): Integer;
|
---|
232 | var
|
---|
233 | I: Integer;
|
---|
234 | begin
|
---|
235 | SymbolTable[0].Name := Identifier;
|
---|
236 | I := SymbolTableIndex;
|
---|
237 | while SymbolTable[I].Name <> Identifier do I := I - 1;
|
---|
238 | SearchSymbol := I;
|
---|
239 | end;
|
---|
240 |
|
---|
241 | procedure AddSymbol(var Block: TBlock; AObjectKind: TObjectKind);
|
---|
242 | begin
|
---|
243 | Block.SymbolTableIndex := Block.SymbolTableIndex + 1;
|
---|
244 | with SymbolTable[Block.SymbolTableIndex] do begin
|
---|
245 | Name := LastIdentifier;
|
---|
246 | ObjectKind := AObjectKind;
|
---|
247 | case AObjectKind of
|
---|
248 | okConstant: begin
|
---|
249 | if LastNumber > MaxAddress then begin
|
---|
250 | Error(erNumberOutOfRange);
|
---|
251 | LastNumber := 0;
|
---|
252 | end;
|
---|
253 | Value := LastNumber;
|
---|
254 | end;
|
---|
255 | okVariable: begin
|
---|
256 | Level := Block.Level;
|
---|
257 | Address := Block.DataAllocationIndex;
|
---|
258 | Block.DataAllocationIndex := Block.DataAllocationIndex + 1;
|
---|
259 | end;
|
---|
260 | okProcedure: Level := Block.Level;
|
---|
261 | end;
|
---|
262 | end;
|
---|
263 | end;
|
---|
264 |
|
---|
265 | procedure ParseConstDeclaration(var Block: TBlock);
|
---|
266 | begin
|
---|
267 | if LastSymbol = skIdentifier then begin
|
---|
268 | GetSymbol;
|
---|
269 | if LastSymbol in [skEqual, skBecomes] then begin
|
---|
270 | if LastSymbol = skBecomes then Error(erUnexpectedAssignmentOperator);
|
---|
271 | GetSymbol;
|
---|
272 | if LastSymbol = skNumber then begin
|
---|
273 | AddSymbol(Block, okConstant);
|
---|
274 | GetSymbol;
|
---|
275 | end else Error(erExpectedNumber);
|
---|
276 | end else Error(erExpectEqualOperator);
|
---|
277 | end else Error(erExpectedIdentifier);
|
---|
278 | end;
|
---|
279 |
|
---|
280 | procedure ParseVarDeclaration(var Block: TBlock);
|
---|
281 | begin
|
---|
282 | if LastSymbol = skIdentifier then begin
|
---|
283 | AddSymbol(Block, okVariable);
|
---|
284 | GetSymbol;
|
---|
285 | end else Error(erExpectedIdentifier);
|
---|
286 | end;
|
---|
287 |
|
---|
288 | procedure ListGeneratedCode(var Block: TBlock);
|
---|
289 | var
|
---|
290 | I: Integer;
|
---|
291 | begin
|
---|
292 | for I := Block.InitialCodeIndex to CodeAllocationIndex - 1 do
|
---|
293 | with Code[I] do
|
---|
294 | WriteLn(I: 5, Mnemonic[Func]: 5, 1: 3, Address: 5);
|
---|
295 | end;
|
---|
296 |
|
---|
297 | procedure ParseExpression(var Block: TBlock; SymbolSet: TSymbolSet); forward;
|
---|
298 |
|
---|
299 | procedure ParseFactor(var Block: TBlock; SymbolSet: TSymbolSet);
|
---|
300 | var
|
---|
301 | I: Integer;
|
---|
302 | begin
|
---|
303 | Test(FactorBeginSymbolSet, SymbolSet, er24);
|
---|
304 | while LastSymbol in FactorBeginSymbolSet do begin
|
---|
305 | if LastSymbol = skIdentifier then begin
|
---|
306 | I := SearchSymbol(LastIdentifier, Block.SymbolTableIndex);
|
---|
307 | if I = 0 then Error(erSymbolNotFound)
|
---|
308 | else
|
---|
309 | with SymbolTable[I] do
|
---|
310 | case ObjectKind of
|
---|
311 | okConstant: Generate(fnLoadConstant, 0, Value);
|
---|
312 | okVariable: Generate(fnLoadVariable, Block.Level - Level, Address);
|
---|
313 | okProcedure: Error(erCantReferenceProcedureSymbol)
|
---|
314 | end;
|
---|
315 | GetSymbol;
|
---|
316 | end else
|
---|
317 | if LastSymbol = skNumber then begin
|
---|
318 | if LastNumber > MaxAddress then begin
|
---|
319 | Error(erNumberOutOfRange);
|
---|
320 | LastNumber := 0;
|
---|
321 | end;
|
---|
322 | Generate(fnLoadConstant, 0, LastNumber);
|
---|
323 | GetSymbol;
|
---|
324 | end else
|
---|
325 | if LastSymbol = skLeftParenthesis then begin
|
---|
326 | GetSymbol;
|
---|
327 | ParseExpression(Block, [skRightParenthesis] + SymbolSet);
|
---|
328 | if LastSymbol = skRightParenthesis then GetSymbol
|
---|
329 | else Error(er22);
|
---|
330 | end;
|
---|
331 | Test(SymbolSet, [skLeftParenthesis], er23);
|
---|
332 | end;
|
---|
333 | end;
|
---|
334 |
|
---|
335 | procedure ParseTerm(var Block: TBlock; SymbolSet: TSymbolSet);
|
---|
336 | var
|
---|
337 | MultiplyOperation: TSymbolKind;
|
---|
338 | begin
|
---|
339 | ParseFactor(Block, SymbolSet + [skTimes, skSlash]);
|
---|
340 | while LastSymbol in [skTimes, skSlash] do begin
|
---|
341 | MultiplyOperation := LastSymbol;
|
---|
342 | GetSymbol;
|
---|
343 | ParseFactor(Block, SymbolSet + [skTimes, skSlash]);
|
---|
344 | if MultiplyOperation = skTimes then Generate(fnOperation, 0, Integer(opMultiply))
|
---|
345 | else Generate(fnOperation, 0, Integer(opDivide));
|
---|
346 | end;
|
---|
347 | end;
|
---|
348 |
|
---|
349 | procedure ParseExpression(var Block: TBlock; SymbolSet: TSymbolSet);
|
---|
350 | var
|
---|
351 | AddOperation: TSymbolKind;
|
---|
352 | begin
|
---|
353 | if LastSymbol in [skPlus, skMinus] then begin
|
---|
354 | AddOperation := LastSymbol;
|
---|
355 | GetSymbol;
|
---|
356 | ParseTerm(Block, SymbolSet + [skPlus, skMinus]);
|
---|
357 | if AddOperation = skMinus then
|
---|
358 | Generate(fnOperation, 0, Integer(opNegative));
|
---|
359 | end else
|
---|
360 | ParseTerm(Block, SymbolSet + [skPlus, skMinus]);
|
---|
361 | while LastSymbol in [skPlus, skMinus] do begin
|
---|
362 | AddOperation := LastSymbol;
|
---|
363 | GetSymbol;
|
---|
364 | ParseTerm(Block, SymbolSet + [skPlus, skMinus]);
|
---|
365 | if AddOperation = skPlus then Generate(fnOperation, 0, Integer(opAdd))
|
---|
366 | else Generate(fnOperation, 0, Integer(opSubtract));
|
---|
367 | end;
|
---|
368 | end;
|
---|
369 |
|
---|
370 | procedure ParseCondition(var Block: TBlock; SymbolSet: TSymbolSet);
|
---|
371 | var
|
---|
372 | RelationOperation: TSymbolKind;
|
---|
373 | begin
|
---|
374 | if LastSymbol = skOdd then begin
|
---|
375 | GetSymbol;
|
---|
376 | ParseExpression(Block, SymbolSet);
|
---|
377 | Generate(fnOperation, 0, Integer(opOdd));
|
---|
378 | end
|
---|
379 | else
|
---|
380 | begin
|
---|
381 | ParseExpression(Block, [skEqual, skNotEqual, skLess, skGreater, skLessOrEqual, skGreaterOrEqual] + SymbolSet);
|
---|
382 | if not (LastSymbol in [skEqual, skNotEqual, skLess, skLessOrEqual, skGreater, skGreaterOrEqual]) then
|
---|
383 | Error(erExpectedLogicOperator)
|
---|
384 | else
|
---|
385 | begin
|
---|
386 | RelationOperation := LastSymbol;
|
---|
387 | GetSymbol;
|
---|
388 | ParseExpression(Block, SymbolSet);
|
---|
389 | case RelationOperation of
|
---|
390 | skEqual: Generate(fnOperation, 0, Integer(opEqual));
|
---|
391 | skNotEqual: Generate(fnOperation, 0, Integer(opNotEqual));
|
---|
392 | skLess: Generate(fnOperation, 0, Integer(opLess));
|
---|
393 | skGreaterOrEqual: Generate(fnOperation, 0, Integer(opGreaterOrEqual));
|
---|
394 | skGreater: Generate(fnOperation, 0, Integer(opGreater));
|
---|
395 | skLessOrEqual: Generate(fnOperation, 0, Integer(opLessOrEqual));
|
---|
396 | end;
|
---|
397 | end;
|
---|
398 | end;
|
---|
399 | end;
|
---|
400 |
|
---|
401 | procedure ParseStatement(var Block: TBlock; SymbolSet: TSymbolSet);
|
---|
402 | var
|
---|
403 | I, cx1, cx2: Integer;
|
---|
404 | begin
|
---|
405 | if LastSymbol = skIdentifier then begin
|
---|
406 | I := SearchSymbol(LastIdentifier, Block.SymbolTableIndex);
|
---|
407 | if I = 0 then Error(erSymbolNotFound)
|
---|
408 | else
|
---|
409 | if SymbolTable[I].ObjectKind <> okVariable then begin
|
---|
410 | Error(erAssignmentToNonVariable);
|
---|
411 | I := 0;
|
---|
412 | end;
|
---|
413 | GetSymbol;
|
---|
414 | if LastSymbol = skBecomes then GetSymbol
|
---|
415 | else Error(erExpectedEqualOperator);
|
---|
416 | ParseExpression(Block, SymbolSet);
|
---|
417 | if I <> 0 then
|
---|
418 | with SymbolTable[I] do
|
---|
419 | Generate(fnStoreVariable, Block.Level - Level, Address);
|
---|
420 | end else
|
---|
421 | if LastSymbol = skCall then begin
|
---|
422 | GetSymbol;
|
---|
423 | if LastSymbol <> skIdentifier then Error(erExpectedProcedureName)
|
---|
424 | else begin
|
---|
425 | I := SearchSymbol(LastIdentifier, Block.SymbolTableIndex);
|
---|
426 | if I = 0 then Error(erSymbolNotFound)
|
---|
427 | else
|
---|
428 | with SymbolTable[I] do
|
---|
429 | if ObjectKind = okProcedure then Generate(fnCall, Block.Level - Level, Address)
|
---|
430 | else Error(erIdentifierIsNotProcedureName);
|
---|
431 | GetSymbol;
|
---|
432 | end;
|
---|
433 | end else
|
---|
434 | if LastSymbol = skWrite then begin
|
---|
435 | GetSymbol;
|
---|
436 | if LastSymbol <> skIdentifier then Error(erExpectedIdentifier)
|
---|
437 | else begin
|
---|
438 | I := SearchSymbol(LastIdentifier, Block.SymbolTableIndex);
|
---|
439 | if I = 0 then Error(erSymbolNotFound)
|
---|
440 | else
|
---|
441 | with SymbolTable[I] do
|
---|
442 | if ObjectKind = okVariable then Generate(fnWrite, Block.Level - Level, Address)
|
---|
443 | else Error(erExpectedVariableName);
|
---|
444 | GetSymbol;
|
---|
445 | end;
|
---|
446 | end else
|
---|
447 | if LastSymbol = skRead then begin
|
---|
448 | GetSymbol;
|
---|
449 | if LastSymbol <> skIdentifier then Error(erExpectedIdentifier)
|
---|
450 | else begin
|
---|
451 | I := SearchSymbol(LastIdentifier, Block.SymbolTableIndex);
|
---|
452 | if I = 0 then Error(erSymbolNotFound)
|
---|
453 | else
|
---|
454 | with SymbolTable[I] do
|
---|
455 | if ObjectKind = okVariable then Generate(fnRead, Block.Level - Level, Address)
|
---|
456 | else Error(erExpectedVariableName);
|
---|
457 | GetSymbol;
|
---|
458 | end;
|
---|
459 | end else
|
---|
460 | if LastSymbol = skIf then begin
|
---|
461 | GetSymbol;
|
---|
462 | ParseCondition(Block, [skThen, skDo] + SymbolSet);
|
---|
463 | if LastSymbol = skThen then GetSymbol
|
---|
464 | else Error(erExpectedThen);
|
---|
465 | cx1 := CodeAllocationIndex;
|
---|
466 | Generate(fnJumpConditional, 0, 0);
|
---|
467 | ParseStatement(Block, SymbolSet);
|
---|
468 | Code[cx1].Address := CodeAllocationIndex;
|
---|
469 | end else
|
---|
470 | if LastSymbol = skBegin then begin
|
---|
471 | GetSymbol;
|
---|
472 | ParseStatement(Block, [skSemicolon, skEnd] + SymbolSet);
|
---|
473 | while LastSymbol in [skSemicolon] + StatementBeginSymbolSet do begin
|
---|
474 | if LastSymbol = skSemicolon then GetSymbol
|
---|
475 | else Error(erExpectedSemicolonAfterStatement);
|
---|
476 | ParseStatement(Block, [skSemicolon, skEnd] + SymbolSet);
|
---|
477 | end;
|
---|
478 | if LastSymbol = skEnd then GetSymbol
|
---|
479 | else Error(erExpectedEnd);
|
---|
480 | end
|
---|
481 | else
|
---|
482 | if LastSymbol = skWhile then begin
|
---|
483 | cx1 := CodeAllocationIndex;
|
---|
484 | GetSymbol;
|
---|
485 | ParseCondition(Block, [skDo] + SymbolSet);
|
---|
486 | cx2 := CodeAllocationIndex;
|
---|
487 | Generate(fnJumpConditional, 0, 0);
|
---|
488 | if LastSymbol = skDo then GetSymbol
|
---|
489 | else Error(erExpectedDo);
|
---|
490 | ParseStatement(Block, SymbolSet);
|
---|
491 | Generate(fnJump, 0, cx1);
|
---|
492 | Code[cx2].Address := CodeAllocationIndex;
|
---|
493 | end;
|
---|
494 | Test(SymbolSet, [], er19);
|
---|
495 | end;
|
---|
496 |
|
---|
497 | procedure ParseBlock(Level, SymbolTableIndex: Integer; SymbolSet: TSymbolSet);
|
---|
498 | var
|
---|
499 | Block: TBlock;
|
---|
500 | begin
|
---|
501 | Block.Level := Level;
|
---|
502 | Block.SymbolTableIndex := SymbolTableIndex;
|
---|
503 | Block.DataAllocationIndex := 3;
|
---|
504 | Block.InitialSymbolTableIndex := Block.SymbolTableIndex;
|
---|
505 | SymbolTable[Block.SymbolTableIndex].Address := CodeAllocationIndex;
|
---|
506 | Generate(fnJump, 0, 0);
|
---|
507 | if Block.Level > MaxBlockLevel then Error(erMaximumBlockLevelReached);
|
---|
508 | repeat
|
---|
509 | if LastSymbol = skConst then begin
|
---|
510 | GetSymbol;
|
---|
511 | repeat
|
---|
512 | ParseConstDeclaration(Block);
|
---|
513 | while LastSymbol = skComma do begin
|
---|
514 | GetSymbol;
|
---|
515 | ParseConstDeclaration(Block);
|
---|
516 | end;
|
---|
517 | if LastSymbol = skSemicolon then GetSymbol
|
---|
518 | else Error(erExpectedSemicolon)
|
---|
519 | until LastSymbol <> skIdentifier;
|
---|
520 | end;
|
---|
521 | if LastSymbol = skVar then begin
|
---|
522 | GetSymbol;
|
---|
523 | repeat
|
---|
524 | ParseVarDeclaration(Block);
|
---|
525 | while LastSymbol = skComma do begin
|
---|
526 | GetSymbol;
|
---|
527 | ParseVarDeclaration(Block);
|
---|
528 | end;
|
---|
529 | if LastSymbol = skSemicolon then GetSymbol
|
---|
530 | else Error(erExpectedSemicolon)
|
---|
531 | until LastSymbol <> skIdentifier;
|
---|
532 | end;
|
---|
533 | while LastSymbol = skProcedure do begin
|
---|
534 | GetSymbol;
|
---|
535 | if LastSymbol = skIdentifier then begin
|
---|
536 | AddSymbol(Block, okProcedure);
|
---|
537 | GetSymbol;
|
---|
538 | end
|
---|
539 | else Error(erExpectedIdentifier);
|
---|
540 | if LastSymbol = skSemicolon then GetSymbol
|
---|
541 | else Error(erExpectedSemicolon);
|
---|
542 | ParseBlock(Block.Level + 1, Block.SymbolTableIndex, [skSemicolon] + SymbolSet);
|
---|
543 | if LastSymbol = skSemicolon then begin
|
---|
544 | GetSymbol;
|
---|
545 | Test(StatementBeginSymbolSet + [skIdentifier, skProcedure], SymbolSet, er6);
|
---|
546 | end else Error(erExpectedSemicolon);
|
---|
547 | end;
|
---|
548 | Test(StatementBeginSymbolSet + [skIdentifier], DeclarationBeginSymbolSet, er7)
|
---|
549 | until not (LastSymbol in DeclarationBeginSymbolSet);
|
---|
550 | Code[SymbolTable[Block.InitialSymbolTableIndex].Address].Address := CodeAllocationIndex;
|
---|
551 | with SymbolTable[Block.InitialSymbolTableIndex] do begin
|
---|
552 | Address := CodeAllocationIndex; {start Address of Code}
|
---|
553 | end;
|
---|
554 | Block.InitialCodeIndex := 0; {CodeAllocationIndex}
|
---|
555 | Generate(fnIncrementTopStack, 0, Block.DataAllocationIndex);
|
---|
556 | ParseStatement(Block, [skSemicolon, skEnd] + SymbolSet);
|
---|
557 | Generate(fnOperation, 0, Integer(opReturn));
|
---|
558 | Test(SymbolSet, [], er8);
|
---|
559 | ListGeneratedCode(Block);
|
---|
560 | end;
|
---|
561 |
|
---|
562 | procedure ParseProgram;
|
---|
563 | begin
|
---|
564 | GetSymbol;
|
---|
565 | ParseBlock(0, 0, [skPeriod] + DeclarationBeginSymbolSet + StatementBeginSymbolSet);
|
---|
566 | if LastSymbol <> skPeriod then Error(erMissingPeriod);
|
---|
567 | end;
|
---|
568 |
|
---|
569 | procedure Interpret;
|
---|
570 | const
|
---|
571 | StackSize = 500;
|
---|
572 | var
|
---|
573 | ProgramCounter: Integer;
|
---|
574 | Base: Integer;
|
---|
575 | TopStack: Integer;
|
---|
576 | Instruction: TInstruction;
|
---|
577 | DataStore: array [1..StackSize] of Integer;
|
---|
578 | X: Char;
|
---|
579 |
|
---|
580 | function GetBaseDown(Levels: Integer): Integer;
|
---|
581 | var
|
---|
582 | NewBase: Integer;
|
---|
583 | begin
|
---|
584 | NewBase := Base;
|
---|
585 | while Levels > 0 do begin
|
---|
586 | NewBase := DataStore[NewBase];
|
---|
587 | Levels := Levels - 1;
|
---|
588 | end;
|
---|
589 | GetBaseDown := NewBase;
|
---|
590 | end;
|
---|
591 |
|
---|
592 | begin
|
---|
593 | WriteLn(' start pl/0');
|
---|
594 | TopStack := 0;
|
---|
595 | Base := 1;
|
---|
596 | ProgramCounter := 0;
|
---|
597 | DataStore[1] := 0;
|
---|
598 | DataStore[2] := 0;
|
---|
599 | DataStore[3] := 0;
|
---|
600 | repeat
|
---|
601 | Instruction := Code[ProgramCounter];
|
---|
602 | ProgramCounter := ProgramCounter + 1;
|
---|
603 | with Instruction do
|
---|
604 | case Func of
|
---|
605 | fnLoadConstant: begin
|
---|
606 | TopStack := TopStack + 1;
|
---|
607 | DataStore[TopStack] := Address;
|
---|
608 | end;
|
---|
609 | fnOperation: case TOperation(Address) of
|
---|
610 | opReturn: begin
|
---|
611 | TopStack := Base - 1;
|
---|
612 | ProgramCounter := DataStore[TopStack + 3];
|
---|
613 | Base := DataStore[TopStack + 2];
|
---|
614 | end;
|
---|
615 | opNegative: DataStore[TopStack] := -DataStore[TopStack];
|
---|
616 | opAdd: begin
|
---|
617 | TopStack := TopStack - 1;
|
---|
618 | DataStore[TopStack] := DataStore[TopStack] + DataStore[TopStack + 1];
|
---|
619 | end;
|
---|
620 | opSubtract: begin
|
---|
621 | TopStack := TopStack - 1;
|
---|
622 | DataStore[TopStack] := DataStore[TopStack] - DataStore[TopStack + 1];
|
---|
623 | end;
|
---|
624 | opMultiply: begin
|
---|
625 | TopStack := TopStack - 1;
|
---|
626 | DataStore[TopStack] := DataStore[TopStack] * DataStore[TopStack + 1];
|
---|
627 | end;
|
---|
628 | opDivide: begin
|
---|
629 | TopStack := TopStack - 1;
|
---|
630 | DataStore[TopStack] := DataStore[TopStack] div DataStore[TopStack + 1];
|
---|
631 | end;
|
---|
632 | opOdd: DataStore[TopStack] := Ord(Odd(DataStore[TopStack]));
|
---|
633 | opEqual: begin
|
---|
634 | TopStack := TopStack - 1;
|
---|
635 | DataStore[TopStack] := Ord(DataStore[TopStack] = DataStore[TopStack + 1]);
|
---|
636 | end;
|
---|
637 | opNotEqual: begin
|
---|
638 | TopStack := TopStack - 1;
|
---|
639 | DataStore[TopStack] := Ord(DataStore[TopStack] <> DataStore[TopStack + 1]);
|
---|
640 | end;
|
---|
641 | opLess: begin
|
---|
642 | TopStack := TopStack - 1;
|
---|
643 | DataStore[TopStack] := Ord(DataStore[TopStack] < DataStore[TopStack + 1]);
|
---|
644 | end;
|
---|
645 | opGreaterOrEqual: begin
|
---|
646 | TopStack := TopStack - 1;
|
---|
647 | DataStore[TopStack] := Ord(DataStore[TopStack] >= DataStore[TopStack + 1]);
|
---|
648 | end;
|
---|
649 | opGreater: begin
|
---|
650 | TopStack := TopStack - 1;
|
---|
651 | DataStore[TopStack] := Ord(DataStore[TopStack] > DataStore[TopStack + 1]);
|
---|
652 | end;
|
---|
653 | opLessOrEqual: begin
|
---|
654 | TopStack := TopStack - 1;
|
---|
655 | DataStore[TopStack] := Ord(DataStore[TopStack] <= DataStore[TopStack + 1]);
|
---|
656 | end;
|
---|
657 | end;
|
---|
658 | fnLoadVariable: begin
|
---|
659 | TopStack := TopStack + 1;
|
---|
660 | DataStore[TopStack] := DataStore[GetBaseDown(Level) + Address];
|
---|
661 | end;
|
---|
662 | fnStoreVariable: begin
|
---|
663 | DataStore[GetBaseDown(Level) + Address] := DataStore[TopStack];
|
---|
664 | //WriteLn(DataStore[TopStack]);
|
---|
665 | TopStack := TopStack - 1;
|
---|
666 | end;
|
---|
667 | fnCall: begin {generate new ParseBlock mark}
|
---|
668 | DataStore[TopStack + 1] := GetBaseDown(Level);
|
---|
669 | DataStore[TopStack + 2] := Base;
|
---|
670 | DataStore[TopStack + 3] := ProgramCounter;
|
---|
671 | Base := TopStack + 1;
|
---|
672 | ProgramCounter := Address;
|
---|
673 | end;
|
---|
674 | fnIncrementTopStack: TopStack := TopStack + Address;
|
---|
675 | fnJump: ProgramCounter := Address;
|
---|
676 | fnJumpConditional: begin
|
---|
677 | if DataStore[TopStack] = 0 then ProgramCounter := Address;
|
---|
678 | TopStack := TopStack - 1;
|
---|
679 | end;
|
---|
680 | fnWrite: Write(DataStore[GetBaseDown(Level) + Address]:0, ' ');
|
---|
681 | fnRead: ReadLn(DataStore[GetBaseDown(Level) + Address]);
|
---|
682 | end;
|
---|
683 | until ProgramCounter = 0;
|
---|
684 | Write(' end pl/0');
|
---|
685 | end;
|
---|
686 |
|
---|
687 | procedure Init;
|
---|
688 | begin
|
---|
689 | for LastChar := Chr(0) to Chr(255) do
|
---|
690 | SingleCharSymbols[LastChar] := skNul;
|
---|
691 | ReservedWords[1] := 'begin ';
|
---|
692 | ReservedWords[2] := 'call ';
|
---|
693 | ReservedWords[3] := 'const ';
|
---|
694 | ReservedWords[4] := 'do ';
|
---|
695 | ReservedWords[5] := 'end ';
|
---|
696 | ReservedWords[6] := 'if ';
|
---|
697 | ReservedWords[7] := 'odd ';
|
---|
698 | ReservedWords[8] := 'procedure ';
|
---|
699 | ReservedWords[9] := 'then ';
|
---|
700 | ReservedWords[10] := 'var ';
|
---|
701 | ReservedWords[11] := 'while ';
|
---|
702 | WordSymbols[1] := skBegin;
|
---|
703 | WordSymbols[2] := skCall;
|
---|
704 | WordSymbols[3] := skConst;
|
---|
705 | WordSymbols[4] := skDo;
|
---|
706 | WordSymbols[5] := skEnd;
|
---|
707 | WordSymbols[6] := skIf;
|
---|
708 | WordSymbols[7] := skOdd;
|
---|
709 | WordSymbols[8] := skProcedure;
|
---|
710 | WordSymbols[9] := skThen;
|
---|
711 | WordSymbols[10] := skVar;
|
---|
712 | WordSymbols[11] := skWhile;
|
---|
713 | SingleCharSymbols['+'] := skPlus;
|
---|
714 | SingleCharSymbols['-'] := skMinus;
|
---|
715 | SingleCharSymbols['*'] := skTimes;
|
---|
716 | SingleCharSymbols['/'] := skSlash;
|
---|
717 | SingleCharSymbols['('] := skLeftParenthesis;
|
---|
718 | SingleCharSymbols[')'] := skRightParenthesis;
|
---|
719 | SingleCharSymbols['='] := skEqual;
|
---|
720 | SingleCharSymbols[','] := skComma;
|
---|
721 | SingleCharSymbols['.'] := skPeriod;
|
---|
722 | SingleCharSymbols['#'] := skNotEqual;
|
---|
723 | SingleCharSymbols['<'] := skLess;
|
---|
724 | SingleCharSymbols['>'] := skGreater;
|
---|
725 | SingleCharSymbols[';'] := skSemicolon;
|
---|
726 | SingleCharSymbols['!'] := skWrite;
|
---|
727 | SingleCharSymbols['?'] := skRead;
|
---|
728 | Mnemonic[fnLoadConstant] := ' lit';
|
---|
729 | Mnemonic[fnOperation] := ' opr';
|
---|
730 | Mnemonic[fnLoadVariable] := ' lod';
|
---|
731 | Mnemonic[fnStoreVariable] := ' sto';
|
---|
732 | Mnemonic[fnCall] := ' cal';
|
---|
733 | Mnemonic[fnIncrementTopStack] := ' int';
|
---|
734 | Mnemonic[fnJump] := ' jmp';
|
---|
735 | Mnemonic[fnJumpConditional] := ' jpc';
|
---|
736 | Mnemonic[fnWrite] := ' wri';
|
---|
737 | Mnemonic[fnRead] := ' rea';
|
---|
738 | DeclarationBeginSymbolSet := [skConst, skVar, skProcedure];
|
---|
739 | StatementBeginSymbolSet := [skBegin, skCall, skIf, skWhile];
|
---|
740 | FactorBeginSymbolSet := [skIdentifier, skNumber, skLeftParenthesis];
|
---|
741 | Page(output);
|
---|
742 | ErrorCount := 0;
|
---|
743 | CharacterCount := 0;
|
---|
744 | CodeAllocationIndex := 0;
|
---|
745 | LineLength := 0;
|
---|
746 | LastChar := ' ';
|
---|
747 | end;
|
---|
748 |
|
---|
749 | begin
|
---|
750 | if ParamCount > 0 then begin
|
---|
751 | WriteLn(ParamStr(1));
|
---|
752 | Assign(SourceFile, ParamStr(1));
|
---|
753 | Reset(SourceFile);
|
---|
754 | end else SourceFile := Input;
|
---|
755 | Init;
|
---|
756 | ParseProgram;
|
---|
757 | Close(SourceFile);
|
---|
758 | if ErrorCount = 0 then Interpret
|
---|
759 | else Write(ErrorCount, ' errors in pl/0 program');
|
---|
760 | 99: WriteLn;
|
---|
761 | end.
|
---|