* a lot of changes:

     - basic dyn. array support
     - basic C++ support
     - some work for interfaces done
     ....

compiler/i386/n386inl.pas

@@ -194,6 +194,7 @@ implementation
          {inc/dec}
          addconstant : boolean;
          addvalue : longint;
+         hp : tnode;
 
 
       procedure handlereadwrite(doread,doln : boolean);
@@ -681,6 +682,7 @@ implementation
            dummycoll : tparaitem;
            has_code, has_32bit_code, oldregisterdef: boolean;
            r : preference;
+           l : longint;
 
           begin
            dummycoll.init;
@@ -907,6 +909,8 @@ implementation
          hregister : tregister;
          otlabel,oflabel{,l1}   : pasmlabel;
          oldpushedparasize : longint;
+         def : pdef;
+         hr,hr2 : treference;
 
       begin
       { save & reset pushedparasize }
@@ -1341,6 +1345,67 @@ implementation
                     emitcall('FPC_REWRITE_TYPED');
                   popusedregisters(pushed);
                end;
+            in_setlength_x:
+               begin
+                  pushusedregisters(pushed,$ff);
+                  l:=0;
+                  { push dimensions }
+                  hp:=left;
+                  while assigned(tcallparanode(hp).right) do
+                    begin
+                       inc(l);
+                       hp:=tcallparanode(hp).right;
+                    end;
+                  def:=tcallparanode(hp).left.resulttype;
+                  hp:=left;
+                  if is_dynamic_array(def) then
+                    begin
+                       { get temp. space }
+                       gettempofsizereference(l*4,hr);
+                       { copy dimensions }
+                       hp:=left;
+                       while assigned(tcallparanode(hp).right) do
+                         begin
+                            secondpass(tcallparanode(hp).left);
+                            emit_mov_loc_ref(tcallparanode(hp).left.location,hr,
+                              S_L,true);
+                            inc(hr.offset,4);
+                            hp:=tcallparanode(hp).right;
+                         end;
+                    end
+                  else
+                    begin
+                       secondpass(tcallparanode(hp).left);
+                       emit_push_loc(tcallparanode(hp).left.location);
+                       hp:=tcallparanode(hp).right;
+                    end;
+                  secondpass(tcallparanode(hp).left);
+                  if is_dynamic_array(def) then
+                    begin
+                       emitpushreferenceaddr(hr);
+                       push_int(l);
+                       reset_reference(hr2);
+                       hr2.symbol:=def^.get_inittable_label;
+                       emitpushreferenceaddr(hr2);
+                       emitpushreferenceaddr(tcallparanode(hp).left.location.reference);
+                       emitcall('FPC_DYNARR_SETLENGTH');
+                       ungetiftemp(hr);
+                    end
+                  else
+                    { must be string }
+                    begin
+                       emitpushreferenceaddr(tcallparanode(hp).left.location.reference);
+                       case pstringdef(def)^.string_typ of
+                          st_widestring:
+                            emitcall('FPC_WIDESTR_SETLENGTH');
+                          st_ansistring:
+                            emitcall('FPC_ANSISTR_SETLENGTH');
+                          st_shortstring:
+                            emitcall('FPC_SHORTSTR_SETLENGTH');
+                       end;
+                    end;
+                  popusedregisters(pushed);
+               end;
             in_write_x :
               handlereadwrite(false,false);
             in_writeln_x :
@@ -1547,7 +1612,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2000-10-15 09:33:31  peter
+  Revision 1.2  2000-10-21 18:16:13  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.1  2000/10/15 09:33:31  peter
     * moved n386*.pas to i386/ cpu_target dir
 
   Revision 1.2  2000/10/15 09:08:58  peter

compiler/i386/n386mem.pas

@@ -520,6 +520,39 @@ implementation
                      1,location.reference.base);
                 end;
 
+              { we've also to keep left up-to-date, because it is used   }
+              { if a constant array index occurs, subject to change (FK) }
+              set_location(left.location,location);
+           end
+         else if is_dynamic_array(left.resulttype) then
+         { ... also a dynamic string }
+           begin
+              reset_reference(location.reference);
+
+              if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+                begin
+                   location.reference.base:=left.location.register;
+                end
+              else
+                begin
+                   del_reference(left.location.reference);
+                   location.reference.base:=getregister32;
+                   emit_ref_reg(A_MOV,S_L,
+                     newreference(left.location.reference),
+                     location.reference.base);
+                end;
+{$warning FIXME}
+              { check for a zero length string,
+                we can use the ansistring routine here }
+              if (cs_check_range in aktlocalswitches) then
+                begin
+                   pushusedregisters(pushed,$ff);
+                   emit_reg(A_PUSH,S_L,location.reference.base);
+                   emitcall('FPC_ANSISTR_CHECKZERO');
+                   maybe_loadesi;
+                   popusedregisters(pushed);
+                end;
+
               { we've also to keep left up-to-date, because it is used   }
               { if a constant array index occurs, subject to change (FK) }
               set_location(left.location,location);
@@ -528,7 +561,8 @@ implementation
            set_location(location,left.location);
 
          { offset can only differ from 0 if arraydef }
-         if left.resulttype^.deftype=arraydef then
+         if (left.resulttype^.deftype=arraydef) and
+           not(is_dynamic_array(left.resulttype)) then
            dec(location.reference.offset,
                get_mul_size*parraydef(left.resulttype)^.lowrange);
          if right.nodetype=ordconstn then
@@ -537,7 +571,8 @@ implementation
               if (left.resulttype^.deftype=arraydef) then
                 begin
                    if not(is_open_array(left.resulttype)) and
-                      not(is_array_of_const(left.resulttype)) then
+                      not(is_array_of_const(left.resulttype)) and
+                      not(is_dynamic_array(left.resulttype)) then
                      begin
                         if (tordconstnode(right).value>parraydef(left.resulttype)^.highrange) or
                            (tordconstnode(right).value<parraydef(left.resulttype)^.lowrange) then
@@ -552,7 +587,8 @@ implementation
                      end
                    else
                      begin
-                        { range checking for open arrays !!!! }
+                        { range checking for open and dynamic arrays !!!! }
+{$warning FIXME}
                         {!!!!!!!!!!!!!!!!!}
                      end;
                 end
@@ -1017,7 +1053,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2000-10-15 09:33:32  peter
+  Revision 1.2  2000-10-21 18:16:13  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.1  2000/10/15 09:33:32  peter
     * moved n386*.pas to i386/ cpu_target dir
 
   Revision 1.2  2000/10/14 21:52:54  peter

compiler/innr.inc

@@ -53,6 +53,7 @@ const
    in_assert_x_y        = 41;
    in_addr_x            = 42;
    in_typeinfo_x        = 43;
+   in_setlength_x       = 44;
 
 { Internal constant functions }
    in_const_trunc      = 100;
@@ -100,7 +101,14 @@ const
 
 {
   $Log$
-  Revision 1.3  2000-08-16 13:06:06  florian
+  Revision 1.4  2000-10-21 18:16:11  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.3  2000/08/16 13:06:06  florian
     + support of 64 bit integer constants
 
   Revision 1.2  2000/07/13 11:32:43  michael

compiler/ncal.pas

@@ -2,6 +2,8 @@
     $Id$
     Copyright (c) 1998-2000 by Florian Klaempfl
 
+    This file implements the node for sub procedure calling
+
 
     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
@@ -43,6 +45,7 @@ interface
           constructor create(v : pprocsym;st : psymtable; mp : tnode);virtual;
           destructor destroy;override;
           function getcopy : tnode;override;
+          procedure insertintolist(l : tnodelist);override;
           function pass_1 : tnode;override;
        end;
 
@@ -62,6 +65,7 @@ interface
           constructor create(expr,next : tnode);virtual;
           destructor destroy;override;
           function getcopy : tnode;override;
+          procedure insertintolist(l : tnodelist);override;
           procedure gen_high_tree(openstring:boolean);
           { tcallparanode doesn't use pass_1 }
           { tcallnode takes care of this     }
@@ -78,6 +82,7 @@ interface
           constructor create(callp,code : tnode);virtual;
           destructor destroy;override;
           function getcopy : tnode;override;
+          procedure insertintolist(l : tnodelist);override;
           function pass_1 : tnode;override;
        end;
 
@@ -171,6 +176,11 @@ interface
          result:=n;
       end;
 
+    procedure tcallparanode.insertintolist(l : tnodelist);
+
+      begin
+      end;
+
     procedure tcallparanode.firstcallparan(defcoll : pparaitem;do_count : boolean);
       var
         old_get_para_resulttype : boolean;
@@ -520,6 +530,10 @@ interface
         result:=n;
       end;
 
+    procedure tcallnode.insertintolist(l : tnodelist);
+
+      begin
+      end;
     function tcallnode.pass_1 : tnode;
       type
          pprocdefcoll = ^tprocdefcoll;
@@ -1514,6 +1528,11 @@ interface
          getcopy:=n;
       end;
 
+    procedure tprocinlinenode.insertintolist(l : tnodelist);
+
+      begin
+      end;
+
     function tprocinlinenode.pass_1 : tnode;
       begin
         pass_1:=nil;
@@ -1530,7 +1549,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  2000-10-21 14:35:27  peter
+  Revision 1.12  2000-10-21 18:16:11  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.11  2000/10/21 14:35:27  peter
     * readd to many remove p. for tcallnode.is_equal()
 
   Revision 1.10  2000/10/14 21:52:55  peter
@@ -1563,4 +1589,4 @@ end.
   Revision 1.1  2000/09/20 20:52:16  florian
     * initial revision
 
-}
+}

compiler/nflw.pas

@@ -36,6 +36,7 @@ interface
           constructor create(tt : tnodetype;l,r,_t1,_t2 : tnode);virtual;
           destructor destroy;override;
           function getcopy : tnode;override;
+          procedure insertintolist(l : tnodelist);override;
 {$ifdef extdebug}
           procedure dowrite;override;
 {$endif extdebug}
@@ -91,6 +92,7 @@ interface
           frametree : tnode;
           constructor create(l,taddr,tframe:tnode);virtual;
           function getcopy : tnode;override;
+          procedure insertintolist(l : tnodelist);override;
           function pass_1 : tnode;override;
        end;
 
@@ -217,6 +219,10 @@ implementation
          getcopy:=p;
       end;
 
+    procedure tloopnode.insertintolist(l : tnodelist);
+
+      begin
+      end;
 {$ifdef extdebug}
     procedure tloopnode.dowrite;
       begin
@@ -725,6 +731,11 @@ implementation
          getcopy:=n;
       end;
 
+    procedure traisenode.insertintolist(l : tnodelist);
+
+      begin
+      end;
+
     function traisenode.pass_1 : tnode;
       begin
          pass_1:=nil;
@@ -982,7 +993,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.7  2000-10-14 21:52:55  peter
+  Revision 1.8  2000-10-21 18:16:11  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.7  2000/10/14 21:52:55  peter
     * fixed memory leaks
 
   Revision 1.6  2000/10/14 10:14:50  peter
@@ -1003,4 +1021,4 @@ end.
   Revision 1.1  2000/09/22 22:46:03  florian
     + initial revision
 
-}
+}

compiler/ninl.pas

@@ -100,9 +100,10 @@ implementation
 {$endif fpc}
     function tinlinenode.pass_1 : tnode;
       var
-         vl,vl2  : longint;
+         vl,vl2,counter  : longint;
          vr      : bestreal;
          p1,hp,hpp  :  tnode;
+         ppn : tcallparanode;
 {$ifndef NOCOLONCHECK}
          frac_para,length_para : tnode;
 {$endif ndef NOCOLONCHECK}
@@ -658,6 +659,43 @@ implementation
                     end;
                end;
 
+             in_setlength_x:
+               begin
+                  resulttype:=voiddef;
+                  if assigned(left) then
+                    begin
+                       ppn:=tcallparanode(left);
+                       counter:=0;
+                       { check type }
+                       while assigned(ppn.right) do
+                         begin
+                            ppn.left:=gentypeconvnode(ppn.left,s32bitdef);
+                            firstpass(ppn.left);
+                            if codegenerror then
+                              exit;
+                            inc(counter);
+                            ppn:=tcallparanode(ppn.right);
+                         end;
+                       firstpass(ppn.left);
+                       if codegenerror then
+                        exit;
+                       { last param must be var }
+                       valid_for_assign(ppn.left,false);
+                       set_varstate(ppn.left,true);
+                       { first param must be a string or dynamic array ...}
+                       if not((ppn.left.resulttype^.deftype=stringdef) or
+                          (is_dynamic_array(ppn.left.resulttype))) then
+                         CGMessage(type_e_mismatch);
+
+                       { only dynamic arrays accept more dimensions }
+                       if (counter>1) and
+                         (not(is_dynamic_array(left.resulttype))) then
+                         CGMessage(type_e_mismatch);
+                    end
+                  else
+                    CGMessage(type_e_mismatch);
+               end;
+
              in_inc_x,
              in_dec_x:
                begin
@@ -1293,7 +1331,6 @@ implementation
                   else
                     handleextendedfunction;
                end;
-
              in_pi:
                if block_type=bt_const then
                  setconstrealvalue(pi)
@@ -1412,7 +1449,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2000-10-15 08:38:46  jonas
+  Revision 1.10  2000-10-21 18:16:11  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.9  2000/10/15 08:38:46  jonas
     * added missing getcopy for previous addition
 
   Revision 1.8  2000/10/14 18:27:53  jonas

compiler/nmem.pas

@@ -744,7 +744,9 @@ implementation
 
               { for ansi/wide strings, we need at least one register }
               if is_ansistring(left.resulttype) or
-                is_widestring(left.resulttype) then
+                is_widestring(left.resulttype) or
+              { ... as well as for dynamic arrays }
+                is_dynamic_array(left.resulttype) then
                 registers32:=max(registers32,1);
            end
          else
@@ -755,7 +757,9 @@ implementation
 
               { for ansi/wide strings, we need at least one register }
               if is_ansistring(left.resulttype) or
-                is_widestring(left.resulttype) then
+                is_widestring(left.resulttype) or
+              { ... as well as for dynamic arrays }
+                is_dynamic_array(left.resulttype) then
                 registers32:=max(registers32,1);
 
               { need we an extra register when doing the restore ? }
@@ -904,7 +908,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.7  2000-10-14 21:52:55  peter
+  Revision 1.8  2000-10-21 18:16:11  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.7  2000/10/14 21:52:55  peter
     * fixed memory leaks
 
   Revision 1.6  2000/10/14 10:14:51  peter

compiler/node.inc

@@ -240,6 +240,11 @@
          getcopy:=p;
       end;
 
+    procedure tnode.insertintolist(l : tnodelist);
+
+      begin
+      end;
+
     procedure tnode.set_file_line(from : tnode);
 
       begin
@@ -292,6 +297,11 @@
          getcopy:=p;
       end;
 
+    procedure tunarynode.insertintolist(l : tnodelist);
+
+      begin
+      end;
+
 {$ifdef extdebug}
     procedure tunarynode.dowrite;
 
@@ -411,6 +421,10 @@
          getcopy:=p;
       end;
 
+    procedure tbinarynode.insertintolist(l : tnodelist);
+
+      begin
+      end;
 
     procedure tbinarynode.swapleftright;
 
@@ -502,7 +516,14 @@
 
 {
   $Log$
-  Revision 1.10  2000-10-14 21:52:55  peter
+  Revision 1.11  2000-10-21 18:16:11  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.10  2000/10/14 21:52:55  peter
     * fixed memory leaks
 
   Revision 1.9  2000/10/14 10:14:51  peter

compiler/nodeh.inc

@@ -178,6 +178,9 @@
        flagsequal : tnodeflagset = [nf_error,nf_static_call,nf_backward];
 
     type
+       tnodelist = class
+       end;
+
        { later (for the newcg) tnode will inherit from tlinkedlist_item }
        tnode = class
           nodetype : tnodetype;
@@ -230,6 +233,7 @@
           { gets a copy of the node }
           function getcopy : tnode;virtual;
 
+          procedure insertintolist(l : tnodelist);virtual;
 {$ifdef EXTDEBUG}
           { writes a node for debugging purpose, shouldn't be called }
           { direct, because there is no test for nil, use writenode  }
@@ -265,6 +269,7 @@
           procedure det_temp;override;
           function docompare(p : tnode) : boolean;override;
           function getcopy : tnode;override;
+          procedure insertintolist(l : tnodelist);override;
           procedure left_max;
 {$ifdef extdebug}
           procedure dowrite;override;
@@ -283,6 +288,7 @@
           function docompare(p : tnode) : boolean;override;
           procedure swapleftright;
           function getcopy : tnode;override;
+          procedure insertintolist(l : tnodelist);override;
           procedure left_right_max;
 {$ifdef extdebug}
           procedure dowrite;override;
@@ -304,7 +310,14 @@
 
 {
   $Log$
-  Revision 1.13  2000-10-14 21:52:55  peter
+  Revision 1.14  2000-10-21 18:16:11  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.13  2000/10/14 21:52:55  peter
     * fixed memory leaks
 
   Revision 1.12  2000/10/14 10:14:51  peter

compiler/nset.pas

@@ -70,6 +70,7 @@ interface
           constructor create(l,r : tnode;n : pcaserecord);virtual;
           destructor destroy;override;
           function getcopy : tnode;override;
+          procedure insertintolist(l : tnodelist);override;
           function pass_1 : tnode;override;
        end;
 
@@ -511,6 +512,11 @@ implementation
          getcopy:=p;
       end;
 
+    procedure tcasenode.insertintolist(l : tnodelist);
+
+      begin
+      end;
+
 begin
    csetelementnode:=tsetelementnode;
    cinnode:=tinnode;
@@ -519,7 +525,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2000-10-14 10:14:51  peter
+  Revision 1.6  2000-10-21 18:16:11  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.5  2000/10/14 10:14:51  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.4  2000/10/01 19:48:25  peter

compiler/pdecobj.pas

@@ -883,11 +883,9 @@ unit pdecobj;
         begin
            if aktclass^.is_cppclass then
              begin
-                {
                 include(aktprocsym^.definition^.proccalloptions,pocall_cppdecl);
                 aktprocsym^.definition^.setmangledname(
-                  target_os.Cprefix+aktprocsym^.definition^.cplusplusmangledname(realname));
-                }
+                  target_os.Cprefix+aktprocsym^.definition^.cplusplusmangledname);
              end;
         end;
 
@@ -1079,7 +1077,14 @@ unit pdecobj;
 end.
 {
   $Log$
-  Revision 1.1  2000-10-14 10:14:51  peter
+  Revision 1.2  2000-10-21 18:16:11  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.1  2000/10/14 10:14:51  peter
     * moehrendorf oct 2000 rewrite
 
 }

compiler/pdecsub.pas

@@ -897,7 +897,7 @@ procedure pd_cppdecl(const procnames:Tstringcontainer);
 begin
   if aktprocsym^.definition^.deftype<>procvardef then
     aktprocsym^.definition^.setmangledname(
-      target_os.Cprefix+aktprocsym^.definition^.cplusplusmangledname(aktprocsym^.realname));
+      target_os.Cprefix+aktprocsym^.definition^.cplusplusmangledname);
   { do not copy on local !! }
   if (aktprocsym^.definition^.deftype=procdef) and
      assigned(aktprocsym^.definition^.parast) then
@@ -1580,7 +1580,7 @@ begin
                    (aktprocsym^.definition^.maxparacount>0)) then
                  begin
                     MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_header_dont_match_forward,
-                                aktprocsym^.declarationstr);
+                                aktprocsym^.declarationstr(aktprocsym^.definition));
                     exit;
                  end;
                if hd^.forwarddef then
@@ -1593,7 +1593,7 @@ begin
                       (m_repeat_forward in aktmodeswitches)) then
                      begin
                        MessagePos1(aktprocsym^.definition^.fileinfo,parser_e_header_dont_match_forward,
-                                   aktprocsym^.declarationstr);
+                                   aktprocsym^.declarationstr(aktprocsym^.definition));
                        exit;
                      end;
                    { Check calling convention, no check for internconst,internproc which
@@ -1648,7 +1648,8 @@ begin
                          if hd^.forwarddef and aktprocsym^.definition^.forwarddef then
                            begin
                              MessagePos1(aktprocsym^.definition^.fileinfo,
-                                         parser_e_function_already_declared_public_forward,aktprocsym^.declarationstr);
+                                         parser_e_function_already_declared_public_forward,
+                                         aktprocsym^.declarationstr(aktprocsym^.definition));
                              check_identical_proc:=true;
                            { Remove other forward from the list to reduce errors }
                              pd^.nextoverloaded:=pd^.nextoverloaded^.nextoverloaded;
@@ -1814,7 +1815,14 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-10-15 07:47:51  peter
+  Revision 1.3  2000-10-21 18:16:11  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.2  2000/10/15 07:47:51  peter
     * unit names and procedure names are stored mixed case
 
   Revision 1.1  2000/10/14 10:14:51  peter

compiler/pexpr.pas

@@ -514,6 +514,23 @@ implementation
               statement_syssym := p1;
             end;
 
+          in_setlength_x:
+            begin
+              if token=_LKLAMMER then
+               begin
+                 consume(_LKLAMMER);
+                 in_args:=true;
+                 paras:=parse_paras(false,false);
+                 consume(_RKLAMMER);
+               end
+              else
+               paras:=nil;
+              pd:=voiddef;
+              p1:=geninlinenode(l,false,paras);
+              do_firstpass(p1);
+              statement_syssym := p1;
+            end;
+
           in_write_x,
           in_writeln_x :
             begin
@@ -2357,7 +2374,14 @@ _LECKKLAMMER : begin
 end.
 {
   $Log$
-  Revision 1.11  2000-10-14 10:14:51  peter
+  Revision 1.12  2000-10-21 18:16:12  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.11  2000/10/14 10:14:51  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.10  2000/10/01 19:48:25  peter

compiler/psub.pas

@@ -626,7 +626,8 @@ implementation
            { A method must be forward defined (in the object declaration) }
              if assigned(procinfo^._class) and (not assigned(oldprocinfo^._class)) then
               begin
-                Message1(parser_e_header_dont_match_any_member,aktprocsym^.declarationstr);
+                Message1(parser_e_header_dont_match_any_member,
+                  aktprocsym^.declarationstr(aktprocsym^.definition));
                 aktprocsym^.write_parameter_lists(aktprocsym^.definition);
               end
              else
@@ -639,7 +640,8 @@ implementation
                    aktprocsym^.definition^.nextoverloaded^.interfacedef and
                    not(assigned(aktprocsym^.definition^.nextoverloaded^.nextoverloaded)) then
                  begin
-                   Message1(parser_e_header_dont_match_forward,aktprocsym^.declarationstr);
+                   Message1(parser_e_header_dont_match_forward,
+                     aktprocsym^.declarationstr(aktprocsym^.definition));
                    aktprocsym^.write_parameter_lists(aktprocsym^.definition);
                  end
                 else
@@ -686,7 +688,8 @@ implementation
       { compile procedure when a body is needed }
          if (pdflags and pd_body)<>0 then
            begin
-             Message1(parser_p_procedure_start,aktprocsym^.declarationstr);
+             Message1(parser_p_procedure_start,
+               aktprocsym^.declarationstr(aktprocsym^.definition));
              names^.insert(aktprocsym^.definition^.mangledname);
             { set _FAIL as keyword if constructor }
             if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
@@ -828,7 +831,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.17  2000-10-15 07:47:51  peter
+  Revision 1.18  2000-10-21 18:16:12  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.17  2000/10/15 07:47:51  peter
     * unit names and procedure names are stored mixed case
 
   Revision 1.16  2000/10/14 10:14:52  peter

compiler/psystem.pas

@@ -42,7 +42,7 @@ uses
 
 procedure insertinternsyms(p : psymtable);
 {
-  all intern procedures for system unit
+  all intern procedures for the system unit
 }
 begin
   p^.insert(new(psyssym,init('Concat',in_concat_x)));
@@ -71,6 +71,7 @@ begin
   p^.insert(new(psyssym,init('Val',in_val_x)));
   p^.insert(new(psyssym,init('Addr',in_addr_x)));
   p^.insert(new(psyssym,init('TypeInfo',in_typeinfo_x)));
+  p^.insert(new(psyssym,init('SetLength',in_setlength_x)));
 end;
 
 
@@ -255,7 +256,14 @@ end;
 end.
 {
   $Log$
-  Revision 1.6  2000-10-14 10:14:52  peter
+  Revision 1.7  2000-10-21 18:16:12  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.6  2000/10/14 10:14:52  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.5  2000/09/24 15:06:24  peter

compiler/ptype.pas

@@ -347,70 +347,80 @@ implementation
 
         begin
            consume(_ARRAY);
-           consume(_LECKKLAMMER);
-           { defaults }
-           arraytype:=generrordef;
-           lowval:=$80000000;
-           highval:=$7fffffff;
-           tt.reset;
-           repeat
-             { read the expression and check it, check apart if the
-               declaration is an enum declaration because that needs to
-               be parsed by readtype (PFV) }
-             if token=_LKLAMMER then
-              begin
-                read_type(ht,'');
-                setdefdecl(ht.def);
-              end
-             else
-              begin
-                pt:=expr;
-                if pt.nodetype=typen then
-                 setdefdecl(pt.resulttype)
-                else
-                  begin
-                     do_firstpass(pt);
-                     if (pt.nodetype=rangen) then
-                      begin
-                        if (trangenode(pt).left.nodetype=ordconstn) and
-                           (trangenode(pt).right.nodetype=ordconstn) then
-                         begin
-                           lowval:=tordconstnode(trangenode(pt).left).value;
-                           highval:=tordconstnode(trangenode(pt).right).value;
-                           if highval<lowval then
-                            begin
-                              Message(parser_e_array_lower_less_than_upper_bound);
-                              highval:=lowval;
-                            end;
-                           arraytype:=trangenode(pt).right.resulttype;
-                         end
-                        else
-                         Message(type_e_cant_eval_constant_expr);
-                      end
+           { open array? }
+           if token=_LECKKLAMMER then
+             begin
+                consume(_LECKKLAMMER);
+                { defaults }
+                arraytype:=generrordef;
+                lowval:=$80000000;
+                highval:=$7fffffff;
+                tt.reset;
+                repeat
+                  { read the expression and check it, check apart if the
+                    declaration is an enum declaration because that needs to
+                    be parsed by readtype (PFV) }
+                  if token=_LKLAMMER then
+                   begin
+                     read_type(ht,'');
+                     setdefdecl(ht.def);
+                   end
+                  else
+                   begin
+                     pt:=expr;
+                     if pt.nodetype=typen then
+                      setdefdecl(pt.resulttype)
                      else
-                      Message(sym_e_error_in_type_def)
-                  end;
-                pt.free;
-              end;
+                       begin
+                          do_firstpass(pt);
+                          if (pt.nodetype=rangen) then
+                           begin
+                             if (trangenode(pt).left.nodetype=ordconstn) and
+                                (trangenode(pt).right.nodetype=ordconstn) then
+                              begin
+                                lowval:=tordconstnode(trangenode(pt).left).value;
+                                highval:=tordconstnode(trangenode(pt).right).value;
+                                if highval<lowval then
+                                 begin
+                                   Message(parser_e_array_lower_less_than_upper_bound);
+                                   highval:=lowval;
+                                 end;
+                                arraytype:=trangenode(pt).right.resulttype;
+                              end
+                             else
+                              Message(type_e_cant_eval_constant_expr);
+                           end
+                          else
+                           Message(sym_e_error_in_type_def)
+                       end;
+                     pt.free;
+                   end;
 
-           { create arraydef }
-             if not assigned(tt.def) then
-              begin
-                ap:=new(parraydef,init(lowval,highval,arraytype));
-                tt.setdef(ap);
-              end
-             else
-              begin
-                ap^.elementtype.setdef(new(parraydef,init(lowval,highval,arraytype)));
-                ap:=parraydef(ap^.elementtype.def);
-              end;
+                { create arraydef }
+                  if not assigned(tt.def) then
+                   begin
+                     ap:=new(parraydef,init(lowval,highval,arraytype));
+                     tt.setdef(ap);
+                   end
+                  else
+                   begin
+                     ap^.elementtype.setdef(new(parraydef,init(lowval,highval,arraytype)));
+                     ap:=parraydef(ap^.elementtype.def);
+                   end;
 
-             if token=_COMMA then
-               consume(_COMMA)
-             else
-               break;
-           until false;
-           consume(_RECKKLAMMER);
+                  if token=_COMMA then
+                    consume(_COMMA)
+                  else
+                    break;
+                until false;
+                consume(_RECKKLAMMER);
+             end
+           else
+             begin
+                ap:=new(parraydef,init(0,-1,s32bitdef));
+                ap^.IsDynamicArray:=true;
+                tt.setdef(ap);
+             end;
            consume(_OF);
            read_type(tt2,'');
            { if no error, set element type }
@@ -572,7 +582,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.10  2000-10-14 10:14:52  peter
+  Revision 1.11  2000-10-21 18:16:12  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.10  2000/10/14 10:14:52  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.9  2000/09/24 15:06:25  peter

compiler/symconst.pas

@@ -53,6 +53,7 @@ const
   tkBool     = 18;
   tkInt64    = 19;
   tkQWord    = 20;
+  tkDynArray = 21;
 
   otSByte    = 0;
   otUByte    = 1;
@@ -281,7 +282,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.9  2000-10-15 07:47:52  peter
+  Revision 1.10  2000-10-21 18:16:12  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.9  2000/10/15 07:47:52  peter
     * unit names and procedure names are stored mixed case
 
   Revision 1.8  2000/10/14 10:14:52  peter

compiler/symdef.inc

@@ -1832,6 +1832,7 @@
          IsVariant:=false;
          IsConstructor:=false;
          IsArrayOfConst:=false;
+         IsDynamicArray:=false;
          rangenr:=0;
       end;
 
@@ -1848,6 +1849,8 @@
          IsArrayOfConst:=boolean(readbyte);
          IsVariant:=false;
          IsConstructor:=false;
+{$warning FIXME!!!!!}
+         IsDynamicArray:=false;
          rangenr:=0;
       end;
 
@@ -1949,6 +1952,11 @@
     function tarraydef.size : longint;
       begin
         {Tarraydef.size may never be called for an open array!}
+        if IsDynamicArray then
+          begin
+             size:=4;
+             exit;
+          end;
         if highrange<lowrange then
             internalerror(99080501);
         If (elesize>0) and
@@ -1978,7 +1986,7 @@
 
     function tarraydef.needs_inittable : boolean;
       begin
-         needs_inittable:=elementtype.def^.needs_inittable;
+         needs_inittable:=IsDynamicArray or elementtype.def^.needs_inittable;
       end;
 
 
@@ -1990,14 +1998,20 @@
 
     procedure tarraydef.write_rtti_data;
       begin
-         rttilist^.concat(new(pai_const,init_8bit(tkarray)));
+         if IsDynamicArray then
+           rttilist^.concat(new(pai_const,init_8bit(tkdynarray)))
+         else
+           rttilist^.concat(new(pai_const,init_8bit(tkarray)));
          write_rtti_name;
          { size of elements }
          rttilist^.concat(new(pai_const,init_32bit(elesize)));
          { count of elements }
-         rttilist^.concat(new(pai_const,init_32bit(highrange-lowrange+1)));
+         if not(IsDynamicArray) then
+           rttilist^.concat(new(pai_const,init_32bit(highrange-lowrange+1)));
          { element type }
          rttilist^.concat(new(pai_const_symbol,initname(elementtype.def^.get_rtti_label)));
+         { variant type }
+         // !!!!!!!!!!!!!!!!
       end;
 
     function tarraydef.gettypename : string;
@@ -2010,7 +2024,7 @@
              else
                gettypename:='Array Of '+elementtype.def^.typename;
            end
-         else if is_open_array(@self) then
+         else if is_open_array(@self) or IsDynamicArray then
            gettypename:='Array Of '+elementtype.def^.typename
          else
            begin
@@ -3085,7 +3099,7 @@ Const local_symtable_index : longint = $8001;
       end;
 {$endif}
 
-    function tprocdef.cplusplusmangledname(const rn : string) : string;
+    function tprocdef.cplusplusmangledname : string;
 
       function getcppparaname(p : pdef) : string;
 
@@ -3117,7 +3131,7 @@ Const local_symtable_index : longint = $8001;
          param : pparaitem;
 
       begin
-         s := rn;
+         s := procsym^.realname;
          if procsym^.owner^.symtabletype=objectsymtable then
            begin
               s2:=upper(pobjectdef(procsym^.owner^.defowner)^.typesym^.realname);
@@ -3624,7 +3638,7 @@ Const local_symtable_index : longint = $8001;
 
     function tobjectdef.vmt_mangledname : string;
     {DM: I get a nil pointer on the owner name. I don't know if this
-     mayhappen, and I have therefore fixed the problem by doing nil pointer
+     may happen, and I have therefore fixed the problem by doing nil pointer
      checks.}
     var
       s1,s2:string;
@@ -4339,7 +4353,14 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.23  2000-10-15 07:47:52  peter
+  Revision 1.24  2000-10-21 18:16:12  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.23  2000/10/15 07:47:52  peter
     * unit names and procedure names are stored mixed case
 
   Revision 1.22  2000/10/14 10:14:52  peter

compiler/symdefh.inc

@@ -261,6 +261,7 @@
           highrange  : longint;
           elementtype,
           rangetype  : ttype;
+          IsDynamicArray,
           IsVariant,
           IsConstructor,
           IsArrayOfConst : boolean;
@@ -464,7 +465,7 @@
 {$ifdef dummy}
           function  procname: string;
 {$endif dummy}
-          function  cplusplusmangledname(const rn : string) : string;
+          function  cplusplusmangledname : string;
           { debug }
 {$ifdef GDB}
           function  stabstring : pchar;virtual;
@@ -559,7 +560,14 @@
 
 {
   $Log$
-  Revision 1.12  2000-10-15 07:47:52  peter
+  Revision 1.13  2000-10-21 18:16:12  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.12  2000/10/15 07:47:52  peter
     * unit names and procedure names are stored mixed case
 
   Revision 1.11  2000/10/14 10:14:53  peter

compiler/symsym.inc

@@ -394,9 +394,9 @@
       end;
 
 
-    function tprocsym.declarationstr:string;
+    function tprocsym.declarationstr(p : pprocdef):string;
       begin
-        declarationstr:=realname+definition^.demangled_paras;
+        declarationstr:=realname+p^.demangled_paras;
       end;
 
 
@@ -424,9 +424,9 @@
               if pd^.forwarddef then
                 begin
                    if assigned(pd^._class) then
-                     MessagePos1(fileinfo,sym_e_forward_not_resolved,pd^._class^.objname^+'.'+declarationstr)
+                     MessagePos1(fileinfo,sym_e_forward_not_resolved,pd^._class^.objname^+'.'+declarationstr(pd))
                    else
-                     MessagePos1(fileinfo,sym_e_forward_not_resolved,declarationstr);
+                     MessagePos1(fileinfo,sym_e_forward_not_resolved,declarationstr(pd));
                    { Turn futher error messages off }
                    pd^.forwarddef:=false;
                 end;
@@ -2208,7 +2208,14 @@
 
 {
   $Log$
-  Revision 1.10  2000-10-15 07:47:53  peter
+  Revision 1.11  2000-10-21 18:16:12  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.10  2000/10/15 07:47:53  peter
     * unit names and procedure names are stored mixed case
 
   Revision 1.9  2000/09/24 21:19:52  peter

compiler/symsymh.inc

@@ -112,7 +112,7 @@
           constructor load;
           destructor done;virtual;
           function mangledname : string;virtual;
-          function declarationstr:string;
+          function declarationstr(p : pprocdef):string;
           { writes all declarations }
           procedure write_parameter_lists(skipdef:pprocdef);
           { tests, if all procedures definitions are defined and not }
@@ -316,7 +316,14 @@
 
 {
   $Log$
-  Revision 1.6  2000-10-15 07:47:53  peter
+  Revision 1.7  2000-10-21 18:16:12  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.6  2000/10/15 07:47:53  peter
     * unit names and procedure names are stored mixed case
 
   Revision 1.5  2000/08/27 20:19:40  peter

compiler/types.pas

@@ -80,6 +80,9 @@ interface
     { true if p points to an open array def }
     function is_open_array(p : pdef) : boolean;
 
+    { true if p points to a dynamic array def }
+    function is_dynamic_array(p : pdef) : boolean;
+
     { true, if p points to an array of const def }
     function is_array_constructor(p : pdef) : boolean;
 
@@ -564,6 +567,14 @@ implementation
                               not(is_special_array(p));
       end;
 
+    { true if p points to a dynamic array def }
+    function is_dynamic_array(p : pdef) : boolean;
+      begin
+         is_dynamic_array:=(p^.deftype=arraydef) and
+           parraydef(p)^.IsDynamicArray;
+      end;
+
+
     { true, if p points to an open array def }
     function is_open_array(p : pdef) : boolean;
       begin
@@ -575,7 +586,8 @@ implementation
                         (parraydef(p)^.highrange=-1) and
                         not(parraydef(p)^.IsConstructor) and
                         not(parraydef(p)^.IsVariant) and
-                        not(parraydef(p)^.IsArrayOfConst);
+                        not(parraydef(p)^.IsArrayOfConst) and
+                        not(parraydef(p)^.IsDynamicArray);
 
       end;
 
@@ -1070,12 +1082,15 @@ implementation
          else
            if (def1^.deftype=arraydef) and (def2^.deftype=arraydef) then
              begin
-               if is_array_of_const(def1) or is_array_of_const(def2) then
-                begin
+               if is_dynamic_array(def1) and is_dynamic_array(def2) then
+                 b:=is_equal(parraydef(def1)^.elementtype.def,parraydef(def2)^.elementtype.def)
+               else
+                if is_array_of_const(def1) or is_array_of_const(def2) then
+                 begin
                   b:=(is_array_of_const(def1) and is_array_of_const(def2)) or
                      (is_array_of_const(def1) and is_array_constructor(def2)) or
                      (is_array_of_const(def2) and is_array_constructor(def1));
-                end
+                 end
                else
                 if is_open_array(def1) or is_open_array(def2) then
                  begin
@@ -1669,7 +1684,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.14  2000-10-14 10:14:56  peter
+  Revision 1.15  2000-10-21 18:16:12  florian
+    * a lot of changes:
+       - basic dyn. array support
+       - basic C++ support
+       - some work for interfaces done
+       ....
+
+  Revision 1.14  2000/10/14 10:14:56  peter
     * moehrendorf oct 2000 rewrite
 
   Revision 1.13  2000/10/01 19:48:26  peter