Changeset 38 for trunk/Compiler/UCompiler.pas
- Timestamp:
- Feb 25, 2012, 6:04:21 PM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Compiler/UCompiler.pas
r20 r38 6 6 7 7 uses 8 SysUtils, Variants, Classes, Contnrs, UAnalyzers, UProducers, 9 Dialogs, USourceCode, UProducer, UAnalyzer ;8 SysUtils, Variants, Classes, Contnrs, UAnalyzers, UProducers, FileUtil, 9 Dialogs, USourceCode, UProducer, UAnalyzer, SpecializedList; 10 10 11 11 type … … 36 36 FOnErrorMessage: TErrorMessageEvent; 37 37 FProducerType: TProducerType; 38 FProducer: TProducer; 39 function GetSource(Name: string; var SourceCode: string): Boolean; 38 40 procedure ErrorMessage(Text: string; Position: TPoint; FileName: string); 39 41 procedure SetAnalyzer(const AValue: TAnalyzer); 42 procedure SetProducer(AValue: TProducer); 43 procedure AnalyzeAll; 44 procedure ProduceAll; 40 45 public 41 ProgramCode: TProgram; 42 Producer: TProducer; 43 ErrorMessages: TObjectList; 46 AbstractCode: TProgram; 47 ErrorMessages: TListObject; 44 48 CompiledFolder: string; 45 49 SupportedTargets: TCompilerTargetList; … … 48 52 Producers: TListProducer; 49 53 Analyzers: TListAnalyzer; 54 SourceFiles: TListString; 50 55 constructor Create; 51 56 destructor Destroy; override; 52 57 procedure Init; 53 procedure Compile (ModuleName: string; Source: TStringList);58 procedure Compile; 54 59 property OnErrorMessage: TErrorMessageEvent read FOnErrorMessage 55 60 write FOnErrorMessage; 56 61 property Analyzer: TAnalyzer read FAnalyzer write SetAnalyzer; 62 property Producer: TProducer read FProducer write SetProducer; 57 63 end; 58 64 59 65 implementation 60 66 67 resourcestring 68 SNothingToAnalyze = 'Nothing to analyze'; 69 61 70 { TCompiler } 62 71 63 procedure TCompiler.Compile(ModuleName: string; Source: TStringList); 64 var 65 NewModule: TModule; 66 ProducedCode: TStringList; 67 I: Integer; 68 TargetFileName: string; 69 begin 70 try 71 ProducedCode := TStringList.Create; 72 Analyzer.FileName := ModuleName; 73 Analyzer.SourceCode := Source.Text; 74 Analyzer.Process; 75 //ShowMessage(IntToHex(Integer(Addr(Analyzer.OnGetSource)), 8)); 76 Analyzer.ParseModule(ProgramCode); 77 with ProgramCode do 78 for I := 0 to Modules.Count - 1 do begin 79 Producer.Produce(TModule(Modules[I])); 80 Producer.AssignToStringList(ProducedCode); 81 TargetFileName := TargetFolder + DirectorySeparator + 82 CompiledFolder + DirectorySeparator + Producer.Name + 83 DirectorySeparator + TModule(Modules[I]).TargetFile; 84 ForceDirectories(ExtractFileDir(TargetFileName)); 85 ProducedCode.SaveToFile(TargetFileName); 86 end; 87 finally 88 ProducedCode.Free; 89 end; 72 procedure TCompiler.Compile; 73 begin 74 AnalyzeAll; 75 ProduceAll; 90 76 end; 91 77 … … 94 80 Analyzers := TListAnalyzer.Create; 95 81 Producers := TListProducer.Create; 82 SourceFiles := TListString.Create; 96 83 97 84 RegisterAnalyzers(Self); … … 106 93 SupportedTargets.Add('Dallas', 'DS89C450', '8052'); 107 94 108 ProgramCode := TProgram.Create;95 AbstractCode := TProgram.Create; 109 96 Producer := nil; 110 97 Analyzer := nil; 111 ErrorMessages := T ObjectList.Create;98 ErrorMessages := TListObject.Create; 112 99 CompiledFolder := 'Compiled'; 113 100 end; … … 116 103 begin 117 104 ErrorMessages.Clear; 118 ProgramCode.Modules.Clear;105 AbstractCode.Modules.Clear; 119 106 end; 120 107 121 108 destructor TCompiler.Destroy; 122 109 begin 123 ProgramCode.Free;110 AbstractCode.Free; 124 111 Analyzers.Free; 125 112 Producers.Free; 126 113 ErrorMessages.Free; 127 114 SupportedTargets.Free; 115 SourceFiles.Free; 116 end; 117 118 function TCompiler.GetSource(Name: string; var SourceCode: string): Boolean; 119 var 120 I: Integer; 121 F: TFileStream; 122 begin 123 I := 0; 124 while (I < SourceFiles.Count) and (ExtractFileNameOnly(SourceFiles[I]) <> Name) do Inc(I); 125 if I < SourceFiles.Count then begin 126 if FileExistsUTF8(SourceFiles[I]) then 127 try 128 F := TFileStream.Create(UTF8Decode(SourceFiles[I]), fmOpenRead); 129 SetLength(SourceCode, F.Size); 130 if F.Size > 0 then 131 F.Read(SourceCode[1], F.Size); 132 Result := True; 133 finally 134 F.Free; 135 end else Result := False; 136 end else Result := False; 128 137 end; 129 138 … … 144 153 if FAnalyzer = AValue then exit; 145 154 FAnalyzer := AValue; 146 if Assigned(Analyzer) then 155 if Assigned(Analyzer) then begin 147 156 Analyzer.OnErrorMessage := ErrorMessage; 157 Analyzer.OnGetSource := GetSource; 158 end; 159 end; 160 161 procedure TCompiler.SetProducer(AValue: TProducer); 162 begin 163 if FProducer = AValue then Exit; 164 FProducer := AValue; 165 end; 166 167 procedure TCompiler.AnalyzeAll; 168 begin 169 if SourceFiles.Count > 0 then begin 170 Analyzer.FileName := SourceFiles[0]; 171 Analyzer.OnGetSource(ExtractFileNameOnly(Analyzer.FileName), Analyzer.SourceCode); 172 Analyzer.Process; 173 //ShowMessage(IntToHex(Integer(Addr(Analyzer.OnGetSource)), 8)); 174 Analyzer.ParseModule(AbstractCode); 175 end else raise Exception.Create(SNothingToAnalyze); 176 end; 177 178 procedure TCompiler.ProduceAll; 179 var 180 NewModule: TModule; 181 ProducedCode: TStringList; 182 I: Integer; 183 TargetFileName: string; 184 begin 185 try 186 ProducedCode := TStringList.Create; 187 with AbstractCode do 188 for I := 0 to Modules.Count - 1 do begin 189 Producer.Produce(TModule(Modules[I])); 190 Producer.AssignToStringList(ProducedCode); 191 TargetFileName := TargetFolder + DirectorySeparator + 192 CompiledFolder + DirectorySeparator + Producer.Name + 193 DirectorySeparator + TModule(Modules[I]).TargetFile; 194 ForceDirectoriesUTF8(ExtractFileDir(TargetFileName)); 195 ProducedCode.SaveToFile(TargetFileName); 196 end; 197 finally 198 ProducedCode.Free; 199 end; 148 200 end; 149 201
Note:
See TracChangeset
for help on using the changeset viewer.