mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-15 14:19:28 +02:00
* add pinline unit that inserts compiler supported functions using
one or more statements * moved finalize and setlength from ninl to pinline
This commit is contained in:
peter
parent
451532aaed
commit
67ede1276b
@ -59,16 +59,11 @@ implementation
|
||||
addsubop:array[in_inc_x..in_dec_x] of TOpCG=(OP_ADD,OP_SUB);
|
||||
var
|
||||
asmop : tasmop;
|
||||
pushed : tpushedsaved;
|
||||
{inc/dec}
|
||||
addconstant : boolean;
|
||||
addvalue : longint;
|
||||
hp : tnode;
|
||||
|
||||
var
|
||||
href,href2 : treference;
|
||||
href : treference;
|
||||
hp2 : tstringconstnode;
|
||||
dummycoll : tparaitem;
|
||||
l : longint;
|
||||
ispushed : boolean;
|
||||
hregisterhi,
|
||||
@ -76,7 +71,6 @@ implementation
|
||||
lengthlab,
|
||||
otlabel,oflabel{,l1} : tasmlabel;
|
||||
oldpushedparasize : longint;
|
||||
def : tdef;
|
||||
cgop : TOpCG;
|
||||
cgsize : TCGSize;
|
||||
begin
|
||||
@ -276,36 +270,6 @@ implementation
|
||||
emit_ref_reg(A_LEA,S_L,href,location.register);
|
||||
end;
|
||||
|
||||
in_finalize_x:
|
||||
begin
|
||||
rg.saveusedregisters(exprasmlist,pushed,all_registers);
|
||||
{ if a count is passed, push size, typeinfo and count }
|
||||
if assigned(tcallparanode(left).right) then
|
||||
begin
|
||||
secondpass(tcallparanode(tcallparanode(left).right).left);
|
||||
push_int(tcallparanode(left).left.resulttype.def.size);
|
||||
if codegenerror then
|
||||
exit;
|
||||
cg.a_param_loc(exprasmlist,tcallparanode(tcallparanode(left).right).left.location,1);
|
||||
end;
|
||||
|
||||
{ generate a reference }
|
||||
reference_reset_symbol(href,tstoreddef(ttypenode(tcallparanode(left).left).resulttype.def).get_rtti_label(initrtti),0);
|
||||
emitpushreferenceaddr(href);
|
||||
|
||||
{ data to finalize }
|
||||
secondpass(tcallparanode(left).left);
|
||||
if codegenerror then
|
||||
exit;
|
||||
emitpushreferenceaddr(tcallparanode(left).left.location.reference);
|
||||
rg.saveregvars(exprasmlist,all_registers);
|
||||
if assigned(tcallparanode(left).right) then
|
||||
emitcall('FPC_FINALIZEARRAY')
|
||||
else
|
||||
emitcall('FPC_FINALIZE');
|
||||
rg.restoreusedregisters(exprasmlist,pushed);
|
||||
end;
|
||||
|
||||
in_assigned_x :
|
||||
begin
|
||||
secondpass(tcallparanode(left).left);
|
||||
@ -323,93 +287,6 @@ implementation
|
||||
location_reset(location,LOC_FLAGS,OS_NO);
|
||||
location.resflags:=F_NE;
|
||||
end;
|
||||
in_setlength_x:
|
||||
begin
|
||||
rg.saveusedregisters(exprasmlist,pushed,all_registers);
|
||||
l:=0;
|
||||
{ push dimensions }
|
||||
hp:=left;
|
||||
while assigned(tcallparanode(hp).right) do
|
||||
begin
|
||||
inc(l);
|
||||
hp:=tcallparanode(hp).right;
|
||||
end;
|
||||
def:=tcallparanode(hp).left.resulttype.def;
|
||||
hp:=left;
|
||||
if is_dynamic_array(def) then
|
||||
begin
|
||||
{ get temp. space }
|
||||
tg.gettempofsizereference(exprasmlist,l*4,href);
|
||||
{ keep data start }
|
||||
href2:=href;
|
||||
{ copy dimensions }
|
||||
hp:=left;
|
||||
while assigned(tcallparanode(hp).right) do
|
||||
begin
|
||||
secondpass(tcallparanode(hp).left);
|
||||
location_release(exprasmlist,tcallparanode(hp).left.location);
|
||||
cg.a_load_loc_ref(exprasmlist,tcallparanode(hp).left.location,href);
|
||||
inc(href.offset,4);
|
||||
hp:=tcallparanode(hp).right;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
secondpass(tcallparanode(hp).left);
|
||||
cg.a_param_loc(exprasmlist,tcallparanode(hp).left.location,1);
|
||||
hp:=tcallparanode(hp).right;
|
||||
end;
|
||||
{ handle shortstrings separately since the hightree must be }
|
||||
{ pushed too (JM) }
|
||||
if not(is_dynamic_array(def)) and
|
||||
(tstringdef(def).string_typ = st_shortstring) then
|
||||
begin
|
||||
dummycoll:=TParaItem.Create;
|
||||
dummycoll.paratyp:=vs_var;
|
||||
dummycoll.paratype:=openshortstringtype;
|
||||
tcallparanode(hp).secondcallparan(dummycoll,false,false,false,0,0);
|
||||
dummycoll.free;
|
||||
if codegenerror then
|
||||
exit;
|
||||
end
|
||||
else secondpass(tcallparanode(hp).left);
|
||||
if is_dynamic_array(def) then
|
||||
begin
|
||||
emitpushreferenceaddr(href2);
|
||||
push_int(l);
|
||||
reference_reset_symbol(href2,tstoreddef(def).get_rtti_label(initrtti),0);
|
||||
emitpushreferenceaddr(href2);
|
||||
emitpushreferenceaddr(tcallparanode(hp).left.location.reference);
|
||||
rg.saveregvars(exprasmlist,all_registers);
|
||||
emitcall('FPC_DYNARR_SETLENGTH');
|
||||
tg.ungetiftemp(exprasmlist,href);
|
||||
end
|
||||
else
|
||||
{ must be string }
|
||||
begin
|
||||
case tstringdef(def).string_typ of
|
||||
st_widestring:
|
||||
begin
|
||||
emitpushreferenceaddr(tcallparanode(hp).left.location.reference);
|
||||
rg.saveregvars(exprasmlist,all_registers);
|
||||
emitcall('FPC_WIDESTR_SETLENGTH');
|
||||
end;
|
||||
st_ansistring:
|
||||
begin
|
||||
emitpushreferenceaddr(tcallparanode(hp).left.location.reference);
|
||||
rg.saveregvars(exprasmlist,all_registers);
|
||||
emitcall('FPC_ANSISTR_SETLENGTH');
|
||||
end;
|
||||
st_shortstring:
|
||||
begin
|
||||
rg.saveregvars(exprasmlist,all_registers);
|
||||
emitcall('FPC_SHORTSTR_SETLENGTH');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
rg.restoreusedregisters(exprasmlist,pushed);
|
||||
maybe_loadself;
|
||||
end;
|
||||
in_include_x_y,
|
||||
in_exclude_x_y:
|
||||
begin
|
||||
@ -591,7 +468,12 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.38 2002-04-21 15:35:54 carl
|
||||
Revision 1.39 2002-04-23 19:16:35 peter
|
||||
* add pinline unit that inserts compiler supported functions using
|
||||
one or more statements
|
||||
* moved finalize and setlength from ninl to pinline
|
||||
|
||||
Revision 1.38 2002/04/21 15:35:54 carl
|
||||
* changeregsize -> rg.makeregsize
|
||||
|
||||
Revision 1.37 2002/04/19 15:39:35 peter
|
||||
|
||||
@ -1052,7 +1052,7 @@ implementation
|
||||
|
||||
{ create the call to the concat routine both strings as arguments }
|
||||
result := ccallnode.createintern('fpc_'+
|
||||
lower(tstringdef(resulttype.def).stringtypname)+'_concat',
|
||||
tstringdef(resulttype.def).stringtypname+'_concat',
|
||||
ccallparanode.create(right,ccallparanode.create(left,nil)));
|
||||
{ we reused the arguments }
|
||||
left := nil;
|
||||
@ -1097,7 +1097,7 @@ implementation
|
||||
end;
|
||||
{ no string constant -> call compare routine }
|
||||
result := ccallnode.createintern('fpc_'+
|
||||
lower(tstringdef(left.resulttype.def).stringtypname)+'_compare',
|
||||
tstringdef(left.resulttype.def).stringtypname+'_compare',
|
||||
ccallparanode.create(right,ccallparanode.create(left,nil)));
|
||||
{ and compare its result with 0 according to the original operator }
|
||||
result := caddnode.create(nodetype,result,
|
||||
@ -1601,7 +1601,12 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.45 2002-04-04 19:05:56 peter
|
||||
Revision 1.46 2002-04-23 19:16:34 peter
|
||||
* add pinline unit that inserts compiler supported functions using
|
||||
one or more statements
|
||||
* moved finalize and setlength from ninl to pinline
|
||||
|
||||
Revision 1.45 2002/04/04 19:05:56 peter
|
||||
* removed unused units
|
||||
* use tlocation.size in cg.a_*loc*() routines
|
||||
|
||||
|
||||
@ -109,12 +109,14 @@ interface
|
||||
{ a node which is a reference to a certain temp }
|
||||
ttemprefnode = class(tnode)
|
||||
constructor create(const temp: ttempcreatenode); virtual;
|
||||
constructor create_offset(const temp: ttempcreatenode;aoffset:longint);
|
||||
function getcopy: tnode; override;
|
||||
function pass_1 : tnode; override;
|
||||
function det_resulttype : tnode; override;
|
||||
function docompare(p: tnode): boolean; override;
|
||||
protected
|
||||
tempinfo: ptempinfo;
|
||||
offset : longint;
|
||||
end;
|
||||
ttemprefnodeclass = class of ttemprefnode;
|
||||
|
||||
@ -543,6 +545,13 @@ implementation
|
||||
begin
|
||||
inherited create(temprefn);
|
||||
tempinfo := temp.tempinfo;
|
||||
offset:=0;
|
||||
end;
|
||||
|
||||
constructor ttemprefnode.create_offset(const temp: ttempcreatenode;aoffset:longint);
|
||||
begin
|
||||
self.create(temp);
|
||||
offset := aoffset;
|
||||
end;
|
||||
|
||||
function ttemprefnode.getcopy: tnode;
|
||||
@ -570,6 +579,7 @@ implementation
|
||||
|
||||
function ttemprefnode.pass_1 : tnode;
|
||||
begin
|
||||
location.loc:=LOC_REFERENCE;
|
||||
result := nil;
|
||||
end;
|
||||
|
||||
@ -665,7 +675,12 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.21 2002-04-21 19:02:03 peter
|
||||
Revision 1.22 2002-04-23 19:16:34 peter
|
||||
* add pinline unit that inserts compiler supported functions using
|
||||
one or more statements
|
||||
* moved finalize and setlength from ninl to pinline
|
||||
|
||||
Revision 1.21 2002/04/21 19:02:03 peter
|
||||
* removed newn and disposen nodes, the code is now directly
|
||||
inlined from pexpr
|
||||
* -an option that will write the secondpass nodes to the .s file, this
|
||||
|
||||
@ -263,6 +263,7 @@ interface
|
||||
{ set the temp's location }
|
||||
location_reset(location,LOC_REFERENCE,def_cgsize(tempinfo^.restype.def));
|
||||
location.reference := tempinfo^.ref;
|
||||
inc(location.reference.offset,offset);
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
@ -289,7 +290,12 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 2002-04-21 19:02:03 peter
|
||||
Revision 1.14 2002-04-23 19:16:34 peter
|
||||
* add pinline unit that inserts compiler supported functions using
|
||||
one or more statements
|
||||
* moved finalize and setlength from ninl to pinline
|
||||
|
||||
Revision 1.13 2002/04/21 19:02:03 peter
|
||||
* removed newn and disposen nodes, the code is now directly
|
||||
inlined from pexpr
|
||||
* -an option that will write the secondpass nodes to the .s file, this
|
||||
|
||||
@ -36,6 +36,7 @@ interface
|
||||
totype : ttype;
|
||||
convtype : tconverttype;
|
||||
constructor create(node : tnode;const t : ttype);virtual;
|
||||
constructor create_explicit(node : tnode;const t : ttype);
|
||||
function getcopy : tnode;override;
|
||||
function pass_1 : tnode;override;
|
||||
function det_resulttype:tnode;override;
|
||||
@ -410,6 +411,14 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
constructor ttypeconvnode.create_explicit(node : tnode;const t:ttype);
|
||||
|
||||
begin
|
||||
self.create(node,t);
|
||||
toggleflag(nf_explizit);
|
||||
end;
|
||||
|
||||
|
||||
function ttypeconvnode.getcopy : tnode;
|
||||
|
||||
var
|
||||
@ -458,7 +467,7 @@ implementation
|
||||
|
||||
begin
|
||||
result := ccallnode.createinternres(
|
||||
'fpc_chararray_to_'+lower(tstringdef(resulttype.def).stringtypname),
|
||||
'fpc_chararray_to_'+tstringdef(resulttype.def).stringtypname,
|
||||
ccallparanode.create(left,nil),resulttype);
|
||||
left := nil;
|
||||
end;
|
||||
@ -485,7 +494,7 @@ implementation
|
||||
exit;
|
||||
end;
|
||||
result := ccallnode.createinternres(
|
||||
'fpc_'+lower(tstringdef(left.resulttype.def).stringtypname)+
|
||||
'fpc_'+tstringdef(left.resulttype.def).stringtypname+
|
||||
'_to_chararray',ccallparanode.create(left,ccallparanode.create(
|
||||
cordconstnode.create(arrsize,s32bittype),nil)),resulttype);
|
||||
left := nil;
|
||||
@ -532,9 +541,8 @@ implementation
|
||||
else
|
||||
begin
|
||||
{ get the correct procedure name }
|
||||
procname := 'fpc_'+
|
||||
lower(tstringdef(left.resulttype.def).stringtypname+
|
||||
'_to_'+tstringdef(resulttype.def).stringtypname);
|
||||
procname := 'fpc_'+tstringdef(left.resulttype.def).stringtypname+
|
||||
'_to_'+tstringdef(resulttype.def).stringtypname;
|
||||
|
||||
{ create parameter (and remove left node from typeconvnode }
|
||||
{ since it's reused as parameter) }
|
||||
@ -585,8 +593,7 @@ implementation
|
||||
left := nil;
|
||||
|
||||
{ and the procname }
|
||||
procname := 'fpc_char_to_' +
|
||||
lower(tstringdef(resulttype.def).stringtypname);
|
||||
procname := 'fpc_char_to_' +tstringdef(resulttype.def).stringtypname;
|
||||
|
||||
{ and finally the call }
|
||||
result := ccallnode.createinternres(procname,para,resulttype);
|
||||
@ -734,7 +741,7 @@ implementation
|
||||
|
||||
begin
|
||||
result := ccallnode.createinternres(
|
||||
'fpc_pchar_to_'+lower(tstringdef(resulttype.def).stringtypname),
|
||||
'fpc_pchar_to_'+tstringdef(resulttype.def).stringtypname,
|
||||
ccallparanode.create(left,nil),resulttype);
|
||||
left := nil;
|
||||
end;
|
||||
@ -1705,7 +1712,12 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.52 2002-04-21 19:02:03 peter
|
||||
Revision 1.53 2002-04-23 19:16:34 peter
|
||||
* add pinline unit that inserts compiler supported functions using
|
||||
one or more statements
|
||||
* moved finalize and setlength from ninl to pinline
|
||||
|
||||
Revision 1.52 2002/04/21 19:02:03 peter
|
||||
* removed newn and disposen nodes, the code is now directly
|
||||
inlined from pexpr
|
||||
* -an option that will write the secondpass nodes to the .s file, this
|
||||
|
||||
@ -201,7 +201,7 @@ implementation
|
||||
left := nil;
|
||||
|
||||
{ create procedure name }
|
||||
procname := 'fpc_' + lower(tstringdef(dest.resulttype.def).stringtypname)+'_';
|
||||
procname := 'fpc_' + tstringdef(dest.resulttype.def).stringtypname+'_';
|
||||
if is_real then
|
||||
procname := procname + 'float'
|
||||
else
|
||||
@ -543,7 +543,7 @@ implementation
|
||||
case para.left.resulttype.def.deftype of
|
||||
stringdef :
|
||||
begin
|
||||
name := procprefix+lower(tstringdef(para.left.resulttype.def).stringtypname);
|
||||
name := procprefix+tstringdef(para.left.resulttype.def).stringtypname;
|
||||
end;
|
||||
pointerdef :
|
||||
begin
|
||||
@ -941,7 +941,7 @@ implementation
|
||||
{ play a trick to have tcallnode handle invalid source parameters: }
|
||||
{ the shortstring-longint val routine by default }
|
||||
if (sourcepara.resulttype.def.deftype = stringdef) then
|
||||
procname := procname + lower(tstringdef(sourcepara.resulttype.def).stringtypname)
|
||||
procname := procname + tstringdef(sourcepara.resulttype.def).stringtypname
|
||||
else procname := procname + 'shortstr';
|
||||
|
||||
{ set up the correct parameters for the call: the code para... }
|
||||
@ -1070,14 +1070,10 @@ implementation
|
||||
end;
|
||||
|
||||
var
|
||||
counter : longint;
|
||||
ppn : tcallparanode;
|
||||
dummycoll : tparaitem;
|
||||
vl,vl2 : longint;
|
||||
vr : bestreal;
|
||||
hp : tnode;
|
||||
srsym : tsym;
|
||||
def : tdef;
|
||||
isreal : boolean;
|
||||
label
|
||||
myexit;
|
||||
@ -1573,81 +1569,11 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
in_finalize_x,
|
||||
in_setlength_x:
|
||||
begin
|
||||
resulttype:=voidtype;
|
||||
if assigned(left) then
|
||||
begin
|
||||
ppn:=tcallparanode(left);
|
||||
counter:=0;
|
||||
{ check type }
|
||||
while assigned(ppn.right) do
|
||||
begin
|
||||
set_varstate(ppn.left,true);
|
||||
inserttypeconv(ppn.left,s32bittype);
|
||||
inc(counter);
|
||||
ppn:=tcallparanode(ppn.right);
|
||||
end;
|
||||
{ last param must be var }
|
||||
valid_for_var(ppn.left);
|
||||
set_varstate(ppn.left,false);
|
||||
{ first param must be a string or dynamic array ...}
|
||||
if not((ppn.left.resulttype.def.deftype=stringdef) or
|
||||
(is_dynamic_array(ppn.left.resulttype.def))) then
|
||||
CGMessage(type_e_mismatch);
|
||||
|
||||
{ only dynamic arrays accept more dimensions }
|
||||
if (counter>1) then
|
||||
if (not(is_dynamic_array(ppn.left.resulttype.def))) then
|
||||
CGMessage(type_e_mismatch)
|
||||
else
|
||||
{ check if the amount of dimensions is valid }
|
||||
begin
|
||||
def := tarraydef(ppn.left.resulttype.def).elementtype.def;
|
||||
while counter > 1 do
|
||||
begin
|
||||
if not(is_dynamic_array(def)) then
|
||||
begin
|
||||
CGMessage(parser_e_wrong_parameter_size);
|
||||
break;
|
||||
end;
|
||||
dec(counter);
|
||||
def := tarraydef(def).elementtype.def;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ convert shortstrings to openstring parameters }
|
||||
{ (generate the hightree) (JM) }
|
||||
if (ppn.left.resulttype.def.deftype = stringdef) and
|
||||
(tstringdef(ppn.left.resulttype.def).string_typ =
|
||||
st_shortstring) then
|
||||
begin
|
||||
dummycoll:=tparaitem.create;
|
||||
dummycoll.paratyp:=vs_var;
|
||||
dummycoll.paratype:=openshortstringtype;
|
||||
tcallparanode(ppn).insert_typeconv(dummycoll,false);
|
||||
dummycoll.destroy;
|
||||
end;
|
||||
end
|
||||
else
|
||||
CGMessage(type_e_mismatch);
|
||||
end;
|
||||
|
||||
in_finalize_x:
|
||||
begin
|
||||
resulttype:=voidtype;
|
||||
if assigned(left) and assigned(tcallparanode(left).left) then
|
||||
begin
|
||||
{ first param must be var }
|
||||
valid_for_var(tcallparanode(left).left);
|
||||
set_varstate(tcallparanode(left).left,true);
|
||||
|
||||
{ two parameters?, the last parameter must be a longint }
|
||||
if assigned(tcallparanode(left).right) then
|
||||
inserttypeconv(tcallparanode(tcallparanode(left).right).left,s32bittype);
|
||||
end
|
||||
else
|
||||
CGMessage(type_e_mismatch);
|
||||
{ inlined from pinline }
|
||||
internalerror(200204231);
|
||||
end;
|
||||
|
||||
in_inc_x,
|
||||
@ -2341,7 +2267,12 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.71 2002-04-02 17:11:29 peter
|
||||
Revision 1.72 2002-04-23 19:16:34 peter
|
||||
* add pinline unit that inserts compiler supported functions using
|
||||
one or more statements
|
||||
* moved finalize and setlength from ninl to pinline
|
||||
|
||||
Revision 1.71 2002/04/02 17:11:29 peter
|
||||
* tlocation,treference update
|
||||
* LOC_CONSTANT added for better constant handling
|
||||
* secondadd splitted in multiple routines
|
||||
|
||||
@ -421,7 +421,7 @@ implementation
|
||||
|
||||
function tassignmentnode.det_resulttype:tnode;
|
||||
var
|
||||
hp,hp2 : tnode;
|
||||
hp : tnode;
|
||||
begin
|
||||
result:=nil;
|
||||
resulttype:=voidtype;
|
||||
@ -450,12 +450,11 @@ implementation
|
||||
if is_dynamic_array(left.resulttype.def) and
|
||||
(right.nodetype=niln) then
|
||||
begin
|
||||
hp := ctypeconvnode.create(left,voidpointertype);
|
||||
hp.toggleflag(nf_explizit);
|
||||
hp2 := crttinode.create(tstoreddef(left.resulttype.def),initrtti);
|
||||
hp := ccallparanode.create(hp2,ccallparanode.create(hp,nil));
|
||||
left:=nil;
|
||||
hp:=ccallparanode.create(caddrnode.create
|
||||
(crttinode.create(tstoreddef(left.resulttype.def),initrtti)),
|
||||
ccallparanode.create(ctypeconvnode.create_explicit(left,voidpointertype),nil));
|
||||
result := ccallnode.createintern('fpc_dynarray_clear',hp);
|
||||
left:=nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
@ -925,7 +924,12 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.36 2002-04-22 16:30:06 peter
|
||||
Revision 1.37 2002-04-23 19:16:34 peter
|
||||
* add pinline unit that inserts compiler supported functions using
|
||||
one or more statements
|
||||
* moved finalize and setlength from ninl to pinline
|
||||
|
||||
Revision 1.36 2002/04/22 16:30:06 peter
|
||||
* fixed @methodpointer
|
||||
|
||||
Revision 1.35 2002/04/21 19:02:04 peter
|
||||
|
||||
@ -43,6 +43,8 @@ interface
|
||||
|
||||
procedure string_dec(var t: ttype);
|
||||
|
||||
function parse_paras(__colon,in_prop_paras : boolean) : tnode;
|
||||
|
||||
{ the ID token has to be consumed before calling this function }
|
||||
procedure do_member_read(getaddr : boolean;sym : tsym;var p1 : tnode;var again : boolean);
|
||||
|
||||
@ -72,7 +74,7 @@ implementation
|
||||
nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
|
||||
{ parser }
|
||||
scanner,
|
||||
pbase,
|
||||
pbase,pinline,
|
||||
{ codegen }
|
||||
cgbase
|
||||
;
|
||||
@ -218,313 +220,6 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function new_dispose_statement(is_new:boolean) : tnode;
|
||||
var
|
||||
newstatement : tstatementnode;
|
||||
temp : ttempcreatenode;
|
||||
para : tcallparanode;
|
||||
p,p2 : tnode;
|
||||
again : boolean; { dummy for do_proc_call }
|
||||
destructorname : stringid;
|
||||
sym : tsym;
|
||||
classh : tobjectdef;
|
||||
destructorpos,
|
||||
storepos : tfileposinfo;
|
||||
begin
|
||||
consume(_LKLAMMER);
|
||||
p:=comp_expr(true);
|
||||
{ calc return type }
|
||||
{ rg.cleartempgen; }
|
||||
set_varstate(p,(not is_new));
|
||||
{ constructor,destructor specified }
|
||||
if try_to_consume(_COMMA) then
|
||||
begin
|
||||
{ extended syntax of new and dispose }
|
||||
{ function styled new is handled in factor }
|
||||
{ destructors have no parameters }
|
||||
destructorname:=pattern;
|
||||
destructorpos:=akttokenpos;
|
||||
consume(_ID);
|
||||
|
||||
if (p.resulttype.def.deftype<>pointerdef) then
|
||||
begin
|
||||
Message1(type_e_pointer_type_expected,p.resulttype.def.typename);
|
||||
p.free;
|
||||
p:=factor(false);
|
||||
p.free;
|
||||
consume(_RKLAMMER);
|
||||
new_dispose_statement:=cerrornode.create;
|
||||
exit;
|
||||
end;
|
||||
{ first parameter must be an object or class }
|
||||
if tpointerdef(p.resulttype.def).pointertype.def.deftype<>objectdef then
|
||||
begin
|
||||
Message(parser_e_pointer_to_class_expected);
|
||||
p.free;
|
||||
new_dispose_statement:=factor(false);
|
||||
consume_all_until(_RKLAMMER);
|
||||
consume(_RKLAMMER);
|
||||
exit;
|
||||
end;
|
||||
{ check, if the first parameter is a pointer to a _class_ }
|
||||
classh:=tobjectdef(tpointerdef(p.resulttype.def).pointertype.def);
|
||||
if is_class(classh) then
|
||||
begin
|
||||
Message(parser_e_no_new_or_dispose_for_classes);
|
||||
new_dispose_statement:=factor(false);
|
||||
consume_all_until(_RKLAMMER);
|
||||
consume(_RKLAMMER);
|
||||
exit;
|
||||
end;
|
||||
{ search cons-/destructor, also in parent classes }
|
||||
storepos:=akttokenpos;
|
||||
akttokenpos:=destructorpos;
|
||||
sym:=search_class_member(classh,destructorname);
|
||||
akttokenpos:=storepos;
|
||||
|
||||
{ the second parameter of new/dispose must be a call }
|
||||
{ to a cons-/destructor }
|
||||
if (not assigned(sym)) or (sym.typ<>procsym) then
|
||||
begin
|
||||
if is_new then
|
||||
Message(parser_e_expr_have_to_be_constructor_call)
|
||||
else
|
||||
Message(parser_e_expr_have_to_be_destructor_call);
|
||||
p.free;
|
||||
new_dispose_statement:=cerrornode.create;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if is_new then
|
||||
p2:=chnewnode.create(tpointerdef(p.resulttype.def).pointertype)
|
||||
else
|
||||
p2:=chdisposenode.create(p);
|
||||
do_resulttypepass(p2);
|
||||
if is_new then
|
||||
do_member_read(false,sym,p2,again)
|
||||
else
|
||||
begin
|
||||
if not(m_fpc in aktmodeswitches) then
|
||||
do_member_read(false,sym,p2,again)
|
||||
else
|
||||
begin
|
||||
p2:=ccallnode.create(nil,tprocsym(sym),sym.owner,p2);
|
||||
{ support dispose(p,done()); }
|
||||
if try_to_consume(_LKLAMMER) then
|
||||
begin
|
||||
if not try_to_consume(_RKLAMMER) then
|
||||
begin
|
||||
Message(parser_e_no_paras_for_destructor);
|
||||
consume_all_until(_RKLAMMER);
|
||||
consume(_RKLAMMER);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ we need the real called method }
|
||||
{ rg.cleartempgen;}
|
||||
do_resulttypepass(p2);
|
||||
if not codegenerror then
|
||||
begin
|
||||
if is_new then
|
||||
begin
|
||||
if (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor) then
|
||||
Message(parser_e_expr_have_to_be_constructor_call);
|
||||
p2.resulttype:=p.resulttype;
|
||||
p2:=cassignmentnode.create(p,p2);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (tcallnode(p2).procdefinition.proctypeoption<>potype_destructor) then
|
||||
Message(parser_e_expr_have_to_be_destructor_call);
|
||||
end;
|
||||
end;
|
||||
new_dispose_statement:=p2;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (p.resulttype.def.deftype<>pointerdef) then
|
||||
Begin
|
||||
Message1(type_e_pointer_type_expected,p.resulttype.def.typename);
|
||||
new_dispose_statement:=cerrornode.create;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (tpointerdef(p.resulttype.def).pointertype.def.deftype=objectdef) and
|
||||
(oo_has_vmt in tobjectdef(tpointerdef(p.resulttype.def).pointertype.def).objectoptions) then
|
||||
Message(parser_w_use_extended_syntax_for_objects);
|
||||
if (tpointerdef(p.resulttype.def).pointertype.def.deftype=orddef) and
|
||||
(torddef(tpointerdef(p.resulttype.def).pointertype.def).typ=uvoid) then
|
||||
begin
|
||||
if (m_tp7 in aktmodeswitches) or
|
||||
(m_delphi in aktmodeswitches) then
|
||||
Message(parser_w_no_new_dispose_on_void_pointers)
|
||||
else
|
||||
Message(parser_e_no_new_dispose_on_void_pointers);
|
||||
end;
|
||||
|
||||
{ create statements with call to getmem+initialize or
|
||||
finalize+freemem }
|
||||
new_dispose_statement:=internalstatements(newstatement);
|
||||
|
||||
if is_new then
|
||||
begin
|
||||
{ create temp for result }
|
||||
temp := ctempcreatenode.create(p.resulttype,p.resulttype.def.size,true);
|
||||
addstatement(newstatement,temp);
|
||||
|
||||
{ create call to fpc_getmem }
|
||||
para := ccallparanode.create(cordconstnode.create
|
||||
(tpointerdef(p.resulttype.def).pointertype.def.size,s32bittype),nil);
|
||||
addstatement(newstatement,cassignmentnode.create(
|
||||
ctemprefnode.create(temp),
|
||||
ccallnode.createintern('fpc_getmem',para)));
|
||||
|
||||
{ create call to fpc_initialize }
|
||||
if tpointerdef(p.resulttype.def).pointertype.def.needs_inittable then
|
||||
begin
|
||||
para := ccallparanode.create(caddrnode.create(crttinode.create(
|
||||
tstoreddef(tpointerdef(p.resulttype.def).pointertype.def),initrtti)),
|
||||
ccallparanode.create(ctemprefnode.create
|
||||
(temp),nil));
|
||||
addstatement(newstatement,ccallnode.createintern('fpc_initialize',para));
|
||||
end;
|
||||
|
||||
{ copy the temp to the destination }
|
||||
addstatement(newstatement,cassignmentnode.create(
|
||||
p,
|
||||
ctemprefnode.create(temp)));
|
||||
|
||||
{ release temp }
|
||||
addstatement(newstatement,ctempdeletenode.create(temp));
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ create call to fpc_finalize }
|
||||
if tpointerdef(p.resulttype.def).pointertype.def.needs_inittable then
|
||||
begin
|
||||
{ we need to use a copy of p here }
|
||||
para := ccallparanode.create(caddrnode.create(crttinode.create
|
||||
(tstoreddef(tpointerdef(p.resulttype.def).pointertype.def),initrtti)),
|
||||
ccallparanode.create(p.getcopy,nil));
|
||||
addstatement(newstatement,ccallnode.createintern('fpc_finalize',para));
|
||||
end;
|
||||
|
||||
{ create call to fpc_freemem }
|
||||
para := ccallparanode.create(p,nil);
|
||||
addstatement(newstatement,ccallnode.createintern('fpc_freemem',para));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
consume(_RKLAMMER);
|
||||
end;
|
||||
|
||||
|
||||
function new_function : tnode;
|
||||
var
|
||||
newstatement : tstatementnode;
|
||||
newblock : tblocknode;
|
||||
temp : ttempcreatenode;
|
||||
para : tcallparanode;
|
||||
p1,p2 : tnode;
|
||||
classh : tobjectdef;
|
||||
sym : tsym;
|
||||
again : boolean; { dummy for do_proc_call }
|
||||
begin
|
||||
consume(_LKLAMMER);
|
||||
p1:=factor(false);
|
||||
if p1.nodetype<>typen then
|
||||
begin
|
||||
Message(type_e_type_id_expected);
|
||||
p1.destroy;
|
||||
p1:=cerrornode.create;
|
||||
do_resulttypepass(p1);
|
||||
end;
|
||||
|
||||
if (p1.resulttype.def.deftype<>pointerdef) then
|
||||
Message1(type_e_pointer_type_expected,p1.resulttype.def.typename)
|
||||
else
|
||||
if token=_RKLAMMER then
|
||||
begin
|
||||
if (tpointerdef(p1.resulttype.def).pointertype.def.deftype=objectdef) and
|
||||
(oo_has_vmt in tobjectdef(tpointerdef(p1.resulttype.def).pointertype.def).objectoptions) then
|
||||
Message(parser_w_use_extended_syntax_for_objects);
|
||||
|
||||
{ create statements with call to getmem+initialize }
|
||||
newblock:=internalstatements(newstatement);
|
||||
|
||||
{ create temp for result }
|
||||
temp := ctempcreatenode.create(p1.resulttype,p1.resulttype.def.size,true);
|
||||
addstatement(newstatement,temp);
|
||||
|
||||
{ create call to fpc_getmem }
|
||||
para := ccallparanode.create(cordconstnode.create
|
||||
(tpointerdef(p1.resulttype.def).pointertype.def.size,s32bittype),nil);
|
||||
addstatement(newstatement,cassignmentnode.create(
|
||||
ctemprefnode.create(temp),
|
||||
ccallnode.createintern('fpc_getmem',para)));
|
||||
|
||||
{ create call to fpc_initialize }
|
||||
if tpointerdef(p1.resulttype.def).pointertype.def.needs_inittable then
|
||||
begin
|
||||
para := ccallparanode.create(caddrnode.create(crttinode.create
|
||||
(tstoreddef(tpointerdef(p1.resulttype.def).pointertype.def),initrtti)),
|
||||
ccallparanode.create(ctemprefnode.create
|
||||
(temp),nil));
|
||||
addstatement(newstatement,ccallnode.createintern('fpc_initialize',para));
|
||||
end;
|
||||
|
||||
{ the last statement should return the value as
|
||||
location and type, this is done be referencing the
|
||||
temp and converting it first from a persistent temp to
|
||||
normal temp }
|
||||
addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
|
||||
addstatement(newstatement,ctemprefnode.create(temp));
|
||||
|
||||
p1.destroy;
|
||||
p1:=newblock;
|
||||
consume(_RKLAMMER);
|
||||
end
|
||||
else
|
||||
begin
|
||||
p2:=chnewnode.create(tpointerdef(p1.resulttype.def).pointertype);
|
||||
do_resulttypepass(p2);
|
||||
consume(_COMMA);
|
||||
afterassignment:=false;
|
||||
{ determines the current object defintion }
|
||||
classh:=tobjectdef(p2.resulttype.def);
|
||||
if classh.deftype=objectdef then
|
||||
begin
|
||||
{ check for an abstract class }
|
||||
if (oo_has_abstract in classh.objectoptions) then
|
||||
Message(sym_e_no_instance_of_abstract_object);
|
||||
{ search the constructor also in the symbol tables of
|
||||
the parents }
|
||||
sym:=searchsym_in_class(classh,pattern);
|
||||
consume(_ID);
|
||||
do_member_read(false,sym,p2,again);
|
||||
{ we need to know which procedure is called }
|
||||
do_resulttypepass(p2);
|
||||
if (p2.nodetype<>calln) or
|
||||
(assigned(tcallnode(p2).procdefinition) and
|
||||
(tcallnode(p2).procdefinition.proctypeoption<>potype_constructor)) then
|
||||
Message(parser_e_expr_have_to_be_constructor_call);
|
||||
end
|
||||
else
|
||||
Message(parser_e_pointer_to_class_expected);
|
||||
{ constructors return boolean, update resulttype to return
|
||||
the pointer to the object }
|
||||
p2.resulttype:=p1.resulttype;
|
||||
p1.destroy;
|
||||
p1:=p2;
|
||||
consume(_RKLAMMER);
|
||||
end;
|
||||
new_function:=p1;
|
||||
end;
|
||||
|
||||
|
||||
function statement_syssym(l : longint) : tnode;
|
||||
var
|
||||
p1,p2,paras : tnode;
|
||||
@ -724,7 +419,7 @@ implementation
|
||||
|
||||
in_finalize_x:
|
||||
begin
|
||||
consume(_LKLAMMER);
|
||||
{ consume(_LKLAMMER);
|
||||
in_args:=true;
|
||||
p1:=comp_expr(true);
|
||||
if token=_COMMA then
|
||||
@ -737,6 +432,8 @@ implementation
|
||||
p2:=ccallparanode.create(p1,p2);
|
||||
statement_syssym:=geninlinenode(in_finalize_x,false,p2);
|
||||
consume(_RKLAMMER);
|
||||
}
|
||||
statement_syssym:=inline_finalize;
|
||||
end;
|
||||
|
||||
in_concat_x :
|
||||
@ -783,17 +480,7 @@ implementation
|
||||
|
||||
in_setlength_x:
|
||||
begin
|
||||
if token=_LKLAMMER then
|
||||
begin
|
||||
consume(_LKLAMMER);
|
||||
in_args:=true;
|
||||
paras:=parse_paras(false,false);
|
||||
consume(_RKLAMMER);
|
||||
end
|
||||
else
|
||||
paras:=nil;
|
||||
p1:=geninlinenode(l,false,paras);
|
||||
statement_syssym := p1;
|
||||
statement_syssym := inline_setlength;
|
||||
end;
|
||||
|
||||
in_length_x:
|
||||
@ -2537,7 +2224,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.63 2002-04-21 19:02:05 peter
|
||||
Revision 1.64 2002-04-23 19:16:34 peter
|
||||
* add pinline unit that inserts compiler supported functions using
|
||||
one or more statements
|
||||
* moved finalize and setlength from ninl to pinline
|
||||
|
||||
Revision 1.63 2002/04/21 19:02:05 peter
|
||||
* removed newn and disposen nodes, the code is now directly
|
||||
inlined from pexpr
|
||||
* -an option that will write the secondpass nodes to the .s file, this
|
||||
|
||||
573
compiler/pinline.pas
Normal file
573
compiler/pinline.pas
Normal file
@ -0,0 +1,573 @@
|
||||
{
|
||||
$Id$
|
||||
Copyright (c) 1998-2001 by Florian Klaempfl
|
||||
|
||||
Generates nodes for routines that need compiler support
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
|
||||
****************************************************************************
|
||||
}
|
||||
unit pinline;
|
||||
|
||||
{$i defines.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
symtype,
|
||||
node,
|
||||
globals,
|
||||
cpuinfo;
|
||||
|
||||
function new_dispose_statement(is_new:boolean) : tnode;
|
||||
function new_function : tnode;
|
||||
|
||||
function inline_setlength : tnode;
|
||||
function inline_finalize : tnode;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
{$ifdef delphi}
|
||||
SysUtils,
|
||||
{$endif}
|
||||
{ common }
|
||||
cutils,
|
||||
{ global }
|
||||
globtype,tokens,verbose,
|
||||
systems,widestr,
|
||||
{ symtable }
|
||||
symconst,symbase,symdef,symsym,symtable,types,
|
||||
{ pass 1 }
|
||||
pass_1,htypechk,
|
||||
nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
|
||||
{ parser }
|
||||
scanner,
|
||||
pbase,pexpr,
|
||||
{ codegen }
|
||||
cgbase
|
||||
;
|
||||
|
||||
|
||||
function new_dispose_statement(is_new:boolean) : tnode;
|
||||
var
|
||||
newstatement : tstatementnode;
|
||||
temp : ttempcreatenode;
|
||||
para : tcallparanode;
|
||||
p,p2 : tnode;
|
||||
again : boolean; { dummy for do_proc_call }
|
||||
destructorname : stringid;
|
||||
sym : tsym;
|
||||
classh : tobjectdef;
|
||||
destructorpos,
|
||||
storepos : tfileposinfo;
|
||||
begin
|
||||
consume(_LKLAMMER);
|
||||
p:=comp_expr(true);
|
||||
{ calc return type }
|
||||
set_varstate(p,(not is_new));
|
||||
{ constructor,destructor specified }
|
||||
if try_to_consume(_COMMA) then
|
||||
begin
|
||||
{ extended syntax of new and dispose }
|
||||
{ function styled new is handled in factor }
|
||||
{ destructors have no parameters }
|
||||
destructorname:=pattern;
|
||||
destructorpos:=akttokenpos;
|
||||
consume(_ID);
|
||||
|
||||
if (p.resulttype.def.deftype<>pointerdef) then
|
||||
begin
|
||||
Message1(type_e_pointer_type_expected,p.resulttype.def.typename);
|
||||
p.free;
|
||||
p:=factor(false);
|
||||
p.free;
|
||||
consume(_RKLAMMER);
|
||||
new_dispose_statement:=cerrornode.create;
|
||||
exit;
|
||||
end;
|
||||
{ first parameter must be an object or class }
|
||||
if tpointerdef(p.resulttype.def).pointertype.def.deftype<>objectdef then
|
||||
begin
|
||||
Message(parser_e_pointer_to_class_expected);
|
||||
p.free;
|
||||
new_dispose_statement:=factor(false);
|
||||
consume_all_until(_RKLAMMER);
|
||||
consume(_RKLAMMER);
|
||||
exit;
|
||||
end;
|
||||
{ check, if the first parameter is a pointer to a _class_ }
|
||||
classh:=tobjectdef(tpointerdef(p.resulttype.def).pointertype.def);
|
||||
if is_class(classh) then
|
||||
begin
|
||||
Message(parser_e_no_new_or_dispose_for_classes);
|
||||
new_dispose_statement:=factor(false);
|
||||
consume_all_until(_RKLAMMER);
|
||||
consume(_RKLAMMER);
|
||||
exit;
|
||||
end;
|
||||
{ search cons-/destructor, also in parent classes }
|
||||
storepos:=akttokenpos;
|
||||
akttokenpos:=destructorpos;
|
||||
sym:=search_class_member(classh,destructorname);
|
||||
akttokenpos:=storepos;
|
||||
|
||||
{ the second parameter of new/dispose must be a call }
|
||||
{ to a cons-/destructor }
|
||||
if (not assigned(sym)) or (sym.typ<>procsym) then
|
||||
begin
|
||||
if is_new then
|
||||
Message(parser_e_expr_have_to_be_constructor_call)
|
||||
else
|
||||
Message(parser_e_expr_have_to_be_destructor_call);
|
||||
p.free;
|
||||
new_dispose_statement:=cerrornode.create;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if is_new then
|
||||
p2:=chnewnode.create(tpointerdef(p.resulttype.def).pointertype)
|
||||
else
|
||||
p2:=chdisposenode.create(p);
|
||||
do_resulttypepass(p2);
|
||||
if is_new then
|
||||
do_member_read(false,sym,p2,again)
|
||||
else
|
||||
begin
|
||||
if not(m_fpc in aktmodeswitches) then
|
||||
do_member_read(false,sym,p2,again)
|
||||
else
|
||||
begin
|
||||
p2:=ccallnode.create(nil,tprocsym(sym),sym.owner,p2);
|
||||
{ support dispose(p,done()); }
|
||||
if try_to_consume(_LKLAMMER) then
|
||||
begin
|
||||
if not try_to_consume(_RKLAMMER) then
|
||||
begin
|
||||
Message(parser_e_no_paras_for_destructor);
|
||||
consume_all_until(_RKLAMMER);
|
||||
consume(_RKLAMMER);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ we need the real called method }
|
||||
{ rg.cleartempgen;}
|
||||
do_resulttypepass(p2);
|
||||
if not codegenerror then
|
||||
begin
|
||||
if is_new then
|
||||
begin
|
||||
if (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor) then
|
||||
Message(parser_e_expr_have_to_be_constructor_call);
|
||||
p2.resulttype:=p.resulttype;
|
||||
p2:=cassignmentnode.create(p,p2);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (tcallnode(p2).procdefinition.proctypeoption<>potype_destructor) then
|
||||
Message(parser_e_expr_have_to_be_destructor_call);
|
||||
end;
|
||||
end;
|
||||
new_dispose_statement:=p2;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (p.resulttype.def.deftype<>pointerdef) then
|
||||
Begin
|
||||
Message1(type_e_pointer_type_expected,p.resulttype.def.typename);
|
||||
new_dispose_statement:=cerrornode.create;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (tpointerdef(p.resulttype.def).pointertype.def.deftype=objectdef) and
|
||||
(oo_has_vmt in tobjectdef(tpointerdef(p.resulttype.def).pointertype.def).objectoptions) then
|
||||
Message(parser_w_use_extended_syntax_for_objects);
|
||||
if (tpointerdef(p.resulttype.def).pointertype.def.deftype=orddef) and
|
||||
(torddef(tpointerdef(p.resulttype.def).pointertype.def).typ=uvoid) then
|
||||
begin
|
||||
if (m_tp7 in aktmodeswitches) or
|
||||
(m_delphi in aktmodeswitches) then
|
||||
Message(parser_w_no_new_dispose_on_void_pointers)
|
||||
else
|
||||
Message(parser_e_no_new_dispose_on_void_pointers);
|
||||
end;
|
||||
|
||||
{ create statements with call to getmem+initialize or
|
||||
finalize+freemem }
|
||||
new_dispose_statement:=internalstatements(newstatement);
|
||||
|
||||
if is_new then
|
||||
begin
|
||||
{ create temp for result }
|
||||
temp := ctempcreatenode.create(p.resulttype,p.resulttype.def.size,true);
|
||||
addstatement(newstatement,temp);
|
||||
|
||||
{ create call to fpc_getmem }
|
||||
para := ccallparanode.create(cordconstnode.create
|
||||
(tpointerdef(p.resulttype.def).pointertype.def.size,s32bittype),nil);
|
||||
addstatement(newstatement,cassignmentnode.create(
|
||||
ctemprefnode.create(temp),
|
||||
ccallnode.createintern('fpc_getmem',para)));
|
||||
|
||||
{ create call to fpc_initialize }
|
||||
if tpointerdef(p.resulttype.def).pointertype.def.needs_inittable then
|
||||
begin
|
||||
para := ccallparanode.create(caddrnode.create(crttinode.create(
|
||||
tstoreddef(tpointerdef(p.resulttype.def).pointertype.def),initrtti)),
|
||||
ccallparanode.create(ctemprefnode.create
|
||||
(temp),nil));
|
||||
addstatement(newstatement,ccallnode.createintern('fpc_initialize',para));
|
||||
end;
|
||||
|
||||
{ copy the temp to the destination }
|
||||
addstatement(newstatement,cassignmentnode.create(
|
||||
p,
|
||||
ctemprefnode.create(temp)));
|
||||
|
||||
{ release temp }
|
||||
addstatement(newstatement,ctempdeletenode.create(temp));
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ create call to fpc_finalize }
|
||||
if tpointerdef(p.resulttype.def).pointertype.def.needs_inittable then
|
||||
begin
|
||||
{ we need to use a copy of p here }
|
||||
para := ccallparanode.create(caddrnode.create(crttinode.create
|
||||
(tstoreddef(tpointerdef(p.resulttype.def).pointertype.def),initrtti)),
|
||||
ccallparanode.create(p.getcopy,nil));
|
||||
addstatement(newstatement,ccallnode.createintern('fpc_finalize',para));
|
||||
end;
|
||||
|
||||
{ create call to fpc_freemem }
|
||||
para := ccallparanode.create(p,nil);
|
||||
addstatement(newstatement,ccallnode.createintern('fpc_freemem',para));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
consume(_RKLAMMER);
|
||||
end;
|
||||
|
||||
|
||||
function new_function : tnode;
|
||||
var
|
||||
newstatement : tstatementnode;
|
||||
newblock : tblocknode;
|
||||
temp : ttempcreatenode;
|
||||
para : tcallparanode;
|
||||
p1,p2 : tnode;
|
||||
classh : tobjectdef;
|
||||
sym : tsym;
|
||||
again : boolean; { dummy for do_proc_call }
|
||||
begin
|
||||
consume(_LKLAMMER);
|
||||
p1:=factor(false);
|
||||
if p1.nodetype<>typen then
|
||||
begin
|
||||
Message(type_e_type_id_expected);
|
||||
p1.destroy;
|
||||
p1:=cerrornode.create;
|
||||
do_resulttypepass(p1);
|
||||
end;
|
||||
|
||||
if (p1.resulttype.def.deftype<>pointerdef) then
|
||||
Message1(type_e_pointer_type_expected,p1.resulttype.def.typename)
|
||||
else
|
||||
if token=_RKLAMMER then
|
||||
begin
|
||||
if (tpointerdef(p1.resulttype.def).pointertype.def.deftype=objectdef) and
|
||||
(oo_has_vmt in tobjectdef(tpointerdef(p1.resulttype.def).pointertype.def).objectoptions) then
|
||||
Message(parser_w_use_extended_syntax_for_objects);
|
||||
|
||||
{ create statements with call to getmem+initialize }
|
||||
newblock:=internalstatements(newstatement);
|
||||
|
||||
{ create temp for result }
|
||||
temp := ctempcreatenode.create(p1.resulttype,p1.resulttype.def.size,true);
|
||||
addstatement(newstatement,temp);
|
||||
|
||||
{ create call to fpc_getmem }
|
||||
para := ccallparanode.create(cordconstnode.create
|
||||
(tpointerdef(p1.resulttype.def).pointertype.def.size,s32bittype),nil);
|
||||
addstatement(newstatement,cassignmentnode.create(
|
||||
ctemprefnode.create(temp),
|
||||
ccallnode.createintern('fpc_getmem',para)));
|
||||
|
||||
{ create call to fpc_initialize }
|
||||
if tpointerdef(p1.resulttype.def).pointertype.def.needs_inittable then
|
||||
begin
|
||||
para := ccallparanode.create(caddrnode.create(crttinode.create
|
||||
(tstoreddef(tpointerdef(p1.resulttype.def).pointertype.def),initrtti)),
|
||||
ccallparanode.create(ctemprefnode.create
|
||||
(temp),nil));
|
||||
addstatement(newstatement,ccallnode.createintern('fpc_initialize',para));
|
||||
end;
|
||||
|
||||
{ the last statement should return the value as
|
||||
location and type, this is done be referencing the
|
||||
temp and converting it first from a persistent temp to
|
||||
normal temp }
|
||||
addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
|
||||
addstatement(newstatement,ctemprefnode.create(temp));
|
||||
|
||||
p1.destroy;
|
||||
p1:=newblock;
|
||||
consume(_RKLAMMER);
|
||||
end
|
||||
else
|
||||
begin
|
||||
p2:=chnewnode.create(tpointerdef(p1.resulttype.def).pointertype);
|
||||
do_resulttypepass(p2);
|
||||
consume(_COMMA);
|
||||
afterassignment:=false;
|
||||
{ determines the current object defintion }
|
||||
classh:=tobjectdef(p2.resulttype.def);
|
||||
if classh.deftype=objectdef then
|
||||
begin
|
||||
{ check for an abstract class }
|
||||
if (oo_has_abstract in classh.objectoptions) then
|
||||
Message(sym_e_no_instance_of_abstract_object);
|
||||
{ search the constructor also in the symbol tables of
|
||||
the parents }
|
||||
sym:=searchsym_in_class(classh,pattern);
|
||||
consume(_ID);
|
||||
do_member_read(false,sym,p2,again);
|
||||
{ we need to know which procedure is called }
|
||||
do_resulttypepass(p2);
|
||||
if (p2.nodetype<>calln) or
|
||||
(assigned(tcallnode(p2).procdefinition) and
|
||||
(tcallnode(p2).procdefinition.proctypeoption<>potype_constructor)) then
|
||||
Message(parser_e_expr_have_to_be_constructor_call);
|
||||
end
|
||||
else
|
||||
Message(parser_e_pointer_to_class_expected);
|
||||
{ constructors return boolean, update resulttype to return
|
||||
the pointer to the object }
|
||||
p2.resulttype:=p1.resulttype;
|
||||
p1.destroy;
|
||||
p1:=p2;
|
||||
consume(_RKLAMMER);
|
||||
end;
|
||||
new_function:=p1;
|
||||
end;
|
||||
|
||||
|
||||
function inline_setlength : tnode;
|
||||
var
|
||||
paras : tnode;
|
||||
npara,
|
||||
ppn : tcallparanode;
|
||||
counter : integer;
|
||||
isarray : boolean;
|
||||
def : tdef;
|
||||
destppn : tnode;
|
||||
newstatement : tstatementnode;
|
||||
temp : ttempcreatenode;
|
||||
newblock : tnode;
|
||||
begin
|
||||
{ for easy exiting if something goes wrong }
|
||||
result := cerrornode.create;
|
||||
|
||||
consume(_LKLAMMER);
|
||||
paras:=parse_paras(false,false);
|
||||
consume(_RKLAMMER);
|
||||
if not assigned(paras) then
|
||||
begin
|
||||
CGMessage(parser_e_wrong_parameter_size);
|
||||
exit;
|
||||
end;
|
||||
|
||||
counter:=0;
|
||||
if assigned(paras) then
|
||||
begin
|
||||
{ check type of lengths }
|
||||
ppn:=tcallparanode(paras);
|
||||
while assigned(ppn.right) do
|
||||
begin
|
||||
set_varstate(ppn.left,true);
|
||||
inserttypeconv(ppn.left,s32bittype);
|
||||
inc(counter);
|
||||
ppn:=tcallparanode(ppn.right);
|
||||
end;
|
||||
end;
|
||||
if counter=0 then
|
||||
begin
|
||||
CGMessage(parser_e_wrong_parameter_size);
|
||||
paras.free;
|
||||
exit;
|
||||
end;
|
||||
{ last param must be var }
|
||||
destppn:=ppn.left;
|
||||
inc(parsing_para_level);
|
||||
valid_for_var(destppn);
|
||||
set_varstate(destppn,false);
|
||||
dec(parsing_para_level);
|
||||
{ first param must be a string or dynamic array ...}
|
||||
isarray:=is_dynamic_array(destppn.resulttype.def);
|
||||
if not((destppn.resulttype.def.deftype=stringdef) or
|
||||
isarray) then
|
||||
begin
|
||||
CGMessage(type_e_mismatch);
|
||||
paras.free;
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ only dynamic arrays accept more dimensions }
|
||||
if (counter>1) then
|
||||
begin
|
||||
if (not isarray) then
|
||||
CGMessage(type_e_mismatch)
|
||||
else
|
||||
begin
|
||||
{ check if the amount of dimensions is valid }
|
||||
def := tarraydef(destppn.resulttype.def).elementtype.def;
|
||||
while counter > 1 do
|
||||
begin
|
||||
if not(is_dynamic_array(def)) then
|
||||
begin
|
||||
CGMessage(parser_e_wrong_parameter_size);
|
||||
break;
|
||||
end;
|
||||
dec(counter);
|
||||
def := tarraydef(def).elementtype.def;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if isarray then
|
||||
begin
|
||||
{ create statements with call initialize the arguments and
|
||||
call fpc_dynarr_setlength }
|
||||
newblock:=internalstatements(newstatement);
|
||||
|
||||
{ get temp for array of lengths }
|
||||
temp := ctempcreatenode.create(s32bittype,counter*s32bittype.def.size,true);
|
||||
addstatement(newstatement,temp);
|
||||
|
||||
{ load array of lengths }
|
||||
ppn:=tcallparanode(paras);
|
||||
counter:=0;
|
||||
while assigned(ppn.right) do
|
||||
begin
|
||||
addstatement(newstatement,cassignmentnode.create(
|
||||
ctemprefnode.create_offset(temp,counter*s32bittype.def.size),
|
||||
ppn.left));
|
||||
ppn.left:=nil;
|
||||
inc(counter);
|
||||
ppn:=tcallparanode(ppn.right);
|
||||
end;
|
||||
{ destppn is also reused }
|
||||
ppn.left:=nil;
|
||||
|
||||
{ create call to fpc_dynarr_setlength }
|
||||
npara:=ccallparanode.create(caddrnode.create
|
||||
(ctemprefnode.create(temp)),
|
||||
ccallparanode.create(cordconstnode.create
|
||||
(counter,s32bittype),
|
||||
ccallparanode.create(caddrnode.create
|
||||
(crttinode.create(tstoreddef(destppn.resulttype.def),initrtti)),
|
||||
ccallparanode.create(ctypeconvnode.create_explicit(destppn,voidpointertype),nil))));
|
||||
addstatement(newstatement,ccallnode.createintern('fpc_dynarray_setlength',npara));
|
||||
addstatement(newstatement,ctempdeletenode.create(temp));
|
||||
|
||||
{ we don't need original the callparanodes tree }
|
||||
paras.free;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ we can reuse the supplied parameters }
|
||||
newblock:=ccallnode.createintern(
|
||||
'fpc_'+tstringdef(destppn.resulttype.def).stringtypname+'_setlength',paras);
|
||||
end;
|
||||
|
||||
result.free;
|
||||
result:=newblock;
|
||||
end;
|
||||
|
||||
|
||||
function inline_finalize : tnode;
|
||||
var
|
||||
newblock,
|
||||
paras : tnode;
|
||||
npara,
|
||||
destppn,
|
||||
ppn : tcallparanode;
|
||||
begin
|
||||
{ for easy exiting if something goes wrong }
|
||||
result := cerrornode.create;
|
||||
|
||||
consume(_LKLAMMER);
|
||||
paras:=parse_paras(false,false);
|
||||
consume(_RKLAMMER);
|
||||
if not assigned(paras) then
|
||||
begin
|
||||
CGMessage(parser_e_wrong_parameter_size);
|
||||
exit;
|
||||
end;
|
||||
|
||||
ppn:=tcallparanode(paras);
|
||||
{ 2 arguments? }
|
||||
if assigned(ppn.right) then
|
||||
begin
|
||||
destppn:=tcallparanode(ppn.right);
|
||||
{ 3 arguments is invalid }
|
||||
if assigned(destppn.right) then
|
||||
begin
|
||||
CGMessage(parser_e_wrong_parameter_size);
|
||||
paras.free;
|
||||
exit;
|
||||
end;
|
||||
{ create call to fpc_finalize_array }
|
||||
npara:=ccallparanode.create(cordconstnode.create
|
||||
(destppn.left.resulttype.def.size,s32bittype),
|
||||
ccallparanode.create(ctypeconvnode.create
|
||||
(ppn.left,s32bittype),
|
||||
ccallparanode.create(caddrnode.create
|
||||
(crttinode.create(tstoreddef(destppn.left.resulttype.def),initrtti)),
|
||||
ccallparanode.create(caddrnode.create
|
||||
(destppn.left),nil))));
|
||||
newblock:=ccallnode.createintern('fpc_finalize_array',npara);
|
||||
destppn.left:=nil;
|
||||
ppn.left:=nil;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ create call to fpc_finalize }
|
||||
npara:=ccallparanode.create(caddrnode.create
|
||||
(crttinode.create(tstoreddef(ppn.left.resulttype.def),initrtti)),
|
||||
ccallparanode.create(caddrnode.create
|
||||
(ppn.left),nil));
|
||||
newblock:=ccallnode.createintern('fpc_finalize',npara);
|
||||
ppn.left:=nil;
|
||||
end;
|
||||
paras.free;
|
||||
result.free;
|
||||
result:=newblock;
|
||||
end;
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2002-04-23 19:16:35 peter
|
||||
* add pinline unit that inserts compiler supported functions using
|
||||
one or more statements
|
||||
* moved finalize and setlength from ninl to pinline
|
||||
|
||||
}
|
||||
@ -774,15 +774,16 @@ implementation
|
||||
Message1(sym_e_illegal_field,s);
|
||||
error := true;
|
||||
end;
|
||||
if not assigned(srsym) or
|
||||
(s <> srsym.name) then
|
||||
if (not error) and
|
||||
(not assigned(srsym) or
|
||||
(s <> srsym.name)) then
|
||||
{ possible variant record (JM) }
|
||||
begin
|
||||
{ All parts of a variant start at the same offset }
|
||||
{ Also allow jumping from one variant part to another, }
|
||||
{ as long as the offsets match }
|
||||
if (assigned(srsym) and
|
||||
(tvarsym(recsym).address = tvarsym(srsym).address)) or
|
||||
(tvarsym(recsym).address = tvarsym(srsym).address)) or
|
||||
{ srsym is not assigned after parsing w2 in the }
|
||||
{ typed const in the next example: }
|
||||
{ type tr = record case byte of }
|
||||
@ -970,7 +971,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.44 2002-04-20 21:32:24 carl
|
||||
Revision 1.45 2002-04-23 19:16:35 peter
|
||||
* add pinline unit that inserts compiler supported functions using
|
||||
one or more statements
|
||||
* moved finalize and setlength from ninl to pinline
|
||||
|
||||
Revision 1.44 2002/04/20 21:32:24 carl
|
||||
+ generic FPC_CHECKPOINTER
|
||||
+ first parameter offset in stack now portable
|
||||
* rename some constants
|
||||
|
||||
@ -1252,7 +1252,7 @@ implementation
|
||||
function tstringdef.stringtypname:string;
|
||||
const
|
||||
typname:array[tstringtype] of string[8]=('',
|
||||
'SHORTSTR','LONGSTR','ANSISTR','WIDESTR'
|
||||
'shortstr','longstr','ansistr','widestr'
|
||||
);
|
||||
begin
|
||||
stringtypname:=typname[string_typ];
|
||||
@ -5470,7 +5470,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.73 2002-04-21 19:02:05 peter
|
||||
Revision 1.74 2002-04-23 19:16:35 peter
|
||||
* add pinline unit that inserts compiler supported functions using
|
||||
one or more statements
|
||||
* moved finalize and setlength from ninl to pinline
|
||||
|
||||
Revision 1.73 2002/04/21 19:02:05 peter
|
||||
* removed newn and disposen nodes, the code is now directly
|
||||
inlined from pexpr
|
||||
* -an option that will write the secondpass nodes to the .s file, this
|
||||
|
||||
Loading…
Reference in New Issue
Block a user