diff options
author | peter <peter@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2006-03-27 07:22:02 +0000 |
---|---|---|
committer | peter <peter@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2006-03-27 07:22:02 +0000 |
commit | 4674d98fd7f58da5365bffdd1fb7cdf6b5370449 (patch) | |
tree | f2841352faf2e3040c4ebab7dde7717627d29006 /compiler | |
parent | 97a9163f799b2f2f325e8b290a5097997b576942 (diff) | |
download | fpc-4674d98fd7f58da5365bffdd1fb7cdf6b5370449.tar.gz |
* don't allow stringconst+integer
* change booleans in arraydef to set
* set option in arraydef to indicate a constant string so
a nicer type can be shown instead of array[0..x] of char
git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@3051 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/dbgdwarf.pas | 2 | ||||
-rw-r--r-- | compiler/defutil.pas | 48 | ||||
-rw-r--r-- | compiler/htypechk.pas | 4 | ||||
-rw-r--r-- | compiler/nadd.pas | 8 | ||||
-rw-r--r-- | compiler/ncgld.pas | 2 | ||||
-rw-r--r-- | compiler/ncon.pas | 1 | ||||
-rw-r--r-- | compiler/nld.pas | 13 | ||||
-rw-r--r-- | compiler/pdecsub.pas | 16 | ||||
-rw-r--r-- | compiler/ppu.pas | 2 | ||||
-rw-r--r-- | compiler/ptype.pas | 2 | ||||
-rw-r--r-- | compiler/symconst.pas | 10 | ||||
-rw-r--r-- | compiler/symdef.pas | 53 | ||||
-rw-r--r-- | compiler/symsym.pas | 2 | ||||
-rw-r--r-- | compiler/utils/ppudump.pp | 122 |
14 files changed, 197 insertions, 88 deletions
diff --git a/compiler/dbgdwarf.pas b/compiler/dbgdwarf.pas index 72f91c5f7b..eebb8deed2 100644 --- a/compiler/dbgdwarf.pas +++ b/compiler/dbgdwarf.pas @@ -904,7 +904,7 @@ implementation DW_AT_stride_size,DW_FORM_udata,def.elesize*8 ]); append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementtype.def)); - if def.IsDynamicArray then + if is_dynamic_array(def) then begin { !!! FIXME !!! } { gdb's dwarf implementation sucks, so we can't use DW_OP_push_object here (FK) diff --git a/compiler/defutil.pas b/compiler/defutil.pas index f7d12baa91..f934fa1c06 100644 --- a/compiler/defutil.pas +++ b/compiler/defutil.pas @@ -463,16 +463,16 @@ implementation { 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)); + result:=(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; + result:=(p.deftype=arraydef) and + (ado_IsDynamicArray in tarraydef(p).arrayoptions); end; @@ -481,48 +481,42 @@ implementation begin { check for s32inttype is needed, because for u32bit the high range is also -1 ! (PFV) } - is_open_array:=(p.deftype=arraydef) and - (tarraydef(p).rangetype.def=s32inttype.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); - + result:=(p.deftype=arraydef) and + (tarraydef(p).rangetype.def=s32inttype.def) and + (tarraydef(p).lowrange=0) and + (tarraydef(p).highrange=-1) and + ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_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); + result:=(p.deftype=arraydef) and + (ado_IsConstructor in tarraydef(p).arrayoptions); 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); + result:=(p.deftype=arraydef) and + (ado_IsVariant in tarraydef(p).arrayoptions); 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); + result:=(p.deftype=arraydef) and + (ado_IsArrayOfConst in tarraydef(p).arrayoptions); 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 - (tarraydef(p).IsDynamicArray) or - is_open_array(p) - ); + result:=(p.deftype=arraydef) and + ( + ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])<>[]) or + is_open_array(p) + ); end; { true if p is an ansi string def } diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 07026d1970..1f83c6f756 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -1404,8 +1404,8 @@ implementation begin { set can also be a not yet converted array constructor } if (p.resulttype.def.deftype=arraydef) and - (tarraydef(p.resulttype.def).IsConstructor) and - not(tarraydef(p.resulttype.def).IsVariant) then + is_array_constructor(p.resulttype.def) and + not is_variant_array(p.resulttype.def) then eq:=te_equal; end; procvardef : diff --git a/compiler/nadd.pas b/compiler/nadd.pas index 0bd5854000..283aa030d4 100644 --- a/compiler/nadd.pas +++ b/compiler/nadd.pas @@ -1393,7 +1393,8 @@ implementation { this is a little bit dangerous, also the left type } { pointer to should be checked! This broke the mmx support } - else if (rd.deftype=pointerdef) or is_zero_based_array(rd) then + else if (rd.deftype=pointerdef) or + (is_zero_based_array(rd) and (rt<>stringconstn)) then begin if is_zero_based_array(rd) then begin @@ -1419,7 +1420,8 @@ implementation CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); end - else if (ld.deftype=pointerdef) or is_zero_based_array(ld) then + else if (ld.deftype=pointerdef) or + (is_zero_based_array(ld) and (lt<>stringconstn)) then begin if is_zero_based_array(ld) then begin @@ -1769,7 +1771,7 @@ implementation todefsigned) and (v >= low(longint)) and (v <= high(longint)) - else + else result := (qword(v) >= low(cardinal)) and (qword(v) <= high(cardinal)) diff --git a/compiler/ncgld.pas b/compiler/ncgld.pas index 52cffae7d8..395569f7a3 100644 --- a/compiler/ncgld.pas +++ b/compiler/ncgld.pas @@ -749,7 +749,7 @@ implementation tmpreg : tregister; paraloc : tcgparalocation; begin - dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant; + dovariant:=(nf_forcevaria in flags) or is_variant_array(resulttype.def); if dovariant then elesize:=sizeof(aint)+sizeof(aint) else diff --git a/compiler/ncon.pas b/compiler/ncon.pas index 1c7e51401c..0627a5b5f3 100644 --- a/compiler/ncon.pas +++ b/compiler/ncon.pas @@ -649,6 +649,7 @@ implementation l:=0; resulttype.setdef(tarraydef.create(0,l,s32inttype)); tarraydef(resulttype.def).setelementtype(cchartype); + include(tarraydef(resulttype.def).arrayoptions,ado_IsConstString); end; cst_shortstring : resulttype:=cshortstringtype; diff --git a/compiler/nld.pas b/compiler/nld.pas index 5190a118c9..3bfc002ef1 100644 --- a/compiler/nld.pas +++ b/compiler/nld.pas @@ -887,8 +887,9 @@ implementation htype:=voidtype; resulttype.setdef(tarraydef.create(0,len-1,s32inttype)); tarraydef(resulttype.def).setelementtype(htype); - tarraydef(resulttype.def).IsConstructor:=true; - tarraydef(resulttype.def).IsVariant:=varia; + include(tarraydef(resulttype.def).arrayoptions,ado_IsConstructor); + if varia then + include(tarraydef(resulttype.def).arrayoptions,ado_IsVariant); end; @@ -897,8 +898,8 @@ implementation hp : tarrayconstructornode; begin tarraydef(resulttype.def).setelementtype(tt); - tarraydef(resulttype.def).IsConstructor:=true; - tarraydef(resulttype.def).IsVariant:=false; + include(tarraydef(resulttype.def).arrayoptions,ado_IsConstructor); + exclude(tarraydef(resulttype.def).arrayoptions,ado_IsVariant); if assigned(left) then begin hp:=self; @@ -918,7 +919,7 @@ implementation begin if (iscvarargs) then include(flags,nf_cvarargs); - dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant or iscvarargs; + dovariant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resulttype.def).arrayoptions) or iscvarargs; { only pass left tree, right tree contains next construct if any } if assigned(left) then begin @@ -1006,7 +1007,7 @@ implementation hp : tarrayconstructornode; do_variant:boolean; begin - do_variant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant; + do_variant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resulttype.def).arrayoptions); result:=nil; { Insert required type convs, this must be done in pass 1, because the call must be diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index b8fae4255c..4b4d36c56e 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -348,13 +348,13 @@ implementation case vartype.def.deftype of arraydef : begin - with tarraydef(vartype.def) do - if IsVariant or IsConstructor then - begin - Message1(parser_w_not_supported_for_inline,'array of const'); - Message(parser_w_inlining_disabled); - pd.proccalloption:=pocall_default; - end; + if is_array_constructor(vartype.def) or + is_variant_array(vartype.def) then + begin + Message1(parser_w_not_supported_for_inline,'array of const'); + Message(parser_w_inlining_disabled); + pd.proccalloption:=pocall_default; + end; end; end; end; @@ -507,7 +507,7 @@ implementation consume(_CONST); srsym:=search_system_type('TVARREC'); tarraydef(tt.def).setelementtype(ttypesym(srsym).restype); - tarraydef(tt.def).IsArrayOfConst:=true; + include(tarraydef(tt.def).arrayoptions,ado_IsArrayOfConst); end else begin diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 7b5296468c..bfc142acde 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -43,7 +43,7 @@ type {$endif Test_Double_checksum} const - CurrentPPUVersion=55; + CurrentPPUVersion=56; { buffer sizes } maxentrysize = 1024; diff --git a/compiler/ptype.pas b/compiler/ptype.pas index b77ec3a98e..53d4355c58 100644 --- a/compiler/ptype.pas +++ b/compiler/ptype.pas @@ -542,7 +542,7 @@ implementation else begin ap:=tarraydef.create(0,-1,s32inttype); - ap.IsDynamicArray:=true; + include(ap.arrayoptions,ado_IsDynamicArray); tt.setdef(ap); end; consume(_OF); diff --git a/compiler/symconst.pas b/compiler/symconst.pas index 7b0b3b14b1..73599b9443 100644 --- a/compiler/symconst.pas +++ b/compiler/symconst.pas @@ -295,6 +295,16 @@ type ); tobjectoptions=set of tobjectoption; + tarraydefoption=(ado_none, + ado_IsConvertedPointer, + ado_IsDynamicArray, + ado_IsVariant, + ado_IsConstructor, + ado_IsArrayOfConst, + ado_IsConstString + ); + tarraydefoptions=set of tarraydefoption; + { options for properties } tpropertyoption=(ppo_none, ppo_indexed, diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 277959f373..cf78d98c4e 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -327,11 +327,7 @@ interface lowrange, highrange : aint; rangetype : ttype; - IsConvertedPointer, - IsDynamicArray, - IsVariant, - IsConstructor, - IsArrayOfConst : boolean; + arrayoptions : tarraydefoptions; protected _elementtype : ttype; public @@ -2394,18 +2390,14 @@ implementation highrange:=h; rangetype:=t; elementtype.reset; - IsVariant:=false; - IsConstructor:=false; - IsArrayOfConst:=false; - IsDynamicArray:=false; - IsConvertedPointer:=false; + arrayoptions:=[]; end; constructor tarraydef.create_from_pointer(const elemt : ttype); begin self.create(0,$7fffffff,s32inttype); - IsConvertedPointer:=true; + arrayoptions:=[ado_IsConvertedPointer]; setelementtype(elemt); end; @@ -2418,21 +2410,14 @@ implementation ppufile.gettype(rangetype); lowrange:=ppufile.getaint; highrange:=ppufile.getaint; - IsArrayOfConst:=boolean(ppufile.getbyte); - IsDynamicArray:=boolean(ppufile.getbyte); - IsVariant:=false; - IsConstructor:=false; + ppufile.getsmallset(arrayoptions); end; function tarraydef.getcopy : tstoreddef; begin result:=tarraydef.create(lowrange,highrange,rangetype); - tarraydef(result).IsConvertedPointer:=IsConvertedPointer; - tarraydef(result).IsDynamicArray:=IsDynamicArray; - tarraydef(result).IsVariant:=IsVariant; - tarraydef(result).IsConstructor:=IsConstructor; - tarraydef(result).IsArrayOfConst:=IsArrayOfConst; + tarraydef(result).arrayoptions:=arrayoptions; tarraydef(result)._elementtype:=_elementtype; end; @@ -2460,8 +2445,7 @@ implementation ppufile.puttype(rangetype); ppufile.putaint(lowrange); ppufile.putaint(highrange); - ppufile.putbyte(byte(IsArrayOfConst)); - ppufile.putbyte(byte(IsDynamicArray)); + ppufile.putsmallset(arrayoptions); ppufile.writeentry(ibarraydef); end; @@ -2476,7 +2460,7 @@ implementation var qhigh,qlow : qword; begin - if IsDynamicArray then + if ado_IsDynamicArray in arrayoptions then begin result:=0; exit; @@ -2501,7 +2485,7 @@ implementation cachedelecount, cachedelesize : aint; begin - if IsDynamicArray then + if ado_IsDynamicArray in arrayoptions then begin size:=sizeof(aint); exit; @@ -2529,8 +2513,8 @@ implementation procedure tarraydef.setelementtype(t: ttype); begin _elementtype:=t; - if not(IsDynamicArray or - IsConvertedPointer or + if not((ado_IsDynamicArray in arrayoptions) or + (ado_IsConvertedPointer in arrayoptions) or (highrange<lowrange)) then begin if (size=-1) then @@ -2553,7 +2537,7 @@ implementation function tarraydef.needs_inittable : boolean; begin - needs_inittable:=IsDynamicArray or elementtype.def.needs_inittable; + needs_inittable:=(ado_IsDynamicArray in arrayoptions) or elementtype.def.needs_inittable; end; @@ -2565,7 +2549,7 @@ implementation procedure tarraydef.write_rtti_data(rt:trttitype); begin - if IsDynamicArray then + if ado_IsDynamicArray in arrayoptions then current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkdynarray)) else current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkarray)); @@ -2575,7 +2559,7 @@ implementation {$endif cpurequiresproperalignment} { size of elements } current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_aint(elesize)); - if not(IsDynamicArray) then + if not(ado_IsDynamicArray in arrayoptions) then current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_aint(elecount)); { element type } current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(tstoreddef(elementtype.def).get_rtti_label(rt))); @@ -2586,14 +2570,17 @@ implementation function tarraydef.gettypename : string; begin - if isarrayofconst or isConstructor then + if (ado_IsConstString in arrayoptions) then + result:='Constant String' + else if (ado_isarrayofconst in arrayoptions) or + (ado_isConstructor in arrayoptions) then begin - if isvariant or ((highrange=-1) and (lowrange=0)) then + if (ado_isvariant in arrayoptions) or ((highrange=-1) and (lowrange=0)) then gettypename:='Array Of Const' else gettypename:='Array Of '+elementtype.def.typename; end - else if ((highrange=-1) and (lowrange=0)) or IsDynamicArray then + else if ((highrange=-1) and (lowrange=0)) or (ado_IsDynamicArray in arrayoptions) then gettypename:='Array Of '+elementtype.def.typename else begin @@ -2608,7 +2595,7 @@ implementation function tarraydef.getmangledparaname : string; begin - if isarrayofconst then + if ado_isarrayofconst in arrayoptions then getmangledparaname:='array_of_const' else if ((highrange=-1) and (lowrange=0)) then diff --git a/compiler/symsym.pas b/compiler/symsym.pas index 8b1fd0c480..3a6cb3ec8b 100644 --- a/compiler/symsym.pas +++ b/compiler/symsym.pas @@ -1260,7 +1260,7 @@ implementation begin if assigned(vartype.def) and ((vartype.def.deftype<>arraydef) or - tarraydef(vartype.def).isDynamicArray or + is_dynamic_array(vartype.def) or (tarraydef(vartype.def).highrange>=tarraydef(vartype.def).lowrange)) then result:=vartype.def.size else diff --git a/compiler/utils/ppudump.pp b/compiler/utils/ppudump.pp index c42ebb3ced..087c547e72 100644 --- a/compiler/utils/ppudump.pp +++ b/compiler/utils/ppudump.pp @@ -1135,6 +1135,116 @@ begin end; +procedure readobjectdefoptions; +type + tobjectoption=(oo_none, + oo_is_forward, { the class is only a forward declared yet } + oo_has_virtual, { the object/class has virtual methods } + oo_has_private, + oo_has_protected, + oo_has_strictprivate, + oo_has_strictprotected, + oo_has_constructor, { the object/class has a constructor } + oo_has_destructor, { the object/class has a destructor } + oo_has_vmt, { the object/class has a vmt } + oo_has_msgstr, + oo_has_msgint, + oo_can_have_published,{ the class has rtti, i.e. you can publish properties } + oo_has_default_property + ); + tobjectoptions=set of tobjectoption; + tsymopt=record + mask : tobjectoption; + str : string[30]; + end; +const + symopts=13; + symopt : array[1..symopts] of tsymopt=( + (mask:oo_has_virtual; str:'IsForward'), + (mask:oo_has_virtual; str:'HasVirtual'), + (mask:oo_has_private; str:'HasPrivate'), + (mask:oo_has_protected; str:'HasProtected'), + (mask:oo_has_strictprivate; str:'HasStrictPrivate'), + (mask:oo_has_strictprotected;str:'HasStrictProtected'), + (mask:oo_has_constructor; str:'HasConstructor'), + (mask:oo_has_destructor; str:'HasDestructor'), + (mask:oo_has_vmt; str:'HasVMT'), + (mask:oo_has_msgstr; str:'HasMsgStr'), + (mask:oo_has_msgint; str:'HasMsgInt'), + (mask:oo_can_have_published; str:'CanHavePublished'), + (mask:oo_has_default_property;str:'HasDefaultProperty') + ); +var + symoptions : tobjectoptions; + i : longint; + first : boolean; +begin + ppufile.getsmallset(symoptions); + if symoptions<>[] then + begin + first:=true; + for i:=1to symopts do + if (symopt[i].mask in symoptions) then + begin + if first then + first:=false + else + write(', '); + write(symopt[i].str); + end; + end; + writeln; +end; + + +procedure readarraydefoptions; +type + tarraydefoption=(ado_none, + ado_IsConvertedPointer, + ado_IsDynamicArray, + ado_IsVariant, + ado_IsConstructor, + ado_IsArrayOfConst, + ado_IsConstString + ); + tarraydefoptions=set of tarraydefoption; + tsymopt=record + mask : tarraydefoption; + str : string[30]; + end; +const + symopts=6; + symopt : array[1..symopts] of tsymopt=( + (mask:ado_IsConvertedPointer;str:'ConvertedPointer'), + (mask:ado_IsDynamicArray; str:'IsDynamicArray'), + (mask:ado_IsVariant; str:'IsVariant'), + (mask:ado_IsConstructor; str:'IsConstructor'), + (mask:ado_IsArrayOfConst; str:'ArrayOfConst'), + (mask:ado_IsConstString; str:'ConstString') + ); +var + symoptions : tarraydefoptions; + i : longint; + first : boolean; +begin + ppufile.getsmallset(symoptions); + if symoptions<>[] then + begin + first:=true; + for i:=1to symopts do + if (symopt[i].mask in symoptions) then + begin + if first then + first:=false + else + write(', '); + write(symopt[i].str); + end; + end; + writeln; +end; + + procedure readnodetree; var l : longint; @@ -1558,8 +1668,8 @@ begin write (space,' Range Type : '); readtype; writeln(space,' Range : ',getlongint,' to ',getlongint); - writeln(space,' Is Constructor : ',(getbyte<>0)); - writeln(space,' Is Dynamic : ',(getbyte<>0)); + write (space,' Options : '); + readarraydefoptions; end; ibprocdef : @@ -1682,9 +1792,10 @@ begin writeln(space,' FieldAlign : ',getbyte); writeln(space,' RecordAlign : ',getbyte); writeln(space,' Vmt offset : ',getlongint); - write(space, ' Ancestor Class : '); + write (space, ' Ancestor Class : '); readderef; - writeln(space,' Options : ',getlongint); + write (space,' Options : '); + readobjectdefoptions; if tobjectdeftype(b) in [odt_interfacecom,odt_interfacecorba] then begin @@ -1872,6 +1983,9 @@ begin iblinkothersharedlibs : ReadLinkContainer('Link other shared lib: '); + iblinkdlls : + ReadLinkContainer('Link DLLs: '); + ibderefdata : ReadDerefData; |