- Timestamp:
- May 19, 2019, 1:23:18 PM (6 years ago)
- Location:
- trunk
- Files:
-
- 1 added
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk
-
Property svn:ignore
set to
lib
compiler
compiler.lps
-
Property svn:ignore
set to
-
trunk/Examples/Square.pas
r1 r2 8 8 begin 9 9 x := 1; 10 while x [10 do10 while x <= 10 do 11 11 begin 12 12 call square; 13 ! 13 !squ; 14 14 x := x + 1 15 15 end -
trunk/compiler.pas
r1 r2 74 74 CharacterCount: Integer; 75 75 LineLength: Integer; 76 kk: Integer;77 76 ErrorCount: Integer; 78 77 CodeAllocationIndex: Integer; 79 78 Line: array [1..81] of Char; 80 a: TIdentifier;81 79 Code: array [0..MaxCodeIndex] of TInstruction; 82 80 ReservedWords: array [1..ReservedWordsCount] of TIdentifier; … … 88 86 FactorBeginSymbolSet: TSymbolSet; 89 87 SymbolTable: array [0..IdentifierTableSize] of TSymbol; 88 SourceFile: Text; 90 89 91 90 procedure Error(ErrorCode: TError); … … 98 97 begin 99 98 if CharacterCount = LineLength then begin 100 if Eof( Input) then begin99 if Eof(SourceFile) then begin 101 100 Write(' program incomplete'); 102 101 goto 99; … … 105 104 CharacterCount := 0; 106 105 Write(CodeAllocationIndex: 5, ' '); 107 while not Eoln( Input) do begin106 while not Eoln(SourceFile) do begin 108 107 LineLength := LineLength + 1; 109 Read( LastChar);108 Read(SourceFile, LastChar); 110 109 Write(LastChar); 110 if LastChar in ['A'..'Z'] then 111 LastChar := Chr(Ord(LastChar) - Ord('A') + Ord('a')); 111 112 Line[LineLength] := LastChar; 112 113 end; 113 114 WriteLn; 114 ReadLn ;115 ReadLn(SourceFile); 115 116 LineLength := LineLength + 1; 116 117 Line[LineLength] := ' '; … … 120 121 end; 121 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 122 141 procedure GetSymbol; 123 142 var 124 i, j, k: Integer; 143 I, K: Integer; 144 Identifier: TIdentifier; 145 kk: Integer; 125 146 begin 126 147 while LastChar = ' ' do GetCharacter; 127 148 if LastChar in ['a'..'z'] then begin 128 149 {identifier or reserved ReservedWords} 129 k:= 0;150 K := 0; 130 151 repeat 131 if k< MaxIdentifierLength then begin132 k := k+ 1;133 a[k] := LastChar;152 if K < MaxIdentifierLength then begin 153 K := K + 1; 154 Identifier[K] := LastChar; 134 155 end; 135 156 GetCharacter; 136 157 until not (LastChar in ['a'..'z', '0'..'9']); 137 if k >= kk then kk := k 158 kk := MaxIdentifierLength; 159 if K >= kk then kk := K 138 160 else repeat 139 a[kk] := ' ';161 Identifier[kk] := ' '; 140 162 kk := kk - 1 141 until kk = k; 142 LastIdentifier := a; 143 i := 1; 144 j := ReservedWordsCount; 145 repeat 146 k := (i + j) div 2; 147 if LastIdentifier <= ReservedWords[k] then j := k - 1; 148 if LastIdentifier >= ReservedWords[k] then i := k + 1; 149 until i > j; 150 if i - 1 > j then LastSymbol := WordSymbols[k] 163 until kk = K; 164 LastIdentifier := Identifier; 165 I := SearchReservedWord(Identifier); 166 if I > 0 then LastSymbol := WordSymbols[I] 151 167 else LastSymbol := skIdentifier; 152 168 end else 153 169 if LastChar in ['0'..'9'] then begin 154 170 {skNumber} 155 k:= 0;171 K := 0; 156 172 LastNumber := 0; 157 173 LastSymbol := skNumber; 158 174 repeat 159 175 LastNumber := 10 * LastNumber + (Ord(LastChar) - Ord('0')); 160 k := k+ 1;176 K := K + 1; 161 177 GetCharacter 162 178 until not (LastChar in ['0'..'9']); 163 if k> MaxNumberDigitsCount then Error(erNumberOutOfRange);179 if K > MaxNumberDigitsCount then Error(erNumberOutOfRange); 164 180 end else 165 181 if LastChar = ':' then begin … … 173 189 LastSymbol := SingleCharSymbols[LastChar]; 174 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; 175 204 end; 176 205 end; … … 259 288 procedure ListGeneratedCode(var Block: TBlock); 260 289 var 261 i: Integer;262 begin 263 for i:= Block.InitialCodeIndex to CodeAllocationIndex - 1 do264 with Code[ i] do265 WriteLn( i: 5, Mnemonic[Func]: 5, 1: 3, Address: 5);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); 266 295 end; 267 296 … … 285 314 end; 286 315 GetSymbol; 287 end 288 else 316 end else 289 317 if LastSymbol = skNumber then begin 290 318 if LastNumber > MaxAddress then begin … … 294 322 Generate(fnLoadConstant, 0, LastNumber); 295 323 GetSymbol; 296 end 297 else 324 end else 298 325 if LastSymbol = skLeftParenthesis then begin 299 326 GetSymbol; … … 308 335 procedure ParseTerm(var Block: TBlock; SymbolSet: TSymbolSet); 309 336 var 310 Operation: TSymbolKind;337 MultiplyOperation: TSymbolKind; 311 338 begin 312 339 ParseFactor(Block, SymbolSet + [skTimes, skSlash]); 313 while LastSymbol in [skTimes, skSlash] do 314 begin 315 Operation := LastSymbol; 340 while LastSymbol in [skTimes, skSlash] do begin 341 MultiplyOperation := LastSymbol; 316 342 GetSymbol; 317 343 ParseFactor(Block, SymbolSet + [skTimes, skSlash]); 318 if Operation = skTimes then Generate(fnOperation, 0, Integer(opMultiply))344 if MultiplyOperation = skTimes then Generate(fnOperation, 0, Integer(opMultiply)) 319 345 else Generate(fnOperation, 0, Integer(opDivide)); 320 346 end; … … 323 349 procedure ParseExpression(var Block: TBlock; SymbolSet: TSymbolSet); 324 350 var 325 addop: TSymbolKind;351 AddOperation: TSymbolKind; 326 352 begin 327 353 if LastSymbol in [skPlus, skMinus] then begin 328 addop:= LastSymbol;354 AddOperation := LastSymbol; 329 355 GetSymbol; 330 356 ParseTerm(Block, SymbolSet + [skPlus, skMinus]); 331 if addop= skMinus then357 if AddOperation = skMinus then 332 358 Generate(fnOperation, 0, Integer(opNegative)); 333 end 334 else 359 end else 335 360 ParseTerm(Block, SymbolSet + [skPlus, skMinus]); 336 while LastSymbol in [skPlus, skMinus] do 337 begin 338 addop := LastSymbol; 361 while LastSymbol in [skPlus, skMinus] do begin 362 AddOperation := LastSymbol; 339 363 GetSymbol; 340 364 ParseTerm(Block, SymbolSet + [skPlus, skMinus]); 341 if addop = skPlus then 342 Generate(fnOperation, 0, Integer(opAdd)) 343 else 344 Generate(fnOperation, 0, Integer(opSubtract)); 365 if AddOperation = skPlus then Generate(fnOperation, 0, Integer(opAdd)) 366 else Generate(fnOperation, 0, Integer(opSubtract)); 345 367 end; 346 368 end; … … 348 370 procedure ParseCondition(var Block: TBlock; SymbolSet: TSymbolSet); 349 371 var 350 relop: TSymbolKind;372 RelationOperation: TSymbolKind; 351 373 begin 352 374 if LastSymbol = skOdd then begin … … 362 384 else 363 385 begin 364 relop:= LastSymbol;386 RelationOperation := LastSymbol; 365 387 GetSymbol; 366 388 ParseExpression(Block, SymbolSet); 367 case relopof389 case RelationOperation of 368 390 skEqual: Generate(fnOperation, 0, Integer(opEqual)); 369 391 skNotEqual: Generate(fnOperation, 0, Integer(opNotEqual)); 370 392 skLess: Generate(fnOperation, 0, Integer(opLess)); 371 skGreaterOrEqual: Generate(fnOperation, 0, Integer(opGreater ));372 skGreater: Generate(fnOperation, 0, Integer(opGreater OrEqual));393 skGreaterOrEqual: Generate(fnOperation, 0, Integer(opGreaterOrEqual)); 394 skGreater: Generate(fnOperation, 0, Integer(opGreater)); 373 395 skLessOrEqual: Generate(fnOperation, 0, Integer(opLessOrEqual)); 374 396 end; … … 379 401 procedure ParseStatement(var Block: TBlock; SymbolSet: TSymbolSet); 380 402 var 381 i, cx1, cx2: Integer;403 I, cx1, cx2: Integer; 382 404 begin 383 405 if LastSymbol = skIdentifier then begin 384 i:= SearchSymbol(LastIdentifier, Block.SymbolTableIndex);385 if i= 0 then Error(erSymbolNotFound)406 I := SearchSymbol(LastIdentifier, Block.SymbolTableIndex); 407 if I = 0 then Error(erSymbolNotFound) 386 408 else 387 if SymbolTable[ i].ObjectKind <> okVariable then begin409 if SymbolTable[I].ObjectKind <> okVariable then begin 388 410 Error(erAssignmentToNonVariable); 389 i:= 0;411 I := 0; 390 412 end; 391 413 GetSymbol; … … 393 415 else Error(erExpectedEqualOperator); 394 416 ParseExpression(Block, SymbolSet); 395 if i<> 0 then396 with SymbolTable[ i] do417 if I <> 0 then 418 with SymbolTable[I] do 397 419 Generate(fnStoreVariable, Block.Level - Level, Address); 398 420 end else … … 401 423 if LastSymbol <> skIdentifier then Error(erExpectedProcedureName) 402 424 else begin 403 i:= SearchSymbol(LastIdentifier, Block.SymbolTableIndex);404 if i= 0 then Error(erSymbolNotFound)425 I := SearchSymbol(LastIdentifier, Block.SymbolTableIndex); 426 if I = 0 then Error(erSymbolNotFound) 405 427 else 406 with SymbolTable[ i] do428 with SymbolTable[I] do 407 429 if ObjectKind = okProcedure then Generate(fnCall, Block.Level - Level, Address) 408 430 else Error(erIdentifierIsNotProcedureName); … … 414 436 if LastSymbol <> skIdentifier then Error(erExpectedIdentifier) 415 437 else begin 416 i:= SearchSymbol(LastIdentifier, Block.SymbolTableIndex);417 if i= 0 then Error(erSymbolNotFound)438 I := SearchSymbol(LastIdentifier, Block.SymbolTableIndex); 439 if I = 0 then Error(erSymbolNotFound) 418 440 else 419 with SymbolTable[ i] do441 with SymbolTable[I] do 420 442 if ObjectKind = okVariable then Generate(fnWrite, Block.Level - Level, Address) 421 443 else Error(erExpectedVariableName); … … 427 449 if LastSymbol <> skIdentifier then Error(erExpectedIdentifier) 428 450 else begin 429 i:= SearchSymbol(LastIdentifier, Block.SymbolTableIndex);430 if i= 0 then Error(erSymbolNotFound)451 I := SearchSymbol(LastIdentifier, Block.SymbolTableIndex); 452 if I = 0 then Error(erSymbolNotFound) 431 453 else 432 with SymbolTable[ i] do454 with SymbolTable[I] do 433 455 if ObjectKind = okVariable then Generate(fnRead, Block.Level - Level, Address) 434 456 else Error(erExpectedVariableName); … … 554 576 Instruction: TInstruction; 555 577 DataStore: array [1..StackSize] of Integer; 578 X: Char; 556 579 557 580 function GetBaseDown(Levels: Integer): Integer; … … 607 630 DataStore[TopStack] := DataStore[TopStack] div DataStore[TopStack + 1]; 608 631 end; 609 opOdd: DataStore[TopStack] := Ord( odd(DataStore[TopStack]));632 opOdd: DataStore[TopStack] := Ord(Odd(DataStore[TopStack])); 610 633 opEqual: begin 611 634 TopStack := TopStack - 1; … … 656 679 end; 657 680 fnWrite: Write(DataStore[GetBaseDown(Level) + Address]:0, ' '); 658 fnRead: Read (DataStore[GetBaseDown(Level) + Address]);681 fnRead: ReadLn(DataStore[GetBaseDown(Level) + Address]); 659 682 end; 660 683 until ProgramCounter = 0; … … 700 723 SingleCharSymbols['<'] := skLess; 701 724 SingleCharSymbols['>'] := skGreater; 702 SingleCharSymbols['['] := skLessOrEqual;703 SingleCharSymbols[']'] := skGreaterOrEqual;704 725 SingleCharSymbols[';'] := skSemicolon; 705 726 SingleCharSymbols['!'] := skWrite; … … 724 745 LineLength := 0; 725 746 LastChar := ' '; 726 kk := MaxIdentifierLength; 727 end; 728 729 begin 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; 730 755 Init; 731 756 ParseProgram; 757 Close(SourceFile); 732 758 if ErrorCount = 0 then Interpret 733 759 else Write(ErrorCount, ' errors in pl/0 program');
Note:
See TracChangeset
for help on using the changeset viewer.