ParsingUnit.pas 15 KB

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