paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-23 00:09:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

* constants ordinals now always have a type assigned

Browse Source 
* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
compiler/browcol.pas
View File

@ -268,7 +268,7 @@ uses
globtype,globals,comphook,
finput,fmodule,
cpuinfo,cgbase,aasmbase,aasmtai,paramgr,
symsym,symdef,symtype,symbase;
symsym,symdef,symtype,symbase,defutil;
const
RModuleNameCollection: TStreamRec = (
@ -1369,18 +1369,24 @@ end;
if Name='' then
case sym.consttyp of
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,
conststring :
Name:=''''+StrPas(pchar(sym.value.valueptr))+'''';
constreal:
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:
{ Name:=SetToStr(pnormalset(sym.value.valueptr)) };
constnil: ;
@ -2112,7 +2118,12 @@ begin
end.
{
$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
* cginfo renamed to cgbase
* moved cgmessage to verbose

49
compiler/defutil.pas
View File

@ -48,7 +48,9 @@ interface
function get_min_value(def : tdef) : TConstExprInt;
{# 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 }
function is_integer(def : tdef) : boolean;
@ -244,22 +246,42 @@ implementation
end;
function range_to_basetype(low,high:TConstExprInt):tbasetype;
function range_to_basetype(l,h: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
if (l>=0) and (h<=255) then
range_to_basetype:=u8bit
else if (low>=-128) and (high<=127) then
else if (l>=-128) and (h<=127) then
range_to_basetype:=s8bit
else if (low>=0) and (high<=65536) then
else if (l>=0) and (h<=65535) then
range_to_basetype:=u16bit
else if (low>=-32768) and (high<=32767) then
else if (l>=-32768) and (h<=32767) then
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
range_to_basetype:=s32bit;
{$warning add support for range_to_basetype 64bit}
range_to_basetype:=s64bit;
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;
@ -855,7 +877,12 @@ implementation
end.
{
$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
Revision 1.9 2004/02/03 22:32:53 peter

13
compiler/nadd.pas
View File

@ -340,11 +340,11 @@ implementation
else
t:=genintconstnode(int64(qword(lv)*qword(rv)));
xorn :
t:=cordconstnode.create(lv xor rv,left.resulttype,true);
t:=cordconstnode.create(lv xor rv,left.resulttype,false);
orn :
t:=cordconstnode.create(lv or rv,left.resulttype,true);
t:=cordconstnode.create(lv or rv,left.resulttype,false);
andn :
t:=cordconstnode.create(lv and rv,left.resulttype,true);
t:=cordconstnode.create(lv and rv,left.resulttype,false);
ltn :
t:=cordconstnode.create(ord(lv<rv),booltype,true);
lten :
@ -1926,7 +1926,12 @@ begin
end.
{
$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
* replaced some type_e_mismatch with more informational messages

35
compiler/ncnv.pas
View File

@ -199,7 +199,7 @@ interface
implementation
uses
globtype,systems,tokens,
globtype,systems,
cutils,verbose,globals,widestr,
symconst,symdef,symsym,symtable,
ncon,ncal,nset,nadd,ninl,nmem,nmat,nutils,
@ -593,7 +593,7 @@ implementation
function ttypeconvnode.resulttype_string_to_chararray : tnode;
var
arrsize: longint;
arrsize: aword;
begin
with tarraydef(resulttype.def) do
@ -1121,6 +1121,7 @@ implementation
function ttypeconvnode.det_resulttype:tnode;
var
htype : ttype;
hp : tnode;
currprocdef,
aprocdef : tprocdef;
@ -1289,6 +1290,29 @@ implementation
{ do common tc_equal cast }
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 }
if (not(tstoreddef(resulttype.def).is_intregable) and
not(tstoreddef(resulttype.def).is_fpuregable)) or
@ -2378,7 +2402,12 @@ begin
end.
{
$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
* replaced some type_e_mismatch with more informational messages

33
compiler/ncon.pas
View File

@ -183,21 +183,11 @@ implementation
nld;
function genintconstnode(v : TConstExprInt) : tordconstnode;
var
i,i2 : TConstExprInt;
htype : ttype;
begin
{ we need to bootstrap this code, so it's a little bit messy }
i:=2147483647;
{ 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);
int_to_type(v,htype);
genintconstnode:=cordconstnode.create(v,htype,true);
end;
@ -305,8 +295,8 @@ implementation
begin
p1:=nil;
case p.consttyp of
constint :
p1:=genintconstnode(p.value.valueord);
constord :
p1:=cordconstnode.create(p.value.valueord,p.consttype,true);
conststring :
begin
len:=p.value.len;
@ -317,16 +307,10 @@ implementation
pc[len]:=#0;
p1:=cstringconstnode.createpchar(pc,len);
end;
constchar :
p1:=cordconstnode.create(p.value.valueord,cchartype,true);
constreal :
p1:=crealconstnode.create(pbestreal(p.value.valueptr)^,pbestrealtype^);
constbool :
p1:=cordconstnode.create(p.value.valueord,booltype,true);
constset :
p1:=csetconstnode.create(pconstset(p.value.valueptr),p.consttype);
constord :
p1:=cordconstnode.create(p.value.valueord,p.consttype,true);
constpointer :
p1:=cpointerconstnode.create(p.value.valueordptr,p.consttype);
constnil :
@ -950,7 +934,12 @@ begin
end.
{
$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 registers32 to registersint
* replace some s32bit,u32bit with torddef([su]inttype).def.typ

37
compiler/nmat.pas
View File

@ -670,6 +670,7 @@ implementation
function tnotnode.det_resulttype : tnode;
var
t : tnode;
tt : ttype;
notdef : Tprocdef;
v : tconstexprint;
begin
@ -709,6 +710,7 @@ implementation
if (left.nodetype=ordconstn) then
begin
v:=tordconstnode(left).value;
tt:=left.resulttype;
case torddef(left.resulttype.def).typ of
bool8bit,
bool16bit,
@ -719,27 +721,23 @@ implementation
v:=byte(not(boolean(byte(v))));
end;
uchar,
u8bit :
v:=byte(not byte(v));
s8bit :
v:=shortint(not shortint(v));
uwidechar,
u16bit :
v:=word(not word(v));
s16bit :
v:=smallint(not smallint(v));
u32bit :
v:=cardinal(not cardinal(v));
s32bit :
v:=longint(not longint(v));
u8bit,
s8bit,
u16bit,
s16bit,
u32bit,
s32bit,
s64bit,
u64bit :
v:=int64(not int64(v)); { maybe qword is required }
s64bit :
v:=int64(not int64(v));
begin
v:=int64(not int64(v)); { maybe qword is required }
int_to_type(v,tt);
end;
else
CGMessage(type_e_mismatch);
end;
t:=cordconstnode.create(v,left.resulttype,true);
t:=cordconstnode.create(v,tt,true);
result:=t;
exit;
end;
@ -858,7 +856,12 @@ begin
end.
{
$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
* overload choosing is now generic and moved to htypechk

12
compiler/options.pas
View File

@ -1108,8 +1108,8 @@ begin
include(initglobalswitches,cs_link_internal);
'm' :
include(initglobalswitches,cs_link_map);
'f' :
include(initglobalswitches,cs_link_pthread);
'f' :
include(initglobalswitches,cs_link_pthread);
's' :
include(initglobalswitches,cs_link_strip);
'c' : Cshared:=TRUE;
@ -1704,6 +1704,7 @@ begin
if pocall_default = pocall_register then
def_symbol('REGCALL');
def_symbol('DECRREFNOTNIL');
def_symbol('HAS_INTERNAL_INTTYPES');
{ using a case is pretty useless here (FK) }
{ some stuff for TP compatibility }
@ -2034,7 +2035,12 @@ finalization
end.
{
$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 FPC_REQUIRES_PROPER_ALIGNMENT define for targets which require proper alignment

34
compiler/pdecl.pas
View File

@ -91,19 +91,10 @@ implementation
case p.nodetype of
ordconstn:
begin
if is_constintnode(p) then
hp:=tconstsym.create_ord_typed(orgname,constint,tordconstnode(p).value,tordconstnode(p).resulttype)
else if is_constcharnode(p) then
hp:=tconstsym.create_ord(orgname,constchar,tordconstnode(p).value)
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);
if p.resulttype.def.deftype=pointerdef then
hp:=tconstsym.create_ordptr(orgname,constpointer,tordconstnode(p).value,p.resulttype)
else
hp:=tconstsym.create_ord(orgname,constord,tordconstnode(p).value,p.resulttype);
end;
stringconstn:
begin
@ -115,21 +106,21 @@ implementation
begin
new(pd);
pd^:=trealconstnode(p).value_real;
hp:=tconstsym.create_ptr(orgname,constreal,pd);
hp:=tconstsym.create_ptr(orgname,constreal,pd,p.resulttype);
end;
setconstn :
begin
new(ps);
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;
pointerconstn :
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;
niln :
begin
hp:=tconstsym.create_ord_typed(orgname,constnil,0,p.resulttype);
hp:=tconstsym.create_ord(orgname,constnil,0,p.resulttype);
end;
typen :
begin
@ -139,7 +130,7 @@ implementation
begin
new(pg);
pg^:=tobjectdef(p.resulttype.def).iidguid^;
hp:=tconstsym.create_ptr(orgname,constguid,pg);
hp:=tconstsym.create_ptr(orgname,constguid,pg,p.resulttype);
end
else
Message1(parser_e_interface_has_no_guid,tobjectdef(p.resulttype.def).objrealname^);
@ -668,7 +659,12 @@ implementation
end.
{
$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
+ -dCMEM supported by the compiler
* label/goto asmsymbol type with -dextdebug fixed

9
compiler/pdecvar.pas
View File

@ -342,6 +342,8 @@ implementation
Message(parser_e_invalid_property_index_value);
p.index:=0;
end;
{$warning FIXME: force 32bit int for property index}
inserttypeconv(pt,s32inttype);
p.indextype.setdef(pt.resulttype.def);
include(p.propoptions,ppo_indexed);
{ concat a longint to the para templates }
@ -1170,7 +1172,12 @@ implementation
end.
{
$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
PIC support for now. You have to save/restore r31 when you us it! :)
Also, it's not necessary to support the imported variables

52
compiler/pexpr.pas
View File

@ -1313,21 +1313,11 @@ implementation
constsym :
begin
case tconstsym(srsym).consttyp of
constint :
constord :
begin
{$ifdef cpu64bit}
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,sinttype,true);
{$else cpu64bit}
{ 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}
if tconstsym(srsym).consttype.def=nil then
internalerror(200403232);
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,tconstsym(srsym).consttype,true);
end;
conststring :
begin
@ -1339,16 +1329,10 @@ implementation
pc[len]:=#0;
p1:=cstringconstnode.createpchar(pc,len);
end;
constchar :
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,cchartype,true);
constreal :
p1:=crealconstnode.create(pbestreal(tconstsym(srsym).value.valueptr)^,pbestrealtype^);
constbool :
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,booltype,true);
constset :
p1:=csetconstnode.create(pconstset(tconstsym(srsym).value.valueptr),tconstsym(srsym).consttype);
constord :
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,tconstsym(srsym).consttype,true);
constpointer :
p1:=cpointerconstnode.create(tconstsym(srsym).value.valueordptr,tconstsym(srsym).consttype);
constnil :
@ -1903,7 +1887,8 @@ implementation
if code=0 then
begin
consume(_INTCONST);
p1:=cordconstnode.create(ic,sinttype,true);
int_to_type(card,htype);
p1:=cordconstnode.create(ic,htype,true);
end;
{$else cpu64bit}
{ try cardinal first }
@ -1911,16 +1896,8 @@ implementation
if code=0 then
begin
consume(_INTCONST);
{ check whether the value isn't in the longint range as well }
{ (longint is easier to perform calculations with) (JM) }
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)
int_to_type(card,htype);
p1:=cordconstnode.create(card,htype,true);
end
else
begin
@ -1929,7 +1906,8 @@ implementation
if code = 0 then
begin
consume(_INTCONST);
p1:=cordconstnode.create(l,sinttype,true)
int_to_type(l,htype);
p1:=cordconstnode.create(l,htype,true);
end
else
begin
@ -1938,7 +1916,8 @@ implementation
if code=0 then
begin
consume(_INTCONST);
p1:=cordconstnode.create(ic,s64inttype,true);
int_to_type(ic,htype);
p1:=cordconstnode.create(ic,htype,true);
end;
end;
end;
@ -2419,7 +2398,12 @@ implementation
end.
{
$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
Revision 1.149 2004/02/18 21:58:53 peter

9
compiler/ppu.pas
View File

@ -44,7 +44,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion=39;
CurrentPPUVersion=40;
{ buffer sizes }
maxentrysize = 1024;
@ -1042,7 +1042,12 @@ end;
end.
{
$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
+ refaddr to treference added
+ refsymbol to treference added

101
compiler/psystem.pas
View File

@ -42,7 +42,7 @@ interface
implementation
uses
globals,globtype,
globals,globtype,verbose,
symconst,symtype,symsym,symdef,symtable,
aasmtai,aasmcpu,ncgutil,
{$ifdef GDB}
@ -157,12 +157,17 @@ implementation
addtype('ByteBool',booltype);
adddef('WordBool',torddef.create(bool16bit,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('WideChar',cwidechartype);
adddef('Text',tfiledef.createtext);
addtype('Longword',u32inttype);
addtype('QWord',u64inttype);
addtype('Int64',s64inttype);
adddef('TypedFile',tfiledef.createtyped(voidtype));
addtype('Variant',cvarianttype);
addtype('OleVariant',colevarianttype);
@ -170,7 +175,9 @@ implementation
addtype('$formal',cformaltype);
addtype('$void',voidtype);
addtype('$byte',u8inttype);
addtype('$shortint',s8inttype);
addtype('$word',u16inttype);
addtype('$smallint',s16inttype);
addtype('$ulong',u32inttype);
addtype('$longint',s32inttype);
addtype('$qword',u64inttype);
@ -224,38 +231,53 @@ implementation
{
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
globaldef('byte',u8inttype);
globaldef('word',u16inttype);
globaldef('ulong',u32inttype);
globaldef('longint',s32inttype);
globaldef('qword',u64inttype);
globaldef('int64',s64inttype);
globaldef('formal',cformaltype);
globaldef('void',voidtype);
globaldef('char',cchartype);
globaldef('widechar',cwidechartype);
globaldef('shortstring',cshortstringtype);
globaldef('longstring',clongstringtype);
globaldef('ansistring',cansistringtype);
globaldef('widestring',cwidestringtype);
globaldef('openshortstring',openshortstringtype);
globaldef('openchararray',openchararraytype);
globaldef('s32real',s32floattype);
globaldef('s64real',s64floattype);
globaldef('s80real',s80floattype);
globaldef('s64currency',s64currencytype);
globaldef('boolean',booltype);
globaldef('void_pointer',voidpointertype);
globaldef('char_pointer',charpointertype);
globaldef('void_farpointer',voidfarpointertype);
globaldef('file',cfiletype);
globaldef('pvmt',pvmttype);
globaldef('vtblarray',vmtarraytype);
globaldef('__vtbl_ptr_type',vmttype);
globaldef('variant',cvarianttype);
globaldef('olevariant',colevarianttype);
globaldef('methodpointer',methodpointertype);
loadtype('byte',u8inttype);
loadtype('shortint',s8inttype);
loadtype('word',u16inttype);
loadtype('smallint',s16inttype);
loadtype('ulong',u32inttype);
loadtype('longint',s32inttype);
loadtype('qword',u64inttype);
loadtype('int64',s64inttype);
loadtype('formal',cformaltype);
loadtype('void',voidtype);
loadtype('char',cchartype);
loadtype('widechar',cwidechartype);
loadtype('shortstring',cshortstringtype);
loadtype('longstring',clongstringtype);
loadtype('ansistring',cansistringtype);
loadtype('widestring',cwidestringtype);
loadtype('openshortstring',openshortstringtype);
loadtype('openchararray',openchararraytype);
loadtype('s32real',s32floattype);
loadtype('s64real',s64floattype);
loadtype('s80real',s80floattype);
loadtype('s64currency',s64currencytype);
loadtype('boolean',booltype);
loadtype('void_pointer',voidpointertype);
loadtype('char_pointer',charpointertype);
loadtype('void_farpointer',voidfarpointertype);
loadtype('file',cfiletype);
loadtype('pvmt',pvmttype);
loadtype('vtblarray',vmtarraytype);
loadtype('__vtbl_ptr_type',vmttype);
loadtype('variant',cvarianttype);
loadtype('olevariant',colevarianttype);
loadtype('methodpointer',methodpointertype);
{$ifdef cpu64bit}
uinttype:=u64inttype;
sinttype:=s64inttype;
@ -281,7 +303,9 @@ implementation
cformaltype.setdef(tformaldef.create);
voidtype.setdef(torddef.create(uvoid,0,0));
u8inttype.setdef(torddef.create(u8bit,0,255));
s8inttype.setdef(torddef.create(s8bit,-128,127));
u16inttype.setdef(torddef.create(u16bit,0,65535));
s16inttype.setdef(torddef.create(s16bit,-32768,32767));
u32inttype.setdef(torddef.create(u32bit,0,high(longword)));
s32inttype.setdef(torddef.create(s32bit,low(longint),high(longint)));
u64inttype.setdef(torddef.create(u64bit,low(qword),TConstExprInt(high(qword))));
@ -488,7 +512,12 @@ implementation
end.
{
$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
units

15
compiler/ptype.pas
View File

@ -289,8 +289,12 @@ implementation
consume(_POINTPOINT);
{ get high value of range }
pt2:=comp_expr(not(ignore_equal));
{ make both the same type }
inserttypeconv(pt1,pt2.resulttype);
{ make both the same type or give an error. This is not
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 }
if (pt1.nodetype=ordconstn) and
(pt2.nodetype=ordconstn) then
@ -643,7 +647,12 @@ implementation
end.
{
$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 registers32 to registersint
* replace some s32bit,u32bit with torddef([su]inttype).def.typ

13
compiler/rautils.pas
View File

@ -962,7 +962,7 @@ Begin
end;
constsym :
begin
if tconstsym(sym).consttyp in [constint,constchar,constbool] then
if tconstsym(sym).consttyp=constord then
begin
setconst(tconstsym(sym).value.valueord);
SetupVar:=true;
@ -1312,7 +1312,7 @@ Begin
case srsym.typ of
constsym :
begin
if (tconstsym(srsym).consttyp in [constord,constint,constchar,constbool]) then
if tconstsym(srsym).consttyp=constord then
Begin
l:=tconstsym(srsym).value.valueord;
SearchIConstant:=TRUE;
@ -1368,7 +1368,7 @@ Begin
st:=tobjectdef(def).symtable;
end;
typesym :
with Ttypesym(sym).restype do
with Ttypesym(sym).restype do
case def.deftype of
recorddef :
st:=trecorddef(def).symtable;
@ -1632,7 +1632,12 @@ end;
end.
{
$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
Revision 1.83 2004/03/17 22:27:41 florian

13
compiler/symconst.pas
View File

@ -303,9 +303,9 @@ type
absolutetyp = (tovar,toasm,toaddr);
tconsttyp = (constnone,
constord,conststring,constreal,constbool,
constint,constchar,constset,constpointer,constnil,
constresourcestring,constwstring,constwchar,constguid
constord,conststring,constreal,
constset,constpointer,constnil,
constresourcestring,constwstring,constguid
);
{ RTTI information to store }
@ -404,7 +404,12 @@ initialization
end.
{
$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
units

46
compiler/symdef.pas
View File

@ -717,16 +717,18 @@ interface
charpointertype, { pointer for Char-Pointerdef }
voidfarpointertype,
cformaltype, { unique formal definition }
voidtype, { Pointer to Void (procedure) }
cchartype, { Pointer to Char }
cwidechartype, { Pointer to WideChar }
booltype, { pointer to boolean type }
u8inttype, { Pointer to 8-Bit unsigned }
u16inttype, { Pointer to 16-Bit unsigned }
u32inttype, { Pointer to 32-Bit unsigned }
s32inttype, { Pointer to 32-Bit signed }
u64inttype, { pointer to 64 bit unsigned def }
s64inttype, { pointer to 64 bit signed def, }
voidtype, { Void (procedure) }
cchartype, { Char }
cwidechartype, { WideChar }
booltype, { boolean type }
u8inttype, { 8-Bit unsigned integer }
s8inttype, { 8-Bit signed integer }
u16inttype, { 16-Bit unsigned integer }
s16inttype, { 16-Bit signed integer }
u32inttype, { 32-Bit unsigned integer }
s32inttype, { 32-Bit signed integer }
u64inttype, { 64-bit unsigned integer }
s64inttype, { 64-bit signed integer }
s32floattype, { pointer for realconstn }
s64floattype, { pointer for realconstn }
s80floattype, { pointer to type of temp. floats }
@ -3519,21 +3521,22 @@ implementation
hs:=strpas(pchar(hpc.value.valueptr));
constreal :
str(pbestreal(hpc.value.valueptr)^,hs);
constord :
hs:=tostr(hpc.value.valueord);
constpointer :
hs:=tostr(hpc.value.valueordptr);
constbool :
constord :
begin
if hpc.value.valueord<>0 then
hs:='TRUE'
if is_boolean(hpc.consttype.def) then
begin
if hpc.value.valueord<>0 then
hs:='TRUE'
else
hs:='FALSE';
end
else
hs:='FALSE';
hs:=tostr(hpc.value.valueord);
end;
constnil :
hs:='nil';
constchar :
hs:=chr(hpc.value.valueord);
constset :
hs:='<set>';
end;
@ -6061,7 +6064,12 @@ implementation
end.
{
$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
Revision 1.231 2004/03/14 22:51:46 peter

66
compiler/symsym.pas
View File

@ -251,15 +251,12 @@ interface
consttyp : tconsttyp;
value : tconstvalue;
resstrindex : longint; { needed for resource strings }
constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint);
constructor create_ord_typed(const n : string;t : tconsttyp;v : tconstexprint;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);
constructor create_ptr_typed(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
constructor create_ord(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_ptr(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override;
{ function mangledname : string;}
procedure buildderef;override;
procedure deref;override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
@ -860,7 +857,7 @@ implementation
if (eq>=te_equal) or
((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
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
((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
begin
@ -1720,19 +1717,7 @@ implementation
TCONSTSYM
****************************************************************************}
constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : TConstExprInt);
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);
constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
begin
inherited create(n);
fillchar(value, sizeof(value), #0);
@ -1744,7 +1729,7 @@ implementation
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
inherited create(n);
fillchar(value, sizeof(value), #0);
@ -1756,19 +1741,7 @@ implementation
end;
constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer);
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);
constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
begin
inherited create(n);
fillchar(value, sizeof(value), #0);
@ -1806,12 +1779,6 @@ implementation
consttyp:=tconsttyp(ppufile.getbyte);
fillchar(value, sizeof(value), #0);
case consttyp of
constint:
value.valueord:=ppufile.getexprint;
constwchar,
constbool,
constchar :
value.valueord:=ppufile.getlongint;
constord :
begin
ppufile.gettype(consttype);
@ -1894,12 +1861,6 @@ implementation
ppufile.putbyte(byte(consttyp));
case consttyp of
constnil : ;
constint:
ppufile.putexprint(value.valueord);
constbool,
constchar,
constwchar :
ppufile.putlongint(value.valueord);
constord :
begin
ppufile.puttype(consttype);
@ -1943,11 +1904,7 @@ implementation
case consttyp of
conststring:
st:='s'''+backspace_quote(strpas(pchar(value.valueptr)),['''','"','\',#10,#13])+'''';
constbool,
constint,
constord,
constwchar,
constchar:
constord:
st:='i'+int64tostr(value.valueord);
constpointer:
st:='i'+int64tostr(value.valueordptr);
@ -2243,7 +2200,12 @@ implementation
end.
{
$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
* special mode -gv for valgrind compatible stabs

10
compiler/symutil.pas
View File

@ -70,9 +70,6 @@ implementation
if sym1.consttyp<>sym2.consttyp then
exit;
case sym1.consttyp of
constint,
constbool,
constchar,
constord :
equal_constsym:=(sym1.value.valueord=sym2.value.valueord);
constpointer :
@ -119,7 +116,12 @@ implementation
end.
{
$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
* use count_locals in powerpc/cpupi to check whether we should set the
first temp offset (and as such generate a stackframe)