diff --git a/compiler/defutil.pas b/compiler/defutil.pas index 6c88671bf1..88b6e5c77e 100644 --- a/compiler/defutil.pas +++ b/compiler/defutil.pas @@ -1011,7 +1011,7 @@ implementation {# returns true, if the type passed is a varset } function is_varset(p : tdef) : boolean; begin - result:=(p.typ=setdef) and not(p.size=4) and not(p.size=32); + result:=(p.typ=setdef) and not(p.size=4); end; diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 631389bdf5..68da9ccf0b 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -895,6 +895,7 @@ implementation function valid_for_assign(p:tnode;opts:TValidAssigns; report_errors: boolean):boolean; var + hp2, hp : tnode; gotstring, gotsubscript, @@ -1084,6 +1085,24 @@ implementation gotdynarray:=true; hp:=tunarynode(hp).left; end; + blockn : + begin + hp2:=tblocknode(hp).statements; + if assigned(hp2) then + begin + if hp2.nodetype<>statementn then + internalerror(2006110801); + while assigned(tstatementnode(hp2).next) do + hp2:=tstatementnode(hp2).next; + hp:=tstatementnode(hp2).statement; + end + else + begin + if report_errors then + CGMessagePos(hp.fileinfo,type_e_variable_id_expected); + exit; + end; + end; asn : begin { asn can't be assigned directly, it returns the value in a register instead diff --git a/compiler/nadd.pas b/compiler/nadd.pas index 968fd7196a..433ebab276 100644 --- a/compiler/nadd.pas +++ b/compiler/nadd.pas @@ -1729,10 +1729,8 @@ implementation newstatement : tstatementnode; temp : ttempcreatenode; begin - if is_varset(left.resultdef) then + if is_varset(left.resultdef) or is_varset(right.resultdef) then begin - if not(is_varset(right.resultdef)) then - internalerror(2006091901); case nodetype of equaln,unequaln,lten,gten: begin @@ -1778,7 +1776,7 @@ implementation addstatement(newstatement,ccallnode.createintern('fpc_varset_create_element', ccallparanode.create(ctemprefnode.create(temp), ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false), - ccallparanode.create(tsetelementnode(right).left,nil)))) + ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),nil)))) ); { the last statement should return the value as @@ -1804,15 +1802,15 @@ implementation if assigned(tsetelementnode(right).right) then addstatement(newstatement,ccallnode.createintern('fpc_varset_set_range', ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false), - ccallparanode.create(tsetelementnode(right).right, - ccallparanode.create(tsetelementnode(right).left, + ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(tsetelementnode(right).right),sinttype), + ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(tsetelementnode(right).left),sinttype), ccallparanode.create(ctemprefnode.create(temp), ccallparanode.create(left,nil)))))) ) else addstatement(newstatement,ccallnode.createintern('fpc_varset_set', ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false), - ccallparanode.create(tsetelementnode(right).left, + ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype), ccallparanode.create(ctemprefnode.create(temp), ccallparanode.create(left,nil))))) ); diff --git a/compiler/nbas.pas b/compiler/nbas.pas index f0b5519d01..7895b9c62f 100644 --- a/compiler/nbas.pas +++ b/compiler/nbas.pas @@ -73,6 +73,8 @@ interface function pass_1 : tnode;override; function pass_typecheck:tnode;override; procedure printnodetree(var t:text);override; + property statement : tnode read left write left; + property next : tnode read right write right; end; tstatementnodeclass = class of tstatementnode; @@ -84,6 +86,7 @@ interface {$ifdef state_tracking} function track_state_pass(exec_known:boolean):boolean;override; {$endif state_tracking} + property statements : tnode read left write left; end; tblocknodeclass = class of tblocknode; diff --git a/compiler/ncgadd.pas b/compiler/ncgadd.pas index 1ecb4735a3..cd2a195764 100644 --- a/compiler/ncgadd.pas +++ b/compiler/ncgadd.pas @@ -219,7 +219,7 @@ interface { when it is not allowed to swap we have a constant on left, that will give problems } if not allow_swap then - internalerror(200307041); + internalerror(200307043); swapleftright; end; end; diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 417d5a3ce3..dea9fd7919 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -2012,10 +2012,14 @@ implementation if high<32 then begin settype:=smallset; + { if current_settings.setalloc=0 then { $PACKSET Fixed?} + } savesize:=Sizeof(longint) + { else {No, use $PACKSET VALUE for rounding} - savesize:=current_settings.setalloc*((high+current_settings.setalloc*8-1) DIV (current_settings.setalloc*8)); + savesize:=current_settings.setalloc*(((high+1)+current_settings.setalloc*8-1) DIV (current_settings.setalloc*8)); + } end else if high<256 then @@ -2024,10 +2028,10 @@ implementation if current_settings.setalloc=0 then { $PACKSET Fixed?} savesize:=32 else {No, use $PACKSET VALUE for rounding} - savesize:=current_settings.setalloc*((high+current_settings.setalloc*8-1) DIV (current_settings.setalloc*8)); + savesize:=current_settings.setalloc*(((high+1)+current_settings.setalloc*8-1) DIV (current_settings.setalloc*8)); end else - savesize:=current_settings.setalloc*((high+current_settings.setalloc*8-1) DIV (current_settings.setalloc*8)); + savesize:=current_settings.setalloc*(((high+1)+current_settings.setalloc*8-1) DIV (current_settings.setalloc*8)); end; diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc index f741999aab..ca64b8a68c 100644 --- a/rtl/inc/compproc.inc +++ b/rtl/inc/compproc.inc @@ -313,8 +313,8 @@ function fpc_set_contains_sets(const set1,set2: fpc_normal_set): boolean; compil procedure fpc_varset_load_small(l: fpc_small_set;var dest;size : ptrint); compilerproc; procedure fpc_varset_create_element(b,size : ptrint; var data); compilerproc; -procedure fpc_varset_set(var source,dest; b,size : ptrint); compilerproc; -procedure fpc_varset_unset(var source,dest; b,size : ptrint); compilerproc; +procedure fpc_varset_set(const source;var dest; b,size : ptrint); compilerproc; +procedure fpc_varset_unset(const source;var dest; b,size : ptrint); compilerproc; procedure fpc_varset_set_range(const orgset; var dest;l,h,size : ptrint); compilerproc; function fpc_varset_in(const p; b : ptrint): boolean; compilerproc; procedure fpc_varset_add_sets(const set1,set2; var dest;size : ptrint); compilerproc; diff --git a/rtl/inc/genset.inc b/rtl/inc/genset.inc index 9aa28ab279..3f2bbe7a57 100644 --- a/rtl/inc/genset.inc +++ b/rtl/inc/genset.inc @@ -239,11 +239,11 @@ procedure fpc_varset_create_element(b,size : ptrint; var data); compilerproc; { add the element b to the set "source" } -procedure fpc_varset_set(var source,dest; b,size : ptrint); compilerproc; +procedure fpc_varset_set(const source;var dest; b,size : ptrint); compilerproc; type tbytearray = array[0..sizeof(sizeint)-1] of byte; begin - move(source,dest,sizeof(source)); + move(source,dest,size); tbytearray(dest)[b div 8]:=tbytearray(dest)[b div 8] or (1 shl (b mod 8)); end; {$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_SET_BYTE} @@ -254,7 +254,7 @@ procedure fpc_varset_set(var source,dest; b,size : ptrint); compilerproc; suppresses the element b to the set pointed by p used for exclude(set,element) } -procedure fpc_varset_unset(var source,dest; b,size : ptrint); compilerproc; +procedure fpc_varset_unset(const source;var dest; b,size : ptrint); compilerproc; type tbytearray = array[0..sizeof(sizeint)-1] of byte; begin