* procsym definition rewrite

compiler/browcol.pas

@@ -1392,7 +1392,7 @@ end;
       constchar:
         Name:=''''+chr(sym.valueord)+'''';
       constset:
-{        Name:=SetToStr(pnormalset(sym.valueptr)) }; 
+{        Name:=SetToStr(pnormalset(sym.valueptr)) };
       constnil: ;
     end;
     GetConstValueName:=Name;
@@ -1488,13 +1488,13 @@ end;
           procsym :
             begin
               with tprocsym(sym) do
-              if assigned(definition) then
+              if assigned(defs^.def) then
               begin
                 if cs_local_browser in aktmoduleswitches then
-                  ProcessSymTable(Symbol,Symbol^.Items,definition.parast);
-                if assigned(definition.parast) then
+                  ProcessSymTable(Symbol,Symbol^.Items,defs^.def.parast);
+                if assigned(defs^.def.parast) then
                   begin
-                    Symbol^.Params:=TypeNames^.Add(GetAbsProcParmDefStr(definition));
+                    Symbol^.Params:=TypeNames^.Add(GetAbsProcParmDefStr(defs^.def));
                   end
                 else { param-definition is NOT assigned }
                   if assigned(Table.Name) then
@@ -1504,9 +1504,9 @@ end;
                   end;
                 if cs_local_browser in aktmoduleswitches then
                  begin
-                   if assigned(definition.localst) and
-                     (definition.localst.symtabletype<>staticsymtable) then
-                    ProcessSymTable(Symbol,Symbol^.Items,definition.localst);
+                   if assigned(defs^.def.localst) and
+                     (defs^.def.localst.symtabletype<>staticsymtable) then
+                    ProcessSymTable(Symbol,Symbol^.Items,defs^.def.localst);
                  end;
               end;
             end;
@@ -2125,7 +2125,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.21  2001-09-04 11:53:48  jonas
+  Revision 1.22  2001-11-02 22:58:00  peter
+    * procsym definition rewrite
+
+  Revision 1.21  2001/09/04 11:53:48  jonas
     * fixed compiling errors
 
   Revision 1.20  2001/08/07 17:08:49  peter

compiler/browlog.pas

@@ -369,13 +369,13 @@ implementation
                   end;
                 procsym :
                   begin
-                     symt:=tprocsym(sym).definition.parast;
+                     symt:=tprocsym(sym).defs^.def.parast;
                      symb:=tstoredsym(symt.search(ss));
                      if symb=nil then
                        symb:=tstoredsym(symt.search(upper(ss)));
                      if not assigned(symb) then
                        begin
-                          symt:=tprocsym(sym).definition.localst;
+                          symt:=tprocsym(sym).defs^.def.localst;
                           sym:=tstoredsym(symt.search(ss));
                           if symb=nil then
                             symb:=tstoredsym(symt.search(upper(ss)));
@@ -413,7 +413,7 @@ implementation
     procedure writesymtable(p:tsymtable);
       var
         hp : tstoredsym;
-        prdef : tprocdef;
+        prdef : pprocdeflist;
       begin
         if cs_browser in aktmoduleswitches then
          begin
@@ -446,22 +446,22 @@ implementation
                   end;
                 procsym :
                   begin
-                    prdef:=tprocsym(hp).definition;
+                    prdef:=tprocsym(hp).defs;
                     while assigned(prdef) do
                      begin
-                       if assigned(prdef.defref) then
+                       if assigned(prdef^.def.defref) then
                         begin
-                          browserlog.AddLog('***'+prdef.mangledname);
-                          browserlog.AddLogRefs(prdef.defref);
+                          browserlog.AddLog('***'+prdef^.def.mangledname);
+                          browserlog.AddLogRefs(prdef^.def.defref);
                           if (current_module.flags and uf_local_browser)<>0 then
                             begin
-                               if assigned(prdef.parast) then
-                                 writesymtable(prdef.parast);
-                               if assigned(prdef.localst) then
-                                 writesymtable(prdef.localst);
+                               if assigned(prdef^.def.parast) then
+                                 writesymtable(prdef^.def.parast);
+                               if assigned(prdef^.def.localst) then
+                                 writesymtable(prdef^.def.localst);
                             end;
                         end;
-                       prdef:=tprocdef(prdef).nextoverloaded;
+                       prdef:=prdef^.next;
                      end;
                   end;
               end;
@@ -514,7 +514,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.9  2001-08-19 09:39:27  peter
+  Revision 1.10  2001-11-02 22:58:01  peter
+    * procsym definition rewrite
+
+  Revision 1.9  2001/08/19 09:39:27  peter
     * local browser support fixed
 
   Revision 1.8  2001/04/18 22:01:53  peter

compiler/htypechk.pas

@@ -588,7 +588,7 @@ implementation
                         begin
                           if (assigned(hsym.owner) and
                              assigned(aktprocsym) and
-                             (hsym.owner = aktprocsym.definition.localst)) then
+                             (hsym.owner = aktprocdef.localst)) then
                            begin
                              if tloadnode(p).symtable.symtabletype=localsymtable then
                               CGMessage1(sym_n_uninitialized_local_variable,hsym.realname)
@@ -974,7 +974,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.37  2001-10-20 20:30:21  peter
+  Revision 1.38  2001-11-02 22:58:01  peter
+    * procsym definition rewrite
+
+  Revision 1.37  2001/10/20 20:30:21  peter
     * read only typed const support, switch $J-
 
   Revision 1.36  2001/10/12 13:51:51  jonas

compiler/i386/cga.pas

@@ -1533,7 +1533,7 @@ implementation
     var
       pl : tasmlabel;
     begin
-      if (po_assembler in aktprocsym.definition.procoptions) then
+      if (po_assembler in aktprocdef.procoptions) then
        exit;
       case target_info.target of
          target_i386_win32,
@@ -2076,7 +2076,7 @@ implementation
          (aktoptprocessor in [classp5,classp6]) then
          begin
             ls:=0;
-            aktprocsym.definition.localst.foreach({$ifndef TP}@{$endif}largest_size);
+            aktprocdef.localst.foreach({$ifndef TP}@{$endif}largest_size);
             if ls>=8 then
               aList.insert(Taicpu.Op_const_reg(A_AND,S_L,-8,R_ESP));
          end;
@@ -2107,7 +2107,7 @@ implementation
     begin
        oldexprasmlist:=exprasmlist;
        exprasmlist:=alist;
-       if (not inlined) and (aktprocsym.definition.proctypeoption=potype_proginit) then
+       if (not inlined) and (aktprocdef.proctypeoption=potype_proginit) then
            begin
               emitinsertcall('FPC_INITIALIZEUNITS');
               { initialize profiling for win32 }
@@ -2134,7 +2134,7 @@ implementation
 {$endif GDB}
 
       { a constructor needs a help procedure }
-      if (aktprocsym.definition.proctypeoption=potype_constructor) then
+      if (aktprocdef.proctypeoption=potype_constructor) then
         begin
           if is_class(procinfo^._class) then
             begin
@@ -2164,7 +2164,7 @@ implementation
 
       { When message method contains self as a parameter,
         we must load it into ESI }
-      If (po_containsself in aktprocsym.definition.procoptions) then
+      If (po_containsself in aktprocdef.procoptions) then
         begin
            new(hr);
            reset_reference(hr^);
@@ -2174,9 +2174,9 @@ implementation
            exprasmList.insert(Tairegalloc.Alloc(R_ESI));
         end;
       { should we save edi,esi,ebx like C ? }
-      if (po_savestdregs in aktprocsym.definition.procoptions) then
+      if (po_savestdregs in aktprocdef.procoptions) then
        begin
-         if (aktprocsym.definition.usedregisters and ($80 shr byte(R_EBX)))<>0 then
+         if (aktprocdef.usedregisters and ($80 shr byte(R_EBX)))<>0 then
            exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_EBX));
          exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_ESI));
          exprasmList.insert(Taicpu.Op_reg(A_PUSH,S_L,R_EDI));
@@ -2184,7 +2184,7 @@ implementation
 
       { for the save all registers we can simply use a pusha,popa which
         push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
-      if (po_saveregisters in aktprocsym.definition.procoptions) then
+      if (po_saveregisters in aktprocdef.procoptions) then
         begin
           exprasmList.insert(Taicpu.Op_none(A_PUSHA,S_L));
         end;
@@ -2195,20 +2195,20 @@ implementation
           begin
               CGMessage(cg_d_stackframe_omited);
               nostackframe:=true;
-              if (aktprocsym.definition.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
+              if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
                 parasize:=0
               else
-                parasize:=aktprocsym.definition.parast.datasize+procinfo^.para_offset-4;
+                parasize:=aktprocdef.parast.datasize+procinfo^.para_offset-4;
               if stackframe<>0 then
                 exprasmList.insert(Taicpu.op_const_reg(A_SUB,S_L,stackframe,R_ESP));
           end
         else
           begin
               alignstack(alist);
-              if (aktprocsym.definition.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
+              if (aktprocdef.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
                 parasize:=0
               else
-                parasize:=aktprocsym.definition.parast.datasize+procinfo^.para_offset-8;
+                parasize:=aktprocdef.parast.datasize+procinfo^.para_offset-8;
               nostackframe:=false;
               if stackframe<>0 then
                begin
@@ -2266,22 +2266,22 @@ implementation
                end;
           end;
 
-      if (po_interrupt in aktprocsym.definition.procoptions) then
+      if (po_interrupt in aktprocdef.procoptions) then
           generate_interrupt_stackframe_entry;
 
       { initialize return value }
-      if (not is_void(aktprocsym.definition.rettype.def)) and
-         (aktprocsym.definition.rettype.def.needs_inittable) then
+      if (not is_void(aktprocdef.rettype.def)) and
+         (aktprocdef.rettype.def.needs_inittable) then
         begin
            procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
            reset_reference(r);
            r.offset:=procinfo^.return_offset;
            r.base:=procinfo^.framepointer;
-           initialize(aktprocsym.definition.rettype.def,r,ret_in_param(aktprocsym.definition.rettype.def));
+           initialize(aktprocdef.rettype.def,r,ret_in_param(aktprocdef.rettype.def));
         end;
 
       { initialisize local data like ansistrings }
-      case aktprocsym.definition.proctypeoption of
+      case aktprocdef.proctypeoption of
          potype_unitinit:
            begin
               { using current_module.globalsymtable is hopefully      }
@@ -2292,25 +2292,25 @@ implementation
          { units have seperate code for initilization and finalization }
          potype_unitfinalize: ;
          else
-           aktprocsym.definition.localst.foreach_static({$ifndef TP}@{$endif}initialize_data);
+           aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data);
       end;
 
       { initialisizes temp. ansi/wide string data }
       inittempvariables;
 
       { generate copies of call by value parameters }
-      if not(po_assembler in aktprocsym.definition.procoptions) and
-         not(aktprocsym.definition.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_palmossyscall,pocall_system]) then
-        aktprocsym.definition.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas);
+      if not(po_assembler in aktprocdef.procoptions) and
+         not(aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_palmossyscall,pocall_system]) then
+        aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas);
 
-      if assigned( aktprocsym.definition.parast) then
-        aktprocsym.definition.parast.foreach_static({$ifndef TP}@{$endif}init_paras);
+      if assigned( aktprocdef.parast) then
+        aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}init_paras);
 
       { do we need an exception frame because of ansi/widestrings/interfaces ? }
       if not inlined and
          ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
       { but it's useless in init/final code of units }
-        not(aktprocsym.definition.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
+        not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
         begin
             usedinproc:=usedinproc or ($80 shr byte(R_EAX));
 
@@ -2342,11 +2342,11 @@ implementation
       if not inlined then
        begin
          if (cs_profile in aktmoduleswitches) or
-            (aktprocsym.definition.owner.symtabletype=globalsymtable) or
+            (aktprocdef.owner.symtabletype=globalsymtable) or
             (assigned(procinfo^._class) and (procinfo^._class.owner.symtabletype=globalsymtable)) then
               make_global:=true;
 
-         hs:=aktprocsym.definition.aliasnames.getfirst;
+         hs:=aktprocdef.aliasnames.getfirst;
 
 {$ifdef GDB}
          if (cs_debuginfo in aktmoduleswitches) and target_info.use_function_relative_addresses then
@@ -2366,7 +2366,7 @@ implementation
               exprasmList.insert(Tai_stab_function_name.Create(strpnew(hs)));
 {$endif GDB}
 
-            hs:=aktprocsym.definition.aliasnames.getfirst;
+            hs:=aktprocdef.aliasnames.getfirst;
           end;
 
          if make_global or ((procinfo^.flags and pi_is_global) <> 0) then
@@ -2400,21 +2400,21 @@ implementation
        op : Tasmop;
        s : Topsize;
   begin
-      if not is_void(aktprocsym.definition.rettype.def) then
+      if not is_void(aktprocdef.rettype.def) then
           begin
               {if ((procinfo^.flags and pi_operator)<>0) and
                  assigned(otsym) then
                 procinfo^.funcret_is_valid:=
                   procinfo^.funcret_is_valid or (otsym.refs>0);}
-              if (tfuncretsym(aktprocsym.definition.funcretsym).funcretstate<>vs_assigned) and not inlined { and
+              if (tfuncretsym(aktprocdef.funcretsym).funcretstate<>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^.return_offset);
-              if (aktprocsym.definition.rettype.def.deftype in [orddef,enumdef]) then
+              if (aktprocdef.rettype.def.deftype in [orddef,enumdef]) then
                 begin
                   uses_eax:=true;
                   exprasmList.concat(Tairegalloc.Alloc(R_EAX));
-                  case aktprocsym.definition.rettype.def.size of
+                  case aktprocdef.rettype.def.size of
                    8:
                      begin
                         emit_ref_reg(A_MOV,S_L,hr,R_EAX);
@@ -2435,16 +2435,16 @@ implementation
                   end;
                 end
               else
-                if ret_in_acc(aktprocsym.definition.rettype.def) then
+                if ret_in_acc(aktprocdef.rettype.def) then
                   begin
                     uses_eax:=true;
                     exprasmList.concat(Tairegalloc.Alloc(R_EAX));
                     emit_ref_reg(A_MOV,S_L,hr,R_EAX);
                   end
               else
-                 if (aktprocsym.definition.rettype.def.deftype=floatdef) then
+                 if (aktprocdef.rettype.def.deftype=floatdef) then
                    begin
-                      floatloadops(tfloatdef(aktprocsym.definition.rettype.def).typ,op,s);
+                      floatloadops(tfloatdef(aktprocdef.rettype.def).typ,op,s);
                       exprasmList.concat(Taicpu.Op_ref(op,s,hr));
                    end
               else
@@ -2459,12 +2459,12 @@ implementation
        op : Tasmop;
        s : Topsize;
     begin
-      if not is_void(aktprocsym.definition.rettype.def) then
+      if not is_void(aktprocdef.rettype.def) then
           begin
               hr:=new_reference(procinfo^.framepointer,procinfo^.return_offset);
-              if (aktprocsym.definition.rettype.def.deftype in [orddef,enumdef]) then
+              if (aktprocdef.rettype.def.deftype in [orddef,enumdef]) then
                 begin
-                  case aktprocsym.definition.rettype.def.size of
+                  case aktprocdef.rettype.def.size of
                    8:
                      begin
                         emit_reg_ref(A_MOV,S_L,R_EAX,hr);
@@ -2483,14 +2483,14 @@ implementation
                   end;
                 end
               else
-                if ret_in_acc(aktprocsym.definition.rettype.def) then
+                if ret_in_acc(aktprocdef.rettype.def) then
                   begin
                     emit_reg_ref(A_MOV,S_L,R_EAX,hr);
                   end
               else
-                 if (aktprocsym.definition.rettype.def.deftype=floatdef) then
+                 if (aktprocdef.rettype.def.deftype=floatdef) then
                    begin
-                      floatstoreops(tfloatdef(aktprocsym.definition.rettype.def).typ,op,s);
+                      floatstoreops(tfloatdef(aktprocdef.rettype.def).typ,op,s);
                       exprasmlist.concat(taicpu.op_ref(op,s,hr));
                    end
               else
@@ -2531,7 +2531,7 @@ implementation
         exprasmList.concat(Tai_label.Create(aktexitlabel));
 
       { call the destructor help procedure }
-      if (aktprocsym.definition.proctypeoption=potype_destructor) and
+      if (aktprocdef.proctypeoption=potype_destructor) and
          assigned(procinfo^._class) then
         begin
           if is_class(procinfo^._class) then
@@ -2571,7 +2571,7 @@ implementation
       finalizetempvariables;
 
       { finalize local data like ansistrings}
-      case aktprocsym.definition.proctypeoption of
+      case aktprocdef.proctypeoption of
          potype_unitfinalize:
            begin
               { using current_module.globalsymtable is hopefully      }
@@ -2582,21 +2582,21 @@ implementation
          { units have seperate code for initialization and finalization }
          potype_unitinit: ;
          else
-           aktprocsym.definition.localst.foreach_static({$ifndef TP}@{$endif}finalize_data);
+           aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data);
       end;
 
       { finalize paras data }
-      if assigned(aktprocsym.definition.parast) then
-        aktprocsym.definition.parast.foreach_static({$ifndef TP}@{$endif}final_paras);
+      if assigned(aktprocdef.parast) then
+        aktprocdef.parast.foreach_static({$ifndef TP}@{$endif}final_paras);
 
       { do we need to handle exceptions because of ansi/widestrings ? }
       if not inlined and
          ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
       { but it's useless in init/final code of units }
-        not(aktprocsym.definition.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
+        not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
         begin
            { the exception helper routines modify all registers }
-           aktprocsym.definition.usedregisters:=$ff;
+           aktprocdef.usedregisters:=$ff;
 
            getlabel(noreraiselabel);
            emitcall('FPC_POPADDRSTACK');
@@ -2605,7 +2605,7 @@ implementation
            exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX));
            ungetregister32(R_EAX);
            emitjmp(C_E,noreraiselabel);
-           if (aktprocsym.definition.proctypeoption=potype_constructor) then
+           if (aktprocdef.proctypeoption=potype_constructor) then
              begin
                 if assigned(procinfo^._class) then
                   begin
@@ -2648,15 +2648,15 @@ implementation
              end
            else
            { must be the return value finalized before reraising the exception? }
-           if (not is_void(aktprocsym.definition.rettype.def)) and
-             (aktprocsym.definition.rettype.def.needs_inittable) and
-             ((aktprocsym.definition.rettype.def.deftype<>objectdef) or
-              not is_class(aktprocsym.definition.rettype.def)) then
+           if (not is_void(aktprocdef.rettype.def)) and
+             (aktprocdef.rettype.def.needs_inittable) and
+             ((aktprocdef.rettype.def.deftype<>objectdef) or
+              not is_class(aktprocdef.rettype.def)) then
              begin
                 reset_reference(hr);
                 hr.offset:=procinfo^.return_offset;
                 hr.base:=procinfo^.framepointer;
-                finalize(aktprocsym.definition.rettype.def,hr,ret_in_param(aktprocsym.definition.rettype.def));
+                finalize(aktprocdef.rettype.def,hr,ret_in_param(aktprocdef.rettype.def));
              end;
 
            emitcall('FPC_RERAISE');
@@ -2664,7 +2664,7 @@ implementation
         end;
 
       { call __EXIT for main program }
-      if (not DLLsource) and (not inlined) and (aktprocsym.definition.proctypeoption=potype_proginit) then
+      if (not DLLsource) and (not inlined) and (aktprocdef.proctypeoption=potype_proginit) then
        begin
          emitcall('FPC_DO_EXIT');
        end;
@@ -2673,8 +2673,8 @@ implementation
       uses_eax:=false;
       uses_edx:=false;
       uses_esi:=false;
-      if not(po_assembler in aktprocsym.definition.procoptions) then
-          if (aktprocsym.definition.proctypeoption<>potype_constructor) then
+      if not(po_assembler in aktprocdef.procoptions) then
+          if (aktprocdef.proctypeoption<>potype_constructor) then
             handle_return_value(inlined,uses_eax,uses_edx)
           else
               begin
@@ -2723,13 +2723,13 @@ implementation
           emitlab(stabsendlabel);
         end;
       { gives problems for long mangled names }
-      {List.concat(Tai_symbol.Create(aktprocsym.definition.mangledname+'_end'));}
+      {List.concat(Tai_symbol.Create(aktprocdef.mangledname+'_end'));}
 
       { should we restore edi ? }
       { for all i386 gcc implementations }
-      if (po_savestdregs in aktprocsym.definition.procoptions) then
+      if (po_savestdregs in aktprocdef.procoptions) then
         begin
-          if (aktprocsym.definition.usedregisters and ($80 shr byte(R_EBX)))<>0 then
+          if (aktprocdef.usedregisters and ($80 shr byte(R_EBX)))<>0 then
            exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,R_EBX));
           exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,R_ESI));
           exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,R_EDI));
@@ -2737,14 +2737,14 @@ implementation
             but that is risky because it only works
             if genexitcode is called after genentrycode
             so lets skip this for the moment PM
-          aktprocsym.definition.usedregisters:=
-            aktprocsym.definition.usedregisters or not ($80 shr byte(R_EBX));
+          aktprocdef.usedregisters:=
+            aktprocdef.usedregisters or not ($80 shr byte(R_EBX));
           }
         end;
 
       { for the save all registers we can simply use a pusha,popa which
         push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
-      if (po_saveregisters in aktprocsym.definition.procoptions) then
+      if (po_saveregisters in aktprocdef.procoptions) then
         begin
           if uses_esi then
             exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_ESI,new_reference(R_ESP,4)));
@@ -2769,13 +2769,13 @@ implementation
 
       { parameters are limited to 65535 bytes because }
       { ret allows only imm16                    }
-      if (parasize>65535) and not(po_clearstack in aktprocsym.definition.procoptions) then
+      if (parasize>65535) and not(po_clearstack in aktprocdef.procoptions) then
        CGMessage(cg_e_parasize_too_big);
 
       { at last, the return is generated }
 
       if not inlined then
-      if (po_interrupt in aktprocsym.definition.procoptions) then
+      if (po_interrupt in aktprocdef.procoptions) then
           begin
              if uses_esi then
                exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,R_ESI,new_reference(R_ESP,16)));
@@ -2795,11 +2795,11 @@ implementation
        begin
        {Routines with the poclearstack flag set use only a ret.}
        { also routines with parasize=0     }
-         if (po_clearstack in aktprocsym.definition.procoptions) then
+         if (po_clearstack in aktprocdef.procoptions) then
            begin
 {$ifndef OLD_C_STACK}
              { complex return values are removed from stack in C code PM }
-             if ret_in_param(aktprocsym.definition.rettype.def) then
+             if ret_in_param(aktprocdef.rettype.def) then
                exprasmList.concat(Taicpu.Op_const(A_RET,S_NO,4))
              else
 {$endif not OLD_C_STACK}
@@ -2812,7 +2812,7 @@ implementation
        end;
 
       if not inlined then
-        exprasmList.concat(Tai_symbol_end.Createname(aktprocsym.definition.mangledname));
+        exprasmList.concat(Tai_symbol_end.Createname(aktprocdef.mangledname));
 
 {$ifdef GDB}
       if (cs_debuginfo in aktmoduleswitches) and not inlined  then
@@ -2822,10 +2822,10 @@ implementation
                 if (not assigned(procinfo^.parent) or
                    not assigned(procinfo^.parent^._class)) then
                   begin
-                    if (po_classmethod in aktprocsym.definition.procoptions) or
-                       ((po_virtualmethod in aktprocsym.definition.procoptions) and
-                        (potype_constructor=aktprocsym.definition.proctypeoption)) or
-                       (po_staticmethod in aktprocsym.definition.procoptions) then
+                    if (po_classmethod in aktprocdef.procoptions) or
+                       ((po_virtualmethod in aktprocdef.procoptions) and
+                        (potype_constructor=aktprocdef.proctypeoption)) or
+                       (po_staticmethod in aktprocdef.procoptions) then
                       begin
                         exprasmList.concat(Tai_stabs.Create(strpnew(
                          '"pvmt:p'+tstoreddef(pvmttype.def).numberstring+'",'+
@@ -2860,50 +2860,50 @@ implementation
                  '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
                  tostr(N_LSYM)+',0,0,'+tostr(procinfo^.framepointer_offset))));
 
-              if (not is_void(aktprocsym.definition.rettype.def)) then
+              if (not is_void(aktprocdef.rettype.def)) then
                 begin
-                  if ret_in_param(aktprocsym.definition.rettype.def) then
+                  if ret_in_param(aktprocdef.rettype.def) then
                     exprasmList.concat(Tai_stabs.Create(strpnew(
-                     '"'+aktprocsym.name+':X*'+tstoreddef(aktprocsym.definition.rettype.def).numberstring+'",'+
+                     '"'+aktprocsym.name+':X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
                      tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))))
                   else
                     exprasmList.concat(Tai_stabs.Create(strpnew(
-                     '"'+aktprocsym.name+':X'+tstoreddef(aktprocsym.definition.rettype.def).numberstring+'",'+
+                     '"'+aktprocsym.name+':X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
                      tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))));
                   if (m_result in aktmodeswitches) then
-                    if ret_in_param(aktprocsym.definition.rettype.def) then
+                    if ret_in_param(aktprocdef.rettype.def) then
                       exprasmList.concat(Tai_stabs.Create(strpnew(
-                       '"RESULT:X*'+tstoreddef(aktprocsym.definition.rettype.def).numberstring+'",'+
+                       '"RESULT:X*'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
                        tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))))
                     else
                       exprasmList.concat(Tai_stabs.Create(strpnew(
-                       '"RESULT:X'+tstoreddef(aktprocsym.definition.rettype.def).numberstring+'",'+
+                       '"RESULT:X'+tstoreddef(aktprocdef.rettype.def).numberstring+'",'+
                        tostr(N_tsym)+',0,0,'+tostr(procinfo^.return_offset))));
                 end;
-              mangled_length:=length(aktprocsym.definition.mangledname);
+              mangled_length:=length(aktprocdef.mangledname);
               getmem(p,2*mangled_length+50);
               strpcopy(p,'192,0,0,');
-              strpcopy(strend(p),aktprocsym.definition.mangledname);
+              strpcopy(strend(p),aktprocdef.mangledname);
               if (target_info.use_function_relative_addresses) then
                 begin
                   strpcopy(strend(p),'-');
-                  strpcopy(strend(p),aktprocsym.definition.mangledname);
+                  strpcopy(strend(p),aktprocdef.mangledname);
                 end;
               exprasmList.concat(Tai_stabn.Create(strnew(p)));
               {List.concat(Tai_stabn.Create(strpnew('192,0,0,'
-               +aktprocsym.definition.mangledname))));
+               +aktprocdef.mangledname))));
               p[0]:='2';p[1]:='2';p[2]:='4';
               strpcopy(strend(p),'_end');}
               strpcopy(p,'224,0,0,'+stabsendlabel.name);
               if (target_info.use_function_relative_addresses) then
                 begin
                   strpcopy(strend(p),'-');
-                  strpcopy(strend(p),aktprocsym.definition.mangledname);
+                  strpcopy(strend(p),aktprocdef.mangledname);
                 end;
               exprasmList.concatlist(withdebuglist);
               exprasmList.concat(Tai_stabn.Create(strnew(p)));
                { strpnew('224,0,0,'
-               +aktprocsym.definition.mangledname+'_end'))));}
+               +aktprocdef.mangledname+'_end'))));}
               freemem(p,2*mangled_length+50);
           end;
 {$endif GDB}
@@ -2974,7 +2974,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.8  2001-10-25 21:22:41  peter
+  Revision 1.9  2001-11-02 22:58:09  peter
+    * procsym definition rewrite
+
+  Revision 1.8  2001/10/25 21:22:41  peter
     * calling convention rewrite
 
   Revision 1.7  2001/10/20 17:22:57  peter

compiler/i386/daopt386.pas

@@ -393,18 +393,18 @@ Procedure RemoveLastDeallocForFuncRes(asmL: TAAsmOutput; p: Tai);
   end;
 
 begin
-    case aktprocsym.definition.rettype.def.deftype of
+    case aktprocdef.rettype.def.deftype of
       arraydef,recorddef,pointerdef,
          stringdef,enumdef,procdef,objectdef,errordef,
          filedef,setdef,procvardef,
          classrefdef,forwarddef:
         DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
       orddef:
-        if aktprocsym.definition.rettype.def.size <> 0 then
+        if aktprocdef.rettype.def.size <> 0 then
           begin
             DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
             { for int64/qword }
-            if aktprocsym.definition.rettype.def.size = 8 then
+            if aktprocdef.rettype.def.size = 8 then
               DoRemoveLastDeallocForFuncRes(asmL,R_EDX);
           end;
     end;
@@ -414,18 +414,18 @@ procedure getNoDeallocRegs(var regs: TRegSet);
 var regCounter: TRegister;
 begin
   regs := [];
-    case aktprocsym.definition.rettype.def.deftype of
+    case aktprocdef.rettype.def.deftype of
       arraydef,recorddef,pointerdef,
          stringdef,enumdef,procdef,objectdef,errordef,
          filedef,setdef,procvardef,
          classrefdef,forwarddef:
        regs := [R_EAX];
       orddef:
-        if aktprocsym.definition.rettype.def.size <> 0 then
+        if aktprocdef.rettype.def.size <> 0 then
           begin
             regs := [R_EAX];
             { for int64/qword }
-            if aktprocsym.definition.rettype.def.size = 8 then
+            if aktprocdef.rettype.def.size = 8 then
               regs := regs + [R_EDX];
           end;
     end;
@@ -2591,7 +2591,10 @@ End.
 
 {
   $Log$
-  Revision 1.23  2001-10-27 10:20:43  jonas
+  Revision 1.24  2001-11-02 22:58:09  peter
+    * procsym definition rewrite
+
+  Revision 1.23  2001/10/27 10:20:43  jonas
     + replace mem accesses to locations to which a reg was stored recently with that reg
 
   Revision 1.22  2001/10/12 13:58:05  jonas

compiler/i386/n386cal.pas

@@ -329,7 +329,7 @@ implementation
               right:=nil;
               { set it to the same lexical level as the local symtable, becuase
                 the para's are stored there }
-              tprocdef(procdefinition).parast.symtablelevel:=aktprocsym.definition.localst.symtablelevel;
+              tprocdef(procdefinition).parast.symtablelevel:=aktprocdef.localst.symtablelevel;
               if assigned(params) then
                 inlinecode.para_offset:=gettempofsizepersistant(inlinecode.para_size);
               store_parast_fixup:=tprocdef(procdefinition).parast.address_fixup;
@@ -355,7 +355,7 @@ implementation
            begin
               if (cs_check_io in aktlocalswitches) and
                  (po_iocheck in procdefinition.procoptions) and
-                 not(po_iocheck in aktprocsym.definition.procoptions) then
+                 not(po_iocheck in aktprocdef.procoptions) then
                 begin
                    getaddrlabel(iolabel);
                    emitlab(iolabel);
@@ -607,8 +607,6 @@ implementation
 
                                     { a class destructor needs a flag }
                                     if is_class(tobjectdef(methodpointer.resulttype.def)) and
-                                       {assigned(aktprocsym) and
-                                       (aktprocsym.definition.proctypeoption=potype_destructor)}
                                        (procdefinition.proctypeoption=potype_destructor) then
                                       begin
                                         push_int(0);
@@ -617,8 +615,6 @@ implementation
 
                                     if not(is_con_or_destructor and
                                            is_class(methodpointer.resulttype.def) and
-                                           {assigned(aktprocsym) and
-                                          (aktprocsym.definition.proctypeoption in [potype_constructor,potype_destructor])}
                                            (procdefinition.proctypeoption in [potype_constructor,potype_destructor])
                                           ) then
                                       emit_reg(A_PUSH,S_L,R_ESI);
@@ -628,9 +624,9 @@ implementation
                                     { con- and destructors need a pointer to the vmt }
                                     if is_con_or_destructor and
                                       is_object(methodpointer.resulttype.def) and
-                                      assigned(aktprocsym) then
+                                      assigned(aktprocdef) then
                                       begin
-                                         if not(aktprocsym.definition.proctypeoption in
+                                         if not(aktprocdef.proctypeoption in
                                                 [potype_constructor,potype_destructor]) then
                                           CGMessage(cg_w_member_cd_call_from_method);
                                       end;
@@ -639,8 +635,8 @@ implementation
                                     if is_con_or_destructor and
                                       not(
                                         is_class(methodpointer.resulttype.def) and
-                                        assigned(aktprocsym) and
-                                        (aktprocsym.definition.proctypeoption=potype_destructor)) then
+                                        assigned(aktprocdef) and
+                                        (aktprocdef.proctypeoption=potype_destructor)) then
                                       begin
                                          { a constructor needs also a flag }
                                          if is_class(methodpointer.resulttype.def) then
@@ -765,8 +761,8 @@ implementation
                      begin
                         if (po_classmethod in procdefinition.procoptions) and
                           not(
-                            assigned(aktprocsym) and
-                            (po_classmethod in aktprocsym.definition.procoptions)
+                            assigned(aktprocdef) and
+                            (po_classmethod in aktprocdef.procoptions)
                           ) then
                           begin
                              { class method needs current VMT }
@@ -909,10 +905,10 @@ implementation
                    { Here it is quite tricky because it also depends }
                    { on the methodpointer                        PM }
                    getexplicitregister32(R_ESI);
-                   if assigned(aktprocsym) then
+                   if assigned(aktprocdef) then
                      begin
-                       if (((sp_static in aktprocsym.symoptions) or
-                        (po_classmethod in aktprocsym.definition.procoptions)) and
+                       if (((sp_static in aktprocdef.procsym.symoptions) or
+                        (po_classmethod in aktprocdef.procoptions)) and
                         ((methodpointer=nil) or (methodpointer.nodetype=typen)))
                         or
                         (po_staticmethod in procdefinition.procoptions) or
@@ -944,7 +940,7 @@ implementation
                          end;
                      end
                    else
-                     { aktprocsym should be assigned, also in main program }
+                     { aktprocdef should be assigned, also in main program }
                      internalerror(12345);
                    {
                      begin
@@ -1122,7 +1118,7 @@ implementation
             (procdefinition.proctypeoption=potype_constructor) and
             assigned(methodpointer) and
             (methodpointer.nodetype=typen) and
-            (aktprocsym.definition.proctypeoption=potype_constructor) then
+            (aktprocdef.proctypeoption=potype_constructor) then
            begin
              emitjmp(C_Z,faillabel);
            end;
@@ -1398,7 +1394,7 @@ implementation
 
     procedure ti386procinlinenode.pass_2;
        var st : tsymtable;
-           oldprocsym : tprocsym;
+           oldprocdef : tprocdef;
            ps, i : longint;
            tmpreg: tregister;
            oldprocinfo : pprocinfo;
@@ -1422,9 +1418,9 @@ implementation
 {$endif GDB}
        begin
           { deallocate the registers used for the current procedure's regvars }
-          if assigned(aktprocsym.definition.regvarinfo) then
+          if assigned(aktprocdef.regvarinfo) then
             begin
-              with pregvarinfo(aktprocsym.definition.regvarinfo)^ do
+              with pregvarinfo(aktprocdef.regvarinfo)^ do
                 for i := 1 to maxvarregs do
                   if assigned(regvars[i]) then
                     store_regvar(exprasmlist,regvars[i].reg);
@@ -1443,8 +1439,8 @@ implementation
               resetusableregisters;
               clearregistercount;
               cleartempgen;
-              if assigned(inlineprocsym.definition.regvarinfo) then
-                with pregvarinfo(inlineprocsym.definition.regvarinfo)^ do
+              if assigned(inlineprocdef.regvarinfo) then
+                with pregvarinfo(inlineprocdef.regvarinfo)^ do
                  for i := 1 to maxvarregs do
                   if assigned(regvars[i]) then
                     begin
@@ -1467,18 +1463,17 @@ implementation
           { we're inlining a procedure }
           inlining_procedure:=true;
           { save old procinfo }
-          oldprocsym:=aktprocsym;
           getmem(oldprocinfo,sizeof(tprocinfo));
           move(procinfo^,oldprocinfo^,sizeof(tprocinfo));
           { set new procinfo }
-          aktprocsym:=inlineprocsym;
+          aktprocdef:=inlineprocdef;
           procinfo^.return_offset:=retoffset;
           procinfo^.para_offset:=para_offset;
           procinfo^.no_fast_exit:=false;
           { arg space has been filled by the parent secondcall }
-          st:=aktprocsym.definition.localst;
+          st:=aktprocdef.localst;
           { set it to the same lexical level }
-          st.symtablelevel:=oldprocsym.definition.localst.symtablelevel;
+          st.symtablelevel:=oldprocdef.localst.symtablelevel;
           if st.datasize>0 then
             begin
               st.address_fixup:=gettempofsizepersistant(st.datasize)+st.datasize;
@@ -1498,23 +1493,23 @@ implementation
               getaddrlabel(startlabel);
               getaddrlabel(endlabel);
               emitlab(startlabel);
-              inlineprocsym.definition.localst.symtabletype:=inlinelocalsymtable;
-              inlineprocsym.definition.parast.symtabletype:=inlineparasymtable;
+              inlineprocdef.localst.symtabletype:=inlinelocalsymtable;
+              inlineprocdef.parast.symtabletype:=inlineparasymtable;
 
               { Here we must include the para and local symtable info }
-              inlineprocsym.concatstabto(withdebuglist);
+              tprocsym(inlineprocdef.procsym).concatstabto(withdebuglist);
 
               { set it back for safety }
-              inlineprocsym.definition.localst.symtabletype:=localsymtable;
-              inlineprocsym.definition.parast.symtabletype:=parasymtable;
+              inlineprocdef.localst.symtabletype:=localsymtable;
+              inlineprocdef.parast.symtabletype:=parasymtable;
 
-              mangled_length:=length(oldprocsym.definition.mangledname);
+              mangled_length:=length(oldprocdef.mangledname);
               getmem(pp,mangled_length+50);
               strpcopy(pp,'192,0,0,'+startlabel.name);
               if (target_info.use_function_relative_addresses) then
                 begin
                   strpcopy(strend(pp),'-');
-                  strpcopy(strend(pp),oldprocsym.definition.mangledname);
+                  strpcopy(strend(pp),oldprocdef.mangledname);
                 end;
               withdebugList.concat(Tai_stabn.Create(strnew(pp)));
             end;
@@ -1525,12 +1520,12 @@ implementation
           ps:=para_size;
           make_global:=false; { to avoid warning }
           genentrycode(inlineentrycode,make_global,0,ps,nostackframe,true);
-          if po_assembler in aktprocsym.definition.procoptions then
+          if po_assembler in aktprocdef.procoptions then
             inlineentrycode.insert(Tai_marker.Create(asmblockstart));
           exprasmList.concatlist(inlineentrycode);
           secondpass(inlinetree);
           genexitcode(inlineexitcode,0,false,true);
-          if po_assembler in aktprocsym.definition.procoptions then
+          if po_assembler in aktprocdef.procoptions then
             inlineexitcode.concat(Tai_marker.Create(asmblockend));
           exprasmList.concatlist(inlineexitcode);
 
@@ -1558,14 +1553,14 @@ implementation
              if (target_info.use_function_relative_addresses) then
                begin
                  strpcopy(strend(pp),'-');
-                 strpcopy(strend(pp),oldprocsym.definition.mangledname);
+                 strpcopy(strend(pp),oldprocdef.mangledname);
                end;
               withdebugList.concat(Tai_stabn.Create(strnew(pp)));
               freemem(pp,mangled_length+50);
             end;
 {$endif GDB}
           { restore }
-          aktprocsym:=oldprocsym;
+          aktprocdef:=oldprocdef;
           aktexitlabel:=oldexitlabel;
           aktexit2label:=oldexit2label;
           quickexitlabel:=oldquickexitlabel;
@@ -1574,7 +1569,7 @@ implementation
           { reallocate the registers used for the current procedure's regvars, }
           { since they may have been used and then deallocated in the inlined  }
           { procedure (JM)                                                     }
-          if assigned(aktprocsym.definition.regvarinfo) then
+          if assigned(aktprocdef.regvarinfo) then
             begin
               unused := oldunused;
               usableregs := oldusableregs;
@@ -1597,7 +1592,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.35  2001-10-25 21:22:41  peter
+  Revision 1.36  2001-11-02 22:58:09  peter
+    * procsym definition rewrite
+
+  Revision 1.35  2001/10/25 21:22:41  peter
     * calling convention rewrite
 
   Revision 1.34  2001/10/21 12:33:07  peter

compiler/i386/n386ld.pas

@@ -87,7 +87,7 @@ implementation
                        location.reference.offset:=tabsolutesym(symtableentry).address;
                      end
                     else
-                     location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
+                     location.reference.symbol:=newasmsymbol(tabsolutesym(symtableentry).mangledname);
                  end;
               constsym:
                 begin
@@ -106,13 +106,13 @@ implementation
                     { C variable }
                     if (vo_is_C_var in tvarsym(symtableentry).varoptions) then
                       begin
-                         location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
+                         location.reference.symbol:=newasmsymbol(tvarsym(symtableentry).mangledname);
                       end
                     { DLL variable }
                     else if (vo_is_dll_var in tvarsym(symtableentry).varoptions) then
                       begin
                          hregister:=getregister32;
-                         location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
+                         location.reference.symbol:=newasmsymbol(tvarsym(symtableentry).mangledname);
                          emit_ref_reg(A_MOV,S_L,newreference(location.reference),hregister);
                          location.reference.symbol:=nil;
                          location.reference.base:=hregister;
@@ -120,7 +120,7 @@ implementation
                     { external variable }
                     else if (vo_is_external in tvarsym(symtableentry).varoptions) then
                       begin
-                         location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
+                         location.reference.symbol:=newasmsymbol(tvarsym(symtableentry).mangledname);
                       end
                     { thread variable }
                     else if (vo_is_thread_var in tvarsym(symtableentry).varoptions) then
@@ -128,7 +128,7 @@ implementation
                          popeax:=not(R_EAX in unused);
                          if popeax then
                            emit_reg(A_PUSH,S_L,R_EAX);
-                         location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
+                         location.reference.symbol:=newasmsymbol(tvarsym(symtableentry).mangledname);
                          emit_ref(A_PUSH,S_L,newreference(location.reference));
                          { the called procedure isn't allowed to change }
                          { any register except EAX                    }
@@ -219,7 +219,7 @@ implementation
                                    globalsymtable,
                                    staticsymtable :
                                      begin
-                                       location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
+                                       location.reference.symbol:=newasmsymbol(tvarsym(symtableentry).mangledname);
                                      end;
                                    stt_exceptsymtable:
                                      begin
@@ -231,7 +231,7 @@ implementation
                                         getexplicitregister32(R_ESI);
                                         if (sp_static in tvarsym(symtableentry).symoptions) then
                                           begin
-                                             location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
+                                             location.reference.symbol:=newasmsymbol(tvarsym(symtableentry).mangledname);
                                           end
                                         else
                                           begin
@@ -392,7 +392,7 @@ implementation
                  end;
               typedconstsym :
                  begin
-                    location.reference.symbol:=newasmsymbol(symtableentry.mangledname);
+                    location.reference.symbol:=newasmsymbol(ttypedconstsym(symtableentry).mangledname);
                  end;
               else internalerror(4);
          end;
@@ -1085,7 +1085,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.25  2001-10-28 17:22:25  peter
+  Revision 1.26  2001-11-02 22:58:11  peter
+    * procsym definition rewrite
+
+  Revision 1.25  2001/10/28 17:22:25  peter
     * allow assignment of overloaded procedures to procvars when we know
       which procedure to take
 

compiler/i386/ra386.pas

@@ -195,10 +195,10 @@ Begin
   if res and (procinfo^.return_offset=0) then
    begin
      opr.typ:=OPR_REGISTER;
-     if is_fpu(aktprocsym.definition.rettype.def) then
+     if is_fpu(aktprocdef.rettype.def) then
        begin
          opr.reg:=R_ST0;
-         case tfloatdef(aktprocsym.definition.rettype.def).typ of
+         case tfloatdef(aktprocdef.rettype.def).typ of
            s32real : size:=S_FS;
            s64real : size:=S_FL;
            s80real : size:=S_FX;
@@ -210,8 +210,8 @@ Begin
            end;
          end;
        end
-     else if ret_in_acc(aktprocsym.definition.rettype.def) then
-       case aktprocsym.definition.rettype.def.size of
+     else if ret_in_acc(aktprocdef.rettype.def) then
+       case aktprocdef.rettype.def.size of
        1 : begin
              opr.reg:=R_AL;
              size:=S_B;
@@ -683,7 +683,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.12  2001-08-26 13:37:01  florian
+  Revision 1.13  2001-11-02 22:58:11  peter
+    * procsym definition rewrite
+
+  Revision 1.12  2001/08/26 13:37:01  florian
     * some cg reorganisation
     * some PPC updates
 

compiler/i386/ra386att.pas

@@ -1022,7 +1022,11 @@ Begin
                      typedconstsym :
                        hs:=ttypedconstsym(sym).mangledname;
                      procsym :
-                       hs:=tprocsym(sym).mangledname;
+                       begin
+                         if assigned(tprocsym(sym).defs^.next) then
+                          Message(asmr_w_calling_overload_func);
+                         hs:=tprocsym(sym).defs^.def.mangledname;
+                       end;
                      typesym :
                        begin
                          if not(ttypesym(sym).restype.def.deftype in [recorddef,objectdef]) then
@@ -1888,10 +1892,10 @@ Var
 Begin
   Message1(asmr_d_start_reading,'AT&T');
   firsttoken:=TRUE;
-  if assigned(aktprocsym.definition.funcretsym) and
-     (is_fpu(aktprocsym.definition.rettype.def) or
-     ret_in_acc(aktprocsym.definition.rettype.def)) then
-    tfuncretsym(aktprocsym.definition.funcretsym).funcretstate:=vs_assigned;
+  if assigned(aktprocdef.funcretsym) and
+     (is_fpu(aktprocdef.rettype.def) or
+     ret_in_acc(aktprocdef.rettype.def)) then
+    tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
   { sets up all opcode and register tables in uppercase }
   if not _asmsorted then
    Begin
@@ -2135,7 +2139,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.14  2001-08-26 13:37:02  florian
+  Revision 1.15  2001-11-02 22:58:11  peter
+    * procsym definition rewrite
+
+  Revision 1.14  2001/08/26 13:37:02  florian
     * some cg reorganisation
     * some PPC updates
 

compiler/i386/ra386dir.pas

@@ -74,19 +74,19 @@ interface
            if s<>'' then
             code.concat(Tai_direct.Create(strpnew(s)));
             { consider it set function set if the offset was loaded }
-           if assigned(aktprocsym.definition.funcretsym) and
+           if assigned(aktprocdef.funcretsym) and
               (pos(retstr,upper(s))>0) then
-             tfuncretsym(aktprocsym.definition.funcretsym).funcretstate:=vs_assigned;
+             tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
            s:='';
          end;
 
      begin
        ende:=false;
        s:='';
-       if assigned(aktprocsym.definition.funcretsym) and
-          is_fpu(aktprocsym.definition.rettype.def) then
-         tfuncretsym(aktprocsym.definition.funcretsym).funcretstate:=vs_assigned;
-       if (not is_void(aktprocsym.definition.rettype.def)) then
+       if assigned(aktprocdef.funcretsym) and
+          is_fpu(aktprocdef.rettype.def) then
+         tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+       if (not is_void(aktprocdef.rettype.def)) then
          retstr:=upper(tostr(procinfo^.return_offset)+'('+att_reg2str[procinfo^.framepointer]+')')
        else
          retstr:='';
@@ -131,22 +131,22 @@ interface
                              FwaitWarning
                             else
                             { access to local variables }
-                            if assigned(aktprocsym) then
+                            if assigned(aktprocdef) then
                               begin
                                  { is the last written character an special }
                                  { char ?                                   }
                                  if (s[length(s)]='%') and
-                                    ret_in_acc(aktprocsym.definition.rettype.def) and
+                                    ret_in_acc(aktprocdef.rettype.def) and
                                     ((pos('AX',upper(hs))>0) or
                                     (pos('AL',upper(hs))>0)) then
-                                   tfuncretsym(aktprocsym.definition.funcretsym).funcretstate:=vs_assigned;
+                                   tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
                                  if (s[length(s)]<>'%') and
                                    (s[length(s)]<>'$') and
                                    ((s[length(s)]<>'0') or (hs[1]<>'x')) then
                                    begin
-                                      if assigned(aktprocsym.definition.localst) and
+                                      if assigned(aktprocdef.localst) and
                                          (lexlevel >= normal_function_level) then
-                                        sym:=tsym(aktprocsym.definition.localst.search(upper(hs)))
+                                        sym:=tsym(aktprocdef.localst.search(upper(hs)))
                                       else
                                         sym:=nil;
                                       if assigned(sym) then
@@ -175,13 +175,13 @@ interface
                                            if (sym.typ=procsym) and ((pos('CALL',upper(s))>0) or
                                               (pos('LEA',upper(s))>0)) then
                                              begin
-                                                hs:=tprocsym(sym).definition.mangledname;
+                                                hs:=tprocsym(sym).defs^.def.mangledname;
                                              end;
                                         end
                                       else
                                         begin
-                                           if assigned(aktprocsym.definition.parast) then
-                                             sym:=tsym(aktprocsym.definition.parast.search(upper(hs)))
+                                           if assigned(aktprocdef.parast) then
+                                             sym:=tsym(aktprocdef.parast.search(upper(hs)))
                                            else
                                              sym:=nil;
                                            if assigned(sym) then
@@ -190,7 +190,7 @@ interface
                                                   begin
                                                      l:=tvarsym(sym).address;
                                                      { set offset }
-                                                     inc(l,aktprocsym.definition.parast.address_fixup);
+                                                     inc(l,aktprocdef.parast.address_fixup);
                                                      hs:=tostr(l)+'('+att_reg2str[procinfo^.framepointer]+')';
                                                      if pos(',',s) > 0 then
                                                        tvarsym(sym).varstate:=vs_used;
@@ -203,30 +203,37 @@ interface
                                       else
 
                                         begin
-{$ifndef IGNOREGLOBALVAR}
                                            searchsym(upper(hs),sym,srsymtable);
                                            if assigned(sym) and (sym.owner.symtabletype in [globalsymtable,staticsymtable]) then
                                              begin
-                                                if (sym.typ = varsym) or (sym.typ = typedconstsym) then
-                                                  begin
-                                                     Message2(asmr_h_direct_global_to_mangled,hs,sym.mangledname);
-                                                     hs:=sym.mangledname;
-                                                     if sym.typ=varsym then
-                                                       inc(tvarsym(sym).refs);
-                                                  end;
-                                                { procs can be called or the address can be loaded }
-                                                if (sym.typ=procsym) and
-                                                   ((pos('CALL',upper(s))>0) or (pos('LEA',upper(s))>0)) then
-                                                  begin
-                                                     if assigned(tprocsym(sym).definition.nextoverloaded) then
-                                                       Message1(asmr_w_direct_global_is_overloaded_func,hs);
-                                                     Message2(asmr_h_direct_global_to_mangled,hs,sym.mangledname);
-                                                     hs:=sym.mangledname;
-                                                  end;
+                                               case sym.typ of
+                                                 varsym :
+                                                   begin
+                                                     Message2(asmr_h_direct_global_to_mangled,hs,tvarsym(sym).mangledname);
+                                                     hs:=tvarsym(sym).mangledname;
+                                                     inc(tvarsym(sym).refs);
+                                                   end;
+                                                 typedconstsym :
+                                                   begin
+                                                     Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname);
+                                                     hs:=ttypedconstsym(sym).mangledname;
+                                                   end;
+                                                 procsym :
+                                                   begin
+                                                     { procs can be called or the address can be loaded }
+                                                     if ((pos('CALL',upper(s))>0) or (pos('LEA',upper(s))>0)) then
+                                                      begin
+                                                        if assigned(tprocsym(sym).defs^.def) then
+                                                          Message1(asmr_w_direct_global_is_overloaded_func,hs);
+                                                        Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).defs^.def.mangledname);
+                                                        hs:=tprocsym(sym).defs^.def.mangledname;
+                                                      end;
+                                                   end;
+                                                 else
+                                                   Message(asmr_e_wrong_sym_type);
+                                               end;
                                              end
-                                           else
-{$endif TESTGLOBALVAR}
-                                           if upper(hs)='__SELF' then
+                                           else if upper(hs)='__SELF' then
                                              begin
                                                 if assigned(procinfo^._class) then
                                                   hs:=tostr(procinfo^.selfpointer_offset)+
@@ -236,7 +243,7 @@ interface
                                              end
                                            else if upper(hs)='__RESULT' then
                                              begin
-                                                if (not is_void(aktprocsym.definition.rettype.def)) then
+                                                if (not is_void(aktprocdef.rettype.def)) then
                                                   hs:=retstr
                                                 else
                                                   Message(asmr_e_void_function);
@@ -260,7 +267,7 @@ interface
                    end;
  '{',';',#10,#13 : begin
                       if pos(retstr,s) > 0 then
-                        tfuncretsym(aktprocsym.definition.funcretsym).funcretstate:=vs_assigned;
+                        tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
                      writeasmline;
                      c:=current_scanner.asmgetchar;
                    end;
@@ -295,7 +302,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.11  2001-08-26 13:37:02  florian
+  Revision 1.12  2001-11-02 22:58:11  peter
+    * procsym definition rewrite
+
+  Revision 1.11  2001/08/26 13:37:02  florian
     * some cg reorganisation
     * some PPC updates
 

compiler/i386/ra386int.pas

@@ -908,7 +908,11 @@ Begin
                      typedconstsym :
                        hs:=ttypedconstsym(sym).mangledname;
                      procsym :
-                       hs:=tprocsym(sym).mangledname;
+                       begin
+                         if assigned(tprocsym(sym).defs^.next) then
+                          Message(asmr_w_calling_overload_func);
+                         hs:=tprocsym(sym).defs^.def.mangledname;
+                       end;
                      typesym :
                        begin
                          if not(ttypesym(sym).restype.def.deftype in [recorddef,objectdef]) then
@@ -1843,10 +1847,10 @@ Begin
   Message1(asmr_d_start_reading,'intel');
   inexpression:=FALSE;
   firsttoken:=TRUE;
-  if assigned(aktprocsym.definition.funcretsym) and
-     (is_fpu(aktprocsym.definition.rettype.def) or
-     ret_in_acc(aktprocsym.definition.rettype.def)) then
-    tfuncretsym(aktprocsym.definition.funcretsym).funcretstate:=vs_assigned;
+  if assigned(aktprocdef.funcretsym) and
+     (is_fpu(aktprocdef.rettype.def) or
+     ret_in_acc(aktprocdef.rettype.def)) then
+    tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
  { sets up all opcode and register tables in uppercase }
   if not _asmsorted then
    Begin
@@ -1964,7 +1968,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.18  2001-09-17 21:29:14  peter
+  Revision 1.19  2001-11-02 22:58:11  peter
+    * procsym definition rewrite
+
+  Revision 1.18  2001/09/17 21:29:14  peter
     * merged netbsd, fpu-overflow from fixes branch
 
   Revision 1.17  2001/08/26 13:37:03  florian

compiler/nbas.pas

@@ -331,9 +331,9 @@ implementation
                    { concat function result to exit }
                    { this is wrong for string or other complex
                      result types !!! }
-                   if {ret_in_acc(aktprocsym.definition.rettype.def) and }
-                      (is_ordinal(aktprocsym.definition.rettype.def) or
-                       is_smallset(aktprocsym.definition.rettype.def)) and
+                   if {ret_in_acc(aktprocdef.rettype.def) and }
+                      (is_ordinal(aktprocdef.rettype.def) or
+                       is_smallset(aktprocdef.rettype.def)) and
                       assigned(hp.left) and
                       assigned(tstatementnode(hp.left).right) and
                       (tstatementnode(hp.left).right.nodetype=exitn) and
@@ -625,7 +625,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.17  2001-09-02 21:12:06  peter
+  Revision 1.18  2001-11-02 22:58:01  peter
+    * procsym definition rewrite
+
+  Revision 1.17  2001/09/02 21:12:06  peter
     * move class of definitions into type section for delphi
 
   Revision 1.16  2001/08/26 13:36:38  florian

compiler/ncal.pas

@@ -94,7 +94,7 @@ interface
 
        tprocinlinenode = class(tnode)
           inlinetree : tnode;
-          inlineprocsym : tprocsym;
+          inlineprocdef : tprocdef;
           retoffset,para_offset,para_size : longint;
           constructor create(callp,code : tnode);virtual;
           destructor destroy;override;
@@ -274,9 +274,9 @@ implementation
           begin
             if is_array_of_const(defcoll.paratype.def) then
              begin
-               if assigned(aktcallprocsym) and
-                  (aktcallprocsym.definition.proccalloption in [pocall_cppdecl,pocall_cdecl]) and
-                  (po_external in aktcallprocsym.definition.procoptions) then
+               if assigned(aktcallprocdef) and
+                  (aktcallprocdef.proccalloption in [pocall_cppdecl,pocall_cdecl]) and
+                  (po_external in aktcallprocdef.procoptions) then
                  include(left.flags,nf_cargs);
                { force variant array }
                include(left.flags,nf_forcevaria);
@@ -295,9 +295,9 @@ implementation
            test_local_to_procvar(tprocvardef(left.resulttype.def),defcoll.paratype.def);
 
          { generate the high() value tree }
-         if not(assigned(aktcallprocsym) and
-                (aktcallprocsym.definition.proccalloption in [pocall_cppdecl,pocall_cdecl]) and
-                (po_external in aktcallprocsym.definition.procoptions)) and
+         if not(assigned(aktcallprocdef) and
+                (aktcallprocdef.proccalloption in [pocall_cppdecl,pocall_cdecl]) and
+                (po_external in aktcallprocdef.procoptions)) and
             push_high_param(defcoll.paratype.def) then
            gen_high_tree(is_open_string(defcoll.paratype.def));
 
@@ -604,7 +604,7 @@ implementation
         restypeset := true;
         { both the normal and specified resulttype either have to be returned via a }
         { parameter or not, but no mixing (JM)                                      }
-        if ret_in_param(restype.def) xor ret_in_param(symtableprocentry.definition.rettype.def) then
+        if ret_in_param(restype.def) xor ret_in_param(symtableprocentry.defs^.def.rettype.def) then
           internalerror(200108291);
       end;
 
@@ -655,8 +655,8 @@ implementation
          end;
       var
          hp,procs,hp2 : pprocdefcoll;
-         pd : tprocdef;
-         oldcallprocsym : tprocsym;
+         pd : pprocdeflist;
+         oldcallprocdef : tprocdef;
          def_from,def_to,conv_to : tdef;
          hpt : tnode;
          pt : tcallparanode;
@@ -749,8 +749,8 @@ implementation
 
          procs:=nil;
 
-         oldcallprocsym:=aktcallprocsym;
-         aktcallprocsym:=nil;
+         oldcallprocdef:=aktcallprocdef;
+         aktcallprocdef:=nil;
 
          { determine length of parameter list }
          pt:=tcallparanode(left);
@@ -802,60 +802,34 @@ implementation
          else
          { not a procedure variable }
            begin
-              aktcallprocsym:=tprocsym(symtableprocentry);
               { do we know the procedure to call ? }
               if not(assigned(procdefinition)) then
                 begin
-{$ifdef TEST_PROCSYMS}
-                 if (unit_specific) or
-                    assigned(methodpointer) then
-                   nextprocsym:=nil
-                 else while not assigned(procs) do
-                  begin
-                     symt:=symtableproc;
-                     srsym:=nil;
-                     while assigned(symt^.next) and not assigned(srsym) do
-                       begin
-                          symt:=symt^.next;
-                          srsym:=searchsymonlyin(symt,actprocsym.name);
-                          if assigned(srsym) then
-                            if srsym.typ<>procsym then
-                              begin
-                                 { reject all that is not a procedure }
-                                 srsym:=nil;
-                                 { don't search elsewhere }
-                                 while assigned(symt^.next) do
-                                   symt:=symt^.next;
-                              end;
-                       end;
-                     nextprocsym:=srsym;
-                  end;
-{$endif TEST_PROCSYMS}
                    { link all procedures which have the same # of parameters }
-                   pd:=aktcallprocsym.definition;
+                   pd:=symtableprocentry.defs;
                    while assigned(pd) do
                      begin
                         { only when the # of parameter are supported by the
                           procedure }
-                        if (paralength>=pd.minparacount) and
-                           ((po_varargs in pd.procoptions) or { varargs }
-                            (paralength<=pd.maxparacount)) then
+                        if (paralength>=pd^.def.minparacount) and
+                           ((po_varargs in pd^.def.procoptions) or { varargs }
+                            (paralength<=pd^.def.maxparacount)) then
                           begin
                              new(hp);
-                             hp^.data:=pd;
+                             hp^.data:=pd^.def;
                              hp^.next:=procs;
-                             hp^.firstpara:=tparaitem(pd.Para.first);
-                             if not(po_varargs in pd.procoptions) then
+                             hp^.firstpara:=tparaitem(pd^.def.Para.first);
+                             if not(po_varargs in pd^.def.procoptions) then
                               begin
                                 { if not all parameters are given, then skip the
                                   default parameters }
-                                for i:=1 to pd.maxparacount-paralength do
+                                for i:=1 to pd^.def.maxparacount-paralength do
                                  hp^.firstpara:=tparaitem(hp^.firstPara.next);
                               end;
                              hp^.nextpara:=hp^.firstpara;
                              procs:=hp;
                           end;
-                        pd:=pd.nextoverloaded;
+                        pd:=pd^.next;
                      end;
 
                    { no procedures found? then there is something wrong
@@ -879,7 +853,7 @@ implementation
                           if assigned(left) then
                            aktfilepos:=left.fileinfo;
                           CGMessage(parser_e_wrong_parameter_size);
-                          aktcallprocsym.write_parameter_lists(nil);
+                          symtableprocentry.write_parameter_lists(nil);
                         end;
                       goto errorexit;
                     end;
@@ -1016,7 +990,7 @@ implementation
                           CGMessage3(type_e_wrong_parameter_type,tostr(lastpara),
                             pt.resulttype.def.typename,lastparatype.typename);
                         end;
-                      aktcallprocsym.write_parameter_lists(nil);
+                      symtableprocentry.write_parameter_lists(nil);
                       goto errorexit;
                     end;
 
@@ -1273,17 +1247,9 @@ implementation
                    if not(assigned(procs)) or assigned(procs^.next) then
                      begin
                         CGMessage(cg_e_cant_choose_overload_function);
-                        aktcallprocsym.write_parameter_lists(nil);
+                        symtableprocentry.write_parameter_lists(nil);
                         goto errorexit;
                      end;
-{$ifdef TEST_PROCSYMS}
-                   if (procs=nil) and assigned(nextprocsym) then
-                     begin
-                        symtableprocentry:=nextprocsym;
-                        symtableproc:=symt;
-                     end;
-                 end ; { of while assigned(symtableprocentry) do }
-{$endif TEST_PROCSYMS}
                    if make_ref then
                      begin
                         procs^.data.lastref:=tref.create(procs^.data.lastref,@fileinfo);
@@ -1298,21 +1264,6 @@ implementation
                    but neede for overloaded operators !! }
                    if symtableproc=nil then
                      symtableproc:=procdefinition.owner;
-
-{$ifdef CHAINPROCSYMS}
-                   { object with method read;
-                     call to read(x) will be a usual procedure call }
-                   if assigned(methodpointer) and
-                     (procdefinition._class=nil) then
-                     begin
-                        { not ok for extended }
-                        case methodpointer^.nodetype of
-                           typen,hnewn : fatalerror(no_para_match);
-                        end;
-                        methodpointer.free;
-                        methodpointer:=nil;
-                     end;
-{$endif CHAINPROCSYMS}
                end; { end of procedure to call determination }
 
 
@@ -1416,13 +1367,16 @@ implementation
 
          { insert type conversions }
          if assigned(left) then
-          tcallparanode(left).insert_typeconv(tparaitem(procdefinition.Para.first),true);
+          begin
+            aktcallprocdef:=tprocdef(procdefinition);
+            tcallparanode(left).insert_typeconv(tparaitem(procdefinition.Para.first),true);
+          end;
 
       errorexit:
          { Reset some settings back }
          if assigned(procs) then
            dispose(procs);
-         aktcallprocsym:=oldcallprocsym;
+         aktcallprocdef:=oldcallprocdef;
       end;
 
 
@@ -1671,11 +1625,11 @@ implementation
 
       begin
          inherited create(procinlinen);
-         inlineprocsym:=tcallnode(callp).symtableprocentry;
+         inlineprocdef:=tcallnode(callp).symtableprocentry.defs^.def;
          retoffset:=-target_info.size_of_pointer; { less dangerous as zero (PM) }
          para_offset:=0;
-         para_size:=inlineprocsym.definition.para_size(target_info.alignment.paraalign);
-         if ret_in_param(inlineprocsym.definition.rettype.def) then
+         para_size:=inlineprocdef.para_size(target_info.alignment.paraalign);
+         if ret_in_param(inlineprocdef.rettype.def) then
            inc(para_size,target_info.size_of_pointer);
          { copy args }
          if assigned(code) then
@@ -1686,7 +1640,7 @@ implementation
 {$ifdef SUPPORT_MMX}
          registersmmx:=code.registersmmx;
 {$endif SUPPORT_MMX}
-         resulttype:=inlineprocsym.definition.rettype;
+         resulttype:=inlineprocdef.rettype;
       end;
 
     destructor tprocinlinenode.destroy;
@@ -1707,7 +1661,7 @@ implementation
            n.inlinetree:=inlinetree.getcopy
          else
            n.inlinetree:=nil;
-         n.inlineprocsym:=inlineprocsym;
+         n.inlineprocdef:=inlineprocdef;
          n.retoffset:=retoffset;
          n.para_offset:=para_offset;
          n.para_size:=para_size;
@@ -1733,7 +1687,7 @@ implementation
         docompare :=
           inherited docompare(p) and
           inlinetree.isequal(tprocinlinenode(p).inlinetree) and
-          (inlineprocsym = tprocinlinenode(p).inlineprocsym);
+          (inlineprocdef = tprocinlinenode(p).inlineprocdef);
       end;
 
 begin
@@ -1743,7 +1697,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.53  2001-10-28 17:22:25  peter
+  Revision 1.54  2001-11-02 22:58:01  peter
+    * procsym definition rewrite
+
+  Revision 1.53  2001/10/28 17:22:25  peter
     * allow assignment of overloaded procedures to procvars when we know
       which procedure to take
 

compiler/ncgbas.pas

@@ -137,8 +137,8 @@ interface
          if inlining_procedure then
            begin
              CreateUsedAsmSymbolList;
-             localfixup:=aktprocsym.definition.localst.address_fixup;
-             parafixup:=aktprocsym.definition.parast.address_fixup;
+             localfixup:=aktprocdef.localst.address_fixup;
+             parafixup:=aktprocdef.parast.address_fixup;
              hp:=tai(p_asm.first);
              while assigned(hp) do
               begin
@@ -204,7 +204,7 @@ interface
            begin
              { if the routine is an inline routine, then we must hold a copy
                because it can be necessary for inlining later }
-             if (aktprocsym.definition.proccalloption=pocall_inline) then
+             if (aktprocdef.proccalloption=pocall_inline) then
                exprasmList.concatlistcopy(p_asm)
              else
                exprasmList.concatlist(p_asm);
@@ -279,7 +279,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  2001-10-25 21:22:35  peter
+  Revision 1.9  2001-11-02 22:58:01  peter
+    * procsym definition rewrite
+
+  Revision 1.8  2001/10/25 21:22:35  peter
     * calling convention rewrite
 
   Revision 1.7  2001/08/26 13:36:39  florian

compiler/ncgflw.pas

@@ -435,7 +435,7 @@ implementation
               else
                 internalerror(2001);
               end;
-              case aktprocsym.definition.rettype.def.deftype of
+              case aktprocdef.rettype.def.deftype of
            pointerdef,
            procvardef : begin
                           cleanleft;
@@ -451,7 +451,7 @@ implementation
              floatdef : begin
                           cleanleft;
                           if is_mem then
-                           floatload(tfloatdef(aktprocsym.definition.rettype.def).typ,left.location.reference);
+                           floatload(tfloatdef(aktprocdef.rettype.def).typ,left.location.reference);
                         end;
               { orddef,
               enumdef : }
@@ -462,7 +462,7 @@ implementation
                    cleanleft;
                    cg.a_reg_alloc(exprasmlist,accumulator);
                    allocated_acc := true;
-                   case aktprocsym.definition.rettype.def.size of
+                   case aktprocdef.rettype.def.size of
                     { it can be a qword/int64 too ... }
                     8 :
                       if is_mem then
@@ -582,7 +582,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2001-10-04 14:33:28  jonas
+  Revision 1.4  2001-11-02 22:58:01  peter
+    * procsym definition rewrite
+
+  Revision 1.3  2001/10/04 14:33:28  jonas
     * fixed range check errors
 
   Revision 1.2  2001/09/30 16:19:58  jonas

compiler/ncgmem.pas

@@ -334,7 +334,7 @@ implementation
 
                usetemp:=false;
                if (left.nodetype=loadn) and
-                  (tloadnode(left).symtable=aktprocsym.definition.localst) then
+                  (tloadnode(left).symtable=aktprocdef.localst) then
                  begin
                     { for locals use the local storage }
                     withreference^:=left.location.reference;
@@ -386,13 +386,13 @@ implementation
                          '"with'+tostr(withlevel)+':'+tostr(symtablestack.getnewtypecount)+
                          '=*'+tstoreddef(left.resulttype.def).numberstring+'",'+
                          tostr(N_LSYM)+',0,0,'+tostr(withreference^.offset))));
-                      mangled_length:=length(aktprocsym.definition.mangledname);
+                      mangled_length:=length(aktprocdef.mangledname);
                       getmem(pp,mangled_length+50);
                       strpcopy(pp,'192,0,0,'+withstartlabel.name);
                       if (target_info.use_function_relative_addresses) then
                         begin
                           strpcopy(strend(pp),'-');
-                          strpcopy(strend(pp),aktprocsym.definition.mangledname);
+                          strpcopy(strend(pp),aktprocdef.mangledname);
                         end;
                       withdebugList.concat(Tai_stabn.Create(strnew(pp)));
                     end;
@@ -414,7 +414,7 @@ implementation
                       if (target_info.use_function_relative_addresses) then
                         begin
                           strpcopy(strend(pp),'-');
-                          strpcopy(strend(pp),aktprocsym.definition.mangledname);
+                          strpcopy(strend(pp),aktprocdef.mangledname);
                         end;
                        withdebugList.concat(Tai_stabn.Create(strnew(pp)));
                        freemem(pp,mangled_length+50);
@@ -444,7 +444,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2001-09-30 16:17:17  jonas
+  Revision 1.2  2001-11-02 22:58:02  peter
+    * procsym definition rewrite
+
+  Revision 1.1  2001/09/30 16:17:17  jonas
     * made most constant and mem handling processor independent
 
 

compiler/ncnv.pas

@@ -852,7 +852,7 @@ implementation
                  else
                   begin
                     if (left.nodetype<>addrn) then
-                      aprocdef:=tprocsym(tloadnode(left).symtableentry).definition;
+                      aprocdef:=tprocsym(tloadnode(left).symtableentry).defs^.def;
                   end;
                  convtype:=tc_proc_2_procvar;
                  { Now check if the procedure we are going to assign to
@@ -1597,7 +1597,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.42  2001-10-28 17:22:25  peter
+  Revision 1.43  2001-11-02 22:58:02  peter
+    * procsym definition rewrite
+
+  Revision 1.42  2001/10/28 17:22:25  peter
     * allow assignment of overloaded procedures to procvars when we know
       which procedure to take
 

compiler/nflw.pas

@@ -643,12 +643,12 @@ implementation
          begin
            if assigned(left) then
             begin
-              inserttypeconv(left,aktprocsym.definition.rettype);
-              if ret_in_param(aktprocsym.definition.rettype.def) or
+              inserttypeconv(left,aktprocdef.rettype);
+              if ret_in_param(aktprocdef.rettype.def) or
                  (procinfo^.no_fast_exit) or
                  ((procinfo^.flags and pi_uses_exceptions)<>0) then
                begin
-                 pt:=cfuncretnode.create(aktprocsym.definition.funcretsym);
+                 pt:=cfuncretnode.create(aktprocdef.funcretsym);
                  left:=cassignmentnode.create(pt,left);
                end;
             end;
@@ -1178,7 +1178,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.25  2001-10-16 15:10:35  jonas
+  Revision 1.26  2001-11-02 22:58:02  peter
+    * procsym definition rewrite
+
+  Revision 1.25  2001/10/16 15:10:35  jonas
     * fixed goto/label/try bugs
 
   Revision 1.24  2001/09/02 21:12:07  peter

compiler/nld.pas

@@ -34,7 +34,7 @@ interface
        tloadnode = class(tunarynode)
           symtableentry : tsym;
           symtable : tsymtable;
-          procsymdef : tprocdef;
+          procdeflist : tprocdef;
           constructor create(v : tsym;st : tsymtable);virtual;
           constructor create_procvar(v : tsym;d:tprocdef;st : tsymtable);virtual;
           procedure set_mp(p:tnode);
@@ -125,7 +125,7 @@ implementation
           internalerror(200108121);
          symtableentry:=v;
          symtable:=st;
-         procsymdef:=nil;
+         procdeflist:=nil;
       end;
 
     constructor tloadnode.create_procvar(v : tsym;d:tprocdef;st : tsymtable);
@@ -135,7 +135,7 @@ implementation
           internalerror(200108121);
          symtableentry:=v;
          symtable:=st;
-         procsymdef:=d;
+         procdeflist:=d;
       end;
 
     procedure tloadnode.set_mp(p:tnode);
@@ -239,14 +239,14 @@ implementation
                   resulttype:=ttypedconstsym(symtableentry).typedconsttype;
             procsym :
                 begin
-                   if not assigned(procsymdef) then
+                   if not assigned(procdeflist) then
                     begin
-                      if assigned(tprocsym(symtableentry).definition.nextoverloaded) then
+                      if assigned(tprocsym(symtableentry).defs^.next) then
                        CGMessage(parser_e_no_overloaded_procvars);
-                      resulttype.setdef(tprocsym(symtableentry).definition);
+                      resulttype.setdef(tprocsym(symtableentry).defs^.def);
                     end
                    else
-                    resulttype.setdef(procsymdef);
+                    resulttype.setdef(procdeflist);
                    { if the owner of the procsym is a object,  }
                    { left must be set, if left isn't set       }
                    { it can be only self                       }
@@ -335,8 +335,8 @@ implementation
                      { this will create problem with local var set by
                      under_procedures
                      if (assigned(tvarsym(symtableentry).owner) and assigned(aktprocsym)
-                       and ((tvarsym(symtableentry).owner = aktprocsym.definition.localst)
-                       or (tvarsym(symtableentry).owner = aktprocsym.definition.localst))) then }
+                       and ((tvarsym(symtableentry).owner = aktprocdef.localst)
+                       or (tvarsym(symtableentry).owner = aktprocdef.localst))) then }
                    if t_times<1 then
                      inc(tvarsym(symtableentry).refs)
                    else
@@ -821,7 +821,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.28  2001-10-31 17:34:20  jonas
+  Revision 1.29  2001-11-02 22:58:02  peter
+    * procsym definition rewrite
+
+  Revision 1.28  2001/10/31 17:34:20  jonas
     * fixed web bug 1651
 
   Revision 1.27  2001/10/28 17:22:25  peter

compiler/nmat.pas

@@ -198,7 +198,7 @@ implementation
         power: longint;
       begin
         result := nil;
-        
+
         { divide/mod an unsigned number by a constant which is a power of 2? }
         if (right.nodetype = ordconstn) and
            not is_signed(resulttype.def) and
@@ -220,7 +220,7 @@ implementation
             firstpass(result);
             exit;
           end;
-          
+
         { otherwise create a call to a helper }
         if nodetype = divn then
           procname := 'fpc_div_'
@@ -352,7 +352,7 @@ implementation
     function tunaryminusnode.det_resulttype : tnode;
       var
          t : tnode;
-         minusdef : tprocdef;
+         minusdef : pprocdeflist;
       begin
          result:=nil;
          resulttypepass(left);
@@ -404,13 +404,13 @@ implementation
          else
            begin
               if assigned(overloaded_operators[_minus]) then
-                minusdef:=overloaded_operators[_minus].definition
+                minusdef:=overloaded_operators[_minus].defs
               else
                 minusdef:=nil;
               while assigned(minusdef) do
                 begin
-                   if is_equal(tparaitem(minusdef.para.first).paratype.def,left.resulttype.def) and
-                      (tparaitem(minusdef.para.first).next=nil) then
+                   if is_equal(tparaitem(minusdef^.def.para.first).paratype.def,left.resulttype.def) and
+                      (tparaitem(minusdef^.def.para.first).next=nil) then
                      begin
                         t:=ccallnode.create(ccallparanode.create(left,nil),
                                             overloaded_operators[_minus],nil,nil);
@@ -418,7 +418,7 @@ implementation
                         result:=t;
                         exit;
                      end;
-                   minusdef:=minusdef.nextoverloaded;
+                   minusdef:=minusdef^.next;
                 end;
               CGMessage(type_e_mismatch);
            end;
@@ -486,7 +486,7 @@ implementation
     function tnotnode.det_resulttype : tnode;
       var
          t : tnode;
-         notdef : tprocdef;
+         notdef : pprocdeflist;
          v : tconstexprint;
       begin
          result:=nil;
@@ -555,13 +555,13 @@ implementation
          else
            begin
               if assigned(overloaded_operators[_op_not]) then
-                notdef:=overloaded_operators[_op_not].definition
+                notdef:=overloaded_operators[_op_not].defs
               else
                 notdef:=nil;
               while assigned(notdef) do
                 begin
-                   if is_equal(tparaitem(notdef.para.first).paratype.def,left.resulttype.def) and
-                      (tparaitem(notdef.para.first).next=nil) then
+                   if is_equal(tparaitem(notdef^.def.para.first).paratype.def,left.resulttype.def) and
+                      (tparaitem(notdef^.def.para.first).next=nil) then
                      begin
                         t:=ccallnode.create(ccallparanode.create(left,nil),
                                             overloaded_operators[_op_not],nil,nil);
@@ -569,7 +569,7 @@ implementation
                         result:=t;
                         exit;
                      end;
-                   notdef:=notdef.nextoverloaded;
+                   notdef:=notdef^.next;
                 end;
               CGMessage(type_e_mismatch);
            end;
@@ -640,7 +640,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.24  2001-10-12 13:51:51  jonas
+  Revision 1.25  2001-11-02 22:58:02  peter
+    * procsym definition rewrite
+
+  Revision 1.24  2001/10/12 13:51:51  jonas
     * fixed internalerror(10) due to previous fpu overflow fixes ("merged")
     * fixed bug in n386add (introduced after compilerproc changes for string
       operations) where calcregisters wasn't called for shortstring addnodes

compiler/nmem.pas

@@ -416,7 +416,7 @@ implementation
                  if assigned(getprocvardef) then
                   hp3:=getprocvardef
                  else
-                  hp3:=tabstractprocdef(tprocsym(tloadnode(left).symtableentry).definition);
+                  hp3:=tabstractprocdef(tprocsym(tloadnode(left).symtableentry).defs^.def);
 
                  { create procvardef }
                  resulttype.setdef(tprocvardef.create);
@@ -928,7 +928,7 @@ implementation
             for i:=1 to tablecount do
              begin
                if (left.nodetype=loadn) and
-                  (tloadnode(left).symtable=aktprocsym.definition.localst) then
+                  (tloadnode(left).symtable=aktprocdef.localst) then
                 symtable.direct_with:=true;
                symtable.withnode:=self;
                symtable:=twithsymtable(symtable.next);
@@ -985,7 +985,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.22  2001-10-28 17:22:25  peter
+  Revision 1.23  2001-11-02 22:58:02  peter
+    * procsym definition rewrite
+
+  Revision 1.22  2001/10/28 17:22:25  peter
     * allow assignment of overloaded procedures to procvars when we know
       which procedure to take
 

compiler/nobj.pas

@@ -219,24 +219,24 @@ implementation
     procedure tclassheader.insertmsgint(p : tnamedindexitem);
 
       var
-         hp : tprocdef;
+         hp : pprocdeflist;
          pt : pprocdeftree;
 
       begin
          if tsym(p).typ=procsym then
            begin
-              hp:=tprocsym(p).definition;
+              hp:=tprocsym(p).defs;
               while assigned(hp) do
                 begin
-                   if (po_msgint in hp.procoptions) then
+                   if (po_msgint in hp^.def.procoptions) then
                      begin
                         new(pt);
-                        pt^.data:=hp;
+                        pt^.data:=hp^.def;
                         pt^.l:=nil;
                         pt^.r:=nil;
                         insertint(pt,root);
                      end;
-                   hp:=hp.nextoverloaded;
+                   hp:=hp^.next;
                 end;
            end;
       end;
@@ -244,24 +244,24 @@ implementation
     procedure tclassheader.insertmsgstr(p : tnamedindexitem);
 
       var
-         hp : tprocdef;
+         hp : pprocdeflist;
          pt : pprocdeftree;
 
       begin
          if tsym(p).typ=procsym then
            begin
-              hp:=tprocsym(p).definition;
+              hp:=tprocsym(p).defs;
               while assigned(hp) do
                 begin
-                   if (po_msgstr in hp.procoptions) then
+                   if (po_msgstr in hp^.def.procoptions) then
                      begin
                         new(pt);
-                        pt^.data:=hp;
+                        pt^.data:=hp^.def;
                         pt^.l:=nil;
                         pt^.r:=nil;
                         insertstr(pt,root);
                      end;
-                   hp:=hp.nextoverloaded;
+                   hp:=hp^.next;
                 end;
            end;
       end;
@@ -459,9 +459,9 @@ implementation
       begin
          if (tsym(p).typ=procsym) and (sp_published in tsym(p).symoptions) then
            begin
-              hp:=tprocsym(p).definition;
-              if assigned(hp.nextoverloaded) then
+              if assigned(tprocsym(p).defs^.next) then
                 internalerror(1209992);
+              hp:=tprocsym(p).defs^.def;
               getdatalabel(l);
 
               Consts.concat(Tai_label.Create(l));
@@ -502,7 +502,7 @@ implementation
 
       var
          procdefcoll : pprocdefcoll;
-         hp : tprocdef;
+         hp : pprocdeflist;
          symcoll : psymcoll;
          _name : string;
          stored : boolean;
@@ -517,34 +517,34 @@ implementation
            symcoll^.next:=wurzel;
            symcoll^.data:=nil;
            wurzel:=symcoll;
-           hp:=tprocsym(sym).definition;
 
            { inserts all definitions }
+           hp:=tprocsym(sym).defs;
            while assigned(hp) do
              begin
                 new(procdefcoll);
-                procdefcoll^.data:=hp;
+                procdefcoll^.data:=hp^.def;
                 procdefcoll^.next:=symcoll^.data;
                 symcoll^.data:=procdefcoll;
 
                 { if it's a virtual method }
-                if (po_virtualmethod in hp.procoptions) then
+                if (po_virtualmethod in hp^.def.procoptions) then
                   begin
                      { then it gets a number ... }
-                     hp.extnumber:=nextvirtnumber;
+                     hp^.def.extnumber:=nextvirtnumber;
                      { and we inc the number }
                      inc(nextvirtnumber);
                      has_virtual_method:=true;
                   end;
 
-                if (hp.proctypeoption=potype_constructor) then
+                if (hp^.def.proctypeoption=potype_constructor) then
                   has_constructor:=true;
 
                 { check, if a method should be overridden }
-                if (po_overridingmethod in hp.procoptions) then
-                  MessagePos1(hp.fileinfo,parser_e_nothing_to_be_overridden,_class.objname^+'.'+_name+hp.demangled_paras);
+                if (po_overridingmethod in hp^.def.procoptions) then
+                  MessagePos1(hp^.def.fileinfo,parser_e_nothing_to_be_overridden,_class.objname^+'.'+_name+hp^.def.demangled_paras);
                 { next overloaded method }
-                hp:=hp.nextoverloaded;
+                hp:=hp^.next;
              end;
         end;
 
@@ -552,26 +552,26 @@ implementation
 
         begin
            new(procdefcoll);
-           procdefcoll^.data:=hp;
+           procdefcoll^.data:=hp^.def;
            procdefcoll^.next:=symcoll^.data;
            symcoll^.data:=procdefcoll;
 
            { if it's a virtual method }
-           if (po_virtualmethod in hp.procoptions) then
+           if (po_virtualmethod in hp^.def.procoptions) then
              begin
                 { then it gets a number ... }
-                hp.extnumber:=nextvirtnumber;
+                hp^.def.extnumber:=nextvirtnumber;
                 { and we inc the number }
                 inc(nextvirtnumber);
                 has_virtual_method:=true;
              end;
 
-           if (hp.proctypeoption=potype_constructor) then
+           if (hp^.def.proctypeoption=potype_constructor) then
              has_constructor:=true;
 
            { check, if a method should be overridden }
-           if (po_overridingmethod in hp.procoptions) then
-             MessagePos1(hp.fileinfo,parser_e_nothing_to_be_overridden,_class.objname^+'.'+_name+hp.demangled_paras);
+           if (po_overridingmethod in hp^.def.procoptions) then
+             MessagePos1(hp^.def.fileinfo,parser_e_nothing_to_be_overridden,_class.objname^+'.'+_name+hp^.def.demangled_paras);
         end;
 
       label
@@ -589,7 +589,7 @@ implementation
                    if _name=symcoll^.name^ then
                      begin
                         { walk through all defs of the symbol }
-                        hp:=tprocsym(sym).definition;
+                        hp:=tprocsym(sym).defs;
                         while assigned(hp) do
                           begin
                              { compare with all stored definitions }
@@ -598,35 +598,35 @@ implementation
                              while assigned(procdefcoll) do
                                begin
                                   { compare parameters }
-                                  if equal_paras(procdefcoll^.data.para,hp.para,cp_all) and
+                                  if equal_paras(procdefcoll^.data.para,hp^.def.para,cp_all) and
                                      (
                                        (po_virtualmethod in procdefcoll^.data.procoptions) or
-                                       (po_virtualmethod in hp.procoptions)
+                                       (po_virtualmethod in hp^.def.procoptions)
                                      ) then
                                     begin { same parameters }
                                        { wenn sie gleich sind }
                                        { und eine davon virtual deklariert ist }
                                        { Fehler falls nur eine VIRTUAL }
                                        if (po_virtualmethod in procdefcoll^.data.procoptions)<>
-                                          (po_virtualmethod in hp.procoptions) then
+                                          (po_virtualmethod in hp^.def.procoptions) then
                                          begin
                                             { in classes, we hide the old method }
                                             if is_class(_class) then
                                               begin
                                                  { warn only if it is the first time,
                                                    we hide the method }
-                                                 if _class=hp._class then
-                                                   Message1(parser_w_should_use_override,hp.fullprocname);
+                                                 if _class=hp^.def._class then
+                                                   Message1(parser_w_should_use_override,hp^.def.fullprocname);
                                               end
                                             else
-                                              if _class=hp._class then
+                                              if _class=hp^.def._class then
                                                 begin
                                                    if (po_virtualmethod in procdefcoll^.data.procoptions) then
                                                      Message1(parser_w_overloaded_are_not_both_virtual,
-                                                              hp.fullprocname)
+                                                              hp^.def.fullprocname)
                                                    else
                                                      Message1(parser_w_overloaded_are_not_both_non_virtual,
-                                                              hp.fullprocname);
+                                                              hp^.def.fullprocname);
                                                 end;
                                             { was newentry; exit; (FK) }
                                             newdefentry;
@@ -636,45 +636,45 @@ implementation
                                        { the flags have to match      }
                                        { except abstract and override }
                                        { only if both are virtual !!  }
-                                       if (procdefcoll^.data.proccalloption<>hp.proccalloption) or
-                                          (procdefcoll^.data.proctypeoption<>hp.proctypeoption) or
+                                       if (procdefcoll^.data.proccalloption<>hp^.def.proccalloption) or
+                                          (procdefcoll^.data.proctypeoption<>hp^.def.proctypeoption) or
                                           ((procdefcoll^.data.procoptions-
                                               [po_abstractmethod,po_overridingmethod,po_assembler,po_overload])<>
-                                           (hp.procoptions-[po_abstractmethod,po_overridingmethod,po_assembler,po_overload])) then
-                                         Message1(parser_e_header_dont_match_forward,hp.fullprocname);
+                                           (hp^.def.procoptions-[po_abstractmethod,po_overridingmethod,po_assembler,po_overload])) then
+                                         Message1(parser_e_header_dont_match_forward,hp^.def.fullprocname);
 
                                        { check, if the overridden directive is set }
                                        { (povirtualmethod is set! }
 
                                        { class ? }
                                        if is_class(_class) and
-                                          not(po_overridingmethod in hp.procoptions) then
+                                          not(po_overridingmethod in hp^.def.procoptions) then
                                          begin
                                             { warn only if it is the first time,
                                               we hide the method }
-                                            if _class=hp._class then
-                                              Message1(parser_w_should_use_override,hp.fullprocname);
+                                            if _class=hp^.def._class then
+                                              Message1(parser_w_should_use_override,hp^.def.fullprocname);
                                             { was newentry; (FK) }
                                             newdefentry;
                                             exit;
                                          end;
 
                                        { error, if the return types aren't equal }
-                                       if not(is_equal(procdefcoll^.data.rettype.def,hp.rettype.def)) and
+                                       if not(is_equal(procdefcoll^.data.rettype.def,hp^.def.rettype.def)) and
                                          not((procdefcoll^.data.rettype.def.deftype=objectdef) and
-                                           (hp.rettype.def.deftype=objectdef) and
+                                           (hp^.def.rettype.def.deftype=objectdef) and
                                            is_class(procdefcoll^.data.rettype.def) and
-                                           is_class(hp.rettype.def) and
-                                           (tobjectdef(hp.rettype.def).is_related(
+                                           is_class(hp^.def.rettype.def) and
+                                           (tobjectdef(hp^.def.rettype.def).is_related(
                                                tobjectdef(procdefcoll^.data.rettype.def)))) then
-                                         Message2(parser_e_overridden_methods_not_same_ret,hp.fullprocnamewithret,
+                                         Message2(parser_e_overridden_methods_not_same_ret,hp^.def.fullprocnamewithret,
                                            procdefcoll^.data.fullprocnamewithret);
 
 
                                        { now set the number }
-                                       hp.extnumber:=procdefcoll^.data.extnumber;
+                                       hp^.def.extnumber:=procdefcoll^.data.extnumber;
                                        { and exchange }
-                                       procdefcoll^.data:=hp;
+                                       procdefcoll^.data:=hp^.def;
                                        stored:=true;
                                        goto handlenextdef;
                                     end;  { same parameters }
@@ -685,23 +685,23 @@ implementation
                              if not(stored) then
                                begin
                                   new(procdefcoll);
-                                  procdefcoll^.data:=hp;
+                                  procdefcoll^.data:=hp^.def;
                                   procdefcoll^.next:=symcoll^.data;
                                   symcoll^.data:=procdefcoll;
                                   { if the method is virtual ... }
-                                  if (po_virtualmethod in hp.procoptions) then
+                                  if (po_virtualmethod in hp^.def.procoptions) then
                                     begin
                                        { ... it will get a number }
-                                       hp.extnumber:=nextvirtnumber;
+                                       hp^.def.extnumber:=nextvirtnumber;
                                        inc(nextvirtnumber);
                                     end;
                                   { check, if a method should be overridden }
-                                  if (po_overridingmethod in hp.procoptions) then
-                                   MessagePos1(hp.fileinfo,parser_e_nothing_to_be_overridden,
-                                     hp.fullprocname);
+                                  if (po_overridingmethod in hp^.def.procoptions) then
+                                   MessagePos1(hp^.def.fileinfo,parser_e_nothing_to_be_overridden,
+                                     hp^.def.fullprocname);
                                end;
                           handlenextdef:
-                             hp:=hp.nextoverloaded;
+                             hp:=hp^.next;
                           end;
                         exit;
                      end;
@@ -980,18 +980,24 @@ implementation
     function tclassheader.gintfgetcprocdef(proc: tprocdef;const name: string): tprocdef;
       var
         sym: tprocsym;
-        implprocdef: tprocdef;
+        implprocdef : pprocdeflist;
       begin
-        implprocdef:=nil;
+        gintfgetcprocdef:=nil;
         sym:=tprocsym(search_class_member(_class,name));
         if assigned(sym) and (sym.typ=procsym) then
           begin
-            implprocdef:=sym.definition;
-            while assigned(implprocdef) and not equal_paras(proc.para,implprocdef.para,cp_none) and
-              (proc.proccalloption<>implprocdef.proccalloption) do
-              implprocdef:=implprocdef.nextoverloaded;
+            implprocdef:=sym.defs;
+            while assigned(implprocdef) do
+             begin
+               if equal_paras(proc.para,implprocdef^.def.para,cp_none) and
+                  (proc.proccalloption=implprocdef^.def.proccalloption) then
+                begin
+                  gintfgetcprocdef:=implprocdef^.def;
+                  exit;
+                end;
+               implprocdef:=implprocdef^.next;
+             end;
           end;
-        gintfgetcprocdef:=implprocdef;
       end;
 
 
@@ -1275,7 +1281,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.7  2001-10-25 21:22:35  peter
+  Revision 1.8  2001-11-02 22:58:02  peter
+    * procsym definition rewrite
+
+  Revision 1.7  2001/10/25 21:22:35  peter
     * calling convention rewrite
 
   Revision 1.6  2001/10/20 19:28:38  peter

compiler/parser.pas

@@ -38,7 +38,7 @@ implementation
     uses
       cutils,cclasses,
       globtype,version,tokens,systems,globals,verbose,
-      symbase,symtable,symsym,fmodule,fppu,aasm,
+      symbase,symtable,symdef,symsym,fmodule,fppu,aasm,
       cgbase,
       script,gendef,
 {$ifdef BrowserLog}
@@ -67,6 +67,7 @@ implementation
 
          { Symtable }
          aktprocsym:=nil;
+         aktprocdef:=nil;
 
          current_module:=nil;
          compiled_module:=nil;
@@ -242,6 +243,7 @@ implementation
          oldsymtablestack : tsymtable;
          oldprocprefix    : string;
          oldaktprocsym    : tprocsym;
+         oldaktprocdef    : tprocdef;
          oldoverloaded_operators : toverloaded_operators;
        { cg }
          oldnextlabelnr : longint;
@@ -305,6 +307,7 @@ implementation
          oldrefsymtable:=refsymtable;
          oldprocprefix:=procprefix;
          oldaktprocsym:=aktprocsym;
+         oldaktprocdef:=aktprocdef;
          oldaktdefproccall:=aktdefproccall;
          move(overloaded_operators,oldoverloaded_operators,sizeof(toverloaded_operators));
        { save scanner state }
@@ -539,6 +542,7 @@ implementation
               defaultsymtablestack:=olddefaultsymtablestack;
               aktdefproccall:=oldaktdefproccall;
               aktprocsym:=oldaktprocsym;
+              aktprocdef:=oldaktprocdef;
               procprefix:=oldprocprefix;
               move(oldoverloaded_operators,overloaded_operators,sizeof(toverloaded_operators));
               aktlocalswitches:=oldaktlocalswitches;
@@ -607,7 +611,7 @@ implementation
              begin
                { init parts are not needed in units !! }
                if current_module.is_unit then
-                 aktprocsym.definition.forwarddef:=false;
+                 aktprocdef.forwarddef:=false;
                dispose(aktprocsym,done);
              end; *)
           end;
@@ -625,7 +629,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.25  2001-10-25 21:22:35  peter
+  Revision 1.26  2001-11-02 22:58:02  peter
+    * procsym definition rewrite
+
+  Revision 1.25  2001/10/25 21:22:35  peter
     * calling convention rewrite
 
   Revision 1.24  2001/10/23 21:49:42  peter

compiler/pass_2.pas

@@ -260,8 +260,8 @@ implementation
                                    if assigned(aktprocsym) then
                                      begin
                                        if not(assigned(procinfo^._class)) and
-                                          not(aktprocsym.definition.proctypeoption in [potype_constructor,potype_destructor]) and
-                                          not(po_interrupt in aktprocsym.definition.procoptions) and
+                                          not(aktprocdef.proctypeoption in [potype_constructor,potype_destructor]) and
+                                          not(po_interrupt in aktprocdef.procoptions) and
                                           ((procinfo^.flags and pi_do_call)=0) and
                                           (lexlevel>=normal_function_level) then
                                          begin
@@ -280,7 +280,7 @@ implementation
                                              dec(procinfo^.retoffset,4);
 
                                            dec(procinfo^.para_offset,4);
-                                           aktprocsym.definition.parast.address_fixup:=procinfo^.para_offset;
+                                           aktprocdef.parast.address_fixup:=procinfo^.para_offset;
                                          end;
                                      end;
                                     *)
@@ -291,7 +291,7 @@ implementation
               cleanup_regvars(procinfo^.aktexitcode);
 
               if assigned(aktprocsym) and
-                 (aktprocsym.definition.proccalloption=pocall_inline) then
+                 (aktprocdef.proccalloption=pocall_inline) then
                 make_const_global:=true;
               do_secondpass(p);
 
@@ -306,7 +306,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.19  2001-10-25 21:22:35  peter
+  Revision 1.20  2001-11-02 22:58:02  peter
+    * procsym definition rewrite
+
+  Revision 1.19  2001/10/25 21:22:35  peter
     * calling convention rewrite
 
   Revision 1.18  2001/08/26 13:36:44  florian

compiler/pdecobj.pas

@@ -70,12 +70,12 @@ implementation
                 if is_class(aktclass) then
                   begin
                      { CLASS constructors return the created instance }
-                     aktprocsym.definition.rettype.def:=aktclass;
+                     aktprocdef.rettype.def:=aktclass;
                   end
                 else
                   begin
                      { OBJECT constructors return a boolean }
-                     aktprocsym.definition.rettype:=booltype;
+                     aktprocdef.rettype:=booltype;
                   end;
              end;
         end;
@@ -202,18 +202,20 @@ implementation
         { returns the matching procedure to access a property }
         function get_procdef : tprocdef;
           var
-             p : tprocdef;
+             p : pprocdeflist;
           begin
-             p:=tprocsym(sym).definition;
              get_procdef:=nil;
+             p:=tprocsym(sym).defs;
              while assigned(p) do
                begin
-                  if equal_paras(p.para,propertyparas,cp_value_equal_const) or
-                     convertable_paras(p.para,propertyparas,cp_value_equal_const) then
-                    break;
-                  p:=p.nextoverloaded;
+                  if equal_paras(p^.def.para,propertyparas,cp_value_equal_const) or
+                     convertable_paras(p^.def.para,propertyparas,cp_value_equal_const) then
+                    begin
+                      get_procdef:=p^.def;
+                      exit;
+                    end;
+                  p:=p^.next;
                end;
-             get_procdef:=p;
           end;
 
         var
@@ -226,12 +228,14 @@ implementation
            s : string;
            tt : ttype;
            declarepos : tfileposinfo;
-           pp : tprocdef;
+           pp : pprocdeflist;
+           pd : tprocdef;
            pt : tnode;
            propname : stringid;
         begin
            { check for a class }
            aktprocsym:=nil;
+           aktprocdef:=nil;
            if not((is_class_or_interface(aktclass)) or
               ((m_delphi in aktmodeswitches) and (is_object(aktclass)))) then
              Message(parser_e_syntax_error);
@@ -382,11 +386,11 @@ implementation
                       case sym.typ of
                         procsym :
                           begin
-                            pp:=get_procdef;
-                            if not(assigned(pp)) or
-                               not(is_equal(pp.rettype.def,p.proptype.def)) then
+                            pd:=get_procdef;
+                            if not(assigned(pd)) or
+                               not(is_equal(pd.rettype.def,p.proptype.def)) then
                               Message(parser_e_ill_property_access_sym);
-                            p.readaccess.setdef(pp);
+                            p.readaccess.setdef(pd);
                           end;
                         varsym :
                           begin
@@ -417,12 +421,12 @@ implementation
                           begin
                             { insert data entry to check access method }
                             propertyparas.insert(datacoll);
-                            pp:=get_procdef;
+                            pd:=get_procdef;
                             { ... and remove it }
                             propertyparas.remove(datacoll);
-                            if not(assigned(pp)) then
+                            if not(assigned(pd)) then
                               Message(parser_e_ill_property_access_sym);
-                            p.writeaccess.setdef(pp);
+                            p.writeaccess.setdef(pd);
                           end;
                         varsym :
                           begin
@@ -461,19 +465,20 @@ implementation
                                case sym.typ of
                                  procsym :
                                    begin
-                                     pp:=tprocsym(sym).definition;
+                                     pp:=tprocsym(sym).defs;
                                      while assigned(pp) do
                                       begin
                                         { the stored function shouldn't have any parameters }
-                                        if pp.Para.empty then
+                                        if pp^.def.Para.empty then
                                          break;
-                                        pp:=pp.nextoverloaded;
+                                        pp:=pp^.next;
                                       end;
                                      { found we a procedure and does it really return a bool? }
-                                     if not(assigned(pp)) or
-                                        not(is_boolean(pp.rettype.def)) then
+                                     if assigned(pp) and
+                                        is_boolean(pp^.def.rettype.def) then
+                                       p.storedaccess.setdef(pp^.def)
+                                     else
                                        Message(parser_e_ill_property_storage_sym);
-                                     p.storedaccess.setdef(pp);
                                    end;
                                  varsym :
                                    begin
@@ -570,11 +575,11 @@ implementation
             Message(parser_e_destructorname_must_be_done);
            include(aktclass.objectoptions,oo_has_destructor);
            consume(_SEMICOLON);
-           if not(aktprocsym.definition.Para.empty) then
+           if not(aktprocdef.Para.empty) then
              if not (m_tp in aktmodeswitches) then
                Message(parser_e_no_paras_for_destructor);
            { no return value }
-           aktprocsym.definition.rettype:=voidtype;
+           aktprocdef.rettype:=voidtype;
         end;
 
       var
@@ -583,6 +588,7 @@ implementation
          tt     : ttype;
          oldprocinfo : pprocinfo;
          oldprocsym : tprocsym;
+         oldprocdef : tprocdef;
          oldparse_only : boolean;
          storetypecanbeforward : boolean;
 
@@ -877,17 +883,16 @@ implementation
         begin
            if is_cppclass(aktclass) then
              begin
-                aktprocsym.definition.proccalloption:=pocall_cppdecl;
-                aktprocsym.definition.setmangledname(
-                  target_info.Cprefix+aktprocsym.definition.cplusplusmangledname);
+                aktprocdef.proccalloption:=pocall_cppdecl;
+                aktprocdef.setmangledname(
+                  target_info.Cprefix+aktprocdef.cplusplusmangledname);
              end;
         end;
 
-      var
-        temppd : tprocdef;
       begin
          {Nowadays aktprocsym may already have a value, so we need to save
           it.}
+         oldprocdef:=aktprocdef;
          oldprocsym:=aktprocsym;
          { forward is resolved }
          if assigned(fd) then
@@ -943,123 +948,140 @@ implementation
               if (sp_protected in actmembertype) then
                 include(aktclass.objectoptions,oo_has_protected);
               case token of
-              _ID : begin
-                      case idtoken of
-                       _PRIVATE : begin
-                                    if is_interface(aktclass) then
-                                      Message(parser_e_no_access_specifier_in_interfaces);
-                                    consume(_PRIVATE);
-                                    actmembertype:=[sp_private];
-                                    current_object_option:=[sp_private];
-                                  end;
-                     _PROTECTED : begin
-                                    if is_interface(aktclass) then
-                                      Message(parser_e_no_access_specifier_in_interfaces);
-                                    consume(_PROTECTED);
-                                    current_object_option:=[sp_protected];
-                                    actmembertype:=[sp_protected];
-                                  end;
-                        _PUBLIC : begin
-                                    if is_interface(aktclass) then
-                                      Message(parser_e_no_access_specifier_in_interfaces);
-                                    consume(_PUBLIC);
-                                    current_object_option:=[sp_public];
-                                    actmembertype:=[sp_public];
-                                  end;
-                     _PUBLISHED : begin
-                                    if is_interface(aktclass) then
-                                      Message(parser_e_no_access_specifier_in_interfaces)
-                                    else
-                                      if not(oo_can_have_published in aktclass.objectoptions) then
-                                        Message(parser_e_cant_have_published);
-                                    consume(_PUBLISHED);
-                                    current_object_option:=[sp_published];
-                                    actmembertype:=[sp_published];
-                                  end;
-                      else
-                        if is_interface(aktclass) then
-                          Message(parser_e_no_vars_in_interfaces);
-                        read_var_decs(false,true,false);
-                      end;
-                    end;
-        _PROPERTY : begin
-                      property_dec;
-                    end;
-       _PROCEDURE,
-        _FUNCTION,
-           _CLASS : begin
-                      oldparse_only:=parse_only;
-                      parse_only:=true;
-                      parse_proc_dec;
-                      { this is for error recovery as well as forward }
-                      { interface mappings, i.e. mapping to a method  }
-                      { which isn't declared yet                      }
-                      if assigned(aktprocsym) then
+                _ID :
+                  begin
+                    case idtoken of
+                      _PRIVATE :
                         begin
-{$ifndef newcg}
-                            parse_object_proc_directives(aktprocsym);
-{$endif newcg}
-                            { check if there are duplicates }
-                            check_identical_proc(temppd);
-                            if (po_msgint in aktprocsym.definition.procoptions) then
-                             include(aktclass.objectoptions,oo_has_msgint);
+                          if is_interface(aktclass) then
+                             Message(parser_e_no_access_specifier_in_interfaces);
+                           consume(_PRIVATE);
+                           actmembertype:=[sp_private];
+                           current_object_option:=[sp_private];
+                         end;
+                       _PROTECTED :
+                         begin
+                           if is_interface(aktclass) then
+                             Message(parser_e_no_access_specifier_in_interfaces);
+                           consume(_PROTECTED);
+                           current_object_option:=[sp_protected];
+                           actmembertype:=[sp_protected];
+                         end;
+                       _PUBLIC :
+                         begin
+                           if is_interface(aktclass) then
+                             Message(parser_e_no_access_specifier_in_interfaces);
+                           consume(_PUBLIC);
+                           current_object_option:=[sp_public];
+                           actmembertype:=[sp_public];
+                         end;
+                       _PUBLISHED :
+                         begin
+                           if is_interface(aktclass) then
+                             Message(parser_e_no_access_specifier_in_interfaces)
+                           else
+                             if not(oo_can_have_published in aktclass.objectoptions) then
+                               Message(parser_e_cant_have_published);
+                           consume(_PUBLISHED);
+                           current_object_option:=[sp_published];
+                           actmembertype:=[sp_published];
+                         end;
+                       else
+                         begin
+                           if is_interface(aktclass) then
+                            Message(parser_e_no_vars_in_interfaces);
+                           read_var_decs(false,true,false);
+                         end;
+                    end;
+                  end;
+                _PROPERTY :
+                  begin
+                    property_dec;
+                  end;
+                _PROCEDURE,
+                _FUNCTION,
+                _CLASS :
+                  begin
+                    oldparse_only:=parse_only;
+                    parse_only:=true;
+                    parse_proc_dec;
+                    { this is for error recovery as well as forward }
+                    { interface mappings, i.e. mapping to a method  }
+                    { which isn't declared yet                      }
+                    if assigned(aktprocsym) then
+                      begin
+                          parse_object_proc_directives(aktprocsym);
 
-                            if (po_msgstr in aktprocsym.definition.procoptions) then
-                              include(aktclass.objectoptions,oo_has_msgstr);
+                          { add definition to procsym }
+                          proc_add_definition(aktprocsym,aktprocdef);
 
-                            if (po_virtualmethod in aktprocsym.definition.procoptions) then
-                              include(aktclass.objectoptions,oo_has_virtual);
+                          { add procdef options to objectdef options }
+                          if (po_msgint in aktprocdef.procoptions) then
+                           include(aktclass.objectoptions,oo_has_msgint);
+                          if (po_msgstr in aktprocdef.procoptions) then
+                            include(aktclass.objectoptions,oo_has_msgstr);
+                          if (po_virtualmethod in aktprocdef.procoptions) then
+                            include(aktclass.objectoptions,oo_has_virtual);
 
-                            chkcpp;
-                         end;
+                          chkcpp;
+                       end;
 
-                      parse_only:=oldparse_only;
-                    end;
-     _CONSTRUCTOR : begin
-                      if not(sp_public in actmembertype) then
-                        Message(parser_w_constructor_should_be_public);
-                      if is_interface(aktclass) then
-                        Message(parser_e_no_con_des_in_interfaces);
-                      oldparse_only:=parse_only;
-                      parse_only:=true;
-                      constructor_head;
-{$ifndef newcg}
-                      parse_object_proc_directives(aktprocsym);
-{$endif newcg}
-                      if (po_virtualmethod in aktprocsym.definition.procoptions) then
-                        include(aktclass.objectoptions,oo_has_virtual);
-
-                      chkcpp;
-
-                      parse_only:=oldparse_only;
-                    end;
-      _DESTRUCTOR : begin
-                      if there_is_a_destructor then
-                        Message(parser_n_only_one_destructor);
-                      if is_interface(aktclass) then
-                        Message(parser_e_no_con_des_in_interfaces);
-                      there_is_a_destructor:=true;
-                      if not(sp_public in actmembertype) then
-                        Message(parser_w_destructor_should_be_public);
-                      oldparse_only:=parse_only;
-                      parse_only:=true;
-                      destructor_head;
-{$ifndef newcg}
-                      parse_object_proc_directives(aktprocsym);
-{$endif newcg}
-                      if (po_virtualmethod in aktprocsym.definition.procoptions) then
-                        include(aktclass.objectoptions,oo_has_virtual);
-
-                      chkcpp;
-
-                      parse_only:=oldparse_only;
-                    end;
-             _END : begin
-                      consume(_END);
-                      break;
-                    end;
-              else
-               consume(_ID); { Give a ident expected message, like tp7 }
+                    parse_only:=oldparse_only;
+                  end;
+                _CONSTRUCTOR :
+                  begin
+                    if not(sp_public in actmembertype) then
+                      Message(parser_w_constructor_should_be_public);
+                    if is_interface(aktclass) then
+                      Message(parser_e_no_con_des_in_interfaces);
+                    oldparse_only:=parse_only;
+                    parse_only:=true;
+                    constructor_head;
+                    parse_object_proc_directives(aktprocsym);
+
+                    { add definition to procsym }
+                    proc_add_definition(aktprocsym,aktprocdef);
+
+                    { add procdef options to objectdef options }
+                    if (po_virtualmethod in aktprocdef.procoptions) then
+                      include(aktclass.objectoptions,oo_has_virtual);
+
+                    chkcpp;
+
+                    parse_only:=oldparse_only;
+                  end;
+                _DESTRUCTOR :
+                  begin
+                    if there_is_a_destructor then
+                      Message(parser_n_only_one_destructor);
+                    if is_interface(aktclass) then
+                      Message(parser_e_no_con_des_in_interfaces);
+                    there_is_a_destructor:=true;
+                    if not(sp_public in actmembertype) then
+                      Message(parser_w_destructor_should_be_public);
+                    oldparse_only:=parse_only;
+                    parse_only:=true;
+                    destructor_head;
+                    parse_object_proc_directives(aktprocsym);
+
+                    { add definition to procsym }
+                    proc_add_definition(aktprocsym,aktprocdef);
+
+                    { add procdef options to objectdef options }
+                    if (po_virtualmethod in aktprocdef.procoptions) then
+                      include(aktclass.objectoptions,oo_has_virtual);
+
+                    chkcpp;
+
+                    parse_only:=oldparse_only;
+                  end;
+                _END :
+                  begin
+                    consume(_END);
+                    break;
+                  end;
+                else
+                  consume(_ID); { Give a ident expected message, like tp7 }
               end;
             until false;
             current_object_option:=[sp_public];
@@ -1087,6 +1109,7 @@ implementation
          procinfo:=oldprocinfo;
          {Restore the aktprocsym.}
          aktprocsym:=oldprocsym;
+         aktprocdef:=oldprocdef;
 
          object_dec:=aktclass;
       end;
@@ -1094,7 +1117,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.32  2001-10-25 21:22:35  peter
+  Revision 1.33  2001-11-02 22:58:02  peter
+    * procsym definition rewrite
+
+  Revision 1.32  2001/10/25 21:22:35  peter
     * calling convention rewrite
 
   Revision 1.31  2001/10/21 13:10:50  peter

compiler/pexports.pas

@@ -72,16 +72,26 @@ implementation
                    orgs:=orgpattern;
                    consume_sym(srsym,srsymtable);
                    hp.sym:=srsym;
-                   if ((hp.sym.typ<>procsym) or
-                       ((tf_need_export in target_info.flags) and
-                        not(po_exports in tprocdef(tprocsym(srsym).definition).procoptions)
-                       )
-                      ) and
-                      (srsym.typ<>varsym) and (srsym.typ<>typedconstsym) then
-                    Message(parser_e_illegal_symbol_exported)
-                   else
+                   InternalProcName:='';
+                   case srsym.typ of
+                     varsym :
+                       InternalProcName:=tvarsym(srsym).mangledname;
+                     typedconstsym :
+                       InternalProcName:=ttypedconstsym(srsym).mangledname;
+                     procsym :
+                       begin
+                         if assigned(tprocsym(srsym).defs^.next) or
+                            ((tf_need_export in target_info.flags) and
+                             not(po_exports in tprocsym(srsym).defs^.def.procoptions)) then
+                           Message(parser_e_illegal_symbol_exported)
+                         else
+                           InternalProcName:=tprocsym(srsym).defs^.def.mangledname;
+                       end;
+                     else
+                       Message(parser_e_illegal_symbol_exported)
+                   end;
+                   if InternalProcName<>'' then
                     begin
-                      InternalProcName:=srsym.mangledname;
                       { This is wrong if the first is not
                         an underline }
                       if InternalProcName[1]='_' then
@@ -163,7 +173,10 @@ end.
 
 {
   $Log$
-  Revision 1.15  2001-04-18 22:01:57  peter
+  Revision 1.16  2001-11-02 22:58:04  peter
+    * procsym definition rewrite
+
+  Revision 1.15  2001/04/18 22:01:57  peter
     * registration of targets and assemblers
 
   Revision 1.14  2001/04/13 01:22:12  peter

compiler/pexpr.pas

@@ -1118,9 +1118,9 @@ implementation
                  (objdef.owner.symtabletype=globalsymtable) and
                  (objdef.owner.unitid<>0) then
                 begin
-                  if assigned(aktprocsym.definition._class) then
+                  if assigned(aktprocdef._class) then
                     begin
-                       if not aktprocsym.definition._class.is_related(objdef) then
+                       if not aktprocdef._class.is_related(objdef) then
                          Message(parser_e_cant_access_protected_member);
                     end
                   else
@@ -1137,7 +1137,7 @@ implementation
                                    (getprocvar and
                                     ((block_type=bt_const) or
                                      ((m_tp_procvar in aktmodeswitches) and
-                                      proc_to_procvar_equal(tprocsym(sym).definition,getprocvardef,false)
+                                      proc_to_procvar_equal(tprocsym(sym).defs^.def,getprocvardef,false)
                                      )
                                     )
                                    ),again,p1);
@@ -1283,7 +1283,7 @@ implementation
                     { are we in a class method ? }
                     if (srsym.owner.symtabletype=objectsymtable) and
                        assigned(aktprocsym) and
-                       (po_classmethod in aktprocsym.definition.procoptions) then
+                       (po_classmethod in aktprocdef.procoptions) then
                       Message(parser_e_only_class_methods);
                     if (sp_static in srsym.symoptions) then
                      begin
@@ -1471,13 +1471,13 @@ implementation
                     { are we in a class method ? }
                     possible_error:=(srsym.owner.symtabletype=objectsymtable) and
                                     assigned(aktprocsym) and
-                                    (po_classmethod in aktprocsym.definition.procoptions);
+                                    (po_classmethod in aktprocdef.procoptions);
                     do_proc_call(srsym,srsymtable,
                                  getaddr or
                                  (getprocvar and
                                   ((block_type=bt_const) or
                                    ((m_tp_procvar in aktmodeswitches) and
-                                    proc_to_procvar_equal(tprocsym(srsym).definition,getprocvardef,false)
+                                    proc_to_procvar_equal(tprocsym(srsym).defs^.def,getprocvardef,false)
                                    )
                                   )
                                  ),again,p1);
@@ -1499,7 +1499,7 @@ implementation
                     { are we in a class method ? }
                     if (srsym.owner.symtabletype=objectsymtable) and
                        assigned(aktprocsym) and
-                       (po_classmethod in aktprocsym.definition.procoptions) then
+                       (po_classmethod in aktprocdef.procoptions) then
                      Message(parser_e_only_class_methods);
                     { no method pointer }
                     p1:=nil;
@@ -1965,7 +1965,7 @@ implementation
                 end
                else
                 begin
-                  if (po_classmethod in aktprocsym.definition.procoptions) then
+                  if (po_classmethod in aktprocdef.procoptions) then
                    begin
                      { self in class methods is a class reference type }
                      htype.setdef(procinfo^._class);
@@ -2513,7 +2513,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.48  2001-10-28 17:22:25  peter
+  Revision 1.49  2001-11-02 22:58:05  peter
+    * procsym definition rewrite
+
+  Revision 1.48  2001/10/28 17:22:25  peter
     * allow assignment of overloaded procedures to procvars when we know
       which procedure to take
 

compiler/pmodules.pas

@@ -437,9 +437,11 @@ implementation
          hp2 : tmodule;
          hp3 : tsymtable;
          oldprocsym:tprocsym;
+         oldprocdef:tprocdef;
          unitsym : tunitsym;
       begin
          oldprocsym:=aktprocsym;
+         oldprocdef:=aktprocdef;
          consume(_USES);
 {$ifdef DEBUG}
          test_symtablestack;
@@ -539,6 +541,7 @@ implementation
               hp:=tused_unit(hp.next);
            end;
           aktprocsym:=oldprocsym;
+          aktprocdef:=oldprocdef;
       end;
 
 
@@ -634,6 +637,7 @@ implementation
     procedure gen_main_procsym(const name:string;options:tproctypeoption;st:tsymtable);
       var
         stt : tsymtable;
+        procdefs : pprocdeflist;
       begin
         {Generate a procsym for main}
         make_ref:=false;
@@ -643,16 +647,21 @@ implementation
         {Try to insert in in static symtable ! }
         stt:=symtablestack;
         symtablestack:=st;
-        aktprocsym.definition:=tprocdef.create;
+        aktprocdef:=tprocdef.create;
+        new(procdefs);
+        procdefs^.def:=aktprocdef;
+        procdefs^.next:=aktprocsym.defs;
+        aktprocsym.defs:=procdefs;
+        aktprocdef.procsym:=aktprocsym;
         symtablestack:=stt;
-        aktprocsym.definition.proctypeoption:=options;
-        aktprocsym.definition.setmangledname(target_info.cprefix+name);
-        aktprocsym.definition.forwarddef:=false;
+        aktprocdef.proctypeoption:=options;
+        aktprocdef.setmangledname(target_info.cprefix+name);
+        aktprocdef.forwarddef:=false;
         make_ref:=true;
         { The localst is a local symtable. Change it into the static
           symtable }
-        aktprocsym.definition.localst.free;
-        aktprocsym.definition.localst:=st;
+        aktprocdef.localst.free;
+        aktprocdef.localst:=st;
         { and insert the procsym in symtable }
         st.insert(aktprocsym);
         { set some informations about the main program }
@@ -662,7 +671,7 @@ implementation
            para_offset:=8;
            framepointer:=frame_pointer;
            flags:=0;
-           procdef:=aktprocsym.definition;
+           procdef:=aktprocdef;
          end;
       end;
 
@@ -897,13 +906,13 @@ implementation
          { Compile the unit }
          codegen_newprocedure;
          gen_main_procsym(current_module.modulename^+'_init',potype_unitinit,st);
-         aktprocsym.definition.aliasnames.insert('INIT$$'+current_module.modulename^);
-         aktprocsym.definition.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_init');
+         aktprocdef.aliasnames.insert('INIT$$'+current_module.modulename^);
+         aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_init');
          compile_proc_body(true,false);
          codegen_doneprocedure;
 
          { avoid self recursive destructor call !! PM }
-         aktprocsym.definition.localst:=nil;
+         aktprocdef.localst:=nil;
 
          { if the unit contains ansi/widestrings, initialization and
            finalization code must be forced }
@@ -929,8 +938,8 @@ implementation
               { Compile the finalize }
               codegen_newprocedure;
               gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
-              aktprocsym.definition.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
-              aktprocsym.definition.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
+              aktprocdef.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
+              aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
               compile_proc_body(true,false);
               codegen_doneprocedure;
            end
@@ -956,9 +965,9 @@ implementation
           end;
 
          { avoid self recursive destructor call !! PM }
-         aktprocsym.definition.localst:=nil;
+         aktprocdef.localst:=nil;
          { absence does not matter here !! }
-         aktprocsym.definition.forwarddef:=false;
+         aktprocdef.forwarddef:=false;
          { test static symtable }
          if (Errorcount=0) then
            begin
@@ -994,11 +1003,14 @@ implementation
 
          reset_global_defs;
 
-         { tests, if all (interface) forwards are resolved }
          if (Errorcount=0) then
            begin
+             { tests, if all (interface) forwards are resolved }
              tstoredsymtable(symtablestack).check_forwards;
+             { check if all private fields are used }
              tstoredsymtable(symtablestack).allprivatesused;
+             { remove cross unit overloads }
+             tstoredsymtable(symtablestack).unchain_overloaded;
            end;
 
          current_module.in_implementation:=false;
@@ -1200,18 +1212,18 @@ implementation
          if islibrary then
           begin
             gen_main_procsym(current_module.modulename^+'_main',potype_proginit,st);
-            aktprocsym.definition.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_main');
-            aktprocsym.definition.aliasnames.insert('PASCALMAIN');
+            aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_main');
+            aktprocdef.aliasnames.insert('PASCALMAIN');
             { this code is called from C so we need to save some
               registers }
-            include(aktprocsym.definition.procoptions,po_savestdregs);
+            include(aktprocdef.procoptions,po_savestdregs);
           end
          else
           begin
             gen_main_procsym('main',potype_proginit,st);
-            aktprocsym.definition.aliasnames.insert('program_init');
-            aktprocsym.definition.aliasnames.insert('PASCALMAIN');
-            aktprocsym.definition.aliasnames.insert(target_info.cprefix+'main');
+            aktprocdef.aliasnames.insert('program_init');
+            aktprocdef.aliasnames.insert('PASCALMAIN');
+            aktprocdef.aliasnames.insert(target_info.cprefix+'main');
           end;
          compile_proc_body(true,false);
 
@@ -1223,7 +1235,7 @@ implementation
            codesegment.concat(tai_const_symbol.create(exportlib.edatalabel));
 
          { avoid self recursive destructor call !! PM }
-         aktprocsym.definition.localst:=nil;
+         aktprocdef.localst:=nil;
 
          { consider these symbols as global ones for browser
            but the typecasting of the globalsymtable with tglobalsymtable
@@ -1250,8 +1262,8 @@ implementation
               { Compile the finalize }
               codegen_newprocedure;
               gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
-              aktprocsym.definition.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
-              aktprocsym.definition.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
+              aktprocdef.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
+              aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
               compile_proc_body(true,false);
               codegen_doneprocedure;
            end;
@@ -1339,7 +1351,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.47  2001-09-18 11:30:48  michael
+  Revision 1.48  2001-11-02 22:58:05  peter
+    * procsym definition rewrite
+
+  Revision 1.47  2001/09/18 11:30:48  michael
   * Fixes win32 linking problems with import libraries
   * LINKLIB Libraries are now looked for using C file extensions
   * get_exepath fix

compiler/pstatmnt.pas

@@ -408,7 +408,7 @@ implementation
                            symtab:=twithsymtable.Create(obj,obj.symtable.symsearch);
                            withsymtable:=symtab;
                            if (p.nodetype=loadn) and
-                              (tloadnode(p).symtable=aktprocsym.definition.localst) then
+                              (tloadnode(p).symtable=aktprocdef.localst) then
                              twithsymtable(symtab).direct_with:=true;
                            twithsymtable(symtab).withrefnode:=p;
                            levelcount:=1;
@@ -418,7 +418,7 @@ implementation
                               symtab.next:=twithsymtable.create(obj,obj.symtable.symsearch);
                               symtab:=symtab.next;
                               if (p.nodetype=loadn) and
-                                 (tloadnode(p).symtable=aktprocsym.definition.localst) then
+                                 (tloadnode(p).symtable=aktprocdef.localst) then
                                 twithsymtable(symtab).direct_with:=true;
                               twithsymtable(symtab).withrefnode:=p;
                               obj:=obj.childof;
@@ -432,7 +432,7 @@ implementation
                            levelcount:=1;
                            withsymtable:=twithsymtable.create(trecorddef(p.resulttype.def),symtab.symsearch);
                            if (p.nodetype=loadn) and
-                              (tloadnode(p).symtable=aktprocsym.definition.localst) then
+                              (tloadnode(p).symtable=aktprocdef.localst) then
                            twithsymtable(withsymtable).direct_with:=true;
                            twithsymtable(withsymtable).withrefnode:=p;
                            withsymtable.next:=symtablestack;
@@ -727,7 +727,7 @@ implementation
               consume(_RKLAMMER);
               if (block_type=bt_except) then
                 Message(parser_e_exit_with_argument_not__possible);
-              if is_void(aktprocsym.definition.rettype.def) then
+              if is_void(aktprocdef.rettype.def) then
                 Message(parser_e_void_function);
            end
          else
@@ -761,11 +761,11 @@ implementation
              begin
                if not target_asm.allowdirect then
                  Message(parser_f_direct_assembler_not_allowed);
-               if (aktprocsym.definition.proccalloption=pocall_inline) then
+               if (aktprocdef.proccalloption=pocall_inline) then
                  Begin
                     Message1(parser_w_not_supported_for_inline,'direct asm');
                     Message(parser_w_inlining_disabled);
-                    aktprocsym.definition.proccalloption:=pocall_fpccall;
+                    aktprocdef.proccalloption:=pocall_fpccall;
                  End;
                asmstat:=tasmnode(ra386dir.assemble);
              end;
@@ -940,7 +940,7 @@ implementation
              code:=cnothingnode.create;
            _FAIL :
              begin
-                if (aktprocsym.definition.proctypeoption<>potype_constructor) then
+                if (aktprocdef.proctypeoption<>potype_constructor) then
                   Message(parser_e_fail_only_in_constructor);
                 consume(_FAIL);
                 code:=cfailnode.create;
@@ -1053,10 +1053,10 @@ implementation
 
          { assembler code does not allocate }
          { space for the return value       }
-          if not is_void(aktprocsym.definition.rettype.def) then
+          if not is_void(aktprocdef.rettype.def) then
            begin
-              aktprocsym.definition.funcretsym:=tfuncretsym.create(aktprocsym.name,aktprocsym.definition.rettype);
-              if ret_in_acc(aktprocsym.definition.rettype.def) then
+              aktprocdef.funcretsym:=tfuncretsym.create(aktprocsym.name,aktprocdef.rettype);
+              if ret_in_acc(aktprocdef.rettype.def) then
                 begin
                    { in assembler code the result should be directly in %eax
                    procinfo^.retoffset:=procinfo^.firsttemp-procinfo^.retdef.size;
@@ -1088,23 +1088,23 @@ implementation
            { at -8(%ebp) (JM)                                      }
            { why if se use %esp then self is still at the correct address PM }
            if {not(assigned(procinfo^._class)) and}
-              (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.rettype.def)) then
+              (po_assembler in aktprocdef.procoptions) and
+              (aktprocdef.localst.datasize=0) and
+              (aktprocdef.parast.datasize=0) and
+              not(ret_in_param(aktprocdef.rettype.def)) then
              begin
                procinfo^.framepointer:=stack_pointer;
                { set the right value for parameters }
-               dec(aktprocsym.definition.parast.address_fixup,target_info.size_of_pointer);
+               dec(aktprocdef.parast.address_fixup,target_info.size_of_pointer);
                dec(procinfo^.para_offset,target_info.size_of_pointer);
              end;
           { only insert now in the symtable, otherwise the              }
-          { "aktprocsym.definition.localst.datasize=0" check above will }
+          { "aktprocdef.localst.datasize=0" check above will }
           { always fail (JM)                                            }
-          if not is_void(aktprocsym.definition.rettype.def) then
+          if not is_void(aktprocdef.rettype.def) then
             begin
               { insert in local symtable }
-              symtablestack.insert(aktprocsym.definition.funcretsym);
+              symtablestack.insert(aktprocdef.funcretsym);
             end;
           { force the asm statement }
             if token<>_ASM then
@@ -1119,7 +1119,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.42  2001-10-26 22:36:42  florian
+  Revision 1.43  2001-11-02 22:58:05  peter
+    * procsym definition rewrite
+
+  Revision 1.42  2001/10/26 22:36:42  florian
     * fixed ranges in case statements with widechars
 
   Revision 1.41  2001/10/25 21:22:37  peter

compiler/psub.pas

@@ -89,34 +89,34 @@ implementation
          { do we have an assembler block without the po_assembler?
            we should allow this for Delphi compatibility (PFV) }
          if (token=_ASM) and (m_delphi in aktmodeswitches) then
-          include(aktprocsym.definition.procoptions,po_assembler);
+          include(aktprocdef.procoptions,po_assembler);
 
          { Handle assembler block different }
-         if (po_assembler in aktprocsym.definition.procoptions) then
+         if (po_assembler in aktprocdef.procoptions) then
           begin
             read_declarations(false);
             block:=assembler_block;
             exit;
           end;
 
-         if not is_void(aktprocsym.definition.rettype.def) then
+         if not is_void(aktprocdef.rettype.def) then
            begin
               { if the current is a function aktprocsym is non nil }
               { and there is a local symtable set }
               storepos:=akttokenpos;
               akttokenpos:=aktprocsym.fileinfo;
-              aktprocsym.definition.funcretsym:=tfuncretsym.create(aktprocsym.name,aktprocsym.definition.rettype);
+              aktprocdef.funcretsym:=tfuncretsym.create(aktprocsym.name,aktprocdef.rettype);
               { insert in local symtable }
-              symtablestack.insert(aktprocsym.definition.funcretsym);
+              symtablestack.insert(aktprocdef.funcretsym);
               akttokenpos:=storepos;
-              if ret_in_acc(aktprocsym.definition.rettype.def) or
-                 (aktprocsym.definition.rettype.def.deftype=floatdef) then
-                procinfo^.return_offset:=-tfuncretsym(aktprocsym.definition.funcretsym).address;
+              if ret_in_acc(aktprocdef.rettype.def) or
+                 (aktprocdef.rettype.def.deftype=floatdef) then
+                procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
               { insert result also if support is on }
               if (m_result in aktmodeswitches) then
                begin
-                 aktprocsym.definition.resultfuncretsym:=tfuncretsym.create('RESULT',aktprocsym.definition.rettype);
-                 symtablestack.insert(aktprocsym.definition.resultfuncretsym);
+                 aktprocdef.resultfuncretsym:=tfuncretsym.create('RESULT',aktprocdef.rettype);
+                 symtablestack.insert(aktprocdef.resultfuncretsym);
                end;
            end;
          read_declarations(islibrary);
@@ -131,12 +131,12 @@ implementation
          { !!!!!   this means that we can not set the return value
          in a subfunction !!!!! }
          { because we don't know yet where the address is }
-         if not is_void(aktprocsym.definition.rettype.def) then
+         if not is_void(aktprocdef.rettype.def) then
            begin
-              if ret_in_acc(aktprocsym.definition.rettype.def) or (aktprocsym.definition.rettype.def.deftype=floatdef) then
+              if ret_in_acc(aktprocdef.rettype.def) or (aktprocdef.rettype.def.deftype=floatdef) then
                 begin
                    { the space has been set in the local symtable }
-                   procinfo^.return_offset:=-tfuncretsym(aktprocsym.definition.funcretsym).address;
+                   procinfo^.return_offset:=-tfuncretsym(aktprocdef.funcretsym).address;
                    if ((procinfo^.flags and pi_operator)<>0) and
                       assigned(otsym) then
                      otsym.address:=-procinfo^.return_offset;
@@ -145,13 +145,13 @@ implementation
 {$ifdef i386}
                    usedinproc:=usedinproc or ($80 shr byte(R_EAX));
 
-                   if is_64bitint(aktprocsym.definition.rettype.def) then
+                   if is_64bitint(aktprocdef.rettype.def) then
                      usedinproc:=usedinproc or ($80 shr byte(R_EDX))
 {$endif}
 {$ifdef m68k}
                    usedinproc:=usedinproc + [accumulator];
 
-                   if is_64bitint(aktprocsym.definition.rettype.def) then
+                   if is_64bitint(aktprocdef.rettype.def) then
                      usedinproc:=usedinproc  + [scratch_reg];
 {$endif}
 {$endif newcg}
@@ -237,7 +237,7 @@ implementation
           Message(parser_e_too_much_lexlevel);
 
          { static is also important for local procedures !! }
-         if (po_staticmethod in aktprocsym.definition.procoptions) then
+         if (po_staticmethod in aktprocdef.procoptions) then
            allow_only_static:=true
          else if (lexlevel=normal_function_level) then
            allow_only_static:=false;
@@ -251,7 +251,7 @@ implementation
          getlabel(aktexitlabel);
          getlabel(aktexit2label);
          { exit for fail in constructors }
-         if (aktprocsym.definition.proctypeoption=potype_constructor) then
+         if (aktprocdef.proctypeoption=potype_constructor) then
            begin
              getlabel(faillabel);
              getlabel(quickexitlabel);
@@ -281,13 +281,13 @@ implementation
            for checking of same names used in interface and implementation !! }
          if lexlevel>=normal_function_level then
            begin
-              aktprocsym.definition.parast.next:=symtablestack;
-              symtablestack:=aktprocsym.definition.parast;
+              aktprocdef.parast.next:=symtablestack;
+              symtablestack:=aktprocdef.parast;
               symtablestack.symtablelevel:=lexlevel;
            end;
          { insert localsymtable in symtablestack}
-         aktprocsym.definition.localst.next:=symtablestack;
-         symtablestack:=aktprocsym.definition.localst;
+         aktprocdef.localst.next:=symtablestack;
+         symtablestack:=aktprocdef.localst;
          symtablestack.symtablelevel:=lexlevel;
          { constant symbols are inserted in this symboltable }
          constsymtable:=symtablestack;
@@ -346,7 +346,7 @@ implementation
          if assigned(code) then
           begin
             { the procedure is now defined }
-            aktprocsym.definition.forwarddef:=false;
+            aktprocdef.forwarddef:=false;
 
              { only generate the code if no type errors are found, else
                finish at least the type checking pass }
@@ -354,7 +354,7 @@ implementation
             if (status.errorcount=0) then
               begin
                 generatecode(code);
-                aktprocsym.definition.code:=code;
+                aktprocdef.code:=code;
 {$ifdef newcg}
                 stackframe:=gettempsize;
 {$else newcg}
@@ -391,9 +391,9 @@ implementation
 
                 { now all the registers used are known }
 {$ifdef newcg}
-                aktprocsym.definition.usedregisters:=tg.usedinproc;
+                aktprocdef.usedregisters:=tg.usedinproc;
 {$else newcg}
-                aktprocsym.definition.usedregisters:=usedinproc;
+                aktprocdef.usedregisters:=usedinproc;
 {$endif newcg}
                 procinfo^.aktproccode.insertlist(procinfo^.aktentrycode);
                 procinfo^.aktproccode.concatlist(procinfo^.aktexitcode);
@@ -438,17 +438,21 @@ implementation
            begin
              if (Errorcount=0) then
                begin
-                 tstoredsymtable(aktprocsym.definition.localst).check_forwards;
-                 tstoredsymtable(aktprocsym.definition.localst).checklabels;
+                 { check if forwards are resolved }
+                 tstoredsymtable(aktprocdef.localst).check_forwards;
+                 { check if all labels are used }
+                 tstoredsymtable(aktprocdef.localst).checklabels;
+                 { remove cross unit overloads }
+                 tstoredsymtable(aktprocdef.localst).unchain_overloaded;
                end;
              if (procinfo^.flags and pi_uses_asm)=0 then
                begin
                   { not for unit init, becuase the var can be used in finalize,
                     it will be done in proc_unit }
-                  if not(aktprocsym.definition.proctypeoption
+                  if not(aktprocdef.proctypeoption
                      in [potype_proginit,potype_unitinit,potype_unitfinalize]) then
-                     tstoredsymtable(aktprocsym.definition.localst).allsymbolsused;
-                  tstoredsymtable(aktprocsym.definition.parast).allsymbolsused;
+                     tstoredsymtable(aktprocdef.localst).allsymbolsused;
+                  tstoredsymtable(aktprocdef.parast).allsymbolsused;
                end;
            end;
 
@@ -460,11 +464,11 @@ implementation
          { so no dispose here !!                              }
          if assigned(code) and
             not(cs_browser in aktmoduleswitches) and
-            (aktprocsym.definition.proccalloption<>pocall_inline) then
+            (aktprocdef.proccalloption<>pocall_inline) then
            begin
              if lexlevel>=normal_function_level then
-               aktprocsym.definition.localst.free;
-             aktprocsym.definition.localst:=nil;
+               aktprocdef.localst.free;
+             aktprocdef.localst:=nil;
            end;
 
 {$ifdef newcg}
@@ -480,7 +484,7 @@ implementation
 {$endif newcg}
 
          { remove code tree, if not inline procedure }
-         if assigned(code) and (aktprocsym.definition.proccalloption<>pocall_inline) then
+         if assigned(code) and (aktprocdef.proccalloption<>pocall_inline) then
            code.free;
 
          { remove class member symbol tables }
@@ -519,12 +523,12 @@ implementation
            if copy(name,1,3)='val' then
             begin
               s:=Copy(name,4,255);
-              if not(po_assembler in aktprocsym.definition.procoptions) then
+              if not(po_assembler in aktprocdef.procoptions) then
                begin
                  vs:=tvarsym.create(s,vartype);
                  vs.fileinfo:=fileinfo;
                  vs.varspez:=varspez;
-                 aktprocsym.definition.localst.insert(vs);
+                 aktprocdef.localst.insert(vs);
                  include(vs.varoptions,vo_is_local_copy);
                  vs.varstate:=vs_assigned;
                  localvarsym:=vs;
@@ -534,7 +538,7 @@ implementation
                end
               else
                begin
-                 aktprocsym.definition.parast.rename(name,s);
+                 aktprocdef.parast.rename(name,s);
                end;
             end;
          end;
@@ -547,15 +551,17 @@ implementation
         generates the code for it
       }
       var
-        oldprefix     : string;
+        oldprefix        : string;
         oldprocsym       : tprocsym;
+        oldprocdef       : tprocdef;
         oldprocinfo      : pprocinfo;
         oldconstsymtable : tsymtable;
         oldfilepos       : tfileposinfo;
-        pdflags         : word;
-        prevdef,stdef   : tprocdef;
+        pdflags          : word;
+        prevdef,stdef    : tprocdef;
       begin
       { save old state }
+         oldprocdef:=aktprocdef;
          oldprocsym:=aktprocsym;
          oldprefix:=procprefix;
          oldconstsymtable:=constsymtable;
@@ -576,15 +582,15 @@ implementation
 
          parse_proc_dec;
 
-         procinfo^.procdef:=aktprocsym.definition;
+         procinfo^.procdef:=aktprocdef;
 
-      { set the default function options }
+         { set the default function options }
          if parse_only then
           begin
-            aktprocsym.definition.forwarddef:=true;
+            aktprocdef.forwarddef:=true;
             { set also the interface flag, for better error message when the
               implementation doesn't much this header }
-            aktprocsym.definition.interfacedef:=true;
+            aktprocdef.interfacedef:=true;
             pdflags:=pd_interface;
           end
          else
@@ -595,25 +601,25 @@ implementation
             if (not current_module.is_unit) or (cs_create_smart in aktmoduleswitches) then
              pdflags:=pdflags or pd_global;
             procinfo^.exported:=false;
-            aktprocsym.definition.forwarddef:=false;
+            aktprocdef.forwarddef:=false;
           end;
 
-      { parse the directives that may follow }
+         { parse the directives that may follow }
          inc(lexlevel);
          parse_proc_directives(pdflags);
          dec(lexlevel);
 
-      { hint directives, these can be separated by semicolons here,
-        that need to be handled here with a loop (PFV) }
+         { hint directives, these can be separated by semicolons here,
+           that need to be handled here with a loop (PFV) }
          while try_consume_hintdirective(aktprocsym.symoptions) do
           Consume(_SEMICOLON);
 
-      { set aktfilepos to the beginning of the function declaration }
+         { set aktfilepos to the beginning of the function declaration }
          oldfilepos:=aktfilepos;
-         aktfilepos:=aktprocsym.definition.fileinfo;
+         aktfilepos:=aktprocdef.fileinfo;
 
-      { For varargs directive also cdecl and external must be defined }
-         if (po_varargs in aktprocsym.definition.procoptions) then
+         { For varargs directive also cdecl and external must be defined }
+         if (po_varargs in aktprocdef.procoptions) then
           begin
             { check first for external in the interface, if available there
               then the cdecl must also be there since there is no implementation
@@ -621,42 +627,41 @@ implementation
             if parse_only then
              begin
                { if external is available, then cdecl must also be available }
-               if (po_external in aktprocsym.definition.procoptions) and
-                  not(aktprocsym.definition.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+               if (po_external in aktprocdef.procoptions) and
+                  not(aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
                 Message(parser_e_varargs_need_cdecl_and_external);
              end
             else
              begin
                { both must be defined now }
-               if not(po_external in aktprocsym.definition.procoptions) or
-                  not(aktprocsym.definition.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+               if not(po_external in aktprocdef.procoptions) or
+                  not(aktprocdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
                 Message(parser_e_varargs_need_cdecl_and_external);
              end;
           end;
 
-      { search for forward declarations }
-         if not check_identical_proc(prevdef) then
+         { search for forward declarations }
+         if not proc_add_definition(aktprocsym,aktprocdef) then
            begin
-           { A method must be forward defined (in the object declaration) }
-             if assigned(procinfo^._class) and (not assigned(oldprocinfo^._class)) then
+             { A method must be forward defined (in the object declaration) }
+             if assigned(procinfo^._class) and
+                (not assigned(oldprocinfo^._class)) then
               begin
-                Message1(parser_e_header_dont_match_any_member,
-                         aktprocsym.definition.fullprocname);
-                aktprocsym.write_parameter_lists(aktprocsym.definition);
+                Message1(parser_e_header_dont_match_any_member,aktprocdef.fullprocname);
+                aktprocsym.write_parameter_lists(aktprocdef);
               end
              else
               begin
                 { Give a better error if there is a forward def in the interface and only
                   a single implementation }
-                if (not aktprocsym.definition.forwarddef) and
-                   assigned(aktprocsym.definition.nextoverloaded) and
-                   aktprocsym.definition.nextoverloaded.forwarddef and
-                   aktprocsym.definition.nextoverloaded.interfacedef and
-                   not(assigned(aktprocsym.definition.nextoverloaded.nextoverloaded)) then
+                if (not aktprocdef.forwarddef) and
+                   assigned(aktprocsym.defs^.next) and
+                   aktprocsym.defs^.def.forwarddef and
+                   aktprocsym.defs^.def.interfacedef and
+                   not(assigned(aktprocsym.defs^.next^.next)) then
                  begin
-                   Message1(parser_e_header_dont_match_forward,
-                            aktprocsym.definition.fullprocname);
-                   aktprocsym.write_parameter_lists(aktprocsym.definition);
+                   Message1(parser_e_header_dont_match_forward,aktprocdef.fullprocname);
+                   aktprocsym.write_parameter_lists(aktprocdef);
                  end
                 else
                  begin
@@ -669,13 +674,13 @@ implementation
               end;
            end;
 
-         { update procinfo, because the aktprocsym.definition can be
+         { update procinfo, because the aktprocdef can be
            changed by check_identical_proc (PFV) }
-         procinfo^.procdef:=aktprocsym.definition;
+         procinfo^.procdef:=aktprocdef;
 
 {$ifdef i386}
          { add implicit pushes for interrupt routines }
-         if (po_interrupt in aktprocsym.definition.procoptions) then
+         if (po_interrupt in aktprocdef.procoptions) then
            begin
              { we push Flags and CS as long
                to cope with the IRETD
@@ -685,60 +690,63 @@ implementation
 {$endif i386}
 
          { pointer to the return value ? }
-         if ret_in_param(aktprocsym.definition.rettype.def) then
+         if ret_in_param(aktprocdef.rettype.def) then
           begin
             procinfo^.return_offset:=procinfo^.para_offset;
             inc(procinfo^.para_offset,target_info.size_of_pointer);
           end;
          { allows to access the parameters of main functions in nested functions }
-         aktprocsym.definition.parast.address_fixup:=procinfo^.para_offset;
+         aktprocdef.parast.address_fixup:=procinfo^.para_offset;
 
          { when it is a value para and it needs a local copy then rename
            the parameter and insert a copy in the localst. This is not done
            for assembler procedures }
-         if (not parse_only) and (not aktprocsym.definition.forwarddef) then
-           aktprocsym.definition.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkvaluepara);
+         if (not parse_only) and (not aktprocdef.forwarddef) then
+           aktprocdef.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}checkvaluepara);
 
-      { restore file pos }
+         { restore file pos }
          aktfilepos:=oldfilepos;
 
-      { compile procedure when a body is needed }
+         { compile procedure when a body is needed }
          if (pdflags and pd_body)<>0 then
            begin
              Message1(parser_p_procedure_start,
-                      aktprocsym.definition.fullprocname);
-             aktprocsym.definition.aliasnames.insert(aktprocsym.definition.mangledname);
+                      aktprocdef.fullprocname);
+             aktprocdef.aliasnames.insert(aktprocdef.mangledname);
             { set _FAIL as keyword if constructor }
-            if (aktprocsym.definition.proctypeoption=potype_constructor) then
+            if (aktprocdef.proctypeoption=potype_constructor) then
               tokeninfo^[_FAIL].keyword:=m_all;
-            if assigned(aktprocsym.definition._class) then
+            if assigned(aktprocdef._class) then
               tokeninfo^[_SELF].keyword:=m_all;
 
              compile_proc_body(((pdflags and pd_global)<>0),assigned(oldprocinfo^._class));
 
             { reset _FAIL as normal }
-            if (aktprocsym.definition.proctypeoption=potype_constructor) then
+            if (aktprocdef.proctypeoption=potype_constructor) then
               tokeninfo^[_FAIL].keyword:=m_none;
-            if assigned(aktprocsym.definition._class) and (lexlevel=main_program_level) then
+            if assigned(aktprocdef._class) and (lexlevel=main_program_level) then
               tokeninfo^[_SELF].keyword:=m_none;
              consume(_SEMICOLON);
            end;
-      { close }
+         { close }
          codegen_doneprocedure;
-      { Restore old state }
+         { Restore old state }
          constsymtable:=oldconstsymtable;
          { from now on all refernece to mangledname means
            that the function is already used }
-         aktprocsym.definition.count:=true;
+         aktprocdef.count:=true;
+{$ifdef notused}
          { restore the interface order to maintain CRC values PM }
-         if assigned(prevdef) and assigned(aktprocsym.definition.nextoverloaded) then
+         if assigned(prevdef) and assigned(aktprocdef.nextoverloaded) then
            begin
-             stdef:=aktprocsym.definition;
-             aktprocsym.definition:=stdef.nextoverloaded;
+             stdef:=aktprocdef;
+             aktprocdef:=stdef.nextoverloaded;
              stdef.nextoverloaded:=prevdef.nextoverloaded;
              prevdef.nextoverloaded:=stdef;
            end;
+{$endif notused}
          aktprocsym:=oldprocsym;
+         aktprocdef:=oldprocdef;
          procprefix:=oldprefix;
          procinfo:=oldprocinfo;
          otsym:=nil;
@@ -754,11 +762,11 @@ implementation
         procedure Not_supported_for_inline(t : ttoken);
         begin
            if assigned(aktprocsym) and
-              (aktprocsym.definition.proccalloption=pocall_inline) then
+              (aktprocdef.proccalloption=pocall_inline) then
              Begin
                 Message1(parser_w_not_supported_for_inline,tokenstring(t));
                 Message(parser_w_inlining_disabled);
-                aktprocsym.definition.proccalloption:=pocall_fpccall;
+                aktprocdef.proccalloption:=pocall_fpccall;
              End;
         end;
 
@@ -843,7 +851,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.40  2001-10-25 21:22:37  peter
+  Revision 1.41  2001-11-02 22:58:06  peter
+    * procsym definition rewrite
+
+  Revision 1.40  2001/10/25 21:22:37  peter
     * calling convention rewrite
 
   Revision 1.39  2001/10/22 21:20:46  peter

compiler/ptconst.pas

@@ -385,9 +385,21 @@ implementation
                              end;
                              hp:=tbinarynode(hp).left;
                           end;
-                        if tloadnode(hp).symtableentry.typ=constsym then
-                          Message(type_e_variable_id_expected);
-                        curconstSegment.concat(Tai_const_symbol.Createname_offset(tloadnode(hp).symtableentry.mangledname,offset));
+                        srsym:=tloadnode(hp).symtableentry;
+                        case srsym.typ of
+                          procsym :
+                            begin
+                              if assigned(tprocsym(srsym).defs^.next) then
+                                Message(parser_e_no_overloaded_procvars);
+                              curconstSegment.concat(Tai_const_symbol.Createname_offset(tprocsym(srsym).defs^.def.mangledname,offset));
+                            end;
+                          varsym :
+                            curconstSegment.concat(Tai_const_symbol.Createname_offset(tvarsym(srsym).mangledname,offset));
+                          typedconstsym :
+                            curconstSegment.concat(Tai_const_symbol.Createname_offset(ttypedconstsym(srsym).mangledname,offset));
+                          else
+                            Message(type_e_variable_id_expected);
+                        end;
                       end
                     else
                       Message(cg_e_illegal_expression);
@@ -707,7 +719,7 @@ implementation
                  (tloadnode(p).symtableentry.typ=procsym) then
                begin
                  curconstSegment.concat(Tai_const_symbol.createname(
-                   tprocsym(tloadnode(p).symtableentry).definition.mangledname));
+                   tprocsym(tloadnode(p).symtableentry).defs^.def.mangledname));
                end
               else
                Message(cg_e_illegal_expression);
@@ -959,7 +971,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.37  2001-10-29 14:59:48  jonas
+  Revision 1.38  2001-11-02 22:58:06  peter
+    * procsym definition rewrite
+
+  Revision 1.37  2001/10/29 14:59:48  jonas
     * typed constants that are "procedure of object" and which are assigned
       nil require 8 bytes of "0" (not 4)
     * fixed web bug 1655 (reject the code)

compiler/rautils.pas

@@ -726,7 +726,7 @@ Function TOperand.SetupResult:boolean;
 Begin
   SetupResult:=false;
   { replace by correct offset. }
-  if (not is_void(aktprocsym.definition.rettype.def)) then
+  if (not is_void(aktprocdef.rettype.def)) then
    begin
      if (procinfo^.return_offset=0) and ((m_tp in aktmodeswitches) or
         (m_delphi in aktmodeswitches)) then
@@ -738,7 +738,7 @@ Begin
      opr.ref.base:= procinfo^.framepointer;
      opr.ref.options:=ref_parafixup;
      { always assume that the result is valid. }
-     tfuncretsym(aktprocsym.definition.funcretsym).funcretstate:=vs_assigned;
+     tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
      SetupResult:=true;
    end
   else
@@ -853,7 +853,7 @@ Begin
               opr.ref.offset:=tvarsym(sym).address;
               if (lexlevel=tvarsym(sym).owner.symtablelevel) then
                 begin
-                  opr.ref.offsetfixup:=aktprocsym.definition.parast.address_fixup;
+                  opr.ref.offsetfixup:=aktprocdef.parast.address_fixup;
                   opr.ref.options:=ref_parafixup;
                 end
               else
@@ -892,7 +892,7 @@ Begin
                   opr.ref.offset:=-(tvarsym(sym).address);
                   if (lexlevel=tvarsym(sym).owner.symtablelevel) then
                     begin
-                      opr.ref.offsetfixup:=aktprocsym.definition.localst.address_fixup;
+                      opr.ref.offsetfixup:=aktprocdef.localst.address_fixup;
                       opr.ref.options:=ref_localfixup;
                     end
                   else
@@ -974,11 +974,11 @@ Begin
       end;
     procsym :
       begin
-        if assigned(tprocsym(sym).definition.nextoverloaded) then
+        if assigned(tprocsym(sym).defs^.next) then
           Message(asmr_w_calling_overload_func);
         l:=opr.ref.offset;
         opr.typ:=OPR_SYMBOL;
-        opr.symbol:=newasmsymbol(tprocsym(sym).definition.mangledname);
+        opr.symbol:=newasmsymbol(tprocsym(sym).defs^.def.mangledname);
         opr.symofs:=l;
         hasvar:=true;
         SetupVar:=TRUE;
@@ -1581,7 +1581,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.24  2001-09-02 21:18:28  peter
+  Revision 1.25  2001-11-02 22:58:06  peter
+    * procsym definition rewrite
+
+  Revision 1.24  2001/09/02 21:18:28  peter
     * split constsym.value in valueord,valueordptr,valueptr. The valueordptr
       is used for holding target platform pointer values. As those can be
       bigger than the source platform.

compiler/regvars.pas

@@ -71,7 +71,7 @@ implementation
               { walk through all momentary register variables }
               for i:=1 to maxvarregs do
                 begin
-                  with pregvarinfo(aktprocsym.definition.regvarinfo)^ do
+                  with pregvarinfo(aktprocdef.regvarinfo)^ do
                    if ((regvars[i]=nil) or (j>regvars_refs[i])) and (j>0) then
                      begin
                         for k:=maxvarregs-1 downto i do
@@ -110,7 +110,7 @@ implementation
               { walk through all momentary register variables }
               for i:=1 to maxfpuvarregs do
                 begin
-                  with pregvarinfo(aktprocsym.definition.regvarinfo)^ do
+                  with pregvarinfo(aktprocdef.regvarinfo)^ do
                    if ((fpuregvars[i]=nil) or (j>fpuregvars_refs[i])) and (j>0) then
                      begin
                         for k:=maxfpuvarregs-1 downto i do
@@ -162,7 +162,7 @@ implementation
         begin
           new(regvarinfo);
           fillchar(regvarinfo^,sizeof(regvarinfo^),0);
-          aktprocsym.definition.regvarinfo := regvarinfo;
+          aktprocdef.regvarinfo := regvarinfo;
           if (p.registers32<4) then
             begin
               parasym:=false;
@@ -293,7 +293,7 @@ implementation
       regvarinfo: pregvarinfo;
       vsym: tvarsym;
     begin
-      regvarinfo := pregvarinfo(aktprocsym.definition.regvarinfo);
+      regvarinfo := pregvarinfo(aktprocdef.regvarinfo);
       if not assigned(regvarinfo) then
         exit;
       for i := 1 to maxvarregs do
@@ -364,7 +364,7 @@ implementation
       i: longint;
       regvarinfo: pregvarinfo;
     begin
-      regvarinfo := pregvarinfo(aktprocsym.definition.regvarinfo);
+      regvarinfo := pregvarinfo(aktprocdef.regvarinfo);
       if not assigned(regvarinfo) then
         exit;
       reg := reg32(reg);
@@ -379,7 +379,7 @@ implementation
       i: longint;
       regvarinfo: pregvarinfo;
     begin
-      regvarinfo := pregvarinfo(aktprocsym.definition.regvarinfo);
+      regvarinfo := pregvarinfo(aktprocdef.regvarinfo);
       if not assigned(regvarinfo) then
         exit;
       for i := 1 to maxvarregs do
@@ -400,7 +400,7 @@ implementation
       if (cs_regalloc in aktglobalswitches) and
          ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
         begin
-          regvarinfo := pregvarinfo(aktprocsym.definition.regvarinfo);
+          regvarinfo := pregvarinfo(aktprocdef.regvarinfo);
           { can happen when inlining assembler procedures (JM) }
           if not assigned(regvarinfo) then
             exit;
@@ -498,11 +498,11 @@ implementation
     begin
 {$ifdef i386}
       { can happen when inlining assembler procedures (JM) }
-      if not assigned(aktprocsym.definition.regvarinfo) then
+      if not assigned(aktprocdef.regvarinfo) then
         exit;
       if (cs_regalloc in aktglobalswitches) and
          ((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
-        with pregvarinfo(aktprocsym.definition.regvarinfo)^ do
+        with pregvarinfo(aktprocdef.regvarinfo)^ do
           begin
             for i:=1 to maxfpuvarregs do
               if assigned(fpuregvars[i]) then
@@ -520,7 +520,10 @@ end.
 
 {
   $Log$
-  Revision 1.18  2001-08-26 13:36:49  florian
+  Revision 1.19  2001-11-02 22:58:06  peter
+    * procsym definition rewrite
+
+  Revision 1.18  2001/08/26 13:36:49  florian
     * some cg reorganisation
     * some PPC updates
 

compiler/symdef.pas

@@ -461,7 +461,6 @@ interface
        public
           extnumber  : longint;
           messageinf : tmessageinf;
-          nextoverloaded : tprocdef;
 {$ifndef EXTDEBUG}
           { where is this function defined, needed here because there
             is only one symbol for all overloaded functions
@@ -532,6 +531,13 @@ interface
 {$endif GDB}
        end;
 
+       { single linked list of overloaded procs }
+       pprocdeflist = ^tprocdeflist;
+       tprocdeflist = record
+         def  : tprocdef;
+         next : pprocdeflist;
+       end;
+
        tstringdef = class(tstoreddef)
           string_typ : tstringtype;
           len        : longint;
@@ -3221,7 +3227,6 @@ implementation
          deftype:=procdef;
          has_mangledname:=false;
          _mangledname:=nil;
-         nextoverloaded:=nil;
          fileinfo:=aktfilepos;
          extnumber:=-1;
          aliasnames:=tstringlist.create;
@@ -3291,8 +3296,8 @@ implementation
          _mangledname:=stringdup(ppufile.getstring);
 
          extnumber:=ppufile.getlongint;
-         nextoverloaded:=tprocdef(ppufile.getderef);
          _class := tobjectdef(ppufile.getderef);
+         procsym := tsym(ppufile.getderef);
          ppufile.getposinfo(fileinfo);
          { inline stuff }
          if proccalloption=pocall_inline then
@@ -3400,18 +3405,8 @@ implementation
          ppufile.do_interface_crc:=oldintfcrc;
          ppufile.putstring(mangledname);
          ppufile.putlongint(extnumber);
-         if (proctypeoption<>potype_operator) then
-           ppufile.putderef(nextoverloaded)
-         else
-           begin
-              { only write the overloads from the same unit }
-              if assigned(nextoverloaded) and
-                 (nextoverloaded.owner=owner) then
-                ppufile.putderef(nextoverloaded)
-              else
-                ppufile.putderef(nil);
-           end;
          ppufile.putderef(_class);
+         ppufile.putderef(procsym);
          ppufile.putposinfo(fileinfo);
 
          { inline stuff references to localsymtable, no influence
@@ -3648,13 +3643,15 @@ implementation
         oldlocalsymtable : tsymtable;
       begin
          inherited deref;
-         resolvedef(tdef(nextoverloaded));
          resolvedef(tdef(_class));
          { parast }
          oldlocalsymtable:=aktlocalsymtable;
          aktlocalsymtable:=parast;
          tparasymtable(parast).deref;
          aktlocalsymtable:=oldlocalsymtable;
+         { procsym that originaly defined this definition, should be in the
+           same symtable }
+         resolvesym(procsym);
       end;
 
 
@@ -3662,6 +3659,7 @@ implementation
       var
         oldlocalsymtable : tsymtable;
       begin
+         { locals }
          if assigned(localst) then
           begin
             { localst }
@@ -4228,7 +4226,7 @@ implementation
    procedure tobjectdef._searchdestructor(sym : tnamedindexitem);
 
      var
-        p : tprocdef;
+        p : pprocdeflist;
 
      begin
         { if we found already a destructor, then we exit }
@@ -4236,15 +4234,15 @@ implementation
           exit;
         if tsym(sym).typ=procsym then
           begin
-             p:=tprocsym(sym).definition;
+             p:=tprocsym(sym).defs;
              while assigned(p) do
                begin
-                  if p.proctypeoption=potype_destructor then
+                  if p^.def.proctypeoption=potype_destructor then
                     begin
-                       sd:=p;
+                       sd:=p^.def;
                        exit;
                     end;
-                  p:=p.nextoverloaded;
+                  p:=p^.next;
                end;
           end;
      end;
@@ -4349,15 +4347,19 @@ implementation
           para : TParaItem;
           arglength : byte;
           sp : char;
-
+          pdl : pprocdeflist;
       begin
         If tsym(p).typ = procsym then
          begin
-           pd := tprocsym(p).definition;
+           pd := tprocsym(p).defs^.def;
            { this will be used for full implementation of object stabs
            not yet done }
-           ipd := pd;
-           while assigned(ipd.nextoverloaded) do ipd := ipd.nextoverloaded;
+           pdl:=tprocsym(p).defs;
+           while assigned(pdl) do
+            begin
+              ipd:=pdl^.def;
+              pdl:=pdl^.next;
+            end;
            if (po_virtualmethod in pd.procoptions) then
              begin
                lindex := pd.extnumber;
@@ -5394,7 +5396,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.54  2001-10-25 21:22:37  peter
+  Revision 1.55  2001-11-02 22:58:06  peter
+    * procsym definition rewrite
+
+  Revision 1.54  2001/10/25 21:22:37  peter
     * calling convention rewrite
 
   Revision 1.53  2001/10/20 17:21:54  peter

compiler/symsym.pas

@@ -59,7 +59,6 @@ interface
           procedure write(ppufile:tcompilerppufile);virtual;abstract;
           procedure writesym(ppufile:tcompilerppufile);
           procedure deref;override;
-          function  mangledname : string;override;
           procedure insert_in_data;virtual;
 {$ifdef GDB}
           function  stabstring : pchar;virtual;
@@ -73,11 +72,11 @@ interface
           lab     : tasmlabel;
           used,
           defined : boolean;
-          code : pointer; { should be ptree! }
+          code : pointer; { should be tnode }
           constructor create(const n : string; l : tasmlabel);
           destructor destroy;override;
           constructor load(ppufile:tcompilerppufile);
-          function mangledname : string;override;
+          function mangledname : string;
           procedure write(ppufile:tcompilerppufile);override;
        end;
 
@@ -99,24 +98,20 @@ interface
        end;
 
        tprocsym = class(tstoredsym)
-          definition  : tprocdef;
-{$ifdef CHAINPROCSYMS}
-          nextprocsym : tprocsym;
-{$endif CHAINPROCSYMS}
-          is_global   : boolean;
+          defs      : pprocdeflist; { linked list of overloaded procdefs }
+          is_global : boolean;
           constructor create(const n : string);
           constructor load(ppufile:tcompilerppufile);
           destructor destroy;override;
-          function mangledname : string;override;
           { writes all declarations except the specified one }
-          procedure write_parameter_lists(skitdef:tprocdef);
+          procedure write_parameter_lists(skipdef:tprocdef);
           { tests, if all procedures definitions are defined and not }
           { only forward                                             }
           procedure check_forward;
-          procedure order_overloaded;
+          procedure unchain_overload;
           procedure write(ppufile:tcompilerppufile);override;
           procedure deref;override;
-          procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
+          procedure addprocdef(p:tprocdef);
           function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
 {$ifdef GDB}
           function stabstring : pchar;override;
@@ -158,7 +153,7 @@ interface
           procedure write(ppufile:tcompilerppufile);override;
           procedure deref;override;
           procedure setmangledname(const s : string);
-          function  mangledname : string;override;
+          function  mangledname : string;
           procedure insert_in_data;override;
           function  getsize : longint;
           function  getvaluesize : longint;
@@ -218,7 +213,7 @@ interface
           constructor create(const n : string;const tt : ttype);
           constructor load(ppufile:tcompilerppufile);
           procedure deref;override;
-          function  mangledname : string;override;
+          function  mangledname : string;
           procedure write(ppufile:tcompilerppufile);override;
           procedure insert_in_data;override;
 {$ifdef GDB}
@@ -234,7 +229,7 @@ interface
           constructor createtype(const n : string;const tt : ttype;writable : boolean);
           constructor load(ppufile:tcompilerppufile);
           destructor destroy;override;
-          function  mangledname : string;override;
+          function  mangledname : string;
           procedure write(ppufile:tcompilerppufile);override;
           procedure deref;override;
           function  getsize:longint;
@@ -260,7 +255,7 @@ interface
           constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
           constructor load(ppufile:tcompilerppufile);
           destructor  destroy;override;
-          function  mangledname : string;override;
+          function  mangledname : string;
           procedure deref;override;
           procedure write(ppufile:tcompilerppufile);override;
 {$ifdef GDB}
@@ -301,7 +296,7 @@ interface
           constructor create(const n:string;rt:trttitype);
           constructor load(ppufile:tcompilerppufile);
           procedure write(ppufile:tcompilerppufile);override;
-          function  mangledname:string;override;
+          function  mangledname:string;
           function  get_label:tasmsymbol;
        end;
 
@@ -321,10 +316,11 @@ interface
     var
        aktprocsym : tprocsym;      { pointer to the symbol for the
                                      currently be parsed procedure }
+       aktprocdef : tprocdef;
 
-       aktcallprocsym : tprocsym;  { pointer to the symbol for the
-                                     currently be called procedure,
-                                     only set/unset in firstcall }
+       aktcallprocdef : tprocdef;  { pointer to the definition of the
+                                     currently called procedure,
+                                     only set/unset in ncal }
 
        aktvarsym : tvarsym;     { pointer to the symbol for the
                                      currently read var, only used
@@ -512,12 +508,6 @@ implementation
       end;
 
 
-    function tstoredsym.mangledname : string;
-      begin
-         mangledname:=name;
-      end;
-
-
     { for most symbol types there is nothing to do at all }
     procedure tstoredsym.insert_in_data;
       begin
@@ -686,17 +676,25 @@ implementation
       begin
          inherited create(n);
          typ:=procsym;
-         definition:=nil;
+         defs:=nil;
          owner:=nil;
          is_global := false;
       end;
 
 
     constructor tprocsym.load(ppufile:tcompilerppufile);
+      var
+         pd : tprocdef;
       begin
          inherited loadsym(ppufile);
          typ:=procsym;
-         definition:=tprocdef(ppufile.getderef);
+         defs:=nil;
+         repeat
+           pd:=tprocdef(ppufile.getderef);
+           if pd=nil then
+            break;
+           addprocdef(pd);
+         until false;
          is_global := false;
       end;
 
@@ -707,151 +705,132 @@ implementation
       end;
 
 
-    function tprocsym.mangledname : string;
-      begin
-         mangledname:=definition.mangledname;
-      end;
-
-
-    procedure tprocsym.write_parameter_lists(skitdef:tprocdef);
+    procedure tprocsym.write_parameter_lists(skipdef:tprocdef);
       var
-         p : tprocdef;
+         p : pprocdeflist;
       begin
-         p:=definition;
+         p:=defs;
          while assigned(p) do
            begin
-              if p<>skitdef then
-                MessagePos1(p.fileinfo,sym_b_param_list,p.fullprocname);
-              p:=p.nextoverloaded;
+              if p^.def<>skipdef then
+                MessagePos1(p^.def.fileinfo,sym_b_param_list,p^.def.fullprocname);
+              p:=p^.next;
            end;
       end;
 
 
     procedure tprocsym.check_forward;
       var
-         pd : tprocdef;
+         p : pprocdeflist;
       begin
-         pd:=definition;
-         while assigned(pd) do
+         p:=defs;
+         while assigned(p) do
            begin
-              if pd.forwarddef then
+              if (p^.def.procsym=self) and
+                 (p^.def.forwarddef) then
                 begin
-                   MessagePos1(fileinfo,sym_e_forward_not_resolved,pd.fullprocname);
+                   MessagePos1(fileinfo,sym_e_forward_not_resolved,p^.def.fullprocname);
                    { Turn futher error messages off }
-                   pd.forwarddef:=false;
+                   p^.def.forwarddef:=false;
                 end;
-              pd:=pd.nextoverloaded;
-              { do not check defs of operators in other units }
-              if assigned(pd) and (pd.procsym<>self) then
-                pd:=nil;
+              p:=p^.next;
            end;
       end;
 
 
     procedure tprocsym.deref;
       var
-        pd : tprocdef;
+         p : pprocdeflist;
       begin
-         resolvedef(tdef(definition));
-         pd:=definition;
-         while assigned(pd) do
+         p:=defs;
+         while assigned(p) do
            begin
-              pd.procsym:=self;
-              pd:=pd.nextoverloaded;
+             resolvedef(tdef(p^.def));
+             p:=p^.next;
            end;
       end;
 
-    procedure tprocsym.order_overloaded;
-      var firstdef,currdef,lastdef,nextotdef : tprocdef;
+
+    procedure tprocsym.addprocdef(p:tprocdef);
+      var
+        pd : pprocdeflist;
       begin
-         if not assigned(definition) then
-           exit;
-         firstdef:=definition;
-         currdef:=definition;
-         while assigned(currdef) and (currdef.owner=firstdef.owner) do
-           begin
-             currdef.count:=false;
-             currdef:=currdef.nextoverloaded;
-           end;
-         nextotdef:=currdef;
-         definition:=definition.nextoverloaded;
-         firstdef.nextoverloaded:=nil;
-         while (definition<>nextotdef) do
-           begin
-             currdef:=firstdef;
-             lastdef:=definition;
-             definition:=definition.nextoverloaded;
-             if lastdef.mangledname<firstdef.mangledname then
-               begin
-                 lastdef.nextoverloaded:=firstdef;
-                 firstdef:=lastdef;
-               end
-             else
-               begin
-                 while assigned(currdef.nextoverloaded) and
-                    (lastdef.mangledname>currdef.nextoverloaded.mangledname) do
-                   currdef:=currdef.nextoverloaded;
-                 lastdef.nextoverloaded:=currdef.nextoverloaded;
-                 currdef.nextoverloaded:=lastdef;
-               end;
-           end;
-         definition:=firstdef;
-         currdef:=definition;
-         while assigned(currdef) do
-           begin
-             currdef.count:=true;
-             lastdef:=currdef;
-             currdef:=currdef.nextoverloaded;
-           end;
-         lastdef.nextoverloaded:=nextotdef;
+        new(pd);
+        pd^.def:=p;
+        pd^.next:=defs;
+        defs:=pd;
       end;
 
+
     procedure tprocsym.write(ppufile:tcompilerppufile);
+      var
+         p : pprocdeflist;
       begin
          inherited writesym(ppufile);
-         ppufile.putderef(definition);
+         p:=defs;
+         while assigned(p) do
+           begin
+             ppufile.putderef(p^.def);
+             p:=p^.next;
+           end;
+         ppufile.putderef(nil);
          ppufile.writeentry(ibprocsym);
       end;
 
 
-    procedure tprocsym.load_references(ppufile:tcompilerppufile;locals:boolean);
-      (*var
-        prdef,prdef2 : tprocdef;
-        b : byte; *)
-      begin
-         inherited load_references(ppufile,locals);
-         (*prdef:=definition;
-           done in tsymtable.load_browser (PM)
-         { take care about operators !!  }
-         if (current_module^.flags and uf_has_browser) <>0 then
-           while assigned(prdef) and (prdef.owner=definition.owner) do
-             begin
-                b:=ppufile.readentry;
-                if b<>ibdefref then
-                  Message(unit_f_ppu_read_error);
-                prdef2:=tprocdef(readdefref);
-                resolvedef(prdef2);
-                if prdef<>prdef2 then
-                  Message(unit_f_ppu_read_error);
-                prdef.load_references(ppufile);
-                prdef:=prdef.nextoverloaded;
-             end; *)
-      end;
-
     function tprocsym.write_references(ppufile:tcompilerppufile;locals:boolean) : boolean;
       var
-        prdef : tprocdef;
+        p : pprocdeflist;
       begin
          write_references:=false;
          if not inherited write_references(ppufile,locals) then
            exit;
          write_references:=true;
-         prdef:=definition;
-         while assigned(prdef) and (prdef.owner=definition.owner) do
-          begin
-            prdef.write_references(ppufile,locals);
-            prdef:=prdef.nextoverloaded;
-          end;
+         p:=defs;
+         while assigned(p) do
+           begin
+              if (p^.def.procsym=self) then
+                p^.def.write_references(ppufile,locals);
+              p:=p^.next;
+           end;
+      end;
+
+
+    procedure tprocsym.unchain_overload;
+      var
+         p,hp,
+         first,
+         last : pprocdeflist;
+      begin
+         { remove all overloaded procdefs from the
+           procdeflist that are not in the current symtable }
+         first:=nil;
+         last:=nil;
+         p:=defs;
+         while assigned(p) do
+           begin
+              hp:=p^.next;
+              if (p^.def.procsym=self) then
+                begin
+                  { keep in list }
+                  if not assigned(first) then
+                   begin
+                     first:=p;
+                     last:=p;
+                   end
+                  else
+                   last^.next:=p;
+                  last:=p;
+                  p^.next:=nil;
+                end
+              else
+                begin
+                  { remove }
+                  dispose(p);
+                end;
+              p:=hp;
+           end;
+         defs:=first;
       end;
 
 
@@ -877,14 +856,15 @@ implementation
           but this is no true anymore !! PM
         if (owner.symtabletype=localsymtable) and assigned(owner.name) then
          info := ','+name+','+owner.name^;  }
-        if (owner.symtabletype=localsymtable) and assigned(owner.defowner) and
+        if (owner.symtabletype=localsymtable) and
+           assigned(owner.defowner) and
            assigned(tprocdef(owner.defowner).procsym) then
           info := ','+name+','+tprocdef(owner.defowner).procsym.name;
       end;
-     stabsstr:=definition.mangledname;
+     stabsstr:=defs^.def.mangledname;
      getmem(p,length(stabsstr)+255);
      strpcopy(p,'"'+obj+':'+RetType
-           +tstoreddef(definition.rettype.def).numberstring+info+'",'+tostr(n_function)
+           +tstoreddef(defs^.def.rettype.def).numberstring+info+'",'+tostr(n_function)
            +',0,'+
            tostr(aktfilepos.line)
            +',');
@@ -895,18 +875,18 @@ implementation
 
     procedure tprocsym.concatstabto(asmlist : taasmoutput);
     begin
-      if (definition.proccalloption=pocall_internproc) then exit;
+      if (defs^.def.proccalloption=pocall_internproc) then exit;
       if not isstabwritten then
         asmList.concat(Tai_stabs.Create(stabstring));
       isstabwritten := true;
-      if assigned(definition.parast) then
-        tstoredsymtable(definition.parast).concatstabto(asmlist);
+      if assigned(defs^.def.parast) then
+        tstoredsymtable(defs^.def.parast).concatstabto(asmlist);
       { local type defs and vars should not be written
         inside the main proc stab }
-      if assigned(definition.localst) and
+      if assigned(defs^.def.localst) and
          (lexlevel>main_program_level) then
-        tstoredsymtable(definition.localst).concatstabto(asmlist);
-      definition.is_def_stab_written := written;
+        tstoredsymtable(defs^.def.localst).concatstabto(asmlist);
+      defs^.def.is_def_stab_written := written;
     end;
 {$endif GDB}
 
@@ -1219,7 +1199,14 @@ implementation
       begin
          case abstyp of
            tovar :
-             mangledname:=ref.mangledname;
+             begin
+               case ref.typ of
+                 varsym :
+                   mangledname:=tvarsym(ref).mangledname;
+                 else
+                   internalerror(200111011);
+               end;
+             end;
            toasm :
              mangledname:=asmname^;
            toaddr :
@@ -2490,7 +2477,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.25  2001-10-25 21:22:40  peter
+  Revision 1.26  2001-11-02 22:58:08  peter
+    * procsym definition rewrite
+
+  Revision 1.25  2001/10/25 21:22:40  peter
     * calling convention rewrite
 
   Revision 1.24  2001/10/23 21:49:43  peter

compiler/symtable.pas

@@ -61,7 +61,7 @@ interface
           procedure resetstab(p : TNamedIndexItem);
           procedure concattypestab(p : TNamedIndexItem);
 {$endif}
-          procedure order_overloads(p : TNamedIndexItem);
+          procedure unchain_overloads(p : TNamedIndexItem);
           procedure loaddefs(ppufile:tcompilerppufile);
           procedure loadsyms(ppufile:tcompilerppufile);
           procedure writedefs(ppufile:tcompilerppufile);
@@ -82,9 +82,7 @@ interface
           procedure check_forwards;
           procedure checklabels;
           function  needs_init_final : boolean;
-{$ifdef CHAINPROCSYMS}
-          procedure chainprocsyms;
-{$endif CHAINPROCSYMS}
+          procedure unchain_overloaded;
           procedure chainoperators;
 {$ifdef GDB}
           procedure concatstabto(asmlist : taasmoutput);virtual;
@@ -605,16 +603,13 @@ implementation
         hp:=tstoredsym(inherited speedsearch(s,speedvalue));
         if assigned(hp) then
          begin
-           { reject non static members in static procedures,
-             be carefull aktprocsym.definition is not allways
-             loaded already (PFV) }
+           { reject non static members in static procedures }
            if (symtabletype=objectsymtable) and
               not(sp_static in hp.symoptions) and
-              allow_only_static
-              {assigned(aktprocsym) and
-              assigned(aktprocsym.definition) and
-              ((aktprocsym.definition.options and postaticmethod)<>0)} then
-                  Message(sym_e_only_static_in_static);
+              allow_only_static then
+             Message(sym_e_only_static_in_static);
+
+           { unit uses count }
            if (unitid<>0) and
               (symtabletype = globalsymtable) and
               assigned(tglobalsymtable(self).unitsym) then
@@ -625,7 +620,10 @@ implementation
              this might be the cause of the class debug problems
              as TCHILDCLASS.Create did not generate appropriate
              stabs debug info if TCHILDCLASS wasn't used anywhere else PM }
-           if (hp.typ=typesym) and make_ref then
+{$warning TODO: turn on debuginfo check}
+           if // (cs_debuginfo in aktmoduleswitches) and
+              (hp.typ=typesym) and
+              make_ref then
              begin
                if assigned(ttypesym(hp).restype.def) then
                  tstoreddef(ttypesym(hp).restype.def).numberstring
@@ -633,6 +631,7 @@ implementation
                  ttypesym(hp).isusedinstab:=true;
              end;
 {$endif GDB}
+
            { unitsym are only loaded for browsing PM    }
            { this was buggy anyway because we could use }
            { unitsyms from other units in _USES !!      }
@@ -640,7 +639,8 @@ implementation
               assigned(current_module) and (current_module.globalsymtable<>.load) then
              hp:=nil;}
            if assigned(hp) and
-              (cs_browser in aktmoduleswitches) and make_ref then
+              make_ref and
+              (cs_browser in aktmoduleswitches) then
              begin
                 newref:=tref.create(hp.lastref,@akttokenpos);
                 { for symbols that are in tables without
@@ -798,10 +798,10 @@ implementation
       end;
 
 
-    procedure tstoredsymtable.order_overloads(p : TNamedIndexItem);
+    procedure tstoredsymtable.unchain_overloads(p : TNamedIndexItem);
       begin
          if tsym(p).typ=procsym then
-           tprocsym(p).order_overloaded;
+           tprocsym(p).unchain_overload;
       end;
 
 {$ifdef GDB}
@@ -870,6 +870,7 @@ implementation
     procedure tstoredsymtable.chainoperators;
       var
         p : tprocsym;
+        pd : pprocdeflist;
         t : ttoken;
         def : tprocdef;
         srsym : tsym;
@@ -900,30 +901,24 @@ implementation
                     begin
                        if (srsym.typ<>procsym) then
                          internalerror(12344321);
-                       if assigned(p) then
-                         begin
-{$ifdef CHAINPROCSYMS}
-                           p.nextprocsym:=tprocsym(srsym);
-{$endif CHAINPROCSYMS}
-                           def.nextoverloaded:=tprocsym(srsym).definition;
-                         end
+                       { use this procsym as start ? }
+                       if not assigned(overloaded_operators[t]) then
+                        overloaded_operators[t]:=tprocsym(srsym)
                        else
-                         overloaded_operators[t]:=tprocsym(srsym);
-                       p:=tprocsym(srsym);
-                       def:=p.definition;
-                       while assigned(def.nextoverloaded) and
-                         (def.nextoverloaded.owner=p.owner) do
-                         def:=def.nextoverloaded;
-                       def.nextoverloaded:=nil;
+                        begin
+                          { already got a procsym, only add defs of the current procsym }
+                          pd:=tprocsym(srsym).defs;
+                          while assigned(pd) do
+                           begin
+                             overloaded_operators[t].addprocdef(pd^.def);
+                             pd:=pd^.next;
+                           end;
+                        end;
                        symtablestack:=srsym.owner.next;
                     end
                   else
                     begin
                       symtablestack:=nil;
-{$ifdef CHAINPROCSYMS}
-                      if assigned(p) then
-                        p.nextprocsym:=nil;
-{$endif CHAINPROCSYMS}
                     end;
                   { search for same procsym in other units }
                 end;
@@ -969,12 +964,10 @@ implementation
       end;
 
 
-{$ifdef CHAINPROCSYMS}
-    procedure tstoredsymtable.chainprocsyms;
+    procedure tstoredsymtable.unchain_overloaded;
       begin
-         foreach({$ifdef FPCPROCVAR}@{$endif}chainprocsym);
+         foreach({$ifdef FPCPROCVAR}@{$endif}unchain_overloads);
       end;
-{$endif CHAINPROCSYMS}
 
 
 {$ifdef GDB}
@@ -1025,9 +1018,6 @@ implementation
          oldtyp:=ppufile.entrytyp;
          ppufile.entrytyp:=subentryid;
 
-         { order procsym overloads }
-         foreach({$ifdef FPCPROCVAR}@{$endif}Order_overloads);
-
          inherited write(ppufile);
 
          ppufile.entrytyp:=oldtyp;
@@ -1189,9 +1179,6 @@ implementation
          oldtyp:=ppufile.entrytyp;
          ppufile.entrytyp:=subentryid;
 
-         { order procsym overloads }
-         foreach({$ifdef FPCPROCVAR}@{$endif}Order_overloads);
-
          { write definitions }
          writedefs(ppufile);
          { write symbols }
@@ -1468,9 +1455,6 @@ implementation
       begin
         aktstaticsymtable:=self;
 
-        { order procsym overloads }
-        foreach({$ifdef FPCPROCVAR}@{$endif}Order_overloads);
-
         inherited write(ppufile);
       end;
 
@@ -1597,9 +1581,6 @@ implementation
 
     procedure tglobalsymtable.write(ppufile:tcompilerppufile);
       begin
-        { order procsym overloads }
-        foreach({$ifdef FPCPROCVAR}@{$endif}Order_overloads);
-
         { write the symtable entries }
         inherited write(ppufile);
 
@@ -2104,7 +2085,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.47  2001-10-12 20:27:43  jonas
+  Revision 1.48  2001-11-02 22:58:08  peter
+    * procsym definition rewrite
+
+  Revision 1.47  2001/10/12 20:27:43  jonas
     * fixed crashing bug in unit reference counting
 
   Revision 1.46  2001/09/30 21:29:47  peter

compiler/symtype.pas

@@ -91,7 +91,6 @@ interface
          function  realname:string;
          procedure deref;virtual;abstract;
          function  gettypedef:tdef;virtual;
-         function  mangledname : string;virtual;abstract;
       end;
 
 {************************************************
@@ -518,7 +517,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.10  2001-10-21 12:33:07  peter
+  Revision 1.11  2001-11-02 22:58:08  peter
+    * procsym definition rewrite
+
+  Revision 1.10  2001/10/21 12:33:07  peter
     * array access for properties added
 
   Revision 1.9  2001/08/30 20:13:57  peter

compiler/targets/t_beos.pas

@@ -80,7 +80,7 @@ begin
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
-    aktprocsym.definition.setmangledname(name)
+    aktprocdef.setmangledname(name)
   else
     message(parser_e_empty_import_name);
 end;
@@ -161,15 +161,21 @@ begin
   hp2:=texported_item(current_module._exports.first);
   while assigned(hp2) do
    begin
-     if not hp2.is_var then
+     if (not hp2.is_var) and
+        (hp2.sym.typ=procsym) then
       begin
+        { the manglednames can already be the same when the procedure
+          is declared with cdecl }
+        if tprocsym(hp2.sym).defs^.def.mangledname<>hp2.name^ then
+         begin
 {$ifdef i386}
-        { place jump in codesegment }
-        codesegment.concat(Tai_align.Create_op(4,$90));
-        codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
-        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym.mangledname)));
-        codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
+           { place jump in codesegment }
+           codesegment.concat(Tai_align.Create_op(4,$90));
+           codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
+           codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(tprocsym(hp2.sym).defs^.def.mangledname)));
+           codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
 {$endif i386}
+         end;
       end
      else
       Message1(parser_e_no_export_of_variables_for_target,'beos');
@@ -529,7 +535,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.9  2001-10-12 16:05:34  peter
+  Revision 1.10  2001-11-02 22:58:11  peter
+    * procsym definition rewrite
+
+  Revision 1.9  2001/10/12 16:05:34  peter
     * system lib search fixed (merged)
 
   Revision 1.8  2001/09/18 11:32:00  michael

compiler/targets/t_fbsd.pas

@@ -82,7 +82,7 @@ begin
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
-    aktprocsym.definition.setmangledname(name)
+    aktprocdef.setmangledname(name)
   else
     message(parser_e_empty_import_name);
 end;
@@ -163,15 +163,21 @@ begin
   hp2:=texported_item(current_module._exports.first);
   while assigned(hp2) do
    begin
-     if not hp2.is_var then
+     if (not hp2.is_var) and
+        (hp2.sym.typ=procsym) then
       begin
+        { the manglednames can already be the same when the procedure
+          is declared with cdecl }
+        if tprocsym(hp2.sym).defs^.def.mangledname<>hp2.name^ then
+         begin
 {$ifdef i386}
-        { place jump in codesegment }
-        codeSegment.concat(Tai_align.Create_op(4,$90));
-        codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
-        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym.mangledname)));
-        codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
+           { place jump in codesegment }
+           codesegment.concat(Tai_align.Create_op(4,$90));
+           codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
+           codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(tprocsym(hp2.sym).defs^.def.mangledname)));
+           codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
 {$endif i386}
+         end;
       end
      else
       Message1(parser_e_no_export_of_variables_for_target,'freebsd');
@@ -710,7 +716,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.12  2001-09-18 11:32:00  michael
+  Revision 1.13  2001-11-02 22:58:11  peter
+    * procsym definition rewrite
+
+  Revision 1.12  2001/09/18 11:32:00  michael
   * Fixes win32 linking problems with import libraries
   * LINKLIB Libraries are now looked for using C file extensions
   * get_exepath fix

compiler/targets/t_linux.pas

@@ -81,7 +81,7 @@ begin
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
-    aktprocsym.definition.setmangledname(name)
+    aktprocdef.setmangledname(name)
   else
     message(parser_e_empty_import_name);
 end;
@@ -162,17 +162,18 @@ begin
   hp2:=texported_item(current_module._exports.first);
   while assigned(hp2) do
    begin
-     if not hp2.is_var then
+     if (not hp2.is_var) and
+        (hp2.sym.typ=procsym) then
       begin
         { the manglednames can already be the same when the procedure
           is declared with cdecl }
-        if hp2.sym.mangledname<>hp2.name^ then
+        if tprocsym(hp2.sym).defs^.def.mangledname<>hp2.name^ then
          begin
 {$ifdef i386}
            { place jump in codesegment }
            codesegment.concat(Tai_align.Create_op(4,$90));
            codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
-           codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym.mangledname)));
+           codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(tprocsym(hp2.sym).defs^.def.mangledname)));
            codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
 {$endif i386}
          end;
@@ -739,7 +740,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.13  2001-09-18 11:32:00  michael
+  Revision 1.14  2001-11-02 22:58:12  peter
+    * procsym definition rewrite
+
+  Revision 1.13  2001/09/18 11:32:00  michael
   * Fixes win32 linking problems with import libraries
   * LINKLIB Libraries are now looked for using C file extensions
   * get_exepath fix

compiler/targets/t_nwm.pas

@@ -133,7 +133,7 @@ begin
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
-    aktprocsym.definition.setmangledname(name)
+    aktprocdef.setmangledname(name)
   else
     message(parser_e_empty_import_name);
 end;
@@ -220,15 +220,21 @@ begin
   hp2:=texported_item(current_module._exports.first);
   while assigned(hp2) do
    begin
-     if not hp2.is_var then
+     if (not hp2.is_var) and
+        (hp2.sym.typ=procsym) then
       begin
+        { the manglednames can already be the same when the procedure
+          is declared with cdecl }
+        if tprocsym(hp2.sym).defs^.def.mangledname<>hp2.name^ then
+         begin
 {$ifdef i386}
-        { place jump in codesegment }
-        codeSegment.concat(Tai_align.Create_op(4,$90));
-        codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
-        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym.mangledname)));
-        codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
+           { place jump in codesegment }
+           codesegment.concat(Tai_align.Create_op(4,$90));
+           codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
+           codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(tprocsym(hp2.sym).defs^.def.mangledname)));
+           codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
 {$endif i386}
+         end;
       end
      else
       Comment(V_Error,'Exporting of variables is not supported under netware');
@@ -532,7 +538,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.11  2001-09-18 11:32:00  michael
+  Revision 1.12  2001-11-02 22:58:12  peter
+    * procsym definition rewrite
+
+  Revision 1.11  2001/09/18 11:32:00  michael
   * Fixes win32 linking problems with import libraries
   * LINKLIB Libraries are now looked for using C file extensions
   * get_exepath fix

compiler/targets/t_sunos.pas

@@ -90,7 +90,7 @@ begin
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { do nothing with the procedure, only set the mangledname }
   if name<>'' then
-    aktprocsym.definition.setmangledname(name)
+    aktprocdef.setmangledname(name)
   else
     message(parser_e_empty_import_name);
 end;
@@ -177,15 +177,21 @@ begin
   hp2:=texported_item(current_module._exports.first);
   while assigned(hp2) do
    begin
-     if not hp2.is_var then
+     if (not hp2.is_var) and
+        (hp2.sym.typ=procsym) then
       begin
+        { the manglednames can already be the same when the procedure
+          is declared with cdecl }
+        if tprocsym(hp2.sym).defs^.def.mangledname<>hp2.name^ then
+         begin
 {$ifdef i386}
-        { place jump in codesegment }
-        codesegment.concat(Tai_align.Create_op(4,$90));
-        codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
-        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym.mangledname)));
-        codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
+           { place jump in codesegment }
+           codesegment.concat(Tai_align.Create_op(4,$90));
+           codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
+           codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(tprocsym(hp2.sym).defs^.def.mangledname)));
+           codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
 {$endif i386}
+         end;
       end
      else
       Message1(parser_e_no_export_of_variables_for_target,'SunOS');
@@ -555,7 +561,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.12  2001-09-18 11:32:00  michael
+  Revision 1.13  2001-11-02 22:58:12  peter
+    * procsym definition rewrite
+
+  Revision 1.12  2001/09/18 11:32:00  michael
   * Fixes win32 linking problems with import libraries
   * LINKLIB Libraries are now looked for using C file extensions
   * get_exepath fix

compiler/targets/t_win32.pas

@@ -37,6 +37,7 @@ implementation
 {$endif Delphi}
        cutils,cclasses,
        aasm,fmodule,globtype,globals,systems,verbose,
+       symconst,symsym,
        script,gendef,
        cpubase,cpuasm,
 {$ifdef GDB}
@@ -709,7 +710,14 @@ implementation
                    address_table.concat(Tai_const.Create_32bit(0));
                    inc(current_index);
                 end;
-              address_table.concat(Tai_const_symbol.Createname_rva(hp.sym.mangledname));
+              case hp.sym.typ of
+                varsym :
+                  address_table.concat(Tai_const_symbol.Createname_rva(tvarsym(hp.sym).mangledname));
+                typedconstsym :
+                  address_table.concat(Tai_const_symbol.Createname_rva(ttypedconstsym(hp.sym).mangledname));
+                procsym :
+                  address_table.concat(Tai_const_symbol.Createname_rva(tprocsym(hp.sym).defs^.def.mangledname));
+              end;
               inc(current_index);
               hp:=texported_item(hp.next);
            end;
@@ -728,13 +736,24 @@ implementation
     procedure texportlibwin32.generatenasmlib;
       var
          hp : texported_item;
-         p : pchar;
+         p  : pchar;
+         s  : string;
       begin
          exportssection.concat(tai_section.create(sec_code));
          hp:=texported_item(current_module._exports.first);
          while assigned(hp) do
            begin
-             p:=strpnew(#9+'export '+hp.sym.mangledname+' '+hp.name^+' '+tostr(hp.index));
+             case hp.sym.typ of
+               varsym :
+                 s:=tvarsym(hp.sym).mangledname;
+               typedconstsym :
+                 s:=ttypedconstsym(hp.sym).mangledname;
+               procsym :
+                 s:=tprocsym(hp.sym).defs^.def.mangledname;
+               else
+                 s:='';
+             end;
+             p:=strpnew(#9+'export '+s+' '+hp.name^+' '+tostr(hp.index));
              exportssection.concat(tai_direct.create(p));
              hp:=texported_item(hp.next);
            end;
@@ -783,8 +802,7 @@ Var
   HPath   : TStringListItem;
   s,s2    : string;
   i       : integer;
-  linklibc,
-  found   : boolean;
+  linklibc : boolean;
 begin
   WriteResponseFile:=False;
   linklibc:=false;
@@ -1585,7 +1603,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.20  2001-10-12 16:06:27  peter
+  Revision 1.21  2001-11-02 22:58:12  peter
+    * procsym definition rewrite
+
+  Revision 1.20  2001/10/12 16:06:27  peter
     * duplicate imports fix for gdb (merged)
 
   Revision 1.19  2001/09/30 21:29:47  peter

compiler/types.pas

@@ -246,7 +246,7 @@ implementation
 
     uses
        globtype,globals,systems,tokens,verbose,
-       symconst,symtable,nld;
+       symconst,symtable;
 
 
     function needs_prop_entry(sym : tsym) : boolean;
@@ -450,18 +450,18 @@ implementation
 
     function get_proc_2_procvar_def(p:tprocsym;d:tprocvardef):tprocdef;
       var
-        matchprocdef,
-        currprocdef : tprocdef;
+        matchprocdef : tprocdef;
+        pd : pprocdeflist;
       begin
         { This function will return the pprocdef of pprocsym that
           is the best match for procvardef. When there are multiple
           matches it returns nil }
         { exact match }
-        currprocdef:=p.definition;
         matchprocdef:=nil;
-        while assigned(currprocdef) do
+        pd:=p.defs;
+        while assigned(pd) do
          begin
-           if proc_to_procvar_equal(currprocdef,d,true) then
+           if proc_to_procvar_equal(pd^.def,d,true) then
             begin
               { already found a match ? Then stop and return nil }
               if assigned(matchprocdef) then
@@ -469,18 +469,18 @@ implementation
                  matchprocdef:=nil;
                  break;
                end;
-              matchprocdef:=currprocdef;
+              matchprocdef:=pd^.def;
             end;
-           currprocdef:=currprocdef.nextoverloaded;
+           pd:=pd^.next;
          end;
         { convertable match, if no exact match was found }
         if not assigned(matchprocdef) and
-           not assigned(currprocdef) then
+           not assigned(pd) then
          begin
-           currprocdef:=p.definition;
-           while assigned(currprocdef) do
+           pd:=p.defs;
+           while assigned(pd) do
             begin
-              if proc_to_procvar_equal(currprocdef,d,false) then
+              if proc_to_procvar_equal(pd^.def,d,false) then
                begin
                  { already found a match ? Then stop and return nil }
                  if assigned(matchprocdef) then
@@ -488,9 +488,9 @@ implementation
                     matchprocdef:=nil;
                     break;
                   end;
-                 matchprocdef:=currprocdef;
+                 matchprocdef:=pd^.def;
                end;
-              currprocdef:=currprocdef.nextoverloaded;
+              pd:=pd^.next;
             end;
          end;
         get_proc_2_procvar_def:=matchprocdef;
@@ -1252,51 +1252,50 @@ implementation
 
     function assignment_overloaded(from_def,to_def : tdef) : tprocdef;
        var
-          passproc : tprocdef;
+          passprocs : pprocdeflist;
           convtyp : tconverttype;
        begin
           assignment_overloaded:=nil;
-          if assigned(overloaded_operators[_ASSIGNMENT]) then
-            passproc:=overloaded_operators[_ASSIGNMENT].definition
-          else
+          if not assigned(overloaded_operators[_ASSIGNMENT]) then
             exit;
 
           { look for an exact match first }
-          while passproc<>nil do
+          passprocs:=overloaded_operators[_ASSIGNMENT].defs;
+          while assigned(passprocs) do
             begin
-              if is_equal(passproc.rettype.def,to_def) and
-                (TParaItem(passproc.Para.first).paratype.def=from_def) then
+              if is_equal(passprocs^.def.rettype.def,to_def) and
+                (TParaItem(passprocs^.def.Para.first).paratype.def=from_def) then
                 begin
-                   assignment_overloaded:=passproc;
+                   assignment_overloaded:=passprocs^.def;
                    exit;
                 end;
-              passproc:=passproc.nextoverloaded;
+              passprocs:=passprocs^.next;
             end;
 
-          passproc:=overloaded_operators[_ASSIGNMENT].definition;
           { .... then look for an equal match }
-          while passproc<>nil do
+          passprocs:=overloaded_operators[_ASSIGNMENT].defs;
+          while assigned(passprocs) do
             begin
-              if is_equal(passproc.rettype.def,to_def) and
-                 is_equal(TParaItem(passproc.Para.first).paratype.def,from_def) then
+              if is_equal(passprocs^.def.rettype.def,to_def) and
+                 is_equal(TParaItem(passprocs^.def.Para.first).paratype.def,from_def) then
                 begin
-                   assignment_overloaded:=passproc;
+                   assignment_overloaded:=passprocs^.def;
                    exit;
                 end;
-              passproc:=passproc.nextoverloaded;
+              passprocs:=passprocs^.next;
             end;
 
-          passproc:=overloaded_operators[_ASSIGNMENT].definition;
           {  .... then for convert level 1 }
-          while passproc<>nil do
+          passprocs:=overloaded_operators[_ASSIGNMENT].defs;
+          while assigned(passprocs) do
             begin
-              if is_equal(passproc.rettype.def,to_def) and
-               (isconvertable(from_def,TParaItem(passproc.Para.first).paratype.def,convtyp,ordconstn,false)=1) then
+              if is_equal(passprocs^.def.rettype.def,to_def) and
+                 (isconvertable(from_def,TParaItem(passprocs^.def.Para.first).paratype.def,convtyp,ordconstn,false)=1) then
                 begin
-                   assignment_overloaded:=passproc;
+                   assignment_overloaded:=passprocs^.def;
                    exit;
                 end;
-              passproc:=passproc.nextoverloaded;
+              passprocs:=passprocs^.next;
             end;
        end;
 
@@ -1859,7 +1858,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.54  2001-10-28 17:22:25  peter
+  Revision 1.55  2001-11-02 22:58:09  peter
+    * procsym definition rewrite
+
+  Revision 1.54  2001/10/28 17:22:25  peter
     * allow assignment of overloaded procedures to procvars when we know
       which procedure to take
 

compiler/utils/ppudump.pp

@@ -378,12 +378,37 @@ end;
 
 
 procedure readsymlist(const s:string);
+type
+  tsltype = (sl_none,
+    sl_load,
+    sl_call,
+    sl_subscript,
+    sl_vec
+  );
+const
+  slstr : array[tsltype] of string[9] = ('',
+    'load',
+    'call',
+    'subscript',
+    'vec'
+  );
+var
+  sl : tsltype;
 begin
   readdefref;
   repeat
-    write(s);
-    if not readsymref then
+    sl:=tsltype(ppufile.getbyte);
+    if sl=sl_none then
      break;
+    write(s,'(',slstr[sl],') ');
+    case sl of
+      sl_call,
+      sl_load,
+      sl_subscript :
+        readsymref;
+      sl_vec :
+        writeln(ppufile.getlongint);
+    end;
   until false;
 end;
 
@@ -391,17 +416,20 @@ end;
 { Read abstract procdef and return if inline procdef }
 type
   tproccalloption=(pocall_none,
-    pocall_clearstack,    { Use IBM flat calling convention. (Used by GCC.) }
-    pocall_leftright,     { Push parameters from left to right }
     pocall_cdecl,         { procedure uses C styled calling }
-    pocall_register,      { procedure uses register (fastcall) calling }
-    pocall_stdcall,       { procedure uses stdcall call }
-    pocall_safecall,      { safe call calling conventions }
-    pocall_palmossyscall, { procedure is a PalmOS system call }
-    pocall_system,
+    pocall_cppdecl,       { C++ calling conventions }
+    pocall_compilerproc,  { Procedure is used for internal compiler calls }
+    pocall_far16,         { Far16 for OS/2 }
+    pocall_fpccall,       { FPC default calling }
     pocall_inline,        { Procedure is an assembler macro }
+    pocall_internconst,   { procedure has constant evaluator intern }
     pocall_internproc,    { Procedure has compiler magic}
-    pocall_internconst    { procedure has constant evaluator intern }
+    pocall_palmossyscall, { procedure is a PalmOS system call }
+    pocall_pascal,        { pascal standard left to right }
+    pocall_register,      { procedure uses register (fastcall) calling }
+    pocall_safecall,      { safe call calling conventions }
+    pocall_stdcall,       { procedure uses stdcall call }
+    pocall_system         { system call }
   );
   tproccalloptions=set of tproccalloption;
   tproctypeoption=(potype_none,
@@ -434,7 +462,7 @@ type
     po_varargs            { printf like arguments }
   );
   tprocoptions=set of tprocoption;
-function read_abstract_proc_def:tproccalloptions;
+function read_abstract_proc_def:tproccalloption;
 type
   tproccallopt=record
     mask : tproccalloption;
@@ -449,21 +477,22 @@ type
     str  : string[30];
   end;
 const
-  proccallopts=12;
-  proccallopt : array[1..proccallopts] of tproccallopt=(
-     (mask:pocall_none;         str:''),
-     (mask:pocall_clearstack;   str:'ClearStack'),
-     (mask:pocall_leftright;    str:'LeftRight'),
-     (mask:pocall_cdecl;        str:'Cdecl'),
-     (mask:pocall_register;     str:'Register'),
-     (mask:pocall_stdcall;      str:'StdCall'),
-     (mask:pocall_safecall;     str:'SafeCall'),
-     (mask:pocall_palmossyscall;str:'PalmOSSysCall'),
-     (mask:pocall_system;       str:'System'),
-     (mask:pocall_inline;       str:'Inline'),
-     (mask:pocall_internproc;   str:'InternProc'),
-     (mask:pocall_internconst;  str:'InternConst')
-  );
+  proccalloptionStr : array[tproccalloption] of string[14]=('',
+     'CDecl',
+     'CPPDecl',
+     'CompilerProc',
+     'Far16',
+     'FPCCall',
+     'Inline',
+     'InternConst',
+     'InternProc',
+     'PalmOSSysCall',
+     'Pascal',
+     'Register',
+     'SafeCall',
+     'StdCall',
+     'System'
+   );
   proctypeopts=6;
   proctypeopt : array[1..proctypeopts] of tproctypeopt=(
      (mask:potype_proginit;    str:'ProgInit'),
@@ -494,10 +523,10 @@ const
      (mask:po_overload;        str:'Overload'),
      (mask:po_varargs;         str:'VarArgs')
   );
-  tvarspez : array[0..2] of string[5]=('Value','Const','Var  ');
+  tvarspez : array[0..3] of string[5]=('Value','Const','Var  ','Out  ');
 var
   proctypeoption  : tproctypeoption;
-  proccalloptions : tproccalloptions;
+  proccalloption  : tproccalloption;
   procoptions     : tprocoptions;
   i,params : longint;
   first    : boolean;
@@ -505,7 +534,7 @@ begin
   write(space,'      Return type : ');
   readtype;
   writeln(space,'         Fpu used : ',ppufile.getbyte);
-  proctypeoption:=tproctypeoption(ppufile.getlongint);
+  proctypeoption:=tproctypeoption(ppufile.getbyte);
   if proctypeoption<>potype_none then
    begin
      write(space,'       TypeOption : ');
@@ -521,23 +550,9 @@ begin
        end;
      writeln;
    end;
-  ppufile.getsmallset(proccalloptions);
-  read_abstract_proc_def:=proccalloptions;
-  if proccalloptions<>[] then
-   begin
-     write(space,'      CallOptions : ');
-     first:=true;
-     for i:=1to proccallopts do
-      if (proccallopt[i].mask in proccalloptions) then
-       begin
-         if first then
-           first:=false
-         else
-           write(', ');
-         write(proccallopt[i].str);
-       end;
-     writeln;
-   end;
+  proccalloption:=tproccalloption(ppufile.getbyte);
+  read_abstract_proc_def:=proccalloption;
+  writeln(space,'       CallOption : ',proccalloptionStr[proccalloption]);
   ppufile.getsmallset(procoptions);
   if procoptions<>[] then
    begin
@@ -713,8 +728,9 @@ begin
          ibprocsym :
            begin
              readcommonsym('Procedure symbol ');
-             write(space,'  Definition: ');
-             readdefref;
+             repeat
+               write(space,'  Definition: ');
+             until not readdefref;
            end;
 
          ibconstsym :
@@ -933,7 +949,7 @@ var
   oldread_member : boolean;
   totaldefs,l,j,
   defcnt : longint;
-  calloption : tproccalloptions;
+  calloption : tproccalloption;
 begin
   defcnt:=0;
   with ppufile do
@@ -1016,13 +1032,13 @@ begin
              writeln(space,'    Used Register : ',getbyte);
              writeln(space,'     Mangled name : ',getstring);
              writeln(space,'           Number : ',getlongint);
-             write  (space,'             Next : ');
-             readdefref;
              write  (space,'            Class : ');
              readdefref;
+             write  (space,'          Procsym : ');
+             readsymref;
              write  (space,'         File Pos : ');
              readposinfo;
-             if (pocall_inline in calloption) then
+             if (calloption=pocall_inline) then
               begin
                 write  (space,'       FuncretSym : ');
                 readdefref;
@@ -1032,7 +1048,7 @@ begin
              readdefinitions(false);
              readsymbols;
              { localst }
-             if (pocall_inline in calloption) or
+             if (calloption=pocall_inline) or
                 ((ppufile.header.flags and uf_local_browser) <> 0) then
               begin
                 readdefinitions(false);
@@ -1627,7 +1643,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  2001-09-22 04:52:27  carl
+  Revision 1.9  2001-11-02 22:58:12  peter
+    * procsym definition rewrite
+
+  Revision 1.8  2001/09/22 04:52:27  carl
   * updated targets
 
   Revision 1.7  2001/08/30 20:55:02  peter