* procvar handling for tp procvar mode fixed

  * proc to procvar moved from addrnode to typeconvnode
  * inlininginfo is now allocated only for inline routines that
    can be inlined, introduced a new flag po_has_inlining_info

compiler/defcmp.pas

@@ -41,7 +41,7 @@ interface
        tcompare_defs_option = (cdo_internal,cdo_explicit,cdo_check_operator,cdo_allow_variant);
        tcompare_defs_options = set of tcompare_defs_option;
 
-       tconverttype = (
+       tconverttype = (tc_none,
           tc_equal,
           tc_not_possible,
           tc_string_2_string,
@@ -165,6 +165,9 @@ implementation
          hd3 : tobjectdef;
          hpd : tprocdef;
       begin
+         eq:=te_incompatible;
+         doconv:=tc_not_possible;
+
          { safety check }
          if not(assigned(def_from) and assigned(def_to)) then
           begin
@@ -175,14 +178,13 @@ implementation
          { same def? then we've an exact match }
          if def_from=def_to then
           begin
+            doconv:=tc_equal;
             compare_defs_ext:=te_exact;
             exit;
           end;
 
          { we walk the wanted (def_to) types and check then the def_from
            types if there is a conversion possible }
-         eq:=te_incompatible;
-         doconv:=tc_not_possible;
          case def_to.deftype of
            orddef :
              begin
@@ -786,13 +788,10 @@ implementation
                    end;
                  procvardef :
                    begin
-                     { procedure variable can be assigned to an void pointer }
-                     { Not anymore. Use the @ operator now.}
-                     if not(m_tp_procvar in aktmodeswitches) and
-                       { method pointers can't be assigned to void pointers
-                       not(tprocvardef(def_from).is_methodpointer) and }
-                        (tpointerdef(def_to).pointertype.def.deftype=orddef) and
-                        (torddef(tpointerdef(def_to).pointertype.def).typ=uvoid) then
+                     { procedure variable can be assigned to an void pointer,
+                       this not allowed for methodpointers }
+                     if is_void(tpointerdef(def_to).pointertype.def) and
+                        tprocvardef(def_from).is_addressonly then
                       begin
                         doconv:=tc_equal;
                         eq:=te_convert_l1;
@@ -879,8 +878,8 @@ implementation
                       { for example delphi allows the assignement from pointers }
                       { to procedure variables                                  }
                       if (m_pointer_2_procedure in aktmodeswitches) and
-                         (tpointerdef(def_from).pointertype.def.deftype=orddef) and
-                         (torddef(tpointerdef(def_from).pointertype.def).typ=uvoid) then
+                         is_void(tpointerdef(def_from).pointertype.def) and
+                         tprocvardef(def_to).is_addressonly then
                        begin
                          doconv:=tc_equal;
                          eq:=te_convert_l1;
@@ -1312,7 +1311,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.61  2004-11-29 17:32:56  peter
+  Revision 1.62  2004-12-05 12:28:10  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.61  2004/11/29 17:32:56  peter
     * prevent some IEs with delphi methodpointers
 
   Revision 1.60  2004/11/26 22:33:54  peter

compiler/htypechk.pas

@@ -128,8 +128,8 @@ interface
     procedure make_not_regable(p : tnode);
     procedure calcregisters(p : tbinarynode;r32,fpu,mmx : word);
 
-    { subroutine handling }
-    function  is_procsym_load(p:tnode):boolean;
+    { procvar handling }
+    function  is_procvar_load(p:tnode):boolean;
     procedure test_local_to_procvar(from_def:tprocvardef;to_def:tdef);
 
     { sets varsym varstate field correctly }
@@ -143,6 +143,7 @@ interface
     function  valid_for_formal_const(p : tnode) : boolean;
     function  valid_for_var(p:tnode):boolean;
     function  valid_for_assignment(p:tnode):boolean;
+    function  valid_for_addr(p : tnode) : boolean;
 
 
 implementation
@@ -152,12 +153,12 @@ implementation
        cutils,verbose,globals,
        symtable,
        defutil,defcmp,
-       nbas,ncnv,nld,nmem,ncal,nmat,nutils,
+       nbas,ncnv,nld,nmem,ncal,nmat,ninl,nutils,
        cgbase,procinfo
        ;
 
     type
-      TValidAssign=(Valid_Property,Valid_Void,Valid_Const);
+      TValidAssign=(Valid_Property,Valid_Void,Valid_Const,Valid_Addr);
       TValidAssigns=set of TValidAssign;
 
 
@@ -703,22 +704,16 @@ implementation
                           Subroutine Handling
 ****************************************************************************}
 
-    function is_procsym_load(p:tnode):boolean;
+    function is_procvar_load(p:tnode):boolean;
       begin
-         { ignore vecn,subscriptn }
-         repeat
-           case p.nodetype of
-             vecn :
-               p:=tvecnode(p).left;
-             subscriptn :
-               p:=tsubscriptnode(p).left;
-             else
-               break;
-           end;
-         until false;
-         is_procsym_load:=((p.nodetype=loadn) and (tloadnode(p).symtableentry.typ=procsym)) or
-                          ((p.nodetype=addrn) and (taddrnode(p).left.nodetype=loadn)
-                          and (tloadnode(taddrnode(p).left).symtableentry.typ=procsym)) ;
+        result:=false;
+        { remove voidpointer typecast for tp procvars }
+        if (m_tp_procvar in aktmodeswitches) and
+           (p.nodetype=typeconvn) and
+           is_voidpointer(p.resulttype.def) then
+          p:=tunarynode(p).left;
+        result:=(p.nodetype=typeconvn) and
+                (ttypeconvnode(p).convtype=tc_proc_2_procvar);
       end;
 
 
@@ -832,8 +827,13 @@ implementation
         gotderef : boolean;
         fromdef,
         todef    : tdef;
+        errmsg   : longint;
       begin
-        valid_for_assign:=false;
+        if valid_const in opts then
+          errmsg:=type_e_variable_id_expected
+        else
+          errmsg:=type_e_argument_cant_be_assigned;
+        result:=false;
         gotsubscript:=false;
         gotvec:=false;
         gotderef:=false;
@@ -844,7 +844,7 @@ implementation
         if not(valid_void in opts) and
            is_void(hp.resulttype.def) then
          begin
-           CGMessagePos(hp.fileinfo,type_e_argument_cant_be_assigned);
+           CGMessagePos(hp.fileinfo,errmsg);
            exit;
          end;
         while assigned(hp) do
@@ -853,7 +853,7 @@ implementation
            if (nf_isproperty in hp.flags) then
             begin
               if (valid_property in opts) then
-               valid_for_assign:=true
+               result:=true
               else
                begin
                  { check return type }
@@ -867,18 +867,26 @@ implementation
                      gotclass:=true;
                  end;
                  { 1. if it returns a pointer and we've found a deref,
-                   2. if it returns a class or record and a subscription or with is found }
+                   2. if it returns a class or record and a subscription or with is found
+                   3. if the address is needed of a field (subscriptn) }
                  if (gotpointer and gotderef) or
-                    (gotclass and (gotsubscript or gotwith)) then
-                   valid_for_assign:=true
+                    (
+                     gotclass and
+                     (gotsubscript or gotwith)
+                    ) or
+                    (
+                     (Valid_Addr in opts) and
+                     (hp.nodetype=subscriptn)
+                    ) then
+                   result:=true
                  else
-                   CGMessagePos(hp.fileinfo,type_e_argument_cant_be_assigned);
+                   CGMessagePos(hp.fileinfo,errmsg);
                end;
               exit;
             end;
            if (Valid_Const in opts) and is_constnode(hp) then
              begin
-               valid_for_assign:=true;
+               result:=true;
                exit;
              end;
            case hp.nodetype of
@@ -924,7 +932,7 @@ implementation
                  if not(gotsubscript or gotvec or gotderef) and
                     not(ttypeconvnode(hp).assign_allowed) then
                    begin
-                     CGMessagePos(hp.fileinfo,type_e_argument_cant_be_assigned);
+                     CGMessagePos(hp.fileinfo,errmsg);
                      exit;
                    end;
                  case hp.resulttype.def.deftype of
@@ -955,7 +963,7 @@ implementation
                    of reference. }
                  if not(gotsubscript or gotderef or gotvec) then
                    begin
-                     CGMessagePos(hp.fileinfo,type_e_argument_cant_be_assigned);
+                     CGMessagePos(hp.fileinfo,errmsg);
                      exit;
                    end;
                  hp:=tunarynode(hp).left;
@@ -981,16 +989,15 @@ implementation
                  if ((hp.resulttype.def.deftype=pointerdef) or
                      (is_integer(hp.resulttype.def) and gotpointer)) and
                     gotderef then
-                  valid_for_assign:=true
+                  result:=true
                  else
                   CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
                  exit;
                end;
              addrn :
                begin
-                 if gotderef or
-                    (nf_procvarload in hp.flags) then
-                  valid_for_assign:=true
+                 if gotderef then
+                  result:=true
                  else
                   CGMessagePos(hp.fileinfo,type_e_no_assign_to_addr);
                  exit;
@@ -1022,9 +1029,18 @@ implementation
                    2. if it returns a class or record and a subscription or with is found }
                  if (gotpointer and gotderef) or
                     (gotclass and (gotsubscript or gotwith)) then
-                  valid_for_assign:=true
+                  result:=true
                  else
-                  CGMessagePos(hp.fileinfo,type_e_argument_cant_be_assigned);
+                  CGMessagePos(hp.fileinfo,errmsg);
+                 exit;
+               end;
+             inlinen :
+               begin
+                 if (valid_const in opts) and
+                    (tinlinenode(hp).inlinenumber in [in_typeof_x]) then
+                   result:=true
+                 else
+                   CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
                  exit;
                end;
              loadn :
@@ -1044,7 +1060,7 @@ implementation
                         begin
                           { allow p^:= constructions with p is const parameter }
                           if gotderef or (Valid_Const in opts) then
-                           valid_for_assign:=true
+                           result:=true
                           else
                            CGMessagePos(tloadnode(hp).fileinfo,type_e_no_assign_to_const);
                           exit;
@@ -1059,18 +1075,34 @@ implementation
                         end
                        else
                         begin
-                          valid_for_assign:=true;
+                          result:=true;
                           exit;
                         end;
                      end;
                    typedconstsym :
                      begin
                        if ttypedconstsym(tloadnode(hp).symtableentry).is_writable then
-                        valid_for_assign:=true
+                        result:=true
                        else
                         CGMessagePos(hp.fileinfo,type_e_no_assign_to_const);
                        exit;
                      end;
+                   procsym :
+                     begin
+                       if (Valid_Const in opts) then
+                         result:=true
+                       else
+                         CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
+                       exit;
+                     end;
+                   labelsym :
+                     begin
+                       if (Valid_Addr in opts) then
+                         result:=true
+                       else
+                         CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
+                       exit;
+                     end;
                    else
                      begin
                        CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
@@ -1102,7 +1134,7 @@ implementation
 
     function  valid_for_formal_const(p : tnode) : boolean;
       begin
-        valid_for_formal_const:=is_procsym_load(p) or (p.resulttype.def.deftype=formaldef) or
+        valid_for_formal_const:=(p.resulttype.def.deftype=formaldef) or
           valid_for_assign(p,[valid_void,valid_const,valid_property]);
       end;
 
@@ -1113,6 +1145,12 @@ implementation
       end;
 
 
+    function  valid_for_addr(p : tnode) : boolean;
+      begin
+        result:=valid_for_assign(p,[valid_const,valid_addr,valid_void]);
+      end;
+
+
     procedure var_para_allowed(var eq:tequaltype;def_from,def_to:Tdef);
       begin
         { Note: eq must be already valid, it will only be updated! }
@@ -1933,7 +1971,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.105  2004-11-29 21:40:54  peter
+  Revision 1.106  2004-12-05 12:28:10  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.105  2004/11/29 21:40:54  peter
     * fixed wrong calculation for checking default parameters
 
   Revision 1.104  2004/11/15 23:35:31  peter

compiler/ncal.pas

@@ -24,8 +24,6 @@ unit ncal;
 
 {$i fpcdefs.inc}
 
-{ define NODEINLINE}
-
 interface
 
     uses
@@ -2053,7 +2051,7 @@ type
                     tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,tt_persistent,tparavarsym(para.parasym).varregable<>vr_none);
                     addstatement(createstatement,tempnode);
                     addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
-                      caddrnode.create(para.left)));
+                      caddrnode.create_internal(para.left)));
                     para.left := ctypeconvnode.create_internal(cderefnode.create(ctemprefnode.create(tempnode)),para.left.resulttype);
                     addstatement(deletestatement,ctempdeletenode.create(tempnode));
                   end;
@@ -2081,7 +2079,8 @@ type
         body : tnode;
         i: longint;
       begin
-        if not assigned(tprocdef(procdefinition).inlininginfo^.code) then
+        if not(assigned(tprocdef(procdefinition).inlininginfo) and
+               assigned(tprocdef(procdefinition).inlininginfo^.code)) then
           internalerror(200412021);
         { inherit flags }
         current_procinfo.flags := current_procinfo.flags + ((procdefinition as tprocdef).inlininginfo^.flags*inherited_inlining_flags);
@@ -2121,15 +2120,13 @@ type
       begin
          result:=nil;
 
-{$ifdef NODEINLINE}
+         { Can we inline the procedure? }
          if (procdefinition.proccalloption=pocall_inline) and
-            { can we inline this procedure at the node level? }
-            (tprocdef(procdefinition).inlininginfo^.inlinenode) then
+            (po_has_inlininginfo in procdefinition.procoptions) then
            begin
              result:=pass1_inline;
              exit;
            end;
-{$endif NODEINLINE}
 
          { calculate the parameter info for the procdef }
          if not procdefinition.has_paraloc_info then
@@ -2435,7 +2432,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.267  2004-12-03 16:07:04  peter
+  Revision 1.268  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.267  2004/12/03 16:07:04  peter
     * fix crashes with nodeinlining
 
   Revision 1.266  2004/12/02 19:26:14  peter

compiler/ncgcal.pas

@@ -402,16 +402,7 @@ implementation
                   if (parasym.varspez=vs_const) and
                      (left.location.loc=LOC_CONSTANT) then
                     location_force_mem(exprasmlist,left.location);
-
-                  { allow (typecasted) @var }
-                  hp:=left;
-                  while (hp.nodetype=typeconvn) do
-                    hp:=ttypeconvnode(hp).left;
-                  if (hp.nodetype=addrn) and
-                     (not(nf_procvarload in hp.flags)) then
-                    cg.a_param_loc(exprasmlist,left.location,tempcgpara)
-                  else
-                    push_addr_para;
+                  push_addr_para;
                end
              { Normal parameter }
              else
@@ -1262,7 +1253,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.189  2004-12-02 19:26:15  peter
+  Revision 1.190  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.189  2004/12/02 19:26:15  peter
     * disable pass2inline
 
   Revision 1.188  2004/11/21 18:13:31  peter

compiler/ncgcnv.pas

@@ -319,20 +319,15 @@ interface
 
 
     procedure tcgtypeconvnode.second_proc_to_procvar;
-
       begin
-        { method pointer ? }
-        if tabstractprocdef(left.resulttype.def).is_methodpointer and
-           not(tabstractprocdef(left.resulttype.def).is_addressonly) then
+        if tabstractprocdef(resulttype.def).is_addressonly then
           begin
-             location_copy(location,left.location);
+            location_reset(location,LOC_REGISTER,OS_ADDR);
+            location.register:=cg.getaddressregister(exprasmlist);
+            cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register);
           end
         else
-          begin
-             location_reset(location,LOC_REGISTER,OS_ADDR);
-             location.register:=cg.getaddressregister(exprasmlist);
-             cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register);
-          end;
+          location_copy(location,left.location);
       end;
 
 
@@ -534,7 +529,13 @@ end.
 
 {
   $Log$
-  Revision 1.65  2004-11-29 21:02:08  peter
+  Revision 1.66  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.65  2004/11/29 21:02:08  peter
     * location_force_reg in second_nothing can reuse LOC_CREGISTER
 
   Revision 1.64  2004/11/29 17:32:56  peter

compiler/ncgmem.pas

@@ -207,26 +207,9 @@ implementation
       begin
          secondpass(left);
 
-         { when loading procvar we do nothing with this node, so load the
-           location of left }
-         if nf_procvarload in flags then
-          begin
-            location_copy(location,left.location);
-            exit;
-          end;
-
          location_reset(location,LOC_REGISTER,OS_ADDR);
          location.register:=cg.getaddressregister(exprasmlist);
-         { @ on a procvar means returning an address to the procedure that
-           is stored in it }
-         if (m_tp_procvar in aktmodeswitches) and
-            (left.nodetype=loadn) and
-            (tloadnode(left).resulttype.def.deftype=procvardef) and
-            assigned(tloadnode(left).symtableentry) and
-            (tloadnode(left).symtableentry.typ in [globalvarsym,localvarsym,paravarsym]) then
-           cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,left.location.reference,location.register)
-         else
-           cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register);
+         cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register);
       end;
 
 
@@ -878,7 +861,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.102  2004-11-08 22:09:59  peter
+  Revision 1.103  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.102  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.101  2004/11/01 23:30:11  peter

compiler/ncgset.pas

@@ -91,7 +91,7 @@ implementation
       paramgr,
       pass_2,tgobj,
       nbas,ncon,nflw,
-      ncgutil,regvars,cpuinfo,
+      ncgutil,regvars,
       cgutils;
 
 
@@ -806,7 +806,7 @@ implementation
                      end
                    else
                      begin
-                        max_dist:=4*aword(labels);
+                        max_dist:=4*labelcnt;
                         if jumptable_no_range then
                           max_linear_list:=4
                         else
@@ -870,7 +870,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.71  2004-11-30 18:13:39  jonas
+  Revision 1.72  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.71  2004/11/30 18:13:39  jonas
     * patch from Peter to fix inlining of case statements
 
   Revision 1.70  2004/10/31 21:45:03  peter

compiler/ncgutil.pas

@@ -105,8 +105,10 @@ interface
 
     procedure gen_alloc_symtable(list:TAAsmoutput;st:tsymtable);
     procedure gen_free_symtable(list:TAAsmoutput;st:tsymtable);
+{$ifdef PASS2INLINE}
     procedure gen_alloc_inline_parast(list:TAAsmoutput;pd:tprocdef);
     procedure gen_alloc_inline_funcret(list:TAAsmoutput;pd:tprocdef);
+{$endif PASS2INLINE}
 
     { rtti and init/final }
     procedure generate_rtti(p:Ttypesym);
@@ -2075,6 +2077,7 @@ implementation
       end;
 
 
+{$ifdef PASS2INLINE}
     procedure gen_alloc_inline_parast(list:TAAsmoutput;pd:tprocdef);
       var
         sym : tsym;
@@ -2166,12 +2169,12 @@ implementation
                 end;
               LOC_REGISTER:
                 begin
-{$ifndef cpu64bit}
+  {$ifndef cpu64bit}
                   if callerparaloc.size in [OS_64,OS_S64] then
                     begin
                     end
                   else
-{$endif cpu64bit}
+  {$endif cpu64bit}
                     begin
                       pd.funcretloc[calleeside].register:=cg.getintregister(list,pd.funcretloc[calleeside].size);
                       pd.funcretloc[callerside].register:=pd.funcretloc[calleeside].register;
@@ -2204,6 +2207,7 @@ implementation
               end;
           end;
       end;
+{$endif PASS2INLINE}
 
 
     { persistent rtti generation }
@@ -2282,7 +2286,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.246  2004-12-03 16:06:31  peter
+  Revision 1.247  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.246  2004/12/03 16:06:31  peter
     * fix for int64 parameters passed in a single LOC_REFERENCE of 8 bytes
 
   Revision 1.245  2004/11/21 18:13:31  peter

compiler/ncnv.pas

@@ -40,6 +40,7 @@ interface
           constructor create(node : tnode;const t : ttype);virtual;
           constructor create_explicit(node : tnode;const t : ttype);
           constructor create_internal(node : tnode;const t : ttype);
+          constructor create_proc_to_procvar(node : tnode);
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
@@ -75,6 +76,7 @@ interface
           function resulttype_call_helper(c : tconverttype) : tnode;
           function resulttype_variant_to_enum : tnode;
           function resulttype_enum_to_variant : tnode;
+          function resulttype_proc_to_procvar : tnode;
        protected
           function first_int_to_int : tnode;virtual;
           function first_cstring_to_pchar : tnode;virtual;
@@ -198,9 +200,9 @@ interface
 implementation
 
    uses
-      globtype,systems,
+      cclasses,globtype,systems,
       cutils,verbose,globals,widestr,
-      symconst,symdef,symsym,symtable,
+      symconst,symdef,symsym,symbase,symtable,
       ncon,ncal,nset,nadd,ninl,nmem,nmat,nutils,
       cgbase,procinfo,
       htypechk,pass_1,cpuinfo;
@@ -500,7 +502,7 @@ implementation
 
       begin
          inherited create(typeconvn,node);
-         convtype:=tc_not_possible;
+         convtype:=tc_none;
          totype:=t;
          if t.def=nil then
           internalerror(200103281);
@@ -526,6 +528,14 @@ implementation
       end;
 
 
+    constructor ttypeconvnode.create_proc_to_procvar(node : tnode);
+
+      begin
+         self.create(node,voidtype);
+         convtype:=tc_proc_2_procvar;
+      end;
+
+
     constructor ttypeconvnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
       begin
         inherited ppuload(t,ppufile);
@@ -948,6 +958,7 @@ implementation
          { evaluate again, reset resulttype so the convert_typ
            will be calculated again and cstring_to_pchar will
            be used for futher conversion }
+         convtype:=tc_none;
          result:=det_resulttype;
       end;
 
@@ -1027,7 +1038,7 @@ implementation
       begin
         result := ccallnode.createinternres(
           'fpc_variant_to_dynarray',
-          ccallparanode.create(caddrnode.create(crttinode.create(tstoreddef(resulttype.def),initrtti)),
+          ccallparanode.create(caddrnode.create_internal(crttinode.create(tstoreddef(resulttype.def),initrtti)),
             ccallparanode.create(left,nil)
           ),resulttype);
         resulttypepass(result);
@@ -1040,7 +1051,7 @@ implementation
       begin
         result := ccallnode.createinternres(
           'fpc_dynarray_to_variant',
-          ccallparanode.create(caddrnode.create(crttinode.create(tstoreddef(resulttype.def),initrtti)),
+          ccallparanode.create(caddrnode.create_internal(crttinode.create(tstoreddef(resulttype.def),initrtti)),
             ccallparanode.create(ctypeconvnode.create_explicit(left,voidpointertype),nil)
           ),resulttype);
         resulttypepass(result);
@@ -1070,10 +1081,61 @@ implementation
       end;
 
 
+    procedure copyparasym(p:TNamedIndexItem;arg:pointer);
+      var
+        newparast : tsymtable absolute arg;
+        vs : tparavarsym;
+      begin
+        if tsym(p).typ<>paravarsym then
+          exit;
+        with tparavarsym(p) do
+          begin
+            vs:=tparavarsym.create(realname,paranr,varspez,vartype);
+            vs.varoptions:=varoptions;
+            vs.defaultconstsym:=defaultconstsym;
+            newparast.insert(vs);
+          end;
+      end;
+
+
+    function ttypeconvnode.resulttype_proc_to_procvar : tnode;
+      var
+        pd : tabstractprocdef;
+      begin
+        result:=nil;
+        pd:=tabstractprocdef(left.resulttype.def);
+
+        { create procvardef }
+        resulttype.setdef(tprocvardef.create(pd.parast.symtablelevel));
+        tprocvardef(resulttype.def).proctypeoption:=pd.proctypeoption;
+        tprocvardef(resulttype.def).proccalloption:=pd.proccalloption;
+        tprocvardef(resulttype.def).procoptions:=pd.procoptions;
+        tprocvardef(resulttype.def).rettype:=pd.rettype;
+
+        { method ? then set the methodpointer flag }
+        if (pd.owner.symtabletype=objectsymtable) then
+          include(tprocvardef(resulttype.def).procoptions,po_methodpointer);
+
+        { only need the address of the method? this is needed
+          for @tobject.create. In this case there will be a loadn without
+          a methodpointer. }
+        if (left.nodetype=loadn) and
+           not assigned(tloadnode(left).left) then
+          include(tprocvardef(resulttype.def).procoptions,po_addressonly);
+
+        { Add parameters use only references, we don't need to keep the
+          parast. We use the parast from the original function to calculate
+          our parameter data and reset it afterwards }
+        pd.parast.foreach_static(@copyparasym,tprocvardef(resulttype.def).parast);
+        tprocvardef(resulttype.def).calcparas;
+      end;
+
+
     function ttypeconvnode.resulttype_call_helper(c : tconverttype) : tnode;
 {$ifdef fpc}
       const
          resulttypeconvert : array[tconverttype] of pointer = (
+          {none} nil,
           {equal} nil,
           {not_possible} nil,
           { string_2_string } @ttypeconvnode.resulttype_string_to_string,
@@ -1094,7 +1156,7 @@ implementation
           { real_2_real } @ttypeconvnode.resulttype_real_to_real,
           { int_2_real } @ttypeconvnode.resulttype_int_to_real,
           { real_2_currency } @ttypeconvnode.resulttype_real_to_currency,
-          { proc_2_procvar } nil,
+          { proc_2_procvar } @ttypeconvnode.resulttype_proc_to_procvar,
           { arrayconstructor_2_set } @ttypeconvnode.resulttype_arrayconstructor_to_set,
           { load_smallset } nil,
           { cord_2_pointer } @ttypeconvnode.resulttype_cord_to_pointer,
@@ -1103,12 +1165,12 @@ implementation
           { class_2_intf } nil,
           { char_2_char } @ttypeconvnode.resulttype_char_to_char,
           { normal_2_smallset} nil,
-          { dynarray_2_openarray} @resulttype_dynarray_to_openarray,
-          { pwchar_2_string} @resulttype_pwchar_to_string,
-          { variant_2_dynarray} @resulttype_variant_to_dynarray,
-          { dynarray_2_variant} @resulttype_dynarray_to_variant,
-          { variant_2_enum} @resulttype_variant_to_enum,
-          { enum_2_variant} @resulttype_enum_to_variant
+          { dynarray_2_openarray} @ttypeconvnode.resulttype_dynarray_to_openarray,
+          { pwchar_2_string} @ttypeconvnode.resulttype_pwchar_to_string,
+          { variant_2_dynarray} @ttypeconvnode.resulttype_variant_to_dynarray,
+          { dynarray_2_variant} @ttypeconvnode.resulttype_dynarray_to_variant,
+          { variant_2_enum} @ttypeconvnode.resulttype_variant_to_enum,
+          { enum_2_variant} @ttypeconvnode.resulttype_enum_to_variant
          );
       type
          tprocedureofobject = function : tnode of object;
@@ -1183,7 +1245,8 @@ implementation
         { tp procvar support. Skip typecasts to record or set. Those
           convert on the procvar value. This is used to access the
           fields of a methodpointer }
-        if not(resulttype.def.deftype in [recorddef,setdef]) then
+        if not(nf_load_procvar in flags) and
+           not(resulttype.def.deftype in [recorddef,setdef]) then
           maybe_call_procvar(left,true);
 
         { convert array constructors to sets, because there is no conversion
@@ -1195,242 +1258,229 @@ implementation
             resulttypepass(left);
           end;
 
-        cdoptions:=[cdo_check_operator,cdo_allow_variant];
-        if nf_explicit in flags then
-          include(cdoptions,cdo_explicit);
-        if nf_internal in flags then
-          include(cdoptions,cdo_internal);
-        eq:=compare_defs_ext(left.resulttype.def,resulttype.def,left.nodetype,convtype,aprocdef,cdoptions);
-        case eq of
-          te_exact,
-          te_equal :
-            begin
-              { because is_equal only checks the basetype for sets we need to
-                check here if we are loading a smallset into a normalset }
-              if (resulttype.def.deftype=setdef) and
-                 (left.resulttype.def.deftype=setdef) and
-                 ((tsetdef(resulttype.def).settype = smallset) xor
-                  (tsetdef(left.resulttype.def).settype = smallset)) then
+        if convtype=tc_none then
+          begin
+            cdoptions:=[cdo_check_operator,cdo_allow_variant];
+            if nf_explicit in flags then
+              include(cdoptions,cdo_explicit);
+            if nf_internal in flags then
+              include(cdoptions,cdo_internal);
+            eq:=compare_defs_ext(left.resulttype.def,resulttype.def,left.nodetype,convtype,aprocdef,cdoptions);
+            case eq of
+              te_exact,
+              te_equal :
                 begin
-                  { constant sets can be converted by changing the type only }
-                  if (left.nodetype=setconstn) then
-                   begin
-                     left.resulttype:=resulttype;
-                     result:=left;
-                     left:=nil;
-                     exit;
-                   end;
+                  { because is_equal only checks the basetype for sets we need to
+                    check here if we are loading a smallset into a normalset }
+                  if (resulttype.def.deftype=setdef) and
+                     (left.resulttype.def.deftype=setdef) and
+                     ((tsetdef(resulttype.def).settype = smallset) xor
+                      (tsetdef(left.resulttype.def).settype = smallset)) then
+                    begin
+                      { constant sets can be converted by changing the type only }
+                      if (left.nodetype=setconstn) then
+                       begin
+                         left.resulttype:=resulttype;
+                         result:=left;
+                         left:=nil;
+                         exit;
+                       end;
 
-                  if (tsetdef(resulttype.def).settype <> smallset) then
-                   convtype:=tc_load_smallset
+                      if (tsetdef(resulttype.def).settype <> smallset) then
+                       convtype:=tc_load_smallset
+                      else
+                       convtype := tc_normal_2_smallset;
+                      exit;
+                    end
                   else
-                   convtype := tc_normal_2_smallset;
-                  exit;
-                end
-              else
-               begin
-                 { Only leave when there is no conversion to do.
-                   We can still need to call a conversion routine,
-                   like the routine to convert a stringconstnode }
-                 if convtype in [tc_equal,tc_not_possible] then
-                  begin
-                    left.resulttype:=resulttype;
-                    result:=left;
-                    left:=nil;
-                    exit;
-                  end;
-               end;
-            end;
-
-          te_convert_l1,
-          te_convert_l2,
-          te_convert_l3 :
-            begin
-              { nothing to do }
-            end;
-
-          te_convert_operator :
-            begin
-              include(current_procinfo.flags,pi_do_call);
-              inc(aprocdef.procsym.refs);
-              hp:=ccallnode.create(ccallparanode.create(left,nil),Tprocsym(aprocdef.procsym),nil,nil,[]);
-              { tell explicitly which def we must use !! (PM) }
-              tcallnode(hp).procdefinition:=aprocdef;
-              left:=nil;
-              result:=hp;
-              exit;
-            end;
-
-          te_incompatible :
-            begin
-              { Procedures have a resulttype.def of voiddef and functions of their
-                own resulttype.def. They will therefore always be incompatible with
-                a procvar. Because isconvertable cannot check for procedures we
-                use an extra check for them.}
-              if (m_tp_procvar in aktmodeswitches) and
-                 (resulttype.def.deftype=procvardef) then
-               begin
-                 if is_procsym_load(left) then
-                  begin
-                    if (left.nodetype<>addrn) then
-                     begin
-                       convtype:=tc_proc_2_procvar;
-                       { Now check if the procedure we are going to assign to
-                         the procvar, is compatible with the procvar's type }
-                       if not(nf_explicit in flags) and
-                          (proc_to_procvar_equal(tprocsym(tloadnode(left).symtableentry).first_procdef,
-                                                 tprocvardef(resulttype.def),true)=te_incompatible) then
-                         IncompatibleTypes(tprocsym(tloadnode(left).symtableentry).first_procdef,resulttype.def);
-                       exit;
-                     end;
-                  end
-                 else
-                  if (left.nodetype=calln) and
-                     (tcallnode(left).para_count=0) then
                    begin
-                     if assigned(tcallnode(left).right) then
+                     { Only leave when there is no conversion to do.
+                       We can still need to call a conversion routine,
+                       like the routine to convert a stringconstnode }
+                     if convtype in [tc_equal,tc_not_possible] then
                       begin
-                        { this is already a procvar, if it is really equal
-                          is checked below }
-                        convtype:=tc_equal;
-                        hp:=tcallnode(left).right.getcopy;
-                        currprocdef:=tprocdef(hp.resulttype.def);
-                      end
-                     else
-                      begin
-                        convtype:=tc_proc_2_procvar;
-                        currprocdef:=Tprocsym(Tcallnode(left).symtableprocentry).search_procdef_byprocvardef(Tprocvardef(resulttype.def));
-                        hp:=cloadnode.create_procvar(tprocsym(tcallnode(left).symtableprocentry),
-                            currprocdef,tcallnode(left).symtableproc);
-                        if (tcallnode(left).symtableprocentry.owner.symtabletype=objectsymtable) then
-                         begin
-                           if assigned(tcallnode(left).methodpointer) then
-                             begin
-                               { Under certain circumstances the methodpointer is a loadvmtaddrn
-                                 which isn't possible if it is used as a method pointer, so
-                                 fix this.
-                                 If you change this, ensure that tests/tbs/tw2669.pp still works }
-                               if tcallnode(left).methodpointer.nodetype=loadvmtaddrn then
-                                 tloadnode(hp).set_mp(tloadvmtaddrnode(tcallnode(left).methodpointer).left.getcopy)
-                               else
-                                 tloadnode(hp).set_mp(tcallnode(left).methodpointer.getcopy);
-                             end
-                           else
-                             tloadnode(hp).set_mp(load_self_node);
-                         end;
-                        resulttypepass(hp);
+                        left.resulttype:=resulttype;
+                        result:=left;
+                        left:=nil;
+                        exit;
                       end;
-                     left.free;
-                     left:=hp;
-                     { Now check if the procedure we are going to assign to
-                       the procvar, is compatible with the procvar's type }
-                     if not(nf_explicit in flags) and
-                        (proc_to_procvar_equal(currprocdef,
-                                               tprocvardef(resulttype.def),true)=te_incompatible) then
-                       IncompatibleTypes(left.resulttype.def,resulttype.def);
-                     exit;
                    end;
-               end;
+                end;
 
-              { Handle explicit type conversions }
-              if nf_explicit in flags then
-               begin
-                 { do common tc_equal cast }
-                 convtype:=tc_equal;
+              te_convert_l1,
+              te_convert_l2,
+              te_convert_l3 :
+                begin
+                  { nothing to do }
+                end;
+
+              te_convert_operator :
+                begin
+                  include(current_procinfo.flags,pi_do_call);
+                  inc(aprocdef.procsym.refs);
+                  hp:=ccallnode.create(ccallparanode.create(left,nil),Tprocsym(aprocdef.procsym),nil,nil,[]);
+                  { tell explicitly which def we must use !! (PM) }
+                  tcallnode(hp).procdefinition:=aprocdef;
+                  left:=nil;
+                  result:=hp;
+                  exit;
+                end;
 
-                 { ordinal constants can be resized to 1,2,4,8 bytes }
-                 if (left.nodetype=ordconstn) then
+              te_incompatible :
+                begin
+                  { Procedures have a resulttype.def of voiddef and functions of their
+                    own resulttype.def. They will therefore always be incompatible with
+                    a procvar. Because isconvertable cannot check for procedures we
+                    use an extra check for them.}
+                  if (m_tp_procvar in aktmodeswitches) and
+                     (resulttype.def.deftype=procvardef) then
                    begin
-                     { Insert typeconv for ordinal to the correct size first on left, after
-                       that the other conversion can be done }
-                     htype.reset;
-                     case longint(resulttype.def.size) of
-                       1 :
-                         htype:=s8inttype;
-                       2 :
-                         htype:=s16inttype;
-                       4 :
-                         htype:=s32inttype;
-                       8 :
-                         htype:=s64inttype;
-                     end;
-                     { we need explicit, because it can also be an enum }
-                     if assigned(htype.def) then
-                       inserttypeconv_internal(left,htype)
-                     else
-                       CGMessage2(type_e_illegal_type_conversion,left.resulttype.def.gettypename,resulttype.def.gettypename);
+                      if (left.nodetype=calln) and
+                         (tcallnode(left).para_count=0) then
+                       begin
+                         if assigned(tcallnode(left).right) then
+                          begin
+                            { this is already a procvar, if it is really equal
+                              is checked below }
+                            convtype:=tc_equal;
+                            hp:=tcallnode(left).right.getcopy;
+                            currprocdef:=tprocdef(hp.resulttype.def);
+                          end
+                         else
+                          begin
+                            convtype:=tc_proc_2_procvar;
+                            currprocdef:=Tprocsym(Tcallnode(left).symtableprocentry).search_procdef_byprocvardef(Tprocvardef(resulttype.def));
+                            hp:=cloadnode.create_procvar(tprocsym(tcallnode(left).symtableprocentry),
+                                currprocdef,tcallnode(left).symtableproc);
+                            if (tcallnode(left).symtableprocentry.owner.symtabletype=objectsymtable) then
+                             begin
+                               if assigned(tcallnode(left).methodpointer) then
+                                 begin
+                                   { Under certain circumstances the methodpointer is a loadvmtaddrn
+                                     which isn't possible if it is used as a method pointer, so
+                                     fix this.
+                                     If you change this, ensure that tests/tbs/tw2669.pp still works }
+                                   if tcallnode(left).methodpointer.nodetype=loadvmtaddrn then
+                                     tloadnode(hp).set_mp(tloadvmtaddrnode(tcallnode(left).methodpointer).left.getcopy)
+                                   else
+                                     tloadnode(hp).set_mp(tcallnode(left).methodpointer.getcopy);
+                                 end
+                               else
+                                 tloadnode(hp).set_mp(load_self_node);
+                             end;
+                            resulttypepass(hp);
+                          end;
+                         left.free;
+                         left:=hp;
+                         { Now check if the procedure we are going to assign to
+                           the procvar, is compatible with the procvar's type }
+                         if not(nf_explicit in flags) and
+                            (proc_to_procvar_equal(currprocdef,
+                                                   tprocvardef(resulttype.def),true)=te_incompatible) then
+                           IncompatibleTypes(left.resulttype.def,resulttype.def);
+                         exit;
+                       end;
                    end;
 
-                 { check if the result could be in a register }
-                 if (not(tstoreddef(resulttype.def).is_intregable) and
-                     not(tstoreddef(resulttype.def).is_fpuregable)) or
-                    ((left.resulttype.def.deftype = floatdef) and
-                     (resulttype.def.deftype <> floatdef))  then
-                   make_not_regable(left);
-
-                 { class to class or object to object, with checkobject support }
-                 if (resulttype.def.deftype=objectdef) and
-                    (left.resulttype.def.deftype=objectdef) then
+                  { Handle explicit type conversions }
+                  if nf_explicit in flags then
                    begin
-                     if (cs_check_object in aktlocalswitches) then
-                      begin
-                        if is_class_or_interface(resulttype.def) then
-                         begin
-                           { we can translate the typeconvnode to 'as' when
-                             typecasting to a class or interface }
-                           hp:=casnode.create(left,cloadvmtaddrnode.create(ctypenode.create(resulttype)));
-                           left:=nil;
-                           result:=hp;
-                           exit;
+                     { do common tc_equal cast }
+                     convtype:=tc_equal;
+
+                     { ordinal constants can be resized to 1,2,4,8 bytes }
+                     if (left.nodetype=ordconstn) then
+                       begin
+                         { Insert typeconv for ordinal to the correct size first on left, after
+                           that the other conversion can be done }
+                         htype.reset;
+                         case longint(resulttype.def.size) of
+                           1 :
+                             htype:=s8inttype;
+                           2 :
+                             htype:=s16inttype;
+                           4 :
+                             htype:=s32inttype;
+                           8 :
+                             htype:=s64inttype;
                          end;
-                      end
-                     else
-                      begin
-                        { check if the types are related }
-                        if not(nf_internal in flags) and
-                           (not(tobjectdef(left.resulttype.def).is_related(tobjectdef(resulttype.def)))) and
-                           (not(tobjectdef(resulttype.def).is_related(tobjectdef(left.resulttype.def)))) then
+                         { we need explicit, because it can also be an enum }
+                         if assigned(htype.def) then
+                           inserttypeconv_internal(left,htype)
+                         else
+                           CGMessage2(type_e_illegal_type_conversion,left.resulttype.def.gettypename,resulttype.def.gettypename);
+                       end;
+
+                     { check if the result could be in a register }
+                     if (not(tstoreddef(resulttype.def).is_intregable) and
+                         not(tstoreddef(resulttype.def).is_fpuregable)) or
+                        ((left.resulttype.def.deftype = floatdef) and
+                         (resulttype.def.deftype <> floatdef))  then
+                       make_not_regable(left);
+
+                     { class to class or object to object, with checkobject support }
+                     if (resulttype.def.deftype=objectdef) and
+                        (left.resulttype.def.deftype=objectdef) then
+                       begin
+                         if (cs_check_object in aktlocalswitches) then
                           begin
-                            { Give an error when typecasting class to interface, this is compatible
-                              with delphi }
-                            if is_interface(resulttype.def) and
-                               not is_interface(left.resulttype.def) then
-                              CGMessage2(type_e_classes_not_related,
-                                FullTypeName(left.resulttype.def,resulttype.def),
-                                FullTypeName(resulttype.def,left.resulttype.def))
-                            else
-                              CGMessage2(type_w_classes_not_related,
-                                FullTypeName(left.resulttype.def,resulttype.def),
-                                FullTypeName(resulttype.def,left.resulttype.def))
+                            if is_class_or_interface(resulttype.def) then
+                             begin
+                               { we can translate the typeconvnode to 'as' when
+                                 typecasting to a class or interface }
+                               hp:=casnode.create(left,cloadvmtaddrnode.create(ctypenode.create(resulttype)));
+                               left:=nil;
+                               result:=hp;
+                               exit;
+                             end;
+                          end
+                         else
+                          begin
+                            { check if the types are related }
+                            if not(nf_internal in flags) and
+                               (not(tobjectdef(left.resulttype.def).is_related(tobjectdef(resulttype.def)))) and
+                               (not(tobjectdef(resulttype.def).is_related(tobjectdef(left.resulttype.def)))) then
+                              begin
+                                { Give an error when typecasting class to interface, this is compatible
+                                  with delphi }
+                                if is_interface(resulttype.def) and
+                                   not is_interface(left.resulttype.def) then
+                                  CGMessage2(type_e_classes_not_related,
+                                    FullTypeName(left.resulttype.def,resulttype.def),
+                                    FullTypeName(resulttype.def,left.resulttype.def))
+                                else
+                                  CGMessage2(type_w_classes_not_related,
+                                    FullTypeName(left.resulttype.def,resulttype.def),
+                                    FullTypeName(resulttype.def,left.resulttype.def))
+                              end;
                           end;
-                      end;
-                   end
+                       end
 
+                      else
+                       begin
+                         { only if the same size or formal def }
+                         if not(
+                                (left.resulttype.def.deftype=formaldef) or
+                                (
+                                 not(is_open_array(left.resulttype.def)) and
+                                 (left.resulttype.def.size=resulttype.def.size)
+                                ) or
+                                (
+                                 is_void(left.resulttype.def)  and
+                                 (left.nodetype=derefn)
+                                )
+                               ) then
+                           CGMessage2(type_e_illegal_type_conversion,left.resulttype.def.gettypename,resulttype.def.gettypename);
+                       end;
+                   end
                   else
-                   begin
-                     { only if the same size or formal def }
-                     if not(
-                            (left.resulttype.def.deftype=formaldef) or
-                            (
-                             not(is_open_array(left.resulttype.def)) and
-                             (left.resulttype.def.size=resulttype.def.size)
-                            ) or
-                            (
-                             is_void(left.resulttype.def)  and
-                             (left.nodetype=derefn)
-                            )
-                           ) then
-                       CGMessage2(type_e_illegal_type_conversion,left.resulttype.def.gettypename,resulttype.def.gettypename);
-                   end;
-               end
+                   IncompatibleTypes(left.resulttype.def,resulttype.def);
+                end;
+
               else
-               IncompatibleTypes(left.resulttype.def,resulttype.def);
+                internalerror(200211231);
             end;
-
-          else
-            internalerror(200211231);
-        end;
-
+          end;
         { Give hint or warning for unportable code, exceptions are
            - typecasts from constants
            - void }
@@ -1753,19 +1803,19 @@ implementation
     function ttypeconvnode.first_proc_to_procvar : tnode;
       begin
          first_proc_to_procvar:=nil;
-         if assigned(tunarynode(left).left) then
+         if tabstractprocdef(resulttype.def).is_addressonly then
           begin
-            if (left.expectloc<>LOC_CREFERENCE) then
-              CGMessage(parser_e_illegal_expression);
             registersint:=left.registersint;
-            expectloc:=left.expectloc
+            if registersint<1 then
+              registersint:=1;
+            expectloc:=LOC_REGISTER;
           end
          else
           begin
+            if not(left.expectloc in [LOC_CREFERENCE,LOC_REFERENCE]) then
+              CGMessage(parser_e_illegal_expression);
             registersint:=left.registersint;
-            if registersint<1 then
-              registersint:=1;
-            expectloc:=LOC_REGISTER;
+            expectloc:=left.expectloc
           end
       end;
 
@@ -1920,6 +1970,7 @@ implementation
 
       const
          firstconvert : array[tconverttype] of pointer = (
+           nil, { none }
            @ttypeconvnode._first_nothing, {equal}
            @ttypeconvnode._first_nothing, {not_possible}
            nil, { removed in resulttype_string_to_string }
@@ -2151,44 +2202,44 @@ implementation
 
 
     procedure ttypeconvnode.second_call_helper(c : tconverttype);
-{$ifdef fpc}
       const
          secondconvert : array[tconverttype] of pointer = (
-           @_second_nothing, {equal}
-           @_second_nothing, {not_possible}
-           @_second_nothing, {second_string_to_string, handled in resulttype pass }
-           @_second_char_to_string,
-           @_second_nothing, {char_to_charray}
-           @_second_nothing, { pchar_to_string, handled in resulttype pass }
-           @_second_nothing, {cchar_to_pchar}
-           @_second_cstring_to_pchar,
-           @_second_ansistring_to_pchar,
-           @_second_string_to_chararray,
-           @_second_nothing, { chararray_to_string, handled in resulttype pass }
-           @_second_array_to_pointer,
-           @_second_pointer_to_array,
-           @_second_int_to_int,
-           @_second_int_to_bool,
-           @_second_bool_to_bool,
-           @_second_bool_to_int,
-           @_second_real_to_real,
-           @_second_int_to_real,
-           @_second_nothing, { real_to_currency, handled in resulttype pass }
-           @_second_proc_to_procvar,
-           @_second_nothing, { arrayconstructor_to_set }
-           @_second_nothing, { second_load_smallset, handled in first pass }
-           @_second_cord_to_pointer,
-           @_second_nothing, { interface 2 string }
-           @_second_nothing, { interface 2 guid   }
-           @_second_class_to_intf,
-           @_second_char_to_char,
-           @_second_nothing,  { normal_2_smallset }
-           @_second_nothing,  { dynarray_2_openarray }
-           @_second_nothing,  { pwchar_2_string }
-           @_second_nothing,  { variant_2_dynarray }
-           @_second_nothing,  { dynarray_2_variant}
-           @_second_nothing,  { variant_2_enum }
-           @_second_nothing   { enum_2_variant }
+           @ttypeconvnode._second_nothing, {none}
+           @ttypeconvnode._second_nothing, {equal}
+           @ttypeconvnode._second_nothing, {not_possible}
+           @ttypeconvnode._second_nothing, {second_string_to_string, handled in resulttype pass }
+           @ttypeconvnode._second_char_to_string,
+           @ttypeconvnode._second_nothing, {char_to_charray}
+           @ttypeconvnode._second_nothing, { pchar_to_string, handled in resulttype pass }
+           @ttypeconvnode._second_nothing, {cchar_to_pchar}
+           @ttypeconvnode._second_cstring_to_pchar,
+           @ttypeconvnode._second_ansistring_to_pchar,
+           @ttypeconvnode._second_string_to_chararray,
+           @ttypeconvnode._second_nothing, { chararray_to_string, handled in resulttype pass }
+           @ttypeconvnode._second_array_to_pointer,
+           @ttypeconvnode._second_pointer_to_array,
+           @ttypeconvnode._second_int_to_int,
+           @ttypeconvnode._second_int_to_bool,
+           @ttypeconvnode._second_bool_to_bool,
+           @ttypeconvnode._second_bool_to_int,
+           @ttypeconvnode._second_real_to_real,
+           @ttypeconvnode._second_int_to_real,
+           @ttypeconvnode._second_nothing, { real_to_currency, handled in resulttype pass }
+           @ttypeconvnode._second_proc_to_procvar,
+           @ttypeconvnode._second_nothing, { arrayconstructor_to_set }
+           @ttypeconvnode._second_nothing, { second_load_smallset, handled in first pass }
+           @ttypeconvnode._second_cord_to_pointer,
+           @ttypeconvnode._second_nothing, { interface 2 string }
+           @ttypeconvnode._second_nothing, { interface 2 guid   }
+           @ttypeconvnode._second_class_to_intf,
+           @ttypeconvnode._second_char_to_char,
+           @ttypeconvnode._second_nothing,  { normal_2_smallset }
+           @ttypeconvnode._second_nothing,  { dynarray_2_openarray }
+           @ttypeconvnode._second_nothing,  { pwchar_2_string }
+           @ttypeconvnode._second_nothing,  { variant_2_dynarray }
+           @ttypeconvnode._second_nothing,  { dynarray_2_variant}
+           @ttypeconvnode._second_nothing,  { variant_2_enum }
+           @ttypeconvnode._second_nothing   { enum_2_variant }
          );
       type
          tprocedureofobject = procedure of object;
@@ -2206,46 +2257,7 @@ implementation
          r.obj:=self;
          tprocedureofobject(r)();
       end;
-{$else fpc}
-     begin
-        case c of
-          tc_equal,
-          tc_not_possible,
-          tc_string_2_string : second_nothing;
-          tc_char_2_string : second_char_to_string;
-          tc_char_2_chararray : second_nothing;
-          tc_pchar_2_string : second_nothing;
-          tc_cchar_2_pchar : second_nothing;
-          tc_cstring_2_pchar : second_cstring_to_pchar;
-          tc_ansistring_2_pchar : second_ansistring_to_pchar;
-          tc_string_2_chararray : second_string_to_chararray;
-          tc_chararray_2_string : second_nothing;
-          tc_array_2_pointer : second_array_to_pointer;
-          tc_pointer_2_array : second_pointer_to_array;
-          tc_int_2_int : second_int_to_int;
-          tc_int_2_bool : second_int_to_bool;
-          tc_bool_2_bool : second_bool_to_bool;
-          tc_bool_2_int : second_bool_to_int;
-          tc_real_2_real : second_real_to_real;
-          tc_int_2_real : second_int_to_real;
-          tc_real_2_currency : second_nothing;
-          tc_proc_2_procvar : second_proc_to_procvar;
-          tc_arrayconstructor_2_set : second_nothing;
-          tc_load_smallset : second_nothing;
-          tc_cord_2_pointer : second_cord_to_pointer;
-          tc_intf_2_string : second_nothing;
-          tc_intf_2_guid : second_nothing;
-          tc_class_2_intf : second_class_to_intf;
-          tc_char_2_char : second_char_to_char;
-          tc_normal_2_smallset : second_nothing;
-          tc_dynarray_2_openarray : second_nothing;
-          tc_pwchar_2_string : second_nothing;
-          tc_variant_2_dynarray : second_nothing;
-          tc_dynarray_2_variant : second_nothing;
-          else internalerror(2002101101);
-        end;
-     end;
-{$endif fpc}
+
 
 {*****************************************************************************
                                 TISNODE
@@ -2486,7 +2498,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.165  2004-12-05 12:15:11  florian
+  Revision 1.166  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.165  2004/12/05 12:15:11  florian
     * fixed compiler side of variant <-> dyn. array conversion
 
   Revision 1.164  2004/11/26 22:34:28  peter

compiler/ninl.pas

@@ -424,7 +424,7 @@ implementation
                 { assign the address of the file to the temp }
                 addstatement(newstatement,
                   cassignmentnode.create(ctemprefnode.create(filetemp),
-                    caddrnode.create(filepara.left)));
+                    caddrnode.create_internal(filepara.left)));
                 resulttypepass(newstatement.left);
                 { create a new fileparameter as follows: file_type(temp^)    }
                 { (so that we pass the value and not the address of the temp }
@@ -2160,7 +2160,7 @@ implementation
                        tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,tt_persistent,true);
                        addstatement(newstatement,tempnode);
                        addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
-                         caddrnode.create(tcallparanode(left).left.getcopy)));
+                         caddrnode.create_internal(tcallparanode(left).left.getcopy)));
                        hp := cderefnode.create(ctemprefnode.create(tempnode));
                        inserttypeconv_internal(hp,tcallparanode(left).left.resulttype);
                      end
@@ -2463,7 +2463,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.155  2004-11-26 22:33:00  peter
+  Revision 1.156  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.155  2004/11/26 22:33:00  peter
     * fixed read temp for result
 
   Revision 1.154  2004/11/21 21:27:31  peter

compiler/nld.pas

@@ -595,7 +595,7 @@ implementation
         if is_dynamic_array(left.resulttype.def) and
            (right.nodetype=niln) then
          begin
-           hp:=ccallparanode.create(caddrnode.create
+           hp:=ccallparanode.create(caddrnode.create_internal
                    (crttinode.create(tstoreddef(left.resulttype.def),initrtti)),
                ccallparanode.create(ctypeconvnode.create_internal(left,voidpointertype),nil));
            result := ccallnode.createintern('fpc_dynarray_clear',hp);
@@ -1172,7 +1172,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.139  2004-11-08 22:09:59  peter
+  Revision 1.140  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.139  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.138  2004/11/02 12:55:16  peter

compiler/nmem.pas

@@ -56,6 +56,7 @@ interface
           getprocvardef : tprocvardef;
           getprocvardefderef : tderef;
           constructor create(l : tnode);virtual;
+          constructor create_internal(l : tnode); virtual;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure mark_write;override;
@@ -127,7 +128,7 @@ implementation
 
     uses
       globtype,systems,
-      cutils,cclasses,verbose,globals,
+      cutils,verbose,globals,
       symconst,symbase,defutil,defcmp,
       nbas,nutils,
       htypechk,pass_1,ncal,nld,ncon,ncnv,cgbase,procinfo
@@ -255,6 +256,13 @@ implementation
       end;
 
 
+    constructor taddrnode.create_internal(l : tnode);
+      begin
+        self.create(l);
+        include(flags,nf_internal);
+      end;
+
+
     constructor taddrnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
       begin
         inherited ppuload(t,ppufile);
@@ -301,29 +309,11 @@ implementation
       end;
 
 
-    procedure copyparasym(p:TNamedIndexItem;arg:pointer);
-      var
-        newparast : tsymtable absolute arg;
-        vs : tparavarsym;
-      begin
-        if tsym(p).typ<>paravarsym then
-          exit;
-        with tparavarsym(p) do
-          begin
-            vs:=tparavarsym.create(realname,paranr,varspez,vartype);
-            vs.varoptions:=varoptions;
-//            vs.paraloc[callerside]:=paraloc[callerside].getcopy;
-//            vs.paraloc[callerside]:=paraloc[callerside].getcopy;
-            vs.defaultconstsym:=defaultconstsym;
-            newparast.insert(vs);
-          end;
-      end;
-
-
     function taddrnode.det_resulttype:tnode;
       var
          hp  : tnode;
-         hp3 : tabstractprocdef;
+         hsym : tfieldvarsym;
+         isprocvar : boolean;
       begin
         result:=nil;
         resulttypepass(left);
@@ -340,137 +330,94 @@ implementation
            exit;
          end;
 
-        { tp @procvar support (type of @procvar is a void pointer)
-          Note: we need to leave the addrn in the tree,
-          else we can't see the difference between @procvar and procvar.
-          we set the procvarload flag so a secondpass does nothing for
-          this node (PFV) }
-        if (m_tp_procvar in aktmodeswitches) then
-         begin
-           case left.nodetype of
-             calln :
-               begin
-                 { a load of a procvar can't have parameters }
-                 if assigned(tcallnode(left).left) then
-                   CGMessage(parser_e_illegal_expression);
-                 { is it a procvar? }
-                 hp:=tcallnode(left).right;
-                 if assigned(hp) then
-                   begin
-                     { remove calln node }
-                     tcallnode(left).right:=nil;
-                     left.free;
-                     left:=hp;
-                     include(flags,nf_procvarload);
-                   end;
-               end;
-             loadn,
-             subscriptn,
-             typeconvn,
-             vecn,
-             derefn :
-               begin
-                 if left.resulttype.def.deftype=procvardef then
-                   include(flags,nf_procvarload);
-               end;
-           end;
-           if nf_procvarload in flags then
-            begin
-              resulttype:=voidpointertype;
-              exit;
-            end;
-         end;
-
-        { proc 2 procvar ? }
-        if left.nodetype=calln then
-         { if it were a valid construct, the addr node would already have }
-         { been removed in the parser. This happens for (in FPC mode)     }
-         { procvar1 := @procvar2(parameters);                             }
-         CGMessage(parser_e_illegal_expression)
-        else
-         if (left.nodetype=loadn) and (tloadnode(left).symtableentry.typ=procsym) then
+        { Handle @proc special, also @procvar in tp-mode needs
+          special handling }
+        if (left.resulttype.def.deftype=procdef) or
+           ((left.resulttype.def.deftype=procvardef) and
+            (m_tp_procvar in aktmodeswitches)) then
           begin
-            { result is a procedure variable }
-            { No, to be TP compatible, you must return a voidpointer to
-              the procedure that is stored in the procvar.}
-            if not(m_tp_procvar in aktmodeswitches) then
+            isprocvar:=(left.resulttype.def.deftype=procvardef);
+
+            if not isprocvar then
+              begin
+                left:=ctypeconvnode.create_proc_to_procvar(left);
+                resulttypepass(left);
+              end;
+
+            { In tp procvar mode the result is always a voidpointer. Insert
+              a typeconversion to voidpointer. For methodpointers we need
+              to load the proc field }
+            if (m_tp_procvar in aktmodeswitches) then
               begin
-                 if assigned(getprocvardef) and
-                    (tprocsym(tloadnode(left).symtableentry).procdef_count>1) then
+                if tabstractprocdef(left.resulttype.def).is_addressonly then
                   begin
-                    hp3:=tprocsym(tloadnode(left).symtableentry).search_procdef_byprocvardef(getprocvardef);
-                    if not assigned(hp3)  then
-                     begin
-                       IncompatibleTypes(tprocsym(tloadnode(left).symtableentry).first_procdef,getprocvardef);
-                       exit;
-                     end;
+                    result:=ctypeconvnode.create_internal(left,voidpointertype);
+                    include(result.flags,nf_load_procvar);
+                    left:=nil;
                   end
-                 else
-                  hp3:=tabstractprocdef(tprocsym(tloadnode(left).symtableentry).first_procdef);
-
-                 { create procvardef }
-                 resulttype.setdef(tprocvardef.create(hp3.parast.symtablelevel));
-                 tprocvardef(resulttype.def).proctypeoption:=hp3.proctypeoption;
-                 tprocvardef(resulttype.def).proccalloption:=hp3.proccalloption;
-                 tprocvardef(resulttype.def).procoptions:=hp3.procoptions;
-                 tprocvardef(resulttype.def).rettype:=hp3.rettype;
-
-                 { method ? then set the methodpointer flag }
-                 if (hp3.owner.symtabletype=objectsymtable) then
-                   include(tprocvardef(resulttype.def).procoptions,po_methodpointer);
-
-                 { only need the address of the method? this is needed
-                   for @tobject.create }
-                 if assigned(tloadnode(left).left) then
-                   include(flags,nf_procvarload)
-                 else
-                   include(tprocvardef(resulttype.def).procoptions,po_addressonly);
-
-                 { Add parameters use only references, we don't need to keep the
-                   parast. We use the parast from the original function to calculate
-                   our parameter data and reset it afterwards }
-                 hp3.parast.foreach_static(@copyparasym,tprocvardef(resulttype.def).parast);
-                 tprocvardef(resulttype.def).calcparas;
+                else
+                  begin
+                    { For procvars we need to return the proc field of the
+                      methodpointer }
+                    if isprocvar then
+                      begin
+                        { find proc field in methodpointer record }
+                        hsym:=tfieldvarsym(trecorddef(methodpointertype.def).symtable.search('proc'));
+                        if not assigned(hsym) then
+                          internalerror(200412041);
+                        { Load tmehodpointer(left).proc }
+                        result:=csubscriptnode.create(
+                                     hsym,
+                                     ctypeconvnode.create_internal(left,methodpointertype));
+                        left:=nil;
+                      end
+                    else
+                      CGMessage(type_e_variable_id_expected);
+                  end;
               end
             else
               begin
-                if assigned(tloadnode(left).left) then
-                  CGMessage(parser_e_illegal_expression);
-                resulttype:=voidpointertype;
+                { Return the typeconvn only }
+                result:=left;
+                left:=nil;
               end;
           end
         else
           begin
             { what are we getting the address from an absolute sym? }
             hp:=left;
-            while assigned(hp) and (hp.nodetype in [vecn,derefn,subscriptn]) do
-             hp:=tunarynode(hp).left;
+            while assigned(hp) and (hp.nodetype in [typeconvn,vecn,derefn,subscriptn]) do
+              hp:=tunarynode(hp).left;
+            if not assigned(hp) then
+              internalerror(200412042);
 {$ifdef i386}
-            if assigned(hp) and
-               (hp.nodetype=loadn) and
+            if (hp.nodetype=loadn) and
                ((tloadnode(hp).symtableentry.typ=absolutevarsym) and
-                tabsolutevarsym(tloadnode(hp).symtableentry).absseg) then
-             begin
-               if not(nf_typedaddr in flags) then
-                 resulttype:=voidfarpointertype
-               else
-                 resulttype.setdef(tpointerdef.createfar(left.resulttype));
-             end
+               tabsolutevarsym(tloadnode(hp).symtableentry).absseg) then
+              begin
+                if not(nf_typedaddr in flags) then
+                  resulttype:=voidfarpointertype
+                else
+                  resulttype.setdef(tpointerdef.createfar(left.resulttype));
+              end
             else
 {$endif i386}
-             begin
-               if not(nf_typedaddr in flags) then
-                 resulttype:=voidpointertype
-               else
-                 resulttype.setdef(tpointerdef.create(left.resulttype));
-             end;
+              if (nf_internal in flags) or
+                 valid_for_addr(left) then
+                begin
+                  if not(nf_typedaddr in flags) then
+                    resulttype:=voidpointertype
+                  else
+                    resulttype.setdef(tpointerdef.create(left.resulttype));
+                end
+            else
+              CGMessage(type_e_variable_id_expected);
           end;
 
          { this is like the function addr }
          inc(parsing_para_level);
          set_varstate(left,vs_used,false);
          dec(parsing_para_level);
-
       end;
 
 
@@ -481,19 +428,6 @@ implementation
          if codegenerror then
           exit;
 
-         if nf_procvarload in flags then
-          begin
-            registersint:=left.registersint;
-            registersfpu:=left.registersfpu;
-{$ifdef SUPPORT_MMX}
-            registersmmx:=left.registersmmx;
-{$endif SUPPORT_MMX}
-            if registersint<1 then
-             registersint:=1;
-            expectloc:=left.expectloc;
-            exit;
-          end;
-
          { we should allow loc_mem for @string }
          if not(left.expectloc in [LOC_CREFERENCE,LOC_REFERENCE]) then
            begin
@@ -997,7 +931,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.91  2004-11-29 17:32:56  peter
+  Revision 1.92  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.91  2004/11/29 17:32:56  peter
     * prevent some IEs with delphi methodpointers
 
   Revision 1.90  2004/11/26 22:33:24  peter

compiler/node.pas

@@ -205,7 +205,6 @@ interface
          nf_isproperty,
 
          { taddrnode }
-         nf_procvarload,
          nf_typedaddr,
 
          { tderefnode }
@@ -235,6 +234,7 @@ interface
          { ttypeconvnode }
          nf_explicit,
          nf_internal,  { no warnings/hints generated }
+         nf_load_procvar,
 
          { tinlinenode }
          nf_inlineconst,
@@ -1139,7 +1139,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.91  2004-12-02 19:26:15  peter
+  Revision 1.92  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.91  2004/12/02 19:26:15  peter
     * disable pass2inline
 
   Revision 1.90  2004/11/02 12:55:16  peter

compiler/nutils.pas

@@ -417,11 +417,11 @@ implementation
           begin
             result:=ccallnode.createintern('fpc_initialize',
                   ccallparanode.create(
-                      caddrnode.create(
+                      caddrnode.create_internal(
                           crttinode.create(
                               tstoreddef(p.resulttype.def),initrtti)),
                   ccallparanode.create(
-                      caddrnode.create(p),
+                      caddrnode.create_internal(p),
                   nil)));
           end;
       end;
@@ -433,11 +433,11 @@ implementation
           resulttypepass(p);
         result:=ccallnode.createintern('fpc_finalize',
               ccallparanode.create(
-                  caddrnode.create(
+                  caddrnode.create_internal(
                       crttinode.create(
                           tstoreddef(p.resulttype.def),initrtti)),
               ccallparanode.create(
-                  caddrnode.create(p),
+                  caddrnode.create_internal(p),
               nil)));
       end;
 
@@ -466,9 +466,9 @@ implementation
                 end;
               loadn:
                 begin
-		  { threadvars need a helper call }
+                  { threadvars need a helper call }
                   if (tloadnode(p).symtableentry.typ=globalvarsym) and
-		     (vo_is_thread_var in tglobalvarsym(tloadnode(p).symtableentry).varoptions) then
+                     (vo_is_thread_var in tglobalvarsym(tloadnode(p).symtableentry).varoptions) then
                     inc(result,5)
                   else
                     inc(result);
@@ -530,7 +530,13 @@ end.
 
 {
   $Log$
-  Revision 1.23  2004-12-02 19:26:15  peter
+  Revision 1.24  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.23  2004/12/02 19:26:15  peter
     * disable pass2inline
 
   Revision 1.22  2004/11/28 19:29:45  jonas

compiler/pdecsub.pas

@@ -1821,12 +1821,12 @@ const
             { External Procedures }
             if (po_external in pd.procoptions) then
               begin
-	        { import by number? }
+                { import by number? }
                 if pd.import_nr<>0 then
-		  begin
-		    { Nothing to do }
-		  end
-		else
+                  begin
+                    { Nothing to do }
+                  end
+                else
                 { external name specified }
                   if assigned(pd.import_name) then
                     begin
@@ -1838,12 +1838,12 @@ const
                              (target_info.system in [system_i386_win32,system_i386_wdosx,
                                                      system_i386_emx,system_i386_os2])
                             ) then
-			begin    
+                        begin
                           if not(pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
                             pd.setmangledname(pd.import_name^)
                           else
                             pd.setmangledname(target_info.Cprefix+pd.import_name^);
-			end;    
+                        end;
                     end
                 else
                   begin
@@ -2358,7 +2358,13 @@ const
 end.
 {
   $Log$
-  Revision 1.216  2004-12-05 00:32:56  olle
+  Revision 1.217  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.216  2004/12/05 00:32:56  olle
     + bugfix for $Z+ for mode macpas
 
   Revision 1.215  2004/11/29 21:50:08  peter

compiler/pexpr.pas

@@ -321,7 +321,7 @@ implementation
              htype.setdef(tpointerdef.create(p1.resulttype));
              temp:=ctempcreatenode.create(htype,sizeof(aint),tt_persistent,false);
              addstatement(newstatement,temp);
-             addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(temp),caddrnode.create(p1)));
+             addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(temp),caddrnode.create_internal(p1)));
              addstatement(newstatement,cassignmentnode.create(
                  cderefnode.create(ctemprefnode.create(temp)),
                  caddnode.create(ntyp,
@@ -2505,7 +2505,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.174  2004-11-21 17:54:59  peter
+  Revision 1.175  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.174  2004/11/21 17:54:59  peter
     * ttempcreatenode.create_reg merged into .create with parameter
       whether a register is allowed
     * funcret_paraloc renamed to funcretloc

compiler/pinline.pas

@@ -327,7 +327,7 @@ implementation
             { create call to fpc_initialize }
             if tpointerdef(p1.resulttype.def).pointertype.def.needs_inittable then
              begin
-               para := ccallparanode.create(caddrnode.create(crttinode.create
+               para := ccallparanode.create(caddrnode.create_internal(crttinode.create
                           (tstoreddef(tpointerdef(p1.resulttype.def).pointertype.def),initrtti)),
                        ccallparanode.create(ctemprefnode.create
                           (temp),nil));
@@ -495,11 +495,11 @@ implementation
             ppn.left:=nil;
 
             { create call to fpc_dynarr_setlength }
-            npara:=ccallparanode.create(caddrnode.create
+            npara:=ccallparanode.create(caddrnode.create_internal
                       (ctemprefnode.create(temp)),
                    ccallparanode.create(cordconstnode.create
                       (counter,s32inttype,true),
-                   ccallparanode.create(caddrnode.create
+                   ccallparanode.create(caddrnode.create_internal
                       (crttinode.create(tstoreddef(destppn.resulttype.def),initrtti)),
                    ccallparanode.create(ctypeconvnode.create_internal(destppn,voidpointertype),nil))));
             addstatement(newstatement,ccallnode.createintern('fpc_dynarray_setlength',npara));
@@ -593,9 +593,9 @@ implementation
                      (destppn.left.resulttype.def.size,s32inttype,true),
                   ccallparanode.create(ctypeconvnode.create
                      (ppn.left,s32inttype),
-                  ccallparanode.create(caddrnode.create
+                  ccallparanode.create(caddrnode.create_internal
                      (crttinode.create(tstoreddef(destppn.left.resulttype.def),initrtti)),
-                  ccallparanode.create(caddrnode.create
+                  ccallparanode.create(caddrnode.create_internal
                      (destppn.left),nil))));
            newblock:=ccallnode.createintern('fpc_finalize_array',npara);
            destppn.left:=nil;
@@ -724,7 +724,7 @@ implementation
             { create call to fpc_dynarray_copy }
             npara:=ccallparanode.create(highppn,
                    ccallparanode.create(lowppn,
-                   ccallparanode.create(caddrnode.create
+                   ccallparanode.create(caddrnode.create_internal
                       (crttinode.create(tstoreddef(ppn.left.resulttype.def),initrtti)),
                    ccallparanode.create
                       (ctypeconvnode.create_internal(ppn.left,voidpointertype),
@@ -754,7 +754,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.37  2004-11-21 17:54:59  peter
+  Revision 1.38  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.37  2004/11/21 17:54:59  peter
     * ttempcreatenode.create_reg merged into .create with parameter
       whether a register is allowed
     * funcret_paraloc renamed to funcretloc

compiler/pstatmnt.pas

@@ -489,7 +489,7 @@ implementation
                 end
                else
                 begin
-                  hp:=caddrnode.create(p);
+                  hp:=caddrnode.create_internal(p);
                   refp:=cderefnode.create(ctemprefnode.create(loadp));
                 end;
                addstatement(newstatement,loadp);
@@ -1147,7 +1147,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.146  2004-11-30 18:13:39  jonas
+  Revision 1.147  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.146  2004/11/30 18:13:39  jonas
     * patch from Peter to fix inlining of case statements
 
   Revision 1.145  2004/11/21 17:54:59  peter

compiler/psub.pas

@@ -928,11 +928,9 @@ implementation
          if assigned(code) then
           begin
             { the inline procedure has already got a copy of the tree
-              stored in current_procinfo.procdef.code }
+              stored in procdef.inlininginfo }
             code.free;
             code:=nil;
-            if (procdef.proccalloption<>pocall_inline) then
-              procdef.inlininginfo^.code:=nil;
           end;
        end;
 
@@ -943,8 +941,7 @@ implementation
         currpara : tparavarsym;
       begin
         result := false;
-        if not assigned(procdef.inlininginfo^.code) or
-           (po_assembler in procdef.procoptions) then
+        if (po_assembler in procdef.procoptions) then
           exit;
         for i:=0 to procdef.paras.count-1 do
           begin
@@ -1039,19 +1036,19 @@ implementation
                end;
            end;
 
-         { store a copy of the original tree for inline, for
-           normal procedures only store a reference to the
-           current tree }
          if (procdef.proccalloption=pocall_inline) then
            begin
-             procdef.inlininginfo^.code:=code.getcopy;
-             procdef.inlininginfo^.flags:=current_procinfo.flags;
-             procdef.inlininginfo^.inlinenode:=checknodeinlining(procdef);
-             if procdef.inlininginfo^.code.nodetype=blockn then
-               include(procdef.inlininginfo^.code.flags,nf_block_with_exit);
-           end
-         else
-           procdef.inlininginfo^.code:=code;
+             { Can we inline this procedure? }
+             if checknodeinlining(procdef) then
+               begin
+                 new(procdef.inlininginfo);
+                 include(procdef.procoptions,po_has_inlininginfo);
+                 procdef.inlininginfo^.code:=code.getcopy;
+                 procdef.inlininginfo^.flags:=current_procinfo.flags;
+                 if procdef.inlininginfo^.code.nodetype=blockn then
+                   include(procdef.inlininginfo^.code.flags,nf_block_with_exit);
+               end;
+           end;
 
          { Print the node to tree.log }
          if paraprintnodetree=1 then
@@ -1430,7 +1427,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.221  2004-12-02 19:26:15  peter
+  Revision 1.222  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.221  2004/12/02 19:26:15  peter
     * disable pass2inline
 
   Revision 1.220  2004/11/29 18:50:15  peter

compiler/ptconst.pas

@@ -42,7 +42,7 @@ implementation
        symconst,symbase,symdef,symtable,
        aasmbase,aasmtai,aasmcpu,defutil,defcmp,
        { pass 1 }
-       node,
+       node,htypechk,
        nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,
        { parser specific stuff }
        pbase,pexpr,
@@ -61,7 +61,7 @@ implementation
          Psetbytes = ^setbytes;
       var
          len,base  : longint;
-         p,hp,hpstart : tnode;
+         p,hp      : tnode;
          i,j,l,
          varalign  : longint;
          offset,
@@ -369,32 +369,17 @@ implementation
                       Message(parser_e_illegal_expression);
                 end
               else
-                if p.nodetype=addrn then
+                if (p.nodetype=addrn) or
+                   is_procvar_load(p) then
                   begin
-                    { support @@procvar in tp mode }
-                    if (m_tp_procvar in aktmodeswitches) and
-                       (taddrnode(p).left.nodetype=addrn) then
-                      p:=taddrnode(p).left;
                     { insert typeconv }
                     inserttypeconv(p,t);
-                    { if a typeconv node was inserted then check if it was an tc_equal. If
-                      true then we remove the node. If not tc_equal then we leave the typeconvn
-                      and the nodetype=loadn will always be false and generate the error (PFV) }
-                    if (p.nodetype=typeconvn) then
-                     begin
-                       if (ttypeconvnode(p).convtype=tc_equal) then
-                        hpstart:=taddrnode(ttypeconvnode(p).left).left
-                       else
-                        hpstart:=p;
-                     end
-                    else
-                     hpstart:=taddrnode(p).left;
-                    hp:=hpstart;
-                    while assigned(hp) and (hp.nodetype in [subscriptn,vecn]) do
+                    hp:=p;
+                    while assigned(hp) and (hp.nodetype in [addrn,typeconvn,subscriptn,vecn]) do
                       hp:=tunarynode(hp).left;
                     if (hp.nodetype=loadn) then
                       begin
-                        hp:=hpstart;
+                        hp:=p;
                         offset:=0;
                         while assigned(hp) and (hp.nodetype<>loadn) do
                           begin
@@ -423,7 +408,14 @@ implementation
                                      Message(parser_e_illegal_expression);
                                  end;
                                subscriptn :
-                                 inc(offset,tsubscriptnode(hp).vs.fieldoffset)
+                                 inc(offset,tsubscriptnode(hp).vs.fieldoffset);
+                               typeconvn :
+                                 begin
+                                   if not(ttypeconvnode(hp).convtype in [tc_equal,tc_proc_2_procvar]) then
+                                     Message(parser_e_illegal_expression);
+                                 end;
+                               addrn :
+                                 ;
                                else
                                  Message(parser_e_illegal_expression);
                              end;
@@ -1089,7 +1081,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.96  2004-11-09 17:26:47  peter
+  Revision 1.97  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.96  2004/11/09 17:26:47  peter
     * fixed wrong typecasts
 
   Revision 1.95  2004/11/08 22:09:59  peter

compiler/symconst.pas

@@ -248,7 +248,8 @@ type
     po_has_mangledname,
     po_has_public_name,
     po_forward,
-    po_global
+    po_global,
+    po_has_inlininginfo
   );
   tprocoptions=set of tprocoption;
 
@@ -428,7 +429,13 @@ initialization
 end.
 {
   $Log$
-  Revision 1.95  2004-11-19 08:17:02  michael
+  Revision 1.96  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.95  2004/11/19 08:17:02  michael
   * Split po_public into po_public and po_global (Peter)
 
   Revision 1.94  2004/11/17 22:21:35  peter

compiler/symdef.pas

@@ -494,10 +494,9 @@ interface
        end;
 
        tinlininginfo = record
-         { node tree }
-          code : tnode;
+          { node tree }
+          code  : tnode;
           flags : tprocinfoflags;
-          inlinenode : boolean;
        end;
        pinlininginfo = ^tinlininginfo;
 
@@ -3605,8 +3604,7 @@ implementation
          import_dll:=nil;
          import_name:=nil;
          import_nr:=0;
-         new(inlininginfo);
-         fillchar(inlininginfo^,sizeof(tinlininginfo),0);
+         inlininginfo:=nil;
 {$ifdef GDB}
          isstabwritten := false;
 {$endif GDB}
@@ -3639,22 +3637,24 @@ implementation
          import_name:=nil;
          import_nr:=0;
          { inline stuff }
-         if proccalloption=pocall_inline then
+         if (po_has_inlininginfo in procoptions) then
            begin
              ppufile.getderef(funcretsymderef);
              new(inlininginfo);
              ppufile.getsmallset(inlininginfo^.flags);
-             inlininginfo^.inlinenode:=boolean(ppufile.getbyte);
            end
          else
-           funcretsym:=nil;
+           begin
+             inlininginfo:=nil;
+             funcretsym:=nil;
+           end;
          { load para symtable }
          parast:=tparasymtable.create(level);
          tparasymtable(parast).ppuload(ppufile);
          parast.defowner:=self;
          { load local symtable }
-         if ((proccalloption=pocall_inline) or
-             ((current_module.flags and uf_local_browser)<>0)) then
+         if (po_has_inlininginfo in procoptions) or
+            ((current_module.flags and uf_local_browser)<>0) then
           begin
             localst:=tlocalsymtable.create(level);
             tlocalsymtable(localst).ppuload(ppufile);
@@ -3663,10 +3663,8 @@ implementation
          else
           localst:=nil;
          { inline stuff }
-         if proccalloption=pocall_inline then
-           inlininginfo^.code:=ppuloadnodetree(ppufile)
-         else
-           inlininginfo := nil;
+         if (po_has_inlininginfo in procoptions) then
+           inlininginfo^.code:=ppuloadnodetree(ppufile);
          { default values for no persistent data }
          if (cs_link_deffile in aktglobalswitches) and
             (tf_need_export in target_info.flags) and
@@ -3704,7 +3702,7 @@ implementation
             memproclocalst.start;
 {$endif MEMDEBUG}
           end;
-         if (proccalloption=pocall_inline) and assigned(inlininginfo) then
+         if assigned(inlininginfo) then
           begin
 {$ifdef MEMDEBUG}
             memprocnodetree.start;
@@ -3713,11 +3711,10 @@ implementation
 {$ifdef MEMDEBUG}
             memprocnodetree.start;
 {$endif MEMDEBUG}
+            dispose(inlininginfo);
           end;
          stringdispose(import_dll);
          stringdispose(import_name);
-         if assigned(inlininginfo) then
-           dispose(inlininginfo);
          if (po_msgstr in procoptions) then
            strdispose(messageinf.str);
          if assigned(_mangledname) then
@@ -3768,13 +3765,11 @@ implementation
          { inline stuff }
          oldintfcrc:=ppufile.do_crc;
          ppufile.do_crc:=false;
-         if proccalloption=pocall_inline then
+         if (po_has_inlininginfo in procoptions) then
            begin
              ppufile.putderef(funcretsymderef);
              ppufile.putsmallset(inlininginfo^.flags);
-             ppufile.putbyte(byte(inlininginfo^.inlinenode));
            end;
-
          ppufile.do_crc:=oldintfcrc;
 
          { write this entry }
@@ -3785,7 +3780,7 @@ implementation
 
          { save localsymtable for inline procedures or when local
            browser info is requested, this has no influence on the crc }
-         if (proccalloption=pocall_inline) or
+         if (po_has_inlininginfo in procoptions) or
             ((current_module.flags and uf_local_browser)<>0) then
           begin
             { we must write a localsymtable }
@@ -3800,9 +3795,8 @@ implementation
          { node tree for inlining }
          oldintfcrc:=ppufile.do_crc;
          ppufile.do_crc:=false;
-         if proccalloption=pocall_inline then
+         if (po_has_inlininginfo in procoptions) then
            ppuwritenodetree(ppufile,inlininginfo^.code);
-
          ppufile.do_crc:=oldintfcrc;
 
          aktparasymtable:=oldparasymtable;
@@ -4155,7 +4149,7 @@ implementation
 
          { Locals }
          if assigned(localst) and
-            ((proccalloption=pocall_inline) or
+            ((po_has_inlininginfo in procoptions) or
              ((current_module.flags and uf_local_browser)<>0)) then
            begin
              tlocalsymtable(localst).buildderef;
@@ -4163,7 +4157,7 @@ implementation
            end;
 
          { inline tree }
-         if (proccalloption=pocall_inline) then
+         if (po_has_inlininginfo in procoptions) then
            begin
              funcretsymderef.build(funcretsym);
              inlininginfo^.code.buildderefimpl;
@@ -4221,7 +4215,7 @@ implementation
           end;
 
         { Inline }
-        if (proccalloption=pocall_inline) then
+        if (po_has_inlininginfo in procoptions) then
           begin
             inlininginfo^.code.derefimpl;
             { funcretsym, this is always located in the localst }
@@ -6129,7 +6123,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.281  2004-12-03 15:57:39  peter
+  Revision 1.282  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.281  2004/12/03 15:57:39  peter
     * int64 can also be put in a register
 
   Revision 1.280  2004/11/30 18:13:39  jonas

compiler/systems/t_win32.pas

@@ -244,9 +244,9 @@ implementation
     procedure timportlibwin32.generatesmartlib;
       var
          hp1 : timportlist;
+         mangledstring : string;
 {$ifdef GDB}
          importname : string;
-         mangledstring : string;
          suffix : integer;
 {$endif GDB}
          hp2 : twin32imported_item;
@@ -395,9 +395,9 @@ implementation
          hp1 : timportlist;
          hp2 : twin32imported_item;
          l1,l2,l3,l4 : tasmlabel;
+         mangledstring : string;
 {$ifdef GDB}
          importname : string;
-         mangledstring : string;
          suffix : integer;
 {$endif GDB}
          href : treference;
@@ -1623,7 +1623,13 @@ initialization
 end.
 {
   $Log$
-  Revision 1.45  2004-11-18 10:06:19  michael
+  Revision 1.46  2004-12-05 12:28:11  peter
+    * procvar handling for tp procvar mode fixed
+    * proc to procvar moved from addrnode to typeconvnode
+    * inlininginfo is now allocated only for inline routines that
+      can be inlined, introduced a new flag po_has_inlining_info
+
+  Revision 1.45  2004/11/18 10:06:19  michael
   + Fix for win32 cycle
 
   Revision 1.44  2004/11/17 22:22:12  peter