* constants ordinals now always have a type assigned

* integer constants have the smallest type, unsigned prefered over
    signed
This commit is contained in:
peter 2004-03-23 22:34:49 +00:00
parent 1280635cc4
commit e46cdcea48
18 changed files with 329 additions and 247 deletions

View File

@ -268,7 +268,7 @@ uses
globtype,globals,comphook, globtype,globals,comphook,
finput,fmodule, finput,fmodule,
cpuinfo,cgbase,aasmbase,aasmtai,paramgr, cpuinfo,cgbase,aasmbase,aasmtai,paramgr,
symsym,symdef,symtype,symbase; symsym,symdef,symtype,symbase,defutil;
const const
RModuleNameCollection: TStreamRec = ( RModuleNameCollection: TStreamRec = (
@ -1369,18 +1369,24 @@ end;
if Name='' then if Name='' then
case sym.consttyp of case sym.consttyp of
constord : constord :
Name:=sym.consttype.def.typesym.name+'('+IntToStr(sym.value.valueord)+')'; begin
if sym.consttype.def.deftype=enumdef then
Name:=sym.consttype.def.typesym.name+'('+IntToStr(sym.value.valueord)+')'
else
if is_boolean(sym.consttype.def) then
Name:='Longbool('+IntToStr(sym.value.valueord)+')'
else
if is_char(sym.consttype.def) or
is_widechar(sym.consttype.def) then
Name:=''''+chr(sym.value.valueord)+''''
else
Name:=IntToStr(sym.value.valueord);
end;
constresourcestring, constresourcestring,
conststring : conststring :
Name:=''''+StrPas(pchar(sym.value.valueptr))+''''; Name:=''''+StrPas(pchar(sym.value.valueptr))+'''';
constreal: constreal:
Name:=FloatToStr(PBestReal(sym.value.valueptr)^); Name:=FloatToStr(PBestReal(sym.value.valueptr)^);
constbool:
Name:='Longbool('+IntToStr(sym.value.valueord)+')';
constint:
Name:=IntToStr(sym.value.valueord);
constchar:
Name:=''''+chr(sym.value.valueord)+'''';
constset: constset:
{ Name:=SetToStr(pnormalset(sym.value.valueptr)) }; { Name:=SetToStr(pnormalset(sym.value.valueptr)) };
constnil: ; constnil: ;
@ -2112,7 +2118,12 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.36 2003-10-01 20:34:48 peter Revision 1.37 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.36 2003/10/01 20:34:48 peter
* procinfo unit contains tprocinfo * procinfo unit contains tprocinfo
* cginfo renamed to cgbase * cginfo renamed to cgbase
* moved cgmessage to verbose * moved cgmessage to verbose

View File

@ -48,7 +48,9 @@ interface
function get_min_value(def : tdef) : TConstExprInt; function get_min_value(def : tdef) : TConstExprInt;
{# Returns basetype of the specified integer range } {# Returns basetype of the specified integer range }
function range_to_basetype(low,high:TConstExprInt):tbasetype; function range_to_basetype(l,h:TConstExprInt):tbasetype;
procedure int_to_type(v:TConstExprInt;var tt:ttype);
{# Returns true, if definition defines an integer type } {# Returns true, if definition defines an integer type }
function is_integer(def : tdef) : boolean; function is_integer(def : tdef) : boolean;
@ -244,22 +246,42 @@ implementation
end; end;
function range_to_basetype(low,high:TConstExprInt):tbasetype; function range_to_basetype(l,h:TConstExprInt):tbasetype;
begin begin
{ generate a unsigned range if high<0 and low>=0 } { generate a unsigned range if high<0 and low>=0 }
if (low>=0) and (high<0) then if (l>=0) and (h<=255) then
range_to_basetype:=u32bit
else if (low>=0) and (high<=255) then
range_to_basetype:=u8bit range_to_basetype:=u8bit
else if (low>=-128) and (high<=127) then else if (l>=-128) and (h<=127) then
range_to_basetype:=s8bit range_to_basetype:=s8bit
else if (low>=0) and (high<=65536) then else if (l>=0) and (h<=65535) then
range_to_basetype:=u16bit range_to_basetype:=u16bit
else if (low>=-32768) and (high<=32767) then else if (l>=-32768) and (h<=32767) then
range_to_basetype:=s16bit range_to_basetype:=s16bit
else if (l>=low(longint)) and (h<=high(longint)) then
range_to_basetype:=s32bit
else if (l>=low(cardinal)) and (h<=high(cardinal)) then
range_to_basetype:=u32bit
else else
range_to_basetype:=s32bit; range_to_basetype:=s64bit;
{$warning add support for range_to_basetype 64bit} end;
procedure int_to_type(v:TConstExprInt;var tt:ttype);
begin
if (v>=0) and (v<=255) then
tt:=u8inttype
else if (v>=-128) and (v<=127) then
tt:=s8inttype
else if (v>=0) and (v<=65535) then
tt:=u16inttype
else if (v>=-32768) and (v<=32767) then
tt:=s16inttype
else if (v>=low(longint)) and (v<=high(longint)) then
tt:=s32inttype
else if (v>=low(cardinal)) and (v<=high(cardinal)) then
tt:=u32inttype
else
tt:=s64inttype;
end; end;
@ -855,7 +877,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.10 2004-02-04 22:01:13 peter Revision 1.11 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.10 2004/02/04 22:01:13 peter
* first try to get cpupara working for x86_64 * first try to get cpupara working for x86_64
Revision 1.9 2004/02/03 22:32:53 peter Revision 1.9 2004/02/03 22:32:53 peter

View File

@ -340,11 +340,11 @@ implementation
else else
t:=genintconstnode(int64(qword(lv)*qword(rv))); t:=genintconstnode(int64(qword(lv)*qword(rv)));
xorn : xorn :
t:=cordconstnode.create(lv xor rv,left.resulttype,true); t:=cordconstnode.create(lv xor rv,left.resulttype,false);
orn : orn :
t:=cordconstnode.create(lv or rv,left.resulttype,true); t:=cordconstnode.create(lv or rv,left.resulttype,false);
andn : andn :
t:=cordconstnode.create(lv and rv,left.resulttype,true); t:=cordconstnode.create(lv and rv,left.resulttype,false);
ltn : ltn :
t:=cordconstnode.create(ord(lv<rv),booltype,true); t:=cordconstnode.create(ord(lv<rv),booltype,true);
lten : lten :
@ -1926,7 +1926,12 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.113 2004-03-18 16:19:03 peter Revision 1.114 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.113 2004/03/18 16:19:03 peter
* fixed operator overload allowing for pointer-string * fixed operator overload allowing for pointer-string
* replaced some type_e_mismatch with more informational messages * replaced some type_e_mismatch with more informational messages

View File

@ -199,7 +199,7 @@ interface
implementation implementation
uses uses
globtype,systems,tokens, globtype,systems,
cutils,verbose,globals,widestr, cutils,verbose,globals,widestr,
symconst,symdef,symsym,symtable, symconst,symdef,symsym,symtable,
ncon,ncal,nset,nadd,ninl,nmem,nmat,nutils, ncon,ncal,nset,nadd,ninl,nmem,nmat,nutils,
@ -593,7 +593,7 @@ implementation
function ttypeconvnode.resulttype_string_to_chararray : tnode; function ttypeconvnode.resulttype_string_to_chararray : tnode;
var var
arrsize: longint; arrsize: aword;
begin begin
with tarraydef(resulttype.def) do with tarraydef(resulttype.def) do
@ -1121,6 +1121,7 @@ implementation
function ttypeconvnode.det_resulttype:tnode; function ttypeconvnode.det_resulttype:tnode;
var var
htype : ttype;
hp : tnode; hp : tnode;
currprocdef, currprocdef,
aprocdef : tprocdef; aprocdef : tprocdef;
@ -1289,6 +1290,29 @@ implementation
{ do common tc_equal cast } { do common tc_equal cast }
convtype:=tc_equal; convtype:=tc_equal;
{ ordinal constants can be resized to 1,2,4,8 bytes }
if (left.nodetype=ordconstn) then
begin
{ Insert typeconv for ordinal to the correct size first on left, after
that the other conversion can be done }
htype.reset;
case resulttype.def.size of
1 :
htype:=s8inttype;
2 :
htype:=s16inttype;
4 :
htype:=s32inttype;
8 :
htype:=s64inttype;
end;
{ we need explicit, because it can also be an enum }
if assigned(htype.def) then
inserttypeconv_explicit(left,htype)
else
CGMessage2(cg_e_illegal_type_conversion,left.resulttype.def.gettypename,resulttype.def.gettypename);
end;
{ check if the result could be in a register } { check if the result could be in a register }
if (not(tstoreddef(resulttype.def).is_intregable) and if (not(tstoreddef(resulttype.def).is_intregable) and
not(tstoreddef(resulttype.def).is_fpuregable)) or not(tstoreddef(resulttype.def).is_fpuregable)) or
@ -2378,7 +2402,12 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.142 2004-03-18 16:19:03 peter Revision 1.143 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.142 2004/03/18 16:19:03 peter
* fixed operator overload allowing for pointer-string * fixed operator overload allowing for pointer-string
* replaced some type_e_mismatch with more informational messages * replaced some type_e_mismatch with more informational messages

View File

@ -183,21 +183,11 @@ implementation
nld; nld;
function genintconstnode(v : TConstExprInt) : tordconstnode; function genintconstnode(v : TConstExprInt) : tordconstnode;
var var
i,i2 : TConstExprInt; htype : ttype;
begin begin
{ we need to bootstrap this code, so it's a little bit messy } int_to_type(v,htype);
i:=2147483647; genintconstnode:=cordconstnode.create(v,htype,true);
{ maxcardinal }
i2 := i+i+1;
if (v<=i) and (v>=-i-1) then
genintconstnode:=cordconstnode.create(v,s32inttype,true)
else if (v > i) and (v <= i2) then
genintconstnode:=cordconstnode.create(v,u32inttype,true)
else
genintconstnode:=cordconstnode.create(v,s64inttype,true);
end; end;
@ -305,8 +295,8 @@ implementation
begin begin
p1:=nil; p1:=nil;
case p.consttyp of case p.consttyp of
constint : constord :
p1:=genintconstnode(p.value.valueord); p1:=cordconstnode.create(p.value.valueord,p.consttype,true);
conststring : conststring :
begin begin
len:=p.value.len; len:=p.value.len;
@ -317,16 +307,10 @@ implementation
pc[len]:=#0; pc[len]:=#0;
p1:=cstringconstnode.createpchar(pc,len); p1:=cstringconstnode.createpchar(pc,len);
end; end;
constchar :
p1:=cordconstnode.create(p.value.valueord,cchartype,true);
constreal : constreal :
p1:=crealconstnode.create(pbestreal(p.value.valueptr)^,pbestrealtype^); p1:=crealconstnode.create(pbestreal(p.value.valueptr)^,pbestrealtype^);
constbool :
p1:=cordconstnode.create(p.value.valueord,booltype,true);
constset : constset :
p1:=csetconstnode.create(pconstset(p.value.valueptr),p.consttype); p1:=csetconstnode.create(pconstset(p.value.valueptr),p.consttype);
constord :
p1:=cordconstnode.create(p.value.valueord,p.consttype,true);
constpointer : constpointer :
p1:=cpointerconstnode.create(p.value.valueordptr,p.consttype); p1:=cpointerconstnode.create(p.value.valueordptr,p.consttype);
constnil : constnil :
@ -950,7 +934,12 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.59 2004-02-03 22:32:54 peter Revision 1.60 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.59 2004/02/03 22:32:54 peter
* renamed xNNbittype to xNNinttype * renamed xNNbittype to xNNinttype
* renamed registers32 to registersint * renamed registers32 to registersint
* replace some s32bit,u32bit with torddef([su]inttype).def.typ * replace some s32bit,u32bit with torddef([su]inttype).def.typ

View File

@ -670,6 +670,7 @@ implementation
function tnotnode.det_resulttype : tnode; function tnotnode.det_resulttype : tnode;
var var
t : tnode; t : tnode;
tt : ttype;
notdef : Tprocdef; notdef : Tprocdef;
v : tconstexprint; v : tconstexprint;
begin begin
@ -709,6 +710,7 @@ implementation
if (left.nodetype=ordconstn) then if (left.nodetype=ordconstn) then
begin begin
v:=tordconstnode(left).value; v:=tordconstnode(left).value;
tt:=left.resulttype;
case torddef(left.resulttype.def).typ of case torddef(left.resulttype.def).typ of
bool8bit, bool8bit,
bool16bit, bool16bit,
@ -719,27 +721,23 @@ implementation
v:=byte(not(boolean(byte(v)))); v:=byte(not(boolean(byte(v))));
end; end;
uchar, uchar,
u8bit :
v:=byte(not byte(v));
s8bit :
v:=shortint(not shortint(v));
uwidechar, uwidechar,
u16bit : u8bit,
v:=word(not word(v)); s8bit,
s16bit : u16bit,
v:=smallint(not smallint(v)); s16bit,
u32bit : u32bit,
v:=cardinal(not cardinal(v)); s32bit,
s32bit : s64bit,
v:=longint(not longint(v));
u64bit : u64bit :
v:=int64(not int64(v)); { maybe qword is required } begin
s64bit : v:=int64(not int64(v)); { maybe qword is required }
v:=int64(not int64(v)); int_to_type(v,tt);
end;
else else
CGMessage(type_e_mismatch); CGMessage(type_e_mismatch);
end; end;
t:=cordconstnode.create(v,left.resulttype,true); t:=cordconstnode.create(v,tt,true);
result:=t; result:=t;
exit; exit;
end; end;
@ -858,7 +856,12 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.59 2004-02-24 16:12:39 peter Revision 1.60 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.59 2004/02/24 16:12:39 peter
* operator overload chooses rewrite * operator overload chooses rewrite
* overload choosing is now generic and moved to htypechk * overload choosing is now generic and moved to htypechk

View File

@ -1108,8 +1108,8 @@ begin
include(initglobalswitches,cs_link_internal); include(initglobalswitches,cs_link_internal);
'm' : 'm' :
include(initglobalswitches,cs_link_map); include(initglobalswitches,cs_link_map);
'f' : 'f' :
include(initglobalswitches,cs_link_pthread); include(initglobalswitches,cs_link_pthread);
's' : 's' :
include(initglobalswitches,cs_link_strip); include(initglobalswitches,cs_link_strip);
'c' : Cshared:=TRUE; 'c' : Cshared:=TRUE;
@ -1704,6 +1704,7 @@ begin
if pocall_default = pocall_register then if pocall_default = pocall_register then
def_symbol('REGCALL'); def_symbol('REGCALL');
def_symbol('DECRREFNOTNIL'); def_symbol('DECRREFNOTNIL');
def_symbol('HAS_INTERNAL_INTTYPES');
{ using a case is pretty useless here (FK) } { using a case is pretty useless here (FK) }
{ some stuff for TP compatibility } { some stuff for TP compatibility }
@ -2034,7 +2035,12 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.129 2004-03-21 22:40:15 florian Revision 1.130 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.129 2004/03/21 22:40:15 florian
+ added interface support for the arm + added interface support for the arm
* added FPC_REQUIRES_PROPER_ALIGNMENT define for targets which require proper alignment * added FPC_REQUIRES_PROPER_ALIGNMENT define for targets which require proper alignment

View File

@ -91,19 +91,10 @@ implementation
case p.nodetype of case p.nodetype of
ordconstn: ordconstn:
begin begin
if is_constintnode(p) then if p.resulttype.def.deftype=pointerdef then
hp:=tconstsym.create_ord_typed(orgname,constint,tordconstnode(p).value,tordconstnode(p).resulttype) hp:=tconstsym.create_ordptr(orgname,constpointer,tordconstnode(p).value,p.resulttype)
else if is_constcharnode(p) then else
hp:=tconstsym.create_ord(orgname,constchar,tordconstnode(p).value) hp:=tconstsym.create_ord(orgname,constord,tordconstnode(p).value,p.resulttype);
else if is_constboolnode(p) then
hp:=tconstsym.create_ord(orgname,constbool,tordconstnode(p).value)
else if is_constwidecharnode(p) then
hp:=tconstsym.create_ord(orgname,constwchar,tordconstnode(p).value)
else if p.resulttype.def.deftype=enumdef then
hp:=tconstsym.create_ord_typed(orgname,constord,tordconstnode(p).value,p.resulttype)
else if p.resulttype.def.deftype=pointerdef then
hp:=tconstsym.create_ordptr_typed(orgname,constpointer,tordconstnode(p).value,p.resulttype)
else internalerror(111);
end; end;
stringconstn: stringconstn:
begin begin
@ -115,21 +106,21 @@ implementation
begin begin
new(pd); new(pd);
pd^:=trealconstnode(p).value_real; pd^:=trealconstnode(p).value_real;
hp:=tconstsym.create_ptr(orgname,constreal,pd); hp:=tconstsym.create_ptr(orgname,constreal,pd,p.resulttype);
end; end;
setconstn : setconstn :
begin begin
new(ps); new(ps);
ps^:=tsetconstnode(p).value_set^; ps^:=tsetconstnode(p).value_set^;
hp:=tconstsym.create_ptr_typed(orgname,constset,ps,p.resulttype); hp:=tconstsym.create_ptr(orgname,constset,ps,p.resulttype);
end; end;
pointerconstn : pointerconstn :
begin begin
hp:=tconstsym.create_ordptr_typed(orgname,constpointer,tpointerconstnode(p).value,p.resulttype); hp:=tconstsym.create_ordptr(orgname,constpointer,tpointerconstnode(p).value,p.resulttype);
end; end;
niln : niln :
begin begin
hp:=tconstsym.create_ord_typed(orgname,constnil,0,p.resulttype); hp:=tconstsym.create_ord(orgname,constnil,0,p.resulttype);
end; end;
typen : typen :
begin begin
@ -139,7 +130,7 @@ implementation
begin begin
new(pg); new(pg);
pg^:=tobjectdef(p.resulttype.def).iidguid^; pg^:=tobjectdef(p.resulttype.def).iidguid^;
hp:=tconstsym.create_ptr(orgname,constguid,pg); hp:=tconstsym.create_ptr(orgname,constguid,pg,p.resulttype);
end end
else else
Message1(parser_e_interface_has_no_guid,tobjectdef(p.resulttype.def).objrealname^); Message1(parser_e_interface_has_no_guid,tobjectdef(p.resulttype.def).objrealname^);
@ -668,7 +659,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.84 2004-03-20 20:55:36 florian Revision 1.85 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.84 2004/03/20 20:55:36 florian
+ implemented cdecl'd varargs on arm + implemented cdecl'd varargs on arm
+ -dCMEM supported by the compiler + -dCMEM supported by the compiler
* label/goto asmsymbol type with -dextdebug fixed * label/goto asmsymbol type with -dextdebug fixed

View File

@ -342,6 +342,8 @@ implementation
Message(parser_e_invalid_property_index_value); Message(parser_e_invalid_property_index_value);
p.index:=0; p.index:=0;
end; end;
{$warning FIXME: force 32bit int for property index}
inserttypeconv(pt,s32inttype);
p.indextype.setdef(pt.resulttype.def); p.indextype.setdef(pt.resulttype.def);
include(p.propoptions,ppo_indexed); include(p.propoptions,ppo_indexed);
{ concat a longint to the para templates } { concat a longint to the para templates }
@ -1170,7 +1172,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.71 2004-03-05 22:17:11 jonas Revision 1.72 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.71 2004/03/05 22:17:11 jonas
* fixed importing of variables from shared libraries, but disabled * fixed importing of variables from shared libraries, but disabled
PIC support for now. You have to save/restore r31 when you us it! :) PIC support for now. You have to save/restore r31 when you us it! :)
Also, it's not necessary to support the imported variables Also, it's not necessary to support the imported variables

View File

@ -1313,21 +1313,11 @@ implementation
constsym : constsym :
begin begin
case tconstsym(srsym).consttyp of case tconstsym(srsym).consttyp of
constint : constord :
begin begin
{$ifdef cpu64bit} if tconstsym(srsym).consttype.def=nil then
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,sinttype,true); internalerror(200403232);
{$else cpu64bit} p1:=cordconstnode.create(tconstsym(srsym).value.valueord,tconstsym(srsym).consttype,true);
{ do a very dirty trick to bootstrap this code }
if (tconstsym(srsym).value.valueord>=-(int64(2147483647)+int64(1))) and
(tconstsym(srsym).value.valueord<=2147483647) then
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,s32inttype,true)
else if (tconstsym(srsym).value.valueord > maxlongint) and
(tconstsym(srsym).value.valueord <= int64(maxlongint)+int64(maxlongint)+1) then
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,u32inttype,true)
else
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,s64inttype,true);
{$endif cpu64bit}
end; end;
conststring : conststring :
begin begin
@ -1339,16 +1329,10 @@ implementation
pc[len]:=#0; pc[len]:=#0;
p1:=cstringconstnode.createpchar(pc,len); p1:=cstringconstnode.createpchar(pc,len);
end; end;
constchar :
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,cchartype,true);
constreal : constreal :
p1:=crealconstnode.create(pbestreal(tconstsym(srsym).value.valueptr)^,pbestrealtype^); p1:=crealconstnode.create(pbestreal(tconstsym(srsym).value.valueptr)^,pbestrealtype^);
constbool :
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,booltype,true);
constset : constset :
p1:=csetconstnode.create(pconstset(tconstsym(srsym).value.valueptr),tconstsym(srsym).consttype); p1:=csetconstnode.create(pconstset(tconstsym(srsym).value.valueptr),tconstsym(srsym).consttype);
constord :
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,tconstsym(srsym).consttype,true);
constpointer : constpointer :
p1:=cpointerconstnode.create(tconstsym(srsym).value.valueordptr,tconstsym(srsym).consttype); p1:=cpointerconstnode.create(tconstsym(srsym).value.valueordptr,tconstsym(srsym).consttype);
constnil : constnil :
@ -1903,7 +1887,8 @@ implementation
if code=0 then if code=0 then
begin begin
consume(_INTCONST); consume(_INTCONST);
p1:=cordconstnode.create(ic,sinttype,true); int_to_type(card,htype);
p1:=cordconstnode.create(ic,htype,true);
end; end;
{$else cpu64bit} {$else cpu64bit}
{ try cardinal first } { try cardinal first }
@ -1911,16 +1896,8 @@ implementation
if code=0 then if code=0 then
begin begin
consume(_INTCONST); consume(_INTCONST);
{ check whether the value isn't in the longint range as well } int_to_type(card,htype);
{ (longint is easier to perform calculations with) (JM) } p1:=cordconstnode.create(card,htype,true);
if card <= $7fffffff then
{ no sign extension necessary, so not longint typecast (JM) }
{ use the native int types here instead of fixed 32bit,
this is needed to have integer values the same size as
pointers (PFV) }
p1:=cordconstnode.create(card,s32inttype,true)
else
p1:=cordconstnode.create(card,u32inttype,true)
end end
else else
begin begin
@ -1929,7 +1906,8 @@ implementation
if code = 0 then if code = 0 then
begin begin
consume(_INTCONST); consume(_INTCONST);
p1:=cordconstnode.create(l,sinttype,true) int_to_type(l,htype);
p1:=cordconstnode.create(l,htype,true);
end end
else else
begin begin
@ -1938,7 +1916,8 @@ implementation
if code=0 then if code=0 then
begin begin
consume(_INTCONST); consume(_INTCONST);
p1:=cordconstnode.create(ic,s64inttype,true); int_to_type(ic,htype);
p1:=cordconstnode.create(ic,htype,true);
end; end;
end; end;
end; end;
@ -2419,7 +2398,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.150 2004-02-20 21:55:59 peter Revision 1.151 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.150 2004/02/20 21:55:59 peter
* procvar cleanup * procvar cleanup
Revision 1.149 2004/02/18 21:58:53 peter Revision 1.149 2004/02/18 21:58:53 peter

View File

@ -44,7 +44,7 @@ type
{$endif Test_Double_checksum} {$endif Test_Double_checksum}
const const
CurrentPPUVersion=39; CurrentPPUVersion=40;
{ buffer sizes } { buffer sizes }
maxentrysize = 1024; maxentrysize = 1024;
@ -1042,7 +1042,12 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.46 2004-02-27 10:21:05 florian Revision 1.47 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.46 2004/02/27 10:21:05 florian
* top_symbol killed * top_symbol killed
+ refaddr to treference added + refaddr to treference added
+ refsymbol to treference added + refsymbol to treference added

View File

@ -42,7 +42,7 @@ interface
implementation implementation
uses uses
globals,globtype, globals,globtype,verbose,
symconst,symtype,symsym,symdef,symtable, symconst,symtype,symsym,symdef,symtable,
aasmtai,aasmcpu,ncgutil, aasmtai,aasmcpu,ncgutil,
{$ifdef GDB} {$ifdef GDB}
@ -157,12 +157,17 @@ implementation
addtype('ByteBool',booltype); addtype('ByteBool',booltype);
adddef('WordBool',torddef.create(bool16bit,0,1)); adddef('WordBool',torddef.create(bool16bit,0,1));
adddef('LongBool',torddef.create(bool32bit,0,1)); adddef('LongBool',torddef.create(bool32bit,0,1));
addtype('Byte',u8inttype);
addtype('ShortInt',s8inttype);
addtype('Word',u16inttype);
addtype('SmallInt',s16inttype);
addtype('LongWord',u32inttype);
addtype('LongInt',s32inttype);
addtype('QWord',u64inttype);
addtype('Int64',s64inttype);
addtype('Char',cchartype); addtype('Char',cchartype);
addtype('WideChar',cwidechartype); addtype('WideChar',cwidechartype);
adddef('Text',tfiledef.createtext); adddef('Text',tfiledef.createtext);
addtype('Longword',u32inttype);
addtype('QWord',u64inttype);
addtype('Int64',s64inttype);
adddef('TypedFile',tfiledef.createtyped(voidtype)); adddef('TypedFile',tfiledef.createtyped(voidtype));
addtype('Variant',cvarianttype); addtype('Variant',cvarianttype);
addtype('OleVariant',colevarianttype); addtype('OleVariant',colevarianttype);
@ -170,7 +175,9 @@ implementation
addtype('$formal',cformaltype); addtype('$formal',cformaltype);
addtype('$void',voidtype); addtype('$void',voidtype);
addtype('$byte',u8inttype); addtype('$byte',u8inttype);
addtype('$shortint',s8inttype);
addtype('$word',u16inttype); addtype('$word',u16inttype);
addtype('$smallint',s16inttype);
addtype('$ulong',u32inttype); addtype('$ulong',u32inttype);
addtype('$longint',s32inttype); addtype('$longint',s32inttype);
addtype('$qword',u64inttype); addtype('$qword',u64inttype);
@ -224,38 +231,53 @@ implementation
{ {
Load all default definitions for consts from the system unit Load all default definitions for consts from the system unit
} }
procedure loadtype(const s:string;var t:ttype);
var
srsym : tsym;
begin
srsym:=searchsymonlyin(systemunit,s);
if not(assigned(srsym) and
(srsym.typ=typesym)) then
internalerror(200403231);
t:=ttypesym(srsym).restype;
end;
begin begin
globaldef('byte',u8inttype); loadtype('byte',u8inttype);
globaldef('word',u16inttype); loadtype('shortint',s8inttype);
globaldef('ulong',u32inttype); loadtype('word',u16inttype);
globaldef('longint',s32inttype); loadtype('smallint',s16inttype);
globaldef('qword',u64inttype); loadtype('ulong',u32inttype);
globaldef('int64',s64inttype); loadtype('longint',s32inttype);
globaldef('formal',cformaltype); loadtype('qword',u64inttype);
globaldef('void',voidtype); loadtype('int64',s64inttype);
globaldef('char',cchartype); loadtype('formal',cformaltype);
globaldef('widechar',cwidechartype); loadtype('void',voidtype);
globaldef('shortstring',cshortstringtype); loadtype('char',cchartype);
globaldef('longstring',clongstringtype); loadtype('widechar',cwidechartype);
globaldef('ansistring',cansistringtype); loadtype('shortstring',cshortstringtype);
globaldef('widestring',cwidestringtype); loadtype('longstring',clongstringtype);
globaldef('openshortstring',openshortstringtype); loadtype('ansistring',cansistringtype);
globaldef('openchararray',openchararraytype); loadtype('widestring',cwidestringtype);
globaldef('s32real',s32floattype); loadtype('openshortstring',openshortstringtype);
globaldef('s64real',s64floattype); loadtype('openchararray',openchararraytype);
globaldef('s80real',s80floattype); loadtype('s32real',s32floattype);
globaldef('s64currency',s64currencytype); loadtype('s64real',s64floattype);
globaldef('boolean',booltype); loadtype('s80real',s80floattype);
globaldef('void_pointer',voidpointertype); loadtype('s64currency',s64currencytype);
globaldef('char_pointer',charpointertype); loadtype('boolean',booltype);
globaldef('void_farpointer',voidfarpointertype); loadtype('void_pointer',voidpointertype);
globaldef('file',cfiletype); loadtype('char_pointer',charpointertype);
globaldef('pvmt',pvmttype); loadtype('void_farpointer',voidfarpointertype);
globaldef('vtblarray',vmtarraytype); loadtype('file',cfiletype);
globaldef('__vtbl_ptr_type',vmttype); loadtype('pvmt',pvmttype);
globaldef('variant',cvarianttype); loadtype('vtblarray',vmtarraytype);
globaldef('olevariant',colevarianttype); loadtype('__vtbl_ptr_type',vmttype);
globaldef('methodpointer',methodpointertype); loadtype('variant',cvarianttype);
loadtype('olevariant',colevarianttype);
loadtype('methodpointer',methodpointertype);
{$ifdef cpu64bit} {$ifdef cpu64bit}
uinttype:=u64inttype; uinttype:=u64inttype;
sinttype:=s64inttype; sinttype:=s64inttype;
@ -281,7 +303,9 @@ implementation
cformaltype.setdef(tformaldef.create); cformaltype.setdef(tformaldef.create);
voidtype.setdef(torddef.create(uvoid,0,0)); voidtype.setdef(torddef.create(uvoid,0,0));
u8inttype.setdef(torddef.create(u8bit,0,255)); u8inttype.setdef(torddef.create(u8bit,0,255));
s8inttype.setdef(torddef.create(s8bit,-128,127));
u16inttype.setdef(torddef.create(u16bit,0,65535)); u16inttype.setdef(torddef.create(u16bit,0,65535));
s16inttype.setdef(torddef.create(s16bit,-32768,32767));
u32inttype.setdef(torddef.create(u32bit,0,high(longword))); u32inttype.setdef(torddef.create(u32bit,0,high(longword)));
s32inttype.setdef(torddef.create(s32bit,low(longint),high(longint))); s32inttype.setdef(torddef.create(s32bit,low(longint),high(longint)));
u64inttype.setdef(torddef.create(u64bit,low(qword),TConstExprInt(high(qword)))); u64inttype.setdef(torddef.create(u64bit,low(qword),TConstExprInt(high(qword))));
@ -488,7 +512,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.66 2004-03-08 22:07:47 peter Revision 1.67 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.66 2004/03/08 22:07:47 peter
* stabs updates to write stabs for def for all implictly used * stabs updates to write stabs for def for all implictly used
units units

View File

@ -289,8 +289,12 @@ implementation
consume(_POINTPOINT); consume(_POINTPOINT);
{ get high value of range } { get high value of range }
pt2:=comp_expr(not(ignore_equal)); pt2:=comp_expr(not(ignore_equal));
{ make both the same type } { make both the same type or give an error. This is not
inserttypeconv(pt1,pt2.resulttype); done when both are integer values, because typecasting
between -3200..3200 will result in a signed-unsigned
conflict and give a range check error (PFV) }
if not(is_integer(pt1.resulttype.def) and is_integer(pt2.resulttype.def)) then
inserttypeconv(pt1,pt2.resulttype);
{ both must be evaluated to constants now } { both must be evaluated to constants now }
if (pt1.nodetype=ordconstn) and if (pt1.nodetype=ordconstn) and
(pt2.nodetype=ordconstn) then (pt2.nodetype=ordconstn) then
@ -643,7 +647,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.64 2004-02-03 22:32:54 peter Revision 1.65 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.64 2004/02/03 22:32:54 peter
* renamed xNNbittype to xNNinttype * renamed xNNbittype to xNNinttype
* renamed registers32 to registersint * renamed registers32 to registersint
* replace some s32bit,u32bit with torddef([su]inttype).def.typ * replace some s32bit,u32bit with torddef([su]inttype).def.typ

View File

@ -962,7 +962,7 @@ Begin
end; end;
constsym : constsym :
begin begin
if tconstsym(sym).consttyp in [constint,constchar,constbool] then if tconstsym(sym).consttyp=constord then
begin begin
setconst(tconstsym(sym).value.valueord); setconst(tconstsym(sym).value.valueord);
SetupVar:=true; SetupVar:=true;
@ -1312,7 +1312,7 @@ Begin
case srsym.typ of case srsym.typ of
constsym : constsym :
begin begin
if (tconstsym(srsym).consttyp in [constord,constint,constchar,constbool]) then if tconstsym(srsym).consttyp=constord then
Begin Begin
l:=tconstsym(srsym).value.valueord; l:=tconstsym(srsym).value.valueord;
SearchIConstant:=TRUE; SearchIConstant:=TRUE;
@ -1368,7 +1368,7 @@ Begin
st:=tobjectdef(def).symtable; st:=tobjectdef(def).symtable;
end; end;
typesym : typesym :
with Ttypesym(sym).restype do with Ttypesym(sym).restype do
case def.deftype of case def.deftype of
recorddef : recorddef :
st:=trecorddef(def).symtable; st:=trecorddef(def).symtable;
@ -1632,7 +1632,12 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.84 2004-03-18 11:43:57 olle Revision 1.85 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.84 2004/03/18 11:43:57 olle
* change AT_FUNCTION to AT_DATA where appropriate * change AT_FUNCTION to AT_DATA where appropriate
Revision 1.83 2004/03/17 22:27:41 florian Revision 1.83 2004/03/17 22:27:41 florian

View File

@ -303,9 +303,9 @@ type
absolutetyp = (tovar,toasm,toaddr); absolutetyp = (tovar,toasm,toaddr);
tconsttyp = (constnone, tconsttyp = (constnone,
constord,conststring,constreal,constbool, constord,conststring,constreal,
constint,constchar,constset,constpointer,constnil, constset,constpointer,constnil,
constresourcestring,constwstring,constwchar,constguid constresourcestring,constwstring,constguid
); );
{ RTTI information to store } { RTTI information to store }
@ -404,7 +404,12 @@ initialization
end. end.
{ {
$Log$ $Log$
Revision 1.77 2004-03-08 22:07:47 peter Revision 1.78 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.77 2004/03/08 22:07:47 peter
* stabs updates to write stabs for def for all implictly used * stabs updates to write stabs for def for all implictly used
units units

View File

@ -717,16 +717,18 @@ interface
charpointertype, { pointer for Char-Pointerdef } charpointertype, { pointer for Char-Pointerdef }
voidfarpointertype, voidfarpointertype,
cformaltype, { unique formal definition } cformaltype, { unique formal definition }
voidtype, { Pointer to Void (procedure) } voidtype, { Void (procedure) }
cchartype, { Pointer to Char } cchartype, { Char }
cwidechartype, { Pointer to WideChar } cwidechartype, { WideChar }
booltype, { pointer to boolean type } booltype, { boolean type }
u8inttype, { Pointer to 8-Bit unsigned } u8inttype, { 8-Bit unsigned integer }
u16inttype, { Pointer to 16-Bit unsigned } s8inttype, { 8-Bit signed integer }
u32inttype, { Pointer to 32-Bit unsigned } u16inttype, { 16-Bit unsigned integer }
s32inttype, { Pointer to 32-Bit signed } s16inttype, { 16-Bit signed integer }
u64inttype, { pointer to 64 bit unsigned def } u32inttype, { 32-Bit unsigned integer }
s64inttype, { pointer to 64 bit signed def, } s32inttype, { 32-Bit signed integer }
u64inttype, { 64-bit unsigned integer }
s64inttype, { 64-bit signed integer }
s32floattype, { pointer for realconstn } s32floattype, { pointer for realconstn }
s64floattype, { pointer for realconstn } s64floattype, { pointer for realconstn }
s80floattype, { pointer to type of temp. floats } s80floattype, { pointer to type of temp. floats }
@ -3519,21 +3521,22 @@ implementation
hs:=strpas(pchar(hpc.value.valueptr)); hs:=strpas(pchar(hpc.value.valueptr));
constreal : constreal :
str(pbestreal(hpc.value.valueptr)^,hs); str(pbestreal(hpc.value.valueptr)^,hs);
constord :
hs:=tostr(hpc.value.valueord);
constpointer : constpointer :
hs:=tostr(hpc.value.valueordptr); hs:=tostr(hpc.value.valueordptr);
constbool : constord :
begin begin
if hpc.value.valueord<>0 then if is_boolean(hpc.consttype.def) then
hs:='TRUE' begin
if hpc.value.valueord<>0 then
hs:='TRUE'
else
hs:='FALSE';
end
else else
hs:='FALSE'; hs:=tostr(hpc.value.valueord);
end; end;
constnil : constnil :
hs:='nil'; hs:='nil';
constchar :
hs:=chr(hpc.value.valueord);
constset : constset :
hs:='<set>'; hs:='<set>';
end; end;
@ -6061,7 +6064,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.232 2004-03-18 11:43:57 olle Revision 1.233 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.232 2004/03/18 11:43:57 olle
* change AT_FUNCTION to AT_DATA where appropriate * change AT_FUNCTION to AT_DATA where appropriate
Revision 1.231 2004/03/14 22:51:46 peter Revision 1.231 2004/03/14 22:51:46 peter

View File

@ -251,15 +251,12 @@ interface
consttyp : tconsttyp; consttyp : tconsttyp;
value : tconstvalue; value : tconstvalue;
resstrindex : longint; { needed for resource strings } resstrindex : longint; { needed for resource strings }
constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint); constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
constructor create_ord_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype); constructor create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
constructor create_ordptr_typed(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype); constructor create_ptr(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
constructor create_ptr(const n : string;t : tconsttyp;v : pointer);
constructor create_ptr_typed(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint); constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
constructor ppuload(ppufile:tcompilerppufile); constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override; destructor destroy;override;
{ function mangledname : string;}
procedure buildderef;override; procedure buildderef;override;
procedure deref;override; procedure deref;override;
procedure ppuwrite(ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override;
@ -860,7 +857,7 @@ implementation
if (eq>=te_equal) or if (eq>=te_equal) or
((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
begin begin
eq:=compare_paras(pd^.def.para,params,cp_value_equal_const,cpoptions); eq:=compare_paras(params,pd^.def.para,cp_value_equal_const,cpoptions);
if (eq>=te_equal) or if (eq>=te_equal) or
((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
begin begin
@ -1720,19 +1717,7 @@ implementation
TCONSTSYM TCONSTSYM
****************************************************************************} ****************************************************************************}
constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : TConstExprInt); constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
begin
inherited create(n);
fillchar(value, sizeof(value), #0);
typ:=constsym;
consttyp:=t;
value.valueord:=v;
ResStrIndex:=0;
consttype.reset;
end;
constructor tconstsym.create_ord_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
begin begin
inherited create(n); inherited create(n);
fillchar(value, sizeof(value), #0); fillchar(value, sizeof(value), #0);
@ -1744,7 +1729,7 @@ implementation
end; end;
constructor tconstsym.create_ordptr_typed(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype); constructor tconstsym.create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
begin begin
inherited create(n); inherited create(n);
fillchar(value, sizeof(value), #0); fillchar(value, sizeof(value), #0);
@ -1756,19 +1741,7 @@ implementation
end; end;
constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer); constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
begin
inherited create(n);
fillchar(value, sizeof(value), #0);
typ:=constsym;
consttyp:=t;
value.valueptr:=v;
ResStrIndex:=0;
consttype.reset;
end;
constructor tconstsym.create_ptr_typed(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
begin begin
inherited create(n); inherited create(n);
fillchar(value, sizeof(value), #0); fillchar(value, sizeof(value), #0);
@ -1806,12 +1779,6 @@ implementation
consttyp:=tconsttyp(ppufile.getbyte); consttyp:=tconsttyp(ppufile.getbyte);
fillchar(value, sizeof(value), #0); fillchar(value, sizeof(value), #0);
case consttyp of case consttyp of
constint:
value.valueord:=ppufile.getexprint;
constwchar,
constbool,
constchar :
value.valueord:=ppufile.getlongint;
constord : constord :
begin begin
ppufile.gettype(consttype); ppufile.gettype(consttype);
@ -1894,12 +1861,6 @@ implementation
ppufile.putbyte(byte(consttyp)); ppufile.putbyte(byte(consttyp));
case consttyp of case consttyp of
constnil : ; constnil : ;
constint:
ppufile.putexprint(value.valueord);
constbool,
constchar,
constwchar :
ppufile.putlongint(value.valueord);
constord : constord :
begin begin
ppufile.puttype(consttype); ppufile.puttype(consttype);
@ -1943,11 +1904,7 @@ implementation
case consttyp of case consttyp of
conststring: conststring:
st:='s'''+backspace_quote(strpas(pchar(value.valueptr)),['''','"','\',#10,#13])+''''; st:='s'''+backspace_quote(strpas(pchar(value.valueptr)),['''','"','\',#10,#13])+'''';
constbool, constord:
constint,
constord,
constwchar,
constchar:
st:='i'+int64tostr(value.valueord); st:='i'+int64tostr(value.valueord);
constpointer: constpointer:
st:='i'+int64tostr(value.valueordptr); st:='i'+int64tostr(value.valueordptr);
@ -2243,7 +2200,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.167 2004-03-10 22:52:57 peter Revision 1.168 2004-03-23 22:34:49 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.167 2004/03/10 22:52:57 peter
* more stabs fixes * more stabs fixes
* special mode -gv for valgrind compatible stabs * special mode -gv for valgrind compatible stabs

View File

@ -70,9 +70,6 @@ implementation
if sym1.consttyp<>sym2.consttyp then if sym1.consttyp<>sym2.consttyp then
exit; exit;
case sym1.consttyp of case sym1.consttyp of
constint,
constbool,
constchar,
constord : constord :
equal_constsym:=(sym1.value.valueord=sym2.value.valueord); equal_constsym:=(sym1.value.valueord=sym2.value.valueord);
constpointer : constpointer :
@ -119,7 +116,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.3 2003-12-07 16:40:45 jonas Revision 1.4 2004-03-23 22:34:50 peter
* constants ordinals now always have a type assigned
* integer constants have the smallest type, unsigned prefered over
signed
Revision 1.3 2003/12/07 16:40:45 jonas
* moved count_locals from pstatmnt to symutils * moved count_locals from pstatmnt to symutils
* use count_locals in powerpc/cpupi to check whether we should set the * use count_locals in powerpc/cpupi to check whether we should set the
first temp offset (and as such generate a stackframe) first temp offset (and as such generate a stackframe)