freepascal.compiler/compiler/ninl.pas

{
    $Id$
    Copyright (c) 1998-2002 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 fpcdefs.inc}

interface

    uses
       node,htypechk,cpuinfo,symppu;

    {$i compinnr.inc}

    type
       tinlinenode = class(tunarynode)
          inlinenumber : byte;
          constructor create(number : byte;is_const:boolean;l : tnode);virtual;
          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
          procedure ppuwrite(ppufile:tcompilerppufile);override;
          function getcopy : tnode;override;
          function pass_1 : tnode;override;
          function det_resulttype:tnode;override;
          function docompare(p: tnode): boolean; override;
          { All the following routines currently
            call compilerproc's, unless they are
            overriden in which case, the code
            generator handles them.
          }
          function first_pi: tnode ; virtual;
          function first_arctan_real: tnode; virtual;
          function first_abs_real: tnode; virtual;
          function first_sqr_real: tnode; virtual;
          function first_sqrt_real: tnode; virtual;
          function first_ln_real: tnode; virtual;
          function first_cos_real: tnode; virtual;
          function first_sin_real: tnode; virtual;
        private
          function handle_str: tnode;
          function handle_reset_rewrite_typed: tnode;
          function handle_read_write: tnode;
          function handle_val: tnode;
       end;
       tinlinenodeclass = class of tinlinenode;

    var
       cinlinenode : tinlinenodeclass;

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

implementation

    uses
      verbose,globals,systems,
      globtype, cutils,
      symbase,symconst,symtype,symdef,symsym,symtable,paramgr,defbase,
      pass_1,
      ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,
      cpubase,tgobj,cgbase
      ;

   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;


    constructor tinlinenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
      begin
        inherited ppuload(t,ppufile);
        inlinenumber:=ppufile.getbyte;
      end;


    procedure tinlinenode.ppuwrite(ppufile:tcompilerppufile);
      begin
        inherited ppuwrite(ppufile);
        ppufile.putbyte(inlinenumber);
      end;


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


      function tinlinenode.handle_str : tnode;
      var
        lenpara,
        fracpara,
        newparas,
        dest,
        source  : tcallparanode;
        newnode : tnode;
        procname: string;
        is_real : boolean;

      begin
        result := cerrornode.create;

        { make sure we got at least two parameters (if we got only one, }
        { this parameter may not be encapsulated in a callparan)        }
        if not assigned(left) or
           (left.nodetype <> callparan) then
          begin
            CGMessage(parser_e_wrong_parameter_size);
            exit;
          end;
        { get destination string }
        dest := tcallparanode(left);

        { get source para (number) }
        source := dest;
        while assigned(source.right) do
          source := tcallparanode(source.right);
        is_real := source.resulttype.def.deftype = floatdef;

        if not assigned(dest) or
           ((dest.left.resulttype.def.deftype<>stringdef) and
            not(is_chararray(dest.left.resulttype.def))) or
           not(is_real or
               (source.left.resulttype.def.deftype = orddef)) then
          begin
            { the parser will give this message already because we }
            { return an errornode (JM)                             }
            { CGMessagePos(fileinfo,cg_e_illegal_expression);      }
            exit;
          end;

        { get len/frac parameters }
        lenpara := nil;
        fracpara := nil;
        if (cpf_is_colon_para in tcallparanode(dest.right).callparaflags) then
          begin
            lenpara := tcallparanode(dest.right);

            { we can let the callnode do the type checking of these parameters too, }
            { but then the error messages aren't as nice                            }
            if not is_integer(lenpara.resulttype.def) then
              begin
                CGMessagePos1(lenpara.fileinfo,
                  type_e_integer_expr_expected,lenpara.resulttype.def.typename);
                exit;
              end;
            if (cpf_is_colon_para in tcallparanode(lenpara.right).callparaflags) then
              begin
                { parameters are in reverse order! }
                fracpara := lenpara;
                lenpara := tcallparanode(lenpara.right);
                if not is_real then
                  begin
                    CGMessagePos(lenpara.fileinfo,parser_e_illegal_colon_qualifier);
                    exit
                  end;
                if not is_integer(lenpara.resulttype.def) then
                  begin
                    CGMessagePos1(lenpara.fileinfo,
                      type_e_integer_expr_expected,lenpara.resulttype.def.typename);
                    exit;
                  end;
              end;
          end;

        { generate the parameter list for the compilerproc }
        newparas := dest;

        { if we have a float parameter, insert the realtype, len and fracpara parameters }
        if is_real then
          begin
            { insert realtype parameter }
            newparas.right := ccallparanode.create(cordconstnode.create(
              ord(tfloatdef(source.left.resulttype.def).typ),s32bittype),newparas.right);
            { if necessary, insert a fraction parameter }
            if not assigned(fracpara) then
              begin
                tcallparanode(newparas.right).right := ccallparanode.create(
                  cordconstnode.create(-1,s32bittype),tcallparanode(newparas.right).right);
                fracpara := tcallparanode(tcallparanode(newparas.right).right);
              end;
            { if necessary, insert a length para }
            if not assigned(lenpara) then
              fracpara.right := ccallparanode.create(cordconstnode.create(-32767,s32bittype),
                fracpara.right);
          end
        else
          { for a normal parameter, insert a only length parameter if one is missing }
          if not assigned(lenpara) then
            newparas.right := ccallparanode.create(cordconstnode.create(-1,s32bittype),
              newparas.right);

        { remove the parameters from the original node so they won't get disposed, }
        { since they're reused                                                     }
        left := nil;

        { create procedure name }
        if is_chararray(dest.resulttype.def) then
          procname:='fpc_chararray_'
        else
          procname := 'fpc_' + tstringdef(dest.resulttype.def).stringtypname+'_';
        if is_real then
          procname := procname + 'float'
        else
          case torddef(source.resulttype.def).typ of
            u32bit:
              procname := procname + 'cardinal';
            u64bit:
              procname := procname + 'qword';
            s64bit:
              procname := procname + 'int64';
            else
              procname := procname + 'longint';
          end;

        { create the call node, }
        newnode := ccallnode.createintern(procname,newparas);
        { resulttypepass it }
        resulttypepass(newnode);

        { and return it (but first free the errornode we generated in the beginning) }
        result.free;
        result := newnode;
      end;


    function tinlinenode.handle_reset_rewrite_typed: tnode;
      begin
        { since this is a "in_xxxx_typedfile" node, we can be sure we have  }
        { a typed file as argument and we don't have to check it again (JM) }

        { add the recsize parameter }
        { note: for some reason, the parameter of intern procedures with only one }
        {   parameter is gets lifted out of its original tcallparanode (see round }
        {   line 1306 of ncal.pas), so recreate a tcallparanode here (JM)         }
        left := ccallparanode.create(cordconstnode.create(
          tfiledef(left.resulttype.def).typedfiletype.def.size,s32bittype),
          ccallparanode.create(left,nil));
        { create the correct call }
        if inlinenumber=in_reset_typedfile then
          result := ccallnode.createintern('fpc_reset_typed',left)
        else
          result := ccallnode.createintern('fpc_rewrite_typed',left);
        firstpass(result);
        { make sure left doesn't get disposed, since we use it in the new call }
        left := nil;
      end;


    function tinlinenode.handle_read_write: tnode;

      const
        procnames: array[boolean,boolean] of string[11] =
          (('write_text_','read_text_'),('typed_write','typed_read'));

      var
        filepara,
        lenpara,
        fracpara,
        nextpara,
        para          : tcallparanode;
        newstatement  : tstatementnode;
        newblock      : tblocknode;
        p1            : tnode;
        filetemp,
        temp          : ttempcreatenode;
        procprefix,
        name          : string[31];
        srsym         : tvarsym;
        tempowner     : tsymtable;
        restype       : ^ttype;
        is_typed,
        do_read,
        is_real,
        error_para,
        found_error,
        is_ordinal   : boolean;
      begin
        filepara := nil;
        is_typed := false;
        filetemp := nil;
        do_read := inlinenumber in [in_read_x,in_readln_x];
        { if we fail, we can quickly exit this way. We must generate something }
        { instead of the inline node, because firstpass will bomb with an      }
        { internalerror if it encounters a read/write                          }
        result := cerrornode.create;

        { reverse the parameters (needed to get the colon parameters in the }
        { correct order when processing write(ln)                           }
        left := reverseparameters(tcallparanode(left));

        if assigned(left) then
          begin
            { check if we have a file parameter and if yes, what kind it is }
            filepara := tcallparanode(left);

            if (filepara.resulttype.def.deftype=filedef) then
              begin
                if (tfiledef(filepara.resulttype.def).filetyp=ft_untyped) then
                  begin
                    CGMessagePos(fileinfo,type_e_no_read_write_for_untyped_file);
                    exit;
                  end
                else
                  begin
                    if (tfiledef(filepara.resulttype.def).filetyp=ft_typed) then
                      begin
                        if (inlinenumber in [in_readln_x,in_writeln_x]) then
                          begin
                            CGMessagePos(fileinfo,type_e_no_readln_writeln_for_typed_file);
                            exit;
                          end;
                        is_typed := true;
                      end
                  end;
              end
            else
              filepara := nil;
          end;

        { create a blocknode in which the successive write/read statements will be  }
        { put, since they belong together. Also create a dummy statement already to }
        { make inserting of additional statements easier                            }
        newstatement := cstatementnode.create(nil,cnothingnode.create);
        newblock := cblocknode.create(newstatement);

        { if we don't have a filepara, create one containing the default }
        if not assigned(filepara) then
          begin

            { create a loadnode for the standard input/output handle }
            if do_read then
              name := 'INPUT'
            else
              name := 'OUTPUT';

            { if we are compiling the system unit, the systemunit symtable is nil. }
            { however, if we aren't compiling the system unit, another unit could  }
            { also have defined the INPUT or OUTPUT symbols. Therefore we need the }
            { separate cases (JM)                                                  }
            if not searchsysvar(name,srsym,tempowner) then
              internalerror(200108141);

            { create the file parameter }
            filepara := ccallparanode.create(cloadnode.create(srsym,tempowner),nil);
          end
        else
          { remove filepara from the parameter chain }
          begin
            left := filepara.right;
            filepara.right := nil;
            { the file para is a var parameter, but it must be valid already }
            set_varstate(filepara,true);
            { check if we should make a temp to store the result of a complex }
            { expression (better heuristics, anyone?) (JM)                    }
            if (filepara.left.nodetype <> loadn) then
              begin
                { create a temp which will hold a pointer to the file }
                filetemp := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,true);

                { add it to the statements }
                newstatement.left := cstatementnode.create(nil,filetemp);
                newstatement := tstatementnode(newstatement.left);

                { make sure the resulttype of the temp (and as such of the }
                { temprefs coming after it) is set (necessary because the  }
                { temprefs will be part of the filepara, of which we need  }
                { the resulttype later on and temprefs can only be         }
                { resulttypepassed if the resulttype of the temp is known) }
                resulttypepass(tnode(filetemp));

                { assign the address of the file to the temp }
                newstatement.left := cstatementnode.create(nil,
                  cassignmentnode.create(ctemprefnode.create(filetemp),
                    caddrnode.create(filepara.left)));
                newstatement := tstatementnode(newstatement.left);
                resulttypepass(newstatement.right);
                { create a new fileparameter as follows: file_type(temp^)    }
                { (so that we pass the value and not the address of the temp }
                { to the read/write routine)                                 }
                nextpara := ccallparanode.create(ctypeconvnode.create(
                  cderefnode.create(ctemprefnode.create(filetemp)),filepara.left.resulttype),nil);
                { make sure the type conversion is explicit, otherwise this }
                { typecast won't work                                       }
                nextpara.left.toggleflag(nf_explizit);

                { replace the old file para with the new one }
                filepara.left := nil;
                filepara.free;
                filepara := nextpara;

                { the resulttype of the filepara must be set since it's }
                { used below                                            }
                filepara.get_paratype;
              end;
          end;

        { now, filepara is nowhere referenced anymore, so we can safely dispose it }
        { if something goes wrong or at the end of the procedure                   }

        { choose the correct procedure prefix }
        procprefix := 'fpc_'+procnames[is_typed,do_read];

        { we're going to reuse the paranodes, so make sure they don't get freed }
        { twice                                                                 }
        para := tcallparanode(left);
        left := nil;

        { no errors found yet... }
        found_error := false;

        if is_typed then
          begin
            { add the typesize to the filepara }
            filepara.right := ccallparanode.create(cordconstnode.create(
              tfiledef(filepara.resulttype.def).typedfiletype.def.size,s32bittype),nil);

            { check for "no parameters" (you need at least one extra para for typed files) }
            if not assigned(para) then
              begin
                CGMessage(parser_e_wrong_parameter_size);
                found_error := true;
              end;

            { process all parameters }
            while assigned(para) do
              begin
                { check if valid parameter }
                if para.left.nodetype=typen then
                  begin
                    CGMessagePos(para.left.fileinfo,type_e_cant_read_write_type);
                    found_error := true;
                  end;

                { support writeln(procvar) }
                if (para.left.resulttype.def.deftype=procvardef) then
                  begin
                    p1:=ccallnode.create(nil,nil,nil,nil);
                    tcallnode(p1).set_procvar(para.left);
                    resulttypepass(p1);
                    para.left:=p1;
                  end;

                if not is_equal(para.left.resulttype.def,tfiledef(filepara.resulttype.def).typedfiletype.def) then
                  begin
                    CGMessagePos(para.left.fileinfo,type_e_mismatch);
                    found_error := true;
                  end;

                if assigned(para.right) and
                   (cpf_is_colon_para in tcallparanode(para.right).callparaflags) then
                  begin
                    CGMessagePos(para.right.fileinfo,parser_e_illegal_colon_qualifier);

                    { skip all colon para's }
                    nextpara := tcallparanode(tcallparanode(para.right).right);
                    while assigned(nextpara) and
                          (cpf_is_colon_para in nextpara.callparaflags) do
                      nextpara := tcallparanode(nextpara.right);

                    found_error := true;
                  end
                else
                  { get next parameter }
                  nextpara := tcallparanode(para.right);

                { When we have a call, we have a problem: you can't pass the  }
                { result of a call as a formal const parameter. Solution:     }
                { assign the result to a temp and pass this temp as parameter }
                { This is not very efficient, but write(typedfile,x) is       }
                { already slow by itself anyway (no buffering) (JM)           }
                if (para.left.nodetype = calln) then
                  begin
                    { create temp for result }
                    temp := ctempcreatenode.create(para.left.resulttype,
                      para.left.resulttype.def.size,true);
                    newstatement.left := cstatementnode.create(nil,temp);
                    { assign result to temp }
                    newstatement := tstatementnode(newstatement.left);
                    newstatement.left := cstatementnode.create(nil,
                      cassignmentnode.create(ctemprefnode.create(temp),
                      para.left));
                    newstatement := tstatementnode(newstatement.left);
                    { replace (reused) paranode with temp }
                    para.left := ctemprefnode.create(temp);
                  end;
                { add fileparameter }
                para.right := filepara.getcopy;

                { create call statment                                             }
                { since the parameters are in the correct order, we have to insert }
                { the statements always at the end of the current block            }
                newstatement.left := cstatementnode.create(nil,
                  ccallnode.createintern(procprefix,para));
                newstatement := tstatementnode(newstatement.left);

                { if we used a temp, free it }
                if para.left.nodetype = temprefn then
                  begin
                    newstatement.left := cstatementnode.create(nil,
                      ctempdeletenode.create(temp));
                    newstatement := tstatementnode(newstatement.left);
                  end;

                { process next parameter }
                para := nextpara;
              end;

            { free the file parameter }
            filepara.free;
          end
        else
          { text read/write }
          begin
            while assigned(para) do
              begin
                { is this parameter faulty? }
                error_para := false;
                { is this parameter an ordinal? }
                is_ordinal := false;
                { is this parameter a real? }
                is_real:=false;

                { can't read/write types }
                if para.left.nodetype=typen then
                  begin
                    CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
                    error_para := true;
                  end;

                { support writeln(procvar) }
                if (para.left.resulttype.def.deftype=procvardef) then
                  begin
                    p1:=ccallnode.create(nil,nil,nil,nil);
                    tcallnode(p1).set_procvar(para.left);
                    resulttypepass(p1);
                    para.left:=p1;
                  end;

                case para.left.resulttype.def.deftype of
                  stringdef :
                    begin
                      name := procprefix+tstringdef(para.left.resulttype.def).stringtypname;
                    end;
                  pointerdef :
                    begin
                      if not is_pchar(para.left.resulttype.def) then
                        begin
                          CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
                          error_para := true;
                        end
                      else
                        name := procprefix+'pchar_as_pointer';
                    end;
                  floatdef :
                    begin
                      is_real:=true;
                      name := procprefix+'float';
                    end;
                  orddef :
                    begin
                      is_ordinal := true;
                      case torddef(para.left.resulttype.def).typ of
                        s8bit,s16bit,s32bit :
                          name := procprefix+'sint';
                        u8bit,u16bit,u32bit :
                          name := procprefix+'uint';
                        uchar :
                          name := procprefix+'char';
                        uwidechar :
                          name := procprefix+'widechar';
                        s64bit :
                          name := procprefix+'int64';
                        u64bit :
                          name := procprefix+'qword';
                        bool8bit,
                        bool16bit,
                        bool32bit :
                          begin
                            if do_read then
                              begin
                                CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
                                error_para := true;
                              end
                            else
                              name := procprefix+'boolean'
                            end
                        else
                          begin
                            CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
                            error_para := true;
                          end;
                      end;
                    end;
                  arraydef :
                    begin
                      if is_chararray(para.left.resulttype.def) then
                        name := procprefix+'pchar_as_array'
                      else
                        begin
                          CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
                          error_para := true;
                        end
                    end
                  else
                    begin
                      CGMessagePos(para.fileinfo,type_e_cant_read_write_type);
                      error_para := true;
                    end
                end;

                { check for length/fractional colon para's }
                fracpara := nil;
                lenpara := nil;
                if assigned(para.right) and
                   (cpf_is_colon_para in tcallparanode(para.right).callparaflags) then
                  begin
                    lenpara := tcallparanode(para.right);
                    if assigned(lenpara.right) and
                       (cpf_is_colon_para in tcallparanode(lenpara.right).callparaflags) then
                      fracpara:=tcallparanode(lenpara.right);
                  end;
                { get the next parameter now already, because we're going }
                { to muck around with the pointers                        }
                if assigned(fracpara) then
                  nextpara := tcallparanode(fracpara.right)
                else if assigned(lenpara) then
                  nextpara := tcallparanode(lenpara.right)
                else
                  nextpara := tcallparanode(para.right);

                { check if a fracpara is allowed }
                if assigned(fracpara) and not is_real then
                  begin
                    CGMessagePos(fracpara.fileinfo,parser_e_illegal_colon_qualifier);
                    error_para := true;
                  end
                else if assigned(lenpara) and do_read then
                  begin
                    { I think this is already filtered out by parsing, but I'm not sure (JM) }
                    CGMessagePos(lenpara.fileinfo,parser_e_illegal_colon_qualifier);
                    error_para := true;
                  end;

                { adjust found_error }
                found_error := found_error or error_para;

                if not error_para then
                  begin
                    { create dummy frac/len para's if necessary }
                    if not do_read then
                      begin
                        { difference in default value for floats and the rest :( }
                        if not is_real then
                          begin
                            if not assigned(lenpara) then
                              lenpara := ccallparanode.create(cordconstnode.create(0,s32bittype),nil)
                            else
                              { make sure we don't pass the successive }
                              { parameters too. We also already have a }
                              { reference to the next parameter in     }
                              { nextpara                               }
                              lenpara.right := nil;
                          end
                        else
                          begin
                            if not assigned(lenpara) then
                              lenpara := ccallparanode.create(
                                cordconstnode.create(-32767,s32bittype),nil);
                            { also create a default fracpara if necessary }
                            if not assigned(fracpara) then
                              fracpara := ccallparanode.create(
                                cordconstnode.create(-1,s32bittype),nil);
                            { add it to the lenpara }
                            lenpara.right := fracpara;
                            { and add the realtype para (this also removes the link }
                            { to any parameters coming after it)                    }
                            fracpara.right := ccallparanode.create(
                                cordconstnode.create(ord(tfloatdef(para.left.resulttype.def).typ),
                                s32bittype),nil);
                          end;
                      end;

                    if do_read and
                      ((is_ordinal and
                        (torddef(para.left.resulttype.def).typ in [s8bit,s16bit,u8bit,u16bit])
                       ) or
                       (is_real and
                        not is_equal(para.left.resulttype.def,pbestrealtype^.def)
                       )
                      ) then
                      { special handling of reading small numbers, because the helpers  }
                      { expect a longint/card/bestreal var parameter. Use a temp. can't }
                      { use functions because then the call to FPC_IOCHECK destroys     }
                      { their result before we can store it                             }
                      begin
                        { get the resulttype of the var parameter of the helper }
                        if is_real then
                          restype := pbestrealtype
                        else if is_signed(para.left.resulttype.def) then
                          restype := @s32bittype
                        else
                          restype := @u32bittype;

                        { create the parameter list: the temp ... }
                        temp := ctempcreatenode.create(restype^,restype^.def.size,true);
                        newstatement.left := cstatementnode.create(nil,temp);
                        newstatement := tstatementnode(newstatement.left);

                        { ... and the file }
                        p1 := ccallparanode.create(ctemprefnode.create(temp),
                          filepara.getcopy);

                        { create the call to the helper }
                        newstatement.left := cstatementnode.create(nil,
                          ccallnode.createintern(name,tcallparanode(p1)));
                        newstatement := tstatementnode(newstatement.left);

                        { assign the result to the original var (this automatically }
                        { takes care of range checking)                             }
                        newstatement.left := cstatementnode.create(nil,
                          cassignmentnode.create(para.left,
                           ctemprefnode.create(temp)));
                        newstatement := tstatementnode(newstatement.left);

                        { release the temp location }
                        newstatement.left := cstatementnode.create(nil,
                          ctempdeletenode.create(temp));
                        newstatement := tstatementnode(newstatement.left);

                        { statement of para is used }
                        para.left := nil;

                        { free the enclosing tcallparanode, but not the }
                        { parameters coming after it                    }
                        para.right := nil;
                        para.free;
                      end
                    else
                      { read of non s/u-8/16bit, or a write }
                      begin
                        { add the filepara to the current parameter }
                        para.right := filepara.getcopy;
                        { add the lenpara (fracpara and realtype are already linked }
                        { with it if necessary)                                     }
                        tcallparanode(para.right).right := lenpara;
                        { create the call statement }
                        newstatement.left := cstatementnode.create(nil,
                          ccallnode.createintern(name,para));
                        newstatement := tstatementnode(newstatement.left);
                      end
                  end
                else
                  { error_para = true }
                  begin
                    { free the parameter, since it isn't referenced anywhere anymore }
                    para.right := nil;
                    para.free;
                    if assigned(lenpara) then
                      begin
                        lenpara.right := nil;
                        lenpara.free;
                      end;
                    if assigned(fracpara) then
                      begin
                        fracpara.right := nil;
                        fracpara.free;
                      end;
                  end;

                { process next parameter }
                para := nextpara;
              end;

            { if no error, add the write(ln)/read(ln) end calls }
            if not found_error then
              begin
                case inlinenumber of
                  in_read_x:
                    newstatement.left := ccallnode.createintern('fpc_read_end',filepara);
                  in_write_x:
                    newstatement.left := ccallnode.createintern('fpc_write_end',filepara);
                  in_readln_x:
                    newstatement.left := ccallnode.createintern('fpc_readln_end',filepara);
                  in_writeln_x:
                    newstatement.left := ccallnode.createintern('fpc_writeln_end',filepara);
                end;
                newstatement.left := cstatementnode.create(nil,newstatement.left);
                newstatement := tstatementnode(newstatement.left);
              end;
          end;

          { if we found an error, simply delete the generated blocknode }
          if found_error then
            newblock.free
          else
            begin
              { deallocate the temp for the file para if we used one }
              if assigned(filetemp) then
                begin
                  newstatement.left := cstatementnode.create(nil,
                    ctempdeletenode.create(filetemp));
                  newstatement := tstatementnode(newstatement.left);
                end;
              { otherwise return the newly generated block of instructions, }
              { but first free the errornode we generated at the beginning }
              result.free;
              result := newblock
            end;
      end;


    function tinlinenode.handle_val: tnode;
      var
        procname,
        suffix        : string[31];
        sourcepara,
        destpara,
        codepara,
        sizepara,
        newparas      : tcallparanode;
        orgcode       : tnode;
        newstatement  : tstatementnode;
        newblock      : tblocknode;
        tempcode      : ttempcreatenode;
      begin
        { for easy exiting if something goes wrong }
        result := cerrornode.create;

        { 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;

        { reverse parameters for easier processing }
        left := reverseparameters(tcallparanode(left));

        { get the parameters }
        tempcode := nil;
        orgcode := nil;
        sizepara := nil;
        sourcepara := tcallparanode(left);
        destpara := tcallparanode(sourcepara.right);
        codepara := tcallparanode(destpara.right);

        { check if codepara is valid }
        if assigned(codepara) and
           ((codepara.resulttype.def.deftype <> orddef) or
            is_64bitint(codepara.resulttype.def)) then
          begin
            CGMessagePos(codepara.fileinfo,type_e_mismatch);
            exit;
          end;

        { check if dest para is valid }
        if not(destpara.resulttype.def.deftype in [orddef,floatdef]) then
          begin
            CGMessagePos(destpara.fileinfo,type_e_integer_or_real_expr_expected);
            exit;
          end;

        { we're going to reuse the exisiting para's, so make sure they }
        { won't be disposed                                            }
        left := nil;

        { create the blocknode which will hold the generated statements + }
        { an initial dummy statement                                      }
        newstatement := cstatementnode.create(nil,cnothingnode.create);
        newblock := cblocknode.create(newstatement);

        { do we need a temp for code? Yes, if no code specified, or if  }
        { code is not a 32bit parameter (we already checked whether the }
        { the code para, if specified, was an orddef)                   }
        if not assigned(codepara) or
           (torddef(codepara.resulttype.def).typ in [u8bit,u16bit,s8bit,s16bit]) then
          begin
            tempcode := ctempcreatenode.create(s32bittype,4,true);
            newstatement.left := cstatementnode.create(nil,tempcode);
            newstatement := tstatementnode(newstatement.left);
            { set the resulttype of the temp (needed to be able to get }
            { the resulttype of the tempref used in the new code para) }
            resulttypepass(tnode(tempcode));
            { create a temp codepara, but save the original code para to }
            { assign the result to later on                              }
            if assigned(codepara) then
              orgcode := codepara.left
            else
              codepara := ccallparanode.create(nil,nil);
            codepara.left := ctemprefnode.create(tempcode);
            { we need its resulttype later on }
            codepara.get_paratype;
          end
        else if (torddef(codepara.resulttype.def).typ = u32bit) then
          { because code is a var parameter, it must match types exactly    }
          { however, since it will return values in [0..255], both longints }
          { and cardinals are fine. Since the formal code para type is      }
          { longint, insert a typecoversion to longint for cardinal para's  }
          begin
            codepara.left := ctypeconvnode.create(codepara.left,s32bittype);
            { make it explicit, oterwise you may get a nonsense range }
            { check error if the cardinal already contained a value   }
            { > $7fffffff                                             }
            codepara.left.toggleflag(nf_explizit);
            codepara.get_paratype;
          end;

        { create the procedure name }
        procname := 'fpc_val_';

        case destpara.resulttype.def.deftype of
          orddef:
            begin
              case torddef(destpara.resulttype.def).typ of
                s8bit,s16bit,s32bit:
                  begin
                    suffix := 'sint_';
                    { we also need a destsize para in this case }
                    sizepara := ccallparanode.create(cordconstnode.create
                      (destpara.resulttype.def.size,s32bittype),nil);
                  end;
                u8bit,u16bit,u32bit:
                   suffix := 'uint_';
                s64bit: suffix := 'int64_';
                u64bit: suffix := 'qword_';
              end;
            end;
          floatdef:
            begin
              suffix := 'real_';
            end;
        end;

        procname := procname + suffix;

        { play a trick to have tcallnode handle invalid source parameters: }
        { the shortstring-longint val routine by default                   }
        if (sourcepara.resulttype.def.deftype = stringdef) then
          procname := procname + tstringdef(sourcepara.resulttype.def).stringtypname
        else procname := procname + 'shortstr';

        { set up the correct parameters for the call: the code para... }
        newparas := codepara;
        { and the source para }
        codepara.right := sourcepara;
        { sizepara either contains nil if none is needed (which is ok, since   }
        { then the next statement severes any possible links with other paras  }
        { that sourcepara may have) or it contains the necessary size para and }
        { its right field is nil                                               }
        sourcepara.right := sizepara;

        { create the call and assign the result to dest  }
        { (val helpers are functions)                    }
        { the assignment will take care of rangechecking }
        newstatement.left := cstatementnode.create(nil,cassignmentnode.create(
          destpara.left,ccallnode.createintern(procname,newparas)));
        newstatement := tstatementnode(newstatement.left);

        { dispose of the enclosing paranode of the destination }
        destpara.left := nil;
        destpara.right := nil;
        destpara.free;

        { check if we used a temp for code and whether we have to store }
        { it to the real code parameter                                 }
        if assigned(orgcode) then
          begin
            newstatement.left := cstatementnode.create(nil,cassignmentnode.create(
              orgcode,ctemprefnode.create(tempcode)));
            newstatement := tstatementnode(newstatement.left);
          end;

        { release the temp if we allocated one }
        if assigned(tempcode) then
          begin
            newstatement.left := cstatementnode.create(nil,
              ctempdeletenode.create(tempcode));
            newstatement := tstatementnode(newstatement.left);
          end;

        { free the errornode }
        result.free;
        { and return it }
        result := newblock;
      end;


{$ifdef fpc}
{$maxfpuregisters 0}
{$endif fpc}

    function tinlinenode.det_resulttype:tnode;

        function do_lowhigh(const t:ttype) : tnode;
        var
           v    : tconstexprint;
           enum : tenumsym;
           hp   : tnode;
        begin
           case t.def.deftype of
             orddef:
               begin
                  if inlinenumber=in_low_x then
                    v:=torddef(t.def).low
                  else
                    v:=torddef(t.def).high;
                  { low/high of torddef are longints, so we need special }
                  { handling for cardinal and 64bit types (JM)           }
                  { 1.0.x doesn't support int64($ffffffff) correct, it'll expand
                    to -1 instead of staying $ffffffff. Therefor we use $ffff with
                    shl twice (PFV) }
                  if is_signed(t.def) and
                     is_64bitint(t.def) then
                    if (inlinenumber=in_low_x) then
                      v := int64($80000000) shl 32
                    else
                      v := (int64($7fffffff) shl 32) or int64($ffff) shl 16 or int64($ffff)
                  else
                    if is_64bitint(t.def) then
                      { we have to use a dirty trick for high(qword),     }
                      { because it's bigger than high(tconstexprint) (JM) }
                      v := 0
                    else
                      if not is_signed(t.def) then
                        v := cardinal(v);
                  hp:=cordconstnode.create(v,t);
                  resulttypepass(hp);
                  { fix high(qword) }
                  if not is_signed(t.def) and
                     is_64bitint(t.def) and
                     (inlinenumber = in_high_x) then
                    tordconstnode(hp).value := -1; { is the same as qword($ffffffffffffffff) }
                  do_lowhigh:=hp;
               end;
             enumdef:
               begin
                  enum:=tenumsym(tenumdef(t.def).firstenum);
                  v:=tenumdef(t.def).maxval;
                  if inlinenumber=in_high_x then
                    while assigned(enum) and (enum.value <> v) do
                      enum:=enum.nextenum;
                  if not assigned(enum) then
                    internalerror(309993)
                  else
                    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);
        begin
           result:=crealconstnode.create(r,pbestrealtype^);
        end;

      var
         vl,vl2    : longint;
         vr        : bestreal;
         hp        : tnode;
         srsym     : tsym;
         isreal    : boolean;
      label
         myexit;
      begin
         result:=nil;
         { if we handle writeln; left contains no valid address }
         if assigned(left) then
           begin
             if left.nodetype=callparan then
               tcallparanode(left).get_paratype
             else
               resulttypepass(left);
           end;
         inc(parsing_para_level);

         { handle intern constant functions in separate case }
         if nf_inlineconst in flags then
          begin
            { no parameters? }
            if not assigned(left) then
             begin
               case inlinenumber of
                 in_const_pi :
                   hp:=crealconstnode.create(pi,pbestrealtype^);
                 else
                   internalerror(89);
               end;
             end
            else
             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:=cordconstnode.create(1,s32bittype)
                            end
                          else
                            hp:=cordconstnode.create(trunc(vr),s32bittype)
                       end
                     else
                      hp:=cordconstnode.create(trunc(vl),s32bittype);
                   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:=cordconstnode.create(1,s32bittype)
                            end
                          else
                            hp:=cordconstnode.create(round(vr),s32bittype)
                       end
                     else
                      hp:=cordconstnode.create(round(vl),s32bittype);
                   end;
                 in_const_frac :
                   begin
                     if isreal then
                      hp:=crealconstnode.create(frac(vr),pbestrealtype^)
                     else
                      hp:=crealconstnode.create(frac(vl),pbestrealtype^);
                   end;
                 in_const_int :
                   begin
                     if isreal then
                      hp:=crealconstnode.create(int(vr),pbestrealtype^)
                     else
                      hp:=crealconstnode.create(int(vl),pbestrealtype^);
                   end;
                 in_const_abs :
                   begin
                     if isreal then
                      hp:=crealconstnode.create(abs(vr),pbestrealtype^)
                     else
                      hp:=cordconstnode.create(abs(vl),left.resulttype);
                   end;
                 in_const_sqr :
                   begin
                     if isreal then
                      hp:=crealconstnode.create(sqr(vr),pbestrealtype^)
                     else
                      hp:=cordconstnode.create(sqr(vl),left.resulttype);
                   end;
                 in_const_odd :
                   begin
                     if isreal then
                      CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename)
                     else
                      hp:=cordconstnode.create(byte(odd(vl)),booltype);
                   end;
                 in_const_swap_word :
                   begin
                     if isreal then
                      CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename)
                     else
                      hp:=cordconstnode.create((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:=cordconstnode.create((vl and $ffff) shl 16+(vl shr 16),left.resulttype);
                   end;
                 in_const_ptr :
                   begin
                     if isreal then
                      CGMessage(type_e_mismatch)
                     else
                      hp:=cpointerconstnode.create((vl2 shl 4)+vl,voidfarpointertype);
                   end;
                 in_const_sqrt :
                   begin
                     if isreal then
                       begin
                          if vr<0.0 then
                           CGMessage(type_e_wrong_math_argument)
                          else
                           hp:=crealconstnode.create(sqrt(vr),pbestrealtype^)
                       end
                     else
                       begin
                          if vl<0 then
                           CGMessage(type_e_wrong_math_argument)
                          else
                           hp:=crealconstnode.create(sqrt(vl),pbestrealtype^);
                       end;
                   end;
                 in_const_arctan :
                   begin
                     if isreal then
                      hp:=crealconstnode.create(arctan(vr),pbestrealtype^)
                     else
                      hp:=crealconstnode.create(arctan(vl),pbestrealtype^);
                   end;
                 in_const_cos :
                   begin
                     if isreal then
                      hp:=crealconstnode.create(cos(vr),pbestrealtype^)
                     else
                      hp:=crealconstnode.create(cos(vl),pbestrealtype^);
                   end;
                 in_const_sin :
                   begin
                     if isreal then
                      hp:=crealconstnode.create(sin(vr),pbestrealtype^)
                     else
                      hp:=crealconstnode.create(sin(vl),pbestrealtype^);
                   end;
                 in_const_exp :
                   begin
                     if isreal then
                      hp:=crealconstnode.create(exp(vr),pbestrealtype^)
                     else
                      hp:=crealconstnode.create(exp(vl),pbestrealtype^);
                   end;
                 in_const_ln :
                   begin
                     if isreal then
                       begin
                          if vr<=0.0 then
                           CGMessage(type_e_wrong_math_argument)
                          else
                           hp:=crealconstnode.create(ln(vr),pbestrealtype^)
                       end
                     else
                       begin
                          if vl<=0 then
                           CGMessage(type_e_wrong_math_argument)
                          else
                           hp:=crealconstnode.create(ln(vl),pbestrealtype^);
                       end;
                   end;
                 else
                   internalerror(88);
               end;
             end;
            if hp=nil then
             hp:=tnode.create(errorn);
            result:=hp;
            goto myexit;
          end
         else
          begin
            case inlinenumber of
              in_lo_long,
              in_hi_long,
              in_lo_qword,
              in_hi_qword,
              in_lo_word,
              in_hi_word :
                begin
                  { give warning for incompatibility with tp and delphi }
                  if (inlinenumber in [in_lo_long,in_hi_long,in_lo_qword,in_hi_qword]) and
                     ((m_tp7 in aktmodeswitches) or
                      (m_delphi in aktmodeswitches)) then
                    CGMessage(type_w_maybe_wrong_hi_lo);
                  { constant folding }
                  if left.nodetype=ordconstn then
                   begin
                     case inlinenumber of
                       in_lo_word :
                         hp:=cordconstnode.create(tordconstnode(left).value and $ff,left.resulttype);
                       in_hi_word :
                         hp:=cordconstnode.create(tordconstnode(left).value shr 8,left.resulttype);
                       in_lo_long :
                         hp:=cordconstnode.create(tordconstnode(left).value and $ffff,left.resulttype);
                       in_hi_long :
                         hp:=cordconstnode.create(tordconstnode(left).value shr 16,left.resulttype);
                       in_lo_qword :
                         hp:=cordconstnode.create(tordconstnode(left).value and $ffffffff,left.resulttype);
                       in_hi_qword :
                         hp:=cordconstnode.create(tordconstnode(left).value shr 32,left.resulttype);
                     end;
                     result:=hp;
                     goto myexit;
                   end;
                  set_varstate(left,true);
                  if not is_integer(left.resulttype.def) then
                   CGMessage(type_e_mismatch);
                  case inlinenumber of
                    in_lo_word,
                    in_hi_word :
                      resulttype:=u8bittype;
                    in_lo_long,
                    in_hi_long :
                      resulttype:=u16bittype;
                    in_lo_qword,
                    in_hi_qword :
                      resulttype:=u32bittype;
                  end;
                end;


              in_sizeof_x:
                begin
                  set_varstate(left,false);
                  resulttype:=s32bittype;
                end;

              in_typeof_x:
                begin
                  set_varstate(left,false);
                  resulttype:=voidpointertype;
                end;

              in_ord_x:
                begin
                   if (left.nodetype=ordconstn) then
                    begin
                      hp:=cordconstnode.create(tordconstnode(left).value,s32bittype);
                      result:=hp;
                      goto myexit;
                    end;
                   set_varstate(left,true);
                   case left.resulttype.def.deftype of
                     orddef :
                       begin
                         case torddef(left.resulttype.def).typ of
                           bool8bit,
                           uchar:
                             begin
                               { change to byte() }
                               hp:=ctypeconvnode.create(left,u8bittype);
                               left:=nil;
                               include(hp.flags,nf_explizit);
                               result:=hp;
                             end;
                           bool16bit,
                           uwidechar :
                             begin
                               { change to word() }
                               hp:=ctypeconvnode.create(left,u16bittype);
                               left:=nil;
                               include(hp.flags,nf_explizit);
                               result:=hp;
                             end;
                           bool32bit :
                             begin
                               { change to dword() }
                               hp:=ctypeconvnode.create(left,u32bittype);
                               left:=nil;
                               include(hp.flags,nf_explizit);
                               result:=hp;
                             end;
                           uvoid :
                             CGMessage(type_e_mismatch)
                           else
                             begin
                               { all other orddef need no transformation }
                               hp:=left;
                               left:=nil;
                               result:=hp;
                             end;
                         end;
                       end;
                     enumdef :
                       begin
                         hp:=ctypeconvnode.create(left,s32bittype);
                         left:=nil;
                         include(hp.flags,nf_explizit);
                         result:=hp;
                       end;
                     else
                       CGMessage(type_e_mismatch);
                   end;
                end;

              in_chr_byte:
                begin
                   { convert to explicit char() }
                   set_varstate(left,true);
                   hp:=ctypeconvnode.create(left,cchartype);
                   include(hp.flags,nf_explizit);
                   left:=nil;
                   result:=hp;
                end;

              in_length_x:
                begin
                  set_varstate(left,true);

                  case left.resulttype.def.deftype of
                    stringdef :
                      begin
                        { we don't need string convertions here }
                        if (left.nodetype=typeconvn) and
                           (ttypeconvnode(left).left.resulttype.def.deftype=stringdef) then
                         begin
                           hp:=ttypeconvnode(left).left;
                           ttypeconvnode(left).left:=nil;
                           left.free;
                           left:=hp;
                         end;

                        { evaluates length of constant strings direct }
                        if (left.nodetype=stringconstn) then
                         begin
                           hp:=cordconstnode.create(tstringconstnode(left).len,s32bittype);
                           result:=hp;
                           goto myexit;
                         end;
                      end;
                    orddef :
                      begin
                        { length of char is one allways }
                        if is_char(left.resulttype.def) or
                           is_widechar(left.resulttype.def) then
                         begin
                           hp:=cordconstnode.create(1,s32bittype);
                           result:=hp;
                           goto myexit;
                         end
                        else
                         CGMessage(type_e_mismatch);
                      end;
                    arraydef :
                      begin
                        if is_open_array(left.resulttype.def) or
                           is_array_of_const(left.resulttype.def) then
                         begin
                           srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name);
                           hp:=caddnode.create(addn,cloadnode.create(srsym,tloadnode(left).symtable),
                                                    cordconstnode.create(1,s32bittype));
                           result:=hp;
                           goto myexit;
                         end
                        else
                         if not is_dynamic_array(left.resulttype.def) then
                          begin
                            hp:=cordconstnode.create(tarraydef(left.resulttype.def).highrange-
                                                      tarraydef(left.resulttype.def).lowrange+1,
                                                     s32bittype);
                            result:=hp;
                            goto myexit;
                          end
                        else
                          begin
                            { can't use inserttypeconv because we need }
                            { an explicit type conversion (JM)         }
                            hp := ctypeconvnode.create(left,voidpointertype);
                            hp.toggleflag(nf_explizit);
                            hp := ccallparanode.create(hp,nil);
                            result := ccallnode.createintern('fpc_dynarray_length',hp);
                            { make sure the left node doesn't get disposed, since it's }
                            { reused in the new node (JM)                              }
                            left:=nil;
                            resulttypepass(result);
                            exit;
                          end;
                      end;
                    else
                      CGMessage(type_e_mismatch);
                  end;

                  { shortstring return an 8 bit value as the length
                    is the first byte of the string }
                  if is_shortstring(left.resulttype.def) then
                   resulttype:=u8bittype
                  else
                   resulttype:=s32bittype;
                end;

              in_typeinfo_x:
                begin
                   set_varstate(left,true);
                   resulttype:=voidpointertype;
                end;

              in_assigned_x:
                begin
{
                   result := caddnode.create(unequaln,
                     ctypeconvnode.create_explicit(tcallparanode(left).left,
                     voidpointertype),cnilnode.create);
}
                   result := caddnode.create(unequaln,tcallparanode(left).left,
                     cnilnode.create);
                   tcallparanode(left).left := nil;
                   { free left, because otherwise some code at 'myexit' tries  }
                   { to run get_paratype for it, which crashes since left.left }
                   { is now nil                                                }
                   left.free;
                   left := nil;
                   resulttypepass(result);
                   goto myexit;
                end;

              in_ofs_x :
                internalerror(2000101001);

              in_seg_x :
                begin
                  set_varstate(left,false);
                  hp:=cordconstnode.create(0,s32bittype);
                  result:=hp;
                  goto myexit;
                end;

              in_pred_x,
              in_succ_x:
                begin
                   set_varstate(left,true);
                   resulttype:=left.resulttype;
                   if not is_ordinal(resulttype.def) then
                     CGMessage(type_e_ordinal_expr_expected)
                   else
                     begin
                       if (resulttype.def.deftype=enumdef) and
                          (tenumdef(resulttype.def).has_jumps) then
                         CGMessage(type_e_succ_and_pred_enums_with_assign_not_possible);
                     end;

                   { do constant folding after check for jumps }
                   if left.nodetype=ordconstn then
                    begin
                      if inlinenumber=in_succ_x then
                       hp:=cordconstnode.create(tordconstnode(left).value+1,left.resulttype)
                      else
                       hp:=cordconstnode.create(tordconstnode(left).value-1,left.resulttype);
                      result:=hp;
                    end;
                end;

              in_finalize_x,
              in_setlength_x:
                begin
                  { inlined from pinline }
                  internalerror(200204231);
                end;

              in_inc_x,
              in_dec_x:
                begin
                  resulttype:=voidtype;
                  if assigned(left) then
                    begin
                       set_varstate(left,true);
                       if codegenerror then
                        exit;
                       { first param must be var }
                       valid_for_var(tcallparanode(left).left);

                       if (left.resulttype.def.deftype in [enumdef,pointerdef]) or
                          is_ordinal(left.resulttype.def) then
                        begin
                           { value of left gets changed -> must be unique }
                           { (bug 1735) (JM)                              }
                           set_unique(tcallparanode(left).left);
                           { two paras ? }
                          if assigned(tcallparanode(left).right) then
                           begin
                             if (aktlocalswitches *
                                   [cs_check_overflow,cs_check_range] = []) then
                               begin
                                 { insert a type conversion       }
                                 { the second param is always longint }
                                 if is_64bitint(left.resulttype.def) then
                                   if is_signed(left.resulttype.def) then
                                     inserttypeconv(tcallparanode(tcallparanode(left).right).left,cs64bittype)
                                   else
                                     inserttypeconv(tcallparanode(tcallparanode(left).right).left,cu64bittype)
                                 else
                                   if is_signed(left.resulttype.def) then
                                     inserttypeconv(tcallparanode(tcallparanode(left).right).left,s32bittype)
                                   else
                                     inserttypeconv(tcallparanode(tcallparanode(left).right).left,u32bittype);
                               end;

                             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
                  result := handle_read_write;
                end;
              in_settextbuf_file_x :
                begin
                  resulttype:=voidtype;
                  { now we know the type of buffer }
                  srsym:=searchsymonlyin(systemunit,'SETTEXTBUF');
                  hp:=ccallparanode.create(cordconstnode.create(tcallparanode(left).left.resulttype.def.size,s32bittype),left);
                  hp:=ccallnode.create(hp,tprocsym(srsym),systemunit,nil);
                  left:=nil;
                  result:=hp;
                end;

              { the firstpass of the arg has been done in firstcalln ? }
              in_reset_typedfile,
              in_rewrite_typedfile :
                begin
                  result := handle_reset_rewrite_typed;
                end;

              in_str_x_string :
                begin
                  result := handle_str;
                end;

              in_val_x :
                begin
                  result := handle_val;
                end;

              in_include_x_y,
              in_exclude_x_y:
                begin
                  resulttype:=voidtype;
                  { the parser already checks whether we have two (and exectly two) }
                  { parameters (JM)                                                 }
                  set_varstate(left,true);
                  { first param must be var }
                  valid_for_var(tcallparanode(left).left);
                  { check type }
                  if (left.resulttype.def.deftype=setdef) then
                    begin
                      { insert a type conversion       }
                      { to the type of the set elements  }
                      inserttypeconv(tcallparanode(tcallparanode(left).right).left,
                        tsetdef(left.resulttype.def).elementtype);
                    end
                  else
                    CGMessage(type_e_mismatch);
                end;

              in_low_x,
              in_high_x:
                begin
                  set_varstate(left,false);
                  case left.resulttype.def.deftype of
                    orddef,
                    enumdef:
                      begin
                        result:=do_lowhigh(left.resulttype);
                      end;
                    setdef:
                      begin
                        result:=do_lowhigh(tsetdef(left.resulttype.def).elementtype);
                      end;
                    arraydef:
                      begin
                        if inlinenumber=in_low_x then
                         begin
                           result:=cordconstnode.create(tarraydef(left.resulttype.def).lowrange,tarraydef(left.resulttype.def).rangetype);
                         end
                        else
                         begin
                           if is_open_array(left.resulttype.def) or
                             is_array_of_const(left.resulttype.def) then
                            begin
                              srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name);
                              result:=cloadnode.create(srsym,tloadnode(left).symtable);
                            end
                           else
                            if is_dynamic_array(left.resulttype.def) then
                              begin
                                { can't use inserttypeconv because we need }
                                { an explicit type conversion (JM)         }
                                hp := ctypeconvnode.create(left,voidpointertype);
                                hp.toggleflag(nf_explizit);
                                hp := ccallparanode.create(hp,nil);
                                result := ccallnode.createintern('fpc_dynarray_high',hp);
                                { make sure the left node doesn't get disposed, since it's }
                                { reused in the new node (JM)                              }
                                left:=nil;
                              end
                           else
                            begin
                              result:=cordconstnode.create(tarraydef(left.resulttype.def).highrange,tarraydef(left.resulttype.def).rangetype);
                            end;
                         end;
                         resulttypepass(result);
                      end;
                    stringdef:
                      begin
                        if inlinenumber=in_low_x then
                         begin
                           hp:=cordconstnode.create(0,u8bittype);
                           resulttypepass(hp);
                           result:=hp;
                         end
                        else
                         begin
                           if is_open_string(left.resulttype.def) then
                            begin
                              srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name);
                              hp:=cloadnode.create(srsym,tloadnode(left).symtable);
                              resulttypepass(hp);
                              result:=hp;
                            end
                           else
                            begin
                              hp:=cordconstnode.create(tstringdef(left.resulttype.def).len,u8bittype);
                              resulttypepass(hp);
                              result:=hp;
                            end;
                         end;
                     end;
                    else
                      CGMessage(type_e_mismatch);
                  end;
                end;

             in_pi:
                begin
                  if block_type=bt_const then
                     setconstrealvalue(pi)
                  else
                     resulttype:=pbestrealtype^;
                end;
              in_cos_extended :
                begin
                  if left.nodetype in [ordconstn,realconstn] then
                   setconstrealvalue(cos(getconstrealvalue))
                  else
                   begin
                     set_varstate(left,true);
                     inserttypeconv(left,pbestrealtype^);
                     resulttype:=pbestrealtype^;
                   end;
                end;

              in_sin_extended :
                begin
                  if left.nodetype in [ordconstn,realconstn] then
                   setconstrealvalue(sin(getconstrealvalue))
                  else
                   begin
                     set_varstate(left,true);
                     inserttypeconv(left,pbestrealtype^);
                     resulttype:=pbestrealtype^;
                   end;
                end;

              in_arctan_extended :
                begin
                  if left.nodetype in [ordconstn,realconstn] then
                   setconstrealvalue(arctan(getconstrealvalue))
                  else
                   begin
                     set_varstate(left,true);
                     inserttypeconv(left,pbestrealtype^);
                     resulttype:=pbestrealtype^;
                   end;
                end;

              in_abs_extended :
                begin
                  if left.nodetype in [ordconstn,realconstn] then
                   setconstrealvalue(abs(getconstrealvalue))
                  else
                   begin
                     set_varstate(left,true);
                     inserttypeconv(left,pbestrealtype^);
                     resulttype:=pbestrealtype^;
                   end;
                end;

              in_sqr_extended :
                begin
                  if left.nodetype in [ordconstn,realconstn] then
                   setconstrealvalue(sqr(getconstrealvalue))
                  else
                   begin
                     set_varstate(left,true);
                     inserttypeconv(left,pbestrealtype^);
                     resulttype:=pbestrealtype^;
                   end;
                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
                   begin
                     set_varstate(left,true);
                     inserttypeconv(left,pbestrealtype^);
                     resulttype:=pbestrealtype^;
                   end;
                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
                   begin
                     set_varstate(left,true);
                     inserttypeconv(left,pbestrealtype^);
                     resulttype:=pbestrealtype^;
                   end;
                end;

 {$ifdef SUPPORT_MMX}
              in_mmx_pcmpeqb..in_mmx_pcmpgtw:
                begin
                end;
 {$endif SUPPORT_MMX}

              in_assert_x_y :
                begin
                  resulttype:=voidtype;
                  if assigned(left) then
                    begin
                       set_varstate(left,true);
                       { check type }
                       if is_boolean(left.resulttype.def) then
                         begin
                            { must always be a string }
                            inserttypeconv(tcallparanode(tcallparanode(left).right).left,cshortstringtype);
                         end
                       else
                         CGMessage(type_e_mismatch);
                    end
                  else
                    CGMessage(type_e_mismatch);
                end;

               else
                internalerror(8);
            end;
          end;

      myexit:
        { Run get_paratype again to update maybe inserted typeconvs }
        if not codegenerror then
         begin
           if assigned(left) and
              (left.nodetype=callparan) then
            tcallparanode(left).get_paratype;
         end;
        dec(parsing_para_level);
      end;


    function tinlinenode.pass_1 : tnode;
      var
         srsym   : tsym;
         hp,hpp  : tnode;
         shiftconst: longint;

      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;
              location.loc:=left.location.loc;
           end;
         inc(parsing_para_level);
         { intern const should already be handled }
         if nf_inlineconst in flags then
          internalerror(200104044);
         case inlinenumber of
          in_lo_qword,
          in_hi_qword,
          in_lo_long,
          in_hi_long,
          in_lo_word,
          in_hi_word:
            begin
              shiftconst := 0;
              case inlinenumber of
                in_hi_qword:
                  shiftconst := 32;
                in_hi_long:
                  shiftconst := 16;
                in_hi_word:
                  shiftconst := 8;
              end;
              if shiftconst <> 0 then
                result := ctypeconvnode.create(cshlshrnode.create(shrn,left,
                    cordconstnode.create(shiftconst,u32bittype)),resulttype)
              else
                result := ctypeconvnode.create(left,resulttype);
              left := nil;
              include(result.flags,nf_explizit);
              firstpass(result);
            end;
          in_sizeof_x:
            begin
              if paramanager.push_high_param(left.resulttype.def) then
               begin
                 srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name);
                 hp:=caddnode.create(addn,cloadnode.create(srsym,tloadnode(left).symtable),
                                  cordconstnode.create(1,s32bittype));
                 if (left.resulttype.def.deftype=arraydef) and
                    (tarraydef(left.resulttype.def).elesize<>1) then
                   hp:=caddnode.create(muln,hp,cordconstnode.create(tarraydef(left.resulttype.def).elesize,s32bittype));
                 firstpass(hp);
                 result:=hp;
               end
              else
               begin
                 if registers32<1 then
                    registers32:=1;
                 location.loc:=LOC_REGISTER;
               end;
            end;

          in_typeof_x:
            begin
               if registers32<1 then
                 registers32:=1;
               location.loc:=LOC_REGISTER;
            end;

          in_ord_x,
          in_chr_byte:
            begin
               { should not happend as it's converted to typeconv }
               internalerror(200104045);
            end;


          in_length_x:
            begin
               if is_shortstring(left.resulttype.def) then
                location.loc:=LOC_REFERENCE
               else
                begin
                  { ansi/wide string }
                  if registers32<1 then
                   registers32:=1;
                  location.loc:=LOC_REGISTER;
                end;
            end;

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

          in_assigned_x:
            begin
               { should be removed in resulttype pass }
               internalerror(2002080201);
            end;

          in_ofs_x :
            internalerror(2000101001);

          in_seg_x :
            internalerror(200104046);

          in_pred_x,
          in_succ_x:
            begin
              if is_64bitint(resulttype.def) then
               begin
                 if (registers32<2) then
                  registers32:=2
               end
              else
               begin
                 if (registers32<1) then
                  registers32:=1;
               end;
              location.loc:=LOC_REGISTER;
            end;

          in_setlength_x:
            begin
            end;

          in_finalize_x:
            begin
            end;

          in_inc_x,
          in_dec_x:
            begin
               { check type }
               if is_64bitint(left.resulttype.def) or
                  { range/overflow checking doesn't work properly }
                  { with the inc/dec code that's generated (JM)   }
                  ((left.resulttype.def.deftype = orddef) and
                   not(is_char(left.resulttype.def)) and
                   not(is_boolean(left.resulttype.def)) and
                   (aktlocalswitches *
                    [cs_check_overflow,cs_check_range] <> [])) then
                 { convert to simple add (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,s32bittype);
                   { 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 }
                   result := hpp;
                 end
               else if (left.resulttype.def.deftype in [enumdef,pointerdef]) or
                       is_ordinal(left.resulttype.def) then
                 begin
                    { two paras ? }
                    if assigned(tcallparanode(left).right) then
                      begin
                         { need we an additional register ? }
                         if not(is_constintnode(tcallparanode(tcallparanode(left).right).left)) and
                           (tcallparanode(tcallparanode(left).right).left.location.loc in [LOC_CREFERENCE,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);
                      end;
                 end;
            end;

          in_read_x,
          in_readln_x,
          in_write_x,
          in_writeln_x :
            begin
               { should be handled by det_resulttype }
               internalerror(200108234);
            end;
         in_settextbuf_file_x :
           internalerror(200104262);

         in_reset_typedfile,
         in_rewrite_typedfile :
           begin
              { should already be removed in det_resulttype (JM) }
              internalerror(200108236);
           end;

         in_str_x_string :
           begin
              { should already be removed in det_resulttype (JM) }
              internalerror(200108235);
           end;

         in_val_x :
           begin
              { should already be removed in det_resulttype (JM) }
              internalerror(200108242);
           end;

         in_include_x_y,
         in_exclude_x_y:
           begin
              registers32:=left.registers32;
              registersfpu:=left.registersfpu;
{$ifdef SUPPORT_MMX}
              registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
           end;

         in_low_x,
         in_high_x:
          internalerror(200104047);

         in_cos_extended:
           begin
             result:= first_cos_real;
           end;

         in_sin_extended:
           begin
             result := first_sin_real;
           end;

         in_arctan_extended:
           begin
             result := first_arctan_real;
           end;

         in_pi:
           begin
             result := first_pi;
           end;

         in_abs_extended:
           begin
             result := first_abs_real;
           end;

         in_sqr_extended:
           begin
             result := first_sqr_real;
           end;

         in_sqrt_extended:
           begin
             result := first_sqrt_real;
           end;

         in_ln_extended:
           begin
             result := first_ln_real;
           end;

{$ifdef SUPPORT_MMX}
         in_mmx_pcmpeqb..in_mmx_pcmpgtw:
           begin
           end;
{$endif SUPPORT_MMX}

         in_assert_x_y :
            begin
              { 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
               begin
                 { we need a valid node, so insert a nothingn }
                 result:=cnothingnode.create;
               end
              else
               begin
                 registers32:=left.registers32;
                 registersfpu:=left.registersfpu;
{$ifdef SUPPORT_MMX}
                 registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
               end;
            end;

          else
            internalerror(8);
          end;
         dec(parsing_para_level);
       end;
{$ifdef fpc}
{$maxfpuregisters default}
{$endif fpc}

    function tinlinenode.docompare(p: tnode): boolean;
      begin
        docompare :=
          inherited docompare(p) and
          (inlinenumber = tinlinenode(p).inlinenumber);
      end;


     function tinlinenode.first_pi : tnode;
      begin
        { create the call to the helper }
        first_pi := ccallnode.createintern('fpc_pi',nil);
        { now left is nil, nothing left, so no second pass
          required.
        }
        left := nil;
      end;


     function tinlinenode.first_arctan_real : tnode;
      begin
        { create the call to the helper }
        { on entry left node contains the parameter }
        first_arctan_real := ccallnode.createintern('fpc_arctan_real',
                ccallparanode.create(left,nil));
        { now left is nil, nothing left, so no second pass
          required.
        }
        left := nil;
      end;

     function tinlinenode.first_abs_real : tnode;
      begin
        { create the call to the helper }
        { on entry left node contains the parameter }
        first_abs_real := ccallnode.createintern('fpc_abs_real',
                ccallparanode.create(left,nil));
        { now left is nil, nothing left, so no second pass
          required.
        }
        left := nil;
      end;

     function tinlinenode.first_sqr_real : tnode;
      begin
        { create the call to the helper }
        { on entry left node contains the parameter }
        first_sqr_real := ccallnode.createintern('fpc_sqr_real',
                ccallparanode.create(left,nil));
        { now left is nil, nothing left, so no second pass
          required.
        }
        left := nil;
      end;

     function tinlinenode.first_sqrt_real : tnode;
      begin
        { create the call to the helper }
        { on entry left node contains the parameter }
        first_sqrt_real := ccallnode.createintern('fpc_sqrt_real',
                ccallparanode.create(left,nil));
        { now left is nil, nothing left, so no second pass
          required.
        }
        left := nil;
      end;

     function tinlinenode.first_ln_real : tnode;
      begin
        { create the call to the helper }
        { on entry left node contains the parameter }
        first_ln_real := ccallnode.createintern('fpc_ln_real',
                ccallparanode.create(left,nil));
        { now left is nil, nothing left, so no second pass
          required.
        }
        left := nil;
      end;

     function tinlinenode.first_cos_real : tnode;
      begin
        { create the call to the helper }
        { on entry left node contains the parameter }
        first_cos_real := ccallnode.createintern('fpc_cos_real',
                ccallparanode.create(left,nil));
        { now left is nil, nothing left, so no second pass
          required.
        }
        left := nil;
      end;

     function tinlinenode.first_sin_real : tnode;
      begin
        { create the call to the helper }
        { on entry left node contains the parameter }
        first_sin_real := ccallnode.createintern('fpc_sin_real',
                ccallparanode.create(left,nil));
        { now left is nil, nothing left, so no second pass
          required.
        }
        left := nil;
      end;


begin
   cinlinenode:=tinlinenode;
end.
{
  $Log$
  Revision 1.85  2002-09-02 19:24:42  peter
    * array of char support for Str()

  Revision 1.84  2002/08/19 19:36:43  peter
    * More fixes for cross unit inlining, all tnodes are now implemented
    * Moved pocall_internconst to po_internconst because it is not a
      calling type at all and it conflicted when inlining of these small
      functions was requested

  Revision 1.83  2002/08/02 07:44:31  jonas
    * made assigned() handling generic
    * add nodes now can also evaluate constant expressions at compile time
      that contain nil nodes

  Revision 1.82  2002/07/29 21:23:43  florian
    * more fixes for the ppc
    + wrappers for the tcnvnode.first_* stuff introduced

  Revision 1.81  2002/07/26 12:28:50  jonas
    * don't always convert the second argument of inc/dec to a longint, but
      to a type based on the first argument

  Revision 1.80  2002/07/25 18:00:19  carl
    + Resulttype for floats is now CPU independent (bestrealytype)
    + Generic version of some routines (call to RTL routines)
        : still untested.

  Revision 1.79  2002/07/20 11:57:54  florian
    * types.pas renamed to defbase.pas because D6 contains a types
      unit so this would conflicts if D6 programms are compiled
    + Willamette/SSE2 instructions to assembler added

  Revision 1.78  2002/07/11 14:41:28  florian
    * start of the new generic parameter handling

  Revision 1.77  2002/06/06 18:53:53  jonas
    * fixed fpu stack overflow in compiler when compiled with -Or

  Revision 1.76  2002/05/18 13:34:10  peter
    * readded missing revisions

  Revision 1.75  2002/05/16 19:46:38  carl
  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  + try to fix temp allocation (still in ifdef)
  + generic constructor calls
  + start of tassembler / tmodulebase class cleanup

  Revision 1.73  2002/05/12 16:53:07  peter
    * moved entry and exitcode to ncgutil and cgobj
    * foreach gets extra argument for passing local data to the
      iterator function
    * -CR checks also class typecasts at runtime by changing them
      into as
    * fixed compiler to cycle with the -CR option
    * fixed stabs with elf writer, finally the global variables can
      be watched
    * removed a lot of routines from cga unit and replaced them by
      calls to cgobj
    * u32bit-s32bit updates for and,or,xor nodes. When one element is
      u32bit then the other is typecasted also to u32bit without giving
      a rangecheck warning/error.
    * fixed pascal calling method with reversing also the high tree in
      the parast, detected by tcalcst3 test

  Revision 1.72  2002/04/23 19:16:34  peter
    * add pinline unit that inserts compiler supported functions using
      one or more statements
    * moved finalize and setlength from ninl to pinline

  Revision 1.71  2002/04/02 17:11:29  peter
    * tlocation,treference update
    * LOC_CONSTANT added for better constant handling
    * secondadd splitted in multiple routines
    * location_force_reg added for loading a location to a register
      of a specified size
    * secondassignment parses now first the right and then the left node
      (this is compatible with Kylix). This saves a lot of push/pop especially
      with string operations
    * adapted some routines to use the new cg methods

  Revision 1.70  2002/03/31 20:26:34  jonas
    + a_loadfpu_* and a_loadmm_* methods in tcg
    * register allocation is now handled by a class and is mostly processor
      independent (+rgobj.pas and i386/rgcpu.pas)
    * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
    * some small improvements and fixes to the optimizer
    * some register allocation fixes
    * some fpuvaroffset fixes in the unary minus node
    * push/popusedregisters is now called rg.save/restoreusedregisters and
      (for i386) uses temps instead of push/pop's when using -Op3 (that code is
      also better optimizable)
    * fixed and optimized register saving/restoring for new/dispose nodes
    * LOC_FPU locations now also require their "register" field to be set to
      R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
    - list field removed of the tnode class because it's not used currently
      and can cause hard-to-find bugs

  Revision 1.69  2002/01/24 18:25:48  peter
   * implicit result variable generation for assembler routines
   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead

  Revision 1.68  2002/01/19 11:53:56  peter
    * constant evaluation for assinged added

}