* 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

compiler/cg64f32.pas

@@ -96,7 +96,7 @@ unit cg64f32;
        globtype,globals,systems,
        cgbase,
        verbose,
-       symbase,symconst,symdef,defbase;
+       symbase,symconst,symdef,defutil;
 
 
     function joinreg64(reglo,reghi : tregister) : tregister64;
@@ -748,7 +748,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.31  2002-10-05 12:43:23  carl
+  Revision 1.32  2002-11-25 17:43:16  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.31  2002/10/05 12:43:23  carl
     * fixes for Delphi 6 compilation
      (warning : Some features do not work under Delphi)
 

compiler/cgbase.pas

@@ -250,7 +250,7 @@ implementation
         systems,
         cresstr,
         tgobj,rgobj,
-        defbase,
+        defutil,
         fmodule
 {$ifdef fixLeaksOnError}
         ,comphook
@@ -658,7 +658,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.33  2002-11-18 17:31:54  peter
+  Revision 1.34  2002-11-25 17:43:16  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.33  2002/11/18 17:31:54  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.32  2002/10/05 12:43:23  carl

compiler/cgobj.pas

@@ -247,9 +247,9 @@ unit cgobj;
 
           procedure a_jmp_always(list : taasmoutput;l: tasmlabel); virtual; abstract;
           procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); virtual; abstract;
- 
-          {# Depending on the value to check in the flags, either sets the register reg to one (if the flag is set) 
-             or zero (if the flag is cleared). The size parameter indicates the destination size register. 
+
+          {# Depending on the value to check in the flags, either sets the register reg to one (if the flag is set)
+             or zero (if the flag is cleared). The size parameter indicates the destination size register.
           }
           procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); virtual; abstract;
           procedure g_flags2ref(list: taasmoutput; size: TCgSize; const f: tresflags; const ref:TReference); virtual;
@@ -491,7 +491,7 @@ unit cgobj;
 
     uses
        globals,globtype,options,systems,cgbase,
-       verbose,defbase,tgobj,symdef,paramgr,
+       verbose,defutil,tgobj,symdef,paramgr,
        rgobj,cutils;
 
     const
@@ -1625,7 +1625,12 @@ finalization
 end.
 {
   $Log$
-  Revision 1.65  2002-11-17 16:27:31  carl
+  Revision 1.66  2002-11-25 17:43:16  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.65  2002/11/17 16:27:31  carl
     * document flags2reg
 
   Revision 1.64  2002/11/16 17:06:28  peter

compiler/defbase.pas

@@ -1,2225 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    This unit provides some help routines for type handling
-
-    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 defbase;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-       cclasses,
-       cpuinfo,
-       globals,
-       node,
-       symconst,symbase,symtype,symdef,symsym;
-
-    type
-       tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
-                   mmxu32bit,mmxs32bit,mmxfixed16,mmxsingle);
-
-    const
-       {# true if we must never copy this parameter }
-       never_copy_const_param : boolean = false;
-
-{*****************************************************************************
-                          Basic type functions
- *****************************************************************************}
-
-    {# Returns true, if definition defines an ordinal type }
-    function is_ordinal(def : tdef) : boolean;
-
-    {# Returns the minimal integer value of the type }
-    function get_min_value(def : tdef) : TConstExprInt;
-
-    {# Returns basetype of the specified integer range }
-    function range_to_basetype(low,high:TConstExprInt):tbasetype;
-
-    {# Returns true, if definition defines an integer type }
-    function is_integer(def : tdef) : boolean;
-
-    {# Returns true if definition is a boolean }
-    function is_boolean(def : tdef) : boolean;
-
-    {# Returns true if definition is a char
-
-       This excludes the unicode char.
-    }
-    function is_char(def : tdef) : boolean;
-
-    {# Returns true if definition is a widechar }
-    function is_widechar(def : tdef) : boolean;
-
-    {# Returns true if definition is a void}
-    function is_void(def : tdef) : boolean;
-
-    {# Returns true if definition is a smallset}
-    function is_smallset(p : tdef) : boolean;
-
-    {# Returns true, if def defines a signed data type
-       (only for ordinal types)
-    }
-    function is_signed(def : tdef) : boolean;
-
-    {# Returns true whether def_from's range is comprised in def_to's if both are
-      orddefs, false otherwise                                              }
-    function is_in_limit(def_from,def_to : tdef) : boolean;
-
-    function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;
-
-{*****************************************************************************
-                              Array helper functions
- *****************************************************************************}
-
-    {# Returns true, if p points to a zero based (non special like open or
-      dynamic array def).
-
-      This is mainly used to see if the array
-      is convertable to a pointer
-    }
-    function is_zero_based_array(p : tdef) : boolean;
-
-    {# Returns true if p points to an open array definition }
-    function is_open_array(p : tdef) : boolean;
-
-    {# Returns true if p points to a dynamic array definition }
-    function is_dynamic_array(p : tdef) : boolean;
-
-    {# Returns true, if p points to an array of const definition }
-    function is_array_constructor(p : tdef) : boolean;
-
-    {# Returns true, if p points to a variant array }
-    function is_variant_array(p : tdef) : boolean;
-
-    {# Returns true, if p points to an array of const }
-    function is_array_of_const(p : tdef) : boolean;
-
-    {# Returns true, if p points any kind of special array
-
-       That is if the array is an open array, a variant
-       array, an array constants constructor, or an
-       array of const.
-    }
-    function is_special_array(p : tdef) : boolean;
-
-    {# Returns true if p is a char array def }
-    function is_chararray(p : tdef) : boolean;
-
-    {# Returns true if p is a wide char array def }
-    function is_widechararray(p : tdef) : boolean;
-
-{*****************************************************************************
-                          String helper functions
- *****************************************************************************}
-
-    {# Returns true if p points to an open string type }
-    function is_open_string(p : tdef) : boolean;
-
-    {# Returns true if p is an ansi string type }
-    function is_ansistring(p : tdef) : boolean;
-
-    {# Returns true if p is a long string type }
-    function is_longstring(p : tdef) : boolean;
-
-    {# returns true if p is a wide string type }
-    function is_widestring(p : tdef) : boolean;
-
-    {# Returns true if p is a short string type }
-    function is_shortstring(p : tdef) : boolean;
-
-    {# Returns true if p is a pchar def }
-    function is_pchar(p : tdef) : boolean;
-
-    {# Returns true if p is a pwidechar def }
-    function is_pwidechar(p : tdef) : boolean;
-
-    {# Returns true if p is a voidpointer def }
-    function is_voidpointer(p : tdef) : boolean;
-
-    {# Returns true, if definition is a float }
-    function is_fpu(def : tdef) : boolean;
-
-    {# Returns true, if def is a currency type }
-    function is_currency(def : tdef) : boolean;
-
-    {# Returns true, if def is a 64 bit integer type }
-    function is_64bitint(def : tdef) : boolean;
-
-    {# Returns true, if def1 and def2 are semantically the same }
-    function is_equal(def1,def2 : tdef) : boolean;
-
-    {# Checks for type compatibility (subgroups of type)
-       used for case statements... probably missing stuff
-       to use on other types
-    }
-    function is_subequal(def1, def2: tdef): boolean;
-
-     type
-       tconverttype = (
-          tc_equal,
-          tc_not_possible,
-          tc_string_2_string,
-          tc_char_2_string,
-          tc_char_2_chararray,
-          tc_pchar_2_string,
-          tc_cchar_2_pchar,
-          tc_cstring_2_pchar,
-          tc_ansistring_2_pchar,
-          tc_string_2_chararray,
-          tc_chararray_2_string,
-          tc_array_2_pointer,
-          tc_pointer_2_array,
-          tc_int_2_int,
-          tc_int_2_bool,
-          tc_bool_2_bool,
-          tc_bool_2_int,
-          tc_real_2_real,
-          tc_int_2_real,
-          tc_proc_2_procvar,
-          tc_arrayconstructor_2_set,
-          tc_load_smallset,
-          tc_cord_2_pointer,
-          tc_intf_2_string,
-          tc_intf_2_guid,
-          tc_class_2_intf,
-          tc_char_2_char,
-          tc_normal_2_smallset,
-          tc_dynarray_2_openarray,
-          tc_pwchar_2_string
-       );
-
-    function assignment_overloaded(from_def,to_def : tdef) : tprocdef;
-
-    { Returns:
-       0 - Not convertable
-       1 - Convertable
-       2 - Convertable, but not first choice }
-    function isconvertable(def_from,def_to : tdef;
-             var doconv : tconverttype;
-             fromtreetype : tnodetype;
-             explicit : boolean) : byte;
-
-    { this routine is recusrive safe, and is used by the
-      checking of overloaded assignment operators ONLY!
-    }
-    function overloaded_assignment_isconvertable(def_from,def_to : tdef;
-             var doconv : tconverttype;
-             fromtreetype : tnodetype;
-             explicit : boolean; var overload_procs : pprocdeflist) : byte;
-
-
-    { Same as is_equal, but with error message if failed }
-    function CheckTypes(def1,def2 : tdef) : boolean;
-
-    function equal_constsym(sym1,sym2:tconstsym):boolean;
-
-    { if acp is cp_all the var const or nothing are considered equal }
-    type
-      compare_type = ( cp_none, cp_value_equal_const, cp_all,cp_procvar);
-
-    {# true, if two parameter lists are equal
-      if acp is cp_none, all have to match exactly
-      if acp is cp_value_equal_const call by value
-      and call by const parameter are assumed as
-      equal
-      allowdefaults indicates if default value parameters
-      are allowed (in this case, the search order will first
-      search for a routine with default parameters, before
-      searching for the same definition with no parameters)
-    }
-    function equal_paras(paralist1,paralist2 : TLinkedList; acp : compare_type;allowdefaults:boolean) : boolean;
-
-
-    { True if a type can be allowed for another one
-      in a func var }
-    function convertable_paras(paralist1,paralist2 : tlinkedlist; acp : compare_type) : boolean;
-
-    { True if a function can be assigned to a procvar }
-    { changed first argument type to pabstractprocdef so that it can also be }
-    { used to test compatibility between two pprocvardefs (JM)               }
-    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef;exact:boolean) : boolean;
-
-{    function get_proc_2_procvar_def(p:tprocsym;d:tprocvardef):tprocdef;}
-
-    {# If @var(l) isn't in the range of def a range check error (if not explicit) is generated and
-      the value is placed within the range
-    }
-    procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
-
-    {# Returns the range of def, where @var(l) is the low-range and @var(h) is
-      the high-range.
-    }
-    procedure getrange(def : tdef;var l : TConstExprInt;var h : TConstExprInt);
-
-    { some type helper routines for MMX support }
-    function is_mmx_able_array(p : tdef) : boolean;
-
-    {# returns the mmx type }
-    function mmx_type(p : tdef) : tmmxtype;
-
-    {# returns true, if sym needs an entry in the proplist of a class rtti }
-    function needs_prop_entry(sym : tsym) : boolean;
-
-
-implementation
-
-    uses
-       globtype,tokens,systems,verbose,
-       symtable;
-
-
-    function needs_prop_entry(sym : tsym) : boolean;
-
-      begin
-         needs_prop_entry:=(sp_published in tsym(sym).symoptions) and
-         (sym.typ in [propertysym,varsym]);
-      end;
-
-
-    function equal_constsym(sym1,sym2:tconstsym):boolean;
-      var
-        p1,p2,pend : pchar;
-      begin
-        equal_constsym:=false;
-        if sym1.consttyp<>sym2.consttyp then
-         exit;
-        case sym1.consttyp of
-           constint,
-           constbool,
-           constchar,
-           constord :
-             equal_constsym:=(sym1.value.valueord=sym2.value.valueord);
-           constpointer :
-             equal_constsym:=(sym1.value.valueordptr=sym2.value.valueordptr);
-           conststring,constresourcestring :
-             begin
-               if sym1.value.len=sym2.value.len then
-                begin
-                  p1:=pchar(sym1.value.valueptr);
-                  p2:=pchar(sym2.value.valueptr);
-                  pend:=p1+sym1.value.len;
-                  while (p1<pend) do
-                   begin
-                     if p1^<>p2^ then
-                      break;
-                     inc(p1);
-                     inc(p2);
-                   end;
-                  if (p1=pend) then
-                   equal_constsym:=true;
-                end;
-             end;
-           constreal :
-             equal_constsym:=(pbestreal(sym1.value.valueptr)^=pbestreal(sym2.value.valueptr)^);
-           constset :
-             equal_constsym:=(pnormalset(sym1.value.valueptr)^=pnormalset(sym2.value.valueptr)^);
-           constnil :
-             equal_constsym:=true;
-        end;
-      end;
-
-
-    function equal_paras(paralist1,paralist2 : TLinkedList; acp : compare_type;allowdefaults:boolean) : boolean;
-      var
-        def1,def2 : TParaItem;
-      begin
-         { we need to parse the list from left-right so the
-           not-default parameters are checked first }
-         def1:=TParaItem(paralist1.last);
-         def2:=TParaItem(paralist2.last);
-         while (assigned(def1)) and (assigned(def2)) do
-           begin
-             case acp of
-              cp_value_equal_const :
-                begin
-                   if not(is_equal(def1.paratype.def,def2.paratype.def)) or
-                     ((def1.paratyp<>def2.paratyp) and
-                      ((def1.paratyp in [vs_var,vs_out]) or
-                       (def2.paratyp in [vs_var,vs_out])
-                      )
-                     ) then
-                     begin
-                        equal_paras:=false;
-                        exit;
-                     end;
-                end;
-              cp_all,cp_procvar :
-                begin
-                   if not(is_equal(def1.paratype.def,def2.paratype.def)) or
-                      (def1.paratyp<>def2.paratyp) then
-                     begin
-                        equal_paras:=false;
-                        exit;
-                     end;
-                end;
-              cp_none :
-                begin
-                   if not(is_equal(def1.paratype.def,def2.paratype.def)) then
-                     begin
-                        equal_paras:=false;
-                        exit;
-                     end;
-                   { also check default value if both have it declared }
-                   if assigned(def1.defaultvalue) and
-                      assigned(def2.defaultvalue) then
-                    begin
-                      if not equal_constsym(tconstsym(def1.defaultvalue),tconstsym(def2.defaultvalue)) then
-                       begin
-                         equal_paras:=false;
-                         exit;
-                       end;
-                    end;
-                end;
-              end;
-              def1:=TParaItem(def1.previous);
-              def2:=TParaItem(def2.previous);
-           end;
-         { when both lists are empty then the parameters are equal. Also
-           when one list is empty and the other has a parameter with default
-           value assigned then the parameters are also equal }
-         if ((def1=nil) and (def2=nil)) or
-            (allowdefaults and
-             ((assigned(def1) and assigned(def1.defaultvalue)) or
-              (assigned(def2) and assigned(def2.defaultvalue)))) then
-           equal_paras:=true
-         else
-           equal_paras:=false;
-      end;
-
-
-    function convertable_paras(paralist1,paralist2 : TLinkedList;acp : compare_type) : boolean;
-      var
-        def1,def2 : TParaItem;
-        doconv : tconverttype;
-        p : pointer;
-        b : byte;
-      begin
-         def1:=TParaItem(paralist1.first);
-         def2:=TParaItem(paralist2.first);
-         while (assigned(def1)) and (assigned(def2)) do
-           begin
-              case acp of
-              cp_value_equal_const :
-                begin
-                   if (isconvertable(def1.paratype.def,def2.paratype.def,doconv,callparan,false)=0) or
-                     ((def1.paratyp<>def2.paratyp) and
-                      ((def1.paratyp in [vs_out,vs_var]) or
-                       (def2.paratyp in [vs_out,vs_var])
-                      )
-                     ) then
-                     begin
-                        convertable_paras:=false;
-                        exit;
-                     end;
-                end;
-              cp_all :
-                begin
-                   if (isconvertable(def1.paratype.def,def2.paratype.def,doconv,callparan,false)=0) or
-                      (def1.paratyp<>def2.paratyp) then
-                     begin
-                        convertable_paras:=false;
-                        exit;
-                     end;
-                end;
-              cp_procvar :
-                begin
-                  b:=isconvertable(def1.paratype.def,def2.paratype.def,doconv,callparan,false);
-                  if (b=0) or
-                     not(doconv in [tc_equal,tc_int_2_int]) or
-                     (def1.paratyp<>def2.paratyp) or
-                     (not is_special_array(def1.paratype.def) and
-                      not is_special_array(def2.paratype.def) and
-                      (def1.paratype.def.size<>def2.paratype.def.size)) then
-                    begin
-                       convertable_paras:=false;
-                       exit;
-                    end;
-                end;
-              cp_none :
-                begin
-                   if (isconvertable(def1.paratype.def,def2.paratype.def,doconv,callparan,false)=0) then
-                     begin
-                        convertable_paras:=false;
-                        exit;
-                     end;
-                end;
-              end;
-              def1:=TParaItem(def1.next);
-              def2:=TParaItem(def2.next);
-           end;
-         if (def1=nil) and (def2=nil) then
-           convertable_paras:=true
-         else
-           convertable_paras:=false;
-      end;
-
-
-    { true if a function can be assigned to a procvar }
-    { changed first argument type to pabstractprocdef so that it can also be }
-    { used to test compatibility between two pprocvardefs (JM)               }
-    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef;exact:boolean) : boolean;
-      const
-        po_comp = po_compatibility_options-[po_methodpointer,po_classmethod];
-      var
-        ismethod : boolean;
-      begin
-         proc_to_procvar_equal:=false;
-         if not(assigned(def1)) or not(assigned(def2)) then
-           exit;
-         { check for method pointer }
-         if def1.deftype=procvardef then
-          begin
-            ismethod:=(po_methodpointer in def1.procoptions);
-          end
-         else
-          begin
-            ismethod:=assigned(def1.owner) and
-                      (def1.owner.symtabletype=objectsymtable);
-          end;
-         if (ismethod and not (po_methodpointer in def2.procoptions)) or
-            (not(ismethod) and (po_methodpointer in def2.procoptions)) then
-          begin
-            Message(type_e_no_method_and_procedure_not_compatible);
-            exit;
-          end;
-         { check return value and para's and options, methodpointer is already checked
-           parameters may also be convertable }
-         if is_equal(def1.rettype.def,def2.rettype.def) and
-            (def1.para_size(target_info.alignment.paraalign)=def2.para_size(target_info.alignment.paraalign)) and
-            (equal_paras(def1.para,def2.para,cp_procvar,false) or
-             ((not exact) and convertable_paras(def1.para,def2.para,cp_procvar))) and
-            ((po_comp * def1.procoptions)= (po_comp * def2.procoptions)) then
-           proc_to_procvar_equal:=true
-         else
-           proc_to_procvar_equal:=false;
-      end;
-
-    { returns true, if def uses FPU }
-    function is_fpu(def : tdef) : boolean;
-      begin
-         is_fpu:=(def.deftype=floatdef);
-      end;
-
-
-    { returns true, if def is a currency type }
-    function is_currency(def : tdef) : boolean;
-      begin
-         is_currency:=(def.deftype=floatdef) and (tfloatdef(def).typ=s64currency);
-      end;
-
-
-      function range_to_basetype(low,high:TConstExprInt):tbasetype;
-      begin
-        { generate a unsigned range if high<0 and low>=0 }
-        if (low>=0) and (high<0) then
-         range_to_basetype:=u32bit
-        else if (low>=0) and (high<=255) then
-         range_to_basetype:=u8bit
-        else if (low>=-128) and (high<=127) then
-         range_to_basetype:=s8bit
-        else if (low>=0) and (high<=65536) then
-         range_to_basetype:=u16bit
-        else if (low>=-32768) and (high<=32767) then
-         range_to_basetype:=s16bit
-        else
-         range_to_basetype:=s32bit;
-      end;
-
-
-    { true if p is an ordinal }
-    function is_ordinal(def : tdef) : boolean;
-      var
-         dt : tbasetype;
-      begin
-         case def.deftype of
-           orddef :
-             begin
-               dt:=torddef(def).typ;
-               is_ordinal:=dt in [uchar,uwidechar,
-                                  u8bit,u16bit,u32bit,u64bit,
-                                  s8bit,s16bit,s32bit,s64bit,
-                                  bool8bit,bool16bit,bool32bit];
-             end;
-           enumdef :
-             is_ordinal:=true;
-           else
-             is_ordinal:=false;
-         end;
-      end;
-
-
-    { returns the min. value of the type }
-    function get_min_value(def : tdef) : TConstExprInt;
-      begin
-         case def.deftype of
-           orddef:
-             get_min_value:=torddef(def).low;
-           enumdef:
-             get_min_value:=tenumdef(def).min;
-           else
-             get_min_value:=0;
-         end;
-      end;
-
-
-    { true if p is an integer }
-    function is_integer(def : tdef) : boolean;
-      begin
-        is_integer:=(def.deftype=orddef) and
-                    (torddef(def).typ in [u8bit,u16bit,u32bit,u64bit,
-                                          s8bit,s16bit,s32bit,s64bit]);
-      end;
-
-
-    { true if p is a boolean }
-    function is_boolean(def : tdef) : boolean;
-      begin
-        is_boolean:=(def.deftype=orddef) and
-                    (torddef(def).typ in [bool8bit,bool16bit,bool32bit]);
-      end;
-
-
-    { true if p is a void }
-    function is_void(def : tdef) : boolean;
-      begin
-        is_void:=(def.deftype=orddef) and
-                 (torddef(def).typ=uvoid);
-      end;
-
-
-    { true if p is a char }
-    function is_char(def : tdef) : boolean;
-      begin
-        is_char:=(def.deftype=orddef) and
-                 (torddef(def).typ=uchar);
-      end;
-
-
-    { true if p is a wchar }
-    function is_widechar(def : tdef) : boolean;
-      begin
-        is_widechar:=(def.deftype=orddef) and
-                 (torddef(def).typ=uwidechar);
-      end;
-
-
-    { true if p is signed (integer) }
-    function is_signed(def : tdef) : boolean;
-      var
-         dt : tbasetype;
-      begin
-         case def.deftype of
-           orddef :
-             begin
-               dt:=torddef(def).typ;
-               is_signed:=(dt in [s8bit,s16bit,s32bit,s64bit]);
-             end;
-           enumdef :
-             is_signed:=tenumdef(def).min < 0;
-           arraydef :
-             is_signed:=is_signed(tarraydef(def).rangetype.def);
-           else
-             is_signed:=false;
-         end;
-      end;
-
-
-    function is_in_limit(def_from,def_to : tdef) : boolean;
-
-      var
-        fromqword, toqword: boolean;
-
-      begin
-         if (def_from.deftype <> orddef) or
-            (def_to.deftype <> orddef) then
-           begin
-             is_in_limit := false;
-             exit;
-           end;
-         fromqword := torddef(def_from).typ = u64bit;
-         toqword := torddef(def_to).typ = u64bit;
-         is_in_limit:=(toqword and is_signed(def_from)) or
-                      ((not fromqword) and
-                       (torddef(def_from).low>=torddef(def_to).low) and
-                       (torddef(def_from).high<=torddef(def_to).high));
-      end;
-
-
-    function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;
-
-      begin
-         if (def_from.deftype <> orddef) and
-            (def_to.deftype <> orddef) then
-           internalerror(200210062);
-         if (torddef(def_to).typ = u64bit) then
-          begin
-            is_in_limit_value:=((TConstExprUInt(val_from)>=TConstExprUInt(torddef(def_to).low)) and
-                                (TConstExprUInt(val_from)<=TConstExprUInt(torddef(def_to).high)));
-          end
-         else
-          begin;
-            is_in_limit_value:=((val_from>=torddef(def_to).low) and
-                                (val_from<=torddef(def_to).high));
-          end;
-      end;
-
-
-    { true, if p points to an open array def }
-    function is_open_string(p : tdef) : boolean;
-      begin
-         is_open_string:=(p.deftype=stringdef) and
-                         (tstringdef(p).string_typ=st_shortstring) and
-                         (tstringdef(p).len=0);
-      end;
-
-
-    { true, if p points to a zero based array def }
-    function is_zero_based_array(p : tdef) : boolean;
-      begin
-         is_zero_based_array:=(p.deftype=arraydef) and
-                              (tarraydef(p).lowrange=0) and
-                              not(is_special_array(p));
-      end;
-
-    { true if p points to a dynamic array def }
-    function is_dynamic_array(p : tdef) : boolean;
-      begin
-         is_dynamic_array:=(p.deftype=arraydef) and
-           tarraydef(p).IsDynamicArray;
-      end;
-
-
-    { true, if p points to an open array def }
-    function is_open_array(p : tdef) : boolean;
-      begin
-         { check for s32bittype is needed, because for u32bit the high
-           range is also -1 ! (PFV) }
-         is_open_array:=(p.deftype=arraydef) and
-                        (tarraydef(p).rangetype.def=s32bittype.def) and
-                        (tarraydef(p).lowrange=0) and
-                        (tarraydef(p).highrange=-1) and
-                        not(tarraydef(p).IsConstructor) and
-                        not(tarraydef(p).IsVariant) and
-                        not(tarraydef(p).IsArrayOfConst) and
-                        not(tarraydef(p).IsDynamicArray);
-
-      end;
-
-    { true, if p points to an array of const def }
-    function is_array_constructor(p : tdef) : boolean;
-      begin
-         is_array_constructor:=(p.deftype=arraydef) and
-                        (tarraydef(p).IsConstructor);
-      end;
-
-    { true, if p points to a variant array }
-    function is_variant_array(p : tdef) : boolean;
-      begin
-         is_variant_array:=(p.deftype=arraydef) and
-                        (tarraydef(p).IsVariant);
-      end;
-
-    { true, if p points to an array of const }
-    function is_array_of_const(p : tdef) : boolean;
-      begin
-         is_array_of_const:=(p.deftype=arraydef) and
-                        (tarraydef(p).IsArrayOfConst);
-      end;
-
-    { true, if p points to a special array }
-    function is_special_array(p : tdef) : boolean;
-      begin
-         is_special_array:=(p.deftype=arraydef) and
-                        ((tarraydef(p).IsVariant) or
-                         (tarraydef(p).IsArrayOfConst) or
-                         (tarraydef(p).IsConstructor) or
-                         is_open_array(p)
-                        );
-      end;
-
-    { true if p is an ansi string def }
-    function is_ansistring(p : tdef) : boolean;
-      begin
-         is_ansistring:=(p.deftype=stringdef) and
-                        (tstringdef(p).string_typ=st_ansistring);
-      end;
-
-
-    { true if p is an long string def }
-    function is_longstring(p : tdef) : boolean;
-      begin
-         is_longstring:=(p.deftype=stringdef) and
-                        (tstringdef(p).string_typ=st_longstring);
-      end;
-
-
-    { true if p is an wide string def }
-    function is_widestring(p : tdef) : boolean;
-      begin
-         is_widestring:=(p.deftype=stringdef) and
-                        (tstringdef(p).string_typ=st_widestring);
-      end;
-
-
-    { true if p is an short string def }
-    function is_shortstring(p : tdef) : boolean;
-      begin
-         is_shortstring:=(p.deftype=stringdef) and
-                         (tstringdef(p).string_typ=st_shortstring);
-      end;
-
-    { true if p is a char array def }
-    function is_chararray(p : tdef) : boolean;
-      begin
-        is_chararray:=(p.deftype=arraydef) and
-                      is_equal(tarraydef(p).elementtype.def,cchartype.def) and
-                      not(is_special_array(p));
-      end;
-
-    { true if p is a widechar array def }
-    function is_widechararray(p : tdef) : boolean;
-      begin
-        is_widechararray:=(p.deftype=arraydef) and
-                      is_equal(tarraydef(p).elementtype.def,cwidechartype.def) and
-                      not(is_special_array(p));
-      end;
-
-
-    { true if p is a pchar def }
-    function is_pchar(p : tdef) : boolean;
-      begin
-        is_pchar:=(p.deftype=pointerdef) and
-                  (is_equal(tpointerdef(p).pointertype.def,cchartype.def) or
-                   (is_zero_based_array(tpointerdef(p).pointertype.def) and
-                    is_chararray(tpointerdef(p).pointertype.def)));
-      end;
-
-    { true if p is a pchar def }
-    function is_pwidechar(p : tdef) : boolean;
-      begin
-        is_pwidechar:=(p.deftype=pointerdef) and
-                  (is_equal(tpointerdef(p).pointertype.def,cwidechartype.def) or
-                   (is_zero_based_array(tpointerdef(p).pointertype.def) and
-                    is_widechararray(tpointerdef(p).pointertype.def)));
-      end;
-
-
-    { true if p is a voidpointer def }
-    function is_voidpointer(p : tdef) : boolean;
-      begin
-        is_voidpointer:=(p.deftype=pointerdef) and
-                        (tpointerdef(p).pointertype.def.deftype=orddef) and
-                        (torddef(tpointerdef(p).pointertype.def).typ=uvoid);
-      end;
-
-
-    { true if p is a smallset def }
-    function is_smallset(p : tdef) : boolean;
-      begin
-        is_smallset:=(p.deftype=setdef) and
-                     (tsetdef(p).settype=smallset);
-      end;
-
-
-    { true, if def is a 64 bit int type }
-    function is_64bitint(def : tdef) : boolean;
-      begin
-         is_64bitint:=(def.deftype=orddef) and (torddef(def).typ in [u64bit,s64bit])
-      end;
-
-
-    { if l isn't in the range of def a range check error (if not explicit) is generated and
-      the value is placed within the range }
-    procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
-      var
-         lv,hv: TConstExprInt;
-         error: boolean;
-      begin
-         error := false;
-         { for 64 bit types we need only to check if it is less than }
-         { zero, if def is a qword node                              }
-         if is_64bitint(def) then
-           begin
-              if (l<0) and (torddef(def).typ=u64bit) then
-                begin
-                   { don't zero the result, because it may come from hex notation
-                     like $ffffffffffffffff! (JM)
-                   l:=0; }
-                   if not explicit then
-                    begin
-                      if (cs_check_range in aktlocalswitches) then
-                        Message(parser_e_range_check_error)
-                      else
-                        Message(parser_w_range_check_error);
-                    end;
-                   error := true;
-                end;
-           end
-         else
-           begin
-              getrange(def,lv,hv);
-              if (def.deftype=orddef) and
-                 (torddef(def).typ=u32bit) then
-                begin
-                  if (l < cardinal(lv)) or
-                     (l > cardinal(hv)) then
-                    begin
-                      if not explicit then
-                       begin
-                         if (cs_check_range in aktlocalswitches) then
-                           Message(parser_e_range_check_error)
-                         else
-                           Message(parser_w_range_check_error);
-                       end;
-                      error := true;
-                    end;
-                end
-              else if (l<lv) or (l>hv) then
-                begin
-                   if not explicit then
-                    begin
-                      if ((def.deftype=enumdef) and
-                          { delphi allows range check errors in
-                           enumeration type casts FK }
-                          not(m_delphi in aktmodeswitches)) or
-                         (cs_check_range in aktlocalswitches) then
-                        Message(parser_e_range_check_error)
-                      else
-                        Message(parser_w_range_check_error);
-                    end;
-                   error := true;
-                end;
-           end;
-         if error then
-          begin
-             { Fix the value to fit in the allocated space for this type of variable }
-             case def.size of
-               1: l := l and $ff;
-               2: l := l and $ffff;
-               { work around sign extension bug (to be fixed) (JM) }
-               4: l := l and (int64($fffffff) shl 4 + $f);
-             end;
-             { do sign extension if necessary (JM) }
-             if is_signed(def) then
-              begin
-                case def.size of
-                  1: l := shortint(l);
-                  2: l := smallint(l);
-                  4: l := longint(l);
-                end;
-              end;
-          end;
-      end;
-
-
-    { return the range from def in l and h }
-    procedure getrange(def : tdef;var l : TConstExprInt;var h : TConstExprInt);
-      begin
-        case def.deftype of
-          orddef :
-            begin
-              l:=torddef(def).low;
-              h:=torddef(def).high;
-            end;
-          enumdef :
-            begin
-              l:=tenumdef(def).min;
-              h:=tenumdef(def).max;
-            end;
-          arraydef :
-            begin
-              l:=tarraydef(def).lowrange;
-              h:=tarraydef(def).highrange;
-            end;
-        else
-          internalerror(987);
-        end;
-      end;
-
-
-    function mmx_type(p : tdef) : tmmxtype;
-      begin
-         mmx_type:=mmxno;
-         if is_mmx_able_array(p) then
-           begin
-              if tarraydef(p).elementtype.def.deftype=floatdef then
-                case tfloatdef(tarraydef(p).elementtype.def).typ of
-                  s32real:
-                    mmx_type:=mmxsingle;
-                end
-              else
-                case torddef(tarraydef(p).elementtype.def).typ of
-                   u8bit:
-                     mmx_type:=mmxu8bit;
-                   s8bit:
-                     mmx_type:=mmxs8bit;
-                   u16bit:
-                     mmx_type:=mmxu16bit;
-                   s16bit:
-                     mmx_type:=mmxs16bit;
-                   u32bit:
-                     mmx_type:=mmxu32bit;
-                   s32bit:
-                     mmx_type:=mmxs32bit;
-                end;
-           end;
-      end;
-
-
-    function is_mmx_able_array(p : tdef) : boolean;
-      begin
-{$ifdef SUPPORT_MMX}
-         if (cs_mmx_saturation in aktlocalswitches) then
-           begin
-              is_mmx_able_array:=(p.deftype=arraydef) and
-                not(is_special_array(p)) and
-                (
-                 (
-                  (tarraydef(p).elementtype.def.deftype=orddef) and
-                  (
-                   (
-                    (tarraydef(p).lowrange=0) and
-                    (tarraydef(p).highrange=1) and
-                    (torddef(tarraydef(p).elementtype.def).typ in [u32bit,s32bit])
-                   )
-                   or
-                   (
-                    (tarraydef(p).lowrange=0) and
-                    (tarraydef(p).highrange=3) and
-                    (torddef(tarraydef(p).elementtype.def).typ in [u16bit,s16bit])
-                   )
-                  )
-                 )
-                 or
-                (
-                 (
-                  (tarraydef(p).elementtype.def.deftype=floatdef) and
-                  (
-                   (tarraydef(p).lowrange=0) and
-                   (tarraydef(p).highrange=1) and
-                   (tfloatdef(tarraydef(p).elementtype.def).typ=s32real)
-                  )
-                 )
-                )
-              );
-           end
-         else
-           begin
-              is_mmx_able_array:=(p.deftype=arraydef) and
-                (
-                 (
-                  (tarraydef(p).elementtype.def.deftype=orddef) and
-                  (
-                   (
-                    (tarraydef(p).lowrange=0) and
-                    (tarraydef(p).highrange=1) and
-                    (torddef(tarraydef(p).elementtype.def).typ in [u32bit,s32bit])
-                   )
-                   or
-                   (
-                    (tarraydef(p).lowrange=0) and
-                    (tarraydef(p).highrange=3) and
-                    (torddef(tarraydef(p).elementtype.def).typ in [u16bit,s16bit])
-                   )
-                   or
-                   (
-                    (tarraydef(p).lowrange=0) and
-                    (tarraydef(p).highrange=7) and
-                    (torddef(tarraydef(p).elementtype.def).typ in [u8bit,s8bit])
-                   )
-                  )
-                 )
-                 or
-                 (
-                  (tarraydef(p).elementtype.def.deftype=floatdef) and
-                  (
-                   (tarraydef(p).lowrange=0) and
-                   (tarraydef(p).highrange=1) and
-                   (tfloatdef(tarraydef(p).elementtype.def).typ=s32real)
-                  )
-                 )
-                );
-           end;
-{$else SUPPORT_MMX}
-         is_mmx_able_array:=false;
-{$endif SUPPORT_MMX}
-      end;
-
-
-    function is_equal(def1,def2 : tdef) : boolean;
-      var
-         b : boolean;
-         hd : tdef;
-      begin
-         { both types must exists }
-         if not (assigned(def1) and assigned(def2)) then
-          begin
-            is_equal:=false;
-            exit;
-          end;
-
-         { be sure, that if there is a stringdef, that this is def1 }
-         if def2.deftype=stringdef then
-           begin
-              hd:=def1;
-              def1:=def2;
-              def2:=hd;
-           end;
-         b:=false;
-
-         { both point to the same definition ? }
-         if def1=def2 then
-           b:=true
-         else
-         { pointer with an equal definition are equal }
-           if (def1.deftype=pointerdef) and (def2.deftype=pointerdef) then
-             begin
-                { check if both are farpointer }
-                if (tpointerdef(def1).is_far=tpointerdef(def2).is_far) then
-                 begin
-                   { here a problem detected in tabsolutesym }
-                   { the types can be forward type !!        }
-                   if assigned(def1.typesym) and (tpointerdef(def1).pointertype.def.deftype=forwarddef) then
-                    b:=(def1.typesym=def2.typesym)
-                   else
-                    b:=tpointerdef(def1).pointertype.def=tpointerdef(def2).pointertype.def;
-                 end
-                else
-                 b:=false;
-             end
-         else
-         { ordinals are equal only when the ordinal type is equal }
-           if (def1.deftype=orddef) and (def2.deftype=orddef) then
-             begin
-                case torddef(def1).typ of
-                  u8bit,u16bit,u32bit,u64bit,
-                  s8bit,s16bit,s32bit,s64bit:
-                    b:=((torddef(def1).typ=torddef(def2).typ) and
-                        (torddef(def1).low=torddef(def2).low) and
-                        (torddef(def1).high=torddef(def2).high));
-                  uvoid,uchar,uwidechar,
-                  bool8bit,bool16bit,bool32bit:
-                    b:=(torddef(def1).typ=torddef(def2).typ);
-                  else
-                    internalerror(200210061);
-                end;
-             end
-         else
-           if (def1.deftype=floatdef) and (def2.deftype=floatdef) then
-             b:=tfloatdef(def1).typ=tfloatdef(def2).typ
-         else
-           { strings with the same length are equal }
-           if (def1.deftype=stringdef) and (def2.deftype=stringdef) and
-              (tstringdef(def1).string_typ=tstringdef(def2).string_typ) then
-             begin
-                b:=not(is_shortstring(def1)) or
-                   (tstringdef(def1).len=tstringdef(def2).len);
-             end
-         else
-           if (def1.deftype=formaldef) and (def2.deftype=formaldef) then
-             b:=true
-         { file types with the same file element type are equal }
-         { this is a problem for assign !!                      }
-         { changed to allow if one is untyped                   }
-         { all typed files are equal to the special             }
-         { typed file that has voiddef as elemnt type           }
-         { but must NOT match for text file !!!                 }
-         else
-            if (def1.deftype=filedef) and (def2.deftype=filedef) then
-              b:=(tfiledef(def1).filetyp=tfiledef(def2).filetyp) and
-                 ((
-                 ((tfiledef(def1).typedfiletype.def=nil) and
-                  (tfiledef(def2).typedfiletype.def=nil)) or
-                 (
-                  (tfiledef(def1).typedfiletype.def<>nil) and
-                  (tfiledef(def2).typedfiletype.def<>nil) and
-                  is_equal(tfiledef(def1).typedfiletype.def,tfiledef(def2).typedfiletype.def)
-                 ) or
-                 ( (tfiledef(def1).typedfiletype.def=tdef(voidtype.def)) or
-                   (tfiledef(def2).typedfiletype.def=tdef(voidtype.def))
-                 )))
-         { sets with the same element base type are equal }
-         else
-           if (def1.deftype=setdef) and (def2.deftype=setdef) then
-             begin
-                if assigned(tsetdef(def1).elementtype.def) and
-                   assigned(tsetdef(def2).elementtype.def) then
-                  b:=is_subequal(tsetdef(def1).elementtype.def,tsetdef(def2).elementtype.def)
-                else
-                  { empty set is compatible with everything }
-                  b:=true;
-             end
-         else
-           if (def1.deftype=procvardef) and (def2.deftype=procvardef) then
-             begin
-                { poassembler isn't important for compatibility }
-                { if a method is assigned to a methodpointer    }
-                { is checked before                             }
-                b:=(tprocvardef(def1).proctypeoption=tprocvardef(def2).proctypeoption) and
-                   (tprocvardef(def1).proccalloption=tprocvardef(def2).proccalloption) and
-                   ((tprocvardef(def1).procoptions * po_compatibility_options)=
-                    (tprocvardef(def2).procoptions * po_compatibility_options)) and
-                   is_equal(tprocvardef(def1).rettype.def,tprocvardef(def2).rettype.def) and
-                   equal_paras(tprocvardef(def1).para,tprocvardef(def2).para,cp_all,false);
-             end
-         else
-           if (def1.deftype=arraydef) and (def2.deftype=arraydef) then
-             begin
-               if is_dynamic_array(def1) and is_dynamic_array(def2) then
-                 b:=is_equal(tarraydef(def1).elementtype.def,tarraydef(def2).elementtype.def)
-               else
-                if is_array_of_const(def1) or is_array_of_const(def2) then
-                 begin
-                  b:=(is_array_of_const(def1) and is_array_of_const(def2)) or
-                     (is_array_of_const(def1) and is_array_constructor(def2)) or
-                     (is_array_of_const(def2) and is_array_constructor(def1));
-                 end
-               else
-                if (is_dynamic_array(def1) or is_dynamic_array(def2)) then
-                  begin
-                    b := is_dynamic_array(def1) and is_dynamic_array(def2) and
-                         is_equal(tarraydef(def1).elementtype.def,tarraydef(def2).elementtype.def);
-                  end
-               else
-                if is_open_array(def1) or is_open_array(def2) then
-                 begin
-                   b:=is_equal(tarraydef(def1).elementtype.def,tarraydef(def2).elementtype.def);
-                 end
-               else
-                begin
-                  b:=not(m_tp7 in aktmodeswitches) and
-                     not(m_delphi in aktmodeswitches) and
-                     (tarraydef(def1).lowrange=tarraydef(def2).lowrange) and
-                     (tarraydef(def1).highrange=tarraydef(def2).highrange) and
-                     is_equal(tarraydef(def1).elementtype.def,tarraydef(def2).elementtype.def) and
-                     is_equal(tarraydef(def1).rangetype.def,tarraydef(def2).rangetype.def);
-                end;
-             end
-         else
-           if (def1.deftype=classrefdef) and (def2.deftype=classrefdef) then
-             begin
-                { similar to pointerdef: }
-                if assigned(def1.typesym) and (tclassrefdef(def1).pointertype.def.deftype=forwarddef) then
-                  b:=(def1.typesym=def2.typesym)
-                else
-                  b:=is_equal(tclassrefdef(def1).pointertype.def,tclassrefdef(def2).pointertype.def);
-             end;
-         is_equal:=b;
-      end;
-
-
-    function is_subequal(def1, def2: tdef): boolean;
-
-      var
-         basedef1,basedef2 : tenumdef;
-
-      Begin
-        is_subequal := false;
-        if assigned(def1) and assigned(def2) then
-        Begin
-          if (def1.deftype = orddef) and (def2.deftype = orddef) then
-            Begin
-              { see p.47 of Turbo Pascal 7.01 manual for the separation of types }
-              { range checking for case statements is done with testrange        }
-              case torddef(def1).typ of
-                u8bit,u16bit,u32bit,
-                s8bit,s16bit,s32bit,s64bit,u64bit :
-                  is_subequal:=(torddef(def2).typ in [s64bit,u64bit,s32bit,u32bit,u8bit,s8bit,s16bit,u16bit]);
-                bool8bit,bool16bit,bool32bit :
-                  is_subequal:=(torddef(def2).typ in [bool8bit,bool16bit,bool32bit]);
-                uchar :
-                  is_subequal:=(torddef(def2).typ=uchar);
-                uwidechar :
-                  is_subequal:=(torddef(def2).typ=uwidechar);
-              end;
-            end
-          else
-            Begin
-              { I assume that both enumerations are equal when the first }
-              { pointers are equal.                                      }
-
-              { I changed this to assume that the enums are equal }
-              { if the basedefs are equal (FK)                    }
-              if (def1.deftype=enumdef) and (def2.deftype=enumdef) then
-                Begin
-                   { get both basedefs }
-                   basedef1:=tenumdef(def1);
-                   while assigned(basedef1.basedef) do
-                     basedef1:=basedef1.basedef;
-                   basedef2:=tenumdef(def2);
-                   while assigned(basedef2.basedef) do
-                     basedef2:=basedef2.basedef;
-                   is_subequal:=basedef1=basedef2;
-                   {
-                   if tenumdef(def1).firstenum = tenumdef(def2).firstenum then
-                      is_subequal := TRUE;
-                   }
-                end;
-            end;
-        end; { endif assigned ... }
-      end;
-
-(*    function assignment_overloaded(from_def,to_def : tdef) : tprocdef;
-       var
-          passprocs : pprocdeflist;
-          convtyp : tconverttype;
-       begin
-          assignment_overloaded:=nil;
-          if not assigned(overloaded_operators[_ASSIGNMENT]) then
-            exit;
-
-          { look for an exact match first }
-          passprocs:=overloaded_operators[_ASSIGNMENT].defs;
-          while assigned(passprocs) do
-            begin
-              if is_equal(passprocs^.def.rettype.def,to_def) and
-                (TParaItem(passprocs^.def.Para.first).paratype.def=from_def) then
-                begin
-                   assignment_overloaded:=passprocs^.def;
-                   exit;
-                end;
-              passprocs:=passprocs^.next;
-            end;
-
-          { .... then look for an equal match }
-          passprocs:=overloaded_operators[_ASSIGNMENT].defs;
-          while assigned(passprocs) do
-            begin
-              if is_equal(passprocs^.def.rettype.def,to_def) and
-                 is_equal(TParaItem(passprocs^.def.Para.first).paratype.def,from_def) then
-                begin
-                   assignment_overloaded:=passprocs^.def;
-                   exit;
-                end;
-              passprocs:=passprocs^.next;
-            end;
-
-          {  .... then for convert level 1 }
-          passprocs:=overloaded_operators[_ASSIGNMENT].defs;
-          while assigned(passprocs) do
-            begin
-              if is_equal(passprocs^.def.rettype.def,to_def) and
-                 (isconvertable(from_def,TParaItem(passprocs^.def.Para.first).paratype.def,convtyp,ordconstn,false)=1) then
-                begin
-                   assignment_overloaded:=passprocs^.def;
-                   exit;
-                end;
-              passprocs:=passprocs^.next;
-            end;
-       end;
-*)
-    { this is an internal routine to take care of recursivity }
-    function internal_assignment_overloaded(from_def,to_def : tdef;
-        var overload_procs : pprocdeflist) : tprocdef;
-     var
-       p :pprocdeflist;
-       _result : tprocdef;
-     begin
-          internal_assignment_overloaded:=nil;
-          p := nil;
-          if not assigned(overloaded_operators[_ASSIGNMENT]) then
-            exit;
-
-          { look for an exact match first, from start of list }
-          _result:=overloaded_operators[_ASSIGNMENT].
-             search_procdef_byretdef_by1paradef(to_def,from_def,dm_exact,
-               p);
-          if assigned(_result) then
-            begin
-              internal_assignment_overloaded := _result;
-              exit;
-            end;
-
-          { .... then look for an equal match, from start of list }
-          _result:=overloaded_operators[_ASSIGNMENT].
-           search_procdef_byretdef_by1paradef(to_def,from_def,dm_equal,
-                p);
-          if assigned(_result) then
-            begin
-              internal_assignment_overloaded := _result;
-              exit;
-            end;
-
-          {  .... then for convert level 1, continue from where we were at }
-          internal_assignment_overloaded:=overloaded_operators[_ASSIGNMENT].
-           search_procdef_byretdef_by1paradef(to_def,from_def,dm_convertl1,
-                overload_procs);
-     end;
-
-
-    function assignment_overloaded(from_def,to_def : tdef) : tprocdef;
-
-       var
-         p : pprocdeflist;
-       begin
-          p:=nil;
-          assignment_overloaded:=nil;
-          assignment_overloaded:=internal_assignment_overloaded(
-            from_def, to_def, p);
-       end;
-
-
-    { Returns:
-       0 - Not convertable
-       1 - Convertable
-       2 - Convertable, but not first choice
-    }
-    function isconvertable(def_from,def_to : tdef;
-             var doconv : tconverttype;
-             fromtreetype : tnodetype;
-             explicit : boolean) : byte;
-      var
-       p: pprocdeflist;
-      begin
-        p:=nil;
-        isconvertable:=overloaded_assignment_isconvertable(def_from,def_to,
-          doconv, fromtreetype, explicit,p);
-      end;
-
-    function overloaded_assignment_isconvertable(def_from,def_to : tdef;
-             var doconv : tconverttype;
-             fromtreetype : tnodetype;
-             explicit : boolean; var overload_procs : pprocdeflist) : byte;
-
-      { Tbasetype:
-           uvoid,
-           u8bit,u16bit,u32bit,u64bit,
-           s8bit,s16bit,s32bit,s64bit,
-           bool8bit,bool16bit,bool32bit,
-           uchar,uwidechar }
-
-      type
-        tbasedef=(bvoid,bchar,bint,bbool);
-      const
-        basedeftbl:array[tbasetype] of tbasedef =
-          (bvoid,
-           bint,bint,bint,bint,
-           bint,bint,bint,bint,
-           bbool,bbool,bbool,
-           bchar,bchar);
-
-        basedefconverts : array[tbasedef,tbasedef] of tconverttype =
-         ((tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible),
-          (tc_not_possible,tc_char_2_char,tc_not_possible,tc_not_possible),
-          (tc_not_possible,tc_not_possible,tc_int_2_int,tc_int_2_bool),
-          (tc_not_possible,tc_not_possible,tc_bool_2_int,tc_bool_2_bool));
-
-      var
-         b : byte;
-         hd1,hd2 : tdef;
-         hct : tconverttype;
-         hd3 : tobjectdef;
-      begin
-       { safety check }
-         if not(assigned(def_from) and assigned(def_to)) then
-          begin
-            overloaded_assignment_isconvertable :=0;
-            exit;
-          end;
-
-       { tp7 procvar def support, in tp7 a procvar is always called, if the
-         procvar is passed explicit a addrn would be there }
-         if (m_tp_procvar in aktmodeswitches) and
-            (def_from.deftype=procvardef) and
-            (fromtreetype=loadn) and
-            { only if the procvar doesn't require any paramters }
-            (tprocvardef(def_from).minparacount = 0) then
-          begin
-            def_from:=tprocvardef(def_from).rettype.def;
-          end;
-
-       { we walk the wanted (def_to) types and check then the def_from
-         types if there is a conversion possible }
-         b:=0;
-         case def_to.deftype of
-           orddef :
-             begin
-               case def_from.deftype of
-                 orddef :
-                   begin
-                     doconv:=basedefconverts[basedeftbl[torddef(def_from).typ],basedeftbl[torddef(def_to).typ]];
-                     b:=1;
-                     if (doconv=tc_not_possible) or
-                        ((doconv=tc_int_2_bool) and
-                         (not explicit) and
-                         (not is_boolean(def_from))) or
-                        ((doconv=tc_bool_2_int) and
-                         (not explicit) and
-                         (not is_boolean(def_to))) then
-                       b:=0
-                     else
-                       { "punish" bad type conversions :) (JM) }
-                       if not is_in_limit(def_from,def_to) and
-                          (def_from.size > def_to.size) then
-                         b := 2;
-                   end;
-                 enumdef :
-                   begin
-                     { needed for char(enum) }
-                     if explicit then
-                      begin
-                        doconv:=tc_int_2_int;
-                        b:=1;
-                      end;
-                   end;
-               end;
-             end;
-
-          stringdef :
-             begin
-               case def_from.deftype of
-                 stringdef :
-                   begin
-                     doconv:=tc_string_2_string;
-                     b:=1;
-                   end;
-                 orddef :
-                   begin
-                   { char to string}
-                     if is_char(def_from) or
-                        is_widechar(def_from) then
-                      begin
-                        doconv:=tc_char_2_string;
-                        b:=1;
-                      end;
-                   end;
-                 arraydef :
-                   begin
-                   { array of char to string, the length check is done by the firstpass of this node }
-                     if is_chararray(def_from) or
-                        (is_equal(tarraydef(def_from).elementtype.def,cchartype.def) and
-                         is_open_array(def_from)) then
-                      begin
-                        doconv:=tc_chararray_2_string;
-                        if is_open_array(def_from) or
-                           (is_shortstring(def_to) and
-                            (def_from.size <= 255)) or
-                           (is_ansistring(def_to) and
-                            (def_from.size > 255)) then
-                         b:=1
-                        else
-                         b:=2;
-                      end;
-                   end;
-                 pointerdef :
-                   begin
-                   { pchar can be assigned to short/ansistrings,
-                     but not in tp7 compatible mode }
-                     if not(m_tp7 in aktmodeswitches) then
-                       begin
-                          if is_pchar(def_from) then
-                           begin
-                             doconv:=tc_pchar_2_string;
-                             { trefer ansistrings because pchars can overflow shortstrings, }
-                             { but only if ansistrings are the default (JM)                 }
-                             if (is_shortstring(def_to) and
-                                 not(cs_ansistrings in aktlocalswitches)) or
-                                (is_ansistring(def_to) and
-                                 (cs_ansistrings in aktlocalswitches)) then
-                               b:=1
-                             else
-                               b:=2;
-                           end
-                          else if is_pwidechar(def_from) then
-                           begin
-                             doconv:=tc_pwchar_2_string;
-                             { trefer ansistrings because pchars can overflow shortstrings, }
-                             { but only if ansistrings are the default (JM)                 }
-                             if is_widestring(def_to) then
-                               b:=1
-                             else
-                               b:=2;
-                           end;
-                       end;
-                   end;
-               end;
-             end;
-
-           floatdef :
-             begin
-               case def_from.deftype of
-                 orddef :
-                   begin { ordinal to real }
-                     if is_integer(def_from) then
-                       begin
-                         doconv:=tc_int_2_real;
-                         b:=1;
-                       end;
-                   end;
-                 floatdef :
-                   begin { 2 float types ? }
-                     if tfloatdef(def_from).typ=tfloatdef(def_to).typ then
-                       doconv:=tc_equal
-                     else
-                       doconv:=tc_real_2_real;
-                     b:=1;
-                   end;
-               end;
-             end;
-
-           enumdef :
-             begin
-               if (def_from.deftype=enumdef) then
-                begin
-                  if explicit then
-                   begin
-                     b:=1;
-                     doconv:=tc_int_2_int;
-                   end
-                  else
-                   begin
-                     hd1:=def_from;
-                     while assigned(tenumdef(hd1).basedef) do
-                      hd1:=tenumdef(hd1).basedef;
-                     hd2:=def_to;
-                     while assigned(tenumdef(hd2).basedef) do
-                      hd2:=tenumdef(hd2).basedef;
-                     if (hd1=hd2) then
-                      begin
-                        b:=1;
-                        { because of packenum they can have different sizes! (JM) }
-                        doconv:=tc_int_2_int;
-                      end;
-                   end;
-                end;
-             end;
-
-           arraydef :
-             begin
-             { open array is also compatible with a single element of its base type }
-               if is_open_array(def_to) and
-                  is_equal(tarraydef(def_to).elementtype.def,def_from) then
-                begin
-                  doconv:=tc_equal;
-                  b:=1;
-                end
-               else if is_dynamic_array(def_to) and
-                { nil is compatible with dyn. arrays }
-                (fromtreetype=niln) then
-                 begin
-                   doconv:=tc_equal;
-                   b:=1;
-                 end
-               else
-                begin
-                  case def_from.deftype of
-                    arraydef :
-                      begin
-                        { array constructor -> open array }
-                        if is_open_array(def_to) and
-                           is_array_constructor(def_from) then
-                         begin
-                           if is_void(tarraydef(def_from).elementtype.def) or
-                              is_equal(tarraydef(def_to).elementtype.def,tarraydef(def_from).elementtype.def) then
-                            begin
-                              doconv:=tc_equal;
-                              b:=1;
-                            end
-                           else
-                            if isconvertable(tarraydef(def_from).elementtype.def,
-                                             tarraydef(def_to).elementtype.def,hct,arrayconstructorn,false)<>0 then
-                             begin
-                               doconv:=hct;
-                               b:=2;
-                             end;
-                         end
-                        else
-                         { dynamic array -> open array }
-                         if is_dynamic_array(def_from) and
-                            is_open_array(def_to) and
-                            is_equal(tarraydef(def_to).elementtype.def,tarraydef(def_from).elementtype.def) then
-                           begin
-                             doconv := tc_dynarray_2_openarray;
-                             b := 2;
-                           end
-                        else
-                        { array of tvarrec -> array of const }
-                         if is_array_of_const(def_to) and
-                            is_equal(tarraydef(def_to).elementtype.def,tarraydef(def_from).elementtype.def) then
-                          begin
-                            doconv:=tc_equal;
-                            b:=1;
-                          end;
-                      end;
-                    pointerdef :
-                      begin
-                        if is_zero_based_array(def_to) and
-                           is_equal(tpointerdef(def_from).pointertype.def,tarraydef(def_to).elementtype.def) then
-                         begin
-                           doconv:=tc_pointer_2_array;
-                           b:=1;
-                         end;
-                      end;
-                    stringdef :
-                      begin
-                        { string to char array }
-                        if (not is_special_array(def_to)) and
-                           is_char(tarraydef(def_to).elementtype.def) then
-                         begin
-                           doconv:=tc_string_2_chararray;
-                           b:=1;
-                         end;
-                      end;
-                    orddef:
-                      begin
-                        if is_chararray(def_to) and
-                           is_char(def_from) then
-                          begin
-                            doconv:=tc_char_2_chararray;
-                            b:=2;
-                          end;
-                      end;
-                    recorddef :
-                      begin
-                        { tvarrec -> array of const }
-                         if is_array_of_const(def_to) and
-                            is_equal(def_from,tarraydef(def_to).elementtype.def) then
-                          begin
-                            doconv:=tc_equal;
-                            b:=1;
-                          end;
-                      end;
-                  end;
-                end;
-             end;
-
-           pointerdef :
-             begin
-               case def_from.deftype of
-                 stringdef :
-                   begin
-                     { string constant (which can be part of array constructor)
-                       to zero terminated string constant }
-                     if (fromtreetype in [arrayconstructorn,stringconstn]) and
-                        is_pchar(def_to) or is_pwidechar(def_to) then
-                      begin
-                        doconv:=tc_cstring_2_pchar;
-                        b:=1;
-                      end;
-                   end;
-                 orddef :
-                   begin
-                     { char constant to zero terminated string constant }
-                     if (fromtreetype=ordconstn) then
-                      begin
-                        if is_equal(def_from,cchartype.def) and
-                           is_pchar(def_to) then
-                         begin
-                           doconv:=tc_cchar_2_pchar;
-                           b:=1;
-                         end
-                        else
-                         if is_integer(def_from) then
-                          begin
-                            doconv:=tc_cord_2_pointer;
-                            b:=1;
-                          end;
-                      end;
-                   end;
-                 arraydef :
-                   begin
-                     { chararray to pointer }
-                     if is_zero_based_array(def_from) and
-                        is_equal(tarraydef(def_from).elementtype.def,tpointerdef(def_to).pointertype.def) then
-                      begin
-                        doconv:=tc_array_2_pointer;
-                        b:=1;
-                      end;
-                   end;
-                 pointerdef :
-                   begin
-                     { child class pointer can be assigned to anchestor pointers }
-                     if (
-                         (tpointerdef(def_from).pointertype.def.deftype=objectdef) and
-                         (tpointerdef(def_to).pointertype.def.deftype=objectdef) and
-                         tobjectdef(tpointerdef(def_from).pointertype.def).is_related(
-                           tobjectdef(tpointerdef(def_to).pointertype.def))
-                        ) or
-                        { all pointers can be assigned to void-pointer }
-                        is_equal(tpointerdef(def_to).pointertype.def,voidtype.def) or
-                        { in my opnion, is this not clean pascal }
-                        { well, but it's handy to use, it isn't ? (FK) }
-                        is_equal(tpointerdef(def_from).pointertype.def,voidtype.def) then
-                       begin
-                         { but don't allow conversion between farpointer-pointer }
-                         if (tpointerdef(def_to).is_far=tpointerdef(def_from).is_far) then
-                          begin
-                            doconv:=tc_equal;
-                            b:=1;
-                          end;
-                       end;
-                   end;
-                 procvardef :
-                   begin
-                     { procedure variable can be assigned to an void pointer }
-                     { Not anymore. Use the @ operator now.}
-                     if not(m_tp_procvar in aktmodeswitches) and
-                        (tpointerdef(def_to).pointertype.def.deftype=orddef) and
-                        (torddef(tpointerdef(def_to).pointertype.def).typ=uvoid) then
-                      begin
-                        doconv:=tc_equal;
-                        b:=1;
-                      end;
-                   end;
-                 classrefdef,
-                 objectdef :
-                   begin
-                     { class types and class reference type
-                       can be assigned to void pointers      }
-                     if (
-                         is_class_or_interface(def_from) or
-                         (def_from.deftype=classrefdef)
-                        ) and
-                        (tpointerdef(def_to).pointertype.def.deftype=orddef) and
-                        (torddef(tpointerdef(def_to).pointertype.def).typ=uvoid) then
-                       begin
-                         doconv:=tc_equal;
-                         b:=1;
-                       end;
-                   end;
-               end;
-             end;
-
-           setdef :
-             begin
-               { automatic arrayconstructor -> set conversion }
-               if is_array_constructor(def_from) then
-                begin
-                  doconv:=tc_arrayconstructor_2_set;
-                  b:=1;
-                end;
-             end;
-
-           procvardef :
-             begin
-               { proc -> procvar }
-               if (def_from.deftype=procdef) and
-                  (m_tp_procvar in aktmodeswitches) then
-                begin
-                  doconv:=tc_proc_2_procvar;
-                  if proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to),false) then
-                   b:=1;
-                end
-               { procvar -> procvar }
-               else
-                 if (def_from.deftype=procvardef) and
-                    (proc_to_procvar_equal(tprocvardef(def_from),tprocvardef(def_to),false)) then
-                   begin
-                     doconv:=tc_equal;
-                     b := 2;
-                   end
-               else
-                { for example delphi allows the assignement from pointers }
-                { to procedure variables                                  }
-                if (m_pointer_2_procedure in aktmodeswitches) and
-                  (def_from.deftype=pointerdef) and
-                  (tpointerdef(def_from).pointertype.def.deftype=orddef) and
-                  (torddef(tpointerdef(def_from).pointertype.def).typ=uvoid) then
-                begin
-                   doconv:=tc_equal;
-                   b:=1;
-                end
-               else
-               { nil is compatible with procvars }
-                if (fromtreetype=niln) then
-                 begin
-                   doconv:=tc_equal;
-                   b:=1;
-                 end;
-             end;
-
-           objectdef :
-             begin
-               { object pascal objects }
-               if (def_from.deftype=objectdef) and
-                 tobjectdef(def_from).is_related(tobjectdef(def_to)) then
-                begin
-                  doconv:=tc_equal;
-                  b:=1;
-                end
-               else
-               { Class/interface specific }
-                if is_class_or_interface(def_to) then
-                 begin
-                   { void pointer also for delphi mode }
-                   if (m_delphi in aktmodeswitches) and
-                      is_voidpointer(def_from) then
-                    begin
-                      doconv:=tc_equal;
-                      b:=1;
-                    end
-                   else
-                   { nil is compatible with class instances and interfaces }
-                    if (fromtreetype=niln) then
-                     begin
-                       doconv:=tc_equal;
-                       b:=1;
-                     end
-                   { classes can be assigned to interfaces }
-                   else if is_interface(def_to) and
-                     is_class(def_from) and
-                     assigned(tobjectdef(def_from).implementedinterfaces) then
-                     begin
-                        { we've to search in parent classes as well }
-                        hd3:=tobjectdef(def_from);
-                        while assigned(hd3) do
-                          begin
-                             if hd3.implementedinterfaces.searchintf(def_to)<>-1 then
-                               begin
-                                  doconv:=tc_class_2_intf;
-                                  b:=1;
-                                  break;
-                               end;
-                             hd3:=hd3.childof;
-                          end;
-                     end
-                   { Interface 2 GUID handling }
-                   else if (def_to=tdef(rec_tguid)) and
-                           (fromtreetype=typen) and
-                           is_interface(def_from) and
-                           assigned(tobjectdef(def_from).iidguid) then
-                     begin
-                       b:=1;
-                       doconv:=tc_equal;
-                     end;
-                 end;
-             end;
-
-           classrefdef :
-             begin
-               { class reference types }
-               if (def_from.deftype=classrefdef) then
-                begin
-                  doconv:=tc_equal;
-                  if tobjectdef(tclassrefdef(def_from).pointertype.def).is_related(
-                       tobjectdef(tclassrefdef(def_to).pointertype.def)) then
-                   b:=1;
-                end
-               else
-                { nil is compatible with class references }
-                if (fromtreetype=niln) then
-                 begin
-                   doconv:=tc_equal;
-                   b:=1;
-                 end;
-             end;
-
-           filedef :
-             begin
-               { typed files are all equal to the abstract file type
-               name TYPEDFILE in system.pp in is_equal in types.pas
-               the problem is that it sholud be also compatible to FILE
-               but this would leed to a problem for ASSIGN RESET and REWRITE
-               when trying to find the good overloaded function !!
-               so all file function are doubled in system.pp
-               this is not very beautiful !!}
-               if (def_from.deftype=filedef) and
-                  (
-                   (
-                    (tfiledef(def_from).filetyp = ft_typed) and
-                    (tfiledef(def_to).filetyp = ft_typed) and
-                    (
-                     (tfiledef(def_from).typedfiletype.def = tdef(voidtype.def)) or
-                     (tfiledef(def_to).typedfiletype.def = tdef(voidtype.def))
-                    )
-                   ) or
-                   (
-                    (
-                     (tfiledef(def_from).filetyp = ft_untyped) and
-                     (tfiledef(def_to).filetyp = ft_typed)
-                    ) or
-                    (
-                     (tfiledef(def_from).filetyp = ft_typed) and
-                     (tfiledef(def_to).filetyp = ft_untyped)
-                    )
-                   )
-                  ) then
-                 begin
-                    doconv:=tc_equal;
-                    b:=1;
-                 end
-             end;
-
-           recorddef :
-             begin
-               { interface -> guid }
-               if is_interface(def_from) and
-                  (def_to=rec_tguid) then
-                begin
-                  doconv:=tc_intf_2_guid;
-                  b:=1;
-                end
-               else
-                begin
-                  { assignment overwritten ?? }
-                  if internal_assignment_overloaded(def_from,def_to,overload_procs)<>nil then
-                    b:=2;
-                end;
-             end;
-           { a variant isn't compatible to nil (FK)
-           variantdef :
-             begin
-               if (fromtreetype=niln) then
-                 begin
-                   doconv:=tc_equal;
-                   b:=1;
-                 end;
-             end;
-           }
-           formaldef :
-             begin
-               { Just about everything can be converted to a formaldef...}
-               if not (def_from.deftype in [abstractdef,errordef]) then
-                 b:=1
-               else
-                 begin
-                   { assignment overwritten ?? }
-                   if internal_assignment_overloaded(def_from,def_to,overload_procs)<>nil then
-                     b:=2;
-                 end;
-             end;
-        end;
-        { if we didn't find an appropriate type conversion yet, we try the overloaded := operator  }
-        { This is done for variants only yet, maybe we should do this for other types as well (FK) }
-        if (b=0) and ((def_from.deftype in [variantdef]) or (def_to.deftype in [variantdef])) then
-          begin
-             if internal_assignment_overloaded(def_from,def_to,overload_procs)<>nil then
-               b:=2;
-          end;
-        overloaded_assignment_isconvertable :=b;
-      end;
-
-
-    function CheckTypes(def1,def2 : tdef) : boolean;
-
-      var
-         s1,s2 : string;
-
-      begin
-        CheckTypes:=False;
-        if not is_equal(def1,def2) then
-         begin
-           { Crash prevention }
-           if (not assigned(def1)) or (not assigned(def2)) then
-             Message(type_e_mismatch)
-           else
-             begin
-                if not is_subequal(def1,def2) then
-                  begin
-                    s1:=def1.typename;
-                    s2:=def2.typename;
-                    Message2(type_e_not_equal_types,def1.typename,def2.typename);
-                  end
-                else
-                  CheckTypes := true;
-             end;
-         end
-      else
-       CheckTypes := True;
-     end;
-
-end.
-{
-  $Log$
-  Revision 1.27  2002-11-22 22:48:10  carl
-  * memory optimization with tconstsym (1.5%)
-
-  Revision 1.26  2002/11/17 16:31:55  carl
-    * memory optimization (3-4%) : cleanup of tai fields,
-       cleanup of tdef and tsym fields.
-    * make it work for m68k
-
-  Revision 1.25  2002/11/16 18:00:53  peter
-    * fix merged proc-procvar check
-
-  Revision 1.24  2002/11/15 01:58:46  peter
-    * merged changes from 1.0.7 up to 04-11
-      - -V option for generating bug report tracing
-      - more tracing for option parsing
-      - errors for cdecl and high()
-      - win32 import stabs
-      - win32 records<=8 are returned in eax:edx (turned off by default)
-      - heaptrc update
-      - more info for temp management in .s file with EXTDEBUG
-
-  Revision 1.23  2002/10/20 15:34:16  peter
-    * removed df_unique flag. It breaks code. For a good type=type <id>
-      a def copy is required
-
-  Revision 1.22  2002/10/10 16:07:57  florian
-    + several widestring/pwidechar related stuff added
-
-  Revision 1.21  2002/10/09 21:01:41  florian
-    * variants aren't compatible with nil
-
-  Revision 1.20  2002/10/07 09:49:42  florian
-    * overloaded :=-operator is now searched when looking for possible
-      variant type conversions
-
-  Revision 1.19  2002/10/06 21:02:17  peter
-    * fixed limit checking for qword
-
-  Revision 1.18  2002/10/06 15:08:59  peter
-    * only check for forwarddefs the definitions that really belong to
-      the current procsym
-
-  Revision 1.17  2002/10/06 12:25:04  florian
-    + proper support of type <id> = type <another id>;
-
-  Revision 1.16  2002/10/05 12:43:24  carl
-    * fixes for Delphi 6 compilation
-     (warning : Some features do not work under Delphi)
-
-  Revision 1.15  2002/10/05 00:50:01  peter
-    * check parameters from left to right in equal_paras, so default
-      parameters are checked at the end
-
-  Revision 1.14  2002/09/30 07:00:44  florian
-    * fixes to common code to get the alpha compiler compiled applied
-
-  Revision 1.13  2002/09/22 14:02:34  carl
-    * stack checking cannot be called before system unit is initialized
-    * MC68020 define
-
-  Revision 1.12  2002/09/16 14:11:12  peter
-    * add argument to equal_paras() to support default values or not
-
-  Revision 1.11  2002/09/15 17:54:46  peter
-    * allow default parameters in equal_paras
-
-  Revision 1.10  2002/09/08 11:10:17  carl
-    * bugfix 2109 (bad imho, but only way)
-
-  Revision 1.9  2002/09/07 15:25:02  peter
-    * old logs removed and tabs fixed
-
-  Revision 1.8  2002/09/07 09:16:55  carl
-    * fix my stupid copy and paste bug
-
-  Revision 1.7  2002/09/06 19:58:31  carl
-   * start bugfix 1996
-   * 64-bit typed constant now work correctly and fully (bugfix 2001)
-
-  Revision 1.6  2002/08/20 10:31:26  daniel
-   * Tcallnode.det_resulttype rewritten
-
-  Revision 1.5  2002/08/12 20:39:17  florian
-    * casting of classes to interface fixed when the interface was
-      implemented by a parent class
-
-  Revision 1.4  2002/08/12 14:17:56  florian
-    * nil is now recognized as being compatible with a dynamic array
-
-  Revision 1.3  2002/08/05 18:27:48  carl
-    + more more more documentation
-    + first version include/exclude (can't test though, not enough scratch for i386 :()...
-
-  Revision 1.2  2002/07/23 09:51:22  daniel
-  * Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
-    are worth comitting.
-
-  Revision 1.1  2002/07/20 11:57:53  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.75  2002/07/11 14:41:32  florian
-    * start of the new generic parameter handling
-
-  Revision 1.74  2002/07/01 16:23:54  peter
-    * cg64 patch
-    * basics for currency
-    * asnode updates for class and interface (not finished)
-
-  Revision 1.73  2002/05/18 13:34:21  peter
-    * readded missing revisions
-
-  Revision 1.72  2002/05/16 19:46:47  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.70  2002/05/12 16:53:16  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.69  2002/04/25 20:16:39  peter
-    * moved more routines from cga/n386util
-
-  Revision 1.68  2002/04/15 19:08:22  carl
-  + target_info.size_of_pointer -> pointer_size
-  + some cleanup of unused types/variables
-
-  Revision 1.67  2002/04/07 13:40:29  carl
-  + update documentation
-
-  Revision 1.66  2002/04/02 17:11:32  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.65  2002/04/01 20:57:14  jonas
-    * fixed web bug 1907
-    * fixed some other procvar related bugs (all related to accepting procvar
-        constructs with either too many or too little parameters)
-    (both merged, includes second typo fix of pexpr.pas)
-
-  Revision 1.64  2002/01/24 18:25:53  peter
-   * implicit result variable generation for assembler routines
-   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
-
-  Revision 1.63  2002/01/24 12:33:53  jonas
-    * adapted ranges of native types to int64 (e.g. high cardinal is no
-      longer longint($ffffffff), but just $fffffff in psystem)
-    * small additional fix in 64bit rangecheck code generation for 32 bit
-      processors
-    * adaption of ranges required the matching talgorithm used for selecting
-      which overloaded procedure to call to be adapted. It should now always
-      select the closest match for ordinal parameters.
-    + inttostr(qword) in sysstr.inc/sysstrh.inc
-    + abs(int64), sqr(int64), sqr(qword) in systemh.inc/generic.inc (previous
-      fixes were required to be able to add them)
-    * is_in_limit() moved from ncal to types unit, should always be used
-      instead of direct comparisons of low/high values of orddefs because
-      qword is a special case
-
-}

compiler/defcmp.pas

@@ -0,0 +1,1150 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Compare definitions and parameter lists
+
+    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 defcmp;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+       cclasses,
+       cpuinfo,
+       globals,
+       node,
+       symconst,symbase,symtype,symdef;
+
+     type
+       { The order is from low priority to high priority,
+         Note: the operators > and < are used on this list }
+       tequaltype = (
+         te_incompatible,
+         te_convert_operator,
+         te_convert_l2,
+         te_convert_l1,
+         te_equal,
+         te_exact
+       );
+
+       { if acp is cp_all the var const or nothing are considered equal }
+       compare_type = ( cp_none, cp_value_equal_const, cp_all,cp_procvar);
+
+       tconverttype = (
+          tc_equal,
+          tc_not_possible,
+          tc_string_2_string,
+          tc_char_2_string,
+          tc_char_2_chararray,
+          tc_pchar_2_string,
+          tc_cchar_2_pchar,
+          tc_cstring_2_pchar,
+          tc_ansistring_2_pchar,
+          tc_string_2_chararray,
+          tc_chararray_2_string,
+          tc_array_2_pointer,
+          tc_pointer_2_array,
+          tc_int_2_int,
+          tc_int_2_bool,
+          tc_bool_2_bool,
+          tc_bool_2_int,
+          tc_real_2_real,
+          tc_int_2_real,
+          tc_proc_2_procvar,
+          tc_arrayconstructor_2_set,
+          tc_load_smallset,
+          tc_cord_2_pointer,
+          tc_intf_2_string,
+          tc_intf_2_guid,
+          tc_class_2_intf,
+          tc_char_2_char,
+          tc_normal_2_smallset,
+          tc_dynarray_2_openarray,
+          tc_pwchar_2_string
+       );
+
+    function compare_defs_ext(def_from,def_to : tdef;
+                              fromtreetype : tnodetype;
+                              explicit : boolean;
+                              check_operator : boolean;
+                              var doconv : tconverttype;
+                              var operatorpd : tprocdef):tequaltype;
+
+    { Returns if the type def_from can be converted to def_to or if both types are equal }
+    function compare_defs(def_from,def_to:tdef;fromtreetype:tnodetype):tequaltype;
+
+    { Returns true, if def1 and def2 are semantically the same }
+    function equal_defs(def_from,def_to:tdef):boolean;
+
+    { Checks for type compatibility (subgroups of type)
+      used for case statements... probably missing stuff
+      to use on other types }
+    function is_subequal(def1, def2: tdef): boolean;
+
+    function assignment_overloaded(from_def,to_def : tdef) : tprocdef;
+
+     {# true, if two parameter lists are equal
+      if acp is cp_none, all have to match exactly
+      if acp is cp_value_equal_const call by value
+      and call by const parameter are assumed as
+      equal
+      allowdefaults indicates if default value parameters
+      are allowed (in this case, the search order will first
+      search for a routine with default parameters, before
+      searching for the same definition with no parameters)
+    }
+    function compare_paras(paralist1,paralist2 : TLinkedList; acp : compare_type;allowdefaults:boolean):tequaltype;
+
+    { True if a function can be assigned to a procvar }
+    { changed first argument type to pabstractprocdef so that it can also be }
+    { used to test compatibility between two pprocvardefs (JM)               }
+    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef):tequaltype;
+
+
+implementation
+
+    uses
+      globtype,tokens,
+      verbose,systems,
+      symsym,symtable,
+      defutil,symutil;
+
+
+    function assignment_overloaded(from_def,to_def:tdef):tprocdef;
+      begin
+        if assigned(overloaded_operators[_ASSIGNMENT]) then
+          assignment_overloaded:=overloaded_operators[_ASSIGNMENT].search_procdef_assignment_operator(from_def,to_def)
+        else
+          assignment_overloaded:=nil;
+      end;
+
+
+    function compare_defs_ext(def_from,def_to : tdef;
+                              fromtreetype : tnodetype;
+                              explicit : boolean;
+                              check_operator : boolean;
+                              var doconv : tconverttype;
+                              var operatorpd : tprocdef):tequaltype;
+
+      { Tbasetype:
+           uvoid,
+           u8bit,u16bit,u32bit,u64bit,
+           s8bit,s16bit,s32bit,s64bit,
+           bool8bit,bool16bit,bool32bit,
+           uchar,uwidechar }
+
+      type
+        tbasedef=(bvoid,bchar,bint,bbool);
+      const
+        basedeftbl:array[tbasetype] of tbasedef =
+          (bvoid,
+           bint,bint,bint,bint,
+           bint,bint,bint,bint,
+           bbool,bbool,bbool,
+           bchar,bchar);
+
+        basedefconvertsimplicit : array[tbasedef,tbasedef] of tconverttype =
+          { void, char, int, bool }
+         ((tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible),
+          (tc_not_possible,tc_char_2_char,tc_not_possible,tc_not_possible),
+          (tc_not_possible,tc_not_possible,tc_int_2_int,tc_int_2_bool),
+          (tc_not_possible,tc_not_possible,tc_bool_2_int,tc_bool_2_bool));
+        basedefconvertsexplicit : array[tbasedef,tbasedef] of tconverttype =
+          { void, char, int, bool }
+         ((tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible),
+          (tc_not_possible,tc_char_2_char,tc_int_2_int,tc_int_2_bool),
+          (tc_not_possible,tc_int_2_int,tc_int_2_int,tc_int_2_bool),
+          (tc_not_possible,tc_bool_2_int,tc_bool_2_int,tc_bool_2_bool));
+
+      var
+         eq,b : tequaltype;
+         hd1,hd2 : tdef;
+         hct : tconverttype;
+         hd3 : tobjectdef;
+         hpd : tprocdef;
+      begin
+         { safety check }
+         if not(assigned(def_from) and assigned(def_to)) then
+          begin
+            compare_defs_ext:=te_incompatible;
+            exit;
+          end;
+
+         { same def? then we've an exact match }
+         if def_from=def_to then
+          begin
+            compare_defs_ext:=te_exact;
+            exit;
+          end;
+
+         { tp7 procvar def support, in tp7 a procvar is always called, if the
+           procvar is passed explicit a addrn would be there }
+         if (m_tp_procvar in aktmodeswitches) and
+            (def_from.deftype=procvardef) and
+            (fromtreetype=loadn) and
+            { only if the procvar doesn't require any paramters }
+            (tprocvardef(def_from).minparacount = 0) then
+          begin
+            def_from:=tprocvardef(def_from).rettype.def;
+          end;
+
+         { we walk the wanted (def_to) types and check then the def_from
+           types if there is a conversion possible }
+         b:=te_incompatible;
+         doconv:=tc_not_possible;
+         case def_to.deftype of
+           orddef :
+             begin
+               case def_from.deftype of
+                 orddef :
+                   begin
+                     if (torddef(def_from).typ=torddef(def_to).typ) then
+                      begin
+                        case torddef(def_from).typ of
+                          u8bit,u16bit,u32bit,u64bit,
+                          s8bit,s16bit,s32bit,s64bit:
+                            begin
+                              if (torddef(def_from).low=torddef(def_to).low) and
+                                 (torddef(def_from).high=torddef(def_to).high) then
+                                b:=te_equal
+                              else
+                                b:=te_convert_l1;
+                            end;
+                          uvoid,uchar,uwidechar,
+                          bool8bit,bool16bit,bool32bit:
+                            b:=te_equal;
+                          else
+                            internalerror(200210061);
+                        end;
+                      end
+                     else
+                      begin
+                        if explicit then
+                         doconv:=basedefconvertsexplicit[basedeftbl[torddef(def_from).typ],basedeftbl[torddef(def_to).typ]]
+                        else
+                         doconv:=basedefconvertsimplicit[basedeftbl[torddef(def_from).typ],basedeftbl[torddef(def_to).typ]];
+                        if (doconv=tc_not_possible) then
+                          b:=te_incompatible
+                        else
+                          { "punish" bad type conversions :) (JM) }
+                          if (not is_in_limit(def_from,def_to)) and
+                             (def_from.size > def_to.size) then
+                            b:=te_convert_l2
+                        else
+                          b:=te_convert_l1;
+                      end;
+                   end;
+                 enumdef :
+                   begin
+                     { needed for char(enum) }
+                     if explicit then
+                      begin
+                        doconv:=tc_int_2_int;
+                        b:=te_convert_l1;
+                      end;
+                   end;
+                 pointerdef :
+                   begin
+                     if explicit and
+                        (fromtreetype=niln) then
+                      begin
+                        { will be handled by the constant folding }
+                        doconv:=tc_equal;
+                        b:=te_convert_l1;
+                      end;
+                   end;
+               end;
+             end;
+
+          stringdef :
+             begin
+               case def_from.deftype of
+                 stringdef :
+                   begin
+                     if (tstringdef(def_from).string_typ=tstringdef(def_to).string_typ) and
+                        ((tstringdef(def_from).string_typ<>st_shortstring) or
+                         (tstringdef(def_from).len=tstringdef(def_to).len)) then
+                       b:=te_equal
+                     else
+                       begin
+                         doconv:=tc_string_2_string;
+                         b:=te_convert_l1;
+                       end;
+                   end;
+                 orddef :
+                   begin
+                   { char to string}
+                     if is_char(def_from) or
+                        is_widechar(def_from) then
+                      begin
+                        doconv:=tc_char_2_string;
+                        b:=te_convert_l1;
+                      end;
+                   end;
+                 arraydef :
+                   begin
+                   { array of char to string, the length check is done by the firstpass of this node }
+                     if is_chararray(def_from) or
+                        (is_char(tarraydef(def_from).elementtype.def) and
+                         is_open_array(def_from)) then
+                      begin
+                        doconv:=tc_chararray_2_string;
+                        if is_open_array(def_from) or
+                           (is_shortstring(def_to) and
+                            (def_from.size <= 255)) or
+                           (is_ansistring(def_to) and
+                            (def_from.size > 255)) then
+                         b:=te_convert_l1
+                        else
+                         b:=te_convert_l2;
+                      end;
+                   end;
+                 pointerdef :
+                   begin
+                   { pchar can be assigned to short/ansistrings,
+                     but not in tp7 compatible mode }
+                     if not(m_tp7 in aktmodeswitches) then
+                       begin
+                          if is_pchar(def_from) then
+                           begin
+                             doconv:=tc_pchar_2_string;
+                             { trefer ansistrings because pchars can overflow shortstrings, }
+                             { but only if ansistrings are the default (JM)                 }
+                             if (is_shortstring(def_to) and
+                                 not(cs_ansistrings in aktlocalswitches)) or
+                                (is_ansistring(def_to) and
+                                 (cs_ansistrings in aktlocalswitches)) then
+                               b:=te_convert_l1
+                             else
+                               b:=te_convert_l2;
+                           end
+                          else if is_pwidechar(def_from) then
+                           begin
+                             doconv:=tc_pwchar_2_string;
+                             { trefer ansistrings because pchars can overflow shortstrings, }
+                             { but only if ansistrings are the default (JM)                 }
+                             if is_widestring(def_to) then
+                               b:=te_convert_l1
+                             else
+                               b:=te_convert_l2;
+                           end;
+                       end;
+                   end;
+               end;
+             end;
+
+           floatdef :
+             begin
+               case def_from.deftype of
+                 orddef :
+                   begin { ordinal to real }
+                     if is_integer(def_from) then
+                       begin
+                         doconv:=tc_int_2_real;
+                         b:=te_convert_l1;
+                       end;
+                   end;
+                 floatdef :
+                   begin
+                     if tfloatdef(def_from).typ=tfloatdef(def_to).typ then
+                       b:=te_equal
+                     else
+                       begin
+                         doconv:=tc_real_2_real;
+                         b:=te_convert_l1;
+                       end;
+                   end;
+               end;
+             end;
+
+           enumdef :
+             begin
+               case def_from.deftype of
+                 enumdef :
+                   begin
+                     if explicit then
+                      begin
+                        b:=te_convert_l1;
+                        doconv:=tc_int_2_int;
+                      end
+                     else
+                      begin
+                        hd1:=def_from;
+                        while assigned(tenumdef(hd1).basedef) do
+                         hd1:=tenumdef(hd1).basedef;
+                        hd2:=def_to;
+                        while assigned(tenumdef(hd2).basedef) do
+                         hd2:=tenumdef(hd2).basedef;
+                        if (hd1=hd2) then
+                         begin
+                           b:=te_convert_l1;
+                           { because of packenum they can have different sizes! (JM) }
+                           doconv:=tc_int_2_int;
+                         end;
+                      end;
+                   end;
+                 orddef :
+                   begin
+                     if explicit then
+                      begin
+                        b:=te_convert_l1;
+                        doconv:=tc_int_2_int;
+                      end;
+                   end;
+               end;
+             end;
+
+           arraydef :
+             begin
+             { open array is also compatible with a single element of its base type }
+               if is_open_array(def_to) and
+                  equal_defs(def_from,tarraydef(def_to).elementtype.def) then
+                begin
+                  doconv:=tc_equal;
+                  b:=te_convert_l1;
+                end
+               else
+                begin
+                  case def_from.deftype of
+                    arraydef :
+                      begin
+                        { to dynamic array }
+                        if is_dynamic_array(def_to) then
+                         begin
+                           { dynamic array -> dynamic array }
+                           if is_dynamic_array(def_from) and
+                              equal_defs(tarraydef(def_from).elementtype.def,tarraydef(def_to).elementtype.def) then
+                            b:=te_equal;
+                         end
+                        else
+                         { to open array }
+                         if is_open_array(def_to) then
+                          begin
+                            { array constructor -> open array }
+                            if is_array_constructor(def_from) then
+                             begin
+                               if is_void(tarraydef(def_from).elementtype.def) then
+                                begin
+                                  doconv:=tc_equal;
+                                  b:=te_convert_l1;
+                                end
+                               else
+                                begin
+                                  eq:=compare_defs_ext(tarraydef(def_from).elementtype.def,
+                                                       tarraydef(def_to).elementtype.def,
+                                                       arrayconstructorn,false,true,hct,hpd);
+                                  if (eq>=te_equal) then
+                                    begin
+                                      doconv:=tc_equal;
+                                      b:=te_convert_l1;
+                                    end
+                                  else
+                                   if (eq>te_incompatible) then
+                                    begin
+                                      doconv:=hct;
+                                      b:=te_convert_l2;
+                                    end;
+                                end;
+                             end
+                            else
+                             { dynamic array -> open array }
+                             if is_dynamic_array(def_from) and
+                                equal_defs(tarraydef(def_from).elementtype.def,tarraydef(def_to).elementtype.def) then
+                               begin
+                                 doconv:=tc_dynarray_2_openarray;
+                                 b:=te_convert_l2;
+                               end
+                            else
+                             { array -> open array }
+                             if equal_defs(tarraydef(def_from).elementtype.def,tarraydef(def_to).elementtype.def) then
+                               b:=te_equal;
+                          end
+                        else
+                         { to array of const }
+                         if is_array_of_const(def_to) then
+                          begin
+                            if is_array_of_const(def_from) or
+                               is_array_constructor(def_from) then
+                             begin
+                               b:=te_equal;
+                             end
+                            else
+                             { array of tvarrec -> array of const }
+                             if equal_defs(tarraydef(def_to).elementtype.def,tarraydef(def_from).elementtype.def) then
+                              begin
+                                doconv:=tc_equal;
+                                b:=te_convert_l1;
+                              end;
+                          end
+                        else
+                         { other arrays }
+                          begin
+                            { open array -> array }
+                            if is_open_array(def_from) and
+                               equal_defs(tarraydef(def_from).elementtype.def,tarraydef(def_to).elementtype.def) then
+                              begin
+                                b:=te_equal
+                              end
+                            else
+                            { array -> array }
+                             if not(m_tp7 in aktmodeswitches) and
+                                not(m_delphi in aktmodeswitches) and
+                                (tarraydef(def_from).lowrange=tarraydef(def_to).lowrange) and
+                                (tarraydef(def_from).highrange=tarraydef(def_to).highrange) and
+                                equal_defs(tarraydef(def_from).elementtype.def,tarraydef(def_to).elementtype.def) and
+                                equal_defs(tarraydef(def_from).rangetype.def,tarraydef(def_to).rangetype.def) then
+                              begin
+                                b:=te_equal
+                              end;
+                          end;
+                      end;
+                    pointerdef :
+                      begin
+                        { nil is compatible with dyn. arrays }
+                        if is_dynamic_array(def_to) and
+                           (fromtreetype=niln) then
+                         begin
+                           doconv:=tc_equal;
+                           b:=te_convert_l1;
+                         end
+                        else
+                         if is_zero_based_array(def_to) and
+                            equal_defs(tpointerdef(def_from).pointertype.def,tarraydef(def_to).elementtype.def) then
+                          begin
+                            doconv:=tc_pointer_2_array;
+                            b:=te_convert_l1;
+                          end;
+                      end;
+                    stringdef :
+                      begin
+                        { string to char array }
+                        if (not is_special_array(def_to)) and
+                           is_char(tarraydef(def_to).elementtype.def) then
+                         begin
+                           doconv:=tc_string_2_chararray;
+                           b:=te_convert_l1;
+                         end;
+                      end;
+                    orddef:
+                      begin
+                        if is_chararray(def_to) and
+                           is_char(def_from) then
+                          begin
+                            doconv:=tc_char_2_chararray;
+                            b:=te_convert_l2;
+                          end;
+                      end;
+                    recorddef :
+                      begin
+                        { tvarrec -> array of const }
+                         if is_array_of_const(def_to) and
+                            equal_defs(def_from,tarraydef(def_to).elementtype.def) then
+                          begin
+                            doconv:=tc_equal;
+                            b:=te_convert_l1;
+                          end;
+                      end;
+                  end;
+                end;
+             end;
+
+           pointerdef :
+             begin
+               case def_from.deftype of
+                 stringdef :
+                   begin
+                     { string constant (which can be part of array constructor)
+                       to zero terminated string constant }
+                     if (fromtreetype in [arrayconstructorn,stringconstn]) and
+                        (is_pchar(def_to) or is_pwidechar(def_to)) then
+                      begin
+                        doconv:=tc_cstring_2_pchar;
+                        b:=te_convert_l1;
+                      end
+                     else
+                      if explicit then
+                       begin
+                         { pchar(ansistring) }
+                         if is_pchar(def_to) and
+                            is_ansistring(def_from) then
+                          begin
+                            doconv:=tc_ansistring_2_pchar;
+                            b:=te_convert_l1;
+                          end
+                         else
+                          { pwidechar(ansistring) }
+                          if is_pwidechar(def_to) and
+                             is_widestring(def_from) then
+                           begin
+                             doconv:=tc_ansistring_2_pchar;
+                             b:=te_convert_l1;
+                           end;
+                       end;
+                   end;
+                 orddef :
+                   begin
+                     { char constant to zero terminated string constant }
+                     if (fromtreetype=ordconstn) then
+                      begin
+                        if is_char(def_from) and
+                           is_pchar(def_to) then
+                         begin
+                           doconv:=tc_cchar_2_pchar;
+                           b:=te_convert_l1;
+                         end
+                        else
+                         if is_integer(def_from) then
+                          begin
+                            doconv:=tc_cord_2_pointer;
+                            b:=te_convert_l1;
+                          end;
+                      end;
+                     if (b=te_incompatible) and
+                        explicit and
+                        (m_delphi in aktmodeswitches) then
+                      begin
+                        doconv:=tc_int_2_int;
+                        b:=te_convert_l1;
+                      end;
+                   end;
+                 arraydef :
+                   begin
+                     { chararray to pointer }
+                     if is_zero_based_array(def_from) and
+                        equal_defs(tarraydef(def_from).elementtype.def,tpointerdef(def_to).pointertype.def) then
+                      begin
+                        doconv:=tc_array_2_pointer;
+                        b:=te_convert_l1;
+                      end;
+                   end;
+                 pointerdef :
+                   begin
+                     { check for far pointers }
+                     if (tpointerdef(def_from).is_far<>tpointerdef(def_to).is_far) then
+                       begin
+                         b:=te_incompatible;
+                       end
+                     else
+                      { the types can be forward type, handle before normal type check !! }
+                      if assigned(def_to.typesym) and
+                         (tpointerdef(def_to).pointertype.def.deftype=forwarddef) then
+                       begin
+                         if (def_from.typesym=def_to.typesym) then
+                          b:=te_equal
+                       end
+                     else
+                      { same types }
+                      if (tpointerdef(def_from).pointertype.def=tpointerdef(def_to).pointertype.def) then
+                       begin
+                         b:=te_equal
+                       end
+                     else
+                      { child class pointer can be assigned to anchestor pointers }
+                      if (
+                          (tpointerdef(def_from).pointertype.def.deftype=objectdef) and
+                          (tpointerdef(def_to).pointertype.def.deftype=objectdef) and
+                          tobjectdef(tpointerdef(def_from).pointertype.def).is_related(
+                            tobjectdef(tpointerdef(def_to).pointertype.def))
+                         ) or
+                         { all pointers can be assigned to/from void-pointer }
+                         is_void(tpointerdef(def_to).pointertype.def) or
+                         is_void(tpointerdef(def_from).pointertype.def) then
+                       begin
+                         doconv:=tc_equal;
+                         b:=te_convert_l1;
+                       end;
+                   end;
+                 procvardef :
+                   begin
+                     { procedure variable can be assigned to an void pointer }
+                     { Not anymore. Use the @ operator now.}
+                     if not(m_tp_procvar in aktmodeswitches) and
+                        (tpointerdef(def_to).pointertype.def.deftype=orddef) and
+                        (torddef(tpointerdef(def_to).pointertype.def).typ=uvoid) then
+                      begin
+                        doconv:=tc_equal;
+                        b:=te_convert_l1;
+                      end;
+                   end;
+                 classrefdef,
+                 objectdef :
+                   begin
+                     { class types and class reference type
+                       can be assigned to void pointers      }
+                     if (
+                         is_class_or_interface(def_from) or
+                         (def_from.deftype=classrefdef)
+                        ) and
+                        (tpointerdef(def_to).pointertype.def.deftype=orddef) and
+                        (torddef(tpointerdef(def_to).pointertype.def).typ=uvoid) then
+                       begin
+                         doconv:=tc_equal;
+                         b:=te_convert_l1;
+                       end;
+                   end;
+               end;
+             end;
+
+           setdef :
+             begin
+               case def_from.deftype of
+                 setdef :
+                   begin
+                     if assigned(tsetdef(def_from).elementtype.def) and
+                        assigned(tsetdef(def_to).elementtype.def) then
+                      begin
+                        { sets with the same element base type are equal }
+                        if is_subequal(tsetdef(def_from).elementtype.def,tsetdef(def_to).elementtype.def) then
+                         b:=te_equal;
+                      end
+                     else
+                      { empty set is compatible with everything }
+                      b:=te_equal;
+                   end;
+                 arraydef :
+                   begin
+                     { automatic arrayconstructor -> set conversion }
+                     if is_array_constructor(def_from) then
+                      begin
+                        doconv:=tc_arrayconstructor_2_set;
+                        b:=te_convert_l1;
+                      end;
+                   end;
+               end;
+             end;
+
+           procvardef :
+             begin
+               case def_from.deftype of
+                 procdef :
+                   begin
+                     { proc -> procvar }
+                     if (m_tp_procvar in aktmodeswitches) then
+                      begin
+                        b:=proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to));
+                        if b>te_incompatible then
+                         begin
+                           doconv:=tc_proc_2_procvar;
+                           b:=te_convert_l1;
+                         end;
+                      end;
+                   end;
+                 procvardef :
+                   begin
+                     { procvar -> procvar }
+                     b:=proc_to_procvar_equal(tprocvardef(def_from),tprocvardef(def_to));
+                   end;
+                 pointerdef :
+                   begin
+                     { nil is compatible with procvars }
+                     if (fromtreetype=niln) then
+                      begin
+                        doconv:=tc_equal;
+                        b:=te_convert_l1;
+                      end
+                     else
+                      { for example delphi allows the assignement from pointers }
+                      { to procedure variables                                  }
+                      if (m_pointer_2_procedure in aktmodeswitches) and
+                         (tpointerdef(def_from).pointertype.def.deftype=orddef) and
+                         (torddef(tpointerdef(def_from).pointertype.def).typ=uvoid) then
+                       begin
+                         doconv:=tc_equal;
+                         b:=te_convert_l1;
+                       end;
+                   end;
+               end;
+             end;
+
+           objectdef :
+             begin
+               { object pascal objects }
+               if (def_from.deftype=objectdef) and
+                 tobjectdef(def_from).is_related(tobjectdef(def_to)) then
+                begin
+                  doconv:=tc_equal;
+                  b:=te_convert_l1;
+                end
+               else
+               { Class/interface specific }
+                if is_class_or_interface(def_to) then
+                 begin
+                   { void pointer also for delphi mode }
+                   if (m_delphi in aktmodeswitches) and
+                      is_voidpointer(def_from) then
+                    begin
+                      doconv:=tc_equal;
+                      b:=te_convert_l1;
+                    end
+                   else
+                   { nil is compatible with class instances and interfaces }
+                    if (fromtreetype=niln) then
+                     begin
+                       doconv:=tc_equal;
+                       b:=te_convert_l1;
+                     end
+                   { classes can be assigned to interfaces }
+                   else if is_interface(def_to) and
+                     is_class(def_from) and
+                     assigned(tobjectdef(def_from).implementedinterfaces) then
+                     begin
+                        { we've to search in parent classes as well }
+                        hd3:=tobjectdef(def_from);
+                        while assigned(hd3) do
+                          begin
+                             if hd3.implementedinterfaces.searchintf(def_to)<>-1 then
+                               begin
+                                  doconv:=tc_class_2_intf;
+                                  b:=te_convert_l1;
+                                  break;
+                               end;
+                             hd3:=hd3.childof;
+                          end;
+                     end
+                   { Interface 2 GUID handling }
+                   else if (def_to=tdef(rec_tguid)) and
+                           (fromtreetype=typen) and
+                           is_interface(def_from) and
+                           assigned(tobjectdef(def_from).iidguid) then
+                     begin
+                       b:=te_convert_l1;
+                       doconv:=tc_equal;
+                     end;
+                 end;
+             end;
+
+           classrefdef :
+             begin
+               { similar to pointerdef wrt forwards }
+               if assigned(def_to.typesym) and
+                  (tclassrefdef(def_to).pointertype.def.deftype=forwarddef) then
+                 begin
+                   if (def_from.typesym=def_to.typesym) then
+                    b:=te_equal;
+                 end
+               else
+                { class reference types }
+                if (def_from.deftype=classrefdef) then
+                 begin
+                   if equal_defs(tclassrefdef(def_from).pointertype.def,tclassrefdef(def_to).pointertype.def) then
+                    begin
+                      b:=te_equal;
+                    end
+                   else
+                    begin
+                      doconv:=tc_equal;
+                      if tobjectdef(tclassrefdef(def_from).pointertype.def).is_related(
+                           tobjectdef(tclassrefdef(def_to).pointertype.def)) then
+                        b:=te_convert_l1;
+                    end;
+                 end
+               else
+                { nil is compatible with class references }
+                if (fromtreetype=niln) then
+                 begin
+                   doconv:=tc_equal;
+                   b:=te_convert_l1;
+                 end;
+             end;
+
+           filedef :
+             begin
+               { typed files are all equal to the abstract file type
+               name TYPEDFILE in system.pp in is_equal in types.pas
+               the problem is that it sholud be also compatible to FILE
+               but this would leed to a problem for ASSIGN RESET and REWRITE
+               when trying to find the good overloaded function !!
+               so all file function are doubled in system.pp
+               this is not very beautiful !!}
+               if (def_from.deftype=filedef) then
+                begin
+                  if (tfiledef(def_from).filetyp=tfiledef(def_to).filetyp) then
+                   begin
+                     if
+                        (
+                         (tfiledef(def_from).typedfiletype.def=nil) and
+                         (tfiledef(def_to).typedfiletype.def=nil)
+                        ) or
+                        (
+                         (tfiledef(def_from).typedfiletype.def<>nil) and
+                         (tfiledef(def_to).typedfiletype.def<>nil) and
+                         equal_defs(tfiledef(def_from).typedfiletype.def,tfiledef(def_to).typedfiletype.def)
+                        ) or
+                        (
+                         (tfiledef(def_from).filetyp = ft_typed) and
+                         (tfiledef(def_to).filetyp = ft_typed) and
+                         (
+                          (tfiledef(def_from).typedfiletype.def = tdef(voidtype.def)) or
+                          (tfiledef(def_to).typedfiletype.def = tdef(voidtype.def))
+                         )
+                        ) then
+                      begin
+                        b:=te_equal;
+                      end;
+                   end
+                  else
+                   if ((tfiledef(def_from).filetyp = ft_untyped) and
+                       (tfiledef(def_to).filetyp = ft_typed)) or
+                      ((tfiledef(def_from).filetyp = ft_typed) and
+                       (tfiledef(def_to).filetyp = ft_untyped)) then
+                    begin
+                      doconv:=tc_equal;
+                      b:=te_convert_l1;
+                    end;
+                end;
+             end;
+
+           recorddef :
+             begin
+               { interface -> guid }
+               if is_interface(def_from) and
+                  (def_to=rec_tguid) then
+                begin
+                  doconv:=tc_intf_2_guid;
+                  b:=te_convert_l1;
+                end
+               else
+                begin
+                  { assignment overwritten ?? }
+                  if check_operator then
+                   begin
+                     operatorpd:=assignment_overloaded(def_from,def_to);
+                     if assigned(operatorpd) then
+                      b:=te_convert_operator;
+                   end;
+                end;
+             end;
+
+           formaldef :
+             begin
+               if (def_from.deftype=formaldef) then
+                 b:=te_equal
+               else
+                { Just about everything can be converted to a formaldef...}
+                if not (def_from.deftype in [abstractdef,errordef]) then
+                  b:=te_convert_l1
+               else
+                 begin
+                   { assignment overwritten ?? }
+                   if check_operator then
+                    begin
+                      operatorpd:=assignment_overloaded(def_from,def_to);
+                      if assigned(operatorpd) then
+                       b:=te_convert_operator;
+                    end;
+                 end;
+             end;
+        end;
+
+        { if we didn't find an appropriate type conversion yet, we try the overloaded := operator  }
+        { This is done for variants only yet, maybe we should do this for other types as well (FK) }
+        if (b=te_incompatible) and
+           check_operator and
+           ((def_from.deftype in [variantdef]) or
+            (def_to.deftype in [variantdef])) then
+          begin
+            operatorpd:=assignment_overloaded(def_from,def_to);
+            if assigned(operatorpd) then
+             b:=te_convert_operator;
+          end;
+        compare_defs_ext:=b;
+      end;
+
+
+    function equal_defs(def_from,def_to:tdef):boolean;
+      var
+        convtyp : tconverttype;
+        pd : tprocdef;
+      begin
+        { Compare defs with nothingn and no explicit typecasts and
+          searching for overloaded operators is not needed }
+        equal_defs:=(compare_defs_ext(def_from,def_to,nothingn,false,false,convtyp,pd)>=te_equal);
+      end;
+
+
+    function compare_defs(def_from,def_to:tdef;fromtreetype:tnodetype):tequaltype;
+      var
+        doconv : tconverttype;
+        pd : tprocdef;
+      begin
+        compare_defs:=compare_defs_ext(def_from,def_to,fromtreetype,false,true,doconv,pd);
+      end;
+
+
+    function is_subequal(def1, def2: tdef): boolean;
+      var
+         basedef1,basedef2 : tenumdef;
+
+      Begin
+        is_subequal := false;
+        if assigned(def1) and assigned(def2) then
+         Begin
+           if (def1.deftype = orddef) and (def2.deftype = orddef) then
+            Begin
+              { see p.47 of Turbo Pascal 7.01 manual for the separation of types }
+              { range checking for case statements is done with testrange        }
+              case torddef(def1).typ of
+                u8bit,u16bit,u32bit,u64bit,
+                s8bit,s16bit,s32bit,s64bit :
+                  is_subequal:=(torddef(def2).typ in [s64bit,u64bit,s32bit,u32bit,u8bit,s8bit,s16bit,u16bit]);
+                bool8bit,bool16bit,bool32bit :
+                  is_subequal:=(torddef(def2).typ in [bool8bit,bool16bit,bool32bit]);
+                uchar :
+                  is_subequal:=(torddef(def2).typ=uchar);
+                uwidechar :
+                  is_subequal:=(torddef(def2).typ=uwidechar);
+              end;
+            end
+           else
+            Begin
+              { Check if both basedefs are equal }
+              if (def1.deftype=enumdef) and (def2.deftype=enumdef) then
+                Begin
+                   { get both basedefs }
+                   basedef1:=tenumdef(def1);
+                   while assigned(basedef1.basedef) do
+                     basedef1:=basedef1.basedef;
+                   basedef2:=tenumdef(def2);
+                   while assigned(basedef2.basedef) do
+                     basedef2:=basedef2.basedef;
+                   is_subequal:=(basedef1=basedef2);
+                end;
+            end;
+         end;
+      end;
+
+
+    function compare_paras(paralist1,paralist2 : TLinkedList; acp : compare_type;allowdefaults:boolean):tequaltype;
+      var
+        def1,def2 : TParaItem;
+        eq,lowesteq : tequaltype;
+      begin
+         compare_paras:=te_incompatible;
+         { we need to parse the list from left-right so the
+           not-default parameters are checked first }
+         lowesteq:=high(tequaltype);
+         def1:=TParaItem(paralist1.last);
+         def2:=TParaItem(paralist2.last);
+         while (assigned(def1)) and (assigned(def2)) do
+           begin
+             eq:=te_incompatible;
+             case acp of
+               cp_value_equal_const :
+                 begin
+                    if (
+                        (def1.paratyp<>def2.paratyp) and
+                        ((def1.paratyp in [vs_var,vs_out]) or
+                         (def2.paratyp in [vs_var,vs_out]))
+                       ) then
+                      exit;
+                 end;
+               cp_all,cp_procvar :
+                 begin
+                    if (def1.paratyp<>def2.paratyp) then
+                      exit;
+                 end;
+              end;
+              { check type }
+              eq:=compare_defs(def1.paratype.def,def2.paratype.def,nothingn);
+              if eq=te_incompatible then
+                exit;
+              if eq<lowesteq then
+                lowesteq:=eq;
+              { also check default value if both have it declared }
+              if assigned(def1.defaultvalue) and
+                 assigned(def2.defaultvalue) then
+               begin
+                 if not equal_constsym(tconstsym(def1.defaultvalue),tconstsym(def2.defaultvalue)) then
+                   exit;
+               end;
+              def1:=TParaItem(def1.previous);
+              def2:=TParaItem(def2.previous);
+           end;
+         { when both lists are empty then the parameters are equal. Also
+           when one list is empty and the other has a parameter with default
+           value assigned then the parameters are also equal }
+         if ((def1=nil) and (def2=nil)) or
+            (allowdefaults and
+             ((assigned(def1) and assigned(def1.defaultvalue)) or
+              (assigned(def2) and assigned(def2.defaultvalue)))) then
+           compare_paras:=lowesteq;
+      end;
+
+
+    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef):tequaltype;
+      const
+        po_comp = po_compatibility_options-[po_methodpointer,po_classmethod];
+      var
+        ismethod : boolean;
+      begin
+         proc_to_procvar_equal:=te_incompatible;
+         if not(assigned(def1)) or not(assigned(def2)) then
+           exit;
+         { check for method pointer }
+         if def1.deftype=procvardef then
+          begin
+            ismethod:=(po_methodpointer in def1.procoptions);
+          end
+         else
+          begin
+            ismethod:=assigned(def1.owner) and
+                      (def1.owner.symtabletype=objectsymtable);
+          end;
+         if (ismethod and not (po_methodpointer in def2.procoptions)) or
+            (not(ismethod) and (po_methodpointer in def2.procoptions)) then
+          begin
+            Message(type_e_no_method_and_procedure_not_compatible);
+            exit;
+          end;
+         { check return value and options, methodpointer is already checked }
+         if ((po_comp * def1.procoptions)= (po_comp * def2.procoptions)) and
+            equal_defs(def1.rettype.def,def2.rettype.def) and
+            (def1.para_size(target_info.alignment.paraalign)=def2.para_size(target_info.alignment.paraalign)) then
+          begin
+            { return equal type based on the parameters }
+            proc_to_procvar_equal:=compare_paras(def1.para,def2.para,cp_procvar,false);
+          end;
+      end;
+
+
+    function is_equal(def1,def2 : tdef) : boolean;
+      var
+        doconv : tconverttype;
+        hpd : tprocdef;
+      begin
+        is_equal:=(compare_defs_ext(def1,def2,nothingn,false,true,doconv,hpd)>=te_equal);
+      end;
+
+
+    function equal_paras(paralist1,paralist2 : TLinkedList; acp : compare_type;allowdefaults:boolean) : boolean;
+      begin
+        equal_paras:=(compare_paras(paralist1,paralist2,acp,allowdefaults)>=te_equal);
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2002-11-25 17:43:16  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
+
+}

compiler/defutil.pas

@@ -0,0 +1,928 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    This unit provides some help routines for type handling
+
+    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 defutil;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+       cclasses,
+       cpuinfo,
+       globals,
+       node,
+       symconst,symbase,symtype,symdef;
+
+    type
+       tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
+                   mmxu32bit,mmxs32bit,mmxfixed16,mmxsingle);
+
+    const
+       {# true if we must never copy this parameter }
+       never_copy_const_param : boolean = false;
+
+{*****************************************************************************
+                          Basic type functions
+ *****************************************************************************}
+
+    {# Returns true, if definition defines an ordinal type }
+    function is_ordinal(def : tdef) : boolean;
+
+    {# Returns the minimal integer value of the type }
+    function get_min_value(def : tdef) : TConstExprInt;
+
+    {# Returns basetype of the specified integer range }
+    function range_to_basetype(low,high:TConstExprInt):tbasetype;
+
+    {# Returns true, if definition defines an integer type }
+    function is_integer(def : tdef) : boolean;
+
+    {# Returns true if definition is a boolean }
+    function is_boolean(def : tdef) : boolean;
+
+    {# Returns true if definition is a char
+
+       This excludes the unicode char.
+    }
+    function is_char(def : tdef) : boolean;
+
+    {# Returns true if definition is a widechar }
+    function is_widechar(def : tdef) : boolean;
+
+    {# Returns true if definition is a void}
+    function is_void(def : tdef) : boolean;
+
+    {# Returns true if definition is a smallset}
+    function is_smallset(p : tdef) : boolean;
+
+    {# Returns true, if def defines a signed data type
+       (only for ordinal types)
+    }
+    function is_signed(def : tdef) : boolean;
+
+    {# Returns true whether def_from's range is comprised in def_to's if both are
+      orddefs, false otherwise                                              }
+    function is_in_limit(def_from,def_to : tdef) : boolean;
+
+    function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;
+
+{*****************************************************************************
+                              Array helper functions
+ *****************************************************************************}
+
+    {# Returns true, if p points to a zero based (non special like open or
+      dynamic array def).
+
+      This is mainly used to see if the array
+      is convertable to a pointer
+    }
+    function is_zero_based_array(p : tdef) : boolean;
+
+    {# Returns true if p points to an open array definition }
+    function is_open_array(p : tdef) : boolean;
+
+    {# Returns true if p points to a dynamic array definition }
+    function is_dynamic_array(p : tdef) : boolean;
+
+    {# Returns true, if p points to an array of const definition }
+    function is_array_constructor(p : tdef) : boolean;
+
+    {# Returns true, if p points to a variant array }
+    function is_variant_array(p : tdef) : boolean;
+
+    {# Returns true, if p points to an array of const }
+    function is_array_of_const(p : tdef) : boolean;
+
+    {# Returns true, if p points any kind of special array
+
+       That is if the array is an open array, a variant
+       array, an array constants constructor, or an
+       array of const.
+    }
+    function is_special_array(p : tdef) : boolean;
+
+    {# Returns true if p is a char array def }
+    function is_chararray(p : tdef) : boolean;
+
+    {# Returns true if p is a wide char array def }
+    function is_widechararray(p : tdef) : boolean;
+
+{*****************************************************************************
+                          String helper functions
+ *****************************************************************************}
+
+    {# Returns true if p points to an open string type }
+    function is_open_string(p : tdef) : boolean;
+
+    {# Returns true if p is an ansi string type }
+    function is_ansistring(p : tdef) : boolean;
+
+    {# Returns true if p is a long string type }
+    function is_longstring(p : tdef) : boolean;
+
+    {# returns true if p is a wide string type }
+    function is_widestring(p : tdef) : boolean;
+
+    {# Returns true if p is a short string type }
+    function is_shortstring(p : tdef) : boolean;
+
+    {# Returns true if p is a pchar def }
+    function is_pchar(p : tdef) : boolean;
+
+    {# Returns true if p is a pwidechar def }
+    function is_pwidechar(p : tdef) : boolean;
+
+    {# Returns true if p is a voidpointer def }
+    function is_voidpointer(p : tdef) : boolean;
+
+    {# Returns true, if definition is a float }
+    function is_fpu(def : tdef) : boolean;
+
+    {# Returns true, if def is a currency type }
+    function is_currency(def : tdef) : boolean;
+
+    {# Returns true, if def is a 64 bit integer type }
+    function is_64bitint(def : tdef) : boolean;
+
+    {# If @var(l) isn't in the range of def a range check error (if not explicit) is generated and
+      the value is placed within the range
+    }
+    procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
+
+    {# Returns the range of def, where @var(l) is the low-range and @var(h) is
+      the high-range.
+    }
+    procedure getrange(def : tdef;var l : TConstExprInt;var h : TConstExprInt);
+
+    { some type helper routines for MMX support }
+    function is_mmx_able_array(p : tdef) : boolean;
+
+    {# returns the mmx type }
+    function mmx_type(p : tdef) : tmmxtype;
+
+
+implementation
+
+    uses
+       globtype,tokens,systems,verbose,
+       symtable;
+
+    { returns true, if def uses FPU }
+    function is_fpu(def : tdef) : boolean;
+      begin
+         is_fpu:=(def.deftype=floatdef);
+      end;
+
+
+    { returns true, if def is a currency type }
+    function is_currency(def : tdef) : boolean;
+      begin
+         is_currency:=(def.deftype=floatdef) and (tfloatdef(def).typ=s64currency);
+      end;
+
+
+      function range_to_basetype(low,high:TConstExprInt):tbasetype;
+      begin
+        { generate a unsigned range if high<0 and low>=0 }
+        if (low>=0) and (high<0) then
+         range_to_basetype:=u32bit
+        else if (low>=0) and (high<=255) then
+         range_to_basetype:=u8bit
+        else if (low>=-128) and (high<=127) then
+         range_to_basetype:=s8bit
+        else if (low>=0) and (high<=65536) then
+         range_to_basetype:=u16bit
+        else if (low>=-32768) and (high<=32767) then
+         range_to_basetype:=s16bit
+        else
+         range_to_basetype:=s32bit;
+      end;
+
+
+    { true if p is an ordinal }
+    function is_ordinal(def : tdef) : boolean;
+      var
+         dt : tbasetype;
+      begin
+         case def.deftype of
+           orddef :
+             begin
+               dt:=torddef(def).typ;
+               is_ordinal:=dt in [uchar,uwidechar,
+                                  u8bit,u16bit,u32bit,u64bit,
+                                  s8bit,s16bit,s32bit,s64bit,
+                                  bool8bit,bool16bit,bool32bit];
+             end;
+           enumdef :
+             is_ordinal:=true;
+           else
+             is_ordinal:=false;
+         end;
+      end;
+
+
+    { returns the min. value of the type }
+    function get_min_value(def : tdef) : TConstExprInt;
+      begin
+         case def.deftype of
+           orddef:
+             get_min_value:=torddef(def).low;
+           enumdef:
+             get_min_value:=tenumdef(def).min;
+           else
+             get_min_value:=0;
+         end;
+      end;
+
+
+    { true if p is an integer }
+    function is_integer(def : tdef) : boolean;
+      begin
+        is_integer:=(def.deftype=orddef) and
+                    (torddef(def).typ in [u8bit,u16bit,u32bit,u64bit,
+                                          s8bit,s16bit,s32bit,s64bit]);
+      end;
+
+
+    { true if p is a boolean }
+    function is_boolean(def : tdef) : boolean;
+      begin
+        is_boolean:=(def.deftype=orddef) and
+                    (torddef(def).typ in [bool8bit,bool16bit,bool32bit]);
+      end;
+
+
+    { true if p is a void }
+    function is_void(def : tdef) : boolean;
+      begin
+        is_void:=(def.deftype=orddef) and
+                 (torddef(def).typ=uvoid);
+      end;
+
+
+    { true if p is a char }
+    function is_char(def : tdef) : boolean;
+      begin
+        is_char:=(def.deftype=orddef) and
+                 (torddef(def).typ=uchar);
+      end;
+
+
+    { true if p is a wchar }
+    function is_widechar(def : tdef) : boolean;
+      begin
+        is_widechar:=(def.deftype=orddef) and
+                 (torddef(def).typ=uwidechar);
+      end;
+
+
+    { true if p is signed (integer) }
+    function is_signed(def : tdef) : boolean;
+      var
+         dt : tbasetype;
+      begin
+         case def.deftype of
+           orddef :
+             begin
+               dt:=torddef(def).typ;
+               is_signed:=(dt in [s8bit,s16bit,s32bit,s64bit]);
+             end;
+           enumdef :
+             is_signed:=tenumdef(def).min < 0;
+           arraydef :
+             is_signed:=is_signed(tarraydef(def).rangetype.def);
+           else
+             is_signed:=false;
+         end;
+      end;
+
+
+    function is_in_limit(def_from,def_to : tdef) : boolean;
+
+      var
+        fromqword, toqword: boolean;
+
+      begin
+         if (def_from.deftype <> orddef) or
+            (def_to.deftype <> orddef) then
+           begin
+             is_in_limit := false;
+             exit;
+           end;
+         fromqword := torddef(def_from).typ = u64bit;
+         toqword := torddef(def_to).typ = u64bit;
+         is_in_limit:=(toqword and is_signed(def_from)) or
+                      ((not fromqword) and
+                       (torddef(def_from).low>=torddef(def_to).low) and
+                       (torddef(def_from).high<=torddef(def_to).high));
+      end;
+
+
+    function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;
+
+      begin
+         if (def_from.deftype <> orddef) and
+            (def_to.deftype <> orddef) then
+           internalerror(200210062);
+         if (torddef(def_to).typ = u64bit) then
+          begin
+            is_in_limit_value:=((TConstExprUInt(val_from)>=TConstExprUInt(torddef(def_to).low)) and
+                                (TConstExprUInt(val_from)<=TConstExprUInt(torddef(def_to).high)));
+          end
+         else
+          begin;
+            is_in_limit_value:=((val_from>=torddef(def_to).low) and
+                                (val_from<=torddef(def_to).high));
+          end;
+      end;
+
+
+    { true, if p points to an open array def }
+    function is_open_string(p : tdef) : boolean;
+      begin
+         is_open_string:=(p.deftype=stringdef) and
+                         (tstringdef(p).string_typ=st_shortstring) and
+                         (tstringdef(p).len=0);
+      end;
+
+
+    { true, if p points to a zero based array def }
+    function is_zero_based_array(p : tdef) : boolean;
+      begin
+         is_zero_based_array:=(p.deftype=arraydef) and
+                              (tarraydef(p).lowrange=0) and
+                              not(is_special_array(p));
+      end;
+
+    { true if p points to a dynamic array def }
+    function is_dynamic_array(p : tdef) : boolean;
+      begin
+         is_dynamic_array:=(p.deftype=arraydef) and
+           tarraydef(p).IsDynamicArray;
+      end;
+
+
+    { true, if p points to an open array def }
+    function is_open_array(p : tdef) : boolean;
+      begin
+         { check for s32bittype is needed, because for u32bit the high
+           range is also -1 ! (PFV) }
+         is_open_array:=(p.deftype=arraydef) and
+                        (tarraydef(p).rangetype.def=s32bittype.def) and
+                        (tarraydef(p).lowrange=0) and
+                        (tarraydef(p).highrange=-1) and
+                        not(tarraydef(p).IsConstructor) and
+                        not(tarraydef(p).IsVariant) and
+                        not(tarraydef(p).IsArrayOfConst) and
+                        not(tarraydef(p).IsDynamicArray);
+
+      end;
+
+    { true, if p points to an array of const def }
+    function is_array_constructor(p : tdef) : boolean;
+      begin
+         is_array_constructor:=(p.deftype=arraydef) and
+                        (tarraydef(p).IsConstructor);
+      end;
+
+    { true, if p points to a variant array }
+    function is_variant_array(p : tdef) : boolean;
+      begin
+         is_variant_array:=(p.deftype=arraydef) and
+                        (tarraydef(p).IsVariant);
+      end;
+
+    { true, if p points to an array of const }
+    function is_array_of_const(p : tdef) : boolean;
+      begin
+         is_array_of_const:=(p.deftype=arraydef) and
+                        (tarraydef(p).IsArrayOfConst);
+      end;
+
+    { true, if p points to a special array }
+    function is_special_array(p : tdef) : boolean;
+      begin
+         is_special_array:=(p.deftype=arraydef) and
+                        ((tarraydef(p).IsVariant) or
+                         (tarraydef(p).IsArrayOfConst) or
+                         (tarraydef(p).IsConstructor) or
+                         is_open_array(p)
+                        );
+      end;
+
+    { true if p is an ansi string def }
+    function is_ansistring(p : tdef) : boolean;
+      begin
+         is_ansistring:=(p.deftype=stringdef) and
+                        (tstringdef(p).string_typ=st_ansistring);
+      end;
+
+
+    { true if p is an long string def }
+    function is_longstring(p : tdef) : boolean;
+      begin
+         is_longstring:=(p.deftype=stringdef) and
+                        (tstringdef(p).string_typ=st_longstring);
+      end;
+
+
+    { true if p is an wide string def }
+    function is_widestring(p : tdef) : boolean;
+      begin
+         is_widestring:=(p.deftype=stringdef) and
+                        (tstringdef(p).string_typ=st_widestring);
+      end;
+
+
+    { true if p is an short string def }
+    function is_shortstring(p : tdef) : boolean;
+      begin
+         is_shortstring:=(p.deftype=stringdef) and
+                         (tstringdef(p).string_typ=st_shortstring);
+      end;
+
+    { true if p is a char array def }
+    function is_chararray(p : tdef) : boolean;
+      begin
+        is_chararray:=(p.deftype=arraydef) and
+                      is_char(tarraydef(p).elementtype.def) and
+                      not(is_special_array(p));
+      end;
+
+    { true if p is a widechar array def }
+    function is_widechararray(p : tdef) : boolean;
+      begin
+        is_widechararray:=(p.deftype=arraydef) and
+                          is_widechar(tarraydef(p).elementtype.def) and
+                          not(is_special_array(p));
+      end;
+
+
+    { true if p is a pchar def }
+    function is_pchar(p : tdef) : boolean;
+      begin
+        is_pchar:=(p.deftype=pointerdef) and
+                  (is_char(tpointerdef(p).pointertype.def) or
+                   (is_zero_based_array(tpointerdef(p).pointertype.def) and
+                    is_chararray(tpointerdef(p).pointertype.def)));
+      end;
+
+    { true if p is a pchar def }
+    function is_pwidechar(p : tdef) : boolean;
+      begin
+        is_pwidechar:=(p.deftype=pointerdef) and
+                      (is_widechar(tpointerdef(p).pointertype.def) or
+                       (is_zero_based_array(tpointerdef(p).pointertype.def) and
+                        is_widechararray(tpointerdef(p).pointertype.def)));
+      end;
+
+
+    { true if p is a voidpointer def }
+    function is_voidpointer(p : tdef) : boolean;
+      begin
+        is_voidpointer:=(p.deftype=pointerdef) and
+                        (tpointerdef(p).pointertype.def.deftype=orddef) and
+                        (torddef(tpointerdef(p).pointertype.def).typ=uvoid);
+      end;
+
+
+    { true if p is a smallset def }
+    function is_smallset(p : tdef) : boolean;
+      begin
+        is_smallset:=(p.deftype=setdef) and
+                     (tsetdef(p).settype=smallset);
+      end;
+
+
+    { true, if def is a 64 bit int type }
+    function is_64bitint(def : tdef) : boolean;
+      begin
+         is_64bitint:=(def.deftype=orddef) and (torddef(def).typ in [u64bit,s64bit])
+      end;
+
+
+    { if l isn't in the range of def a range check error (if not explicit) is generated and
+      the value is placed within the range }
+    procedure testrange(def : tdef;var l : tconstexprint;explicit:boolean);
+      var
+         lv,hv: TConstExprInt;
+         error: boolean;
+      begin
+         error := false;
+         { for 64 bit types we need only to check if it is less than }
+         { zero, if def is a qword node                              }
+         if is_64bitint(def) then
+           begin
+              if (l<0) and (torddef(def).typ=u64bit) then
+                begin
+                   { don't zero the result, because it may come from hex notation
+                     like $ffffffffffffffff! (JM)
+                   l:=0; }
+                   if not explicit then
+                    begin
+                      if (cs_check_range in aktlocalswitches) then
+                        Message(parser_e_range_check_error)
+                      else
+                        Message(parser_w_range_check_error);
+                    end;
+                   error := true;
+                end;
+           end
+         else
+           begin
+              getrange(def,lv,hv);
+              if (def.deftype=orddef) and
+                 (torddef(def).typ=u32bit) then
+                begin
+                  if (l < cardinal(lv)) or
+                     (l > cardinal(hv)) then
+                    begin
+                      if not explicit then
+                       begin
+                         if (cs_check_range in aktlocalswitches) then
+                           Message(parser_e_range_check_error)
+                         else
+                           Message(parser_w_range_check_error);
+                       end;
+                      error := true;
+                    end;
+                end
+              else if (l<lv) or (l>hv) then
+                begin
+                   if not explicit then
+                    begin
+                      if ((def.deftype=enumdef) and
+                          { delphi allows range check errors in
+                           enumeration type casts FK }
+                          not(m_delphi in aktmodeswitches)) or
+                         (cs_check_range in aktlocalswitches) then
+                        Message(parser_e_range_check_error)
+                      else
+                        Message(parser_w_range_check_error);
+                    end;
+                   error := true;
+                end;
+           end;
+         if error then
+          begin
+             { Fix the value to fit in the allocated space for this type of variable }
+             case def.size of
+               1: l := l and $ff;
+               2: l := l and $ffff;
+               { work around sign extension bug (to be fixed) (JM) }
+               4: l := l and (int64($fffffff) shl 4 + $f);
+             end;
+             { do sign extension if necessary (JM) }
+             if is_signed(def) then
+              begin
+                case def.size of
+                  1: l := shortint(l);
+                  2: l := smallint(l);
+                  4: l := longint(l);
+                end;
+              end;
+          end;
+      end;
+
+
+    { return the range from def in l and h }
+    procedure getrange(def : tdef;var l : TConstExprInt;var h : TConstExprInt);
+      begin
+        case def.deftype of
+          orddef :
+            begin
+              l:=torddef(def).low;
+              h:=torddef(def).high;
+            end;
+          enumdef :
+            begin
+              l:=tenumdef(def).min;
+              h:=tenumdef(def).max;
+            end;
+          arraydef :
+            begin
+              l:=tarraydef(def).lowrange;
+              h:=tarraydef(def).highrange;
+            end;
+        else
+          internalerror(987);
+        end;
+      end;
+
+
+    function mmx_type(p : tdef) : tmmxtype;
+      begin
+         mmx_type:=mmxno;
+         if is_mmx_able_array(p) then
+           begin
+              if tarraydef(p).elementtype.def.deftype=floatdef then
+                case tfloatdef(tarraydef(p).elementtype.def).typ of
+                  s32real:
+                    mmx_type:=mmxsingle;
+                end
+              else
+                case torddef(tarraydef(p).elementtype.def).typ of
+                   u8bit:
+                     mmx_type:=mmxu8bit;
+                   s8bit:
+                     mmx_type:=mmxs8bit;
+                   u16bit:
+                     mmx_type:=mmxu16bit;
+                   s16bit:
+                     mmx_type:=mmxs16bit;
+                   u32bit:
+                     mmx_type:=mmxu32bit;
+                   s32bit:
+                     mmx_type:=mmxs32bit;
+                end;
+           end;
+      end;
+
+
+    function is_mmx_able_array(p : tdef) : boolean;
+      begin
+{$ifdef SUPPORT_MMX}
+         if (cs_mmx_saturation in aktlocalswitches) then
+           begin
+              is_mmx_able_array:=(p.deftype=arraydef) and
+                not(is_special_array(p)) and
+                (
+                 (
+                  (tarraydef(p).elementtype.def.deftype=orddef) and
+                  (
+                   (
+                    (tarraydef(p).lowrange=0) and
+                    (tarraydef(p).highrange=1) and
+                    (torddef(tarraydef(p).elementtype.def).typ in [u32bit,s32bit])
+                   )
+                   or
+                   (
+                    (tarraydef(p).lowrange=0) and
+                    (tarraydef(p).highrange=3) and
+                    (torddef(tarraydef(p).elementtype.def).typ in [u16bit,s16bit])
+                   )
+                  )
+                 )
+                 or
+                (
+                 (
+                  (tarraydef(p).elementtype.def.deftype=floatdef) and
+                  (
+                   (tarraydef(p).lowrange=0) and
+                   (tarraydef(p).highrange=1) and
+                   (tfloatdef(tarraydef(p).elementtype.def).typ=s32real)
+                  )
+                 )
+                )
+              );
+           end
+         else
+           begin
+              is_mmx_able_array:=(p.deftype=arraydef) and
+                (
+                 (
+                  (tarraydef(p).elementtype.def.deftype=orddef) and
+                  (
+                   (
+                    (tarraydef(p).lowrange=0) and
+                    (tarraydef(p).highrange=1) and
+                    (torddef(tarraydef(p).elementtype.def).typ in [u32bit,s32bit])
+                   )
+                   or
+                   (
+                    (tarraydef(p).lowrange=0) and
+                    (tarraydef(p).highrange=3) and
+                    (torddef(tarraydef(p).elementtype.def).typ in [u16bit,s16bit])
+                   )
+                   or
+                   (
+                    (tarraydef(p).lowrange=0) and
+                    (tarraydef(p).highrange=7) and
+                    (torddef(tarraydef(p).elementtype.def).typ in [u8bit,s8bit])
+                   )
+                  )
+                 )
+                 or
+                 (
+                  (tarraydef(p).elementtype.def.deftype=floatdef) and
+                  (
+                   (tarraydef(p).lowrange=0) and
+                   (tarraydef(p).highrange=1) and
+                   (tfloatdef(tarraydef(p).elementtype.def).typ=s32real)
+                  )
+                 )
+                );
+           end;
+{$else SUPPORT_MMX}
+         is_mmx_able_array:=false;
+{$endif SUPPORT_MMX}
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2002-11-25 17:43:17  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.26  2002/11/17 16:31:55  carl
+    * memory optimization (3-4%) : cleanup of tai fields,
+       cleanup of tdef and tsym fields.
+    * make it work for m68k
+
+  Revision 1.25  2002/11/16 18:00:53  peter
+    * fix merged proc-procvar check
+
+  Revision 1.24  2002/11/15 01:58:46  peter
+    * merged changes from 1.0.7 up to 04-11
+      - -V option for generating bug report tracing
+      - more tracing for option parsing
+      - errors for cdecl and high()
+      - win32 import stabs
+      - win32 records<=8 are returned in eax:edx (turned off by default)
+      - heaptrc update
+      - more info for temp management in .s file with EXTDEBUG
+
+  Revision 1.23  2002/10/20 15:34:16  peter
+    * removed df_unique flag. It breaks code. For a good type=type <id>
+      a def copy is required
+
+  Revision 1.22  2002/10/10 16:07:57  florian
+    + several widestring/pwidechar related stuff added
+
+  Revision 1.21  2002/10/09 21:01:41  florian
+    * variants aren't compatible with nil
+
+  Revision 1.20  2002/10/07 09:49:42  florian
+    * overloaded :=-operator is now searched when looking for possible
+      variant type conversions
+
+  Revision 1.19  2002/10/06 21:02:17  peter
+    * fixed limit checking for qword
+
+  Revision 1.18  2002/10/06 15:08:59  peter
+    * only check for forwarddefs the definitions that really belong to
+      the current procsym
+
+  Revision 1.17  2002/10/06 12:25:04  florian
+    + proper support of type <id> = type <another id>;
+
+  Revision 1.16  2002/10/05 12:43:24  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.15  2002/10/05 00:50:01  peter
+    * check parameters from left to right in equal_paras, so default
+      parameters are checked at the end
+
+  Revision 1.14  2002/09/30 07:00:44  florian
+    * fixes to common code to get the alpha compiler compiled applied
+
+  Revision 1.13  2002/09/22 14:02:34  carl
+    * stack checking cannot be called before system unit is initialized
+    * MC68020 define
+
+  Revision 1.12  2002/09/16 14:11:12  peter
+    * add argument to equal_paras() to support default values or not
+
+  Revision 1.11  2002/09/15 17:54:46  peter
+    * allow default parameters in equal_paras
+
+  Revision 1.10  2002/09/08 11:10:17  carl
+    * bugfix 2109 (bad imho, but only way)
+
+  Revision 1.9  2002/09/07 15:25:02  peter
+    * old logs removed and tabs fixed
+
+  Revision 1.8  2002/09/07 09:16:55  carl
+    * fix my stupid copy and paste bug
+
+  Revision 1.7  2002/09/06 19:58:31  carl
+   * start bugfix 1996
+   * 64-bit typed constant now work correctly and fully (bugfix 2001)
+
+  Revision 1.6  2002/08/20 10:31:26  daniel
+   * Tcallnode.det_resulttype rewritten
+
+  Revision 1.5  2002/08/12 20:39:17  florian
+    * casting of classes to interface fixed when the interface was
+      implemented by a parent class
+
+  Revision 1.4  2002/08/12 14:17:56  florian
+    * nil is now recognized as being compatible with a dynamic array
+
+  Revision 1.3  2002/08/05 18:27:48  carl
+    + more more more documentation
+    + first version include/exclude (can't test though, not enough scratch for i386 :()...
+
+  Revision 1.2  2002/07/23 09:51:22  daniel
+  * Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
+    are worth comitting.
+
+  Revision 1.1  2002/07/20 11:57:53  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.75  2002/07/11 14:41:32  florian
+    * start of the new generic parameter handling
+
+  Revision 1.74  2002/07/01 16:23:54  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.73  2002/05/18 13:34:21  peter
+    * readded missing revisions
+
+  Revision 1.72  2002/05/16 19:46:47  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.70  2002/05/12 16:53:16  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.69  2002/04/25 20:16:39  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.68  2002/04/15 19:08:22  carl
+  + target_info.size_of_pointer -> pointer_size
+  + some cleanup of unused types/variables
+
+  Revision 1.67  2002/04/07 13:40:29  carl
+  + update documentation
+
+  Revision 1.66  2002/04/02 17:11:32  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.65  2002/04/01 20:57:14  jonas
+    * fixed web bug 1907
+    * fixed some other procvar related bugs (all related to accepting procvar
+        constructs with either too many or too little parameters)
+    (both merged, includes second typo fix of pexpr.pas)
+
+  Revision 1.64  2002/01/24 18:25:53  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.63  2002/01/24 12:33:53  jonas
+    * adapted ranges of native types to int64 (e.g. high cardinal is no
+      longer longint($ffffffff), but just $fffffff in psystem)
+    * small additional fix in 64bit rangecheck code generation for 32 bit
+      processors
+    * adaption of ranges required the matching talgorithm used for selecting
+      which overloaded procedure to call to be adapted. It should now always
+      select the closest match for ordinal parameters.
+    + inttostr(qword) in sysstr.inc/sysstrh.inc
+    + abs(int64), sqr(int64), sqr(qword) in systemh.inc/generic.inc (previous
+      fixes were required to be able to add them)
+    * is_in_limit() moved from ncal to types unit, should always be used
+      instead of direct comparisons of low/high values of orddefs because
+      qword is a special case
+
+}

compiler/htypechk.pas

@@ -126,7 +126,7 @@ implementation
        globtype,systems,
        cutils,verbose,globals,
        symconst,symsym,symtable,
-       defbase,cpubase,
+       defutil,defcmp,cpubase,
        ncnv,nld,
        nmem,ncal,nmat,
        cgbase
@@ -975,7 +975,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.50  2002-10-07 20:12:08  peter
+  Revision 1.51  2002-11-25 17:43:17  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.50  2002/10/07 20:12:08  peter
     * ugly hack to fix tb0411
 
   Revision 1.49  2002/10/05 00:47:03  peter

compiler/i386/cgcpu.pas

@@ -55,7 +55,7 @@ unit cgcpu;
 
     uses
        globtype,globals,verbose,systems,cutils,
-       symdef,symsym,defbase,paramgr,
+       symdef,symsym,defutil,paramgr,
        rgobj,tgobj,rgcpu;
 
 
@@ -174,7 +174,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.31  2002-10-05 12:43:29  carl
+  Revision 1.32  2002-11-25 17:43:26  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.31  2002/10/05 12:43:29  carl
     * fixes for Delphi 6 compilation
      (warning : Some features do not work under Delphi)
 

compiler/i386/n386add.pas

@@ -57,7 +57,7 @@ interface
       globtype,systems,
       cutils,verbose,globals,
       symconst,symdef,paramgr,
-      aasmbase,aasmtai,aasmcpu,defbase,htypechk,
+      aasmbase,aasmtai,aasmcpu,defutil,htypechk,
       cgbase,pass_2,regvars,
       cpupara,
       ncon,nset,
@@ -1553,7 +1553,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.51  2002-11-15 01:58:56  peter
+  Revision 1.52  2002-11-25 17:43:26  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.51  2002/11/15 01:58:56  peter
     * merged changes from 1.0.7 up to 04-11
       - -V option for generating bug report tracing
       - more tracing for option parsing

compiler/i386/n386cal.pas

@@ -50,7 +50,7 @@ implementation
     uses
       systems,
       cutils,verbose,globals,
-      symconst,symbase,symsym,symtable,defbase,
+      symconst,symbase,symsym,symtable,defutil,
 {$ifdef GDB}
   {$ifdef delphi}
       sysutils,
@@ -1242,7 +1242,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.75  2002-11-18 17:32:00  peter
+  Revision 1.76  2002-11-25 17:43:26  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.75  2002/11/18 17:32:00  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.74  2002/11/15 01:58:57  peter

compiler/i386/n386cnv.pas

@@ -27,7 +27,7 @@ unit n386cnv;
 interface
 
     uses
-      node,ncgcnv,defbase;
+      node,ncgcnv,defutil,defcmp;
 
     type
        ti386typeconvnode = class(tcgtypeconvnode)
@@ -413,7 +413,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.51  2002-10-10 16:14:54  florian
+  Revision 1.52  2002-11-25 17:43:26  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.51  2002/10/10 16:14:54  florian
     * fixed to reflect last tconvtype change
 
   Revision 1.50  2002/10/05 12:43:29  carl

compiler/i386/n386inl.pas

@@ -62,7 +62,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,fmodule,
-      symconst,symdef,defbase,
+      symconst,symdef,defutil,
       aasmbase,aasmtai,aasmcpu,
       cginfo,cgbase,pass_1,pass_2,
       cpubase,paramgr,
@@ -328,7 +328,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.53  2002-09-07 15:25:10  peter
+  Revision 1.54  2002-11-25 17:43:26  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.53  2002/09/07 15:25:10  peter
     * old logs removed and tabs fixed
 
   Revision 1.52  2002/08/02 07:44:31  jonas

compiler/i386/n386mat.pas

@@ -54,7 +54,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symdef,aasmbase,aasmtai,aasmcpu,defbase,
+      symconst,symdef,aasmbase,aasmtai,aasmcpu,defutil,
       cginfo,cgbase,pass_1,pass_2,
       ncon,
       cpubase,cpuinfo,
@@ -838,7 +838,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.40  2002-09-07 15:25:10  peter
+  Revision 1.41  2002-11-25 17:43:26  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.40  2002/09/07 15:25:10  peter
     * old logs removed and tabs fixed
 
   Revision 1.39  2002/08/15 15:15:55  carl

compiler/i386/n386mem.pas

@@ -52,7 +52,7 @@ implementation
 {$endif}
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symtype,symdef,symsym,symtable,defbase,paramgr,
+      symconst,symtype,symdef,symsym,symtable,defutil,paramgr,
       aasmbase,aasmtai,aasmcpu,
       cginfo,cgbase,pass_2,
       pass_1,nld,ncon,nadd,
@@ -149,7 +149,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.45  2002-11-23 22:50:09  carl
+  Revision 1.46  2002-11-25 17:43:27  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.45  2002/11/23 22:50:09  carl
     * some small speed optimizations
     + added several new warnings/hints
 

compiler/i386/n386opt.pas

@@ -42,7 +42,7 @@ type
 implementation
 
 uses
-  pass_1, defbase, htypechk,
+  pass_1,defutil,htypechk,
   symdef,paramgr,
   aasmbase,aasmtai,aasmcpu,
   ncnv, ncon, pass_2,
@@ -248,7 +248,12 @@ end.
 
 {
   $Log$
-  Revision 1.25  2002-11-15 01:58:57  peter
+  Revision 1.26  2002-11-25 17:43:27  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.25  2002/11/15 01:58:57  peter
     * merged changes from 1.0.7 up to 04-11
       - -V option for generating bug report tracing
       - more tracing for option parsing

compiler/i386/n386set.pas

@@ -49,7 +49,7 @@ implementation
     uses
       globtype,systems,
       verbose,globals,
-      symconst,symdef,defbase,
+      symconst,symdef,defutil,
       aasmbase,aasmtai,aasmcpu,
       cginfo,cgbase,pass_2,
       ncon,
@@ -706,7 +706,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.44  2002-10-03 21:34:45  carl
+  Revision 1.45  2002-11-25 17:43:27  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.44  2002/10/03 21:34:45  carl
     * range check error fixes
 
   Revision 1.43  2002/09/17 18:54:05  jonas

compiler/i386/radirect.pas

@@ -42,7 +42,7 @@ interface
        { aasm }
        aasmbase,aasmtai,aasmcpu,
        { symtable }
-       symconst,symbase,symtype,symsym,symtable,defbase,paramgr,
+       symconst,symbase,symtype,symsym,symtable,defutil,paramgr,
        { pass 1 }
        nbas,
        { parser }
@@ -304,7 +304,12 @@ initialization
 end.
 {
   $Log$
-  Revision 1.4  2002-11-18 17:32:00  peter
+  Revision 1.5  2002-11-25 17:43:27  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.4  2002/11/18 17:32:00  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.3  2002/09/03 16:26:28  daniel

compiler/m68k/cgcpu.pas

@@ -108,7 +108,7 @@ Implementation
 
     uses
        globtype,globals,verbose,systems,cutils,
-       symdef,symsym,defbase,paramgr,
+       symdef,symsym,defutil,paramgr,
        rgobj,tgobj,rgcpu;
 
 
@@ -1250,7 +1250,12 @@ end.
 
 {
   $Log$
-  Revision 1.11  2002-11-18 17:32:00  peter
+  Revision 1.12  2002-11-25 17:43:27  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.11  2002/11/18 17:32:00  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.10  2002/09/22 14:15:31  carl

compiler/m68k/n68kcnv.pas

@@ -27,7 +27,7 @@ unit n68kcnv;
 interface
 
     uses
-      node,ncnv,ncgcnv,defbase;
+      node,ncnv,ncgcnv,defcmp;
 
     type
        tm68ktypeconvnode = class(tcgtypeconvnode)
@@ -44,6 +44,7 @@ implementation
    uses
       verbose,globals,systems,
       symconst,symdef,aasmbase,aasmtai,
+      defutil,
       cgbase,pass_1,pass_2,
       ncon,ncal,
       ncgutil,
@@ -293,7 +294,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2002-11-09 16:10:35  carl
+  Revision 1.6  2002-11-25 17:43:27  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.5  2002/11/09 16:10:35  carl
     + update for compilation
 
   Revision 1.4  2002/09/07 20:53:28  carl

compiler/nadd.pas

@@ -67,7 +67,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,widestr,
-      symconst,symtype,symdef,symsym,symtable,defbase,
+      symconst,symtype,symdef,symsym,symtable,defutil,defcmp,
       cgbase,
       htypechk,pass_1,
       nbas,nmat,ncnv,ncon,nset,nopt,ncal,ninl,
@@ -238,8 +238,8 @@ implementation
                    else if (nodetype <> subn) and
                            is_voidpointer(ld) then
                      inserttypeconv(left,right.resulttype)
-                   else if not(is_equal(ld,rd)) then
-                     CGMessage(type_e_mismatch);
+                   else if not(equal_defs(ld,rd)) then
+                     CGMessage2(type_e_incompatible_types,ld.typename,rd.typename);
                 end
               else if (lt=ordconstn) and (rt=ordconstn) then
                 begin
@@ -866,14 +866,14 @@ implementation
                          CGMessage(type_w_signed_unsigned_always_false);
                     end
                  else
-                 { give out a warning if types are not of the same sign, and are 
+                 { give out a warning if types are not of the same sign, and are
                    not constants.
                  }
-                 if (((byte(is_signed(rd)) xor byte(is_signed(ld))) and 1)<>0) and 
+                 if (((byte(is_signed(rd)) xor byte(is_signed(ld))) and 1)<>0) and
                       (nodetype in [ltn,gtn,gten,lten,equaln,unequaln]) and (not is_constintnode(left)) and
                       (not is_constintnode(right)) then
                    begin
-                       CGMessage(type_w_mixed_signed_unsigned3); 
+                       CGMessage(type_w_mixed_signed_unsigned3);
                    end;
 
                  inserttypeconv(right,s32bittype);
@@ -896,7 +896,7 @@ implementation
              begin
                if (rt=setelementn) then
                 begin
-                  if not(is_equal(tsetdef(ld).elementtype.def,rd)) then
+                  if not(equal_defs(tsetdef(ld).elementtype.def,rd)) then
                    CGMessage(type_e_set_element_are_not_comp);
                 end
                else
@@ -907,7 +907,7 @@ implementation
                if not(nodetype in [addn,subn,symdifn,muln,equaln,unequaln,lten,gten]) then
                 CGMessage(type_e_set_operation_unknown);
                { right def must be a also be set }
-               if (rd.deftype<>setdef) or not(is_equal(rd,ld)) then
+               if (rd.deftype<>setdef) or not(equal_defs(rd,ld)) then
                 CGMessage(type_e_set_element_are_not_comp);
              end;
 
@@ -996,8 +996,8 @@ implementation
                       inserttypeconv(right,left.resulttype)
                     else if is_voidpointer(left.resulttype.def) then
                       inserttypeconv(left,right.resulttype)
-                    else if not(is_equal(ld,rd)) then
-                      CGMessage(type_e_mismatch);
+                    else if not(equal_defs(ld,rd)) then
+                      CGMessage2(type_e_incompatible_types,ld.typename,rd.typename);
                  end;
                ltn,lten,gtn,gten:
                  begin
@@ -1007,8 +1007,8 @@ implementation
                         inserttypeconv(right,left.resulttype)
                        else if is_voidpointer(left.resulttype.def) then
                         inserttypeconv(left,right.resulttype)
-                       else if not(is_equal(ld,rd)) then
-                        CGMessage(type_e_mismatch);
+                       else if not(equal_defs(ld,rd)) then
+                        CGMessage2(type_e_incompatible_types,ld.typename,rd.typename);
                      end
                     else
                      CGMessage(type_e_mismatch);
@@ -1021,8 +1021,8 @@ implementation
                         inserttypeconv(right,left.resulttype)
                        else if is_voidpointer(left.resulttype.def) then
                         inserttypeconv(left,right.resulttype)
-                       else if not(is_equal(ld,rd)) then
-                        CGMessage(type_e_mismatch);
+                       else if not(equal_defs(ld,rd)) then
+                        CGMessage2(type_e_incompatible_types,ld.typename,rd.typename);
                      end
                     else
                      CGMessage(type_e_mismatch);
@@ -1037,8 +1037,8 @@ implementation
                         inserttypeconv(right,left.resulttype)
                        else if is_voidpointer(left.resulttype.def) then
                         inserttypeconv(left,right.resulttype)
-                       else if not(is_equal(ld,rd)) then
-                        CGMessage(type_e_mismatch);
+                       else if not(equal_defs(ld,rd)) then
+                        CGMessage2(type_e_incompatible_types,ld.typename,rd.typename);
                      end
                     else
                      CGMessage(type_e_mismatch);
@@ -1118,7 +1118,7 @@ implementation
          else if (cs_mmx in aktlocalswitches) and
                  is_mmx_able_array(ld) and
                  is_mmx_able_array(rd) and
-                 is_equal(ld,rd) then
+                 equal_defs(ld,rd) then
             begin
               case nodetype of
                 addn,subn,xorn,orn,andn:
@@ -1179,7 +1179,9 @@ implementation
               CGMessage(type_e_mismatch);
          end
 
-         else if (rd.deftype=procvardef) and (ld.deftype=procvardef) and is_equal(rd,ld) then
+         else if (rd.deftype=procvardef) and
+                 (ld.deftype=procvardef) and
+                 equal_defs(rd,ld) then
           begin
             if not (nodetype in [equaln,unequaln]) then
              CGMessage(type_e_mismatch);
@@ -1188,7 +1190,7 @@ implementation
          { enums }
          else if (ld.deftype=enumdef) and (rd.deftype=enumdef) then
           begin
-            if not(is_equal(ld,rd)) then
+            if not(equal_defs(ld,rd)) then
              inserttypeconv(right,left.resulttype);
             if not(nodetype in [equaln,unequaln,ltn,lten,gtn,gten]) then
              CGMessage(type_e_mismatch);
@@ -1816,7 +1818,9 @@ implementation
               calcregisters(self,1,0,0);
             end
 
-         else  if (rd.deftype=procvardef) and (ld.deftype=procvardef) and is_equal(rd,ld) then
+         else  if (rd.deftype=procvardef) and
+                  (ld.deftype=procvardef) and
+                  equal_defs(rd,ld) then
            begin
              location.loc:=LOC_REGISTER;
              calcregisters(self,1,0,0);
@@ -1887,7 +1891,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.71  2002-11-23 22:50:06  carl
+  Revision 1.72  2002-11-25 17:43:17  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.71  2002/11/23 22:50:06  carl
     * some small speed optimizations
     + added several new warnings/hints
 

compiler/nbas.pas

@@ -173,7 +173,7 @@ implementation
     uses
       cutils,
       verbose,globals,globtype,systems,
-      symconst,symdef,symsym,defbase,
+      symconst,symdef,symsym,defutil,defcmp,
       pass_1,
       nld,ncal,nflw,rgobj,cgbase
       ;
@@ -617,7 +617,7 @@ implementation
         result :=
           inherited docompare(p) and
           (ttempcreatenode(p).size = size) and
-          is_equal(ttempcreatenode(p).tempinfo^.restype.def,tempinfo^.restype.def);
+          equal_defs(ttempcreatenode(p).tempinfo^.restype.def,tempinfo^.restype.def);
       end;
 
 {*****************************************************************************
@@ -767,7 +767,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.36  2002-10-05 15:15:19  peter
+  Revision 1.37  2002-11-25 17:43:17  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.36  2002/10/05 15:15:19  peter
     * don't complain in X- mode for internal generated function calls
       with funcretrefnode set
     * give statement error at the correct line position instead of the

compiler/ncal.pas

@@ -147,7 +147,7 @@ implementation
     uses
       cutils,systems,
       verbose,globals,
-      symconst,paramgr,defbase,
+      symconst,paramgr,defutil,defcmp,
       htypechk,pass_1,cpuinfo,cpubase,
       nbas,ncnv,nld,ninl,nadd,ncon,
       rgobj,cgbase
@@ -352,7 +352,7 @@ implementation
               { passing a single element to a openarray of the same type }
                 not(
                    (is_open_array(to_def) and
-                   is_equal(tarraydef(to_def).elementtype.def,from_def))
+                   equal_defs(tarraydef(to_def).elementtype.def,from_def))
                    ) and
               { an implicit file conversion is also allowed }
               { from a typed file to an untyped one           }
@@ -362,7 +362,7 @@ implementation
                    (tfiledef(to_def).filetyp = ft_untyped) and
                    (tfiledef(from_def).filetyp = ft_typed)
                     ) and
-                not(is_equal(from_def,to_def)));
+                not(equal_defs(from_def,to_def)));
 
     end;
 
@@ -491,11 +491,11 @@ implementation
             is_shortstring(defcoll.paratype.def) and
             (defcoll.paratyp in [vs_out,vs_var]) and
             not(is_open_string(defcoll.paratype.def)) and
-            not(is_equal(left.resulttype.def,defcoll.paratype.def)) then
-            begin
-               aktfilepos:=left.fileinfo;
-               CGMessage(type_e_strict_var_string_violation);
-            end;
+            not(equal_defs(left.resulttype.def,defcoll.paratype.def)) then
+           begin
+             aktfilepos:=left.fileinfo;
+             CGMessage(type_e_strict_var_string_violation);
+           end;
 
          { Handle formal parameters separate }
          if (defcoll.paratype.def.deftype=formaldef) then
@@ -1442,7 +1442,7 @@ implementation
             end;
            { all types can be passed to a formaldef }
            is_equal:=(def.deftype=formaldef) or
-             (defbase.is_equal(p.resulttype.def,def))
+             (defcmp.equal_defs(p.resulttype.def,def))
            { integer constants are compatible with all integer parameters if
              the specified value matches the range }
              or
@@ -1481,7 +1481,7 @@ implementation
              (
               (m_tp_procvar in aktmodeswitches) and
               (def.deftype=procvardef) and (p.left.nodetype=calln) and
-              (proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def),false))
+              (proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def))>=te_equal)
              )
              ;
         end;
@@ -1629,7 +1629,7 @@ implementation
                                       hp:=procs;
                                       while assigned(hp) do
                                        begin
-                                         if equal_paras(hp^.data.para,pd.para,cp_value_equal_const,false) then
+                                         if compare_paras(hp^.data.para,pd.para,cp_value_equal_const,false)>=te_equal then
                                           begin
                                             found:=true;
                                             break;
@@ -1757,8 +1757,17 @@ implementation
                                        (m_tp7 in aktmodeswitches)) then
                                     hp^.nextPara.convertlevel:=0
                                    else
-                                    hp^.nextPara.convertlevel:=isconvertable(pt.resulttype.def,hp^.nextPara.paratype.def,
-                                        hcvt,pt.left.nodetype,false);
+                                    begin
+                                      case compare_defs(pt.resulttype.def,hp^.nextPara.paratype.def,pt.left.nodetype) of
+                                        te_convert_l1 :
+                                          hp^.nextPara.convertlevel:=1;
+                                        te_convert_operator,
+                                        te_convert_l2 :
+                                          hp^.nextPara.convertlevel:=2;
+                                        else
+                                          hp^.nextPara.convertlevel:=0;
+                                      end;
+                                    end;
                                    case hp^.nextPara.convertlevel of
                                     1 : include(pt.callparaflags,cpf_convlevel1found);
                                     2 : include(pt.callparaflags,cpf_convlevel2found);
@@ -1920,7 +1929,7 @@ implementation
                                               is_in_limit(def_to,conv_to) then
                                              begin
                                                 { is it the same as the previous best? }
-                                                if not defbase.is_equal(def_to,conv_to) then
+                                                if not defcmp.equal_defs(def_to,conv_to) then
                                                   begin
                                                     { no -> remove all previous best matches }
                                                     hp := hp^.next;
@@ -2531,7 +2540,7 @@ implementation
           (procdefinition = tcallnode(p).procdefinition) and
           (methodpointer.isequal(tcallnode(p).methodpointer)) and
           ((restypeset and tcallnode(p).restypeset and
-            (is_equal(restype.def,tcallnode(p).restype.def))) or
+            (equal_defs(restype.def,tcallnode(p).restype.def))) or
            (not restypeset and not tcallnode(p).restypeset));
       end;
 
@@ -2655,7 +2664,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.108  2002-11-18 17:31:54  peter
+  Revision 1.109  2002-11-25 17:43:17  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.108  2002/11/18 17:31:54  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.107  2002/11/15 01:58:50  peter

compiler/ncgcal.pas

@@ -61,7 +61,7 @@ implementation
     uses
       systems,
       cutils,verbose,globals,
-      symconst,symbase,symsym,symtable,defbase,paramgr,
+      symconst,symbase,symsym,symtable,defutil,paramgr,
 {$ifdef GDB}
   {$ifdef delphi}
       sysutils,
@@ -1541,7 +1541,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.28  2002-11-18 17:31:54  peter
+  Revision 1.29  2002-11-25 17:43:17  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.28  2002/11/18 17:31:54  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.27  2002/11/16 15:34:30  florian

compiler/ncgcnv.pas

@@ -28,7 +28,7 @@ unit ncgcnv;
 interface
 
     uses
-       node,ncnv,defbase;
+       node,ncnv,defutil,defcmp;
 
     type
        tcgtypeconvnode = class(ttypeconvnode)
@@ -437,7 +437,7 @@ interface
       begin
 {$ifdef fpc}
         {$warning todo: add RTL routine for widechar-char conversion }
-{$endif}        
+{$endif}
         { Quick hack to atleast generate 'working' code (PFV) }
         second_int_to_int;
       end;
@@ -507,7 +507,12 @@ end.
 
 {
   $Log$
-  Revision 1.33  2002-10-05 12:43:25  carl
+  Revision 1.34  2002-11-25 17:43:17  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.33  2002/10/05 12:43:25  carl
     * fixes for Delphi 6 compilation
      (warning : Some features do not work under Delphi)
 

compiler/ncgcon.pas

@@ -65,7 +65,7 @@ implementation
     uses
       globtype,widestr,systems,
       verbose,globals,
-      symconst,symdef,aasmbase,aasmtai,aasmcpu,defbase,
+      symconst,symdef,aasmbase,aasmtai,aasmcpu,defutil,
       cpuinfo,cpubase,
       cginfo,cgbase,tgobj,rgobj
 {$ifdef delphi}
@@ -531,7 +531,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.22  2002-11-09 15:36:50  carl
+  Revision 1.23  2002-11-25 17:43:17  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.22  2002/11/09 15:36:50  carl
     * align all constants correctly (default of 4 size for real type constants)
 
   Revision 1.21  2002/10/06 21:01:50  peter

compiler/ncgflw.pas

@@ -89,7 +89,7 @@ implementation
 
     uses
       verbose,globals,systems,globtype,
-      symconst,symsym,aasmbase,aasmtai,aasmcpu,defbase,
+      symconst,symsym,aasmbase,aasmtai,aasmcpu,defutil,
       cginfo,cgbase,pass_2,
       cpubase,cpuinfo,
       nld,ncon,
@@ -1247,7 +1247,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.43  2002-09-30 07:00:45  florian
+  Revision 1.44  2002-11-25 17:43:17  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/09/30 07:00:45  florian
     * fixes to common code to get the alpha compiler compiled applied
 
   Revision 1.42  2002/09/07 15:25:02  peter

compiler/ncginl.pas

@@ -54,7 +54,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,fmodule,
-      symconst,symdef,defbase,
+      symconst,symdef,defutil,
       aasmbase,aasmtai,aasmcpu,
       cginfo,cgbase,pass_1,pass_2,
       cpubase,paramgr,
@@ -610,7 +610,12 @@ end.
 
 {
   $Log$
-  Revision 1.16  2002-10-05 12:43:25  carl
+  Revision 1.17  2002-11-25 17:43:18  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.16  2002/10/05 12:43:25  carl
     * fixes for Delphi 6 compilation
      (warning : Some features do not work under Delphi)
 

compiler/ncgld.pas

@@ -53,7 +53,7 @@ implementation
     uses
       systems,
       verbose,globtype,globals,
-      symconst,symtype,symdef,symsym,symtable,defbase,paramgr,
+      symconst,symtype,symdef,symsym,symtable,defutil,paramgr,
       ncnv,ncon,nmem,
       aasmbase,aasmtai,aasmcpu,regvars,
       cginfo,cgbase,pass_2,
@@ -989,7 +989,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.39  2002-11-22 16:22:45  jonas
+  Revision 1.40  2002-11-25 17:43:18  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.39  2002/11/22 16:22:45  jonas
     * fixed error in my previous commit (the size of the location of the
       funcretnode must be based on the current resulttype of the node and not
       the resulttype defined by the function; these can be different in case

compiler/ncgmat.pas

@@ -99,7 +99,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symdef,aasmbase,aasmtai,aasmcpu,defbase,
+      symconst,symdef,aasmbase,aasmtai,aasmcpu,defutil,
       pass_1,pass_2,
       ncon,
       cpuinfo,
@@ -454,7 +454,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2002-09-17 18:54:02  jonas
+  Revision 1.5  2002-11-25 17:43:18  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.4  2002/09/17 18:54:02  jonas
     * a_load_reg_reg() now has two size parameters: source and dest. This
       allows some optimizations on architectures that don't encode the
       register size in the register name.

compiler/ncgmem.pas

@@ -95,7 +95,7 @@ implementation
 {$endif GDB}
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symtype,symdef,symsym,symtable,defbase,paramgr,
+      symconst,symtype,symdef,symsym,symtable,defutil,paramgr,
       aasmbase,aasmtai,aasmcpu,
       cginfo,cgbase,pass_2,
       pass_1,nld,ncon,nadd,
@@ -915,7 +915,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.34  2002-11-24 18:19:20  carl
+  Revision 1.35  2002-11-25 17:43:18  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.34  2002/11/24 18:19:20  carl
     + checkpointer for interfaces also
 
   Revision 1.33  2002/11/23 22:50:06  carl

compiler/ncgset.pas

@@ -87,7 +87,7 @@ implementation
     uses
       globtype,systems,
       verbose,
-      symconst,symdef,defbase,
+      symconst,symdef,defutil,
       paramgr,
       pass_2,
       ncon,
@@ -747,7 +747,7 @@ implementation
                                hregister2, l1);
                           { the comparisation of the low dword must be always unsigned! }
                           cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_B, aword(lo(int64(t^._low))), hregister, elselabel);
-{$endif}                          
+{$endif}
                           cg.a_label(exprasmlist,l1);
                        end
                      else
@@ -772,7 +772,7 @@ implementation
                      cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_gt, aword(hi(int64(t^._high))), hregister2,
                            l1);
                     cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_BE, aword(lo(int64(t^._high))), hregister, t^.statement);
-{$endif}                    
+{$endif}
                     cg.a_label(exprasmlist,l1);
                   end
                 else
@@ -1015,7 +1015,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.22  2002-10-05 12:43:25  carl
+  Revision 1.23  2002-11-25 17:43:18  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.22  2002/10/05 12:43:25  carl
     * fixes for Delphi 6 compilation
      (warning : Some features do not work under Delphi)
 

compiler/ncgutil.pas

@@ -99,8 +99,8 @@ implementation
 {$endif}
     cutils,cclasses,
     globals,systems,verbose,
-    symconst,symsym,symtable,defbase,paramgr,
-    fmodule,
+    symconst,symsym,symtable,defutil,
+    paramgr,fmodule,
     cgbase,regvars,
 {$ifdef GDB}
     gdb,
@@ -1876,7 +1876,12 @@ function returns in a register and the caller receives it in an other one}
 end.
 {
   $Log$
-  Revision 1.62  2002-11-18 17:31:55  peter
+  Revision 1.63  2002-11-25 17:43:18  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.62  2002/11/18 17:31:55  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.61  2002/11/17 17:49:08  mazen

compiler/ncnv.pas

@@ -28,7 +28,8 @@ interface
 
     uses
        node,
-       symtype,symppu,defbase,
+       symtype,symppu,
+       defutil,defcmp,
        nld
 {$ifdef Delphi}
        ,dmisc
@@ -194,7 +195,7 @@ implementation
          end;
 
         { don't insert obsolete type conversions }
-        if is_equal(p.resulttype.def,t.def) and
+        if equal_defs(p.resulttype.def,t.def) and
            not ((p.resulttype.def.deftype=setdef) and
                 (tsetdef(p.resulttype.def).settype <>
                  tsetdef(t.def).settype)) then
@@ -220,7 +221,7 @@ implementation
          end;
 
         { don't insert obsolete type conversions }
-        if is_equal(p.resulttype.def,t.def) and
+        if equal_defs(p.resulttype.def,t.def) and
            not ((p.resulttype.def.deftype=setdef) and
                 (tsetdef(p.resulttype.def).settype <>
                  tsetdef(t.def).settype)) then
@@ -363,7 +364,7 @@ implementation
                             inserttypeconv(p3,u8bitdef);
                           end;
                          }
-                         if assigned(htype.def) and not(is_equal(htype.def,p3.resulttype.def)) then
+                         if assigned(htype.def) and not(equal_defs(htype.def,p3.resulttype.def)) then
                            begin
                               aktfilepos:=p3.fileinfo;
                               CGMessage(type_e_typeconflict_in_set);
@@ -967,7 +968,7 @@ implementation
         hp : tnode;
         currprocdef,
         aprocdef : tprocdef;
-
+        eq : tequaltype;
       begin
         result:=nil;
         resulttype:=totype;
@@ -976,394 +977,266 @@ implementation
         if codegenerror then
          exit;
 
-        { remove obsolete type conversions }
-        if is_equal(left.resulttype.def,resulttype.def) then
-          begin
-          { because is_equal only checks the basetype for sets we need to
-            check here if we are loading a smallset into a normalset }
-            if (resulttype.def.deftype=setdef) and
-               (left.resulttype.def.deftype=setdef) and
-               ((tsetdef(resulttype.def).settype = smallset) xor
-                (tsetdef(left.resulttype.def).settype = smallset)) then
-              begin
-                { constant sets can be converted by changing the type only }
-                if (left.nodetype=setconstn) then
-                 begin
-                   tsetdef(left.resulttype.def).changesettype(tsetdef(resulttype.def).settype);
-                   result:=left;
-                   left:=nil;
-                   exit;
-                 end;
-
-                if (tsetdef(resulttype.def).settype <> smallset) then
-                 convtype:=tc_load_smallset
-                else
-                 convtype := tc_normal_2_smallset;
-                exit;
-              end
-            else
-             begin
-               left.resulttype:=resulttype;
-               result:=left;
-               left:=nil;
-               exit;
-             end;
-          end;
-        aprocdef:=assignment_overloaded(left.resulttype.def,resulttype.def);
-        if assigned(aprocdef) then
-          begin
-             procinfo.flags:=procinfo.flags or pi_do_call;
-             hp:=ccallnode.create(ccallparanode.create(left,nil),
-                                  overloaded_operators[_assignment],nil,nil);
-             { tell explicitly which def we must use !! (PM) }
-             tcallnode(hp).procdefinition:=aprocdef;
-             left:=nil;
-             result:=hp;
-             exit;
-          end;
-
-        if isconvertable(left.resulttype.def,resulttype.def,convtype,left.nodetype,nf_explizit in flags)=0 then
-         begin
-           {Procedures have a resulttype.def of voiddef and functions of their
-           own resulttype.def. They will therefore always be incompatible with
-           a procvar. Because isconvertable cannot check for procedures we
-           use an extra check for them.}
-           if (m_tp_procvar in aktmodeswitches) then
+        eq:=compare_defs_ext(left.resulttype.def,resulttype.def,left.nodetype,
+                             nf_explizit in flags,true,convtype,aprocdef);
+        case eq of
+          te_exact,
+          te_equal :
             begin
-              if (resulttype.def.deftype=procvardef) and
-                 (is_procsym_load(left) or is_procsym_call(left)) then
+              { because is_equal only checks the basetype for sets we need to
+                check here if we are loading a smallset into a normalset }
+              if (resulttype.def.deftype=setdef) and
+                 (left.resulttype.def.deftype=setdef) and
+                 ((tsetdef(resulttype.def).settype = smallset) xor
+                  (tsetdef(left.resulttype.def).settype = smallset)) then
+                begin
+                  { constant sets can be converted by changing the type only }
+                  if (left.nodetype=setconstn) then
+                   begin
+                     tsetdef(left.resulttype.def).changesettype(tsetdef(resulttype.def).settype);
+                     result:=left;
+                     left:=nil;
+                     exit;
+                   end;
+
+                  if (tsetdef(resulttype.def).settype <> smallset) then
+                   convtype:=tc_load_smallset
+                  else
+                   convtype := tc_normal_2_smallset;
+                  exit;
+                end
+              else
                begin
-                 if is_procsym_call(left) then
-                  begin
-                    currprocdef:=Tprocsym(Tcallnode(left).symtableprocentry).search_procdef_byprocvardef(Tprocvardef(resulttype.def));
-                    hp:=cloadnode.create_procvar(tprocsym(tcallnode(left).symtableprocentry),
-                        currprocdef,tcallnode(left).symtableproc);
-                    if (tcallnode(left).symtableprocentry.owner.symtabletype=objectsymtable) and
-                       assigned(tcallnode(left).methodpointer) then
-                      tloadnode(hp).set_mp(tcallnode(left).methodpointer.getcopy);
-                    resulttypepass(hp);
-                    left.free;
-                    left:=hp;
-                    aprocdef:=tprocdef(left.resulttype.def);
-                  end
-                 else
-                  begin
-                    if (left.nodetype<>addrn) then
-                      aprocdef:=tprocsym(tloadnode(left).symtableentry).first_procdef;
-                  end;
-                 convtype:=tc_proc_2_procvar;
-                 { Now check if the procedure we are going to assign to
-                   the procvar,  is compatible with the procvar's type }
-                 if assigned(aprocdef) then
-                  begin
-                    if not proc_to_procvar_equal(aprocdef,tprocvardef(resulttype.def),false) then
-                     CGMessage2(type_e_incompatible_types,aprocdef.typename,resulttype.def.typename);
-                  end
-                 else
-                  CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
+                 left.resulttype:=resulttype;
+                 result:=left;
+                 left:=nil;
                  exit;
                end;
             end;
-           if nf_explizit in flags then
-            begin
-              { check if the result could be in a register }
-              if not(tstoreddef(resulttype.def).is_intregable) and
-                not(tstoreddef(resulttype.def).is_fpuregable) then
-                make_not_regable(left);
-              { boolean to byte are special because the
-                location can be different }
-
-              if is_integer(resulttype.def) and
-                 is_boolean(left.resulttype.def) then
-               begin
-                  convtype:=tc_bool_2_int;
-                  exit;
-               end;
 
-              if is_char(resulttype.def) and
-                 is_boolean(left.resulttype.def) then
-               begin
-                  convtype:=tc_bool_2_int;
-                  exit;
-               end;
+          te_convert_l1,
+          te_convert_l2 :
+            begin
+              { nothing to do }
+            end;
 
-              { ansistring to pchar }
-              if is_pchar(resulttype.def) and
-                 is_ansistring(left.resulttype.def) then
-               begin
-                 convtype:=tc_ansistring_2_pchar;
-                 exit;
-               end;
-              { do common tc_equal cast }
-              convtype:=tc_equal;
+          te_convert_operator :
+            begin
+              procinfo.flags:=procinfo.flags or pi_do_call;
+              hp:=ccallnode.create(ccallparanode.create(left,nil),
+                                   overloaded_operators[_assignment],nil,nil);
+              { tell explicitly which def we must use !! (PM) }
+              tcallnode(hp).procdefinition:=aprocdef;
+              left:=nil;
+              result:=hp;
+              exit;
+            end;
 
-              { enum to ordinal will always be s32bit }
-              if (left.resulttype.def.deftype=enumdef) and
-                 is_ordinal(resulttype.def) then
+          te_incompatible :
+            begin
+              { Procedures have a resulttype.def of voiddef and functions of their
+                own resulttype.def. They will therefore always be incompatible with
+                a procvar. Because isconvertable cannot check for procedures we
+                use an extra check for them.}
+              if (m_tp_procvar in aktmodeswitches) then
                begin
-                 if left.nodetype=ordconstn then
+                 if (resulttype.def.deftype=procvardef) and
+                    (is_procsym_load(left) or is_procsym_call(left)) then
                   begin
-                    hp:=cordconstnode.create(tordconstnode(left).value,
-                       resulttype,true);
-                    result:=hp;
+                    if is_procsym_call(left) then
+                     begin
+                       currprocdef:=Tprocsym(Tcallnode(left).symtableprocentry).search_procdef_byprocvardef(Tprocvardef(resulttype.def));
+                       hp:=cloadnode.create_procvar(tprocsym(tcallnode(left).symtableprocentry),
+                           currprocdef,tcallnode(left).symtableproc);
+                       if (tcallnode(left).symtableprocentry.owner.symtabletype=objectsymtable) and
+                          assigned(tcallnode(left).methodpointer) then
+                         tloadnode(hp).set_mp(tcallnode(left).methodpointer.getcopy);
+                       resulttypepass(hp);
+                       left.free;
+                       left:=hp;
+                       aprocdef:=tprocdef(left.resulttype.def);
+                     end
+                    else
+                     begin
+                       if (left.nodetype<>addrn) then
+                         aprocdef:=tprocsym(tloadnode(left).symtableentry).first_procdef;
+                     end;
+                    convtype:=tc_proc_2_procvar;
+                    { Now check if the procedure we are going to assign to
+                      the procvar,  is compatible with the procvar's type }
+                    if assigned(aprocdef) then
+                     begin
+                       if proc_to_procvar_equal(aprocdef,tprocvardef(resulttype.def))=te_incompatible then
+                        CGMessage2(type_e_incompatible_types,aprocdef.typename,resulttype.def.typename);
+                     end
+                    else
+                     CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
                     exit;
-                  end
-                 else
-                  begin
-                    if isconvertable(s32bittype.def,resulttype.def,convtype,ordconstn,false)=0 then
-                      CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
                   end;
-               end
-
-              { ordinal to enumeration }
-              else
-               if (resulttype.def.deftype=enumdef) and
-                  is_ordinal(left.resulttype.def) then
-                begin
-                  if left.nodetype=ordconstn then
-                   begin
-                     hp:=cordconstnode.create(tordconstnode(left).value,
-                       resulttype,true);
-                     result:=hp;
-                     exit;
-                   end
-                  else
-                   begin
-                     if IsConvertable(left.resulttype.def,s32bittype.def,convtype,ordconstn,false)=0 then
-                       CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
-                   end;
-                end
+               end;
 
-               { nil to ordinal node }
-               else if (left.nodetype=niln) and is_ordinal(resulttype.def) then
-                  begin
-                     hp:=cordconstnode.create(0,resulttype,true);
-                     result:=hp;
-                     exit;
-                  end
+              { Handle explicit type conversions }
+              if nf_explizit in flags then
+               begin
+                 { do common tc_equal cast }
+                 convtype:=tc_equal;
 
-              { constant pointer to ordinal }
-              else if is_ordinal(resulttype.def) and
-                      (left.nodetype=pointerconstn) then
-                begin
-                   hp:=cordconstnode.create(tpointerconstnode(left).value,
-                     resulttype,true);
-                   result:=hp;
-                   exit;
-                end
+                 { check if the result could be in a register }
+                 if not(tstoreddef(resulttype.def).is_intregable) and
+                   not(tstoreddef(resulttype.def).is_fpuregable) then
+                   make_not_regable(left);
 
-              { class to class or object to object, with checkobject support }
-              else if (resulttype.def.deftype=objectdef) and
-                      (left.resulttype.def.deftype=objectdef) then
-                begin
-                  if (cs_check_object in aktlocalswitches) then
+                 { class to class or object to object, with checkobject support }
+                 if (resulttype.def.deftype=objectdef) and
+                    (left.resulttype.def.deftype=objectdef) then
                    begin
-                     if is_class_or_interface(resulttype.def) then
+                     if (cs_check_object in aktlocalswitches) then
                       begin
-                        { we can translate the typeconvnode to 'as' when
-                          typecasting to a class or interface }
-                        hp:=casnode.create(left,cloadvmtnode.create(ctypenode.create(resulttype)));
-                        left:=nil;
-                        result:=hp;
-                        exit;
+                        if is_class_or_interface(resulttype.def) then
+                         begin
+                           { we can translate the typeconvnode to 'as' when
+                             typecasting to a class or interface }
+                           hp:=casnode.create(left,cloadvmtnode.create(ctypenode.create(resulttype)));
+                           left:=nil;
+                           result:=hp;
+                           exit;
+                         end;
+                      end
+                     else
+                      begin
+                        { check if the types are related }
+                        if (not(tobjectdef(left.resulttype.def).is_related(tobjectdef(resulttype.def)))) and
+                           (not(tobjectdef(resulttype.def).is_related(tobjectdef(left.resulttype.def)))) then
+                          CGMessage2(type_w_classes_not_related,left.resulttype.def.typename,resulttype.def.typename);
                       end;
                    end
+
+                  { only if the same size or formal def }
+                  { why do we allow typecasting of voiddef ?? (PM) }
                   else
                    begin
-                     { check if the types are related }
-                     if (not(tobjectdef(left.resulttype.def).is_related(tobjectdef(resulttype.def)))) and
-                        (not(tobjectdef(resulttype.def).is_related(tobjectdef(left.resulttype.def)))) then
-                       CGMessage2(type_w_classes_not_related,left.resulttype.def.typename,resulttype.def.typename);
+                     if not(
+                        (left.resulttype.def.deftype=formaldef) or
+                        (not(is_open_array(left.resulttype.def)) and
+                         (left.resulttype.def.size=resulttype.def.size)) or
+                        (is_void(left.resulttype.def)  and
+                         (left.nodetype=derefn))
+                        ) then
+                       CGMessage(cg_e_illegal_type_conversion);
+                     if ((left.resulttype.def.deftype=orddef) and
+                         (resulttype.def.deftype=pointerdef)) or
+                         ((resulttype.def.deftype=orddef) and
+                          (left.resulttype.def.deftype=pointerdef)) then
+                       CGMessage(cg_d_pointer_to_longint_conv_not_portable);
                    end;
-                end
 
-              {Are we typecasting an ordconst to a char?}
+                  { the conversion into a strutured type is only }
+                  { possible, if the source is not a register    }
+                  if (
+                      (resulttype.def.deftype in [recorddef,stringdef,arraydef]) or
+                      ((resulttype.def.deftype=objectdef) and
+                       not(is_class(resulttype.def)))
+                     ) and
+                     (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                    CGMessage(cg_e_illegal_type_conversion);
+               end
               else
-                if is_char(resulttype.def) and
-                   is_ordinal(left.resulttype.def) then
-                 begin
-                   if left.nodetype=ordconstn then
-                    begin
-                      hp:=cordconstnode.create(tordconstnode(left).value,
-                        resulttype,true);
-                      result:=hp;
-                      exit;
-                    end
-                   else
-                    begin
-                      if IsConvertable(left.resulttype.def,u8bittype.def,convtype,ordconstn,false)=0 then
-                        CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
-                    end;
-                 end
+               CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
+            end;
 
-              {Are we typecasting an ordconst to a wchar?}
-              else
-                if is_widechar(resulttype.def) and
-                   is_ordinal(left.resulttype.def) then
-                 begin
-                   if left.nodetype=ordconstn then
-                    begin
-                      hp:=cordconstnode.create(tordconstnode(left).value,
-                        resulttype,true);
-                      result:=hp;
-                      exit;
-                    end
-                   else
-                    begin
-                      if IsConvertable(left.resulttype.def,u16bittype.def,convtype,ordconstn,false)=0 then
-                        CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
-                    end;
-                 end
+          else
+            internalerror(200211231);
+        end;
 
-              { char to ordinal }
-              else
-                if is_char(left.resulttype.def) and
-                   is_ordinal(resulttype.def) then
-                 begin
-                   if left.nodetype=ordconstn then
-                    begin
-                      hp:=cordconstnode.create(tordconstnode(left).value,
-                        resulttype,true);
-                      result:=hp;
-                      exit;
-                    end
-                   else
-                    begin
-                      if IsConvertable(u8bittype.def,resulttype.def,convtype,ordconstn,false)=0 then
-                        CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
-                    end;
-                 end
-              { widechar to ordinal }
-              else
-                if is_widechar(left.resulttype.def) and
-                   is_ordinal(resulttype.def) then
-                 begin
-                   if left.nodetype=ordconstn then
-                    begin
-                      hp:=cordconstnode.create(tordconstnode(left).value,
-                         resulttype,true);
-                      result:=hp;
-                      exit;
-                    end
-                   else
-                    begin
-                      if IsConvertable(u16bittype.def,resulttype.def,convtype,ordconstn,false)=0 then
-                        CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
-                    end;
-                 end
+        { Constant folding and other node transitions to
+          remove the typeconv node }
+        case left.nodetype of
+          loadn :
+            begin
+              { tp7 procvar support, when right is not a procvardef and we got a
+                loadn of a procvar then convert to a calln, the check for the
+                result is already done in is_convertible, also no conflict with
+                @procvar is here because that has an extra addrn }
+              if (m_tp_procvar in aktmodeswitches) and
+                 (resulttype.def.deftype<>procvardef) and
+                 (left.resulttype.def.deftype=procvardef) then
+               begin
+                 hp:=ccallnode.create(nil,nil,nil,nil);
+                 tcallnode(hp).set_procvar(left);
+                 resulttypepass(hp);
+                 left:=hp;
+               end;
+            end;
 
-              { ordinal to pointer }
+          niln :
+            begin
+              { nil to ordinal node }
+              if (resulttype.def.deftype=orddef) then
+               begin
+                 hp:=cordconstnode.create(0,resulttype,true);
+                 result:=hp;
+                 exit;
+               end
+              else
+               { fold nil to any pointer type }
+               if (resulttype.def.deftype=pointerdef) then
+                begin
+                  hp:=cnilnode.create;
+                  hp.resulttype:=resulttype;
+                  result:=hp;
+                  exit;
+                end
               else
-                if (m_delphi in aktmodeswitches) and
-                   is_ordinal(left.resulttype.def) and
-                   (resulttype.def.deftype=pointerdef) then
+               { remove typeconv after niln, but not when the result is a
+                 methodpointer. The typeconv of the methodpointer will then
+                 take care of updateing size of niln to OS_64 }
+               if not((resulttype.def.deftype=procvardef) and
+                      (po_methodpointer in tprocvardef(resulttype.def).procoptions)) then
                  begin
-                   if left.nodetype=pointerconstn then
-                    begin
-                      hp:=cordconstnode.create(tpointerconstnode(left).value,
-                         resulttype,true);
-                      result:=hp;
-                      exit;
-                    end
-                   else
-                    begin
-                      if IsConvertable(left.resulttype.def,ordpointertype.def,convtype,ordconstn,false)=0 then
-                        CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
-                    end;
-                 end
+                   left.resulttype:=resulttype;
+                   result:=left;
+                   left:=nil;
+                   exit;
+                 end;
+            end;
 
-               { only if the same size or formal def }
-               { why do we allow typecasting of voiddef ?? (PM) }
-               else
+          ordconstn :
+            begin
+              { ordinal contants can be directly converted }
+              { but not char to char because it is a widechar to char or via versa }
+              { which needs extra code to do the code page transistion             }
+              if is_ordinal(resulttype.def) and
+                 not(convtype=tc_char_2_char) then
                 begin
-                  if not(
-                     (left.resulttype.def.deftype=formaldef) or
-                     (not(is_open_array(left.resulttype.def)) and
-                      (left.resulttype.def.size=resulttype.def.size)) or
-                     (is_void(left.resulttype.def)  and
-                      (left.nodetype=derefn))
-                     ) then
-                    CGMessage(cg_e_illegal_type_conversion);
-                  if ((left.resulttype.def.deftype=orddef) and
-                      (resulttype.def.deftype=pointerdef)) or
-                      ((resulttype.def.deftype=orddef) and
-                       (left.resulttype.def.deftype=pointerdef)) then
-                    CGMessage(cg_d_pointer_to_longint_conv_not_portable);
+                   { replace the resulttype and recheck the range }
+                   left.resulttype:=resulttype;
+                   testrange(left.resulttype.def,tordconstnode(left).value,(nf_explizit in flags));
+                   result:=left;
+                   left:=nil;
+                   exit;
                 end;
+            end;
 
-               { the conversion into a strutured type is only }
-               { possible, if the source is not a register    }
-               if ((resulttype.def.deftype in [recorddef,stringdef,arraydef]) or
-                   ((resulttype.def.deftype=objectdef) and not(is_class(resulttype.def)))
-                  ) and (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) { and
-                   it also works if the assignment is overloaded
-                   YES but this code is not executed if assignment is overloaded (PM)
-                  not assigned(assignment_overloaded(left.resulttype.def,resulttype.def))} then
-                 CGMessage(cg_e_illegal_type_conversion);
-            end
-           else
-            CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
-         end;
-
-       { tp7 procvar support, when right is not a procvardef and we got a
-         loadn of a procvar then convert to a calln, the check for the
-         result is already done in is_convertible, also no conflict with
-         @procvar is here because that has an extra addrn }
-         if (m_tp_procvar in aktmodeswitches) and
-            (resulttype.def.deftype<>procvardef) and
-            (left.resulttype.def.deftype=procvardef) and
-            (left.nodetype=loadn) then
-          begin
-            hp:=ccallnode.create(nil,nil,nil,nil);
-            tcallnode(hp).set_procvar(left);
-            resulttypepass(hp);
-            left:=hp;
-          end;
-
-        { remove typeconv after niln, but not when the result is a
-          methodpointer. The typeconv of the methodpointer will then
-          take care of updateing size of niln to OS_64 }
-        if (left.nodetype=niln) and
-           not((resulttype.def.deftype=procvardef) and
-               (po_methodpointer in tprocvardef(resulttype.def).procoptions)) then
-          begin
-            left.resulttype:=resulttype;
-            result:=left;
-            left:=nil;
-            exit;
-          end;
-
-        { ordinal contants can be directly converted }
-        if (left.nodetype=ordconstn) and is_ordinal(resulttype.def) and
-        { but not char to char because it is a widechar to char or via versa }
-        { which needs extra code to do the code page transistion             }
-          not(convtype=tc_char_2_char) then
-          begin
-             { replace the resulttype and recheck the range }
-             left.resulttype:=resulttype;
-             testrange(left.resulttype.def,tordconstnode(left).value,(nf_explizit in flags));
-             result:=left;
-             left:=nil;
-             exit;
-          end;
-
-        { fold nil to any pointer type }
-        if (left.nodetype=niln) and (resulttype.def.deftype=pointerdef) then
-          begin
-             hp:=cnilnode.create;
-             hp.resulttype:=resulttype;
-             result:=hp;
-             exit;
-          end;
-
-        { further, pointerconstn to any pointer is folded too }
-        if (left.nodetype=pointerconstn) and (resulttype.def.deftype=pointerdef) then
-          begin
-             left.resulttype:=resulttype;
-             result:=left;
-             left:=nil;
-             exit;
-          end;
+          pointerconstn :
+            begin
+              { pointerconstn to any pointer is folded too }
+              if (resulttype.def.deftype=pointerdef) then
+                begin
+                   left.resulttype:=resulttype;
+                   result:=left;
+                   left:=nil;
+                   exit;
+                end
+              { constant pointer to ordinal }
+              else if is_ordinal(resulttype.def) then
+                begin
+                   hp:=cordconstnode.create(tpointerconstnode(left).value,
+                     resulttype,true);
+                   result:=hp;
+                   exit;
+                end;
+            end;
+        end;
 
         { now call the resulttype helper to do constant folding }
         result:=resulttype_call_helper(convtype);
@@ -2098,7 +1971,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.88  2002-11-17 16:31:56  carl
+  Revision 1.89  2002-11-25 17:43:18  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.88  2002/11/17 16:31:56  carl
     * memory optimization (3-4%) : cleanup of tai fields,
        cleanup of tdef and tsym fields.
     * make it work for m68k

compiler/ncon.pas

@@ -172,7 +172,7 @@ implementation
 
     uses
       cutils,verbose,systems,
-      defbase,cpubase,nld;
+      defutil,cpubase,nld;
 
     function genintconstnode(v : TConstExprInt) : tordconstnode;
 
@@ -924,7 +924,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.44  2002-11-22 22:48:10  carl
+  Revision 1.45  2002-11-25 17:43:18  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.44  2002/11/22 22:48:10  carl
   * memory optimization with tconstsym (1.5%)
 
   Revision 1.43  2002/10/05 12:43:25  carl

compiler/nflw.pas

@@ -207,7 +207,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symtable,paramgr,defbase,htypechk,pass_1,
+      symconst,symtable,paramgr,defutil,htypechk,pass_1,
       ncon,nmem,nld,ncnv,nbas,rgobj,
     {$ifdef state_tracking}
       nstate,
@@ -1412,7 +1412,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.55  2002-11-18 17:31:56  peter
+  Revision 1.56  2002-11-25 17:43:18  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.55  2002/11/18 17:31:56  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.54  2002/10/20 15:31:49  peter

compiler/ninl.pas

@@ -72,7 +72,7 @@ implementation
     uses
       verbose,globals,systems,
       globtype, cutils,
-      symbase,symconst,symtype,symdef,symsym,symtable,paramgr,defbase,
+      symbase,symconst,symtype,symdef,symsym,symtable,paramgr,defutil,defcmp,
       pass_1,
       ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,
       cpubase,tgobj,cgbase
@@ -488,7 +488,7 @@ implementation
                     para.left:=p1;
                   end;
 
-                if not is_equal(para.left.resulttype.def,tfiledef(filepara.resulttype.def).typedfiletype.def) then
+                if not equal_defs(para.left.resulttype.def,tfiledef(filepara.resulttype.def).typedfiletype.def) then
                   begin
                     CGMessagePos(para.left.fileinfo,type_e_mismatch);
                     found_error := true;
@@ -728,7 +728,7 @@ implementation
                         (torddef(para.left.resulttype.def).typ in [s8bit,s16bit,u8bit,u16bit])
                        ) or
                        (is_real and
-                        not is_equal(para.left.resulttype.def,pbestrealtype^.def)
+                        not equal_defs(para.left.resulttype.def,pbestrealtype^.def)
                        )
                       ) then
                       { special handling of reading small numbers, because the helpers  }
@@ -2408,7 +2408,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.97  2002-11-18 18:35:01  peter
+  Revision 1.98  2002-11-25 17:43:19  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.97  2002/11/18 18:35:01  peter
     * Swap(QWord) constant support
 
   Revision 1.96  2002/11/18 17:31:57  peter

compiler/nld.pas

@@ -151,7 +151,7 @@ implementation
 
     uses
       cutils,verbose,globtype,globals,systems,
-      symtable,paramgr,defbase,
+      symtable,paramgr,defutil,defcmp,
       htypechk,pass_1,
       ncon,ninl,ncnv,nmem,ncal,cpubase,rgobj,cginfo,cgbase
       ;
@@ -878,7 +878,7 @@ implementation
               else
                begin
                  if ((nf_novariaallowed in flags) or (not varia)) and
-                    (not is_equal(htype.def,hp.left.resulttype.def)) then
+                    (not equal_defs(htype.def,hp.left.resulttype.def)) then
                   begin
                     varia:=true;
                   end;
@@ -1181,7 +1181,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.65  2002-11-18 17:31:57  peter
+  Revision 1.66  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.65  2002/11/18 17:31:57  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.64  2002/11/15 01:58:52  peter

compiler/nmat.pas

@@ -83,7 +83,7 @@ implementation
       systems,tokens,
       verbose,globals,cutils,
       globtype,
-      symconst,symtype,symtable,symdef,defbase,
+      symconst,symtype,symtable,symdef,defutil,
       htypechk,pass_1,cpubase,
       cgbase,
       ncon,ncnv,ncal,nadd;
@@ -118,7 +118,7 @@ implementation
                end;
              if is_constintnode(left) then
                begin
-                 lv:=tordconstnode(left).value; 
+                 lv:=tordconstnode(left).value;
 
                   case nodetype of
                    modn:
@@ -748,7 +748,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.43  2002-10-04 21:19:28  jonas
+  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

compiler/nmem.pas

@@ -155,7 +155,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symbase,defbase,
+      symconst,symbase,defutil,defcmp,
       nbas,
       htypechk,pass_1,ncal,nld,ncon,ncnv,cgbase
       ;
@@ -734,9 +734,7 @@ implementation
            arraydef :
              begin
                { check type of the index value }
-               if (isconvertable(right.resulttype.def,tarraydef(left.resulttype.def).rangetype.def,
-                      ct,ordconstn,false)=0) and
-                  not(is_equal(right.resulttype.def,tarraydef(left.resulttype.def).rangetype.def)) then
+               if (compare_defs(right.resulttype.def,tarraydef(left.resulttype.def).rangetype.def,right.nodetype)=te_incompatible) then
                  CGMessage(type_e_mismatch);
                resulttype:=tarraydef(left.resulttype.def).elementtype;
              end;
@@ -1057,7 +1055,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.40  2002-09-27 21:13:28  carl
+  Revision 1.41  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.40  2002/09/27 21:13:28  carl
     * low-highval always checked if limit ober 2GB is reached (to avoid overflow)
 
   Revision 1.39  2002/09/01 18:44:17  peter

compiler/nobj.pas

@@ -145,7 +145,7 @@ implementation
        strings,
 {$endif}
        globals,verbose,
-       symtable,symconst,symtype,symsym,defbase,paramgr,
+       symtable,symconst,symtype,symsym,defutil,defcmp,paramgr,
 {$ifdef GDB}
        gdb,
 {$endif GDB}
@@ -630,7 +630,7 @@ implementation
                                       begin
                                         if tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class) and
                                            (not(pdoverload or hasoverloads) or
-                                            equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)) then
+                                            (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)>=te_equal)) then
                                          begin
                                            if is_visible then
                                              procdefcoll^.hidden:=true;
@@ -648,7 +648,7 @@ implementation
                                          begin
                                            { we start a new virtual tree, hide the old }
                                            if (not(pdoverload or hasoverloads) or
-                                               equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)) and
+                                               (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)>=te_equal)) and
                                               (tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class)) then
                                             begin
                                               if is_visible then
@@ -664,7 +664,7 @@ implementation
                                            { do nothing, the error will follow when adding the entry }
                                          end
                                         { same parameters }
-                                        else if (equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)) then
+                                        else if (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)>=te_equal) then
                                          begin
                                            { overload is inherited }
                                            if (po_overload in procdefcoll^.data.procoptions) then
@@ -680,7 +680,7 @@ implementation
                                               MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,pd.fullprocname);
 
                                            { error, if the return types aren't equal }
-                                           if not(is_equal(procdefcoll^.data.rettype.def,pd.rettype.def)) and
+                                           if not(equal_defs(procdefcoll^.data.rettype.def,pd.rettype.def)) and
                                               not((procdefcoll^.data.rettype.def.deftype=objectdef) and
                                                (pd.rettype.def.deftype=objectdef) and
                                                is_class(procdefcoll^.data.rettype.def) and
@@ -718,7 +718,7 @@ implementation
                                           if the new defintion has not the overload directive }
                                         if is_visible and
                                            ((not(pdoverload or hasoverloads)) or
-                                            equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)) then
+                                            (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)>=te_equal)) then
                                           procdefcoll^.hidden:=true;
                                       end;
                                    end
@@ -728,7 +728,7 @@ implementation
                                        has not the overload directive }
                                      if is_visible and
                                         ((not pdoverload) or
-                                         equal_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)) then
+                                         (compare_paras(procdefcoll^.data.para,pd.para,cp_value_equal_const,false)>=te_equal)) then
                                        procdefcoll^.hidden:=true;
                                    end;
                                 end; { not hidden }
@@ -1030,7 +1030,7 @@ implementation
           for i:=1 to sym.procdef_count do
             begin
               implprocdef:=sym.procdef[i];
-              if equal_paras(proc.para,implprocdef.para,cp_none,false) and
+              if (compare_paras(proc.para,implprocdef.para,cp_none,false)>=te_equal) and
                  (proc.proccalloption=implprocdef.proccalloption) then
                 begin
                   gintfgetcprocdef:=implprocdef;
@@ -1333,7 +1333,12 @@ initialization
 end.
 {
   $Log$
-  Revision 1.37  2002-11-17 16:31:56  carl
+  Revision 1.38  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.37  2002/11/17 16:31:56  carl
     * memory optimization (3-4%) : cleanup of tai fields,
        cleanup of tdef and tsym fields.
     * make it work for m68k

compiler/nopt.pas

@@ -84,7 +84,7 @@ var
 
 implementation
 
-uses cutils, htypechk, defbase, globtype, globals, cpubase, ncnv, ncon,
+uses cutils, htypechk, defutil, defcmp, globtype, globals, cpubase, ncnv, ncon,
      verbose, symdef, cgbase;
 
 
@@ -278,7 +278,12 @@ end.
 
 {
   $Log$
-  Revision 1.11  2002-08-17 09:23:37  florian
+  Revision 1.12  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.11  2002/08/17 09:23:37  florian
     * first part of procinfo rewrite
 
   Revision 1.10  2002/07/20 11:57:55  florian

compiler/nset.pas

@@ -116,7 +116,7 @@ implementation
     uses
       globtype,systems,
       verbose,
-      symconst,symdef,symsym,defbase,
+      symconst,symdef,symsym,defutil,defcmp,
       htypechk,pass_1,
       ncnv,ncon,cpubase,nld,rgobj,cgbase;
 
@@ -348,8 +348,7 @@ implementation
          if codegenerror then
            exit;
          { both types must be compatible }
-         if not(is_equal(left.resulttype.def,right.resulttype.def)) and
-            (isconvertable(left.resulttype.def,right.resulttype.def,ct,ordconstn,false)=0) then
+         if compare_defs(left.resulttype.def,right.resulttype.def,left.nodetype)=te_incompatible then
            CGMessage(type_e_mismatch);
          { Check if only when its a constant set }
          if (left.nodetype=ordconstn) and (right.nodetype=ordconstn) then
@@ -691,7 +690,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.34  2002-10-05 12:43:25  carl
+  Revision 1.35  2002-11-25 17:43:21  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.34  2002/10/05 12:43:25  carl
     * fixes for Delphi 6 compilation
      (warning : Some features do not work under Delphi)
 

compiler/paramgr.pas

@@ -108,7 +108,7 @@ unit paramgr;
        cpuinfo,globals,systems,
        symconst,symbase,symsym,
        rgobj,
-       defbase,cgbase,cginfo,verbose;
+       defutil,cgbase,cginfo,verbose;
 
     { true if the return value is in accumulator (EAX for i386), D0 for 68k }
     function tparamanager.ret_in_acc(def : tdef;calloption : tproccalloption) : boolean;
@@ -339,7 +339,12 @@ end.
 
 {
    $Log$
-   Revision 1.23  2002-11-18 17:31:58  peter
+   Revision 1.24  2002-11-25 17:43:21  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.23  2002/11/18 17:31:58  peter
      * pass proccalloption to ret_in_xxx and push_xxx functions
 
    Revision 1.22  2002/11/16 18:00:04  peter

compiler/pdecobj.pas

@@ -37,7 +37,7 @@ implementation
     uses
       cutils,cclasses,
       globals,verbose,systems,tokens,
-      symconst,symbase,symsym,symtable,defbase,
+      symconst,symbase,symsym,symtable,defutil,defcmp,
       cgbase,
       node,nld,nmem,ncon,ncnv,ncal,pass_1,
       scanner,
@@ -397,13 +397,13 @@ implementation
                           begin
                             pd:=Tprocsym(sym).search_procdef_bypara(propertyparas,true,false);
                             if not(assigned(pd)) or
-                               not(is_equal(pd.rettype.def,p.proptype.def)) then
+                               not(equal_defs(pd.rettype.def,p.proptype.def)) then
                               Message(parser_e_ill_property_access_sym);
                             p.readaccess.setdef(pd);
                           end;
                         varsym :
                           begin
-                            if CheckTypes(p.readaccess.def,p.proptype.def) then
+                            if compare_defs(p.readaccess.def,p.proptype.def,nothingn)>=te_equal then
                              begin
                                { property parameters are allowed if this is
                                  an indexed property, because the index is then
@@ -412,7 +412,9 @@ implementation
                                  that it isn't allowed, but the compiler accepts it (PFV) }
                                if (ppo_hasparameters in p.propoptions) then
                                 Message(parser_e_ill_property_access_sym);
-                             end;
+                             end
+                            else
+                             CGMessage2(type_e_incompatible_types,p.readaccess.def.typename,p.proptype.def.typename);
                           end;
                         else
                           Message(parser_e_ill_property_access_sym);
@@ -439,7 +441,7 @@ implementation
                           end;
                         varsym :
                           begin
-                            if CheckTypes(p.writeaccess.def,p.proptype.def) then
+                            if compare_defs(p.writeaccess.def,p.proptype.def,nothingn)>=te_equal then
                              begin
                                { property parameters are allowed if this is
                                  an indexed property, because the index is then
@@ -448,7 +450,9 @@ implementation
                                  that it isn't allowed, but the compiler accepts it (PFV) }
                                if (ppo_hasparameters in p.propoptions) then
                                 Message(parser_e_ill_property_access_sym);
-                             end;
+                             end
+                            else
+                             CGMessage2(type_e_incompatible_types,p.readaccess.def.typename,p.proptype.def.typename);
                           end;
                         else
                           Message(parser_e_ill_property_access_sym);
@@ -780,8 +784,8 @@ implementation
               Message1(sym_e_duplicate_id,implintf.name)
             else
               begin
-                 { allocate and prepare the GUID only if the class 
-                   implements some interfaces. 
+                 { allocate and prepare the GUID only if the class
+                   implements some interfaces.
                  }
                  if aktclass.implementedinterfaces.count = 0 then
                    aktclass.prepareguid;
@@ -1169,7 +1173,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.56  2002-11-17 16:31:56  carl
+  Revision 1.57  2002-11-25 17:43:21  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.56  2002/11/17 16:31:56  carl
     * memory optimization (3-4%) : cleanup of tai fields,
        cleanup of tdef and tsym fields.
     * make it work for m68k

compiler/pdecsub.pas

@@ -72,7 +72,7 @@ implementation
        { aasm }
        aasmbase,aasmtai,aasmcpu,
        { symtable }
-       symbase,symtable,defbase,paramgr,
+       symbase,symtable,defutil,defcmp,paramgr,
        { pass 1 }
        node,htypechk,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
@@ -226,7 +226,10 @@ implementation
               aktprocdef.concatpara(tt,vs,varspez,nil);
               { check the types for procedures only }
               if not is_procvar then
-               CheckTypes(tt.def,procinfo._class);
+               begin
+                 if compare_defs(tt.def,procinfo._class,nothingn)>=te_equal then
+                   CGMessage2(type_e_incompatible_types,tt.def.typename,procinfo._class.typename);
+               end;
             end
           else
             begin
@@ -764,7 +767,7 @@ implementation
                             if assigned(otsym) then
                               otsym.vartype.def:=aktprocdef.rettype.def;
                             if (optoken=_ASSIGNMENT) and
-                               is_equal(aktprocdef.rettype.def,
+                               equal_defs(aktprocdef.rettype.def,
                                   tvarsym(aktprocdef.parast.symindex.first).vartype.def) then
                               message(parser_e_no_such_assignment)
                             else if not isoperatoracceptable(aktprocdef,optoken) then
@@ -1837,10 +1840,10 @@ const
               ) or
               { check arguments }
               (
-               equal_paras(aprocdef.para,hd.para,cp_none,false) and
+               (compare_paras(aprocdef.para,hd.para,cp_none,false)>=te_equal) and
                { for operators equal_paras is not enough !! }
                ((aprocdef.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
-                is_equal(hd.rettype.def,aprocdef.rettype.def))
+                equal_defs(hd.rettype.def,aprocdef.rettype.def))
               ) then
              begin
                { Check if we've found the forwarddef, if found then
@@ -1856,12 +1859,12 @@ const
                       (
                        (m_repeat_forward in aktmodeswitches) and
                        (not((aprocdef.maxparacount=0) or
-                            equal_paras(aprocdef.para,hd.para,cp_all,false)))
+                            (compare_paras(aprocdef.para,hd.para,cp_all,false)>=te_equal)))
                       ) or
                       (
                        ((m_repeat_forward in aktmodeswitches) or
                         not(is_void(aprocdef.rettype.def))) and
-                       (not is_equal(hd.rettype.def,aprocdef.rettype.def))) then
+                       (not equal_defs(hd.rettype.def,aprocdef.rettype.def))) then
                      begin
                        MessagePos1(aprocdef.fileinfo,parser_e_header_dont_match_forward,
                                    aprocdef.fullprocname);
@@ -2054,7 +2057,12 @@ const
 end.
 {
   $Log$
-  Revision 1.81  2002-11-18 17:31:58  peter
+  Revision 1.82  2002-11-25 17:43:21  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.81  2002/11/18 17:31:58  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.80  2002/11/17 16:31:56  carl

compiler/pdecvar.pas

@@ -39,7 +39,8 @@ implementation
        globtype,globals,tokens,verbose,
        systems,
        { symtable }
-       symconst,symbase,symtype,symdef,symsym,symtable,defbase,fmodule,paramgr,
+       symconst,symbase,symtype,symdef,symsym,symtable,defutil,
+       fmodule,paramgr,
        { pass 1 }
        node,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
@@ -578,7 +579,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.39  2002-11-15 16:29:31  peter
+  Revision 1.40  2002-11-25 17:43:21  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.39  2002/11/15 16:29:31  peter
     * made tasmsymbol.refs private (merged)
 
   Revision 1.38  2002/11/15 01:58:53  peter

compiler/pexpr.pas

@@ -68,7 +68,7 @@ implementation
        globtype,tokens,verbose,
        systems,widestr,
        { symtable }
-       symconst,symbase,symdef,symsym,symtable,defbase,
+       symconst,symbase,symdef,symsym,symtable,defutil,defcmp,
        { pass 1 }
        pass_1,htypechk,
        nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
@@ -609,11 +609,6 @@ implementation
       begin
          prevafterassn:=afterassignment;
          afterassignment:=false;
-{$ifdef EXTDEBUG}
-        { if assigned(p1) and
-            (p1.nodetype<>calln) then
-           internalerror(20021118);}
-{$endif EXTDEBUG}
          { want we only determine the address of }
          { a subroutine ?                       }
          if not(getaddr) then
@@ -907,7 +902,7 @@ implementation
                                    (assigned(getprocvardef) and
                                     ((block_type=bt_const) or
                                      ((m_tp_procvar in aktmodeswitches) and
-                                      proc_to_procvar_equal(tprocsym(sym).first_procdef,getprocvardef,false)
+                                      (proc_to_procvar_equal(tprocsym(sym).first_procdef,getprocvardef)>te_incompatible)
                                      )
                                     )
                                    ),again,p1);
@@ -1244,7 +1239,7 @@ implementation
                                  (assigned(getprocvardef) and
                                   ((block_type=bt_const) or
                                    ((m_tp_procvar in aktmodeswitches) and
-                                    proc_to_procvar_equal(tprocsym(srsym).first_procdef,getprocvardef,false)
+                                    (proc_to_procvar_equal(tprocsym(srsym).first_procdef,getprocvardef)>te_incompatible)
                                    )
                                   )
                                  ),again,p1);
@@ -1608,7 +1603,7 @@ implementation
                       if (p1.resulttype.def.deftype=procvardef) then
                        begin
                          if assigned(getprocvardef) and
-                            is_equal(p1.resulttype.def,getprocvardef) then
+                            equal_defs(p1.resulttype.def,getprocvardef) then
                            again:=false
                          else
                            if (token=_LKLAMMER) or
@@ -2266,8 +2261,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.91  2002-11-22 22:48:10  carl
-  * memory optimization with tconstsym (1.5%)
+  Revision 1.92  2002-11-25 17:43:22  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.91  2002/11/22 22:48:10  carl
+   * memory optimization with tconstsym (1.5%)
 
   Revision 1.90  2002/11/20 22:49:55  pierre
    * commented check code tht was invalid in 1.1

compiler/pinline.pas

@@ -52,7 +52,7 @@ implementation
        globtype,tokens,verbose,
        systems,
        { symtable }
-       symconst,symdef,symsym,symtable,defbase,
+       symconst,symdef,symsym,symtable,defutil,
        { pass 1 }
        pass_1,htypechk,
        nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
@@ -657,7 +657,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.9  2002-10-29 10:01:22  pierre
+  Revision 1.10  2002-11-25 17:43:22  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.9  2002/10/29 10:01:22  pierre
    * fix crash report as webbug 2174
 
   Revision 1.8  2002/10/02 18:20:52  peter

compiler/powerpc/cpubase.pas

@@ -605,11 +605,11 @@ uses
   {the return_result_reg, is used inside the called function to store its return
   value when that is a scalar value otherwise a pointer to the address of the
   result is placed inside it}
-	return_result_reg		=	accumulator;
+        return_result_reg               =       accumulator;
 
   {the function_result_reg contains the function result after a call to a scalar
   function othewise it contains a pointer to the returned result}
-	function_result_reg	=	accumulator;
+        function_result_reg     =       accumulator;
       {# Hi-Results are returned in this register (64-bit value high register) }
       accumulatorhigh = R_4;
       { WARNING: don't change to R_ST0!! See comments above implementation of }
@@ -740,7 +740,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.37  2002-11-24 14:28:56  jonas
+  Revision 1.38  2002-11-25 17:43:27  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.37  2002/11/24 14:28:56  jonas
     + some comments describing the fields of treference
 
   Revision 1.36  2002/11/17 18:26:16  mazen

compiler/powerpc/cpupara.pas

@@ -44,7 +44,7 @@ unit cpupara;
        verbose,
        globtype,
        cpuinfo,cginfo,cgbase,
-       defbase;
+       defutil;
 
     function tppcparamanager.getintparaloc(nr : longint) : tparalocation;
 
@@ -295,7 +295,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.16  2002-11-18 17:32:01  peter
+  Revision 1.17  2002-11-25 17:43:27  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.16  2002/11/18 17:32:01  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.15  2002/10/02 13:33:36  jonas

compiler/powerpc/nppcadd.pas

@@ -54,7 +54,7 @@ interface
       globtype,systems,
       cutils,verbose,globals,
       symconst,symdef,paramgr,
-      aasmbase,aasmtai,aasmcpu,defbase,htypechk,
+      aasmbase,aasmtai,aasmcpu,defutil,htypechk,
       cgbase,cpuinfo,pass_1,pass_2,regvars,
       cpupara,
       ncon,nset,
@@ -1464,7 +1464,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.19  2002-10-21 18:08:05  jonas
+  Revision 1.20  2002-11-25 17:43:27  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.19  2002/10/21 18:08:05  jonas
     * some range errors fixed
 
   Revision 1.18  2002/09/08 14:14:49  jonas

compiler/powerpc/nppccal.pas

@@ -40,7 +40,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symbase,symsym,symtable,defbase,paramgr,
+      symconst,symbase,symsym,symtable,defutil,paramgr,
 {$ifdef GDB}
   {$ifdef delphi}
       sysutils,
@@ -121,7 +121,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  2002-08-17 09:23:49  florian
+  Revision 1.3  2002-11-25 17:43:28  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.2  2002/08/17 09:23:49  florian
     * first part of procinfo rewrite
 
   Revision 1.1  2002/08/13 21:40:59  florian

compiler/powerpc/nppccnv.pas

@@ -27,7 +27,7 @@ unit nppccnv;
 interface
 
     uses
-      node,ncnv,ncgcnv,defbase;
+      node,ncnv,ncgcnv,defcmp;
 
     type
        tppctypeconvnode = class(tcgtypeconvnode)
@@ -61,6 +61,7 @@ implementation
    uses
       verbose,globals,systems,
       symconst,symdef,aasmbase,aasmtai,
+      defutil,
       cgbase,pass_1,pass_2,
       ncon,ncal,
       ncgutil,
@@ -391,7 +392,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.26  2002-10-18 16:38:42  jonas
+  Revision 1.27  2002-11-25 17:43:28  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.26  2002/10/18 16:38:42  jonas
     + added entry for pwchar_to_string conversion addition
 
   Revision 1.25  2002/09/17 18:54:06  jonas

compiler/powerpc/nppcinl.pas

@@ -50,7 +50,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,fmodule,
-      symconst,symdef,defbase,
+      symconst,symdef,defutil,
       aasmbase,aasmtai,aasmcpu,
       cginfo,cgbase,pass_1,pass_2,
       cpubase,paramgr,
@@ -150,7 +150,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2002-09-18 09:19:37  jonas
+  Revision 1.4  2002-11-25 17:43:28  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.3  2002/09/18 09:19:37  jonas
     * fixed LOC_REFERENCE/LOC_CREFERENCE problems
 
   Revision 1.2  2002/08/19 17:35:42  jonas

compiler/powerpc/nppcmat.pas

@@ -55,7 +55,7 @@ implementation
       cutils,verbose,globals,
       symconst,symdef,
       aasmbase,aasmcpu,aasmtai,
-      defbase,
+      defutil,
       cgbase,cgobj,pass_1,pass_2,
       ncon,
       cpubase,cpuinfo,cginfo,
@@ -503,7 +503,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.19  2002-09-10 21:21:29  jonas
+  Revision 1.20  2002-11-25 17:43:28  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.19  2002/09/10 21:21:29  jonas
     * fixed unary minus of 64bit values
 
   Revision 1.18  2002/09/07 15:25:14  peter

compiler/powerpc/nppcset.pas

@@ -42,7 +42,7 @@ implementation
     uses
       globtype,systems,
       verbose,globals,
-      symconst,symdef,defbase,
+      symconst,symdef,defutil,
       paramgr,
       cpuinfo,
       pass_2,cgcpu,
@@ -156,7 +156,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2002-10-21 18:08:05  jonas
+  Revision 1.5  2002-11-25 17:43:28  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.4  2002/10/21 18:08:05  jonas
     * some range errors fixed
 
   Revision 1.3  2002/09/09 13:57:45  jonas

compiler/powerpc/radirect.pas

@@ -45,7 +45,7 @@ interface
        { aasm }
        aasmbase,aasmtai,aasmcpu,
        { symtable }
-       symconst,symbase,symtype,symsym,symtable,defbase,
+       symconst,symbase,symtype,symsym,symtable,defutil,
        { pass 1 }
        nbas,
        { parser }
@@ -314,7 +314,12 @@ initialization
 end.
 {
   $Log$
-  Revision 1.5  2002-09-03 19:04:18  daniel
+  Revision 1.6  2002-11-25 17:43:28  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.5  2002/09/03 19:04:18  daniel
     * Fixed PowerPC & M68000 compilation
 
   Revision 1.4  2002/09/03 16:26:28  daniel

compiler/pstatmnt.pas

@@ -46,7 +46,8 @@ implementation
        { aasm }
        cpubase,aasmbase,aasmtai,aasmcpu,
        { symtable }
-       symconst,symbase,symtype,symdef,symsym,symtable,defbase,paramgr,
+       symconst,symbase,symtype,symdef,symsym,symtable,defutil,defcmp,
+       paramgr,
        { pass 1 }
        pass_1,htypechk,
        nbas,nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,
@@ -1146,7 +1147,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.79  2002-11-18 17:31:58  peter
+  Revision 1.80  2002-11-25 17:43:22  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.79  2002/11/18 17:31:58  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.78  2002/09/07 19:34:08  florian

compiler/psub.pas

@@ -46,7 +46,8 @@ implementation
        { aasm }
        cpubase,cpuinfo,aasmbase,aasmtai,
        { symtable }
-       symconst,symbase,symdef,symsym,symtype,symtable,defbase,paramgr,
+       symconst,symbase,symdef,symsym,symtype,symtable,defutil,
+       paramgr,
        ppu,fmodule,
        { pass 1 }
        node,
@@ -804,7 +805,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.77  2002-11-23 22:50:06  carl
+  Revision 1.78  2002-11-25 17:43:23  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.77  2002/11/23 22:50:06  carl
     * some small speed optimizations
     + added several new warnings/hints
 

compiler/ptconst.pas

@@ -41,9 +41,9 @@ implementation
 {$else}
        strings,
 {$endif Delphi}
-       globtype,systems,tokens,
+       globtype,systems,tokens,verbose,
        cutils,globals,widestr,scanner,
-       symconst,symbase,symdef,aasmbase,aasmtai,aasmcpu,defbase,verbose,
+       symconst,symbase,symdef,aasmbase,aasmtai,aasmcpu,defutil,defcmp,
        { pass 1 }
        node,
        nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,
@@ -248,7 +248,7 @@ implementation
               p:=comp_expr(true);
               if (p.nodetype=typeconvn) and
                  (ttypeconvnode(p).left.nodetype in [addrn,niln]) and
-                 is_equal(t.def,p.resulttype.def) then
+                 equal_defs(t.def,p.resulttype.def) then
                 begin
                    hp:=ttypeconvnode(p).left;
                    ttypeconvnode(p).left:=nil;
@@ -477,7 +477,7 @@ implementation
               p:=comp_expr(true);
               if p.nodetype=ordconstn then
                 begin
-                  if is_equal(p.resulttype.def,t.def) or
+                  if equal_defs(p.resulttype.def,t.def) or
                      is_subequal(p.resulttype.def,t.def) then
                    begin
                      case p.resulttype.def.size of
@@ -985,7 +985,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.59  2002-11-22 22:48:10  carl
+  Revision 1.60  2002-11-25 17:43:23  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.59  2002/11/22 22:48:10  carl
   * memory optimization with tconstsym (1.5%)
 
   Revision 1.58  2002/11/09 15:31:57  carl

compiler/ptype.pas

@@ -60,7 +60,8 @@ implementation
        globals,tokens,verbose,
        systems,
        { symtable }
-       symconst,symbase,symdef,symsym,symtable,defbase,
+       symconst,symbase,symdef,symsym,symtable,
+       defutil,defcmp,
        { pass 1 }
        node,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
@@ -481,7 +482,7 @@ implementation
                             same type }
                           if is_integer(p.resulttype.def) or
                              is_char(p.resulttype.def) or
-                             is_equal(p.resulttype.def,aktenumdef) then
+                             equal_defs(p.resulttype.def,aktenumdef) then
                            v:=tordconstnode(p).value
                           else
                            Message2(type_e_incompatible_types,p.resulttype.def.typename,s32bittype.def.typename);
@@ -508,7 +509,7 @@ implementation
                           { we expect an integer or an enum of the
                             same type }
                           if is_integer(p.resulttype.def) or
-                             is_equal(p.resulttype.def,aktenumdef) then
+                             equal_defs(p.resulttype.def,aktenumdef) then
                            l:=tordconstnode(p).value
                           else
                            Message2(type_e_incompatible_types,p.resulttype.def.typename,s32bittype.def.typename);
@@ -640,7 +641,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.45  2002-09-27 21:13:29  carl
+  Revision 1.46  2002-11-25 17:43:23  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.45  2002/09/27 21:13:29  carl
     * low-highval always checked if limit ober 2GB is reached (to avoid overflow)
 
   Revision 1.44  2002/09/10 16:26:39  peter

compiler/rautils.pas

@@ -216,7 +216,7 @@ uses
 {$else}
   strings,
 {$endif}
-  defbase,systems,verbose,globals,
+  defutil,systems,verbose,globals,
   symsym,symtable,paramgr,
   aasmcpu,
   cgbase;
@@ -1592,7 +1592,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.49  2002-11-22 22:48:10  carl
+  Revision 1.50  2002-11-25 17:43:23  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.49  2002/11/22 22:48:10  carl
   * memory optimization with tconstsym (1.5%)
 
   Revision 1.48  2002/11/18 17:31:59  peter

compiler/regvars.pas

@@ -48,7 +48,7 @@ implementation
     uses
       globtype,systems,comphook,
       cutils,cclasses,verbose,globals,
-      symconst,symbase,symtype,symdef,paramgr,defbase,
+      symconst,symbase,symtype,symdef,paramgr,defutil,
       cgbase,cgobj,cgcpu,rgcpu;
 
 
@@ -469,7 +469,12 @@ end.
 
 {
   $Log$
-  Revision 1.42  2002-11-18 17:31:59  peter
+  Revision 1.43  2002-11-25 17:43:24  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.42  2002/11/18 17:31:59  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.41  2002/08/25 19:25:20  peter

compiler/sparc/cgcpu.pas

@@ -98,7 +98,7 @@ CONST
 IMPLEMENTATION
 USES
   globtype,globals,verbose,systems,cutils,
-  symdef,symsym,defbase,paramgr,
+  symdef,symsym,defutil,paramgr,
   rgobj,tgobj,rgcpu,cpupi;
     { we implement the following routines because otherwise we can't }
     { instantiate the class since it's abstract                      }
@@ -107,15 +107,15 @@ procedure tcgSPARC.a_param_reg(list:TAasmOutput;size:tcgsize;r:tregister;CONST L
     IF(Size<>OS_32)AND(Size<>OS_S32)
     THEN
       InternalError(2002032212);
-		with list,LocPara do
-		  case Loc of
-			  LOC_REGISTER:
-    			if r<>Register
-					then
-						Concat(taicpu.op_Reg_Reg_Reg(A_OR,r,R_G0,Register));
-				else
-				  InternalError(2002101002);
-			end;
+                with list,LocPara do
+                  case Loc of
+                          LOC_REGISTER:
+                        if r<>Register
+                                        then
+                                                Concat(taicpu.op_Reg_Reg_Reg(A_OR,r,R_G0,Register));
+                                else
+                                  InternalError(2002101002);
+                        end;
   end;
 procedure tcgSPARC.a_param_const(list:TAasmOutput;size:tcgsize;a:aword;CONST LocPara:TParaLocation);
   BEGIN
@@ -134,37 +134,37 @@ procedure tcgSPARC.a_param_ref(list:TAasmOutput;size:tcgsize;const r:TReference;
     ref: treference;
     tmpreg:TRegister;
   begin
-	  with LocPara do
-	    case locpara.loc of
-  	    LOC_REGISTER,LOC_CREGISTER:
-    	    a_load_ref_reg(list,size,r,Register);
-      	LOC_REFERENCE:
-        	begin
+          with LocPara do
+            case locpara.loc of
+            LOC_REGISTER,LOC_CREGISTER:
+            a_load_ref_reg(list,size,r,Register);
+        LOC_REFERENCE:
+                begin
           {Code conventions need the parameters being allocated in %o6+92. See
           comment on g_stack_frame}
-          	if locpara.sp_fixup<92
-          	then
-            	InternalError(2002081104);
-          	reference_reset(ref);
-          	ref.base:=locpara.reference.index;
-          	ref.offset:=locpara.reference.offset;
-          	tmpreg := get_scratch_reg_int(list);
-          	a_load_ref_reg(list,size,r,tmpreg);
-          	a_load_reg_ref(list,size,tmpreg,ref);
-          	free_scratch_reg(list,tmpreg);
-        	end;
-      	LOC_FPUREGISTER,LOC_CFPUREGISTER:
-        	case size of
-          	OS_32:
-            	a_loadfpu_ref_reg(list,OS_F32,r,locpara.register);
-	          OS_64:
-  	          a_loadfpu_ref_reg(list,OS_F64,r,locpara.register);
-    	    else
-      	    internalerror(2002072801);
-        	end;
-	    	else
-  	    	internalerror(2002081103);
-    	end;
+                if locpara.sp_fixup<92
+                then
+                InternalError(2002081104);
+                reference_reset(ref);
+                ref.base:=locpara.reference.index;
+                ref.offset:=locpara.reference.offset;
+                tmpreg := get_scratch_reg_int(list);
+                a_load_ref_reg(list,size,r,tmpreg);
+                a_load_reg_ref(list,size,tmpreg,ref);
+                free_scratch_reg(list,tmpreg);
+                end;
+        LOC_FPUREGISTER,LOC_CFPUREGISTER:
+                case size of
+                OS_32:
+                a_loadfpu_ref_reg(list,OS_F32,r,locpara.register);
+                  OS_64:
+                  a_loadfpu_ref_reg(list,OS_F64,r,locpara.register);
+            else
+            internalerror(2002072801);
+                end;
+                else
+                internalerror(2002081103);
+        end;
   end;
 procedure tcgSPARC.a_paramaddr_ref(list:TAasmOutput;CONST r:TReference;CONST LocPara:TParaLocation);
   VAR
@@ -833,7 +833,7 @@ procedure tcgSPARC.g_return_from_proc(list:TAasmOutput;parasize:aword);
 {According to the SPARC ABI, the stack is cleared using the RESTORE instruction
 which is genereted in the g_restore_frame_pointer. Notice that SPARC has no
 RETURN instruction and that JMPL is used instead. The JMPL instrucion have one
-delay slot, so an inversion is possible such as 
+delay slot, so an inversion is possible such as
   JMPL  %i7+8,%g0
   RESTORE  %g0,0,%g0
 If no inversion we can use just
@@ -1253,7 +1253,12 @@ BEGIN
 END.
 {
   $Log$
-  Revision 1.24  2002-11-17 17:49:09  mazen
+  Revision 1.25  2002-11-25 17:43:28  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.24  2002/11/17 17:49:09  mazen
   + return_result_reg and function_result_reg are now used, in all plateforms, to pass functions result between called function and its caller. See the explanation of each one
 
   Revision 1.23  2002/11/10 19:07:46  mazen

compiler/sparc/cpupara.pas

@@ -42,7 +42,7 @@ uses
   verbose,
   globtype,
   cpuinfo,cginfo,cgbase,
-  defbase;
+  defutil;
 function TSparcParaManager.GetIntParaLoc(nr:longint):TParaLocation;
   begin
     if nr<1
@@ -283,7 +283,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2002-11-18 17:32:01  peter
+  Revision 1.11  2002-11-25 17:43:28  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.10  2002/11/18 17:32:01  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.9  2002/11/03 20:22:40  mazen

compiler/sparc/naddcpu.pas

@@ -40,7 +40,7 @@ uses
   globtype,systems,
   cutils,verbose,globals,
   symconst,symdef,paramgr,
-  aasmbase,aasmtai,aasmcpu,defbase,htypechk,
+  aasmbase,aasmtai,aasmcpu,defutil,htypechk,
   cgbase,pass_2,regvars,
   cpupara,
   ncon,nset,
@@ -302,7 +302,7 @@ procedures }
     extra_not:=false;
     mboverflow:=false;
     cmpop:=false;
-    unsigned:=not(is_signed(left.resulttype.def))or 
+    unsigned:=not(is_signed(left.resulttype.def))or
               not(is_signed(right.resulttype.def));
     opsize:=def_opsize(left.resulttype.def);
     pass_left_and_right;
@@ -408,7 +408,12 @@ begin
 end.
 {
     $Log$
-    Revision 1.9  2002-11-10 19:07:46  mazen
+    Revision 1.10  2002-11-25 17:43:28  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.9  2002/11/10 19:07:46  mazen
     * SPARC calling mechanism almost OK (as in GCC./mppcsparc )
 
     Revision 1.8  2002/11/06 15:34:00  mazen

compiler/sparc/ncpucnv.pas

@@ -25,7 +25,7 @@ unit ncpucnv;
 interface
 
     uses
-      node,ncnv,ncgcnv,defbase;
+      node,ncnv,ncgcnv,defcmp;
 
     type
        TSparcTypeConvNode = class(TCgTypeConvNode)
@@ -59,6 +59,7 @@ implementation
    uses
       verbose,globals,systems,
       symconst,symdef,aasmbase,aasmtai,
+      defutil,
       cgbase,pass_1,pass_2,
       ncon,ncal,
       ncgutil,
@@ -374,7 +375,7 @@ implementation
            @second_char_to_char,
            @second_nothing,  { normal_2_smallset }
            @second_nothing,   { dynarray_2_openarray }
-					 @second_nothing
+                                         @second_nothing
          );
       type
          tprocedureofobject = procedure of object;
@@ -420,7 +421,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.7  2002-11-10 19:07:46  mazen
+  Revision 1.8  2002-11-25 17:43:28  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.7  2002/11/10 19:07:46  mazen
   * SPARC calling mechanism almost OK (as in GCC./mppcsparc )
 
   Revision 1.6  2002/11/06 11:31:24  mazen

compiler/sparc/radirect.pas

@@ -48,7 +48,7 @@ interface
        { aasm }
        aasmbase,aasmtai,aasmcpu,
        { symtable }
-       symconst,symbase,symtype,symsym,symtable,defbase,paramgr,
+       symconst,symbase,symtype,symsym,symtable,defutil,paramgr,
        { pass 1 }
        nbas,
        { parser }
@@ -314,7 +314,12 @@ initialization
 end.
 {
   $Log$
-  Revision 1.3  2002-11-18 17:32:01  peter
+  Revision 1.4  2002-11-25 17:43:29  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.3  2002/11/18 17:32:01  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.2  2002/09/19 20:24:47  mazen

compiler/symdef.pas

@@ -729,7 +729,7 @@ implementation
        systems,
        { symtable }
        symsym,symtable,paramgr,
-       defbase,
+       symutil,defutil,
        { module }
 {$ifdef GDB}
        gdb,
@@ -3526,7 +3526,7 @@ implementation
       begin
         s:=fullprocname;
         if assigned(rettype.def) and
-          not(is_equal(rettype.def,voidtype.def)) then
+          not(is_void(rettype.def)) then
                s:=s+' : '+rettype.def.gettypename;
         fullprocnamewithret:=s;
       end;
@@ -5537,7 +5537,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.109  2002-11-23 22:50:06  carl
+  Revision 1.110  2002-11-25 17:43:24  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.109  2002/11/23 22:50:06  carl
     * some small speed optimizations
     + added several new warnings/hints
 

compiler/symsym.pas

@@ -143,8 +143,7 @@ interface
                                          allowdefault:boolean):Tprocdef;
           function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
           function search_procdef_by1paradef(firstpara:Tdef):Tprocdef;
-          function search_procdef_byretdef_by1paradef(retdef,firstpara:Tdef;
-             matchtype:Tdefmatch; var pd : pprocdeflist):Tprocdef;
+          function search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
           function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
 {$ifdef GDB}
           function stabstring : pchar;override;
@@ -390,7 +389,7 @@ implementation
        { target }
        systems,
        { symtable }
-       symtable,defbase,
+       symtable,defutil,defcmp,
 {$ifdef GDB}
        gdb,
 {$endif GDB}
@@ -1021,72 +1020,58 @@ implementation
     function Tprocsym.search_procdef_bypara(params:Tparalinkedlist;
                                             allowconvert,
                                             allowdefault:boolean):Tprocdef;
-
       var
         pd:Pprocdeflist;
+        eq : tequaltype;
       begin
         search_procdef_bypara:=nil;
         pd:=defs;
         while assigned(pd) do
-            begin
-                if equal_paras(pd^.def.para,params,cp_value_equal_const,allowdefault) or
-                   (allowconvert and convertable_paras(pd^.def.para,params,
-                                                       cp_value_equal_const)) then
-                    begin
-                        search_procdef_bypara:=pd^.def;
-                        break;
-                    end;
-                pd:=pd^.next;
-            end;
-    end;
+         begin
+           eq:=compare_paras(pd^.def.para,params,cp_value_equal_const,allowdefault);
+           if (eq>=te_equal) or
+              (allowconvert and (eq>te_incompatible)) then
+             begin
+               search_procdef_bypara:=pd^.def;
+               break;
+             end;
+           pd:=pd^.next;
+         end;
+      end;
 
     function Tprocsym.search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
-    var pd:Pprocdeflist;
-        _result : tprocdef;
-    begin
-        {This function will return the pprocdef of pprocsym that
-         is the best match for procvardef. When there are multiple
-         matches it returns nil.}
-        {Try to find an exact match first.}
+      var
+        pd : Pprocdeflist;
+        eq,besteq : tequaltype;
+        bestpd : tprocdef;
+      begin
+        { This function will return the pprocdef of pprocsym that
+          is the best match for procvardef. When there are multiple
+          matches it returns nil.}
         search_procdef_byprocvardef:=nil;
-        _result := nil;
+        bestpd:=nil;
+        besteq:=te_incompatible;
         pd:=defs;
         while assigned(pd) do
-          begin
-            if proc_to_procvar_equal(pd^.def,d,true) then
-              begin
-                { already found a match ? Then stop and return nil }
-                if assigned(search_procdef_byprocvardef) then
-                  begin
-                    search_procdef_byprocvardef:=nil;
-                    break;
-                  end;
-                search_procdef_byprocvardef:=pd^.def;
-              end;
-            pd:=pd^.next;
-          end;
-        {Try a convertable match, if no exact match was found.}
-        if not assigned(_result) and not assigned(pd) then
+         begin
+           eq:=proc_to_procvar_equal(pd^.def,d);
+           if eq>te_incompatible then
             begin
-                pd:=defs;
-                while assigned(pd) do
-                    begin
-                        if proc_to_procvar_equal(pd^.def,d,false) then
-                            begin
-                                { already found a match ? Then stop and return nil }
-                                if assigned(_result) then
-                                    begin
-                                        search_procdef_byprocvardef:=nil;
-                                        _result := nil;
-                                        break;
-                                    end;
-                                search_procdef_byprocvardef:=pd^.def;
-                                _result:=pd^.def;
-                            end;
-                        pd:=pd^.next;
-                    end;
+              { multiple procvars with the same equal level }
+              if assigned(bestpd) and
+                 (besteq=eq) then
+                exit;
+              if eq>besteq then
+               begin
+                 besteq:=eq;
+                 bestpd:=pd^.def;
+               end;
             end;
-    end;
+           pd:=pd^.next;
+         end;
+        search_procdef_byprocvardef:=bestpd;
+      end;
+
 
     function Tprocsym.search_procdef_by1paradef(firstpara:Tdef):Tprocdef;
       var
@@ -1096,7 +1081,7 @@ implementation
         pd:=defs;
         while assigned(pd) do
           begin
-            if is_equal(Tparaitem(pd^.def.para.first).paratype.def,firstpara) and
+            if equal_defs(Tparaitem(pd^.def.para.first).paratype.def,firstpara) and
                (Tparaitem(pd^.def.para.first).next=nil) then
               begin
                 search_procdef_by1paradef:=pd^.def;
@@ -1107,40 +1092,39 @@ implementation
       end;
 
 
-    function Tprocsym.search_procdef_byretdef_by1paradef(retdef,firstpara:Tdef;
-                                                         matchtype:Tdefmatch; var pd : pprocdeflist):Tprocdef;
-
+    function Tprocsym.search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
       var
-        convtyp:tconverttype;
-        a,b:boolean;
-        oldpd : pprocdeflist;
-      begin
-        search_procdef_byretdef_by1paradef:=nil;
-        if not assigned(pd) then
-          pd:=defs;
+        convtyp : tconverttype;
+        pd : pprocdeflist;
+        bestpd : tprocdef;
+        eq,
+        besteq : tequaltype;
+        hpd : tprocdef;
+      begin
+        search_procdef_assignment_operator:=nil;
+        bestpd:=nil;
+        besteq:=te_incompatible;
+        pd:=defs;
         while assigned(pd) do
           begin
-            oldpd := pd;
-            a:=is_equal(retdef,pd^.def.rettype.def);
-            if a then
-              begin
-                case matchtype of
-                  dm_exact:
-                        b:=TParaItem(pd^.def.para.first).paratype.def=firstpara;
-                    dm_equal:
-                        b:=is_equal(Tparaitem(pd^.def.para.first).paratype.def,firstpara);
-                    dm_convertl1:
-                        b:=overloaded_assignment_isconvertable(firstpara,Tparaitem(pd^.def.para.first).paratype.def,
-                            convtyp,ordconstn,false,oldpd)=1;
+            if equal_defs(todef,pd^.def.rettype.def) then
+             begin
+               eq:=compare_defs_ext(fromdef,Tparaitem(pd^.def.para.first).paratype.def,
+                                    nothingn,false,false,convtyp,hpd);
+               if eq=te_exact then
+                begin
+                  search_procdef_assignment_operator:=pd^.def;
+                  exit;
+                end;
+               if eq>besteq then
+                begin
+                  bestpd:=pd^.def;
+                  besteq:=eq;
                 end;
-              end;
-            if a and b then
-              begin
-                search_procdef_byretdef_by1paradef:=pd^.def;
-                break;
               end;
             pd:=pd^.next;
           end;
+        search_procdef_assignment_operator:=bestpd;
       end;
 
 
@@ -2499,7 +2483,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.75  2002-11-23 22:50:09  carl
+  Revision 1.76  2002-11-25 17:43:26  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.75  2002/11/23 22:50:09  carl
     * some small speed optimizations
     + added several new warnings/hints
 

compiler/symutil.pas

@@ -0,0 +1,108 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    This unit provides some help routines for symbol handling
+
+    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 symutil;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+       cclasses,
+       cpuinfo,
+       globals,
+       node,
+       symconst,symbase,symtype,symdef,symsym;
+
+
+    function equal_constsym(sym1,sym2:tconstsym):boolean;
+
+    { returns true, if sym needs an entry in the proplist of a class rtti }
+    function needs_prop_entry(sym : tsym) : boolean;
+
+
+implementation
+
+    uses
+       globtype,tokens,systems,verbose,
+       symtable;
+
+
+    function needs_prop_entry(sym : tsym) : boolean;
+
+      begin
+         needs_prop_entry:=(sp_published in tsym(sym).symoptions) and
+         (sym.typ in [propertysym,varsym]);
+      end;
+
+
+    function equal_constsym(sym1,sym2:tconstsym):boolean;
+      var
+        p1,p2,pend : pchar;
+      begin
+        equal_constsym:=false;
+        if sym1.consttyp<>sym2.consttyp then
+         exit;
+        case sym1.consttyp of
+           constint,
+           constbool,
+           constchar,
+           constord :
+             equal_constsym:=(sym1.value.valueord=sym2.value.valueord);
+           constpointer :
+             equal_constsym:=(sym1.value.valueordptr=sym2.value.valueordptr);
+           conststring,constresourcestring :
+             begin
+               if sym1.value.len=sym2.value.len then
+                begin
+                  p1:=pchar(sym1.value.valueptr);
+                  p2:=pchar(sym2.value.valueptr);
+                  pend:=p1+sym1.value.len;
+                  while (p1<pend) do
+                   begin
+                     if p1^<>p2^ then
+                      break;
+                     inc(p1);
+                     inc(p2);
+                   end;
+                  if (p1=pend) then
+                   equal_constsym:=true;
+                end;
+             end;
+           constreal :
+             equal_constsym:=(pbestreal(sym1.value.valueptr)^=pbestreal(sym2.value.valueptr)^);
+           constset :
+             equal_constsym:=(pnormalset(sym1.value.valueptr)^=pnormalset(sym2.value.valueptr)^);
+           constnil :
+             equal_constsym:=true;
+        end;
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2002-11-25 17:43:26  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
+
+}

compiler/x86/cgx86.pas

@@ -147,7 +147,7 @@ unit cgx86;
 
     uses
        globtype,globals,verbose,systems,cutils,
-       symdef,symsym,defbase,paramgr,
+       symdef,symsym,defutil,paramgr,
        rgobj,tgobj,rgcpu;
 
 {$ifndef NOTARGETWIN32}
@@ -1682,7 +1682,12 @@ unit cgx86;
 end.
 {
   $Log$
-  Revision 1.21  2002-11-18 17:32:01  peter
+  Revision 1.22  2002-11-25 17:43:29  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.21  2002/11/18 17:32:01  peter
     * pass proccalloption to ret_in_xxx and push_xxx functions
 
   Revision 1.20  2002/11/09 21:18:31  carl