* fixed linker errors

rtl/inc/dynarr.inc

@@ -0,0 +1,138 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2000 by Florian Klaempfl
+    member of the Free Pascal development team.
+
+    This file implements the helper routines for dyn. Arrays in FPC
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************
+}
+
+type
+   tdynarrayindex = longint;
+   pdynarrayindex = ^tdynarrayindex;
+   t_size = dword;
+
+   { don't add new fields, the size is used }
+   { to calculate memory requirements       }
+   tdynarray = record
+      refcount : dword;
+      high : tdynarrayindex;
+   end;
+
+   pdynarray = ^tdynarray;
+   pdynarraytypeinfo = packed record
+      kind : byte;
+      namelen : byte;
+      // here the chars follow, we've to skip them
+      elesize : t_size;
+      eletype : pdynarraytypeinfo;
+   end;
+
+function dynarray_length(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_LENGTH'];
+
+  begin
+     dynarray_length:=pdynarray(p-sizeof(tdynarray))^.high+1;
+  end;
+
+function dynarray_high(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_HIGH'];
+
+  begin
+//!!!!!!!     dynarray_length:=pdynarray(p-sizeof(tdynarray))^.high;
+  end;
+
+procedure dynarray_decr_ref(var p : pointer);[Public,Alias:'FPC_DYNARRAY_DECR_REF'];
+
+  begin
+  end;
+
+procedure dynarray_setlength(var p : pointer;ti : pdynarraytypeinfo;
+  dimcount : dword;dims : pdynarrayindex);[Public,Alias:'FPC_DYNARRAY_SETLENGTH'];
+
+  var
+     i : tdynarrayindex;
+     size : t_size;
+     { contains the "fixed" pointers where the refcount }
+     { and high are at positive offsets                 }
+     realp,newp : pdynarray;
+
+  begin
+{!!!!!!
+     realp:=pdynarray(p-sizeof(tdynarray));
+     if dims[0]<0 then
+       HandleErrorFrame(201,get_frame);
+     if dims[0]=0 then
+       begin
+          { release all data }
+          !!!!!
+          p:=nil;
+          exit;
+       end;
+     if dims[0]<>realp^.high+1 then
+       begin
+          { determine new memory size }
+          size:=ti.elesize*dims[0]+sizeof(tdynarray);
+
+          { range checking is quite difficult ... }
+          if (size<sizeof(tdynarray)) or
+            ((ti.elesize>0) and (size<ti.elesize)) then
+            HandleErrorFrame(201,get_frame);
+
+          { skip kind and name }
+          inc(pointer(ti),ord(ti.namelen));
+
+          { resize? }
+          if realp.refcount=1 then
+            begin
+               { shrink the array? }
+               if dims[0]<realp^.high+1 then
+                 begin
+                    for i:=dims[0]-1 to realp^.high do
+                       finalize(,ti^.eletype);
+                    reallocmem(realp,size);
+                 end
+               else
+                 begin
+                    reallocmem(realp,size);
+                    !!!!!! fillchar
+                 end;
+            end
+          else
+            begin
+               { no, copy }
+               !!!!!!!
+            end;
+       end;
+
+     { handle nested arrays }
+     if dimcount>1 then
+       begin
+          for i:=0 to dims[0]-1 do
+            dynarray_setlength(newp+sizeof(tdynarray)+i*elesize,
+              ti.eletype,dimcount-1,@dims[1]);
+       end;
+     p:=newp+sizeof(tdynarray);
+!!!!!!}
+  end;
+
+function dynarray_copy(var p : pointer;ti : pdynarraytypeinfo;
+  dimcount : dword;dims : pdynarrayindex) : pointer;[Public,Alias:'FPC_DYNARRAY_COPY'];
+
+  begin
+  end;
+
+
+{
+  $Log$
+  Revision 1.1  2000-11-04 17:52:46  florian
+    * fixed linker errors
+
+}

rtl/inc/objpas.inc

@@ -32,7 +32,25 @@
            handleerror(219);
       end;
 
-{$ifndef ver1_0}
+{$ifdef ver1_0}
+    { dummies for make cycle with 1.0.x }
+    procedure int_do_intf_decr_ref(var i: pointer);[public,alias: 'FPC_INTF_DECR_REF'];
+      begin
+      end;
+
+    procedure int_do_intf_incr_ref(const i: pointer);[public,alias: 'FPC_INTF_INCR_REF'];
+      begin
+      end;
+
+    procedure int_do_intf_assign(var D: pointer; const S: pointer);[public,alias: 'FPC_INTF_ASSIGN'];
+      begin
+      end;
+
+    procedure int_do_intf_as(var D: pointer; const S: pointer; const iid: TGUID);[public,alias: 'FPC_INTF_AS'];
+      begin
+      end;
+
+{$else ver1_0}
     { interface helpers }
     procedure int_do_intf_decr_ref(var i: pointer);[public,alias: 'FPC_INTF_DECR_REF'];
       begin
@@ -586,7 +604,10 @@
 
 {
   $Log$
-  Revision 1.4  2000-11-04 16:29:54  florian
+  Revision 1.5  2000-11-04 17:52:46  florian
+    * fixed linker errors
+
+  Revision 1.4  2000/11/04 16:29:54  florian
     + interfaces support
 
   Revision 1.3  2000/07/22 14:52:01  sg
@@ -594,4 +615,4 @@
 
   Revision 1.1.2.1  2000/07/22 14:46:57  sg
   * Made TObject.MethodAddress case independent
-}
+}

rtl/inc/system.inc

@@ -175,6 +175,8 @@ End;
 {$i wstrings.inc}
 {$endif haswidechar}
 
+{$i dynarr.inc}
+
 {****************************************************************************
                          Run-Time Type Information (RTTI)
 ****************************************************************************}
@@ -635,7 +637,10 @@ end;
 
 {
   $Log$
-  Revision 1.6  2000-10-13 12:04:03  peter
+  Revision 1.7  2000-11-04 17:52:46  florian
+    * fixed linker errors
+
+  Revision 1.6  2000/10/13 12:04:03  peter
     * FPC_BREAK_ERROR added
 
   Revision 1.5  2000/08/13 17:55:14  michael