Ver código fonte

* overloading fix for array of const

peter 27 anos atrás
pai
commit
0f3b84ca23
6 arquivos alterados com 876 adições e 14 exclusões
  1. 6 2
      compiler/cg386cnv.pas
  2. 59 8
      compiler/pass_1.pas
  3. 9 2
      compiler/symdef.inc
  4. 476 0
      compiler/symdefh.inc
  5. 320 0
      compiler/symsymh.inc
  6. 6 2
      compiler/tree.pas

+ 6 - 2
compiler/cg386cnv.pas

@@ -1151,7 +1151,8 @@ implementation
            second_nothing,
            second_load_smallset,
            second_ansistring_to_pchar,
-           second_pchar_to_string);
+           second_pchar_to_string,
+           second_nothing);
 
       begin
          { this isn't good coding, I think tc_bool_2_int, shouldn't be }
@@ -1281,7 +1282,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.22  1998-09-22 15:34:09  peter
+  Revision 1.23  1998-09-23 12:03:51  peter
+    * overloading fix for array of const
+
+  Revision 1.22  1998/09/22 15:34:09  peter
     + pchar -> string conversion
 
   Revision 1.21  1998/09/20 17:46:47  florian

+ 59 - 8
compiler/pass_1.pas

@@ -319,6 +319,7 @@ unit pass_1;
         pd : pdef;
         hp : ptree;
         len : longint;
+        varia : boolean;
       begin
       { are we allowing array constructor? Then convert it to a set }
         if not allow_array_constructor then
@@ -330,6 +331,7 @@ unit pass_1;
       { only pass left tree, right tree contains next construct if any }
         pd:=nil;
         len:=0;
+        varia:=false;
         if assigned(p^.left) then
          begin
            hp:=p;
@@ -339,7 +341,11 @@ unit pass_1;
               if (pd=nil) then
                pd:=hp^.left^.resulttype
               else
-               Comment(V_Warning,'Variant type found !!');
+               if (not varia) and (not is_equal(pd,hp^.left^.resulttype)) then
+                begin
+                  varia:=true;
+                  Comment(V_Warning,'Variant type found !!');
+                end;
               inc(len);
               hp:=hp^.right;
             end;
@@ -348,6 +354,8 @@ unit pass_1;
          end;
         calcregisters(p,0,0,0);
         p^.resulttype:=new(parraydef,init(0,len,pd));
+        parraydef(p^.resulttype)^.IsConstructor:=true;
+        parraydef(p^.resulttype)^.IsVariant:=varia;
         p^.location.loc:=LOC_REFERENCE;
       end;
 
@@ -434,13 +442,15 @@ unit pass_1;
          b : boolean;
          hd1,hd2 : pdef;
       begin
-         b:=false;
-         if (not assigned(def_from)) or (not assigned(def_to)) then
+       { safety check }
+         if not(assigned(def_from) and assigned(def_to)) then
           begin
             isconvertable:=false;
             exit;
           end;
 
+         b:=false;
+
         { handle ord to ord first }
          if (def_from^.deftype=orddef) and (def_to^.deftype=orddef) then
            begin
@@ -528,6 +538,14 @@ unit pass_1;
            end
          else
 
+          if (def_from^.deftype=arraydef) and (def_to^.deftype=setdef) and
+             (parraydef(def_from)^.IsConstructor) then
+           begin
+             doconv:=tc_arrayconstructor_2_set;
+             b:=true;
+           end
+         else
+
          { typed files are all equal to the abstract file type
          name TYPEDFILE in system.pp in is_equal in types.pas
          the problem is that it sholud be also compatible to FILE
@@ -2708,6 +2726,22 @@ unit pass_1;
            p^.registers32:=1;
       end;
 
+
+    procedure first_arrayconstructor_to_set(var p:ptree);
+      var
+        hp : ptree;
+      begin
+        if p^.left^.treetype<>arrayconstructn then
+         internalerror(5546);
+      { remove typeconv node }
+        hp:=p;
+        p:=p^.left;
+        putnode(hp);
+      { create a set constructor tree }
+        arrayconstructor_to_set(p);
+      end;
+
+
     function is_procsym_load(p:Ptree):boolean;
 
       begin
@@ -2786,7 +2820,8 @@ unit pass_1;
                            first_cchar_charpointer,
                            first_load_smallset,
                            first_ansistring_to_pchar,
-                           first_pchar_to_ansistring);
+                           first_pchar_to_ansistring,
+                           first_arrayconstructor_to_set);
 
     begin
        aprocdef:=nil;
@@ -2855,6 +2890,7 @@ unit pass_1;
             firstpass(p);
             exit;
          end;
+
        if (not(isconvertable(p^.left^.resulttype,p^.resulttype,
            p^.convtyp,p^.left^.treetype,p^.explizit))) then
          begin
@@ -3161,7 +3197,7 @@ unit pass_1;
                     { only process typeconvn, else it will break other trees }
                     old_array_constructor:=allow_array_constructor;
                     allow_array_constructor:=true;
-{                    if (p^.left^.treetype=typeconvn) then }
+                    if (p^.left^.treetype=typeconvn) then
                       firstpass(p^.left);
                     allow_array_constructor:=old_array_constructor;
                     must_be_valid:=store_valid;
@@ -3271,17 +3307,29 @@ unit pass_1;
       function is_equal(def1,def2 : pdef) : boolean;
 
         begin
+           { safety check }
+           if not (assigned(def1) or assigned(def2)) then
+            begin
+              is_equal:=false;
+              exit;
+            end;
            { all types can be passed to a formaldef }
            is_equal:=(def1^.deftype=formaldef) or
-             (assigned(def2) and types.is_equal(def1,def2))
+             (types.is_equal(def1,def2))
            { to support ansi/long/wide strings in a proper way }
            { string and string[10] are assumed as equal        }
            { when searching the correct overloaded procedure   }
              or
-             (assigned(def1) and assigned(def2) and
+             (
               (def1^.deftype=stringdef) and (def2^.deftype=stringdef) and
               (pstringdef(def1)^.string_typ=pstringdef(def2)^.string_typ)
              )
+           { set can also be a not yet converted array constructor }
+             or
+             (
+              (def1^.deftype=setdef) and (def2^.deftype=arraydef) and
+              (parraydef(def2)^.IsConstructor) and not(parraydef(def2)^.IsVariant)
+             )
              ;
         end;
 
@@ -5733,7 +5781,10 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.90  1998-09-23 09:58:49  peter
+  Revision 1.91  1998-09-23 12:03:53  peter
+    * overloading fix for array of const
+
+  Revision 1.90  1998/09/23 09:58:49  peter
     * first working array of const things
 
   Revision 1.89  1998/09/22 15:34:10  peter

+ 9 - 2
compiler/symdef.inc

@@ -2,7 +2,7 @@
     $Id$
     Copyright (c) 1993-98 by Florian Klaempfl, Pierre Muller
 
-    Symbol table implementation for the defenitions
+    Symbol table implementation for the definitions
 
     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
@@ -1410,6 +1410,8 @@
          highrange:=h;
          rangedef:=rd;
          definition:=nil;
+         IsVariant:=false;
+         IsConstructor:=false;
          IsArrayOfConst:=false;
          rangenr:=0;
       end;
@@ -1425,6 +1427,8 @@
          lowrange:=readlong;
          highrange:=readlong;
          IsArrayOfConst:=boolean(readbyte);
+         IsVariant:=false;
+         IsConstructor:=false;
          rangenr:=0;
       end;
 
@@ -3020,7 +3024,10 @@
 
 {
   $Log$
-  Revision 1.48  1998-09-22 15:37:23  peter
+  Revision 1.49  1998-09-23 12:03:55  peter
+    * overloading fix for array of const
+
+  Revision 1.48  1998/09/22 15:37:23  peter
     + array of const start
 
   Revision 1.47  1998/09/21 15:46:01  michael

+ 476 - 0
compiler/symdefh.inc

@@ -0,0 +1,476 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl, Pierre Muller
+
+    Interface for the definition types of the symtable
+
+    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.
+ ****************************************************************************
+}
+
+{************************************************
+                    TDef
+************************************************}
+
+       { definition contains the informations about a type }
+       tdeftype = (abstractdef,arraydef,recorddef,pointerdef,orddef,
+                   stringdef,enumdef,procdef,objectdef,errordef,
+                   filedef,formaldef,setdef,procvardef,floatdef,
+                   classrefdef);
+
+       pdef = ^tdef;
+       tdef = object
+          deftype  : tdeftype;
+          indexnb  : longint;
+          savesize : longint;
+          next     : pdef;
+          owner    : psymtable;
+          sym      : ptypesym;  { which type the definition was generated this def }
+
+          has_inittable : boolean;
+          { adress of init informations }
+          inittable_label : plabel;
+
+          has_rtti   : boolean;
+          { address of rtti }
+          rtti_label : plabel;
+
+{$ifdef GDB}
+          globalnb       : word;
+          nextglobal,
+          previousglobal : pdef;
+          is_def_stab_written : boolean;
+{$endif GDB}
+          constructor init;
+          constructor load;
+          destructor  done;virtual;
+          procedure write;virtual;
+          procedure writename;
+          function  size:longint;virtual;
+{$ifdef GDB}
+          function  NumberString:string;
+          procedure set_globalnb;
+          function  stabstring : pchar;virtual;
+          function  allstabstring : pchar;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+          procedure deref;virtual;
+
+          { init. tables }
+          function  needs_inittable : boolean;virtual;
+          procedure generate_inittable;
+          function  get_inittable_label : plabel;
+          { the default implemenation calls write_rtti_data     }
+          { if init and rtti data is different these procedures }
+          { must be overloaded                                  }
+          procedure write_init_data;virtual;
+          { writes rtti of child to avoid mixup of rtti }
+          procedure write_child_init_data;virtual;
+
+          { rtti }
+          function get_rtti_label : plabel;
+
+          procedure generate_rtti;virtual;
+          procedure write_rtti_data;virtual;
+          procedure write_child_rtti_data;virtual;
+
+          { returns true, if the definition can be published }
+          function is_publishable : boolean;virtual;
+       end;
+
+       targconvtyp = (act_convertable,act_equal,act_exact);
+
+       tvarspez = (vs_value,vs_const,vs_var);
+
+       pdefcoll = ^tdefcoll;
+       tdefcoll = record
+          data    : pdef;
+          next    : pdefcoll;
+          paratyp : tvarspez;
+          argconvtyp : targconvtyp;
+       end;
+
+       tfiletype = (ft_text,ft_typed,ft_untyped);
+
+       pfiledef = ^tfiledef;
+       tfiledef = object(tdef)
+          filetype : tfiletype;
+          typed_as : pdef;
+          constructor init(ft : tfiletype;tas : pdef);
+          constructor load;
+          procedure write;virtual;
+          procedure deref;virtual;
+          procedure setsize;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+       end;
+
+       pformaldef = ^tformaldef;
+       tformaldef = object(tdef)
+          constructor init;
+          constructor load;
+          procedure write;virtual;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+       end;
+
+       perrordef = ^terrordef;
+       terrordef = object(tdef)
+          constructor init;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+{$endif GDB}
+       end;
+
+       { tpointerdef and tclassrefdef should get a common
+         base class, but I derived tclassrefdef from tpointerdef
+         to avoid problems with bugs (FK)
+       }
+
+       ppointerdef = ^tpointerdef;
+       tpointerdef = object(tdef)
+          definition : pdef;
+          defsym : ptypesym;
+          constructor init(def : pdef);
+          constructor load;
+          procedure write;virtual;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+          procedure deref;virtual;
+       end;
+
+       pobjectdef = ^tobjectdef;
+       tobjectdef = object(tdef)
+          childof : pobjectdef;
+          name : pstring;
+          { privatesyms : psymtable;
+          protectedsyms : psymtable; }
+          publicsyms : psymtable;
+          options : longint;
+          { to be able to have a variable vmt position }
+          { and no vmt field for objects without virtuals }
+          vmt_offset : longint;
+          constructor init(const n : string;c : pobjectdef);
+          destructor done;virtual;
+          procedure check_forwards;
+          function isrelated(d : pobjectdef) : boolean;
+          function size : longint;virtual;
+          constructor load;
+          procedure write;virtual;
+          function vmt_mangledname : string;
+          function rtti_name : string;
+          function isclass : boolean;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+{$endif GDB}
+          procedure deref;virtual;
+
+          function  needs_inittable : boolean;virtual;
+          procedure write_init_data;virtual;
+          procedure write_child_init_data;virtual;
+
+          { rtti }
+          procedure generate_rtti;virtual;
+          procedure write_rtti_data;virtual;
+          procedure write_child_rtti_data;virtual;
+          function next_free_name_index : longint;
+          function is_publishable : boolean;virtual;
+       end;
+
+
+       pclassrefdef = ^tclassrefdef;
+       tclassrefdef = object(tpointerdef)
+          constructor init(def : pdef);
+          constructor load;
+          procedure write;virtual;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+       end;
+
+       parraydef = ^tarraydef;
+       tarraydef = object(tdef)
+          lowrange,
+          highrange  : longint;
+          definition : pdef;
+          rangedef   : pdef;
+          IsVariant,
+          IsConstructor,
+          IsArrayOfConst : boolean;
+          rangenr    : longint;
+          function elesize : longint;
+          constructor init(l,h : longint;rd : pdef);
+          constructor load;
+          procedure write;virtual;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+          procedure deref;virtual;
+          function size : longint;virtual;
+          { generates the ranges needed by the asm instruction BOUND (i386)
+            or CMP2 (Motorola) }
+          procedure genrangecheck;
+          function needs_inittable : boolean;virtual;
+          procedure write_rtti_data;virtual;
+          procedure write_child_rtti_table;virtual;
+       end;
+
+       precdef = ^trecdef;
+       trecdef = object(tdef)
+          symtable : psymtable;
+          constructor init(p : psymtable);
+          constructor load;
+          destructor done;virtual;
+          procedure write;virtual;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+          procedure deref;virtual;
+          function  needs_inittable : boolean;virtual;
+          procedure write_rtti_data;virtual;
+          procedure write_init_data;virtual;
+          procedure write_child_rtti_data;virtual;
+          procedure write_child_init_data;virtual;
+       end;
+
+       { base types }
+       tbasetype = (uauto,uvoid,uchar,
+                    u8bit,u16bit,u32bit,
+                    s8bit,s16bit,s32bit,
+                    bool8bit,bool16bit,bool32bit { uwchar,bool1bit,bitfield});
+
+       porddef = ^torddef;
+       torddef = object(tdef)
+          low,high : longint;
+          rangenr  : longint;
+          typ      : tbasetype;
+          {
+          bits     : byte;
+          }
+          constructor init(t : tbasetype;v,b : longint);
+          constructor load;
+          procedure write;virtual;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+{$endif GDB}
+          procedure setsize;
+
+          { generates the ranges needed by the asm instruction BOUND }
+          { or CMP2 (Motorola)                                       }
+          procedure genrangecheck;
+          procedure write_rtti_data;virtual;
+          function is_publishable : boolean;virtual;
+       end;
+
+       { sextreal is dependant on the cpu, s64bit is also }
+       { dependant on the size (tp = 80bit for both)      }
+       { The EXTENDED format exists on the motorola FPU   }
+       { but it uses 96 bits instead of 80, with some     }
+       { unused bits within the number itself! Pretty     }
+       { complicated to support, so no support for the    }
+       { moment.                                          }
+       { s64 bit is considered as a real because all      }
+       { calculations are done by the fpu.                }
+       tfloattype = (f32bit,s32real,s64real,s80real,s64bit,f16bit);
+
+       pfloatdef = ^tfloatdef;
+       tfloatdef = object(tdef)
+          typ : tfloattype;
+          constructor init(t : tfloattype);
+          constructor load;
+          procedure write;virtual;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+{$endif GDB}
+          procedure setsize;
+          function is_publishable : boolean;virtual;
+          procedure write_rtti_data;virtual;
+       end;
+
+       pabstractprocdef = ^tabstractprocdef;
+       tabstractprocdef = object(tdef)
+          { saves a definition to the return type }
+          retdef : pdef;
+          fpu_used : byte; { how many stack fpu must be empty }
+          { save the procedure options }
+          options : longint;
+          para1 : pdefcoll;
+          constructor init;
+          constructor load;
+          destructor done;virtual;
+          procedure concatdef(p : pdef;vsp : tvarspez);
+          procedure deref;virtual;
+          function para_size : longint;
+          function demangled_paras : string;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+          procedure test_if_fpu_result;
+          procedure write;virtual;
+       end;
+
+       pprocvardef = ^tprocvardef;
+       tprocvardef = object(tabstractprocdef)
+          constructor init;
+          constructor load;
+          procedure write;virtual;
+          function size : longint;virtual;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput); virtual;
+{$endif GDB}
+          procedure write_child_rtti_data;virtual;
+          function is_publishable : boolean;virtual;
+          procedure write_rtti_data;virtual;
+       end;
+
+       pprocdef = ^tprocdef;
+       tprocdef = object(tabstractprocdef)
+          extnumber : longint;
+          nextoverloaded : pprocdef;
+          { pointer to the local symbol table }
+          localst : psymtable;
+          { pointer to the parameter symbol table }
+          parast : psymtable;
+{$ifdef UseBrowser}
+          lastref,
+          defref,
+          lastwritten : pref;
+          refcount : longint;
+{$endif UseBrowser}
+          _class : pobjectdef;
+          _mangledname : pchar;
+          { it's a tree, but this not easy to handle }
+          { used for inlined procs                   }
+          code : pointer;
+          { true, if the procedure is only declared }
+          { (forward procedure) }
+          forwarddef : boolean;
+          { set which contains the modified registers }
+{$ifdef i386}
+          usedregisters : byte;
+{$endif}
+{$ifdef m68k}
+          usedregisters : word;
+{$endif}
+{$ifdef alpha}
+          usedregisters_int : longint;
+          usedregisters_fpu : longint;
+{$endif}
+          constructor init;
+          destructor done;virtual;
+          constructor load;
+          procedure write;virtual;
+{$ifdef GDB}
+          function cplusplusmangledname : string;
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+          procedure deref;virtual;
+          function mangledname : string;
+          procedure setmangledname(const s : string);
+{$ifdef UseBrowser}
+          procedure load_references;
+          function  write_references : boolean;
+          procedure add_to_browserlog;
+{$endif UseBrowser}
+       end;
+
+       tstringtype = (st_shortstring, st_longstring, st_ansistring, st_widestring);
+
+       pstringdef = ^tstringdef;
+       tstringdef = object(tdef)
+          string_typ : tstringtype;
+          len : longint;
+          constructor init(l : byte);
+          constructor load;
+          constructor longinit(l : longint);
+          constructor longload;
+          constructor ansiinit(l : longint);
+          constructor ansiload;
+          constructor wideinit(l : longint);
+          constructor wideload;
+          function size : longint;virtual;
+          procedure write;virtual;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+          function needs_inittable : boolean;virtual;
+          procedure write_rtti_data;virtual;
+          function is_publishable : boolean;virtual;
+       end;
+
+       penumdef = ^tenumdef;
+       tenumdef = object(tdef)
+          minval,
+          maxval    : longint;
+          has_jumps : boolean;
+          first     : penumsym;
+          basedef   : penumdef;
+          constructor init;
+          constructor init_subrange(_basedef:penumdef;_min,_max:longint);
+          constructor load;
+          destructor done;virtual;
+          procedure write;virtual;
+          procedure deref;virtual;
+          procedure calcsavesize;
+          procedure setmax(_max:longint);
+          procedure setmin(_min:longint);
+          function  min:longint;
+          function  max:longint;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+{$endif GDB}
+          procedure write_child_rtti_data;virtual;
+          procedure write_rtti_data;virtual;
+          function is_publishable : boolean;virtual;
+       end;
+
+       tsettype = (normset,smallset,varset);
+
+       psetdef = ^tsetdef;
+       tsetdef = object(tdef)
+          setof : pdef;
+          settype : tsettype;
+          constructor init(s : pdef;high : longint);
+          constructor load;
+          procedure write;virtual;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+          procedure deref;virtual;
+          function is_publishable : boolean;virtual;
+          procedure write_rtti_data;virtual;
+          procedure write_child_rtti_data;virtual;
+       end;
+
+{
+  $Log$
+  Revision 1.1  1998-09-23 12:03:57  peter
+    * overloading fix for array of const
+
+}

+ 320 - 0
compiler/symsymh.inc

@@ -0,0 +1,320 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl, Pierre Muller
+
+    Interface for the symbols types of the symtable
+
+    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.
+ ****************************************************************************
+}
+
+{************************************************
+                   TSym
+************************************************}
+
+       symprop = byte;
+
+       { possible types for symtable entries }
+       tsymtyp = (abstractsym,varsym,typesym,procsym,unitsym,programsym,
+                  constsym,enumsym,typedconstsym,errorsym,syssym,
+                  labelsym,absolutesym,propertysym,funcretsym);
+                  { varsym_C,typedconstsym_C); }
+
+       { this object is the base for all symbol objects }
+       psym = ^tsym;
+       tsym = object
+          typ        : tsymtyp;
+          _name      : pchar;
+          left,right : psym;
+          speedvalue : longint;
+          properties : symprop;
+          owner      : psymtable;
+          indexnb    : longint;
+          fileinfo   : tfileposinfo;
+{$ifdef GDB}
+          isstabwritten : boolean;
+{$endif GDB}
+{$ifdef UseBrowser}
+          lastref,
+          defref,
+          lastwritten : pref;
+          refcount    : longint;
+{$endif UseBrowser}
+          constructor init(const n : string);
+          constructor load;
+          destructor done;virtual;
+          procedure write;virtual;
+          procedure deref;virtual;
+          function name : string;
+          function mangledname : string;virtual;
+          procedure setname(const s : string);
+          procedure insert_in_data;virtual;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+{$ifdef UseBrowser}
+          procedure load_references;virtual;
+          function  write_references : boolean;virtual;
+          procedure add_to_browserlog;virtual;
+{$endif UseBrowser}
+       end;
+
+       plabelsym = ^tlabelsym;
+       tlabelsym = object(tsym)
+          number : plabel;
+          defined : boolean;
+          constructor init(const n : string; l : plabel);
+          constructor load;
+          destructor done;virtual;
+          function mangledname : string;virtual;
+          procedure write;virtual;
+       end;
+
+       punitsym = ^tunitsym;
+       tunitsym = object(tsym)
+          unitsymtable : punitsymtable;
+          prevsym : punitsym;
+          refs : longint;
+          constructor init(const n : string;ref : punitsymtable);
+          constructor load;
+          destructor done;virtual;
+          procedure write;virtual;
+{$ifdef GDB}
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+       end;
+
+       pmacrosym = ^tmacrosym;
+       tmacrosym = object(tsym)
+          defined : boolean;
+          buftext : pchar;
+          buflen : longint;
+          { macros aren't written to PPU files ! }
+          constructor init(const n : string);
+          destructor done;virtual;
+       end;
+
+       perrorsym = ^terrorsym;
+       terrorsym = object(tsym)
+          constructor init;
+       end;
+
+       pprocsym = ^tprocsym;
+       tprocsym = object(tsym)
+          definition : pprocdef;
+{$ifdef CHAINPROCSYMS}
+          nextprocsym : pprocsym;
+{$endif CHAINPROCSYMS}
+{$ifdef GDB}
+          is_global : boolean;{necessary for stab}
+{$endif GDB}
+          constructor init(const n : string);
+          constructor load;
+          destructor done;virtual;
+          function mangledname : string;virtual;
+          function demangledname:string;
+          { writes all declarations }
+          procedure write_parameter_lists;
+          { tests, if all procedures definitions are defined and not }
+          { only forward                                             }
+          procedure check_forward;
+          procedure write;virtual;
+          procedure deref;virtual;
+{$ifdef UseBrowser}
+          procedure load_references;virtual;
+          function  write_references : boolean;virtual;
+          procedure add_to_browserlog;virtual;
+{$endif UseBrowser}
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+       end;
+
+       ttypesym = object(tsym)
+          definition : pdef;
+          forwardpointer : ppointerdef;
+{$ifdef GDB}
+          isusedinstab : boolean;
+{$endif GDB}
+          constructor init(const n : string;d : pdef);
+          constructor load;
+          destructor done;virtual;
+          procedure write;virtual;
+          procedure deref;virtual;
+{$ifdef UseBrowser}
+          procedure load_references;virtual;
+          function  write_references : boolean;virtual;
+          procedure add_to_browserlog;virtual;
+{$endif UseBrowser}
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+       end;
+
+       pvarsym = ^tvarsym;
+       tvarsym = object(tsym)
+          address      : longint;
+          definition   : pdef;
+          refs         : longint;
+          var_options  : byte;
+          _mangledname : pchar;
+          reg          : tregister; { if reg<>R_NO, then the variable is an register variable }
+          varspez      : tvarspez;  { sets the type of access }
+          is_valid     : byte;
+          constructor init(const n : string;p : pdef);
+          constructor load;
+          constructor init_C(const n,mangled : string;p : pdef);
+          constructor load_C;
+          destructor done;virtual;
+          function mangledname : string;virtual;
+          procedure insert_in_data;virtual;
+          function getsize : longint;
+          procedure write;virtual;
+          procedure deref;virtual;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+       end;
+
+       ppropertysym = ^tpropertysym;
+       tpropertysym = object(tsym)
+          options : longint;
+          proptype : pdef;
+          { proppara : pdefcoll; }
+          readaccesssym,writeaccesssym,storedsym : psym;
+          readaccessdef,writeaccessdef,storeddef : pdef;
+          index,default : longint;
+          constructor init(const n : string);
+          destructor done;virtual;
+          constructor load;
+          function getsize : longint;virtual;
+          procedure write;virtual;
+          procedure deref;virtual;
+{$ifdef GDB}
+          { I don't know how (FK) }
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+       end;
+
+       pfuncretsym = ^tfuncretsym;
+       tfuncretsym = object(tsym)
+          funcretprocinfo : pointer{ should be pprocinfo};
+          funcretdef : pdef;
+          address : longint;
+          constructor init(const n : string;approcinfo : pointer{pprocinfo});
+{$ifdef GDB}
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+       end;
+
+       absolutetyp = (tovar,toasm,toaddr);
+
+       pabsolutesym = ^tabsolutesym;
+       tabsolutesym = object(tvarsym)
+          abstyp : absolutetyp;
+          absseg : boolean;
+          ref : psym;
+          asmname : pstring;
+          constructor load;
+          procedure deref;virtual;
+          function mangledname : string;virtual;
+          procedure write;virtual;
+          procedure insert_in_data;virtual;
+          { this creates a problem in gen_vmt !!!!!
+          because the pdef is not resolved yet !!
+          we should fix this
+          constructor init(const s : string;p : pdef;newref : psym);}
+{$ifdef GDB}
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+       end;
+
+       ptypedconstsym = ^ttypedconstsym;
+       ttypedconstsym = object(tsym)
+          prefix : pstring;
+          definition : pdef;
+          constructor init(const n : string;p : pdef);
+          constructor load;
+          destructor done;virtual;
+          function  mangledname : string;virtual;
+          procedure write;virtual;
+          procedure deref;virtual;
+          procedure insert_in_data;virtual;
+          procedure really_insert_in_data;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+{$endif GDB}
+       end;
+
+       tconsttype = (constord,conststring,constreal,constbool,
+                     constint,constchar,constset);
+
+       pconstsym = ^tconstsym;
+       tconstsym = object(tsym)
+          definition : pdef;
+          consttype  : tconsttype;
+          value      : longint;
+          constructor init(const n : string;t : tconsttype;v : longint;def : pdef);
+          constructor load;
+          function  mangledname : string;virtual;
+          destructor done;virtual;
+          procedure deref;virtual;
+          procedure write;virtual;
+{$ifdef GDB}
+          function stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+       end;
+
+       tenumsym = object(tsym)
+          value : longint;
+          definition : penumdef;
+          next : penumsym;
+          constructor init(const n : string;def : penumdef;v : longint);
+          constructor load;
+          procedure write;virtual;
+          procedure deref;virtual;
+{$ifdef GDB}
+          procedure order;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+       end;
+
+       pprogramsym = ^tprogramsym;
+       tprogramsym = object(tsym)
+          constructor init(const n : string);
+       end;
+
+       psyssym = ^tsyssym;
+       tsyssym = object(tsym)
+          number : longint;
+          constructor init(const n : string;l : longint);
+          procedure write;virtual;
+{$ifdef GDB}
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+       end;
+
+{
+  $Log$
+  Revision 1.1  1998-09-23 12:03:57  peter
+    * overloading fix for array of const
+
+}

+ 6 - 2
compiler/tree.pas

@@ -149,7 +149,8 @@ unit tree;
                       tc_fix_2_real,tc_int_2_fix,tc_real_2_real,
                       tc_chararray_2_string,
                       tc_proc2procvar,tc_cchar_charpointer,tc_load_smallset,
-                      tc_ansistring_2_pchar,tc_pchar_2_string);
+                      tc_ansistring_2_pchar,tc_pchar_2_string,
+                      tc_arrayconstructor_2_set);
 
        { allows to determine which elementes are to be replaced }
        tdisposetyp = (dt_nothing,dt_leftright,dt_left,
@@ -1569,7 +1570,10 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.41  1998-09-23 09:58:55  peter
+  Revision 1.42  1998-09-23 12:03:59  peter
+    * overloading fix for array of const
+
+  Revision 1.41  1998/09/23 09:58:55  peter
     * first working array of const things
 
   Revision 1.40  1998/09/22 15:34:07  peter