From 692155686a3887325d4dcc93d53009d1c98997bb Mon Sep 17 00:00:00 2001 From: peter Date: Thu, 24 Sep 1998 09:02:13 +0000 Subject: [PATCH] * rewritten isconvertable to use case * array of .. and single variable are compatible --- compiler/cg386cal.pas | 18 +- compiler/htypechk.pas | 596 +++++++++++++++++++++--------------------- compiler/tccal.pas | 12 +- 3 files changed, 319 insertions(+), 307 deletions(-) diff --git a/compiler/cg386cal.pas b/compiler/cg386cal.pas index 3afaffa421..84bf2a7e0a 100644 --- a/compiler/cg386cal.pas +++ b/compiler/cg386cal.pas @@ -55,6 +55,7 @@ implementation procedure maybe_push_open_array_high; var r : preference; + len : longint; begin { open array ? } { defcoll^.data can be nil for read/write } @@ -77,16 +78,17 @@ implementation end else begin + if p^.left^.resulttype^.deftype=arraydef then + len:=parraydef(p^.left^.resulttype)^.highrange-parraydef(p^.left^.resulttype)^.lowrange + else + len:=0; if inlined then begin r:=new_reference(procinfo.framepointer,para_offset-pushedparasize); - exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L, - parraydef(p^.left^.resulttype)^.highrange- - parraydef(p^.left^.resulttype)^.lowrange,r))); + exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,len,r))); end else - push_int(parraydef(p^.left^.resulttype)^.highrange- - parraydef(p^.left^.resulttype)^.lowrange); + push_int(len); end; end; end; @@ -1394,7 +1396,11 @@ implementation end. { $Log$ - Revision 1.26 1998-09-21 08:45:06 pierre + Revision 1.27 1998-09-24 09:02:13 peter + * rewritten isconvertable to use case + * array of .. and single variable are compatible + + Revision 1.26 1998/09/21 08:45:06 pierre + added vmt_offset in tobjectdef.write for fututre use (first steps to have objects without vmt if no virtual !!) + added fpu_used field for tabstractprocdef : diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 2dff9c9812..c0bb119452 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -143,277 +143,300 @@ implementation end; b:=false; - - { handle ord to ord first } - if (def_from^.deftype=orddef) and (def_to^.deftype=orddef) then - begin - doconv:=basedefconverts[porddef(def_from)^.typ,porddef(def_to)^.typ]; - { Don't allow automatic int->bool. - Very Bad Hack !!!! (PFV) } - if (doconv=tc_int_2_bool) and (not explicit) then - b:=false - else - if doconv<>tc_not_possible then - b:=true; - end - else - - if (def_from^.deftype=orddef) and (def_to^.deftype=floatdef) then - begin - if pfloatdef(def_to)^.typ=f32bit then - doconv:=tc_int_2_fix - else - doconv:=tc_int_2_real; - b:=true; - end - else - - { 2 float types ? } - if (def_from^.deftype=floatdef) and (def_to^.deftype=floatdef) then - begin - if pfloatdef(def_from)^.typ=pfloatdef(def_to)^.typ then - doconv:=tc_equal - else - begin - if pfloatdef(def_from)^.typ=f32bit then - doconv:=tc_fix_2_real - else if pfloatdef(def_to)^.typ=f32bit then - doconv:=tc_real_2_fix - else - doconv:=tc_real_2_real; - { comp isn't a floating type } + { 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 + orddef : begin + if (def_from^.deftype=orddef) then + begin + doconv:=basedefconverts[porddef(def_from)^.typ,porddef(def_to)^.typ]; + if (doconv<>tc_not_possible) and + (explicit or not(doconv in [tc_int_2_bool])) then + b:=true; + end; + end; + stringdef : begin + case def_from^.deftype of + stringdef : begin + doconv:=tc_string_to_string; + b:=true; + end; + orddef : begin + { char to string} + if is_equal(def_from,cchardef) then + begin + doconv:=tc_char_to_string; + b:=true; + end; + end; + arraydef : begin + { string to array of char, the length check is done by the firstpass of this node } + if is_equal(parraydef(def_from)^.definition,cchardef) then + begin + doconv:=tc_chararray_2_string; + b:=true; + end; + end; + pointerdef : begin + { pchar can be assigned to short/ansistrings } + if is_pchar(def_from) then + begin + doconv:=tc_pchar_2_string; + b:=true; + end; + end; + end; + end; + floatdef : begin + case def_from^.deftype of + orddef : begin { ordinal to real } + if pfloatdef(def_to)^.typ=f32bit then + doconv:=tc_int_2_fix + else + doconv:=tc_int_2_real; + b:=true; + end; + floatdef : begin { 2 float types ? } + if pfloatdef(def_from)^.typ=pfloatdef(def_to)^.typ then + doconv:=tc_equal + else + begin + if pfloatdef(def_from)^.typ=f32bit then + doconv:=tc_fix_2_real + else + if pfloatdef(def_to)^.typ=f32bit then + doconv:=tc_real_2_fix + else + doconv:=tc_real_2_real; + { comp isn't a floating type } {$ifdef i386} - if (pfloatdef(def_to)^.typ=s64bit) and - (pfloatdef(def_from)^.typ<>s64bit) and - not (explicit) then - CGMessage(type_w_convert_real_2_comp); + if (pfloatdef(def_to)^.typ=s64bit) and + (pfloatdef(def_from)^.typ<>s64bit) and + not (explicit) then + CGMessage(type_w_convert_real_2_comp); {$endif} - end; + end; + b:=true; + end; + end; + end; + enumdef : begin + if (def_from^.deftype=enumdef) then + begin + if assigned(penumdef(def_from)^.basedef) then + hd1:=penumdef(def_from)^.basedef + else + hd1:=def_from; + if assigned(penumdef(def_to)^.basedef) then + hd2:=penumdef(def_to)^.basedef + else + hd2:=def_to; + b:=(hd1=hd2); + 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(parraydef(def_to)^.definition,def_from) then + begin + doconv:=tc_equal; + b:=true; + end + else + begin + case def_from^.deftype of + pointerdef : begin + if (parraydef(def_to)^.lowrange=0) and + is_equal(ppointerdef(def_from)^.definition,parraydef(def_to)^.definition) then + begin + doconv:=tc_pointer_to_array; + b:=true; + end; + end; + stringdef : begin + { array of char to string } + if is_equal(parraydef(def_to)^.definition,cchardef) then + begin + doconv:=tc_string_chararray; + b:=true; + end; + end; + end; + end; + end; + pointerdef : begin + case def_from^.deftype of + stringdef : begin + { string constant to zero terminated string constant } + if (fromtreetype=stringconstn) and + is_pchar(def_to) then + begin + doconv:=tc_cstring_charpointer; + b:=true; + end; + end; + orddef : begin + { char constant to zero terminated string constant } + if (fromtreetype=ordconstn) and is_equal(def_from,cchardef) and + is_pchar(def_to) then + begin + doconv:=tc_cchar_charpointer; + b:=true; + end; + end; + arraydef : begin + { chararray to pointer } + if (parraydef(def_from)^.lowrange=0) and + is_equal(parraydef(def_from)^.definition,ppointerdef(def_to)^.definition) then + begin + doconv:=tc_array_to_pointer; + b:=true; + end; + end; + pointerdef : begin + { child class pointer can be assigned to anchestor pointers } + if ( + (ppointerdef(def_from)^.definition^.deftype=objectdef) and + (ppointerdef(def_to)^.definition^.deftype=objectdef) and + pobjectdef(ppointerdef(def_from)^.definition)^.isrelated( + pobjectdef(ppointerdef(def_to)^.definition)) + ) or + { all pointers can be assigned to void-pointer } + is_equal(ppointerdef(def_to)^.definition,voiddef) or + { in my opnion, is this not clean pascal } + { well, but it's handy to use, it isn't ? (FK) } + is_equal(ppointerdef(def_from)^.definition,voiddef) then + begin + doconv:=tc_equal; + b:=true; + end; + end; + procvardef : begin + { procedure variable can be assigned to an void pointer } + { Not anymore. Use the @ operator now.} + if not(cs_tp_compatible in aktmoduleswitches) and + (ppointerdef(def_to)^.definition^.deftype=orddef) and + (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then + begin + doconv:=tc_equal; + b:=true; + end; + end; + classrefdef, + objectdef : begin + { class types and class reference type + can be assigned to void pointers } + if ( + ((def_from^.deftype=objectdef) and pobjectdef(def_from)^.isclass) or + (def_from^.deftype=classrefdef) + ) and + (ppointerdef(def_to)^.definition^.deftype=orddef) and + (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then + begin + doconv:=tc_equal; + b:=true; + end; + end; + end; + end; + setdef : begin + { automatic arrayconstructor -> set conversion } + if (def_from^.deftype=arraydef) and (parraydef(def_from)^.IsConstructor) then + begin + doconv:=tc_arrayconstructor_2_set; + b:=true; + end; + end; + procvardef : begin + { proc -> procvar } + if (def_from^.deftype=procdef) then + begin + def_from^.deftype:=procvardef; + doconv:=tc_proc2procvar; + b:=is_equal(def_from,def_to); + def_from^.deftype:=procdef; + end + else + { nil is compatible with procvars } + if (fromtreetype=niln) then + begin + doconv:=tc_equal; + b:=true; + end; + end; + objectdef : begin + { object pascal objects } + if (def_from^.deftype=objectdef) {and + pobjectdef(def_from)^.isclass and pobjectdef(def_to)^.isclass }then + begin + doconv:=tc_equal; + b:=pobjectdef(def_from)^.isrelated(pobjectdef(def_to)); + end + else + { nil is compatible with class instances } + if (fromtreetype=niln) and (pobjectdef(def_to)^.isclass) then + begin + doconv:=tc_equal; + b:=true; + end; + end; + classrefdef : begin + { class reference types } + if (def_from^.deftype=classrefdef) then + begin + doconv:=tc_equal; + b:=pobjectdef(pclassrefdef(def_from)^.definition)^.isrelated( + pobjectdef(pclassrefdef(def_to)^.definition)); + end + else + { nil is compatible with class references } + if (fromtreetype=niln) then + begin + doconv:=tc_equal; + b:=true; + 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 + ( + ( + (pfiledef(def_from)^.filetype = ft_typed) and + (pfiledef(def_to)^.filetype = ft_typed) and + ( + (pfiledef(def_from)^.typed_as = pdef(voiddef)) or + (pfiledef(def_to)^.typed_as = pdef(voiddef)) + ) + ) or + ( + ( + (pfiledef(def_from)^.filetype = ft_untyped) and + (pfiledef(def_to)^.filetype = ft_typed) + ) or + ( + (pfiledef(def_from)^.filetype = ft_typed) and + (pfiledef(def_to)^.filetype = ft_untyped) + ) + ) + ) then + begin + doconv:=tc_equal; + b:=true; + end + end; + else + begin + { assignment overwritten ?? } + if is_assignment_overloaded(def_from,def_to) then b:=true; - end - else - - { enum to enum } - if (def_from^.deftype=enumdef) and (def_to^.deftype=enumdef) then - begin - if assigned(penumdef(def_from)^.basedef) then - hd1:=penumdef(def_from)^.basedef - else - hd1:=def_from; - if assigned(penumdef(def_to)^.basedef) then - hd2:=penumdef(def_to)^.basedef - else - hd2:=def_to; - b:=(hd1=hd2); - end - else - - { assignment overwritten ?? } - if is_assignment_overloaded(def_from,def_to) then - b:=true - else - - if (def_from^.deftype=pointerdef) and (def_to^.deftype=arraydef) and - (parraydef(def_to)^.lowrange=0) and - is_equal(ppointerdef(def_from)^.definition,parraydef(def_to)^.definition) then - begin - doconv:=tc_pointer_to_array; - b:=true; - end - else - - if (def_from^.deftype=arraydef) and (def_to^.deftype=pointerdef) and - (parraydef(def_from)^.lowrange=0) and - is_equal(parraydef(def_from)^.definition,ppointerdef(def_to)^.definition) then - begin - doconv:=tc_array_to_pointer; - b:=true; - end - else - - if (def_from^.deftype=arraydef) and (def_to^.deftype=setdef) and - (parraydef(def_from)^.IsConstructor) then - begin - doconv:=tc_arrayconstructor_2_set; - b:=true; - end - else - - { 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 (def_to^.deftype=filedef) and - ( - ( - (pfiledef(def_from)^.filetype = ft_typed) and - (pfiledef(def_to)^.filetype = ft_typed) and - ( - (pfiledef(def_from)^.typed_as = pdef(voiddef)) or - (pfiledef(def_to)^.typed_as = pdef(voiddef)) - ) - ) or - ( - ( - (pfiledef(def_from)^.filetype = ft_untyped) and - (pfiledef(def_to)^.filetype = ft_typed) - ) or - ( - (pfiledef(def_from)^.filetype = ft_typed) and - (pfiledef(def_to)^.filetype = ft_untyped) - ) - ) - ) then - begin - doconv:=tc_equal; - b:=true; - end - else - - { object pascal objects } - if (def_from^.deftype=objectdef) and (def_to^.deftype=objectdef) {and - pobjectdef(def_from)^.isclass and pobjectdef(def_to)^.isclass }then - begin - doconv:=tc_equal; - b:=pobjectdef(def_from)^.isrelated( - pobjectdef(def_to)); - end - else - { class types and class reference type - can be assigned to void pointers } - if (((def_from^.deftype=objectdef) and - pobjectdef(def_from)^.isclass) or - (def_from^.deftype=classrefdef) - ) and - (def_to^.deftype=pointerdef) and - (ppointerdef(def_to)^.definition^.deftype=orddef) and - (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then - - begin - doconv:=tc_equal; - b:=true; - end - else - - { class reference types } - if (def_from^.deftype=classrefdef) and (def_from^.deftype=classrefdef) then - begin - doconv:=tc_equal; - b:=pobjectdef(pclassrefdef(def_from)^.definition)^.isrelated( - pobjectdef(pclassrefdef(def_to)^.definition)); - end - else - - if (def_from^.deftype=pointerdef) and (def_to^.deftype=pointerdef) then - begin - { child class pointer can be assigned to anchestor pointers } - if ( - (ppointerdef(def_from)^.definition^.deftype=objectdef) and - (ppointerdef(def_to)^.definition^.deftype=objectdef) and - pobjectdef(ppointerdef(def_from)^.definition)^.isrelated( - pobjectdef(ppointerdef(def_to)^.definition)) - ) or - { all pointers can be assigned to void-pointer } - is_equal(ppointerdef(def_to)^.definition,voiddef) or - { in my opnion, is this not clean pascal } - { well, but it's handy to use, it isn't ? (FK) } - is_equal(ppointerdef(def_from)^.definition,voiddef) then - begin - doconv:=tc_equal; - b:=true; - end - end - else - - if (def_from^.deftype=stringdef) and (def_to^.deftype=stringdef) then - begin - doconv:=tc_string_to_string; - b:=true; - end - else - - { char to string} - if is_equal(def_from,cchardef) and (def_to^.deftype=stringdef) then - begin - doconv:=tc_char_to_string; - b:=true; - end - else - - { string constant to zero terminated string constant } - if (fromtreetype=stringconstn) and - is_pchar(def_to) then - begin - doconv:=tc_cstring_charpointer; - b:=true; - end - else - - { array of char to string, the length check is done by the firstpass of this node } - if (def_from^.deftype=stringdef) and - ((def_to^.deftype=arraydef) and is_equal(parraydef(def_to)^.definition,cchardef)) then - begin - doconv:=tc_string_chararray; - b:=true; - end - else - - { string to array of char, the length check is done by the firstpass of this node } - if ((def_from^.deftype=arraydef) and is_equal(parraydef(def_from)^.definition,cchardef)) and - (def_to^.deftype=stringdef) then - begin - doconv:=tc_chararray_2_string; - b:=true; - end - else - - if (fromtreetype=ordconstn) and is_equal(def_from,cchardef) then - begin - if (def_to^.deftype=pointerdef) and - is_equal(ppointerdef(def_to)^.definition,cchardef) then - begin - doconv:=tc_cchar_charpointer; - b:=true; - end; - end - else - - if (def_to^.deftype=procvardef) and (def_from^.deftype=procdef) then - begin - def_from^.deftype:=procvardef; - doconv:=tc_proc2procvar; - b:=is_equal(def_from,def_to); - def_from^.deftype:=procdef; - end - else - - { nil is compatible with class instances } - if (fromtreetype=niln) and (def_to^.deftype=objectdef) - and (pobjectdef(def_to)^.isclass) then - begin - doconv:=tc_equal; - b:=true; - end - else - - { nil is compatible with class references } - if (fromtreetype=niln) and (def_to^.deftype=classrefdef) then - begin - doconv:=tc_equal; - b:=true; - end - else - - { nil is compatible with procvars } - if (fromtreetype=niln) and (def_to^.deftype=procvardef) then - begin - doconv:=tc_equal; - b:=true; - end - else + end; + end; { nil is compatible with ansi- and wide strings } { no, that isn't true, (FK) @@ -450,36 +473,7 @@ implementation end else } - - { pchar can be assigned to short/ansistrings } - if (def_to^.deftype=stringdef) and - ((def_from^.deftype=pointerdef) and - (ppointerdef(def_from)^.definition^.deftype=orddef) and - (porddef(ppointerdef(def_from)^.definition)^.typ=uchar)) then - begin - if (pstringdef(def_to)^.string_typ in [st_shortstring,st_ansistring]) then - begin - doconv:=tc_pchar_2_string; - b:=true; - end; - end - else - - { procedure variable can be assigned to an void pointer } - { Not anymore. Use the @ operator now.} - if not (cs_tp_compatible in aktmoduleswitches) then - begin - if (def_from^.deftype=procvardef) and - (def_to^.deftype=pointerdef) and - (ppointerdef(def_to)^.definition^.deftype=orddef) and - (porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then - begin - doconv:=tc_equal; - b:=true; - end; - end; - - isconvertable:=b; + isconvertable:=b; end; @@ -645,7 +639,11 @@ implementation end. { $Log$ - Revision 1.1 1998-09-23 20:42:22 peter + Revision 1.2 1998-09-24 09:02:14 peter + * rewritten isconvertable to use case + * array of .. and single variable are compatible + + Revision 1.1 1998/09/23 20:42:22 peter * splitted pass_1 } diff --git a/compiler/tccal.pas b/compiler/tccal.pas index 19dd2666ee..d36807146f 100644 --- a/compiler/tccal.pas +++ b/compiler/tccal.pas @@ -134,7 +134,11 @@ implementation (defcoll^.data^.deftype=objectdef) and pobjectdef(p^.left^.resulttype)^.isrelated(pobjectdef(defcoll^.data)) ) and - + { passing a single element to a openarray of the same type } + not( + (is_open_array(defcoll^.data) and + is_equal(parraydef(defcoll^.data)^.definition,p^.left^.resulttype)) + ) and { an implicit file conversion is also allowed } { from a typed file to an untyped one } not( @@ -895,7 +899,11 @@ implementation end. { $Log$ - Revision 1.1 1998-09-23 20:42:24 peter + Revision 1.2 1998-09-24 09:02:16 peter + * rewritten isconvertable to use case + * array of .. and single variable are compatible + + Revision 1.1 1998/09/23 20:42:24 peter * splitted pass_1 }