paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 15:19:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ cstreams unit

Browse Source 
* dynamicarray object to class
This commit is contained in:
peter 2000-12-24 12:25:31 +00:00
parent 377e4c5927
commit 0c0c01980f
9 changed files with 2676 additions and 359 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1908
compiler/cclasses.pas Normal file
View File

File diff suppressed because it is too large Load Diff

243
compiler/cobjects.pas
View File

@ -237,38 +237,6 @@ interface
procedure insert(p:Pnamedindexobject);
end;
const
dynamicblockbasesize = 12;
type
pdynamicblock = ^tdynamicblock;
tdynamicblock = record
pos,
used : longint;
next : pdynamicblock;
data : array[0..high(longint)-20] of byte;
end;
pdynamicarray = ^tdynamicarray;
tdynamicarray = object
blocksize : longint;
firstblock,
lastblock : pdynamicblock;
constructor init(Ablocksize:longint);
destructor done;
function size:longint;
procedure align(i:longint);
procedure seek(i:longint);
procedure write(const d;len:longint);
procedure writestr(const s:string);
function read(var d;len:longint):longint;
procedure blockwrite(var f:file);
private
posn : longint;
posnblock : pdynamicblock;
procedure grow;
end;
tindexobjectarray=array[1..16000] of Pnamedindexobject;
Pnamedindexobjectarray=^tindexobjectarray;
@ -1495,212 +1463,6 @@ end;
end;
{****************************************************************************
tdynamicarray
****************************************************************************}
constructor tdynamicarray.init(Ablocksize:longint);
begin
posn:=0;
posnblock:=nil;
firstblock:=nil;
lastblock:=nil;
blocksize:=Ablocksize;
grow;
end;
function tdynamicarray.size:longint;
begin
if assigned(lastblock) then
size:=lastblock^.pos+lastblock^.used
else
size:=0;
end;
procedure tdynamicarray.grow;
var
nblock : pdynamicblock;
begin
getmem(nblock,blocksize+dynamicblockbasesize);
if not assigned(firstblock) then
begin
firstblock:=nblock;
posnblock:=nblock;
nblock^.pos:=0;
end
else
begin
lastblock^.next:=nblock;
nblock^.pos:=lastblock^.pos+lastblock^.used;
end;
nblock^.used:=0;
nblock^.next:=nil;
fillchar(nblock^.data,blocksize,0);
lastblock:=nblock;
end;
procedure tdynamicarray.align(i:longint);
var
j : longint;
begin
j:=(posn mod i);
if j<>0 then
begin
j:=i-j;
if posnblock^.used+j>blocksize then
begin
dec(j,blocksize-posnblock^.used);
posnblock^.used:=blocksize;
grow;
posnblock:=lastblock;
end;
inc(posnblock^.used,j);
inc(posn,j);
end;
end;
procedure tdynamicarray.seek(i:longint);
begin
if (i<posnblock^.pos) or (i>posnblock^.pos+blocksize) then
begin
{ set posnblock correct if the size is bigger then
the current block }
if posnblock^.pos>i then
posnblock:=firstblock;
while assigned(posnblock) do
begin
if posnblock^.pos+blocksize>i then
break;
posnblock:=posnblock^.next;
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(const 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
grow;
posnblock:=lastblock;
end;
end
else
begin
move(p^,posnblock^.data[i],len);
inc(p,len);
inc(posn,len);
i:=posn mod blocksize;
if i>posnblock^.used then
posnblock^.used:=i;
len:=0;
end;
end;
end;
procedure tdynamicarray.writestr(const s:string);
begin
write(s[1],length(s));
end;
function tdynamicarray.read(var d;len:longint):longint;
var
p : pchar;
i,j,res : longint;
begin
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(res,len);
len:=0;
end;
end;
read:=res;
end;
procedure tdynamicarray.blockwrite(var f:file);
var
hp : pdynamicblock;
begin
hp:=firstblock;
while assigned(hp) do
begin
system.blockwrite(f,hp^.data,hp^.used);
hp:=hp^.next;
end;
end;
destructor tdynamicarray.done;
var
hp : pdynamicblock;
begin
while assigned(firstblock) do
begin
hp:=firstblock;
firstblock:=firstblock^.next;
freemem(hp,blocksize+dynamicblockbasesize);
end;
end;
{****************************************************************************
tindexarray
****************************************************************************}
@ -1854,8 +1616,9 @@ end;
end.
{
$Log$
Revision 1.20 2000-12-23 19:52:24 peter
* fixed memleak in stringqueue.delete
Revision 1.21 2000-12-24 12:25:31 peter
+ cstreams unit
* dynamicarray object to class
Revision 1.19 2000/11/12 22:20:37 peter
* create generic toutputsection for binary writers

613
compiler/cstreams.pas Normal file
View File

@ -0,0 +1,613 @@
{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl and Peter Vreman
This module provides stream classes
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit cstreams;
{$i defines.inc}
interface
{****************************************************************************
TCStream
****************************************************************************}
{
TCStream is copied directly from classesh.inc from the FCL so
it's compatible with the normal Classes.TStream.
TCFileStream is a merge of THandleStream and TFileStream and updated
to have a 'file' type instead of Handle.
TCCustomMemoryStream and TCMemoryStream are direct copies.
}
const
{ TCStream seek origins }
soFromBeginning = 0;
soFromCurrent = 1;
soFromEnd = 2;
{ TCFileStream create mode }
fmCreate = $FFFF;
fmOpenRead = 0;
fmOpenWrite = 1;
fmOpenReadWrite = 2;
var
{ Used for Error reporting instead of exceptions }
CStreamError : longint;
type
{ Fake TComponent class, it isn't used any futher }
TCComponent = class(TObject)
end;
{ TCStream abstract class }
TCStream = class(TObject)
private
function GetPosition: Longint;
procedure SetPosition(Pos: Longint);
function GetSize: Longint;
protected
procedure SetSize(NewSize: Longint); virtual;
public
function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;
procedure ReadBuffer(var Buffer; Count: Longint);
procedure WriteBuffer(const Buffer; Count: Longint);
function CopyFrom(Source: TCStream; Count: Longint): Longint;
function ReadComponent(Instance: TCComponent): TCComponent;
function ReadComponentRes(Instance: TCComponent): TCComponent;
procedure WriteComponent(Instance: TCComponent);
procedure WriteComponentRes(const ResName: string; Instance: TCComponent);
procedure WriteDescendent(Instance, Ancestor: TCComponent);
procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TCComponent);
procedure WriteResourceHeader(const ResName: string; {!!!:out} var FixupInfo: Integer);
procedure FixupResourceHeader(FixupInfo: Integer);
procedure ReadResHeader;
function ReadByte : Byte;
function ReadWord : Word;
function ReadDWord : Cardinal;
function ReadAnsiString : AnsiString;
procedure WriteByte(b : Byte);
procedure WriteWord(w : Word);
procedure WriteDWord(d : Cardinal);
Procedure WriteAnsiString (S : AnsiString);
property Position: Longint read GetPosition write SetPosition;
property Size: Longint read GetSize write SetSize;
end;
{ TFileStream class }
TCFileStream = class(TCStream)
Private
FFileName : String;
FHandle: File;
protected
procedure SetSize(NewSize: Longint); override;
public
constructor Create(const AFileName: string; Mode: Word);
destructor Destroy; override;
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
function Seek(Offset: Longint; Origin: Word): Longint; override;
property FileName : String Read FFilename;
end;
{ TCustomMemoryStream abstract class }
TCCustomMemoryStream = class(TCStream)
private
FMemory: Pointer;
FSize, FPosition: Longint;
protected
procedure SetPointer(Ptr: Pointer; ASize: Longint);
public
function Read(var Buffer; Count: Longint): Longint; override;
function Seek(Offset: Longint; Origin: Word): Longint; override;
procedure SaveToStream(Stream: TCStream);
procedure SaveToFile(const FileName: string);
property Memory: Pointer read FMemory;
end;
{ TCMemoryStream }
TCMemoryStream = class(TCCustomMemoryStream)
private
FCapacity: Longint;
procedure SetCapacity(NewCapacity: Longint);
protected
function Realloc(var NewCapacity: Longint): Pointer; virtual;
property Capacity: Longint read FCapacity write SetCapacity;
public
destructor Destroy; override;
procedure Clear;
procedure LoadFromStream(Stream: TCStream);
procedure LoadFromFile(const FileName: string);
procedure SetSize(NewSize: Longint); override;
function Write(const Buffer; Count: Longint): Longint; override;
end;
implementation
{*****************************************************************************
TCStream
*****************************************************************************}
function TCStream.GetPosition: Longint;
begin
Result:=Seek(0,soFromCurrent);
end;
procedure TCStream.SetPosition(Pos: Longint);
begin
Seek(pos,soFromBeginning);
end;
function TCStream.GetSize: Longint;
var
p : longint;
begin
p:=GetPosition;
GetSize:=Seek(0,soFromEnd);
Seek(p,soFromBeginning);
end;
procedure TCStream.SetSize(NewSize: Longint);
begin
// We do nothing. Pipe streams don't support this
// As wel as possible read-ony streams !!
end;
procedure TCStream.ReadBuffer(var Buffer; Count: Longint);
begin
CStreamError:=0;
if Read(Buffer,Count)<Count then
CStreamError:=102;
end;
procedure TCStream.WriteBuffer(const Buffer; Count: Longint);
begin
CStreamError:=0;
if Write(Buffer,Count)<Count then
CStreamError:=103;
end;
function TCStream.CopyFrom(Source: TCStream; Count: Longint): Longint;
var
i : longint;
buffer : array[0..1023] of byte;
begin
CStreamError:=0;
CopyFrom:=0;
while Count>0 do
begin
if (Count>sizeof(buffer)) then
i:=sizeof(Buffer)
else
i:=Count;
i:=Source.Read(buffer,i);
i:=Write(buffer,i);
dec(count,i);
CopyFrom:=CopyFrom+i;
if i=0 then
exit;
end;
end;
function TCStream.ReadComponent(Instance: TCComponent): TCComponent;
begin
Result:=nil;
end;
function TCStream.ReadComponentRes(Instance: TCComponent): TCComponent;
begin
Result:=nil;
end;
procedure TCStream.WriteComponent(Instance: TCComponent);
begin
end;
procedure TCStream.WriteComponentRes(const ResName: string; Instance: TCComponent);
begin
end;
procedure TCStream.WriteDescendent(Instance, Ancestor: TCComponent);
begin
end;
procedure TCStream.WriteDescendentRes(const ResName: string; Instance, Ancestor: TCComponent);
begin
end;
procedure TCStream.WriteResourceHeader(const ResName: string; {!!!: out} var FixupInfo: Integer);
begin
end;
procedure TCStream.FixupResourceHeader(FixupInfo: Integer);
begin
end;
procedure TCStream.ReadResHeader;
begin
end;
function TCStream.ReadByte : Byte;
var
b : Byte;
begin
ReadBuffer(b,1);
ReadByte:=b;
end;
function TCStream.ReadWord : Word;
var
w : Word;
begin
ReadBuffer(w,2);
ReadWord:=w;
end;
function TCStream.ReadDWord : Cardinal;
var
d : Cardinal;
begin
ReadBuffer(d,4);
ReadDWord:=d;
end;
Function TCStream.ReadAnsiString : AnsiString;
Type
PByte = ^Byte;
Var
TheSize : Longint;
P : PByte ;
begin
ReadBuffer (TheSize,SizeOf(TheSize));
SetLength(Result,TheSize);
// Illegal typecast if no AnsiStrings defined.
if TheSize>0 then
begin
ReadBuffer (Pointer(Result)^,TheSize);
P:=Pointer(Result)+TheSize;
p^:=0;
end;
end;
Procedure TCStream.WriteAnsiString (S : AnsiString);
Var L : Longint;
begin
L:=Length(S);
WriteBuffer (L,SizeOf(L));
WriteBuffer (Pointer(S)^,L);
end;
procedure TCStream.WriteByte(b : Byte);
begin
WriteBuffer(b,1);
end;
procedure TCStream.WriteWord(w : Word);
begin
WriteBuffer(w,2);
end;
procedure TCStream.WriteDWord(d : Cardinal);
begin
WriteBuffer(d,4);
end;
{****************************************************************************}
{* TCFileStream *}
{****************************************************************************}
constructor TCFileStream.Create(const AFileName: string; Mode: Word);
begin
FFileName:=AFileName;
If Mode=fmcreate then
begin
system.assign(FHandle,AFileName);
{$I-}
system.rewrite(FHandle,1);
{$I+}
CStreamError:=IOResult;
end
else
begin
system.assign(FHandle,AFileName);
{$I-}
system.reset(FHandle,1);
{$I+}
CStreamError:=IOResult;
end;
end;
destructor TCFileStream.Destroy;
begin
{$I-}
System.Close(FHandle);
{$I+}
CStreamError:=IOResult;
end;
function TCFileStream.Read(var Buffer; Count: Longint): Longint;
begin
CStreamError:=0;
BlockRead(FHandle,Buffer,Count,Result);
If Result=-1 then Result:=0;
end;
function TCFileStream.Write(const Buffer; Count: Longint): Longint;
begin
CStreamError:=0;
BlockWrite (FHandle,Buffer,Count,Result);
If Result=-1 then Result:=0;
end;
Procedure TCFileStream.SetSize(NewSize: Longint);
begin
{$I-}
System.Seek(FHandle,NewSize);
System.Truncate(FHandle);
{$I+}
CStreamError:=IOResult;
end;
function TCFileStream.Seek(Offset: Longint; Origin: Word): Longint;
var
l : longint;
begin
{$I-}
case Origin of
soFromBeginning :
System.Seek(FHandle,Offset);
soFromCurrent :
begin
l:=System.FilePos(FHandle);
inc(l,Offset);
System.Seek(FHandle,l);
end;
soFromEnd :
begin
l:=System.FileSize(FHandle);
dec(l,Offset);
if l<0 then
l:=0;
System.Seek(FHandle,l);
end;
end;
{$I+}
CStreamError:=IOResult;
Result:=CStreamError;
end;
{****************************************************************************}
{* TCustomMemoryStream *}
{****************************************************************************}
procedure TCCustomMemoryStream.SetPointer(Ptr: Pointer; ASize: Longint);
begin
FMemory:=Ptr;
FSize:=ASize;
end;
function TCCustomMemoryStream.Read(var Buffer; Count: Longint): Longint;
begin
Result:=0;
If (FSize>0) and (FPosition<Fsize) then
begin
Result:=FSize-FPosition;
If Result>Count then Result:=Count;
Move ((FMemory+FPosition)^,Buffer,Result);
FPosition:=Fposition+Result;
end;
end;
function TCCustomMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
Case Origin of
soFromBeginning : FPosition:=Offset;
soFromEnd : FPosition:=FSize+Offset;
soFromCurrent : FpoSition:=FPosition+Offset;
end;
Result:=FPosition;
end;
procedure TCCustomMemoryStream.SaveToStream(Stream: TCStream);
begin
if FSize>0 then Stream.WriteBuffer (FMemory^,FSize);
end;
procedure TCCustomMemoryStream.SaveToFile(const FileName: string);
Var S : TCFileStream;
begin
Try
S:=TCFileStream.Create (FileName,fmCreate);
SaveToStream(S);
finally
S.free;
end;
end;
{****************************************************************************}
{* TCMemoryStream *}
{****************************************************************************}
Const TMSGrow = 4096; { Use 4k blocks. }
procedure TCMemoryStream.SetCapacity(NewCapacity: Longint);
begin
SetPointer (Realloc(NewCapacity),Fsize);
FCapacity:=NewCapacity;
end;
function TCMemoryStream.Realloc(var NewCapacity: Longint): Pointer;
Var MoveSize : Longint;
begin
CStreamError:=0;
If NewCapacity>0 Then // round off to block size.
NewCapacity := (NewCapacity + (TMSGrow-1)) and not (TMSGROW-1);
// Only now check !
If NewCapacity=FCapacity then
Result:=FMemory
else
If NewCapacity=0 then
FreeMem (FMemory,Fcapacity)
else
begin
GetMem (Result,NewCapacity);
If Result=Nil then
CStreamError:=204;
If FCapacity>0 then
begin
MoveSize:=FSize;
If MoveSize>NewCapacity then MoveSize:=NewCapacity;
Move (Fmemory^,Result^,MoveSize);
FreeMem (FMemory,FCapacity);
end;
end;
end;
destructor TCMemoryStream.Destroy;
begin
Clear;
Inherited Destroy;
end;
procedure TCMemoryStream.Clear;
begin
FSize:=0;
FPosition:=0;
SetCapacity (0);
end;
procedure TCMemoryStream.LoadFromStream(Stream: TCStream);
begin
Stream.Position:=0;
SetSize(Stream.Size);
If FSize>0 then Stream.ReadBuffer(FMemory^,FSize);
end;
procedure TCMemoryStream.LoadFromFile(const FileName: string);
Var S : TCFileStream;
begin
Try
S:=TCFileStream.Create (FileName,fmOpenRead);
LoadFromStream(S);
finally
S.free;
end;
end;
procedure TCMemoryStream.SetSize(NewSize: Longint);
begin
SetCapacity (NewSize);
FSize:=NewSize;
IF FPosition>FSize then
FPosition:=FSize;
end;
function TCMemoryStream.Write(const Buffer; Count: Longint): Longint;
Var NewPos : Longint;
begin
If Count=0 then
exit(0);
NewPos:=FPosition+Count;
If NewPos>Fsize then
begin
IF NewPos>FCapacity then
SetCapacity (NewPos);
FSize:=Newpos;
end;
System.Move (Buffer,(FMemory+FPosition)^,Count);
FPosition:=NewPos;
Result:=Count;
end;
end.
{
$Log$
Revision 1.1 2000-12-24 12:25:31 peter
+ cstreams unit
* dynamicarray object to class
}

28
compiler/cutils.pas
View File

@ -86,6 +86,12 @@ procedure ansistringdispose(var p : pchar;length : longint);
function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint;
function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
{*****************************************************************************
File Functions
*****************************************************************************}
function DeleteFile(const fn:string):boolean;
implementation
@ -606,12 +612,32 @@ end;
end;
{*****************************************************************************
File Functions
*****************************************************************************}
function DeleteFile(const fn:string):boolean;
var
f : file;
begin
{$I-}
assign(f,fn);
erase(f);
{$I-}
DeleteFile:=(IOResult=0);
end;
initialization
initupperlower;
end.
{
$Log$
Revision 1.4 2000-11-28 00:17:43 pierre
Revision 1.5 2000-12-24 12:25:31 peter
+ cstreams unit
* dynamicarray object to class
Revision 1.4 2000/11/28 00:17:43 pierre
+ int64tostr function added
Revision 1.3 2000/11/07 20:47:35 peter

20
compiler/ogbase.pas
View File

@ -35,7 +35,7 @@ interface
dos,
{$endif Delphi}
{ common }
cobjects,
cclasses,cobjects,
{ targets }
systems,
{ outputwriters }
@ -73,7 +73,7 @@ interface
secsymidx : longint; { index for the section in symtab }
addralign : longint;
{ size of the data and in the file }
data : PDynamicArray;
data : TDynamicArray;
datasize : longint;
datapos : longint;
{ size and position in memory, set by setsectionsize }
@ -236,7 +236,7 @@ implementation
if alloconly then
data:=nil
else
new(Data,Init(8192));
Data:=TDynamicArray.Create(8192);
{ position }
mempos:=0;
memsize:=0;
@ -250,7 +250,7 @@ implementation
destructor tobjectsection.destroy;
begin
if assigned(Data) then
dispose(Data,done);
Data.Free;
end;
@ -259,7 +259,7 @@ implementation
write:=datasize;
if not assigned(Data) then
Internalerror(3334441);
Data^.write(d,l);
Data.write(d,l);
inc(datasize,l);
end;
@ -269,7 +269,7 @@ implementation
writestr:=datasize;
if not assigned(Data) then
Internalerror(3334441);
Data^.write(s[1],length(s));
Data.write(s[1],length(s));
inc(datasize,length(s));
end;
@ -288,7 +288,7 @@ implementation
if assigned(data) then
begin
fillchar(empty,sizeof(empty),0);
data^.write(empty,l-i);
Data.write(empty,l-i);
end;
inc(datasize,l-i);
end;
@ -529,7 +529,11 @@ implementation
end.
{
$Log$
Revision 1.3 2000-12-23 19:59:35 peter
Revision 1.4 2000-12-24 12:25:31 peter
+ cstreams unit
* dynamicarray object to class
Revision 1.3 2000/12/23 19:59:35 peter
* object to class for ow/og objects
* split objectdata from objectoutput

42
compiler/ogcoff.pas
View File

@ -32,7 +32,7 @@ interface
uses
{ common }
cobjects,
cclasses,cobjects,
{ target }
systems,
{ assembler }
@ -63,7 +63,7 @@ interface
procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);override;
procedure writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;nidx,nother,line:longint;reloc:boolean);override;
strs,
syms : Pdynamicarray;
syms : Tdynamicarray;
end;
tcoffoutput = class(tobjectoutput)
@ -191,8 +191,8 @@ implementation
var
s : string;
begin
new(syms,init(symbolresize));
new(strs,init(strsresize));
Syms:=TDynamicArray.Create(symbolresize);
Strs:=TDynamicArray.Create(strsresize);
{ we need at least the following 3 sections }
createsection(sec_code);
createsection(sec_data);
@ -292,9 +292,9 @@ implementation
s:=p^.name;
if length(s)>8 then
begin
sym.nameidx:=strs^.size+4;
strs^.writestr(s);
strs^.writestr(#0);
sym.nameidx:=Strs.size+4;
Strs.writestr(s);
Strs.writestr(#0);
end
else
begin
@ -302,9 +302,9 @@ implementation
sym.namestr:=s;
end;
{ update the asmsymbol index }
p^.idx:=syms^.size div sizeof(TOutputSymbol);
p^.idx:=Syms.size div sizeof(TOutputSymbol);
{ write the symbol }
syms^.write(sym,sizeof(toutputsymbol));
Syms.write(sym,sizeof(toutputsymbol));
end
else
begin
@ -623,10 +623,10 @@ implementation
writer.write(secrec,sizeof(secrec));
end;
{ The real symbols }
syms^.seek(0);
for i:=1 to syms^.size div sizeof(TOutputSymbol) do
Syms.seek(0);
for i:=1 to Syms.size div sizeof(TOutputSymbol) do
begin
syms^.read(sym,sizeof(TOutputSymbol));
Syms.read(sym,sizeof(TOutputSymbol));
if sym.bind=AB_LOCAL then
globalval:=3
else
@ -679,8 +679,8 @@ implementation
hstab.nother:=0;
hstab.ndesc:=(sects[sec_stab].datasize div sizeof(coffstab))-1{+1 according to gas output PM};
hstab.nvalue:=sects[sec_stabstr].datasize;
sects[sec_stab].data^.seek(0);
sects[sec_stab].data^.write(hstab,sizeof(hstab));
sects[sec_stab].data.seek(0);
sects[sec_stab].data.write(hstab,sizeof(hstab));
end;
{ Calculate the filepositions }
datapos:=sizeof(coffheader)+sizeof(coffsechdr)*nsects;
@ -709,7 +709,7 @@ implementation
header.mach:=$14c;
header.nsects:=nsects;
header.sympos:=sympos;
header.syms:=(syms^.size div sizeof(TOutputSymbol))+initsym;
header.syms:=(Syms.size div sizeof(TOutputSymbol))+initsym;
if gotreloc then
header.flag:=$104
else
@ -745,7 +745,7 @@ implementation
assigned(sects[sec].data) then
begin
sects[sec].alignsection;
hp:=sects[sec].data^.firstblock;
hp:=sects[sec].data.firstblock;
while assigned(hp) do
begin
writer.write(hp^.data,hp^.used);
@ -759,9 +759,9 @@ implementation
{ Symbols }
write_symbols;
{ Strings }
i:=strs^.size+4;
i:=Strs.size+4;
writer.write(i,4);
hp:=strs^.firstblock;
hp:=Strs.firstblock;
while assigned(hp) do
begin
writer.write(hp^.data,hp^.used);
@ -778,7 +778,11 @@ implementation
end.
{
$Log$
Revision 1.6 2000-12-23 19:59:35 peter
Revision 1.7 2000-12-24 12:25:31 peter
+ cstreams unit
* dynamicarray object to class
Revision 1.6 2000/12/23 19:59:35 peter
* object to class for ow/og objects
* split objectdata from objectoutput

40
compiler/ogelf.pas
View File

@ -32,7 +32,7 @@ interface
uses
{ common }
cobjects,
cclasses,cobjects,
{ target }
systems,
{ assembler }
@ -67,8 +67,7 @@ interface
gotsect,
pltsect,
symsect : telf32Section;
strs,
syms : Pdynamicarray;
syms : Tdynamicarray;
constructor create;
destructor destroy;override;
procedure createsection(sec:tsection);override;
@ -107,7 +106,6 @@ implementation
const
symbolresize = 200*18;
strsresize = 8192;
DataResize = 8192;
const
@ -286,7 +284,7 @@ implementation
begin
inherited create;
{ reset }
new(syms,init(symbolresize));
Syms:=TDynamicArray.Create(symbolresize);
{ default sections }
symtabsect:=telf32section.createname('.symtab',2,0,0,0,4,16);
strtabsect:=telf32section.createname('.strtab',3,0,0,0,1,0);
@ -313,7 +311,7 @@ implementation
destructor telf32data.destroy;
begin
dispose(syms,done);
Syms.Free;
symtabsect.free;
strtabsect.free;
shstrtabsect.free;
@ -363,9 +361,9 @@ implementation
strtabsect.writestr(p^.name);
strtabsect.writestr(#0);
{ update the asmsymbol index }
p^.idx:=syms^.size div sizeof(toutputsymbol);
p^.idx:=syms.size div sizeof(toutputsymbol);
{ symbol }
syms^.write(sym,sizeof(toutputsymbol));
Syms.write(sym,sizeof(toutputsymbol));
end
else
begin
@ -589,10 +587,10 @@ implementation
inc(locals);
end;
{ symbols }
syms^.seek(0);
for i:=1 to (syms^.size div sizeof(toutputsymbol)) do
Syms.seek(0);
for i:=1 to (Syms.size div sizeof(toutputsymbol)) do
begin
syms^.read(sym,sizeof(toutputsymbol));
Syms.read(sym,sizeof(toutputsymbol));
fillchar(elfsym,sizeof(elfsym),0);
elfsym.st_name:=sym.nameidx;
elfsym.st_value:=sym.value;
@ -720,8 +718,8 @@ implementation
hstab.nother:=0;
hstab.ndesc:=(sects[sec_stab].datasize div sizeof(telf32stab))-1{+1 according to gas output PM};
hstab.nvalue:=sects[sec_stabstr].datasize;
sects[sec_stab].data^.seek(0);
sects[sec_stab].data^.write(hstab,sizeof(hstab));
sects[sec_stab].Data.seek(0);
sects[sec_stab].Data.write(hstab,sizeof(hstab));
end;
{ Create the relocation sections }
for sec:=low(tsection) to high(tsection) do
@ -784,7 +782,7 @@ implementation
assigned(sects[sec].data) then
begin
sects[sec].alignsection;
hp:=sects[sec].data^.firstblock;
hp:=sects[sec].Data.firstblock;
while assigned(hp) do
begin
writer.write(hp^.data,hp^.used);
@ -793,7 +791,7 @@ implementation
end;
{ .shstrtab }
shstrtabsect.alignsection;
hp:=shstrtabsect.data^.firstblock;
hp:=shstrtabsect.Data.firstblock;
while assigned(hp) do
begin
writer.write(hp^.data,hp^.used);
@ -813,7 +811,7 @@ implementation
writesectionheader(strtabsect);
{ .symtab }
symtabsect.alignsection;
hp:=symtabsect.data^.firstblock;
hp:=symtabsect.Data.firstblock;
while assigned(hp) do
begin
writer.write(hp^.data,hp^.used);
@ -821,7 +819,7 @@ implementation
end;
{ .strtab }
strtabsect.writealign(4);
hp:=strtabsect.data^.firstblock;
hp:=strtabsect.Data.firstblock;
while assigned(hp) do
begin
writer.write(hp^.data,hp^.used);
@ -833,7 +831,7 @@ implementation
assigned(telf32section(sects[sec]).relocsect) then
begin
telf32section(sects[sec]).relocsect.alignsection;
hp:=telf32section(sects[sec]).relocsect.data^.firstblock;
hp:=telf32section(sects[sec]).relocsect.Data.firstblock;
while assigned(hp) do
begin
writer.write(hp^.data,hp^.used);
@ -846,7 +844,11 @@ implementation
end.
{
$Log$
Revision 1.3 2000-12-23 19:59:35 peter
Revision 1.4 2000-12-24 12:25:32 peter
+ cstreams unit
* dynamicarray object to class
Revision 1.3 2000/12/23 19:59:35 peter
* object to class for ow/og objects
* split objectdata from objectoutput

109
compiler/owar.pas
View File

@ -27,7 +27,8 @@ unit owar;
interface
uses
cobjects,owbase;
cclasses,
owbase;
type
tarhdr=packed record
@ -53,7 +54,7 @@ type
symreloc,
symstr,
lfnstr,
ardata : PDynamicArray;
ardata : TDynamicArray;
objpos : longint;
objfn : string;
timestamp : string[12];
@ -65,6 +66,7 @@ type
implementation
uses
cstreams,
verbose,
{$ifdef Delphi}
dmisc;
@ -120,10 +122,10 @@ var
dummy : word;
begin
arfn:=Aarfn;
new(arData,init(arbufsize));
new(symreloc,init(symrelocbufsize));
new(symstr,init(symstrbufsize));
new(lfnstr,init(lfnstrbufsize));
ardata:=TDynamicArray.Create(arbufsize);
symreloc:=TDynamicArray.Create(symrelocbufsize);
symstr:=TDynamicArray.Create(symstrbufsize);
lfnstr:=TDynamicArray.Create(lfnstrbufsize);
{ create timestamp }
getdate(time.year,time.month,time.day,dummy);
gettime(time.hour,time.min,time.sec,dummy);
@ -135,10 +137,10 @@ destructor tarobjectwriter.destroy;
begin
if Errorcount=0 then
writear;
dispose(arData,done);
dispose(symreloc,done);
dispose(symstr,done);
dispose(lfnstr,done);
arData.Free;
symreloc.Free;
symstr.Free;
lfnstr.Free;
end;
@ -152,10 +154,10 @@ begin
if length(fn)>16 then
begin
arhdr.name[0]:='/';
str(lfnstr^.size,tmp);
str(lfnstr.size,tmp);
move(tmp[1],arhdr.name[1],length(tmp));
fn:=fn+#10;
lfnstr^.write(fn[1],length(fn));
lfnstr.write(fn[1],length(fn));
end
else
move(fn[1],arhdr.name,length(fn));
@ -174,19 +176,19 @@ end;
procedure tarobjectwriter.createfile(const fn:string);
begin
objfn:=fn;
objpos:=ardata^.size;
ardata^.seek(objpos + sizeof(tarhdr));
objpos:=ardata.size;
ardata.seek(objpos + sizeof(tarhdr));
end;
procedure tarobjectwriter.closefile;
begin
ardata^.align(2);
ardata.align(2);
{ fix the size in the header }
createarhdr(objfn,ardata^.size-objpos-sizeof(tarhdr),'42','42','644');
createarhdr(objfn,ardata.size-objpos-sizeof(tarhdr),'42','42','644');
{ write the header }
ardata^.seek(objpos);
ardata^.write(arhdr,sizeof(tarhdr));
ardata.seek(objpos);
ardata.write(arhdr,sizeof(tarhdr));
end;
@ -195,15 +197,15 @@ var
c : char;
begin
c:=#0;
symreloc^.write(objpos,4);
symstr^.write(sym[1],length(sym));
symstr^.write(c,1);
symreloc.write(objpos,4);
symstr.write(sym[1],length(sym));
symstr.write(c,1);
end;
procedure tarobjectwriter.write(const b;len:longint);
begin
ardata^.write(b,len);
ardata.write(b,len);
end;
@ -227,63 +229,60 @@ const
type
plongint=^longint;
var
arf : file;
arf : TCFileStream;
fixup,l,
relocs,i : longint;
begin
assign(arf,arfn);
{$I-}
rewrite(arf,1);
{$I+}
if ioresult<>0 then
arf:=TCFileStream.Create(arfn,fmCreate);
if CStreamError<>0 then
begin
Message1(exec_e_cant_create_archivefile,arfn);
exit;
end;
blockwrite(arf,armagic,sizeof(armagic));
arf.Write(armagic,sizeof(armagic));
{ align first, because we need the size for the fixups of the symbol reloc }
if lfnstr^.size>0 then
lfnstr^.align(2);
if symreloc^.size>0 then
if lfnstr.size>0 then
lfnstr.align(2);
if symreloc.size>0 then
begin
symstr^.align(2);
fixup:=12+sizeof(tarhdr)+symreloc^.size+symstr^.size;
if lfnstr^.size>0 then
inc(fixup,lfnstr^.size+sizeof(tarhdr));
relocs:=symreloc^.size div 4;
symstr.align(2);
fixup:=12+sizeof(tarhdr)+symreloc.size+symstr.size;
if lfnstr.size>0 then
inc(fixup,lfnstr.size+sizeof(tarhdr));
relocs:=symreloc.size div 4;
{ fixup relocs }
for i:=0to relocs-1 do
begin
symreloc^.seek(i*4);
symreloc^.read(l,4);
symreloc^.seek(i*4);
symreloc.seek(i*4);
symreloc.read(l,4);
symreloc.seek(i*4);
l:=lsb2msb(l+fixup);
symreloc^.write(l,4);
symreloc.write(l,4);
end;
createarhdr('',4+symreloc^.size+symstr^.size,'0','0','0');
blockwrite(arf,arhdr,sizeof(tarhdr));
createarhdr('',4+symreloc.size+symstr.size,'0','0','0');
arf.Write(arhdr,sizeof(tarhdr));
relocs:=lsb2msb(relocs);
blockwrite(arf,relocs,4);
symreloc^.blockwrite(arf);
symstr^.blockwrite(arf);
arf.Write(relocs,4);
symreloc.WriteStream(arf);
symstr.WriteStream(arf);
end;
if lfnstr^.size>0 then
if lfnstr.size>0 then
begin
createarhdr('/',lfnstr^.size,'','','');
blockwrite(arf,arhdr,sizeof(tarhdr));
lfnstr^.blockwrite(arf);
createarhdr('/',lfnstr.size,'','','');
arf.Write(arhdr,sizeof(tarhdr));
lfnstr.WriteStream(arf);
end;
ardata^.blockwrite(arf);
system.close(arf);
ardata.WriteStream(arf);
Arf.Free;
end;
end.
{
$Log$
Revision 1.6 2000-12-23 19:59:35 peter
* object to class for ow/og objects
* split objectdata from objectoutput
Revision 1.7 2000-12-24 12:25:32 peter
+ cstreams unit
* dynamicarray object to class
Revision 1.5 2000/09/24 15:06:20 peter
* use defines.inc

32
compiler/owbase.pas
View File

@ -25,6 +25,8 @@ unit owbase;
{$i defines.inc}
interface
uses
cstreams;
type
tobjectwriter=class
@ -35,7 +37,7 @@ type
procedure writesym(const sym:string);virtual;
procedure write(const b;len:longint);virtual;
private
f : file;
f : TCFileStream;
opened : boolean;
buf : pchar;
bufidx : longint;
@ -47,6 +49,7 @@ type
implementation
uses
cutils,
verbose;
const
@ -71,11 +74,8 @@ end;
procedure tobjectwriter.createfile(const fn:string);
begin
assign(f,fn);
{$I-}
rewrite(f,1);
{$I+}
if ioresult<>0 then
f:=TCFileStream.Create(fn,fmCreate);
if CStreamError<>0 then
begin
Message1(exec_e_cant_create_objectfile,fn);
exit;
@ -87,18 +87,16 @@ end;
procedure tobjectwriter.closefile;
var
fn : string;
begin
if bufidx>0 then
writebuf;
system.close(f);
fn:=f.filename;
f.free;
{ Remove if size is 0 }
if size=0 then
begin
{$I-}
system.erase(f);
{$I+}
if ioresult<>0 then;
end;
DeleteFile(fn);
opened:=false;
size:=0;
end;
@ -106,7 +104,7 @@ end;
procedure tobjectwriter.writebuf;
begin
blockwrite(f,buf^,bufidx);
f.write(buf^,bufidx);
bufidx:=0;
end;
@ -149,9 +147,9 @@ end;
end.
{
$Log$
Revision 1.5 2000-12-23 19:59:35 peter
* object to class for ow/og objects
* split objectdata from objectoutput
Revision 1.6 2000-12-24 12:25:32 peter
+ cstreams unit
* dynamicarray object to class
Revision 1.4 2000/09/24 15:06:20 peter
* use defines.inc