mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-13 03:29:30 +02:00
* removed uauto from orddef, use new range_to_basetype generating
the correct ordinal type for a range
This commit is contained in:
peter
parent
0aa1c49c9f
commit
d24762aeba
@ -506,6 +506,8 @@ implementation
|
||||
is_64bitint(p.proptype.def) or
|
||||
((p.proptype.def.deftype=setdef) and
|
||||
(tsetdef(p.proptype.def).settype=smallset))) or
|
||||
((p.proptype.def.deftype=arraydef) and
|
||||
(ppo_indexed in p.propoptions)) or
|
||||
not(propertyparas.empty) then
|
||||
Message(parser_e_property_cant_have_a_default_value);
|
||||
{ Get the result of the default, the firstpass is
|
||||
@ -1109,8 +1111,9 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.35 2001-12-31 16:59:41 peter
|
||||
* protected/private symbols parsing fixed
|
||||
Revision 1.36 2002-01-06 12:08:15 peter
|
||||
* removed uauto from orddef, use new range_to_basetype generating
|
||||
the correct ordinal type for a range
|
||||
|
||||
Revision 1.34 2001/12/06 17:57:35 florian
|
||||
+ parasym to tparaitem added
|
||||
|
||||
@ -246,6 +246,7 @@ implementation
|
||||
procedure expr_type;
|
||||
var
|
||||
pt1,pt2 : tnode;
|
||||
lv,hv : TConstExprInt;
|
||||
begin
|
||||
{ use of current parsed object ? }
|
||||
if (token=_ID) and (testcurobject=2) and (curobjectname=pattern) then
|
||||
@ -274,24 +275,26 @@ implementation
|
||||
if (pt1.nodetype=ordconstn) and
|
||||
(pt2.nodetype=ordconstn) then
|
||||
begin
|
||||
lv:=tordconstnode(pt1).value;
|
||||
hv:=tordconstnode(pt2).value;
|
||||
{ Check bounds }
|
||||
if tordconstnode(pt2).value<tordconstnode(pt1).value then
|
||||
if hv<lv then
|
||||
Message(cg_e_upper_lower_than_lower)
|
||||
else
|
||||
begin
|
||||
{ All checks passed, create the new def }
|
||||
case pt1.resulttype.def.deftype of
|
||||
enumdef :
|
||||
tt.setdef(tenumdef.create_subrange(tenumdef(pt1.resulttype.def),tordconstnode(pt1).value,tordconstnode(pt2).value));
|
||||
tt.setdef(tenumdef.create_subrange(tenumdef(pt1.resulttype.def),lv,hv));
|
||||
orddef :
|
||||
begin
|
||||
if is_char(pt1.resulttype.def) then
|
||||
tt.setdef(torddef.create(uchar,tordconstnode(pt1).value,tordconstnode(pt2).value))
|
||||
tt.setdef(torddef.create(uchar,lv,hv))
|
||||
else
|
||||
if is_boolean(pt1.resulttype.def) then
|
||||
tt.setdef(torddef.create(bool8bit,tordconstnode(pt1).value,tordconstnode(pt2).value))
|
||||
tt.setdef(torddef.create(bool8bit,l,hv))
|
||||
else
|
||||
tt.setdef(torddef.create(uauto,tordconstnode(pt1).value,tordconstnode(pt2).value));
|
||||
tt.setdef(torddef.create(range_to_basetype(lv,hv),lv,hv));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -607,8 +610,9 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.31 2001-12-31 16:59:43 peter
|
||||
* protected/private symbols parsing fixed
|
||||
Revision 1.32 2002-01-06 12:08:15 peter
|
||||
* removed uauto from orddef, use new range_to_basetype generating
|
||||
the correct ordinal type for a range
|
||||
|
||||
Revision 1.30 2001/08/30 20:13:53 peter
|
||||
* rtti/init table updates
|
||||
|
||||
@ -132,11 +132,11 @@ type
|
||||
|
||||
{ base types for orddef }
|
||||
tbasetype = (
|
||||
uauto,uvoid,uchar,
|
||||
u8bit,u16bit,u32bit,
|
||||
s8bit,s16bit,s32bit,
|
||||
uvoid,
|
||||
u8bit,u16bit,u32bit,u64bit,
|
||||
s8bit,s16bit,s32bit,s64bit,
|
||||
bool8bit,bool16bit,bool32bit,
|
||||
u64bit,s64bit,uwidechar
|
||||
uchar,uwidechar
|
||||
);
|
||||
|
||||
{ float types }
|
||||
@ -326,7 +326,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.27 2001-10-25 21:22:37 peter
|
||||
Revision 1.28 2002-01-06 12:08:15 peter
|
||||
* removed uauto from orddef, use new range_to_basetype generating
|
||||
the correct ordinal type for a range
|
||||
|
||||
Revision 1.27 2001/10/25 21:22:37 peter
|
||||
* calling convention rewrite
|
||||
|
||||
Revision 1.26 2001/10/23 21:49:43 peter
|
||||
|
||||
@ -1655,65 +1655,26 @@ implementation
|
||||
|
||||
procedure torddef.setsize;
|
||||
begin
|
||||
if typ=uauto then
|
||||
begin
|
||||
{ generate a unsigned range if high<0 and low>=0 }
|
||||
if (low>=0) and (high<0) then
|
||||
begin
|
||||
savesize:=4;
|
||||
typ:=u32bit;
|
||||
end
|
||||
else if (low>=0) and (high<=255) then
|
||||
begin
|
||||
savesize:=1;
|
||||
typ:=u8bit;
|
||||
end
|
||||
else if (low>=-128) and (high<=127) then
|
||||
begin
|
||||
savesize:=1;
|
||||
typ:=s8bit;
|
||||
end
|
||||
else if (low>=0) and (high<=65536) then
|
||||
begin
|
||||
savesize:=2;
|
||||
typ:=u16bit;
|
||||
end
|
||||
else if (low>=-32768) and (high<=32767) then
|
||||
begin
|
||||
savesize:=2;
|
||||
typ:=s16bit;
|
||||
end
|
||||
else
|
||||
begin
|
||||
savesize:=4;
|
||||
typ:=s32bit;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
case typ of
|
||||
u8bit,s8bit,
|
||||
uchar,bool8bit:
|
||||
savesize:=1;
|
||||
|
||||
u16bit,s16bit,
|
||||
bool16bit,uwidechar:
|
||||
savesize:=2;
|
||||
|
||||
s32bit,u32bit,
|
||||
bool32bit:
|
||||
savesize:=4;
|
||||
|
||||
u64bit,s64bit:
|
||||
savesize:=8;
|
||||
else
|
||||
savesize:=0;
|
||||
end;
|
||||
end;
|
||||
case typ of
|
||||
u8bit,s8bit,
|
||||
uchar,bool8bit:
|
||||
savesize:=1;
|
||||
u16bit,s16bit,
|
||||
bool16bit,uwidechar:
|
||||
savesize:=2;
|
||||
s32bit,u32bit,
|
||||
bool32bit:
|
||||
savesize:=4;
|
||||
u64bit,s64bit:
|
||||
savesize:=8;
|
||||
else
|
||||
savesize:=0;
|
||||
end;
|
||||
{ there are no entrys for range checking }
|
||||
rangenr:=0;
|
||||
end;
|
||||
|
||||
|
||||
function torddef.getrangecheckstring : string;
|
||||
|
||||
begin
|
||||
@ -1808,8 +1769,12 @@ implementation
|
||||
|
||||
procedure dointeger;
|
||||
const
|
||||
trans : array[uchar..bool8bit] of byte =
|
||||
(otUByte,otUByte,otUWord,otULong,otSByte,otSWord,otSLong,otUByte);
|
||||
trans : array[tbasetype] of byte =
|
||||
(otUByte{otNone},
|
||||
otUByte,otUWord,otULong,otUByte{otNone},
|
||||
otSByte,otSWord,otSLong,otUByte{otNone},
|
||||
otUByte,otUWord,otULong,
|
||||
otUByte,otUWord);
|
||||
begin
|
||||
write_rtti_name;
|
||||
rttiList.concat(Tai_const.Create_8bit(byte(trans[typ])));
|
||||
@ -1873,10 +1838,12 @@ implementation
|
||||
function torddef.gettypename : string;
|
||||
|
||||
const
|
||||
names : array[tbasetype] of string[20] = ('<unknown type>',
|
||||
'untyped','Char','Byte','Word','DWord','ShortInt',
|
||||
'SmallInt','LongInt','Boolean','WordBool',
|
||||
'LongBool','QWord','Int64','WideChar');
|
||||
names : array[tbasetype] of string[20] = (
|
||||
'untyped',
|
||||
'Byte','Word','DWord','QWord',
|
||||
'ShortInt','SmallInt','LongInt','Int64',
|
||||
'Boolean','WordBool','LongBool',
|
||||
'Char','WideChar');
|
||||
|
||||
begin
|
||||
gettypename:=names[typ];
|
||||
@ -3805,11 +3772,11 @@ implementation
|
||||
|
||||
const
|
||||
ordtype2str : array[tbasetype] of string[2] = (
|
||||
'','','c',
|
||||
'Uc','Us','Ui',
|
||||
'Sc','s','i',
|
||||
'',
|
||||
'Uc','Us','Ui','Us',
|
||||
'Sc','s','i','x',
|
||||
'b','b','b',
|
||||
'Us','x','w');
|
||||
'c','w');
|
||||
|
||||
var
|
||||
s : string;
|
||||
@ -5506,7 +5473,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.61 2001-12-19 09:34:51 florian
|
||||
Revision 1.62 2002-01-06 12:08:15 peter
|
||||
* removed uauto from orddef, use new range_to_basetype generating
|
||||
the correct ordinal type for a range
|
||||
|
||||
Revision 1.61 2001/12/19 09:34:51 florian
|
||||
* publishing of publishable classes fixed
|
||||
|
||||
Revision 1.60 2001/12/06 17:57:39 florian
|
||||
|
||||
@ -30,7 +30,7 @@ interface
|
||||
cclasses,
|
||||
cpuinfo,
|
||||
node,
|
||||
symbase,symtype,symdef,symsym;
|
||||
symconst,symbase,symtype,symdef,symsym;
|
||||
|
||||
type
|
||||
tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
|
||||
@ -50,6 +50,9 @@ interface
|
||||
{ returns the min. value of the type }
|
||||
function get_min_value(def : tdef) : longint;
|
||||
|
||||
{ returns basetype of the specified range }
|
||||
function range_to_basetype(low,high:TConstExprInt):tbasetype;
|
||||
|
||||
{ returns true, if def defines an ordinal type }
|
||||
function is_integer(def : tdef) : boolean;
|
||||
|
||||
@ -250,7 +253,7 @@ implementation
|
||||
|
||||
uses
|
||||
globtype,globals,systems,tokens,verbose,
|
||||
symconst,symtable;
|
||||
symtable;
|
||||
|
||||
|
||||
function needs_prop_entry(sym : tsym) : boolean;
|
||||
@ -510,6 +513,24 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function range_to_basetype(low,high:TConstExprInt):tbasetype;
|
||||
begin
|
||||
{ generate a unsigned range if high<0 and low>=0 }
|
||||
if (low>=0) and (high<0) then
|
||||
range_to_basetype:=u32bit
|
||||
else if (low>=0) and (high<=255) then
|
||||
range_to_basetype:=u8bit
|
||||
else if (low>=-128) and (high<=127) then
|
||||
range_to_basetype:=s8bit
|
||||
else if (low>=0) and (high<=65536) then
|
||||
range_to_basetype:=u16bit
|
||||
else if (low>=-32768) and (high<=32767) then
|
||||
range_to_basetype:=s16bit
|
||||
else
|
||||
range_to_basetype:=s32bit;
|
||||
end;
|
||||
|
||||
|
||||
{ true if p is an ordinal }
|
||||
function is_ordinal(def : tdef) : boolean;
|
||||
var
|
||||
@ -550,8 +571,8 @@ implementation
|
||||
function is_integer(def : tdef) : boolean;
|
||||
begin
|
||||
is_integer:=(def.deftype=orddef) and
|
||||
(torddef(def).typ in [uauto,u8bit,u16bit,u32bit,u64bit,
|
||||
s8bit,s16bit,s32bit,s64bit]);
|
||||
(torddef(def).typ in [u8bit,u16bit,u32bit,u64bit,
|
||||
s8bit,s16bit,s32bit,s64bit]);
|
||||
end;
|
||||
|
||||
|
||||
@ -1184,7 +1205,7 @@ implementation
|
||||
b := is_dynamic_array(def1) and is_dynamic_array(def2) and
|
||||
is_equal(tarraydef(def1).elementtype.def,tarraydef(def2).elementtype.def);
|
||||
end
|
||||
else
|
||||
else
|
||||
if is_open_array(def1) or is_open_array(def2) then
|
||||
begin
|
||||
b:=is_equal(tarraydef(def1).elementtype.def,tarraydef(def2).elementtype.def);
|
||||
@ -1322,19 +1343,22 @@ implementation
|
||||
fromtreetype : tnodetype;
|
||||
explicit : boolean) : byte;
|
||||
|
||||
{ Tbasetype: uauto,uvoid,uchar,
|
||||
u8bit,u16bit,u32bit,
|
||||
s8bit,s16bit,s32,
|
||||
bool8bit,bool16bit,bool32bit,
|
||||
u64bit,s64bitint,uwidechar }
|
||||
{ Tbasetype:
|
||||
uvoid,
|
||||
u8bit,u16bit,u32bit,u64bit,
|
||||
s8bit,s16bit,s32bit,s64bit,
|
||||
bool8bit,bool16bit,bool32bit,
|
||||
uchar,uwidechar }
|
||||
|
||||
type
|
||||
tbasedef=(bvoid,bchar,bint,bbool);
|
||||
const
|
||||
basedeftbl:array[tbasetype] of tbasedef =
|
||||
(bvoid,bvoid,bchar,
|
||||
bint,bint,bint,
|
||||
bint,bint,bint,
|
||||
bbool,bbool,bbool,bint,bint,bchar);
|
||||
(bvoid,
|
||||
bint,bint,bint,bint,
|
||||
bint,bint,bint,bint,
|
||||
bbool,bbool,bbool,
|
||||
bchar,bchar);
|
||||
|
||||
basedefconverts : array[tbasedef,tbasedef] of tconverttype =
|
||||
((tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible),
|
||||
@ -1897,7 +1921,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.60 2001-12-17 12:49:08 jonas
|
||||
Revision 1.61 2002-01-06 12:08:16 peter
|
||||
* removed uauto from orddef, use new range_to_basetype generating
|
||||
the correct ordinal type for a range
|
||||
|
||||
Revision 1.60 2001/12/17 12:49:08 jonas
|
||||
* added type conversion from procvar to procvar (if their arguments are
|
||||
convertable, two procvars are convertable too) ("merged")
|
||||
|
||||
|
||||
@ -87,7 +87,7 @@ type
|
||||
target_i386_netbsd, { 17 }
|
||||
target_m68k_netbsd, { 18 }
|
||||
target_i386_Netware, { 19 }
|
||||
target_i386_qnx { 20 }
|
||||
target_i386_qnx { 20 }
|
||||
);
|
||||
const
|
||||
Targets : array[ttarget] of string[12]=(
|
||||
@ -933,11 +933,11 @@ procedure readdefinitions(start_read : boolean);
|
||||
type
|
||||
tsettype = (normset,smallset,varset);
|
||||
tbasetype = (
|
||||
uauto,uvoid,uchar,
|
||||
u8bit,u16bit,u32bit,
|
||||
s8bit,s16bit,s32bit,
|
||||
uvoid,
|
||||
u8bit,u16bit,u32bit,u64bit,
|
||||
s8bit,s16bit,s32bit,s64bit,
|
||||
bool8bit,bool16bit,bool32bit,
|
||||
u64bit,s64bit,uwidechar
|
||||
uchar,uwidechar
|
||||
);
|
||||
tobjectdeftype = (odt_none,
|
||||
odt_class,
|
||||
@ -989,20 +989,19 @@ begin
|
||||
write (space,' Base type : ');
|
||||
b:=getbyte;
|
||||
case tbasetype(b) of
|
||||
uauto : writeln('uauto');
|
||||
uvoid : writeln('uvoid');
|
||||
uchar : writeln('uchar');
|
||||
u8bit : writeln('u8bit');
|
||||
u16bit : writeln('u16bit');
|
||||
u32bit : writeln('s32bit');
|
||||
u64bit : writeln('u64bit');
|
||||
s8bit : writeln('s8bit');
|
||||
s16bit : writeln('s16bit');
|
||||
s32bit : writeln('s32bit');
|
||||
s64bit : writeln('s64bit');
|
||||
bool8bit : writeln('bool8bit');
|
||||
bool16bit : writeln('bool16bit');
|
||||
bool32bit : writeln('bool32bit');
|
||||
u64bit : writeln('u64bit');
|
||||
s64bit : writeln('s64bit');
|
||||
uchar : writeln('uchar');
|
||||
uwidechar : writeln('uwidechar');
|
||||
else writeln('!! Warning: Invalid base type ',b);
|
||||
end;
|
||||
@ -1645,7 +1644,11 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 2001-12-15 05:28:01 carl
|
||||
Revision 1.11 2002-01-06 12:08:16 peter
|
||||
* removed uauto from orddef, use new range_to_basetype generating
|
||||
the correct ordinal type for a range
|
||||
|
||||
Revision 1.10 2001/12/15 05:28:01 carl
|
||||
+ Added QNX target
|
||||
|
||||
Revision 1.9 2001/11/02 22:58:12 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user