* some variant <-> dyn. array stuff

compiler/defbase.pas

@@ -0,0 +1,2251 @@
+{
+    $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,
+          tc_variant_2_dynarray,
+          tc_dynarray_2_variant
+       );
+
+    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;
+                    variantdef :
+                      begin
+                         if is_dynamic_array(def_to) then
+                           begin
+                              doconv:=tc_variant_2_dynarray;
+                              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
+               begin
+                  {
+                  if ((def_from.deftype=orddef) and (torddef(def_from).typ=s32bit)) or
+                    ((def_to.deftype=orddef) and (torddef(def_to).typ=s32bit)) then
+                    b:=1
+                  else
+                  }
+                    b:=2;
+               end;
+          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.29  2002-12-05 14:27:25  florian
+    * some variant <-> dyn. array stuff
+
+  Revision 1.28  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.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

@@ -39,7 +39,7 @@ interface
        tequaltype = (
          te_incompatible,
          te_convert_operator,
-         te_convert_l2,     { compatible conversion with possible loss of data }     
+         te_convert_l2,     { compatible conversion with possible loss of data }
          te_convert_l1,     { compatible conversion     }
          te_equal,          { the definitions are equal }
          te_exact
@@ -78,7 +78,9 @@ interface
           tc_char_2_char,
           tc_normal_2_smallset,
           tc_dynarray_2_openarray,
-          tc_pwchar_2_string
+          tc_pwchar_2_string,
+          tc_variant_2_dynarray,
+          tc_dynarray_2_variant
        );
 
     function compare_defs_ext(def_from,def_to : tdef;
@@ -551,6 +553,14 @@ implementation
                             b:=te_convert_l1;
                           end;
                       end;
+                    variantdef :
+                      begin
+                         if is_dynamic_array(def_to) then
+                           begin
+                              doconv:=tc_variant_2_dynarray;
+                              b:=te_convert_l1;
+                           end;
+                      end;
                   end;
                 end;
              end;
@@ -1149,7 +1159,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2002-12-01 22:07:41  carl
+  Revision 1.5  2002-12-05 14:27:26  florian
+    * some variant <-> dyn. array stuff
+
+  Revision 1.4  2002/12/01 22:07:41  carl
     * warning of portabilitiy problems with parasize / localsize
     + some added documentation
 
@@ -1164,4 +1177,4 @@ end.
     * merged isconvertable and is_equal into compare_defs(_ext)
     * made operator search faster by walking the list only once
 
-}
+}

compiler/i386/n386cnv.pas

@@ -354,7 +354,9 @@ implementation
            {$ifdef fpc}@{$endif}second_char_to_char,
            {$ifdef fpc}@{$endif}second_nothing,  { normal_2_smallset }
            {$ifdef fpc}@{$endif}second_nothing,  { dynarray_2_openarray }
-           {$ifdef fpc}@{$endif}second_nothing   { pwchar_2_string }
+           {$ifdef fpc}@{$endif}second_nothing,  { pwchar_2_string }
+           {$ifdef fpc}@{$endif}second_nothing,  { variant_2_dynarray }
+           {$ifdef fpc}@{$endif}second_nothing   { dynarray_2_variant}
          );
       type
          tprocedureofobject = procedure of object;
@@ -404,6 +406,10 @@ implementation
           tc_char_2_char : second_char_to_char;
           tc_normal_2_smallset : second_nothing;
           tc_dynarray_2_openarray : second_nothing;
+          tc_pwchar_2_string : second_nothing;
+          tc_variant_2_dynarray : second_nothing;
+          tc_dynarray_2_variant : second_nothing;
+          else internalerror(2002101101);
         end;
      end;
 {$endif}
@@ -413,7 +419,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.52  2002-11-25 17:43:26  peter
+  Revision 1.53  2002-12-05 14:27:42  florian
+    * some variant <-> dyn. array stuff
+
+  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

compiler/m68k/n68kcnv.pas

@@ -248,7 +248,9 @@ implementation
            @second_char_to_char,
            @second_nothing,  { normal_2_smallset }
            @second_nothing,  { dynarray_2_openarray }
-           @second_nothing   { tc_pwchar_2_string   }
+           @second_nothing,  { tc_pwchar_2_string   }
+           {$ifdef fpc}@{$endif}second_nothing,  { variant_2_dynarray }
+           {$ifdef fpc}@{$endif}second_nothing   { dynarray_2_variant}
          );
       type
          tprocedureofobject = procedure of object;
@@ -294,7 +296,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2002-11-25 17:43:27  peter
+  Revision 1.7  2002-12-05 14:27:53  florian
+    * some variant <-> dyn. array stuff
+
+  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
@@ -317,4 +322,4 @@ end.
     * out of bound references should now be handled correctly
 
 
-}
+}

compiler/ncnv.pas

@@ -69,6 +69,8 @@ interface
           function resulttype_interface_to_guid : tnode;
           function resulttype_dynarray_to_openarray : tnode;
           function resulttype_pwchar_to_string : tnode;
+          function resulttype_variant_to_dynarray : tnode;
+          function resulttype_dynarray_to_variant : tnode;
           function resulttype_call_helper(c : tconverttype) : tnode;
        protected
           function first_int_to_int : tnode;virtual;
@@ -311,12 +313,12 @@ implementation
         hp : tarrayconstructornode;
       begin
         if p.nodetype<>arrayconstructorn then
-         internalerror(200205105);
-  new(constset);
+          internalerror(200205105);
+        new(constset);
       {$ifdef oldset}
         FillChar(constset^,sizeof(constset^),0);
       {$else}
-  constset^:=[];
+        constset^:=[];
       {$endif}
         htype.reset;
         constsetlo:=0;
@@ -900,6 +902,7 @@ implementation
         result.resulttype := resulttype;
       end;
 
+
     function ttypeconvnode.resulttype_pwchar_to_string : tnode;
 
       begin
@@ -910,6 +913,24 @@ implementation
       end;
 
 
+    function ttypeconvnode.resulttype_variant_to_dynarray : tnode;
+
+      begin
+        result := ccallnode.createinternres(
+          'fpc_variant_to_dynarray',
+          ccallparanode.create(caddrnode.create(crttinode.create(tstoreddef(resulttype.def),initrtti)),
+            ccallparanode.create(left,nil)
+          ),resulttype);
+        left := nil;
+      end;
+
+
+    function ttypeconvnode.resulttype_dynarray_to_variant : tnode;
+
+      begin
+      end;
+
+
     function ttypeconvnode.resulttype_call_helper(c : tconverttype) : tnode;
 {$ifdef fpc}
       const
@@ -943,7 +964,9 @@ implementation
           { char_2_char } @ttypeconvnode.resulttype_char_to_char,
           { normal_2_smallset} nil,
           { dynarray_2_openarray} @resulttype_dynarray_to_openarray,
-          { pwchar_2_string} @resulttype_pwchar_to_string
+          { pwchar_2_string} @resulttype_pwchar_to_string,
+          { variant_2_dynarray} @resulttype_variant_to_dynarray,
+          { dynarray_2_variant} @resulttype_dynarray_to_variant
          );
       type
          tprocedureofobject = function : tnode of object;
@@ -980,6 +1003,8 @@ implementation
           tc_char_2_char : resulttype_char_to_char;
           tc_dynarray_2_openarray : resulttype_dynarray_to_openarray;
           tc_pwchar_2_string : resulttype_pwchar_to_string;
+          tc_variant_2_dynarray : resulttype_variant_to_dynarray;
+          tc_dynarray_2_variant : resulttype_dynarray_to_variant;
         end;
       end;
 {$Endif fpc}
@@ -1672,6 +1697,8 @@ implementation
            @ttypeconvnode._first_char_to_char,
            @ttypeconvnode._first_nothing,
            @ttypeconvnode._first_nothing,
+           nil,
+           nil,
            nil
          );
       type
@@ -1994,7 +2021,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.93  2002-11-30 10:45:14  carl
+  Revision 1.94  2002-12-05 14:27:26  florian
+    * some variant <-> dyn. array stuff
+
+  Revision 1.93  2002/11/30 10:45:14  carl
     * fix bug with checking of duplicated items in sets (new sets bug only)
 
   Revision 1.92  2002/11/27 19:43:21  carl

compiler/powerpc/nppccal.pas

@@ -74,27 +74,17 @@ implementation
   procedure tppccallnode.load_framepointer;
 
     begin
-       { if we call a nested function in a method, we must      }
-       { push also SELF!                                        }
-       { THAT'S NOT TRUE, we have to load ESI via frame pointer }
-       { access                                                 }
-       {
-         begin
-            loadesi:=false;
-            emit_reg(A_PUSH,S_L,R_ESI);
-         end;
-       }
        {
        if lexlevel=(tprocdef(procdefinition).parast.symtablelevel) then
          begin
             reference_reset_base(href,procinfo^.framepointer,procinfo^.framepointer_offset);
-            cg.a_param_ref(exprasmlist,OS_ADDR,href,-1);
+            cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getframepointerloc(procinfo.procdef));
          end
          { this is only true if the difference is one !!
            but it cannot be more !! }
        else if (lexlevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
          begin
-            cg.a_param_reg(exprasmlist,OS_ADDR,procinfo^.framepointer,-1);
+            cg.a_param_reg(exprasmlist,OS_ADDR,procinfo^.framepointer,paramanager.getframepointerloc(procinfo.procdef));
          end
        else if (lexlevel>(tprocdef(procdefinition).parast.symtablelevel)) then
          begin
@@ -121,7 +111,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2002-11-25 17:43:28  peter
+  Revision 1.4  2002-12-05 14:28:12  florian
+    * some variant <-> dyn. array stuff
+
+  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

compiler/powerpc/nppccnv.pas

@@ -346,7 +346,9 @@ implementation
            @second_char_to_char,
            @second_nothing,  { normal_2_smallset }
            @second_nothing,   { dynarray_2_openarray }
-           @second_nothing
+           @second_nothing,
+           {$ifdef fpc}@{$endif}second_nothing,  { variant_2_dynarray }
+           {$ifdef fpc}@{$endif}second_nothing   { dynarray_2_variant}
          );
       type
          tprocedureofobject = procedure of object;
@@ -392,7 +394,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.27  2002-11-25 17:43:28  peter
+  Revision 1.28  2002-12-05 14:28:13  florian
+    * some variant <-> dyn. array stuff
+
+  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
@@ -474,4 +479,4 @@ end.
   Revision 1.5  2002/04/06 18:13:02  jonas
     * several powerpc-related additions and fixes
 
-}
+}

compiler/sparc/ncpucnv.pas

@@ -375,7 +375,9 @@ implementation
            @second_char_to_char,
            @second_nothing,  { normal_2_smallset }
            @second_nothing,   { dynarray_2_openarray }
-                                         @second_nothing
+           @second_nothing,
+           {$ifdef fpc}@{$endif}second_nothing,  { variant_2_dynarray }
+           {$ifdef fpc}@{$endif}second_nothing   { dynarray_2_variant}
          );
       type
          tprocedureofobject = procedure of object;
@@ -421,7 +423,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  2002-11-25 17:43:28  peter
+  Revision 1.9  2002-12-05 14:28:03  florian
+    * some variant <-> dyn. array stuff
+
+  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
@@ -514,4 +519,4 @@ end.
   + generic constructor calls
   + start of tassembler / tmodulebase class cleanup
 
-}
+}