+ cstreams unit

* dynamicarray object to class

compiler/cobjects.pas

@@ -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
+  Revision 1.21  2000-12-24 12:25:31  peter
-    * fixed memleak in stringqueue.delete
+    + cstreams unit
+    * dynamicarray object to class
 
   Revision 1.19  2000/11/12 22:20:37  peter
     * create generic toutputsection for binary writers

compiler/cstreams.pas

@@ -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
+
+}

compiler/cutils.pas

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

compiler/ogbase.pas

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

compiler/ogcoff.pas

@@ -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));
+        Syms:=TDynamicArray.Create(symbolresize);
-        new(strs,init(strsresize));
+        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;
+              sym.nameidx:=Strs.size+4;
-              strs^.writestr(s);
+              Strs.writestr(s);
-              strs^.writestr(#0);
+              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);
+           Syms.seek(0);
-           for i:=1 to syms^.size div sizeof(TOutputSymbol) do
+           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.seek(0);
-              sects[sec_stab].data^.write(hstab,sizeof(hstab));
+              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
 

compiler/ogelf.pas

@@ -32,7 +32,7 @@ interface
 
     uses
        { common }
-       cobjects,
+       cclasses,cobjects,
        { target }
        systems,
        { assembler }
@@ -67,8 +67,7 @@ interface
          gotsect,
          pltsect,
          symsect  : telf32Section;
-         strs,
+         syms     : Tdynamicarray;
-         syms     : Pdynamicarray;
          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);
+           Syms.seek(0);
-           for i:=1 to (syms^.size div sizeof(toutputsymbol)) do
+           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.seek(0);
-              sects[sec_stab].data^.write(hstab,sizeof(hstab));
+              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
 

compiler/owar.pas

@@ -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));
+  ardata:=TDynamicArray.Create(arbufsize);
-  new(symreloc,init(symrelocbufsize));
+  symreloc:=TDynamicArray.Create(symrelocbufsize);
-  new(symstr,init(symstrbufsize));
+  symstr:=TDynamicArray.Create(symstrbufsize);
-  new(lfnstr,init(lfnstrbufsize));
+  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);
+  arData.Free;
-  dispose(symreloc,done);
+  symreloc.Free;
-  dispose(symstr,done);
+  symstr.Free;
-  dispose(lfnstr,done);
+  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;
+  objpos:=ardata.size;
-  ardata^.seek(objpos + sizeof(tarhdr));
+  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.seek(objpos);
-  ardata^.write(arhdr,sizeof(tarhdr));
+  ardata.write(arhdr,sizeof(tarhdr));
 end;
 
 
@@ -195,15 +197,15 @@ var
   c : char;
 begin
   c:=#0;
-  symreloc^.write(objpos,4);
+  symreloc.write(objpos,4);
-  symstr^.write(sym[1],length(sym));
+  symstr.write(sym[1],length(sym));
-  symstr^.write(c,1);
+  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);
+  arf:=TCFileStream.Create(arfn,fmCreate);
-  {$I-}
+  if CStreamError<>0 then
-   rewrite(arf,1);
-  {$I+}
-  if ioresult<>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
+  if lfnstr.size>0 then
-   lfnstr^.align(2);
+   lfnstr.align(2);
-  if symreloc^.size>0 then
+  if symreloc.size>0 then
    begin
-     symstr^.align(2);
+     symstr.align(2);
-     fixup:=12+sizeof(tarhdr)+symreloc^.size+symstr^.size;
+     fixup:=12+sizeof(tarhdr)+symreloc.size+symstr.size;
-     if lfnstr^.size>0 then
+     if lfnstr.size>0 then
-      inc(fixup,lfnstr^.size+sizeof(tarhdr));
+      inc(fixup,lfnstr.size+sizeof(tarhdr));
-     relocs:=symreloc^.size div 4;
+     relocs:=symreloc.size div 4;
      { fixup relocs }
      for i:=0to relocs-1 do
       begin
-        symreloc^.seek(i*4);
+        symreloc.seek(i*4);
-        symreloc^.read(l,4);
+        symreloc.read(l,4);
-        symreloc^.seek(i*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');
+     createarhdr('',4+symreloc.size+symstr.size,'0','0','0');
-     blockwrite(arf,arhdr,sizeof(tarhdr));
+     arf.Write(arhdr,sizeof(tarhdr));
      relocs:=lsb2msb(relocs);
-     blockwrite(arf,relocs,4);
+     arf.Write(relocs,4);
-     symreloc^.blockwrite(arf);
+     symreloc.WriteStream(arf);
-     symstr^.blockwrite(arf);
+     symstr.WriteStream(arf);
    end;
-  if lfnstr^.size>0 then
+  if lfnstr.size>0 then
    begin
-     createarhdr('/',lfnstr^.size,'','','');
+     createarhdr('/',lfnstr.size,'','','');
-     blockwrite(arf,arhdr,sizeof(tarhdr));
+     arf.Write(arhdr,sizeof(tarhdr));
-     lfnstr^.blockwrite(arf);
+     lfnstr.WriteStream(arf);
    end;
-  ardata^.blockwrite(arf);
+  ardata.WriteStream(arf);
-  system.close(arf);
+  Arf.Free;
 end;
 
 
 end.
 {
   $Log$
-  Revision 1.6  2000-12-23 19:59:35  peter
+  Revision 1.7  2000-12-24 12:25:32  peter
-    * object to class for ow/og objects
+    + cstreams unit
-    * split objectdata from objectoutput
+    * dynamicarray object to class
 
   Revision 1.5  2000/09/24 15:06:20  peter
     * use defines.inc

compiler/owbase.pas

@@ -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);
+  f:=TCFileStream.Create(fn,fmCreate);
-  {$I-}
+  if CStreamError<>0 then
-   rewrite(f,1);
-  {$I+}
-  if ioresult<>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
+   DeleteFile(fn);
-     {$I-}
-      system.erase(f);
-     {$I+}
-     if ioresult<>0 then;
-   end;
   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
+  Revision 1.6  2000-12-24 12:25:32  peter
-    * object to class for ow/og objects
+    + cstreams unit
-    * split objectdata from objectoutput
+    * dynamicarray object to class
 
   Revision 1.4  2000/09/24 15:06:20  peter
     * use defines.inc