diff --git a/compiler/cg386set.pas b/compiler/cg386set.pas index a4c5c16076..3006df27e4 100644 --- a/compiler/cg386set.pas +++ b/compiler/cg386set.pas @@ -659,6 +659,7 @@ implementation var lv,hv,min_label,max_label,labels : longint; max_linear_list : longint; + dist : dword; begin getlabel(endlabel); @@ -732,14 +733,26 @@ implementation min_label:=case_get_min(p^.nodes); max_label:=case_get_max(p^.nodes); labels:=case_count_labels(p^.nodes); - { can we omit the range check of the jump table } + { can we omit the range check of the jump table ? } getrange(p^.left^.resulttype,lv,hv); jumptable_no_range:=(lv=min_label) and (hv=max_label); + { hack a little bit, because the range can be greater } + { than the positive range of a longint } + + if (min_label<0) and (max_label>0) then + begin + if min_label=$80000000 then + dist:=dword(max_label)+dword($80000000) + else + dist:=dword(max_label)+dword(-min_label) + end + else + dist:=max_label-min_label; { optimize for size ? } if cs_littlesize in aktglobalswitches then begin - if (labels<=2) or ((max_label-min_label)>3*labels) then + if (labels<=2) or (dist>3*labels) then { a linear list is always smaller than a jump tree } genlinearlist(p^.nodes) else @@ -764,7 +777,7 @@ implementation genlinearlist(p^.nodes) else begin - if ((max_label-min_label)>4*labels) then + if (dist>4*labels) then begin if labels>16 then gentreejmp(p^.nodes) @@ -805,7 +818,13 @@ implementation end. { $Log$ - Revision 1.24 1999-03-02 18:21:35 peter + Revision 1.25 1999-04-08 20:59:37 florian + * fixed problem with default properties which are a class + * case bug (from the mailing list with -O2) fixed, the + distance of the case labels can be greater than the positive + range of a longint => it is now a dword for fpc + + Revision 1.24 1999/03/02 18:21:35 peter + flags support for add and case Revision 1.23 1999/02/25 21:02:31 peter diff --git a/compiler/cobjects.pas b/compiler/cobjects.pas index 4a94892346..90a86d913c 100644 --- a/compiler/cobjects.pas +++ b/compiler/cobjects.pas @@ -47,6 +47,13 @@ unit cobjects; type pstring = ^string; +{$ifdef TP} + { redeclare dword only in case of emergency, some small things + of the compiler won't work then correctly (FK) + } + dword = longint; +{$endif TP} + pfileposinfo = ^tfileposinfo; tfileposinfo = record line : longint; @@ -1612,7 +1619,13 @@ end; end. { $Log$ - Revision 1.22 1999-03-31 13:55:10 peter + Revision 1.23 1999-04-08 20:59:39 florian + * fixed problem with default properties which are a class + * case bug (from the mailing list with -O2) fixed, the + distance of the case labels can be greater than the positive + range of a longint => it is now a dword for fpc + + Revision 1.22 1999/03/31 13:55:10 peter * assembler inlining working for ag386bin Revision 1.21 1999/03/19 16:35:29 pierre diff --git a/compiler/pbase.pas b/compiler/pbase.pas index fda23374c5..5d472cb694 100644 --- a/compiler/pbase.pas +++ b/compiler/pbase.pas @@ -100,7 +100,10 @@ unit pbase; procedure consume(i : ttoken); begin if (token<>i) and (idtoken<>i) then - Message2(scan_f_syn_expected,tokeninfo[i].str,tokeninfo[token].str) + if token=ID then + Message2(scan_f_syn_expected,tokeninfo[i].str,'identifier '+pattern) + else + Message2(scan_f_syn_expected,tokeninfo[i].str,tokeninfo[token].str) else begin if token=_END then @@ -180,7 +183,13 @@ end. { $Log$ - Revision 1.18 1998-12-11 00:03:29 peter + Revision 1.19 1999-04-08 20:59:42 florian + * fixed problem with default properties which are a class + * case bug (from the mailing list with -O2) fixed, the + distance of the case labels can be greater than the positive + range of a longint => it is now a dword for fpc + + Revision 1.18 1998/12/11 00:03:29 peter + globtype,tokens,version unit splitted from globals Revision 1.17 1998/09/26 17:45:31 peter diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index afe3d1f5fb..d02c0e6335 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -1231,10 +1231,7 @@ unit pexpr; message(parser_e_no_default_property_available); end else - begin - p1:=nil; - handle_propertysym(propsym,propsym^.owner,p1,pd); - end; + handle_propertysym(propsym,propsym^.owner,p1,pd); end else begin @@ -1976,7 +1973,13 @@ unit pexpr; end. { $Log$ - Revision 1.91 1999-04-06 11:21:56 peter + Revision 1.92 1999-04-08 20:59:43 florian + * fixed problem with default properties which are a class + * case bug (from the mailing list with -O2) fixed, the + distance of the case labels can be greater than the positive + range of a longint => it is now a dword for fpc + + Revision 1.91 1999/04/06 11:21:56 peter * more use of ttoken Revision 1.90 1999/03/31 13:55:12 peter diff --git a/compiler/temp_gen.pas b/compiler/temp_gen.pas index 728949d023..c9f4af4870 100644 --- a/compiler/temp_gen.pas +++ b/compiler/temp_gen.pas @@ -37,6 +37,15 @@ unit temp_gen; {$endif m68k} cobjects,globals,tree,hcodegen,verbose,files,aasm; + type +{ this saves some memory } +{$ifdef FPC} +{$minenumsize 1} +{$endif FPC} + ttemptype = (tt_normal,tt_ansistring,tt_widestring); +{$ifdef FPC} +{$minenumsize default} +{$endif FPC} { generates temporary variables } procedure resettempgen; procedure setfirsttemp(l : longint); @@ -49,9 +58,10 @@ unit temp_gen; procedure ungettemp(pos : longint;size : longint); procedure ungetpersistanttemp(pos : longint;size : longint); procedure gettempofsizereference(l : longint;var ref : treference); - procedure gettempansistringreference(var ref : treference); + procedure gettempslotreference(slottype : ttemptype;var ref : treference); function istemp(const ref : treference) : boolean; procedure ungetiftemp(const ref : treference); + procedure gettempansistringreference(var ref : treference); implementation @@ -74,14 +84,19 @@ unit temp_gen; pos : longint; size : longint; persistant : boolean; { used for inlined procedures } + temptype : ttemptype; {$ifdef EXTDEBUG} posinfo,releaseposinfo : tfileposinfo; {$endif} end; var + { contains all free temps } tmpfreelist : pfreerecord; + { contains all used temps } templist : pfreerecord; + { contains the slots for ansi/wide string temps } + reftempslots : pfreerecord; {$ifdef EXTDEBUG} tempfreedlist : pfreerecord; {$endif} @@ -252,6 +267,7 @@ unit temp_gen; end; procedure gettempansistringreference(var ref : treference); + begin { do a reset, because the reference isn't used } reset_reference(ref); @@ -259,6 +275,15 @@ unit temp_gen; ref.base:=procinfo.framepointer; end; + procedure gettempslotreference(slottype : ttemptype;var ref : treference); + begin + { do a reset, because the reference isn't used } + reset_reference(ref); + ref.offset:=gettempofsize(4); + ref.base:=procinfo.framepointer; + templist^.temptype:=slottype; + end; + function istemp(const ref : treference) : boolean; @@ -439,13 +464,13 @@ unit temp_gen; while assigned(tl) do begin { no release of persistant blocks this way!! } - if tl^.persistant then + if (tl^.persistant) or (tl^.temptype<>tt_normal) then if (ref.offset>=tl^.pos) and (ref.offset it is now a dword for fpc + + Revision 1.10 1999/04/06 11:19:49 peter * fixed temp reuse Revision 1.9 1999/02/22 02:15:56 peter