Changeset 18
- Timestamp:
- Apr 9, 2009, 11:17:38 AM (16 years ago)
- Files:
-
- 2 added
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Example.pas
r11 r18 1 1 program Test; 2 2 var 3 A: Byte; 3 a: Byte; 4 B: Byte; 4 5 begin 5 A := 'a' + (10 + 2) * 3 xor 10 / 2; 6 A := 'a' + (10 + 2 * 3 + 2) xor 10 / 2; 7 B := 20; 6 8 while A < 10 do A := A + 1; 9 7 10 end; -
trunk/UMainForm.pas
r11 r18 12 12 TModuleType = (mdProgram, mdUnit, mdLibrary, mdPackage); 13 13 14 TInstruction = (inJump, inConditionalJump, inExpressionEvaluation); 15 16 TNodeType = (ntNone, ntVariable, ntMethod, ntConstant, ntOperator); 14 TInstruction = (inNone, inJump, inConditionalJump, inExpressionEvaluation, 15 inReturn); 16 17 TNodeType = (ntNone, ntVariable, nTFunction, ntConstant, ntOperator); 17 18 18 19 TValue = array of Byte; … … 23 24 TConstantList = class; 24 25 TVariableList = class; 25 T MethodList = class;26 TFunctionList = class; 26 27 TExpression = class; 27 28 TOperationList = class; 29 TFunction = class; 28 30 29 31 TDevice = class … … 38 40 Types: TTypeList; 39 41 Variables: TVariableList; 40 Methods: T MethodList;42 Methods: TFunctionList; 41 43 Operations: TOperationList; 42 44 procedure AllocateMemory; … … 48 50 procedure ParseOperation(Compiler: TCompiler); 49 51 procedure GenerateAssembler(Compiler: TCompiler; LabelPrefix: string); 52 procedure CheckReferences; 50 53 end; 51 54 … … 93 96 NodeType: TNodeType; 94 97 Variable: TVariable; 95 Method: T Method;98 Method: TFunction; 96 99 Value: TValue; 97 100 OperatorName: string; … … 108 111 GotoAddress: Integer; 109 112 Negative: Boolean; 113 Referenced: Boolean; 110 114 end; 111 115 … … 114 118 end; 115 119 116 T Method= class(TCommonBlock)120 TFunction = class(TCommonBlock) 117 121 Parameters: TList; // TList<TParameter> 118 122 ResultType: TType; … … 122 126 end; 123 127 124 T MethodList = class(TList)128 TFunctionList = class(TList) 125 129 Parent: TCommonBlock; 126 130 procedure Parse(Compiler: TCompiler); 127 function Search(Name: string): T Method;131 function Search(Name: string): TFunction; 128 132 end; 129 133 … … 137 141 procedure ParseUnit(Compiler: TCompiler); 138 142 procedure ParseProgram(Compiler: TCompiler); 143 procedure Clear; 139 144 end; 140 145 … … 275 280 ProgramCode.Parse(Self); 276 281 ProgramCode.AllocateMemory; 282 AssemblyCode.Clear; 277 283 GenerateAssemblyCode; 278 284 end; … … 438 444 end; 439 445 440 { T Method}441 442 constructor T Method.Create;446 { TFunction } 447 448 constructor TFunction.Create; 443 449 begin 444 450 inherited; … … 447 453 end; 448 454 449 destructor T Method.Destroy;455 destructor TFunction.Destroy; 450 456 begin 451 457 Parameters.Free; … … 454 460 end; 455 461 456 procedure T Method.Parse(Compiler: TCompiler);462 procedure TFunction.Parse(Compiler: TCompiler); 457 463 begin 458 464 with Compiler do begin … … 478 484 Device := TDevice.Create; 479 485 Modules := TList.Create; 486 end; 487 488 destructor TProgram.Destroy; 489 begin 490 491 end; 492 493 procedure TProgram.GenerateAssembler(Compiler: TCompiler); 494 var 495 I: Integer; 496 begin 497 for I := 0 to Modules.Count - 1 do 498 TModule(Modules[I]).GenerateAssembler(Compiler, ''); 499 end; 500 501 procedure TProgram.Parse(Compiler: TCompiler); 502 var 503 I: Integer; 504 begin 505 for I := 0 to Modules.Count - 1 do 506 TModule(Modules[I]).Clear; 507 Modules.Clear; 480 508 with TModule(Modules[Modules.Add(TModule.Create)]) do begin 481 509 Name := 'main'; … … 486 514 end; 487 515 end; 488 end;489 490 destructor TProgram.Destroy;491 begin492 493 end;494 495 procedure TProgram.GenerateAssembler(Compiler: TCompiler);496 var497 I: Integer;498 begin499 for I := 0 to Modules.Count - 1 do500 TModule(Modules[I]).GenerateAssembler(Compiler, '');501 end;502 503 procedure TProgram.Parse(Compiler: TCompiler);504 begin505 516 TModule(Modules[0]).Parse(Compiler); 506 517 end; … … 537 548 538 549 { TModule } 550 551 procedure TModule.Clear; 552 begin 553 Variables.Clear; 554 Constants.Clear; 555 Methods.Clear; 556 Operations.Clear; 557 end; 539 558 540 559 constructor TModule.Create; … … 589 608 end; 590 609 610 procedure TCommonBlock.CheckReferences; 611 var 612 I: Integer; 613 begin 614 for I := 0 to Operations.Count - 1 do 615 with TOperation(Operations[I]) do begin 616 if (Instruction = inJump) or (Instruction = inConditionalJump) then 617 TOperation(Operations[GotoAddress]).Referenced := True; 618 end; 619 end; 620 591 621 constructor TCommonBlock.Create; 592 622 begin … … 597 627 Variables := TVariableList.Create; 598 628 Variables.Parent := Self; 599 Methods := T MethodList.Create;629 Methods := TFunctionList.Create; 600 630 Methods.Parent := Self; 601 631 Operations := TOperationList.Create; … … 615 645 var 616 646 I: Integer; 647 LabelName: string; 617 648 begin 618 649 with Compiler do 619 for I := 0 to Operations.Count - 1 do 650 for I := 0 to Operations.Count - 1 do 620 651 with TOperation(Operations[I]) do begin 652 if Referenced then LabelName := Name + '_L' + IntToStr(I) 653 else LabelName := ''; 621 654 case Instruction of 622 655 inJump: begin 623 AddInstruction( '', 'JMP', Name + '_L' + IntToStr(GotoAddress), '');656 AddInstruction(LabelName, 'JMP', Name + '_L' + IntToStr(GotoAddress), ''); 624 657 end; 625 658 inConditionalJump: begin 626 659 ExpressionTree.GenerateAssembler(Compiler, LabelPrefix + '_L' + IntToStr(GotoAddress)); 627 AddInstruction( '', 'BRCS', Name + '_L' + IntToStr(GotoAddress), '');660 AddInstruction(LabelName, 'BRCS', Name + '_L' + IntToStr(GotoAddress), ''); 628 661 end; 629 662 inExpressionEvaluation: begin 663 if LabelName <> '' then AddInstruction(LabelName, '', '', ''); 630 664 ExpressionTree.GenerateAssembler(Compiler, Name + '_L' + IntToStr(GotoAddress)); 631 665 end; 666 inReturn: 667 AddInstruction(LabelName, 'RET', '', ''); 632 668 end; 633 669 end; … … 652 688 var 653 689 Identifier: string; 654 Variable: TVariable;655 Method: T Method;690 NewVariable: TVariable; 691 Method: TFunction; 656 692 Constant: TConstant; 657 693 // Brackets: Integer; … … 680 716 end else 681 717 if IsIdentificator(Identifier) then begin 682 Variable := Variables.Search(Identifier);683 if Assigned( Variable) then begin718 NewVariable := Variables.Search(Identifier); 719 if Assigned(NewVariable) then begin 684 720 with TExpression(Expressions[Expressions.Count - 1]) do begin 685 721 SubItems[1] := TExpression.Create; 686 722 TExpression(SubItems[1]).NodeType := ntVariable; 687 TExpression(SubItems[1]).Variable := Variable;723 TExpression(SubItems[1]).Variable := NewVariable; 688 724 end; 689 725 with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do begin … … 705 741 Expect(')'); 706 742 end; 707 TExpression(SubItems[1]).NodeType := n tMethod;743 TExpression(SubItems[1]).NodeType := nTFunction; 708 744 TExpression(SubItems[1]).Method := Method; 709 745 end; … … 722 758 SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1]; 723 759 end; 760 end else begin 761 ErrorMessage('Neznámý identifikátor: ' + Identifier); 724 762 end; 725 763 end; … … 769 807 Identifier: string; 770 808 Variable: TVariable; 771 Method: T Method;809 Method: TFunction; 772 810 First: TOperation; 773 811 Second: TOperation; … … 909 947 end; 910 948 Expect('end'); 911 end; 949 with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin 950 Instruction := inReturn; 951 end; 952 end; 953 CheckReferences; 912 954 end; 913 955 … … 1010 1052 end; 1011 1053 1012 { T MethodList }1013 1014 procedure T MethodList.Parse(Compiler: TCompiler);1015 begin 1016 1017 end; 1018 1019 function T MethodList.Search(Name: string): TMethod;1054 { TFunctionList } 1055 1056 procedure TFunctionList.Parse(Compiler: TCompiler); 1057 begin 1058 1059 end; 1060 1061 function TFunctionList.Search(Name: string): TFunction; 1020 1062 var 1021 1063 I: Integer; 1022 1064 begin 1023 1065 I := 0; 1024 while (I < Count) and (T Method(Items[I]).Name <> Name) do Inc(I);1066 while (I < Count) and (TFunction(Items[I]).Name <> Name) do Inc(I); 1025 1067 if I < Count then Result := Items[I] else begin 1026 1068 if Assigned(Parent.Parent) then Result := Parent.Parent.Methods.Search(Name) … … 1045 1087 end; 1046 1088 1047 procedure TExpression.GenerateAssembler(Compiler: TCompiler; 1048 LabelPrefix: string); 1089 procedure TExpression.GenerateAssembler(Compiler: TCompiler; LabelPrefix: string); 1049 1090 var 1050 1091 I: Integer; … … 1053 1094 case NodeType of 1054 1095 ntNone: ; 1055 ntVariable: AddInstruction('', 'CALL', '', '');1056 n tMethod: AddInstruction('', 'CALL', '', '');1096 ntVariable: if Assigned(Variable) then AddInstruction('', 'GETVAR', Variable.Name, ''); 1097 nTFunction: AddInstruction('', 'CALL', Method.Name, ''); 1057 1098 ntConstant: AddInstruction('', 'CONST', '', ''); 1058 1099 ntOperator: begin … … 1084 1125 function TAssemblerLine.AsString: string; 1085 1126 begin 1086 Result := LabelName + ': ' + Instruction + ' ' + Operand1 + ',' + Operand2; 1127 if LabelName = '' then LabelName := #9 else 1128 LabelName := LabelName + ':'#9; 1129 if Operand2 <> '' then Operand1 := Operand1 + ', '; 1130 1131 Result := LabelName + Instruction + ' ' + Operand1 + Operand2; 1087 1132 end; 1088 1133
Note:
See TracChangeset
for help on using the changeset viewer.