TiGcc.dpr 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942
  1. program TiGcc;
  2. uses
  3. Windows, Classes, SysUtils,
  4. ParsingUnit in '..\ParsingUnit.pas',
  5. CalcUnit in '..\CalcUnit.pas',
  6. LinkDLLUnit in '..\LinkDLLUnit.pas',
  7. VersionUnit in '..\VersionUnit.pas';
  8. const
  9. SErrorPrefix = 'TIGCC.EXE: ';
  10. SFileNotFound = '%s: No such file or directory';
  11. SNoFiles = 'No input files';
  12. SRunFailed = 'Program execution failed';
  13. SProgNotFound = 'Installation error: Cannot find %s';
  14. SQuillNotFound = 'File ''Quill.drv'' not found in Bin or Include directory';
  15. SVariableTooLarge = 'Variable size of %ld bytes is too large, unexpectedly';
  16. SUnexpectedMismatch = 'Unexpected destination calculator mismatch';
  17. SLinkDLLNotLoaded = 'Link DLL not loaded';
  18. SNoNewOSUpgradeFiles = 'Support for ''.??u'' files is not implemented; use ''--outputbin''';
  19. procedure ErrorOutput(const Msg: PChar);
  20. var
  21. WriteResult: Cardinal;
  22. begin
  23. WriteFile (GetStdHandle (Std_Error_Handle), Msg^, StrLen (Msg), WriteResult, nil);
  24. end;
  25. procedure Error(const Msg: string = '');
  26. begin
  27. if Length (Msg) > 0 then begin
  28. ErrorOutput (SErrorPrefix);
  29. ErrorOutput (PChar (Msg));
  30. ErrorOutput (#13#10);
  31. end;
  32. end;
  33. procedure Fatal(const Msg: string = '');
  34. begin
  35. raise Exception.Create (Msg);
  36. end;
  37. function LastPos(const Substr, S: string): Integer;
  38. var
  39. I: Integer;
  40. begin
  41. Result := 0;
  42. for I := Length (S) - Length (Substr) + 1 downto 1 do
  43. if Copy (S, I, Length (SubStr)) = Substr then begin
  44. Result := I;
  45. Break;
  46. end;
  47. end;
  48. function GetShortFileName(FileName: string): string;
  49. var
  50. F: TSearchRec;
  51. Found: Boolean;
  52. begin
  53. Result := '';
  54. while Length (FileName) > 2 do begin
  55. FileName := StringReplace (FileName, '/', '\', [rfReplaceAll]);
  56. Found := FindFirst (FileName, faAnyFile, F) = 0;
  57. while Found and ((F.Name = '') or (F.Name = '.') or (F.Name = '..')) do
  58. Found := FindNext (F) = 0;
  59. if Found then begin
  60. if F.FindData.cAlternateFileName <> '' then
  61. Result := F.FindData.cAlternateFileName + '\' + Result
  62. else if Length (F.Name) > 0 then
  63. Result := F.Name + '\' + Result
  64. else
  65. Result := ExtractFileName (FileName) + '\' + Result;
  66. end else
  67. Result := ExtractFileName (FileName) + '\' + Result;
  68. FindClose (F);
  69. Delete (FileName, LastPos ('\', FileName), Length (FileName));
  70. end;
  71. Result := FileName + '\' + Copy (Result, 1, Length (Result) - 1);
  72. end;
  73. function Enquote(const S: string): string;
  74. begin
  75. if Pos (' ', S) > 0 then
  76. Result := '"' + S + '"'
  77. else
  78. Result := S;
  79. end;
  80. procedure InsertOptionString(var Dest: string; Options: string);
  81. var
  82. P: Integer;
  83. begin
  84. Options := Options + ',';
  85. while Length (Options) > 0 do begin
  86. P := Pos (',', Options);
  87. Dest := Dest + ' ' + Enquote (Copy (Options, 1, P - 1));
  88. Delete (Options, 1, P);
  89. end;
  90. end;
  91. procedure OutputText(const S: string);
  92. var
  93. C: Cardinal;
  94. begin
  95. WriteFile (GetStdHandle (Std_Output_Handle), PChar(S)^, Length (S), C, nil);
  96. end;
  97. procedure OutputTextLine(const S: string);
  98. begin
  99. OutputText (S + #13#10);
  100. end;
  101. procedure InsertNewLine;
  102. begin
  103. OutputTextLine ('');
  104. end;
  105. function CreatePPChar(List: TStrings): PPChar;
  106. var
  107. I: Integer;
  108. begin
  109. Result := AllocMem (SizeOf (PPChar) * (List.Count + 1));
  110. for I := 0 to List.Count - 1 do
  111. Result [I] := PChar (List.Strings [I]);
  112. end;
  113. procedure FreePPChar(Param: PPChar);
  114. begin
  115. FreeMem (Param);
  116. end;
  117. procedure TryDeleteFile(const FileName: string);
  118. begin
  119. if FileExists (FileName) then try
  120. DeleteFile (FileName);
  121. except end;
  122. end;
  123. procedure TryDeleteFiles(const FileName, Extension: string);
  124. begin
  125. TryDeleteFile (FileName + '89' + Extension);
  126. TryDeleteFile (FileName + '9x' + Extension);
  127. TryDeleteFile (FileName + 'v2' + Extension);
  128. TryDeleteFile (FileName + Extension + '89');
  129. TryDeleteFile (FileName + Extension + '9x');
  130. TryDeleteFile (FileName + Extension + 'v2');
  131. end;
  132. procedure ParseVarName(const Param: string; var FolderName, VarName: string);
  133. var
  134. P: Integer;
  135. begin
  136. P := Pos ('\', Param);
  137. if P <= 0 then
  138. P := Pos ('/', Param);
  139. if P > 0 then begin
  140. FolderName := LowerCase (Copy (Param, 1, P - 1));
  141. VarName := LowerCase (Copy (Param, P + 1, Length (Param)));
  142. end else
  143. VarName := LowerCase (Param);
  144. end;
  145. var
  146. PrintCommands: Boolean = False;
  147. Verbose: Boolean = False;
  148. Quiet: Boolean = False;
  149. procedure Execute(const CommandLine: string);
  150. var
  151. TempStr: array [0..1] of Char;
  152. WriteResult: Cardinal;
  153. StartupInfo: TStartupInfo;
  154. ProcessInfo: TProcessInformation;
  155. begin
  156. if FileExists (Copy (CommandLine, 1, Pos (' ', CommandLine))) then begin
  157. if PrintCommands then begin
  158. WriteFile (GetStdHandle (Std_Output_Handle), PChar(CommandLine)^, Length (CommandLine), WriteResult, nil);
  159. TempStr[0] := #13;
  160. TempStr[1] := #10;
  161. WriteFile (GetStdHandle (Std_Output_Handle), TempStr, 2, WriteResult, nil);
  162. end;
  163. FillChar (StartupInfo, SizeOf (StartupInfo), 0);
  164. with StartupInfo do begin
  165. cb := SizeOf (StartupInfo);
  166. lpTitle := PChar ('TIGCC');
  167. end;
  168. if CreateProcess (nil, PChar (CommandLine), nil, nil, True, 0, nil, nil, StartupInfo, ProcessInfo) then begin
  169. WaitForSingleObject (ProcessInfo.hProcess, Infinite);
  170. GetExitCodeProcess (ProcessInfo.hProcess, WriteResult);
  171. CloseHandle (ProcessInfo.hProcess);
  172. CloseHandle (ProcessInfo.hThread);
  173. if WriteResult <> 0 then
  174. Fatal;
  175. end else
  176. Fatal (SRunFailed);
  177. end else
  178. Fatal (Format (SProgNotFound, [Copy (CommandLine, 1, Pos (' ', CommandLine))]));
  179. end;
  180. procedure LinkLibErrorMessage(FileName, Text: PChar; MessageType: LongInt); cdecl;
  181. begin
  182. if Assigned (FileName) then begin
  183. ErrorOutput (FileName);
  184. ErrorOutput (': ');
  185. end;
  186. case MessageType of
  187. llmtError:
  188. ErrorOutput ('Error: ');
  189. llmtWarning:
  190. ErrorOutput ('Warning: ');
  191. end;
  192. ErrorOutput (Text);
  193. ErrorOutput (#13#10);
  194. end;
  195. type
  196. TFileRole = (frMain, frData);
  197. TLinkOutputFile = record
  198. Data: TMemoryStream;
  199. Tag: Byte;
  200. VarExt: string;
  201. ExeFile,
  202. OSUpgrade: Boolean;
  203. end;
  204. var
  205. LinkOutputFiles: array [TCalcDest, TFileRole] of TLinkOutputFile;
  206. LinkDebugFile: TLinkOutputFile;
  207. function LinkLibGetOutputFile(var DestFile: TLinkLibDestFile; FileSize, DestCalc, FileRole, FileFormat, FileType: LongInt; Extension: PChar; Executable: WordBool; var EffectiveSize: LongInt): WordBool; cdecl;
  208. var
  209. CalcDest: TCalcDest;
  210. CalcFileRole: TFileRole;
  211. begin
  212. Result := False;
  213. case FileFormat of
  214. llffTIOS:
  215. EffectiveSize := 2 + FileSize + 1;
  216. llffTIOSUpgrade:
  217. EffectiveSize := FileSize + SizeOF (TCalcOSFooter);
  218. llffGDBCOFF:
  219. begin
  220. EffectiveSize := FileSize;
  221. with LinkDebugFile do begin
  222. if not Assigned (Data) then
  223. Data := TMemoryStream.Create;
  224. Data.Size := FileSize;
  225. DestFile.Data := Data.Memory;
  226. end;
  227. Result := True;
  228. Exit;
  229. end;
  230. else
  231. Exit;
  232. end;
  233. case DestCalc of
  234. llcdTI89: CalcDest := cdTI89;
  235. llcdTI89 or llcdFlagTitanium: CalcDest := cdTI89Titanium;
  236. llcdTI92Plus: CalcDest := cdTI92Plus;
  237. llcdV200: CalcDest := cdV200;
  238. llcdTI92: CalcDest := cdTI92;
  239. else
  240. Exit;
  241. end;
  242. case FileRole of
  243. llfrMain: CalcFileRole := frMain;
  244. llfrData: CalcFileRole := frData;
  245. else
  246. Exit;
  247. end;
  248. with LinkOutputFiles [CalcDest, CalcFileRole] do begin
  249. if not Assigned (Data) then
  250. Data := TMemoryStream.Create;
  251. Data.Size := FileSize;
  252. DestFile.Data := Data.Memory;
  253. Tag := FileType;
  254. if Assigned (Extension) then begin
  255. VarExt := Extension;
  256. Inc (EffectiveSize, Length (VarExt) + 2);
  257. end else
  258. VarExt := '';
  259. ExeFile := Executable;
  260. OSUpgrade := (FileFormat = llffTIOSUpgrade);
  261. end;
  262. Result := True;
  263. end;
  264. var
  265. ProgPath: string;
  266. LinkLibHandle: HModule;
  267. LinkLibGetInterfaceVersion: TLinkLibGetInterfaceVersion;
  268. LinkLibLinkFiles: TLinkLibLinkFiles;
  269. LinkLibCreateArchive: TLinkLibCreateArchive;
  270. OutputBin: Boolean = False;
  271. DelFiles: TStringList;
  272. procedure HandleContents(const DestFile, FolderName, VarName, DataFolderName, DataVarName: string; Pack: Boolean; const PackVar: string; CalcDest: TCalcDest);
  273. var
  274. InputStream,
  275. OutputStream: TMemoryStream;
  276. OutputSize: LongWord;
  277. FileSize: Integer;
  278. F: file;
  279. B: Byte;
  280. PackSwitches: string;
  281. begin
  282. with LinkOutputFiles [CalcDest, frMain] do
  283. if Assigned (Data) then begin
  284. OutputStream := TMemoryStream.Create;
  285. try
  286. if OSUpgrade then begin
  287. OutputStream.Size := GetOSUpgradeFileSize (Data.Size, OutputBin);
  288. ProduceOSUpgradeFile (OutputStream.Memory, Data.Memory, Data.Size, OutputBin);
  289. OutputStream.SaveToFile (DestFile + GetOSUpgradeFileExt (CalcDest, OutputBin));
  290. end else begin
  291. FileSize := 2 + Data.Size + 1;
  292. if Pack then begin
  293. TryDeleteFile ('tempprog.pck');
  294. AssignFile (F, 'tempprog.bin');
  295. Rewrite (F, 1);
  296. B := (FileSize - 2) shr 8;
  297. BlockWrite (F, B, 1);
  298. B := (FileSize - 2);
  299. BlockWrite (F, B, 1);
  300. BlockWrite (F, Data.Memory^, Data.Size);
  301. B := Tag;
  302. BlockWrite (F, B, 1);
  303. CloseFile (F);
  304. if Verbose then
  305. PackSwitches := '-v'
  306. else if Quiet then
  307. PackSwitches := '-quiet'
  308. else
  309. PackSwitches := '';
  310. Execute (ProgPath + 'BIN\PACK.EXE ' + PackSwitches + ' tempprog.bin tempprog.pck');
  311. InputStream := TMemoryStream.Create;
  312. with InputStream do try
  313. LoadFromFile ('tempprog.pck');
  314. OutputSize := GetTransferFileSize (Size, 'ppg', OutputBin);
  315. if OutputSize > 0 then begin
  316. OutputStream.Size := OutputSize;
  317. ProduceTransferFile (OutputStream.Memory, Memory, Size, CalcDest, FolderName, PackVar, $F8, 'ppg', OutputBin);
  318. OutputStream.SaveToFile (DestFile + GetTransferFileExt (CalcDest, $F8, OutputBin));
  319. end else
  320. Fatal (Format (SVariableTooLarge, [IntToStr (Size)]));
  321. finally
  322. Free;
  323. end;
  324. DelFiles.Add ('tempprog.bin');
  325. DelFiles.Add ('tempprog.pck');
  326. end else begin
  327. OutputSize := GetTransferFileSize (Data.Size, VarExt, OutputBin);
  328. if OutputSize > 0 then begin
  329. OutputStream.Size := OutputSize;
  330. ProduceTransferFile (OutputStream.Memory, Data.Memory, Data.Size, CalcDest, FolderName, VarName, Tag, VarExt, OutputBin);
  331. OutputStream.SaveToFile (DestFile + GetTransferFileExt (CalcDest, Tag, OutputBin));
  332. end else
  333. Fatal (Format (SVariableTooLarge, [IntToStr (FileSize)]));
  334. end;
  335. end;
  336. finally
  337. OutputStream.Free;
  338. end;
  339. end else
  340. Fatal (SUnexpectedMismatch);
  341. with LinkOutputFiles [CalcDest, frData] do
  342. if Assigned (Data) then begin
  343. FileSize := 2 + Data.Size + 1;
  344. OutputStream := TMemoryStream.Create;
  345. try
  346. OutputSize := GetTransferFileSize (Data.Size, VarExt, OutputBin);
  347. if OutputSize > 0 then begin
  348. OutputStream.Size := OutputSize;
  349. ProduceTransferFile (OutputStream.Memory, Data.Memory, Data.Size, CalcDest, DataFolderName, DataVarName, Tag, VarExt, OutputBin);
  350. OutputStream.SaveToFile (DestFile + '-data' + GetTransferFileExt (CalcDest, Tag, OutputBin));
  351. end else
  352. Fatal (Format (SVariableTooLarge, [IntToStr (FileSize)]));
  353. finally
  354. OutputStream.Free;
  355. end;
  356. end;
  357. end;
  358. procedure HandleDebugContents(const DestFile: string);
  359. begin
  360. with LinkDebugFile do
  361. if Assigned (Data) then
  362. Data.SaveToFile (DestFile + '.dbg');
  363. end;
  364. procedure CreatePackStarter(const DestFile, StarterFileName, FolderName, VarName, PackVar: string; CalcDests: TCalcDests);
  365. var
  366. CurCalcDest: TCalcDest;
  367. ObjectFileNames: array [0..1] of PChar;
  368. DataVarInfo: TLinkLibDataVarInfo;
  369. OptimizeInfo: TLinkLibOptimizeInfo;
  370. begin
  371. ParsePStarter (ProgPath + 'LIB\' + StarterFileName, StarterFileName, PackVar);
  372. ObjectFileNames [0] := PChar (StarterFileName);
  373. ObjectFileNames [1] := nil;
  374. FillChar (DataVarInfo, SizeOf (DataVarInfo), 0);
  375. FillChar (OptimizeInfo, SizeOf (OptimizeInfo), 0);
  376. try
  377. if Assigned (LinkLibLinkFiles) then begin
  378. LinkLibLinkFiles (@ObjectFileNames, nil, LinkLibErrorMessage, LinkLibGetOutputFile, nil, False, False, False, DataVarInfo, OptimizeInfo, False);
  379. for CurCalcDest := cdTI89 to cdV200 do
  380. if CurCalcDest in CalcDests then
  381. HandleContents (DestFile, FolderName, VarName, '', '', False, '', CurCalcDest);
  382. end else
  383. Fatal (SLinkDLLNotLoaded);
  384. DelFiles.Add (StarterFileName);
  385. finally
  386. for CurCalcDest := FirstCalcDest to LastCalcDest do begin
  387. if Assigned (LinkOutputFiles[CurCalcDest,frMain].Data) then
  388. LinkOutputFiles[CurCalcDest,frMain].Data.Free;
  389. if Assigned (LinkOutputFiles[CurCalcDest,frData].Data) then
  390. LinkOutputFiles[CurCalcDest,frData].Data.Free;
  391. LinkOutputFiles[CurCalcDest,frMain].Data := nil;
  392. LinkOutputFiles[CurCalcDest,frData].Data := nil;
  393. end;
  394. end;
  395. end;
  396. var
  397. Assemble: Boolean = True;
  398. Link: Boolean = True;
  399. Archive: Boolean = False;
  400. NativeMode: Boolean = False;
  401. FlashOSMode: Boolean = False;
  402. FargoMode: Boolean = False;
  403. OmitBSSInit: Boolean = False;
  404. DebugInfo: Boolean = False;
  405. Pack: Boolean = False;
  406. StdLib: Boolean = True;
  407. KeepObjectFiles: Boolean = False;
  408. SaveTemps: Boolean = False;
  409. FirstFile: string = '';
  410. DestFile: string = '';
  411. VarName: string = '';
  412. FolderName: string = 'main';
  413. DataVarName: string = '';
  414. DataFolderName: string = '';
  415. PackVarName: string = '';
  416. GCCFiles,
  417. A68kFiles,
  418. ObjectFiles,
  419. ArchiveFiles: TStringList;
  420. A68kDest: Boolean = False;
  421. GCCLine,
  422. AsLine,
  423. A68kLine: string;
  424. DataVar: string = '';
  425. DataVarInfo: TLinkLibDataVarInfo;
  426. OptimizeInfo: TLinkLibOptimizeInfo;
  427. CalcDests: TCalcDests;
  428. CurCalcDest: TCalcDest;
  429. PassOn,
  430. GCCFile: Boolean;
  431. I: Integer;
  432. S,
  433. T: string;
  434. L: TStringList;
  435. ObjectFileArray,
  436. ArchiveFileArray: PPChar;
  437. begin
  438. ParsingUnit.ErrorMessageProc := Error;
  439. FillChar (DataVarInfo, SizeOf (DataVarInfo), 0);
  440. FillChar (OptimizeInfo, SizeOf (OptimizeInfo), 0);
  441. DataVarInfo.CreateCopy := True;
  442. DataVarInfo.CopyOnlyIfArchived := True;
  443. DelFiles := TStringList.Create;
  444. GCCFiles := TStringList.Create;
  445. A68kFiles := TStringList.Create;
  446. ObjectFiles := TStringList.Create;
  447. ArchiveFiles := TStringList.Create;
  448. try
  449. try
  450. if ParamCount <= 0 then
  451. Fatal (SNoFiles);
  452. // Basic command lines
  453. ProgPath := ExtractFilePath (GetShortFileName (ParamStr (0)));
  454. GCCLine := ProgPath + 'BIN\GCC.EXE -B' + ProgPath + 'BIN\ -I ' + ProgPath + 'INCLUDE\C\';
  455. AsLine := ProgPath + 'BIN\AS.EXE -mc68000 -I ' + ProgPath + 'INCLUDE\S\';
  456. A68kLine := ProgPath + 'BIN\A68K.EXE -i' + ProgPath + 'INCLUDE\ASM\ -g -t';
  457. // Parsing of command line arguments
  458. I := 1;
  459. while I <= ParamCount do begin
  460. S := ParamStr (I);
  461. if (Length (S) >= 2) and (S [1] = '-') then begin
  462. PassOn := False;
  463. if Length (S) = 2 then begin
  464. case S [2] of
  465. 'E', 'S': begin
  466. Link := False;
  467. Assemble := False;
  468. if S [2] = 'E' then
  469. PassOn := True;
  470. end;
  471. 'c':
  472. Link := False;
  473. 'q':
  474. Quiet := True;
  475. 'g':
  476. DebugInfo := True;
  477. 'x':
  478. if I < ParamCount then begin
  479. Inc (I);
  480. Insert (' ' + S + ' ' + Enquote (ParamStr (I)), GCCLine, Length (GCCLine) + 1);
  481. end;
  482. 'o':
  483. if I < ParamCount then begin
  484. Inc (I);
  485. DestFile := ParamStr (I);
  486. end;
  487. 'n':
  488. if I < ParamCount then begin
  489. Inc (I);
  490. ParseVarName (ParamStr (I), FolderName, VarName);
  491. end;
  492. 'd':
  493. if I < ParamCount then begin
  494. Inc (I);
  495. ParseVarName (ParamStr (I), DataFolderName, DataVarName);
  496. end;
  497. else
  498. PassOn := True;
  499. end;
  500. end else begin
  501. if S = '-bsr' then
  502. // ignore for compatibility
  503. else if S = '--output' then begin
  504. if I < ParamCount then begin
  505. Inc (I);
  506. DestFile := ParamStr (I);
  507. end;
  508. end else if S = '--varname' then begin
  509. if I < ParamCount then begin
  510. Inc (I);
  511. ParseVarName (ParamStr (I), FolderName, VarName);
  512. end;
  513. end else if S = '--data-var' then begin
  514. if I < ParamCount then begin
  515. Inc (I);
  516. ParseVarName (ParamStr (I), DataFolderName, DataVarName);
  517. end;
  518. end else if (S = '-outputbin') or (S = '--outputbin') then
  519. OutputBin := True
  520. else if (S = '-standalone') or (S = '--standalone') then
  521. StdLib := False
  522. else if S = '-ar' then begin
  523. Archive := True;
  524. StdLib := False;
  525. end else if (S = '-keep') or (S = '--keep') then
  526. KeepObjectFiles := True
  527. else if (S = '-save-temps') or (S = '--save-temps') then begin
  528. KeepObjectFiles := True;
  529. SaveTemps := True;
  530. Insert (' ' + Enquote (S), GCCLine, Length (GCCLine) + 1);
  531. end else if (S = '-include') or (S = '--param') or (S = '-isystem') then begin
  532. if I < ParamCount then begin
  533. Inc (I);
  534. Insert (' ' + Enquote (S) + ' ' + Enquote (ParamStr (I)), GCCLine, Length (GCCLine) + 1);
  535. end;
  536. end else if (S = '-pack') or (S = '--pack') then begin
  537. if I < ParamCount then begin
  538. Pack := True;
  539. Inc (I);
  540. PackVarName := LowerCase (Copy (ParamStr (I), 1, 8));
  541. end;
  542. end else if S = '-quill' then begin
  543. if FileExists (ProgPath + 'BIN\Quill.drv') then
  544. Insert (' -Os -include ' + Enquote (ProgPath + 'BIN\Quill.drv') + ' -x c', GCCLine, Length (GCCLine) + 1)
  545. else if FileExists (ProgPath + 'INCLUDE\C\Quill.drv') then
  546. Insert (' -Os -include ' + Enquote (ProgPath + 'BIN\Quill.drv') + ' -x c', GCCLine, Length (GCCLine) + 1)
  547. else if FileExists (ProgPath + 'INCLUDE\QUILL\Quill.drv') then
  548. Insert (' -Os -include ' + Enquote (ProgPath + 'BIN\Quill.drv') + ' -x c', GCCLine, Length (GCCLine) + 1)
  549. else
  550. Fatal (SQuillNotFound);
  551. end else if S = '--native' then
  552. NativeMode := True
  553. else if S = '--flash-os' then
  554. FlashOSMode := True
  555. else if S = '--fargo' then
  556. FargoMode := True
  557. else if S = '--remove-unused' then
  558. OptimizeInfo.RemoveUnused := True
  559. else if S = '--optimize-relocs' then
  560. OptimizeInfo.OptimizeRelocs := True
  561. else if S = '--optimize-code' then begin
  562. OptimizeInfo.OptimizeNOPs := True;
  563. OptimizeInfo.OptimizeReturns := True;
  564. OptimizeInfo.OptimizeBranches := True;
  565. OptimizeInfo.OptimizeMoves := True;
  566. OptimizeInfo.OptimizeTests := True;
  567. OptimizeInfo.OptimizeCalcs := True;
  568. end else if S = '--optimize-nops' then
  569. OptimizeInfo.OptimizeNOPs := True
  570. else if S = '--optimize-returns' then
  571. OptimizeInfo.OptimizeReturns := True
  572. else if S = '--optimize-branches' then
  573. OptimizeInfo.OptimizeBranches := True
  574. else if S = '--optimize-moves' then
  575. OptimizeInfo.OptimizeMoves := True
  576. else if S = '--optimize-tests' then
  577. OptimizeInfo.OptimizeTests := True
  578. else if S = '--optimize-calcs' then
  579. OptimizeInfo.OptimizeCalcs := True
  580. else if S = '--cut-ranges' then
  581. OptimizeInfo.CutRanges := True
  582. else if S = '--reorder-sections' then
  583. OptimizeInfo.ReorderSections := True
  584. else if S = '--merge-constants' then
  585. OptimizeInfo.MergeConstants := True
  586. else if S = '--omit-bss-init' then
  587. OmitBSSInit := True
  588. else if Copy (S, 1, 4) = '-Wa,' then
  589. InsertOptionString (AsLine, Copy (S, 5, Length (S)))
  590. else if Copy (S, 1, 4) = '-WA,' then
  591. InsertOptionString (A68kLine, Copy (S, 5, Length (S)))
  592. else if Copy (S, 1, Length ('--data-var-copy=')) = '--data-var-copy=' then begin
  593. Delete (S, 1, Length ('--data-var-copy='));
  594. if S = 'never' then begin
  595. DataVarInfo.CreateCopy := False;
  596. DataVarInfo.CopyOnlyIfArchived := False;
  597. end else if S = 'always' then begin
  598. DataVarInfo.CreateCopy := True;
  599. DataVarInfo.CopyOnlyIfArchived := False;
  600. end else if S = 'archived' then begin
  601. DataVarInfo.CreateCopy := True;
  602. DataVarInfo.CopyOnlyIfArchived := True;
  603. end;
  604. end else
  605. PassOn := True;
  606. end;
  607. if PassOn then begin
  608. if Copy (S, 1, 2) = '-v' then begin
  609. PrintCommands := True;
  610. if S <> '-v0' then begin
  611. Verbose := True;
  612. Quiet := False;
  613. Insert (' ' + Enquote (S), GCCLine, Length (GCCLine) + 1);
  614. end;
  615. end else begin
  616. if (S = '--help') or (S = '--version') then begin
  617. Assemble := False;
  618. Link := False;
  619. if S = '--version' then
  620. OutputTextLine ('tigcc.exe built for TIGCC Version ' + TIGCCLongVersion);
  621. end;
  622. Insert (' ' + Enquote (S), GCCLine, Length (GCCLine) + 1);
  623. end;
  624. end;
  625. end else begin
  626. if LowerCase (ExtractFileExt (S)) = '.a' then begin
  627. if (not FileExists (S)) and FileExists (ProgPath + 'LIB\' + S) then
  628. S := ProgPath + 'LIB\' + S;
  629. ArchiveFiles.Add (S);
  630. end else begin
  631. if FileExists (S) then begin
  632. ObjectFiles.Add (ChangeFileExt (S, '.o'));
  633. if Length (FirstFile) <= 0 then
  634. FirstFile := Copy (S, 1, Pos (ExtractFileExt (S), S) - 1);
  635. if LowerCase (ExtractFileExt (S)) <> '.o' then begin
  636. if LowerCase (ExtractFileExt (S)) = '.asm' then
  637. A68kFiles.Add (S)
  638. else begin
  639. Insert (' ' + Enquote (S), GCCLine, Length (GCCLine) + 1);
  640. GCCFiles.Add (S);
  641. end;
  642. if Link then
  643. DelFiles.Add (ChangeFileExt (S, '.o'));
  644. end;
  645. end else
  646. Error (Format (SFileNotFound, [S]));
  647. end;
  648. end;
  649. Inc (I);
  650. end;
  651. if FlashOSMode and (not OutputBin) then
  652. Fatal (SNoNewOSUpgradeFiles);
  653. if Length (DataVarName) > 0 then begin
  654. if Length (DataFolderName) > 0 then
  655. DataVar := DataFolderName + '\' + DataVarName
  656. else begin
  657. DataVar := DataVarName;
  658. DataFolderName := FolderName;
  659. end;
  660. DataVarInfo.VarName := PChar (DataVar);
  661. end;
  662. if OptimizeInfo.CutRanges or Archive then begin
  663. Insert (' --all-relocs', AsLine, Length (AsLine) + 1);
  664. Insert (' -a', A68kLine, Length (A68kLine) + 1);
  665. end;
  666. if OptimizeInfo.OptimizeReturns or Archive then begin
  667. Insert (' --keep-locals', AsLine, Length (AsLine) + 1);
  668. Insert (' -d', A68kLine, Length (A68kLine) + 1);
  669. end;
  670. if StdLib then begin
  671. if FlashOSMode then
  672. ArchiveFiles.Add (ProgPath + 'LIB\flashos.a')
  673. else if FargoMode then
  674. ArchiveFiles.Add (ProgPath + 'LIB\fargo.a')
  675. else
  676. ArchiveFiles.Add (ProgPath + 'LIB\tigcc.a');
  677. end;
  678. if (not Link) or KeepObjectFiles then
  679. with DelFiles do
  680. for I := Count - 1 downto 0 do
  681. if LowerCase (ExtractFileExt (Strings [I])) = '.o' then
  682. Delete (I);
  683. // Execution of GCC.exe (compiling and assembling)
  684. if (GCCFiles.Count > 0) or (Pos ('--', GCCLine) > 0) then begin
  685. if (Pos (' -S', GCCLine) <= 0) and (Pos (' -E', GCCLine) <= 0) then
  686. Insert (' -S', GCCLine, Length (GCCLine) + 1);
  687. if DebugInfo then begin
  688. Insert (' -gdwarf-2 -g3 -fasynchronous-unwind-tables', GCCLine, Length (GCCLine) + 1);
  689. Insert (' --gdwarf2', AsLine, Length (AsLine) + 1);
  690. end;
  691. if Length (DataVar) > 0 then
  692. Insert (' -mno-merge-sections', GCCLine, Length (GCCLine) + 1);
  693. if FlashOSMode then
  694. Insert (' -DFLASH_OS', GCCLine, Length (GCCLine) + 1)
  695. else if FargoMode then
  696. Insert (' -DFARGO', GCCLine, Length (GCCLine) + 1);
  697. if (GCCFiles.Count = 1) and (A68kFiles.Count <= 0) and (Length (DestFile) > 0) and (not Assemble) then
  698. Insert (' -o ' + Enquote (DestFile), GCCLine, Length (GCCLine) + 1);
  699. Execute (GCCLine);
  700. for I := 0 to GCCFiles.Count - 1 do begin
  701. S := GCCFiles.Strings [I];
  702. GCCFile := LowerCase (ExtractFileExt (S)) <> '.s';
  703. T := ChangeFileExt (StringReplace (S, '/', '\', [rfReplaceAll]), '.s');
  704. if GCCFile then
  705. T := ExtractFileName (T);
  706. if FileExists (T) then begin
  707. if GCCFile then begin
  708. if Assemble then begin
  709. DelFiles.Add (T);
  710. end;
  711. L := TStringList.Create;
  712. with L do try
  713. LoadFromFile (T);
  714. ParseSFile (L);
  715. SaveToFile (T);
  716. finally
  717. Free;
  718. end;
  719. end;
  720. if Assemble then begin
  721. if (not Link) and (GCCFiles.Count = 1) and (Length (DestFile) > 0) then
  722. Execute (AsLine + ' ' + Enquote (T) + ' -o ' + Enquote (DestFile))
  723. else
  724. Execute (AsLine + ' ' + Enquote (T) + ' -o ' + Enquote (ChangeFileExt (S, '.o')));
  725. end;
  726. end;
  727. end;
  728. if Link and Verbose then
  729. InsertNewLine;
  730. end;
  731. // Execution of A68k.exe (assembling)
  732. if A68kFiles.Count > 0 then begin
  733. if DebugInfo then
  734. Insert (' -d', A68kLine, Length (A68kLine) + 1);
  735. if Quiet then
  736. Insert (' -q', A68kLine, Length (A68kLine) + 1);
  737. if (A68kFiles.Count = 1) and (GCCFiles.Count <= 0) and (Length (DestFile) > 0) and (not Link) then begin
  738. Insert (' ' + Enquote ('-o' + DestFile), A68kLine, Length (A68kLine) + 1);
  739. A68kDest := True;
  740. end;
  741. while A68kFiles.Count > 0 do begin
  742. Execute (A68kLine + ' ' + Enquote (A68kFiles.Strings [0]));
  743. A68kFiles.Delete (0);
  744. if Link and not Quiet then begin
  745. InsertNewLine;
  746. InsertNewLine;
  747. end;
  748. end;
  749. end;
  750. // Execution of Link.dll (linking and archiving)
  751. if Link and (ObjectFiles.Count > 0) then begin
  752. LinkLibHandle := LoadLibrary (PChar (ProgPath + 'BIN\LINK.DLL'));
  753. if LinkLibHandle <> 0 then begin
  754. try
  755. LinkLibGetInterfaceVersion := GetProcAddress (LinkLibHandle, 'GetInterfaceVersion');
  756. if Assigned (LinkLibGetInterfaceVersion) and (LinkLibGetInterfaceVersion = LinkLibCurInterfaceVersion) then begin
  757. LinkLibLinkFiles := GetProcAddress (LinkLibHandle, 'LinkFiles');
  758. LinkLibCreateArchive := GetProcAddress (LinkLibHandle, 'CreateArchive');
  759. if Length (DestFile) <= 0 then
  760. DestFile := ChangeFileExt (FirstFile, '');
  761. if Archive then begin
  762. if Pos ('.', DestFile) <= 0 then
  763. DestFile := DestFile + '.a';
  764. ObjectFileArray := CreatePPChar (ObjectFiles);
  765. try
  766. if LinkLibCreateArchive (PChar (DestFile), ObjectFileArray, LinkLibErrorMessage, True) <> 0 then
  767. Fatal;
  768. finally
  769. FreePPChar (ObjectFileArray);
  770. end;
  771. end else begin
  772. TryDeleteFiles (DestFile + '.', 'z');
  773. TryDeleteFiles (DestFile + '-titanium.', 'z');
  774. TryDeleteFiles (DestFile + '.', 'y');
  775. TryDeleteFiles (DestFile + '-data.', 'y');
  776. TryDeleteFiles (DestFile + '-', '.tib');
  777. if Length (VarName) <= 0 then
  778. VarName := DestFile;
  779. ObjectFileArray := CreatePPChar (ObjectFiles);
  780. try
  781. ArchiveFileArray := CreatePPChar (ArchiveFiles);
  782. try
  783. for CurCalcDest := FirstCalcDest to LastCalcDest do begin
  784. LinkOutputFiles[CurCalcDest,frMain].Data := nil;
  785. LinkOutputFiles[CurCalcDest,frData].Data := nil;
  786. end;
  787. LinkDebugFile.Data := nil;
  788. try
  789. if LinkLibLinkFiles (ObjectFileArray, ArchiveFileArray, LinkLibErrorMessage, LinkLibGetOutputFile, nil, NativeMode, FlashOSMode, FargoMode, DataVarInfo, OptimizeInfo, OmitBSSInit) <> 0 then
  790. Fatal;
  791. for CurCalcDest := FirstCalcDest to LastCalcDest do
  792. if Assigned (LinkOutputFiles[CurCalcDest,frMain].Data) then begin
  793. Include (CalcDests, CurCalcDest);
  794. HandleContents (DestFile, FolderName, VarName, DataFolderName, DataVarName, Pack and (CurCalcDest <> cdTI92), PackVarName, CurCalcDest);
  795. end;
  796. if Assigned (LinkDebugFile.Data) then begin
  797. HandleDebugContents (DestFile);
  798. end;
  799. finally
  800. for CurCalcDest := FirstCalcDest to LastCalcDest do begin
  801. if Assigned (LinkOutputFiles[CurCalcDest,frMain].Data) then
  802. LinkOutputFiles[CurCalcDest,frMain].Data.Free;
  803. if Assigned (LinkOutputFiles[CurCalcDest,frData].Data) then
  804. LinkOutputFiles[CurCalcDest,frData].Data.Free;
  805. LinkOutputFiles[CurCalcDest,frMain].Data := nil;
  806. LinkOutputFiles[CurCalcDest,frData].Data := nil;
  807. end;
  808. if Assigned (LinkDebugFile.Data) then
  809. LinkDebugFile.Data.Free;
  810. LinkDebugFile.Data := nil;
  811. end;
  812. finally
  813. FreePPChar (ArchiveFileArray);
  814. end;
  815. finally
  816. FreePPChar (ObjectFileArray);
  817. end;
  818. if Pack then
  819. CreatePackStarter (DestFile, 'pstarter.o', FolderName, VarName, PackVarName, CalcDests - [cdTI92]);
  820. if Verbose then
  821. with OptimizeInfo do begin
  822. OutputTextLine ('Program Variable Size: ' + IntToStr (ProgramSize) + ' Bytes');
  823. if DataSize > 0 then
  824. OutputTextLine ('Data Variable Size: ' + IntToStr (DataSize) + ' Bytes');
  825. if BSSSize > 0 then
  826. OutputTextLine ('BSS Size: ' + IntToStr (BSSSize) + ' Bytes');
  827. OutputTextLine ('Absolute Relocs: ' + IntToStr (RelocCount));
  828. OutputTextLine ('Natively Emitted Relocs: ' + IntToStr (NativeRelocCount));
  829. if OptimizeBranchesResult > 0 then begin
  830. if OptimizeBranches then
  831. S := 'Relocs Saved by Branch Optimization: '
  832. else
  833. S := 'Relocs Savable by Branch Optimization: ';
  834. OutputTextLine (S + IntToStr (OptimizeBranchesResult));
  835. end;
  836. if OptimizeMovesResult > 0 then begin
  837. if OptimizeMoves then
  838. S := 'Relocs Saved by Move Optimization: '
  839. else
  840. S := 'Relocs Savable by Move Optimization: ';
  841. OutputTextLine (S + IntToStr (OptimizeMovesResult));
  842. end;
  843. if OptimizeTestsResult > 0 then begin
  844. if OptimizeTests then
  845. S := 'Relocs Saved by Test Optimization: '
  846. else
  847. S := 'Relocs Savable by Test Optimization: ';
  848. OutputTextLine (S + IntToStr (OptimizeTestsResult));
  849. end;
  850. if OptimizeCalcsResult > 0 then begin
  851. if OptimizeCalcs then
  852. S := 'Relocs Saved by Calculation Optimization: '
  853. else
  854. S := 'Relocs Savable by Calculation Optimization: ';
  855. OutputTextLine (S + IntToStr (OptimizeCalcsResult));
  856. end;
  857. if UseFLineJumpsResult > 0 then begin
  858. if UseFLineJumps or Use4ByteFLineJumps then
  859. S := 'Relocs Saved by F-Line Jumps: '
  860. else
  861. S := 'Relocs Savable by F-Line Jumps: ';
  862. OutputTextLine (S + IntToStr (UseFLineJumpsResult));
  863. end;
  864. if CutRangesResult > 0 then begin
  865. if CutRanges then
  866. S := 'Space Saved by Range-Cutting: '
  867. else
  868. S := 'Space Savable by Range-Cutting: ';
  869. OutputTextLine (S + IntToStr (CutRangesResult) + ' Bytes');
  870. end;
  871. if NearAssemblyResult > 0 then
  872. OutputTextLine ('Space Savable by Using GNU Assembler ''-l'' Switch: ' + IntToStr (NearAssemblyResult) + ' Bytes');
  873. end;
  874. end;
  875. end else
  876. Fatal (SLinkDLLNotLoaded);
  877. finally
  878. FreeLibrary (LinkLibHandle);
  879. end;
  880. end else
  881. Fatal (Format (SProgNotFound, ['LINK.DLL']));
  882. end;
  883. if not SaveTemps then
  884. with DelFiles do
  885. for I := 0 to Count - 1 do
  886. TryDeleteFile (Strings [I]);
  887. finally
  888. ArchiveFiles.Free;
  889. ObjectFiles.Free;
  890. A68kFiles.Free;
  891. GCCFiles.Free;
  892. DelFiles.Free;
  893. end;
  894. except
  895. on E: Exception do begin
  896. if not (E is EAbort) then
  897. Error (E.Message);
  898. Halt (1);
  899. end;
  900. end;
  901. end.