Update to support TMT Pascal Compiler

Author: RetroNick2020

objlib.pas

@@ -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;
 
@@ -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
@@ -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;
@@ -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;
@@ -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

rtbinobj.pas

@@ -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;
@@ -20,6 +20,8 @@
   CompAmigaHunk = 4;
   CompBSAVE = 5;
   CompCOFF  = 6;
+  CompTMT   = 7;
+
 type
   { RtBinObj }
 
@@ -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;
@@ -89,6 +92,7 @@ procedure TRTBinObj.DoRun;
                                          'HUNK':CompilerMode:=CompAmigaHunk;
                                          'BSAVE':CompilerMode:=CompBSAVE;
                                          'COFF':CompilerMode:=CompCOFF;
+                                         'TMT':CompilerMode:=CompTMT;
 
   end;
 
@@ -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
@@ -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)');

rtbinobjform.lfm

@@ -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
@@ -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
@@ -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
@@ -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 = (
@@ -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
@@ -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
@@ -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 = (
@@ -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

rtbinobjform.pas

@@ -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
 
@@ -46,6 +46,9 @@   TForm1 = class(TForm)
     function ValidFields : boolean;
     procedure SetPublicNames;
     procedure CreateTPOBJFile;
+
+    procedure CreateTMTOBJFile;
+
     procedure CreateTCOBJFile;
     procedure CreateOBJFile;
     procedure CreateOWDOS32OBJFile;
@@ -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);
@@ -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;
@@ -414,6 +449,7 @@ procedure TForm1.CreateOBJFile;
                                       4:CreateAmigaHunkFile;
                                       5:CreateBSaveFile;
                                       6:CreateCOFFFile;
+                                      7:CreateTMTObjFile;
 
   end;
 end;