ParsingUnit.pas 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524
  1. {
  2. TIGCC IDE
  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. unit ParsingUnit;
  18. interface
  19. uses
  20. CalcUnit,
  21. SysUtils, Classes;
  22. const
  23. LineIndicator = '#L';
  24. OffsetIndicator = '#$';
  25. PatchToken = '$$PATCH';
  26. ErrorToken = '$$ERROR';
  27. WarningToken = '$$WARNING';
  28. ALineIdentifier = '_A_LINE';
  29. FLineIdentifier = '_F_LINE';
  30. SParseError = 'Line %d: Parse error before ''%s''';
  31. type
  32. EFileParseError = class(Exception);
  33. PBoolean = ^Boolean;
  34. type
  35. TCalcInt1 = packed record
  36. Int: Byte;
  37. end;
  38. PCalcInt1 = ^TCalcInt1;
  39. TCalcInt2 = packed record
  40. Hi,
  41. Lo: TCalcInt1;
  42. end;
  43. PCalcInt2 = ^TCalcInt2;
  44. TCalcInt4 = packed record
  45. Hi,
  46. Lo: TCalcInt2;
  47. end;
  48. PCalcInt4 = ^TCalcInt4;
  49. TPCInt1 = packed record
  50. Int: Byte;
  51. end;
  52. PPCInt1 = ^TPCInt1;
  53. TPCInt2 = packed record
  54. Lo,
  55. Hi: TPCInt1;
  56. end;
  57. PPCInt2 = ^TPCInt2;
  58. TPCInt4 = packed record
  59. Lo,
  60. Hi: TPCInt2;
  61. end;
  62. PPCInt4 = ^TPCInt4;
  63. function ReadCalcInt(Int: TCalcInt1): Byte; overload;
  64. function ReadCalcInt(Int: TCalcInt2): Word; overload;
  65. function ReadCalcInt(Int: TCalcInt4): LongWord; overload;
  66. procedure WriteCalcInt(Input: Byte; out Int: TCalcInt1); overload;
  67. procedure WriteCalcInt(Input: Word; out Int: TCalcInt2); overload;
  68. procedure WriteCalcInt(Input: LongWord; out Int: TCalcInt4); overload;
  69. function ReadPCInt(Int: TPCInt1): Byte; overload;
  70. function ReadPCInt(Int: TPCInt2): Word; overload;
  71. function ReadPCInt(Int: TPCInt4): LongWord; overload;
  72. procedure WritePCInt(Input: Byte; out Int: TPCInt1); overload;
  73. procedure WritePCInt(Input: Word; out Int: TPCInt2); overload;
  74. procedure WritePCInt(Input: LongWord; out Int: TPCInt4); overload;
  75. type
  76. TTFRes2 = array [0..1] of Byte;
  77. TTFRes3 = array [0..2] of Byte;
  78. TTFRes6 = array [0..5] of Byte;
  79. TTransferFileHeader = packed record
  80. Signature: array [0..7] of Char; // "**TI92P*" or "**TI89**"
  81. Reserved1: TTFRes2; // 01 00
  82. Folder: array [0..7] of Char; // folder name
  83. Desc: array [0..39] of Char; // not used
  84. Reserved2: TTFRes6; // 01 00 52 00 00 00
  85. VarName: array [0..7] of Char; // variable name
  86. LinkType: TPCInt1; // variable link type (0C = string, 1C = other, 21 = program, ...)
  87. Reserved3: TTFRes3; // 00 00 00
  88. FileSize: TPCInt4; // file size from Signature to CheckSum
  89. Reserved4: TTFRes6; // A5 5A 00 00 00 00
  90. end;
  91. PTransferFileHeader = ^TTransferFileHeader;
  92. TCalcVarHeader = packed record
  93. DataSize: TCalcInt2; // data size (including Tag)
  94. end;
  95. PCalcVarHeader = ^TCalcVarHeader;
  96. TCalcVarFooter = packed record
  97. Tag: TCalcInt1; // variable tag
  98. end;
  99. PCalcVarFooter = ^TCalcVarFooter;
  100. TTransferFileFooter = packed record
  101. CheckSum: TPCInt2; // checksum from DataSize to Tag
  102. end;
  103. PTransferFileFooter = ^TTransferFileFooter;
  104. TCalcOSFooter = packed record
  105. CheckSum: TCalcInt4; // encrypted checksum
  106. SignatureHeader: TCalcInt2; // 02 0D
  107. SignatureType: TCalcInt1; // 40
  108. Signature: array [0..63] of Byte; // signature, encrypted using TI's private key
  109. end;
  110. PCalcOSFooter = ^TCalcOSFooter;
  111. PBinData = PChar;
  112. const
  113. MaxCalcAllocBlock = $FFF0;
  114. procedure ParseSFile(Contents: TStringList);
  115. procedure ParsePStarter(const InputFile: string; const OutputFile: string; const PackVar: string);
  116. function GetCalcVarSize(ContentLength: LongWord; const Extension: string = ''): LongWord;
  117. function GetTransferFileSize(ContentLength: LongWord; const Extension: string = ''; OutputBin: Boolean = False): LongWord;
  118. procedure ProduceTransferFile(Output: Pointer; Contents: Pointer; ContentLength: LongWord; CalcDest: TCalcDest; const DestFolder, DestVarName: string; VarTag: Byte; const Extension: string = ''; OutputBin: Boolean = False);
  119. function GetTransferFileExt(CalcDest: TCalcDest; VarTag: Byte; OutputBin: Boolean = False): string;
  120. function GetOSUpgradeFileSize(ContentLength: LongWord; OutputBin: Boolean = True): LongWord;
  121. procedure ProduceOSUpgradeFile(Output: Pointer; Contents: Pointer; ContentLength: LongWord; OutputBin: Boolean = True);
  122. function GetOSUpgradeFileExt(CalcDest: TCalcDest; OutputBin: Boolean = False): string;
  123. var
  124. ErrorMessageProc: procedure(const Msg: string) = nil;
  125. implementation
  126. uses
  127. Windows, UtilsDos;
  128. { General parsing procedures }
  129. procedure ParseSFile(Contents: TStringList);
  130. var
  131. I,
  132. P1,
  133. P2: Integer;
  134. RegRelative,
  135. NeedFLine,
  136. Changed: Boolean;
  137. L: string;
  138. begin
  139. RegRelative := False;
  140. NeedFLine := False;
  141. with Contents do begin
  142. for I := 0 to Count - 1 do begin
  143. L := Strings [I];
  144. if L = #9'.set __relation,__ld_entry_point_plus_0x8000' then
  145. RegRelative := True;
  146. if Pos (FLineIdentifier, L) > 0 then
  147. NeedFLine := True;
  148. if not ((Copy (L, 1, Length (#9'.ascii')) = #9'.ascii') or (Copy (L, 1, Length (#9'.asciz')) = #9'.asciz')) then begin
  149. if RegRelative then begin
  150. P1 := Pos ('-__relation', L);
  151. while P1 > 0 do begin
  152. P2 := PosEx ('_CALL_', L, P1, True);
  153. if (P2 > 0) and (P2 < P1) and (P1 - P2 <= Length ('_CALL_') + 4) then begin
  154. System.Delete (L, P1, Length ('-__relation') + 1);
  155. while (Length (L) > 0) and (L [P1] <> ')') do
  156. System.Delete (L, P1, 1);
  157. System.Delete (L, P1, 1);
  158. Strings [I] := L;
  159. end;
  160. P2 := PosEx ('_ER_CODE_', L, P1, True);
  161. if (P2 > 0) and (P2 < P1) and (P1 - P2 <= Length ('_ER_CODE_') + 5) then begin
  162. System.Delete (L, P1, Length ('-__relation') + 1);
  163. while (Length (L) > 0) and (L [P1] <> ')') do
  164. System.Delete (L, P1, 1);
  165. System.Delete (L, P1, 1);
  166. Strings [I] := L;
  167. end;
  168. P1 := PosEx ('-__relation', L, P1 + 1);
  169. end;
  170. end;
  171. if (Copy (L, 1, Length (#9'jra _ER_CODE_')) = #9'jra _ER_CODE_') or (Copy (L, 1, Length (#9'jmp _ER_CODE_')) = #9'jmp _ER_CODE_') then begin
  172. System.Delete (L, 1, Length (#9'jxx _ER_CODE_'));
  173. if Length (L) <= 4 then
  174. Strings [I] := #9'.word _A_LINE+' + L;
  175. end else begin
  176. Changed := True;
  177. if (Copy (L, 1, Length (#9'jbsr')) = #9'jbsr') and (Pos ('_CALL_', L) > 0) then
  178. System.Delete (L, 1 + Length (#9'j'), Length ('b'))
  179. else if (Copy (L, 1, Length (#9'jra')) = #9'jra') and (Pos ('_CALL_', L) > 0) then begin
  180. System.Delete (L, 1, Length (#9'jra'));
  181. L := #9'jmp' + L;
  182. end else if Copy (L, 1, Length (#9'move.l #__ld_calc_const_')) = #9'move.l #__ld_calc_const_' then
  183. L [1 + Length (#9'move.')] := 'w'
  184. else
  185. Changed := False;
  186. if NeedFLine and (Copy (L, 1, Length (#9'jsr _ROM_CALL_')) = #9'jsr _ROM_CALL_') then begin
  187. System.Delete (L, 1, Length (#9'jsr _ROM_CALL_'));
  188. if Length (L) <= 3 then
  189. Strings [I] := #9'.word _F_LINE+0x' + L;
  190. end else begin
  191. P1 := Pos ('_ROM_CALL_', L);
  192. while P1 > 0 do begin
  193. P2 := P1;
  194. Inc (P1, Length ('_ROM_CALL_'));
  195. while (P1 <= Length (L)) and (L [P1] in ['0'..'9', 'a'..'z', 'A'..'Z', '_', '+', '-', '*', '/']) do
  196. Inc (P1);
  197. while (P1 <= Length (L)) and (L [P1] in [':', 'a'..'z', 'A'..'Z']) do
  198. System.Delete (L, P1, 1);
  199. System.Insert (':l', L, P1);
  200. Inc (P1, Length (':l'));
  201. if LowerCase (Copy (L, P1, Length ('(%pc)'))) = '(%pc)' then
  202. System.Delete (L, P1, Length ('(%pc)'))
  203. else if (LowerCase (Copy (L, P1, Length (',%pc)'))) = ',%pc)') and (P2 - 1 > 0) and (L [P2 - 1] = '(') then begin
  204. System.Delete (L, P1, Length (',%pc)'));
  205. System.Delete (L, P2 - 1, 1);
  206. end;
  207. Changed := True;
  208. P1 := PosEx ('_ROM_CALL_', L, P1);
  209. end;
  210. P1 := Pos ('__ld_calc_const_', L);
  211. while P1 > 0 do begin
  212. P2 := P1;
  213. Inc (P1, Length ('__ld_calc_const_'));
  214. while (P1 <= Length (L)) and (L [P1] in ['0'..'9', 'a'..'z', 'A'..'Z', '_', ':']) do
  215. Inc (P1);
  216. if LowerCase (Copy (L, P1, Length ('(%pc)'))) = '(%pc)' then begin
  217. System.Delete (L, P1, Length ('(%pc)'));
  218. Changed := True;
  219. end else if (LowerCase (Copy (L, P1, Length (',%pc)'))) = ',%pc)') and (P2 - 1 > 0) and (L [P2 - 1] = '(') then begin
  220. System.Delete (L, P1, Length (',%pc)'));
  221. System.Delete (L, P2 - 1, 1);
  222. Changed := True;
  223. end;
  224. P1 := PosEx ('__ld_calc_const_', L, P1);
  225. end;
  226. if Changed then
  227. Strings [I] := L;
  228. end;
  229. end;
  230. end;
  231. end;
  232. end;
  233. end;
  234. procedure ParsePStarter(const InputFile: string; const OutputFile: string; const PackVar: string);
  235. const
  236. TempProg = 'TEMPPROG';
  237. var
  238. I: Integer;
  239. ObjectFile: TMemoryStream;
  240. Buf: PChar;
  241. Len: Integer;
  242. TempBuf: array [0..Length(TempProg)] of Char;
  243. begin
  244. TempBuf [Length (TempProg)] := #0;
  245. ObjectFile := TMemoryStream.Create;
  246. try
  247. ObjectFile.LoadFromFile (InputFile);
  248. Buf := ObjectFile.Memory;
  249. Len := ObjectFile.Size;
  250. for I := 0 to Len - Length (TempProg) do
  251. if UpCase (Buf [I]) = TempProg [1] then begin
  252. Move (Buf [I], TempBuf, Length (TempProg));
  253. if UpperCase (AnsiString (TempBuf)) = TempProg then begin
  254. FillChar (Buf [I], Length (TempProg), 0);
  255. StrPLCopy (PChar (@(Buf [I])), LowerCase (PackVar), Length (TempProg));
  256. Break;
  257. end;
  258. end;
  259. ObjectFile.SaveToFile (OutputFile);
  260. finally
  261. ObjectFile.Free;
  262. end;
  263. end;
  264. { Functions to read integers machine-independently }
  265. function ReadCalcInt(Int: TCalcInt1): Byte;
  266. begin
  267. Result := Int.Int;
  268. end;
  269. function ReadCalcInt(Int: TCalcInt2): Word;
  270. begin
  271. Result := ReadCalcInt (Int.Hi) shl (SizeOf (Int.Lo) * 8) or ReadCalcInt (Int.Lo);
  272. end;
  273. function ReadCalcInt(Int: TCalcInt4): LongWord;
  274. begin
  275. Result := ReadCalcInt (Int.Hi) shl (SizeOf (Int.Lo) * 8) or ReadCalcInt (Int.Lo);
  276. end;
  277. function ReadPCInt(Int: TPCInt1): Byte;
  278. begin
  279. Result := Int.Int;
  280. end;
  281. function ReadPCInt(Int: TPCInt2): Word;
  282. begin
  283. Result := ReadPCInt (Int.Hi) shl (SizeOf (Int.Lo) * 8) or ReadPCInt (Int.Lo);
  284. end;
  285. function ReadPCInt(Int: TPCInt4): LongWord;
  286. begin
  287. Result := ReadPCInt (Int.Hi) shl (SizeOf (Int.Lo) * 8) or ReadPCInt (Int.Lo);
  288. end;
  289. { Functions to write integers machine-independently }
  290. procedure WriteCalcInt(Input: Byte; out Int: TCalcInt1);
  291. begin
  292. Int.Int := Input;
  293. end;
  294. procedure WriteCalcInt(Input: Word; out Int: TCalcInt2);
  295. begin
  296. WriteCalcInt (Byte (Input shr (SizeOf (Int.Lo) * 8)), Int.Hi);
  297. WriteCalcInt (Byte (Input), Int.Lo);
  298. end;
  299. procedure WriteCalcInt(Input: LongWord; out Int: TCalcInt4);
  300. begin
  301. WriteCalcInt (Word (Input shr (SizeOf (Int.Lo) * 8)), Int.Hi);
  302. WriteCalcInt (Word (Input), Int.Lo);
  303. end;
  304. procedure WritePCInt(Input: Byte; out Int: TPCInt1);
  305. begin
  306. Int.Int := Input;
  307. end;
  308. procedure WritePCInt(Input: Word; out Int: TPCInt2);
  309. begin
  310. WritePCInt (Byte (Input shr (SizeOf (Int.Lo) * 8)), Int.Hi);
  311. WritePCInt (Byte (Input), Int.Lo);
  312. end;
  313. procedure WritePCInt(Input: LongWord; out Int: TPCInt4);
  314. begin
  315. WritePCInt (Word (Input shr (SizeOf (Int.Lo) * 8)), Int.Hi);
  316. WritePCInt (Word (Input), Int.Lo);
  317. end;
  318. { Calculator file creation functions }
  319. function GetCalcVarSize(ContentLength: LongWord; const Extension: string = ''): LongWord;
  320. begin
  321. Result := SizeOf (TCalcVarHeader) + ContentLength + SizeOf (TCalcVarFooter);
  322. if Length (Extension) > 0 then
  323. Inc (Result, Length (Extension) + 2);
  324. if Result > MaxCalcAllocBlock then
  325. Result := 0;
  326. end;
  327. function GetTransferFileSize(ContentLength: LongWord; const Extension: string = ''; OutputBin: Boolean = False): LongWord;
  328. begin
  329. Result := GetCalcVarSize (ContentLength, Extension);
  330. if (Result > 0) and (not OutputBin) then
  331. Inc (Result, SizeOf (TTransferFileHeader) + SizeOf (TTransferFileFooter));
  332. end;
  333. procedure ProduceTransferFile(Output: Pointer; Contents: Pointer; ContentLength: LongWord; CalcDest: TCalcDest; const DestFolder, DestVarName: string; VarTag: Byte; const Extension: string = ''; OutputBin: Boolean = False);
  334. const
  335. Res1: TTFRes2 = ($01, $00);
  336. Res2: TTFRes6 = ($01, $00, $52, $00, $00, $00);
  337. Res3: TTFRes3 = ($00, $00, $00);
  338. Res4: TTFRes6 = ($A5, $5A, $00, $00, $00, $00);
  339. var
  340. Size,
  341. CalcSize: LongWord;
  342. Header: PTransferFileHeader;
  343. CalcHeader: PCalcVarHeader;
  344. CalcFooter: PCalcVarFooter;
  345. Footer: PTransferFileFooter;
  346. Data: Pointer;
  347. VarLinkType: Byte;
  348. I,
  349. Sum: Word;
  350. begin
  351. CalcSize := GetCalcVarSize (ContentLength, Extension);
  352. Size := GetTransferFileSize (ContentLength, Extension, OutputBin);
  353. if Size > 0 then begin
  354. FillChar (Output^, Size, 0);
  355. if OutputBin then begin
  356. CalcHeader := Output;
  357. CalcFooter := Pointer (@(PBinData(Output) [Size - SizeOf (TCalcVarFooter)]));
  358. Data := @(PBinData(Output) [SizeOf (TCalcVarHeader)]);
  359. end else begin
  360. CalcHeader := Pointer (@(PBinData(Output) [SizeOf (TTransferFileHeader)]));
  361. CalcFooter := Pointer (@(PBinData(Output) [Size - SizeOf (TTransferFileFooter) - SizeOf (TCalcVarFooter)]));
  362. Data := @(PBinData(Output) [SizeOf (TTransferFileHeader) + SizeOf (TCalcVarHeader)]);
  363. end;
  364. WriteCalcInt (CalcSize - SizeOf (TCalcInt2), CalcHeader.DataSize);
  365. Move (Contents^, Data^, ContentLength);
  366. if Length (Extension) > 0 then
  367. StrPCopy (Pointer (@(PBinData(Data) [ContentLength + 1])), Extension);
  368. WriteCalcInt (VarTag, CalcFooter.Tag);
  369. if not OutputBin then begin
  370. Header := Output;
  371. Footer := Pointer (@(PBinData(Output) [Size - SizeOf (TTransferFileFooter)]));
  372. with Header^ do begin
  373. case CalcDest of
  374. cdTI92:
  375. Signature := '**TI92**';
  376. cdTI89:
  377. Signature := '**TI89**'
  378. else
  379. Signature := '**TI92P*';
  380. end;
  381. Reserved1 := Res1;
  382. Reserved2 := Res2;
  383. Reserved3 := Res3;
  384. Reserved4 := Res4;
  385. StrPLCopy (Folder, LowerCase (DestFolder), SizeOf (Folder));
  386. StrPLCopy (VarName, LowerCase (DestVarName), SizeOf (VarName));
  387. case VarTag of
  388. $2D: VarLinkType := $0C;
  389. $DC: VarLinkType := $12;
  390. $F3: VarLinkType := $21;
  391. $F8: VarLinkType := $1C;
  392. else VarLinkType := 0;
  393. end;
  394. WritePCInt (VarLinkType, LinkType);
  395. WritePCInt (Size, FileSize);
  396. end;
  397. Sum := 0;
  398. for I := 0 to CalcSize - 1 do
  399. Inc (Sum, Byte (PBinData(CalcHeader) [I]));
  400. WritePCInt (Sum, Footer.CheckSum);
  401. end;
  402. end;
  403. end;
  404. function GetTransferFileExt(CalcDest: TCalcDest; VarTag: Byte; OutputBin: Boolean = False): string;
  405. var
  406. TypeExt: Char;
  407. begin
  408. case CalcDest of
  409. cdTI92:
  410. Result := '92';
  411. cdTI89:
  412. Result := '89';
  413. cdTI92Plus:
  414. Result := '9x';
  415. cdV200:
  416. Result := 'v2';
  417. else
  418. Result := 'xx';
  419. end;
  420. case VarTag of
  421. $2D: TypeExt := 's';
  422. $DC: TypeExt := 'p';
  423. $F3: TypeExt := 'z';
  424. else TypeExt := 'y';
  425. end;
  426. if OutputBin then
  427. Result := '.' + TypeExt + Result
  428. else
  429. Result := '.' + Result + TypeExt;
  430. end;
  431. function GetOSUpgradeFileSize(ContentLength: LongWord; OutputBin: Boolean = True): LongWord;
  432. begin
  433. Result := ContentLength + SizeOf (TCalcOSFooter);
  434. end;
  435. procedure ProduceOSUpgradeFile(Output: Pointer; Contents: Pointer; ContentLength: LongWord; OutputBin: Boolean = True);
  436. var
  437. CalcFooter: PCalcOSFooter;
  438. begin
  439. Move (Contents^, Output^, ContentLength);
  440. CalcFooter := Pointer (@(PBinData(Output) [ContentLength]));
  441. FillChar (CalcFooter^, SizeOf (TCalcOSFooter), 0);
  442. with CalcFooter^ do begin
  443. WriteCalcInt ($020D, SignatureHeader);
  444. WriteCalcInt ($40, SignatureType);
  445. end;
  446. end;
  447. function GetOSUpgradeFileExt(CalcDest: TCalcDest; OutputBin: Boolean = False): string;
  448. begin
  449. case CalcDest of
  450. cdTI92:
  451. Result := '92';
  452. cdTI89:
  453. Result := '89';
  454. cdTI89Titanium:
  455. Result := '89ti';
  456. cdTI92Plus:
  457. Result := '9x';
  458. cdV200:
  459. Result := 'v2';
  460. else
  461. Result := 'xx';
  462. end;
  463. Result := '-' + Result + '.tib';
  464. end;
  465. end.