freepascal.compiler/compiler/nmat.pas

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

    Type checking and register allocation for math 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 nmat;

{$i fpcdefs.inc}

interface

    uses
       node;

    type
       tmoddivnode = class(tbinopnode)
          function pass_1 : tnode;override;
          function det_resulttype:tnode;override;
         protected
          { override the following if you want to implement }
          { parts explicitely in the code generator (JM)    }
          function first_moddiv64bitint: tnode; virtual;
          function firstoptimize: tnode; virtual;
          function first_moddivint: tnode; virtual;
       end;
       tmoddivnodeclass = class of tmoddivnode;

       tshlshrnode = class(tbinopnode)
          function pass_1 : tnode;override;
          function det_resulttype:tnode;override;
          { override the following if you want to implement }
          { parts explicitely in the code generator (CEC)
            Should return nil, if everything will be handled
            in the code generator
          }
          function first_shlshr64bitint: tnode; virtual;
       end;
       tshlshrnodeclass = class of tshlshrnode;

       tunaryminusnode = class(tunarynode)
          constructor create(expr : tnode);virtual;
          function pass_1 : tnode;override;
          function det_resulttype:tnode;override;
       end;
       tunaryminusnodeclass = class of tunaryminusnode;

       tnotnode = class(tunarynode)
          constructor create(expr : tnode);virtual;
          function pass_1 : tnode;override;
          function det_resulttype:tnode;override;
       {$ifdef state_tracking}
    function track_state_pass(exec_known:boolean):boolean;override;
  {$endif}
       end;
       tnotnodeclass = class of tnotnode;

    var
       cmoddivnode : tmoddivnodeclass;
       cshlshrnode : tshlshrnodeclass;
       cunaryminusnode : tunaryminusnodeclass;
       cnotnode : tnotnodeclass;


implementation

    uses
      systems,tokens,
      verbose,globals,cutils,
      globtype,
      symconst,symtype,symtable,symdef,defutil,
      htypechk,pass_1,cpubase,
      cgbase,procinfo,
      ncon,ncnv,ncal,nadd;

{****************************************************************************
                              TMODDIVNODE
 ****************************************************************************}

    function tmoddivnode.det_resulttype:tnode;
      var
         hp,t : tnode;
         rd,ld : torddef;
         rv,lv : tconstexprint;
      begin
         result:=nil;
         resulttypepass(left);
         resulttypepass(right);
         set_varstate(left,vs_used,true);
         set_varstate(right,vs_used,true);
         if codegenerror then
           exit;

         { we need 2 orddefs always }
         if (left.resulttype.def.deftype<>orddef) then
           inserttypeconv(right,s32bittype);
         if (right.resulttype.def.deftype<>orddef) then
           inserttypeconv(right,s32bittype);
         if codegenerror then
           exit;

         rd:=torddef(right.resulttype.def);
         ld:=torddef(left.resulttype.def);

         { check for division by zero }
         if is_constintnode(right) then
           begin
             rv:=tordconstnode(right).value;
             if (rv=0) then
               begin
                 Message(parser_e_division_by_zero);
                 { recover }
                 rv:=1;
               end;
             if is_constintnode(left) then
               begin
                 lv:=tordconstnode(left).value;

                 case nodetype of
                   modn:
                     if (torddef(ld).typ <> u64bit) or
                        (torddef(rd).typ <> u64bit) then
                       t:=genintconstnode(lv mod rv)
                     else
                       t:=genintconstnode(int64(qword(lv) mod qword(rv)));
                   divn:
                     if (torddef(ld).typ <> u64bit) or
                        (torddef(rd).typ <> u64bit) then
                       t:=genintconstnode(lv div rv)
                     else
                       t:=genintconstnode(int64(qword(lv) div qword(rv)));
                 end;
                 result:=t;
                 exit;
              end;
            end;

         { allow operator overloading }
         t:=self;
         if isbinaryoverloaded(t) then
           begin
              result:=t;
              exit;
           end;

         { if one operand is a cardinal and the other is a positive constant, convert the }
         { constant to a cardinal as well so we don't have to do a 64bit division (JM)    }
         { Do the same for qwords and positive constants as well, otherwise things like   }
         { "qword mod 10" are evaluated with int64 as result, which is wrong if the       }
         { "qword" was > high(int64) (JM)                                                 }
         if (rd.typ in [u32bit,u64bit]) and
            is_constintnode(left) and
            (tordconstnode(left).value >= 0) then
           inserttypeconv(left,right.resulttype)
         else
          if (ld.typ in [u32bit,u64bit]) and
             is_constintnode(right) and
             (tordconstnode(right).value >= 0) then
           inserttypeconv(right,left.resulttype);

         { when there is one currency value, everything is done
           using currency }
         if (ld.typ=scurrency) or
            (rd.typ=scurrency) then
           begin
             if (ld.typ<>scurrency) then
              inserttypeconv(left,s64currencytype);
             if (rd.typ<>scurrency) then
              inserttypeconv(right,s64currencytype);
             resulttype:=left.resulttype;
           end
         else
          { when there is one 64bit value, everything is done
            in 64bit }
          if (is_64bitint(left.resulttype.def) or
              is_64bitint(right.resulttype.def)) then
           begin
             if is_signed(rd) or is_signed(ld) then
               begin
                  if (torddef(ld).typ<>s64bit) then
                    inserttypeconv(left,cs64bittype);
                  if (torddef(rd).typ<>s64bit) then
                    inserttypeconv(right,cs64bittype);
               end
             else
               begin
                  if (torddef(ld).typ<>u64bit) then
                    inserttypeconv(left,cu64bittype);
                  if (torddef(rd).typ<>u64bit) then
                    inserttypeconv(right,cu64bittype);
               end;
             resulttype:=left.resulttype;
           end
         else
          { when mixing cardinals and signed numbers, convert everythign to 64bit (JM) }
          if ((rd.typ = u32bit) and
              is_signed(left.resulttype.def)) or
             ((ld.typ = u32bit) and
              is_signed(right.resulttype.def)) then
           begin
              CGMessage(type_w_mixed_signed_unsigned);
              if (torddef(ld).typ<>s64bit) then
                inserttypeconv(left,cs64bittype);
              if (torddef(rd).typ<>s64bit) then
                inserttypeconv(right,cs64bittype);
              resulttype:=left.resulttype;
           end
         else
           begin
              { Make everything always 32bit }
              if not(torddef(right.resulttype.def).typ in [s32bit,u32bit]) then
                inserttypeconv(right,s32bittype);
              if not(torddef(left.resulttype.def).typ in [s32bit,u32bit]) then
                inserttypeconv(left,s32bittype);
              resulttype:=right.resulttype;
           end;

         { when the result is currency we need some extra code for
           division. this should not be done when the divn node is
           created internally }
         if (nodetype=divn) and
            not(nf_is_currency in flags) and
            is_currency(resulttype.def) then
          begin
            hp:=caddnode.create(muln,getcopy,cordconstnode.create(10000,s64currencytype,false));
            include(hp.flags,nf_is_currency);
            result:=hp;
          end;
      end;


    function tmoddivnode.first_moddivint: tnode;
{$ifdef cpuneedsdiv32helper}
      var
        procname: string[31];
      begin
        result := nil;

        { otherwise create a call to a helper }
        if nodetype = divn then
          procname := 'fpc_div_'
        else
          procname := 'fpc_mod_';
        { only qword needs the unsigned code, the
          signed code is also used for currency }
        if is_signed(resulttype.def) then
          procname := procname + 'longint'
        else
          procname := procname + 'dword';

        result := ccallnode.createintern(procname,ccallparanode.create(left,
          ccallparanode.create(right,nil)));
        left := nil;
        right := nil;
        firstpass(result);
      end;
{$else cpuneedsdiv32helper}
      begin
        result:=nil;
      end;
{$endif cpuneedsdiv32helper}


    function tmoddivnode.first_moddiv64bitint: tnode;
      var
        procname: string[31];
      begin
        result := nil;

        { when currency is used set the result of the
          parameters to s64bit, so they are not converted }
        if is_currency(resulttype.def) then
          begin
            left.resulttype:=cs64bittype;
            right.resulttype:=cs64bittype;
          end;

        { otherwise create a call to a helper }
        if nodetype = divn then
          procname := 'fpc_div_'
        else
          procname := 'fpc_mod_';
        { only qword needs the unsigned code, the
          signed code is also used for currency }
        if is_signed(resulttype.def) then
          procname := procname + 'int64'
        else
          procname := procname + 'qword';

        result := ccallnode.createintern(procname,ccallparanode.create(left,
          ccallparanode.create(right,nil)));
        left := nil;
        right := nil;
        firstpass(result);
      end;


    function tmoddivnode.firstoptimize: tnode;
      var
        power{,shiftval} : longint;
        newtype: tnodetype;
      begin
        result := nil;
        { divide/mod a number by a constant which is a power of 2? }
        if (cs_optimize in aktglobalswitches) and
           (right.nodetype = ordconstn) and
{           ((nodetype = divn) or
            not is_signed(resulttype.def)) and}
           (not is_signed(resulttype.def)) and
           ispowerof2(tordconstnode(right).value,power) then
          begin
            if nodetype = divn then
              begin
(*
                if is_signed(resulttype.def) then
                  begin
                    if is_64bitint(left.resulttype.def) then
                      if not (cs_littlesize in aktglobalswitches) then
                        shiftval := 63
                      else
                        { the shift code is a lot bigger than the call to }
                        { the divide helper                               }
                        exit
                    else
                      shiftval := 31;
                    { we reuse left twice, so create once a copy of it     }
                    { !!! if left is a call is -> call gets executed twice }
                    left := caddnode.create(addn,left,
                      caddnode.create(andn,
                        cshlshrnode.create(sarn,left.getcopy,
                          cordconstnode.create(shiftval,s32bittype,false)),
                        cordconstnode.create(tordconstnode(right).value-1,
                          right.resulttype,false)));
                    newtype := sarn;
                  end
                else
*)
                  newtype := shrn;
                tordconstnode(right).value := power;
                result := cshlshrnode.create(newtype,left,right)
              end
            else
              begin
                dec(tordconstnode(right).value);
                result := caddnode.create(andn,left,right);
              end;
            { left and right are reused }
            left := nil;
            right := nil;
            firstpass(result);
            exit;
          end;
      end;


    function tmoddivnode.pass_1 : tnode;
      begin
         result:=nil;
         firstpass(left);
         firstpass(right);
         if codegenerror then
           exit;

         result := firstoptimize;
         if assigned(result) then
           exit;
         { 64bit }
         if (left.resulttype.def.deftype=orddef) and (right.resulttype.def.deftype=orddef) and
            (is_64bitint(left.resulttype.def) or is_64bitint(right.resulttype.def)) then
           begin
             result := first_moddiv64bitint;
             if assigned(result) then
               exit;
             expectloc:=LOC_REGISTER;
             calcregisters(self,2,0,0);
           end
         else
           begin
             result := first_moddivint;
             if assigned(result) then
               exit;
             left_right_max;
             if left.registers32<=right.registers32 then
              inc(registers32);
           end;
         expectloc:=LOC_REGISTER;
      end;



{****************************************************************************
                              TSHLSHRNODE
 ****************************************************************************}


    function tshlshrnode.first_shlshr64bitint: tnode;
      var
        procname: string[31];
      begin
        result := nil;
        { otherwise create a call to a helper }
        if nodetype = shln then
          procname := 'fpc_shl_int64'
        else
          procname := 'fpc_shr_int64';
{        if is_signed(resulttype.def) then
          procname := procname + 'int64'
        else
          procname := procname + 'qword';
}
        result := ccallnode.createintern(procname,ccallparanode.create(left,
          ccallparanode.create(right,nil)));
        left := nil;
        right := nil;
        firstpass(result);
      end;


    function tshlshrnode.det_resulttype:tnode;
      var
         t : tnode;
      begin
         result:=nil;
         resulttypepass(left);
         resulttypepass(right);
         set_varstate(right,vs_used,true);
         set_varstate(left,vs_used,true);
         if codegenerror then
           exit;

         { constant folding }
         if is_constintnode(left) and is_constintnode(right) then
           begin
              case nodetype of
                 shrn:
                   t:=genintconstnode(tordconstnode(left).value shr tordconstnode(right).value);
                 shln:
                   t:=genintconstnode(tordconstnode(left).value shl tordconstnode(right).value);
              end;
              result:=t;
              exit;
           end;

         { allow operator overloading }
         t:=self;
         if isbinaryoverloaded(t) then
           begin
              result:=t;
              exit;
           end;

         { 64 bit ints have their own shift handling }
         if not(is_64bitint(left.resulttype.def)) then
           begin
              if torddef(left.resulttype.def).typ <> u32bit then
               inserttypeconv(left,s32bittype);
           end;

         inserttypeconv(right,s32bittype);

         resulttype:=left.resulttype;
      end;


    function tshlshrnode.pass_1 : tnode;
      var
         regs : longint;
      begin
         result:=nil;
         firstpass(left);
         firstpass(right);
         if codegenerror then
           exit;

         { 64 bit ints have their own shift handling }
         if not(is_64bit(left.resulttype.def)) then
           begin
            regs:=1
           end
         else
           begin
             result := first_shlshr64bitint;
             if assigned(result) then
               exit;
              regs:=2;
           end;

         if (right.nodetype<>ordconstn) then
          inc(regs);
         expectloc:=LOC_REGISTER;
         calcregisters(self,regs,0,0);
      end;


{****************************************************************************
                            TUNARYMINUSNODE
 ****************************************************************************}

    constructor tunaryminusnode.create(expr : tnode);
      begin
         inherited create(unaryminusn,expr);
      end;

    function tunaryminusnode.det_resulttype : tnode;
      var
         t : tnode;
         minusdef : Tprocdef;
      begin
         result:=nil;
         resulttypepass(left);
         set_varstate(left,vs_used,true);
         if codegenerror then
           exit;

         { constant folding }
         if is_constintnode(left) then
           begin
              tordconstnode(left).value:=-tordconstnode(left).value;
              result:=left;
              left:=nil;
              exit;
           end;
         if is_constrealnode(left) then
           begin
              trealconstnode(left).value_real:=-trealconstnode(left).value_real;
              result:=left;
              left:=nil;
              exit;
           end;

         resulttype:=left.resulttype;
         if (left.resulttype.def.deftype=floatdef) then
           begin
           end
{$ifdef SUPPORT_MMX}
         else if (cs_mmx in aktlocalswitches) and
           is_mmx_able_array(left.resulttype.def) then
             begin
               { if saturation is on, left.resulttype.def isn't
                 "mmx able" (FK)
               if (cs_mmx_saturation in aktlocalswitches^) and
                 (torddef(tarraydef(resulttype.def).definition).typ in
                 [s32bit,u32bit]) then
                 CGMessage(type_e_mismatch);
               }
             end
{$endif SUPPORT_MMX}
         else if is_64bitint(left.resulttype.def) then
           begin
           end
         else if (left.resulttype.def.deftype=orddef) then
           begin
              inserttypeconv(left,s32bittype);
              resulttype:=left.resulttype;
           end
         else
           begin
              minusdef:=nil;
              if assigned(overloaded_operators[_minus]) then
                minusdef:=overloaded_operators[_minus].search_procdef_unary_operator(left.resulttype.def);
              if assigned(minusdef) then
                begin
                  inc(overloaded_operators[_minus].refs);
                  t:=ccallnode.create(ccallparanode.create(left,nil),
                                      overloaded_operators[_minus],nil,nil);
                  left:=nil;
                  result:=t;
                  exit;
                end;
              CGMessage(type_e_mismatch);
           end;
      end;

    { generic code     }
    { overridden by:   }
    {   i386           }
    function tunaryminusnode.pass_1 : tnode;
      begin
         result:=nil;
         firstpass(left);
         if codegenerror then
           exit;

         registers32:=left.registers32;
         registersfpu:=left.registersfpu;
{$ifdef SUPPORT_MMX}
         registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}

         if (left.resulttype.def.deftype=floatdef) then
           begin
              if (left.expectloc<>LOC_REGISTER) and
                 (registersfpu<1) then
                registersfpu:=1;
              expectloc:=LOC_FPUREGISTER;
           end
{$ifdef SUPPORT_MMX}
         else if (cs_mmx in aktlocalswitches) and
           is_mmx_able_array(left.resulttype.def) then
             begin
               if (left.expectloc<>LOC_MMXREGISTER) and
                  (registersmmx<1) then
                 registersmmx:=1;
             end
{$endif SUPPORT_MMX}
         else if is_64bit(left.resulttype.def) then
           begin
              if (left.expectloc<>LOC_REGISTER) and
                 (registers32<2) then
                registers32:=2;
              expectloc:=LOC_REGISTER;
           end
         else if (left.resulttype.def.deftype=orddef) then
           begin
              if (left.expectloc<>LOC_REGISTER) and
                 (registers32<1) then
                registers32:=1;
              expectloc:=LOC_REGISTER;
           end;
      end;


{****************************************************************************
                               TNOTNODE
 ****************************************************************************}

    const boolean_reverse:array[ltn..unequaln] of Tnodetype=
  (gten,gtn,lten,ltn,unequaln,equaln);

    constructor tnotnode.create(expr : tnode);

      begin
         inherited create(notn,expr);
      end;

    function tnotnode.det_resulttype : tnode;
      var
         t : tnode;
         notdef : Tprocdef;
         v : tconstexprint;
      begin
         result:=nil;
         resulttypepass(left);
         set_varstate(left,vs_used,true);
         if codegenerror then
           exit;

         resulttype:=left.resulttype;

         { Try optmimizing ourself away }
         if left.nodetype=notn then
           begin
             { Double not. Remove both }
             result:=Tnotnode(left).left;
             Tnotnode(left).left:=nil;
             exit;
           end;

         if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then
          begin
            { Not of boolean expression. Turn around the operator and remove
              the not. This is not allowed for sets with the gten/lten,
              because there is no ltn/gtn support }
            if (taddnode(left).left.resulttype.def.deftype<>setdef) or
               (left.nodetype in [equaln,unequaln]) then
             begin
               result:=left;
               left.nodetype:=boolean_reverse[left.nodetype];
               left:=nil;
               exit;
             end;
          end;

         { constant folding }
         if (left.nodetype=ordconstn) then
           begin
              v:=tordconstnode(left).value;
              case torddef(left.resulttype.def).typ of
                bool8bit,
                bool16bit,
                bool32bit :
                  begin
                    { here we do a boolean(byte(..)) type cast because }
                    { boolean(<int64>) is buggy in 1.00                }
                    v:=byte(not(boolean(byte(v))));
                  end;
                uchar,
                u8bit :
                  v:=byte(not byte(v));
                s8bit :
                  v:=shortint(not shortint(v));
                uwidechar,
                u16bit :
                  v:=word(not word(v));
                s16bit :
                  v:=smallint(not smallint(v));
                u32bit :
                  v:=cardinal(not cardinal(v));
                s32bit :
                  v:=longint(not longint(v));
                u64bit :
                  v:=int64(not int64(v)); { maybe qword is required }
                s64bit :
                  v:=int64(not int64(v));
                else
                  CGMessage(type_e_mismatch);
              end;
              t:=cordconstnode.create(v,left.resulttype,true);
              result:=t;
              exit;
           end;

         if is_boolean(resulttype.def) then
           begin
           end
         else
{$ifdef SUPPORT_MMX}
           if (cs_mmx in aktlocalswitches) and
             is_mmx_able_array(left.resulttype.def) then
             begin
             end
         else
{$endif SUPPORT_MMX}
           if is_64bitint(left.resulttype.def) then
             begin
             end
         else if is_integer(left.resulttype.def) then
           begin
           end
         else
           begin
              notdef:=nil;
              if assigned(overloaded_operators[_op_not]) then
                notdef:=overloaded_operators[_op_not].search_procdef_unary_operator(left.resulttype.def);
              if notdef<>nil then
                begin
                  inc(overloaded_operators[_op_not].refs);
                  t:=ccallnode.create(ccallparanode.create(left,nil),
                                      overloaded_operators[_op_not],nil,nil);
                  left:=nil;
                  result:=t;
                  exit;
                end;
              CGMessage(type_e_mismatch);
           end;
      end;


    function tnotnode.pass_1 : tnode;
      begin
         result:=nil;
         firstpass(left);
         if codegenerror then
           exit;

         expectloc:=left.expectloc;
         registers32:=left.registers32;
{$ifdef SUPPORT_MMX}
         registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
         if is_boolean(resulttype.def) then
           begin
             if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
              begin
                expectloc:=LOC_REGISTER;
                if (registers32<1) then
                 registers32:=1;
              end;
            { before loading it into flags we need to load it into
              a register thus 1 register is need PM }
{$ifdef cpuflags}
             if left.expectloc<>LOC_JUMP then
               expectloc:=LOC_FLAGS;
{$endif def cpuflags}
           end
         else
{$ifdef SUPPORT_MMX}
           if (cs_mmx in aktlocalswitches) and
             is_mmx_able_array(left.resulttype.def) then
             begin
               if (left.expectloc<>LOC_MMXREGISTER) and
                 (registersmmx<1) then
                 registersmmx:=1;
             end
         else
{$endif SUPPORT_MMX}
           if is_64bit(left.resulttype.def) then
             begin
                if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
                 begin
                   expectloc:=LOC_REGISTER;
                   if (registers32<2) then
                    registers32:=2;
                 end;
             end
         else if is_integer(left.resulttype.def) then
           begin
              if (left.expectloc<>LOC_REGISTER) and
                 (registers32<1) then
                registers32:=1;
              expectloc:=LOC_REGISTER;
           end
      end;

{$ifdef state_tracking}
    function Tnotnode.track_state_pass(exec_known:boolean):boolean;

    begin
  track_state_pass:=true;
  if left.track_state_pass(exec_known) then
      begin
    left.resulttype.def:=nil;
    do_resulttypepass(left);
      end;
    end;
{$endif}

begin
   cmoddivnode:=tmoddivnode;
   cshlshrnode:=tshlshrnode;
   cunaryminusnode:=tunaryminusnode;
   cnotnode:=tnotnode;
end.
{
  $Log$
  Revision 1.54  2003-12-09 21:17:04  jonas
    + support for evaluating qword constant expressions (both arguments have
      to be a qword, constants have to be explicitly typecasted to qword)

  Revision 1.53  2003/10/08 19:19:45  peter
    * set_varstate cleanup

  Revision 1.52  2003/10/01 20:34:49  peter
    * procinfo unit contains tprocinfo
    * cginfo renamed to cgbase
    * moved cgmessage to verbose
    * fixed ppc and sparc compiles

  Revision 1.51  2003/09/07 22:09:35  peter
    * preparations for different default calling conventions
    * various RA fixes

  Revision 1.50  2003/09/03 11:18:37  florian
    * fixed arm concatcopy
    + arm support in the common compiler sources added
    * moved some generic cg code around
    + tfputype added
    * ...

  Revision 1.49  2003/05/24 16:32:34  jonas
    * fixed expectloc of notnode for all processors that have flags

  Revision 1.48  2003/05/09 17:47:02  peter
    * self moved to hidden parameter
    * removed hdisposen,hnewn,selfn

  Revision 1.47  2003/04/25 20:59:33  peter
    * removed funcretn,funcretsym, function result is now in varsym
      and aliases for result and function name are added using absolutesym
    * vs_hidden parameter for funcret passed in parameter
    * vs_hidden fixes
    * writenode changed to printnode and released from extdebug
    * -vp option added to generate a tree.log with the nodetree
    * nicer printnode for statements, callnode

  Revision 1.46  2003/04/23 20:16:04  peter
    + added currency support based on int64
    + is_64bit for use in cg units instead of is_64bitint
    * removed cgmessage from n386add, replace with internalerrors

  Revision 1.45  2003/04/22 23:50:23  peter
    * firstpass uses expectloc
    * checks if there are differences between the expectloc and
      location.loc from secondpass in EXTDEBUG

  Revision 1.44  2002/11/25 17:43:20  peter
    * splitted defbase in defutil,symutil,defcmp
    * merged isconvertable and is_equal into compare_defs(_ext)
    * made operator search faster by walking the list only once

  Revision 1.43  2002/10/04 21:19:28  jonas
    * fixed web bug 2139: checking for division by zero fixed

  Revision 1.42  2002/09/07 12:16:04  carl
    * second part bug report 1996 fix, testrange in cordconstnode
      only called if option is set (also make parsing a tiny faster)

  Revision 1.41  2002/09/03 16:26:26  daniel
    * Make Tprocdef.defs protected

  Revision 1.40  2002/08/25 11:32:33  peter
    * don't optimize not([lten,gten]) for setdefs

  Revision 1.39  2002/08/25 09:10:58  peter
    * fixed not(not()) removal

  Revision 1.38  2002/08/15 15:09:42  carl
    + fpu emulation helpers (ppu checking also)

  Revision 1.37  2002/08/14 19:26:55  carl
    + generic int_to_real type conversion
    + generic unaryminus node

  Revision 1.36  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.35  2002/07/19 11:41:36  daniel
  * State tracker work
  * The whilen and repeatn are now completely unified into whilerepeatn. This
    allows the state tracker to change while nodes automatically into
    repeat nodes.
  * Resulttypepass improvements to the notn. 'not not a' is optimized away and
    'not(a>b)' is optimized into 'a<=b'.
  * Resulttypepass improvements to the whilerepeatn. 'while not a' is optimized
    by removing the notn and later switchting the true and falselabels. The
    same is done with 'repeat until not a'.

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

  Revision 1.33  2002/05/16 19:46:39  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.31  2002/04/07 13:26:10  carl
  + change unit use

  Revision 1.30  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.29  2002/03/04 19:10:11  peter
    * removed compiler warnings

  Revision 1.28  2002/02/11 11:45:51  michael
  * Compilation without mmx support fixed from Peter

}