mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 07:09:29 +02:00
* merged fixes
This commit is contained in:
peter
parent
477e51be64
commit
c5da6c53fd
@ -632,6 +632,14 @@ implementation
|
||||
|
||||
procedure genitem(t : pcaserecord);
|
||||
|
||||
procedure gensub(value:longint);
|
||||
begin
|
||||
if value=1 then
|
||||
emit_reg(A_DEC,opsize,hregister)
|
||||
else
|
||||
emit_const_reg(A_SUB,opsize,value,hregister);
|
||||
end;
|
||||
|
||||
begin
|
||||
if assigned(t^.less) then
|
||||
genitem(t^.less);
|
||||
@ -643,12 +651,10 @@ implementation
|
||||
end;
|
||||
if t^._low=t^._high then
|
||||
begin
|
||||
if t^._low-last=1 then
|
||||
emit_reg(A_DEC,opsize,hregister)
|
||||
else if t^._low-last=0 then
|
||||
if t^._low-last=0 then
|
||||
emit_reg_reg(A_OR,opsize,hregister,hregister)
|
||||
else
|
||||
emit_const_reg(A_SUB,opsize,t^._low-last,hregister);
|
||||
gensub(t^._low-last);
|
||||
last:=t^._low;
|
||||
emitjmp(C_Z,t^.statement);
|
||||
end
|
||||
@ -661,29 +667,18 @@ implementation
|
||||
begin
|
||||
{ have we to ajust the first value ? }
|
||||
if t^._low>get_min_value(p^.left^.resulttype) then
|
||||
begin
|
||||
if t^._low=1 then
|
||||
emit_reg(A_DEC,opsize,
|
||||
hregister)
|
||||
else
|
||||
emit_const_reg(A_SUB,opsize,
|
||||
t^._low,hregister);
|
||||
end;
|
||||
gensub(t^._low);
|
||||
end
|
||||
else
|
||||
{ if there is no unused label between the last and the }
|
||||
{ present label then the lower limit can be checked }
|
||||
{ immediately. else check the range in between: }
|
||||
if (t^._low-last>1) then
|
||||
begin
|
||||
emit_const_reg(A_SUB,opsize,t^._low-last,hregister);
|
||||
emitjmp(jmp_le,elselabel);
|
||||
end
|
||||
else
|
||||
emit_reg(A_DEC,opsize,hregister);
|
||||
{ if there is no unused label between the last and the }
|
||||
{ present label then the lower limit can be checked }
|
||||
{ immediately. else check the range in between: }
|
||||
emit_const_reg(A_SUB,opsize,t^._low-last,hregister);
|
||||
emitjmp(jmp_le,elselabel);
|
||||
end;
|
||||
emit_const_reg(A_SUB,opsize,t^._high-t^._low,hregister);
|
||||
emitjmp(jmp_lee,t^.statement);
|
||||
|
||||
last:=t^._high;
|
||||
end;
|
||||
first:=false;
|
||||
@ -969,7 +964,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2000-07-27 09:25:05 jonas
|
||||
Revision 1.4 2000-07-30 17:04:43 peter
|
||||
* merged fixes
|
||||
|
||||
Revision 1.3 2000/07/27 09:25:05 jonas
|
||||
* moved locflags2reg() procedure from cg386add to cgai386
|
||||
+ added locjump2reg() procedure to cgai386
|
||||
* fixed internalerror(2002) when the result of a case expression has
|
||||
|
||||
@ -99,36 +99,32 @@ unit pdecl;
|
||||
varspez:=vs_value;
|
||||
inserthigh:=false;
|
||||
tt.reset;
|
||||
if idtoken=_SELF then
|
||||
{ self is only allowed in procvars and class methods }
|
||||
if (idtoken=_SELF) and
|
||||
(is_procvar or
|
||||
(assigned(procinfo^._class) and procinfo^._class^.is_class)) then
|
||||
begin
|
||||
{ only allowed in procvars and class methods }
|
||||
if is_procvar or
|
||||
(assigned(procinfo^._class) and procinfo^._class^.is_class) then
|
||||
begin
|
||||
if not is_procvar then
|
||||
begin
|
||||
if not is_procvar then
|
||||
begin
|
||||
{$ifndef UseNiceNames}
|
||||
hs2:=hs2+'$'+'self';
|
||||
hs2:=hs2+'$'+'self';
|
||||
{$else UseNiceNames}
|
||||
hs2:=hs2+tostr(length('self'))+'self';
|
||||
hs2:=hs2+tostr(length('self'))+'self';
|
||||
{$endif UseNiceNames}
|
||||
vs:=new(Pvarsym,initdef('@',procinfo^._class));
|
||||
vs^.varspez:=vs_var;
|
||||
{ insert the sym in the parasymtable }
|
||||
pprocdef(aktprocdef)^.parast^.insert(vs);
|
||||
include(aktprocdef^.procoptions,po_containsself);
|
||||
inc(procinfo^.selfpointer_offset,vs^.address);
|
||||
end;
|
||||
consume(idtoken);
|
||||
consume(_COLON);
|
||||
single_type(tt,hs1,false);
|
||||
aktprocdef^.concatpara(tt,vs_value);
|
||||
{ check the types for procedures only }
|
||||
if not is_procvar then
|
||||
CheckTypes(tt.def,procinfo^._class);
|
||||
end
|
||||
else
|
||||
consume(_ID);
|
||||
vs:=new(Pvarsym,initdef('@',procinfo^._class));
|
||||
vs^.varspez:=vs_var;
|
||||
{ insert the sym in the parasymtable }
|
||||
pprocdef(aktprocdef)^.parast^.insert(vs);
|
||||
include(aktprocdef^.procoptions,po_containsself);
|
||||
inc(procinfo^.selfpointer_offset,vs^.address);
|
||||
end;
|
||||
consume(idtoken);
|
||||
consume(_COLON);
|
||||
single_type(tt,hs1,false);
|
||||
aktprocdef^.concatpara(tt,vs_value);
|
||||
{ check the types for procedures only }
|
||||
if not is_procvar then
|
||||
CheckTypes(tt.def,procinfo^._class);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -1232,7 +1228,10 @@ unit pdecl;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2000-07-14 05:11:49 michael
|
||||
Revision 1.5 2000-07-30 17:04:43 peter
|
||||
* merged fixes
|
||||
|
||||
Revision 1.4 2000/07/14 05:11:49 michael
|
||||
+ Patch to 1.1
|
||||
|
||||
Revision 1.3 2000/07/13 12:08:26 michael
|
||||
|
||||
@ -1252,9 +1252,17 @@ begin
|
||||
if (po_overload in pd^.procoptions) or
|
||||
(po_overload in hd^.procoptions) then
|
||||
begin
|
||||
if not((po_overload in pd^.procoptions) and
|
||||
(po_overload in hd^.procoptions)) then
|
||||
Message1(parser_e_no_overload_for_all_procs,aktprocsym^.name);
|
||||
{ one a forwarddef and the other not then the not may not have
|
||||
the directive as in D5 (PFV) }
|
||||
if hd^.forwarddef and (not pd^.forwarddef) then
|
||||
begin
|
||||
if (po_overload in pd^.procoptions) then
|
||||
Message1(parser_e_proc_dir_not_allowed_in_implementation,'OVERLOAD');
|
||||
end
|
||||
else
|
||||
if not((po_overload in pd^.procoptions) and
|
||||
((po_overload in hd^.procoptions))) then
|
||||
Message1(parser_e_no_overload_for_all_procs,aktprocsym^.name);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -2058,10 +2066,12 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2000-07-13 12:08:27 michael
|
||||
Revision 1.4 2000-07-30 17:04:43 peter
|
||||
* merged fixes
|
||||
|
||||
Revision 1.3 2000/07/13 12:08:27 michael
|
||||
+ patched to 1.1.0 with former 1.09patch from peter
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:46 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
|
||||
@ -1338,6 +1338,28 @@ uses
|
||||
lowval,
|
||||
highval : longint;
|
||||
arraytype : pdef;
|
||||
ht : ttype;
|
||||
|
||||
procedure setdefdecl(p:pdef);
|
||||
begin
|
||||
case p^.deftype of
|
||||
enumdef :
|
||||
begin
|
||||
lowval:=penumdef(p)^.min;
|
||||
highval:=penumdef(p)^.max;
|
||||
arraytype:=p;
|
||||
end;
|
||||
orddef :
|
||||
begin
|
||||
lowval:=porddef(p)^.low;
|
||||
highval:=porddef(p)^.high;
|
||||
arraytype:=p;
|
||||
end;
|
||||
else
|
||||
Message(sym_e_error_in_type_def);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
consume(_ARRAY);
|
||||
consume(_LECKKLAMMER);
|
||||
@ -1347,51 +1369,44 @@ uses
|
||||
highval:=$7fffffff;
|
||||
tt.reset;
|
||||
repeat
|
||||
{ read the expression and check it }
|
||||
pt:=expr;
|
||||
if pt^.treetype=typen then
|
||||
begin
|
||||
case pt^.resulttype^.deftype of
|
||||
enumdef :
|
||||
begin
|
||||
lowval:=penumdef(pt^.resulttype)^.min;
|
||||
highval:=penumdef(pt^.resulttype)^.max;
|
||||
arraytype:=pt^.resulttype;
|
||||
end;
|
||||
orddef :
|
||||
begin
|
||||
lowval:=porddef(pt^.resulttype)^.low;
|
||||
highval:=porddef(pt^.resulttype)^.high;
|
||||
arraytype:=pt^.resulttype;
|
||||
end;
|
||||
else
|
||||
Message(sym_e_error_in_type_def);
|
||||
end;
|
||||
end
|
||||
{ read the expression and check it, check apart if the
|
||||
declaration is an enum declaration because that needs to
|
||||
be parsed by readtype (PFV) }
|
||||
if token=_LKLAMMER then
|
||||
begin
|
||||
read_type(ht,'');
|
||||
setdefdecl(ht.def);
|
||||
end
|
||||
else
|
||||
begin
|
||||
do_firstpass(pt);
|
||||
if (pt^.treetype=rangen) then
|
||||
begin
|
||||
if (pt^.left^.treetype=ordconstn) and
|
||||
(pt^.right^.treetype=ordconstn) then
|
||||
begin
|
||||
pt:=expr;
|
||||
if pt^.treetype=typen then
|
||||
setdefdecl(pt^.resulttype)
|
||||
else
|
||||
begin
|
||||
do_firstpass(pt);
|
||||
if (pt^.treetype=rangen) then
|
||||
begin
|
||||
lowval:=pt^.left^.value;
|
||||
highval:=pt^.right^.value;
|
||||
if highval<lowval then
|
||||
if (pt^.left^.treetype=ordconstn) and
|
||||
(pt^.right^.treetype=ordconstn) then
|
||||
begin
|
||||
Message(parser_e_array_lower_less_than_upper_bound);
|
||||
highval:=lowval;
|
||||
end;
|
||||
arraytype:=pt^.right^.resulttype;
|
||||
lowval:=pt^.left^.value;
|
||||
highval:=pt^.right^.value;
|
||||
if highval<lowval then
|
||||
begin
|
||||
Message(parser_e_array_lower_less_than_upper_bound);
|
||||
highval:=lowval;
|
||||
end;
|
||||
arraytype:=pt^.right^.resulttype;
|
||||
end
|
||||
else
|
||||
Message(type_e_cant_eval_constant_expr);
|
||||
end
|
||||
else
|
||||
Message(type_e_cant_eval_constant_expr);
|
||||
end
|
||||
else
|
||||
Message(sym_e_error_in_type_def)
|
||||
end;
|
||||
disposetree(pt);
|
||||
Message(sym_e_error_in_type_def)
|
||||
end;
|
||||
disposetree(pt);
|
||||
end;
|
||||
|
||||
{ create arraydef }
|
||||
if not assigned(tt.def) then
|
||||
@ -1578,7 +1593,10 @@ uses
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2000-07-13 12:08:27 michael
|
||||
Revision 1.4 2000-07-30 17:04:43 peter
|
||||
* merged fixes
|
||||
|
||||
Revision 1.3 2000/07/13 12:08:27 michael
|
||||
+ patched to 1.1.0 with former 1.09patch from peter
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:47 michael
|
||||
|
||||
@ -1167,7 +1167,8 @@ Begin
|
||||
|
||||
AS_REGISTER :
|
||||
begin
|
||||
if (not GotPlus) and (not GotStar) then
|
||||
if not((GotPlus and (not Negative)) or
|
||||
GotStar) then
|
||||
Message(asmr_e_invalid_reference_syntax);
|
||||
hreg:=actasmregister;
|
||||
Consume(AS_REGISTER);
|
||||
@ -1902,7 +1903,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2000-07-13 11:32:48 michael
|
||||
Revision 1.3 2000-07-30 17:04:43 peter
|
||||
* merged fixes
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:48 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
|
||||
Binary file not shown.
Loading…
Reference in New Issue
Block a user