TiGcc.dpr 32 KB

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