TiGcc.dpr 32 KB

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