Skip to content

Commit 50021d4

Browse files
RetroNick2020RetroNick2020
committed
COFF Support
1 parent cc10d5f commit 50021d4

File tree

5 files changed

+267
-21
lines changed

5 files changed

+267
-21
lines changed

‎cofflib.pas‎

Lines changed: 198 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,198 @@
1+
unit cofflib;
2+
3+
{$mode objfpc}{$H+}
4+
5+
interface
6+
uses
7+
Classes, SysUtils,DateUtils;
8+
9+
Function CreateCOFF(inFile,OutFile,PublicName,publicsizename : String; UseFileSizeSymbol : Boolean) : word;
10+
11+
implementation
12+
13+
type
14+
TCOFFHeader = packed record
15+
Machine: Word;
16+
NumberOfSections: Word;
17+
TimeDateStamp: LongWord;
18+
PointerToSymbolTable: LongWord;
19+
NumberOfSymbols: LongWord;
20+
SizeOfOptionalHeader: Word;
21+
Characteristics: Word;
22+
end;
23+
24+
TCOFFSectionHeader = packed record
25+
Name: array[0..7] of Char;
26+
VirtualSize: LongWord;
27+
VirtualAddress: LongWord;
28+
SizeOfRawData: LongWord;
29+
PointerToRawData: LongWord;
30+
PointerToRelocations: LongWord;
31+
PointerToLinenumbers: LongWord;
32+
NumberOfRelocations: Word;
33+
NumberOfLinenumbers: Word;
34+
Characteristics: LongWord;
35+
end;
36+
37+
TCOFFSymbolTable = packed record
38+
PointerToName : LongWord; //0 by default
39+
Offset : LongWord; //first entry starts at 4 offset; there is longword size of string table
40+
Value : LongWord; //for name_size put value in this and SectionNumber = $FFFF
41+
SectionNumber : Word; // should be 1 for .data
42+
SType : Word; // should be 0 for name
43+
StorageClass : Byte; // 2
44+
AuxSymbols : Byte; // 0
45+
end;
46+
47+
TCOFFStringTable = packed record
48+
Length : LongWord; // includes this field (4 bytes) as part of string table length = all strings added up + 4 bytes
49+
Names : array[0..255] of char; // just storing 2 strings - going to limit names to 20 chars each
50+
end;
51+
52+
TCOFFSymbolTableArray = array[1..2] of TCOFFSymbolTable;
53+
var
54+
coff_header: TCOFFHeader;
55+
section_headers: TCOFFSectionHeader;
56+
section_data: TMemoryStream;
57+
section_data_size: LongWord;
58+
out_file: TFileStream;
59+
string_symbol_table : TCOFFSymbolTableArray;
60+
string_table : TCOFFStringTable;
61+
62+
procedure SetHeader(var H : TCOFFHeader;fsize : LongWord;UseFileSizeSymbol : boolean);
63+
begin
64+
// Set the COFF header fields
65+
H.Machine := $14C;
66+
H.NumberOfSections := 1;
67+
H.TimeDateStamp := DateTimeToUnix(Now);
68+
H.PointerToSymbolTable := SizeOf(TCOFFHeader) + SizeOf(TCOFFSectionHeader)+((4+fsize+15) div 16)*16; // rounded to LongWords
69+
if UseFileSizeSymbol then H.NumberOfSymbols := 2 else H.NumberOfSymbols := 1; //name and name_size
70+
H.SizeOfOptionalHeader := 0;
71+
H.Characteristics := $105;
72+
end;
73+
74+
procedure setsectionheader(var SH : TCOFFSectionHeader; fsize : LongWord);
75+
begin
76+
// Set the section header fields
77+
SH.Name := '.data'#0#0#0; //pad with nulls
78+
SH.VirtualSize := 0;
79+
SH.VirtualAddress := 0;
80+
SH.SizeOfRawData := ((4+fsize+15) div 16)*16 ; // ((4 + size +15 ) div 16) *16
81+
SH.PointerToRawData := SizeOf(TCOFFHeader) + SizeOf(TCOFFSectionHeader); //just after the headers
82+
SH.PointerToRelocations := 0;
83+
SH.PointerToLinenumbers := 0;
84+
SH.NumberOfRelocations := 0;
85+
SH.NumberOfLinenumbers := 0;
86+
SH.Characteristics := $40;
87+
end;
88+
89+
procedure SetStringValues(var STA : TCOFFSymbolTableArray;stable : word;offset,value : longword;sectionnumber,stype :word; StorageClass,AuxSymbols : byte);
90+
begin
91+
STA[stable].PointerToName:=0;
92+
STA[stable].Offset:=offset;
93+
STA[stable].value:=value;
94+
STA[stable].sectionnumber:=sectionnumber;
95+
STA[stable].stype:=stype;
96+
STA[stable].storageclass:=storageclass;
97+
STA[stable].auxsymbols:=auxsymbols;
98+
end;
99+
100+
procedure SetStringData(var STA : TCOFFSymbolTableArray;
101+
var STRT : TCOFFStringTable;
102+
sname,name_size : shortstring; fsize : longword; UseFileSizeSymbol : boolean);
103+
begin
104+
FillChar(STRT.names,sizeof(STRT.names),0); //clear the string tables with nulls
105+
106+
SetStringValues(STA,1,4,4,1,0,2,0);
107+
SetStringValues(STA,2,4+length(sname)+1,fsize,$FFFF,0,2,0);
108+
if UseFileSizeSymbol then
109+
STRT.Length:=4+length(sname)+1+length(name_size)+1
110+
else
111+
STRT.Length:=4+length(sname)+1;
112+
113+
Move(sname[1],STRT.names[0],length(sname));
114+
if UseFileSizeSymbol then Move(name_size[1],STRT.names[length(sname)+1],length(name_size));
115+
end;
116+
117+
procedure WriteHeader(var F : File;var H : TCOFFHeader);
118+
begin
119+
Blockwrite(F,H, SizeOf(H));
120+
end;
121+
122+
procedure WriteSectionHeader(var F : File;var SH : TCOFFSectionHeader);
123+
begin
124+
Blockwrite(F,SH, SizeOf(SH));
125+
end;
126+
127+
procedure WriteSectionData(var F : File;var Data; DataSize,rawsize : LongWord); //rawsize is the longword alligned size
128+
var
129+
startpad : longword =0;
130+
zeropadlength : longword;
131+
padbytes : array[1..32] of byte;
132+
begin
133+
Blockwrite(F,startpad,sizeof(startpad));
134+
Blockwrite(F,Data, DataSize);
135+
zeropadlength:=rawsize-DataSize-sizeof(startpad);
136+
FillChar(padbytes,sizeof(padbytes),0);
137+
Blockwrite(F,padbytes,zeropadlength);
138+
end;
139+
140+
procedure WriteSymbolTable(var F:File;var STA : TCOFFSymbolTableArray;UseFileSizeSymbol : Boolean);
141+
begin
142+
if UseFileSizeSymbol then
143+
Blockwrite(F,STA,sizeof(STA))
144+
else
145+
Blockwrite(F,STA[1],sizeof(STA[1]));
146+
end;
147+
148+
procedure WriteStringTable(var F:File;var STRT : TCOFFStringTable);
149+
begin
150+
Blockwrite(F,STRT,STRT.length);
151+
end;
152+
153+
Function CreateCOFF(inFile,OutFile,PublicName,publicsizename : String; UseFileSizeSymbol : Boolean) : word;
154+
var
155+
inF,OutF : File;
156+
error : word;
157+
InFileSize : Longword;
158+
H : TCOFFHeader;
159+
SH : TCOFFSectionHeader;
160+
STA : TCOFFSymbolTableArray;
161+
STRT : TCOFFStringTable;
162+
Data : Pointer;
163+
begin
164+
{$I-}
165+
Assign(inF,inFile);
166+
Reset(inF,1);
167+
InFileSize:=FileSize(inF);
168+
GetMem(Data,InFileSize);
169+
if Data<>NIL then
170+
begin
171+
Blockread(inF,Data^,InFileSize);
172+
173+
SetHeader(H,InFileSize,UseFileSizeSymbol);
174+
SetSectionHeader(SH,InFileSize);
175+
SetStringData(STA,STRT,PublicName,PublicSizeName,InFileSize,UseFileSizeSymbol);
176+
177+
Assign(outF,OutFile);
178+
Rewrite(outF,1);
179+
180+
WriteHeader(outF,H);
181+
WriteSectionHeader(outF,SH);
182+
WriteSectionData(outF,Data^,InFileSize,SH.SizeOfRawData);
183+
WriteSymbolTable(outF,STA,UseFileSizeSymbol);
184+
WriteStringTable(outF,STRT);
185+
186+
close(outF);
187+
FreeMem(Data,InFileSize);
188+
end;
189+
close(inF);
190+
{$I+}
191+
result:=IORESULT;
192+
end;
193+
194+
195+
begin
196+
197+
end.
198+

‎rtbinobj.pas‎

Lines changed: 23 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -8,18 +8,18 @@
88
cthreads,
99
{$ENDIF}{$ENDIF}
1010
Classes, SysUtils, CustApp,
11-
objlib,hunklib,bsavelib;
11+
objlib,hunklib,bsavelib,cofflib;
1212

1313
Const
14-
ProgramName = 'RtBinObj v1.4 - Released May 1 - 2023 By RetroNick';
14+
ProgramName = 'RtBinObj v1.5 - Released May 17 - 2023 By RetroNick';
1515

1616
CompTP = 0;
1717
CompTC = 1;
1818
CompOW16 = 2;
1919
CompOW32 = 3;
2020
CompAmigaHunk = 4;
2121
CompBSAVE = 5;
22-
22+
CompCOFF = 6;
2323
type
2424
{ RtBinObj }
2525

@@ -42,6 +42,7 @@ function GetCompModeName(Compiler : integer) : string;
4242
CompOW32:result:='Open Watcom DOS 32bit Mode';
4343
CompAmigaHunk:result:='Amiga Hunk Mode';
4444
CompBSAVE:result:='QuickBasic\GWBASIC BSAVE Mode';
45+
CompCOFF:result:='COFF 32bit Mode';
4546

4647
end;
4748
end;
@@ -87,9 +88,11 @@ procedure TRTBinObj.DoRun;
8788
'OW32':CompilerMode:=CompOW32;
8889
'HUNK':CompilerMode:=CompAmigaHunk;
8990
'BSAVE':CompilerMode:=CompBSAVE;
91+
'COFF':CompilerMode:=CompCOFF;
92+
9093
end;
9194

92-
if HasOption('f','usefswitch') and (CompilerMode in [CompTC,CompOW16,CompOW32]) then usefswitch:=true;
95+
if HasOption('f','usefswitch') and (CompilerMode in [CompTC,CompOW16]) then usefswitch:=true;
9396

9497
if GetOptionValue('ps') <> '' then
9598
begin
@@ -106,11 +109,6 @@ procedure TRTBinObj.DoRun;
106109
clname:=GetOptionValue('cn');
107110
end;
108111

109-
if (GetOptionValue('cn')<>'') and (CompilerMode in [CompTC,CompOW16,CompOW32]) then
110-
begin
111-
clname:=GetOptionValue('cn');
112-
end;
113-
114112

115113
if (GetOptionValue('ml')<>'') and (CompilerMode = CompAmigaHunk) then
116114
begin
@@ -126,7 +124,10 @@ procedure TRTBinObj.DoRun;
126124
end;
127125
end;
128126

129-
127+
if (GetOptionValue('hn')<>'') and (CompilerMode = CompAmigaHunk ) then
128+
begin
129+
hunkname:=GetOptionValue('hn');
130+
end;
130131

131132
if CompilerMode = CompTP then
132133
begin
@@ -183,6 +184,17 @@ procedure TRTBinObj.DoRun;
183184
begin
184185
error:=CreateBSaveObj(infile,outfile);
185186
end;
187+
end
188+
else if CompilerMode = CompCOFF then
189+
begin
190+
if publicsizename<>'' then
191+
begin
192+
error:=CreateCOFF(infile,outfile,publicname,publicsizename,True);
193+
end
194+
else
195+
begin
196+
error:=CreateCOFF(infile,outfile,publicname,publicsizename,FALSE);
197+
end;
186198
end;
187199

188200
if error = 0 then writeln('Converted Successfully using ',GetCompModeName(CompilerMode)) else writeln('Looks like we have an error# ',error);
@@ -208,7 +220,7 @@ procedure TRTBinObj.WriteHelp;
208220
writeln(programname);
209221
writeln('Usage: RtBinObj infile outfile public_name');
210222
writeln(' Optional -PS public size name');
211-
writeln(' -O OBJ Mode {TP,TC,OW16,OW32,HUNK,BSAVE}');
223+
writeln(' -O OBJ Mode {TP,TC,OW16,OW32,HUNK,BSAVE,COFF}');
212224
writeln(' -SN segment name');
213225
writeln(' -CN class name');
214226
writeln(' -HN hunk name (Amiga 68k)');

‎rtbinobjform.lfm‎

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,9 @@
11
object Form1: TForm1
22
Left = 491
3-
Height = 401
3+
Height = 431
44
Top = 358
55
Width = 669
6-
ClientHeight = 401
6+
ClientHeight = 431
77
ClientWidth = 669
88
Color = clForm
99
OnCreate = FormCreate
@@ -65,7 +65,7 @@ object Form1: TForm1
6565
object SaveAsButton: TButton
6666
Left = 552
6767
Height = 25
68-
Top = 352
68+
Top = 376
6969
Width = 75
7070
Caption = 'Save As'
7171
OnClick = SaveAsButtonClick
@@ -126,7 +126,7 @@ object Form1: TForm1
126126
end
127127
object ObjModeRadioGroup: TRadioGroup
128128
Left = 384
129-
Height = 152
129+
Height = 177
130130
Hint = 'Turbo Pascal Mode compatible with QuickPascal and FreePascal 8086'#13#10'Turbo C Mode compatible QuickC'
131131
Top = 56
132132
Width = 224
@@ -139,7 +139,7 @@ object Form1: TForm1
139139
ChildSizing.ShrinkVertical = crsScaleChilds
140140
ChildSizing.Layout = cclLeftToRightThenTopToBottom
141141
ChildSizing.ControlsPerLine = 1
142-
ClientHeight = 132
142+
ClientHeight = 157
143143
ClientWidth = 220
144144
ItemIndex = 0
145145
Items.Strings = (
@@ -149,6 +149,7 @@ object Form1: TForm1
149149
'Open Watcom DOS 32 bit'
150150
'Amiga 68k Hunk (vbcc / freepascal)'
151151
'QuickBasic/GWBASIC (bsave)'
152+
'COFF 32 bit'
152153
)
153154
OnClick = ObjModeRadioGroupClick
154155
ParentShowHint = False
@@ -171,7 +172,7 @@ object Form1: TForm1
171172
object AmigaMemRadioGroup: TRadioGroup
172173
Left = 384
173174
Height = 96
174-
Top = 224
175+
Top = 248
175176
Width = 185
176177
AutoFill = True
177178
Caption = 'Amiga Memory Type'

0 commit comments

Comments
 (0)