mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 18:09:27 +02:00
+ constant pointer support which can happend with typecasting like
const p=pointer(1) * better procvar parsing in typed consts
This commit is contained in:
peter
parent
dc7dcdd2a6
commit
2687d75c38
@ -895,6 +895,14 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure second_cord_to_pointer(pto,pfrom : ptree;convtyp : tconverttype);
|
||||
begin
|
||||
{ this can't happend, because constants are already processed in
|
||||
pass 1 }
|
||||
internalerror(47423985);
|
||||
end;
|
||||
|
||||
|
||||
procedure second_int_to_fix(pto,pfrom : ptree;convtyp : tconverttype);
|
||||
var
|
||||
hregister : tregister;
|
||||
@ -1288,7 +1296,8 @@ implementation
|
||||
second_fix_to_real,
|
||||
second_proc_to_procvar,
|
||||
second_nothing, {arrayconstructor_to_set}
|
||||
second_load_smallset
|
||||
second_load_smallset,
|
||||
second_cord_to_pointer
|
||||
);
|
||||
{$ifdef TESTOBJEXT2}
|
||||
var
|
||||
@ -1455,7 +1464,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.88 1999-09-26 13:26:04 florian
|
||||
Revision 1.89 1999-09-26 21:30:15 peter
|
||||
+ constant pointer support which can happend with typecasting like
|
||||
const p=pointer(1)
|
||||
* better procvar parsing in typed consts
|
||||
|
||||
Revision 1.88 1999/09/26 13:26:04 florian
|
||||
* exception patch of Romio nevertheless the excpetion handling
|
||||
needs some corections regarding register saving
|
||||
* gettempansistring is again a procedure
|
||||
|
||||
@ -29,6 +29,7 @@ interface
|
||||
procedure secondrealconst(var p : ptree);
|
||||
procedure secondfixconst(var p : ptree);
|
||||
procedure secondordconst(var p : ptree);
|
||||
procedure secondpointerconst(var p : ptree);
|
||||
procedure secondstringconst(var p : ptree);
|
||||
procedure secondsetconst(var p : ptree);
|
||||
procedure secondniln(var p : ptree);
|
||||
@ -159,6 +160,19 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
SecondPointerConst
|
||||
*****************************************************************************}
|
||||
|
||||
procedure secondpointerconst(var p : ptree);
|
||||
begin
|
||||
{ an integer const. behaves as a memory reference }
|
||||
p^.location.loc:=LOC_MEM;
|
||||
p^.location.reference.is_immediate:=true;
|
||||
p^.location.reference.offset:=p^.value;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
SecondStringConst
|
||||
*****************************************************************************}
|
||||
@ -417,7 +431,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.41 1999-09-20 16:38:52 peter
|
||||
Revision 1.42 1999-09-26 21:30:15 peter
|
||||
+ constant pointer support which can happend with typecasting like
|
||||
const p=pointer(1)
|
||||
* better procvar parsing in typed consts
|
||||
|
||||
Revision 1.41 1999/09/20 16:38:52 peter
|
||||
* cs_create_smart instead of cs_smartlink
|
||||
* -CX is create smartlink
|
||||
* -CD is create dynamic, but does nothing atm.
|
||||
|
||||
@ -313,11 +313,20 @@ implementation
|
||||
orddef :
|
||||
begin
|
||||
{ char constant to zero terminated string constant }
|
||||
if (fromtreetype=ordconstn) and is_equal(def_from,cchardef) and
|
||||
is_pchar(def_to) then
|
||||
if (fromtreetype=ordconstn) then
|
||||
begin
|
||||
doconv:=tc_cchar_2_pchar;
|
||||
b:=1;
|
||||
if is_equal(def_from,cchardef) and
|
||||
is_pchar(def_to) then
|
||||
begin
|
||||
doconv:=tc_cchar_2_pchar;
|
||||
b:=1;
|
||||
end
|
||||
else
|
||||
if is_integer(def_from) then
|
||||
begin
|
||||
doconv:=tc_cord_2_pointer;
|
||||
b:=1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
arraydef :
|
||||
@ -705,7 +714,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.39 1999-09-17 17:14:04 peter
|
||||
Revision 1.40 1999-09-26 21:30:15 peter
|
||||
+ constant pointer support which can happend with typecasting like
|
||||
const p=pointer(1)
|
||||
* better procvar parsing in typed consts
|
||||
|
||||
Revision 1.39 1999/09/17 17:14:04 peter
|
||||
* @procvar fixes for tp mode
|
||||
* @<id>:= gives now an error
|
||||
|
||||
|
||||
@ -231,6 +231,7 @@ implementation
|
||||
firstumminus, {umminusn}
|
||||
firstasm, {asmn}
|
||||
firstvec, {vecn}
|
||||
firstpointerconst, {pointerconstn}
|
||||
firststringconst, {stringconstn}
|
||||
firstfuncret, {funcretn}
|
||||
firstself, {selfn}
|
||||
@ -368,7 +369,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.104 1999-09-11 09:08:31 florian
|
||||
Revision 1.105 1999-09-26 21:30:16 peter
|
||||
+ constant pointer support which can happend with typecasting like
|
||||
const p=pointer(1)
|
||||
* better procvar parsing in typed consts
|
||||
|
||||
Revision 1.104 1999/09/11 09:08:31 florian
|
||||
* fixed bug 596
|
||||
* fixed some problems with procedure variables and procedures of object,
|
||||
especially in TP mode. Procedure of object doesn't apply only to classes,
|
||||
|
||||
@ -214,6 +214,7 @@ implementation
|
||||
secondumminus, {umminusn}
|
||||
secondasm, {asmn}
|
||||
secondvecn, {vecn}
|
||||
secondpointerconst, {pointerconstn}
|
||||
secondstringconst, {stringconstn}
|
||||
secondfuncret, {funcretn}
|
||||
secondselfn, {selfn}
|
||||
@ -696,7 +697,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.38 1999-09-16 23:05:54 florian
|
||||
Revision 1.39 1999-09-26 21:30:17 peter
|
||||
+ constant pointer support which can happend with typecasting like
|
||||
const p=pointer(1)
|
||||
* better procvar parsing in typed consts
|
||||
|
||||
Revision 1.38 1999/09/16 23:05:54 florian
|
||||
* m68k compiler is again compilable (only gas writer, no assembler reader)
|
||||
|
||||
Revision 1.37 1999/09/15 20:35:41 florian
|
||||
|
||||
@ -169,6 +169,10 @@ unit pdecl;
|
||||
ps^:=p^.value_set^;
|
||||
symtablestack^.insert(new(pconstsym,init_def(name,constset,longint(ps),p^.resulttype)));
|
||||
end;
|
||||
pointerconstn :
|
||||
begin
|
||||
symtablestack^.insert(new(pconstsym,init_def(name,constpointer,p^.value,p^.resulttype)))
|
||||
end;
|
||||
niln :
|
||||
begin
|
||||
symtablestack^.insert(new(pconstsym,init_def(name,constnil,0,p^.resulttype)));
|
||||
@ -2536,7 +2540,12 @@ unit pdecl;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.155 1999-09-20 16:38:59 peter
|
||||
Revision 1.156 1999-09-26 21:30:19 peter
|
||||
+ constant pointer support which can happend with typecasting like
|
||||
const p=pointer(1)
|
||||
* better procvar parsing in typed consts
|
||||
|
||||
Revision 1.155 1999/09/20 16:38:59 peter
|
||||
* cs_create_smart instead of cs_smartlink
|
||||
* -CX is create smartlink
|
||||
* -CD is create dynamic, but does nothing atm.
|
||||
|
||||
@ -576,25 +576,37 @@ unit pexpr;
|
||||
afterassignment:=prevafterassn;
|
||||
end;
|
||||
|
||||
procedure handle_procvar(procvar : pprocvardef;var t : ptree);
|
||||
var
|
||||
hp : ptree;
|
||||
procedure handle_procvar(pv : pprocvardef;var p2 : ptree);
|
||||
|
||||
procedure doconv(procvar : pprocvardef;var t : ptree);
|
||||
var
|
||||
hp : ptree;
|
||||
begin
|
||||
hp:=nil;
|
||||
if (proc_to_procvar_equal(pprocsym(t^.symtableentry)^.definition,procvar)) then
|
||||
begin
|
||||
if (po_methodpointer in procvar^.procoptions) then
|
||||
hp:=genloadmethodcallnode(pprocsym(t^.symtableprocentry),t^.symtable,getcopy(t^.methodpointer))
|
||||
else
|
||||
hp:=genloadcallnode(pprocsym(t^.symtableprocentry),t^.symtable);
|
||||
end;
|
||||
if assigned(hp) then
|
||||
begin
|
||||
disposetree(t);
|
||||
t:=hp;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
hp:=nil;
|
||||
if (proc_to_procvar_equal(pprocsym(t^.symtableentry)^.definition,procvar)) then
|
||||
begin
|
||||
if (po_methodpointer in procvar^.procoptions) then
|
||||
hp:=genloadmethodcallnode(pprocsym(t^.symtableprocentry),t^.symtable,getcopy(t^.methodpointer))
|
||||
else
|
||||
hp:=genloadcallnode(pprocsym(t^.symtableprocentry),t^.symtable);
|
||||
end;
|
||||
if assigned(hp) then
|
||||
begin
|
||||
disposetree(t);
|
||||
t:=hp;
|
||||
end;
|
||||
if (p2^.treetype=calln) then
|
||||
doconv(pv,p2)
|
||||
else
|
||||
if (p2^.treetype=typeconvn) and
|
||||
(p2^.left^.treetype=calln) then
|
||||
doconv(pv,p2^.left);
|
||||
end;
|
||||
|
||||
|
||||
{ the following procedure handles the access to a property symbol }
|
||||
procedure handle_propertysym(sym : psym;st : psymtable;var p1 : ptree;
|
||||
var pd : pdef);
|
||||
@ -642,14 +654,7 @@ unit pexpr;
|
||||
getprocvar:=ppropertysym(sym)^.proptype^.deftype=procvardef;
|
||||
p2:=comp_expr(true);
|
||||
if getprocvar then
|
||||
begin
|
||||
if (p2^.treetype=calln) then
|
||||
handle_procvar(pprocvardef(ppropertysym(sym)^.proptype),p2)
|
||||
else
|
||||
if (p2^.treetype=typeconvn) and
|
||||
(p2^.left^.treetype=calln) then
|
||||
handle_procvar(pprocvardef(ppropertysym(sym)^.proptype),p2^.left);
|
||||
end;
|
||||
handle_procvar(pprocvardef(ppropertysym(sym)^.proptype),p2);
|
||||
p1^.left:=gencallparanode(p2,p1^.left);
|
||||
getprocvar:=false;
|
||||
end;
|
||||
@ -784,10 +789,13 @@ unit pexpr;
|
||||
begin
|
||||
p1:=genmethodcallnode(pprocsym(sym),srsymtable,p1);
|
||||
do_proc_call(getaddr or
|
||||
(block_type=bt_const) or
|
||||
(getprocvar and
|
||||
(m_tp_procvar in aktmodeswitches) and
|
||||
proc_to_procvar_equal(pprocsym(sym)^.definition,getprocvardef))
|
||||
,again,p1,pd);
|
||||
if (block_type=bt_const) then
|
||||
handle_procvar(getprocvardef,p1);
|
||||
{ now we know the real method e.g. we can check for a class method }
|
||||
if isclassref and
|
||||
assigned(p1^.procdefinition) and
|
||||
@ -1140,6 +1148,9 @@ unit pexpr;
|
||||
constord :
|
||||
p1:=genordinalconstnode(pconstsym(srsym)^.value,
|
||||
pconstsym(srsym)^.definition);
|
||||
constpointer :
|
||||
p1:=genpointerconstnode(pconstsym(srsym)^.value,
|
||||
pconstsym(srsym)^.definition);
|
||||
constnil :
|
||||
p1:=genzeronode(niln);
|
||||
constresourcestring:
|
||||
@ -1158,10 +1169,13 @@ unit pexpr;
|
||||
p1:=gencallnode(pprocsym(srsym),srsymtable);
|
||||
p1^.unit_specific:=unit_specific;
|
||||
do_proc_call(getaddr or
|
||||
(block_type=bt_const) or
|
||||
(getprocvar and
|
||||
(m_tp_procvar in aktmodeswitches) and
|
||||
proc_to_procvar_equal(pprocsym(srsym)^.definition,getprocvardef)),
|
||||
again,p1,pd);
|
||||
if (block_type=bt_const) then
|
||||
handle_procvar(getprocvardef,p1);
|
||||
if possible_error and
|
||||
not(po_classmethod in p1^.procdefinition^.procoptions) then
|
||||
Message(parser_e_only_class_methods);
|
||||
@ -2008,15 +2022,7 @@ _LECKKLAMMER : begin
|
||||
end;
|
||||
p2:=sub_expr(opcompare,true);
|
||||
if getprocvar then
|
||||
begin
|
||||
if (p2^.treetype=calln) then
|
||||
handle_procvar(getprocvardef,p2)
|
||||
else
|
||||
{ also allow p:= proc(t); !! (PM) }
|
||||
if (p2^.treetype=typeconvn) and
|
||||
(p2^.left^.treetype=calln) then
|
||||
handle_procvar(getprocvardef,p2^.left);
|
||||
end;
|
||||
handle_procvar(getprocvardef,p2);
|
||||
getprocvar:=false;
|
||||
p1:=gennode(assignn,p1,p2);
|
||||
end;
|
||||
@ -2100,7 +2106,12 @@ _LECKKLAMMER : begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.143 1999-09-15 20:35:41 florian
|
||||
Revision 1.144 1999-09-26 21:30:19 peter
|
||||
+ constant pointer support which can happend with typecasting like
|
||||
const p=pointer(1)
|
||||
* better procvar parsing in typed consts
|
||||
|
||||
Revision 1.143 1999/09/15 20:35:41 florian
|
||||
* small fix to operator overloading when in MMX mode
|
||||
+ the compiler uses now fldz and fld1 if possible
|
||||
+ some fixes to floating point registers
|
||||
|
||||
@ -58,11 +58,10 @@ unit ptconst;
|
||||
i,l,offset,
|
||||
strlength : longint;
|
||||
curconstsegment : paasmoutput;
|
||||
ll : pasmlabel;
|
||||
s : string;
|
||||
ca : pchar;
|
||||
ll : pasmlabel;
|
||||
s : string;
|
||||
ca : pchar;
|
||||
aktpos : longint;
|
||||
pd : pprocdef;
|
||||
obj : pobjectdef;
|
||||
symt : psymtable;
|
||||
value : bestreal;
|
||||
@ -560,25 +559,66 @@ unit ptconst;
|
||||
if not(m_tp_procvar in aktmodeswitches) then
|
||||
if token=_KLAMMERAFFE then
|
||||
consume(_KLAMMERAFFE);
|
||||
getsym(pattern,true);
|
||||
consume(_ID);
|
||||
if srsym^.typ=unitsym then
|
||||
begin
|
||||
consume(_POINT);
|
||||
getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
|
||||
consume(_ID);
|
||||
end;
|
||||
if srsym^.typ<>procsym then
|
||||
Message(cg_e_illegal_expression)
|
||||
getprocvar:=true;
|
||||
getprocvardef:=pprocvardef(def);
|
||||
p:=comp_expr(true);
|
||||
getprocvar:=false;
|
||||
do_firstpass(p);
|
||||
if codegenerror then
|
||||
begin
|
||||
disposetree(p);
|
||||
exit;
|
||||
end;
|
||||
{ convert calln to loadn }
|
||||
if p^.treetype=calln then
|
||||
begin
|
||||
if (p^.symtableprocentry^.owner^.symtabletype=objectsymtable) and
|
||||
(pobjectdef(p^.symtableprocentry^.owner^.defowner)^.is_class) then
|
||||
hp:=genloadmethodcallnode(pprocsym(p^.symtableprocentry),p^.symtableproc,
|
||||
getcopy(p^.methodpointer))
|
||||
else
|
||||
hp:=genloadcallnode(pprocsym(p^.symtableprocentry),p^.symtableproc);
|
||||
disposetree(p);
|
||||
do_firstpass(hp);
|
||||
p:=hp;
|
||||
if codegenerror then
|
||||
begin
|
||||
disposetree(p);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
{ let type conversion check everything needed }
|
||||
p:=gentypeconvnode(p,def);
|
||||
do_firstpass(p);
|
||||
if codegenerror then
|
||||
begin
|
||||
disposetree(p);
|
||||
exit;
|
||||
end;
|
||||
{ remove typeconvn, that will normally insert a lea
|
||||
instruction which is not necessary for us }
|
||||
if p^.treetype=typeconvn then
|
||||
begin
|
||||
hp:=p^.left;
|
||||
putnode(p);
|
||||
p:=hp;
|
||||
end;
|
||||
{ remove addrn which we also don't need here }
|
||||
if p^.treetype=addrn then
|
||||
begin
|
||||
hp:=p^.left;
|
||||
putnode(p);
|
||||
p:=hp;
|
||||
end;
|
||||
{ we now need to have a loadn with a procsym }
|
||||
if (p^.treetype=loadn) and
|
||||
(p^.symtableentry^.typ=procsym) then
|
||||
begin
|
||||
curconstsegment^.concat(new(pai_const_symbol,
|
||||
initname(pprocsym(p^.symtableentry)^.definition^.mangledname)));
|
||||
end
|
||||
else
|
||||
begin
|
||||
pd:=pprocsym(srsym)^.definition;
|
||||
if assigned(pd^.nextoverloaded) then
|
||||
Message(parser_e_no_overloaded_procvars);
|
||||
if not proc_to_procvar_equal(pd,pprocvardef(def)) then
|
||||
Message2(type_e_incompatible_types,pd^.typename,pprocvardef(def)^.typename);
|
||||
curconstsegment^.concat(new(pai_const_symbol,initname(pd^.mangledname)));
|
||||
end;
|
||||
Message(cg_e_illegal_expression);
|
||||
end;
|
||||
{ reads a typed constant record }
|
||||
recorddef:
|
||||
@ -700,7 +740,12 @@ unit ptconst;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.52 1999-08-10 12:30:02 pierre
|
||||
Revision 1.53 1999-09-26 21:30:20 peter
|
||||
+ constant pointer support which can happend with typecasting like
|
||||
const p=pointer(1)
|
||||
* better procvar parsing in typed consts
|
||||
|
||||
Revision 1.52 1999/08/10 12:30:02 pierre
|
||||
* avoid unused locals
|
||||
|
||||
Revision 1.51 1999/08/04 13:03:02 jonas
|
||||
|
||||
@ -3088,7 +3088,8 @@ Const local_symtable_index : longint = $8001;
|
||||
function tprocvardef.gettypename : string;
|
||||
|
||||
begin
|
||||
if assigned(retdef) then
|
||||
if assigned(retdef) and
|
||||
(retdef<>pdef(voiddef)) then
|
||||
gettypename:='<procedure variable type of function'+demangled_paras+':'+retdef^.gettypename+'>'
|
||||
else
|
||||
gettypename:='<procedure variable type of procedure'+demangled_paras+'>';
|
||||
@ -3778,7 +3779,12 @@ Const local_symtable_index : longint = $8001;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.165 1999-09-20 16:39:02 peter
|
||||
Revision 1.166 1999-09-26 21:30:21 peter
|
||||
+ constant pointer support which can happend with typecasting like
|
||||
const p=pointer(1)
|
||||
* better procvar parsing in typed consts
|
||||
|
||||
Revision 1.165 1999/09/20 16:39:02 peter
|
||||
* cs_create_smart instead of cs_smartlink
|
||||
* -CX is create smartlink
|
||||
* -CD is create dynamic, but does nothing atm.
|
||||
|
||||
@ -1673,7 +1673,9 @@
|
||||
case consttype of
|
||||
constint,
|
||||
constbool,
|
||||
constchar : value:=readlong;
|
||||
constchar :
|
||||
value:=readlong;
|
||||
constpointer,
|
||||
constord :
|
||||
begin
|
||||
definition:=readdefref;
|
||||
@ -1729,7 +1731,7 @@
|
||||
|
||||
procedure tconstsym.deref;
|
||||
begin
|
||||
if consttype in [constord,constset] then
|
||||
if consttype in [constord,constpointer,constset] then
|
||||
resolvedef(pdef(definition));
|
||||
end;
|
||||
|
||||
@ -1744,6 +1746,7 @@
|
||||
constbool,
|
||||
constchar :
|
||||
writelong(value);
|
||||
constpointer,
|
||||
constord :
|
||||
begin
|
||||
writedefref(definition);
|
||||
@ -1781,7 +1784,11 @@
|
||||
{st := ibm2ascii(pstring(value)^);}
|
||||
st := 's'''+st+'''';
|
||||
end;
|
||||
constbool, constint, constord, constchar : st := 'i'+tostr(value);
|
||||
constbool,
|
||||
constint,
|
||||
constpointer,
|
||||
constord,
|
||||
constchar : st := 'i'+tostr(value);
|
||||
constreal : begin
|
||||
system.str(pbestreal(value)^,st);
|
||||
st := 'r'+st;
|
||||
@ -2157,7 +2164,12 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.118 1999-09-20 16:39:03 peter
|
||||
Revision 1.119 1999-09-26 21:30:22 peter
|
||||
+ constant pointer support which can happend with typecasting like
|
||||
const p=pointer(1)
|
||||
* better procvar parsing in typed consts
|
||||
|
||||
Revision 1.118 1999/09/20 16:39:03 peter
|
||||
* cs_create_smart instead of cs_smartlink
|
||||
* -CX is create smartlink
|
||||
* -CD is create dynamic, but does nothing atm.
|
||||
|
||||
@ -281,7 +281,7 @@
|
||||
end;
|
||||
|
||||
tconsttype = (constord,conststring,constreal,constbool,
|
||||
constint,constchar,constset,constnil,
|
||||
constint,constchar,constset,constpointer,constnil,
|
||||
constresourcestring);
|
||||
|
||||
pconstsym = ^tconstsym;
|
||||
@ -338,7 +338,12 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.34 1999-08-31 15:42:26 pierre
|
||||
Revision 1.35 1999-09-26 21:30:22 peter
|
||||
+ constant pointer support which can happend with typecasting like
|
||||
const p=pointer(1)
|
||||
* better procvar parsing in typed consts
|
||||
|
||||
Revision 1.34 1999/08/31 15:42:26 pierre
|
||||
+ tmacrosym is_used and defined_at_startup boolean fields added
|
||||
|
||||
Revision 1.33 1999/08/23 11:45:45 michael
|
||||
|
||||
@ -505,6 +505,23 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure first_cord_to_pointer(var p : ptree);
|
||||
var
|
||||
t : ptree;
|
||||
begin
|
||||
if p^.left^.treetype=ordconstn then
|
||||
begin
|
||||
t:=genpointerconstnode(p^.left^.value,p^.resulttype);
|
||||
firstpass(t);
|
||||
disposetree(p);
|
||||
p:=t;
|
||||
exit;
|
||||
end
|
||||
else
|
||||
internalerror(432472389);
|
||||
end;
|
||||
|
||||
|
||||
procedure first_pchar_to_string(var p : ptree);
|
||||
begin
|
||||
p^.location.loc:=LOC_REFERENCE;
|
||||
@ -565,7 +582,8 @@ implementation
|
||||
first_fix_to_real,
|
||||
first_proc_to_procvar,
|
||||
first_arrayconstructor_to_set,
|
||||
first_load_smallset
|
||||
first_load_smallset,
|
||||
first_cord_to_pointer
|
||||
);
|
||||
begin
|
||||
aprocdef:=nil;
|
||||
@ -944,7 +962,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.48 1999-09-17 17:14:12 peter
|
||||
Revision 1.49 1999-09-26 21:30:22 peter
|
||||
+ constant pointer support which can happend with typecasting like
|
||||
const p=pointer(1)
|
||||
* better procvar parsing in typed consts
|
||||
|
||||
Revision 1.48 1999/09/17 17:14:12 peter
|
||||
* @procvar fixes for tp mode
|
||||
* @<id>:= gives now an error
|
||||
|
||||
|
||||
@ -29,6 +29,7 @@ interface
|
||||
procedure firstrealconst(var p : ptree);
|
||||
procedure firstfixconst(var p : ptree);
|
||||
procedure firstordconst(var p : ptree);
|
||||
procedure firstpointerconst(var p : ptree);
|
||||
procedure firststringconst(var p : ptree);
|
||||
procedure firstsetconst(var p : ptree);
|
||||
procedure firstniln(var p : ptree);
|
||||
@ -77,6 +78,16 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
FirstPointerConst
|
||||
*****************************************************************************}
|
||||
|
||||
procedure firstpointerconst(var p : ptree);
|
||||
begin
|
||||
p^.location.loc:=LOC_MEM;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
FirstStringConst
|
||||
*****************************************************************************}
|
||||
@ -125,7 +136,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 1999-09-04 20:52:07 florian
|
||||
Revision 1.10 1999-09-26 21:30:22 peter
|
||||
+ constant pointer support which can happend with typecasting like
|
||||
const p=pointer(1)
|
||||
* better procvar parsing in typed consts
|
||||
|
||||
Revision 1.9 1999/09/04 20:52:07 florian
|
||||
* bug 580 fixed
|
||||
|
||||
Revision 1.8 1999/08/04 00:23:38 florian
|
||||
|
||||
@ -71,6 +71,7 @@ unit tree;
|
||||
umminusn, {Represents a sign change (i.e. -2).}
|
||||
asmn, {Represents an assembler node }
|
||||
vecn, {Represents array indexing.}
|
||||
pointerconstn,
|
||||
stringconstn, {Represents a string constant.}
|
||||
funcretn, {Represents the function result var.}
|
||||
selfn, {Represents the self parameter.}
|
||||
@ -143,7 +144,8 @@ unit tree;
|
||||
tc_fix_2_real,
|
||||
tc_proc_2_procvar,
|
||||
tc_arrayconstructor_2_set,
|
||||
tc_load_smallset
|
||||
tc_load_smallset,
|
||||
tc_cord_2_pointer
|
||||
);
|
||||
|
||||
{ allows to determine which elementes are to be replaced }
|
||||
@ -248,6 +250,7 @@ unit tree;
|
||||
function gensinglenode(t : ttreetyp;l : ptree) : ptree;
|
||||
function gensubscriptnode(varsym : pvarsym;l : ptree) : ptree;
|
||||
function genordinalconstnode(v : longint;def : pdef) : ptree;
|
||||
function genpointerconstnode(v : longint;def : pdef) : ptree;
|
||||
function genfixconstnode(v : longint;def : pdef) : ptree;
|
||||
function gentypeconvnode(node : ptree;t : pdef) : ptree;
|
||||
function gentypenode(t : pdef;sym:ptypesym) : ptree;
|
||||
@ -772,6 +775,27 @@ unit tree;
|
||||
genordinalconstnode:=p;
|
||||
end;
|
||||
|
||||
function genpointerconstnode(v : longint;def : pdef) : ptree;
|
||||
|
||||
var
|
||||
p : ptree;
|
||||
|
||||
begin
|
||||
p:=getnode;
|
||||
p^.disposetyp:=dt_nothing;
|
||||
p^.treetype:=pointerconstn;
|
||||
p^.registers32:=0;
|
||||
{ p^.registers16:=0;
|
||||
p^.registers8:=0; }
|
||||
p^.registersfpu:=0;
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p^.registersmmx:=0;
|
||||
{$endif SUPPORT_MMX}
|
||||
p^.resulttype:=def;
|
||||
p^.value:=v;
|
||||
genpointerconstnode:=p;
|
||||
end;
|
||||
|
||||
function genenumnode(v : penumsym) : ptree;
|
||||
|
||||
var
|
||||
@ -1766,7 +1790,12 @@ unit tree;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.97 1999-09-17 17:14:13 peter
|
||||
Revision 1.98 1999-09-26 21:30:22 peter
|
||||
+ constant pointer support which can happend with typecasting like
|
||||
const p=pointer(1)
|
||||
* better procvar parsing in typed consts
|
||||
|
||||
Revision 1.97 1999/09/17 17:14:13 peter
|
||||
* @procvar fixes for tp mode
|
||||
* @<id>:= gives now an error
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user