Turbo C - BGIOBJ Mode

Author: RetroNick2020

objlib.pas

@@ -26,11 +26,14 @@ procedure Write_SegmentData(var F : File; SegmentIndex: byte; EnumeratedDataOffs
 function GetFileSize(filename : string) : longword;
 Procedure Write_FileContents(var F : File;filename : string;segIdx: byte; dataOffset: word);
 procedure Write_ModEnd(var F : File);
-
 procedure Write_PubDefRecords(var F : File; BaseGroupIndex: byte; BaseSegmentIndex: byte;var rdata;rcount : word);
+
 Function CreateTPObj(infile,outfile,publicname : string) : word;
 Function CreateTPObj(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;
+
 implementation
 
 type
@@ -331,10 +334,10 @@ procedure Write_LeData(var F : File;SegmentIndex : Byte;EnumeratedDataOffset : w
 var
   recordPtr: PByte;
 begin
-  GetMem(recordPtr, dataLength + 3);
+  GetMem(recordPtr, dataLength + 3);       // +3 is for Segmentindex (1) and EnumeratedDataOffset(2)
   recordPtr^ := SegmentIndex;
-  (recordPtr + 1)^ := EnumeratedDataOffset and $FF;
-  (recordPtr + 2)^ := EnumeratedDataOffset shr 8;
+  (recordPtr + 1)^ := EnumeratedDataOffset and $FF;    //  LO(EnumeratedDataOffset);
+  (recordPtr + 2)^ := EnumeratedDataOffset shr 8;      //  HI(EnumeratedDataOffset);
   Move(pbyte(databytes)^, (recordPtr + 3)^, dataLength);
 
   Write_Id_Length_Data(F, $A0,recordPtr^,datalength+3);
@@ -464,5 +467,80 @@ procedure ChangePubDefStr(index : byte;var data; PublicName : string; PublicOffs
  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
+// segname overwrites _TEXT and classname overwrites CODE
+function CreateTCLNames(infile,publicname,segname,classname : string;UseFswitch : boolean) : string;
+var
+ LNames,defaultSegName,defaultClassName : string;
+begin
+ defaultSegName:='_TEXT';
+ defaultClassName:='CODE';
+
+ if segname<>'' then defaultSegName:=segname;
+ if classname<>'' then defaultClassName:=classname;
+
+ if useFswitch and (segname='') then
+ begin
+    defaultSegname:=publicname+'_TEXT';
+    if pos('_',defaultSegname)=1 then Delete(DefaultSegname,1,1);
+ end;
+ LNames:='#'+defaultSegName+'#'+defaultClassName+'#';
+ result:=LNames;
+end;
+
+Function CreateTCObj(infile,outfile,publicname,segname,classname : string;UseFswitch : Boolean) : word;
+var
+ size : word;
+ F    : File;
+ LNames : string;
+begin
+ size:=WORD(GetFileSize(infile));
+{$I-}
+ assign(F,outfile);
+ rewrite(F,1);
+
+ Write_THeadr(F,#$3a#$3a);
+ LNames:=CreateTCLNames(infile,publicname,segname,classname,UseFSwitch);
+ Write_LNames(F,LNames);
+ Write_SegDef(F,$68,size,2,3,1);     //borland TC uses $68  = 2,3,1 - if Overlayindex is not 1 - does not work
+ Write_PubDef(F,0,1,publicname,0,0);
+ Write_FileContents(F,infile,1,0);
+ Write_ModEnd(F);
+ close(F);
+{$I+}
+ result:=IORESULT;
+end;
+
+Function CreateTCObj(infile,outfile,publicname,publicsizename,segname,classname : string;UseFswitch : Boolean) : word;
+var
+ size : word;
+ F    : File;
+ data : array[1..2] of TPubDefStrRec;
+ LNames : string;
+begin
+ size:=WORD(GetFileSize(infile));
+{$I-}
+ assign(F,outfile);
+ rewrite(F,1);
+ Write_THeadr(F,#$3a#$3a);
+ LNames:=CreateTCLNames(infile,publicname,segname,classname,UseFSwitch);
+ Write_LNames(F,LNames);
+
+ Write_SegDef(F,$68,size+2,2,3,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;
+
+
 begin
 end.

rtbinobj.pas

@@ -4,7 +4,7 @@
   uses ObjLib;
 
 Const
- ProgramName = 'RtBinObj v1.1 - Released April 23 - 2023 By RetroNick';
+ ProgramName = 'RtBinObj v1.2 - Released April 24 - 2023 By RetroNick';
 
 procedure Usage;
 begin

rtbinobjform.lfm

@@ -1,11 +1,11 @@
 object Form1: TForm1
-  Left = 599
-  Height = 214
-  Top = 460
-  Width = 556
-  Caption = 'RtBinObj v1.1'
-  ClientHeight = 214
-  ClientWidth = 556
+  Left = 673
+  Height = 269
+  Top = 583
+  Width = 605
+  Caption = 'RtBinObj v1.2 By RetroNick - Released April 24 - 2023'
+  ClientHeight = 269
+  ClientWidth = 605
   Color = clForm
   LCLVersion = '2.0.10.0'
   object InFileButton: TButton
@@ -50,7 +50,7 @@ object Form1: TForm1
     Left = 0
     Height = 32
     Top = 0
-    Width = 556
+    Width = 605
     Alignment = taCenter
     Anchors = [akTop, akLeft, akRight]
     AutoSize = False
@@ -63,18 +63,18 @@ object Form1: TForm1
     OptimalFill = True
   end
   object SaveAsButton: TButton
-    Left = 432
+    Left = 496
     Height = 25
-    Top = 144
+    Top = 216
     Width = 75
     Caption = 'Save As'
     OnClick = SaveAsButtonClick
-    TabOrder = 4
+    TabOrder = 8
   end
   object PublicSizeLabel: TLabel
     Left = 8
     Height = 15
-    Top = 124
+    Top = 128
     Width = 91
     Caption = 'Public Size Name'
     ParentColor = False
@@ -88,6 +88,79 @@ object Form1: TForm1
     ParentFont = False
     TabOrder = 3
   end
+  object SegmentNameLabel: TLabel
+    Left = 16
+    Height = 15
+    Top = 160
+    Width = 82
+    Caption = 'Segment Name'
+    ParentColor = False
+  end
+  object EditSegmentName: TEdit
+    Left = 120
+    Height = 23
+    Top = 152
+    Width = 160
+    Enabled = False
+    MaxLength = 20
+    ParentFont = False
+    TabOrder = 4
+  end
+  object ClassNameLabel: TLabel
+    Left = 36
+    Height = 15
+    Top = 192
+    Width = 62
+    Caption = 'Class Name'
+    ParentColor = False
+  end
+  object EditClassName: TEdit
+    Left = 120
+    Height = 23
+    Top = 184
+    Width = 160
+    Enabled = False
+    MaxLength = 20
+    ParentFont = False
+    TabOrder = 5
+  end
+  object ObjModeRadioGroup: TRadioGroup
+    Left = 416
+    Height = 105
+    Top = 56
+    Width = 168
+    AutoFill = True
+    Caption = 'OBJ Mode'
+    ChildSizing.LeftRightSpacing = 6
+    ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+    ChildSizing.EnlargeVertical = crsHomogenousChildResize
+    ChildSizing.ShrinkHorizontal = crsScaleChilds
+    ChildSizing.ShrinkVertical = crsScaleChilds
+    ChildSizing.Layout = cclLeftToRightThenTopToBottom
+    ChildSizing.ControlsPerLine = 1
+    ClientHeight = 85
+    ClientWidth = 164
+    ItemIndex = 0
+    Items.Strings = (
+      'Turbo Pascal - BINOBJ'
+      'Turbo C - BGIOBJ'
+    )
+    OnClick = ObjModeRadioGroupClick
+    TabOrder = 7
+  end
+  object FarCallCheckBox: TCheckBox
+    Left = 36
+    Height = 19
+    Hint = 'Segment Name must be blank'
+    Top = 222
+    Width = 96
+    BidiMode = bdRightToLeft
+    Caption = '      far calls      '
+    Enabled = False
+    OnChange = FarCallCheckBoxChange
+    ParentBidiMode = False
+    TabOrder = 6
+  end
   object OpenDialog: TOpenDialog
     Left = 440
   end

rtbinobjform.pas

@@ -5,28 +5,40 @@
 interface
 
 uses
-  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,LazFileUtils,objlib;
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
+  LazFileUtils, objlib;
 
 type
 
   { TForm1 }
 
   TForm1 = class(TForm)
+    FarCallCheckBox: TCheckBox;
     EditPublicSizeName: TEdit;
+    EditSegmentName: TEdit;
+    EditClassName: TEdit;
     OpenDialog: TOpenDialog;
     PublicSizeLabel: TLabel;
+    ObjModeRadioGroup: TRadioGroup;
+    SegmentNameLabel: TLabel;
     SaveAsButton: TButton;
     EditFileName: TEdit;
     InfoLabel: TLabel;
     EditPublicName: TEdit;
     InFileButton: TButton;
     PublicLabel: TLabel;
     SaveDialog: TSaveDialog;
+    ClassNameLabel: TLabel;
+    procedure FarCallCheckBoxChange(Sender: TObject);
     procedure InFileButtonClick(Sender: TObject);
+    procedure ObjModeRadioGroupClick(Sender: TObject);
     procedure SaveAsButtonClick(Sender: TObject);
   private
     function ValidFields : boolean;
+    procedure CreateTPOBJFile;
+    procedure CreateTCOBJFile;
     procedure CreateOBJFile;
+
   public
 
   end;
@@ -49,9 +61,51 @@ procedure TForm1.InFileButtonClick(Sender: TObject);
   begin
     InfoLabel.Caption:='';
     EditFileName.Text:=OpenDialog.FileName;
-    sname:=UpperCase(ExtractFileName(ExtractFileNameWithoutExt(OpenDialog.FileName)));
-    EditPublicName.Text:=sname;
-    EditPublicSizeName.Text:=sname+'SIZE';
+    if ObjModeRadioGroup.ItemIndex = 0 then
+    begin
+       sname:=UpperCase(ExtractFileName(ExtractFileNameWithoutExt(OpenDialog.FileName)));
+       EditPublicName.Text:=sname;
+       EditPublicSizeName.Text:=sname+'SIZE';
+    end
+    else
+    begin
+      sname:=LowerCase(ExtractFileName(ExtractFileNameWithoutExt(OpenDialog.FileName)));
+      EditPublicName.Text:='_'+sname;
+      EditPublicSizeName.Text:='_'+sname+'size';
+    end;
+  end;
+end;
+
+procedure TForm1.FarCallCheckBoxChange(Sender: TObject);
+begin
+  if FarCallCheckBox.Checked  then
+  begin
+    EditSegmentName.Text:='';
+    EditSegmentName.Enabled:=false;
+    EditClassName.Text:='';
+    EditClassName.Enabled:=false;
+  end
+  else
+  begin
+    EditSegmentName.Enabled:=true;
+    EditClassName.Enabled:=true;
+  end;
+end;
+
+procedure TForm1.ObjModeRadioGroupClick(Sender: TObject);
+begin
+  if ObjModeRadioGroup.ItemIndex = 0 then
+  begin
+    EditSegmentName.Enabled:=false;
+    EditClassName.Enabled:=false;
+    FarCallCheckbox.Enabled:=false;
+  end
+  else if ObjModeRadioGroup.ItemIndex = 1 then
+  begin
+    EditSegmentName.Enabled:=true;
+    EditClassName.Enabled:=true;
+    FarCallCheckbox.Enabled:=true;
+     FarCallCheckbox.Checked:=false;
   end;
 end;
 
@@ -77,11 +131,10 @@ function TForm1.ValidFields: boolean;
     end;
 end;
 
-procedure TForm1.CreateOBJFile;
+procedure TForm1.CreateTPOBJFile;
 var
   error : word;
 begin
-  if SaveDialog.Execute = false then exit;
   if EditPublicSizeName.Text<>'' then
      error:=CreateTPObj(OpenDialog.Filename,SaveDialog.FileName,EditPublicName.Text,EditPublicSizeName.Text)
    else
@@ -97,5 +150,31 @@ procedure TForm1.CreateOBJFile;
   end;
 end;
 
+procedure TForm1.CreateTCOBJFile;
+var
+  error : word;
+begin
+  if EditPublicSizeName.Text<>'' then
+     error:=CreateTCObj(OpenDialog.Filename,SaveDialog.FileName,EditPublicName.Text,EditPublicSizeName.Text,EditSegmentName.Text,EditClassName.Text,FarCallCheckBox.Checked)
+   else
+     error:=CreateTCObj(OpenDialog.Filename,SaveDialog.FileName,EditPublicName.Text,EditSegmentName.Text,EditClassName.Text,FarCallCheckBox.Checked);
+
+
+  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.CreateOBJFile;
+begin
+  if SaveDialog.Execute = false then exit;
+  if ObjModeRadioGroup.ItemIndex = 0 then CreateTPObjFile else CreateTCObjFile;
+end;
+
 end.