source: trunk/compiler.pas

Last change on this file was 2, checked in by chronos, 7 years ago
  • Fixed: >= and <= operators.
  • Added: Read source code from file supplied as command line parameter.
File size: 23.9 KB
Line 
1program compiler(input, output);
2
3{pl/0 compiler with code generation}
4label
5 99;
6
7const
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
16type
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
69var
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
90procedure Error(ErrorCode: TError);
91begin
92 WriteLn(' ****', ' ': CharacterCount - 1, '^', Integer(ErrorCode): 2);
93 ErrorCount := ErrorCount + 1;
94end;
95
96procedure GetCharacter;
97begin
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];
121end;
122
123function SearchReservedWord(Identifier: TIdentifier): Integer;
124var
125 I: Integer;
126 J: Integer;
127 K: Integer;
128begin
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;
138end;
139
140
141procedure GetSymbol;
142var
143 I, K: Integer;
144 Identifier: TIdentifier;
145 kk: Integer;
146begin
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;
205end;
206
207procedure Generate(AFunc: TFunction; ALevel, AAddress: Integer);
208begin
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;
219end;
220
221procedure Test(s1, s2: TSymbolSet; ErrorCode: TError);
222begin
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;
229end;
230
231function SearchSymbol(Identifier: TIdentifier; SymbolTableIndex: Integer): Integer;
232var
233 I: Integer;
234begin
235 SymbolTable[0].Name := Identifier;
236 I := SymbolTableIndex;
237 while SymbolTable[I].Name <> Identifier do I := I - 1;
238 SearchSymbol := I;
239end;
240
241procedure AddSymbol(var Block: TBlock; AObjectKind: TObjectKind);
242begin
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;
263end;
264
265procedure ParseConstDeclaration(var Block: TBlock);
266begin
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);
278end;
279
280procedure ParseVarDeclaration(var Block: TBlock);
281begin
282 if LastSymbol = skIdentifier then begin
283 AddSymbol(Block, okVariable);
284 GetSymbol;
285 end else Error(erExpectedIdentifier);
286end;
287
288procedure ListGeneratedCode(var Block: TBlock);
289var
290 I: Integer;
291begin
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);
295end;
296
297procedure ParseExpression(var Block: TBlock; SymbolSet: TSymbolSet); forward;
298
299procedure ParseFactor(var Block: TBlock; SymbolSet: TSymbolSet);
300var
301 I: Integer;
302begin
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;
333end;
334
335procedure ParseTerm(var Block: TBlock; SymbolSet: TSymbolSet);
336var
337 MultiplyOperation: TSymbolKind;
338begin
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;
347end;
348
349procedure ParseExpression(var Block: TBlock; SymbolSet: TSymbolSet);
350var
351 AddOperation: TSymbolKind;
352begin
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;
368end;
369
370procedure ParseCondition(var Block: TBlock; SymbolSet: TSymbolSet);
371var
372 RelationOperation: TSymbolKind;
373begin
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;
399end;
400
401procedure ParseStatement(var Block: TBlock; SymbolSet: TSymbolSet);
402var
403 I, cx1, cx2: Integer;
404begin
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);
495end;
496
497procedure ParseBlock(Level, SymbolTableIndex: Integer; SymbolSet: TSymbolSet);
498var
499 Block: TBlock;
500begin
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);
560end;
561
562procedure ParseProgram;
563begin
564 GetSymbol;
565 ParseBlock(0, 0, [skPeriod] + DeclarationBeginSymbolSet + StatementBeginSymbolSet);
566 if LastSymbol <> skPeriod then Error(erMissingPeriod);
567end;
568
569procedure Interpret;
570const
571 StackSize = 500;
572var
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
592begin
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');
685end;
686
687procedure Init;
688begin
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 := ' ';
747end;
748
749begin
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;
761end.
Note: See TracBrowser for help on using the repository browser.