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

  to the file, except the dictionary

git-svn-id: trunk@30700 -

compiler/owomflib.pas

@@ -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.