ParsingUnit.pas 18 KB

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