freepascal.compiler/compiler/tccal.pas

{
    $Id$
    Copyright (c) 1993-98 by Florian Klaempfl

    Type checking and register allocation for call nodes

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

 ****************************************************************************
}
unit tccal;
interface

    uses
      symtable,tree;


    procedure firstcallparan(var p : ptree;defcoll : pdefcoll);
    procedure firstcalln(var p : ptree);
    procedure firstprocinline(var p : ptree);


implementation

    uses
      cobjects,verbose,globals,systems,
      aasm,types,
      hcodegen,htypechk,pass_1
{$ifdef i386}
      ,i386,tgeni386
{$endif}
{$ifdef m68k}
      ,m68k,tgeni386
{$endif}
      ;

{*****************************************************************************
                             FirstCallParaN
*****************************************************************************}

    procedure firstcallparan(var p : ptree;defcoll : pdefcoll);
      var
        old_array_constructor : boolean;
        store_valid : boolean;
        oldtype     : pdef;
        convtyp     : tconverttype;
      begin
         inc(parsing_para_level);
         if assigned(p^.right) then
           begin
              if defcoll=nil then
                firstcallparan(p^.right,nil)
              else
                firstcallparan(p^.right,defcoll^.next);
              p^.registers32:=p^.right^.registers32;
              p^.registersfpu:=p^.right^.registersfpu;
{$ifdef SUPPORT_MMX}
              p^.registersmmx:=p^.right^.registersmmx;
{$endif}
           end;
         if defcoll=nil then
           begin
              old_array_constructor:=allow_array_constructor;
              allow_array_constructor:=true;
              if not(assigned(p^.resulttype)) or
                (p^.left^.treetype=typeconvn) then
                firstpass(p^.left);
              allow_array_constructor:=old_array_constructor;
              if codegenerror then
                begin
                   dec(parsing_para_level);
                   exit;
                end;
              p^.resulttype:=p^.left^.resulttype;
           end
         { if we know the routine which is called, then the type }
         { conversions are inserted                              }
         else
           begin
               if count_ref then
                 begin
                    store_valid:=must_be_valid;
                    if (defcoll^.paratyp=vs_var) then
                      test_protected(p^.left);
                    if (defcoll^.paratyp<>vs_var) then
                      must_be_valid:=true
                    else
                      must_be_valid:=false;
                    { here we must add something for the implicit type }
                    { conversion from array of char to pchar }
{                    if isconvertable(p^.left^.resulttype,defcoll^.data,convtyp,
                      p^.left^.treetype,false) then
                      if convtyp=tc_array_to_pointer then
                        must_be_valid:=false; }
                    { only process typeconvn, else it will break other trees }
                    old_array_constructor:=allow_array_constructor;
                    allow_array_constructor:=true;
                    if (p^.left^.treetype=typeconvn) then
                      firstpass(p^.left);
                    allow_array_constructor:=old_array_constructor;
                    must_be_valid:=store_valid;
                 end;
              if not(is_shortstring(p^.left^.resulttype) and
                     is_shortstring(defcoll^.data)) and
                     (defcoll^.data^.deftype<>formaldef) then
                begin
                   if (defcoll^.paratyp=vs_var) and
                   { allows conversion from word to integer and
                     byte to shortint }
                     (not(
                        (p^.left^.resulttype^.deftype=orddef) and
                        (defcoll^.data^.deftype=orddef) and
                        (p^.left^.resulttype^.size=defcoll^.data^.size)
                         ) and
                   { an implicit pointer conversion is allowed }
                     not(
                        (p^.left^.resulttype^.deftype=pointerdef) and
                        (defcoll^.data^.deftype=pointerdef)
                         ) and
                   { child classes can be also passed }
                     not(
                        (p^.left^.resulttype^.deftype=objectdef) and
                        (defcoll^.data^.deftype=objectdef) and
                        pobjectdef(p^.left^.resulttype)^.isrelated(pobjectdef(defcoll^.data))
                        ) and
                   { passing a single element to a openarray of the same type }
                     not(
                        (is_open_array(defcoll^.data) and
                        is_equal(parraydef(defcoll^.data)^.definition,p^.left^.resulttype))
                        ) and
                   { an implicit file conversion is also allowed }
                   { from a typed file to an untyped one           }
                     not(
                        (p^.left^.resulttype^.deftype=filedef) and
                        (defcoll^.data^.deftype=filedef) and
                        (pfiledef(defcoll^.data)^.filetype = ft_untyped) and
                        (pfiledef(p^.left^.resulttype)^.filetype = ft_typed)
                         ) and
                     not(is_equal(p^.left^.resulttype,defcoll^.data))) then
                       CGMessage(parser_e_call_by_ref_without_typeconv);
                   { don't generate an type conversion for open arrays   }
                   { else we loss the ranges                             }
                   if is_open_array(defcoll^.data) then
                    begin
                      oldtype:=p^.left^.resulttype;
                      p^.left:=gentypeconvnode(p^.left,defcoll^.data);
                      firstpass(p^.left);
                      p^.left^.resulttype:=oldtype;
                    end
                   else
                    begin
                      p^.left:=gentypeconvnode(p^.left,defcoll^.data);
                      firstpass(p^.left);
                    end;
                   if codegenerror then
                     begin
                        dec(parsing_para_level);
                        exit;
                     end;
                end;
              { check var strings }
              if (cs_strict_var_strings in aktlocalswitches) and
                 is_shortstring(p^.left^.resulttype) and
                 is_shortstring(defcoll^.data) and
                 (defcoll^.paratyp=vs_var) and
                 not(is_equal(p^.left^.resulttype,defcoll^.data)) then
                 CGMessage(type_e_strict_var_string_violation);
              { Variablen, die call by reference �bergeben werden, }
              { k”nnen nicht in ein Register kopiert werden       }
              { is this usefull here ? }
              { this was missing in formal parameter list   }
              if defcoll^.paratyp=vs_var then
                make_not_regable(p^.left);

              p^.resulttype:=defcoll^.data;
           end;
         if p^.left^.registers32>p^.registers32 then
           p^.registers32:=p^.left^.registers32;
         if p^.left^.registersfpu>p^.registersfpu then
           p^.registersfpu:=p^.left^.registersfpu;
{$ifdef SUPPORT_MMX}
         if p^.left^.registersmmx>p^.registersmmx then
           p^.registersmmx:=p^.left^.registersmmx;
{$endif SUPPORT_MMX}
         dec(parsing_para_level);
      end;


{*****************************************************************************
                             FirstCallN
*****************************************************************************}

    procedure firstcalln(var p : ptree);
      type
         pprocdefcoll = ^tprocdefcoll;
         tprocdefcoll = record
            data      : pprocdef;
            nextpara  : pdefcoll;
            firstpara : pdefcoll;
            next      : pprocdefcoll;
         end;
      var
         hp,procs,hp2 : pprocdefcoll;
         pd : pprocdef;
         actprocsym : pprocsym;
         def_from,def_to,conv_to : pdef;
         pt,inlinecode : ptree;
         exactmatch,inlined : boolean;
         paralength,l : longint;
         pdc : pdefcoll;

         { only Dummy }
         hcvt : tconverttype;
         regi : tregister;
         store_valid, old_count_ref : boolean;

      { types.is_equal can't handle a formaldef ! }
      function is_equal(def1,def2 : pdef) : boolean;

        begin
           { safety check }
           if not (assigned(def1) or assigned(def2)) then
            begin
              is_equal:=false;
              exit;
            end;
           { all types can be passed to a formaldef }
           is_equal:=(def1^.deftype=formaldef) or
             (types.is_equal(def1,def2))
           { to support ansi/long/wide strings in a proper way }
           { string and string[10] are assumed as equal        }
           { when searching the correct overloaded procedure   }
             or
             (
              (def1^.deftype=stringdef) and (def2^.deftype=stringdef) and
              (pstringdef(def1)^.string_typ=pstringdef(def2)^.string_typ)
             )
           { set can also be a not yet converted array constructor }
             or
             (
              (def1^.deftype=setdef) and (def2^.deftype=arraydef) and
              (parraydef(def2)^.IsConstructor) and not(parraydef(def2)^.IsVariant)
             )
             ;
        end;

      function is_in_limit(def_from,def_to : pdef) : boolean;

        begin
           is_in_limit:=(def_from^.deftype = orddef) and
                        (def_to^.deftype = orddef) and
                        (porddef(def_from)^.low>porddef(def_to)^.low) and
                        (porddef(def_from)^.high<porddef(def_to)^.high);
        end;

      var
        is_const : boolean;
      begin
         { release registers! }
         { if procdefinition<>nil then we called firstpass already }
         { it seems to be bad because of the registers }
         { at least we can avoid the overloaded search !! }
         procs:=nil;
         { made this global for disposing !! }
         store_valid:=must_be_valid;
         must_be_valid:=false;

         inlined:=false;
         if assigned(p^.procdefinition) and
            ((p^.procdefinition^.options and poinline)<>0) then
           begin
              inlinecode:=p^.right;
              if assigned(inlinecode) then
                begin
                   inlined:=true;
                   p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
                end;
              p^.right:=nil;
           end;
         { procedure variable ? }
         if assigned(p^.right) then
           begin
              { procedure does a call }
              procinfo.flags:=procinfo.flags or pi_do_call;

              { calc the correture value for the register }
{$ifdef i386}
              for regi:=R_EAX to R_EDI do
                inc(reg_pushes[regi],t_times*2);
{$endif}
{$ifdef m68k}
              for regi:=R_D0 to R_A6 do
                inc(reg_pushes[regi],t_times*2);
{$endif}
              { calculate the type of the parameters }
              if assigned(p^.left) then
                begin
                   old_count_ref:=count_ref;
                   count_ref:=false;
                   firstcallparan(p^.left,nil);
                   count_ref:=old_count_ref;
                   if codegenerror then
                     exit;
                end;
              firstpass(p^.right);

              { check the parameters }
              pdc:=pprocvardef(p^.right^.resulttype)^.para1;
              pt:=p^.left;
              while assigned(pdc) and assigned(pt) do
                begin
                   pt:=pt^.right;
                   pdc:=pdc^.next;
                end;
              if assigned(pt) or assigned(pdc) then
                CGMessage(parser_e_illegal_parameter_list);
              { insert type conversions }
              if assigned(p^.left) then
                begin
                   old_count_ref:=count_ref;
                   count_ref:=true;
                   firstcallparan(p^.left,pprocvardef(p^.right^.resulttype)^.para1);
                   count_ref:=old_count_ref;
                   if codegenerror then
                     exit;
                end;
              p^.resulttype:=pprocvardef(p^.right^.resulttype)^.retdef;
              { this was missing, leads to a bug below if
                the procvar is a function }
              p^.procdefinition:=pprocdef(p^.right^.resulttype);
           end
         else
         { not a procedure variable }
           begin
              { determine the type of the parameters }
              if assigned(p^.left) then
                begin
                   old_count_ref:=count_ref;
                   count_ref:=false;
                   store_valid:=must_be_valid;
                   must_be_valid:=false;
                   firstcallparan(p^.left,nil);
                   count_ref:=old_count_ref;
                   must_be_valid:=store_valid;
                   if codegenerror then
                     exit;
                end;

              { do we know the procedure to call ? }
              if not(assigned(p^.procdefinition)) then
                begin
                   actprocsym:=pprocsym(p^.symtableprocentry);
                   { determine length of parameter list }
                   pt:=p^.left;
                   paralength:=0;
                   while assigned(pt) do
                     begin
                        inc(paralength);
                        pt:=pt^.right;
                     end;

                   { link all procedures which have the same # of parameters }
                   pd:=actprocsym^.definition;
                   while assigned(pd) do
                     begin
                        { we should also check that the overloaded function
                        has been declared in a unit that is in the uses !! }
                        { pd^.owner should be in the symtablestack !! }
                        { Laenge der deklarierten Parameterliste feststellen: }
                        { not necessary why nextprocsym field }
                        {st:=symtablestack;
                        if (pd^.owner^.symtabletype<>objectsymtable) then
                          while assigned(st) do
                            begin
                               if (st=pd^.owner) then break;
                               st:=st^.next;
                            end;
                        if assigned(st) then }
                          begin
                             pdc:=pd^.para1;
                             l:=0;
                             while assigned(pdc) do
                               begin
                                  inc(l);
                                  pdc:=pdc^.next;
                               end;
                             { only when the # of parameter are equal }
                             if l=paralength then
                               begin
                                  new(hp);
                                  hp^.data:=pd;
                                  hp^.next:=procs;
                                  hp^.nextpara:=pd^.para1;
                                  hp^.firstpara:=pd^.para1;
                                  procs:=hp;
                               end;
                          end;
                        pd:=pd^.nextoverloaded;
{$ifdef CHAINPROCSYMS}
                        if (pd=nil) and not (p^.unit_specific) then
                          begin
                             actprocsym:=actprocsym^.nextprocsym;
                             if assigned(actprocsym) then
                               pd:=actprocsym^.definition;
                          end;
{$endif CHAINPROCSYMS}
                     end;

                   { no procedures found? then there is something wrong
                     with the parameter size }
                   if not assigned(procs) and
                      ((parsing_para_level=0) or assigned(p^.left)) then
                    begin
                       CGMessage(parser_e_wrong_parameter_size);
                       actprocsym^.write_parameter_lists;
                       exit;
                    end;

                   { now we can compare parameter after parameter }
                   pt:=p^.left;
                   while assigned(pt) do
                     begin
                        { matches a parameter of one procedure exact ? }
                        exactmatch:=false;
                        hp:=procs;
                        while assigned(hp) do
                          begin
                             if is_equal(hp^.nextpara^.data,pt^.resulttype) then
                               begin
                                  if hp^.nextpara^.data=pt^.resulttype then
                                    begin
                                       pt^.exact_match_found:=true;
                                       hp^.nextpara^.argconvtyp:=act_exact;
                                    end
                                  else
                                    hp^.nextpara^.argconvtyp:=act_equal;
                                  exactmatch:=true;
                               end
                             else
                               hp^.nextpara^.argconvtyp:=act_convertable;
                             hp:=hp^.next;
                          end;

                        { .... if yes, del all the other procedures }
                        if exactmatch then
                          begin
                             { the first .... }
                             while (assigned(procs)) and not(is_equal(procs^.nextpara^.data,pt^.resulttype)) do
                               begin
                                  hp:=procs^.next;
                                  dispose(procs);
                                  procs:=hp;
                               end;
                             { and the others }
                             hp:=procs;
                             while (assigned(hp)) and assigned(hp^.next) do
                               begin
                                  if not(is_equal(hp^.next^.nextpara^.data,pt^.resulttype)) then
                                    begin
                                       hp2:=hp^.next^.next;
                                       dispose(hp^.next);
                                       hp^.next:=hp2;
                                    end
                                  else
                                    hp:=hp^.next;
                               end;
                          end
                        { when a parameter matches exact, remove all procs
                          which need typeconvs }
                        else
                          begin
                             { the first... }
                             while (assigned(procs)) and
                               not(isconvertable(pt^.resulttype,procs^.nextpara^.data,
                                 hcvt,pt^.left^.treetype,false)) do
                               begin
                                  hp:=procs^.next;
                                  dispose(procs);
                                  procs:=hp;
                               end;
                             { and the others }
                             hp:=procs;
                             while (assigned(hp)) and assigned(hp^.next) do
                               begin
                                  if not(isconvertable(pt^.resulttype,hp^.next^.nextpara^.data,
                                    hcvt,pt^.left^.treetype,false)) then
                                    begin
                                       hp2:=hp^.next^.next;
                                       dispose(hp^.next);
                                       hp^.next:=hp2;
                                    end
                                  else
                                    hp:=hp^.next;
                               end;
                          end;
                        { update nextpara for all procedures }
                        hp:=procs;
                        while assigned(hp) do
                          begin
                             hp^.nextpara:=hp^.nextpara^.next;
                             hp:=hp^.next;
                          end;
                        { load next parameter }
                        pt:=pt^.right;
                     end;

                   if not assigned(procs) then
                    begin
                      { there is an error, must be wrong type, because
                        wrong size is already checked (PFV) }
                      if (parsing_para_level=0) or (p^.left<>nil) then
                       begin
                          CGMessage(parser_e_wrong_parameter_type);
                          actprocsym^.write_parameter_lists;
                          exit;
                       end
                      else
                       begin
                         { try to convert to procvar }
                         p^.treetype:=loadn;
                         p^.resulttype:=pprocsym(p^.symtableprocentry)^.definition;
                         p^.symtableentry:=p^.symtableprocentry;
                         p^.is_first:=false;
                         p^.disposetyp:=dt_nothing;
                         firstpass(p);
                         exit;
                       end;
                     end;

                   { if there are several choices left then for orddef }
                   { if a type is totally included in the other        }
                   { we don't fear an overflow ,                       }
                   { so we can do as if it is an exact match           }
                   { this will convert integer to longint              }
                   { rather than to words                              }
                   { conversion of byte to integer or longint          }
                   {would still not be solved                          }
                   if assigned(procs^.next) then
                     begin
                        hp:=procs;
                        while assigned(hp) do
                          begin
                            hp^.nextpara:=hp^.firstpara;
                            hp:=hp^.next;
                          end;
                        pt:=p^.left;
                        while assigned(pt) do
                          begin
                             { matches a parameter of one procedure exact ? }
                             exactmatch:=false;
                             def_from:=pt^.resulttype;
                             hp:=procs;
                             while assigned(hp) do
                               begin
                                  if not is_equal(hp^.nextpara^.data,pt^.resulttype) then
                                    begin
                                       def_to:=hp^.nextpara^.data;
                                       if ((def_from^.deftype=orddef) and (def_to^.deftype=orddef)) and
                                         (is_in_limit(def_from,def_to) or
                                         ((hp^.nextpara^.paratyp=vs_var) and
                                         (def_from^.size=def_to^.size))) then
                                         begin
                                            exactmatch:=true;
                                            conv_to:=def_to;
                                         end;
                                    end;
                                  hp:=hp^.next;
                               end;

                             { .... if yes, del all the other procedures }
                             if exactmatch then
                               begin
                                  { the first .... }
                                  while (assigned(procs)) and not(is_in_limit(def_from,procs^.nextpara^.data)) do
                                    begin
                                       hp:=procs^.next;
                                       dispose(procs);
                                       procs:=hp;
                                    end;
                                  { and the others }
                                  hp:=procs;
                                  while (assigned(hp)) and assigned(hp^.next) do
                                    begin
                                       if not(is_in_limit(def_from,hp^.next^.nextpara^.data)) then
                                         begin
                                            hp2:=hp^.next^.next;
                                            dispose(hp^.next);
                                            hp^.next:=hp2;
                                         end
                                       else
                                         begin
                                           def_to:=hp^.next^.nextpara^.data;
                                           if (conv_to^.size>def_to^.size) or
                                              ((porddef(conv_to)^.low<porddef(def_to)^.low) and
                                              (porddef(conv_to)^.high>porddef(def_to)^.high)) then
                                             begin
                                                hp2:=procs;
                                                procs:=hp;
                                                conv_to:=def_to;
                                                dispose(hp2);
                                             end
                                           else
                                             hp:=hp^.next;
                                         end;
                                    end;
                               end;
                             { update nextpara for all procedures }
                             hp:=procs;
                             while assigned(hp) do
                               begin
                                  hp^.nextpara:=hp^.nextpara^.next;
                                  hp:=hp^.next;
                               end;
                             pt:=pt^.right;
                          end;
                     end;
                   { let's try to eliminate equal is exact is there }
                   {if assigned(procs^.next) then
                     begin
                        pt:=p^.left;
                        while assigned(pt) do
                          begin
                             if pt^.exact_match_found then
                               begin
                                  hp:=procs;
                                  while (assigned(procs)) and (procs^.nextpara^.data<>pt^.resulttype) do
                                    begin
                                       hp:=procs^.next;
                                       dispose(procs);
                                       procs:=hp;
                                    end;
                               end;
                             pt:=pt^.right;
                          end;
                     end; }

{$ifndef CHAINPROCSYMS}
                   if assigned(procs^.next) then
                     begin
                        CGMessage(cg_e_cant_choose_overload_function);
                        actprocsym^.write_parameter_lists;
                     end;
{$else CHAINPROCSYMS}
                   if assigned(procs^.next) then
                     { if the last retained is the only one }
                     { from a unit it is OK              PM  }
                     { the last is the one coming from the first symtable }
                     { as the diff defcoll are inserted in front }
                     begin
                        hp2:=procs;
                        while assigned(hp2^.next) and assigned(hp2^.next^.next) do
                          hp2:=hp2^.next;
                        if (hp2^.data^.owner<>hp2^.next^.data^.owner) then
                          begin
                             hp:=procs^.next;
                             {hp2 is the correct one }
                             hp2:=hp2^.next;
                             while hp<>hp2 do
                               begin
                                 dispose(procs);
                                 procs:=hp;
                                 hp:=procs^.next;
                               end;
                             procs:=hp2;
                          end
                        else
                           begin
                              CGMessage(cg_e_cant_choose_overload_function);
                              actprocsym^.write_parameter_lists;
                              error(too_much_matches);
                           end;
                     end;
{$endif CHAINPROCSYMS}
     {$ifdef UseBrowser}
                   if make_ref then
                     begin
                        procs^.data^.lastref:=new(pref,init(procs^.data^.lastref,@p^.fileinfo));
                     end;
     {$endif UseBrowser}

                   p^.procdefinition:=procs^.data;
                   p^.resulttype:=procs^.data^.retdef;
                   { big error for with statements
                   p^.symtableproc:=p^.procdefinition^.owner; }
                   p^.location.loc:=LOC_MEM;
{$ifdef CHAINPROCSYMS}
                   { object with method read;
                     call to read(x) will be a usual procedure call }
                   if assigned(p^.methodpointer) and
                     (p^.procdefinition^._class=nil) then
                     begin
                        { not ok for extended }
                        case p^.methodpointer^.treetype of
                           typen,hnewn : fatalerror(no_para_match);
                        end;
                        disposetree(p^.methodpointer);
                        p^.methodpointer:=nil;
                     end;
{$endif CHAINPROCSYMS}
               end;{ end of procedure to call determination }

              is_const:=((p^.procdefinition^.options and pointernconst)<>0) and
                         (p^.left^.left^.treetype in [realconstn,ordconstn]);
              { handle predefined procedures }
              if ((p^.procdefinition^.options and pointernproc)<>0) or is_const then
                begin
                   { settextbuf needs two args }
                   if assigned(p^.left^.right) then
                     pt:=geninlinenode(pprocdef(p^.procdefinition)^.extnumber,is_const,p^.left)
                   else
                     begin
                        pt:=geninlinenode(pprocdef(p^.procdefinition)^.extnumber,is_const,p^.left^.left);
                        putnode(p^.left);
                     end;
                   putnode(p);
                   firstpass(pt);
                   p:=pt;

                   must_be_valid:=store_valid;
                   if codegenerror then
                     exit;

                   dispose(procs);
                   exit;
                end
              else
                { no intern procedure => we do a call }
              { calc the correture value for the register }
              { handle predefined procedures }
              if (p^.procdefinition^.options and poinline)<>0 then
                begin
                   if assigned(p^.methodpointer) then
                     CGMessage(cg_e_unable_inline_object_methods);
                   if assigned(p^.right) and (p^.right^.treetype<>procinlinen) then
                     CGMessage(cg_e_unable_inline_procvar);
                   { p^.treetype:=procinlinen; }
                   if not assigned(p^.right) then
                     begin
                        if assigned(p^.procdefinition^.code) then
                          inlinecode:=genprocinlinenode(p,ptree(p^.procdefinition^.code))
                        else
                          CGMessage(cg_e_no_code_for_inline_stored);
                        if assigned(inlinecode) then
                          begin
                             { consider it has not inlined if called
                               again inside the args }
                             p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
                             firstpass(inlinecode);
                             inlined:=true;
                          end;
                     end;
                end
              else
                procinfo.flags:=procinfo.flags or pi_do_call;

              { work trough all parameters to insert the type conversions }
              { !!! done now after internproc !! (PM) }
              if assigned(p^.left) then
                begin
                   old_count_ref:=count_ref;
                   count_ref:=true;
                   firstcallparan(p^.left,p^.procdefinition^.para1);
                   count_ref:=old_count_ref;
                end;
{$ifdef i386}
              for regi:=R_EAX to R_EDI do
                begin
                   if (p^.procdefinition^.usedregisters and ($80 shr word(regi)))<>0 then
                     inc(reg_pushes[regi],t_times*2);
                end;
{$endif}
{$ifdef m68k}
             for regi:=R_D0 to R_A6 do
               begin
                  if (p^.procdefinition^.usedregisters and ($800 shr word(regi)))<>0 then
                    inc(reg_pushes[regi],t_times*2);
               end;
{$endif}
           end;
         { ensure that the result type is set }
         p^.resulttype:=p^.procdefinition^.retdef;
         { get a register for the return value }
         if (p^.resulttype<>pdef(voiddef)) then
           begin
              if (p^.procdefinition^.options and poconstructor)<>0 then
                begin
                   { extra handling of classes }
                   { p^.methodpointer should be assigned! }
                   if assigned(p^.methodpointer) and assigned(p^.methodpointer^.resulttype) and
                     (p^.methodpointer^.resulttype^.deftype=classrefdef) then
                     begin
                        p^.location.loc:=LOC_REGISTER;
                        p^.registers32:=1;
                        { the result type depends on the classref }
                        p^.resulttype:=pclassrefdef(p^.methodpointer^.resulttype)^.definition;
                     end
                  { a object constructor returns the result with the flags }
                   else
                     p^.location.loc:=LOC_FLAGS;
                end
              else
                begin
{$ifdef SUPPORT_MMX}
                   if (cs_mmx in aktlocalswitches) and
                     is_mmx_able_array(p^.resulttype) then
                     begin
                        p^.location.loc:=LOC_MMXREGISTER;
                        p^.registersmmx:=1;
                     end
                   else
{$endif SUPPORT_MMX}
                   if ret_in_acc(p^.resulttype) then
                     begin
                        p^.location.loc:=LOC_REGISTER;
                        p^.registers32:=1;
                     end
                   else if (p^.resulttype^.deftype=floatdef) then
                     begin
                        p^.location.loc:=LOC_FPU;
                        p^.registersfpu:=1;
                     end
                end;
           end;

         { a fpu can be used in any procedure !! }
         p^.registersfpu:=p^.procdefinition^.fpu_used;
         { if this is a call to a method calc the registers }
         if (p^.methodpointer<>nil) then
           begin
              case p^.methodpointer^.treetype of
                { but only, if this is not a supporting node }
                typen,hnewn : ;
                else
                  begin
                     { R.Assign is not a constructor !!! }
                     { but for R^.Assign, R must be valid !! }
                     if ((p^.procdefinition^.options and poconstructor) <> 0) or
                        ((p^.methodpointer^.treetype=loadn) and
                        ((pobjectdef(p^.methodpointer^.resulttype)^.options and oo_hasvirtual) = 0)) then
                       must_be_valid:=false
                     else
                       must_be_valid:=true;
                     firstpass(p^.methodpointer);
                     p^.registersfpu:=max(p^.methodpointer^.registersfpu,p^.registersfpu);
                     p^.registers32:=max(p^.methodpointer^.registers32,p^.registers32);
{$ifdef SUPPORT_MMX}
                     p^.registersmmx:=max(p^.methodpointer^.registersmmx,p^.registersmmx);
{$endif SUPPORT_MMX}
                  end;
              end;
           end;

         if inlined then
           begin
              p^.right:=inlinecode;
              p^.procdefinition^.options:=p^.procdefinition^.options or  poinline;
           end;
         { determine the registers of the procedure variable }
         { is this OK for inlined procs also ?? (PM)         }
         if assigned(p^.right) then
           begin
              p^.registersfpu:=max(p^.right^.registersfpu,p^.registersfpu);
              p^.registers32:=max(p^.right^.registers32,p^.registers32);
{$ifdef SUPPORT_MMX}
              p^.registersmmx:=max(p^.right^.registersmmx,p^.registersmmx);
{$endif SUPPORT_MMX}
           end;
         { determine the registers of the procedure }
         if assigned(p^.left) then
           begin
              p^.registersfpu:=max(p^.left^.registersfpu,p^.registersfpu);
              p^.registers32:=max(p^.left^.registers32,p^.registers32);
{$ifdef SUPPORT_MMX}
              p^.registersmmx:=max(p^.left^.registersmmx,p^.registersmmx);
{$endif SUPPORT_MMX}
           end;
         if assigned(procs) then
           dispose(procs);
         must_be_valid:=store_valid;
      end;


{*****************************************************************************
                             FirstProcInlineN
*****************************************************************************}

    procedure firstprocinline(var p : ptree);
      begin
        { left contains the code in tree form }
        { but it has already been firstpassed }
        { so firstpass(p^.left); does not seem required }
        { might be required later if we change the arg handling !! }
      end;

end.
{
  $Log$
  Revision 1.3  1998-09-24 14:27:40  peter
    * some better support for openarray

  Revision 1.2  1998/09/24 09:02:16  peter
    * rewritten isconvertable to use case
    * array of .. and single variable are compatible

  Revision 1.1  1998/09/23 20:42:24  peter
    * splitted pass_1

}