123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524 |
- {
- TIGCC IDE
- Copyright (C) 2000-2004 Sebastian Reichelt
- Copyright (C) 2005 Kevin Kofler
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2, or (at your option)
- any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- }
- unit ParsingUnit;
- interface
- uses
- CalcUnit,
- SysUtils, Classes;
- const
- LineIndicator = '#L';
- OffsetIndicator = '#$';
- PatchToken = '$$PATCH';
- ErrorToken = '$$ERROR';
- WarningToken = '$$WARNING';
- ALineIdentifier = '_A_LINE';
- FLineIdentifier = '_F_LINE';
- SParseError = 'Line %d: Parse error before ''%s''';
- type
- EFileParseError = class(Exception);
- PBoolean = ^Boolean;
- type
- TCalcInt1 = packed record
- Int: Byte;
- end;
- PCalcInt1 = ^TCalcInt1;
- TCalcInt2 = packed record
- Hi,
- Lo: TCalcInt1;
- end;
- PCalcInt2 = ^TCalcInt2;
- TCalcInt4 = packed record
- Hi,
- Lo: TCalcInt2;
- end;
- PCalcInt4 = ^TCalcInt4;
- TPCInt1 = packed record
- Int: Byte;
- end;
- PPCInt1 = ^TPCInt1;
- TPCInt2 = packed record
- Lo,
- Hi: TPCInt1;
- end;
- PPCInt2 = ^TPCInt2;
- TPCInt4 = packed record
- Lo,
- Hi: TPCInt2;
- end;
- PPCInt4 = ^TPCInt4;
- function ReadCalcInt(Int: TCalcInt1): Byte; overload;
- function ReadCalcInt(Int: TCalcInt2): Word; overload;
- function ReadCalcInt(Int: TCalcInt4): LongWord; overload;
- procedure WriteCalcInt(Input: Byte; out Int: TCalcInt1); overload;
- procedure WriteCalcInt(Input: Word; out Int: TCalcInt2); overload;
- procedure WriteCalcInt(Input: LongWord; out Int: TCalcInt4); overload;
- function ReadPCInt(Int: TPCInt1): Byte; overload;
- function ReadPCInt(Int: TPCInt2): Word; overload;
- function ReadPCInt(Int: TPCInt4): LongWord; overload;
- procedure WritePCInt(Input: Byte; out Int: TPCInt1); overload;
- procedure WritePCInt(Input: Word; out Int: TPCInt2); overload;
- procedure WritePCInt(Input: LongWord; out Int: TPCInt4); overload;
- type
- TTFRes2 = array [0..1] of Byte;
- TTFRes3 = array [0..2] of Byte;
- TTFRes6 = array [0..5] of Byte;
- TTransferFileHeader = packed record
- Signature: array [0..7] of Char; // "**TI92P*" or "**TI89**"
- Reserved1: TTFRes2; // 01 00
- Folder: array [0..7] of Char; // folder name
- Desc: array [0..39] of Char; // not used
- Reserved2: TTFRes6; // 01 00 52 00 00 00
- VarName: array [0..7] of Char; // variable name
- LinkType: TPCInt1; // variable link type (0C = string, 1C = other, 21 = program, ...)
- Reserved3: TTFRes3; // 00 00 00
- FileSize: TPCInt4; // file size from Signature to CheckSum
- Reserved4: TTFRes6; // A5 5A 00 00 00 00
- end;
- PTransferFileHeader = ^TTransferFileHeader;
- TCalcVarHeader = packed record
- DataSize: TCalcInt2; // data size (including Tag)
- end;
- PCalcVarHeader = ^TCalcVarHeader;
- TCalcVarFooter = packed record
- Tag: TCalcInt1; // variable tag
- end;
- PCalcVarFooter = ^TCalcVarFooter;
- TTransferFileFooter = packed record
- CheckSum: TPCInt2; // checksum from DataSize to Tag
- end;
- PTransferFileFooter = ^TTransferFileFooter;
- TCalcOSFooter = packed record
- CheckSum: TCalcInt4; // encrypted checksum
- SignatureHeader: TCalcInt2; // 02 0D
- SignatureType: TCalcInt1; // 40
- Signature: array [0..63] of Byte; // signature, encrypted using TI's private key
- end;
- PCalcOSFooter = ^TCalcOSFooter;
- PBinData = PChar;
- const
- MaxCalcAllocBlock = $FFF0;
- procedure ParseSFile(Contents: TStringList);
- procedure ParsePStarter(const InputFile: string; const OutputFile: string; const PackVar: string);
- function GetCalcVarSize(ContentLength: LongWord; const Extension: string = ''): LongWord;
- function GetTransferFileSize(ContentLength: LongWord; const Extension: string = ''; OutputBin: Boolean = False): LongWord;
- procedure ProduceTransferFile(Output: Pointer; Contents: Pointer; ContentLength: LongWord; CalcDest: TCalcDest; const DestFolder, DestVarName: string; VarTag: Byte; const Extension: string = ''; OutputBin: Boolean = False);
- function GetTransferFileExt(CalcDest: TCalcDest; VarTag: Byte; OutputBin: Boolean = False): string;
- function GetOSUpgradeFileSize(ContentLength: LongWord; OutputBin: Boolean = True): LongWord;
- procedure ProduceOSUpgradeFile(Output: Pointer; Contents: Pointer; ContentLength: LongWord; OutputBin: Boolean = True);
- function GetOSUpgradeFileExt(CalcDest: TCalcDest; OutputBin: Boolean = False): string;
- var
- ErrorMessageProc: procedure(const Msg: string) = nil;
- implementation
- uses
- Windows, UtilsDos;
- { General parsing procedures }
- procedure ParseSFile(Contents: TStringList);
- var
- I,
- P1,
- P2: Integer;
- RegRelative,
- NeedFLine,
- Changed: Boolean;
- L: string;
- begin
- RegRelative := False;
- NeedFLine := False;
- with Contents do begin
- for I := 0 to Count - 1 do begin
- L := Strings [I];
- if L = #9'.set __relation,__ld_entry_point_plus_0x8000' then
- RegRelative := True;
- if Pos (FLineIdentifier, L) > 0 then
- NeedFLine := True;
- if not ((Copy (L, 1, Length (#9'.ascii')) = #9'.ascii') or (Copy (L, 1, Length (#9'.asciz')) = #9'.asciz')) then begin
- if RegRelative then begin
- P1 := Pos ('-__relation', L);
- while P1 > 0 do begin
- P2 := PosEx ('_CALL_', L, P1, True);
- if (P2 > 0) and (P2 < P1) and (P1 - P2 <= Length ('_CALL_') + 4) then begin
- System.Delete (L, P1, Length ('-__relation') + 1);
- while (Length (L) > 0) and (L [P1] <> ')') do
- System.Delete (L, P1, 1);
- System.Delete (L, P1, 1);
- Strings [I] := L;
- end;
- P2 := PosEx ('_ER_CODE_', L, P1, True);
- if (P2 > 0) and (P2 < P1) and (P1 - P2 <= Length ('_ER_CODE_') + 5) then begin
- System.Delete (L, P1, Length ('-__relation') + 1);
- while (Length (L) > 0) and (L [P1] <> ')') do
- System.Delete (L, P1, 1);
- System.Delete (L, P1, 1);
- Strings [I] := L;
- end;
- P1 := PosEx ('-__relation', L, P1 + 1);
- end;
- end;
- 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
- System.Delete (L, 1, Length (#9'jxx _ER_CODE_'));
- if Length (L) <= 4 then
- Strings [I] := #9'.word _A_LINE+' + L;
- end else begin
- Changed := True;
- if (Copy (L, 1, Length (#9'jbsr')) = #9'jbsr') and (Pos ('_CALL_', L) > 0) then
- System.Delete (L, 1 + Length (#9'j'), Length ('b'))
- else if (Copy (L, 1, Length (#9'jra')) = #9'jra') and (Pos ('_CALL_', L) > 0) then begin
- System.Delete (L, 1, Length (#9'jra'));
- L := #9'jmp' + L;
- end else if Copy (L, 1, Length (#9'move.l #__ld_calc_const_')) = #9'move.l #__ld_calc_const_' then
- L [1 + Length (#9'move.')] := 'w'
- else
- Changed := False;
- if NeedFLine and (Copy (L, 1, Length (#9'jsr _ROM_CALL_')) = #9'jsr _ROM_CALL_') then begin
- System.Delete (L, 1, Length (#9'jsr _ROM_CALL_'));
- if Length (L) <= 3 then
- Strings [I] := #9'.word _F_LINE+0x' + L;
- end else begin
- P1 := Pos ('_ROM_CALL_', L);
- while P1 > 0 do begin
- P2 := P1;
- Inc (P1, Length ('_ROM_CALL_'));
- while (P1 <= Length (L)) and (L [P1] in ['0'..'9', 'a'..'z', 'A'..'Z', '_', '+', '-', '*', '/']) do
- Inc (P1);
- while (P1 <= Length (L)) and (L [P1] in [':', 'a'..'z', 'A'..'Z']) do
- System.Delete (L, P1, 1);
- System.Insert (':l', L, P1);
- Inc (P1, Length (':l'));
- if LowerCase (Copy (L, P1, Length ('(%pc)'))) = '(%pc)' then
- System.Delete (L, P1, Length ('(%pc)'))
- else if (LowerCase (Copy (L, P1, Length (',%pc)'))) = ',%pc)') and (P2 - 1 > 0) and (L [P2 - 1] = '(') then begin
- System.Delete (L, P1, Length (',%pc)'));
- System.Delete (L, P2 - 1, 1);
- end;
- Changed := True;
- P1 := PosEx ('_ROM_CALL_', L, P1);
- end;
- P1 := Pos ('__ld_calc_const_', L);
- while P1 > 0 do begin
- P2 := P1;
- Inc (P1, Length ('__ld_calc_const_'));
- while (P1 <= Length (L)) and (L [P1] in ['0'..'9', 'a'..'z', 'A'..'Z', '_', ':']) do
- Inc (P1);
- if LowerCase (Copy (L, P1, Length ('(%pc)'))) = '(%pc)' then begin
- System.Delete (L, P1, Length ('(%pc)'));
- Changed := True;
- end else if (LowerCase (Copy (L, P1, Length (',%pc)'))) = ',%pc)') and (P2 - 1 > 0) and (L [P2 - 1] = '(') then begin
- System.Delete (L, P1, Length (',%pc)'));
- System.Delete (L, P2 - 1, 1);
- Changed := True;
- end;
- P1 := PosEx ('__ld_calc_const_', L, P1);
- end;
- if Changed then
- Strings [I] := L;
- end;
- end;
- end;
- end;
- end;
- end;
- procedure ParsePStarter(const InputFile: string; const OutputFile: string; const PackVar: string);
- const
- TempProg = 'TEMPPROG';
- var
- I: Integer;
- ObjectFile: TMemoryStream;
- Buf: PChar;
- Len: Integer;
- TempBuf: array [0..Length(TempProg)] of Char;
- begin
- TempBuf [Length (TempProg)] := #0;
- ObjectFile := TMemoryStream.Create;
- try
- ObjectFile.LoadFromFile (InputFile);
- Buf := ObjectFile.Memory;
- Len := ObjectFile.Size;
- for I := 0 to Len - Length (TempProg) do
- if UpCase (Buf [I]) = TempProg [1] then begin
- Move (Buf [I], TempBuf, Length (TempProg));
- if UpperCase (AnsiString (TempBuf)) = TempProg then begin
- FillChar (Buf [I], Length (TempProg), 0);
- StrPLCopy (PChar (@(Buf [I])), LowerCase (PackVar), Length (TempProg));
- Break;
- end;
- end;
- ObjectFile.SaveToFile (OutputFile);
- finally
- ObjectFile.Free;
- end;
- end;
- { Functions to read integers machine-independently }
- function ReadCalcInt(Int: TCalcInt1): Byte;
- begin
- Result := Int.Int;
- end;
- function ReadCalcInt(Int: TCalcInt2): Word;
- begin
- Result := ReadCalcInt (Int.Hi) shl (SizeOf (Int.Lo) * 8) or ReadCalcInt (Int.Lo);
- end;
- function ReadCalcInt(Int: TCalcInt4): LongWord;
- begin
- Result := ReadCalcInt (Int.Hi) shl (SizeOf (Int.Lo) * 8) or ReadCalcInt (Int.Lo);
- end;
- function ReadPCInt(Int: TPCInt1): Byte;
- begin
- Result := Int.Int;
- end;
- function ReadPCInt(Int: TPCInt2): Word;
- begin
- Result := ReadPCInt (Int.Hi) shl (SizeOf (Int.Lo) * 8) or ReadPCInt (Int.Lo);
- end;
- function ReadPCInt(Int: TPCInt4): LongWord;
- begin
- Result := ReadPCInt (Int.Hi) shl (SizeOf (Int.Lo) * 8) or ReadPCInt (Int.Lo);
- end;
- { Functions to write integers machine-independently }
- procedure WriteCalcInt(Input: Byte; out Int: TCalcInt1);
- begin
- Int.Int := Input;
- end;
- procedure WriteCalcInt(Input: Word; out Int: TCalcInt2);
- begin
- WriteCalcInt (Byte (Input shr (SizeOf (Int.Lo) * 8)), Int.Hi);
- WriteCalcInt (Byte (Input), Int.Lo);
- end;
- procedure WriteCalcInt(Input: LongWord; out Int: TCalcInt4);
- begin
- WriteCalcInt (Word (Input shr (SizeOf (Int.Lo) * 8)), Int.Hi);
- WriteCalcInt (Word (Input), Int.Lo);
- end;
- procedure WritePCInt(Input: Byte; out Int: TPCInt1);
- begin
- Int.Int := Input;
- end;
- procedure WritePCInt(Input: Word; out Int: TPCInt2);
- begin
- WritePCInt (Byte (Input shr (SizeOf (Int.Lo) * 8)), Int.Hi);
- WritePCInt (Byte (Input), Int.Lo);
- end;
- procedure WritePCInt(Input: LongWord; out Int: TPCInt4);
- begin
- WritePCInt (Word (Input shr (SizeOf (Int.Lo) * 8)), Int.Hi);
- WritePCInt (Word (Input), Int.Lo);
- end;
- { Calculator file creation functions }
- function GetCalcVarSize(ContentLength: LongWord; const Extension: string = ''): LongWord;
- begin
- Result := SizeOf (TCalcVarHeader) + ContentLength + SizeOf (TCalcVarFooter);
- if Length (Extension) > 0 then
- Inc (Result, Length (Extension) + 2);
- if Result > MaxCalcAllocBlock then
- Result := 0;
- end;
- function GetTransferFileSize(ContentLength: LongWord; const Extension: string = ''; OutputBin: Boolean = False): LongWord;
- begin
- Result := GetCalcVarSize (ContentLength, Extension);
- if (Result > 0) and (not OutputBin) then
- Inc (Result, SizeOf (TTransferFileHeader) + SizeOf (TTransferFileFooter));
- end;
- procedure ProduceTransferFile(Output: Pointer; Contents: Pointer; ContentLength: LongWord; CalcDest: TCalcDest; const DestFolder, DestVarName: string; VarTag: Byte; const Extension: string = ''; OutputBin: Boolean = False);
- const
- Res1: TTFRes2 = ($01, $00);
- Res2: TTFRes6 = ($01, $00, $52, $00, $00, $00);
- Res3: TTFRes3 = ($00, $00, $00);
- Res4: TTFRes6 = ($A5, $5A, $00, $00, $00, $00);
- var
- Size,
- CalcSize: LongWord;
- Header: PTransferFileHeader;
- CalcHeader: PCalcVarHeader;
- CalcFooter: PCalcVarFooter;
- Footer: PTransferFileFooter;
- Data: Pointer;
- VarLinkType: Byte;
- I,
- Sum: Word;
- begin
- CalcSize := GetCalcVarSize (ContentLength, Extension);
- Size := GetTransferFileSize (ContentLength, Extension, OutputBin);
- if Size > 0 then begin
- FillChar (Output^, Size, 0);
- if OutputBin then begin
- CalcHeader := Output;
- CalcFooter := Pointer (@(PBinData(Output) [Size - SizeOf (TCalcVarFooter)]));
- Data := @(PBinData(Output) [SizeOf (TCalcVarHeader)]);
- end else begin
- CalcHeader := Pointer (@(PBinData(Output) [SizeOf (TTransferFileHeader)]));
- CalcFooter := Pointer (@(PBinData(Output) [Size - SizeOf (TTransferFileFooter) - SizeOf (TCalcVarFooter)]));
- Data := @(PBinData(Output) [SizeOf (TTransferFileHeader) + SizeOf (TCalcVarHeader)]);
- end;
- WriteCalcInt (CalcSize - SizeOf (TCalcInt2), CalcHeader.DataSize);
- Move (Contents^, Data^, ContentLength);
- if Length (Extension) > 0 then
- StrPCopy (Pointer (@(PBinData(Data) [ContentLength + 1])), Extension);
- WriteCalcInt (VarTag, CalcFooter.Tag);
- if not OutputBin then begin
- Header := Output;
- Footer := Pointer (@(PBinData(Output) [Size - SizeOf (TTransferFileFooter)]));
- with Header^ do begin
- case CalcDest of
- cdTI92:
- Signature := '**TI92**';
- cdTI89:
- Signature := '**TI89**'
- else
- Signature := '**TI92P*';
- end;
- Reserved1 := Res1;
- Reserved2 := Res2;
- Reserved3 := Res3;
- Reserved4 := Res4;
- StrPLCopy (Folder, LowerCase (DestFolder), SizeOf (Folder));
- StrPLCopy (VarName, LowerCase (DestVarName), SizeOf (VarName));
- case VarTag of
- $2D: VarLinkType := $0C;
- $DC: VarLinkType := $12;
- $F3: VarLinkType := $21;
- $F8: VarLinkType := $1C;
- else VarLinkType := 0;
- end;
- WritePCInt (VarLinkType, LinkType);
- WritePCInt (Size, FileSize);
- end;
- Sum := 0;
- for I := 0 to CalcSize - 1 do
- Inc (Sum, Byte (PBinData(CalcHeader) [I]));
- WritePCInt (Sum, Footer.CheckSum);
- end;
- end;
- end;
- function GetTransferFileExt(CalcDest: TCalcDest; VarTag: Byte; OutputBin: Boolean = False): string;
- var
- TypeExt: Char;
- begin
- case CalcDest of
- cdTI92:
- Result := '92';
- cdTI89:
- Result := '89';
- cdTI92Plus:
- Result := '9x';
- cdV200:
- Result := 'v2';
- else
- Result := 'xx';
- end;
- case VarTag of
- $2D: TypeExt := 's';
- $DC: TypeExt := 'p';
- $F3: TypeExt := 'z';
- else TypeExt := 'y';
- end;
- if OutputBin then
- Result := '.' + TypeExt + Result
- else
- Result := '.' + Result + TypeExt;
- end;
- function GetOSUpgradeFileSize(ContentLength: LongWord; OutputBin: Boolean = True): LongWord;
- begin
- Result := ContentLength + SizeOf (TCalcOSFooter);
- end;
- procedure ProduceOSUpgradeFile(Output: Pointer; Contents: Pointer; ContentLength: LongWord; OutputBin: Boolean = True);
- var
- CalcFooter: PCalcOSFooter;
- begin
- Move (Contents^, Output^, ContentLength);
- CalcFooter := Pointer (@(PBinData(Output) [ContentLength]));
- FillChar (CalcFooter^, SizeOf (TCalcOSFooter), 0);
- with CalcFooter^ do begin
- WriteCalcInt ($020D, SignatureHeader);
- WriteCalcInt ($40, SignatureType);
- end;
- end;
- function GetOSUpgradeFileExt(CalcDest: TCalcDest; OutputBin: Boolean = False): string;
- begin
- case CalcDest of
- cdTI92:
- Result := '92';
- cdTI89:
- Result := '89';
- cdTI89Titanium:
- Result := '89ti';
- cdTI92Plus:
- Result := '9x';
- cdV200:
- Result := 'v2';
- else
- Result := 'xx';
- end;
- Result := '-' + Result + '.tib';
- end;
- end.
|