freepascal.compiler/compiler/ninl.pas

{
    $Id$
    Copyright (c) 1998-2000 by Florian Klaempfl

    Type checking and register allocation for inline 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 ninl;

{$i defines.inc}

interface

    uses
       node,htypechk;

    {$i innr.inc}

    type
       tinlinenode = class(tunarynode)
          inlinenumber : byte;
          constructor create(number : byte;is_const:boolean;l : tnode);virtual;
          function getcopy : tnode;override;
          function pass_1 : tnode;override;
       end;

    var
       cinlinenode : class of tinlinenode;

   function geninlinenode(number : byte;is_const:boolean;l : tnode) : tinlinenode;

implementation

    uses
      cobjects,verbose,globals,systems,
      globtype,
      symconst,symtable,aasm,types,
      pass_1,
      ncal,ncon,ncnv,nadd,nld,nbas,
      cpubase
{$ifdef newcg}
      ,cgbase
      ,tgobj
      ,tgcpu
{$else newcg}
      ,hcodegen
{$ifdef i386}
      ,tgeni386
{$endif}
{$endif newcg}
      ;

   function geninlinenode(number : byte;is_const:boolean;l : tnode) : tinlinenode;

     begin
        geninlinenode:=cinlinenode.create(number,is_const,l);
     end;

{*****************************************************************************
                           TINLINENODE
*****************************************************************************}

    constructor tinlinenode.create(number : byte;is_const:boolean;l : tnode);

      begin
         inherited create(inlinen,l);
         if is_const then
           include(flags,nf_inlineconst);
         inlinenumber:=number;
      end;

    function tinlinenode.getcopy : tnode;

      var
         n : tinlinenode;

      begin
         n:=tinlinenode(inherited getcopy);
         n.inlinenumber:=inlinenumber;
         result:=n;
      end;

{$ifdef fpc}
{$maxfpuregisters 0}
{$endif fpc}
    function tinlinenode.pass_1 : tnode;
      var
         vl,vl2,counter  : longint;
         vr      : bestreal;
         p1,hp,hpp  :  tnode;
         ppn : tcallparanode;
{$ifndef NOCOLONCHECK}
         frac_para,length_para : tnode;
{$endif ndef NOCOLONCHECK}
         extra_register,
         isreal,
         iswrite,
         file_is_typed : boolean;

      function do_lowhigh(adef : pdef) : tnode;

        var
           v : longint;
           enum : penumsym;

        begin
           case Adef^.deftype of
             orddef:
               begin
                  if inlinenumber=in_low_x then
                    v:=porddef(adef)^.low
                  else
                    v:=porddef(adef)^.high;
                  hp:=genordinalconstnode(v,adef);
                  firstpass(hp);
                  do_lowhigh:=hp;
               end;
             enumdef:
               begin
                  enum:=Penumdef(Adef)^.firstenum;
                  if inlinenumber=in_high_x then
                    while enum^.nextenum<>nil do
                      enum:=enum^.nextenum;
                  hp:=genenumnode(enum);
                  do_lowhigh:=hp;
               end;
           else
             internalerror(87);
           end;
        end;

      function getconstrealvalue : bestreal;

        begin
           case left.nodetype of
              ordconstn:
                getconstrealvalue:=tordconstnode(left).value;
              realconstn:
                getconstrealvalue:=trealconstnode(left).value_real;
              else
                internalerror(309992);
           end;
        end;

      procedure setconstrealvalue(r : bestreal);

        var
           hp : tnode;

        begin
           hp:=genrealconstnode(r,bestrealdef^);
           firstpass(hp);
           pass_1:=hp;
        end;

      procedure handleextendedfunction;

        begin
           location.loc:=LOC_FPU;
           resulttype:=s80floatdef;
           { redo firstpass for varstate status PM }
           set_varstate(left,true);
           if (left.resulttype^.deftype<>floatdef) or
             (pfloatdef(left.resulttype)^.typ<>s80real) then
             begin
                left:=gentypeconvnode(left,s80floatdef);
                firstpass(left);
             end;
           registers32:=left.registers32;
           registersfpu:=left.registersfpu;
{$ifdef SUPPORT_MMX}
           registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
        end;

      begin
         result:=nil;
         { if we handle writeln; left contains no valid address }
         if assigned(left) then
           begin
              if left.nodetype=callparan then
                tcallparanode(left).firstcallparan(nil,false)
              else
                firstpass(left);
              left_max;
              set_location(location,left.location);
           end;
         inc(parsing_para_level);
         { handle intern constant functions in separate case }
         if nf_inlineconst in flags then
          begin
            hp:=nil;
            { no parameters? }
            if not assigned(left) then
             begin
               case inlinenumber of
                 in_const_pi :
                   hp:=genrealconstnode(pi,bestrealdef^);
                 else
                   internalerror(89);
               end;
             end
            else
            { process constant expression with parameter }
             begin
               vl:=0;
               vl2:=0; { second parameter Ex: ptr(vl,vl2) }
               vr:=0;
               isreal:=false;
               case left.nodetype of
                 realconstn :
                   begin
                     isreal:=true;
                     vr:=trealconstnode(left).value_real;
                   end;
                 ordconstn :
                   vl:=tordconstnode(left).value;
                 callparan :
                   begin
                     { both exists, else it was not generated }
                     vl:=tordconstnode(tcallparanode(left).left).value;
                     vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
                   end;
                 else
                   CGMessage(cg_e_illegal_expression);
               end;
               case inlinenumber of
                 in_const_trunc :
                   begin
                     if isreal then
                       begin
                          if (vr>=2147483648.0) or (vr<=-2147483649.0) then
                            begin
                               CGMessage(parser_e_range_check_error);
                               hp:=genordinalconstnode(1,s32bitdef)
                            end
                          else
                            hp:=genordinalconstnode(trunc(vr),s32bitdef)
                       end
                     else
                      hp:=genordinalconstnode(trunc(vl),s32bitdef);
                   end;
                 in_const_round :
                   begin
                     if isreal then
                       begin
                          if (vr>=2147483647.5) or (vr<=-2147483648.5) then
                            begin
                               CGMessage(parser_e_range_check_error);
                               hp:=genordinalconstnode(1,s32bitdef)
                            end
                          else
                            hp:=genordinalconstnode(round(vr),s32bitdef)
                       end
                     else
                      hp:=genordinalconstnode(round(vl),s32bitdef);
                   end;
                 in_const_frac :
                   begin
                     if isreal then
                      hp:=genrealconstnode(frac(vr),bestrealdef^)
                     else
                      hp:=genrealconstnode(frac(vl),bestrealdef^);
                   end;
                 in_const_int :
                   begin
                     if isreal then
                      hp:=genrealconstnode(int(vr),bestrealdef^)
                     else
                      hp:=genrealconstnode(int(vl),bestrealdef^);
                   end;
                 in_const_abs :
                   begin
                     if isreal then
                      hp:=genrealconstnode(abs(vr),bestrealdef^)
                     else
                      hp:=genordinalconstnode(abs(vl),left.resulttype);
                   end;
                 in_const_sqr :
                   begin
                     if isreal then
                      hp:=genrealconstnode(sqr(vr),bestrealdef^)
                     else
                      hp:=genordinalconstnode(sqr(vl),left.resulttype);
                   end;
                 in_const_odd :
                   begin
                     if isreal then
                      CGMessage1(type_e_integer_expr_expected,left.resulttype^.typename)
                     else
                      hp:=genordinalconstnode(byte(odd(vl)),booldef);
                   end;
                 in_const_swap_word :
                   begin
                     if isreal then
                      CGMessage1(type_e_integer_expr_expected,left.resulttype^.typename)
                     else
                      hp:=genordinalconstnode((vl and $ff) shl 8+(vl shr 8),left.resulttype);
                   end;
                 in_const_swap_long :
                   begin
                     if isreal then
                      CGMessage(type_e_mismatch)
                     else
                      hp:=genordinalconstnode((vl and $ffff) shl 16+(vl shr 16),left.resulttype);
                   end;
                 in_const_ptr :
                   begin
                     if isreal then
                      CGMessage(type_e_mismatch)
                     else
                      hp:=genordinalconstnode((vl2 shl 16) or vl,voidpointerdef);
                   end;
                 in_const_sqrt :
                   begin
                     if isreal then
                       begin
                          if vr<0.0 then
                           CGMessage(type_e_wrong_math_argument)
                          else
                           hp:=genrealconstnode(sqrt(vr),bestrealdef^)
                       end
                     else
                       begin
                          if vl<0 then
                           CGMessage(type_e_wrong_math_argument)
                          else
                           hp:=genrealconstnode(sqrt(vl),bestrealdef^);
                       end;
                   end;
                 in_const_arctan :
                   begin
                     if isreal then
                      hp:=genrealconstnode(arctan(vr),bestrealdef^)
                     else
                      hp:=genrealconstnode(arctan(vl),bestrealdef^);
                   end;
                 in_const_cos :
                   begin
                     if isreal then
                      hp:=genrealconstnode(cos(vr),bestrealdef^)
                     else
                      hp:=genrealconstnode(cos(vl),bestrealdef^);
                   end;
                 in_const_sin :
                   begin
                     if isreal then
                      hp:=genrealconstnode(sin(vr),bestrealdef^)
                     else
                      hp:=genrealconstnode(sin(vl),bestrealdef^);
                   end;
                 in_const_exp :
                   begin
                     if isreal then
                      hp:=genrealconstnode(exp(vr),bestrealdef^)
                     else
                      hp:=genrealconstnode(exp(vl),bestrealdef^);
                   end;
                 in_const_ln :
                   begin
                     if isreal then
                       begin
                          if vr<=0.0 then
                           CGMessage(type_e_wrong_math_argument)
                          else
                           hp:=genrealconstnode(ln(vr),bestrealdef^)
                       end
                     else
                       begin
                          if vl<=0 then
                           CGMessage(type_e_wrong_math_argument)
                          else
                           hp:=genrealconstnode(ln(vl),bestrealdef^);
                       end;
                   end;
                 else
                   internalerror(88);
               end;
             end;
            if hp=nil then
             hp:=tnode.create(errorn);
            firstpass(hp);
            result:=hp;
          end
         else
          begin
            case inlinenumber of
             in_lo_qword,
             in_hi_qword,
             in_lo_long,
             in_hi_long,
             in_lo_word,
             in_hi_word:

               begin
                  set_varstate(left,true);
                  if registers32<1 then
                    registers32:=1;
                  if inlinenumber in [in_lo_word,in_hi_word] then
                    resulttype:=u8bitdef
                  else if inlinenumber in [in_lo_qword,in_hi_qword] then
                    begin
                       resulttype:=u32bitdef;
                       if (m_tp in aktmodeswitches) or
                          (m_delphi in aktmodeswitches) then
                         CGMessage(type_w_maybe_wrong_hi_lo);
                    end
                  else
                    begin
                       resulttype:=u16bitdef;
                       if (m_tp in aktmodeswitches) or
                          (m_delphi in aktmodeswitches) then
                         CGMessage(type_w_maybe_wrong_hi_lo);
                    end;
                  location.loc:=LOC_REGISTER;
                  if not is_integer(left.resulttype) then
                    CGMessage(type_e_mismatch)
                  else
                    begin
                      if left.nodetype=ordconstn then
                       begin
                         case inlinenumber of
                          in_lo_word : hp:=genordinalconstnode(tordconstnode(left).value and $ff,left.resulttype);
                          in_hi_word : hp:=genordinalconstnode(tordconstnode(left).value shr 8,left.resulttype);
                          in_lo_long : hp:=genordinalconstnode(tordconstnode(left).value and $ffff,left.resulttype);
                          in_hi_long : hp:=genordinalconstnode(tordconstnode(left).value shr 16,left.resulttype);
                          in_lo_qword : hp:=genordinalconstnode(tordconstnode(left).value and $ffffffff,left.resulttype);
                          in_hi_qword : hp:=genordinalconstnode(tordconstnode(left).value shr 32,left.resulttype);
                         end;
                         firstpass(hp);
                         result:=hp;
                       end;
                    end;
               end;

             in_sizeof_x:
               begin
                 set_varstate(left,false);
                 if push_high_param(left.resulttype) then
                  begin
                    getsymonlyin(tloadnode(left).symtable,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
                    hp:=caddnode.create(addn,genloadnode(pvarsym(srsym),tloadnode(left).symtable),
                                     genordinalconstnode(1,s32bitdef));
                    if (left.resulttype^.deftype=arraydef) and
                       (parraydef(left.resulttype)^.elesize<>1) then
                      hp:=caddnode.create(muln,hp,genordinalconstnode(parraydef(left.resulttype)^.elesize,s32bitdef));
                    firstpass(hp);
                    result:=hp;
                  end
                 else
                  begin
                    if registers32<1 then
                       registers32:=1;
                    resulttype:=s32bitdef;
                    location.loc:=LOC_REGISTER;
                  end;
               end;

             in_typeof_x:
               begin
                  set_varstate(left,false);
                  if registers32<1 then
                    registers32:=1;
                  location.loc:=LOC_REGISTER;
                  resulttype:=voidpointerdef;
               end;

             in_ord_x:
               begin
                  set_varstate(left,true);
                  if (left.nodetype=ordconstn) then
                    begin
                       hp:=genordinalconstnode(tordconstnode(left).value,s32bitdef);
                       firstpass(hp);
                       result:=hp;
                    end
                  else
                    begin
                       { otherwise you get a crash if you try ord on an expression containing }
                       { an undeclared variable (JM)                                          }
                       if not assigned(left.resulttype) then
                         exit;
                       if (left.resulttype^.deftype=orddef) then
                         if (porddef(left.resulttype)^.typ in [uchar,uwidechar,bool8bit]) then
                           case porddef(left.resulttype)^.typ of
                            uchar:
                               begin
                                  hp:=gentypeconvnode(left,u8bitdef);
                                  left:=nil;
                                  include(hp.flags,nf_explizit);
                                  firstpass(hp);
                                  result:=hp;
                               end;
                            uwidechar:
                               begin
                                  hp:=gentypeconvnode(left,u16bitdef);
                                  left:=nil;
                                  include(hp.flags,nf_explizit);
                                  firstpass(hp);
                                  result:=hp;
                               end;
                            bool8bit:
                               begin
                                  hp:=gentypeconvnode(left,u8bitdef);
                                  left:=nil;
                                  ttypeconvnode(hp).convtype:=tc_bool_2_int;
                                  include(hp.flags,nf_explizit);
                                  firstpass(hp);
                                  result:=hp;
                               end
                           end
                         { can this happen ? }
                         else if (porddef(left.resulttype)^.typ=uvoid) then
                           CGMessage(type_e_mismatch)
                         else
                           { all other orddef need no transformation }
                           begin
                              hp:=left;
                              left:=nil;
                              result:=hp;
                           end
                       else if (left.resulttype^.deftype=enumdef) then
                         begin
                            hp:=gentypeconvnode(left,s32bitdef);
                            left:=nil;
                            include(hp.flags,nf_explizit);
                            firstpass(hp);
                            result:=hp;
                         end
                       else
                         begin
                            { can anything else be ord() ?}
                            CGMessage(type_e_mismatch);
                         end;
                    end;
               end;

             in_chr_byte:
               begin
                  set_varstate(left,true);
                  hp:=gentypeconvnode(left,cchardef);
                  left:=nil;
                  include(hp.flags,nf_explizit);
                  firstpass(hp);
                  result:=hp;
               end;

             in_length_string:
               begin
                  set_varstate(left,true);
                  if is_ansistring(left.resulttype) then
                    resulttype:=s32bitdef
                  else
                    resulttype:=u8bitdef;
                  { we don't need string conversations here }
                  if (left.nodetype=typeconvn) and
                     (ttypeconvnode(left).left.resulttype^.deftype=stringdef) then
                    begin
                       hp:=ttypeconvnode(left).left;
                       ttypeconvnode(left).left:=nil;
                       left.free;
                       left:=hp;
                    end;

                  { check the type, must be string or char }
                  if (left.resulttype^.deftype<>stringdef) and
                     (not is_char(left.resulttype)) then
                    CGMessage(type_e_mismatch);

                  { evaluates length of constant strings direct }
                  if (left.nodetype=stringconstn) then
                    begin
                       hp:=genordinalconstnode(tstringconstnode(left).len,s32bitdef);
                       firstpass(hp);
                       result:=hp;
                    end
                  { length of char is one allways }
                  else if is_constcharnode(left) then
                    begin
                       hp:=genordinalconstnode(1,s32bitdef);
                       firstpass(hp);
                       result:=hp;
                    end;
               end;

             in_typeinfo_x:
               begin
                  resulttype:=voidpointerdef;
                  location.loc:=LOC_REGISTER;
                  registers32:=1;
               end;

             in_assigned_x:
               begin
                  set_varstate(left,true);
                  resulttype:=booldef;
                  location.loc:=LOC_FLAGS;
               end;

             in_ofs_x :
               internalerror(2000101001);

             in_seg_x :
               begin
                 set_varstate(left,false);
                 hp:=genordinalconstnode(0,s32bitdef);
                 firstpass(hp);
                 result:=hp;
               end;

             in_pred_x,
             in_succ_x:
               begin
                  resulttype:=left.resulttype;
                  if is_64bitint(resulttype) then
                    begin
                       if (registers32<2) then
                         registers32:=2
                    end
                  else
                    begin
                       if (registers32<1) then
                         registers32:=1;
                    end;
                  location.loc:=LOC_REGISTER;
                  set_varstate(left,true);
                  if not is_ordinal(resulttype) then
                    CGMessage(type_e_ordinal_expr_expected)
                  else
                    begin
                      if (resulttype^.deftype=enumdef) and
                         (penumdef(resulttype)^.has_jumps) then
                        CGMessage(type_e_succ_and_pred_enums_with_assign_not_possible)
                      else
                        if left.nodetype=ordconstn then
                         begin
                           if inlinenumber=in_succ_x then
                             hp:=genordinalconstnode(tordconstnode(left).value+1,left.resulttype)
                           else
                             hp:=genordinalconstnode(tordconstnode(left).value-1,left.resulttype);
                           firstpass(hp);
                           result:=hp;
                         end;
                    end;
               end;

             in_setlength_x:
               begin
                  resulttype:=voiddef;
                  if assigned(left) then
                    begin
                       ppn:=tcallparanode(left);
                       counter:=0;
                       { check type }
                       while assigned(ppn.right) do
                         begin
                            ppn.left:=gentypeconvnode(ppn.left,s32bitdef);
                            firstpass(ppn.left);
                            if codegenerror then
                              exit;
                            inc(counter);
                            ppn:=tcallparanode(ppn.right);
                         end;
                       firstpass(ppn.left);
                       if codegenerror then
                        exit;
                       { last param must be var }
                       valid_for_assign(ppn.left,false);
                       set_varstate(ppn.left,true);
                       { first param must be a string or dynamic array ...}
                       if not((ppn.left.resulttype^.deftype=stringdef) or
                          (is_dynamic_array(ppn.left.resulttype))) then
                         CGMessage(type_e_mismatch);

                       { only dynamic arrays accept more dimensions }
                       if (counter>1) and
                         (not(is_dynamic_array(left.resulttype))) then
                         CGMessage(type_e_mismatch);
                    end
                  else
                    CGMessage(type_e_mismatch);
               end;

             in_inc_x,
             in_dec_x:
               begin
                 resulttype:=voiddef;
                 if assigned(left) then
                   begin
                      tcallparanode(left).firstcallparan(nil,true);
                      set_varstate(left,true);
                      if codegenerror then
                       exit;
                      { first param must be var }
                      valid_for_assign(tcallparanode(left).left,false);
                      { check type }
                      if is_64bitint(left.resulttype) then
                        { convert to simple add for 64bit (JM) }
                        begin
                          { extra parameter? }
                          if assigned(tcallparanode(left).right) then
                            begin
                              { Yes, use for add node }
                              hpp := tcallparanode(tcallparanode(left).right).left;
                              tcallparanode(tcallparanode(left).right).left := nil;
                              if assigned(tcallparanode(tcallparanode(left).right).right) then
                                CGMessage(cg_e_illegal_expression);
                            end
                          else
                            { no, create constant 1 }
                            hpp := cordconstnode.create(1,s32bitdef);
                          { addition/substraction depending on inc/dec }
                          if inlinenumber = in_inc_x then
                            hp := caddnode.create(addn,tcallparanode(left).left.getcopy,hpp)
                          else
                            hp := caddnode.create(subn,tcallparanode(left).left.getcopy,hpp);
                          { assign result of addition }
                          hpp := cassignmentnode.create(tcallparanode(left).left,hp);
                          tcallparanode(left).left := nil;
                          { firstpass it }
                          firstpass(hpp);
                          { return new node }
                          pass_1 := hpp;
                          dec(parsing_para_level);
                          exit;
                        end;

                      if (left.resulttype^.deftype in [enumdef,pointerdef]) or
                         is_ordinal(left.resulttype) then
                        begin
                           { two paras ? }
                           if assigned(tcallparanode(left).right) then
                             begin
                                { insert a type conversion       }
                                { the second param is always longint }
                                tcallparanode(tcallparanode(left).right).left:=
                                  gentypeconvnode(tcallparanode(tcallparanode(left).right).left,s32bitdef);
                                { check the type conversion }
                                firstpass(tcallparanode(tcallparanode(left).right).left);

                                { need we an additional register ? }
                                if not(is_constintnode(tcallparanode(tcallparanode(left).right).left)) and
                                  (tcallparanode(tcallparanode(left).right).left.location.loc in [LOC_MEM,LOC_REFERENCE]) and
                                  (tcallparanode(tcallparanode(left).right).left.registers32<=1) then
                                  inc(registers32);

                                { do we need an additional register to restore the first parameter? }
                                if tcallparanode(tcallparanode(left).right).left.registers32>=registers32 then
                                  inc(registers32);

                                if assigned(tcallparanode(tcallparanode(left).right).right) then
                                  CGMessage(cg_e_illegal_expression);
                             end;
                        end
                      else
                        CGMessage(type_e_ordinal_expr_expected);
                   end
                 else
                   CGMessage(type_e_mismatch);
               end;

             in_read_x,
             in_readln_x,
             in_write_x,
             in_writeln_x :
               begin
                  { needs a call }
                  procinfo^.flags:=procinfo^.flags or pi_do_call;
                  resulttype:=voiddef;
                  { true, if readln needs an extra register }
                  extra_register:=false;
                  { we must know if it is a typed file or not }
                  { but we must first do the firstpass for it }
                  file_is_typed:=false;
                  if assigned(left) then
                    begin
                       iswrite:=(inlinenumber in [in_write_x,in_writeln_x]);
                       tcallparanode(left).firstcallparan(nil,true);
                       set_varstate(left,iswrite);
                       { now we can check }
                       hp:=left;
                       while assigned(tcallparanode(hp).right) do
                         hp:=tcallparanode(hp).right;
                       { if resulttype is not assigned, then automatically }
                       { file is not typed.                             }
                       if assigned(hp) and assigned(hp.resulttype) then
                         Begin
                           if (hp.resulttype^.deftype=filedef) then
                           if (pfiledef(hp.resulttype)^.filetyp=ft_untyped) then
                             begin
                              if (inlinenumber in [in_readln_x,in_writeln_x]) then
                                CGMessage(type_e_no_readln_writeln_for_typed_file)
                              else
                                CGMessage(type_e_no_read_write_for_untyped_file);
                             end
                           else if (pfiledef(hp.resulttype)^.filetyp=ft_typed) then
                            begin
                              file_is_typed:=true;
                              { test the type }
                              if (inlinenumber in [in_readln_x,in_writeln_x]) then
                                CGMessage(type_e_no_readln_writeln_for_typed_file);
                              hpp:=left;
                              while (hpp<>hp) do
                               begin
                                 if (tcallparanode(hpp).left.nodetype=typen) then
                                   CGMessage(type_e_cant_read_write_type);
                                 if not is_equal(hpp.resulttype,pfiledef(hp.resulttype)^.typedfiletype.def) then
                                   CGMessage(type_e_mismatch);
                                 { generate the high() value for the shortstring }
                                 if ((not iswrite) and is_shortstring(tcallparanode(hpp).left.resulttype)) or
                                    (is_chararray(tcallparanode(hpp).left.resulttype)) then
                                   tcallparanode(hpp).gen_high_tree(true);
                                 { read(ln) is call by reference (JM) }
                                 if not iswrite then
                                   make_not_regable(tcallparanode(hpp).left);
                                 hpp:=tcallparanode(hpp).right;
                               end;
                            end;
                         end; { endif assigned(hp) }

                       { insert type conversions for write(ln) }
                       if (not file_is_typed) then
                         begin
                            hp:=left;
                            while assigned(hp) do
                              begin
                                incrementregisterpushed($ff);
                                if (tcallparanode(hp).left.nodetype=typen) then
                                  CGMessage(type_e_cant_read_write_type);
                                if assigned(tcallparanode(hp).left.resulttype) then
                                  begin
                                    isreal:=false;
                                    { support writeln(procvar) }
                                    if (tcallparanode(hp).left.resulttype^.deftype=procvardef) then
                                     begin
                                       p1:=gencallnode(nil,nil);
                                       tcallnode(p1).right:=tcallparanode(hp).left;
                                       p1.resulttype:=pprocvardef(tcallparanode(hp).left.resulttype)^.rettype.def;
                                       firstpass(p1);
                                       tcallparanode(hp).left:=p1;
                                     end;
                                    case tcallparanode(hp).left.resulttype^.deftype of
                                      filedef :
                                        begin
                                          { only allowed as first parameter }
                                          if assigned(tcallparanode(hp).right) then
                                            CGMessage(type_e_cant_read_write_type);
                                        end;
                                      stringdef :
                                        begin
                                          { generate the high() value for the shortstring }
                                          if (not iswrite) and
                                             is_shortstring(tcallparanode(hp).left.resulttype) then
                                            tcallparanode(hp).gen_high_tree(true);
                                        end;
                                      pointerdef :
                                        begin
                                          if not is_pchar(tcallparanode(hp).left.resulttype) then
                                            CGMessage(type_e_cant_read_write_type);
                                        end;
                                      floatdef :
                                        begin
                                          isreal:=true;
                                        end;
                                      orddef :
                                        begin
                                          case porddef(tcallparanode(hp).left.resulttype)^.typ of
                                            uchar,
                                            u32bit,s32bit,
                                            u64bit,s64bit:
                                              ;
                                            u8bit,s8bit,
                                            u16bit,s16bit :
                                              if iswrite then
                                                tcallparanode(hp).left:=gentypeconvnode(tcallparanode(hp).left,s32bitdef);
                                            bool8bit,
                                            bool16bit,
                                            bool32bit :
                                              if iswrite then
                                                tcallparanode(hp).left:=gentypeconvnode(tcallparanode(hp).left,booldef)
                                              else
                                                CGMessage(type_e_cant_read_write_type);
                                            else
                                              CGMessage(type_e_cant_read_write_type);
                                          end;
                                          if not(iswrite) and
                                            not(is_64bitint(tcallparanode(hp).left.resulttype)) then
                                            extra_register:=true;
                                        end;
                                      arraydef :
                                        begin
                                          if is_chararray(tcallparanode(hp).left.resulttype) then
                                            tcallparanode(hp).gen_high_tree(true)
                                          else
                                            CGMessage(type_e_cant_read_write_type);
                                        end;
                                      else
                                        CGMessage(type_e_cant_read_write_type);
                                    end;

                                    { some format options ? }
                                    if cpf_is_colon_para in tcallparanode(hp).callparaflags then
                                      begin
                                         if cpf_is_colon_para in tcallparanode(tcallparanode(hp).right).callparaflags then
                                           begin
                                              frac_para:=hp;
                                              length_para:=tcallparanode(hp).right;
                                              hp:=tcallparanode(hp).right;
                                              hpp:=tcallparanode(hp).right;
                                           end
                                         else
                                           begin
                                              length_para:=hp;
                                              frac_para:=nil;
                                              hpp:=tcallparanode(hp).right;
                                           end;
                                         { can be nil if you use "write(e:0:6)" while e is undeclared (JM) }
                                         if assigned(tcallparanode(hpp).left.resulttype) then
                                           isreal:=(tcallparanode(hpp).left.resulttype^.deftype=floatdef)
                                         else exit;
                                         if (not is_integer(tcallparanode(length_para).left.resulttype)) then
                                          CGMessage1(type_e_integer_expr_expected,tcallparanode(length_para).left.resulttype^.typename)
                                        else
                                          tcallparanode(length_para).left:=gentypeconvnode(tcallparanode(length_para).left,s32bitdef);
                                        if assigned(frac_para) then
                                          begin
                                            if isreal then
                                             begin
                                               if (not is_integer(tcallparanode(frac_para).left.resulttype)) then
                                                 CGMessage1(type_e_integer_expr_expected,tcallparanode(frac_para).left.resulttype^.typename)
                                               else
                                                 tcallparanode(frac_para).left:=gentypeconvnode(tcallparanode(frac_para).left,s32bitdef);
                                             end
                                            else
                                             CGMessage(parser_e_illegal_colon_qualifier);
                                          end;
                                        { do the checking for the colon'd arg }
                                        hp:=length_para;
                                      end;
                                  end;
                                 hp:=tcallparanode(hp).right;
                              end;
                         end;
                       { pass all parameters again for the typeconversions }
                       if codegenerror then
                         exit;
                       tcallparanode(left).firstcallparan(nil,true);
                       set_varstate(left,true);
                       { calc registers }
                       left_max;
                       if extra_register then
                         inc(registers32);
                    end;
               end;

            in_settextbuf_file_x :
              begin
                 { warning here left is the callparannode
                   not the argument directly }
                 { left.left is text var }
                 { left.right.left is the buffer var }
                 { firstcallparan(left,nil);
                   already done in firstcalln }
                 { now we know the type of buffer }
                 getsymonlyin(systemunit,'SETTEXTBUF');
                 hp:=gencallnode(pprocsym(srsym),systemunit);
                 tcallnode(hp).left:=gencallparanode(
                   genordinalconstnode(tcallparanode(left).left.resulttype^.size,s32bitdef),left);
                 left:=nil;
                 firstpass(hp);
                 result:=hp;
              end;

             { the firstpass of the arg has been done in firstcalln ? }
             in_reset_typedfile,
             in_rewrite_typedfile :
               begin
                  procinfo^.flags:=procinfo^.flags or pi_do_call;
                  firstpass(left);
                  set_varstate(left,true);
                  resulttype:=voiddef;
               end;

             in_str_x_string :
               begin
                  procinfo^.flags:=procinfo^.flags or pi_do_call;
                  resulttype:=voiddef;
                  { check the amount of parameters }
                  if not(assigned(left)) or
                     not(assigned(tcallparanode(left).right)) then
                   begin
                     CGMessage(parser_e_wrong_parameter_size);
                     exit;
                   end;
                  { first pass just the string for first local use }
                  hp:=tcallparanode(left).right;
                  tcallparanode(left).right:=nil;
                  tcallparanode(left).firstcallparan(nil,true);
                  set_varstate(left,false);
                  { remove warning when result is passed }
                  set_funcret_is_valid(tcallparanode(left).left);
                  tcallparanode(left).right:=hp;
                  tcallparanode(tcallparanode(left).right).firstcallparan(nil,true);
                  set_varstate(tcallparanode(left).right,true);
                  hp:=left;
                  { valid string ? }
                  if not assigned(hp) or
                     (tcallparanode(hp).left.resulttype^.deftype<>stringdef) or
                     (tcallparanode(hp).right=nil) then
                    CGMessage(cg_e_illegal_expression);
                  { we need a var parameter }
                  valid_for_assign(tcallparanode(hp).left,false);
                  { generate the high() value for the shortstring }
                  if is_shortstring(tcallparanode(hp).left.resulttype) then
                    tcallparanode(hp).gen_high_tree(true);

                  { !!!! check length of string }

                  while assigned(tcallparanode(hp).right) do
                    hp:=tcallparanode(hp).right;

                  if not assigned(tcallparanode(hp).resulttype) then
                    exit;
                  { check and convert the first param }
                  if (cpf_is_colon_para in tcallparanode(hp).callparaflags) or
                     not assigned(hp.resulttype) then
                    CGMessage(cg_e_illegal_expression);

                  isreal:=false;
                  case hp.resulttype^.deftype of
                    orddef :
                      begin
                        case porddef(tcallparanode(hp).left.resulttype)^.typ of
                          u32bit,s32bit,
                          s64bit,u64bit:
                            ;
                          u8bit,s8bit,
                          u16bit,s16bit:
                            tcallparanode(hp).left:=gentypeconvnode(tcallparanode(hp).left,s32bitdef);
                          else
                            CGMessage(type_e_integer_or_real_expr_expected);
                        end;
                      end;
                    floatdef :
                      begin
                        isreal:=true;
                      end;
                    else
                      CGMessage(type_e_integer_or_real_expr_expected);
                  end;

                  { some format options ? }
                  hpp:=tcallparanode(left).right;
                  if assigned(hpp) and (cpf_is_colon_para in tcallparanode(hpp).callparaflags) then
                    begin
                      firstpass(tcallparanode(hpp).left);
                      set_varstate(tcallparanode(hpp).left,true);
                      if (not is_integer(tcallparanode(hpp).left.resulttype)) then
                        CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype^.typename)
                      else
                        tcallparanode(hpp).left:=gentypeconvnode(tcallparanode(hpp).left,s32bitdef);
                      hpp:=tcallparanode(hpp).right;
                      if assigned(hpp) and (cpf_is_colon_para in tcallparanode(hpp).callparaflags) then
                        begin
                          if isreal then
                           begin
                             if (not is_integer(tcallparanode(hpp).left.resulttype)) then
                               CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype^.typename)
                             else
                               begin
                                 firstpass(tcallparanode(hpp).left);
                                 set_varstate(tcallparanode(hpp).left,true);
                                 tcallparanode(hpp).left:=gentypeconvnode(tcallparanode(hpp).left,s32bitdef);
                               end;
                           end
                          else
                           CGMessage(parser_e_illegal_colon_qualifier);
                        end;
                    end;

                  { pass all parameters again for the typeconversions }
                  if codegenerror then
                    exit;
                  tcallparanode(left).firstcallparan(nil,true);
                  { calc registers }
                  left_max;
               end;

             in_val_x :
               begin
                  procinfo^.flags:=procinfo^.flags or pi_do_call;
                  resulttype:=voiddef;
                  { check the amount of parameters }
                  if not(assigned(left)) or
                     not(assigned(tcallparanode(left).right)) then
                   begin
                     CGMessage(parser_e_wrong_parameter_size);
                     exit;
                   end;
                  If Assigned(tcallparanode(tcallparanode(left).right).right) Then
                   {there is a "code" parameter}
                     Begin
                  { first pass just the code parameter for first local use}
                       hp := tcallparanode(left).right;
                       tcallparanode(left).right := nil;
                       make_not_regable(tcallparanode(left).left);
                       tcallparanode(left).firstcallparan(nil,true);
                       set_varstate(left,false);
                       if codegenerror then exit;
                       tcallparanode(left).right := hp;
                     {code has to be a var parameter}
                       if valid_for_assign(tcallparanode(left).left,false) then
                        begin
                          if (tcallparanode(left).left.resulttype^.deftype <> orddef) or
                            not(porddef(tcallparanode(left).left.resulttype)^.typ in
                                [u16bit,s16bit,u32bit,s32bit]) then
                           CGMessage(type_e_mismatch);
                        end;
                       hpp := tcallparanode(left).right
                     End
                  Else hpp := left;
                  {now hpp = the destination value tree}
                  { first pass just the destination parameter for first local use}
                  hp:=tcallparanode(hpp).right;
                  tcallparanode(hpp).right:=nil;
                  {hpp = destination}
                  make_not_regable(tcallparanode(hpp).left);
                  tcallparanode(hpp).firstcallparan(nil,true);
                  set_varstate(hpp,false);

                  if codegenerror then
                    exit;
                  { remove warning when result is passed }
                  set_funcret_is_valid(tcallparanode(hpp).left);
                  tcallparanode(hpp).right := hp;
                  if valid_for_assign(tcallparanode(hpp).left,false) then
                   begin
                     If Not((tcallparanode(hpp).left.resulttype^.deftype = floatdef) or
                            ((tcallparanode(hpp).left.resulttype^.deftype = orddef) And
                             (POrdDef(tcallparanode(hpp).left.resulttype)^.typ in
                              [u32bit,s32bit,
                               u8bit,s8bit,u16bit,s16bit,s64bit,u64bit]))) Then
                       CGMessage(type_e_mismatch);
                   end;
                 {hp = source (String)}
                  { count_ref := false; WHY ?? }
                  tcallparanode(hp).firstcallparan(nil,true);
                  set_varstate(hp,true);
                  if codegenerror then
                    exit;
                  { if not a stringdef then insert a type conv which
                    does the other type checking }
                  If (tcallparanode(hp).left.resulttype^.deftype<>stringdef) then
                   begin
                     tcallparanode(hp).left:=gentypeconvnode(tcallparanode(hp).left,cshortstringdef);
                     firstpass(hp);
                   end;
                  { calc registers }
                  left_max;

                  { val doesn't calculate the registers really }
                  { correct, we need one register extra   (FK) }
                  if is_64bitint(tcallparanode(hpp).left.resulttype) then
                    inc(registers32,2)
                  else
                    inc(registers32,1);
               end;

             in_include_x_y,
             in_exclude_x_y:
               begin
                 resulttype:=voiddef;
                 if assigned(left) then
                   begin
                      tcallparanode(left).firstcallparan(nil,true);
                      set_varstate(left,true);
                      registers32:=left.registers32;
                      registersfpu:=left.registersfpu;
{$ifdef SUPPORT_MMX}
                      registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
                      { remove warning when result is passed }
                      set_funcret_is_valid(tcallparanode(left).left);
                      { first param must be var }
                      valid_for_assign(tcallparanode(left).left,false);
                      { check type }
                      if assigned(left.resulttype) and
                         (left.resulttype^.deftype=setdef) then
                        begin
                           { two paras ? }
                           if assigned(tcallparanode(left).right) then
                             begin
                                { insert a type conversion       }
                                { to the type of the set elements  }
                                tcallparanode(tcallparanode(left).right).left:=gentypeconvnode(
                                  tcallparanode(tcallparanode(left).right).left,
                                  psetdef(left.resulttype)^.elementtype.def);
                                { check the type conversion }
                                firstpass(tcallparanode(tcallparanode(left).right).left);
                                { only three parameters are allowed }
                                if assigned(tcallparanode(tcallparanode(left).right).right) then
                                  CGMessage(cg_e_illegal_expression);
                             end;
                        end
                      else
                        CGMessage(type_e_mismatch);
                   end
                 else
                   CGMessage(type_e_mismatch);
               end;

             in_low_x,
             in_high_x:
               begin
                  set_varstate(left,false);
                  { this fixes tests\webtbs\tbug879.pp (FK)
                  if left.nodetype in [typen,loadn,subscriptn] then
                    begin
                  }
                       case left.resulttype^.deftype of
                          orddef,enumdef:
                            begin
                               hp:=do_lowhigh(left.resulttype);
                               firstpass(hp);
                               result:=hp;
                            end;
                          setdef:
                            begin
                               hp:=do_lowhigh(Psetdef(left.resulttype)^.elementtype.def);
                               firstpass(hp);
                               result:=hp;
                            end;
                         arraydef:
                            begin
                              if inlinenumber=in_low_x then
                               begin
                                 hp:=genordinalconstnode(Parraydef(left.resulttype)^.lowrange,
                                   Parraydef(left.resulttype)^.rangetype.def);
                                 firstpass(hp);
                                 result:=hp;
                               end
                              else
                               begin
                                 if is_open_array(left.resulttype) or
                                   is_array_of_const(left.resulttype) then
                                  begin
                                    getsymonlyin(tloadnode(left).symtable,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
                                    hp:=genloadnode(pvarsym(srsym),tloadnode(left).symtable);
                                    firstpass(hp);
                                    result:=hp;
                                  end
                                 else
                                  begin
                                    hp:=genordinalconstnode(Parraydef(left.resulttype)^.highrange,
                                      Parraydef(left.resulttype)^.rangetype.def);
                                    firstpass(hp);
                                    result:=hp;
                                  end;
                               end;
                           end;
                         stringdef:
                           begin
                              if inlinenumber=in_low_x then
                               begin
                                 hp:=genordinalconstnode(0,u8bitdef);
                                 firstpass(hp);
                                 result:=hp;
                               end
                              else
                               begin
                                 if is_open_string(left.resulttype) then
                                  begin
                                    getsymonlyin(tloadnode(left).symtable,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
                                    hp:=genloadnode(pvarsym(srsym),tloadnode(left).symtable);
                                    firstpass(hp);
                                    result:=hp;
                                  end
                                 else
                                  begin
                                    hp:=genordinalconstnode(Pstringdef(left.resulttype)^.len,u8bitdef);
                                    firstpass(hp);
                                    result:=hp;
                                  end;
                               end;
                           end;
                         else
                           CGMessage(type_e_mismatch);
                         end;
                  {
                    end
                  else
                    CGMessage(type_e_varid_or_typeid_expected);
                  }
               end;

             in_cos_extended:
               begin
                  if left.nodetype in [ordconstn,realconstn] then
                    setconstrealvalue(cos(getconstrealvalue))
                  else
                    handleextendedfunction;
               end;

             in_sin_extended:
               begin
                  if left.nodetype in [ordconstn,realconstn] then
                    setconstrealvalue(sin(getconstrealvalue))
                  else
                    handleextendedfunction;
               end;

             in_arctan_extended:
               begin
                  if left.nodetype in [ordconstn,realconstn] then
                    setconstrealvalue(arctan(getconstrealvalue))
                  else
                    handleextendedfunction;
               end;
             in_pi:
               if block_type=bt_const then
                 setconstrealvalue(pi)
               else
                 begin
                    location.loc:=LOC_FPU;
                    resulttype:=s80floatdef;
                 end;

             in_abs_extended:
               begin
                  if left.nodetype in [ordconstn,realconstn] then
                    setconstrealvalue(abs(getconstrealvalue))
                  else
                    handleextendedfunction;
               end;

             in_sqr_extended:
               begin
                  if left.nodetype in [ordconstn,realconstn] then
                    setconstrealvalue(sqr(getconstrealvalue))
                  else
                    handleextendedfunction;
               end;

             in_sqrt_extended:
               begin
                  if left.nodetype in [ordconstn,realconstn] then
                    begin
                       vr:=getconstrealvalue;
                       if vr<0.0 then
                         begin
                            CGMessage(type_e_wrong_math_argument);
                            setconstrealvalue(0);
                         end
                       else
                         setconstrealvalue(sqrt(vr));
                    end
                  else
                    handleextendedfunction;
               end;

             in_ln_extended:
               begin
                  if left.nodetype in [ordconstn,realconstn] then
                    begin
                       vr:=getconstrealvalue;
                       if vr<=0.0 then
                         begin
                            CGMessage(type_e_wrong_math_argument);
                            setconstrealvalue(0);
                         end
                       else
                         setconstrealvalue(ln(vr));
                    end
                  else
                    handleextendedfunction;
               end;

{$ifdef SUPPORT_MMX}
            in_mmx_pcmpeqb..in_mmx_pcmpgtw:
              begin
              end;
{$endif SUPPORT_MMX}
            in_assert_x_y :
               begin
                 resulttype:=voiddef;
                 if assigned(left) then
                   begin
                      tcallparanode(left).firstcallparan(nil,true);
                      set_varstate(left,true);
                      registers32:=left.registers32;
                      registersfpu:=left.registersfpu;
{$ifdef SUPPORT_MMX}
                      registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
                      { check type }
                      if is_boolean(left.resulttype) then
                        begin
                           { must always be a string }
                           tcallparanode(tcallparanode(left).right).left:=
                             gentypeconvnode(tcallparanode(tcallparanode(left).right).left,cshortstringdef);
                           firstpass(tcallparanode(tcallparanode(left).right).left);
                        end
                      else
                        CGMessage(type_e_mismatch);
                   end
                 else
                   CGMessage(type_e_mismatch);
                 { We've checked the whole statement for correctness, now we
                   can remove it if assertions are off }
                 if not(cs_do_assertion in aktlocalswitches) then
                   { we need a valid node, so insert a nothingn }
                   result:=cnothingnode.create;
               end;

              else
               internalerror(8);
             end;
            end;
           { generate an error if no resulttype is set }
           if not assigned(resulttype) then
             resulttype:=generrordef;
           { ... also if the node will be replaced }
           if assigned(result) and
              (not assigned(result.resulttype)) then
             result.resulttype:=generrordef;
         dec(parsing_para_level);
       end;
{$ifdef fpc}
{$maxfpuregisters default}
{$endif fpc}

begin
   cinlinenode:=tinlinenode;
end.
{
  $Log$
  Revision 1.10  2000-10-21 18:16:11  florian
    * a lot of changes:
       - basic dyn. array support
       - basic C++ support
       - some work for interfaces done
       ....

  Revision 1.9  2000/10/15 08:38:46  jonas
    * added missing getcopy for previous addition

  Revision 1.8  2000/10/14 18:27:53  jonas
    * merged fix for inc/dec on 64bit types from tcinl

  Revision 1.7  2000/10/14 10:14:50  peter
    * moehrendorf oct 2000 rewrite

  Revision 1.6  2000/10/01 19:48:24  peter
    * lot of compile updates for cg11

  Revision 1.5  2000/09/28 19:49:52  florian
  *** empty log message ***

  Revision 1.4  2000/09/28 16:34:47  florian
  *** empty log message ***

  Revision 1.3  2000/09/27 21:33:22  florian
    * finally nadd.pas compiles

  Revision 1.2  2000/09/27 20:25:44  florian
    * more stuff fixed

  Revision 1.1  2000/09/26 14:59:34  florian
    * more conversion work done

}