* fixed overloading of array of char

compiler/cg386cnv.pas

@@ -161,8 +161,6 @@ implementation
     type
       tsecondconvproc = procedure(pto,pfrom : ptree;convtyp : tconverttype);
 
-{$ifndef OLDCNV}
-
     procedure second_int_to_int(pto,pfrom : ptree;convtyp : tconverttype);
       var
         op        : tasmop;
@@ -238,355 +236,6 @@ implementation
           end;
       end;
 
-{$else}
-
-    procedure maybe_rangechecking(p : ptree;p2,p1 : pdef);
-     {
-       produces if necessary rangecheckcode
-     }
-       var
-          hp : preference;
-          hregister : tregister;
-          neglabel,poslabel : plabel;
-          is_register : boolean;
-      begin
-         { convert from p2 to p1 }
-         { range check from enums is not made yet !!}
-         { and its probably not easy }
-         if (p1^.deftype<>orddef) or (p2^.deftype<>orddef) then
-           exit;
-         { range checking is different for u32bit }
-         { lets try to generate it allways }
-         if (cs_check_range in aktlocalswitches)  and
-           { with $R+ explicit type conversations in TP aren't range checked! }
-           (not(p^.explizit) {or not(cs_tp_compatible in aktmoduleswitches)}) and
-           ((porddef(p1)^.low>porddef(p2)^.low) or
-           (porddef(p1)^.high<porddef(p2)^.high) or
-           (porddef(p1)^.typ=u32bit) or
-           (porddef(p2)^.typ=u32bit)) then
-           begin
-              porddef(p1)^.genrangecheck;
-              is_register:=(p^.location.loc=LOC_REGISTER) or
-                (p^.location.loc=LOC_CREGISTER);
-              if porddef(p2)^.typ=u8bit then
-                begin
-                   if is_register then
-                     exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,p^.location.register,R_EDI)))
-                   else
-                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.location.reference),R_EDI)));
-                   hregister:=R_EDI;
-                end
-              else if porddef(p2)^.typ=s8bit then
-                begin
-                   if is_register then
-                     exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_BL,p^.location.register,R_EDI)))
-                   else
-                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_BL,newreference(p^.location.reference),R_EDI)));
-                   hregister:=R_EDI;
-                end
-              { rangechecking for u32bit ?? !!!!!!}
-              { lets try }
-              else if (porddef(p2)^.typ=s32bit) or (porddef(p2)^.typ=u32bit)  then
-                begin
-                   if is_register then
-                     hregister:=p^.location.register
-                   else
-                     begin
-                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),R_EDI)));
-                        hregister:=R_EDI;
-                     end;
-                end
-              else if porddef(p2)^.typ=u16bit then
-                begin
-                   if is_register then
-                     exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,p^.location.register,R_EDI)))
-                   else
-                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.location.reference),R_EDI)));
-                   hregister:=R_EDI;
-                end
-              else if porddef(p2)^.typ=s16bit then
-                begin
-                   if is_register then
-                     exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_WL,p^.location.register,R_EDI)))
-                   else
-                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,newreference(p^.location.reference),R_EDI)));
-                   hregister:=R_EDI;
-                end
-              else internalerror(6);
-              hp:=new_reference(R_NO,0);
-              hp^.symbol:=newasmsymbol(porddef(p1)^.getrangecheckstring);
-              if porddef(p1)^.low>porddef(p1)^.high then
-                begin
-                   getlabel(neglabel);
-                   getlabel(poslabel);
-                   exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,hregister,hregister)));
-                   emitl(A_JL,neglabel);
-                end;
-              exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hp)));
-              if porddef(p1)^.low>porddef(p1)^.high then
-                begin
-                   hp:=new_reference(R_NO,0);
-                   hp^.symbol:=newasmsymbol(porddef(p1)^.getrangecheckstring);
-                   { second part here !! }
-                   hp^.offset:=8;
-                   emitjmp(C_None,poslabel);
-                   emitlab(neglabel);
-                   exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hp)));
-                   emitlab(poslabel);
-                end;
-           end;
-      end;
-
-
-    procedure second_only_rangecheck(pto,pfrom : ptree;convtyp : tconverttype);
-
-      begin
-         maybe_rangechecking(pto,pfrom^.resulttype,pto^.resulttype);
-      end;
-
-
-    procedure second_smaller(pto,pfrom : ptree;convtyp : tconverttype);
-
-      var
-         hregister,destregister : tregister;
-         ref : boolean;
-         hpp : preference;
-
-      begin
-         ref:=false;
-         { problems with enums !! }
-         if (cs_check_range in aktlocalswitches)  and
-           { with $R+ explicit type conversations in TP aren't range checked! }
-           (not(pto^.explizit) {or not(cs_tp_compatible in aktmoduleswitches)}) and
-           (pto^.resulttype^.deftype=orddef) and
-           (pfrom^.resulttype^.deftype=orddef) then
-           begin
-              if porddef(pfrom^.resulttype)^.typ=u32bit then
-                begin
-                   { when doing range checking for u32bit, we have some trouble }
-                   { because BOUND assumes signed values                        }
-                   { first, we check if the values is greater than 2^31:        }
-                   { the u32bit rangenr contains the appropriate rangenr        }
-                   porddef(pfrom^.resulttype)^.genrangecheck;
-                   hregister:=R_EDI;
-                   if (pto^.location.loc=LOC_REGISTER) or
-                      (pto^.location.loc=LOC_CREGISTER) then
-                     hregister:=pto^.location.register
-                   else
-                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                       newreference(pto^.location.reference),R_EDI)));
-                   hpp:=new_reference(R_NO,0);
-                   hpp^.symbol:=newasmsymbol(porddef(pfrom^.resulttype)^.getrangecheckstring);
-                   exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
-
-                   { then we do a normal range check }
-                   porddef(pto^.resulttype)^.genrangecheck;
-                   hpp:=new_reference(R_NO,0);
-                   hpp^.symbol:=newasmsymbol(porddef(pto^.resulttype)^.getrangecheckstring);
-                   exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
-                end
-              else
-                if ((porddef(pto^.resulttype)^.low>porddef(pfrom^.resulttype)^.low) or
-                (porddef(pto^.resulttype)^.high<porddef(pfrom^.resulttype)^.high)) then
-                begin
-                   porddef(pto^.resulttype)^.genrangecheck;
-                   { per default the var is copied to EDI }
-                   hregister:=R_EDI;
-                   if porddef(pfrom^.resulttype)^.typ=s32bit then
-                     begin
-                        if (pto^.location.loc=LOC_REGISTER) or
-                           (pto^.location.loc=LOC_CREGISTER) then
-                          hregister:=pto^.location.register
-                        else
-                          exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(pto^.location.reference),R_EDI)));
-                     end
-                   else if porddef(pfrom^.resulttype)^.typ=u16bit then
-                     begin
-                        if (pto^.location.loc=LOC_REGISTER) or
-                           (pto^.location.loc=LOC_CREGISTER) then
-                          exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,pto^.location.register,R_EDI)))
-                        else
-                          exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,
-                            newreference(pto^.location.reference),R_EDI)));
-                     end
-                   else if porddef(pfrom^.resulttype)^.typ=s16bit then
-                     begin
-                        if (pto^.location.loc=LOC_REGISTER) or
-                           (pto^.location.loc=LOC_CREGISTER) then
-                          exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_WL,pto^.location.register,R_EDI)))
-                        else
-                          exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,
-                            newreference(pto^.location.reference),R_EDI)));
-                     end
-                   else internalerror(6);
-                   hpp:=new_reference(R_NO,0);
-                   hpp^.symbol:=newasmsymbol(porddef(pto^.resulttype)^.getrangecheckstring);
-                   exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
-                   (*
-                   if (p^.location.loc=LOC_REGISTER) or
-                      (p^.location.loc=LOC_CREGISTER) then
-                     begin
-                        destregister:=pfrom^.location.register;
-                        case convtyp of
-                           tc_s32bit_2_s8bit,
-                           tc_s32bit_2_u8bit:
-                             destregister:=reg32toreg8(destregister);
-                           tc_s32bit_2_s16bit,
-                           tc_s32bit_2_u16bit:
-                             destregister:=reg32toreg16(destregister);
-                           { this was false because destregister is allways a 32bitreg }
-                           tc_s16bit_2_s8bit,
-                           tc_s16bit_2_u8bit,
-                           tc_u16bit_2_s8bit,
-                           tc_u16bit_2_u8bit:
-                             destregister:=reg32toreg8(destregister);
-                        end;
-                   p^.location.register:=destregister;
-                   exit;
-                   *)
-                end;
-           end;
-         { p^.location.loc is already set! }
-         if (pto^.location.loc=LOC_REGISTER) or
-           (pto^.location.loc=LOC_CREGISTER) then
-           begin
-              destregister:=pfrom^.location.register;
-              case convtyp of
-                 tc_s32bit_2_s8bit,
-                 tc_s32bit_2_u8bit:
-                   destregister:=reg32toreg8(destregister);
-                 tc_s32bit_2_s16bit,
-                 tc_s32bit_2_u16bit:
-                   destregister:=reg32toreg16(destregister);
-                 tc_s16bit_2_s8bit,
-                 tc_s16bit_2_u8bit,
-                 tc_u16bit_2_s8bit,
-                 tc_u16bit_2_u8bit:
-                   destregister:=reg16toreg8(destregister);
-              end;
-              pto^.location.register:=destregister;
-           end;
-      end;
-
-    procedure second_bigger(pto,pfrom : ptree;convtyp : tconverttype);
-
-      var
-         hregister : tregister;
-         opsize : topsize;
-         op : tasmop;
-         is_register : boolean;
-
-      begin
-           is_register:=pfrom^.location.loc=LOC_REGISTER;
-           if not(is_register) and (pfrom^.location.loc<>LOC_CREGISTER) then
-             begin
-                del_reference(pfrom^.location.reference);
-                { we can do this here as we need no temp inside second_bigger }
-                ungetiftemp(pfrom^.location.reference);
-             end;
-         { this is wrong !!!
-         gives me movl (%eax),%eax
-         for the length(string !!!
-         use only for constant values }
-           {Constant cannot be loaded into registers using MOVZX!}
-           if (pfrom^.location.loc<>LOC_MEM) or (not pfrom^.location.reference.is_immediate) then
-                case convtyp of
-                    tc_u8bit_2_s32bit,tc_u8bit_2_u32bit :
-                      begin
-                          if is_register then
-                            hregister:=reg8toreg32(pfrom^.location.register)
-                          else hregister:=getregister32;
-                          op:=A_MOVZX;
-                          opsize:=S_BL;
-                      end;
-                    { here what do we do for negative values ? }
-                    tc_s8bit_2_s32bit,tc_s8bit_2_u32bit :
-                      begin
-                          if is_register then
-                            hregister:=reg8toreg32(pfrom^.location.register)
-                          else hregister:=getregister32;
-                          op:=A_MOVSX;
-                          opsize:=S_BL;
-                      end;
-                    tc_u16bit_2_s32bit,tc_u16bit_2_u32bit :
-                      begin
-                          if is_register then
-                            hregister:=reg16toreg32(pfrom^.location.register)
-                          else hregister:=getregister32;
-                          op:=A_MOVZX;
-                          opsize:=S_WL;
-                      end;
-                    tc_s16bit_2_s32bit,tc_s16bit_2_u32bit :
-                      begin
-                          if is_register then
-                            hregister:=reg16toreg32(pfrom^.location.register)
-                          else hregister:=getregister32;
-                          op:=A_MOVSX;
-                          opsize:=S_WL;
-                      end;
-                    tc_s8bit_2_u16bit,
-                    tc_u8bit_2_s16bit,
-                    tc_u8bit_2_u16bit :
-                      begin
-                          if is_register then
-                            hregister:=reg8toreg16(pfrom^.location.register)
-                          else hregister:=reg32toreg16(getregister32);
-                          op:=A_MOVZX;
-                          opsize:=S_BW;
-                      end;
-                    tc_s8bit_2_s16bit :
-                      begin
-                          if is_register then
-                            hregister:=reg8toreg16(pfrom^.location.register)
-                          else hregister:=reg32toreg16(getregister32);
-                          op:=A_MOVSX;
-                          opsize:=S_BW;
-                      end;
-                end
-           else
-                case convtyp of
-                    tc_u8bit_2_s32bit,
-                    tc_s8bit_2_s32bit,
-                    tc_u16bit_2_s32bit,
-                    tc_s16bit_2_s32bit,
-                    tc_u8bit_2_u32bit,
-                    tc_s8bit_2_u32bit,
-                    tc_u16bit_2_u32bit,
-                    tc_s16bit_2_u32bit:
-                      begin
-                         hregister:=getregister32;
-                         op:=A_MOV;
-                         opsize:=S_L;
-                      end;
-                    tc_s8bit_2_u16bit,
-                    tc_s8bit_2_s16bit,
-                    tc_u8bit_2_s16bit,
-                    tc_u8bit_2_u16bit:
-                      begin
-                         hregister:=reg32toreg16(getregister32);
-                         op:=A_MOV;
-                         opsize:=S_W;
-                     end;
-                end;
-           if is_register then
-             begin
-                 emit_reg_reg(op,opsize,pfrom^.location.register,hregister);
-             end
-           else
-             begin
-                 if pfrom^.location.loc=LOC_CREGISTER then
-                    emit_reg_reg(op,opsize,pfrom^.location.register,hregister)
-                 else exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,
-                    newreference(pfrom^.location.reference),hregister)));
-             end;
-           clear_location(pto^.location);
-           pto^.location.loc:=LOC_REGISTER;
-           pto^.location.register:=hregister;
-           maybe_rangechecking(pfrom,pfrom^.resulttype,pto^.resulttype);
-       end;
-
-{$endif}
-
     var
        ltemptoremove : plinkedlist;
 
@@ -803,35 +452,61 @@ implementation
     { to a string                                                        }
     procedure second_chararray_to_string(pto,pfrom : ptree;convtyp : tconverttype);
       var
+         pushed : tpushed;
          l : longint;
       begin
+         { calc the length of the array }
+         l:=parraydef(pfrom^.resulttype)^.highrange-parraydef(pfrom^.resulttype)^.lowrange+1;
          { this is a type conversion which copies the data, so we can't }
          { return a reference                                             }
          clear_location(pto^.location);
          pto^.location.loc:=LOC_MEM;
-         { first get the memory for the string }
-         gettempofsizereference(256,pto^.location.reference);
-
-         { calc the length of the array }
-         l:=parraydef(pfrom^.resulttype)^.highrange-
-           parraydef(pfrom^.resulttype)^.lowrange+1;
-
-         if l>255 then
-           CGMessage(type_e_mismatch);
-
-         { write the length }
-             exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,l,
-               newreference(pto^.location.reference))));
-
-         { copy to first char of string }
-         inc(pto^.location.reference.offset);
-
-         { generates the copy code      }
-         { and we need the source never }
-         concatcopy(pfrom^.location.reference,pto^.location.reference,l,true,false);
-
-         { correct the string location }
-         dec(pto^.location.reference.offset);
+         case pstringdef(pto^.resulttype)^.string_typ of
+           st_shortstring :
+             begin
+               if l>255 then
+                begin
+                  CGMessage(type_e_mismatch);
+                  l:=255;
+                end;
+               { first get the memory for the string }
+               gettempofsizereference(256,pto^.location.reference);
+               { write the length }
+               exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,l,
+                 newreference(pto^.location.reference))));
+               { copy to first char of string }
+               inc(pto^.location.reference.offset);
+               { generates the copy code      }
+               { and we need the source never }
+               concatcopy(pfrom^.location.reference,pto^.location.reference,l,true,false);
+               { correct the string location }
+               dec(pto^.location.reference.offset);
+             end;
+           st_ansistring :
+             begin
+               gettempofsizereference(4,pto^.location.reference);
+               ltemptoremove^.concat(new(ptemptodestroy,init(pto^.location.reference,pto^.resulttype)));
+               exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,0,newreference(pto^.location.reference))));
+               release_loc(pfrom^.location);
+               pushusedregisters(pushed,$ff);
+               push_int(l);
+               emitpushreferenceaddr(exprasmlist,pfrom^.location.reference);
+               emitpushreferenceaddr(exprasmlist,pto^.location.reference);
+               emitcall('FPC_CHARARRAY_TO_ANSISTR',true);
+               popusedregisters(pushed);
+               maybe_loadesi;
+             end;
+           st_longstring:
+             begin
+               {!!!!!!!}
+               internalerror(8888);
+             end;
+           st_widestring:
+             begin
+               {!!!!!!!}
+               internalerror(8888);
+             end;
+        end;
       end;
 
 
@@ -1127,7 +802,6 @@ implementation
          getlabel(truelabel);
          getlabel(falselabel);
          secondpass(pfrom);
-{$ifndef OLDBOOL}
          { byte(boolean) or word(wordbool) or longint(longbool) must
          be accepted for var parameters }
          if (pto^.explizit) and
@@ -1141,7 +815,6 @@ implementation
               falselabel:=oldfalselabel;
               exit;
            end;
-{$endif ndef OLDBOOL}
          clear_location(pto^.location);
          pto^.location.loc:=LOC_REGISTER;
          del_reference(pfrom^.location.reference);
@@ -1248,7 +921,6 @@ implementation
         hregister : tregister;
       begin
          clear_location(pto^.location);
-{$ifndef OLDBOOL}
          { byte(boolean) or word(wordbool) or longint(longbool) must
          be accepted for var parameters }
          if (pto^.explizit) and
@@ -1258,7 +930,6 @@ implementation
               set_location(pto^.location,pfrom^.location);
               exit;
            end;
-{$endif ndef OLDBOOL}
          pto^.location.loc:=LOC_REGISTER;
          del_reference(pfrom^.location.reference);
          case pfrom^.location.loc of
@@ -1426,7 +1097,6 @@ implementation
     procedure secondtypeconv(var p : ptree);
       const
          secondconvert : array[tconverttype] of tsecondconvproc = (
-{$ifndef OLDCNV}
            second_nothing, {equal}
            second_nothing, {not_possible}
            second_string_to_string,
@@ -1451,39 +1121,8 @@ implementation
            second_nothing, {arrayconstructor_to_set}
            second_load_smallset
          );
-{$else}
-           second_nothing,second_nothing,
-           second_bigger,second_only_rangecheck,
-           second_bigger,second_bigger,second_bigger,
-           second_smaller,second_smaller,
-           second_smaller,second_string_to_string,
-           second_cstring_to_pchar,second_string_to_chararray,
-           second_array_to_pointer,second_pointer_to_array,
-           second_char_to_string,second_bigger,
-           second_bigger,second_bigger,
-           second_smaller,second_smaller,
-           second_smaller,second_smaller,
-           second_bigger,second_smaller,
-           second_only_rangecheck,second_bigger,
-           second_bigger,second_bigger,
-           second_bigger,second_only_rangecheck,
-           second_smaller,second_smaller,
-           second_smaller,second_smaller,
-           second_bool_to_int,second_int_to_bool,
-           second_int_to_real,second_real_to_fix,
-           second_fix_to_real,second_int_to_fix,second_real_to_real,
-           second_chararray_to_string,
-           second_proc_to_procvar,
-           { is constant char to pchar, is done by firstpass }
-           second_nothing,
-           second_load_smallset,
-           second_ansistring_to_pchar,
-           second_pchar_to_string,
-           second_nothing);
-{$endif}
       var
          oldrl,oldlrl : plinkedlist;
-
       begin
          { the ansi string disposing is a little bit hairy: }
          oldrl:=temptoremove;
@@ -1624,7 +1263,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.59  1999-03-01 15:46:18  peter
+  Revision 1.60  1999-03-02 18:24:19  peter
+    * fixed overloading of array of char
+
+  Revision 1.59  1999/03/01 15:46:18  peter
     * ag386bin finally make cycles correct
     * prefixes are now also normal opcodes
 

compiler/htypechk.pas

@@ -35,7 +35,7 @@ interface
     { Conversion }
     function isconvertable(def_from,def_to : pdef;
              var doconv : tconverttype;fromtreetype : ttreetyp;
-             explicit : boolean) : boolean;
+             explicit : boolean) : byte;
 
     { Register Allocation }
     procedure make_not_regable(p : ptree);
@@ -62,10 +62,14 @@ implementation
                              Convert
 ****************************************************************************}
 
+    { Returns:
+       0 - Not convertable
+       1 - Convertable
+       2 - Convertable, but not first choice }
     function isconvertable(def_from,def_to : pdef;
              var doconv : tconverttype;fromtreetype : ttreetyp;
-             explicit : boolean) : boolean;
-{$ifndef OLDCNV}
+             explicit : boolean) : byte;
+
       { Tbasetype:  uauto,uvoid,uchar,
                     u8bit,u16bit,u32bit,
                     s8bit,s16bit,s32,
@@ -85,83 +89,19 @@ implementation
           (tc_not_possible,tc_equal,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_int_2_bool));
-{$else}
-      const
-         basedefconverts : array[tbasetype,tbasetype] of tconverttype =
-           {uauto}
-           ((tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_not_possible,tc_not_possible,tc_not_possible),
-           {uvoid}
-            (tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_not_possible,tc_not_possible,tc_not_possible),
-           {uchar}
-            (tc_not_possible,tc_not_possible,tc_only_rangechecks32bit,
-             tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_not_possible,tc_not_possible,tc_not_possible),
-           {u8bit}
-            (tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_only_rangechecks32bit,tc_u8bit_2_u16bit,tc_u8bit_2_u32bit,
-             tc_only_rangechecks32bit,tc_u8bit_2_s16bit,tc_u8bit_2_s32bit,
-             tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
-           {u16bit}
-            (tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_u16bit_2_u8bit,tc_only_rangechecks32bit,tc_u16bit_2_u32bit,
-             tc_u16bit_2_s8bit,tc_only_rangechecks32bit,tc_u16bit_2_s32bit,
-             tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
-           {u32bit}
-            (tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_u32bit_2_u8bit,tc_u32bit_2_u16bit,tc_only_rangechecks32bit,
-             tc_u32bit_2_s8bit,tc_u32bit_2_s16bit,tc_only_rangechecks32bit,
-             tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
-           {s8bit}
-            (tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_only_rangechecks32bit,tc_s8bit_2_u16bit,tc_s8bit_2_u32bit,
-             tc_only_rangechecks32bit,tc_s8bit_2_s16bit,tc_s8bit_2_s32bit,
-             tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
-           {s16bit}
-            (tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_s16bit_2_u8bit,tc_only_rangechecks32bit,tc_s16bit_2_u32bit,
-             tc_s16bit_2_s8bit,tc_only_rangechecks32bit,tc_s16bit_2_s32bit,
-             tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
-           {s32bit}
-            (tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_s32bit_2_u8bit,tc_s32bit_2_u16bit,tc_only_rangechecks32bit,
-             tc_s32bit_2_s8bit,tc_s32bit_2_s16bit,tc_only_rangechecks32bit,
-             tc_int_2_bool,tc_int_2_bool,tc_int_2_bool),
-           {bool8bit}
-            (tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
-             tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
-             tc_only_rangechecks32bit,tc_int_2_bool,tc_int_2_bool),
-           {bool16bit}
-            (tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
-             tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
-             tc_int_2_bool,tc_only_rangechecks32bit,tc_int_2_bool),
-           {bool32bit}
-            (tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
-             tc_bool_2_int,tc_bool_2_int,tc_bool_2_int,
-             tc_int_2_bool,tc_int_2_bool,tc_only_rangechecks32bit));
-{$endif}
 
       var
-         b : boolean;
+         b : byte;
          hd1,hd2 : pdef;
       begin
        { safety check }
          if not(assigned(def_from) and assigned(def_to)) then
           begin
-            isconvertable:=false;
+            isconvertable:=0;
             exit;
           end;
 
-         b:=false;
+         b:=0;
        { we walk the wanted (def_to) types and check then the def_from
          types if there is a conversion possible }
          case def_to^.deftype of
@@ -170,9 +110,8 @@ implementation
                case def_from^.deftype of
                  orddef :
                    begin
-{$ifndef OLDCNV}
                      doconv:=basedefconverts[basedeftbl[porddef(def_from)^.typ],basedeftbl[porddef(def_to)^.typ]];
-                     b:=true;
+                     b:=1;
                      if (doconv=tc_not_possible) or
                         ((doconv=tc_int_2_bool) and
                          (not explicit) and
@@ -180,24 +119,13 @@ implementation
                         ((doconv=tc_bool_2_int) and
                          (not explicit) and
                          (not is_boolean(def_to))) then
-                       b:=false;
-{$else}
-                     doconv:=basedefconverts[porddef(def_from)^.typ,porddef(def_to)^.typ];
-                     b:=true;
-                     if (doconv=tc_not_possible) or
-                        ((doconv=tc_int_2_bool) and
-                         (not explicit) and
-                         (not is_boolean(def_from))) then
-                       b:=false;
-{$endif}
+                       b:=0;
                    end;
-{$ifndef OLDCNV}
                  enumdef :
                    begin
                      doconv:=tc_int_2_int;
-                     b:=true;
+                     b:=1;
                    end;
-{$endif}
                end;
              end;
 
@@ -206,14 +134,14 @@ implementation
                case def_from^.deftype of
                 stringdef : begin
                               doconv:=tc_string_2_string;
-                              b:=true;
+                              b:=1;
                             end;
                    orddef : begin
                             { char to string}
                               if is_char(def_from) then
                                begin
                                  doconv:=tc_char_2_string;
-                                 b:=true;
+                                 b:=1;
                                end;
                             end;
                  arraydef : begin
@@ -221,7 +149,13 @@ implementation
                               if is_equal(parraydef(def_from)^.definition,cchardef) then
                                begin
                                  doconv:=tc_chararray_2_string;
-                                 b:=true;
+                                 if (not(cs_ansistrings in aktlocalswitches) and
+                                     is_shortstring(def_to)) or
+                                    ((cs_ansistrings in aktlocalswitches) and
+                                     is_ansistring(def_to)) then
+                                  b:=1
+                                 else
+                                  b:=2;
                                end;
                             end;
                pointerdef : begin
@@ -229,7 +163,7 @@ implementation
                               if is_pchar(def_from) and not(m_tp in aktmodeswitches) then
                                begin
                                  doconv:=tc_pchar_2_string;
-                                 b:=true;
+                                 b:=1;
                                end;
                             end;
                end;
@@ -245,7 +179,7 @@ implementation
                                   doconv:=tc_int_2_fix
                                 else
                                   doconv:=tc_int_2_real;
-                                b:=true;
+                                b:=1;
                              end;
                          end;
               floatdef : begin { 2 float types ? }
@@ -268,7 +202,7 @@ implementation
                                   CGMessage(type_w_convert_real_2_comp);
 {$endif}
                              end;
-                           b:=true;
+                           b:=1;
                          end;
                end;
              end;
@@ -285,7 +219,8 @@ implementation
                    hd2:=penumdef(def_to)^.basedef
                   else
                    hd2:=def_to;
-                  b:=(hd1=hd2);
+                  if (hd1=hd2) then
+                   b:=1;
                 end;
              end;
 
@@ -296,7 +231,7 @@ implementation
                   is_equal(parraydef(def_to)^.definition,def_from) then
                 begin
                   doconv:=tc_equal;
-                  b:=true;
+                  b:=1;
                 end
                else
                 begin
@@ -306,7 +241,7 @@ implementation
                                      is_equal(ppointerdef(def_from)^.definition,parraydef(def_to)^.definition) then
                                    begin
                                      doconv:=tc_pointer_2_array;
-                                     b:=true;
+                                     b:=1;
                                    end;
                                 end;
                     stringdef : begin
@@ -314,7 +249,7 @@ implementation
                                   if is_equal(parraydef(def_to)^.definition,cchardef) then
                                    begin
                                      doconv:=tc_string_2_chararray;
-                                     b:=true;
+                                     b:=1;
                                    end;
                                 end;
                   end;
@@ -330,7 +265,7 @@ implementation
                                 is_pchar(def_to) then
                               begin
                                 doconv:=tc_cstring_2_pchar;
-                                b:=true;
+                                b:=1;
                               end;
                            end;
                   orddef : begin
@@ -339,7 +274,7 @@ implementation
                                 is_pchar(def_to) then
                               begin
                                 doconv:=tc_cchar_2_pchar;
-                                b:=true;
+                                b:=1;
                               end;
                            end;
                 arraydef : begin
@@ -348,7 +283,7 @@ implementation
                                 is_equal(parraydef(def_from)^.definition,ppointerdef(def_to)^.definition) then
                               begin
                                 doconv:=tc_array_2_pointer;
-                                b:=true;
+                                b:=1;
                               end;
                            end;
               pointerdef : begin
@@ -366,7 +301,7 @@ implementation
                                 is_equal(ppointerdef(def_from)^.definition,voiddef) then
                                begin
                                  doconv:=tc_equal;
-                                 b:=true;
+                                 b:=1;
                                end;
                            end;
               procvardef : begin
@@ -377,7 +312,7 @@ implementation
                                 (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
                               begin
                                 doconv:=tc_equal;
-                                b:=true;
+                                b:=1;
                               end;
                            end;
              classrefdef,
@@ -392,7 +327,7 @@ implementation
                                 (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
                                begin
                                  doconv:=tc_equal;
-                                 b:=true;
+                                 b:=1;
                                end;
                            end;
                end;
@@ -404,7 +339,7 @@ implementation
                if (def_from^.deftype=arraydef) and (parraydef(def_from)^.IsConstructor) then
                 begin
                   doconv:=tc_arrayconstructor_2_set;
-                  b:=true;
+                  b:=1;
                 end;
              end;
 
@@ -415,7 +350,8 @@ implementation
                 begin
                   def_from^.deftype:=procvardef;
                   doconv:=tc_proc_2_procvar;
-                  b:=is_equal(def_from,def_to);
+                  if is_equal(def_from,def_to) then
+                   b:=1;
                   def_from^.deftype:=procdef;
                 end
                else
@@ -427,14 +363,14 @@ implementation
                   (porddef(ppointerdef(def_from)^.definition)^.typ=uvoid) then
                 begin
                    doconv:=tc_equal;
-                   b:=true;
+                   b:=1;
                 end
                else
                { nil is compatible with procvars }
                 if (fromtreetype=niln) then
                  begin
                    doconv:=tc_equal;
-                   b:=true;
+                   b:=1;
                  end;
              end;
 
@@ -445,14 +381,15 @@ implementation
                   pobjectdef(def_from)^.isclass and pobjectdef(def_to)^.isclass }then
                 begin
                   doconv:=tc_equal;
-                  b:=pobjectdef(def_from)^.isrelated(pobjectdef(def_to));
+                  if pobjectdef(def_from)^.isrelated(pobjectdef(def_to)) then
+                   b:=1;
                 end
                else
                 { nil is compatible with class instances }
                 if (fromtreetype=niln) and (pobjectdef(def_to)^.isclass) then
                  begin
                    doconv:=tc_equal;
-                   b:=true;
+                   b:=1;
                  end;
              end;
 
@@ -462,15 +399,16 @@ implementation
                if (def_from^.deftype=classrefdef) then
                 begin
                   doconv:=tc_equal;
-                  b:=pobjectdef(pclassrefdef(def_from)^.definition)^.isrelated(
-                       pobjectdef(pclassrefdef(def_to)^.definition));
+                  if pobjectdef(pclassrefdef(def_from)^.definition)^.isrelated(
+                       pobjectdef(pclassrefdef(def_to)^.definition)) then
+                   b:=1;
                 end
                else
                 { nil is compatible with class references }
                 if (fromtreetype=niln) then
                  begin
                    doconv:=tc_equal;
-                   b:=true;
+                   b:=1;
                  end;
              end;
 
@@ -506,7 +444,7 @@ implementation
                   ) then
                  begin
                     doconv:=tc_equal;
-                    b:=true;
+                    b:=1;
                  end
              end;
 
@@ -514,7 +452,7 @@ implementation
              begin
              { assignment overwritten ?? }
                if is_assignment_overloaded(def_from,def_to) then
-                b:=true;
+                b:=1;
              end;
          end;
 
@@ -524,7 +462,7 @@ implementation
              and (pstringdef(def_to)^.string_typ in [st_ansistring,st_widestring]) then
              begin
                 doconv:=tc_equal;
-                b:=true;
+                b:=1;
              end
          else
            }
@@ -537,7 +475,7 @@ implementation
              (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
              begin
                 doconv:=tc_equal;
-                b:=true;
+                b:=1;
              end
          else
            }
@@ -549,7 +487,7 @@ implementation
              (porddef(ppointerdef(def_to)^.definition)^.typ=uchar) then
              begin
                 doconv:=tc_ansistring_2_pchar;
-                b:=true;
+                b:=1;
              end
          else
            }
@@ -706,8 +644,7 @@ implementation
           while passproc<>nil do
             begin
               if is_equal(passproc^.retdef,to_def) and
-                 isconvertable(from_def,passproc^.para1^.data,convtyp,
-                   ordconstn { nur Dummy},false ) then
+                 (isconvertable(from_def,passproc^.para1^.data,convtyp,ordconstn,false)=1) then
                 begin
                    is_assignment_overloaded:=true;
                    break;
@@ -719,7 +656,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.16  1999-01-27 13:53:27  pierre
+  Revision 1.17  1999-03-02 18:24:20  peter
+    * fixed overloading of array of char
+
+  Revision 1.16  1999/01/27 13:53:27  pierre
   htypechk.pas
 
   Revision 1.15  1999/01/27 13:12:10  pierre

compiler/symdefh.inc

@@ -103,6 +103,7 @@
           next    : pdefcoll;
           paratyp : tvarspez;
           argconvtyp : targconvtyp;
+          convertlevel : byte;
        end;
 
        tfiletype = (ft_text,ft_typed,ft_untyped);
@@ -504,7 +505,10 @@
 
 {
   $Log$
-  Revision 1.17  1999-03-01 13:45:06  pierre
+  Revision 1.18  1999-03-02 18:24:21  peter
+    * fixed overloading of array of char
+
+  Revision 1.17  1999/03/01 13:45:06  pierre
    + added staticppusymtable symtable type for local browsing
 
   Revision 1.16  1999/02/22 20:13:39  florian

compiler/tccal.pas

@@ -517,37 +517,22 @@ implementation
                    pd:=aktcallprocsym^.definition;
                    while assigned(pd) do
                      begin
-                        { we should also check that the overloaded function
-                        has been declared in a unit that is in the uses !! }
-                        { pd^.owner should be in the symtablestack !! }
-                        { Laenge der deklarierten Parameterliste feststellen: }
-                        { not necessary why nextprocsym field }
-                        {st:=symtablestack;
-                        if (pd^.owner^.symtabletype<>objectsymtable) then
-                          while assigned(st) do
-                            begin
-                               if (st=pd^.owner) then break;
-                               st:=st^.next;
-                            end;
-                        if assigned(st) then }
+                        pdc:=pd^.para1;
+                        l:=0;
+                        while assigned(pdc) do
                           begin
-                             pdc:=pd^.para1;
-                             l:=0;
-                             while assigned(pdc) do
-                               begin
-                                  inc(l);
-                                  pdc:=pdc^.next;
-                               end;
-                             { only when the # of parameter are equal }
-                             if (l=paralength) then
-                               begin
-                                  new(hp);
-                                  hp^.data:=pd;
-                                  hp^.next:=procs;
-                                  hp^.nextpara:=pd^.para1;
-                                  hp^.firstpara:=pd^.para1;
-                                  procs:=hp;
-                               end;
+                             inc(l);
+                             pdc:=pdc^.next;
+                          end;
+                        { only when the # of parameter are equal }
+                        if (l=paralength) then
+                          begin
+                             new(hp);
+                             hp^.data:=pd;
+                             hp^.next:=procs;
+                             hp^.nextpara:=pd^.para1;
+                             hp^.firstpara:=pd^.para1;
+                             procs:=hp;
                           end;
                         pd:=pd^.nextoverloaded;
                      end;
@@ -570,7 +555,15 @@ implementation
                    while assigned(pt) do
                      begin
                         dec(l);
-                        { matches a parameter of one procedure exact ? }
+                        { walk all procedures and determine how this parameter matches and set:
+                           1. pt^.exact_match_found if one parameter has an exact match
+                           2. exactmatch if an equal or exact match is found
+
+                           3. para^.argconvtyp to exact,equal or convertable
+                                (when convertable then also convertlevel is set)
+                           4. pt^.convlevel1found if there is a convertlevel=1
+                           5. pt^.convlevel2found if there is a convertlevel=2
+                        }
                         exactmatch:=false;
                         hp:=procs;
                         while assigned(hp) do
@@ -587,61 +580,57 @@ implementation
                                   exactmatch:=true;
                                end
                              else
-                               hp^.nextpara^.argconvtyp:=act_convertable;
+                               begin
+                                 hp^.nextpara^.argconvtyp:=act_convertable;
+                                 hp^.nextpara^.convertlevel:=isconvertable(pt^.resulttype,hp^.nextpara^.data,
+                                     hcvt,pt^.left^.treetype,false);
+                                 case hp^.nextpara^.convertlevel of
+                                  1 : pt^.convlevel1found:=true;
+                                  2 : pt^.convlevel2found:=true;
+                                 end;
+                               end;
+
                              hp:=hp^.next;
                           end;
 
-                        { .... if yes, del all the other procedures }
+                        { If there was an exactmatch then delete all convertables }
                         if exactmatch then
                           begin
-                             { the first .... }
-                             while (assigned(procs)) and not(is_equal(pt,procs^.nextpara^.data)) do
-                               begin
-                                  hp:=procs^.next;
-                                  dispose(procs);
-                                  procs:=hp;
-                               end;
-                             { and the others }
-                             hp:=procs;
-                             while (assigned(hp)) and assigned(hp^.next) do
-                               begin
-                                  if not(is_equal(pt,hp^.next^.nextpara^.data)) then
-                                    begin
-                                       hp2:=hp^.next^.next;
-                                       dispose(hp^.next);
-                                       hp^.next:=hp2;
-                                    end
-                                  else
-                                    hp:=hp^.next;
-                               end;
+                            hp:=procs;
+                            procs:=nil;
+                            while assigned(hp) do
+                              begin
+                                 hp2:=hp^.next;
+                                 { keep if not convertable }
+                                 if (hp^.nextpara^.argconvtyp<>act_convertable) then
+                                  begin
+                                    hp^.next:=procs;
+                                    procs:=hp;
+                                  end
+                                 else
+                                  dispose(hp);
+                                 hp:=hp2;
+                              end;
                           end
-                        { when a parameter matches exact, remove all procs
-                          which need typeconvs }
                         else
+                        { No exact match was found, remove all procedures that are
+                          not convertable (convertlevel=0) }
                           begin
-                             { the first... }
-                             while (assigned(procs)) and
-                               not(isconvertable(pt^.resulttype,procs^.nextpara^.data,
-                                 hcvt,pt^.left^.treetype,false)) do
-                               begin
-                                  hp:=procs^.next;
-                                  dispose(procs);
-                                  procs:=hp;
-                               end;
-                             { and the others }
-                             hp:=procs;
-                             while (assigned(hp)) and assigned(hp^.next) do
-                               begin
-                                  if not(isconvertable(pt^.resulttype,hp^.next^.nextpara^.data,
-                                    hcvt,pt^.left^.treetype,false)) then
-                                    begin
-                                       hp2:=hp^.next^.next;
-                                       dispose(hp^.next);
-                                       hp^.next:=hp2;
-                                    end
-                                  else
-                                    hp:=hp^.next;
-                               end;
+                            hp:=procs;
+                            procs:=nil;
+                            while assigned(hp) do
+                              begin
+                                 hp2:=hp^.next;
+                                 { keep if not convertable }
+                                 if (hp^.nextpara^.convertlevel<>0) then
+                                  begin
+                                    hp^.next:=procs;
+                                    procs:=hp;
+                                  end
+                                 else
+                                  dispose(hp);
+                                 hp:=hp2;
+                              end;
                           end;
                         { update nextpara for all procedures }
                         hp:=procs;
@@ -657,6 +646,8 @@ implementation
                           pt:=nil;
                      end;
 
+                 { All parameters are checked, check if there are any
+                   procedures left }
                    if not assigned(procs) then
                     begin
                       { there is an error, must be wrong type, because
@@ -769,17 +760,18 @@ implementation
                           end;
                      end;
 
-                   { reset nextpara for all procs left }
-                   hp:=procs;
-                   while assigned(hp) do
-                    begin
-                      hp^.nextpara:=hp^.firstpara;
-                      hp:=hp^.next;
-                    end;
-
-                   { let's try to eliminate equal is exact is there }
-                   if assigned(procs^.next) then
+                   { let's try to eliminate equal if there is an exact match
+                     is there }
+                   if assigned(procs) and assigned(procs^.next) then
                      begin
+                        { reset nextpara for all procs left }
+                        hp:=procs;
+                        while assigned(hp) do
+                         begin
+                           hp^.nextpara:=hp^.firstpara;
+                           hp:=hp^.next;
+                         end;
+
                         pt:=p^.left;
                         while assigned(pt) do
                           begin
@@ -791,15 +783,61 @@ implementation
                                    begin
                                       hp2:=hp^.next;
                                       { keep the exact matches, dispose the others }
-                                      if (hp^.nextpara^.data=pt^.resulttype) then
+                                      if (hp^.nextpara^.argconvtyp=act_exact) then
                                        begin
                                          hp^.next:=procs;
                                          procs:=hp;
                                        end
                                       else
+                                       dispose(hp);
+                                      hp:=hp2;
+                                   end;
+                               end;
+                             { update nextpara for all procedures }
+                             hp:=procs;
+                             while assigned(hp) do
+                               begin
+                                  hp^.nextpara:=hp^.nextpara^.next;
+                                  hp:=hp^.next;
+                               end;
+                             pt:=pt^.right;
+                          end;
+                     end;
+
+                   { Check if there are convertlevel 1 and 2 differences
+                     left for the parameters, then discard all convertlevel
+                     2 procedures. The value of convlevelXfound can still
+                     be used, because all convertables are still here or
+                     not }
+                   if assigned(procs) and assigned(procs^.next) then
+                     begin
+                        { reset nextpara for all procs left }
+                        hp:=procs;
+                        while assigned(hp) do
+                         begin
+                           hp^.nextpara:=hp^.firstpara;
+                           hp:=hp^.next;
+                         end;
+
+                        pt:=p^.left;
+                        while assigned(pt) do
+                          begin
+                             if pt^.convlevel1found and pt^.convlevel2found then
+                               begin
+                                 hp:=procs;
+                                 procs:=nil;
+                                 while assigned(hp) do
+                                   begin
+                                      hp2:=hp^.next;
+                                      { keep all not act_convertable and all convertlevels=1 }
+                                      if (hp^.nextpara^.argconvtyp<>act_convertable) or
+                                         (hp^.nextpara^.convertlevel=1) then
                                        begin
-                                         dispose(hp);
-                                       end;
+                                         hp^.next:=procs;
+                                         procs:=hp;
+                                       end
+                                      else
+                                       dispose(hp);
                                       hp:=hp2;
                                    end;
                                end;
@@ -814,10 +852,11 @@ implementation
                           end;
                      end;
 
-                   if assigned(procs^.next) then
+                   if not(assigned(procs)) or assigned(procs^.next) then
                      begin
                         CGMessage(cg_e_cant_choose_overload_function);
                         aktcallprocsym^.write_parameter_lists;
+                        exit;
                      end;
 {$ifdef TEST_PROCSYMS}
                    if (procs=nil) and assigned(nextprocsym) then
@@ -1078,7 +1117,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.25  1999-02-22 15:09:44  florian
+  Revision 1.26  1999-03-02 18:24:22  peter
+    * fixed overloading of array of char
+
+  Revision 1.25  1999/02/22 15:09:44  florian
     * behaviaor of PROTECTED and PRIVATE fixed, works now like TP/Delphi
 
   Revision 1.24  1999/02/22 02:15:45  peter

compiler/tccnv.pas

@@ -239,8 +239,6 @@ implementation
     type
        tfirstconvproc = procedure(var p : ptree);
 
-{$ifndef OLDCNV}
-
     procedure first_int_to_int(var p : ptree);
       begin
         if (p^.registers32=0) and
@@ -252,14 +250,6 @@ implementation
          end;
       end;
 
-{$else}
-    procedure first_bigger_smaller(var p : ptree);
-      begin
-         if (p^.left^.location.loc<>LOC_REGISTER) and (p^.registers32=0) then
-           p^.registers32:=1;
-         p^.location.loc:=LOC_REGISTER;
-      end;
-{$endif}
 
     procedure first_cstring_to_pchar(var p : ptree);
       begin
@@ -454,51 +444,29 @@ implementation
       end;
 
 
-{$ifdef OLDCNV}
-    procedure first_locmem(var p : ptree);
-      begin
-         p^.location.loc:=LOC_MEM;
-      end;
-{$endif}
-
-
     procedure first_bool_to_int(var p : ptree);
       begin
-{$ifndef OLDBOOL}
          { byte(boolean) or word(wordbool) or longint(longbool) must
          be accepted for var parameters }
          if (p^.explizit) and
             (p^.left^.resulttype^.size=p^.resulttype^.size) and
             (p^.left^.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
            exit;
-{$endif ndef OLDBOOL}
          p^.location.loc:=LOC_REGISTER;
-         { Florian I think this is overestimated
-           but I still do not really understand how to get this right (PM) }
-         { Hmmm, I think we need only one reg to return the result of      }
-         { this node => so }
          if p^.registers32<1 then
            p^.registers32:=1;
-         {  should work (FK)
-         p^.registers32:=p^.left^.registers32+1;}
       end;
 
 
     procedure first_int_to_bool(var p : ptree);
       begin
-{$ifndef OLDBOOL}
          { byte(boolean) or word(wordbool) or longint(longbool) must
          be accepted for var parameters }
          if (p^.explizit) and
             (p^.left^.resulttype^.size=p^.resulttype^.size) and
             (p^.left^.location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then
            exit;
-{$endif ndef OLDBOOL}
          p^.location.loc:=LOC_REGISTER;
-         { Florian I think this is overestimated
-           but I still do not really understand how to get this right (PM) }
-         { Hmmm, I think we need only one reg to return the result of      }
-         { this node => so }
          p^.left:=gentypeconvnode(p^.left,s32bitdef);
          { need if bool to bool !!
            not very nice !! }
@@ -506,9 +474,6 @@ implementation
          firstpass(p^.left);
          if p^.registers32<1 then
            p^.registers32:=1;
-{          p^.resulttype:=booldef; }
-         {  should work (FK)
-         p^.registers32:=p^.left^.registers32+1;}
       end;
 
 
@@ -570,7 +535,6 @@ implementation
       proctype : tdeftype;
     const
        firstconvert : array[tconverttype] of tfirstconvproc = (
-{$ifndef OLDCNV}
          first_nothing, {equal}
          first_nothing, {not_possible}
          first_string_to_string,
@@ -595,34 +559,6 @@ implementation
          first_arrayconstructor_to_set,
          first_load_smallset
        );
-{$else}
-                           first_nothing,first_nothing,
-                           first_bigger_smaller,first_nothing,first_bigger_smaller,
-                           first_bigger_smaller,first_bigger_smaller,
-                           first_bigger_smaller,first_bigger_smaller,
-                           first_bigger_smaller,first_string_to_string,
-                           first_cstring_to_pchar,first_string_to_chararray,
-                           first_array_to_pointer,first_pointer_to_array,
-                           first_char_to_string,first_bigger_smaller,
-                           first_bigger_smaller,first_bigger_smaller,
-                           first_bigger_smaller,first_bigger_smaller,
-                           first_bigger_smaller,first_bigger_smaller,
-                           first_bigger_smaller,first_bigger_smaller,
-                           first_bigger_smaller,first_bigger_smaller,
-                           first_bigger_smaller,first_bigger_smaller,
-                           first_bigger_smaller,first_bigger_smaller,
-                           first_bigger_smaller,first_bigger_smaller,
-                           first_bigger_smaller,first_bigger_smaller,
-                           first_bool_to_int,first_int_to_bool,
-                           first_int_to_real,first_real_to_fix,
-                           first_fix_to_real,first_int_to_fix,first_real_to_real,
-                           first_locmem,first_proc_to_procvar,
-                           first_cchar_to_pchar,
-                           first_load_smallset,
-                           first_ansistring_to_pchar,
-                           first_pchar_to_string,
-                           first_arrayconstructor_to_set);
-{$endif}
      begin
        aprocdef:=nil;
        { if explicite type cast, then run firstpass }
@@ -695,8 +631,7 @@ implementation
             exit;
          end;
 
-       if (not(isconvertable(p^.left^.resulttype,p^.resulttype,
-           p^.convtyp,p^.left^.treetype,p^.explizit))) then
+       if isconvertable(p^.left^.resulttype,p^.resulttype,p^.convtyp,p^.left^.treetype,p^.explizit)=0 then
          begin
            {Procedures have a resulttype of voiddef and functions of their
            own resulttype. They will therefore always be incompatible with
@@ -823,8 +758,7 @@ implementation
                             end
                           else
                             begin
-                               if not isconvertable(s32bitdef,p^.resulttype,p^.convtyp,
-                               ordconstn { only Dummy},false ) then
+                               if isconvertable(s32bitdef,p^.resulttype,p^.convtyp,ordconstn,false)=0 then
                                  CGMessage(cg_e_illegal_type_conversion);
                             end;
 
@@ -844,8 +778,7 @@ implementation
                               end
                             else
                               begin
-                                 if not isconvertable(p^.left^.resulttype,s32bitdef,p^.convtyp,
-                                   ordconstn { nur Dummy},false ) then
+                                 if IsConvertable(p^.left^.resulttype,s32bitdef,p^.convtyp,ordconstn,false)=0 then
                                    CGMessage(cg_e_illegal_type_conversion);
                               end;
                          end
@@ -866,8 +799,7 @@ implementation
                               begin
                                  { this is wrong because it converts to a 4 byte long var !!
                                    if not isconvertable(p^.left^.resulttype,s32bitdef,p^.convtyp,ordconstn  nur Dummy ) then }
-                                 if not isconvertable(p^.left^.resulttype,u8bitdef,
-                                   p^.convtyp,ordconstn { nur Dummy},false ) then
+                                 if IsConvertable(p^.left^.resulttype,u8bitdef,p^.convtyp,ordconstn,false)=0 then
                                    CGMessage(cg_e_illegal_type_conversion);
                               end;
                          end
@@ -979,7 +911,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.19  1999-02-22 02:15:46  peter
+  Revision 1.20  1999-03-02 18:24:23  peter
+    * fixed overloading of array of char
+
+  Revision 1.19  1999/02/22 02:15:46  peter
     * updates for ag386bin
 
   Revision 1.18  1999/01/27 14:56:57  pierre

compiler/tcmem.pas

@@ -381,11 +381,9 @@ implementation
          { range check only for arrays }
          if (p^.left^.resulttype^.deftype=arraydef) then
            begin
-              if not(isconvertable(p^.right^.resulttype,
-                parraydef(p^.left^.resulttype)^.rangedef,
-                ct,ordconstn,false)) and
-              not(is_equal(p^.right^.resulttype,
-                parraydef(p^.left^.resulttype)^.rangedef)) then
+              if (isconvertable(p^.right^.resulttype,parraydef(p^.left^.resulttype)^.rangedef,
+                    ct,ordconstn,false)=0) and
+                 not(is_equal(p^.right^.resulttype,parraydef(p^.left^.resulttype)^.rangedef)) then
                 CGMessage(type_e_mismatch);
            end;
          { Never convert a boolean or a char !}
@@ -557,7 +555,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.11  1999-02-22 02:15:54  peter
+  Revision 1.12  1999-03-02 18:24:24  peter
+    * fixed overloading of array of char
+
+  Revision 1.11  1999/02/22 02:15:54  peter
     * updates for ag386bin
 
   Revision 1.10  1999/02/04 11:44:47  florian

compiler/tree.pas

@@ -131,7 +131,6 @@ unit tree;
           loadvmtn
        );
 
-{$ifndef OLDCNV}
        tconverttype = (
           tc_equal,
           tc_not_possible,
@@ -157,32 +156,6 @@ unit tree;
           tc_arrayconstructor_2_set,
           tc_load_smallset
        );
-{$else}
-       tconverttype = (tc_equal,tc_not_possible,tc_u8bit_2_s32bit,
-                      tc_only_rangechecks32bit,tc_s8bit_2_s32bit,
-                      tc_u16bit_2_s32bit,tc_s16bit_2_s32bit,
-                      tc_s32bit_2_s16bit,tc_s32bit_2_u8bit,
-                      tc_s32bit_2_u16bit,tc_string_2_string,
-                      tc_cstring_2_pchar,tc_string_2_chararray,
-                      tc_array_2_pointer,tc_pointer_2_array,
-                      tc_char_2_string,tc_u8bit_2_s16bit,
-                      tc_u8bit_2_u16bit,tc_s8bit_2_s16bit,
-                      tc_s16bit_2_s8bit,tc_s16bit_2_u8bit,
-                      tc_u16bit_2_s8bit,tc_u16bit_2_u8bit,
-                      tc_s8bit_2_u16bit,tc_s32bit_2_s8bit,
-                      tc_s32bit_2_u32bit,tc_s16bit_2_u32bit,
-                      tc_s8bit_2_u32bit,tc_u16bit_2_u32bit,
-                      tc_u8bit_2_u32bit,tc_u32bit_2_s32bit,
-                      tc_u32bit_2_s8bit,tc_u32bit_2_u8bit,
-                      tc_u32bit_2_s16bit,tc_u32bit_2_u16bit,
-                      tc_bool_2_int,tc_int_2_bool,
-                      tc_int_2_real,tc_real_2_fix,
-                      tc_fix_2_real,tc_int_2_fix,tc_real_2_real,
-                      tc_chararray_2_string,
-                      tc_proc_2_procvar,tc_cchar_2_pchar,tc_load_smallset,
-                      tc_ansistring_2_pchar,tc_pchar_2_string,
-                      tc_arrayconstructor_2_set);
-{$endif}
 
        { allows to determine which elementes are to be replaced }
        tdisposetyp = (dt_nothing,dt_leftright,dt_left,dt_leftrighthigh,
@@ -237,7 +210,8 @@ unit tree;
 {$endif extdebug}
           case treetype : ttreetyp of
              addn : (use_strconcat : boolean;string_typ : tstringtype);
-             callparan : (is_colon_para : boolean;exact_match_found : boolean;hightree:ptree);
+             callparan : (is_colon_para : boolean;exact_match_found,
+                          convlevel1found,convlevel2found:boolean;hightree:ptree);
              assignn : (assigntyp : tassigntyp;concat_string : boolean);
              loadn : (symtableentry : psym;symtable : psymtable;
                       is_absolute,is_first : boolean);
@@ -657,6 +631,8 @@ unit tree;
          p^.registersfpu:=0;
          p^.resulttype:=nil;
          p^.exact_match_found:=false;
+         p^.convlevel1found:=false;
+         p^.convlevel2found:=false;
          p^.is_colon_para:=false;
          p^.hightree:=nil;
          set_file_line(expr,p);
@@ -1669,7 +1645,10 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.67  1999-02-25 21:02:56  peter
+  Revision 1.68  1999-03-02 18:24:25  peter
+    * fixed overloading of array of char
+
+  Revision 1.67  1999/02/25 21:02:56  peter
     * ag386bin updates
     + coff writer