paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-07-25 21:46:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* split constsym.value in valueord,valueordptr,valueptr. The valueordptr

Browse Source 
is used for holding target platform pointer values. As those can be
    bigger than the source platform.
This commit is contained in:
peter 2001-09-02 21:18:28 +00:00
parent 1f4bac4fd0
commit 915b5cd7a9
9 changed files with 263 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
compiler/i386/cpuinfo.pas
View File

@ -35,13 +35,11 @@ Type
TConstExprUInt = {$ifdef fpc}qword{$else}int64{$endif}; TConstExprUInt = {$ifdef fpc}qword{$else}int64{$endif};
{ this must be an ordinal type with the same size as a pointer } { this must be an ordinal type with the same size as a pointer }
{ to allow some dirty type casts for example when using }
{ tconstsym.value }
{ Note: must be unsigned!! Otherwise, ugly code like } { Note: must be unsigned!! Otherwise, ugly code like }
{ pointer(-1) will result in a pointer with the value } { pointer(-1) will result in a pointer with the value }
{ $fffffffffffffff on a 32bit machine if the compiler uses } { $fffffffffffffff on a 32bit machine if the compiler uses }
{ int64 constants internally (JM) } { int64 constants internally (JM) }
TPointerOrd = cardinal; TConstPtrUInt = cardinal;
Const Const
{ Size of native extended type } { Size of native extended type }
@ -52,7 +50,12 @@ Implementation
end. end.
{ {
$Log$ $Log$
Revision 1.3 2001-06-03 20:21:08 peter Revision 1.4 2001-09-02 21:18:29 peter
* split constsym.value in valueord,valueordptr,valueptr. The valueordptr
is used for holding target platform pointer values. As those can be
bigger than the source platform.
Revision 1.3 2001/06/03 20:21:08 peter
* Kylix fixes, mostly case names of units * Kylix fixes, mostly case names of units
Revision 1.2 2001/02/08 13:09:03 jonas Revision 1.2 2001/02/08 13:09:03 jonas

17
compiler/pass_1.pas
View File

@ -78,6 +78,9 @@ implementation
if assigned(hp) then if assigned(hp) then
begin begin
p.free; p.free;
{ run resulttypepass }
resulttypepass(hp);
{ switch to new node }
p:=hp; p:=hp;
end; end;
aktlocalswitches:=oldlocalswitches; aktlocalswitches:=oldlocalswitches;
@ -92,7 +95,12 @@ implementation
codegenerror:=codegenerror or oldcodegenerror; codegenerror:=codegenerror or oldcodegenerror;
end end
else else
inc(multiresulttypepasscnt); begin
{ update the codegenerror boolean with the previous result of this node }
if (nf_error in p.flags) then
codegenerror:=true;
inc(multiresulttypepasscnt);
end;
end; end;
@ -170,7 +178,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.16 2001-08-26 13:36:44 florian Revision 1.17 2001-09-02 21:18:28 peter
* split constsym.value in valueord,valueordptr,valueptr. The valueordptr
is used for holding target platform pointer values. As those can be
bigger than the source platform.
Revision 1.16 2001/08/26 13:36:44 florian
* some cg reorganisation * some cg reorganisation
* some PPC updates * some PPC updates

27
compiler/pdecl.pas
View File

@ -82,17 +82,17 @@ implementation
ordconstn: ordconstn:
begin begin
if is_constintnode(p) then if is_constintnode(p) then
hp:=tconstsym.create_typed(name,constint,tordconstnode(p).value,tordconstnode(p).resulttype) hp:=tconstsym.create_ord_typed(name,constint,tordconstnode(p).value,tordconstnode(p).resulttype)
else if is_constcharnode(p) then else if is_constcharnode(p) then
hp:=tconstsym.create(name,constchar,tordconstnode(p).value) hp:=tconstsym.create_ord(name,constchar,tordconstnode(p).value)
else if is_constboolnode(p) then else if is_constboolnode(p) then
hp:=tconstsym.create(name,constbool,tordconstnode(p).value) hp:=tconstsym.create_ord(name,constbool,tordconstnode(p).value)
else if is_constwidecharnode(p) then else if is_constwidecharnode(p) then
hp:=tconstsym.create(name,constwchar,tordconstnode(p).value) hp:=tconstsym.create_ord(name,constwchar,tordconstnode(p).value)
else if p.resulttype.def.deftype=enumdef then else if p.resulttype.def.deftype=enumdef then
hp:=tconstsym.create_typed(name,constord,tordconstnode(p).value,p.resulttype) hp:=tconstsym.create_ord_typed(name,constord,tordconstnode(p).value,p.resulttype)
else if p.resulttype.def.deftype=pointerdef then else if p.resulttype.def.deftype=pointerdef then
hp:=tconstsym.create_typed(name,constord,tordconstnode(p).value,p.resulttype) hp:=tconstsym.create_ordptr_typed(name,constpointer,tordconstnode(p).value,p.resulttype)
else internalerror(111); else internalerror(111);
end; end;
stringconstn: stringconstn:
@ -105,21 +105,21 @@ implementation
begin begin
new(pd); new(pd);
pd^:=trealconstnode(p).value_real; pd^:=trealconstnode(p).value_real;
hp:=tconstsym.create(name,constreal,longint(pd)); hp:=tconstsym.create_ptr(name,constreal,pd);
end; end;
setconstn : setconstn :
begin begin
new(ps); new(ps);
ps^:=tsetconstnode(p).value_set^; ps^:=tsetconstnode(p).value_set^;
hp:=tconstsym.create_typed(name,constset,longint(ps),p.resulttype); hp:=tconstsym.create_ptr_typed(name,constset,ps,p.resulttype);
end; end;
pointerconstn : pointerconstn :
begin begin
hp:=tconstsym.create_typed(name,constpointer,tordconstnode(p).value,p.resulttype); hp:=tconstsym.create_ordptr_typed(name,constpointer,tpointerconstnode(p).value,p.resulttype);
end; end;
niln : niln :
begin begin
hp:=tconstsym.create_typed(name,constnil,0,p.resulttype); hp:=tconstsym.create_ord_typed(name,constnil,0,p.resulttype);
end; end;
else else
Message(cg_e_illegal_expression); Message(cg_e_illegal_expression);
@ -595,7 +595,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.32 2001-08-30 20:13:53 peter Revision 1.33 2001-09-02 21:18:28 peter
* split constsym.value in valueord,valueordptr,valueptr. The valueordptr
is used for holding target platform pointer values. As those can be
bigger than the source platform.
Revision 1.32 2001/08/30 20:13:53 peter
* rtti/init table updates * rtti/init table updates
* rttisym for reusable global rtti/init info * rttisym for reusable global rtti/init info
* support published for interfaces * support published for interfaces

38
compiler/pexpr.pas
View File

@ -56,6 +56,9 @@ interface
implementation implementation
uses uses
{$ifdef delphi}
SysUtils,
{$endif}
{ common } { common }
cutils, cutils,
{ global } { global }
@ -878,7 +881,7 @@ implementation
proc_to_procvar_equal(tprocsym(sym).definition,getprocvardef) proc_to_procvar_equal(tprocsym(sym).definition,getprocvardef)
) )
) )
),again,tcallnode(p1)); ),again,p1);
if (block_type=bt_const) and if (block_type=bt_const) and
getprocvar then getprocvar then
handle_procvar(getprocvardef,p1,getaddr); handle_procvar(getprocvardef,p1,getaddr);
@ -1158,12 +1161,14 @@ implementation
constint : constint :
begin begin
{ do a very dirty trick to bootstrap this code } { do a very dirty trick to bootstrap this code }
if (tconstsym(srsym).value>=-(int64(2147483647)+int64(1))) and (tconstsym(srsym).value<=2147483647) then if (tconstsym(srsym).valueord>=-(int64(2147483647)+int64(1))) and
p1:=cordconstnode.create(tconstsym(srsym).value,s32bittype) (tconstsym(srsym).valueord<=2147483647) then
else if (tconstsym(srsym).value > maxlongint) and (tconstsym(srsym).value <= int64(maxlongint)+int64(maxlongint)+1) then p1:=cordconstnode.create(tconstsym(srsym).valueord,s32bittype)
p1:=cordconstnode.create(tconstsym(srsym).value,u32bittype) else if (tconstsym(srsym).valueord > maxlongint) and
(tconstsym(srsym).valueord <= int64(maxlongint)+int64(maxlongint)+1) then
p1:=cordconstnode.create(tconstsym(srsym).valueord,u32bittype)
else else
p1:=cordconstnode.create(tconstsym(srsym).value,cs64bittype); p1:=cordconstnode.create(tconstsym(srsym).valueord,cs64bittype);
end; end;
conststring : conststring :
begin begin
@ -1171,22 +1176,22 @@ implementation
if not(cs_ansistrings in aktlocalswitches) and (len>255) then if not(cs_ansistrings in aktlocalswitches) and (len>255) then
len:=255; len:=255;
getmem(pc,len+1); getmem(pc,len+1);
move(pchar(tpointerord(tconstsym(srsym).value))^,pc^,len); move(pchar(tconstsym(srsym).valueptr)^,pc^,len);
pc[len]:=#0; pc[len]:=#0;
p1:=cstringconstnode.createpchar(pc,len); p1:=cstringconstnode.createpchar(pc,len);
end; end;
constchar : constchar :
p1:=cordconstnode.create(tconstsym(srsym).value,cchartype); p1:=cordconstnode.create(tconstsym(srsym).valueord,cchartype);
constreal : constreal :
p1:=crealconstnode.create(pbestreal(tpointerord(tconstsym(srsym).value))^,pbestrealtype^); p1:=crealconstnode.create(pbestreal(tconstsym(srsym).valueptr)^,pbestrealtype^);
constbool : constbool :
p1:=cordconstnode.create(tconstsym(srsym).value,booltype); p1:=cordconstnode.create(tconstsym(srsym).valueord,booltype);
constset : constset :
p1:=csetconstnode.create(pconstset(tpointerord(tconstsym(srsym).value)),tconstsym(srsym).consttype); p1:=csetconstnode.create(pconstset(tconstsym(srsym).valueptr),tconstsym(srsym).consttype);
constord : constord :
p1:=cordconstnode.create(tconstsym(srsym).value,tconstsym(srsym).consttype); p1:=cordconstnode.create(tconstsym(srsym).valueord,tconstsym(srsym).consttype);
constpointer : constpointer :
p1:=cpointerconstnode.create(tconstsym(srsym).value,tconstsym(srsym).consttype); p1:=cpointerconstnode.create(tconstsym(srsym).valueordptr,tconstsym(srsym).consttype);
constnil : constnil :
p1:=cnilnode.create; p1:=cnilnode.create;
constresourcestring: constresourcestring:
@ -2320,7 +2325,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.41 2001-08-26 13:36:45 florian Revision 1.42 2001-09-02 21:18:28 peter
* split constsym.value in valueord,valueordptr,valueptr. The valueordptr
is used for holding target platform pointer values. As those can be
bigger than the source platform.
Revision 1.41 2001/08/26 13:36:45 florian
* some cg reorganisation * some cg reorganisation
* some PPC updates * some PPC updates

34
compiler/ptconst.pas
View File

@ -61,7 +61,7 @@ implementation
var var
len,base : longint; len,base : longint;
p,hp : tnode; p,hp,hpstart : tnode;
i,j,l,offset, i,j,l,offset,
strlength : longint; strlength : longint;
curconstsegment : TAAsmoutput; curconstsegment : TAAsmoutput;
@ -312,16 +312,25 @@ implementation
else else
if p.nodetype=addrn then if p.nodetype=addrn then
begin begin
hp:=taddrnode(p).left; inserttypeconv(p,t);
{ if a typeconv node was inserted then check if it was an tc_equal. If
true then we remove the node. If not tc_equal then we leave the typeconvn
and the nodetype=loadn will always be false and generate the error (PFV) }
if (p.nodetype=typeconvn) then
begin
if (ttypeconvnode(p).convtype=tc_equal) then
hpstart:=taddrnode(ttypeconvnode(p).left).left
else
hpstart:=p;
end
else
hpstart:=taddrnode(p).left;
hp:=hpstart;
while assigned(hp) and (hp.nodetype in [subscriptn,vecn]) do while assigned(hp) and (hp.nodetype in [subscriptn,vecn]) do
hp:=tbinarynode(hp).left; hp:=tbinarynode(hp).left;
if (is_equal(tpointerdef(p.resulttype.def).pointertype.def,tpointerdef(t.def).pointertype.def) or if (hp.nodetype=loadn) then
(is_void(tpointerdef(p.resulttype.def).pointertype.def)) or
(is_void(tpointerdef(t.def).pointertype.def))) and
(hp.nodetype=loadn) then
begin begin
do_resulttypepass(taddrnode(p).left); hp:=hpstart;
hp:=taddrnode(p).left;
offset:=0; offset:=0;
while assigned(hp) and (hp.nodetype<>loadn) do while assigned(hp) and (hp.nodetype<>loadn) do
begin begin
@ -461,7 +470,7 @@ implementation
end end
else if is_constresourcestringnode(p) then else if is_constresourcestringnode(p) then
begin begin
strval:=pchar(tpointerord(tconstsym(tloadnode(p).symtableentry).value)); strval:=pchar(tconstsym(tloadnode(p).symtableentry).valueptr);
strlength:=tconstsym(tloadnode(p).symtableentry).len; strlength:=tconstsym(tloadnode(p).symtableentry).len;
end end
else else
@ -916,7 +925,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.31 2001-08-26 13:36:47 florian Revision 1.32 2001-09-02 21:18:28 peter
* split constsym.value in valueord,valueordptr,valueptr. The valueordptr
is used for holding target platform pointer values. As those can be
bigger than the source platform.
Revision 1.31 2001/08/26 13:36:47 florian
* some cg reorganisation * some cg reorganisation
* some PPC updates * some PPC updates

11
compiler/rautils.pas
View File

@ -957,7 +957,7 @@ Begin
if tconstsym(sym).consttyp in [constint,constchar,constbool] then if tconstsym(sym).consttyp in [constint,constchar,constbool] then
begin begin
opr.typ:=OPR_CONSTANT; opr.typ:=OPR_CONSTANT;
opr.val:=tconstsym(sym).value; opr.val:=tconstsym(sym).valueord;
SetupVar:=true; SetupVar:=true;
Exit; Exit;
end; end;
@ -1267,7 +1267,7 @@ Begin
begin begin
if (tconstsym(srsym).consttyp in [constord,constint,constchar,constbool]) then if (tconstsym(srsym).consttyp in [constord,constint,constchar,constbool]) then
Begin Begin
l:=tconstsym(srsym).value; l:=tconstsym(srsym).valueord;
SearchIConstant:=TRUE; SearchIConstant:=TRUE;
exit; exit;
end; end;
@ -1581,7 +1581,12 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.23 2001-08-26 13:36:48 florian Revision 1.24 2001-09-02 21:18:28 peter
* split constsym.value in valueord,valueordptr,valueptr. The valueordptr
is used for holding target platform pointer values. As those can be
bigger than the source platform.
Revision 1.23 2001/08/26 13:36:48 florian
* some cg reorganisation * some cg reorganisation
* some PPC updates * some PPC updates

11
compiler/scandir.pas
View File

@ -32,7 +32,11 @@ interface
implementation implementation
uses uses
{$ifdef delphi}
dmisc,
{$else}
dos, dos,
{$endif}
cutils, cutils,
version,globtype,globals,systems, version,globtype,globals,systems,
verbose,comphook, verbose,comphook,
@ -913,7 +917,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.7 2001-08-19 11:22:24 peter Revision 1.8 2001-09-02 21:18:28 peter
* split constsym.value in valueord,valueordptr,valueptr. The valueordptr
is used for holding target platform pointer values. As those can be
bigger than the source platform.
Revision 1.7 2001/08/19 11:22:24 peter
* palmos support from v10 merged * palmos support from v10 merged
Revision 1.6 2001/08/07 18:47:13 peter Revision 1.6 2001/08/07 18:47:13 peter

23
compiler/symdef.pas
View File

@ -3132,15 +3132,16 @@ implementation
case hpc.consttyp of case hpc.consttyp of
conststring, conststring,
constresourcestring : constresourcestring :
hs:=strpas(pchar(tpointerord(hpc.value))); hs:=strpas(pchar(hpc.valueptr));
constreal : constreal :
str(pbestreal(tpointerord(hpc.value))^,hs); str(pbestreal(hpc.valueptr)^,hs);
constord, constord :
hs:=tostr(hpc.valueord);
constpointer : constpointer :
hs:=tostr(hpc.value); hs:=tostr(hpc.valueordptr);
constbool : constbool :
begin begin
if hpc.value<>0 then if hpc.valueord<>0 then
hs:='TRUE' hs:='TRUE'
else else
hs:='FALSE'; hs:='FALSE';
@ -3148,7 +3149,7 @@ implementation
constnil : constnil :
hs:='nil'; hs:='nil';
constchar : constchar :
hs:=chr(hpc.value); hs:=chr(hpc.valueord);
constset : constset :
hs:='<set>'; hs:='<set>';
end; end;
@ -3318,7 +3319,8 @@ implementation
parast:=tparasymtable.create; parast:=tparasymtable.create;
tparasymtable(parast).load(ppufile); tparasymtable(parast).load(ppufile);
parast.defowner:=self; parast.defowner:=self;
if (pocall_inline in proccalloptions) then if (pocall_inline in proccalloptions) or
((current_module.flags and uf_local_browser)<>0) then
begin begin
localst:=tlocalsymtable.create; localst:=tlocalsymtable.create;
tlocalsymtable(localst).load(ppufile); tlocalsymtable(localst).load(ppufile);
@ -5394,7 +5396,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.46 2001-08-30 20:13:54 peter Revision 1.47 2001-09-02 21:18:28 peter
* split constsym.value in valueord,valueordptr,valueptr. The valueordptr
is used for holding target platform pointer values. As those can be
bigger than the source platform.
Revision 1.46 2001/08/30 20:13:54 peter
* rtti/init table updates * rtti/init table updates
* rttisym for reusable global rtti/init info * rttisym for reusable global rtti/init info
* support published for interfaces * support published for interfaces

195
compiler/symsym.pas
View File

@ -245,13 +245,18 @@ interface
end; end;
tconstsym = class(tstoredsym) tconstsym = class(tstoredsym)
consttype : ttype; consttype : ttype;
consttyp : tconsttyp; consttyp : tconsttyp;
resstrindex, { needed for resource strings } resstrindex, { needed for resource strings }
value : tconstexprint; valueord : tconstexprint; { used for ordinal values }
len : longint; { len is needed for string length } valueordptr : TConstPtrUInt; { used for pointer values }
constructor create(const n : string;t : tconsttyp;v : tconstexprint); valueptr : pointer; { used for string, set, real values }
constructor create_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype); len : longint; { len is needed for string length }
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_string(const n : string;t : tconsttyp;str:pchar;l:longint); constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint);
constructor load(ppufile:tcompilerppufile); constructor load(ppufile:tcompilerppufile);
destructor destroy;override; destructor destroy;override;
@ -1797,24 +1802,70 @@ implementation
TCONSTSYM TCONSTSYM
****************************************************************************} ****************************************************************************}
constructor tconstsym.create(const n : string;t : tconsttyp;v : TConstExprInt); constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : TConstExprInt);
begin begin
inherited create(n); inherited create(n);
typ:=constsym; typ:=constsym;
consttyp:=t; consttyp:=t;
value:=v; valueord:=v;
valueordptr:=0;
valueptr:=nil;
ResStrIndex:=0; ResStrIndex:=0;
consttype.reset; consttype.reset;
len:=0; len:=0;
end; end;
constructor tconstsym.create_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype); constructor tconstsym.create_ord_typed(const n : string;t : tconsttyp;v : tconstexprint;const tt:ttype);
begin begin
inherited create(n); inherited create(n);
typ:=constsym; typ:=constsym;
consttyp:=t; consttyp:=t;
value:=v; valueord:=v;
valueordptr:=0;
valueptr:=nil;
ResStrIndex:=0;
consttype:=tt;
len:=0;
end;
constructor tconstsym.create_ordptr_typed(const n : string;t : tconsttyp;v : tconstptruint;const tt:ttype);
begin
inherited create(n);
typ:=constsym;
consttyp:=t;
valueord:=0;
valueordptr:=v;
valueptr:=nil;
ResStrIndex:=0;
consttype:=tt;
len:=0;
end;
constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer);
begin
inherited create(n);
typ:=constsym;
consttyp:=t;
valueord:=0;
valueordptr:=0;
valueptr:=v;
ResStrIndex:=0;
consttype.reset;
len:=0;
end;
constructor tconstsym.create_ptr_typed(const n : string;t : tconsttyp;v : pointer;const tt:ttype);
begin
inherited create(n);
typ:=constsym;
consttyp:=t;
valueord:=0;
valueordptr:=0;
valueptr:=v;
ResStrIndex:=0; ResStrIndex:=0;
consttype:=tt; consttype:=tt;
len:=0; len:=0;
@ -1826,13 +1877,16 @@ implementation
inherited create(n); inherited create(n);
typ:=constsym; typ:=constsym;
consttyp:=t; consttyp:=t;
value:=longint(str); valueord:=0;
valueordptr:=0;
valueptr:=str;
consttype.reset; consttype.reset;
len:=l; len:=l;
if t=constresourcestring then if t=constresourcestring then
ResStrIndex:=ResourceStrings.Register(name,pchar(tpointerord(value)),len); ResStrIndex:=ResourceStrings.Register(name,pchar(valueptr),len);
end; end;
constructor tconstsym.load(ppufile:tcompilerppufile); constructor tconstsym.load(ppufile:tcompilerppufile);
var var
pd : pbestreal; pd : pbestreal;
@ -1845,6 +1899,9 @@ implementation
typ:=constsym; typ:=constsym;
consttype.reset; consttype.reset;
consttyp:=tconsttyp(ppufile.getbyte); consttyp:=tconsttyp(ppufile.getbyte);
valueord:=0;
valueordptr:=0;
valueptr:=nil;
case consttyp of case consttyp of
constint: constint:
if sizeof(tconstexprint)=8 then if sizeof(tconstexprint)=8 then
@ -1855,19 +1912,18 @@ implementation
{$define Range_check_on} {$define Range_check_on}
{$endif opt R+} {$endif opt R+}
{$R- needed here } {$R- needed here }
value:=qword(l1)+(int64(l2) shl 32); valueord:=qword(l1)+(int64(l2) shl 32);
{$ifdef Range_check_on} {$ifdef Range_check_on}
{$R+} {$R+}
{$undef Range_check_on} {$undef Range_check_on}
{$endif Range_check_on} {$endif Range_check_on}
end end
else else
value:=ppufile.getlongint; valueord:=ppufile.getlongint;
constwchar, constwchar,
constbool, constbool,
constchar : constchar :
value:=ppufile.getlongint; valueord:=ppufile.getlongint;
constpointer,
constord : constord :
begin begin
ppufile.gettype(consttype); ppufile.gettype(consttype);
@ -1879,36 +1935,57 @@ implementation
{$define Range_check_on} {$define Range_check_on}
{$endif opt R+} {$endif opt R+}
{$R- needed here } {$R- needed here }
value:=qword(l1)+(int64(l2) shl 32); valueord:=qword(l1)+(int64(l2) shl 32);
{$ifdef Range_check_on} {$ifdef Range_check_on}
{$R+} {$R+}
{$undef Range_check_on} {$undef Range_check_on}
{$endif Range_check_on} {$endif Range_check_on}
end end
else else
value:=ppufile.getlongint; valueord:=ppufile.getlongint;
end; end;
conststring,constresourcestring : constpointer :
begin
ppufile.gettype(consttype);
if sizeof(TConstPtrUInt)=8 then
begin
l1:=ppufile.getlongint;
l2:=ppufile.getlongint;
{$ifopt R+}
{$define Range_check_on}
{$endif opt R+}
{$R- needed here }
valueordptr:=qword(l1)+(int64(l2) shl 32);
{$ifdef Range_check_on}
{$R+}
{$undef Range_check_on}
{$endif Range_check_on}
end
else
valueordptr:=ppufile.getlongint;
end;
conststring,
constresourcestring :
begin begin
len:=ppufile.getlongint; len:=ppufile.getlongint;
getmem(pc,len+1); getmem(pc,len+1);
ppufile.getdata(pc^,len); ppufile.getdata(pc^,len);
if consttyp=constresourcestring then if consttyp=constresourcestring then
ResStrIndex:=ppufile.getlongint; ResStrIndex:=ppufile.getlongint;
value:=tpointerord(pc); valueptr:=pc;
end; end;
constreal : constreal :
begin begin
new(pd); new(pd);
pd^:=ppufile.getreal; pd^:=ppufile.getreal;
value:=tpointerord(pd); valueptr:=pd;
end; end;
constset : constset :
begin begin
ppufile.gettype(consttype); ppufile.gettype(consttype);
new(ps); new(ps);
ppufile.getnormalset(ps^); ppufile.getnormalset(ps^);
value:=tpointerord(ps); valueptr:=ps;
end; end;
constnil : ; constnil : ;
else else
@ -1920,12 +1997,13 @@ implementation
destructor tconstsym.destroy; destructor tconstsym.destroy;
begin begin
case consttyp of case consttyp of
conststring,constresourcestring : conststring,
freemem(pchar(tpointerord(value)),len+1); constresourcestring :
freemem(pchar(valueptr),len+1);
constreal : constreal :
dispose(pbestreal(tpointerord(value))); dispose(pbestreal(valueptr));
constset : constset :
dispose(pnormalset(tpointerord(value))); dispose(pnormalset(valueptr));
end; end;
inherited destroy; inherited destroy;
end; end;
@ -1951,42 +2029,54 @@ implementation
case consttyp of case consttyp of
constnil : ; constnil : ;
constint: constint:
if sizeof(TConstExprInt)=8 then begin
begin if sizeof(TConstExprInt)=8 then
ppufile.putlongint(longint(lo(value))); begin
ppufile.putlongint(longint(hi(value))); ppufile.putlongint(longint(lo(valueord)));
end ppufile.putlongint(longint(hi(valueord)));
else end
ppufile.putlongint(value); else
ppufile.putlongint(valueord);
end;
constbool, constbool,
constchar : constchar :
ppufile.putlongint(value); ppufile.putlongint(valueord);
constpointer,
constord : constord :
begin begin
ppufile.puttype(consttype); ppufile.puttype(consttype);
if sizeof(TConstExprInt)=8 then if sizeof(TConstExprInt)=8 then
begin begin
ppufile.putlongint(longint(lo(value))); ppufile.putlongint(longint(lo(valueord)));
ppufile.putlongint(longint(hi(value))); ppufile.putlongint(longint(hi(valueord)));
end end
else else
ppufile.putlongint(value); ppufile.putlongint(valueord);
end; end;
conststring,constresourcestring : constpointer :
begin
ppufile.puttype(consttype);
if sizeof(TConstPtrUInt)=8 then
begin
ppufile.putlongint(longint(lo(valueordptr)));
ppufile.putlongint(longint(hi(valueordptr)));
end
else
ppufile.putlongint(valueordptr);
end;
conststring,
constresourcestring :
begin begin
ppufile.putlongint(len); ppufile.putlongint(len);
ppufile.putdata(pchar(TPointerOrd(value))^,len); ppufile.putdata(pchar(valueptr)^,len);
if consttyp=constresourcestring then if consttyp=constresourcestring then
ppufile.putlongint(ResStrIndex); ppufile.putlongint(ResStrIndex);
end; end;
constreal : constreal :
ppufile.putreal(pbestreal(TPointerOrd(value))^); ppufile.putreal(pbestreal(valueptr)^);
constset : constset :
begin begin
ppufile.puttype(consttype); ppufile.puttype(consttype);
ppufile.putnormalset(pointer(TPointerOrd(value))^); ppufile.putnormalset(valueptr^);
end; end;
else else
internalerror(13); internalerror(13);
@ -2001,18 +2091,16 @@ implementation
{even GDB v4.16 only now 'i' 'r' and 'e' !!!} {even GDB v4.16 only now 'i' 'r' and 'e' !!!}
case consttyp of case consttyp of
conststring : begin conststring : begin
{ I had to remove ibm2ascii !! } st := 's'''+strpas(pchar(valueptr))+'''';
st := pstring(TPointerOrd(value))^;
{st := ibm2ascii(pstring(value)^);}
st := 's'''+st+'''';
end; end;
constbool, constbool,
constint, constint,
constpointer,
constord, constord,
constchar : st := 'i'+int64tostr(value); constchar : st := 'i'+int64tostr(valueord);
constpointer :
st := 'i'+int64tostr(valueordptr);
constreal : begin constreal : begin
system.str(pbestreal(TPointerOrd(value))^,st); system.str(pbestreal(valueptr)^,st);
st := 'r'+st; st := 'r'+st;
end; end;
{ if we don't know just put zero !! } { if we don't know just put zero !! }
@ -2392,7 +2480,12 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.20 2001-08-30 20:13:54 peter Revision 1.21 2001-09-02 21:18:29 peter
* split constsym.value in valueord,valueordptr,valueptr. The valueordptr
is used for holding target platform pointer values. As those can be
bigger than the source platform.
Revision 1.20 2001/08/30 20:13:54 peter
* rtti/init table updates * rtti/init table updates
* rttisym for reusable global rtti/init info * rttisym for reusable global rtti/init info
* support published for interfaces * support published for interfaces