Skip to content

Commit

Permalink
Update to support TMT Pascal Compiler
Browse files Browse the repository at this point in the history
  • Loading branch information
@RetroNick2020
RetroNick2020 committed Dec 22, 2023
1 parent 2df15c5 commit 4f94bd8
Show file tree
Hide file tree
Showing 4 changed files with 152 additions and 35 deletions.
109 changes: 90 additions & 19 deletions objlib.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,9 @@ procedure Write_PubDefRecords(var F : File; BaseGroupIndex: byte; BaseSegmentInd
Function CreateTPObj(infile,outfile,publicname : string) : word;
Function CreateTPObj(infile,outfile,publicname,publicsizename : string) : word;

Function CreateTMTObj(infile,outfile,publicname : string) : word;
Function CreateTMTObj(infile,outfile,publicname,publicsizename : string) : word;

Function CreateTCObj(infile,outfile,publicname,segname,classname : string;UseFswitch : Boolean) : word;
Function CreateTCObj(infile,outfile,publicname,publicsizename,segname,classname : string;UseFswitch : Boolean) : word;

Expand Down Expand Up @@ -489,7 +492,7 @@ procedure Write_LeData32(var F : File;SegmentIndex : Byte;EnumeratedDataOffset :
FreeMem(recordPtr, dataLength + 5);
end;

procedure Write_SegmentData32(var F : File; SegmentIndex: byte; EnumeratedDataOffset: longword; dataBytes : PByte; dataLength: word);
procedure Write_SegmentData32(var F : File; SegmentIndex: byte; EnumeratedDataOffset: longword; dataBytes : PByte; dataLength: longword);
begin
while (dataLength > 1024) do
begin
Expand All @@ -515,6 +518,19 @@ function GetFileSize(filename : string) : longword;
{$I+}
end;

function GetFileSize32(filename : string) : longword;
var
F : File;
begin
Assign(F,filename);
{$I-}
Reset(F,1);
result:=FileSize(F);
close(F);
{$I+}
end;


Procedure Write_FileContents(var F : File;filename : string;segIdx: byte; dataOffset: word);
var
size : longword;
Expand Down Expand Up @@ -603,6 +619,26 @@ function GetFileSize(filename : string) : longword;
end;


procedure ChangePubDefStr(index : byte;var data; PublicName : string; PublicOffset : word; typeindex : byte);
var
DataA : array[1..255] of TPubDefStrRec absolute data;
begin
dataA[index].StringLength:=length(publicname);
dataA[index].PubLicName:=publicname;
dataA[index].PublicOffset:=publicoffset;
dataA[index].TypeIndex:=typeindex;
end;

procedure ChangePubDefStr32(index : byte;var data; PublicName : string; PublicOffset : longword; typeindex : byte);
var
DataA : array[1..255] of TPubDefStrRec32 absolute data;
begin
dataA[index].StringLength:=length(publicname);
dataA[index].PubLicName:=publicname;
dataA[index].PublicOffset:=publicoffset;
dataA[index].TypeIndex:=typeindex;
end;


// create Turbo Pascal Compatile BINOBJ output exactly to the byte level
Function CreateTPObj(infile,outfile,publicname : string) : word;
Expand All @@ -625,51 +661,86 @@ function GetFileSize(filename : string) : longword;
result:=IORESULT;
end;

procedure ChangePubDefStr(index : byte;var data; PublicName : string; PublicOffset : word; typeindex : byte);

Function CreateTPObj(infile,outfile,publicname,publicsizename : string) : word;
var
DataA : array[1..255] of TPubDefStrRec absolute data;
size : word;
F : File;
data : array[1..2] of TPubDefStrRec;
begin
dataA[index].StringLength:=length(publicname);
dataA[index].PubLicName:=publicname;
dataA[index].PublicOffset:=publicoffset;
dataA[index].TypeIndex:=typeindex;
size:=WORD(GetFileSize(infile));
{$I-}
assign(F,outfile);
rewrite(F,1);
Write_THeadr(F,#$3a#$3a);
Write_LNames(F,'#CODE##');
Write_SegDef(F,$28,size+2,2,1,1); //+2 is the addtional bytes we will need to include the size information

ChangePubDefStr(1,data,publicname,0,0);
ChangePubDefStr(2,data,publicsizename,size,0);
Write_PubDefRecords(F,0,1,data,2);

Write_FileContentsAndSize(F,infile,1,0);
Write_ModEnd(F);
close(F);
{$I+}
result:=IORESULT;
end;

procedure ChangePubDefStr32(index : byte;var data; PublicName : string; PublicOffset : longword; typeindex : byte);



Function CreateTMTObj(infile,outfile,publicname : string) : word;
var
DataA : array[1..255] of TPubDefStrRec32 absolute data;
size : longword;
F : File;
begin
dataA[index].StringLength:=length(publicname);
dataA[index].PubLicName:=publicname;
dataA[index].PublicOffset:=publicoffset;
dataA[index].TypeIndex:=typeindex;
size:=GetFileSize32(infile);
{$I-}
assign(F,outfile);
rewrite(F,1);
Write_THeadr(F,#$3a#$3a);
Write_LNames(F,'#CODE##');
Write_SegDef32(F,$28,size,2,1,1);
Write_PubDef(F,0,1,publicname,0,0);
Write_FileContents32(F,infile,1,0);
Write_ModEnd(F);
close(F);
{$I+}
result:=IORESULT;
end;

Function CreateTPObj(infile,outfile,publicname,publicsizename : string) : word;

//public size name will not work TMT Pascal. we can only store 2 bytes for size instead of 4
//tmt compiler would need to understand option 91h
Function CreateTMTObj(infile,outfile,publicname,publicsizename : string) : word;
var
size : word;
size : longword;
F : File;
data : array[1..2] of TPubDefStrRec;
begin
size:=WORD(GetFileSize(infile));
size:=GetFileSize32(infile);
{$I-}
assign(F,outfile);
rewrite(F,1);
Write_THeadr(F,#$3a#$3a);
Write_LNames(F,'#CODE##');
Write_SegDef(F,$28,size+2,2,1,1); //+2 is the addtional bytes we will need to include the size information
Write_SegDef32(F,$28,size+4,2,1,1); //+4 is the addtional bytes we will need to include the size information

ChangePubDefStr(1,data,publicname,0,0);
ChangePubDefStr(2,data,publicsizename,size,0);
ChangePubDefStr(2,data,publicsizename,size,0); // <---we are doomed here
Write_PubDefRecords(F,0,1,data,2);

Write_FileContentsAndSize(F,infile,1,0);
Write_FileContentsAndSize32(F,infile,1,0);
Write_ModEnd(F);
close(F);
{$I+}
result:=IORESULT;
end;




// Turbo C's BGIOBJ /F switch inserts another LName that is the same as the public name
// eg default is _TEXT CODE, if public name is _IMAGE, LName section becomes IMAGE_TEXT CODE
// /F switch has not used when segname is provided
Expand Down
15 changes: 12 additions & 3 deletions rtbinobj.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,11 +7,11 @@
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp,
Classes, SysUtils, CustAPP,
objlib,hunklib,bsavelib,cofflib;

Const
ProgramName = 'RtBinObj v1.6 - Released May 22 - 2023 By RetroNick';
ProgramName = 'RtBinObj v1.7 - Released December 21 - 2023 By RetroNick';

CompTP = 0;
CompTC = 1;
Expand All @@ -20,6 +20,8 @@
CompAmigaHunk = 4;
CompBSAVE = 5;
CompCOFF = 6;
CompTMT = 7;

type
{ RtBinObj }

Expand All @@ -43,6 +45,7 @@ function GetCompModeName(Compiler : integer) : string;
CompAmigaHunk:result:='Amiga Hunk Mode';
CompBSAVE:result:='QuickBasic\GWBASIC BSAVE Mode';
CompCOFF:result:='COFF 32bit Mode';
CompTMT:result:='TMT Pascal Obj Mode';

end;
end;
Expand Down Expand Up @@ -89,6 +92,7 @@ procedure TRTBinObj.DoRun;
'HUNK':CompilerMode:=CompAmigaHunk;
'BSAVE':CompilerMode:=CompBSAVE;
'COFF':CompilerMode:=CompCOFF;
'TMT':CompilerMode:=CompTMT;

end;

Expand Down Expand Up @@ -195,8 +199,13 @@ procedure TRTBinObj.DoRun;
begin
error:=CreateCOFF(infile,outfile,publicname,publicsizename,FALSE);
end;
end
else if CompilerMode = CompTMT then
begin
error:=CreateTMTObj(infile,outfile,publicname);
end;


if error = 0 then writeln('Converted Successfully using ',GetCompModeName(CompilerMode)) else writeln('Looks like we have an error# ',error);

// stop program loop
Expand All @@ -220,7 +229,7 @@ procedure TRTBinObj.WriteHelp;
writeln(programname);
writeln('Usage: RtBinObj infile outfile public_name');
writeln(' Optional -PS public size name');
writeln(' -O OBJ Mode {TP,TC,OW16,OW32,HUNK,BSAVE,COFF}');
writeln(' -O OBJ Mode {TP,TC,TMT,OW16,OW32,HUNK,BSAVE,COFF}');
writeln(' -SN segment name');
writeln(' -CN class name');
writeln(' -HN hunk name (Amiga 68k)');
Expand Down
23 changes: 12 additions & 11 deletions rtbinobjform.lfm
View file
Original file line number Diff line number Diff line change
@@ -1,11 +1,11 @@
object Form1: TForm1
Left = 491
Height = 431
Height = 459
Top = 358
Width = 746
AllowDropFiles = True
BorderIcons = [biSystemMenu, biMinimize]
ClientHeight = 431
ClientHeight = 459
ClientWidth = 746
Color = clForm
OnCreate = FormCreate
Expand Down Expand Up @@ -68,7 +68,7 @@ object Form1: TForm1
object SaveAsButton: TButton
Left = 640
Height = 25
Top = 376
Top = 408
Width = 75
Caption = 'Save As'
OnClick = SaveAsButtonClick
Expand Down Expand Up @@ -129,7 +129,7 @@ object Form1: TForm1
end
object ObjModeRadioGroup: TRadioGroup
Left = 491
Height = 177
Height = 200
Hint = 'Turbo Pascal Mode compatible with QuickPascal and FreePascal 8086'#13#10'Turbo C Mode compatible QuickC'
Top = 64
Width = 224
Expand All @@ -142,7 +142,7 @@ object Form1: TForm1
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 157
ClientHeight = 180
ClientWidth = 220
ItemIndex = 0
Items.Strings = (
Expand All @@ -153,6 +153,7 @@ object Form1: TForm1
'Amiga 68k Hunk (vbcc / freepascal)'
'QuickBasic/GWBASIC (bsave)'
'COFF 32 bit'
'TMT Pascal OBJ'
)
OnClick = ObjModeRadioGroupClick
ParentShowHint = False
Expand All @@ -173,10 +174,10 @@ object Form1: TForm1
TabOrder = 6
end
object AmigaMemRadioGroup: TRadioGroup
Left = 491
Left = 494
Height = 96
Top = 256
Width = 185
Top = 280
Width = 221
AutoFill = True
Caption = 'Amiga Memory Type'
ChildSizing.LeftRightSpacing = 6
Expand All @@ -187,7 +188,7 @@ object Form1: TForm1
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 76
ClientWidth = 181
ClientWidth = 217
Enabled = False
ItemIndex = 0
Items.Strings = (
Expand All @@ -199,10 +200,10 @@ object Form1: TForm1
TabOrder = 8
end
object OpenDialog: TOpenDialog
Left = 440
Left = 640
end
object SaveDialog: TSaveDialog
Options = [ofOverwritePrompt, ofEnableSizing, ofViewDetail]
Left = 509
Left = 688
end
end
40 changes: 38 additions & 2 deletions rtbinobjform.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ interface
LazFileUtils, objlib,hunklib,bsavelib,cofflib;

Const
ProgramName = 'RtBinObj v1.6 By RetroNick - Released May 22 - 2023';
ProgramName = 'RtBinObj v1.7 By RetroNick - Released December 21 - 2023';

type

Expand Down Expand Up @@ -46,6 +46,9 @@ TForm1 = class(TForm)
function ValidFields : boolean;
procedure SetPublicNames;
procedure CreateTPOBJFile;

procedure CreateTMTOBJFile;

procedure CreateTCOBJFile;
procedure CreateOBJFile;
procedure CreateOWDOS32OBJFile;
Expand Down Expand Up @@ -241,7 +244,19 @@ procedure TForm1.ObjModeRadioGroupClick(Sender: TObject);
AmigaMemRadioGroup.Enabled:=false;
FarCallCheckbox.Enabled:=false;
FarCallCheckbox.Checked:=false;
end;
end
else if ObjModeRadioGroup.ItemIndex = 7 then
begin
EditPublicName.Enabled:=true;
EditPublicSizeName.Enabled:=false;
EditSegmentName.Enabled:=false;
EditClassName.Enabled:=false;
SegmentNameLabel.Caption:='Segment Name';

AmigaMemRadioGroup.Enabled:=false;
FarCallCheckbox.Enabled:=false;
FarCallCheckbox.Checked:=false;
end;
end;

procedure TForm1.SaveAsButtonClick(Sender: TObject);
Expand Down Expand Up @@ -289,6 +304,26 @@ procedure TForm1.CreateTPOBJFile;
end;
end;

procedure TForm1.CreateTMTOBJFile;
var
error : word;
begin
InfoLabel.Caption:='We are In correct area';
if EditPublicSizeName.Text<>'' then
error:=CreateTMTObj(OpenDialog.Filename,SaveDialog.FileName,EditPublicName.Text,EditPublicSizeName.Text)
else
error:=CreateTMTObj(OpenDialog.Filename,SaveDialog.FileName,EditPublicName.Text);

if error=0 then
begin
InfoLabel.Caption:='New Obj successfully created and saved!';
end
else
begin
InfoLabel.Caption:='Ouch it looks like we had booboo #'+IntToStr(error);
end;
end;

procedure TForm1.CreateTCOBJFile;
var
error : word;
Expand Down Expand Up @@ -414,6 +449,7 @@ procedure TForm1.CreateOBJFile;
4:CreateAmigaHunkFile;
5:CreateBSaveFile;
6:CreateCOFFFile;
7:CreateTMTObjFile;

end;
end;
Expand Down

0 comments on commit 4f94bd8

Please sign in to comment.