2
0
Эх сурвалжийг харах

* new tdynamicarray implementation using blocks instead of
reallocmem (merged)

peter 25 жил өмнө
parent
commit
9dc543c123

+ 175 - 80
compiler/cobjects.pas

@@ -25,7 +25,7 @@
   {$E+,N+,D+,F+}
 {$endif}
 {$I-}
-{$R-}{ necessary for crc calculation }
+{$R-}{ necessary for crc calculation and dynamicblock acessing }
 
 {$ifdef fpc}
 {$define USEREALLOCMEM}
@@ -275,25 +275,35 @@ unit cobjects;
          procedure insert(p:Pnamedindexobject);
        end;
 
+     const
+       dynamicblockbasesize = 12;
+
+     type
+       pdynamicblock = ^tdynamicblock;
+       tdynamicblock = record
+         pos,
+         used : longint;
+         next : pdynamicblock;
+         data : array[0..1] of byte;
+       end;
+
        pdynamicarray = ^tdynamicarray;
        tdynamicarray = object
-         posn,
-         count,
-         limit,
-         elemlen,
-         growcount : longint;
-         data      : pchar;
-         constructor init(Aelemlen,Agrow:longint);
+         blocksize  : longint;
+         firstblock,
+         lastblock  : pdynamicblock;
+         constructor init(Ablocksize:longint);
          destructor  done;
          function  size:longint;
-         function  usedsize:longint;
-         procedure grow;
          procedure align(i:longint);
          procedure seek(i:longint);
          procedure write(var d;len:longint);
-         procedure read(var d;len:longint);
-         procedure writepos(pos:longint;var d;len:longint);
-         procedure readpos(pos:longint;var d;len:longint);
+         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;
@@ -1832,117 +1842,199 @@ end;
                                 tdynamicarray
 ****************************************************************************}
 
-    constructor tdynamicarray.init(Aelemlen,Agrow:longint);
+    constructor tdynamicarray.init(Ablocksize:longint);
       begin
         posn:=0;
-        count:=0;
-        limit:=0;
-        data:=nil;
-        elemlen:=Aelemlen;
-        growcount:=Agrow;
+        posnblock:=nil;
+        firstblock:=nil;
+        lastblock:=nil;
+        blocksize:=Ablocksize;
         grow;
       end;
 
+
     function  tdynamicarray.size:longint;
       begin
-        size:=limit*elemlen;
+        if assigned(lastblock) then
+         size:=lastblock^.pos+lastblock^.used
+        else
+         size:=0;
       end;
 
-    function  tdynamicarray.usedsize:longint;
-      begin
-        usedsize:=count*elemlen;
-      end;
 
     procedure tdynamicarray.grow;
       var
-        osize : longint;
-{$ifndef USEREALLOCMEM}
-        odata : pchar;
-{$endif USEREALLOCMEM}
+        nblock : pdynamicblock;
       begin
-        osize:=size;
-        inc(limit,growcount);
-{$ifndef USEREALLOCMEM}
-        odata:=data;
-        getmem(data,size);
-        if assigned(odata) then
+        getmem(nblock,blocksize+dynamicblockbasesize);
+        if not assigned(firstblock) then
          begin
-           move(odata^,data^,osize);
-           freemem(odata,osize);
+           firstblock:=nblock;
+           posnblock:=nblock;
+           nblock^.pos:=0;
+         end
+        else
+         begin
+           lastblock^.next:=nblock;
+           nblock^.pos:=lastblock^.pos+lastblock^.used;
          end;
-{$else USEREALLOCMEM}
-        reallocmem(data,size);
-{$endif USEREALLOCMEM}
-        fillchar(data[osize],growcount*elemlen,0);
+        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*elemlen mod i);
+        j:=(posn mod i);
         if j<>0 then
          begin
            j:=i-j;
-           while limit<(posn+j) do
-            grow;
+           if posnblock^.used+j>blocksize then
+            begin
+              posnblock^.used:=blocksize;
+              dec(j,blocksize-posnblock^.used);
+              grow;
+              posnblock:=lastblock;
+            end;
+           inc(posnblock^.used,j);
            inc(posn,j);
-           if (posn>count) then
-            count:=posn;
          end;
       end;
 
+
     procedure tdynamicarray.seek(i:longint);
       begin
-        while limit<i do
-         grow;
+        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>count) then
-         count:=posn;
+        if posn mod blocksize>posnblock^.used then
+         posnblock^.used:=posn mod blocksize;
       end;
 
+
     procedure tdynamicarray.write(var d;len:longint);
+      var
+        p : pchar;
+        i,j : longint;
       begin
-        while limit<(posn+len) do
-         grow;
-        move(d,data[posn*elemlen],len*elemlen);
-        inc(posn,len);
-        if (posn>count) then
-         count:=posn;
+        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.read(var d;len:longint);
-      begin
-        move(data[posn*elemlen],d,len*elemlen);
-        inc(posn,len);
-        if (posn>count) then
-         count:=posn;
-      end;
 
-    procedure tdynamicarray.writepos(pos:longint;var d;len:longint);
+    function tdynamicarray.read(var d;len:longint):longint;
+      var
+        p : pchar;
+        i,j,res : longint;
       begin
-        while limit<(pos+len) do
-         grow;
-        move(d,data[pos*elemlen],len*elemlen);
-        posn:=pos+len;
-        if (posn>count) then
-         count:=posn;
+        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.readpos(pos:longint;var d;len:longint);
+
+    procedure tdynamicarray.blockwrite(var f:file);
+      var
+        hp : pdynamicblock;
       begin
-        while limit<(pos+len) do
-         grow;
-        move(data[pos*elemlen],d,len*elemlen);
-        posn:=pos+len;
-        if (posn>count) then
-         count:=posn;
+        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
-        if assigned(data) then
-         freemem(data,size);
+        while assigned(firstblock) do
+         begin
+           hp:=firstblock;
+           firstblock:=firstblock^.next;
+           freemem(hp,blocksize+dynamicblockbasesize);
+         end;
       end;
 
 
@@ -1950,7 +2042,6 @@ end;
                                tindexarray
  ****************************************************************************}
 
-
     constructor tindexarray.init(Agrowsize:longint);
       begin
         growsize:=Agrowsize;
@@ -2492,7 +2583,11 @@ end;
 end.
 {
   $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
       can be used in both lists
     * don't allow "word = word" type definitions (merged)

+ 50 - 27
compiler/og386cff.pas

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

+ 61 - 26
compiler/og386elf.pas

@@ -134,6 +134,17 @@ unit og386elf;
         globtype,globals,files;
 
     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_PC32 = 2;                  { PC-relative relocation }
       R_386_GOT32 = 3;                 { an offset into GOT }
@@ -298,7 +309,7 @@ unit og386elf;
         if shtype=SHT_NOBITS then
          data:=nil
         else
-         new(Data,Init(1,8192));
+         new(Data,Init(8192));
         { relocation }
         NRelocs:=0;
         relocHead:=nil;
@@ -411,15 +422,6 @@ unit og386elf;
                             TElf32Output
 ****************************************************************************}
 
-    const
-{$ifdef TP}
-      symbolresize = 50;
-      strsresize   = 200;
-{$else}
-      symbolresize = 200;
-      strsresize   = 8192;
-{$endif}
-
     constructor telf32output.init(smart:boolean);
       begin
         inherited init(smart);
@@ -439,7 +441,7 @@ unit og386elf;
         inherited initwriting(Aplace);
         { reset }
         initsym:=0;
-        new(syms,init(sizeof(TSymbol),symbolresize));
+        new(syms,init(symbolresize));
         FillChar(Sects,sizeof(Sects),0);
         { default sections }
         new(symtabsect,initname('.symtab',2,0,0,0,4,16));
@@ -522,7 +524,7 @@ unit og386elf;
             end;
         end;
         { update the asmsymbol index }
-        p^.idx:=syms^.count;
+        p^.idx:=syms^.size div sizeof(tsymbol);
         { store the symbol, but not the local ones (PM) }
         if (sym.bind<>AB_LOCAL) then
          begin
@@ -530,7 +532,7 @@ unit og386elf;
            sym.name:=strtabsect^.writestr(p^.name);
            strtabsect^.writestr(#0);
            { symbol }
-           syms^.write(sym,1);
+           syms^.write(sym,sizeof(tsymbol));
          end;
         { make the exported syms known to the objectwriter
           (needed for .a generation) }
@@ -797,9 +799,9 @@ unit og386elf;
           end;
       { symbols }
         syms^.seek(0);
-        for i:=1 to syms^.count do
+        for i:=1 to (syms^.size div sizeof(TSymbol)) do
          begin
-           syms^.read(sym,1);
+           syms^.read(sym,sizeof(TSymbol));
            fillchar(elfsym,sizeof(elfsym),0);
            elfsym.st_name:=sym.name;
            elfsym.st_value:=sym.value;
@@ -884,8 +886,10 @@ unit og386elf;
         datapos,
         shoffset,
         nsects : longint;
+        hstab  : telf32stab;
         sec    : tsection;
         empty  : array[0..63] of byte;
+        hp     : pdynamicblock;
       begin
       { calc amount of sections we have and align sections at 4 bytes }
         fillchar(empty,sizeof(empty),0);
@@ -974,18 +978,30 @@ unit og386elf;
                 calculated more easily }
             if sec=sec_stab then
              begin
-               pelf32stab(sects[sec_stab]^.data^.data)^.nvalue:=sects[sec_stabstr]^.datalen;
-               pelf32stab(sects[sec_stab]^.data^.data)^.strpos:=1;
-               pelf32stab(sects[sec_stab]^.data^.data)^.ndesc:=
-                 (sects[sec_stab]^.datalen div sizeof(telf32stab))-1{+1 according to gas output PM};
+               hstab.strpos:=1;
+               hstab.ntype:=0;
+               hstab.nother:=0;
+               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;
-            { save the original section length }
             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;
       { .shstrtab }
         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 }
         writer^.write(empty,sizeof(telf32sechdr));
         for sec:=low(tsection) to high(tsection) do
@@ -1000,17 +1016,32 @@ unit og386elf;
         writesectionheader(strtabsect);
       { .symtab }
         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 }
         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 }
         for sec:=low(tsection) to high(tsection) do
          if assigned(sects[sec]) and
             assigned(sects[sec]^.relocsect) then
           begin
             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;
 
@@ -1018,7 +1049,11 @@ unit og386elf;
 end.
 {
   $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 is default again for linux
 

+ 53 - 55
compiler/owar.pas

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

+ 7 - 3
compiler/owbase.pas

@@ -30,7 +30,7 @@ type
     destructor  Done;virtual;
     procedure create(const fn:string);virtual;
     procedure close;virtual;
-    procedure writesym(sym:string);virtual;
+    procedure writesym(const sym:string);virtual;
     procedure write(var b;len:longint);virtual;
   private
     f      : file;
@@ -114,7 +114,7 @@ begin
 end;
 
 
-procedure tobjectwriter.writesym(sym:string);
+procedure tobjectwriter.writesym(const sym:string);
 begin
 end;
 
@@ -152,7 +152,11 @@ end;
 end.
 {
   $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
 
 }