paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-18 17:11:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* new tdynamicarray implementation using blocks instead of

Browse Source 
reallocmem (merged)
This commit is contained in:
peter 2000-08-19 18:44:27 +00:00
parent c9de6bc568
commit 9dc543c123
5 changed files with 346 additions and 191 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

249
compiler/cobjects.pas
View File

@ -25,7 +25,7 @@
{$E+,N+,D+,F+} {$E+,N+,D+,F+}
{$endif} {$endif}
{$I-} {$I-}
{$R-}{ necessary for crc calculation } {$R-}{ necessary for crc calculation and dynamicblock acessing }
{$ifdef fpc} {$ifdef fpc}
{$define USEREALLOCMEM} {$define USEREALLOCMEM}
@ -275,25 +275,35 @@ unit cobjects;
procedure insert(p:Pnamedindexobject); procedure insert(p:Pnamedindexobject);
end; end;
const
dynamicblockbasesize = 12;
type
pdynamicblock = ^tdynamicblock;
tdynamicblock = record
pos,
used : longint;
next : pdynamicblock;
data : array[0..1] of byte;
end;
pdynamicarray = ^tdynamicarray; pdynamicarray = ^tdynamicarray;
tdynamicarray = object tdynamicarray = object
posn, blocksize : longint;
count, firstblock,
limit, lastblock : pdynamicblock;
elemlen, constructor init(Ablocksize:longint);
growcount : longint;
data : pchar;
constructor init(Aelemlen,Agrow:longint);
destructor done; destructor done;
function size:longint; function size:longint;
function usedsize:longint;
procedure grow;
procedure align(i:longint); procedure align(i:longint);
procedure seek(i:longint); procedure seek(i:longint);
procedure write(var d;len:longint); procedure write(var d;len:longint);
procedure read(var d;len:longint); function read(var d;len:longint):longint;
procedure writepos(pos:longint;var d;len:longint); procedure blockwrite(var f:file);
procedure readpos(pos:longint;var d;len:longint); private
posn : longint;
posnblock : pdynamicblock;
procedure grow;
end; end;
tindexobjectarray=array[1..16000] of Pnamedindexobject; tindexobjectarray=array[1..16000] of Pnamedindexobject;
@ -1832,117 +1842,199 @@ end;
tdynamicarray tdynamicarray
****************************************************************************} ****************************************************************************}
constructor tdynamicarray.init(Aelemlen,Agrow:longint); constructor tdynamicarray.init(Ablocksize:longint);
begin begin
posn:=0; posn:=0;
count:=0; posnblock:=nil;
limit:=0; firstblock:=nil;
data:=nil; lastblock:=nil;
elemlen:=Aelemlen; blocksize:=Ablocksize;
growcount:=Agrow;
grow; grow;
end; end;
function tdynamicarray.size:longint; function tdynamicarray.size:longint;
begin begin
size:=limit*elemlen; if assigned(lastblock) then
size:=lastblock^.pos+lastblock^.used
else
size:=0;
end; end;
function tdynamicarray.usedsize:longint;
begin
usedsize:=count*elemlen;
end;
procedure tdynamicarray.grow; procedure tdynamicarray.grow;
var var
osize : longint; nblock : pdynamicblock;
{$ifndef USEREALLOCMEM}
odata : pchar;
{$endif USEREALLOCMEM}
begin begin
osize:=size; getmem(nblock,blocksize+dynamicblockbasesize);
inc(limit,growcount); if not assigned(firstblock) then
{$ifndef USEREALLOCMEM}
odata:=data;
getmem(data,size);
if assigned(odata) then
begin begin
move(odata^,data^,osize); firstblock:=nblock;
freemem(odata,osize); posnblock:=nblock;
nblock^.pos:=0;
end
else
begin
lastblock^.next:=nblock;
nblock^.pos:=lastblock^.pos+lastblock^.used;
end; end;
{$else USEREALLOCMEM} nblock^.used:=0;
reallocmem(data,size); nblock^.next:=nil;
{$endif USEREALLOCMEM} fillchar(nblock^.data,blocksize,0);
fillchar(data[osize],growcount*elemlen,0); lastblock:=nblock;
end; end;
procedure tdynamicarray.align(i:longint); procedure tdynamicarray.align(i:longint);
var var
j : longint; j : longint;
begin begin
j:=(posn*elemlen mod i); j:=(posn mod i);
if j<>0 then if j<>0 then
begin begin
j:=i-j; j:=i-j;
while limit<(posn+j) do if posnblock^.used+j>blocksize then
begin
posnblock^.used:=blocksize;
dec(j,blocksize-posnblock^.used);
grow; grow;
posnblock:=lastblock;
end;
inc(posnblock^.used,j);
inc(posn,j); inc(posn,j);
if (posn>count) then
count:=posn;
end; end;
end; end;
procedure tdynamicarray.seek(i:longint); procedure tdynamicarray.seek(i:longint);
begin begin
while limit<i do if (i<posnblock^.pos) or (i>posnblock^.pos+blocksize) then
grow; begin
posn:=i; { set posnblock correct if the size is bigger then
if (posn>count) then the current block }
count:=posn; if posnblock^.pos>i then
posnblock:=firstblock;
while assigned(posnblock) do
begin
if posnblock^.pos+blocksize>i then
break;
posnblock:=posnblock^.next;
end; end;
{ not found ? then increase blocks }
if not assigned(posnblock) then
begin
{ the current lastblock is now also fully used }
lastblock^.used:=blocksize;
repeat
grow;
posnblock:=lastblock;
until posnblock^.pos+blocksize>=i;
end;
end;
posn:=i;
if posn mod blocksize>posnblock^.used then
posnblock^.used:=posn mod blocksize;
end;
procedure tdynamicarray.write(var d;len:longint); procedure tdynamicarray.write(var d;len:longint);
var
p : pchar;
i,j : longint;
begin
p:=pchar(@d);
while (len>0) do
begin
i:=posn mod blocksize;
if i+len>=blocksize then
begin
j:=blocksize-i;
move(p^,posnblock^.data[i],j);
inc(p,j);
inc(posn,j);
dec(len,j);
posnblock^.used:=blocksize;
if assigned(posnblock^.next) then
posnblock:=posnblock^.next
else
begin begin
while limit<(posn+len) do
grow; grow;
move(d,data[posn*elemlen],len*elemlen); posnblock:=lastblock;
end;
end
else
begin
move(p^,posnblock^.data[i],len);
inc(p,len);
inc(posn,len); inc(posn,len);
if (posn>count) then i:=posn mod blocksize;
count:=posn; if i>posnblock^.used then
posnblock^.used:=i;
len:=0;
end;
end;
end; end;
procedure tdynamicarray.read(var d;len:longint);
function tdynamicarray.read(var d;len:longint):longint;
var
p : pchar;
i,j,res : longint;
begin begin
move(data[posn*elemlen],d,len*elemlen); res:=0;
p:=pchar(@d);
while (len>0) do
begin
i:=posn mod blocksize;
if i+len>=posnblock^.used then
begin
j:=posnblock^.used-i;
move(posnblock^.data[i],p^,j);
inc(p,j);
inc(posn,j);
inc(res,j);
dec(len,j);
if assigned(posnblock^.next) then
posnblock:=posnblock^.next
else
break;
end
else
begin
move(posnblock^.data[i],p^,len);
inc(p,len);
inc(posn,len); inc(posn,len);
if (posn>count) then inc(res,len);
count:=posn; len:=0;
end;
end;
read:=res;
end; end;
procedure tdynamicarray.writepos(pos:longint;var d;len:longint);
procedure tdynamicarray.blockwrite(var f:file);
var
hp : pdynamicblock;
begin begin
while limit<(pos+len) do hp:=firstblock;
grow; while assigned(hp) do
move(d,data[pos*elemlen],len*elemlen); begin
posn:=pos+len; system.blockwrite(f,hp^.data,hp^.used);
if (posn>count) then hp:=hp^.next;
count:=posn; end;
end; end;
procedure tdynamicarray.readpos(pos:longint;var d;len:longint);
begin
while limit<(pos+len) do
grow;
move(data[pos*elemlen],d,len*elemlen);
posn:=pos+len;
if (posn>count) then
count:=posn;
end;
destructor tdynamicarray.done; destructor tdynamicarray.done;
var
hp : pdynamicblock;
begin begin
if assigned(data) then while assigned(firstblock) do
freemem(data,size); begin
hp:=firstblock;
firstblock:=firstblock^.next;
freemem(hp,blocksize+dynamicblockbasesize);
end;
end; end;
@ -1950,7 +2042,6 @@ end;
tindexarray tindexarray
****************************************************************************} ****************************************************************************}
constructor tindexarray.init(Agrowsize:longint); constructor tindexarray.init(Agrowsize:longint);
begin begin
growsize:=Agrowsize; growsize:=Agrowsize;
@ -2492,7 +2583,11 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.9 2000-08-16 18:33:53 peter Revision 1.10 2000-08-19 18:44:27 peter
* new tdynamicarray implementation using blocks instead of
reallocmem (merged)
Revision 1.9 2000/08/16 18:33:53 peter
* splitted namedobjectitem.next into indexnext and listnext so it * splitted namedobjectitem.next into indexnext and listnext so it
can be used in both lists can be used in both lists
* don't allow "word = word" type definitions (merged) * don't allow "word = word" type definitions (merged)

77
compiler/og386cff.pas
View File

@ -172,6 +172,18 @@ unit og386cff;
strings,verbose, strings,verbose,
globtype,globals,files; globtype,globals,files;
const
{$ifdef TP}
symbolresize = 20*18;
strsresize = 256;
DataResize = 1024;
{$else}
symbolresize = 200*18;
strsresize = 8192;
DataResize = 8192;
{$endif}
type type
{ Structures which are written directly to the output file } { Structures which are written directly to the output file }
coffheader=packed record coffheader=packed record
@ -254,7 +266,7 @@ unit og386cff;
if sec=sec_bss then if sec=sec_bss then
data:=nil data:=nil
else else
new(Data,Init(1,8192)); new(Data,Init(DataResize));
end; end;
@ -318,15 +330,6 @@ unit og386cff;
Genericcoffoutput Genericcoffoutput
****************************************************************************} ****************************************************************************}
const
{$ifdef TP}
symbolresize = 50;
strsresize = 200;
{$else}
symbolresize = 200;
strsresize = 8192;
{$endif}
constructor tgenericcoffoutput.init(smart:boolean); constructor tgenericcoffoutput.init(smart:boolean);
begin begin
inherited init(smart); inherited init(smart);
@ -346,8 +349,8 @@ unit og386cff;
inherited initwriting(Aplace); inherited initwriting(Aplace);
{ reset } { reset }
initsym:=0; initsym:=0;
new(syms,init(sizeof(TSymbol),symbolresize)); new(syms,init(symbolresize));
new(strs,init(1,strsresize)); new(strs,init(strsresize));
FillChar(Sects,sizeof(Sects),0); FillChar(Sects,sizeof(Sects),0);
{ we need at least the following 3 sections } { we need at least the following 3 sections }
createsection(sec_code); createsection(sec_code);
@ -457,7 +460,7 @@ unit og386cff;
if (p^.section<>sec_none) and not(assigned(sects[p^.section])) then if (p^.section<>sec_none) and not(assigned(sects[p^.section])) then
createsection(p^.section); createsection(p^.section);
{ symbolname } { symbolname }
pos:=strs^.usedsize+4; pos:=strs^.size+4;
s:=p^.name; s:=p^.name;
if length(s)>8 then if length(s)>8 then
begin begin
@ -491,11 +494,11 @@ unit og386cff;
sym.value:=p^.address+sects[p^.section]^.mempos; sym.value:=p^.address+sects[p^.section]^.mempos;
end; end;
{ update the asmsymbol index } { update the asmsymbol index }
p^.idx:=syms^.count; p^.idx:=syms^.size div sizeof(TSymbol);
{ store the symbol, but not the local ones (PM) } { store the symbol, but not the local ones (PM) }
if (sym.typ<>AB_LOCAL) or ((copy(s,1,2)<>'.L') and if (sym.typ<>AB_LOCAL) or ((copy(s,1,2)<>'.L') and
((copy(s,1,1)<>'L') or not win32)) then ((copy(s,1,1)<>'L') or not win32)) then
syms^.write(sym,1); syms^.write(sym,sizeof(tsymbol));
{ make the exported syms known to the objectwriter { make the exported syms known to the objectwriter
(needed for .a generation) } (needed for .a generation) }
if (sym.typ=AB_GLOBAL) or if (sym.typ=AB_GLOBAL) or
@ -521,7 +524,8 @@ unit og386cff;
procedure tgenericcoffoutput.writealign(len:longint); procedure tgenericcoffoutput.writealign(len:longint);
var modulo : longint; var
modulo : longint;
begin begin
if not assigned(sects[currsec]) then if not assigned(sects[currsec]) then
createsection(currsec); createsection(currsec);
@ -814,9 +818,9 @@ unit og386cff;
end; end;
{ The real symbols. } { The real symbols. }
syms^.seek(0); syms^.seek(0);
for i:=1 to syms^.count do for i:=1 to syms^.size div sizeof(TSymbol) do
begin begin
syms^.read(sym,1); syms^.read(sym,sizeof(TSymbol));
if sym.typ=AB_LOCAL then if sym.typ=AB_LOCAL then
globalval:=3 globalval:=3
else else
@ -834,11 +838,13 @@ unit og386cff;
var var
datapos,secsymidx, datapos,secsymidx,
nsects,sympos,i : longint; nsects,sympos,i : longint;
hstab : coffstab;
gotreloc : boolean; gotreloc : boolean;
sec : tsection; sec : tsection;
header : coffheader; header : coffheader;
sechdr : coffsechdr; sechdr : coffsechdr;
empty : array[0..15] of byte; empty : array[0..15] of byte;
hp : pdynamicblock;
begin begin
{ calc amount of sections we have and align sections at 4 bytes } { calc amount of sections we have and align sections at 4 bytes }
fillchar(empty,sizeof(empty),0); fillchar(empty,sizeof(empty),0);
@ -895,7 +901,7 @@ unit og386cff;
header.mach:=$14c; header.mach:=$14c;
header.nsects:=nsects; header.nsects:=nsects;
header.sympos:=sympos; header.sympos:=sympos;
header.syms:=syms^.count+initsym; header.syms:=(syms^.size div sizeof(TSymbol))+initsym;
if gotreloc then if gotreloc then
header.flag:=$104 header.flag:=$104
else else
@ -934,12 +940,20 @@ unit og386cff;
calculated more easily } calculated more easily }
if sec=sec_stab then if sec=sec_stab then
begin begin
pcoffstab(sects[sec_stab]^.data^.data)^.nvalue:=sects[sec_stabstr]^.len; hstab.strpos:=1;
pcoffstab(sects[sec_stab]^.data^.data)^.strpos:=1; hstab.ntype:=0;
pcoffstab(sects[sec_stab]^.data^.data)^.ndesc:= hstab.nother:=0;
(sects[sec_stab]^.len div sizeof(coffstab))-1{+1 according to gas output PM}; hstab.ndesc:=(sects[sec_stab]^.len div sizeof(coffstab))-1{+1 according to gas output PM};
hstab.nvalue:=sects[sec_stabstr]^.len;
sects[sec_stab]^.data^.seek(0);
sects[sec_stab]^.data^.write(hstab,sizeof(hstab));
end;
hp:=sects[sec]^.data^.firstblock;
while assigned(hp) do
begin
writer^.write(hp^.data,hp^.used);
hp:=hp^.next;
end; end;
writer^.write(sects[sec]^.data^.data^,sects[sec]^.data^.usedsize);
end; end;
{ Relocs } { Relocs }
for sec:=low(tsection) to high(tsection) do for sec:=low(tsection) to high(tsection) do
@ -948,9 +962,14 @@ unit og386cff;
{ Symbols } { Symbols }
write_symbols; write_symbols;
{ Strings } { Strings }
i:=strs^.usedsize+4; i:=strs^.size+4;
writer^.write(i,4); writer^.write(i,4);
writer^.write(strs^.data^,strs^.usedsize); hp:=strs^.firstblock;
while assigned(hp) do
begin
writer^.write(hp^.data,hp^.used);
hp:=hp^.next;
end;
end; end;
@ -1019,7 +1038,11 @@ unit og386cff;
end. end.
{ {
$Log$ $Log$
Revision 1.3 2000-07-13 12:08:26 michael Revision 1.4 2000-08-19 18:44:27 peter
* new tdynamicarray implementation using blocks instead of
reallocmem (merged)
Revision 1.3 2000/07/13 12:08:26 michael
+ patched to 1.1.0 with former 1.09patch from peter + patched to 1.1.0 with former 1.09patch from peter
Revision 1.2 2000/07/13 11:32:43 michael Revision 1.2 2000/07/13 11:32:43 michael

87
compiler/og386elf.pas
View File

@ -134,6 +134,17 @@ unit og386elf;
globtype,globals,files; globtype,globals,files;
const const
{$ifdef TP}
symbolresize = 20*18;
strsresize = 256;
DataResize = 1024;
{$else}
symbolresize = 200*18;
strsresize = 8192;
DataResize = 8192;
{$endif}
const
R_386_32 = 1; { ordinary absolute relocation } R_386_32 = 1; { ordinary absolute relocation }
R_386_PC32 = 2; { PC-relative relocation } R_386_PC32 = 2; { PC-relative relocation }
R_386_GOT32 = 3; { an offset into GOT } R_386_GOT32 = 3; { an offset into GOT }
@ -298,7 +309,7 @@ unit og386elf;
if shtype=SHT_NOBITS then if shtype=SHT_NOBITS then
data:=nil data:=nil
else else
new(Data,Init(1,8192)); new(Data,Init(8192));
{ relocation } { relocation }
NRelocs:=0; NRelocs:=0;
relocHead:=nil; relocHead:=nil;
@ -411,15 +422,6 @@ unit og386elf;
TElf32Output TElf32Output
****************************************************************************} ****************************************************************************}
const
{$ifdef TP}
symbolresize = 50;
strsresize = 200;
{$else}
symbolresize = 200;
strsresize = 8192;
{$endif}
constructor telf32output.init(smart:boolean); constructor telf32output.init(smart:boolean);
begin begin
inherited init(smart); inherited init(smart);
@ -439,7 +441,7 @@ unit og386elf;
inherited initwriting(Aplace); inherited initwriting(Aplace);
{ reset } { reset }
initsym:=0; initsym:=0;
new(syms,init(sizeof(TSymbol),symbolresize)); new(syms,init(symbolresize));
FillChar(Sects,sizeof(Sects),0); FillChar(Sects,sizeof(Sects),0);
{ default sections } { default sections }
new(symtabsect,initname('.symtab',2,0,0,0,4,16)); new(symtabsect,initname('.symtab',2,0,0,0,4,16));
@ -522,7 +524,7 @@ unit og386elf;
end; end;
end; end;
{ update the asmsymbol index } { update the asmsymbol index }
p^.idx:=syms^.count; p^.idx:=syms^.size div sizeof(tsymbol);
{ store the symbol, but not the local ones (PM) } { store the symbol, but not the local ones (PM) }
if (sym.bind<>AB_LOCAL) then if (sym.bind<>AB_LOCAL) then
begin begin
@ -530,7 +532,7 @@ unit og386elf;
sym.name:=strtabsect^.writestr(p^.name); sym.name:=strtabsect^.writestr(p^.name);
strtabsect^.writestr(#0); strtabsect^.writestr(#0);
{ symbol } { symbol }
syms^.write(sym,1); syms^.write(sym,sizeof(tsymbol));
end; end;
{ make the exported syms known to the objectwriter { make the exported syms known to the objectwriter
(needed for .a generation) } (needed for .a generation) }
@ -797,9 +799,9 @@ unit og386elf;
end; end;
{ symbols } { symbols }
syms^.seek(0); syms^.seek(0);
for i:=1 to syms^.count do for i:=1 to (syms^.size div sizeof(TSymbol)) do
begin begin
syms^.read(sym,1); syms^.read(sym,sizeof(TSymbol));
fillchar(elfsym,sizeof(elfsym),0); fillchar(elfsym,sizeof(elfsym),0);
elfsym.st_name:=sym.name; elfsym.st_name:=sym.name;
elfsym.st_value:=sym.value; elfsym.st_value:=sym.value;
@ -884,8 +886,10 @@ unit og386elf;
datapos, datapos,
shoffset, shoffset,
nsects : longint; nsects : longint;
hstab : telf32stab;
sec : tsection; sec : tsection;
empty : array[0..63] of byte; empty : array[0..63] of byte;
hp : pdynamicblock;
begin begin
{ calc amount of sections we have and align sections at 4 bytes } { calc amount of sections we have and align sections at 4 bytes }
fillchar(empty,sizeof(empty),0); fillchar(empty,sizeof(empty),0);
@ -974,18 +978,30 @@ unit og386elf;
calculated more easily } calculated more easily }
if sec=sec_stab then if sec=sec_stab then
begin begin
pelf32stab(sects[sec_stab]^.data^.data)^.nvalue:=sects[sec_stabstr]^.datalen; hstab.strpos:=1;
pelf32stab(sects[sec_stab]^.data^.data)^.strpos:=1; hstab.ntype:=0;
pelf32stab(sects[sec_stab]^.data^.data)^.ndesc:= hstab.nother:=0;
(sects[sec_stab]^.datalen div sizeof(telf32stab))-1{+1 according to gas output PM}; hstab.ndesc:=(sects[sec_stab]^.datalen div sizeof(telf32stab))-1{+1 according to gas output PM};
hstab.nvalue:=sects[sec_stabstr]^.datalen;
sects[sec_stab]^.data^.seek(0);
sects[sec_stab]^.data^.write(hstab,sizeof(hstab));
end; end;
{ save the original section length }
sects[sec]^.alignsection; sects[sec]^.alignsection;
writer^.write(sects[sec]^.data^.data^,sects[sec]^.data^.usedsize); hp:=sects[sec]^.data^.firstblock;
while assigned(hp) do
begin
writer^.write(hp^.data,hp^.used);
hp:=hp^.next;
end;
end; end;
{ .shstrtab } { .shstrtab }
shstrtabsect^.alignsection; shstrtabsect^.alignsection;
writer^.write(shstrtabsect^.data^.data^,shstrtabsect^.data^.usedsize); hp:=shstrtabsect^.data^.firstblock;
while assigned(hp) do
begin
writer^.write(hp^.data,hp^.used);
hp:=hp^.next;
end;
{ section headers, start with an empty header for sh_undef } { section headers, start with an empty header for sh_undef }
writer^.write(empty,sizeof(telf32sechdr)); writer^.write(empty,sizeof(telf32sechdr));
for sec:=low(tsection) to high(tsection) do for sec:=low(tsection) to high(tsection) do
@ -1000,17 +1016,32 @@ unit og386elf;
writesectionheader(strtabsect); writesectionheader(strtabsect);
{ .symtab } { .symtab }
symtabsect^.alignsection; symtabsect^.alignsection;
writer^.write(symtabsect^.data^.data^,symtabsect^.data^.usedsize); hp:=symtabsect^.data^.firstblock;
while assigned(hp) do
begin
writer^.write(hp^.data,hp^.used);
hp:=hp^.next;
end;
{ .strtab } { .strtab }
strtabsect^.writealign(4); strtabsect^.writealign(4);
writer^.write(strtabsect^.data^.data^,strtabsect^.data^.usedsize); hp:=strtabsect^.data^.firstblock;
while assigned(hp) do
begin
writer^.write(hp^.data,hp^.used);
hp:=hp^.next;
end;
{ .rel sections } { .rel sections }
for sec:=low(tsection) to high(tsection) do for sec:=low(tsection) to high(tsection) do
if assigned(sects[sec]) and if assigned(sects[sec]) and
assigned(sects[sec]^.relocsect) then assigned(sects[sec]^.relocsect) then
begin begin
sects[sec]^.relocsect^.alignsection; sects[sec]^.relocsect^.alignsection;
writer^.write(sects[sec]^.relocsect^.data^.data^,sects[sec]^.relocsect^.data^.usedsize); hp:=sects[sec]^.relocsect^.data^.firstblock;
while assigned(hp) do
begin
writer^.write(hp^.data,hp^.used);
hp:=hp^.next;
end;
end; end;
end; end;
@ -1018,7 +1049,11 @@ unit og386elf;
end. end.
{ {
$Log$ $Log$
Revision 1.4 2000-08-12 19:14:58 peter Revision 1.5 2000-08-19 18:44:27 peter
* new tdynamicarray implementation using blocks instead of
reallocmem (merged)
Revision 1.4 2000/08/12 19:14:58 peter
* ELF writer works now also with -g * ELF writer works now also with -g
* ELF writer is default again for linux * ELF writer is default again for linux

98
compiler/owar.pas
View File

@ -43,7 +43,7 @@ type
destructor Done;virtual; destructor Done;virtual;
procedure create(const fn:string);virtual; procedure create(const fn:string);virtual;
procedure close;virtual; procedure close;virtual;
procedure writesym(sym:string);virtual; procedure writesym(const sym:string);virtual;
procedure write(var b;len:longint);virtual; procedure write(var b;len:longint);virtual;
private private
arfn : string; arfn : string;
@ -51,10 +51,8 @@ type
symreloc, symreloc,
symstr, symstr,
lfnstr, lfnstr,
ardata{, ardata : PDynamicArray;
objdata }: PDynamicArray; objpos : longint;
objfixup,
objdatasize : longint;
objfn : string; objfn : string;
timestamp : string[12]; timestamp : string[12];
procedure createarhdr(fn:string;size:longint;const gid,uid,mode:string); procedure createarhdr(fn:string;size:longint;const gid,uid,mode:string);
@ -74,13 +72,13 @@ uses
const const
{$ifdef TP} {$ifdef TP}
symrelocbufsize = 32; symrelocbufsize = 256;
symstrbufsize = 256; symstrbufsize = 256;
lfnstrbufsize = 256; lfnstrbufsize = 256;
arbufsize = 256; arbufsize = 256;
objbufsize = 256; objbufsize = 256;
{$else} {$else}
symrelocbufsize = 1024; symrelocbufsize = 4096;
symstrbufsize = 8192; symstrbufsize = 8192;
lfnstrbufsize = 4096; lfnstrbufsize = 4096;
arbufsize = 65536; arbufsize = 65536;
@ -128,10 +126,10 @@ var
dummy : word; dummy : word;
begin begin
arfn:=Aarfn; arfn:=Aarfn;
new(arData,init(1,arbufsize)); new(arData,init(arbufsize));
new(symreloc,init(4,symrelocbufsize)); new(symreloc,init(symrelocbufsize));
new(symstr,init(1,symstrbufsize)); new(symstr,init(symstrbufsize));
new(lfnstr,init(1,lfnstrbufsize)); new(lfnstr,init(lfnstrbufsize));
{ create timestamp } { create timestamp }
getdate(time.year,time.month,time.day,dummy); getdate(time.year,time.month,time.day,dummy);
gettime(time.hour,time.min,time.sec,dummy); gettime(time.hour,time.min,time.sec,dummy);
@ -160,7 +158,7 @@ begin
if length(fn)>16 then if length(fn)>16 then
begin begin
arhdr.name[0]:='/'; arhdr.name[0]:='/';
str(lfnstr^.usedsize,tmp); str(lfnstr^.size,tmp);
move(tmp[1],arhdr.name[1],length(tmp)); move(tmp[1],arhdr.name[1],length(tmp));
fn:=fn+#10; fn:=fn+#10;
lfnstr^.write(fn[1],length(fn)); lfnstr^.write(fn[1],length(fn));
@ -182,47 +180,36 @@ end;
procedure tarobjectwriter.create(const fn:string); procedure tarobjectwriter.create(const fn:string);
begin begin
objfn:=fn; objfn:=fn;
objfixup:=ardata^.usedsize; objpos:=ardata^.size;
{ reset size } ardata^.seek(objpos + sizeof(tarhdr));
{ new(objdata,init(1,objbufsize)); }
objdatasize := 0;
ardata^.seek(ardata^.usedsize + sizeof(tarhdr));
end; end;
procedure tarobjectwriter.close; procedure tarobjectwriter.close;
begin begin
if (objdatasize and 1) <> 0 then ardata^.align(2);
begin
inc(objdatasize);
ardata^.seek(ardata^.usedsize+1);
end;
{ fix the size in the header } { fix the size in the header }
{ createarhdr(objfn,objdata^.usedsize,'42','42','644');} createarhdr(objfn,ardata^.size-objpos-sizeof(tarhdr),'42','42','644');
createarhdr(objfn,objdatasize,'42','42','644');
{ write the header } { write the header }
ardata^.seek(objfixup); ardata^.seek(objpos);
ardata^.write(arhdr,sizeof(tarhdr)); ardata^.write(arhdr,sizeof(tarhdr));
{ write the data of this objfile }
{ ardata^.write(objdata^.data^,objdata^.usedsize);}
{ free this object }
{ dispose(objdata,done);}
end; end;
procedure tarobjectwriter.writesym(sym:string); procedure tarobjectwriter.writesym(const sym:string);
var
c : char;
begin begin
sym:=sym+#0; c:=#0;
symreloc^.write(objfixup,1); symreloc^.write(objpos,4);
symstr^.write(sym[1],length(sym)); symstr^.write(sym[1],length(sym));
symstr^.write(c,1);
end; end;
procedure tarobjectwriter.write(var b;len:longint); procedure tarobjectwriter.write(var b;len:longint);
begin begin
{ objdata^.write(b,len);}
ardata^.write(b,len); ardata^.write(b,len);
inc(objdatasize,len);
end; end;
@ -247,7 +234,7 @@ type
plongint=^longint; plongint=^longint;
var var
arf : file; arf : file;
fixup, fixup,l,
relocs,i : longint; relocs,i : longint;
begin begin
assign(arf,arfn); assign(arf,arfn);
@ -261,31 +248,38 @@ begin
end; end;
blockwrite(arf,armagic,sizeof(armagic)); blockwrite(arf,armagic,sizeof(armagic));
{ align first, because we need the size for the fixups of the symbol reloc } { align first, because we need the size for the fixups of the symbol reloc }
if lfnstr^.usedsize>0 then if lfnstr^.size>0 then
lfnstr^.align(2); lfnstr^.align(2);
if symreloc^.usedsize>0 then if symreloc^.size>0 then
begin begin
symstr^.align(2); symstr^.align(2);
fixup:=12+sizeof(tarhdr)+symreloc^.usedsize+symstr^.usedsize; fixup:=12+sizeof(tarhdr)+symreloc^.size+symstr^.size;
if lfnstr^.usedsize>0 then if lfnstr^.size>0 then
inc(fixup,lfnstr^.usedsize+sizeof(tarhdr)); inc(fixup,lfnstr^.size+sizeof(tarhdr));
relocs:=symreloc^.count; relocs:=symreloc^.size div 4;
{ fixup relocs }
for i:=0to relocs-1 do for i:=0to relocs-1 do
plongint(@symreloc^.data[i*4])^:=lsb2msb(plongint(@symreloc^.data[i*4])^+fixup); begin
createarhdr('',4+symreloc^.usedsize+symstr^.usedsize,'0','0','0'); symreloc^.seek(i*4);
symreloc^.read(l,4);
symreloc^.seek(i*4);
l:=lsb2msb(l+fixup);
symreloc^.write(l,4);
end;
createarhdr('',4+symreloc^.size+symstr^.size,'0','0','0');
blockwrite(arf,arhdr,sizeof(tarhdr)); blockwrite(arf,arhdr,sizeof(tarhdr));
relocs:=lsb2msb(relocs); relocs:=lsb2msb(relocs);
blockwrite(arf,relocs,4); blockwrite(arf,relocs,4);
blockwrite(arf,symreloc^.data^,symreloc^.usedsize); symreloc^.blockwrite(arf);
blockwrite(arf,symstr^.data^,symstr^.usedsize); symstr^.blockwrite(arf);
end; end;
if lfnstr^.usedsize>0 then if lfnstr^.size>0 then
begin begin
createarhdr('/',lfnstr^.usedsize,'','',''); createarhdr('/',lfnstr^.size,'','','');
blockwrite(arf,arhdr,sizeof(tarhdr)); blockwrite(arf,arhdr,sizeof(tarhdr));
blockwrite(arf,lfnstr^.data^,lfnstr^.usedsize); lfnstr^.blockwrite(arf);
end; end;
blockwrite(arf,ardata^.data^,ardata^.usedsize); ardata^.blockwrite(arf);
system.close(arf); system.close(arf);
end; end;
@ -293,7 +287,11 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.3 2000-08-08 19:28:57 peter Revision 1.4 2000-08-19 18:44:27 peter
* new tdynamicarray implementation using blocks instead of
reallocmem (merged)
Revision 1.3 2000/08/08 19:28:57 peter
* memdebug/memory patches (merged) * memdebug/memory patches (merged)
* only once illegal directive (merged) * only once illegal directive (merged)

10
compiler/owbase.pas
View File

@ -30,7 +30,7 @@ type
destructor Done;virtual; destructor Done;virtual;
procedure create(const fn:string);virtual; procedure create(const fn:string);virtual;
procedure close;virtual; procedure close;virtual;
procedure writesym(sym:string);virtual; procedure writesym(const sym:string);virtual;
procedure write(var b;len:longint);virtual; procedure write(var b;len:longint);virtual;
private private
f : file; f : file;
@ -114,7 +114,7 @@ begin
end; end;
procedure tobjectwriter.writesym(sym:string); procedure tobjectwriter.writesym(const sym:string);
begin begin
end; end;
@ -152,7 +152,11 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.2 2000-07-13 11:32:44 michael Revision 1.3 2000-08-19 18:44:27 peter
* new tdynamicarray implementation using blocks instead of
reallocmem (merged)
Revision 1.2 2000/07/13 11:32:44 michael
+ removed logs + removed logs
} }