Browse Source

+ ttype, tsymlist

peter 26 năm trước cách đây
mục cha
commit
0512ba80fb
50 tập tin đã thay đổi với 1920 bổ sung1761 xóa
  1. 0 1
      compiler/Makefile.fpc
  2. 6 3
      compiler/ag386bin.pas
  3. 48 40
      compiler/browcol.pas
  4. 12 9
      compiler/browlog.pas
  5. 14 11
      compiler/cg386cal.pas
  6. 8 5
      compiler/cg386flw.pas
  7. 25 22
      compiler/cg386inl.pas
  8. 11 8
      compiler/cg386ld.pas
  9. 14 11
      compiler/cg386mem.pas
  10. 75 76
      compiler/cgai386.pas
  11. 5 3
      compiler/cpuasm.pas
  12. 11 7
      compiler/hcgdata.pas
  13. 51 16
      compiler/hcodegen.pas
  14. 37 34
      compiler/htypechk.pas
  15. 4 3
      compiler/og386cff.pas
  16. 5 2
      compiler/pass_1.pas
  17. 9 6
      compiler/pass_2.pas
  18. 74 111
      compiler/pdecl.pas
  19. 44 41
      compiler/pexpr.pas
  20. 5 2
      compiler/pmodules.pas
  21. 7 4
      compiler/popt386.pas
  22. 6 3
      compiler/ppu.pas
  23. 41 45
      compiler/pstatmnt.pas
  24. 36 30
      compiler/psub.pas
  25. 66 64
      compiler/psystem.pas
  26. 19 17
      compiler/ptconst.pas
  27. 167 263
      compiler/ptype.pas
  28. 8 23
      compiler/ra386att.pas
  29. 17 12
      compiler/ra386dir.pas
  30. 8 5
      compiler/ra386int.pas
  31. 37 34
      compiler/rautils.pas
  32. 16 2
      compiler/symconst.pas
  33. 233 208
      compiler/symdef.inc
  34. 28 21
      compiler/symdefh.inc
  35. 8 24
      compiler/symppu.inc
  36. 214 301
      compiler/symsym.inc
  37. 37 47
      compiler/symsymh.inc
  38. 320 89
      compiler/symtable.pas
  39. 6 3
      compiler/t_os2.pas
  40. 14 11
      compiler/tcadd.pas
  41. 46 43
      compiler/tccal.pas
  42. 9 6
      compiler/tccnv.pas
  43. 5 2
      compiler/tcflw.pas
  44. 11 8
      compiler/tcinl.pas
  45. 14 11
      compiler/tcld.pas
  46. 5 2
      compiler/tcmat.pas
  47. 17 14
      compiler/tcmem.pas
  48. 9 6
      compiler/tcset.pas
  49. 9 6
      compiler/tree.pas
  50. 49 46
      compiler/types.pas

+ 0 - 1
compiler/Makefile.fpc

@@ -30,7 +30,6 @@ CPU_TARGET=i386
 endif
 
 # RTL
-RTLDIR=../rtl/$(OS_TARGET)
 UTILSDIR=../utils
 
 # Utils used by compiler development/installation

+ 6 - 3
compiler/ag386bin.pas

@@ -773,7 +773,7 @@ unit ag386bin;
 
     procedure ti386binasmlist.writetreesmart;
       var
-        hp,hp1 : pai;
+        hp : pai;
       begin
         objectalloc^.setsection(sec_code);
         objectoutput^.defaultsection(sec_code);
@@ -788,7 +788,7 @@ unit ag386bin;
 {$ifdef GDB}
            StartFileLineInfo;
 {$endif GDB}
-           hp1:=TreePass1(hp);
+           TreePass1(hp);
 
          { set section sizes }
            objectoutput^.setsectionsizes(objectalloc^.secsize);
@@ -907,7 +907,10 @@ unit ag386bin;
 end.
 {
   $Log$
-  Revision 1.27  1999-11-06 14:34:16  peter
+  Revision 1.28  1999-11-30 10:40:42  peter
+    + ttype, tsymlist
+
+  Revision 1.27  1999/11/06 14:34:16  peter
     * truncated log to 20 revs
 
   Revision 1.26  1999/11/02 15:06:56  peter

+ 48 - 40
compiler/browcol.pas

@@ -28,6 +28,9 @@ interface
 uses
   cobjects,objects,symconst,symtable;
 
+  type
+    sw_integer = integer;
+
 const
   SymbolTypLen : integer = 6;
 
@@ -197,7 +200,7 @@ procedure RegisterSymbols;
 implementation
 
 uses
-  Dos,Drivers,Views,App,
+  Dos,Drivers,{Views,App,}
   aasm,globtype,globals,files,comphook;
 
 const
@@ -916,18 +919,18 @@ end;
   var Name: string;
   begin
     Name:='array ['+IntToStr(def^.lowrange)+'..'+IntToStr(def^.highrange)+'] of ';
-    if assigned(def^.definition) then
-      Name:=Name+GetDefinitionStr(def^.definition);
+    if assigned(def^.elementtype.def) then
+      Name:=Name+GetDefinitionStr(def^.elementtype.def);
     GetArrayDefStr:=Name;
   end;
   function GetFileDefStr(def: pfiledef): string;
   var Name: string;
   begin
     Name:='';
-    case def^.filetype of
+    case def^.filetyp of
       ft_text    : Name:='text';
       ft_untyped : Name:='file';
-      ft_typed   : Name:='file of '+GetDefinitionStr(def^.typed_as);
+      ft_typed   : Name:='file of '+GetDefinitionStr(def^.typedfiletype.def);
     end;
     GetFileDefStr:=Name;
   end;
@@ -955,8 +958,8 @@ end;
   var OK: boolean;
   begin
     OK:=false;
-    if assigned(def^.retdef) then
-      if UpcaseStr(GetDefinitionStr(def^.retdef))<>'VOID' then
+    if assigned(def^.rettype.def) then
+      if UpcaseStr(GetDefinitionStr(def^.rettype.def))<>'VOID' then
         OK:=true;
     retdefassigned:=OK;
   end;
@@ -977,12 +980,13 @@ end;
          vs_Const : CurName:=CurName+'const ';
          vs_Var   : CurName:=CurName+'var ';
        end;
-       if assigned(dc^.data) then
-         CurName:=CurName+GetDefinitionStr(dc^.data);
+       if assigned(dc^.paratype.def) then
+         CurName:=CurName+GetDefinitionStr(dc^.paratype.def);
        if dc^.next<>nil then
          CurName:=', '+CurName;
        Name:=CurName+Name;
-       dc:=pparaitem(dc^.next); Inc(Count);
+       dc:=pparaitem(dc^.next);
+       Inc(Count);
      end;
     GetAbsProcParmDefStr:=Name;
   end;
@@ -992,7 +996,7 @@ end;
     Name:=GetAbsProcParmDefStr(def);
     if Name<>'' then Name:='('+Name+')';
     if retdefassigned(def) then
-      Name:='function'+Name+': '+GetDefinitionStr(def^.retdef)
+      Name:='function'+Name+': '+GetDefinitionStr(def^.rettype.def)
     else
       Name:='procedure'+Name;
     GetAbsProcDefStr:=Name;
@@ -1033,7 +1037,7 @@ end;
       varset   : Name:='varset';
     end;
     Name:=Name+' of ';
-    Name:=Name+GetDefinitionStr(def^.setof);
+    Name:=Name+GetDefinitionStr(def^.elementtype.def);
     GetSetDefStr:=Name;
   end;
   function GetDefinitionStr(def: pdef): string;
@@ -1043,8 +1047,8 @@ end;
     Name:='';
     if def<>nil then
     begin
-      if assigned(def^.sym) then
-        Name:=def^.sym^.name;
+      if assigned(def^.typesym) then
+        Name:=def^.typesym^.name;
       if Name='' then
       case def^.deftype of
         arraydef :
@@ -1071,14 +1075,14 @@ end;
   begin
     Name:='';
     if assigned(sym) and assigned(sym^.definition) then
-      if assigned(sym^.definition^.sym) then
+      if assigned(sym^.definition^.typesym) then
       begin
 {        ES:=sym^.definition^.First;
         while (ES<>nil) and (ES^.Value<>sym^.Value) do
           ES:=ES^.next;
         if assigned(es) and (es^.value=sym^.value) then
           Name:=}
-        Name:=sym^.definition^.sym^.name;
+        Name:=sym^.definition^.typesym^.name;
         if Name<>'' then
           Name:=Name+'('+IntToStr(sym^.value)+')';
       end;
@@ -1092,9 +1096,10 @@ end;
      if assigned(sym^.definition^.sym) then
        Name:=sym^.definition^.sym^.name;}
     if Name='' then
-    case sym^.consttype of
+    case sym^.consttyp of
       constord :
-        Name:=sym^.definition^.sym^.name+'('+IntToStr(sym^.value)+')';
+        Name:=sym^.consttype.def^.typesym^.name+'('+IntToStr(sym^.value)+')';
+      constresourcestring,
       conststring :
         Name:=''''+GetStr(PString(sym^.Value))+'''';
       constreal:
@@ -1119,7 +1124,7 @@ end;
   begin
     { still led to infinite recursions
       only usefull for unamed types PM }
-    if assigned(definition) and not assigned(definition^.sym) then
+    if assigned(definition) and not assigned(definition^.typesym) then
     begin
       case definition^.deftype of
         recorddef :
@@ -1153,12 +1158,12 @@ end;
           varsym :
              with pvarsym(sym)^ do
              begin
-               if assigned(definition) then
-                 if assigned(definition^.sym) then
-                   SetVType(Symbol,definition^.sym^.name)
+               if assigned(vartype.def) then
+                 if assigned(vartype.def^.typesym) then
+                   SetVType(Symbol,vartype.def^.typesym^.name)
                  else
-                   SetVType(Symbol,GetDefinitionStr(definition));
-               ProcessDefIfStruct(definition);
+                   SetVType(Symbol,GetDefinitionStr(vartype.def));
+               ProcessDefIfStruct(vartype.def);
                MemInfo.Addr:=address;
                if assigned(localvarsym) then
                  MemInfo.LocalAddr:=localvarsym^.address
@@ -1186,9 +1191,9 @@ end;
           funcretsym :
             if Assigned(OwnerSym) then
             with pfuncretsym(sym)^ do
-              if assigned(funcretdef) then
-                if assigned(funcretdef^.sym) then
-                   SetVType(OwnerSym,funcretdef^.sym^.name);
+              if assigned(rettype.def) then
+                if assigned(rettype.def^.typesym) then
+                   SetVType(OwnerSym,rettype.def^.typesym^.name);
           procsym :
             begin
               with pprocsym(sym)^ do
@@ -1217,37 +1222,37 @@ end;
           typesym :
             begin
             with ptypesym(sym)^ do
-              if assigned(definition) then
-                case definition^.deftype of
+              if assigned(restype.def) then
+                case restype.def^.deftype of
                   arraydef :
-                    SetDType(Symbol,GetArrayDefStr(parraydef(definition)));
+                    SetDType(Symbol,GetArrayDefStr(parraydef(restype.def)));
                   enumdef :
-                    SetDType(Symbol,GetEnumDefStr(penumdef(definition)));
+                    SetDType(Symbol,GetEnumDefStr(penumdef(restype.def)));
                   procdef :
-                    SetDType(Symbol,GetProcDefStr(pprocdef(definition)));
+                    SetDType(Symbol,GetProcDefStr(pprocdef(restype.def)));
                   procvardef :
-                    SetDType(Symbol,GetProcVarDefStr(pprocvardef(definition)));
+                    SetDType(Symbol,GetProcVarDefStr(pprocvardef(restype.def)));
                   objectdef :
-                    with pobjectdef(definition)^ do
+                    with pobjectdef(restype.def)^ do
                     begin
                       ObjDef:=childof;
-                      Symbol^.ObjectID:=longint(definition);
+                      Symbol^.ObjectID:=longint(restype.def);
                       if ObjDef<>nil then
                         Symbol^.AncestorID:=longint(ObjDef);{TypeNames^.Add(S);}
                       Symbol^.Flags:=(Symbol^.Flags or sfObject);
                       if is_class then
                         Symbol^.Flags:=(Symbol^.Flags or sfClass);
-                      ProcessSymTable(Symbol,Symbol^.Items,pobjectdef(definition)^.symtable);
+                      ProcessSymTable(Symbol,Symbol^.Items,pobjectdef(restype.def)^.symtable);
                     end;
                   recorddef :
                     begin
                       Symbol^.Flags:=(Symbol^.Flags or sfRecord);
-                      ProcessSymTable(Symbol,Symbol^.Items,precorddef(definition)^.symtable);
+                      ProcessSymTable(Symbol,Symbol^.Items,precorddef(restype.def)^.symtable);
                     end;
                   filedef :
-                    SetDType(Symbol,GetFileDefStr(pfiledef(definition)));
+                    SetDType(Symbol,GetFileDefStr(pfiledef(restype.def)));
                   setdef :
-                    SetDType(Symbol,GetSetDefStr(psetdef(definition)));
+                    SetDType(Symbol,GetSetDefStr(psetdef(restype.def)));
                 end;
             end;
         end;
@@ -1699,7 +1704,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.27  1999-11-10 00:42:42  pierre
+  Revision 1.28  1999-11-30 10:40:42  peter
+    + ttype, tsymlist
+
+  Revision 1.27  1999/11/10 00:42:42  pierre
     * LookUp function now returns the complete name in browcol
       and fpsymbol only yakes a part of LoopUpStr
 

+ 12 - 9
compiler/browlog.pas

@@ -343,12 +343,12 @@ implementation
               case sym^.typ of
                 typesym :
                   begin
-                     if ptypesym(sym)^.definition^.deftype in [recorddef,objectdef] then
+                     if ptypesym(sym)^.restype.def^.deftype in [recorddef,objectdef] then
                        begin
-                          if ptypesym(sym)^.definition^.deftype=recorddef then
-                            symt:=precorddef(ptypesym(sym)^.definition)^.symtable
+                          if ptypesym(sym)^.restype.def^.deftype=recorddef then
+                            symt:=precorddef(ptypesym(sym)^.restype.def)^.symtable
                           else
-                            symt:=pobjectdef(ptypesym(sym)^.definition)^.symtable;
+                            symt:=pobjectdef(ptypesym(sym)^.restype.def)^.symtable;
                           sym:=symt^.search(ss);
                           if sym=nil then
                             sym:=symt^.search(upper(ss));
@@ -356,12 +356,12 @@ implementation
                   end;
                 varsym :
                   begin
-                     if pvarsym(sym)^.definition^.deftype in [recorddef,objectdef] then
+                     if pvarsym(sym)^.vartype.def^.deftype in [recorddef,objectdef] then
                        begin
-                          if pvarsym(sym)^.definition^.deftype=recorddef then
-                            symt:=precorddef(pvarsym(sym)^.definition)^.symtable
+                          if pvarsym(sym)^.vartype.def^.deftype=recorddef then
+                            symt:=precorddef(pvarsym(sym)^.vartype.def)^.symtable
                           else
-                            symt:=pobjectdef(pvarsym(sym)^.definition)^.symtable;
+                            symt:=pobjectdef(pvarsym(sym)^.vartype.def)^.symtable;
                           sym:=symt^.search(ss);
                           if sym=nil then
                             sym:=symt^.search(upper(ss));
@@ -448,7 +448,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  1999-11-17 17:04:58  pierre
+  Revision 1.4  1999-11-30 10:40:42  peter
+    + ttype, tsymlist
+
+  Revision 1.3  1999/11/17 17:04:58  pierre
    * Notes/hints changes
 
   Revision 1.2  1999/08/03 22:02:30  peter

+ 14 - 11
compiler/cg386cal.pas

@@ -58,8 +58,8 @@ implementation
         begin
            { open array ? }
            { defcoll^.data can be nil for read/write }
-           if assigned(defcoll^.data) and
-              push_high_param(defcoll^.data) then
+           if assigned(defcoll^.paratype.def) and
+              push_high_param(defcoll^.paratype.def) then
              begin
                if assigned(p^.hightree) then
                 begin
@@ -94,8 +94,8 @@ implementation
              { nothing, everything is already pushed }
            end
          { in codegen.handleread.. defcoll^.data is set to nil }
-         else if assigned(defcoll^.data) and
-           (defcoll^.data^.deftype=formaldef) then
+         else if assigned(defcoll^.paratype.def) and
+           (defcoll^.paratype.def^.deftype=formaldef) then
            begin
               { allow @var }
               inc(pushedparasize,4);
@@ -157,8 +157,8 @@ implementation
               { open array must always push the address, this is needed to
                 also push addr of small arrays (PFV) }
 
-              if (assigned(defcoll^.data) and
-                  is_open_array(defcoll^.data)) or
+              if (assigned(defcoll^.paratype.def) and
+                  is_open_array(defcoll^.paratype.def)) or
                  push_addr_param(p^.resulttype) then
                 begin
                    maybe_push_high;
@@ -364,11 +364,11 @@ implementation
                 if inlined then
                   begin
                      reset_reference(funcretref);
-                     funcretref.offset:=gettempofsizepersistant(p^.procdefinition^.retdef^.size);
+                     funcretref.offset:=gettempofsizepersistant(p^.procdefinition^.rettype.def^.size);
                      funcretref.base:=procinfo^.framepointer;
                   end
                 else
-                  gettempofsizereference(p^.procdefinition^.retdef^.size,funcretref);
+                  gettempofsizereference(p^.procdefinition^.rettype.def^.size,funcretref);
            end;
          if assigned(p^.left) then
            begin
@@ -1173,8 +1173,8 @@ implementation
           oldprocinfo:=procinfo;
           { set the return value }
           aktprocsym:=p^.inlineprocsym;
-          procinfo^.retdef:=aktprocsym^.definition^.retdef;
-          procinfo^.retoffset:=p^.retoffset;
+          procinfo^.returntype:=aktprocsym^.definition^.rettype;
+          procinfo^.return_offset:=p^.retoffset;
           { arg space has been filled by the parent secondcall }
           st:=aktprocsym^.definition^.localst;
           { set it to the same lexical level }
@@ -1225,7 +1225,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.110  1999-11-06 14:34:17  peter
+  Revision 1.111  1999-11-30 10:40:42  peter
+    + ttype, tsymlist
+
+  Revision 1.110  1999/11/06 14:34:17  peter
     * truncated log to 20 revs
 
   Revision 1.109  1999/11/04 00:23:58  pierre

+ 8 - 5
compiler/cg386flw.pas

@@ -423,7 +423,7 @@ implementation
               else
                 internalerror(2001);
               end;
-              case procinfo^.retdef^.deftype of
+              case procinfo^.returntype.def^.deftype of
            pointerdef,
            procvardef : begin
                           if is_mem then
@@ -434,7 +434,7 @@ implementation
                               p^.left^.location.register,R_EAX);
                         end;
              floatdef : begin
-                          if pfloatdef(procinfo^.retdef)^.typ=f32bit then
+                          if pfloatdef(procinfo^.returntype.def)^.typ=f32bit then
                            begin
                              if is_mem then
                                emit_ref_reg(A_MOV,S_L,
@@ -444,7 +444,7 @@ implementation
                            end
                           else
                            if is_mem then
-                            floatload(pfloatdef(procinfo^.retdef)^.typ,p^.left^.location.reference);
+                            floatload(pfloatdef(procinfo^.returntype.def)^.typ,p^.left^.location.reference);
                         end;
               { orddef,
               enumdef : }
@@ -452,7 +452,7 @@ implementation
               { it can be anything shorter than 4 bytes PM
               this caused form bug 711 }
                        begin
-                          case procinfo^.retdef^.size of
+                          case procinfo^.returntype.def^.size of
                           { if its 3 bytes only we can still
                             copy one of garbage ! PM }
                            4,3 : if is_mem then
@@ -776,7 +776,10 @@ do_jmp:
 end.
 {
   $Log$
-  Revision 1.58  1999-11-28 23:15:23  pierre
+  Revision 1.59  1999-11-30 10:40:42  peter
+    + ttype, tsymlist
+
+  Revision 1.58  1999/11/28 23:15:23  pierre
    * fix for form bug 721
 
   Revision 1.57  1999/11/15 21:49:09  peter

+ 25 - 22
compiler/cg386inl.pas

@@ -168,7 +168,7 @@ implementation
          addsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADD,A_SUB);
        var
          aktfile : treference;
-         ft : tfiletype;
+         ft : tfiletyp;
          opsize : topsize;
          op,
          asmop : tasmop;
@@ -250,9 +250,9 @@ implementation
                 { is first parameter a file type ? }
                 if node^.left^.resulttype^.deftype=filedef then
                   begin
-                     ft:=pfiledef(node^.left^.resulttype)^.filetype;
+                     ft:=pfiledef(node^.left^.resulttype)^.filetyp;
                      if ft=ft_typed then
-                       typedtyp:=pfiledef(node^.left^.resulttype)^.typed_as;
+                       typedtyp:=pfiledef(node^.left^.resulttype)^.typedfiletype.def;
                      secondpass(node^.left);
                      if codegenerror then
                        exit;
@@ -288,10 +288,10 @@ implementation
                 if ft=ft_typed then
                   { this is to avoid copy of simple const parameters }
                   {dummycoll.data:=new(pformaldef,init)}
-                  dummycoll.data:=cformaldef
+                  dummycoll.paratype.setdef(cformaldef)
                 else
                   { I think, this isn't a good solution (FK) }
-                  dummycoll.data:=nil;
+                  dummycoll.paratype.reset;
 
                 while assigned(node) do
                   begin
@@ -324,13 +324,13 @@ implementation
                         if ft=ft_typed then
                           never_copy_const_param:=true;
                         { reset data type }
-                        dummycoll.data:=nil;
+                        dummycoll.paratype.reset;
                         { create temporary defs for high tree generation }
                         if doread and (is_shortstring(hp^.resulttype)) then
-                          dummycoll.data:=openshortstringdef
+                          dummycoll.paratype.setdef(openshortstringdef)
                         else
                           if (is_chararray(hp^.resulttype)) then
-                            dummycoll.data:=openchararraydef;
+                            dummycoll.paratype.setdef(openchararraydef);
                         secondcallparan(hp,@dummycoll,false,false,false,0);
                         if ft=ft_typed then
                           never_copy_const_param:=false;
@@ -373,7 +373,7 @@ implementation
                                    hp:=node;
                                    node:=node^.right;
                                    hp^.right:=nil;
-                                   dummycoll.data:=hp^.resulttype;
+                                   dummycoll.paratype.setdef(hp^.resulttype);
                                    dummycoll.paratyp:=vs_value;
                                    secondcallparan(hp,@dummycoll,false,false,false,0);
                                    hp^.right:=node;
@@ -392,7 +392,7 @@ implementation
                                    hp:=node;
                                    node:=node^.right;
                                    hp^.right:=nil;
-                                   dummycoll.data:=hp^.resulttype;
+                                   dummycoll.paratype.setdef(hp^.resulttype);
                                    dummycoll.paratyp:=vs_value;
                                    secondcallparan(hp,@dummycoll,false,false,false,0);
                                    hp^.right:=node;
@@ -553,9 +553,9 @@ implementation
            hp^.right:=nil;
            dummycoll.paratyp:=vs_var;
            if is_shortstring(hp^.resulttype) then
-             dummycoll.data:=openshortstringdef
+             dummycoll.paratype.setdef(openshortstringdef)
            else
-             dummycoll.data:=hp^.resulttype;
+             dummycoll.paratype.setdef(hp^.resulttype);
            procedureprefix:='FPC_'+pstringdef(hp^.resulttype)^.stringtypname+'_';
            secondcallparan(hp,@dummycoll,false,false,false,0);
            if codegenerror then
@@ -577,7 +577,7 @@ implementation
            if hp^.is_colon_para and assigned(node) and
               node^.is_colon_para then
              begin
-                dummycoll.data:=hp^.resulttype;
+                dummycoll.paratype.setdef(hp^.resulttype);
                 dummycoll.paratyp:=vs_value;
                 secondcallparan(hp,@dummycoll,false
                   ,false,false,0
@@ -597,7 +597,7 @@ implementation
            { third arg, length only if is_real }
            if hp^.is_colon_para then
              begin
-                dummycoll.data:=hp^.resulttype;
+                dummycoll.paratype.setdef(hp^.resulttype);
                 dummycoll.paratyp:=vs_value;
                 secondcallparan(hp,@dummycoll,false
                   ,false,false,0
@@ -623,7 +623,7 @@ implementation
             end;
 
            { last arg longint or real }
-           dummycoll.data:=hp^.resulttype;
+           dummycoll.paratype.setdef(hp^.resulttype);
            dummycoll.paratyp:=vs_value;
            secondcallparan(hp,@dummycoll,false
              ,false,false,0
@@ -696,7 +696,7 @@ implementation
 
           {load and push the address of the destination}
            dummycoll.paratyp:=vs_var;
-           dummycoll.data:=dest_para^.resulttype;
+           dummycoll.paratype.setdef(dest_para^.resulttype);
            secondcallparan(dest_para,@dummycoll,false,false,false,0);
            if codegenerror then
              exit;
@@ -710,7 +710,7 @@ implementation
            If has_32bit_code Then
              Begin
                dummycoll.paratyp:=vs_var;
-               dummycoll.data:=code_para^.resulttype;
+               dummycoll.paratype.setdef(code_para^.resulttype);
                secondcallparan(code_para,@dummycoll,false,false,false,0);
                if codegenerror then
                  exit;
@@ -725,7 +725,7 @@ implementation
 
           {node = first parameter = string}
            dummycoll.paratyp:=vs_const;
-           dummycoll.data:=node^.resulttype;
+           dummycoll.paratype.setdef(node^.resulttype);
            secondcallparan(node,@dummycoll,false,false,false,0);
            if codegenerror then
              exit;
@@ -1133,10 +1133,10 @@ implementation
                            end;
               pointerdef : begin
                              opsize:=S_L;
-                             if porddef(ppointerdef(p^.left^.left^.resulttype)^.definition)=voiddef then
+                             if porddef(ppointerdef(p^.left^.left^.resulttype)^.pointertype.def)=voiddef then
                               addvalue:=1
                              else
-                              addvalue:=ppointerdef(p^.left^.left^.resulttype)^.definition^.size;
+                              addvalue:=ppointerdef(p^.left^.left^.resulttype)^.pointertype.def^.size;
                            end;
                 else
                  internalerror(10081);
@@ -1244,7 +1244,7 @@ implementation
              in_reset_typedfile,in_rewrite_typedfile :
                begin
                   pushusedregisters(pushed,$ff);
-                  emit_const(A_PUSH,S_L,pfiledef(p^.left^.resulttype)^.typed_as^.size);
+                  emit_const(A_PUSH,S_L,pfiledef(p^.left^.resulttype)^.typedfiletype.def^.size);
                   secondpass(p^.left);
                   emitpushreferenceaddr(p^.left^.location.reference);
                   if p^.inlinenumber=in_reset_typedfile then
@@ -1440,7 +1440,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.80  1999-11-29 00:30:06  pierre
+  Revision 1.81  1999-11-30 10:40:42  peter
+    + ttype, tsymlist
+
+  Revision 1.80  1999/11/29 00:30:06  pierre
    * fix for form bug 699
 
   Revision 1.79  1999/11/20 01:22:18  pierre

+ 11 - 8
compiler/cg386ld.pas

@@ -76,7 +76,7 @@ implementation
                  end;
               constsym:
                 begin
-                   if pconstsym(p^.symtableentry)^.consttype=constresourcestring then
+                   if pconstsym(p^.symtableentry)^.consttyp=constresourcestring then
                      begin
                          pushusedregisters(pushed,$ff);
                          emit_const(A_PUSH,S_L,
@@ -252,10 +252,10 @@ implementation
                          { in case call by reference, then calculate. Open array
                            is always an reference! }
                          if (pvarsym(p^.symtableentry)^.varspez=vs_var) or
-                            is_open_array(pvarsym(p^.symtableentry)^.definition) or
-                            is_array_of_const(pvarsym(p^.symtableentry)^.definition) or
+                            is_open_array(pvarsym(p^.symtableentry)^.vartype.def) or
+                            is_array_of_const(pvarsym(p^.symtableentry)^.vartype.def) or
                             ((pvarsym(p^.symtableentry)^.varspez=vs_const) and
-                             push_addr_param(pvarsym(p^.symtableentry)^.definition)) then
+                             push_addr_param(pvarsym(p^.symtableentry)^.vartype.def)) then
                            begin
                               simple_loadn:=false;
                               if hregister=R_NO then
@@ -808,14 +808,14 @@ implementation
                    pp:=pp^.parent;
                 end;
               p^.location.reference.base:=hr;
-              p^.location.reference.offset:=pp^.retoffset;
+              p^.location.reference.offset:=pp^.return_offset;
            end
          else
            begin
              p^.location.reference.base:=procinfo^.framepointer;
-             p^.location.reference.offset:=procinfo^.retoffset;
+             p^.location.reference.offset:=procinfo^.return_offset;
            end;
-         if ret_in_param(p^.retdef) then
+         if ret_in_param(p^.rettype.def) then
            begin
               if not hr_valid then
                 hr:=getregister32;
@@ -997,7 +997,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.90  1999-11-06 14:34:18  peter
+  Revision 1.91  1999-11-30 10:40:43  peter
+    + ttype, tsymlist
+
+  Revision 1.90  1999/11/06 14:34:18  peter
     * truncated log to 20 revs
 
   Revision 1.89  1999/10/12 22:35:48  florian

+ 14 - 11
compiler/cg386mem.pas

@@ -58,7 +58,7 @@ implementation
       begin
          p^.location.register:=getregister32;
          emit_sym_ofs_reg(A_MOV,
-            S_L,newasmsymbol(pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.vmt_mangledname),0,
+            S_L,newasmsymbol(pobjectdef(pclassrefdef(p^.resulttype)^.pointertype.def)^.vmt_mangledname),0,
             p^.location.register);
       end;
 
@@ -93,15 +93,15 @@ implementation
               gettempofsizereference(target_os.size_of_pointer,p^.location.reference);
 
               { determines the size of the mem block }
-              push_int(ppointerdef(p^.resulttype)^.definition^.size);
+              push_int(ppointerdef(p^.resulttype)^.pointertype.def^.size);
               emit_push_lea_loc(p^.location,false);
               emitcall('FPC_GETMEM');
 
-              if ppointerdef(p^.resulttype)^.definition^.needs_inittable then
+              if ppointerdef(p^.resulttype)^.pointertype.def^.needs_inittable then
                 begin
                    new(r);
                    reset_reference(r^);
-                   r^.symbol:=ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label;
+                   r^.symbol:=ppointerdef(p^.left^.resulttype)^.pointertype.def^.get_inittable_label;
                    emitpushreferenceaddr(r^);
                    dispose(r);
                    { push pointer we just allocated, we need to initialize the
@@ -170,11 +170,11 @@ implementation
          case p^.treetype of
            simpledisposen:
              begin
-                if ppointerdef(p^.left^.resulttype)^.definition^.needs_inittable then
+                if ppointerdef(p^.left^.resulttype)^.pointertype.def^.needs_inittable then
                   begin
                      new(r);
                      reset_reference(r^);
-                     r^.symbol:=ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label;
+                     r^.symbol:=ppointerdef(p^.left^.resulttype)^.pointertype.def^.get_inittable_label;
                      emitpushreferenceaddr(r^);
                      dispose(r);
                      { push pointer adress }
@@ -187,14 +187,14 @@ implementation
            simplenewn:
              begin
                 { determines the size of the mem block }
-                push_int(ppointerdef(p^.left^.resulttype)^.definition^.size);
+                push_int(ppointerdef(p^.left^.resulttype)^.pointertype.def^.size);
                 emit_push_lea_loc(p^.left^.location,true);
                 emitcall('FPC_GETMEM');
-                if ppointerdef(p^.left^.resulttype)^.definition^.needs_inittable then
+                if ppointerdef(p^.left^.resulttype)^.pointertype.def^.needs_inittable then
                   begin
                      new(r);
                      reset_reference(r^);
-                     r^.symbol:=ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label;
+                     r^.symbol:=ppointerdef(p^.left^.resulttype)^.pointertype.def^.get_inittable_label;
                      emitpushreferenceaddr(r^);
                      dispose(r);
                      emit_push_loc(p^.left^.location);
@@ -236,7 +236,7 @@ implementation
            (p^.left^.treetype=loadn) and
            assigned(p^.left^.symtableentry) and
            (p^.left^.symtableentry^.typ=varsym) and
-           (pvarsym(p^.left^.symtableentry)^.definition^.deftype=procvardef) then
+           (pvarsym(p^.left^.symtableentry)^.vartype.def^.deftype=procvardef) then
            emit_ref_reg(A_MOV,S_L,
              newreference(p^.left^.location.reference),
              p^.location.register)
@@ -883,7 +883,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.61  1999-11-15 21:54:38  peter
+  Revision 1.62  1999-11-30 10:40:43  peter
+    + ttype, tsymlist
+
+  Revision 1.61  1999/11/15 21:54:38  peter
     * LOC_JUMP support for vecn
 
   Revision 1.60  1999/11/06 14:34:18  peter

+ 75 - 76
compiler/cgai386.pas

@@ -2488,10 +2488,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 
     begin
        if (psym(p)^.typ=varsym) and
-          assigned(pvarsym(p)^.definition) and
-          not((pvarsym(p)^.definition^.deftype=objectdef) and
-            pobjectdef(pvarsym(p)^.definition)^.is_class) and
-          pvarsym(p)^.definition^.needs_inittable then
+          assigned(pvarsym(p)^.vartype.def) and
+          not((pvarsym(p)^.vartype.def^.deftype=objectdef) and
+            pobjectdef(pvarsym(p)^.vartype.def)^.is_class) and
+          pvarsym(p)^.vartype.def^.needs_inittable then
          begin
             procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
             reset_reference(hr);
@@ -2504,7 +2504,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
               begin
                  hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname);
               end;
-            initialize(pvarsym(p)^.definition,hr,false);
+            initialize(pvarsym(p)^.vartype.def,hr,false);
          end;
     end;
 
@@ -2516,16 +2516,16 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 
     begin
        if (psym(p)^.typ=varsym) and
-          not((pvarsym(p)^.definition^.deftype=objectdef) and
-            pobjectdef(pvarsym(p)^.definition)^.is_class) and
-          pvarsym(p)^.definition^.needs_inittable and
+          not((pvarsym(p)^.vartype.def^.deftype=objectdef) and
+            pobjectdef(pvarsym(p)^.vartype.def)^.is_class) and
+          pvarsym(p)^.vartype.def^.needs_inittable and
           ((pvarsym(p)^.varspez=vs_value) {or
            (pvarsym(p)^.varspez=vs_const) and
            not(dont_copy_const_param(pvarsym(p)^.definition))}) then
          begin
             procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
             reset_reference(hr);
-            hr.symbol:=pvarsym(p)^.definition^.get_inittable_label;
+            hr.symbol:=pvarsym(p)^.vartype.def^.get_inittable_label;
             emitpushreferenceaddr(hr);
             reset_reference(hr);
             hr.base:=procinfo^.framepointer;
@@ -2546,10 +2546,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 
     begin
        if (psym(p)^.typ=varsym) and
-          assigned(pvarsym(p)^.definition) and
-          not((pvarsym(p)^.definition^.deftype=objectdef) and
-          pobjectdef(pvarsym(p)^.definition)^.is_class) and
-          pvarsym(p)^.definition^.needs_inittable then
+          assigned(pvarsym(p)^.vartype.def) and
+          not((pvarsym(p)^.vartype.def^.deftype=objectdef) and
+          pobjectdef(pvarsym(p)^.vartype.def)^.is_class) and
+          pvarsym(p)^.vartype.def^.needs_inittable then
          begin
             { not all kind of parameters need to be finalized  }
             if (psym(p)^.owner^.symtabletype=parasymtable) and
@@ -2573,7 +2573,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                else
                  hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname);
             end;
-            finalize(pvarsym(p)^.definition,hr,false);
+            finalize(pvarsym(p)^.vartype.def,hr,false);
          end;
     end;
 
@@ -2589,10 +2589,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
     begin
        if (psym(p)^.typ=varsym) and
           (pvarsym(p)^.varspez=vs_value) and
-          (push_addr_param(pvarsym(p)^.definition)) then
+          (push_addr_param(pvarsym(p)^.vartype.def)) then
         begin
-          if is_open_array(pvarsym(p)^.definition) or
-             is_array_of_const(pvarsym(p)^.definition) then
+          if is_open_array(pvarsym(p)^.vartype.def) or
+             is_array_of_const(pvarsym(p)^.vartype.def) then
            begin
               { get stack space }
               new(r);
@@ -2607,7 +2607,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 
               exprasmlist^.concat(new(paicpu,
                 op_const_reg(A_IMUL,S_L,
-                parraydef(pvarsym(p)^.definition)^.definition^.size,R_EDI)));
+                parraydef(pvarsym(p)^.vartype.def)^.elementtype.def^.size,R_EDI)));
 {$ifndef NOTARGETWIN32}
               { windows guards only a few pages for stack growing, }
               { so we have to access every page first              }
@@ -2643,7 +2643,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 
                    exprasmlist^.concat(new(paicpu,
                      op_const_reg(A_IMUL,S_L,
-                     parraydef(pvarsym(p)^.definition)^.definition^.size,R_EDI)));
+                     parraydef(pvarsym(p)^.vartype.def)^.elementtype.def^.size,R_EDI)));
                 end
               else
 {$endif NOTARGETWIN32}
@@ -2682,7 +2682,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                 op_reg(A_INC,S_L,R_ECX)));
 
               { calculate size }
-              len:=parraydef(pvarsym(p)^.definition)^.definition^.size;
+              len:=parraydef(pvarsym(p)^.vartype.def)^.elementtype.def^.size;
               opsize:=S_B;
               if (len and 3)=0 then
                begin
@@ -2719,7 +2719,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                 op_reg_ref(A_MOV,S_L,R_ESP,r)));
            end
           else
-           if is_shortstring(pvarsym(p)^.definition) then
+           if is_shortstring(pvarsym(p)^.vartype.def) then
             begin
               reset_reference(href1);
               href1.base:=procinfo^.framepointer;
@@ -2727,7 +2727,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
               reset_reference(href2);
               href2.base:=procinfo^.framepointer;
               href2.offset:=-pvarsym(p)^.localvarsym^.address;
-              copyshortstring(href2,href1,pstringdef(pvarsym(p)^.definition)^.len,true);
+              copyshortstring(href2,href1,pstringdef(pvarsym(p)^.vartype.def)^.len,true);
             end
            else
             begin
@@ -2737,7 +2737,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
               reset_reference(href2);
               href2.base:=procinfo^.framepointer;
               href2.offset:=-pvarsym(p)^.localvarsym^.address;
-              concatcopy(href1,href2,pvarsym(p)^.definition^.size,true,true);
+              concatcopy(href1,href2,pvarsym(p)^.vartype.def^.size,true,true);
             end;
         end;
     end;
@@ -3020,16 +3020,16 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
           generate_interrupt_stackframe_entry;
 
       { initialize return value }
-      if (procinfo^.retdef<>pdef(voiddef)) and
-        (procinfo^.retdef^.needs_inittable) and
-        ((procinfo^.retdef^.deftype<>objectdef) or
-        not(pobjectdef(procinfo^.retdef)^.is_class)) then
+      if (procinfo^.returntype.def<>pdef(voiddef)) and
+        (procinfo^.returntype.def^.needs_inittable) and
+        ((procinfo^.returntype.def^.deftype<>objectdef) or
+        not(pobjectdef(procinfo^.returntype.def)^.is_class)) then
         begin
            procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
            reset_reference(r);
-           r.offset:=procinfo^.retoffset;
+           r.offset:=procinfo^.return_offset;
            r.base:=procinfo^.framepointer;
-           initialize(procinfo^.retdef,r,ret_in_param(procinfo^.retdef));
+           initialize(procinfo^.returntype.def,r,ret_in_param(procinfo^.returntype.def));
         end;
 
       { generate copies of call by value parameters }
@@ -3062,14 +3062,13 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
             emitjmp(C_NE,aktexitlabel);
         end;
 
-
-      if (cs_profile in aktmoduleswitches) or
-         (aktprocsym^.definition^.owner^.symtabletype=globalsymtable) or
-         (assigned(procinfo^._class) and (procinfo^._class^.owner^.symtabletype=globalsymtable)) then
-           make_global:=true;
-
       if not inlined then
        begin
+         if (cs_profile in aktmoduleswitches) or
+            (aktprocsym^.definition^.owner^.symtabletype=globalsymtable) or
+            (assigned(procinfo^._class) and (procinfo^._class^.owner^.symtabletype=globalsymtable)) then
+              make_global:=true;
+
          hs:=proc_names.get;
 
 {$ifdef GDB}
@@ -3095,24 +3094,21 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 
             hs:=proc_names.get;
           end;
-       end;
 
-{$ifdef GDB}
-      if (not inlined) and (cs_debuginfo in aktmoduleswitches) then
-       begin
-         if target_os.use_function_relative_addresses then
-           exprasmlist^.insert(stab_function_name);
          if make_global or ((procinfo^.flags and pi_is_global) <> 0) then
-           aktprocsym^.is_global := True;
-         exprasmlist^.insert(new(pai_stabs,init(aktprocsym^.stabstring)));
-         aktprocsym^.isstabwritten:=true;
-       end;
+          aktprocsym^.is_global := True;
+
+{$ifdef GDB}
+         if (cs_debuginfo in aktmoduleswitches) then
+          begin
+            if target_os.use_function_relative_addresses then
+             exprasmlist^.insert(stab_function_name);
+            exprasmlist^.insert(new(pai_stabs,init(aktprocsym^.stabstring)));
+            aktprocsym^.isstabwritten:=true;
+          end;
 {$endif GDB}
 
-   { Align }
-      if (not inlined) then
-       begin
-       { gprof uses 16 byte granularity !! }
+       { Align, gprof uses 16 byte granularity }
          if (cs_profile in aktmoduleswitches) then
           exprasmlist^.insert(new(pai_align,init_op(16,$90)))
          else
@@ -3129,7 +3125,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
        op : Tasmop;
        s : Topsize;
   begin
-      if procinfo^.retdef<>pdef(voiddef) then
+      if procinfo^.returntype.def<>pdef(voiddef) then
           begin
               {if ((procinfo^.flags and pi_operator)<>0) and
                  assigned(opsym) then
@@ -3138,14 +3134,14 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
               if (procinfo^.funcret_state<>vs_assigned) and not inlined { and
                 ((procinfo^.flags and pi_uses_asm)=0)} then
                CGMessage(sym_w_function_result_not_set);
-              hr:=new_reference(procinfo^.framepointer,procinfo^.retoffset);
-              if (procinfo^.retdef^.deftype in [orddef,enumdef]) then
+              hr:=new_reference(procinfo^.framepointer,procinfo^.return_offset);
+              if (procinfo^.returntype.def^.deftype in [orddef,enumdef]) then
                 begin
-                  case procinfo^.retdef^.size of
+                  case procinfo^.returntype.def^.size of
                    8:
                      begin
                         emit_ref_reg(A_MOV,S_L,hr,R_EAX);
-                        hr:=new_reference(procinfo^.framepointer,procinfo^.retoffset+4);
+                        hr:=new_reference(procinfo^.framepointer,procinfo^.return_offset+4);
                         emit_ref_reg(A_MOV,S_L,hr,R_EDX);
                      end;
 
@@ -3160,12 +3156,12 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                   end;
                 end
               else
-                if ret_in_acc(procinfo^.retdef) then
+                if ret_in_acc(procinfo^.returntype.def) then
                   emit_ref_reg(A_MOV,S_L,hr,R_EAX)
               else
-                 if (procinfo^.retdef^.deftype=floatdef) then
+                 if (procinfo^.returntype.def^.deftype=floatdef) then
                    begin
-                      floatloadops(pfloatdef(procinfo^.retdef)^.typ,op,s);
+                      floatloadops(pfloatdef(procinfo^.returntype.def)^.typ,op,s);
                       exprasmlist^.concat(new(paicpu,op_ref(op,s,hr)))
                    end
               else
@@ -3245,15 +3241,15 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
              op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
            emitjmp(C_E,noreraiselabel);
            { must be the return value finalized before reraising the exception? }
-           if (procinfo^.retdef<>pdef(voiddef)) and
-             (procinfo^.retdef^.needs_inittable) and
-             ((procinfo^.retdef^.deftype<>objectdef) or
-             not(pobjectdef(procinfo^.retdef)^.is_class)) then
+           if (procinfo^.returntype.def<>pdef(voiddef)) and
+             (procinfo^.returntype.def^.needs_inittable) and
+             ((procinfo^.returntype.def^.deftype<>objectdef) or
+             not(pobjectdef(procinfo^.returntype.def)^.is_class)) then
              begin
                 reset_reference(hr);
-                hr.offset:=procinfo^.retoffset;
+                hr.offset:=procinfo^.return_offset;
                 hr.base:=procinfo^.framepointer;
-                finalize(procinfo^.retdef,hr,ret_in_param(procinfo^.retdef));
+                finalize(procinfo^.returntype.def,hr,ret_in_param(procinfo^.returntype.def));
              end;
 
            emitcall('FPC_RERAISE');
@@ -3355,7 +3351,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
            begin
 {$ifndef OLD_C_STACK}
              { complex return values are removed from stack in C code PM }
-             if ret_in_param(aktprocsym^.definition^.retdef) then
+             if ret_in_param(aktprocsym^.definition^.rettype.def) then
                exprasmlist^.concat(new(paicpu,op_const(A_RET,S_NO,4)))
              else
 {$endif not OLD_C_STACK}
@@ -3384,25 +3380,25 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                    '"$t:r*'+procinfo^._class^.numberstring+'",'+
                    tostr(N_RSYM)+',0,0,'+tostr(GDB_i386index[R_ESI])))));
 
-              if (pdef(aktprocsym^.definition^.retdef) <> pdef(voiddef)) then
+              if (pdef(aktprocsym^.definition^.rettype.def) <> pdef(voiddef)) then
                 begin
-                  if ret_in_param(aktprocsym^.definition^.retdef) then
+                  if ret_in_param(aktprocsym^.definition^.rettype.def) then
                     exprasmlist^.concat(new(pai_stabs,init(strpnew(
-                     '"'+aktprocsym^.name+':X*'+aktprocsym^.definition^.retdef^.numberstring+'",'+
-                     tostr(N_PSYM)+',0,0,'+tostr(procinfo^.retoffset)))))
+                     '"'+aktprocsym^.name+':X*'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
+                     tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))))
                   else
                     exprasmlist^.concat(new(pai_stabs,init(strpnew(
-                     '"'+aktprocsym^.name+':X'+aktprocsym^.definition^.retdef^.numberstring+'",'+
-                     tostr(N_PSYM)+',0,0,'+tostr(procinfo^.retoffset)))));
+                     '"'+aktprocsym^.name+':X'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
+                     tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))));
                   if (m_result in aktmodeswitches) then
-                    if ret_in_param(aktprocsym^.definition^.retdef) then
+                    if ret_in_param(aktprocsym^.definition^.rettype.def) then
                       exprasmlist^.concat(new(pai_stabs,init(strpnew(
-                       '"RESULT:X*'+aktprocsym^.definition^.retdef^.numberstring+'",'+
-                       tostr(N_PSYM)+',0,0,'+tostr(procinfo^.retoffset)))))
+                       '"RESULT:X*'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
+                       tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))))
                     else
                       exprasmlist^.concat(new(pai_stabs,init(strpnew(
-                       '"RESULT:X'+aktprocsym^.definition^.retdef^.numberstring+'",'+
-                       tostr(N_PSYM)+',0,0,'+tostr(procinfo^.retoffset)))));
+                       '"RESULT:X'+aktprocsym^.definition^.rettype.def^.numberstring+'",'+
+                       tostr(N_PSYM)+',0,0,'+tostr(procinfo^.return_offset)))));
                 end;
               mangled_length:=length(aktprocsym^.definition^.mangledname);
               getmem(p,mangled_length+50);
@@ -3451,7 +3447,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 end.
 {
   $Log$
-  Revision 1.61  1999-11-20 01:22:18  pierre
+  Revision 1.62  1999-11-30 10:40:43  peter
+    + ttype, tsymlist
+
+  Revision 1.61  1999/11/20 01:22:18  pierre
     + cond FPC_USE_CPREFIX (needs also some RTL changes)
       this allows to use unit global vars as DLL exports
       (the underline prefix seems needed by dlltool)

+ 5 - 3
compiler/cpuasm.pas

@@ -801,7 +801,7 @@ end;
 
 function taicpu.Pass1(offset:longint):longint;
 var
-  m,i,size_prob : longint;
+  m,i : longint;
 begin
   Pass1:=0;
 { Save the old offset and set the new offset }
@@ -835,7 +835,6 @@ begin
    end;
 { Lookup opcode in the table }
   InsSize:=-1;
-  size_prob:=0;
   i:=instabcache^[opcode];
   if i=-1 then
    begin
@@ -1528,7 +1527,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  1999-11-06 14:34:20  peter
+  Revision 1.6  1999-11-30 10:40:43  peter
+    + ttype, tsymlist
+
+  Revision 1.5  1999/11/06 14:34:20  peter
     * truncated log to 20 revs
 
   Revision 1.4  1999/11/05 16:01:46  jonas

+ 11 - 7
compiler/hcgdata.pas

@@ -464,12 +464,13 @@ implementation
                                          end;
 
                                        { error, if the return types aren't equal }
-                                       if not(is_equal(procdefcoll^.data^.retdef,hp^.retdef)) and
-                                         not((procdefcoll^.data^.retdef^.deftype=objectdef) and
-                                           (hp^.retdef^.deftype=objectdef) and
-                                           (pobjectdef(procdefcoll^.data^.retdef)^.is_class) and
-                                           (pobjectdef(hp^.retdef)^.is_class) and
-                                           (pobjectdef(hp^.retdef)^.is_related(pobjectdef(procdefcoll^.data^.retdef)))) then
+                                       if not(is_equal(procdefcoll^.data^.rettype.def,hp^.rettype.def)) and
+                                         not((procdefcoll^.data^.rettype.def^.deftype=objectdef) and
+                                           (hp^.rettype.def^.deftype=objectdef) and
+                                           (pobjectdef(procdefcoll^.data^.rettype.def)^.is_class) and
+                                           (pobjectdef(hp^.rettype.def)^.is_class) and
+                                           (pobjectdef(hp^.rettype.def)^.is_related(
+                                               pobjectdef(procdefcoll^.data^.rettype.def)))) then
                                          Message1(parser_e_overloaded_methodes_not_same_ret,_c^.objname^+'.'+_name);
 
 
@@ -614,7 +615,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.19  1999-11-29 23:42:49  pierre
+  Revision 1.20  1999-11-30 10:40:43  peter
+    + ttype, tsymlist
+
+  Revision 1.19  1999/11/29 23:42:49  pierre
    * fix for form bug 555
 
   Revision 1.18  1999/10/26 12:30:41  peter

+ 51 - 16
compiler/hcodegen.pas

@@ -49,34 +49,29 @@ implementation
                                         { needs to be finalized              }
     type
        pprocinfo = ^tprocinfo;
-       tprocinfo = record
+       tprocinfo = object
           { pointer to parent in nested procedures }
           parent : pprocinfo;
           { current class, if we are in a method }
           _class : pobjectdef;
           { return type }
-          retdef : pdef;
-          { return type }
-          sym : pprocsym;
+          returntype : ttype;
           { symbol of the function, and the sym for result variable }
           resultfuncretsym,
           funcretsym : pfuncretsym;
+          funcret_state : tvarstate;
           { the definition of the proc itself }
-          { why was this a pdef only ?? PM    }
           def : pprocdef;
+          sym : pprocsym;
+
           { frame pointer offset }
           framepointer_offset : longint;
           { self pointer offset }
           selfpointer_offset : longint;
           { result value offset }
-          retoffset : longint;
-
+          return_offset : longint;
           { firsttemp position }
-          firsttemp : longint;
-
-          { funcret_is_valid : boolean; }
-          funcret_state : tvarstate;
-
+          firsttemp_offset : longint;
           { parameter offset }
           call_offset : longint;
 
@@ -97,6 +92,9 @@ implementation
           aktproccode,aktentrycode,
           aktexitcode,aktlocaldata : paasmoutput;
           { local data is used for smartlink }
+
+          constructor init;
+          destructor done;
        end;
 
        { some kind of temp. types needs to be destructed }
@@ -267,6 +265,41 @@ implementation
       end;
 
 
+{****************************************************************************
+                                 TProcInfo
+****************************************************************************}
+
+    constructor tprocinfo.init;
+      begin
+        parent:=nil;
+        _class:=nil;
+        returntype.reset;
+        resultfuncretsym:=nil;
+        funcretsym:=nil;
+        funcret_state:=vs_none;
+        def:=nil;
+        sym:=nil;
+        framepointer_offset:=0;
+        selfpointer_offset:=0;
+        return_offset:=0;
+        firsttemp_offset:=0;
+        call_offset:=0;
+        flags:=0;
+        framepointer:=R_NO;
+        globalsymbol:=false;
+        exported:=false;
+        aktproccode:=nil;
+        aktentrycode:=nil;
+        aktexitcode:=nil;
+        aktlocaldata:=nil;
+      end;
+
+
+    destructor tprocinfo.done;
+      begin
+      end;
+
+
 {*****************************************************************************
          initialize/terminate the codegen for procedure and modules
 *****************************************************************************}
@@ -278,8 +311,7 @@ implementation
          { aktexitlabel:=0; is store in oldaktexitlabel
            so it must not be reset to zero before this storage !}
          { new procinfo }
-         new(procinfo);
-         fillchar(procinfo^,sizeof(tprocinfo),0);
+         new(procinfo,init);
          { the type of this lists isn't important }
          { because the code of this lists is      }
          { copied to the code segment        }
@@ -297,7 +329,7 @@ implementation
          dispose(procinfo^.aktexitcode,done);
          dispose(procinfo^.aktproccode,done);
          dispose(procinfo^.aktlocaldata,done);
-         dispose(procinfo);
+         dispose(procinfo,done);
          procinfo:=nil;
       end;
 
@@ -375,7 +407,10 @@ end.
 
 {
   $Log$
-  Revision 1.49  1999-11-17 17:04:59  pierre
+  Revision 1.50  1999-11-30 10:40:43  peter
+    + ttype, tsymlist
+
+  Revision 1.49  1999/11/17 17:04:59  pierre
    * Notes/hints changes
 
   Revision 1.48  1999/11/09 23:06:45  peter

+ 37 - 34
compiler/htypechk.pas

@@ -121,7 +121,7 @@ implementation
             (def_from^.deftype=procvardef) and
             (fromtreetype=loadn) then
           begin
-            def_from:=pprocvardef(def_from)^.retdef;
+            def_from:=pprocvardef(def_from)^.rettype.def;
           end;
 
        { we walk the wanted (def_to) types and check then the def_from
@@ -254,7 +254,7 @@ implementation
              begin
              { open array is also compatible with a single element of its base type }
                if is_open_array(def_to) and
-                  is_equal(parraydef(def_to)^.definition,def_from) then
+                  is_equal(parraydef(def_to)^.elementtype.def,def_from) then
                 begin
                   doconv:=tc_equal;
                   b:=1;
@@ -268,14 +268,14 @@ implementation
                         if is_open_array(def_to) and
                            is_array_constructor(def_from) then
                          begin
-                           if is_equal(parraydef(def_to)^.definition,parraydef(def_from)^.definition) then
+                           if is_equal(parraydef(def_to)^.elementtype.def,parraydef(def_from)^.elementtype.def) then
                             begin
                               doconv:=tc_equal;
                               b:=1;
                             end
                            else
-                            if isconvertable(parraydef(def_to)^.definition,
-                                             parraydef(def_from)^.definition,hct,nothingn,false)<>0 then
+                            if isconvertable(parraydef(def_to)^.elementtype.def,
+                                             parraydef(def_from)^.elementtype.def,hct,nothingn,false)<>0 then
                              begin
                                doconv:=hct;
                                b:=2;
@@ -285,7 +285,7 @@ implementation
                     pointerdef :
                       begin
                         if is_zero_based_array(def_to) and
-                           is_equal(ppointerdef(def_from)^.definition,parraydef(def_to)^.definition) then
+                           is_equal(ppointerdef(def_from)^.pointertype.def,parraydef(def_to)^.elementtype.def) then
                          begin
                            doconv:=tc_pointer_2_array;
                            b:=1;
@@ -295,7 +295,7 @@ implementation
                       begin
                         { string to array of char}
                         if (not(is_special_array(def_to)) or is_open_array(def_to)) and
-                          is_equal(parraydef(def_to)^.definition,cchardef) then
+                          is_equal(parraydef(def_to)^.elementtype.def,cchardef) then
                          begin
                            doconv:=tc_string_2_chararray;
                            b:=1;
@@ -341,7 +341,7 @@ implementation
                    begin
                      { chararray to pointer }
                      if is_zero_based_array(def_from) and
-                        is_equal(parraydef(def_from)^.definition,ppointerdef(def_to)^.definition) then
+                        is_equal(parraydef(def_from)^.elementtype.def,ppointerdef(def_to)^.pointertype.def) then
                       begin
                         doconv:=tc_array_2_pointer;
                         b:=1;
@@ -351,16 +351,16 @@ implementation
                    begin
                      { child class pointer can be assigned to anchestor pointers }
                      if (
-                         (ppointerdef(def_from)^.definition^.deftype=objectdef) and
-                         (ppointerdef(def_to)^.definition^.deftype=objectdef) and
-                         pobjectdef(ppointerdef(def_from)^.definition)^.is_related(
-                           pobjectdef(ppointerdef(def_to)^.definition))
+                         (ppointerdef(def_from)^.pointertype.def^.deftype=objectdef) and
+                         (ppointerdef(def_to)^.pointertype.def^.deftype=objectdef) and
+                         pobjectdef(ppointerdef(def_from)^.pointertype.def)^.is_related(
+                           pobjectdef(ppointerdef(def_to)^.pointertype.def))
                         ) or
                         { all pointers can be assigned to void-pointer }
-                        is_equal(ppointerdef(def_to)^.definition,voiddef) or
+                        is_equal(ppointerdef(def_to)^.pointertype.def,voiddef) or
                         { in my opnion, is this not clean pascal }
                         { well, but it's handy to use, it isn't ? (FK) }
-                        is_equal(ppointerdef(def_from)^.definition,voiddef) then
+                        is_equal(ppointerdef(def_from)^.pointertype.def,voiddef) then
                        begin
                          doconv:=tc_equal;
                          b:=1;
@@ -371,8 +371,8 @@ implementation
                      { procedure variable can be assigned to an void pointer }
                      { Not anymore. Use the @ operator now.}
                      if not(m_tp_procvar in aktmodeswitches) and
-                        (ppointerdef(def_to)^.definition^.deftype=orddef) and
-                        (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
+                        (ppointerdef(def_to)^.pointertype.def^.deftype=orddef) and
+                        (porddef(ppointerdef(def_to)^.pointertype.def)^.typ=uvoid) then
                       begin
                         doconv:=tc_equal;
                         b:=1;
@@ -387,8 +387,8 @@ implementation
                          ((def_from^.deftype=objectdef) and pobjectdef(def_from)^.is_class) or
                          (def_from^.deftype=classrefdef)
                         ) and
-                        (ppointerdef(def_to)^.definition^.deftype=orddef) and
-                        (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
+                        (ppointerdef(def_to)^.pointertype.def^.deftype=orddef) and
+                        (porddef(ppointerdef(def_to)^.pointertype.def)^.typ=uvoid) then
                        begin
                          doconv:=tc_equal;
                          b:=1;
@@ -421,8 +421,8 @@ implementation
                 { to procedure variables                                  }
                 if (m_pointer_2_procedure in aktmodeswitches) and
                   (def_from^.deftype=pointerdef) and
-                  (ppointerdef(def_from)^.definition^.deftype=orddef) and
-                  (porddef(ppointerdef(def_from)^.definition)^.typ=uvoid) then
+                  (ppointerdef(def_from)^.pointertype.def^.deftype=orddef) and
+                  (porddef(ppointerdef(def_from)^.pointertype.def)^.typ=uvoid) then
                 begin
                    doconv:=tc_equal;
                    b:=1;
@@ -461,8 +461,8 @@ implementation
                if (def_from^.deftype=classrefdef) then
                 begin
                   doconv:=tc_equal;
-                  if pobjectdef(pclassrefdef(def_from)^.definition)^.is_related(
-                       pobjectdef(pclassrefdef(def_to)^.definition)) then
+                  if pobjectdef(pclassrefdef(def_from)^.pointertype.def)^.is_related(
+                       pobjectdef(pclassrefdef(def_to)^.pointertype.def)) then
                    b:=1;
                 end
                else
@@ -486,21 +486,21 @@ implementation
                if (def_from^.deftype=filedef) and
                   (
                    (
-                    (pfiledef(def_from)^.filetype = ft_typed) and
-                    (pfiledef(def_to)^.filetype = ft_typed) and
+                    (pfiledef(def_from)^.filetyp = ft_typed) and
+                    (pfiledef(def_to)^.filetyp = ft_typed) and
                     (
-                     (pfiledef(def_from)^.typed_as = pdef(voiddef)) or
-                     (pfiledef(def_to)^.typed_as = pdef(voiddef))
+                     (pfiledef(def_from)^.typedfiletype.def = pdef(voiddef)) or
+                     (pfiledef(def_to)^.typedfiletype.def = pdef(voiddef))
                     )
                    ) or
                    (
                     (
-                     (pfiledef(def_from)^.filetype = ft_untyped) and
-                     (pfiledef(def_to)^.filetype = ft_typed)
+                     (pfiledef(def_from)^.filetyp = ft_untyped) and
+                     (pfiledef(def_to)^.filetyp = ft_typed)
                     ) or
                     (
-                     (pfiledef(def_from)^.filetype = ft_typed) and
-                     (pfiledef(def_to)^.filetype = ft_untyped)
+                     (pfiledef(def_from)^.filetyp = ft_typed) and
+                     (pfiledef(def_to)^.filetyp = ft_untyped)
                     )
                    )
                   ) then
@@ -701,9 +701,9 @@ implementation
             exit;
           while passproc<>nil do
             begin
-              if is_equal(passproc^.retdef,to_def) and
-                 (is_equal(pparaitem(passproc^.para^.first)^.data,from_def) or
-                 (isconvertable(from_def,pparaitem(passproc^.para^.first)^.data,convtyp,ordconstn,false)=1)) then
+              if is_equal(passproc^.rettype.def,to_def) and
+                 (is_equal(pparaitem(passproc^.para^.first)^.paratype.def,from_def) or
+                 (isconvertable(from_def,pparaitem(passproc^.para^.first)^.paratype.def,convtyp,ordconstn,false)=1)) then
                 begin
                    assignment_overloaded:=passproc;
                    break;
@@ -842,7 +842,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.49  1999-11-18 15:34:45  pierre
+  Revision 1.50  1999-11-30 10:40:43  peter
+    + ttype, tsymlist
+
+  Revision 1.49  1999/11/18 15:34:45  pierre
     * Notes/Hints for local syms changed to
       Set_varstate function
 

+ 4 - 3
compiler/og386cff.pas

@@ -437,7 +437,6 @@ unit og386cff;
       var
         pos : longint;
         sym : tsymbol;
-        c   : char;
         s   : string;
       begin
         { already written ? }
@@ -448,7 +447,6 @@ unit og386cff;
           createsection(p^.section);
         { symbolname }
         pos:=strs^.usedsize+4;
-        c:=#0;
         s:=p^.name;
         if length(s)>8 then
          begin
@@ -978,7 +976,10 @@ unit og386cff;
 end.
 {
   $Log$
-  Revision 1.14  1999-11-06 14:34:21  peter
+  Revision 1.15  1999-11-30 10:40:43  peter
+    + ttype, tsymlist
+
+  Revision 1.14  1999/11/06 14:34:21  peter
     * truncated log to 20 revs
 
   Revision 1.13  1999/11/02 15:06:57  peter

+ 5 - 2
compiler/pass_1.pas

@@ -122,7 +122,7 @@ implementation
                    { Funktionsresultate an exit anh„ngen }
                    { this is wrong for string or other complex
                      result types !!! }
-                   if ret_in_acc(procinfo^.retdef) and
+                   if ret_in_acc(procinfo^.returntype.def) and
                       assigned(hp^.left) and
                       (hp^.left^.right^.treetype=exitn) and
                       (hp^.right^.treetype=assignn) and
@@ -371,7 +371,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.109  1999-11-18 15:34:47  pierre
+  Revision 1.110  1999-11-30 10:40:44  peter
+    + ttype, tsymlist
+
+  Revision 1.109  1999/11/18 15:34:47  pierre
     * Notes/Hints for local syms changed to
       Set_varstate function
 

+ 9 - 6
compiler/pass_2.pas

@@ -519,14 +519,14 @@ implementation
                                   { call by reference/const ? }
                                   if (regvars[i]^.varspez=vs_var) or
                                      ((regvars[i]^.varspez=vs_const) and
-                                       push_addr_param(regvars[i]^.definition)) then
+                                       push_addr_param(regvars[i]^.vartype.def)) then
                                     begin
                                        regvars[i]^.reg:=varregs[i];
                                        regsize:=S_L;
                                     end
                                   else
-                                   if (regvars[i]^.definition^.deftype=orddef) and
-                                      (porddef(regvars[i]^.definition)^.size=1) then
+                                   if (regvars[i]^.vartype.def^.deftype=orddef) and
+                                      (porddef(regvars[i]^.vartype.def)^.size=1) then
                                     begin
 {$ifdef i386}
                                        regvars[i]^.reg:=reg32toreg8(varregs[i]);
@@ -534,8 +534,8 @@ implementation
                                        regsize:=S_B;
                                     end
                                   else
-                                   if (regvars[i]^.definition^.deftype=orddef) and
-                                      (porddef(regvars[i]^.definition)^.size=2) then
+                                   if (regvars[i]^.vartype.def^.deftype=orddef) and
+                                      (porddef(regvars[i]^.vartype.def)^.size=2) then
                                     begin
 {$ifdef i386}
                                        regvars[i]^.reg:=reg32toreg16(varregs[i]);
@@ -697,7 +697,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.43  1999-11-18 15:34:47  pierre
+  Revision 1.44  1999-11-30 10:40:44  peter
+    + ttype, tsymlist
+
+  Revision 1.43  1999/11/18 15:34:47  pierre
     * Notes/Hints for local syms changed to
       Set_varstate function
 

+ 74 - 111
compiler/pdecl.pas

@@ -73,7 +73,7 @@ unit pdecl;
         sc      : Pstringcontainer;
         s       : string;
         storetokenpos : tfileposinfo;
-        p       : Pdef;
+        tt      : ttype;
         hsym    : psym;
         hvs,
         vs      : Pvarsym;
@@ -94,7 +94,7 @@ unit pdecl;
             else
               varspez:=vs_value;
           inserthigh:=false;
-          readtypesym:=nil;
+          tt.reset;
           if idtoken=_SELF then
             begin
                { only allowed in procvars and class methods }
@@ -108,7 +108,7 @@ unit pdecl;
 {$else UseNiceNames}
                      hs2:=hs2+tostr(length('self'))+'self';
 {$endif UseNiceNames}
-                     vs:=new(Pvarsym,init('@',procinfo^._class));
+                     vs:=new(Pvarsym,initdef('@',procinfo^._class));
                      vs^.varspez:=vs_var;
                    { insert the sym in the parasymtable }
                      pprocdef(aktprocdef)^.parast^.insert(vs);
@@ -121,14 +121,11 @@ unit pdecl;
                    end;
                   consume(idtoken);
                   consume(_COLON);
-                  p:=single_type(hs1,false);
-                  if assigned(readtypesym) then
-                   aktprocdef^.concattypesym(readtypesym,vs_value)
-                  else
-                   aktprocdef^.concatdef(p,vs_value);
+                  single_type(tt,hs1,false);
+                  aktprocdef^.concatpara(tt,vs_value);
                   { check the types for procedures only }
                   if not is_procvar then
-                   CheckTypes(p,procinfo^._class);
+                   CheckTypes(tt.def,procinfo^._class);
                 end
                else
                 consume(_ID);
@@ -147,7 +144,7 @@ unit pdecl;
                      consume(_ARRAY);
                      consume(_OF);
                    { define range and type of range }
-                     p:=new(Parraydef,init(0,-1,s32bitdef));
+                     tt.setdef(new(Parraydef,init(0,-1,s32bitdef)));
                    { array of const ? }
                      if (token=_CONST) and (m_objpas in aktmodeswitches) then
                       begin
@@ -156,17 +153,15 @@ unit pdecl;
                         getsymonlyin(systemunit,'TVARREC');
                         if not assigned(srsym) then
                          InternalError(1234124);
-                        Parraydef(p)^.definition:=ptypesym(srsym)^.definition;
-                        Parraydef(p)^.IsArrayOfConst:=true;
+                        Parraydef(tt.def)^.elementtype:=ptypesym(srsym)^.restype;
+                        Parraydef(tt.def)^.IsArrayOfConst:=true;
                         hs1:='array_of_const';
                       end
                      else
                       begin
-                      { define field type }
-                        Parraydef(p)^.definition:=single_type(hs1,false);
+                        { define field type }
+                        single_type(parraydef(tt.def)^.elementtype,hs1,false);
                         hs1:='array_of_'+hs1;
-                        { we don't need the typesym anymore }
-                        readtypesym:=nil;
                       end;
                      inserthigh:=true;
                    end
@@ -181,13 +176,13 @@ unit pdecl;
                           (idtoken=_OPENSTRING)) then
                    begin
                      consume(token);
-                     p:=openshortstringdef;
+                     tt.setdef(openshortstringdef);
                      hs1:='openstring';
                      inserthigh:=true;
                    end
                   { everything else }
                   else
-                   p:=single_type(hs1,false);
+                   single_type(tt,hs1,false);
                 end
                else
                 begin
@@ -196,7 +191,7 @@ unit pdecl;
 {$else UseNiceNames}
                   hs1:='var';
 {$endif UseNiceNames}
-                  p:=cformaldef;
+                  tt.setdef(cformaldef);
                 end;
                if not is_procvar then
                 hs2:=pprocdef(aktprocdef)^.mangledname;
@@ -204,10 +199,7 @@ unit pdecl;
                while not sc^.empty do
                 begin
                   s:=sc^.get_with_tokeninfo(tokenpos);
-                  if assigned(readtypesym) then
-                   aktprocdef^.concattypesym(readtypesym,varspez)
-                  else
-                   aktprocdef^.concatdef(p,varspez);
+                  aktprocdef^.concatpara(tt,varspez);
                   { For proc vars we only need the definitions }
                   if not is_procvar then
                    begin
@@ -216,13 +208,10 @@ unit pdecl;
 {$else UseNiceNames}
                      hs2:=hs2+tostr(length(hs1))+hs1;
 {$endif UseNiceNames}
-                     if assigned(readtypesym) then
-                      vs:=new(Pvarsym,initsym(s,readtypesym))
-                     else
-                      vs:=new(Pvarsym,init(s,p));
+                     vs:=new(pvarsym,init(s,tt));
                      vs^.varspez:=varspez;
                    { we have to add this to avoid var param to be in registers !!!}
-                     if (varspez in [vs_var,vs_const]) and push_addr_param(p) then
+                     if (varspez in [vs_var,vs_const]) and push_addr_param(tt.def) then
 {$ifdef INCLUDEOK}
                        include(vs^.varoptions,vo_regable);
 {$else}
@@ -242,8 +231,8 @@ unit pdecl;
 
                    { do we need a local copy? }
                      if (varspez=vs_value) and
-                        push_addr_param(p) and
-                        not(is_open_array(p) or is_array_of_const(p)) then
+                        push_addr_param(tt.def) and
+                        not(is_open_array(tt.def) or is_array_of_const(tt.def)) then
                        vs^.setname('val'+vs^.name);
 
                    { insert the sym in the parasymtable }
@@ -252,7 +241,7 @@ unit pdecl;
                    { also need to push a high value? }
                      if inserthigh then
                       begin
-                        hvs:=new(Pvarsym,init('high'+s,s32bitdef));
+                        hvs:=new(Pvarsym,initdef('high'+s,s32bitdef));
                         hvs^.varspez:=vs_const;
                         pprocdef(aktprocdef)^.parast^.insert(hvs);
                       end;
@@ -288,24 +277,18 @@ unit pdecl;
     { => the procedure is also used to read     }
     { a sequence of variable declaration        }
 
-      procedure insert_syms(st : psymtable;sc : pstringcontainer;def : pdef;sym:ptypesym;is_threadvar : boolean);
+      procedure insert_syms(st : psymtable;sc : pstringcontainer;tt : ttype;is_threadvar : boolean);
       { inserts the symbols of sc in st with def as definition or sym as ptypesym, sc is disposed }
         var
            s : string;
            filepos : tfileposinfo;
            ss : pvarsym;
         begin
-           { can't have a definition and ttypesym }
-           if assigned(def) and assigned(sym) then
-            internalerror(5438257);
            filepos:=tokenpos;
            while not sc^.empty do
              begin
                 s:=sc^.get_with_tokeninfo(tokenpos);
-                if assigned(sym) then
-                 ss:=new(pvarsym,initsym(s,sym))
-                else
-                 ss:=new(pvarsym,init(s,def));
+                ss:=new(pvarsym,init(s,tt));
                 if is_threadvar then
 {$ifdef INCLUDEOK}
                   include(ss^.varoptions,vo_is_thread_var);
@@ -318,7 +301,7 @@ unit pdecl;
                    (sp_static in current_object_option) then
                   begin
                      s:=lower(st^.name^)+'_'+s;
-                     st^.defowner^.owner^.insert(new(pvarsym,init(s,def)));
+                     st^.defowner^.owner^.insert(new(pvarsym,init(s,tt)));
                   end;
              end;
            dispose(sc,done);
@@ -341,8 +324,7 @@ unit pdecl;
          is_gpc_name,is_cdecl,extern_aktvarsym,export_aktvarsym : boolean;
          dll_name,
          C_name : string;
-         { case }
-         p,casedef : pdef;
+         tt,casetype : ttype;
          { Delphi initialized vars }
          pconstsym : ptypedconstsym;
          { maxsize contains the max. size of a variant }
@@ -378,8 +360,8 @@ unit pdecl;
              { this is needed for Delphi mode at least
                but should be OK for all modes !! (PM) }
              ignore_equal:=true;
-             p:=read_type('');
-             if (variantrecordlevel>0) and p^.needs_inittable then
+             read_type(tt,'');
+             if (variantrecordlevel>0) and tt.def^.needs_inittable then
                Message(parser_e_cant_use_inittable_here);
              ignore_equal:=false;
              symdone:=false;
@@ -390,7 +372,7 @@ unit pdecl;
                   if not sc^.empty then
                    Message(parser_e_absolute_only_one_var);
                   dispose(sc,done);
-                  aktvarsym:=new(pvarsym,init_C(s,target_os.Cprefix+C_name,p));
+                  aktvarsym:=new(pvarsym,init_C(s,target_os.Cprefix+C_name,tt));
 {$ifdef INCLUDEOK}
                   include(aktvarsym^.varoptions,vo_is_external);
 {$else}
@@ -427,7 +409,7 @@ unit pdecl;
                      Message(parser_e_absolute_only_to_var_or_const);
                    storetokenpos:=tokenpos;
                    tokenpos:=declarepos;
-                   abssym:=new(pabsolutesym,init(s,p));
+                   abssym:=new(pabsolutesym,init(s,tt));
                    abssym^.abstyp:=tovar;
                    abssym^.ref:=srsym;
                    symtablestack^.insert(abssym);
@@ -438,7 +420,7 @@ unit pdecl;
                   begin
                     storetokenpos:=tokenpos;
                     tokenpos:=declarepos;
-                    abssym:=new(pabsolutesym,init(s,p));
+                    abssym:=new(pabsolutesym,init(s,tt));
                     s:=pattern;
                     consume(token);
                     abssym^.abstyp:=toasm;
@@ -454,7 +436,7 @@ unit pdecl;
                      begin
                        storetokenpos:=tokenpos;
                        tokenpos:=declarepos;
-                       abssym:=new(pabsolutesym,init(s,p));
+                       abssym:=new(pabsolutesym,init(s,tt));
                        abssym^.abstyp:=toaddr;
                        abssym^.absseg:=false;
                        s:=pattern;
@@ -492,26 +474,23 @@ unit pdecl;
                   s:=sc^.get_with_tokeninfo(tokenpos);
                   if not sc^.empty then
                     Message(parser_e_initialized_only_one_var);
-                  if assigned(readtypesym) then
-                   pconstsym:=new(ptypedconstsym,initsym(s,readtypesym,false))
-                  else
-                   pconstsym:=new(ptypedconstsym,init(s,p,false));
+                  pconstsym:=new(ptypedconstsym,inittype(s,tt,false));
                   symtablestack^.insert(pconstsym);
                   tokenpos:=storetokenpos;
                   consume(_EQUAL);
-                  readtypedconst(p,pconstsym,false);
+                  readtypedconst(tt.def,pconstsym,false);
                   symdone:=true;
                end;
              { for a record there doesn't need to be a ; before the END or ) }
              if not((is_record or is_object) and (token in [_END,_RKLAMMER])) then
                consume(_SEMICOLON);
              { procvar handling }
-             if (p^.deftype=procvardef) and (p^.sym=nil) then
+             if (tt.def^.deftype=procvardef) and (tt.def^.typesym=nil) then
                begin
-                  newtype:=new(ptypesym,init('unnamed',p));
+                  newtype:=new(ptypesym,init('unnamed',tt));
                   parse_var_proc_directives(psym(newtype));
-                  newtype^.definition:=nil;
-                  p^.sym:=nil;
+                  newtype^.restype.def:=nil;
+                  tt.def^.typesym:=nil;
                   dispose(newtype,done);
                end;
              { Check for variable directives }
@@ -574,19 +553,9 @@ unit pdecl;
                    storetokenpos:=tokenpos;
                    tokenpos:=declarepos;
                    if is_dll then
-                    begin
-                      if assigned(readtypesym) then
-                       aktvarsym:=new(pvarsym,initsym_dll(s,readtypesym))
-                      else
-                       aktvarsym:=new(pvarsym,init_dll(s,p))
-                    end
+                    aktvarsym:=new(pvarsym,init_dll(s,tt))
                    else
-                    begin
-                      if assigned(readtypesym) then
-                       aktvarsym:=new(pvarsym,initsym_C(s,C_name,readtypesym))
-                      else
-                       aktvarsym:=new(pvarsym,init_C(s,C_name,p));
-                    end;
+                    aktvarsym:=new(pvarsym,init_C(s,C_name,tt));
                    { set some vars options }
                    if export_aktvarsym then
                     inc(aktvarsym^.refs);
@@ -623,10 +592,7 @@ unit pdecl;
 {$else}
                     current_object_option:=current_object_option+[sp_static];
 {$endif}
-                    if assigned(readtypesym) then
-                     insert_syms(symtablestack,sc,nil,readtypesym,false)
-                    else
-                     insert_syms(symtablestack,sc,p,nil,false);
+                    insert_syms(symtablestack,sc,tt,false);
 {$ifdef INCLUDEOK}
                     exclude(current_object_option,sp_static);
 {$else}
@@ -641,16 +607,13 @@ unit pdecl;
              if not symdone then
                begin
                   if (sp_published in current_object_option) and
-                    (not((p^.deftype=objectdef) and (pobjectdef(p)^.is_class))) then
+                    (not((tt.def^.deftype=objectdef) and (pobjectdef(tt.def)^.is_class))) then
                     Message(parser_e_cant_publish_that)
                   else if (sp_published in current_object_option) and
-                    not(oo_can_have_published in pobjectdef(p)^.objectoptions) then
+                    not(oo_can_have_published in pobjectdef(tt.def)^.objectoptions) then
                     Message(parser_e_only_publishable_classes_can__be_published);
 
-                  if assigned(readtypesym) then
-                   insert_syms(symtablestack,sc,nil,readtypesym,is_threadvar)
-                  else
-                   insert_syms(symtablestack,sc,p,nil,is_threadvar);
+                  insert_syms(symtablestack,sc,tt,is_threadvar)
                end;
            end;
          { Check for Case }
@@ -662,15 +625,15 @@ unit pdecl;
               getsym(s,false);
               { may be only a type: }
               if assigned(srsym) and (srsym^.typ in [typesym,unitsym]) then
-                casedef:=read_type('')
+                read_type(casetype,'')
               else
                 begin
                   consume(_ID);
                   consume(_COLON);
-                  casedef:=read_type('');
-                  symtablestack^.insert(new(pvarsym,init(s,casedef)));
+                  read_type(casetype,'');
+                  symtablestack^.insert(new(pvarsym,init(s,casetype)));
                 end;
-              if not(is_ordinal(casedef)) or is_64bitint(casedef)  then
+              if not(is_ordinal(casetype.def)) or is_64bitint(casetype.def)  then
                Message(type_e_ordinal_expr_expected);
               consume(_OF);
               startvarrec:=symtablestack^.datasize;
@@ -714,7 +677,7 @@ unit pdecl;
       var
          name : stringid;
          p : ptree;
-         def : pdef;
+         tt  : ttype;
          sym : psym;
          storetokenpos,filepos : tfileposinfo;
          old_block_type : tblock_type;
@@ -795,7 +758,7 @@ unit pdecl;
                    block_type:=bt_type;
                    consume(_COLON);
                    ignore_equal:=true;
-                   def:=read_type('');
+                   read_type(tt,'');
                    ignore_equal:=false;
                    block_type:=bt_const;
                    skipequal:=false;
@@ -813,15 +776,12 @@ unit pdecl;
                    else
 {$endif DELPHI_CONST_IN_RODATA}
                      begin
-                       if assigned(readtypesym) then
-                        sym:=new(ptypedconstsym,initsym(name,readtypesym,false))
-                       else
-                        sym:=new(ptypedconstsym,init(name,def,false))
+                       sym:=new(ptypedconstsym,inittype(name,tt,false))
                      end;
                    tokenpos:=storetokenpos;
                    symtablestack^.insert(sym);
                    { procvar can have proc directives }
-                   if (def^.deftype=procvardef) then
+                   if (tt.def^.deftype=procvardef) then
                     begin
                       { support p : procedure;stdcall=nil; }
                       if (token=_SEMICOLON) then
@@ -848,10 +808,10 @@ unit pdecl;
                       consume(_EQUAL);
 {$ifdef DELPHI_CONST_IN_RODATA}
                       if m_delphi in aktmodeswitches then
-                       readtypedconst(def,ptypedconstsym(sym),true)
+                       readtypedconst(tt.def,ptypedconstsym(sym),true)
                       else
 {$endif DELPHI_CONST_IN_RODATA}
-                       readtypedconst(def,ptypedconstsym(sym),false);
+                       readtypedconst(tt.def,ptypedconstsym(sym),false);
                       consume(_SEMICOLON);
                     end;
                 end;
@@ -897,10 +857,10 @@ unit pdecl;
          { Check only typesyms or record/object fields }
          case psym(p)^.typ of
            typesym :
-             pd:=ptypesym(p)^.definition;
+             pd:=ptypesym(p)^.restype.def;
            varsym :
              if (psym(p)^.owner^.symtabletype in [objectsymtable,recordsymtable]) then
-               pd:=pvarsym(p)^.definition
+               pd:=pvarsym(p)^.vartype.def
              else
                exit;
            else
@@ -911,7 +871,7 @@ unit pdecl;
            classrefdef :
              begin
                { classrefdef inherits from pointerdef }
-               hpd:=ppointerdef(pd)^.definition;
+               hpd:=ppointerdef(pd)^.pointertype.def;
                { still a forward def ? }
                if hpd^.deftype=forwarddef then
                 begin
@@ -929,7 +889,7 @@ unit pdecl;
                   if assigned(srsym) and
                      (srsym^.typ=typesym) then
                    begin
-                     ppointerdef(pd)^.definition:=ptypesym(srsym)^.definition;
+                     ppointerdef(pd)^.pointertype.def:=ptypesym(srsym)^.restype.def;
 {$ifdef GDB}
                      if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
                         (psym(p)^.owner^.symtabletype in [globalsymtable,staticsymtable]) then
@@ -940,15 +900,15 @@ unit pdecl;
 {$endif GDB}
                      { we need a class type for classrefdef }
                      if (pd^.deftype=classrefdef) and
-                        not((ptypesym(srsym)^.definition^.deftype=objectdef) and
-                            pobjectdef(ptypesym(srsym)^.definition)^.is_class) then
-                       Message1(type_e_class_type_expected,ptypesym(srsym)^.definition^.typename);
+                        not((ptypesym(srsym)^.restype.def^.deftype=objectdef) and
+                            pobjectdef(ptypesym(srsym)^.restype.def)^.is_class) then
+                       Message1(type_e_class_type_expected,ptypesym(srsym)^.restype.def^.typename);
                    end
                   else
                    begin
                      MessagePos1(psym(p)^.fileinfo,sym_e_forward_type_not_resolved,p^.name);
                      { try to recover }
-                     ppointerdef(pd)^.definition:=generrordef;
+                     ppointerdef(pd)^.pointertype.def:=generrordef;
                    end;
                 end;
              end;
@@ -969,7 +929,7 @@ unit pdecl;
          typename : stringid;
          newtype  : ptypesym;
          sym      : psym;
-         typedef  : pdef;
+         tt       : ttype;
          defpos,storetokenpos : tfileposinfo;
          old_block_type : tblock_type;
       begin
@@ -995,14 +955,14 @@ unit pdecl;
               if (sym^.typ=typesym) then
                begin
                  if (token=_CLASS) and
-                    (assigned(ptypesym(sym)^.definition)) and
-                    (ptypesym(sym)^.definition^.deftype=objectdef) and
-                    pobjectdef(ptypesym(sym)^.definition)^.is_class and
-                    (oo_is_forward in pobjectdef(ptypesym(sym)^.definition)^.objectoptions) then
+                    (assigned(ptypesym(sym)^.restype.def)) and
+                    (ptypesym(sym)^.restype.def^.deftype=objectdef) and
+                    pobjectdef(ptypesym(sym)^.restype.def)^.is_class and
+                    (oo_is_forward in pobjectdef(ptypesym(sym)^.restype.def)^.objectoptions) then
                   begin
                     { we can ignore the result   }
                     { the definition is modified }
-                    object_dec(typename,pobjectdef(ptypesym(sym)^.definition));
+                    object_dec(typename,pobjectdef(ptypesym(sym)^.restype.def));
                     newtype:=ptypesym(sym);
                   end;
                end;
@@ -1010,16 +970,16 @@ unit pdecl;
            { no old type reused ? Then insert this new type }
            if not assigned(newtype) then
             begin
-              typedef:=read_type(typename);
+              read_type(tt,typename);
               storetokenpos:=tokenpos;
               tokenpos:=defpos;
-              newtype:=new(ptypesym,init(typename,typedef));
+              newtype:=new(ptypesym,init(typename,tt));
               newtype:=ptypesym(symtablestack^.insert(newtype));
               tokenpos:=storetokenpos;
             end;
            consume(_SEMICOLON);
-           if assigned(newtype^.definition) and
-              (newtype^.definition^.deftype=procvardef) then
+           if assigned(newtype^.restype.def) and
+              (newtype^.restype.def^.deftype=procvardef) then
              parse_var_proc_directives(psym(newtype));
          until token<>_ID;
          typecanbeforward:=false;
@@ -1200,7 +1160,10 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.172  1999-11-29 15:18:27  pierre
+  Revision 1.173  1999-11-30 10:40:44  peter
+    + ttype, tsymlist
+
+  Revision 1.172  1999/11/29 15:18:27  pierre
    + allow exports in win32 executables
 
   Revision 1.171  1999/11/09 23:43:08  pierre

+ 44 - 41
compiler/pexpr.pas

@@ -132,7 +132,7 @@ unit pexpr;
                  begin
                     p1:=gencallnode(nil,nil);
                     p1^.right:=p;
-                    p1^.resulttype:=pprocvardef(p^.resulttype)^.retdef;
+                    p1^.resulttype:=pprocvardef(p^.resulttype)^.rettype.def;
                     firstpass(p1);
                     p:=p1;
                  end;
@@ -607,7 +607,7 @@ unit pexpr;
       var
          paras : ptree;
          p2 : ptree;
-         plist : ppropsymlist;
+         plist : psymlistitem;
 
       begin
          paras:=nil;
@@ -624,7 +624,7 @@ unit pexpr;
               { indexed property }
               if (ppo_indexed in ppropertysym(sym)^.propoptions) then
                 begin
-                   p2:=genordinalconstnode(ppropertysym(sym)^.index,ppropertysym(sym)^.indexdef);
+                   p2:=genordinalconstnode(ppropertysym(sym)^.index,ppropertysym(sym)^.indextype.def);
                    paras:=gencallparanode(p2,paras);
                 end;
            end;
@@ -635,23 +635,23 @@ unit pexpr;
               { write property: }
               { no result }
               pd:=voiddef;
-              if assigned(ppropertysym(sym)^.writeaccesssym) then
+              if not ppropertysym(sym)^.writeaccess^.empty then
                 begin
-                   case ppropertysym(sym)^.writeaccesssym^.sym^.typ of
+                   case ppropertysym(sym)^.writeaccess^.firstsym^.sym^.typ of
                      procsym :
                        begin
                          { generate the method call }
-                         p1:=genmethodcallnode(pprocsym(ppropertysym(sym)^.writeaccesssym^.sym),st,p1);
+                         p1:=genmethodcallnode(pprocsym(ppropertysym(sym)^.writeaccess^.firstsym^.sym),st,p1);
                          { we know the procedure to call, so
                            force the usage of that procedure }
-                         p1^.procdefinition:=pprocdef(ppropertysym(sym)^.writeaccessdef);
+                         p1^.procdefinition:=pprocdef(ppropertysym(sym)^.writeaccess^.def);
                          p1^.left:=paras;
                          consume(_ASSIGNMENT);
                          { read the expression }
-                         getprocvar:=ppropertysym(sym)^.proptype^.deftype=procvardef;
+                         getprocvar:=ppropertysym(sym)^.proptype.def^.deftype=procvardef;
                          p2:=comp_expr(true);
                          if getprocvar then
-                           handle_procvar(pprocvardef(ppropertysym(sym)^.proptype),p2);
+                           handle_procvar(pprocvardef(ppropertysym(sym)^.proptype.def),p2);
                          p1^.left:=gencallparanode(p2,p1^.left);
                          p1^.isproperty:=true;
                          getprocvar:=false;
@@ -661,7 +661,7 @@ unit pexpr;
                          if assigned(paras) then
                            message(parser_e_no_paras_allowed);
                          { subscribed access? }
-                         plist:=ppropertysym(sym)^.writeaccesssym;
+                         plist:=ppropertysym(sym)^.writeaccess^.firstsym;
                          while assigned(plist) do
                           begin
                             if p1=nil then
@@ -692,16 +692,16 @@ unit pexpr;
          else
            begin
               { read property: }
-              pd:=ppropertysym(sym)^.proptype;
-              if assigned(ppropertysym(sym)^.readaccesssym) then
+              pd:=ppropertysym(sym)^.proptype.def;
+              if not ppropertysym(sym)^.readaccess^.empty then
                 begin
-                   case ppropertysym(sym)^.readaccesssym^.sym^.typ of
+                   case ppropertysym(sym)^.readaccess^.firstsym^.sym^.typ of
                      varsym :
                        begin
                           if assigned(paras) then
                             message(parser_e_no_paras_allowed);
                           { subscribed access? }
-                          plist:=ppropertysym(sym)^.readaccesssym;
+                          plist:=ppropertysym(sym)^.readaccess^.firstsym;
                           while assigned(plist) do
                            begin
                              if p1=nil then
@@ -715,10 +715,10 @@ unit pexpr;
                      procsym :
                        begin
                           { generate the method call }
-                          p1:=genmethodcallnode(pprocsym(ppropertysym(sym)^.readaccesssym^.sym),st,p1);
+                          p1:=genmethodcallnode(pprocsym(ppropertysym(sym)^.readaccess^.firstsym^.sym),st,p1);
                           { we know the procedure to call, so
                             force the usage of that procedure }
-                          p1^.procdefinition:=pprocdef(ppropertysym(sym)^.readaccessdef);
+//                          p1^.procdefinition:=pprocdef(ppropertysym(sym)^.readaccess^.def);
                           { insert paras }
                           p1^.left:=paras;
                           p1^.isproperty:=true;
@@ -822,7 +822,7 @@ unit pexpr;
                         end
                       else
                         p1:=gensubscriptnode(pvarsym(sym),p1);
-                      pd:=pvarsym(sym)^.definition;
+                      pd:=pvarsym(sym)^.vartype.def;
                    end;
                  propertysym:
                    begin
@@ -880,7 +880,7 @@ unit pexpr;
                   ((pfuncretsym(sym)=p^.resultfuncretsym) or
                    ((pfuncretsym(sym)=p^.funcretsym) or
                     ((pvarsym(sym)=opsym) and ((p^.flags and pi_operator)<>0))) and
-                   (p^.retdef<>pdef(voiddef)) and
+                   (p^.returntype.def<>pdef(voiddef)) and
                    (token<>_LKLAMMER) and
                    (not ((m_tp in aktmodeswitches) and (afterassignment or in_args)))
                   ) then
@@ -889,9 +889,9 @@ unit pexpr;
                        ((p^.flags and pi_operator)<>0)) then
                        inc(opsym^.refs);
                     p1:=genzeronode(funcretn);
-                    pd:=p^.retdef;
+                    pd:=p^.returntype.def;
                     p1^.funcretprocinfo:=p;
-                    p1^.retdef:=pd;
+                    p1^.rettype.def:=pd;
                     is_func_ret:=true;
                     if p^.funcret_state=vs_declared then
                       begin
@@ -967,7 +967,7 @@ unit pexpr;
                      case srsym^.typ of
               absolutesym : begin
                               p1:=genloadnode(pvarsym(srsym),srsymtable);
-                              pd:=pabsolutesym(srsym)^.definition;
+                              pd:=pabsolutesym(srsym)^.vartype.def;
                             end;
                    varsym : begin
                               { are we in a class method ? }
@@ -987,15 +987,15 @@ unit pexpr;
                                  { set special between first loaded until checked in firstpass }
                                  pvarsym(srsym)^.varstate:=vs_declared_and_first_found;
                                end;
-                              pd:=pvarsym(srsym)^.definition;
+                              pd:=pvarsym(srsym)^.vartype.def;
                             end;
             typedconstsym : begin
                               p1:=gentypedconstloadnode(ptypedconstsym(srsym),srsymtable);
-                              pd:=ptypedconstsym(srsym)^.definition;
+                              pd:=ptypedconstsym(srsym)^.typedconsttype.def;
                             end;
                    syssym : p1:=statement_syssym(psyssym(srsym)^.number,pd);
                   typesym : begin
-                              pd:=ptypesym(srsym)^.definition;
+                              pd:=ptypesym(srsym)^.restype.def;
                               if not assigned(pd) then
                                begin
                                  pd:=generrordef;
@@ -1118,7 +1118,7 @@ unit pexpr;
                               pd:=p1^.resulttype;
                             end;
                  constsym : begin
-                              case pconstsym(srsym)^.consttype of
+                              case pconstsym(srsym)^.consttyp of
                                 constint :
                                   p1:=genordinalconstnode(pconstsym(srsym)^.value,s32bitdef);
                                 conststring :
@@ -1139,13 +1139,13 @@ unit pexpr;
                                   p1:=genordinalconstnode(pconstsym(srsym)^.value,booldef);
                                 constset :
                                   p1:=gensetconstnode(pconstset(pconstsym(srsym)^.value),
-                                        psetdef(pconstsym(srsym)^.definition));
+                                        psetdef(pconstsym(srsym)^.consttype.def));
                                 constord :
                                   p1:=genordinalconstnode(pconstsym(srsym)^.value,
-                                        pconstsym(srsym)^.definition);
+                                        pconstsym(srsym)^.consttype.def);
                                 constpointer :
                                   p1:=genpointerconstnode(pconstsym(srsym)^.value,
-                                        pconstsym(srsym)^.definition);
+                                        pconstsym(srsym)^.consttype.def);
                                 constnil :
                                   p1:=genzeronode(niln);
                                 constresourcestring:
@@ -1333,7 +1333,7 @@ unit pexpr;
                     else
                       begin
                          p1:=gensinglenode(derefn,p1);
-                         pd:=ppointerdef(pd)^.definition;
+                         pd:=ppointerdef(pd)^.pointertype.def;
                       end;
                   end;
 
@@ -1362,7 +1362,7 @@ unit pexpr;
                                 begin
                                    p2:=comp_expr(true);
                                    p1:=gennode(vecn,p1,p2);
-                                   pd:=ppointerdef(pd)^.definition;
+                                   pd:=ppointerdef(pd)^.pointertype.def;
                                  end;
 
                      stringdef : begin
@@ -1400,7 +1400,7 @@ unit pexpr;
                                      end
                                    else
                                      p1:=gennode(vecn,p1,p2);
-                                   pd:=parraydef(pd)^.definition;
+                                   pd:=parraydef(pd)^.elementtype.def;
                                  end;
                           else
                             begin
@@ -1424,7 +1424,7 @@ unit pexpr;
                       (m_autoderef in aktmodeswitches) then
                       begin
                          p1:=gensinglenode(derefn,p1);
-                         pd:=ppointerdef(pd)^.definition;
+                         pd:=ppointerdef(pd)^.pointertype.def;
                       end;
                     case pd^.deftype of
                        recorddef:
@@ -1439,14 +1439,14 @@ unit pexpr;
                             else
                               begin
                                 p1:=gensubscriptnode(sym,p1);
-                                pd:=sym^.definition;
+                                pd:=sym^.vartype.def;
                               end;
                             consume(_ID);
                           end;
 
                         classrefdef:
                           begin
-                             classh:=pobjectdef(pclassrefdef(pd)^.definition);
+                             classh:=pobjectdef(pclassrefdef(pd)^.pointertype.def);
                              sym:=nil;
                              while assigned(classh) do
                               begin
@@ -1482,7 +1482,7 @@ unit pexpr;
                          pointerdef:
                            begin
                              Message(cg_e_invalid_qualifier);
-                             if ppointerdef(pd)^.definition^.deftype in [recorddef,objectdef,classrefdef] then
+                             if ppointerdef(pd)^.pointertype.def^.deftype in [recorddef,objectdef,classrefdef] then
                               Message(parser_h_maybe_deref_caret_missing);
                            end;
                     else
@@ -1522,7 +1522,7 @@ unit pexpr;
                                    p1^.left:=parse_paras(false,false);
                                    consume(_RKLAMMER);
                                 end;
-                              pd:=pprocvardef(pd)^.retdef;
+                              pd:=pprocvardef(pd)^.rettype.def;
                            { proc():= is never possible }
                               if token=_ASSIGNMENT then
                                begin
@@ -1585,8 +1585,8 @@ unit pexpr;
                  else
                   if token=_RKLAMMER then
                    begin
-                     if (ppointerdef(pd)^.definition^.deftype=objectdef) and
-                        (oo_has_vmt in pobjectdef(ppointerdef(pd)^.definition)^.objectoptions)  then
+                     if (ppointerdef(pd)^.pointertype.def^.deftype=objectdef) and
+                        (oo_has_vmt in pobjectdef(ppointerdef(pd)^.pointertype.def)^.objectoptions)  then
                       Message(parser_w_use_extended_syntax_for_objects);
                      p1:=gensinglenode(newn,nil);
                      p1^.resulttype:=pd2;
@@ -1596,11 +1596,11 @@ unit pexpr;
                    begin
                      disposetree(p1);
                      p1:=genzeronode(hnewn);
-                     p1^.resulttype:=ppointerdef(pd)^.definition;
+                     p1^.resulttype:=ppointerdef(pd)^.pointertype.def;
                      consume(_COMMA);
                      afterassignment:=false;
                      { determines the current object defintion }
-                     classh:=pobjectdef(ppointerdef(pd)^.definition);
+                     classh:=pobjectdef(ppointerdef(pd)^.pointertype.def);
                      if classh^.deftype<>objectdef then
                       Message(parser_e_pointer_to_class_expected)
                      else
@@ -2098,7 +2098,10 @@ _LECKKLAMMER : begin
 end.
 {
   $Log$
-  Revision 1.161  1999-11-18 15:34:47  pierre
+  Revision 1.162  1999-11-30 10:40:44  peter
+    + ttype, tsymlist
+
+  Revision 1.161  1999/11/18 15:34:47  pierre
     * Notes/Hints for local syms changed to
       Set_varstate function
 

+ 5 - 2
compiler/pmodules.pas

@@ -910,7 +910,7 @@ unit pmodules;
         { set some informations about the main program }
         with procinfo^ do
          begin
-           retdef:=voiddef;
+           returntype.setdef(voiddef);
            _class:=nil;
            call_offset:=8;
            framepointer:=frame_pointer;
@@ -1557,7 +1557,10 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.174  1999-11-29 16:24:52  pierre
+  Revision 1.175  1999-11-30 10:40:44  peter
+    + ttype, tsymlist
+
+  Revision 1.174  1999/11/29 16:24:52  pierre
    * bug in previous commit corrected
 
   Revision 1.173  1999/11/29 15:18:27  pierre

+ 7 - 4
compiler/popt386.pas

@@ -492,7 +492,7 @@ Begin
                            ((Paicpu(hp2)^.opcode = A_LEAVE) Or
                             (Paicpu(hp2)^.opcode = A_RET)) And
                            (Paicpu(p)^.oper[0].ref^.Base = procinfo^.FramePointer) And
-                           (Paicpu(p)^.oper[0].ref^.Offset >= procinfo^.RetOffset) And
+                           (Paicpu(p)^.oper[0].ref^.Offset >= procinfo^.Return_Offset) And
                            (Paicpu(p)^.oper[0].ref^.Index = R_NO)
                           Then
                             Begin
@@ -883,7 +883,7 @@ Begin
                                   (Paicpu(hp1)^.opcode = A_RET)) And
                                  (Paicpu(p)^.oper[1].typ = top_ref) And
                                  (Paicpu(p)^.oper[1].ref^.base = procinfo^.FramePointer) And
-                                 (Paicpu(p)^.oper[1].ref^.offset >= procinfo^.RetOffset) And
+                                 (Paicpu(p)^.oper[1].ref^.offset >= procinfo^.Return_Offset) And
                                  (Paicpu(p)^.oper[1].ref^.index = R_NO) And
                                  (Paicpu(p)^.oper[0].typ = top_reg)
                                 Then
@@ -1439,7 +1439,7 @@ Begin
                       (Paicpu(hp2)^.opcode = A_RET)) And
                      (Paicpu(p)^.oper[0].ref^.Base = procinfo^.FramePointer) And
                      (Paicpu(p)^.oper[0].ref^.Index = R_NO) And
-                     (Paicpu(p)^.oper[0].ref^.Offset >= procinfo^.RetOffset) And
+                     (Paicpu(p)^.oper[0].ref^.Offset >= procinfo^.Return_Offset) And
                      (hp1^.typ = ait_instruction) And
                      (Paicpu(hp1)^.opcode = A_MOV) And
                      (Paicpu(hp1)^.opsize = S_B) And
@@ -1728,7 +1728,10 @@ End.
 
 {
  $Log$
- Revision 1.71  1999-11-27 23:47:55  jonas
+ Revision 1.72  1999-11-30 10:40:45  peter
+   + ttype, tsymlist
+
+ Revision 1.71  1999/11/27 23:47:55  jonas
    + change "mov var,reg; add/shr/... x,reg; mov reg,var" to
      "add/shr/... x,var" (if x is a const or reg, suggestion from Peter)
      Enable with -dfoldArithOps

+ 6 - 3
compiler/ppu.pas

@@ -45,9 +45,9 @@ const
 {$endif ORDERSOURCES}
 {$else newcg}
 {$ifdef ORDERSOURCES}
-  CurrentPPUVersion=18;
+  CurrentPPUVersion=19;
 {$else ORDERSOURCES}
-  CurrentPPUVersion=17;
+  CurrentPPUVersion=18;
 {$endif ORDERSOURCES}
 {$endif newcg}
 
@@ -994,7 +994,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.51  1999-11-23 09:42:38  peter
+  Revision 1.52  1999-11-30 10:40:45  peter
+    + ttype, tsymlist
+
+  Revision 1.51  1999/11/23 09:42:38  peter
     * makefile updates to work with new fpcmake
 
   Revision 1.50  1999/11/21 01:42:37  pierre

+ 41 - 45
compiler/pstatmnt.pas

@@ -370,7 +370,7 @@ unit pstatmnt;
     function _with_statement : ptree;
 
       var
-         right,hp,p : ptree;
+         right,p,hp : ptree;
          i,levelcount : longint;
          withsymtable,symtab : psymtable;
          obj : pobjectdef;
@@ -432,11 +432,7 @@ unit pstatmnt;
             if token=_COMMA then
              begin
                consume(_COMMA);
-             {$ifdef tp}
-               right:=_with_statement;
-             {$else}
-               right:=_with_statement();
-             {$endif}
+               right:=_with_statement{$ifndef tp}(){$endif};
              end
             else
              begin
@@ -457,11 +453,7 @@ unit pstatmnt;
             if token=_COMMA then
              begin
                consume(_COMMA);
-             {$ifdef tp}
-               hp:=_with_statement;
-             {$else}
-               hp:=_with_statement();
-             {$endif}
+               hp:=_with_statement{$ifndef tp}(){$endif};
              end
             else
              begin
@@ -585,18 +577,18 @@ unit pstatmnt;
                                     consume(_ID);
                                  end;
                                if (srsym^.typ=typesym) and
-                                 (ptypesym(srsym)^.definition^.deftype=objectdef) and
-                                 pobjectdef(ptypesym(srsym)^.definition)^.is_class then
-                                 ot:=pobjectdef(ptypesym(srsym)^.definition)
+                                 (ptypesym(srsym)^.restype.def^.deftype=objectdef) and
+                                 pobjectdef(ptypesym(srsym)^.restype.def)^.is_class then
+                                 ot:=pobjectdef(ptypesym(srsym)^.restype.def)
                                else
                                  begin
                                     ot:=pobjectdef(generrordef);
                                     if (srsym^.typ=typesym) then
-                                      Message1(type_e_class_type_expected,ptypesym(srsym)^.definition^.typename)
+                                      Message1(type_e_class_type_expected,ptypesym(srsym)^.restype.def^.typename)
                                     else
                                       Message1(type_e_class_type_expected,ot^.typename);
                                  end;
-                               sym:=new(pvarsym,init(objname,ot));
+                               sym:=new(pvarsym,initdef(objname,ot));
                                exceptsymtable:=new(psymtable,init(stt_exceptsymtable));
                                exceptsymtable^.insert(sym);
                                { insert the exception symtable stack }
@@ -613,14 +605,14 @@ unit pstatmnt;
                                     consume(_ID);
                                  end;
                                if (srsym^.typ=typesym) and
-                                 (ptypesym(srsym)^.definition^.deftype=objectdef) and
-                                 pobjectdef(ptypesym(srsym)^.definition)^.is_class then
-                                 ot:=pobjectdef(ptypesym(srsym)^.definition)
+                                 (ptypesym(srsym)^.restype.def^.deftype=objectdef) and
+                                 pobjectdef(ptypesym(srsym)^.restype.def)^.is_class then
+                                 ot:=pobjectdef(ptypesym(srsym)^.restype.def)
                                else
                                  begin
                                     ot:=pobjectdef(generrordef);
                                     if (srsym^.typ=typesym) then
-                                      Message1(type_e_class_type_expected,ptypesym(srsym)^.definition^.typename)
+                                      Message1(type_e_class_type_expected,ptypesym(srsym)^.restype.def^.typename)
                                     else
                                       Message1(type_e_class_type_expected,ot^.typename);
                                  end;
@@ -692,13 +684,13 @@ unit pstatmnt;
               consume(_RKLAMMER);
               if (block_type=bt_except) then
                 Message(parser_e_exit_with_argument_not__possible);
-              if procinfo^.retdef=pdef(voiddef) then
+              if procinfo^.returntype.def=pdef(voiddef) then
                 Message(parser_e_void_function);
            end
          else
            p:=nil;
          p:=gensinglenode(exitn,p);
-         p^.resulttype:=procinfo^.retdef;
+         p^.resulttype:=procinfo^.returntype.def;
          exit_statement:=p;
       end;
 
@@ -874,7 +866,7 @@ unit pstatmnt;
                         exit;
                      end;
                    { first parameter must be an object or class }
-                   if ppointerdef(pd)^.definition^.deftype<>objectdef then
+                   if ppointerdef(pd)^.pointertype.def^.deftype<>objectdef then
                      begin
                         Message(parser_e_pointer_to_class_expected);
                         new_dispose_statement:=factor(false);
@@ -883,7 +875,7 @@ unit pstatmnt;
                         exit;
                      end;
                    { check, if the first parameter is a pointer to a _class_ }
-                   classh:=pobjectdef(ppointerdef(pd)^.definition);
+                   classh:=pobjectdef(ppointerdef(pd)^.pointertype.def);
                    if classh^.is_class then
                      begin
                         Message(parser_e_no_new_or_dispose_for_classes);
@@ -911,7 +903,7 @@ unit pstatmnt;
                            if ht=_NEW then
                                  begin
                                     { Constructors can take parameters.}
-                                    p2^.resulttype:=ppointerdef(pd)^.definition;
+                                    p2^.resulttype:=ppointerdef(pd)^.pointertype.def;
                                     do_member_read(false,sym,p2,pd,again);
                                  end
                            else
@@ -949,11 +941,11 @@ unit pstatmnt;
                  end
                else
                  begin
-                    if (ppointerdef(p^.resulttype)^.definition^.deftype=objectdef) and
-                       (oo_has_vmt in pobjectdef(ppointerdef(p^.resulttype)^.definition)^.objectoptions) then
+                    if (ppointerdef(p^.resulttype)^.pointertype.def^.deftype=objectdef) and
+                       (oo_has_vmt in pobjectdef(ppointerdef(p^.resulttype)^.pointertype.def)^.objectoptions) then
                       Message(parser_w_use_extended_syntax_for_objects);
-                    if (ppointerdef(p^.resulttype)^.definition^.deftype=orddef) and
-                       (porddef(ppointerdef(p^.resulttype)^.definition)^.typ=uvoid) then
+                    if (ppointerdef(p^.resulttype)^.pointertype.def^.deftype=orddef) and
+                       (porddef(ppointerdef(p^.resulttype)^.pointertype.def)^.typ=uvoid) then
                       if (m_tp in aktmodeswitches) or
                          (m_delphi in aktmodeswitches) then
                        Message(parser_w_no_new_dispose_on_void_pointers)
@@ -1151,7 +1143,7 @@ unit pstatmnt;
          storepos : tfileposinfo;
 
       begin
-         if procinfo^.retdef<>pdef(voiddef) then
+         if procinfo^.returntype.def<>pdef(voiddef) then
            begin
               { if the current is a function aktprocsym is non nil }
               { and there is a local symtable set }
@@ -1161,8 +1153,8 @@ unit pstatmnt;
               { insert in local symtable }
               symtablestack^.insert(funcretsym);
               tokenpos:=storepos;
-              if ret_in_acc(procinfo^.retdef) or (procinfo^.retdef^.deftype=floatdef) then
-                procinfo^.retoffset:=-funcretsym^.address;
+              if ret_in_acc(procinfo^.returntype.def) or (procinfo^.returntype.def^.deftype=floatdef) then
+                procinfo^.return_offset:=-funcretsym^.address;
               procinfo^.funcretsym:=funcretsym;
               { insert result also if support is on }
               if (m_result in aktmodeswitches) then
@@ -1175,16 +1167,17 @@ unit pstatmnt;
 
          { temporary space is set, while the BEGIN of the procedure }
          if (symtablestack^.symtabletype=localsymtable) then
-           procinfo^.firsttemp := -symtablestack^.datasize
-         else procinfo^.firsttemp := 0;
+           procinfo^.firsttemp_offset := -symtablestack^.datasize
+         else
+           procinfo^.firsttemp_offset := 0;
 
          { space for the return value }
          { !!!!!   this means that we can not set the return value
          in a subfunction !!!!! }
          { because we don't know yet where the address is }
-         if procinfo^.retdef<>pdef(voiddef) then
+         if procinfo^.returntype.def<>pdef(voiddef) then
            begin
-              if ret_in_acc(procinfo^.retdef) or (procinfo^.retdef^.deftype=floatdef) then
+              if ret_in_acc(procinfo^.returntype.def) or (procinfo^.returntype.def^.deftype=floatdef) then
               { if (procinfo^.retdef^.deftype=orddef) or
                  (procinfo^.retdef^.deftype=pointerdef) or
                  (procinfo^.retdef^.deftype=enumdef) or
@@ -1196,17 +1189,17 @@ unit pstatmnt;
                  ) then  }
                 begin
                    { the space has been set in the local symtable }
-                   procinfo^.retoffset:=-funcretsym^.address;
+                   procinfo^.return_offset:=-funcretsym^.address;
                    if ((procinfo^.flags and pi_operator)<>0) and
                      assigned(opsym) then
                      {opsym^.address:=procinfo^.call_offset; is wrong PM }
-                     opsym^.address:=-procinfo^.retoffset;
+                     opsym^.address:=-procinfo^.return_offset;
                    { eax is modified by a function }
 {$ifndef newcg}
 {$ifdef i386}
                    usedinproc:=usedinproc or ($80 shr byte(R_EAX));
 
-                   if is_64bitint(procinfo^.retdef) then
+                   if is_64bitint(procinfo^.returntype.def) then
                      usedinproc:=usedinproc or ($80 shr byte(R_EDX))
 {$endif}
 {$ifdef m68k}
@@ -1264,15 +1257,15 @@ unit pstatmnt;
          read_declarations(false);
          { temporary space is set, while the BEGIN of the procedure }
          if symtablestack^.symtabletype=localsymtable then
-           procinfo^.firsttemp := -symtablestack^.datasize
+           procinfo^.firsttemp_offset := -symtablestack^.datasize
          else
-           procinfo^.firsttemp := 0;
+           procinfo^.firsttemp_offset := 0;
 
          { assembler code does not allocate }
          { space for the return value       }
-          if procinfo^.retdef<>pdef(voiddef) then
+          if procinfo^.returntype.def<>pdef(voiddef) then
            begin
-              if ret_in_acc(procinfo^.retdef) then
+              if ret_in_acc(procinfo^.returntype.def) then
                 begin
                    { in assembler code the result should be directly in %eax
                    procinfo^.retoffset:=procinfo^.firsttemp-procinfo^.retdef^.size;
@@ -1303,7 +1296,7 @@ unit pstatmnt;
               (po_assembler in aktprocsym^.definition^.procoptions) and
               (aktprocsym^.definition^.localst^.datasize=0) and
               (aktprocsym^.definition^.parast^.datasize=0) and
-              not(ret_in_param(aktprocsym^.definition^.retdef)) then
+              not(ret_in_param(aktprocsym^.definition^.rettype.def)) then
              begin
                procinfo^.framepointer:=stack_pointer;
                { set the right value for parameters }
@@ -1323,7 +1316,10 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.112  1999-11-20 01:19:10  pierre
+  Revision 1.113  1999-11-30 10:40:45  peter
+    + ttype, tsymlist
+
+  Revision 1.112  1999/11/20 01:19:10  pierre
     * DLL index used for win32 target with DEF file
     + DLL initialization/finalization support
 

+ 36 - 30
compiler/psub.pas

@@ -134,7 +134,7 @@ begin
      procstartfilepos:=tokenpos;
      { qualifier is class name ? }
      if (sym^.typ<>typesym) or
-        (ptypesym(sym)^.definition^.deftype<>objectdef) then
+        (ptypesym(sym)^.restype.def^.deftype<>objectdef) then
        begin
           Message(parser_e_class_id_expected);
           aktprocsym:=nil;
@@ -143,8 +143,8 @@ begin
      else
        begin
           { used to allow private syms to be seen }
-          aktobjectdef:=pobjectdef(ptypesym(sym)^.definition);
-          procinfo^._class:=pobjectdef(ptypesym(sym)^.definition);
+          aktobjectdef:=pobjectdef(ptypesym(sym)^.restype.def);
+          procinfo^._class:=pobjectdef(ptypesym(sym)^.restype.def);
           aktprocsym:=pprocsym(procinfo^._class^.symtable^.search(sp));
           consume(_ID);
           {The procedure has been found. So it is
@@ -392,7 +392,7 @@ begin
                     begin
                       consume(_COLON);
                       inc(testcurobject);
-                      aktprocsym^.definition^.retdef:=single_type(hs,false);
+                      single_type(aktprocsym^.definition^.rettype,hs,false);
                       aktprocsym^.definition^.test_if_fpu_result;
                       dec(testcurobject);
                     end;
@@ -400,7 +400,7 @@ begin
     _PROCEDURE : begin
                    consume(_PROCEDURE);
                    parse_proc_head(potype_none);
-                   aktprocsym^.definition^.retdef:=voiddef;
+                   aktprocsym^.definition^.rettype.def:=voiddef;
                  end;
   _CONSTRUCTOR : begin
                    consume(_CONSTRUCTOR);
@@ -409,23 +409,23 @@ begin
                       procinfo^._class^.is_class then
                     begin
                       { CLASS constructors return the created instance }
-                      aktprocsym^.definition^.retdef:=procinfo^._class;
+                      aktprocsym^.definition^.rettype.def:=procinfo^._class;
                     end
                    else
                     begin
                       { OBJECT constructors return a boolean }
 {$IfDef GDB}
                       { GDB doesn't like unnamed types !}
-                      aktprocsym^.definition^.retdef:=globaldef('boolean');
+                      aktprocsym^.definition^.rettype.def:=globaldef('boolean');
 {$else GDB}
-                      aktprocsym^.definition^.retdef:=new(porddef,init(bool8bit,0,1));
+                      aktprocsym^.definition^.rettype.def:=new(porddef,init(bool8bit,0,1));
 {$Endif GDB}
                     end;
                  end;
    _DESTRUCTOR : begin
                    consume(_DESTRUCTOR);
                    parse_proc_head(potype_destructor);
-                   aktprocsym^.definition^.retdef:=voiddef;
+                   aktprocsym^.definition^.rettype.def:=voiddef;
                  end;
      _OPERATOR : begin
                    if lexlevel>normal_function_level then
@@ -445,27 +445,26 @@ begin
                      end
                    else
                      begin
-                       opsym:=new(pvarsym,init(pattern,voiddef));
+                       opsym:=new(pvarsym,initdef(pattern,voiddef));
                        consume(_ID);
                      end;
                    if not try_to_consume(_COLON) then
                      begin
                        consume(_COLON);
-                       aktprocsym^.definition^.retdef:=generrordef;
+                       aktprocsym^.definition^.rettype.def:=generrordef;
                        consume_all_until(_SEMICOLON);
                      end
                    else
                     begin
-                      aktprocsym^.definition^.retdef:=
-                       single_type(hs,false);
+                      single_type(aktprocsym^.definition^.rettype,hs,false);
                       aktprocsym^.definition^.test_if_fpu_result;
                       if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and
-                         ((aktprocsym^.definition^.retdef^.deftype<>
+                         ((aktprocsym^.definition^.rettype.def^.deftype<>
                          orddef) or (porddef(aktprocsym^.definition^.
-                         retdef)^.typ<>bool8bit)) then
+                         rettype.def)^.typ<>bool8bit)) then
                         Message(parser_e_comparative_operator_return_boolean);
                        if assigned(opsym) then
-                         opsym^.definition:=aktprocsym^.definition^.retdef;
+                         opsym^.vartype.def:=aktprocsym^.definition^.rettype.def;
                        { We need to add the retrun type in the mangledname
                          to allow overloading with just different results !! (PM) }
                        aktprocsym^.definition^.setmangledname(
@@ -1196,7 +1195,7 @@ begin
               (equal_paras(aktprocsym^.definition^.para,pd^.nextoverloaded^.para,false) and
               { for operators equal_paras is not enough !! }
               ((aktprocsym^.definition^.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
-               is_equal(pd^.nextoverloaded^.retdef,aktprocsym^.definition^.retdef))) then
+               is_equal(pd^.nextoverloaded^.rettype.def,aktprocsym^.definition^.rettype.def))) then
              begin
                if pd^.nextoverloaded^.forwarddef then
                { remove the forward definition  but don't delete it,      }
@@ -1205,7 +1204,7 @@ begin
                    hd:=pd^.nextoverloaded;
                  { Check if the procedure type and return type are correct }
                    if (hd^.proctypeoption<>aktprocsym^.definition^.proctypeoption) or
-                      (not(is_equal(hd^.retdef,aktprocsym^.definition^.retdef)) and
+                      (not(is_equal(hd^.rettype.def,aktprocsym^.definition^.rettype.def)) and
                       (m_repeat_forward in aktmodeswitches)) then
                      begin
                        Message1(parser_e_header_dont_match_forward,aktprocsym^.demangledName);
@@ -1342,7 +1341,7 @@ begin
   if ((procinfo^.flags and pi_operator)<>0) and assigned(opsym)
      and not parse_only then
     begin
-      if ret_in_param(aktprocsym^.definition^.retdef) then
+      if ret_in_param(aktprocsym^.definition^.rettype.def) then
         begin
           pprocdef(aktprocsym^.definition)^.parast^.insert(opsym);
         { this increases the data size }
@@ -1492,9 +1491,9 @@ begin
    { but only if the are no local variables           }
    { already done in assembler_block }
 {$ifdef newcg}
-   tg.setfirsttemp(procinfo^.firsttemp);
+   tg.setfirsttemp(procinfo^.firsttemp_offset);
 {$else newcg}
-   setfirsttemp(procinfo^.firsttemp);
+   setfirsttemp(procinfo^.firsttemp_offset);
 {$endif newcg}
 
    { ... and generate assembler }
@@ -1711,11 +1710,11 @@ begin
   aktprocsym:=new(pprocsym,init(sym^.name));
   case sym^.typ of
     varsym :
-      pd:=pabstractprocdef(pvarsym(sym)^.definition);
+      pd:=pabstractprocdef(pvarsym(sym)^.vartype.def);
     typedconstsym :
-      pd:=pabstractprocdef(ptypedconstsym(sym)^.definition);
+      pd:=pabstractprocdef(ptypedconstsym(sym)^.typedconsttype.def);
     typesym :
-      pd:=pabstractprocdef(ptypesym(sym)^.definition);
+      pd:=pabstractprocdef(ptypesym(sym)^.restype.def);
     else
       internalerror(994932432);
   end;
@@ -1760,11 +1759,15 @@ begin
         s:=Copy(name,4,255);
         if not(po_assembler in aktprocsym^.definition^.procoptions) then
          begin
-           vs:=new(Pvarsym,init(s,definition));
+           vs:=new(Pvarsym,initdef(s,vartype.def));
            vs^.fileinfo:=fileinfo;
            vs^.varspez:=varspez;
            aktprocsym^.definition^.localst^.insert(vs);
-           vs^.islocalcopy:=true;
+{$ifdef INCLUDEOK}
+           include(vs^.varoptions,vo_is_local_copy);
+{$else}
+           vs^.varoptions:=vs^.varoptions+[vo_is_local_copy];
+{$endif}
            vs^.varstate:=vs_assigned;
            localvarsym:=vs;
            inc(refs); { the para was used to set the local copy ! }
@@ -1872,12 +1875,12 @@ begin
 
 { set return type here, becuase the aktprocsym^.definition can be
   changed by check_identical (PFV) }
-   procinfo^.retdef:=aktprocsym^.definition^.retdef;
+   procinfo^.returntype.def:=aktprocsym^.definition^.rettype.def;
 
    { pointer to the return value ? }
-   if ret_in_param(procinfo^.retdef) then
+   if ret_in_param(procinfo^.returntype.def) then
     begin
-      procinfo^.retoffset:=procinfo^.call_offset;
+      procinfo^.return_offset:=procinfo^.call_offset;
       inc(procinfo^.call_offset,target_os.size_of_pointer);
     end;
    { allows to access the parameters of main functions in nested functions }
@@ -1938,7 +1941,10 @@ end.
 
 {
   $Log$
-  Revision 1.36  1999-11-22 00:23:09  pierre
+  Revision 1.37  1999-11-30 10:40:48  peter
+    + ttype, tsymlist
+
+  Revision 1.36  1999/11/22 00:23:09  pierre
    * also complain about unused functions in program
 
   Revision 1.35  1999/11/17 17:05:02  pierre

+ 66 - 64
compiler/psystem.pas

@@ -79,74 +79,73 @@ var
   vmtsymtable : psymtable;
 begin
 { Internal types }
-  p^.insert(new(ptypesym,init('formal',cformaldef)));
-  p^.insert(new(ptypesym,init('void',voiddef)));
-  p^.insert(new(ptypesym,init('byte',u8bitdef)));
-  p^.insert(new(ptypesym,init('word',u16bitdef)));
-  p^.insert(new(ptypesym,init('ulong',u32bitdef)));
-  p^.insert(new(ptypesym,init('longint',s32bitdef)));
-  p^.insert(new(ptypesym,init('qword',cu64bitdef)));
-  p^.insert(new(ptypesym,init('int64',cs64bitdef)));
-  p^.insert(new(ptypesym,init('char',cchardef)));
-  p^.insert(new(ptypesym,init('shortstring',cshortstringdef)));
-  p^.insert(new(ptypesym,init('longstring',clongstringdef)));
-  p^.insert(new(ptypesym,init('ansistring',cansistringdef)));
-  p^.insert(new(ptypesym,init('widestring',cwidestringdef)));
-  p^.insert(new(ptypesym,init('openshortstring',openshortstringdef)));
-  p^.insert(new(ptypesym,init('boolean',booldef)));
-  p^.insert(new(ptypesym,init('void_pointer',voidpointerdef)));
-  p^.insert(new(ptypesym,init('char_pointer',charpointerdef)));
-  p^.insert(new(ptypesym,init('void_farpointer',voidfarpointerdef)));
-  p^.insert(new(ptypesym,init('openchararray',openchararraydef)));
-  p^.insert(new(ptypesym,init('file',cfiledef)));
-  p^.insert(new(ptypesym,init('s32real',s32floatdef)));
-  p^.insert(new(ptypesym,init('s64real',s64floatdef)));
-  p^.insert(new(ptypesym,init('s80real',s80floatdef)));
-  p^.insert(new(ptypesym,init('s32fixed',s32fixeddef)));
+  p^.insert(new(ptypesym,initdef('formal',cformaldef)));
+  p^.insert(new(ptypesym,initdef('void',voiddef)));
+  p^.insert(new(ptypesym,initdef('byte',u8bitdef)));
+  p^.insert(new(ptypesym,initdef('word',u16bitdef)));
+  p^.insert(new(ptypesym,initdef('ulong',u32bitdef)));
+  p^.insert(new(ptypesym,initdef('longint',s32bitdef)));
+  p^.insert(new(ptypesym,initdef('qword',cu64bitdef)));
+  p^.insert(new(ptypesym,initdef('int64',cs64bitdef)));
+  p^.insert(new(ptypesym,initdef('char',cchardef)));
+  p^.insert(new(ptypesym,initdef('shortstring',cshortstringdef)));
+  p^.insert(new(ptypesym,initdef('longstring',clongstringdef)));
+  p^.insert(new(ptypesym,initdef('ansistring',cansistringdef)));
+  p^.insert(new(ptypesym,initdef('widestring',cwidestringdef)));
+  p^.insert(new(ptypesym,initdef('openshortstring',openshortstringdef)));
+  p^.insert(new(ptypesym,initdef('boolean',booldef)));
+  p^.insert(new(ptypesym,initdef('void_pointer',voidpointerdef)));
+  p^.insert(new(ptypesym,initdef('char_pointer',charpointerdef)));
+  p^.insert(new(ptypesym,initdef('void_farpointer',voidfarpointerdef)));
+  p^.insert(new(ptypesym,initdef('openchararray',openchararraydef)));
+  p^.insert(new(ptypesym,initdef('file',cfiledef)));
+  p^.insert(new(ptypesym,initdef('s32real',s32floatdef)));
+  p^.insert(new(ptypesym,initdef('s64real',s64floatdef)));
+  p^.insert(new(ptypesym,initdef('s80real',s80floatdef)));
+  p^.insert(new(ptypesym,initdef('s32fixed',s32fixeddef)));
   { Add a type for virtual method tables in lowercase }
   { so it isn't reachable!                            }
   vmtsymtable:=new(psymtable,init(recordsymtable));
   vmtdef:=new(precorddef,init(vmtsymtable));
-  pvmtdef:=new(ppointerdef,init(vmtdef));
-  vmtsymtable^.insert(new(pvarsym,init('parent',pvmtdef)));
-  vmtsymtable^.insert(new(pvarsym,init('length',globaldef('longint'))));
-  vmtsymtable^.insert(new(pvarsym,init('mlength',globaldef('longint'))));
+  pvmtdef:=new(ppointerdef,initdef(vmtdef));
+  vmtsymtable^.insert(new(pvarsym,initdef('parent',pvmtdef)));
+  vmtsymtable^.insert(new(pvarsym,initdef('length',globaldef('longint'))));
+  vmtsymtable^.insert(new(pvarsym,initdef('mlength',globaldef('longint'))));
   vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
-  vmtarraydef^.definition := voidpointerdef;
-  vmtsymtable^.insert(new(pvarsym,init('__pfn',vmtarraydef)));
-  p^.insert(new(ptypesym,init('__vtbl_ptr_type',vmtdef)));
-  p^.insert(new(ptypesym,init('pvmt',pvmtdef)));
+  vmtarraydef^.elementtype.setdef(voidpointerdef);
+  vmtsymtable^.insert(new(pvarsym,initdef('__pfn',vmtarraydef)));
+  p^.insert(new(ptypesym,initdef('__vtbl_ptr_type',vmtdef)));
+  p^.insert(new(ptypesym,initdef('pvmt',pvmtdef)));
   vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
-  vmtarraydef^.definition := pvmtdef;
-  p^.insert(new(ptypesym,init('vtblarray',vmtarraydef)));
+  vmtarraydef^.elementtype.setdef(pvmtdef);
+  p^.insert(new(ptypesym,initdef('vtblarray',vmtarraydef)));
   insertinternsyms(p);
 { Normal types }
-  p^.insert(new(ptypesym,init('SINGLE',s32floatdef)));
-  p^.insert(new(ptypesym,init('DOUBLE',s64floatdef)));
-  p^.insert(new(ptypesym,init('EXTENDED',s80floatdef)));
-  p^.insert(new(ptypesym,init('REAL',s64floatdef)));
+  p^.insert(new(ptypesym,initdef('SINGLE',s32floatdef)));
+  p^.insert(new(ptypesym,initdef('DOUBLE',s64floatdef)));
+  p^.insert(new(ptypesym,initdef('EXTENDED',s80floatdef)));
+  p^.insert(new(ptypesym,initdef('REAL',s64floatdef)));
 {$ifdef i386}
-  p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s64comp)))));
+  p^.insert(new(ptypesym,initdef('COMP',new(pfloatdef,init(s64comp)))));
 {$endif}
-  p^.insert(new(ptypesym,init('POINTER',voidpointerdef)));
-  p^.insert(new(ptypesym,init('FARPOINTER',voidfarpointerdef)));
-{  p^.insert(new(ptypesym,init('STRING',cshortstringdef))); }
-  p^.insert(new(ptypesym,init('SHORTSTRING',cshortstringdef)));
-  p^.insert(new(ptypesym,init('LONGSTRING',clongstringdef)));
-  p^.insert(new(ptypesym,init('ANSISTRING',cansistringdef)));
-  p^.insert(new(ptypesym,init('WIDESTRING',cwidestringdef)));
-  p^.insert(new(ptypesym,init('BOOLEAN',booldef)));
-  p^.insert(new(ptypesym,init('BYTEBOOL',booldef)));
-  p^.insert(new(ptypesym,init('WORDBOOL',new(porddef,init(bool16bit,0,1)))));
-  p^.insert(new(ptypesym,init('LONGBOOL',new(porddef,init(bool32bit,0,1)))));
-  p^.insert(new(ptypesym,init('CHAR',cchardef)));
-  p^.insert(new(ptypesym,init('TEXT',new(pfiledef,init(ft_text,nil)))));
-  p^.insert(new(ptypesym,init('CARDINAL',u32bitdef)));
-  p^.insert(new(ptypesym,init('FIXED',new(pfloatdef,init(f32bit)))));
-  p^.insert(new(ptypesym,init('FIXED16',new(pfloatdef,init(f16bit)))));
-  p^.insert(new(ptypesym,init('QWORD',cu64bitdef)));
-  p^.insert(new(ptypesym,init('INT64',cs64bitdef)));
-  p^.insert(new(ptypesym,init('TYPEDFILE',new(pfiledef,init(ft_typed,voiddef)))));
+  p^.insert(new(ptypesym,initdef('POINTER',voidpointerdef)));
+  p^.insert(new(ptypesym,initdef('FARPOINTER',voidfarpointerdef)));
+  p^.insert(new(ptypesym,initdef('SHORTSTRING',cshortstringdef)));
+  p^.insert(new(ptypesym,initdef('LONGSTRING',clongstringdef)));
+  p^.insert(new(ptypesym,initdef('ANSISTRING',cansistringdef)));
+  p^.insert(new(ptypesym,initdef('WIDESTRING',cwidestringdef)));
+  p^.insert(new(ptypesym,initdef('BOOLEAN',booldef)));
+  p^.insert(new(ptypesym,initdef('BYTEBOOL',booldef)));
+  p^.insert(new(ptypesym,initdef('WORDBOOL',new(porddef,init(bool16bit,0,1)))));
+  p^.insert(new(ptypesym,initdef('LONGBOOL',new(porddef,init(bool32bit,0,1)))));
+  p^.insert(new(ptypesym,initdef('CHAR',cchardef)));
+  p^.insert(new(ptypesym,initdef('TEXT',new(pfiledef,inittext))));
+  p^.insert(new(ptypesym,initdef('CARDINAL',u32bitdef)));
+  p^.insert(new(ptypesym,initdef('FIXED',new(pfloatdef,init(f32bit)))));
+  p^.insert(new(ptypesym,initdef('FIXED16',new(pfloatdef,init(f16bit)))));
+  p^.insert(new(ptypesym,initdef('QWORD',cu64bitdef)));
+  p^.insert(new(ptypesym,initdef('INT64',cs64bitdef)));
+  p^.insert(new(ptypesym,initdef('TYPEDFILE',new(pfiledef,inittypeddef(voiddef)))));
 end;
 
 
@@ -211,7 +210,7 @@ begin
   { length=0 for shortstring is open string (needed for readln(string) }
   openshortstringdef:=new(pstringdef,shortinit(0));
   openchararraydef:=new(parraydef,init(0,-1,s32bitdef));
-  parraydef(openchararraydef)^.definition:=cchardef;
+  parraydef(openchararraydef)^.elementtype.setdef(cchardef);
 {$ifdef i386}
   s32floatdef:=new(pfloatdef,init(s32real));
   s64floatdef:=new(pfloatdef,init(s64real));
@@ -227,10 +226,10 @@ begin
 {$endif}
   s32fixeddef:=new(pfloatdef,init(f32bit));
   { some other definitions }
-  voidpointerdef:=new(ppointerdef,init(voiddef));
-  charpointerdef:=new(ppointerdef,init(cchardef));
-  voidfarpointerdef:=new(ppointerdef,initfar(voiddef));
-  cfiledef:=new(pfiledef,init(ft_untyped,nil));
+  voidpointerdef:=new(ppointerdef,initdef(voiddef));
+  charpointerdef:=new(ppointerdef,initdef(cchardef));
+  voidfarpointerdef:=new(ppointerdef,initfardef(voiddef));
+  cfiledef:=new(pfiledef,inituntyped);
   registerdef:=oldregisterdef;
 end;
 
@@ -238,7 +237,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.29  1999-11-06 14:34:23  peter
+  Revision 1.30  1999-11-30 10:40:51  peter
+    + ttype, tsymlist
+
+  Revision 1.29  1999/11/06 14:34:23  peter
     * truncated log to 20 revs
 
   Revision 1.28  1999/09/16 23:05:55  florian

+ 19 - 17
compiler/ptconst.pas

@@ -200,11 +200,11 @@ unit ptconst;
               case p^.treetype of
                  loadvmtn:
                    begin
-                      if not(pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.is_related(
-                        pobjectdef(pclassrefdef(def)^.definition))) then
+                      if not(pobjectdef(pclassrefdef(p^.resulttype)^.pointertype.def)^.is_related(
+                        pobjectdef(pclassrefdef(def)^.pointertype.def))) then
                         Message(cg_e_illegal_expression);
                       curconstsegment^.concat(new(pai_const_symbol,init(newasmsymbol(pobjectdef(
-                        pclassrefdef(p^.resulttype)^.definition)^.vmt_mangledname))));
+                        pclassrefdef(p^.resulttype)^.pointertype.def)^.vmt_mangledname))));
                    end;
                  niln:
                    curconstsegment^.concat(new(pai_const,init_32bit(0)));
@@ -237,8 +237,7 @@ unit ptconst;
                 curconstsegment^.concat(new(pai_const,init_32bit(0)))
               { maybe pchar ? }
               else
-                if (ppointerdef(def)^.definition^.deftype=orddef) and
-                   (porddef(ppointerdef(def)^.definition)^.typ=uchar) and
+                if is_char(ppointerdef(def)^.pointertype.def) and
                    (p^.treetype<>addrn) then
                   begin
                     getdatalabel(ll);
@@ -262,9 +261,9 @@ unit ptconst;
                     hp:=p^.left;
                     while assigned(hp) and (hp^.treetype in [subscriptn,vecn]) do
                       hp:=hp^.left;
-                    if (is_equal(ppointerdef(p^.resulttype)^.definition,ppointerdef(def)^.definition) or
-                       (is_equal(ppointerdef(p^.resulttype)^.definition,voiddef)) or
-                       (is_equal(ppointerdef(def)^.definition,voiddef))) and
+                    if (is_equal(ppointerdef(p^.resulttype)^.pointertype.def,ppointerdef(def)^.pointertype.def) or
+                       (is_equal(ppointerdef(p^.resulttype)^.pointertype.def,voiddef)) or
+                       (is_equal(ppointerdef(def)^.pointertype.def,voiddef))) and
                        (hp^.treetype=loadn) then
                       begin
                         do_firstpass(p^.left);
@@ -312,7 +311,7 @@ unit ptconst;
                                begin
                                   consume(_POINT);
                                   lsym:=pvarsym(precdef(
-                                        ppointerdef(p^.resulttype)^.definition)^.symtable^.search(pattern));
+                                        ppointerdef(p^.resulttype)^.pointertype.def)^.symtable^.search(pattern));
                                   if assigned(sym) then
                                     offset:=offset+lsym^.address
                                   else
@@ -510,15 +509,15 @@ unit ptconst;
                     consume(_LKLAMMER);
                     for l:=parraydef(def)^.lowrange to parraydef(def)^.highrange-1 do
                       begin
-                         readtypedconst(parraydef(def)^.definition,nil,no_change_allowed);
+                         readtypedconst(parraydef(def)^.elementtype.def,nil,no_change_allowed);
                          consume(_COMMA);
                       end;
-                    readtypedconst(parraydef(def)^.definition,nil,no_change_allowed);
+                    readtypedconst(parraydef(def)^.elementtype.def,nil,no_change_allowed);
                     consume(_RKLAMMER);
                  end
               else
               { if array of char then we allow also a string }
-               if is_char(parraydef(def)^.definition) then
+               if is_char(parraydef(def)^.elementtype.def) then
                 begin
                    p:=comp_expr(true);
                    do_firstpass(p);
@@ -673,10 +672,10 @@ unit ptconst;
                             curconstsegment^.concat(new(pai_const,init_8bit(0)));
 
                         { new position }
-                        aktpos:=pvarsym(srsym)^.address+pvarsym(srsym)^.definition^.size;
+                        aktpos:=pvarsym(srsym)^.address+pvarsym(srsym)^.vartype.def^.size;
 
                         { read the data }
-                        readtypedconst(pvarsym(srsym)^.definition,nil,no_change_allowed);
+                        readtypedconst(pvarsym(srsym)^.vartype.def,nil,no_change_allowed);
 
                         if token=_SEMICOLON then
                           consume(_SEMICOLON)
@@ -735,10 +734,10 @@ unit ptconst;
                                  curconstsegment^.concat(new(pai_const,init_8bit(0)));
 
                              { new position }
-                             aktpos:=pvarsym(srsym)^.address+pvarsym(srsym)^.definition^.size;
+                             aktpos:=pvarsym(srsym)^.address+pvarsym(srsym)^.vartype.def^.size;
 
                              { read the data }
-                             readtypedconst(pvarsym(srsym)^.definition,nil,no_change_allowed);
+                             readtypedconst(pvarsym(srsym)^.vartype.def,nil,no_change_allowed);
 
                              if token=_SEMICOLON then
                                consume(_SEMICOLON)
@@ -765,7 +764,10 @@ unit ptconst;
 end.
 {
   $Log$
-  Revision 1.58  1999-11-08 18:50:11  florian
+  Revision 1.59  1999-11-30 10:40:51  peter
+    + ttype, tsymlist
+
+  Revision 1.58  1999/11/08 18:50:11  florian
     * disposetree for classrefdef added
 
   Revision 1.57  1999/11/08 16:24:28  pierre

+ 167 - 263
compiler/ptype.pas

@@ -32,10 +32,6 @@ uses
        typecanbeforward : boolean = false;
 
     var
-       { ttypesym read by read_type, this is needed to be
-         stored in the ppu for resolving purposes }
-       readtypesym : ptypesym;
-
        { hack, which allows to use the current parsed }
        { object type as function argument type  }
        testcurobject : byte;
@@ -50,9 +46,9 @@ uses
 
     { reads a string, file type or a type id and returns a name and }
     { pdef                                                        }
-    function single_type(var s : string;isforwarddef:boolean) : pdef;
+    procedure single_type(var tt:ttype;var s : string;isforwarddef:boolean);
 
-    function read_type(const name : stringid) : pdef;
+    procedure read_type(var tt:ttype;const name : stringid);
 
 
 implementation
@@ -115,8 +111,8 @@ uses
        end;
 
 
-    function id_type(var s : string;isforwarddef:boolean) : pdef;
-    { reads a type definition and returns a pointer }
+    procedure id_type(var tt : ttype;var s : string;isforwarddef:boolean);
+    { reads a type definition }
     { to a appropriating pdef, s gets the name of   }
     { the type to allow name mangling          }
       var
@@ -128,14 +124,14 @@ uses
          { classes can be used also in classes }
          if (curobjectname=pattern) and aktobjectdef^.is_class then
            begin
-              id_type:=aktobjectdef;
+              tt.setdef(aktobjectdef);
               consume(_ID);
               exit;
            end;
          { objects can be parameters }
          if (testcurobject=2) and (curobjectname=pattern) then
            begin
-              id_type:=aktobjectdef;
+              tt.setdef(aktobjectdef);
               consume(_ID);
               exit;
            end;
@@ -157,46 +153,47 @@ uses
          if isforwarddef and
             not(is_unit_specific) then
           begin
-            id_type:=new(pforwarddef,init(s,pos));
+            tt.setdef(new(pforwarddef,init(s,pos)));
             exit;
           end;
          { unknown sym ? }
          if not assigned(srsym) then
           begin
             Message1(sym_e_id_not_found,s);
-            id_type:=generrordef;
+            tt.setdef(generrordef);
             exit;
           end;
          if (srsym^.typ<>typesym) then
           begin
             Message(type_e_type_id_expected);
-            id_type:=generrordef;
+            tt.setdef(generrordef);
             exit;
           end;
-         { can't use in [] here, becuase unitid can be > 255 }
+         { Only use the definitions for system/current unit, becuase
+           they can be refered from the parameters and symbols are not
+           loaded at that time. A symbol reference to an other unit
+           is still possible, because it's already loaded (PFV)
+           can't use in [] here, becuase unitid can be > 255 }
          if (ptypesym(srsym)^.owner^.unitid=0) or
             (ptypesym(srsym)^.owner^.unitid=1) then
-          readtypesym:=nil
+          tt.setdef(ptypesym(srsym)^.restype.def)
          else
-          readtypesym:=ptypesym(srsym);
-         { return the definition of the type }
-         id_type:=ptypesym(srsym)^.definition;
+          tt.setsym(srsym);
       end;
 
 
-    function single_type(var s : string;isforwarddef:boolean) : pdef;
+    procedure single_type(var tt:ttype;var s : string;isforwarddef:boolean);
     { reads a string, file type or a type id and returns a name and }
     { pdef                                                        }
        var
           hs : string;
+          t2 : ttype;
        begin
-          readtypesym:=nil;
           case token of
             _STRING:
                 begin
-                   single_type:=string_dec;
+                   tt.setdef(string_dec);
                    s:='STRING';
-                   readtypesym:=nil;
                 end;
             _FILE:
                 begin
@@ -204,19 +201,19 @@ uses
                    if token=_OF then
                      begin
                         consume(_OF);
-                        single_type:=new(pfiledef,init(ft_typed,single_type(hs,false)));
+                        single_type(t2,hs,false);
+                        tt.setdef(new(pfiledef,inittyped(t2)));
                         s:='FILE$OF$'+hs;
                      end
                    else
                      begin
-                        single_type:=cfiledef;
+                        tt.setdef(cfiledef);
                         s:='FILE';
                      end;
-                   readtypesym:=nil;
                 end;
             else
               begin
-                single_type:=id_type(s,isforwarddef);
+                id_type(tt,s,isforwarddef);
               end;
          end;
       end;
@@ -253,20 +250,12 @@ uses
                 if (aktclass^.is_class) then
                   begin
                      { CLASS constructors return the created instance }
-                     aktprocsym^.definition^.retdef:=aktclass;
+                     aktprocsym^.definition^.rettype.def:=aktclass;
                   end
                 else
                   begin
                      { OBJECT constructors return a boolean }
-{$IfDef GDB}
-                     {GDB doesn't like unnamed types !}
-                     aktprocsym^.definition^.retdef:=
-                       globaldef('boolean');
-{$Else GDB}
-                     aktprocsym^.definition^.retdef:=
-                        new(porddef,init(bool8bit,0,1));
-
-{$Endif GDB}
+                     aktprocsym^.definition^.rettype.setdef(booldef);
                   end;
              end;
         end;
@@ -296,64 +285,6 @@ uses
              get_procdef:=p;
           end;
 
-          procedure deletepropsymlist(p : ppropsymlist);
-
-            var
-               hp : ppropsymlist;
-
-            begin
-               while assigned(p) do
-                 begin
-                    hp:=p;
-                    p:=p^.next;
-                    dispose(hp);
-                 end;
-            end;
-
-          procedure addpropsymlist(var root:ppropsymlist;s:psym);
-          var
-            last,hp : ppropsymlist;
-          begin
-            if not assigned(s) then
-             exit;
-            last:=root;
-            new(hp);
-            hp^.sym:=s;
-            hp^.next:=nil;
-            if assigned(last) then
-             begin
-               while assigned(last^.next) do
-                last:=last^.next;
-               last^.next:=hp;
-             end
-            else
-             root:=hp;
-          end;
-
-          function copypropsymlist(s:ppropsymlist):ppropsymlist;
-          var
-            root,last,hp : ppropsymlist;
-          begin
-            copypropsymlist:=nil;
-            if not assigned(s) then
-             exit;
-            last:=nil;
-            root:=nil;
-            while assigned(s) do
-             begin
-               new(hp);
-               hp^.sym:=s^.sym;
-               hp^.next:=nil;
-               if assigned(last) then
-                last^.next:=hp;
-               last:=hp;
-               if not assigned(root) then
-                root:=hp;
-               s:=s^.next;
-             end;
-            copypropsymlist:=root;
-          end;
-
         var
            hp2,datacoll : pparaitem;
            p,p2 : ppropertysym;
@@ -361,8 +292,8 @@ uses
            hs : string;
            varspez : tvarspez;
            sc : pstringcontainer;
-           hp : pdef;
            s : string;
+           tt : ttype;
            declarepos : tfileposinfo;
            pp : pprocdef;
            pt : ptree;
@@ -418,22 +349,22 @@ uses
                                  consume(_ARRAY);
                                  consume(_OF);
                                  { define range and type of range }
-                                 hp:=new(parraydef,init(0,-1,s32bitdef));
+                                 tt.setdef(new(parraydef,init(0,-1,s32bitdef)));
                                  { define field type }
-                                 parraydef(hp)^.definition:=single_type(s,false);
+                                 single_type(parraydef(tt.def)^.elementtype,s,false);
                               end
                             else
-                              hp:=single_type(s,false);
+                              single_type(tt,s,false);
                          end
                        else
-                         hp:=cformaldef;
+                         tt.setdef(cformaldef);
                        repeat
                          s:=sc^.get_with_tokeninfo(declarepos);
                          if s='' then
                           break;
                          new(hp2,init);
                          hp2^.paratyp:=varspez;
-                         hp2^.data:=hp;
+                         hp2^.paratype:=tt;
                          propertyparas^.insert(hp2);
                        until false;
                        dispose(sc,done);
@@ -446,7 +377,7 @@ uses
                 if (token=_COLON) or not(propertyparas^.empty) then
                   begin
                      consume(_COLON);
-                     p^.proptype:=single_type(hs,false);
+                     single_type(p^.proptype,hs,false);
                      if (idtoken=_INDEX) then
                        begin
                           consume(_INDEX);
@@ -456,12 +387,12 @@ uses
                              is_64bitint(pt^.resulttype) then
                             Message(parser_e_invalid_property_index_value);
                           p^.index:=pt^.value;
-                          p^.indexdef:=pt^.resulttype;
+                          p^.indextype.setdef(pt^.resulttype);
                           include(p^.propoptions,ppo_indexed);
                           { concat a longint to the para template }
                           new(hp2,init);
                           hp2^.paratyp:=vs_value;
-                          hp2^.data:=pt^.resulttype;
+                          hp2^.paratype:=p^.indextype;
                           propertyparas^.insert(hp2);
                           disposetree(pt);
                        end;
@@ -475,40 +406,26 @@ uses
                      overriden:=search_class_member(aktclass,propname);
                      if assigned(overriden) and (overriden^.typ=propertysym) then
                        begin
-                          { take the whole info: }
-                          p^.propoptions:=ppropertysym(overriden)^.propoptions;
-                          p^.index:=ppropertysym(overriden)^.index;
-                          p^.proptype:=ppropertysym(overriden)^.proptype;
-                          p^.proptypesym:=ppropertysym(overriden);
-                          p^.writeaccesssym:=copypropsymlist(ppropertysym(overriden)^.writeaccesssym);
-                          p^.readaccesssym:=copypropsymlist(ppropertysym(overriden)^.readaccesssym);
-                          p^.storedsym:=copypropsymlist(ppropertysym(overriden)^.storedsym);
-                          p^.writeaccessdef:=ppropertysym(overriden)^.writeaccessdef;
-                          p^.readaccessdef:=ppropertysym(overriden)^.readaccessdef;
-                          p^.storeddef:=ppropertysym(overriden)^.storeddef;
-                          p^.indexdef:=ppropertysym(overriden)^.indexdef;
-                          p^.default:=ppropertysym(overriden)^.default;
+                         p^.dooverride(ppropertysym(overriden));
                        end
                      else
                        begin
-                          p^.proptype:=generrordef;
-                          message(parser_e_no_property_found_to_override);
+                         p^.proptype.setdef(generrordef);
+                         message(parser_e_no_property_found_to_override);
                        end;
                   end;
                 if (sp_published in current_object_option) and
-                   not(p^.proptype^.is_publishable) then
+                   not(p^.proptype.def^.is_publishable) then
                   Message(parser_e_cant_publish_that_property);
 
                 { create data defcoll to allow correct parameter checks }
                 new(datacoll,init);
                 datacoll^.paratyp:=vs_value;
-                datacoll^.data:=p^.proptype;
+                datacoll^.paratype:=p^.proptype;
 
                 if (idtoken=_READ) then
                   begin
-                     if assigned(p^.readaccesssym) then
-                       deletepropsymlist(p^.readaccesssym);
-                     p^.readaccesssym:=nil;
+                     p^.readaccess^.clear;
                      consume(_READ);
                      sym:=search_class_member(aktclass,pattern);
                      if not(assigned(sym)) then
@@ -521,11 +438,11 @@ uses
                           consume(_ID);
                           while (token=_POINT) and
                                 ((sym^.typ=varsym) and
-                                 (pvarsym(sym)^.definition^.deftype=recorddef)) do
+                                 (pvarsym(sym)^.vartype.def^.deftype=recorddef)) do
                            begin
-                             addpropsymlist(p^.readaccesssym,sym);
+                             p^.readaccess^.addsym(sym);
                              consume(_POINT);
-                             getsymonlyin(precorddef(pvarsym(sym)^.definition)^.symtable,pattern);
+                             getsymonlyin(precorddef(pvarsym(sym)^.vartype.def)^.symtable,pattern);
                              if not assigned(srsym) then
                                Message1(sym_e_illegal_field,pattern);
                              sym:=srsym;
@@ -541,27 +458,25 @@ uses
                               begin
                                  pp:=get_procdef;
                                  if not(assigned(pp)) or
-                                    not(is_equal(pp^.retdef,p^.proptype)) then
+                                    not(is_equal(pp^.rettype.def,p^.proptype.def)) then
                                    Message(parser_e_ill_property_access_sym);
-                                 p^.readaccessdef:=pp;
+                                 p^.readaccess^.setdef(pp);
                               end;
                             varsym :
                               begin
                                 if not(propertyparas^.empty) or
-                                   not(is_equal(pvarsym(sym)^.definition,p^.proptype)) then
+                                   not(is_equal(pvarsym(sym)^.vartype.def,p^.proptype.def)) then
                                   Message(parser_e_ill_property_access_sym);
                               end;
                             else
                               Message(parser_e_ill_property_access_sym);
                           end;
-                          addpropsymlist(p^.readaccesssym,sym);
+                          p^.readaccess^.addsym(sym);
                        end;
                   end;
                 if (idtoken=_WRITE) then
                   begin
-                     if assigned(p^.writeaccesssym) then
-                       deletepropsymlist(p^.writeaccesssym);
-                     p^.writeaccesssym:=nil;
+                     p^.writeaccess^.clear;
                      consume(_WRITE);
                      sym:=search_class_member(aktclass,pattern);
                      if not(assigned(sym)) then
@@ -574,11 +489,11 @@ uses
                           consume(_ID);
                           while (token=_POINT) and
                                 ((sym^.typ=varsym) and
-                                 (pvarsym(sym)^.definition^.deftype=recorddef)) do
+                                 (pvarsym(sym)^.vartype.def^.deftype=recorddef)) do
                            begin
-                             addpropsymlist(p^.writeaccesssym,sym);
+                             p^.writeaccess^.addsym(sym);
                              consume(_POINT);
-                             getsymonlyin(precorddef(pvarsym(sym)^.definition)^.symtable,pattern);
+                             getsymonlyin(precorddef(pvarsym(sym)^.vartype.def)^.symtable,pattern);
                              if not assigned(srsym) then
                                Message1(sym_e_illegal_field,pattern);
                              sym:=srsym;
@@ -599,28 +514,25 @@ uses
                                  propertyparas^.remove(datacoll);
                                  if not(assigned(pp)) then
                                    Message(parser_e_ill_property_access_sym);
-                                 p^.writeaccessdef:=pp;
+                                 p^.writeaccess^.setdef(pp);
                               end;
                             varsym :
                               begin
                                  if not(propertyparas^.empty) or
-                                    not(is_equal(pvarsym(sym)^.definition,p^.proptype)) then
+                                    not(is_equal(pvarsym(sym)^.vartype.def,p^.proptype.def)) then
                                    Message(parser_e_ill_property_access_sym);
                               end
                             else
                               Message(parser_e_ill_property_access_sym);
                           end;
-                          addpropsymlist(p^.writeaccesssym,sym);
+                          p^.writeaccess^.addsym(sym);
                        end;
                   end;
                 include(p^.propoptions,ppo_stored);
                 if (idtoken=_STORED) then
                   begin
                      consume(_STORED);
-                     if assigned(p^.storedsym) then
-                       deletepropsymlist(p^.storedsym);
-                     p^.storedsym:=nil;
-                     p^.storeddef:=nil;
+                     p^.storedaccess^.clear;
                      case token of
                         _ID:
                            { in the case that idtoken=_DEFAULT }
@@ -640,11 +552,11 @@ uses
                                      consume(_ID);
                                      while (token=_POINT) and
                                            ((sym^.typ=varsym) and
-                                            (pvarsym(sym)^.definition^.deftype=recorddef)) do
+                                            (pvarsym(sym)^.vartype.def^.deftype=recorddef)) do
                                       begin
-                                        addpropsymlist(p^.storedsym,sym);
+                                        p^.storedaccess^.addsym(sym);
                                         consume(_POINT);
-                                        getsymonlyin(precorddef(pvarsym(sym)^.definition)^.symtable,pattern);
+                                        getsymonlyin(precorddef(pvarsym(sym)^.vartype.def)^.symtable,pattern);
                                         if not assigned(srsym) then
                                           Message1(sym_e_illegal_field,pattern);
                                         sym:=srsym;
@@ -668,20 +580,20 @@ uses
                                              end;
                                            { found we a procedure and does it really return a bool? }
                                            if not(assigned(pp)) or
-                                              not(is_equal(pp^.retdef,booldef)) then
+                                              not(is_equal(pp^.rettype.def,booldef)) then
                                              Message(parser_e_ill_property_storage_sym);
-                                           p^.storeddef:=pp;
+                                           p^.storedaccess^.setdef(pp);
                                          end;
                                        varsym :
                                          begin
                                            if not(propertyparas^.empty) or
-                                              not(is_equal(pvarsym(sym)^.definition,booldef)) then
+                                              not(is_equal(pvarsym(sym)^.vartype.def,booldef)) then
                                              Message(parser_e_stored_property_must_be_boolean);
                                          end;
                                        else
                                          Message(parser_e_ill_property_storage_sym);
                                      end;
-                                     addpropsymlist(p^.storedsym,sym);
+                                     p^.storedaccess^.addsym(sym);
                                   end;
                              end;
                         _FALSE:
@@ -696,19 +608,18 @@ uses
                 if (idtoken=_DEFAULT) then
                   begin
                      consume(_DEFAULT);
-                     if not(is_ordinal(p^.proptype) or
-                         is_64bitint(p^.proptype) or
-                       ((p^.proptype^.deftype=setdef) and
-                        (psetdef(p^.proptype)^.settype=smallset)
-                       ) or
-                       not(propertyparas^.empty)
-                       ) then
+                     if not(is_ordinal(p^.proptype.def) or
+                            is_64bitint(p^.proptype.def) or
+                            ((p^.proptype.def^.deftype=setdef) and
+                             (psetdef(p^.proptype.def)^.settype=smallset)) or
+                            not(propertyparas^.empty)
+                        ) then
                        Message(parser_e_property_cant_have_a_default_value);
                      { Get the result of the default, the firstpass is
                        needed to support values like -1 }
                      pt:=comp_expr(true);
                      do_firstpass(pt);
-                     if p^.proptype^.deftype=setdef then
+                     if p^.proptype.def^.deftype=setdef then
                        begin
 {$ifndef newcg}
                          {!!!!!!!!!!}
@@ -716,7 +627,7 @@ uses
 {$endif newcg}
                          do_firstpass(pt);
                        end;
-                     pt:=gentypeconvnode(pt,p^.proptype);
+                     pt:=gentypeconvnode(pt,p^.proptype.def);
                      do_firstpass(pt);
                      if not(is_constnode(pt)) then
                        Message(parser_e_property_default_value_must_const);
@@ -784,13 +695,13 @@ uses
            if not(aktprocsym^.definition^.para^.empty) then
             Message(parser_e_no_paras_for_destructor);
            { no return value }
-           aktprocsym^.definition^.retdef:=voiddef;
+           aktprocsym^.definition^.rettype.def:=voiddef;
         end;
 
       var
          hs      : string;
          pcrd       : pclassrefdef;
-         hp1    : pdef;
+         tt     : ttype;
          oldprocinfo : pprocinfo;
          oldprocsym : pprocsym;
          oldparse_only : boolean;
@@ -838,13 +749,13 @@ uses
                    { a hack, but it's easy to handle }
                    { class reference type }
                    consume(_OF);
-                   hp1:=single_type(hs,typecanbeforward);
+                   single_type(tt,hs,typecanbeforward);
 
                    { accept hp1, if is a forward def or a class }
-                   if (hp1^.deftype=forwarddef) or
-                      ((hp1^.deftype=objectdef) and pobjectdef(hp1)^.is_class) then
+                   if (tt.def^.deftype=forwarddef) or
+                      ((tt.def^.deftype=objectdef) and pobjectdef(tt.def)^.is_class) then
                      begin
-                        pcrd:=new(pclassrefdef,init(hp1));
+                        pcrd:=new(pclassrefdef,init(tt.def));
                         object_dec:=pcrd;
                      end
                    else
@@ -889,7 +800,8 @@ uses
          if token=_LKLAMMER then
            begin
               consume(_LKLAMMER);
-              childof:=pobjectdef(id_type(pattern,false));
+              id_type(tt,pattern,false);
+              childof:=pobjectdef(tt.def);
               if (childof^.deftype<>objectdef) then
                begin
                  Message1(type_e_class_type_expected,childof^.typename);
@@ -987,8 +899,7 @@ uses
 
          { new procinfo }
          oldprocinfo:=procinfo;
-         new(procinfo);
-         fillchar(procinfo^,sizeof(tprocinfo),0);
+         new(procinfo,init);
          procinfo^._class:=aktclass;
 
 
@@ -1229,7 +1140,7 @@ uses
          symtablestack:=symtablestack^.next;
          aktobjectdef:=nil;
          {Restore procinfo}
-         dispose(procinfo);
+         dispose(procinfo,done);
          procinfo:=oldprocinfo;
          {Restore the aktprocsym.}
          aktprocsym:=oldprocsym;
@@ -1269,10 +1180,10 @@ uses
 
 
     { reads a type definition and returns a pointer to it }
-    function read_type(const name : stringid) : pdef;
+    procedure read_type(var tt : ttype;const name : stringid);
       var
         pt : ptree;
-        hp1,p : pdef;
+        tt2 : ttype;
         aufdef : penumdef;
         {aufsym : penumsym;}
         ap : parraydef;
@@ -1290,7 +1201,7 @@ uses
            if (token=_ID) and (testcurobject=2) and (curobjectname=pattern) then
              begin
                 consume(_ID);
-                p:=aktobjectdef;
+                tt.setdef(aktobjectdef);
                 exit;
              end;
            { we can't accept a equal in type }
@@ -1317,15 +1228,15 @@ uses
                         begin
                         { All checks passed, create the new def }
                           case pt1^.resulttype^.deftype of
-                           enumdef : p:=new(penumdef,init_subrange(penumdef(pt1^.resulttype),pt1^.value,pt2^.value));
+                           enumdef : tt.setdef(new(penumdef,init_subrange(penumdef(pt1^.resulttype),pt1^.value,pt2^.value)));
                             orddef : begin
                                        if is_char(pt1^.resulttype) then
-                                         p:=new(porddef,init(uchar,pt1^.value,pt2^.value))
+                                         tt.setdef(new(porddef,init(uchar,pt1^.value,pt2^.value)))
                                        else
                                         if is_boolean(pt1^.resulttype) then
-                                         p:=new(porddef,init(bool8bit,pt1^.value,pt2^.value))
+                                         tt.setdef(new(porddef,init(bool8bit,pt1^.value,pt2^.value)))
                                        else
-                                        p:=new(porddef,init(uauto,pt1^.value,pt2^.value));
+                                        tt.setdef(new(porddef,init(uauto,pt1^.value,pt2^.value)));
                                      end;
                           end;
                         end;
@@ -1338,8 +1249,10 @@ uses
                { a simple type renaming }
                if (pt1^.treetype=typen) then
                  begin
-                   p:=pt1^.resulttype;
-                   readtypesym:=pt1^.typenodesym;
+                   if assigned(pt1^.typenodesym) then
+                     tt.setsym(pt1^.typenodesym)
+                   else
+                     tt.setdef(pt1^.resulttype);
                  end
                else
                  Message(sym_e_error_in_type_def);
@@ -1359,7 +1272,7 @@ uses
            arraytype:=generrordef;
            lowval:=$80000000;
            highval:=$7fffffff;
-           p:=nil;
+           tt.reset;
            repeat
              { read the expression and check it }
              pt:=expr;
@@ -1408,15 +1321,15 @@ uses
              disposetree(pt);
 
            { create arraydef }
-             if p=nil then
+             if not assigned(tt.def) then
               begin
                 ap:=new(parraydef,init(lowval,highval,arraytype));
-                p:=ap;
+                tt.setdef(ap);
               end
              else
               begin
-                ap^.definition:=new(parraydef,init(lowval,highval,arraytype));
-                ap:=parraydef(ap^.definition);
+                ap^.elementtype.setdef(new(parraydef,init(lowval,highval,arraytype)));
+                ap:=parraydef(ap^.elementtype.def);
               end;
 
              if token=_COMMA then
@@ -1426,90 +1339,86 @@ uses
            until false;
            consume(_RECKKLAMMER);
            consume(_OF);
-           hp1:=read_type('');
+           read_type(tt2,'');
            { if no error, set element type }
            if assigned(ap) then
-             ap^.definition:=hp1;
+             ap^.elementtype:=tt2;
         end;
 
       begin
-         readtypesym:=nil;
-         p:=nil;
+         tt.reset;
          case token of
             _STRING,_FILE:
               begin
-                p:=single_type(hs,false);
-                readtypesym:=nil;
+                single_type(tt,hs,false);
               end;
            _LKLAMMER:
               begin
-                 consume(_LKLAMMER);
-                 { allow negativ value_str }
-                 l:=-1;
-                 {aufsym := Nil;}
-                 aufdef:=new(penumdef,init);
-                 repeat
-                   s:=pattern;
-                   defpos:=tokenpos;
-                   consume(_ID);
-                   if token=_ASSIGNMENT then
-                     begin
-                        consume(_ASSIGNMENT);
-                        v:=get_intconst;
-                        { please leave that a note, allows type save }
-                        { declarations in the win32 units !       }
-                        if v<=l then
-                         Message(parser_n_duplicate_enum);
-                        l:=v;
-                     end
-                   else
-                     inc(l);
-                   storepos:=tokenpos;
-                   tokenpos:=defpos;
-                   constsymtable^.insert(new(penumsym,init(s,aufdef,l)));
-                   tokenpos:=storepos;
-                   if token=_COMMA then
-                     consume(_COMMA)
-                   else
-                     break;
-                 until false;
-                 {aufdef^.max:=l;
-                 if we allow unordered enums
-                 this can be wrong
-                 min and max are now set in tenumsym.init PM }
-                 p:=aufdef;
-                 consume(_RKLAMMER);
-                readtypesym:=nil;
+                consume(_LKLAMMER);
+                { allow negativ value_str }
+                l:=-1;
+                {aufsym := Nil;}
+                aufdef:=new(penumdef,init);
+                repeat
+                  s:=pattern;
+                  defpos:=tokenpos;
+                  consume(_ID);
+                  if token=_ASSIGNMENT then
+                    begin
+                       consume(_ASSIGNMENT);
+                       v:=get_intconst;
+                       { please leave that a note, allows type save }
+                       { declarations in the win32 units !       }
+                       if v<=l then
+                        Message(parser_n_duplicate_enum);
+                       l:=v;
+                    end
+                  else
+                    inc(l);
+                  storepos:=tokenpos;
+                  tokenpos:=defpos;
+                  constsymtable^.insert(new(penumsym,init(s,aufdef,l)));
+                  tokenpos:=storepos;
+                  if token=_COMMA then
+                    consume(_COMMA)
+                  else
+                    break;
+                until false;
+                {aufdef^.max:=l;
+                if we allow unordered enums
+                this can be wrong
+                min and max are now set in tenumsym.init PM }
+                tt.setdef(aufdef);
+                consume(_RKLAMMER);
               end;
             _ARRAY:
               begin
                 array_dec;
-                readtypesym:=nil;
               end;
             _SET:
               begin
                 consume(_SET);
                 consume(_OF);
-                hp1:=read_type('');
-                if assigned(hp1) then
+                read_type(tt2,'');
+                if assigned(tt2.def) then
                  begin
-                   case hp1^.deftype of
+                   case tt2.def^.deftype of
                      { don't forget that min can be negativ  PM }
                      enumdef :
-                       if penumdef(hp1)^.min>=0 then
-                        p:=new(psetdef,init(hp1,penumdef(hp1)^.max))
+                       if penumdef(tt2.def)^.min>=0 then
+                        tt.setdef(new(psetdef,init(tt2.def,penumdef(tt2.def)^.max)))
                        else
                         Message(sym_e_ill_type_decl_set);
                      orddef :
                        begin
-                         case porddef(hp1)^.typ of
+                         case porddef(tt2.def)^.typ of
                            uchar :
-                             p:=new(psetdef,init(hp1,255));
+                             tt.setdef(new(psetdef,init(tt2.def,255)));
                            u8bit,u16bit,u32bit,
                            s8bit,s16bit,s32bit :
                              begin
-                               if (porddef(hp1)^.low>=0) then
-                                p:=new(psetdef,init(hp1,porddef(hp1)^.high))
+                               if (porddef(tt2.def)^.low>=0) then
+                                tt.setdef(new(psetdef,init(tt2.def,porddef(tt2.def)^.high)))
                                else
                                 Message(sym_e_ill_type_decl_set);
                              end;
@@ -1522,20 +1431,17 @@ uses
                    end;
                  end
                 else
-                 p:=generrordef;
-                readtypesym:=nil;
+                 tt.setdef(generrordef);
               end;
            _CARET:
               begin
                 consume(_CARET);
-                hp1:=single_type(hs,typecanbeforward);
-                p:=new(ppointerdef,init(hp1));
-                readtypesym:=nil;
+                single_type(tt2,hs,typecanbeforward);
+                tt.setdef(new(ppointerdef,init(tt2)));
               end;
             _RECORD:
               begin
-                p:=record_dec;
-                readtypesym:=nil;
+                tt.setdef(record_dec);
               end;
             _PACKED:
               begin
@@ -1547,69 +1453,67 @@ uses
                     oldaktpackrecords:=aktpackrecords;
                     aktpackrecords:=packrecord_1;
                     if token in [_CLASS,_OBJECT] then
-                      p:=object_dec(name,nil)
+                      tt.setdef(object_dec(name,nil))
                     else
-                      p:=record_dec;
+                      tt.setdef(record_dec);
                     aktpackrecords:=oldaktpackrecords;
                   end;
-                readtypesym:=nil;
               end;
             _CLASS,
             _OBJECT:
               begin
-                p:=object_dec(name,nil);
-                readtypesym:=nil;
+                tt.setdef(object_dec(name,nil));
               end;
             _PROCEDURE:
               begin
                 consume(_PROCEDURE);
-                p:=new(pprocvardef,init);
+                tt.setdef(new(pprocvardef,init));
                 if token=_LKLAMMER then
-                 parameter_dec(pprocvardef(p));
+                 parameter_dec(pprocvardef(tt.def));
                 if token=_OF then
                   begin
                     consume(_OF);
                     consume(_OBJECT);
 {$ifdef INCLUDEOK}
-                    include(pprocvardef(p)^.procoptions,po_methodpointer);
+                    include(pprocvardef(tt.def)^.procoptions,po_methodpointer);
 {$else}
-                    pprocvardef(p)^.procoptions:=pprocvardef(p)^.procoptions+[po_methodpointer];
+                    pprocvardef(tt.def)^.procoptions:=pprocvardef(tt.def)^.procoptions+[po_methodpointer];
 {$endif}
                   end;
-                readtypesym:=nil;
               end;
             _FUNCTION:
               begin
                 consume(_FUNCTION);
-                p:=new(pprocvardef,init);
+                tt.def:=new(pprocvardef,init);
                 if token=_LKLAMMER then
-                 parameter_dec(pprocvardef(p));
+                 parameter_dec(pprocvardef(tt.def));
                 consume(_COLON);
-                pprocvardef(p)^.retdef:=single_type(hs,false);
+                single_type(pprocvardef(tt.def)^.rettype,hs,false);
                 if token=_OF then
                   begin
                     consume(_OF);
                     consume(_OBJECT);
 {$ifdef INCLUDEOK}
-                    include(pprocvardef(p)^.procoptions,po_methodpointer);
+                    include(pprocvardef(tt.def)^.procoptions,po_methodpointer);
 {$else}
-                    pprocvardef(p)^.procoptions:=pprocvardef(p)^.procoptions+[po_methodpointer];
+                    pprocvardef(tt.def)^.procoptions:=pprocvardef(tt.def)^.procoptions+[po_methodpointer];
 {$endif}
                   end;
-                readtypesym:=nil;
               end;
             else
               expr_type;
          end;
-         if p=nil then
-          p:=generrordef;
-         read_type:=p;
+         if tt.def=nil then
+          tt.setdef(generrordef);
       end;
 
 end.
 {
   $Log$
-  Revision 1.11  1999-11-26 00:19:12  peter
+  Revision 1.12  1999-11-30 10:40:52  peter
+    + ttype, tsymlist
+
+  Revision 1.11  1999/11/26 00:19:12  peter
     * property overriding dereference fix, but it need a bigger redesign
       which i'll do tomorrow. This quick hack is for the lazarus ppl so
       they can hack on mwcustomedit.

+ 8 - 23
compiler/ra386att.pas

@@ -85,10 +85,8 @@ const
 const
   newline = #10;
   firsttoken : boolean = TRUE;
-{  charcount  : byte = 0;}
 var
-  _asmsorted,
-  inexpression   : boolean;
+  _asmsorted     : boolean;
   curlist        : paasmoutput;
   c              : char;
   actasmtoken    : tasmtoken;
@@ -236,16 +234,12 @@ end;
 
 Procedure GetToken;
 var
-  forcelabel: boolean;
-  errorflag : boolean;
   len : longint;
 begin
   { save old token and reset new token }
   prevasmtoken:=actasmtoken;
   actasmtoken:=AS_NONE;
   { reset }
-  errorflag:=FALSE;
-  forcelabel:=FALSE;
   actasmpattern:='';
   { while space and tab , continue scan... }
   while c in [' ',#9] do
@@ -778,7 +772,6 @@ Begin
   errorflag:=FALSE;
   tempstr:='';
   expr:='';
-  inexpression:=TRUE;
   parenlevel:=0;
   Repeat
     Case actasmtoken of
@@ -985,8 +978,6 @@ Begin
     value:=CalculateExpression(expr)
   else
     value:=0;
-  { no longer in an expression }
-  inexpression:=FALSE;
 end;
 
 
@@ -1274,12 +1265,10 @@ var
   end;
 
 var
-  tempstr : string;
   tempreg : tregister;
   hl      : PAsmLabel;
   l       : longint;
 Begin
-  tempstr:='';
   expr:='';
   case actasmtoken of
     AS_LPAREN: { Memory reference or constant expression }
@@ -1481,9 +1470,7 @@ Procedure T386AttInstruction.BuildOpCode;
 var
   operandnum : longint;
   PrefixOp,OverrideOp: tasmop;
-  expr : string;
 Begin
-  expr:='';
   PrefixOp:=A_None;
   OverrideOp:=A_None;
   { prefix seg opcode / prefix opcode }
@@ -1565,7 +1552,6 @@ end;
 
 Procedure BuildConstant(maxvalue: longint);
 var
- strlength: byte;
  asmsym,
  expr: string;
  value : longint;
@@ -1574,10 +1560,6 @@ Begin
     Case actasmtoken of
       AS_STRING:
         Begin
-          if maxvalue = $ff then
-           strlength:=1
-          else
-           Message(asmr_e_string_not_allowed_as_const);
           expr:=actasmpattern;
           if length(expr) > 1 then
            Message(asmr_e_string_not_allowed_as_const);
@@ -1745,9 +1727,9 @@ Var
 Begin
   Message1(asmr_d_start_reading,'AT&T');
   firsttoken:=TRUE;
-  if assigned(procinfo^.retdef) and
-     (is_fpu(procinfo^.retdef) or
-     ret_in_acc(procinfo^.retdef)) then
+  if assigned(procinfo^.returntype.def) and
+     (is_fpu(procinfo^.returntype.def) or
+     ret_in_acc(procinfo^.returntype.def)) then
     procinfo^.funcret_state:=vs_assigned;
   { sets up all opcode and register tables in uppercase }
   if not _asmsorted then
@@ -1992,7 +1974,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.63  1999-11-17 17:05:03  pierre
+  Revision 1.64  1999-11-30 10:40:52  peter
+    + ttype, tsymlist
+
+  Revision 1.63  1999/11/17 17:05:03  pierre
    * Notes/hints changes
 
   Revision 1.62  1999/11/09 23:06:46  peter

+ 17 - 12
compiler/ra386dir.pas

@@ -70,7 +70,7 @@ unit Ra386dir;
            if s<>'' then
             code^.concat(new(pai_direct,init(strpnew(s))));
             { consider it set function set if the offset was loaded }
-           if assigned(procinfo^.retdef) and
+           if assigned(procinfo^.returntype.def) and
               (pos(retstr,upper(s))>0) then
               procinfo^.funcret_state:=vs_assigned;
            s:='';
@@ -79,12 +79,12 @@ unit Ra386dir;
      begin
        ende:=false;
        s:='';
-       if assigned(procinfo^.retdef) and
-          is_fpu(procinfo^.retdef) then
+       if assigned(procinfo^.returntype.def) and
+          is_fpu(procinfo^.returntype.def) then
          procinfo^.funcret_state:=vs_assigned;
-       if assigned(procinfo^.retdef) and
-          (procinfo^.retdef<>pdef(voiddef)) then
-         retstr:=upper(tostr(procinfo^.retoffset)+'('+att_reg2str[procinfo^.framepointer]+')')
+       if assigned(procinfo^.returntype.def) and
+          (procinfo^.returntype.def<>pdef(voiddef)) then
+         retstr:=upper(tostr(procinfo^.return_offset)+'('+att_reg2str[procinfo^.framepointer]+')')
        else
          retstr:='';
          c:=current_scanner^.asmgetchar;
@@ -141,7 +141,7 @@ unit Ra386dir;
                                  { is the last written character an special }
                                  { char ?                                   }
                                  if (s[length(s)]='%') and
-                                    ret_in_acc(procinfo^.retdef) and
+                                    ret_in_acc(procinfo^.returntype.def) and
                                     ((pos('AX',upper(hs))>0) or
                                     (pos('AL',upper(hs))>0)) then
                                    procinfo^.funcret_state:=vs_assigned;
@@ -172,7 +172,8 @@ unit Ra386dir;
                                              if (vo_is_external in pvarsym(sym)^.varoptions) then
                                                hs:=pvarsym(sym)^.mangledname
                                              else
-                                               hs:='-'+tostr(pvarsym(sym)^.address)+'('+att_reg2str[procinfo^.framepointer]+')';
+                                               hs:='-'+tostr(pvarsym(sym)^.address)+
+                                                   '('+att_reg2str[procinfo^.framepointer]+')';
                                              end
                                            else
                                            { call to local function }
@@ -235,14 +236,15 @@ unit Ra386dir;
                                            if upper(hs)='__SELF' then
                                              begin
                                                 if assigned(procinfo^._class) then
-                                                  hs:=tostr(procinfo^.selfpointer_offset)+'('+att_reg2str[procinfo^.framepointer]+')'
+                                                  hs:=tostr(procinfo^.selfpointer_offset)+
+                                                      '('+att_reg2str[procinfo^.framepointer]+')'
                                                 else
                                                  Message(asmr_e_cannot_use_SELF_outside_a_method);
                                              end
                                            else if upper(hs)='__RESULT' then
                                              begin
-                                                if assigned(procinfo^.retdef) and
-                                                  (procinfo^.retdef<>pdef(voiddef)) then
+                                                if assigned(procinfo^.returntype.def) and
+                                                  (procinfo^.returntype.def<>pdef(voiddef)) then
                                                   hs:=retstr
                                                 else
                                                   Message(asmr_e_void_function);
@@ -295,7 +297,10 @@ unit Ra386dir;
 end.
 {
   $Log$
-  Revision 1.27  1999-11-17 17:05:03  pierre
+  Revision 1.28  1999-11-30 10:40:53  peter
+    + ttype, tsymlist
+
+  Revision 1.27  1999/11/17 17:05:03  pierre
    * Notes/hints changes
 
   Revision 1.26  1999/11/09 23:06:46  peter

+ 8 - 5
compiler/ra386int.pas

@@ -798,7 +798,7 @@ Begin
                   typedconstsym :
                     l:=ptypedconstsym(srsym)^.getsize;
                   typesym :
-                    l:=ptypesym(srsym)^.definition^.size;
+                    l:=ptypesym(srsym)^.restype.def^.size;
                   else
                     Message(asmr_e_wrong_sym_type);
                 end;
@@ -1653,9 +1653,9 @@ Begin
   Message1(asmr_d_start_reading,'intel');
   inexpression:=FALSE;
   firsttoken:=TRUE;
-  if assigned(procinfo^.retdef) and
-     (is_fpu(procinfo^.retdef) or
-     ret_in_acc(procinfo^.retdef)) then
+  if assigned(procinfo^.returntype.def) and
+     (is_fpu(procinfo^.returntype.def) or
+     ret_in_acc(procinfo^.returntype.def)) then
     procinfo^.funcret_state:=vs_assigned;
  { sets up all opcode and register tables in uppercase }
   if not _asmsorted then
@@ -1772,7 +1772,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.53  1999-11-17 17:05:03  pierre
+  Revision 1.54  1999-11-30 10:40:53  peter
+    + ttype, tsymlist
+
+  Revision 1.53  1999/11/17 17:05:03  pierre
    * Notes/hints changes
 
   Revision 1.52  1999/11/09 23:06:46  peter

+ 37 - 34
compiler/rautils.pas

@@ -677,10 +677,10 @@ Function TOperand.SetupResult:boolean;
 Begin
   SetupResult:=false;
   { replace by correct offset. }
-  if assigned(procinfo^.retdef) and
-     (procinfo^.retdef<>pdef(voiddef)) then
+  if assigned(procinfo^.returntype.def) and
+     (procinfo^.returntype.def<>pdef(voiddef)) then
    begin
-     opr.ref.offset:=procinfo^.retoffset;
+     opr.ref.offset:=procinfo^.return_offset;
      opr.ref.base:= procinfo^.framepointer;
      { always assume that the result is valid. }
      procinfo^.funcret_state:=vs_assigned;
@@ -779,7 +779,7 @@ Begin
                 end;
             end;
         end;
-        case pvarsym(sym)^.definition^.deftype of
+        case pvarsym(sym)^.vartype.def^.deftype of
           orddef,
           enumdef,
           pointerdef,
@@ -789,10 +789,10 @@ Begin
             begin
               { for arrays try to get the element size, take care of
                 multiple indexes }
-              harrdef:=Parraydef(PVarsym(sym)^.definition);
-              while assigned(harrdef^.definition) and
-                    (harrdef^.definition^.deftype=arraydef) do
-               harrdef:=parraydef(harrdef^.definition);
+              harrdef:=Parraydef(PVarsym(sym)^.vartype.def);
+              while assigned(harrdef^.elementtype.def) and
+                    (harrdef^.elementtype.def^.deftype=arraydef) do
+               harrdef:=parraydef(harrdef^.elementtype.def);
               SetSize(harrdef^.elesize);
             end;
         end;
@@ -803,7 +803,7 @@ Begin
     typedconstsym :
       begin
         opr.ref.symbol:=newasmsymbol(ptypedconstsym(sym)^.mangledname);
-        case ptypedconstsym(sym)^.definition^.deftype of
+        case ptypedconstsym(sym)^.typedconsttype.def^.deftype of
           orddef,
           enumdef,
           pointerdef,
@@ -813,10 +813,10 @@ Begin
             begin
               { for arrays try to get the element size, take care of
                 multiple indexes }
-              harrdef:=Parraydef(PTypedConstSym(sym)^.definition);
-              while assigned(harrdef^.definition) and
-                    (harrdef^.definition^.deftype=arraydef) do
-               harrdef:=parraydef(harrdef^.definition);
+              harrdef:=Parraydef(PTypedConstSym(sym)^.typedconsttype.def);
+              while assigned(harrdef^.elementtype.def) and
+                    (harrdef^.elementtype.def^.deftype=arraydef) do
+               harrdef:=parraydef(harrdef^.elementtype.def);
               SetSize(harrdef^.elesize);
             end;
         end;
@@ -826,7 +826,7 @@ Begin
       end;
     constsym :
       begin
-        if pconstsym(sym)^.consttype in [constint,constchar,constbool] then
+        if pconstsym(sym)^.consttyp in [constint,constchar,constbool] then
          begin
            opr.typ:=OPR_CONSTANT;
            opr.val:=pconstsym(sym)^.value;
@@ -837,7 +837,7 @@ Begin
       end;
     typesym :
       begin
-        if ptypesym(sym)^.definition^.deftype in [recorddef,objectdef] then
+        if ptypesym(sym)^.restype.def^.deftype in [recorddef,objectdef] then
          begin
            opr.typ:=OPR_CONSTANT;
            opr.val:=0;
@@ -1084,7 +1084,7 @@ Begin
      case srsym^.typ of
        typesym :
          begin
-           if ptypesym(srsym)^.definition^.deftype in [recorddef,objectdef] then
+           if ptypesym(srsym)^.restype.def^.deftype in [recorddef,objectdef] then
             begin
               SearchRecordType:=true;
               exit;
@@ -1126,7 +1126,7 @@ Begin
      case srsym^.typ of
        constsym :
          begin
-           if (pconstsym(srsym)^.consttype in [constord,constint,constchar,constbool]) then
+           if (pconstsym(srsym)^.consttyp in [constord,constint,constchar,constbool]) then
             Begin
               l:=pconstsym(srsym)^.value;
               SearchIConstant:=TRUE;
@@ -1175,29 +1175,29 @@ Begin
      case sym^.typ of
        varsym :
          begin
-           case pvarsym(sym)^.definition^.deftype of
+           case pvarsym(sym)^.vartype.def^.deftype of
              recorddef :
-               st:=precorddef(pvarsym(sym)^.definition)^.symtable;
+               st:=precorddef(pvarsym(sym)^.vartype.def)^.symtable;
              objectdef :
-               st:=pobjectdef(pvarsym(sym)^.definition)^.symtable;
+               st:=pobjectdef(pvarsym(sym)^.vartype.def)^.symtable;
            end;
          end;
        typesym :
          begin
-           case ptypesym(sym)^.definition^.deftype of
+           case ptypesym(sym)^.restype.def^.deftype of
              recorddef :
-               st:=precorddef(ptypesym(sym)^.definition)^.symtable;
+               st:=precorddef(ptypesym(sym)^.restype.def)^.symtable;
              objectdef :
-               st:=pobjectdef(ptypesym(sym)^.definition)^.symtable;
+               st:=pobjectdef(ptypesym(sym)^.restype.def)^.symtable;
            end;
          end;
        typedconstsym :
          begin
-           case pvarsym(sym)^.definition^.deftype of
+           case ptypedconstsym(sym)^.typedconsttype.def^.deftype of
              recorddef :
-               st:=precorddef(ptypedconstsym(sym)^.definition)^.symtable;
+               st:=precorddef(ptypedconstsym(sym)^.typedconsttype.def)^.symtable;
              objectdef :
-               st:=pobjectdef(ptypedconstsym(sym)^.definition)^.symtable;
+               st:=pobjectdef(ptypedconstsym(sym)^.typedconsttype.def)^.symtable;
            end;
          end;
      end;
@@ -1223,21 +1223,21 @@ Begin
          begin
            inc(Offset,pvarsym(sym)^.address);
            Size:=PVarsym(sym)^.getsize;
-           case pvarsym(sym)^.definition^.deftype of
+           case pvarsym(sym)^.vartype.def^.deftype of
              arraydef :
                begin
                  { for arrays try to get the element size, take care of
                    multiple indexes }
-                 harrdef:=Parraydef(PVarsym(sym)^.definition);
-                 while assigned(harrdef^.definition) and
-                       (harrdef^.definition^.deftype=arraydef) do
-                  harrdef:=parraydef(harrdef^.definition);
+                 harrdef:=Parraydef(PVarsym(sym)^.vartype.def);
+                 while assigned(harrdef^.elementtype.def) and
+                       (harrdef^.elementtype.def^.deftype=arraydef) do
+                  harrdef:=parraydef(harrdef^.elementtype.def);
                  size:=harrdef^.elesize;
                end;
              recorddef :
-               st:=precorddef(pvarsym(sym)^.definition)^.symtable;
+               st:=precorddef(pvarsym(sym)^.vartype.def)^.symtable;
              objectdef :
-               st:=pobjectdef(pvarsym(sym)^.definition)^.symtable;
+               st:=pobjectdef(pvarsym(sym)^.vartype.def)^.symtable;
            end;
          end;
      end;
@@ -1438,7 +1438,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.30  1999-11-17 17:05:04  pierre
+  Revision 1.31  1999-11-30 10:40:54  peter
+    + ttype, tsymlist
+
+  Revision 1.30  1999/11/17 17:05:04  pierre
    * Notes/hints changes
 
   Revision 1.29  1999/11/09 23:06:46  peter

+ 16 - 2
compiler/symconst.pas

@@ -143,7 +143,8 @@ type
     ppo_indexed,
     ppo_defaultproperty,
     ppo_stored,
-    ppo_hasparameters
+    ppo_hasparameters,
+    ppo_is_override
   );
   tpropertyoptions=set of tpropertyoption;
 
@@ -155,6 +156,7 @@ type
     vo_is_dll_var,
     vo_is_thread_var,
     vo_fpuregable,
+    vo_is_local_copy,
     vo_is_const  { variable is declared as const (parameter) and can't be written to }
   );
   tvaroptions=set of tvaroption;
@@ -177,6 +179,15 @@ type
     vs_set_but_first_not_passed,vs_assigned,vs_used
   );
 
+  absolutetyp = (tovar,toasm,toaddr);
+
+  tconsttyp = (constnone,
+    constord,conststring,constreal,constbool,
+    constint,constchar,constset,constpointer,constnil,
+    constresourcestring
+  );
+
+
 const
   { relevant options for assigning a proc or a procvar to a procvar }
   po_compatibility_options = [
@@ -201,7 +212,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  1999-11-17 17:05:04  pierre
+  Revision 1.7  1999-11-30 10:40:54  peter
+    + ttype, tsymlist
+
+  Revision 1.6  1999/11/17 17:05:04  pierre
    * Notes/hints changes
 
   Revision 1.5  1999/11/07 23:16:49  florian

Những thai đổi đã bị hủy bỏ vì nó quá lớn
+ 233 - 208
compiler/symdef.inc


+ 28 - 21
compiler/symdefh.inc

@@ -24,10 +24,9 @@
                     TDef
 ************************************************}
 
-       pdef = ^tdef;
        tdef = object(tsymtableentry)
-          deftype   : tdeftype;
-          sym       : ptypesym;  { which type the definition was generated this def }
+          deftype    : tdeftype;
+          typesym    : ptypesym;  { which type the definition was generated this def }
 
           has_inittable : boolean;
           { adress of init informations }
@@ -92,21 +91,23 @@
 
        pparaitem = ^tparaitem;
        tparaitem = object(tlinkedlist_item)
-          data         : pdef;
-          datasym      : ptypesym;
+          paratype     : ttype;
           paratyp      : tvarspez;
           argconvtyp   : targconvtyp;
           convertlevel : byte;
           register     : tregister;
        end;
 
-       tfiletype = (ft_text,ft_typed,ft_untyped);
+       tfiletyp = (ft_text,ft_typed,ft_untyped);
 
        pfiledef = ^tfiledef;
        tfiledef = object(tdef)
-          filetype : tfiletype;
-          typed_as : pdef;
-          constructor init(ft : tfiletype;tas : pdef);
+          filetyp : tfiletyp;
+          typedfiletype : ttype;
+          constructor inittext;
+          constructor inituntyped;
+          constructor inittyped(const tt : ttype);
+          constructor inittypeddef(p : pdef);
           constructor load;
           procedure write;virtual;
           procedure deref;virtual;
@@ -156,11 +157,12 @@
 
        ppointerdef = ^tpointerdef;
        tpointerdef = object(tdef)
-          definition : pdef;
-          defsym : ptypesym;
+          pointertype : ttype;
           is_far : boolean;
-          constructor init(def : pdef);
-          constructor initfar(def : pdef);
+          constructor init(const tt : ttype);
+          constructor initfar(const tt : ttype);
+          constructor initdef(p : pdef);
+          constructor initfardef(p : pdef);
           constructor load;
           destructor  done;virtual;
           procedure write;virtual;
@@ -234,8 +236,8 @@
        public
           lowrange,
           highrange  : longint;
-          definition : pdef;
-          rangedef   : pdef;
+          elementtype,
+          rangetype  : ttype;
           IsVariant,
           IsConstructor,
           IsArrayOfConst : boolean;
@@ -289,8 +291,10 @@
 
        porddef = ^torddef;
        torddef = object(tdef)
-          low,high : longint;
+        private
           rangenr  : longint;
+        public
+          low,high : longint;
           typ      : tbasetype;
           constructor init(t : tbasetype;v,b : longint);
           constructor load;
@@ -330,7 +334,7 @@
        pabstractprocdef = ^tabstractprocdef;
        tabstractprocdef = object(tdef)
           { saves a definition to the return type }
-          retdef          : pdef;
+          rettype         : ttype;
           proctypeoption  : tproctypeoption;
           proccalloptions : tproccalloptions;
           procoptions     : tprocoptions;
@@ -342,8 +346,7 @@
           destructor done;virtual;
           procedure  write;virtual;
           procedure deref;virtual;
-          procedure concatdef(p : pdef;vsp : tvarspez);
-          procedure concattypesym(p : ptypesym;vsp : tvarspez);
+          procedure concatpara(tt:ttype;vsp : tvarspez);
           function  para_size : longint;
           function  demangled_paras : string;
           function  proccalloption2str : string;
@@ -505,10 +508,11 @@
 
        psetdef = ^tsetdef;
        tsetdef = object(tdef)
-          setof   : pdef;
+          elementtype : ttype;
           settype : tsettype;
           constructor init(s : pdef;high : longint);
           constructor load;
+          destructor  done;virtual;
           procedure write;virtual;
           procedure deref;virtual;
           function  gettypename:string;virtual;
@@ -525,7 +529,10 @@
 
 {
   $Log$
-  Revision 1.47  1999-11-17 17:05:04  pierre
+  Revision 1.48  1999-11-30 10:40:55  peter
+    + ttype, tsymlist
+
+  Revision 1.47  1999/11/17 17:05:04  pierre
    * Notes/hints changes
 
   Revision 1.46  1999/11/09 23:35:50  pierre

+ 8 - 24
compiler/symppu.inc

@@ -132,6 +132,10 @@
                   globalsymtable,
                   unitsymtable :
                     begin
+                      { check if the unit is available in the uses
+                        clause, else it's an error }
+                      if p^.owner^.unitid=$ffff then
+                       internalerror(55665566);
                       current_ppu^.putbyte(ord(derefunit));
                       current_ppu^.putword(p^.owner^.unitid);
                       break;
@@ -179,7 +183,6 @@
         writederef(p);
       end;
 
-
     procedure writesourcefiles;
       var
         hp    : pinputfile;
@@ -455,7 +458,6 @@
       end;
 
 
-{$ifndef OLDDEREF}
     function readderef : pderef;
       var
         hp,p : pderef;
@@ -499,27 +501,6 @@
       begin
         readsymref:=psym(readderef);
       end;
-{$else}
-    function readdefref : pdef;
-      var
-        hd : pdef;
-      begin
-        longint(hd):=current_ppu^.getword;
-        longint(hd):=longint(hd) or (longint(current_ppu^.getword) shl 16);
-        readdefref:=hd;
-      end;
-
-
-    function readsymref : psym;
-      var
-        hd : psym;
-      begin
-        longint(hd):=current_ppu^.getword;
-        longint(hd):=longint(hd) or (longint(current_ppu^.getword) shl 16);
-        readsymref:=hd;
-      end;
-{$endif}
-
 
     procedure readusedmacros;
       var
@@ -753,7 +734,10 @@
 
 {
   $Log$
-  Revision 1.56  1999-11-21 01:42:37  pierre
+  Revision 1.57  1999-11-30 10:40:55  peter
+    + ttype, tsymlist
+
+  Revision 1.56  1999/11/21 01:42:37  pierre
    * Nextoverloading ordering fix
 
   Revision 1.55  1999/11/17 17:05:04  pierre

Những thai đổi đã bị hủy bỏ vì nó quá lớn
+ 214 - 301
compiler/symsym.inc


+ 37 - 47
compiler/symsymh.inc

@@ -25,7 +25,6 @@
 ************************************************}
 
        { this object is the base for all symbol objects }
-       psym = ^tsym;
        tsym = object(tsymtableentry)
           typ        : tsymtyp;
           symoptions : tsymoptions;
@@ -103,9 +102,7 @@
 {$ifdef CHAINPROCSYMS}
           nextprocsym : pprocsym;
 {$endif CHAINPROCSYMS}
-{$ifdef GDB}
-          is_global   : boolean; { necessary for stab }
-{$endif GDB}
+          is_global   : boolean;
           constructor init(const n : string);
           constructor load;
           destructor done;virtual;
@@ -131,12 +128,13 @@
        end;
 
        ttypesym = object(tsym)
-          definition : pdef;
+          restype    : ttype;
           synonym    : ptypesym;
 {$ifdef GDB}
           isusedinstab : boolean;
 {$endif GDB}
-          constructor init(const n : string;d : pdef);
+          constructor init(const n : string;const tt : ttype);
+          constructor initdef(const n : string;d : pdef);
           constructor load;
           destructor done;virtual;
           procedure write;virtual;
@@ -156,19 +154,15 @@
        tvarsym = object(tsym)
           address       : longint;
           localvarsym   : pvarsym;
-          islocalcopy   : boolean;
-          definition    : pdef;
-          definitionsym : ptypesym;
+          vartype       : ttype;
           varoptions    : tvaroptions;
           reg           : tregister; { if reg<>R_NO, then the variable is an register variable }
           varspez       : tvarspez;  { sets the type of access }
           varstate      : tvarstate;
-          constructor init(const n : string;p : pdef);
-          constructor init_dll(const n : string;p : pdef);
-          constructor init_C(const n,mangled : string;p : pdef);
-          constructor initsym(const n : string;p : ptypesym);
-          constructor initsym_dll(const n : string;p : ptypesym);
-          constructor initsym_C(const n,mangled : string;p : ptypesym);
+          constructor init(const n : string;const tt : ttype);
+          constructor init_dll(const n : string;const tt : ttype);
+          constructor init_C(const n,mangled : string;const tt : ttype);
+          constructor initdef(const n : string;p : pdef);
           constructor load;
           destructor  done;virtual;
           procedure write;virtual;
@@ -186,26 +180,24 @@
           _mangledname  : pchar;
        end;
 
-       ppropsymlist = ^tpropsymlist;
-       tpropsymlist = record
-         sym  : psym;
-         next : ppropsymlist;
-       end;
-
        ppropertysym = ^tpropertysym;
        tpropertysym = object(tsym)
-          propoptions : tpropertyoptions;
-          proptype    : pdef;
-          proptypesym : ppropertysym;
-          readaccesssym,writeaccesssym,storedsym : ppropsymlist;
-          readaccessdef,writeaccessdef,storeddef,indexdef : pdef;
-          index,default : longint;
+          propoptions   : tpropertyoptions;
+          proptype      : ttype;
+          propoverriden : ppropertysym;
+          indextype     : ttype;
+          index,
+          default       : longint;
+          readaccess,
+          writeaccess,
+          storedaccess  : psymlist;
           constructor init(const n : string);
           destructor  done;virtual;
           constructor load;
           function  getsize : longint;virtual;
           procedure write;virtual;
           procedure deref;virtual;
+          procedure dooverride(overriden:ppropertysym);
 {$ifdef GDB}
           function  stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
@@ -215,10 +207,11 @@
        pfuncretsym = ^tfuncretsym;
        tfuncretsym = object(tsym)
           funcretprocinfo : pointer{ should be pprocinfo};
-          funcretdef : pdef;
-          address    : longint;
+          rettype  : ttype;
+          address  : longint;
           constructor init(const n : string;approcinfo : pointer{pprocinfo});
           constructor load;
+          destructor  done;virtual;
           procedure write;virtual;
           procedure deref;virtual;
           procedure insert_in_data;virtual;
@@ -227,15 +220,14 @@
 {$endif GDB}
        end;
 
-       absolutetyp = (tovar,toasm,toaddr);
-
        pabsolutesym = ^tabsolutesym;
        tabsolutesym = object(tvarsym)
           abstyp  : absolutetyp;
           absseg  : boolean;
           ref     : psym;
           asmname : pstring;
-          constructor init(const n : string;p : pdef);
+          constructor init(const n : string;const tt : ttype);
+          constructor initdef(const n : string;p : pdef);
           constructor load;
           procedure deref;virtual;
           function  mangledname : string;virtual;
@@ -249,11 +241,10 @@
        ptypedconstsym = ^ttypedconstsym;
        ttypedconstsym = object(tsym)
           prefix          : pstring;
-          definition      : pdef;
-          definitionsym   : ptypesym;
+          typedconsttype  : ttype;
           is_really_const : boolean;
           constructor init(const n : string;p : pdef;really_const : boolean);
-          constructor initsym(const n : string;p : ptypesym;really_const : boolean);
+          constructor inittype(const n : string;const tt : ttype;really_const : boolean);
           constructor load;
           destructor done;virtual;
           function  mangledname : string;virtual;
@@ -266,20 +257,16 @@
 {$endif GDB}
        end;
 
-       tconsttype = (constord,conststring,constreal,constbool,
-                     constint,constchar,constset,constpointer,constnil,
-                     constresourcestring);
-
        pconstsym = ^tconstsym;
        tconstsym = object(tsym)
-          definition : pdef;
-          consttype  : tconsttype;
+          consttype  : ttype;
+          consttyp : tconsttyp;
           resstrindex,    { needed for resource strings }
           value,
           len        : longint; { len is needed for string length }
-          constructor init(const n : string;t : tconsttype;v : longint);
-          constructor init_def(const n : string;t : tconsttype;v : longint;def : pdef);
-          constructor init_string(const n : string;t : tconsttype;str:pchar;l:longint);
+          constructor init(const n : string;t : tconsttyp;v : longint);
+          constructor init_def(const n : string;t : tconsttyp;v : longint;def : pdef);
+          constructor init_string(const n : string;t : tconsttyp;str:pchar;l:longint);
           constructor load;
           destructor  done;virtual;
           function  mangledname : string;virtual;
@@ -324,7 +311,10 @@
 
 {
   $Log$
-  Revision 1.41  1999-11-26 00:19:12  peter
+  Revision 1.42  1999-11-30 10:40:56  peter
+    + ttype, tsymlist
+
+  Revision 1.41  1999/11/26 00:19:12  peter
     * property overriding dereference fix, but it need a bigger redesign
       which i'll do tomorrow. This quick hack is for the lazarus ppl so
       they can hack on mwcustomedit.
@@ -389,8 +379,8 @@
     * NEWLAB for label as symbol
 
   Revision 1.24  1999/05/20 22:22:45  pierre
-    + added synonym filed for ttypesym
-      allows a clean disposal of tdefs and related ttypesyms
+    + added synonym filed for ptypesym
+      allows a clean disposal of tdefs and related ptypesyms
 
   Revision 1.23  1999/05/13 21:59:47  peter
     * removed oldppu code

+ 320 - 89
compiler/symtable.pas

@@ -20,7 +20,7 @@
  ****************************************************************************
 }
 {$ifdef TP}
-  {$N+,E+,F+}
+  {$N+,E+,F+,L-}
 {$endif}
 unit symtable;
 
@@ -66,6 +66,8 @@ unit symtable;
        punitsymtable = ^tunitsymtable;
 
        { needed for names by the definitions }
+       psym = ^tsym;
+       pdef = ^tdef;
        ptypesym = ^ttypesym;
        penumsym = ^tenumsym;
        pprocsym = ^tprocsym;
@@ -94,6 +96,40 @@ unit symtable;
         destructor  done;
       end;
 
+      ttype = object
+        def : pdef;
+        sym : psym;
+        procedure reset;
+        procedure setdef(p:pdef);
+        procedure setsym(p:psym);
+        procedure load;
+        procedure write;
+        procedure resolve;
+      end;
+
+      psymlistitem = ^tsymlistitem;
+      tsymlistitem = record
+        sym  : psym;
+        next : psymlistitem;
+      end;
+
+      psymlist = ^tsymlist;
+      tsymlist = object
+        def      : pdef;
+        firstsym,
+        lastsym  : psymlistitem;
+        constructor init;
+        constructor load;
+        destructor  done;
+        function  empty:boolean;
+        procedure setdef(p:pdef);
+        procedure addsym(p:psym);
+        procedure clear;
+        function  getcopy:psymlist;
+        procedure resolve;
+        procedure write;
+      end;
+
       psymtableentry = ^tsymtableentry;
       tsymtableentry = object(tnamedindexobject)
         owner      : psymtable;
@@ -624,34 +660,11 @@ implementation
        end;
 
 
-{****************************************************************************
-                               TRef
-****************************************************************************}
-
-    constructor tref.init(ref :pref;pos : pfileposinfo);
-      begin
-        nextref:=nil;
-        if pos<>nil then
-          posinfo:=pos^;
-        if assigned(current_module) then
-          moduleindex:=current_module^.unit_index;
-        if assigned(ref) then
-          ref^.nextref:=@self;
-        is_written:=false;
-      end;
-
+{*****************************************************************************
+                               PPU Reading Writing
+*****************************************************************************}
 
-    destructor tref.done;
-      var
-         inputfile : pinputfile;
-      begin
-         inputfile:=get_source_file(moduleindex,posinfo.fileindex);
-         if inputfile<>nil then
-           dec(inputfile^.ref_count);
-         if assigned(nextref) then
-          dispose(nextref,done);
-         nextref:=nil;
-      end;
+{$I symppu.inc}
 
 
 {****************************************************************************
@@ -671,48 +684,6 @@ implementation
       end;
 
 
-{*****************************************************************************
-                           PPU Reading Writing
-*****************************************************************************}
-
-{$I symppu.inc}
-
-
-{*****************************************************************************
-                            Definition Helpers
-*****************************************************************************}
-
-    function globaldef(const s : string) : pdef;
-
-      var st : string;
-          symt : psymtable;
-      begin
-         srsym := nil;
-         if pos('.',s) > 0 then
-           begin
-           st := copy(s,1,pos('.',s)-1);
-           getsym(st,false);
-           st := copy(s,pos('.',s)+1,255);
-           if assigned(srsym) then
-             begin
-             if srsym^.typ = unitsym then
-               begin
-               symt := punitsym(srsym)^.unitsymtable;
-               srsym := symt^.search(st);
-               end else srsym := nil;
-             end;
-           end else st := s;
-         if srsym = nil then getsym(st,false);
-         if srsym = nil then
-           getsymonlyin(systemunit,st);
-         if srsym^.typ<>typesym then
-           begin
-             Message(type_e_type_id_expected);
-             exit;
-           end;
-         globaldef := ptypesym(srsym)^.definition;
-      end;
-
 {*****************************************************************************
                         Symbol / Definition Resolving
 *****************************************************************************}
@@ -821,6 +792,263 @@ implementation
       end;
 
 
+
+{****************************************************************************
+                               TRef
+****************************************************************************}
+
+    constructor tref.init(ref :pref;pos : pfileposinfo);
+      begin
+        nextref:=nil;
+        if pos<>nil then
+          posinfo:=pos^;
+        if assigned(current_module) then
+          moduleindex:=current_module^.unit_index;
+        if assigned(ref) then
+          ref^.nextref:=@self;
+        is_written:=false;
+      end;
+
+
+    destructor tref.done;
+      var
+         inputfile : pinputfile;
+      begin
+         inputfile:=get_source_file(moduleindex,posinfo.fileindex);
+         if inputfile<>nil then
+           dec(inputfile^.ref_count);
+         if assigned(nextref) then
+          dispose(nextref,done);
+         nextref:=nil;
+      end;
+
+
+{****************************************************************************
+                                   TType
+****************************************************************************}
+
+    procedure ttype.reset;
+      begin
+        def:=nil;
+        sym:=nil;
+      end;
+
+
+    procedure ttype.setdef(p:pdef);
+      begin
+        def:=p;
+        sym:=nil;
+      end;
+
+
+    procedure ttype.setsym(p:psym);
+      begin
+        sym:=p;
+        case p^.typ of
+          typesym :
+            def:=ptypesym(p)^.restype.def;
+          propertysym :
+            def:=ppropertysym(p)^.proptype.def;
+          else
+            internalerror(1234005);
+        end;
+      end;
+
+
+    procedure ttype.load;
+      begin
+        def:=pdef(readderef);
+        sym:=psym(readderef);
+      end;
+
+
+    procedure ttype.write;
+      begin
+        if assigned(sym) then
+         begin
+           writederef(nil);
+           writederef(sym);
+         end
+        else
+         begin
+           writederef(def);
+           writederef(nil);
+         end;
+      end;
+
+
+    procedure ttype.resolve;
+      begin
+        if assigned(sym) then
+         begin
+           resolvesym(sym);
+           setsym(sym);
+         end
+        else
+         resolvedef(def);
+      end;
+
+
+{****************************************************************************
+                                    TSymList
+****************************************************************************}
+
+    constructor tsymlist.init;
+      begin
+        def:=nil; { needed for procedures }
+        firstsym:=nil;
+        lastsym:=nil;
+      end;
+
+
+    constructor tsymlist.load;
+      var
+        sym : psym;
+      begin
+        def:=readdefref;
+        firstsym:=nil;
+        lastsym:=nil;
+        repeat
+          sym:=readsymref;
+          if sym=nil then
+           break;
+          addsym(sym);
+        until false;
+      end;
+
+
+    destructor tsymlist.done;
+      begin
+        clear;
+      end;
+
+
+    function tsymlist.empty:boolean;
+      begin
+        empty:=(firstsym=nil);
+      end;
+
+
+    procedure tsymlist.clear;
+      var
+        hp : psymlistitem;
+      begin
+        while assigned(firstsym) do
+         begin
+           hp:=firstsym;
+           firstsym:=firstsym^.next;
+           dispose(hp);
+         end;
+        firstsym:=nil;
+        lastsym:=nil;
+        def:=nil;
+      end;
+
+
+    procedure tsymlist.setdef(p:pdef);
+      begin
+        def:=p;
+      end;
+
+
+    procedure tsymlist.addsym(p:psym);
+      var
+        hp : psymlistitem;
+      begin
+        if not assigned(p) then
+         exit;
+        new(hp);
+        hp^.sym:=p;
+        hp^.next:=nil;
+        if assigned(lastsym) then
+         lastsym^.next:=hp
+        else
+         firstsym:=hp;
+        lastsym:=hp;
+      end;
+
+
+    function tsymlist.getcopy:psymlist;
+      var
+        hp : psymlist;
+        hp2 : psymlistitem;
+      begin
+        new(hp,init);
+        hp^.def:=def;
+        hp2:=firstsym;
+        while assigned(hp2) do
+         begin
+           hp^.addsym(hp2^.sym);
+           hp2:=hp2^.next;
+         end;
+        getcopy:=hp;
+      end;
+
+
+    procedure tsymlist.write;
+      var
+        hp : psymlistitem;
+      begin
+        writederef(def);
+        hp:=firstsym;
+        while assigned(hp) do
+         begin
+           writederef(hp^.sym);
+           hp:=hp^.next;
+         end;
+        writederef(nil);
+      end;
+
+
+    procedure tsymlist.resolve;
+      var
+        hp : psymlistitem;
+      begin
+        resolvedef(def);
+        hp:=firstsym;
+        while assigned(hp) do
+         begin
+           resolvesym(hp^.sym);
+           hp:=hp^.next;
+         end;
+      end;
+
+
+{*****************************************************************************
+                            Definition Helpers
+*****************************************************************************}
+
+    function globaldef(const s : string) : pdef;
+
+      var st : string;
+          symt : psymtable;
+      begin
+         srsym := nil;
+         if pos('.',s) > 0 then
+           begin
+           st := copy(s,1,pos('.',s)-1);
+           getsym(st,false);
+           st := copy(s,pos('.',s)+1,255);
+           if assigned(srsym) then
+             begin
+             if srsym^.typ = unitsym then
+               begin
+               symt := punitsym(srsym)^.unitsymtable;
+               srsym := symt^.search(st);
+               end else srsym := nil;
+             end;
+           end else st := s;
+         if srsym = nil then getsym(st,false);
+         if srsym = nil then
+           getsymonlyin(systemunit,st);
+         if srsym^.typ<>typesym then
+           begin
+             Message(type_e_type_id_expected);
+             exit;
+           end;
+         globaldef := ptypesym(srsym)^.restype.def;
+      end;
+
 {*****************************************************************************
                         Symbol Call Back Functions
 *****************************************************************************}
@@ -845,9 +1073,9 @@ implementation
          { because each object has to have a type sym }
          else
           if (psym(sym)^.typ=typesym) and
-             assigned(ptypesym(sym)^.definition) and
-             (ptypesym(sym)^.definition^.deftype=objectdef) then
-           pobjectdef(ptypesym(sym)^.definition)^.check_forwards;
+             assigned(ptypesym(sym)^.restype.def) and
+             (ptypesym(sym)^.restype.def^.deftype=objectdef) then
+           pobjectdef(ptypesym(sym)^.restype.def)^.check_forwards;
       end;
 
     procedure labeldefined(p : pnamedindexobject);
@@ -886,7 +1114,7 @@ implementation
              exit;
            if (pvarsym(p)^.refs=0) then
              begin
-                if (psym(p)^.owner^.symtabletype=parasymtable) or pvarsym(p)^.islocalcopy then
+                if (psym(p)^.owner^.symtabletype=parasymtable) or (vo_is_local_copy in pvarsym(p)^.varoptions) then
                   begin
                     MessagePos1(psym(p)^.fileinfo,sym_h_para_identifier_not_used,p^.name);
                   end
@@ -902,7 +1130,7 @@ implementation
                     if (pvarsym(p)^.varspez<>vs_var)  then
                       MessagePos1(psym(p)^.fileinfo,sym_h_para_identifier_only_set,p^.name)
                   end
-                else if pvarsym(p)^.islocalcopy then
+                else if (vo_is_local_copy in pvarsym(p)^.varoptions) then
                   begin
                     if (pvarsym(p)^.varspez<>vs_var) then
                       MessagePos1(psym(p)^.fileinfo,sym_h_para_identifier_only_set,p^.name);
@@ -940,8 +1168,8 @@ implementation
     procedure objectprivatesymbolused(p : pnamedindexobject);
       begin
          if (psym(p)^.typ=typesym) and
-            (ptypesym(p)^.definition^.deftype=objectdef) then
-           pobjectdef(ptypesym(p)^.definition)^.symtable^.foreach(
+            (ptypesym(p)^.restype.def^.deftype=objectdef) then
+           pobjectdef(ptypesym(p)^.restype.def)^.symtable^.foreach(
              {$ifndef TP}@{$endif}TestPrivate);
       end;
 
@@ -965,8 +1193,8 @@ implementation
       begin
         if not pd^.is_def_stab_written then
          begin
-           if assigned(pd^.sym) then
-            pd^.sym^.isusedinstab := true;
+           if assigned(pd^.typesym) then
+            pd^.typesym^.isusedinstab := true;
            pd^.concatstabto(asmlist);
          end;
       end;
@@ -1619,11 +1847,11 @@ implementation
            end;
          { register definition of typesym }
          if (sym^.typ = typesym) and
-            assigned(ptypesym(sym)^.definition) then
+            assigned(ptypesym(sym)^.restype.def) then
           begin
-            if not(assigned(ptypesym(sym)^.definition^.owner)) and
-               (ptypesym(sym)^.definition^.deftype<>errordef) then
-              registerdef(ptypesym(sym)^.definition);
+            if not(assigned(ptypesym(sym)^.restype.def^.owner)) and
+               (ptypesym(sym)^.restype.def^.deftype<>errordef) then
+              registerdef(ptypesym(sym)^.restype.def);
 {$ifdef GDB}
             if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
                (symtabletype in [globalsymtable,staticsymtable]) then
@@ -1809,8 +2037,8 @@ implementation
            else
              begin
                 if (symtabletype=recordsymtable) and
-                  assigned(defowner^.sym) then
-                  Browserlog.AddLog('---Symtable '+defowner^.sym^.name)
+                  assigned(defowner^.typesym) then
+                  Browserlog.AddLog('---Symtable '+defowner^.typesym^.name)
                 else
                   Browserlog.AddLog('---Symtable with no name');
              end;
@@ -2244,7 +2472,7 @@ implementation
              Message(type_e_type_id_expected);
              exit;
            end;
-         typeglobalnumber := ptypesym(srsym)^.definition^.numberstring;
+         typeglobalnumber := ptypesym(srsym)^.restype.def^.numberstring;
          make_ref:=old_make_ref;
       end;
 {$endif GDB}
@@ -2271,8 +2499,8 @@ implementation
         while assigned(def) do
           begin
 {$ifdef GDB}
-            if assigned(def^.sym) then
-              def^.sym^.isusedinstab:=false;
+            if assigned(def^.typesym) then
+              def^.typesym^.isusedinstab:=false;
             def^.is_def_stab_written:=false;
 {$endif GDB}
             {if not current_module^.in_implementation then}
@@ -2566,7 +2794,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.67  1999-11-24 11:41:05  pierre
+  Revision 1.68  1999-11-30 10:40:56  peter
+    + ttype, tsymlist
+
+  Revision 1.67  1999/11/24 11:41:05  pierre
    * defaultsymtablestack is now restored after parser.compile
 
   Revision 1.66  1999/11/22 00:23:09  pierre

+ 6 - 3
compiler/t_os2.pas

@@ -291,14 +291,14 @@ procedure timportlibos2.importprocedure(const func,module:string;index:longint;c
  index      = Index of function in DLL. Use 0 to import by name.
  name       = Name of function in DLL. Ignored when index=0;}
 var tmp1,tmp2,tmp3:string;
-    sym_mcount,sym_entry,sym_import:longint;
+    sym_mcount,sym_import:longint;
     fixup_mcount,fixup_import:longint;
 begin
     aout_init;
     tmp2:=func;
     if profile_flag and not (copy(func,1,4)='_16_') then
         begin
-            sym_entry:=aout_sym(func,n_text+n_ext,0,0,aout_text_size);
+            {sym_entry:=aout_sym(func,n_text+n_ext,0,0,aout_text_size);}
             sym_mcount:=aout_sym('__mcount',n_ext,0,0,0);
             {Use, say, "_$U_DosRead" for "DosRead" to import the
              non-profiled function.}
@@ -485,7 +485,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  1999-11-29 20:15:29  hajny
+  Revision 1.6  1999-11-30 10:40:56  peter
+    + ttype, tsymlist
+
+  Revision 1.5  1999/11/29 20:15:29  hajny
     * missing space in EMXBIND params
 
   Revision 1.4  1999/11/16 23:39:04  peter

+ 14 - 11
compiler/tcadd.pas

@@ -581,7 +581,7 @@ implementation
                  begin
                    if (rt=setelementn) then
                     begin
-                      if not(is_equal(psetdef(ld)^.setof,rd)) then
+                      if not(is_equal(psetdef(ld)^.elementtype.def,rd)) then
                        CGMessage(type_e_set_element_are_not_comp);
                     end
                    else
@@ -606,7 +606,7 @@ implementation
                    assigned(p^.right^.right) then
                  begin
                    { generate a temporary normset def }
-                   tempdef:=new(psetdef,init(psetdef(ld)^.setof,255));
+                   tempdef:=new(psetdef,init(psetdef(ld)^.elementtype.def,255));
                    p^.left:=gentypeconvnode(p^.left,tempdef);
                    firstpass(p^.left);
                    dispose(tempdef,done);
@@ -905,8 +905,8 @@ implementation
            if (rd^.deftype=classrefdef) and (ld^.deftype=classrefdef) then
             begin
               p^.location.loc:=LOC_REGISTER;
-              if pobjectdef(pclassrefdef(rd)^.definition)^.is_related(pobjectdef(
-                pclassrefdef(ld)^.definition)) then
+              if pobjectdef(pclassrefdef(rd)^.pointertype.def)^.is_related(pobjectdef(
+                pclassrefdef(ld)^.pointertype.def)) then
                 p^.right:=gentypeconvnode(p^.right,ld)
               else
                 p^.left:=gentypeconvnode(p^.left,rd);
@@ -999,7 +999,7 @@ implementation
             begin
               if is_zero_based_array(rd) then
                 begin
-                   p^.resulttype:=new(ppointerdef,init(parraydef(rd)^.definition));
+                   p^.resulttype:=new(ppointerdef,init(parraydef(rd)^.elementtype));
                    p^.right:=gentypeconvnode(p^.right,p^.resulttype);
                    firstpass(p^.right);
                 end;
@@ -1015,9 +1015,9 @@ implementation
                   { Dirty hack, to support multiple firstpasses (PFV) }
                   if (p^.resulttype=nil) and
                      (rd^.deftype=pointerdef) and
-                     (ppointerdef(rd)^.definition^.size>1) then
+                     (ppointerdef(rd)^.pointertype.def^.size>1) then
                    begin
-                     p^.left:=gennode(muln,p^.left,genordinalconstnode(ppointerdef(rd)^.definition^.size,s32bitdef));
+                     p^.left:=gennode(muln,p^.left,genordinalconstnode(ppointerdef(rd)^.pointertype.def^.size,s32bitdef));
                      firstpass(p^.left);
                    end;
                 end
@@ -1032,7 +1032,7 @@ implementation
             begin
               if is_zero_based_array(ld) then
                 begin
-                   p^.resulttype:=new(ppointerdef,init(parraydef(ld)^.definition));
+                   p^.resulttype:=new(ppointerdef,init(parraydef(ld)^.elementtype));
                    p^.left:=gentypeconvnode(p^.left,p^.resulttype);
                    firstpass(p^.left);
                 end;
@@ -1048,10 +1048,10 @@ implementation
                               { Dirty hack, to support multiple firstpasses (PFV) }
                               if (p^.resulttype=nil) and
                                  (ld^.deftype=pointerdef) and
-                                 (ppointerdef(ld)^.definition^.size>1) then
+                                 (ppointerdef(ld)^.pointertype.def^.size>1) then
                                begin
                                  p^.right:=gennode(muln,p^.right,
-                                   genordinalconstnode(ppointerdef(ld)^.definition^.size,s32bitdef));
+                                   genordinalconstnode(ppointerdef(ld)^.pointertype.def^.size,s32bitdef));
                                  firstpass(p^.right);
                                end;
                             end;
@@ -1187,7 +1187,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.57  1999-11-26 13:51:29  pierre
+  Revision 1.58  1999-11-30 10:40:56  peter
+    + ttype, tsymlist
+
+  Revision 1.57  1999/11/26 13:51:29  pierre
    * fix for overloading of shr shl mod and div
 
   Revision 1.56  1999/11/18 15:34:48  pierre

+ 46 - 43
compiler/tccal.pas

@@ -177,8 +177,8 @@ implementation
                 it here before the arrayconstructor node breaks the tree
                 with its conversions of enum->ord }
               if (p^.left^.treetype=arrayconstructn) and
-                 (defcoll^.data^.deftype=setdef) then
-                p^.left:=gentypeconvnode(p^.left,defcoll^.data);
+                 (defcoll^.paratype.def^.deftype=setdef) then
+                p^.left:=gentypeconvnode(p^.left,defcoll^.paratype.def);
 
               if do_count then
                begin
@@ -207,59 +207,59 @@ implementation
                end;
               { check if local proc/func is assigned to procvar }
               if p^.left^.resulttype^.deftype=procvardef then
-                test_local_to_procvar(pprocvardef(p^.left^.resulttype),defcoll^.data);
+                test_local_to_procvar(pprocvardef(p^.left^.resulttype),defcoll^.paratype.def);
               { property is not allowed as var parameter }
               if (defcoll^.paratyp=vs_var) and
                  (p^.left^.isproperty) then
                 CGMessagePos(p^.left^.fileinfo,type_e_argument_cant_be_assigned);
               { generate the high() value tree }
-              if push_high_param(defcoll^.data) then
-                gen_high_tree(p,is_open_string(defcoll^.data));
+              if push_high_param(defcoll^.paratype.def) then
+                gen_high_tree(p,is_open_string(defcoll^.paratype.def));
               if not(is_shortstring(p^.left^.resulttype) and
-                     is_shortstring(defcoll^.data)) and
-                     (defcoll^.data^.deftype<>formaldef) then
+                     is_shortstring(defcoll^.paratype.def)) and
+                     (defcoll^.paratype.def^.deftype<>formaldef) then
                 begin
                    if (defcoll^.paratyp=vs_var) and
                    { allows conversion from word to integer and
                      byte to shortint }
                      (not(
                         (p^.left^.resulttype^.deftype=orddef) and
-                        (defcoll^.data^.deftype=orddef) and
-                        (p^.left^.resulttype^.size=defcoll^.data^.size)
+                        (defcoll^.paratype.def^.deftype=orddef) and
+                        (p^.left^.resulttype^.size=defcoll^.paratype.def^.size)
                          ) and
                    { an implicit pointer conversion is allowed }
                      not(
                         (p^.left^.resulttype^.deftype=pointerdef) and
-                        (defcoll^.data^.deftype=pointerdef)
+                        (defcoll^.paratype.def^.deftype=pointerdef)
                          ) and
                    { child classes can be also passed }
                      not(
                         (p^.left^.resulttype^.deftype=objectdef) and
-                        (defcoll^.data^.deftype=objectdef) and
-                        pobjectdef(p^.left^.resulttype)^.is_related(pobjectdef(defcoll^.data))
+                        (defcoll^.paratype.def^.deftype=objectdef) and
+                        pobjectdef(p^.left^.resulttype)^.is_related(pobjectdef(defcoll^.paratype.def))
                         ) and
                    { passing a single element to a openarray of the same type }
                      not(
-                        (is_open_array(defcoll^.data) and
-                        is_equal(parraydef(defcoll^.data)^.definition,p^.left^.resulttype))
+                        (is_open_array(defcoll^.paratype.def) and
+                        is_equal(parraydef(defcoll^.paratype.def)^.elementtype.def,p^.left^.resulttype))
                         ) and
                    { an implicit file conversion is also allowed }
                    { from a typed file to an untyped one           }
                      not(
                         (p^.left^.resulttype^.deftype=filedef) and
-                        (defcoll^.data^.deftype=filedef) and
-                        (pfiledef(defcoll^.data)^.filetype = ft_untyped) and
-                        (pfiledef(p^.left^.resulttype)^.filetype = ft_typed)
+                        (defcoll^.paratype.def^.deftype=filedef) and
+                        (pfiledef(defcoll^.paratype.def)^.filetyp = ft_untyped) and
+                        (pfiledef(p^.left^.resulttype)^.filetyp = ft_typed)
                          ) and
-                     not(is_equal(p^.left^.resulttype,defcoll^.data))) then
+                     not(is_equal(p^.left^.resulttype,defcoll^.paratype.def))) then
                        begin
                           CGMessagePos2(p^.left^.fileinfo,parser_e_call_by_ref_without_typeconv,
-                            p^.left^.resulttype^.typename,defcoll^.data^.typename);
+                            p^.left^.resulttype^.typename,defcoll^.paratype.def^.typename);
                        end;
                    { process cargs arrayconstructor }
                    if is_array_constructor(p^.left^.resulttype) then
                     begin
-                      if is_array_of_const(defcoll^.data) then
+                      if is_array_of_const(defcoll^.paratype.def) then
                        begin
                          if assigned(aktcallprocsym) and
                             (pocall_cdecl in aktcallprocsym^.definition^.proccalloptions) and
@@ -271,7 +271,7 @@ implementation
                       else
                        begin
                          p^.left^.novariaallowed:=true;
-                         p^.left^.constructdef:=parraydef(defcoll^.data)^.definition;
+                         p^.left^.constructdef:=parraydef(defcoll^.paratype.def)^.elementtype.def;
                        end;
                       old_array_constructor:=allow_array_constructor;
                       allow_array_constructor:=true;
@@ -279,17 +279,17 @@ implementation
                       allow_array_constructor:=old_array_constructor;
                     end;
                    { process open parameters }
-                   if push_high_param(defcoll^.data) then
+                   if push_high_param(defcoll^.paratype.def) then
                     begin
                       { insert type conv but hold the ranges of the array }
                       oldtype:=p^.left^.resulttype;
-                      p^.left:=gentypeconvnode(p^.left,defcoll^.data);
+                      p^.left:=gentypeconvnode(p^.left,defcoll^.paratype.def);
                       firstpass(p^.left);
                       p^.left^.resulttype:=oldtype;
                     end
                    else
                     begin
-                      p^.left:=gentypeconvnode(p^.left,defcoll^.data);
+                      p^.left:=gentypeconvnode(p^.left,defcoll^.paratype.def);
                       firstpass(p^.left);
                     end;
                    if codegenerror then
@@ -301,10 +301,10 @@ implementation
               { check var strings }
               if (cs_strict_var_strings in aktlocalswitches) and
                  is_shortstring(p^.left^.resulttype) and
-                 is_shortstring(defcoll^.data) and
+                 is_shortstring(defcoll^.paratype.def) and
                  (defcoll^.paratyp=vs_var) and
-                 not(is_open_string(defcoll^.data)) and
-                 not(is_equal(p^.left^.resulttype,defcoll^.data)) then
+                 not(is_open_string(defcoll^.paratype.def)) and
+                 not(is_equal(p^.left^.resulttype,defcoll^.paratype.def)) then
                  begin
                     aktfilepos:=p^.left^.fileinfo;
                     CGMessage(type_e_strict_var_string_violation);
@@ -314,7 +314,7 @@ implementation
               { into a register }
               { is this usefull here ? }
               { this was missing in formal parameter list   }
-              if (defcoll^.data=pdef(cformaldef)) then
+              if (defcoll^.paratype.def=pdef(cformaldef)) then
                 begin
                   if defcoll^.paratyp=vs_var then
                     begin
@@ -340,7 +340,7 @@ implementation
                    make_not_regable(p^.left);
                 end;
 
-              p^.resulttype:=defcoll^.data;
+              p^.resulttype:=defcoll^.paratype.def;
            end;
          if p^.left^.registers32>p^.registers32 then
            p^.registers32:=p^.left^.registers32;
@@ -529,7 +529,7 @@ implementation
                    if codegenerror then
                      goto errorexit;
                 end;
-              p^.resulttype:=pprocvardef(p^.right^.resulttype)^.retdef;
+              p^.resulttype:=pprocvardef(p^.right^.resulttype)^.rettype.def;
 
               { this was missing, leads to a bug below if
                 the procvar is a function }
@@ -653,9 +653,9 @@ implementation
                         hp:=procs;
                         while assigned(hp) do
                           begin
-                             if is_equal(pt,hp^.nextpara^.data) then
+                             if is_equal(pt,hp^.nextpara^.paratype.def) then
                                begin
-                                  if hp^.nextpara^.data=pt^.resulttype then
+                                  if hp^.nextpara^.paratype.def=pt^.resulttype then
                                     begin
                                        pt^.exact_match_found:=true;
                                        hp^.nextpara^.argconvtyp:=act_exact;
@@ -667,7 +667,7 @@ implementation
                              else
                                begin
                                  hp^.nextpara^.argconvtyp:=act_convertable;
-                                 hp^.nextpara^.convertlevel:=isconvertable(pt^.resulttype,hp^.nextpara^.data,
+                                 hp^.nextpara^.convertlevel:=isconvertable(pt^.resulttype,hp^.nextpara^.paratype.def,
                                      hcvt,pt^.left^.treetype,false);
                                  case hp^.nextpara^.convertlevel of
                                   1 : pt^.convlevel1found:=true;
@@ -715,7 +715,7 @@ implementation
                                  else
                                   begin
                                     { save the type for nice error message }
-                                    lastparatype:=hp^.nextpara^.data;
+                                    lastparatype:=hp^.nextpara^.paratype.def;
                                     dispose(hp);
                                   end;
                                  hp:=hp2;
@@ -780,9 +780,9 @@ implementation
                              hp:=procs;
                              while assigned(hp) do
                                begin
-                                  if not is_equal(pt,hp^.nextpara^.data) then
+                                  if not is_equal(pt,hp^.nextpara^.paratype.def) then
                                     begin
-                                       def_to:=hp^.nextpara^.data;
+                                       def_to:=hp^.nextpara^.paratype.def;
                                        if ((def_from^.deftype=orddef) and (def_to^.deftype=orddef)) and
                                          (is_in_limit(def_from,def_to) or
                                          ((hp^.nextpara^.paratyp=vs_var) and
@@ -799,7 +799,7 @@ implementation
                              if exactmatch then
                                begin
                                   { the first .... }
-                                  while (assigned(procs)) and not(is_in_limit(def_from,procs^.nextpara^.data)) do
+                                  while (assigned(procs)) and not(is_in_limit(def_from,procs^.nextpara^.paratype.def)) do
                                     begin
                                        hp:=procs^.next;
                                        dispose(procs);
@@ -809,7 +809,7 @@ implementation
                                   hp:=procs;
                                   while (assigned(hp)) and assigned(hp^.next) do
                                     begin
-                                       if not(is_in_limit(def_from,hp^.next^.nextpara^.data)) then
+                                       if not(is_in_limit(def_from,hp^.next^.nextpara^.paratype.def)) then
                                          begin
                                             hp2:=hp^.next^.next;
                                             dispose(hp^.next);
@@ -817,7 +817,7 @@ implementation
                                          end
                                        else
                                          begin
-                                           def_to:=hp^.next^.nextpara^.data;
+                                           def_to:=hp^.next^.nextpara^.paratype.def;
                                            if (conv_to^.size>def_to^.size) or
                                               ((porddef(conv_to)^.low<porddef(def_to)^.low) and
                                               (porddef(conv_to)^.high>porddef(def_to)^.high)) then
@@ -958,7 +958,7 @@ implementation
                      end;
 
                    p^.procdefinition:=procs^.data;
-                   p^.resulttype:=procs^.data^.retdef;
+                   p^.resulttype:=procs^.data^.rettype.def;
                    { big error for with statements
                    p^.symtableproc:=p^.procdefinition^.owner;
                    but neede for overloaded operators !! }
@@ -1066,7 +1066,7 @@ implementation
 {$endif}
            end;
          { ensure that the result type is set }
-         p^.resulttype:=p^.procdefinition^.retdef;
+         p^.resulttype:=p^.procdefinition^.rettype.def;
          { get a register for the return value }
          if (p^.resulttype<>pdef(voiddef)) then
            begin
@@ -1080,7 +1080,7 @@ implementation
                         p^.location.loc:=LOC_REGISTER;
                         p^.registers32:=1;
                         { the result type depends on the classref }
-                        p^.resulttype:=pclassrefdef(p^.methodpointer^.resulttype)^.definition;
+                        p^.resulttype:=pclassrefdef(p^.methodpointer^.resulttype)^.pointertype.def;
                      end
                   { a object constructor returns the result with the flags }
                    else
@@ -1221,7 +1221,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.73  1999-11-18 15:34:49  pierre
+  Revision 1.74  1999-11-30 10:40:57  peter
+    + ttype, tsymlist
+
+  Revision 1.73  1999/11/18 15:34:49  pierre
     * Notes/Hints for local syms changed to
       Set_varstate function
 

+ 9 - 6
compiler/tccnv.pas

@@ -913,8 +913,8 @@ implementation
 
          { the operands must be related }
          if (not(pobjectdef(p^.left^.resulttype)^.is_related(
-           pobjectdef(pclassrefdef(p^.right^.resulttype)^.definition)))) and
-           (not(pobjectdef(pclassrefdef(p^.right^.resulttype)^.definition)^.is_related(
+           pobjectdef(pclassrefdef(p^.right^.resulttype)^.pointertype.def)))) and
+           (not(pobjectdef(pclassrefdef(p^.right^.resulttype)^.pointertype.def)^.is_related(
            pobjectdef(p^.left^.resulttype)))) then
            CGMessage(type_e_mismatch);
 
@@ -948,20 +948,23 @@ implementation
 
          { the operands must be related }
          if (not(pobjectdef(p^.left^.resulttype)^.is_related(
-           pobjectdef(pclassrefdef(p^.right^.resulttype)^.definition)))) and
-           (not(pobjectdef(pclassrefdef(p^.right^.resulttype)^.definition)^.is_related(
+           pobjectdef(pclassrefdef(p^.right^.resulttype)^.pointertype.def)))) and
+           (not(pobjectdef(pclassrefdef(p^.right^.resulttype)^.pointertype.def)^.is_related(
            pobjectdef(p^.left^.resulttype)))) then
            CGMessage(type_e_mismatch);
 
          set_location(p^.location,p^.left^.location);
-         p^.resulttype:=pclassrefdef(p^.right^.resulttype)^.definition;
+         p^.resulttype:=pclassrefdef(p^.right^.resulttype)^.pointertype.def;
       end;
 
 
 end.
 {
   $Log$
-  Revision 1.53  1999-11-18 15:34:49  pierre
+  Revision 1.54  1999-11-30 10:40:57  peter
+    + ttype, tsymlist
+
+  Revision 1.53  1999/11/18 15:34:49  pierre
     * Notes/Hints for local syms changed to
       Set_varstate function
 

+ 5 - 2
compiler/tcflw.pas

@@ -344,7 +344,7 @@ implementation
               if ret_in_param(p^.resulttype) then
                 begin
                   pt:=genzeronode(funcretn);
-                  pt^.retdef:=p^.resulttype;
+                  pt^.rettype.setdef(p^.resulttype);
                   pt^.funcretprocinfo:=procinfo;
                   p^.left:=gennode(assignn,pt,p^.left);
                   firstpass(p^.left);
@@ -514,7 +514,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.26  1999-11-18 15:34:49  pierre
+  Revision 1.27  1999-11-30 10:40:58  peter
+    + ttype, tsymlist
+
+  Revision 1.26  1999/11/18 15:34:49  pierre
     * Notes/Hints for local syms changed to
       Set_varstate function
 

+ 11 - 8
compiler/tcinl.pas

@@ -648,7 +648,7 @@ implementation
                        if assigned(hp) and assigned(hp^.resulttype) then
                          Begin
                            if (hp^.resulttype^.deftype=filedef) and
-                              (pfiledef(hp^.resulttype)^.filetype=ft_typed) then
+                              (pfiledef(hp^.resulttype)^.filetyp=ft_typed) then
                             begin
                               file_is_typed:=true;
                               { test the type }
@@ -657,7 +657,7 @@ implementation
                                begin
                                  if (hpp^.left^.treetype=typen) then
                                    CGMessage(type_e_cant_read_write_type);
-                                 if not is_equal(hpp^.resulttype,pfiledef(hp^.resulttype)^.typed_as) then
+                                 if not is_equal(hpp^.resulttype,pfiledef(hp^.resulttype)^.typedfiletype.def) then
                                    CGMessage(type_e_mismatch);
                                  { generate the high() value for the shortstring }
                                  if ((not dowrite) and is_shortstring(hpp^.left^.resulttype)) or
@@ -684,7 +684,7 @@ implementation
                                      begin
                                        p1:=gencallnode(nil,nil);
                                        p1^.right:=hp^.left;
-                                       p1^.resulttype:=pprocvardef(hp^.left^.resulttype)^.retdef;
+                                       p1^.resulttype:=pprocvardef(hp^.left^.resulttype)^.rettype.def;
                                        firstpass(p1);
                                        hp^.left:=p1;
                                      end;
@@ -1036,7 +1036,7 @@ implementation
                                 { to the type of the set elements  }
                                 p^.left^.right^.left:=gentypeconvnode(
                                   p^.left^.right^.left,
-                                  psetdef(p^.left^.resulttype)^.setof);
+                                  psetdef(p^.left^.resulttype)^.elementtype.def);
                                 { check the type conversion }
                                 firstpass(p^.left^.right^.left);
                                 { only three parameters are allowed }
@@ -1065,7 +1065,7 @@ implementation
                             end;
                           setdef:
                             begin
-                               do_lowhigh(Psetdef(p^.left^.resulttype)^.setof);
+                               do_lowhigh(Psetdef(p^.left^.resulttype)^.elementtype.def);
                                firstpass(p);
                             end;
                          arraydef:
@@ -1073,7 +1073,7 @@ implementation
                               if p^.inlinenumber=in_low_x then
                                begin
                                  hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.lowrange,
-                                   Parraydef(p^.left^.resulttype)^.rangedef);
+                                   Parraydef(p^.left^.resulttype)^.rangetype.def);
                                  disposetree(p);
                                  p:=hp;
                                  firstpass(p);
@@ -1092,7 +1092,7 @@ implementation
                                  else
                                   begin
                                     hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.highrange,
-                                      Parraydef(p^.left^.resulttype)^.rangedef);
+                                      Parraydef(p^.left^.resulttype)^.rangetype.def);
                                     disposetree(p);
                                     p:=hp;
                                     firstpass(p);
@@ -1272,7 +1272,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.60  1999-11-18 15:34:49  pierre
+  Revision 1.61  1999-11-30 10:40:58  peter
+    + ttype, tsymlist
+
+  Revision 1.60  1999/11/18 15:34:49  pierre
     * Notes/Hints for local syms changed to
       Set_varstate function
 

+ 14 - 11
compiler/tcld.pas

@@ -77,7 +77,7 @@ implementation
            begin
               p1:=genzeronode(funcretn);
               p1^.funcretprocinfo:=pprocinfo(pfuncretsym(p^.symtableentry)^.funcretprocinfo);
-              p1^.retdef:=pfuncretsym(p^.symtableentry)^.funcretdef;
+              p1^.rettype:=pfuncretsym(p^.symtableentry)^.rettype;
               firstpass(p1);
               putnode(p);
               p:=p1;
@@ -85,7 +85,7 @@ implementation
            end;
          if p^.symtableentry^.typ=absolutesym then
            begin
-              p^.resulttype:=pabsolutesym(p^.symtableentry)^.definition;
+              p^.resulttype:=pabsolutesym(p^.symtableentry)^.vartype.def;
               if pabsolutesym(p^.symtableentry)^.abstyp=tovar then
                 p^.symtableentry:=pabsolutesym(p^.symtableentry)^.ref;
               p^.symtable:=p^.symtableentry^.owner;
@@ -95,7 +95,7 @@ implementation
             absolutesym :;
             constsym:
               begin
-                 if pconstsym(p^.symtableentry)^.consttype=constresourcestring then
+                 if pconstsym(p^.symtableentry)^.consttyp=constresourcestring then
                    begin
                       p^.resulttype:=cansistringdef;
                       p^.location.loc:=LOC_MEM;
@@ -106,7 +106,7 @@ implementation
             varsym :
                 begin
                    if not(p^.is_absolute) and (p^.resulttype=nil) then
-                     p^.resulttype:=pvarsym(p^.symtableentry)^.definition;
+                     p^.resulttype:=pvarsym(p^.symtableentry)^.vartype.def;
                    if (p^.symtable^.symtabletype in [parasymtable,localsymtable]) and
                       (lexlevel>p^.symtable^.symtablelevel) then
                      begin
@@ -128,9 +128,9 @@ implementation
                    { we need a register for call by reference parameters }
                    if (pvarsym(p^.symtableentry)^.varspez=vs_var) or
                       ((pvarsym(p^.symtableentry)^.varspez=vs_const) and
-                      push_addr_param(pvarsym(p^.symtableentry)^.definition)) or
+                      push_addr_param(pvarsym(p^.symtableentry)^.vartype.def)) or
                       { call by value open arrays are also indirect addressed }
-                      is_open_array(pvarsym(p^.symtableentry)^.definition) then
+                      is_open_array(pvarsym(p^.symtableentry)^.vartype.def) then
                      p^.registers32:=1;
                    if p^.symtable^.symtabletype=withsymtable then
                      inc(p^.registers32);
@@ -160,7 +160,7 @@ implementation
                 end;
             typedconstsym :
                 if not p^.is_absolute then
-                  p^.resulttype:=ptypedconstsym(p^.symtableentry)^.definition;
+                  p^.resulttype:=ptypedconstsym(p^.symtableentry)^.typedconsttype.def;
             procsym :
                 begin
                    if assigned(pprocsym(p^.symtableentry)^.definition^.nextoverloaded) then
@@ -312,9 +312,9 @@ implementation
 
     procedure firstfuncret(var p : ptree);
       begin
-         p^.resulttype:=p^.retdef;
+         p^.resulttype:=p^.rettype.def;
          p^.location.loc:=LOC_REFERENCE;
-         if ret_in_param(p^.retdef) or
+         if ret_in_param(p^.rettype.def) or
             (procinfo<>pprocinfo(p^.funcretprocinfo)) then
            p^.registers32:=1;
       end;
@@ -446,7 +446,7 @@ implementation
            (parraydef(p^.resulttype)^.lowrange<>0) or
            (parraydef(p^.resulttype)^.highrange<>len-1) then
           p^.resulttype:=new(parraydef,init(0,len-1,s32bitdef));
-        parraydef(p^.resulttype)^.definition:=pd;
+        parraydef(p^.resulttype)^.elementtype.def:=pd;
         parraydef(p^.resulttype)^.IsConstructor:=true;
         parraydef(p^.resulttype)^.IsVariant:=varia;
         p^.location.loc:=LOC_MEM;
@@ -467,7 +467,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.51  1999-11-18 15:34:50  pierre
+  Revision 1.52  1999-11-30 10:40:58  peter
+    + ttype, tsymlist
+
+  Revision 1.51  1999/11/18 15:34:50  pierre
     * Notes/Hints for local syms changed to
       Set_varstate function
 

+ 5 - 2
compiler/tcmat.pas

@@ -314,7 +314,7 @@ implementation
                 minusdef:=nil;
               while assigned(minusdef) do
                 begin
-                   if (pparaitem(minusdef^.para^.first)^.data=p^.left^.resulttype) and
+                   if (pparaitem(minusdef^.para^.first)^.paratype.def=p^.left^.resulttype) and
                       (pparaitem(minusdef^.para^.first)^.next=nil) then
                      begin
                         t:=gencallnode(overloaded_operators[_minus],nil);
@@ -422,7 +422,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.24  1999-11-26 13:51:29  pierre
+  Revision 1.25  1999-11-30 10:40:58  peter
+    + ttype, tsymlist
+
+  Revision 1.24  1999/11/26 13:51:29  pierre
    * fix for overloading of shr shl mod and div
 
   Revision 1.23  1999/11/18 15:34:50  pierre

+ 17 - 14
compiler/tcmem.pas

@@ -122,7 +122,7 @@ implementation
          if p^.left^.location.loc=LOC_CREGISTER then
            inc(p^.registers32);
          p^.location.loc:=LOC_REFERENCE;
-         p^.resulttype:=ppointerdef(p^.left^.resulttype)^.definition;
+         p^.resulttype:=ppointerdef(p^.left^.resulttype)^.pointertype.def;
       end;
 
 
@@ -251,14 +251,14 @@ implementation
 
                     { it could also be a procvar, not only pprocsym ! }
                        if p^.left^.symtableprocentry^.typ=varsym then
-                        hp3:=pabstractprocdef(pvarsym(p^.left^.symtableentry)^.definition)
+                        hp3:=pabstractprocdef(pvarsym(p^.left^.symtableentry)^.vartype.def)
                        else
                         hp3:=pabstractprocdef(pprocsym(p^.left^.symtableprocentry)^.definition);
 
                        pprocvardef(p^.resulttype)^.proctypeoption:=hp3^.proctypeoption;
                        pprocvardef(p^.resulttype)^.proccalloptions:=hp3^.proccalloptions;
                        pprocvardef(p^.resulttype)^.procoptions:=hp3^.procoptions;
-                       pprocvardef(p^.resulttype)^.retdef:=hp3^.retdef;
+                       pprocvardef(p^.resulttype)^.rettype:=hp3^.rettype;
                        pprocvardef(p^.resulttype)^.symtablelevel:=hp3^.symtablelevel;
 
                      { method ? then set the methodpointer flag }
@@ -274,7 +274,7 @@ implementation
                        hp2:=pparaitem(hp3^.para^.last);
                        while assigned(hp2) do
                          begin
-                            pprocvardef(p^.resulttype)^.concatdef(hp2^.data,hp2^.paratyp);
+                            pprocvardef(p^.resulttype)^.concatpara(hp2^.paratype,hp2^.paratyp);
                             hp2:=pparaitem(hp2^.previous);
                          end;
                     end
@@ -297,14 +297,14 @@ implementation
                      if not(cs_typed_addresses in aktlocalswitches) then
                        p^.resulttype:=voidfarpointerdef
                      else
-                       p^.resulttype:=new(ppointerdef,initfar(p^.left^.resulttype));
+                       p^.resulttype:=new(ppointerdef,initfardef(p^.left^.resulttype));
                    end
                   else
                    begin
                      if not(cs_typed_addresses in aktlocalswitches) then
                        p^.resulttype:=voidpointerdef
                      else
-                       p^.resulttype:=new(ppointerdef,init(p^.left^.resulttype));
+                       p^.resulttype:=new(ppointerdef,initdef(p^.left^.resulttype));
                    end;
                 end;
            end;
@@ -400,7 +400,7 @@ implementation
          if p^.left^.resulttype^.deftype<>pointerdef then
           CGMessage(cg_e_invalid_qualifier);
 
-         p^.resulttype:=ppointerdef(p^.left^.resulttype)^.definition;
+         p^.resulttype:=ppointerdef(p^.left^.resulttype)^.pointertype.def;
          p^.location.loc:=LOC_REFERENCE;
       end;
 
@@ -417,7 +417,7 @@ implementation
              p^.resulttype:=generrordef;
              exit;
            end;
-         p^.resulttype:=p^.vs^.definition;
+         p^.resulttype:=p^.vs^.vartype.def;
 
          p^.registers32:=p^.left^.registers32;
          p^.registersfpu:=p^.left^.registersfpu;
@@ -462,9 +462,9 @@ implementation
          { range check only for arrays }
          if (p^.left^.resulttype^.deftype=arraydef) then
            begin
-              if (isconvertable(p^.right^.resulttype,parraydef(p^.left^.resulttype)^.rangedef,
+              if (isconvertable(p^.right^.resulttype,parraydef(p^.left^.resulttype)^.rangetype.def,
                     ct,ordconstn,false)=0) and
-                 not(is_equal(p^.right^.resulttype,parraydef(p^.left^.resulttype)^.rangedef)) then
+                 not(is_equal(p^.right^.resulttype,parraydef(p^.left^.resulttype)^.rangetype.def)) then
                 CGMessage(type_e_mismatch);
            end;
          { Never convert a boolean or a char !}
@@ -482,12 +482,12 @@ implementation
          { determine return type }
          if not assigned(p^.resulttype) then
            if p^.left^.resulttype^.deftype=arraydef then
-             p^.resulttype:=parraydef(p^.left^.resulttype)^.definition
+             p^.resulttype:=parraydef(p^.left^.resulttype)^.elementtype.def
            else if (p^.left^.resulttype^.deftype=pointerdef) then
              begin
                 { convert pointer to array }
                 harr:=new(parraydef,init(0,$7fffffff,s32bitdef));
-                parraydef(harr)^.definition:=ppointerdef(p^.left^.resulttype)^.definition;
+                parraydef(harr)^.elementtype.def:=ppointerdef(p^.left^.resulttype)^.pointertype.def;
                 p^.left:=gentypeconvnode(p^.left,harr);
 
                 firstpass(p^.left);
@@ -496,7 +496,7 @@ implementation
                   begin
                     exit;
                   end;
-                p^.resulttype:=parraydef(harr)^.definition
+                p^.resulttype:=parraydef(harr)^.elementtype.def
              end
            else if p^.left^.resulttype^.deftype=stringdef then
              begin
@@ -640,7 +640,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.35  1999-11-29 22:36:48  florian
+  Revision 1.36  1999-11-30 10:40:58  peter
+    + ttype, tsymlist
+
+  Revision 1.35  1999/11/29 22:36:48  florian
     * problem with taking the address of abstract procedures fixed
 
   Revision 1.34  1999/11/18 15:34:51  pierre

+ 9 - 6
compiler/tcset.pas

@@ -90,10 +90,10 @@ implementation
         i : longint;
       begin
         new(pcs);
-        case psd^.setof^.deftype of
+        case psd^.elementtype.def^.deftype of
           enumdef :
             begin
-              pes:=penumdef(psd^.setof)^.firstenum;
+              pes:=penumdef(psd^.elementtype.def)^.firstenum;
               while assigned(pes) do
                 begin
                   pcs^[pes^.value div 8]:=pcs^[pes^.value div 8] or (1 shl (pes^.value mod 8));
@@ -102,7 +102,7 @@ implementation
             end;
           orddef :
             begin
-              for i:=porddef(psd^.setof)^.low to porddef(psd^.setof)^.high do
+              for i:=porddef(psd^.elementtype.def)^.low to porddef(psd^.elementtype.def)^.high do
                 begin
                   pcs^[i div 8]:=pcs^[i div 8] or (1 shl (i mod 8));
                 end;
@@ -155,7 +155,7 @@ implementation
            exit;
 
          { empty set then return false }
-         if not assigned(psetdef(p^.right^.resulttype)^.setof) then
+         if not assigned(psetdef(p^.right^.resulttype)^.elementtype.def) then
           begin
             t:=genordinalconstnode(0,booldef);
             disposetree(p);
@@ -165,7 +165,7 @@ implementation
           end;
 
          { type conversion/check }
-         p^.left:=gentypeconvnode(p^.left,psetdef(p^.right^.resulttype)^.setof);
+         p^.left:=gentypeconvnode(p^.left,psetdef(p^.right^.resulttype)^.elementtype.def);
          firstpass(p^.left);
          if codegenerror then
            exit;
@@ -306,7 +306,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.15  1999-11-18 15:34:51  pierre
+  Revision 1.16  1999-11-30 10:40:59  peter
+    + ttype, tsymlist
+
+  Revision 1.15  1999/11/18 15:34:51  pierre
     * Notes/Hints for local syms changed to
       Set_varstate function
 

+ 9 - 6
compiler/tree.pas

@@ -226,7 +226,7 @@ unit tree;
              ordconstn : (value : longint);
              realconstn : (value_real : bestreal;lab_real : pasmlabel);
              fixconstn : (value_fix: longint);
-             funcretn : (funcretprocinfo : pointer;retdef : pdef;
+             funcretn : (funcretprocinfo : pointer;rettype : ttype;
                        is_first_funcret : boolean);
              subscriptn : (vs : pvarsym);
              vecn : (memindex,memseg:boolean;callunique : boolean);
@@ -992,7 +992,7 @@ unit tree;
          p^.registersmmx:=0;
 {$endif SUPPORT_MMX}
          p^.treetype:=loadn;
-         p^.resulttype:=v^.definition;
+         p^.resulttype:=v^.vartype.def;
          p^.symtableentry:=v;
          p^.symtable:=st;
          p^.is_first := False;
@@ -1066,7 +1066,7 @@ unit tree;
 {$endif SUPPORT_MMX}
          p^.treetype:=loadn;
          p^.left:=nil;
-         p^.resulttype:=sym^.definition;
+         p^.resulttype:=sym^.typedconsttype.def;
          p^.symtableentry:=sym;
          p^.symtable:=st;
          p^.disposetyp:=dt_nothing;
@@ -1294,7 +1294,7 @@ unit tree;
          p^.retoffset:=-4; { less dangerous as zero (PM) }
          p^.para_offset:=0;
          p^.para_size:=p^.inlineprocsym^.definition^.para_size;
-         if ret_in_param(p^.inlineprocsym^.definition^.retdef) then
+         if ret_in_param(p^.inlineprocsym^.definition^.rettype.def) then
            p^.para_size:=p^.para_size+target_os.size_of_pointer;
          { copy args }
          p^.inlinetree:=code;
@@ -1303,7 +1303,7 @@ unit tree;
 {$ifdef SUPPORT_MMX}
          p^.registersmmx:=0;
 {$endif SUPPORT_MMX}
-         p^.resulttype:=p^.inlineprocsym^.definition^.retdef;
+         p^.resulttype:=p^.inlineprocsym^.definition^.rettype.def;
          genprocinlinenode:=p;
       end;
 
@@ -1897,7 +1897,10 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.103  1999-11-18 15:34:51  pierre
+  Revision 1.104  1999-11-30 10:40:59  peter
+    + ttype, tsymlist
+
+  Revision 1.103  1999/11/18 15:34:51  pierre
     * Notes/Hints for local syms changed to
       Set_varstate function
 

+ 49 - 46
compiler/types.pas

@@ -189,7 +189,7 @@ implementation
            begin
               if value_equal_const then
                 begin
-                   if not(is_equal(def1^.data,def2^.data)) or
+                   if not(is_equal(def1^.paratype.def,def2^.paratype.def)) or
                      ((def1^.paratyp<>def2^.paratyp) and
                       ((def1^.paratyp=vs_var) or
                        (def1^.paratyp=vs_var)
@@ -202,7 +202,7 @@ implementation
                 end
               else
                 begin
-                   if not(is_equal(def1^.data,def2^.data)) or
+                   if not(is_equal(def1^.paratype.def,def2^.paratype.def)) or
                      (def1^.paratyp<>def2^.paratyp) then
                      begin
                         equal_paras:=false;
@@ -229,7 +229,7 @@ implementation
            begin
               if value_equal_const then
                 begin
-                   if (isconvertable(def1^.data,def2^.data,doconv,callparan,false)=0) or
+                   if (isconvertable(def1^.paratype.def,def2^.paratype.def,doconv,callparan,false)=0) or
                      ((def1^.paratyp<>def2^.paratyp) and
                       ((def1^.paratyp=vs_var) or
                        (def1^.paratyp=vs_var)
@@ -242,7 +242,7 @@ implementation
                 end
               else
                 begin
-                   if (isconvertable(def1^.data,def2^.data,doconv,callparan,false)=0) or
+                   if (isconvertable(def1^.paratype.def,def2^.paratype.def,doconv,callparan,false)=0) or
                      (def1^.paratyp<>def2^.paratyp) then
                      begin
                         convertable_paras:=false;
@@ -285,7 +285,7 @@ implementation
           end;
          { check return value and para's and options, methodpointer is already checked
            parameters may also be convertable }
-         if is_equal(def1^.retdef,def2^.retdef) and
+         if is_equal(def1^.rettype.def,def2^.rettype.def) and
             (equal_paras(def1^.para,def2^.para,false) or
              convertable_paras(def1^.para,def2^.para,false)) and
             ((po_comp * def1^.procoptions)= (po_comp * def2^.procoptions)) then
@@ -405,7 +405,7 @@ implementation
          { check for s32bitdef is needed, because for u32bit the high
            range is also -1 ! (PFV) }
          is_open_array:=(p^.deftype=arraydef) and
-                        (parraydef(p)^.rangedef=pdef(s32bitdef)) and
+                        (parraydef(p)^.rangetype.def=pdef(s32bitdef)) and
                         (parraydef(p)^.lowrange=0) and
                         (parraydef(p)^.highrange=-1) and
                         not(parraydef(p)^.IsConstructor) and
@@ -481,7 +481,7 @@ implementation
     function is_chararray(p : pdef) : boolean;
       begin
         is_chararray:=(p^.deftype=arraydef) and
-                      is_equal(parraydef(p)^.definition,cchardef) and
+                      is_equal(parraydef(p)^.elementtype.def,cchardef) and
                       not(is_special_array(p));
       end;
 
@@ -490,7 +490,7 @@ implementation
     function is_pchar(p : pdef) : boolean;
       begin
         is_pchar:=(p^.deftype=pointerdef) and
-                  is_equal(Ppointerdef(p)^.definition,cchardef);
+                  is_equal(Ppointerdef(p)^.pointertype.def,cchardef);
       end;
 
 
@@ -664,15 +664,15 @@ implementation
          mmx_type:=mmxno;
          if is_mmx_able_array(p) then
            begin
-              if parraydef(p)^.definition^.deftype=floatdef then
-                case pfloatdef(parraydef(p)^.definition)^.typ of
+              if parraydef(p)^.elementtype.def^.deftype=floatdef then
+                case pfloatdef(parraydef(p)^.elementtype.def)^.typ of
                   s32real:
                     mmx_type:=mmxsingle;
                   f16bit:
                     mmx_type:=mmxfixed16
                 end
               else
-                case porddef(parraydef(p)^.definition)^.typ of
+                case porddef(parraydef(p)^.elementtype.def)^.typ of
                    u8bit:
                      mmx_type:=mmxu8bit;
                    s8bit:
@@ -699,34 +699,34 @@ implementation
                 not(is_special_array(p)) and
                 (
                  (
-                  (parraydef(p)^.definition^.deftype=orddef) and
+                  (parraydef(p)^.elementtype.def^.deftype=orddef) and
                   (
                    (
                     (parraydef(p)^.lowrange=0) and
                     (parraydef(p)^.highrange=1) and
-                    (porddef(parraydef(p)^.definition)^.typ in [u32bit,s32bit])
+                    (porddef(parraydef(p)^.elementtype.def)^.typ in [u32bit,s32bit])
                    )
                    or
                    (
                     (parraydef(p)^.lowrange=0) and
                     (parraydef(p)^.highrange=3) and
-                    (porddef(parraydef(p)^.definition)^.typ in [u16bit,s16bit])
+                    (porddef(parraydef(p)^.elementtype.def)^.typ in [u16bit,s16bit])
                    )
                   )
                  )
                  or
                 (
                  (
-                  (parraydef(p)^.definition^.deftype=floatdef) and
+                  (parraydef(p)^.elementtype.def^.deftype=floatdef) and
                   (
                    (parraydef(p)^.lowrange=0) and
                    (parraydef(p)^.highrange=3) and
-                   (pfloatdef(parraydef(p)^.definition)^.typ=f16bit)
+                   (pfloatdef(parraydef(p)^.elementtype.def)^.typ=f16bit)
                   ) or
                   (
                    (parraydef(p)^.lowrange=0) and
                    (parraydef(p)^.highrange=1) and
-                   (pfloatdef(parraydef(p)^.definition)^.typ=s32real)
+                   (pfloatdef(parraydef(p)^.elementtype.def)^.typ=s32real)
                   )
                  )
                 )
@@ -737,41 +737,41 @@ implementation
               is_mmx_able_array:=(p^.deftype=arraydef) and
                 (
                  (
-                  (parraydef(p)^.definition^.deftype=orddef) and
+                  (parraydef(p)^.elementtype.def^.deftype=orddef) and
                   (
                    (
                     (parraydef(p)^.lowrange=0) and
                     (parraydef(p)^.highrange=1) and
-                    (porddef(parraydef(p)^.definition)^.typ in [u32bit,s32bit])
+                    (porddef(parraydef(p)^.elementtype.def)^.typ in [u32bit,s32bit])
                    )
                    or
                    (
                     (parraydef(p)^.lowrange=0) and
                     (parraydef(p)^.highrange=3) and
-                    (porddef(parraydef(p)^.definition)^.typ in [u16bit,s16bit])
+                    (porddef(parraydef(p)^.elementtype.def)^.typ in [u16bit,s16bit])
                    )
                    or
                    (
                     (parraydef(p)^.lowrange=0) and
                     (parraydef(p)^.highrange=7) and
-                    (porddef(parraydef(p)^.definition)^.typ in [u8bit,s8bit])
+                    (porddef(parraydef(p)^.elementtype.def)^.typ in [u8bit,s8bit])
                    )
                   )
                  )
                  or
                  (
-                  (parraydef(p)^.definition^.deftype=floatdef) and
+                  (parraydef(p)^.elementtype.def^.deftype=floatdef) and
                   (
                    (
                     (parraydef(p)^.lowrange=0) and
                     (parraydef(p)^.highrange=3) and
-                    (pfloatdef(parraydef(p)^.definition)^.typ=f32bit)
+                    (pfloatdef(parraydef(p)^.elementtype.def)^.typ=f32bit)
                    )
                    or
                    (
                     (parraydef(p)^.lowrange=0) and
                     (parraydef(p)^.highrange=1) and
-                    (pfloatdef(parraydef(p)^.definition)^.typ=s32real)
+                    (pfloatdef(parraydef(p)^.elementtype.def)^.typ=s32real)
                    )
                   )
                  )
@@ -813,10 +813,10 @@ implementation
              begin
                 { here a problem detected in tabsolutesym }
                 { the types can be forward type !!        }
-                if assigned(def1^.sym) and (ppointerdef(def1)^.definition^.deftype=forwarddef) then
-                  b:=(def1^.sym=def2^.sym)
+                if assigned(def1^.typesym) and (ppointerdef(def1)^.pointertype.def^.deftype=forwarddef) then
+                  b:=(def1^.typesym=def2^.typesym)
                 else
-                  b:=ppointerdef(def1)^.definition=ppointerdef(def2)^.definition;
+                  b:=ppointerdef(def1)^.pointertype.def=ppointerdef(def2)^.pointertype.def;
              end
          else
          { ordinals are equal only when the ordinal type is equal }
@@ -855,25 +855,25 @@ implementation
          { but must NOT match for text file !!!                 }
          else
             if (def1^.deftype=filedef) and (def2^.deftype=filedef) then
-              b:=(pfiledef(def1)^.filetype=pfiledef(def2)^.filetype) and
+              b:=(pfiledef(def1)^.filetyp=pfiledef(def2)^.filetyp) and
                  ((
-                 ((pfiledef(def1)^.typed_as=nil) and
-                  (pfiledef(def2)^.typed_as=nil)) or
+                 ((pfiledef(def1)^.typedfiletype.def=nil) and
+                  (pfiledef(def2)^.typedfiletype.def=nil)) or
                  (
-                  (pfiledef(def1)^.typed_as<>nil) and
-                  (pfiledef(def2)^.typed_as<>nil) and
-                  is_equal(pfiledef(def1)^.typed_as,pfiledef(def2)^.typed_as)
+                  (pfiledef(def1)^.typedfiletype.def<>nil) and
+                  (pfiledef(def2)^.typedfiletype.def<>nil) and
+                  is_equal(pfiledef(def1)^.typedfiletype.def,pfiledef(def2)^.typedfiletype.def)
                  ) or
-                 ( (pfiledef(def1)^.typed_as=pdef(voiddef)) or
-                   (pfiledef(def2)^.typed_as=pdef(voiddef))
+                 ( (pfiledef(def1)^.typedfiletype.def=pdef(voiddef)) or
+                   (pfiledef(def2)^.typedfiletype.def=pdef(voiddef))
                  )))
          { sets with the same element type are equal }
          else
            if (def1^.deftype=setdef) and (def2^.deftype=setdef) then
              begin
-                if assigned(psetdef(def1)^.setof) and
-                   assigned(psetdef(def2)^.setof) then
-                  b:=(psetdef(def1)^.setof^.deftype=psetdef(def2)^.setof^.deftype)
+                if assigned(psetdef(def1)^.elementtype.def) and
+                   assigned(psetdef(def2)^.elementtype.def) then
+                  b:=(psetdef(def1)^.elementtype.def^.deftype=psetdef(def2)^.elementtype.def^.deftype)
                 else
                   b:=true;
              end
@@ -887,7 +887,7 @@ implementation
                    (pprocvardef(def1)^.proccalloptions=pprocvardef(def2)^.proccalloptions) and
                    ((pprocvardef(def1)^.procoptions * po_compatibility_options)=
                     (pprocvardef(def2)^.procoptions * po_compatibility_options)) and
-                   is_equal(pprocvardef(def1)^.retdef,pprocvardef(def2)^.retdef) and
+                   is_equal(pprocvardef(def1)^.rettype.def,pprocvardef(def2)^.rettype.def) and
                    equal_paras(pprocvardef(def1)^.para,pprocvardef(def2)^.para,false);
              end
          else
@@ -899,7 +899,7 @@ implementation
                   if parraydef(def1)^.IsArrayOfConst or parraydef(def2)^.IsArrayOfConst then
                    b:=true
                   else
-                   b:=is_equal(parraydef(def1)^.definition,parraydef(def2)^.definition);
+                   b:=is_equal(parraydef(def1)^.elementtype.def,parraydef(def2)^.elementtype.def);
                 end
                else
                 begin
@@ -907,18 +907,18 @@ implementation
                      not(m_delphi in aktmodeswitches) and
                      (parraydef(def1)^.lowrange=parraydef(def2)^.lowrange) and
                      (parraydef(def1)^.highrange=parraydef(def2)^.highrange) and
-                     is_equal(parraydef(def1)^.definition,parraydef(def2)^.definition) and
-                     is_equal(parraydef(def1)^.rangedef,parraydef(def2)^.rangedef);
+                     is_equal(parraydef(def1)^.elementtype.def,parraydef(def2)^.elementtype.def) and
+                     is_equal(parraydef(def1)^.rangetype.def,parraydef(def2)^.rangetype.def);
                 end;
              end
          else
            if (def1^.deftype=classrefdef) and (def2^.deftype=classrefdef) then
              begin
                 { similar to pointerdef: }
-                if assigned(def1^.sym) and (pclassrefdef(def1)^.definition^.deftype=forwarddef) then
-                  b:=(def1^.sym=def2^.sym)
+                if assigned(def1^.typesym) and (pclassrefdef(def1)^.pointertype.def^.deftype=forwarddef) then
+                  b:=(def1^.typesym=def2^.typesym)
                 else
-                  b:=is_equal(pclassrefdef(def1)^.definition,pclassrefdef(def2)^.definition);
+                  b:=is_equal(pclassrefdef(def1)^.pointertype.def,pclassrefdef(def2)^.pointertype.def);
              end;
          is_equal:=b;
       end;
@@ -985,7 +985,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.91  1999-11-06 14:34:31  peter
+  Revision 1.92  1999-11-30 10:40:59  peter
+    + ttype, tsymlist
+
+  Revision 1.91  1999/11/06 14:34:31  peter
     * truncated log to 20 revs
 
   Revision 1.90  1999/10/26 12:30:46  peter

Một số tệp đã không được hiển thị bởi vì quá nhiều tập tin thay đổi trong này khác