paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-07 19:27:12 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ partially implemented the internal omf library writer; everything is written

Browse Source 
to the file, except the dictionary

git-svn-id: trunk@30700 -
This commit is contained in:
nickysn 2015-04-21 20:59:36 +00:00
parent 3fa81fa7cd
commit dbe1081389
1 changed files with 145 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

145
compiler/owomflib.pas
View File

@ -37,9 +37,154 @@ type
{ TOmfLibObjectWriter }
TOmfLibObjectWriter=class(TObjectWriter)
private
FPageSize: Integer;
FLibName: string;
FLibData: TDynamicArray;
FObjFileName: string;
FObjData: TDynamicArray;
FObjStartPage: Word;
procedure WriteHeader(DictStart: DWord; DictBlocks: Word);
procedure WriteFooter;
procedure WriteLib;
public
constructor createAr(const Aarfn:string);override;
destructor destroy;override;
function createfile(const fn:string):boolean;override;
procedure closefile;override;
procedure writesym(const sym:string);override;
procedure write(const b;len:longword);override;
end;
implementation
uses
SysUtils,
cstreams,
globals,
verbose,
omfbase;
const
libbufsize = 65536;
objbufsize = 65536;
{*****************************************************************************
TOmfLibObjectWriter
*****************************************************************************}
constructor TOmfLibObjectWriter.createAr(const Aarfn: string);
begin
FPageSize:=512;
FLibName:=Aarfn;
FLibData:=TDynamicArray.Create(libbufsize);
{ header is at page 0, so first module starts at page 1 }
FObjStartPage:=1;
end;
destructor TOmfLibObjectWriter.destroy;
begin
if Errorcount=0 then
WriteLib;
FLibData.Free;
FObjData.Free;
inherited destroy;
end;
function TOmfLibObjectWriter.createfile(const fn: string): boolean;
begin
FObjFileName:=fn;
FreeAndNil(FObjData);
FObjData:=TDynamicArray.Create(objbufsize);
createfile:=true;
fobjsize:=0;
end;
procedure TOmfLibObjectWriter.closefile;
var
RawRec: TOmfRawRecord;
begin
FLibData.seek(FObjStartPage*FPageSize);
FObjData.seek(0);
RawRec:=TOmfRawRecord.Create;
repeat
RawRec.ReadFrom(FObjData);
RawRec.WriteTo(FLibData);
until RawRec.RecordType in [RT_MODEND,RT_MODEND32];
RawRec.Free;
{ calculate start page of next module }
FObjStartPage:=(FLibData.Pos+FPageSize-1) div FPageSize;
fobjsize:=0;
end;
procedure TOmfLibObjectWriter.writesym(const sym: string);
begin
inherited writesym(sym);
end;
procedure TOmfLibObjectWriter.write(const b; len: longword);
begin
inc(fobjsize,len);
inc(fsize,len);
FObjData.write(b,len);
end;
procedure TOmfLibObjectWriter.WriteHeader(DictStart: DWord; DictBlocks: Word);
var
Header: TOmfRecord_LIBHEAD;
RawRec: TOmfRawRecord;
begin
{ set header properties }
Header:=TOmfRecord_LIBHEAD.Create;
Header.PageSize:=FPageSize;
Header.DictionaryOffset:=DictStart;
Header.DictionarySizeInBlocks:=DictBlocks;
Header.CaseSensitive:=true;
{ write header }
RawRec:=TOmfRawRecord.Create;
Header.EncodeTo(RawRec);
FLibData.seek(0);
RawRec.WriteTo(FLibData);
Header.Free;
RawRec.Free;
end;
procedure TOmfLibObjectWriter.WriteFooter;
var
Footer: TOmfRecord_LIBEND;
RawRec: TOmfRawRecord;
begin
FLibData.seek(FObjStartPage*FPageSize);
Footer:=TOmfRecord_LIBEND.Create;
Footer.CalculatePaddingBytes(FLibData.Pos);
RawRec:=TOmfRawRecord.Create;
Footer.EncodeTo(RawRec);
RawRec.WriteTo(FLibData);
Footer.Free;
RawRec.Free;
end;
procedure TOmfLibObjectWriter.WriteLib;
var
libf: TCCustomFileStream;
begin
libf:=CFileStreamClass.Create(FLibName,fmCreate);
if CStreamError<>0 then
begin
Message1(exec_e_cant_create_archivefile,FLibName);
exit;
end;
WriteFooter;
WriteHeader(FLibData.Pos,2);
FLibData.WriteStream(libf);
libf.Free;
end;
end.