* funcret moved from tprocinfo to tprocdef

compiler/hcodegen.pas

@@ -56,15 +56,8 @@ unit hcodegen;
           parent : pprocinfo;
           { current class, if we are in a method }
           _class : tobjectdef;
-          { return type }
-          returntype : ttype;
-          { symbol of the function, and the sym for result variable }
-          resultfuncretsym,
-          funcretsym : tfuncretsym;
-          funcret_state : tvarstate;
           { the definition of the proc itself }
-          def : tprocdef;
-          sym : tprocsym;
+          procdef : tprocdef;
 
           { frame pointer offset }
           framepointer_offset : longint;
@@ -287,12 +280,7 @@ implementation
       begin
         parent:=nil;
         _class:=nil;
-        returntype.reset;
-        resultfuncretsym:=nil;
-        funcretsym:=nil;
-        funcret_state:=vs_none;
-        def:=nil;
-        sym:=nil;
+        procdef:=nil;
         framepointer_offset:=0;
         selfpointer_offset:=0;
         return_offset:=0;
@@ -437,7 +425,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2001-04-13 01:22:07  peter
+  Revision 1.11  2001-08-06 21:40:46  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.10  2001/04/13 01:22:07  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/htypechk.pas

@@ -625,17 +625,17 @@ implementation
                begin
                  { no claim if setting higher return value_str }
                  if must_be_valid and
-                    (procinfo=pprocinfo(tfuncretnode(p).funcretprocinfo)) and
-                    ((procinfo^.funcret_state=vs_declared) or
+                    (lexlevel=tfuncretnode(p).funcretsym.owner.symtablelevel) and
+                    ((tfuncretnode(p).funcretsym.funcretstate=vs_declared) or
                     ((nf_is_first_funcret in p.flags) and
-                     (procinfo^.funcret_state=vs_declared_and_first_found))) then
+                     (tfuncretnode(p).funcretsym.funcretstate=vs_declared_and_first_found))) then
                    begin
                      CGMessage(sym_w_function_result_not_set);
                      { avoid multiple warnings }
-                     procinfo^.funcret_state:=vs_assigned;
+                     tfuncretnode(p).funcretsym.funcretstate:=vs_assigned;
                    end;
                  if (nf_is_first_funcret in p.flags) and not must_be_valid then
-                   pprocinfo(tfuncretnode(p).funcretprocinfo)^.funcret_state:=vs_assigned;
+                   tfuncretnode(p).funcretsym.funcretstate:=vs_assigned;
                  break;
                end;
              else
@@ -691,7 +691,7 @@ implementation
              funcretn:
                begin
                  if (nf_is_first_funcret in p.flags) then
-                   pprocinfo(tfuncretnode(p).funcretprocinfo)^.funcret_state:=vs_assigned;
+                   tfuncretnode(p).funcretsym.funcretstate:=vs_assigned;
                  break;
                end;
              vecn,
@@ -937,7 +937,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.29  2001-06-04 18:04:36  peter
+  Revision 1.30  2001-08-06 21:40:46  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.29  2001/06/04 18:04:36  peter
     * fixes to valid_for_assign for properties
 
   Revision 1.28  2001/06/04 11:48:02  peter

compiler/i386/cgai386.pas

@@ -2296,14 +2296,14 @@ implementation
           generate_interrupt_stackframe_entry;
 
       { initialize return value }
-      if (not is_void(procinfo^.returntype.def)) and
-         (procinfo^.returntype.def.needs_inittable) then
+      if (not is_void(aktprocsym.definition.rettype.def)) and
+         (aktprocsym.definition.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(procinfo^.returntype.def,r,ret_in_param(procinfo^.returntype.def));
+           initialize(aktprocsym.definition.rettype.def,r,ret_in_param(aktprocsym.definition.rettype.def));
         end;
 
       { initialisize local data like ansistrings }
@@ -2426,21 +2426,21 @@ implementation
        op : Tasmop;
        s : Topsize;
   begin
-      if not is_void(procinfo^.returntype.def) then
+      if not is_void(aktprocsym.definition.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 (procinfo^.funcret_state<>vs_assigned) and not inlined { and
+              if (tfuncretsym(aktprocsym.definition.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 (procinfo^.returntype.def.deftype in [orddef,enumdef]) then
+              if (aktprocsym.definition.rettype.def.deftype in [orddef,enumdef]) then
                 begin
                   uses_eax:=true;
                   exprasmList.concat(Tairegalloc.Alloc(R_EAX));
-                  case procinfo^.returntype.def.size of
+                  case aktprocsym.definition.rettype.def.size of
                    8:
                      begin
                         emit_ref_reg(A_MOV,S_L,hr,R_EAX);
@@ -2461,16 +2461,16 @@ implementation
                   end;
                 end
               else
-                if ret_in_acc(procinfo^.returntype.def) then
+                if ret_in_acc(aktprocsym.definition.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 (procinfo^.returntype.def.deftype=floatdef) then
+                 if (aktprocsym.definition.rettype.def.deftype=floatdef) then
                    begin
-                      floatloadops(tfloatdef(procinfo^.returntype.def).typ,op,s);
+                      floatloadops(tfloatdef(aktprocsym.definition.rettype.def).typ,op,s);
                       exprasmList.concat(Taicpu.Op_ref(op,s,hr));
                    end
               else
@@ -2485,12 +2485,12 @@ implementation
        op : Tasmop;
        s : Topsize;
     begin
-      if not is_void(procinfo^.returntype.def) then
+      if not is_void(aktprocsym.definition.rettype.def) then
           begin
               hr:=new_reference(procinfo^.framepointer,procinfo^.return_offset);
-              if (procinfo^.returntype.def.deftype in [orddef,enumdef]) then
+              if (aktprocsym.definition.rettype.def.deftype in [orddef,enumdef]) then
                 begin
-                  case procinfo^.returntype.def.size of
+                  case aktprocsym.definition.rettype.def.size of
                    8:
                      begin
                         emit_reg_ref(A_MOV,S_L,R_EAX,hr);
@@ -2509,14 +2509,14 @@ implementation
                   end;
                 end
               else
-                if ret_in_acc(procinfo^.returntype.def) then
+                if ret_in_acc(aktprocsym.definition.rettype.def) then
                   begin
                     emit_reg_ref(A_MOV,S_L,R_EAX,hr);
                   end
               else
-                 if (procinfo^.returntype.def.deftype=floatdef) then
+                 if (aktprocsym.definition.rettype.def.deftype=floatdef) then
                    begin
-                      floatstoreops(tfloatdef(procinfo^.returntype.def).typ,op,s);
+                      floatstoreops(tfloatdef(aktprocsym.definition.rettype.def).typ,op,s);
                       exprasmlist.concat(taicpu.op_ref(op,s,hr));
                    end
               else
@@ -2674,15 +2674,15 @@ implementation
              end
            else
            { must be the return value finalized before reraising the exception? }
-           if (not is_void(procinfo^.returntype.def)) and
-             (procinfo^.returntype.def.needs_inittable) and
-             ((procinfo^.returntype.def.deftype<>objectdef) or
-              not is_class(procinfo^.returntype.def)) then
+           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
              begin
                 reset_reference(hr);
                 hr.offset:=procinfo^.return_offset;
                 hr.base:=procinfo^.framepointer;
-                finalize(procinfo^.returntype.def,hr,ret_in_param(procinfo^.returntype.def));
+                finalize(aktprocsym.definition.rettype.def,hr,ret_in_param(aktprocsym.definition.rettype.def));
              end;
 
            emitcall('FPC_RERAISE');
@@ -3000,7 +3000,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.26  2001-07-30 20:59:28  peter
+  Revision 1.27  2001-08-06 21:40:49  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.26  2001/07/30 20:59:28  peter
     * m68k updates from v10 merged
 
   Revision 1.25  2001/07/01 20:16:18  peter

compiler/i386/daopt386.pas

@@ -220,7 +220,7 @@ Var
 Implementation
 
 Uses
-  globals, systems, verbose, hcodegen, symconst, tgcpu;
+  globals, systems, verbose, hcodegen, symconst, symsym, tgcpu;
 
 Type
   TRefCompare = function(const r1, r2: TReference): Boolean;
@@ -387,19 +387,18 @@ Procedure RemoveLastDeallocForFuncRes(asmL: TAAsmOutput; p: Tai);
   end;
 
 begin
-  if assigned(procinfo^.returntype.def) then
-    case procinfo^.returntype.def.deftype of
+    case aktprocsym.definition.rettype.def.deftype of
       arraydef,recorddef,pointerdef,
          stringdef,enumdef,procdef,objectdef,errordef,
          filedef,setdef,procvardef,
          classrefdef,forwarddef:
         DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
       orddef:
-        if procinfo^.returntype.def.size <> 0 then
+        if aktprocsym.definition.rettype.def.size <> 0 then
           begin
             DoRemoveLastDeallocForFuncRes(asmL,R_EAX);
             { for int64/qword }
-            if procinfo^.returntype.def.size = 8 then
+            if aktprocsym.definition.rettype.def.size = 8 then
               DoRemoveLastDeallocForFuncRes(asmL,R_EDX);
           end;
     end;
@@ -409,19 +408,18 @@ procedure getNoDeallocRegs(var regs: TRegSet);
 var regCounter: TRegister;
 begin
   regs := [];
-  if assigned(procinfo^.returntype.def) then
-    case procinfo^.returntype.def.deftype of
+    case aktprocsym.definition.rettype.def.deftype of
       arraydef,recorddef,pointerdef,
          stringdef,enumdef,procdef,objectdef,errordef,
          filedef,setdef,procvardef,
          classrefdef,forwarddef:
        regs := [R_EAX];
       orddef:
-        if procinfo^.returntype.def.size <> 0 then
+        if aktprocsym.definition.rettype.def.size <> 0 then
           begin
             regs := [R_EAX];
             { for int64/qword }
-            if procinfo^.returntype.def.size = 8 then
+            if aktprocsym.definition.rettype.def.size = 8 then
               regs := regs + [R_EDX];
           end;
     end;
@@ -2454,7 +2452,10 @@ End.
 
 {
   $Log$
-  Revision 1.17  2001-04-13 01:22:18  peter
+  Revision 1.18  2001-08-06 21:40:50  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.17  2001/04/13 01:22:18  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/i386/n386cal.pas

@@ -1451,17 +1451,17 @@ implementation
           oldquickexitlabel:=quickexitlabel;
           getlabel(aktexitlabel);
           getlabel(aktexit2label);
-          oldprocsym:=aktprocsym;
           { we're inlining a procedure }
           inlining_procedure:=true;
           { save old procinfo }
+          oldprocsym:=aktprocsym;
           getmem(oldprocinfo,sizeof(tprocinfo));
           move(procinfo^,oldprocinfo^,sizeof(tprocinfo));
-          { set the return value }
+          { set new procinfo }
           aktprocsym:=inlineprocsym;
-          procinfo^.returntype:=aktprocsym.definition.rettype;
           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;
           { set it to the same lexical level }
@@ -1584,7 +1584,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.27  2001-07-08 21:00:16  peter
+  Revision 1.28  2001-08-06 21:40:50  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.27  2001/07/08 21:00:16  peter
     * various widestring updates, it works now mostly without charset
       mapping supported
 

compiler/i386/n386flw.pas

@@ -516,7 +516,7 @@ implementation
               else
                 internalerror(2001);
               end;
-              case procinfo^.returntype.def.deftype of
+              case aktprocsym.definition.rettype.def.deftype of
            pointerdef,
            procvardef : begin
                           cleanleft;
@@ -532,7 +532,7 @@ implementation
              floatdef : begin
                           cleanleft;
                           if is_mem then
-                           floatload(tfloatdef(procinfo^.returntype.def).typ,left.location.reference);
+                           floatload(tfloatdef(aktprocsym.definition.rettype.def).typ,left.location.reference);
                         end;
               { orddef,
               enumdef : }
@@ -543,7 +543,7 @@ implementation
                           cleanleft;
                           exprasmlist.concat(tairegalloc.alloc(R_EAX));
                           allocated_eax := true;
-                          case procinfo^.returntype.def.size of
+                          case aktprocsym.definition.rettype.def.size of
                            { it can be a qword/int64 too ... }
                            8 : if is_mem then
                                  begin
@@ -1340,7 +1340,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2001-07-01 20:16:20  peter
+  Revision 1.14  2001-08-06 21:40:50  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.13  2001/07/01 20:16:20  peter
     * alignmentinfo record added
     * -Oa argument supports more alignment settings that can be specified
       per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN

compiler/i386/n386ld.pas

@@ -838,26 +838,28 @@ implementation
          hp : preference;
          pp : pprocinfo;
          hr_valid : boolean;
+         i : integer;
       begin
          reset_reference(location.reference);
          hr_valid:=false;
          if (not inlining_procedure) and
-            (procinfo<>pprocinfo(funcretprocinfo)) then
+            (lexlevel<>funcretsym.owner.symtablelevel) then
            begin
               hr:=getregister32;
               hr_valid:=true;
-              hp:=new_reference(procinfo^.framepointer,
-                procinfo^.framepointer_offset);
+              hp:=new_reference(procinfo^.framepointer,procinfo^.framepointer_offset);
               emit_ref_reg(A_MOV,S_L,hp,hr);
-              pp:=procinfo^.parent;
+
               { walk up the stack frame }
-              while pp<>pprocinfo(funcretprocinfo) do
-                begin
-                   hp:=new_reference(hr,
-                     pp^.framepointer_offset);
-                   emit_ref_reg(A_MOV,S_L,hp,hr);
-                   pp:=pp^.parent;
-                end;
+              pp:=procinfo^.parent;
+              i:=lexlevel-1;
+              while i>funcretsym.owner.symtablelevel do
+               begin
+                 hp:=new_reference(hr,pp^.framepointer_offset);
+                 emit_ref_reg(A_MOV,S_L,hp,hr);
+                 pp:=pp^.parent;
+                 dec(i);
+               end;
               location.reference.base:=hr;
               location.reference.offset:=pp^.return_offset;
            end
@@ -1086,7 +1088,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.17  2001-08-05 13:19:51  peter
+  Revision 1.18  2001-08-06 21:40:50  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.17  2001/08/05 13:19:51  peter
     * partly fix for proc of obj=nil
 
   Revision 1.15  2001/07/28 15:13:17  peter

compiler/i386/ra386.pas

@@ -56,12 +56,14 @@ type
 implementation
 
 uses
+  globtype,globals,systems,verbose,
+  symconst,symdef,symsym,
 {$ifdef NEWCG}
   cgbase,
 {$else}
   hcodegen,
 {$endif}
-  globtype,symconst,symdef,systems,types,globals,verbose,cpuasm;
+  types,cpuasm;
 
 {$define ATTOP}
 {$define INTELOP}
@@ -197,10 +199,10 @@ Begin
   if res and (procinfo^.return_offset=0) then
    begin
      opr.typ:=OPR_REGISTER;
-     if is_fpu(procinfo^.returntype.def) then
+     if is_fpu(aktprocsym.definition.rettype.def) then
        begin
          opr.reg:=R_ST0;
-         case tfloatdef(procinfo^.returntype.def).typ of
+         case tfloatdef(aktprocsym.definition.rettype.def).typ of
            s32real : size:=S_FS;
            s64real : size:=S_FL;
            s80real : size:=S_FX;
@@ -212,8 +214,8 @@ Begin
            end;
          end;
        end
-     else if ret_in_acc(procinfo^.returntype.def) then
-       case procinfo^.returntype.def.size of
+     else if ret_in_acc(aktprocsym.definition.rettype.def) then
+       case aktprocsym.definition.rettype.def.size of
        1 : begin
              opr.reg:=R_AL;
              size:=S_B;
@@ -686,7 +688,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.9  2001-04-13 01:22:19  peter
+  Revision 1.10  2001-08-06 21:40:50  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.9  2001/04/13 01:22:19  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/i386/ra386att.pas

@@ -1892,10 +1892,10 @@ Var
 Begin
   Message1(asmr_d_start_reading,'AT&T');
   firsttoken:=TRUE;
-  if assigned(procinfo^.returntype.def) and
-     (is_fpu(procinfo^.returntype.def) or
-     ret_in_acc(procinfo^.returntype.def)) then
-    procinfo^.funcret_state:=vs_assigned;
+  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;
   { sets up all opcode and register tables in uppercase }
   if not _asmsorted then
    Begin
@@ -2139,7 +2139,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.12  2001-04-18 22:02:03  peter
+  Revision 1.13  2001-08-06 21:40:50  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.12  2001/04/18 22:02:03  peter
     * registration of targets and assemblers
 
   Revision 1.11  2001/04/13 20:06:05  peter

compiler/i386/ra386dir.pas

@@ -78,20 +78,19 @@ interface
            if s<>'' then
             code.concat(Tai_direct.Create(strpnew(s)));
             { consider it set function set if the offset was loaded }
-           if assigned(procinfo^.returntype.def) and
+           if assigned(aktprocsym.definition.funcretsym) and
               (pos(retstr,upper(s))>0) then
-              procinfo^.funcret_state:=vs_assigned;
+             tfuncretsym(aktprocsym.definition.funcretsym).funcretstate:=vs_assigned;
            s:='';
          end;
 
      begin
        ende:=false;
        s:='';
-       if assigned(procinfo^.returntype.def) and
-          is_fpu(procinfo^.returntype.def) then
-         procinfo^.funcret_state:=vs_assigned;
-       if assigned(procinfo^.returntype.def) and
-          (not is_void(procinfo^.returntype.def)) then
+       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
          retstr:=upper(tostr(procinfo^.return_offset)+'('+att_reg2str[procinfo^.framepointer]+')')
        else
          retstr:='';
@@ -141,10 +140,10 @@ interface
                                  { is the last written character an special }
                                  { char ?                                   }
                                  if (s[length(s)]='%') and
-                                    ret_in_acc(procinfo^.returntype.def) and
+                                    ret_in_acc(aktprocsym.definition.rettype.def) and
                                     ((pos('AX',upper(hs))>0) or
                                     (pos('AL',upper(hs))>0)) then
-                                   procinfo^.funcret_state:=vs_assigned;
+                                   tfuncretsym(aktprocsym.definition.funcretsym).funcretstate:=vs_assigned;
                                  if (s[length(s)]<>'%') and
                                    (s[length(s)]<>'$') and
                                    ((s[length(s)]<>'0') or (hs[1]<>'x')) then
@@ -241,8 +240,7 @@ interface
                                              end
                                            else if upper(hs)='__RESULT' then
                                              begin
-                                                if assigned(procinfo^.returntype.def) and
-                                                  (not is_void(procinfo^.returntype.def)) then
+                                                if (not is_void(aktprocsym.definition.rettype.def)) then
                                                   hs:=retstr
                                                 else
                                                   Message(asmr_e_void_function);
@@ -266,7 +264,7 @@ interface
                    end;
  '{',';',#10,#13 : begin
                       if pos(retstr,s) > 0 then
-                        procinfo^.funcret_state:=vs_assigned;
+                        tfuncretsym(aktprocsym.definition.funcretsym).funcretstate:=vs_assigned;
                      writeasmline;
                      c:=current_scanner.asmgetchar;
                    end;
@@ -301,7 +299,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.9  2001-04-18 22:02:03  peter
+  Revision 1.10  2001-08-06 21:40:51  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.9  2001/04/18 22:02:03  peter
     * registration of targets and assemblers
 
   Revision 1.8  2001/04/13 18:20:21  peter

compiler/i386/ra386int.pas

@@ -1847,10 +1847,10 @@ Begin
   Message1(asmr_d_start_reading,'intel');
   inexpression:=FALSE;
   firsttoken:=TRUE;
-  if assigned(procinfo^.returntype.def) and
-     (is_fpu(procinfo^.returntype.def) or
-     ret_in_acc(procinfo^.returntype.def)) then
-    procinfo^.funcret_state:=vs_assigned;
+  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;
  { sets up all opcode and register tables in uppercase }
   if not _asmsorted then
    Begin
@@ -1968,7 +1968,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.15  2001-04-18 22:02:03  peter
+  Revision 1.16  2001-08-06 21:40:51  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.15  2001/04/18 22:02:03  peter
     * registration of targets and assemblers
 
   Revision 1.14  2001/04/13 20:06:05  peter

compiler/nadd.pas

@@ -48,7 +48,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,widestr,
-      symconst,symtype,symdef,types,
+      symconst,symtype,symdef,symsym,types,
       cpuinfo,
 {$ifdef newcg}
       cgbase,
@@ -1287,7 +1287,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.31  2001-07-08 21:00:14  peter
+  Revision 1.32  2001-08-06 21:40:46  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.31  2001/07/08 21:00:14  peter
     * various widestring updates, it works now mostly without charset
       mapping supported
 

compiler/nbas.pas

@@ -79,7 +79,7 @@ implementation
     uses
       cutils,
       verbose,globals,globtype,systems,
-      symconst,symdef,types,
+      symconst,symdef,symsym,types,
       pass_1,
       ncal,nflw,tgcpu,hcodegen
 {$ifdef newcg}
@@ -266,9 +266,9 @@ implementation
                    { concat function result to exit }
                    { this is wrong for string or other complex
                      result types !!! }
-                   if {ret_in_acc(procinfo^.returntype.def) and }
-                      (is_ordinal(procinfo^.returntype.def) or
-                       is_smallset(procinfo^.returntype.def)) and
+                   if {ret_in_acc(aktprocsym.definition.rettype.def) and }
+                      (is_ordinal(aktprocsym.definition.rettype.def) or
+                       is_smallset(aktprocsym.definition.rettype.def)) and
                       assigned(hp.left) and
                       assigned(tstatementnode(hp.left).right) and
                       (tstatementnode(hp.left).right.nodetype=exitn) and
@@ -396,7 +396,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2001-06-11 17:41:12  jonas
+  Revision 1.13  2001-08-06 21:40:46  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.12  2001/06/11 17:41:12  jonas
     * fixed web bug 1501 in conjunction with -Or
 
   Revision 1.11  2001/05/18 22:31:06  peter

compiler/ncal.pas

@@ -184,7 +184,6 @@ implementation
     procedure tcallparanode.insert_typeconv(defcoll : tparaitem;do_count : boolean);
       var
         oldtype     : ttype;
-        old_array_constructor : boolean;
 {$ifdef extdebug}
         store_count_ref : boolean;
 {$endif def extdebug}
@@ -1326,8 +1325,8 @@ implementation
                if is_widestring(resulttype.def) or
                   is_ansistring(resulttype.def) then
                  begin
-                    { we use ansistrings so no fast exit here }
-                    procinfo^.no_fast_exit:=true;
+                   { we use ansistrings so no fast exit here }
+                   procinfo^.no_fast_exit:=true;
                  end;
              end;
           end;
@@ -1681,7 +1680,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.39  2001-08-01 15:07:29  jonas
+  Revision 1.40  2001-08-06 21:40:46  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.39  2001/08/01 15:07:29  jonas
     + "compilerproc" directive support, which turns both the public and mangled
       name to lowercase(declaration_name). This prevents a normal user from
       accessing the routine, but they can still be easily looked up within

compiler/nflw.pas

@@ -631,20 +631,23 @@ implementation
       begin
         result:=nil;
         { Check the 2 types }
-        if assigned(left) then
+        if not inlining_procedure then
          begin
-           inserttypeconv(left,procinfo^.returntype);
-           if ret_in_param(procinfo^.returntype.def) or procinfo^.no_fast_exit then
+           if assigned(left) then
             begin
-              pt:=cfuncretnode.create(procinfo);
-              left:=cassignmentnode.create(pt,left);
+              inserttypeconv(left,aktprocsym.definition.rettype);
+              if ret_in_param(aktprocsym.definition.rettype.def) or
+                 (procinfo^.no_fast_exit) then
+               begin
+                 pt:=cfuncretnode.create(aktprocsym.definition.funcretsym);
+                 left:=cassignmentnode.create(pt,left);
+               end;
             end;
          end;
         if assigned(left) then
          begin
            resulttypepass(left);
            set_varstate(left,true);
-           procinfo^.funcret_state:=vs_assigned;
          end;
         resulttype:=voidtype;
       end;
@@ -1168,7 +1171,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.20  2001-04-26 21:56:08  peter
+  Revision 1.21  2001-08-06 21:40:47  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.20  2001/04/26 21:56:08  peter
     * moved some code from exitnode.create to det_resulttype
 
   Revision 1.19  2001/04/21 15:36:29  peter

compiler/nld.pas

@@ -55,8 +55,8 @@ interface
        end;
 
        tfuncretnode = class(tnode)
-          funcretprocinfo : pointer;
-          constructor create(p:pointer);virtual;
+          funcretsym : tfuncretsym;
+          constructor create(v:tsym);virtual;
           function getcopy : tnode;override;
           function pass_1 : tnode;override;
           function det_resulttype:tnode;override;
@@ -177,14 +177,14 @@ implementation
          case symtableentry.typ of
             funcretsym :
               begin
-                p1:=cfuncretnode.create(tfuncretsym(symtableentry).funcretprocinfo);
+                p1:=cfuncretnode.create(symtableentry);
                 resulttypepass(p1);
                 { if it's refered as absolute then we need to have the
                   type of the absolute instead of the function return,
                   the function return is then also assigned }
                 if nf_absolute in flags then
                  begin
-                   pprocinfo(tfuncretnode(p1).funcretprocinfo)^.funcret_state:=vs_assigned;
+                   tfuncretsym(symtableentry).funcretstate:=vs_assigned;
                    p1.resulttype:=resulttype;
                  end;
                 left:=nil;
@@ -471,11 +471,11 @@ implementation
                                  TFUNCRETNODE
 *****************************************************************************}
 
-    constructor tfuncretnode.create(p:pointer);
+    constructor tfuncretnode.create(v:tsym);
 
       begin
          inherited create(funcretn);
-         funcretprocinfo:=p;
+         funcretsym:=tfuncretsym(v);
       end;
 
 
@@ -484,7 +484,7 @@ implementation
          n : tfuncretnode;
       begin
          n:=tfuncretnode(inherited getcopy);
-         n.funcretprocinfo:=funcretprocinfo;
+         n.funcretsym:=funcretsym;
          getcopy:=n;
       end;
 
@@ -492,7 +492,7 @@ implementation
     function tfuncretnode.det_resulttype:tnode;
       begin
         result:=nil;
-        resulttype:=pprocinfo(funcretprocinfo)^.returntype;
+        resulttype:=funcretsym.returntype;
       end;
 
 
@@ -501,7 +501,7 @@ implementation
          result:=nil;
          location.loc:=LOC_REFERENCE;
          if ret_in_param(resulttype.def) or
-            (procinfo<>pprocinfo(funcretprocinfo)) then
+            (lexlevel<>funcretsym.owner.symtablelevel) then
            registers32:=1;
       end;
 
@@ -510,7 +510,7 @@ implementation
       begin
         docompare :=
           inherited docompare(p) and
-          (funcretprocinfo = tfuncretnode(p).funcretprocinfo);
+          (funcretsym = tfuncretnode(p).funcretsym);
       end;
 
 
@@ -783,7 +783,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.20  2001-07-30 20:52:25  peter
+  Revision 1.21  2001-08-06 21:40:47  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.20  2001/07/30 20:52:25  peter
     * fixed array constructor passing with type conversions
 
   Revision 1.19  2001/06/04 18:07:47  peter

compiler/pass_2.pas

@@ -295,8 +295,8 @@ implementation
                 make_const_global:=true;
               do_secondpass(p);
 
-              if assigned(procinfo^.def) then
-                procinfo^.def.fpu_used:=p.registersfpu;
+              if assigned(procinfo^.procdef) then
+                procinfo^.procdef.fpu_used:=p.registersfpu;
 
            end;
          procinfo^.aktproccode.concatlist(exprasmlist);
@@ -306,7 +306,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.16  2001-05-09 19:57:07  peter
+  Revision 1.17  2001-08-06 21:40:47  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.16  2001/05/09 19:57:07  peter
     * check for errorcount after firstpass
 
   Revision 1.15  2001/04/15 09:48:30  peter

compiler/pexpr.pas

@@ -948,11 +948,11 @@ implementation
             begin
                { is this an access to a function result? Accessing _RESULT is
                  always allowed and funcretn is generated }
-               if assigned(p^.funcretsym) and
-                  ((tfuncretsym(sym)=p^.resultfuncretsym) or
-                   ((tfuncretsym(sym)=p^.funcretsym) or
+               if assigned(p^.procdef.funcretsym) and
+                  ((tfuncretsym(sym)=p^.procdef.resultfuncretsym) or
+                   ((tfuncretsym(sym)=p^.procdef.funcretsym) or
                     ((tvarsym(sym)=otsym) and ((p^.flags and pi_operator)<>0))) and
-                   (not is_void(p^.returntype.def)) and
+                   (not is_void(p^.procdef.rettype.def)) and
                    (token<>_LKLAMMER) and
                    (not ((m_tp in aktmodeswitches) and (afterassignment or in_args)))
                   ) then
@@ -960,11 +960,11 @@ implementation
                     if ((tvarsym(sym)=otsym) and
                        ((p^.flags and pi_operator)<>0)) then
                        inc(otsym.refs);
-                    p1:=cfuncretnode.create(p);
+                    p1:=cfuncretnode.create(p^.procdef.funcretsym);
                     is_func_ret:=true;
-                    if p^.funcret_state=vs_declared then
+                    if tfuncretsym(p^.procdef.funcretsym).funcretstate=vs_declared then
                       begin
-                        p^.funcret_state:=vs_declared_and_first_found;
+                        tfuncretsym(p^.procdef.funcretsym).funcretstate:=vs_declared_and_first_found;
                         include(p1.flags,nf_is_first_funcret);
                       end;
                     exit;
@@ -2324,7 +2324,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.38  2001-07-09 21:15:41  peter
+  Revision 1.39  2001-08-06 21:40:47  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.38  2001/07/09 21:15:41  peter
     * Length made internal
     * Add array support for Length
 

compiler/pmodules.pas

@@ -654,11 +654,11 @@ implementation
         { set some informations about the main program }
         with procinfo^ do
          begin
-           returntype:=voidtype;
            _class:=nil;
            para_offset:=8;
            framepointer:=frame_pointer;
            flags:=0;
+           procdef:=aktprocsym.definition;
          end;
       end;
 
@@ -1339,7 +1339,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.41  2001-08-05 12:26:52  peter
+  Revision 1.42  2001-08-06 21:40:47  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.41  2001/08/05 12:26:52  peter
     * beos fix (merged)
 
   Revision 1.40  2001/08/04 10:23:54  peter

compiler/pstatmnt.pas

@@ -705,7 +705,7 @@ implementation
               consume(_RKLAMMER);
               if (block_type=bt_except) then
                 Message(parser_e_exit_with_argument_not__possible);
-              if is_void(procinfo^.returntype.def) then
+              if is_void(aktprocsym.definition.rettype.def) then
                 Message(parser_e_void_function);
            end
          else
@@ -1169,9 +1169,9 @@ implementation
 
          { assembler code does not allocate }
          { space for the return value       }
-          if not is_void(procinfo^.returntype.def) then
+          if not is_void(aktprocsym.definition.rettype.def) then
            begin
-              if ret_in_acc(procinfo^.returntype.def) then
+              if ret_in_acc(aktprocsym.definition.rettype.def) then
                 begin
                    { in assembler code the result should be directly in %eax
                    procinfo^.retoffset:=procinfo^.firsttemp-procinfo^.retdef.size;
@@ -1222,7 +1222,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.31  2001-06-03 21:57:37  peter
+  Revision 1.32  2001-08-06 21:40:47  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.31  2001/06/03 21:57:37  peter
     + hint directive parsing support
 
   Revision 1.30  2001/05/17 13:25:24  jonas

compiler/psub.pas

@@ -84,7 +84,6 @@ implementation
 
     function block(islibrary : boolean) : tnode;
       var
-         funcretsym : tfuncretsym;
          storepos : tfileposinfo;
       begin
          { do we have an assembler block without the po_assembler?
@@ -100,24 +99,24 @@ implementation
             exit;
           end;
 
-         if not is_void(procinfo^.returntype.def) then
+         if not is_void(aktprocsym.definition.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;
-              funcretsym:=tfuncretsym.create(aktprocsym.name,procinfo);
+              aktprocsym.definition.funcretsym:=tfuncretsym.create(aktprocsym.name,aktprocsym.definition.rettype);
               { insert in local symtable }
-              symtablestack.insert(funcretsym);
+              symtablestack.insert(aktprocsym.definition.funcretsym);
               akttokenpos:=storepos;
-              if ret_in_acc(procinfo^.returntype.def) or (procinfo^.returntype.def.deftype=floatdef) then
-                procinfo^.return_offset:=-funcretsym.address;
-              procinfo^.funcretsym:=funcretsym;
+              if ret_in_acc(aktprocsym.definition.rettype.def) or
+                 (aktprocsym.definition.rettype.def.deftype=floatdef) then
+                procinfo^.return_offset:=-tfuncretsym(aktprocsym.definition.funcretsym).address;
               { insert result also if support is on }
               if (m_result in aktmodeswitches) then
                begin
-                 procinfo^.resultfuncretsym:=tfuncretsym.create('RESULT',procinfo);
-                 symtablestack.insert(procinfo^.resultfuncretsym);
+                 aktprocsym.definition.resultfuncretsym:=tfuncretsym.create('RESULT',aktprocsym.definition.rettype);
+                 symtablestack.insert(aktprocsym.definition.resultfuncretsym);
                end;
            end;
          read_declarations(islibrary);
@@ -132,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(procinfo^.returntype.def) then
+         if not is_void(aktprocsym.definition.rettype.def) then
            begin
-              if ret_in_acc(procinfo^.returntype.def) or (procinfo^.returntype.def.deftype=floatdef) then
+              if ret_in_acc(aktprocsym.definition.rettype.def) or (aktprocsym.definition.rettype.def.deftype=floatdef) then
                 begin
                    { the space has been set in the local symtable }
-                   procinfo^.return_offset:=-funcretsym.address;
+                   procinfo^.return_offset:=-tfuncretsym(aktprocsym.definition.funcretsym).address;
                    if ((procinfo^.flags and pi_operator)<>0) and
                       assigned(otsym) then
                      otsym.address:=-procinfo^.return_offset;
@@ -146,13 +145,13 @@ implementation
 {$ifdef i386}
                    usedinproc:=usedinproc or ($80 shr byte(R_EAX));
 
-                   if is_64bitint(procinfo^.returntype.def) then
+                   if is_64bitint(aktprocsym.definition.rettype.def) then
                      usedinproc:=usedinproc or ($80 shr byte(R_EDX))
 {$endif}
 {$ifdef m68k}
                    usedinproc:=usedinproc + [accumulator];
 
-                   if is_64bitint(procinfo^.returntype.def) then
+                   if is_64bitint(aktprocsym.definition.rettype.def) then
                      usedinproc:=usedinproc  + [scratch_reg];
 {$endif}
 {$endif newcg}
@@ -566,8 +565,6 @@ implementation
             flags:=0;
           { standard frame pointer }
             framepointer:=frame_pointer;
-            { funcret_is_valid:=false; }
-            funcret_state:=vs_declared;
           { is this a nested function of a method ? }
             if assigned(oldprocinfo) then
               _class:=oldprocinfo^._class;
@@ -575,8 +572,7 @@ implementation
 
          parse_proc_dec;
 
-         procinfo^.sym:=aktprocsym;
-         procinfo^.def:=aktprocsym.definition;
+         procinfo^.procdef:=aktprocsym.definition;
 
       { set the default function options }
          if parse_only then
@@ -667,11 +663,12 @@ implementation
               end;
            end;
 
-         { set return type here, becuase the aktprocsym.definition can be
+         { update procinfo, because the aktprocsym.definition can be
            changed by check_identical_proc (PFV) }
-         procinfo^.returntype.def:=aktprocsym.definition.rettype.def;
+         procinfo^.procdef:=aktprocsym.definition;
 
 {$ifdef i386}
+         { add implicit pushes for interrupt routines }
          if (po_interrupt in aktprocsym.definition.procoptions) then
            begin
              { we push Flags and CS as long
@@ -682,7 +679,7 @@ implementation
 {$endif i386}
 
          { pointer to the return value ? }
-         if ret_in_param(procinfo^.returntype.def) then
+         if ret_in_param(aktprocsym.definition.rettype.def) then
           begin
             procinfo^.return_offset:=procinfo^.para_offset;
             inc(procinfo^.para_offset,target_info.size_of_pointer);
@@ -840,7 +837,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.34  2001-06-04 11:53:13  peter
+  Revision 1.35  2001-08-06 21:40:47  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.34  2001/06/04 11:53:13  peter
     + varargs directive
 
   Revision 1.33  2001/06/03 21:57:37  peter

compiler/rautils.pas

@@ -730,8 +730,7 @@ Function TOperand.SetupResult:boolean;
 Begin
   SetupResult:=false;
   { replace by correct offset. }
-  if assigned(procinfo^.returntype.def) and
-     (not is_void(procinfo^.returntype.def)) then
+  if (not is_void(aktprocsym.definition.rettype.def)) then
    begin
      if (procinfo^.return_offset=0) and ((m_tp in aktmodeswitches) or
         (m_delphi in aktmodeswitches)) then
@@ -743,7 +742,7 @@ Begin
      opr.ref.base:= procinfo^.framepointer;
      opr.ref.options:=ref_parafixup;
      { always assume that the result is valid. }
-     procinfo^.funcret_state:=vs_assigned;
+     tfuncretsym(aktprocsym.definition.funcretsym).funcretstate:=vs_assigned;
      SetupResult:=true;
    end
   else
@@ -1583,7 +1582,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.20  2001-04-18 22:01:58  peter
+  Revision 1.21  2001-08-06 21:40:48  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.20  2001/04/18 22:01:58  peter
     * registration of targets and assemblers
 
   Revision 1.19  2001/04/13 20:06:05  peter

compiler/symdef.pas

@@ -494,6 +494,10 @@ interface
           { symtables }
           parast,
           localst : tsymtable;
+          funcretsym : tsym;
+          { next is only used to check if RESULT is accessed,
+            not stored in a tnode }
+          resultfuncretsym : tsym;
           { browser info }
           lastref,
           defref,
@@ -531,6 +535,7 @@ interface
           destructor  destroy;override;
           procedure write(ppufile:tcompilerppufile);override;
           procedure deref;override;
+          procedure derefimpl;override;
           function  getsymtable(t:tgetsymtable):tsymtable;override;
           function  haspara:boolean;
           function  mangledname : string;
@@ -3323,6 +3328,7 @@ implementation
          aliasnames:=tstringlist.create;
          localst:=tlocalsymtable.create;
          parast:=tparasymtable.create;
+         funcretsym:=nil;
          localst.defowner:=self;
          parast.defowner:=self;
          { this is used by insert
@@ -3379,23 +3385,29 @@ implementation
          nextoverloaded:=tprocdef(ppufile.getderef);
          _class := tobjectdef(ppufile.getderef);
          ppufile.getposinfo(fileinfo);
-
+         { inline stuff }
+         if (pocall_inline in proccalloptions) then
+           funcretsym:=tsym(ppufile.getderef)
+         else
+           funcretsym:=nil;
+         { load para and local symtables }
+         parast:=tparasymtable.create;
+         tparasymtable(parast).load(ppufile);
+         parast.defowner:=self;
+         if (pocall_inline in proccalloptions) then
+          begin
+            localst:=tlocalsymtable.create;
+            tlocalsymtable(localst).load(ppufile);
+            localst.defowner:=self;
+          end
+         else
+          localst:=nil;
+         { default values for no persistent data }
          if (cs_link_deffile in aktglobalswitches) and
             (tf_need_export in target_info.flags) and
             (po_exports in procoptions) then
            deffile.AddExport(mangledname);
-
          aliasnames:=tstringlist.create;
-
-         parast:=tparasymtable.create;
-         tparasymtable(parast).load(ppufile);
-         parast.defowner:=self;
-         localst:=nil;
-         {new(localst,loadas(localsymtable));
-         localst.defowner:=self;
-         parast.next:=localst;
-         localst.next:=owner;}
-
          forwarddef:=false;
          interfacedef:=false;
          hasforward:=false;
@@ -3480,16 +3492,15 @@ implementation
            end;
          ppufile.putderef(_class);
          ppufile.putposinfo(fileinfo);
+
+         { inline stuff }
+         oldintfcrc:=ppufile.do_interface_crc;
+         ppufile.do_interface_crc:=false;
          if (pocall_inline in proccalloptions) then
-           begin
-              { we need to save
-                - the para and the local symtable
-                - the code ptree !! PM
-               writesymtable(parast);
-               writesymtable(localst);
-               writeptree(ptree(code));
-               }
-           end;
+           ppufile.putderef(funcretsym);
+         ppufile.do_interface_crc:=oldintfcrc;
+
+         { write this entry }
          ppufile.writeentry(ibprocdef);
 
          { Save the para and local symtable, for easier reading
@@ -3502,12 +3513,15 @@ implementation
             parast.defowner:=self;
           end;
          tparasymtable(parast).write(ppufile);
-         {if not assigned(localst) then
+         if (pocall_inline in proccalloptions) then
           begin
-            localst:=new(tstoredsymtable.create(localsymtable));
-            localst.defowner:=self;
+            if not assigned(localst) then
+             begin
+               localst:=tlocalsymtable.create;
+               localst.defowner:=self;
+             end;
+            tlocalsymtable(localst).write(ppufile);
           end;
-         localst.writeas;}
          ppufile.do_interface_crc:=oldintfcrc;
       end;
 
@@ -3737,24 +3751,43 @@ Const local_symtable_index : longint = $8001;
       end;
 {$endif GDB}
 
+
     procedure tprocdef.deref;
       var
-        oldsymtablestack,
         oldlocalsymtable : tsymtable;
       begin
          inherited deref;
          resolvedef(tdef(nextoverloaded));
          resolvedef(tdef(_class));
          { parast }
-         oldsymtablestack:=symtablestack;
          oldlocalsymtable:=aktlocalsymtable;
          aktlocalsymtable:=parast;
          tparasymtable(parast).deref;
-         {symtablestack:=parast;
-         aktlocalsymtable:=localst;
-         localst.deref;}
          aktlocalsymtable:=oldlocalsymtable;
-         symtablestack:=oldsymtablestack;
+      end;
+
+
+    procedure tprocdef.derefimpl;
+      var
+        oldlocalsymtable : tsymtable;
+      begin
+         if assigned(localst) then
+          begin
+            { localst }
+            oldlocalsymtable:=aktlocalsymtable;
+            aktlocalsymtable:=localst;
+            { we can deref both interface and implementation parts }
+            tlocalsymtable(localst).deref;
+            tlocalsymtable(localst).derefimpl;
+            aktlocalsymtable:=oldlocalsymtable;
+            { funcretsym, this is always located in the localst }
+            resolvesym(funcretsym);
+          end
+         else
+          begin
+            { safety }
+            funcretsym:=nil;
+          end;
       end;
 
 
@@ -4070,7 +4103,7 @@ Const local_symtable_index : longint = $8001;
         fillchar(iidguid,sizeof(iidguid),0); { default null guid }
         iidstr:=stringdup(''); { default is empty string }
 
-        { set£p implemented interfaces }
+        { setup implemented interfaces }
         if objecttype in [odt_class,odt_interfacecorba] then
           implementedinterfaces:=timplementedinterfaces.create
         else
@@ -5507,7 +5540,10 @@ Const local_symtable_index : longint = $8001;
 end.
 {
   $Log$
-  Revision 1.39  2001-08-01 21:47:48  peter
+  Revision 1.40  2001-08-06 21:40:48  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.39  2001/08/01 21:47:48  peter
     * fixed passing of array of record or shortstring to open array
 
   Revision 1.38  2001/07/30 20:59:27  peter

compiler/symsym.pas

@@ -131,8 +131,8 @@ interface
           constructor create(const n : string;const tt : ttype);
           constructor load(ppufile:tcompilerppufile);
           procedure write(ppufile:tcompilerppufile);override;
+          procedure deref;override;
           function  gettypedef:tdef;override;
-          procedure prederef;override;
           procedure load_references(ppufile:tcompilerppufile);override;
           function  write_references(ppufile:tcompilerppufile) : boolean;override;
 {$ifdef GDB}
@@ -195,10 +195,10 @@ interface
        end;
 
        tfuncretsym = class(tstoredsym)
-          funcretprocinfo : pointer{ should be pprocinfo};
-          rettype  : ttype;
-          address  : longint;
-          constructor create(const n : string;approcinfo : pointer{pprocinfo});
+          returntype    : ttype;
+          address       : longint;
+          funcretstate  : tvarstate;
+          constructor create(const n : string;const tt : ttype);
           constructor load(ppufile:tcompilerppufile);
           destructor  destroy;override;
           procedure write(ppufile:tcompilerppufile);override;
@@ -1026,24 +1026,23 @@ implementation
                                   TFUNCRETSYM
 ****************************************************************************}
 
-    constructor tfuncretsym.create(const n : string;approcinfo : pointer{pprocinfo});
+    constructor tfuncretsym.create(const n : string;const tt:ttype);
 
       begin
          inherited create(n);
          typ:=funcretsym;
-         funcretprocinfo:=approcinfo;
-         rettype:=pprocinfo(approcinfo)^.returntype;
+         returntype:=tt;
+         funcretstate:=vs_declared;
          { address valid for ret in param only }
          { otherwise set by insert             }
-         address:=pprocinfo(approcinfo)^.return_offset;
+         address:=pprocinfo(procinfo)^.return_offset;
       end;
 
     constructor tfuncretsym.load(ppufile:tcompilerppufile);
       begin
          inherited loadsym(ppufile);
-         ppufile.gettype(rettype);
+         ppufile.gettype(returntype);
          address:=ppufile.getlongint;
-         funcretprocinfo:=nil;
          typ:=funcretsym;
       end;
 
@@ -1055,14 +1054,15 @@ implementation
     procedure tfuncretsym.write(ppufile:tcompilerppufile);
       begin
          inherited writesym(ppufile);
-         ppufile.puttype(rettype);
+         ppufile.puttype(returntype);
          ppufile.putlongint(address);
          ppufile.writeentry(ibfuncretsym);
+         funcretstate:=vs_used;
       end;
 
     procedure tfuncretsym.deref;
       begin
-         rettype.resolve;
+         returntype.resolve;
       end;
 
 {$ifdef GDB}
@@ -1074,7 +1074,7 @@ implementation
 
     procedure tfuncretsym.insert_in_data;
       var
-        l : longint;
+        varalign,l : longint;
       begin
         { if retoffset is already set then reuse it, this is needed
           when inserting the result variable }
@@ -1083,22 +1083,15 @@ implementation
         else
          begin
            { allocate space in local if ret in acc or in fpu }
-           if ret_in_acc(procinfo^.returntype.def) or (procinfo^.returntype.def.deftype=floatdef) then
+           if ret_in_acc(returntype.def) or
+              (returntype.def.deftype=floatdef) then
             begin
-              l:=rettype.def.size;
-              inc(owner.datasize,l);
-{$ifdef m68k}
-              { word alignment required for motorola }
-              if (l=1) then
-               inc(owner.datasize,1)
-              else
-{$endif}
-              if (l>=4) and ((owner.datasize and 3)<>0) then
-                inc(owner.datasize,4-(owner.datasize and 3))
-              else if (l>=2) and ((owner.datasize and 1)<>0) then
-                inc(owner.datasize,2-(owner.datasize and 1));
-              address:=owner.datasize;
-              procinfo^.return_offset:=-owner.datasize;
+              l:=returntype.def.size;
+              varalign:=size_2_align(l);
+              varalign:=used_align(varalign,aktalignment.localalignmin,owner.dataalignment);
+              address:=align(owner.datasize+l,varalign);
+              owner.datasize:=address;
+              procinfo^.return_offset:=-address;
             end;
          end;
       end;
@@ -2134,7 +2127,7 @@ implementation
       end;
 
 
-    procedure ttypesym.prederef;
+    procedure ttypesym.deref;
       begin
          restype.resolve;
       end;
@@ -2245,7 +2238,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.14  2001-07-01 20:16:17  peter
+  Revision 1.15  2001-08-06 21:40:48  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.14  2001/07/01 20:16:17  peter
     * alignmentinfo record added
     * -Oa argument supports more alignment settings that can be specified
       per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN

compiler/symtable.pas

@@ -73,6 +73,7 @@ interface
           procedure load_browser(ppufile:tcompilerppufile);virtual;
           procedure write_browser(ppufile:tcompilerppufile);virtual;
           procedure deref;virtual;
+          procedure derefimpl;virtual;
           procedure insert(sym : tsymentry);override;
           function  speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;override;
           procedure allsymbolsused;
@@ -153,7 +154,7 @@ interface
           unittypecount : word;
           unitsym       : tunitsym;
           constructor create(const n : string);
-          destructor  destroy;
+          destructor  destroy;override;
           procedure load(ppufile:tcompilerppufile);override;
           procedure write(ppufile:tcompilerppufile);override;
           procedure insert(sym : tsymentry);override;
@@ -494,30 +495,46 @@ implementation
         hp : tdef;
         hs : tsym;
       begin
-        { deref the definitions }
+        { deref the interface definitions }
         hp:=tdef(defindex.first);
         while assigned(hp) do
          begin
            hp.deref;
            hp:=tdef(hp.indexnext);
          end;
-        { first deref the ttypesyms }
+        { first deref the interface ttype symbols }
         hs:=tsym(symindex.first);
         while assigned(hs) do
          begin
-           hs.prederef;
+           if hs.typ=typesym then
+             hs.deref;
            hs:=tsym(hs.indexnext);
          end;
-        { deref the symbols }
+        { deref the interface symbols }
         hs:=tsym(symindex.first);
         while assigned(hs) do
          begin
-           hs.deref;
+           if hs.typ<>typesym then
+             hs.deref;
            hs:=tsym(hs.indexnext);
          end;
       end;
 
 
+    procedure tstoredsymtable.derefimpl;
+      var
+        hp : tdef;
+      begin
+        { deref the implementation part of definitions }
+        hp:=tdef(defindex.first);
+        while assigned(hp) do
+         begin
+           hp.derefimpl;
+           hp:=tdef(hp.indexnext);
+         end;
+      end;
+
+
     procedure tstoredsymtable.insert(sym:tsymentry);
       var
          hsym : tsym;
@@ -2055,7 +2072,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.39  2001-07-29 22:12:58  peter
+  Revision 1.40  2001-08-06 21:40:49  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.39  2001/07/29 22:12:58  peter
     * skip private symbols when found in withsymtable
 
   Revision 1.38  2001/07/01 20:16:18  peter

compiler/symtype.pas

@@ -66,6 +66,7 @@ interface
          typesym    : tsym;  { which type the definition was generated this def }
          constructor create;
          procedure deref;virtual;
+         procedure derefimpl;virtual;
          function  typename:string;
          function  gettypename:string;virtual;
          function  size:longint;virtual;abstract;
@@ -88,7 +89,6 @@ interface
          constructor create(const n : string);
          destructor destroy;override;
          function  realname:string;
-         procedure prederef;virtual; { needed for ttypesym to be deref'd first }
          procedure deref;virtual;
          function  gettypedef:tdef;virtual;
          function  mangledname : string;virtual;abstract;
@@ -180,6 +180,11 @@ implementation
       end;
 
 
+    procedure tdef.derefimpl;
+      begin
+      end;
+
+
     function tdef.getsymtable(t:tgetsymtable):tsymtable;
       begin
         getsymtable:=nil;
@@ -208,15 +213,11 @@ implementation
       end;
 
 
-    procedure tsym.prederef;
-      begin
-      end;
-
-
     procedure tsym.deref;
       begin
       end;
 
+
     function tsym.realname : string;
       begin
         if assigned(_realname) then
@@ -500,7 +501,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.7  2001-05-06 14:49:19  peter
+  Revision 1.8  2001-08-06 21:40:49  peter
+    * funcret moved from tprocinfo to tprocdef
+
+  Revision 1.7  2001/05/06 14:49:19  peter
     * ppu object to class rewrite
     * move ppu read and write stuff to fppu