mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-26 22:43:52 +02:00
2472 lines
88 KiB
ObjectPascal
2472 lines
88 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998-2002 by Florian Klaempfl
|
|
|
|
Does parsing of expression for Free Pascal
|
|
|
|
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 pexpr;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
symtype,
|
|
node,
|
|
globals,
|
|
cpuinfo;
|
|
|
|
{ reads a whole expression }
|
|
function expr : tnode;
|
|
|
|
{ reads an expression without assignements and .. }
|
|
function comp_expr(accept_equal : boolean):tnode;
|
|
|
|
{ reads a single factor }
|
|
function factor(getaddr : boolean) : tnode;
|
|
|
|
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);
|
|
|
|
{$ifdef int64funcresok}
|
|
function get_intconst:TConstExprInt;
|
|
{$else int64funcresok}
|
|
function get_intconst:longint;
|
|
{$endif int64funcresok}
|
|
|
|
function get_stringconst:string;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$ifdef delphi}
|
|
SysUtils,
|
|
{$endif}
|
|
{ common }
|
|
cutils,
|
|
{ global }
|
|
globtype,tokens,verbose,
|
|
systems,widestr,
|
|
{ symtable }
|
|
symconst,symbase,symdef,symsym,symtable,defutil,defcmp,
|
|
{ pass 1 }
|
|
pass_1,htypechk,
|
|
nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,
|
|
{ parser }
|
|
scanner,
|
|
pbase,pinline,
|
|
{ codegen }
|
|
cgbase
|
|
;
|
|
|
|
{ sub_expr(opmultiply) is need to get -1 ** 4 to be
|
|
read as - (1**4) and not (-1)**4 PM }
|
|
type
|
|
Toperator_precedence=(opcompare,opaddition,opmultiply,oppower);
|
|
|
|
const
|
|
highest_precedence = oppower;
|
|
|
|
function sub_expr(pred_level:Toperator_precedence;accept_equal : boolean):tnode;forward;
|
|
|
|
const
|
|
got_addrn : boolean = false;
|
|
auto_inherited : boolean = false;
|
|
|
|
|
|
|
|
|
|
procedure string_dec(var t: ttype);
|
|
{ reads a string type with optional length }
|
|
{ and returns a pointer to the string }
|
|
{ definition }
|
|
var
|
|
p : tnode;
|
|
begin
|
|
t:=cshortstringtype;
|
|
consume(_STRING);
|
|
if token=_LECKKLAMMER then
|
|
begin
|
|
consume(_LECKKLAMMER);
|
|
p:=comp_expr(true);
|
|
if not is_constintnode(p) then
|
|
begin
|
|
Message(cg_e_illegal_expression);
|
|
{ error recovery }
|
|
consume(_RECKKLAMMER);
|
|
end
|
|
else
|
|
begin
|
|
if (tordconstnode(p).value<=0) then
|
|
begin
|
|
Message(parser_e_invalid_string_size);
|
|
tordconstnode(p).value:=255;
|
|
end;
|
|
consume(_RECKKLAMMER);
|
|
if tordconstnode(p).value>255 then
|
|
begin
|
|
{ longstring is currently unsupported (CEC)! }
|
|
{ t.setdef(tstringdef.createlong(tordconstnode(p).value))}
|
|
Message(parser_e_invalid_string_size);
|
|
tordconstnode(p).value:=255;
|
|
t.setdef(tstringdef.createshort(tordconstnode(p).value));
|
|
end
|
|
else
|
|
if tordconstnode(p).value<>255 then
|
|
t.setdef(tstringdef.createshort(tordconstnode(p).value));
|
|
end;
|
|
p.free;
|
|
end
|
|
else
|
|
begin
|
|
if cs_ansistrings in aktlocalswitches then
|
|
t:=cansistringtype
|
|
else
|
|
t:=cshortstringtype;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
function parse_paras(__colon,in_prop_paras : boolean) : tnode;
|
|
|
|
var
|
|
p1,p2 : tnode;
|
|
end_of_paras : ttoken;
|
|
prev_in_args : boolean;
|
|
old_allow_array_constructor : boolean;
|
|
begin
|
|
if in_prop_paras then
|
|
end_of_paras:=_RECKKLAMMER
|
|
else
|
|
end_of_paras:=_RKLAMMER;
|
|
if token=end_of_paras then
|
|
begin
|
|
parse_paras:=nil;
|
|
exit;
|
|
end;
|
|
{ save old values }
|
|
prev_in_args:=in_args;
|
|
old_allow_array_constructor:=allow_array_constructor;
|
|
{ set para parsing values }
|
|
in_args:=true;
|
|
inc(parsing_para_level);
|
|
allow_array_constructor:=true;
|
|
p2:=nil;
|
|
while true do
|
|
begin
|
|
p1:=comp_expr(true);
|
|
p2:=ccallparanode.create(p1,p2);
|
|
{ it's for the str(l:5,s); }
|
|
if __colon and (token=_COLON) then
|
|
begin
|
|
consume(_COLON);
|
|
p1:=comp_expr(true);
|
|
p2:=ccallparanode.create(p1,p2);
|
|
include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
|
|
if token=_COLON then
|
|
begin
|
|
consume(_COLON);
|
|
p1:=comp_expr(true);
|
|
p2:=ccallparanode.create(p1,p2);
|
|
include(tcallparanode(p2).callparaflags,cpf_is_colon_para);
|
|
end
|
|
end;
|
|
if token=_COMMA then
|
|
consume(_COMMA)
|
|
else
|
|
break;
|
|
end;
|
|
allow_array_constructor:=old_allow_array_constructor;
|
|
dec(parsing_para_level);
|
|
in_args:=prev_in_args;
|
|
parse_paras:=p2;
|
|
end;
|
|
|
|
|
|
procedure check_tp_procvar(var p : tnode);
|
|
var
|
|
hp,
|
|
p1 : tnode;
|
|
begin
|
|
if (m_tp_procvar in aktmodeswitches) and
|
|
(token<>_ASSIGNMENT) and
|
|
(not got_addrn) and
|
|
(block_type=bt_general) then
|
|
begin
|
|
{ ignore vecn,subscriptn }
|
|
hp:=p;
|
|
repeat
|
|
case hp.nodetype of
|
|
vecn :
|
|
hp:=tvecnode(hp).left;
|
|
subscriptn :
|
|
hp:=tsubscriptnode(hp).left;
|
|
else
|
|
break;
|
|
end;
|
|
until false;
|
|
if (hp.nodetype=loadn) then
|
|
begin
|
|
{ get the resulttype of p }
|
|
do_resulttypepass(p);
|
|
{ convert the procvar load to a call:
|
|
- not expecting a procvar
|
|
- the procvar does not get arguments, when it
|
|
requires arguments the callnode will fail
|
|
Note: When arguments were passed there was no loadn }
|
|
if (getprocvardef=nil) and
|
|
(p.resulttype.def.deftype=procvardef) and
|
|
(tprocvardef(p.resulttype.def).minparacount=0) then
|
|
begin
|
|
p1:=ccallnode.create(nil,nil,nil,nil);
|
|
tcallnode(p1).set_procvar(p);
|
|
resulttypepass(p1);
|
|
p:=p1;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function statement_syssym(l : longint) : tnode;
|
|
var
|
|
p1,p2,paras : tnode;
|
|
err,
|
|
prev_in_args : boolean;
|
|
begin
|
|
prev_in_args:=in_args;
|
|
case l of
|
|
|
|
in_new_x :
|
|
begin
|
|
if afterassignment or in_args then
|
|
statement_syssym:=new_function
|
|
else
|
|
statement_syssym:=new_dispose_statement(true);
|
|
end;
|
|
|
|
in_dispose_x :
|
|
begin
|
|
statement_syssym:=new_dispose_statement(false);
|
|
end;
|
|
|
|
in_ord_x :
|
|
begin
|
|
consume(_LKLAMMER);
|
|
in_args:=true;
|
|
p1:=comp_expr(true);
|
|
consume(_RKLAMMER);
|
|
p1:=geninlinenode(in_ord_x,false,p1);
|
|
statement_syssym := p1;
|
|
end;
|
|
|
|
in_exit :
|
|
begin
|
|
if try_to_consume(_LKLAMMER) then
|
|
begin
|
|
p1:=comp_expr(true);
|
|
consume(_RKLAMMER);
|
|
if (block_type=bt_except) then
|
|
Message(parser_e_exit_with_argument_not__possible);
|
|
if is_void(aktprocdef.rettype.def) then
|
|
Message(parser_e_void_function);
|
|
end
|
|
else
|
|
p1:=nil;
|
|
statement_syssym:=cexitnode.create(p1);
|
|
end;
|
|
|
|
in_break :
|
|
begin
|
|
statement_syssym:=cbreaknode.create;
|
|
end;
|
|
|
|
in_continue :
|
|
begin
|
|
statement_syssym:=ccontinuenode.create;
|
|
end;
|
|
|
|
in_typeof_x :
|
|
begin
|
|
consume(_LKLAMMER);
|
|
in_args:=true;
|
|
p1:=comp_expr(true);
|
|
consume(_RKLAMMER);
|
|
if p1.nodetype=typen then
|
|
ttypenode(p1).allowed:=true;
|
|
if p1.resulttype.def.deftype=objectdef then
|
|
statement_syssym:=geninlinenode(in_typeof_x,false,p1)
|
|
else
|
|
begin
|
|
Message(type_e_mismatch);
|
|
p1.destroy;
|
|
statement_syssym:=cerrornode.create;
|
|
end;
|
|
end;
|
|
|
|
in_sizeof_x :
|
|
begin
|
|
consume(_LKLAMMER);
|
|
in_args:=true;
|
|
p1:=comp_expr(true);
|
|
consume(_RKLAMMER);
|
|
if (p1.nodetype<>typen) and
|
|
(
|
|
(is_object(p1.resulttype.def) and
|
|
(oo_has_constructor in tobjectdef(p1.resulttype.def).objectoptions)) or
|
|
is_open_array(p1.resulttype.def) or
|
|
is_open_string(p1.resulttype.def)
|
|
) then
|
|
statement_syssym:=geninlinenode(in_sizeof_x,false,p1)
|
|
else
|
|
begin
|
|
statement_syssym:=cordconstnode.create(p1.resulttype.def.size,s32bittype,true);
|
|
{ p1 not needed !}
|
|
p1.destroy;
|
|
end;
|
|
end;
|
|
|
|
in_typeinfo_x :
|
|
begin
|
|
consume(_LKLAMMER);
|
|
in_args:=true;
|
|
p1:=comp_expr(true);
|
|
if p1.nodetype=typen then
|
|
ttypenode(p1).allowed:=true
|
|
else
|
|
begin
|
|
p1.destroy;
|
|
p1:=cerrornode.create;
|
|
Message(parser_e_illegal_parameter_list);
|
|
end;
|
|
consume(_RKLAMMER);
|
|
p2:=ccallparanode.create(p1,nil);
|
|
p2:=geninlinenode(in_typeinfo_x,false,p2);
|
|
statement_syssym:=p2;
|
|
end;
|
|
|
|
in_assigned_x :
|
|
begin
|
|
err:=false;
|
|
consume(_LKLAMMER);
|
|
in_args:=true;
|
|
p1:=comp_expr(true);
|
|
if not codegenerror then
|
|
begin
|
|
{ With tp procvars we allways need to load a
|
|
procvar when it is passed }
|
|
if (m_tp_procvar in aktmodeswitches) and
|
|
(p1.nodetype=calln) then
|
|
load_procvar_from_calln(p1);
|
|
|
|
case p1.resulttype.def.deftype of
|
|
pointerdef,
|
|
procvardef,
|
|
classrefdef : ;
|
|
objectdef :
|
|
if not is_class_or_interface(p1.resulttype.def) then
|
|
begin
|
|
Message(parser_e_illegal_parameter_list);
|
|
err:=true;
|
|
end;
|
|
else
|
|
begin
|
|
Message(parser_e_illegal_parameter_list);
|
|
err:=true;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
err:=true;
|
|
if not err then
|
|
begin
|
|
p2:=ccallparanode.create(p1,nil);
|
|
p2:=geninlinenode(in_assigned_x,false,p2);
|
|
end
|
|
else
|
|
begin
|
|
p1.free;
|
|
p2:=cerrornode.create;
|
|
end;
|
|
consume(_RKLAMMER);
|
|
statement_syssym:=p2;
|
|
end;
|
|
|
|
in_addr_x :
|
|
begin
|
|
consume(_LKLAMMER);
|
|
in_args:=true;
|
|
p1:=comp_expr(true);
|
|
p1:=caddrnode.create(p1);
|
|
consume(_RKLAMMER);
|
|
statement_syssym:=p1;
|
|
end;
|
|
|
|
in_ofs_x :
|
|
begin
|
|
consume(_LKLAMMER);
|
|
in_args:=true;
|
|
p1:=comp_expr(true);
|
|
p1:=caddrnode.create(p1);
|
|
do_resulttypepass(p1);
|
|
{ Ofs() returns a cardinal, not a pointer }
|
|
p1.resulttype:=u32bittype;
|
|
consume(_RKLAMMER);
|
|
statement_syssym:=p1;
|
|
end;
|
|
|
|
in_seg_x :
|
|
begin
|
|
consume(_LKLAMMER);
|
|
in_args:=true;
|
|
p1:=comp_expr(true);
|
|
p1:=geninlinenode(in_seg_x,false,p1);
|
|
consume(_RKLAMMER);
|
|
statement_syssym:=p1;
|
|
end;
|
|
|
|
in_high_x,
|
|
in_low_x :
|
|
begin
|
|
consume(_LKLAMMER);
|
|
in_args:=true;
|
|
p1:=comp_expr(true);
|
|
p2:=geninlinenode(l,false,p1);
|
|
consume(_RKLAMMER);
|
|
statement_syssym:=p2;
|
|
end;
|
|
|
|
in_succ_x,
|
|
in_pred_x :
|
|
begin
|
|
consume(_LKLAMMER);
|
|
in_args:=true;
|
|
p1:=comp_expr(true);
|
|
p2:=geninlinenode(l,false,p1);
|
|
consume(_RKLAMMER);
|
|
statement_syssym:=p2;
|
|
end;
|
|
|
|
in_inc_x,
|
|
in_dec_x :
|
|
begin
|
|
consume(_LKLAMMER);
|
|
in_args:=true;
|
|
p1:=comp_expr(true);
|
|
if token=_COMMA then
|
|
begin
|
|
consume(_COMMA);
|
|
p2:=ccallparanode.create(comp_expr(true),nil);
|
|
end
|
|
else
|
|
p2:=nil;
|
|
p2:=ccallparanode.create(p1,p2);
|
|
statement_syssym:=geninlinenode(l,false,p2);
|
|
consume(_RKLAMMER);
|
|
end;
|
|
|
|
in_finalize_x:
|
|
begin
|
|
statement_syssym:=inline_finalize;
|
|
end;
|
|
|
|
in_copy_x:
|
|
begin
|
|
statement_syssym:=inline_copy;
|
|
end;
|
|
|
|
in_concat_x :
|
|
begin
|
|
consume(_LKLAMMER);
|
|
in_args:=true;
|
|
p2:=nil;
|
|
while true do
|
|
begin
|
|
p1:=comp_expr(true);
|
|
set_varstate(p1,true);
|
|
if not((p1.resulttype.def.deftype=stringdef) or
|
|
((p1.resulttype.def.deftype=orddef) and
|
|
(torddef(p1.resulttype.def).typ=uchar))) then
|
|
Message(parser_e_illegal_parameter_list);
|
|
if p2<>nil then
|
|
p2:=caddnode.create(addn,p2,p1)
|
|
else
|
|
p2:=p1;
|
|
if token=_COMMA then
|
|
consume(_COMMA)
|
|
else
|
|
break;
|
|
end;
|
|
consume(_RKLAMMER);
|
|
statement_syssym:=p2;
|
|
end;
|
|
|
|
in_read_x,
|
|
in_readln_x :
|
|
begin
|
|
if token=_LKLAMMER then
|
|
begin
|
|
consume(_LKLAMMER);
|
|
paras:=parse_paras(false,false);
|
|
consume(_RKLAMMER);
|
|
end
|
|
else
|
|
paras:=nil;
|
|
p1:=geninlinenode(l,false,paras);
|
|
statement_syssym := p1;
|
|
end;
|
|
|
|
in_setlength_x:
|
|
begin
|
|
statement_syssym := inline_setlength;
|
|
end;
|
|
|
|
in_length_x:
|
|
begin
|
|
consume(_LKLAMMER);
|
|
in_args:=true;
|
|
p1:=comp_expr(true);
|
|
p2:=geninlinenode(l,false,p1);
|
|
consume(_RKLAMMER);
|
|
statement_syssym:=p2;
|
|
end;
|
|
|
|
in_write_x,
|
|
in_writeln_x :
|
|
begin
|
|
if token=_LKLAMMER then
|
|
begin
|
|
consume(_LKLAMMER);
|
|
paras:=parse_paras(true,false);
|
|
consume(_RKLAMMER);
|
|
end
|
|
else
|
|
paras:=nil;
|
|
p1 := geninlinenode(l,false,paras);
|
|
statement_syssym := p1;
|
|
end;
|
|
|
|
in_str_x_string :
|
|
begin
|
|
consume(_LKLAMMER);
|
|
paras:=parse_paras(true,false);
|
|
consume(_RKLAMMER);
|
|
p1 := geninlinenode(l,false,paras);
|
|
statement_syssym := p1;
|
|
end;
|
|
|
|
in_val_x:
|
|
Begin
|
|
consume(_LKLAMMER);
|
|
in_args := true;
|
|
p1:= ccallparanode.create(comp_expr(true), nil);
|
|
consume(_COMMA);
|
|
p2 := ccallparanode.create(comp_expr(true),p1);
|
|
if (token = _COMMA) then
|
|
Begin
|
|
consume(_COMMA);
|
|
p2 := ccallparanode.create(comp_expr(true),p2)
|
|
End;
|
|
consume(_RKLAMMER);
|
|
p2 := geninlinenode(l,false,p2);
|
|
statement_syssym := p2;
|
|
End;
|
|
|
|
in_include_x_y,
|
|
in_exclude_x_y :
|
|
begin
|
|
consume(_LKLAMMER);
|
|
in_args:=true;
|
|
p1:=comp_expr(true);
|
|
consume(_COMMA);
|
|
p2:=comp_expr(true);
|
|
statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
|
|
consume(_RKLAMMER);
|
|
end;
|
|
|
|
in_assert_x_y :
|
|
begin
|
|
consume(_LKLAMMER);
|
|
in_args:=true;
|
|
p1:=comp_expr(true);
|
|
if token=_COMMA then
|
|
begin
|
|
consume(_COMMA);
|
|
p2:=comp_expr(true);
|
|
end
|
|
else
|
|
begin
|
|
{ then insert an empty string }
|
|
p2:=cstringconstnode.createstr('',st_default);
|
|
end;
|
|
statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
|
|
consume(_RKLAMMER);
|
|
end;
|
|
|
|
else
|
|
internalerror(15);
|
|
|
|
end;
|
|
in_args:=prev_in_args;
|
|
end;
|
|
|
|
|
|
{ reads the parameter for a subroutine call }
|
|
procedure do_proc_call(sym:tsym;st:tsymtable;getaddr:boolean;var again : boolean;var p1:tnode);
|
|
var
|
|
prevafterassn : boolean;
|
|
hs,hs1 : tvarsym;
|
|
para,p2 : tnode;
|
|
hst : tsymtable;
|
|
aprocdef : tprocdef;
|
|
begin
|
|
prevafterassn:=afterassignment;
|
|
afterassignment:=false;
|
|
{ want we only determine the address of }
|
|
{ a subroutine ? }
|
|
if not(getaddr) then
|
|
begin
|
|
para:=nil;
|
|
if auto_inherited then
|
|
begin
|
|
hst:=symtablestack;
|
|
while assigned(hst) and (hst.symtabletype<>parasymtable) do
|
|
hst:=hst.next;
|
|
if assigned(hst) then
|
|
begin
|
|
hs:=tvarsym(hst.symindex.first);
|
|
while assigned(hs) do
|
|
begin
|
|
if hs.typ<>varsym then
|
|
internalerror(54382953);
|
|
{ if there is a localcopy then use that }
|
|
if assigned(hs.localvarsym) then
|
|
hs1:=hs.localvarsym
|
|
else
|
|
hs1:=hs;
|
|
para:=ccallparanode.create(cloadnode.create(hs1,hs1.owner),para);
|
|
hs:=tvarsym(hs.indexnext);
|
|
end;
|
|
end
|
|
else
|
|
internalerror(54382954);
|
|
end
|
|
else
|
|
begin
|
|
if try_to_consume(_LKLAMMER) then
|
|
begin
|
|
para:=parse_paras(false,false);
|
|
consume(_RKLAMMER);
|
|
end;
|
|
end;
|
|
p1:=ccallnode.create(para,tprocsym(sym),st,p1);
|
|
include(p1.flags,nf_auto_inherited);
|
|
end
|
|
else
|
|
begin
|
|
{ address operator @: }
|
|
if not assigned(p1) then
|
|
begin
|
|
if (st.symtabletype=withsymtable) and
|
|
(st.defowner.deftype=objectdef) then
|
|
begin
|
|
p1:=tnode(twithsymtable(st).withrefnode).getcopy;
|
|
end
|
|
else
|
|
begin
|
|
{ we must provide a method pointer, if it isn't given, }
|
|
{ it is self }
|
|
if (st.symtabletype=objectsymtable) then
|
|
p1:=cselfnode.create(tobjectdef(st.defowner));
|
|
end;
|
|
end;
|
|
|
|
{ generate a methodcallnode or proccallnode }
|
|
{ we shouldn't convert things like @tcollection.load }
|
|
if assigned(getprocvardef) then
|
|
aprocdef:=Tprocsym(sym).search_procdef_byprocvardef(getprocvardef)
|
|
else
|
|
aprocdef:=nil;
|
|
p2:=cloadnode.create_procvar(sym,aprocdef,st);
|
|
if assigned(p1) then
|
|
tloadnode(p2).set_mp(p1);
|
|
p1:=p2;
|
|
|
|
{ no postfix operators }
|
|
again:=false;
|
|
end;
|
|
afterassignment:=prevafterassn;
|
|
end;
|
|
|
|
procedure handle_procvar(pv : tprocvardef;var p2 : tnode; getaddr: boolean);
|
|
|
|
procedure doconv(procvar : tprocvardef;var t : tnode);
|
|
var
|
|
hp : tnode;
|
|
currprocdef : tprocdef;
|
|
begin
|
|
hp:=nil;
|
|
currprocdef:=tcallnode(t).symtableprocentry.search_procdef_byprocvardef(procvar);
|
|
if assigned(currprocdef) then
|
|
begin
|
|
hp:=cloadnode.create_procvar(tprocsym(tcallnode(t).symtableprocentry),currprocdef,tcallnode(t).symtableproc);
|
|
if (po_methodpointer in procvar.procoptions) then
|
|
tloadnode(hp).set_mp(tnode(tcallnode(t).methodpointer).getcopy);
|
|
t.destroy;
|
|
t:=hp;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if ((m_tp_procvar in aktmodeswitches) or
|
|
not getaddr) then
|
|
if (p2.nodetype=calln) and
|
|
{ a procvar can't have parameters! }
|
|
not assigned(tcallnode(p2).left) then
|
|
doconv(pv,p2)
|
|
else
|
|
if (p2.nodetype=typeconvn) and
|
|
(ttypeconvnode(p2).left.nodetype=calln) and
|
|
{ a procvar can't have parameters! }
|
|
not assigned(tcallnode(ttypeconvnode(p2).left).left) then
|
|
doconv(pv,ttypeconvnode(p2).left);
|
|
end;
|
|
|
|
|
|
{ the following procedure handles the access to a property symbol }
|
|
procedure handle_propertysym(sym : tsym;st : tsymtable;var p1 : tnode; getaddr: boolean);
|
|
|
|
procedure symlist_to_node(var p1:tnode;pl:tsymlist);
|
|
var
|
|
plist : psymlistitem;
|
|
begin
|
|
plist:=pl.firstsym;
|
|
while assigned(plist) do
|
|
begin
|
|
case plist^.sltype of
|
|
sl_load :
|
|
begin
|
|
{ p1 can already contain the loadnode of
|
|
the class variable. Then we need to use a
|
|
subscriptn. If no tree is found (with block), then
|
|
generate a loadn }
|
|
if assigned(p1) then
|
|
p1:=csubscriptnode.create(plist^.sym,p1)
|
|
else
|
|
p1:=cloadnode.create(plist^.sym,st);
|
|
end;
|
|
sl_subscript :
|
|
p1:=csubscriptnode.create(plist^.sym,p1);
|
|
sl_vec :
|
|
p1:=cvecnode.create(p1,cordconstnode.create(plist^.value,s32bittype,true));
|
|
else
|
|
internalerror(200110205);
|
|
end;
|
|
plist:=plist^.next;
|
|
end;
|
|
include(p1.flags,nf_isproperty);
|
|
end;
|
|
|
|
var
|
|
paras : tnode;
|
|
p2 : tnode;
|
|
begin
|
|
paras:=nil;
|
|
{ property parameters? read them only if the property really }
|
|
{ has parameters }
|
|
if (ppo_hasparameters in tpropertysym(sym).propoptions) then
|
|
begin
|
|
if token=_LECKKLAMMER then
|
|
begin
|
|
consume(_LECKKLAMMER);
|
|
paras:=parse_paras(false,true);
|
|
consume(_RECKKLAMMER);
|
|
end;
|
|
end;
|
|
{ indexed property }
|
|
if (ppo_indexed in tpropertysym(sym).propoptions) then
|
|
begin
|
|
p2:=cordconstnode.create(tpropertysym(sym).index,tpropertysym(sym).indextype,true);
|
|
paras:=ccallparanode.create(p2,paras);
|
|
end;
|
|
{ we need only a write property if a := follows }
|
|
{ if not(afterassignment) and not(in_args) then }
|
|
if token=_ASSIGNMENT then
|
|
begin
|
|
{ write property: }
|
|
if not tpropertysym(sym).writeaccess.empty then
|
|
begin
|
|
case tpropertysym(sym).writeaccess.firstsym^.sym.typ of
|
|
procsym :
|
|
begin
|
|
{ generate the method call }
|
|
p1:=ccallnode.create(paras,
|
|
tprocsym(tpropertysym(sym).writeaccess.firstsym^.sym),st,p1);
|
|
paras:=nil;
|
|
consume(_ASSIGNMENT);
|
|
{ read the expression }
|
|
if tpropertysym(sym).proptype.def.deftype=procvardef then
|
|
getprocvardef:=tprocvardef(tpropertysym(sym).proptype.def);
|
|
p2:=comp_expr(true);
|
|
if assigned(getprocvardef) then
|
|
handle_procvar(getprocvardef,p2,getaddr);
|
|
tcallnode(p1).left:=ccallparanode.create(p2,tcallnode(p1).left);
|
|
include(tcallnode(p1).flags,nf_isproperty);
|
|
getprocvardef:=nil;
|
|
end;
|
|
varsym :
|
|
begin
|
|
{ generate access code }
|
|
symlist_to_node(p1,tpropertysym(sym).writeaccess);
|
|
consume(_ASSIGNMENT);
|
|
{ read the expression }
|
|
p2:=comp_expr(true);
|
|
p1:=cassignmentnode.create(p1,p2);
|
|
end
|
|
else
|
|
begin
|
|
p1:=cerrornode.create;
|
|
Message(parser_e_no_procedure_to_access_property);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
p1:=cerrornode.create;
|
|
Message(parser_e_no_procedure_to_access_property);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ read property: }
|
|
if not tpropertysym(sym).readaccess.empty then
|
|
begin
|
|
case tpropertysym(sym).readaccess.firstsym^.sym.typ of
|
|
varsym :
|
|
begin
|
|
{ generate access code }
|
|
symlist_to_node(p1,tpropertysym(sym).readaccess);
|
|
end;
|
|
procsym :
|
|
begin
|
|
{ generate the method call }
|
|
p1:=ccallnode.create(paras,tprocsym(tpropertysym(sym).readaccess.firstsym^.sym),st,p1);
|
|
paras:=nil;
|
|
include(p1.flags,nf_isproperty);
|
|
end
|
|
else
|
|
begin
|
|
p1:=cerrornode.create;
|
|
Message(type_e_mismatch);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ error, no function to read property }
|
|
p1:=cerrornode.create;
|
|
Message(parser_e_no_procedure_to_access_property);
|
|
end;
|
|
end;
|
|
{ release paras if not used }
|
|
if assigned(paras) then
|
|
paras.free;
|
|
end;
|
|
|
|
|
|
{ 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);
|
|
|
|
var
|
|
static_name : string;
|
|
isclassref : boolean;
|
|
srsymtable : tsymtable;
|
|
|
|
begin
|
|
if sym=nil then
|
|
begin
|
|
{ pattern is still valid unless
|
|
there is another ID just after the ID of sym }
|
|
Message1(sym_e_id_no_member,pattern);
|
|
p1.free;
|
|
p1:=cerrornode.create;
|
|
{ try to clean up }
|
|
again:=false;
|
|
end
|
|
else
|
|
begin
|
|
if assigned(p1) then
|
|
begin
|
|
if not assigned(p1.resulttype.def) then
|
|
do_resulttypepass(p1);
|
|
isclassref:=(p1.resulttype.def.deftype=classrefdef);
|
|
end
|
|
else
|
|
isclassref:=false;
|
|
|
|
{ we assume, that only procsyms and varsyms are in an object }
|
|
{ symbol table, for classes, properties are allowed }
|
|
case sym.typ of
|
|
procsym:
|
|
begin
|
|
do_proc_call(sym,sym.owner,
|
|
(getaddr and not(token in [_CARET,_POINT])) or
|
|
(assigned(getprocvardef) and
|
|
((block_type=bt_const) or
|
|
((m_tp_procvar in aktmodeswitches) and
|
|
(proc_to_procvar_equal(tprocsym(sym).first_procdef,getprocvardef)>te_incompatible)
|
|
)
|
|
)
|
|
),again,p1);
|
|
if (block_type=bt_const) and
|
|
assigned(getprocvardef) then
|
|
handle_procvar(getprocvardef,p1,getaddr);
|
|
{ we need to know which procedure is called }
|
|
do_resulttypepass(p1);
|
|
{ now we know the real method e.g. we can check for a class method }
|
|
if isclassref and
|
|
(p1.nodetype=calln) and
|
|
assigned(tcallnode(p1).procdefinition) and
|
|
not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and
|
|
not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then
|
|
Message(parser_e_only_class_methods_via_class_ref);
|
|
end;
|
|
varsym:
|
|
begin
|
|
if isclassref then
|
|
Message(parser_e_only_class_methods_via_class_ref);
|
|
if (sp_static in sym.symoptions) then
|
|
begin
|
|
static_name:=lower(sym.owner.name^)+'_'+sym.name;
|
|
searchsym(static_name,sym,srsymtable);
|
|
check_hints(sym);
|
|
p1.free;
|
|
p1:=cloadnode.create(sym,srsymtable);
|
|
end
|
|
else
|
|
p1:=csubscriptnode.create(sym,p1);
|
|
end;
|
|
propertysym:
|
|
begin
|
|
if isclassref then
|
|
Message(parser_e_only_class_methods_via_class_ref);
|
|
handle_propertysym(sym,sym.owner,p1,getaddr);
|
|
end;
|
|
else internalerror(16);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
Factor
|
|
****************************************************************************}
|
|
{$ifdef fpc}
|
|
{$maxfpuregisters 0}
|
|
{$endif fpc}
|
|
|
|
function factor(getaddr : boolean) : tnode;
|
|
|
|
{---------------------------------------------
|
|
Is_func_ret
|
|
---------------------------------------------}
|
|
|
|
function is_func_ret(var p1:tnode;var sym : tsym;var srsymtable:tsymtable) : boolean;
|
|
var
|
|
p : tprocinfo;
|
|
storesymtablestack : tsymtable;
|
|
begin
|
|
is_func_ret:=false;
|
|
if not assigned(procinfo) or
|
|
((sym.typ<>funcretsym) and ((procinfo.flags and pi_operator)=0)) then
|
|
exit;
|
|
p:=procinfo;
|
|
while assigned(p) do
|
|
begin
|
|
{ is this an access to a function result? Accessing _RESULT is
|
|
always allowed and funcretn is generated }
|
|
if assigned(p.procdef.funcretsym) and
|
|
((sym=tsym(p.procdef.resultfuncretsym)) or
|
|
((sym=tsym(p.procdef.funcretsym)) or
|
|
((sym=tsym(otsym)) and ((p.flags and pi_operator)<>0))) and
|
|
(not is_void(p.procdef.rettype.def)) and
|
|
(token<>_LKLAMMER) and
|
|
(not (not(m_fpc in aktmodeswitches) and (afterassignment or in_args)))
|
|
) then
|
|
begin
|
|
if ((sym=tsym(otsym)) and
|
|
((p.flags and pi_operator)<>0)) then
|
|
inc(otsym.refs);
|
|
p1:=cfuncretnode.create(p.procdef.funcretsym);
|
|
is_func_ret:=true;
|
|
if tfuncretsym(p.procdef.funcretsym).funcretstate=vs_declared then
|
|
begin
|
|
tfuncretsym(p.procdef.funcretsym).funcretstate:=vs_declared_and_first_found;
|
|
include(p1.flags,nf_is_first_funcret);
|
|
end;
|
|
exit;
|
|
end;
|
|
p:=p.parent;
|
|
end;
|
|
{ we must use the function call, update the
|
|
sym to be the procsym }
|
|
if (sym.typ=funcretsym) then
|
|
begin
|
|
storesymtablestack:=symtablestack;
|
|
symtablestack:=sym.owner.next;
|
|
searchsym(sym.name,sym,srsymtable);
|
|
check_hints(sym);
|
|
if not assigned(sym) then
|
|
sym:=generrorsym;
|
|
if (sym.typ<>procsym) then
|
|
Message(cg_e_illegal_expression);
|
|
symtablestack:=storesymtablestack;
|
|
end;
|
|
end;
|
|
|
|
{---------------------------------------------
|
|
Factor_read_id
|
|
---------------------------------------------}
|
|
|
|
procedure factor_read_id(var p1:tnode;var again:boolean);
|
|
var
|
|
pc : pchar;
|
|
len : longint;
|
|
srsym : tsym;
|
|
possible_error : boolean;
|
|
srsymtable : tsymtable;
|
|
htype : ttype;
|
|
static_name : string;
|
|
begin
|
|
{ allow post fix operators }
|
|
again:=true;
|
|
consume_sym(srsym,srsymtable);
|
|
if not is_func_ret(p1,srsym,srsymtable) then
|
|
begin
|
|
{ check semantics of private }
|
|
if (srsym.typ in [propertysym,procsym,varsym]) and
|
|
(srsym.owner.symtabletype=objectsymtable) then
|
|
begin
|
|
if (sp_private in srsym.symoptions) and
|
|
(tobjectdef(srsym.owner.defowner).owner.symtabletype=globalsymtable) and
|
|
(tobjectdef(srsym.owner.defowner).owner.unitid<>0) then
|
|
Message(parser_e_cant_access_private_member);
|
|
end;
|
|
case srsym.typ of
|
|
absolutesym :
|
|
begin
|
|
p1:=cloadnode.create(srsym,srsymtable);
|
|
end;
|
|
|
|
varsym :
|
|
begin
|
|
{ are we in a class method ? }
|
|
if (srsym.owner.symtabletype=objectsymtable) and
|
|
assigned(aktprocsym) and
|
|
(po_classmethod in aktprocdef.procoptions) then
|
|
Message(parser_e_only_class_methods);
|
|
if (sp_static in srsym.symoptions) then
|
|
begin
|
|
static_name:=lower(srsym.owner.name^)+'_'+srsym.name;
|
|
searchsym(static_name,srsym,srsymtable);
|
|
check_hints(srsym);
|
|
end;
|
|
p1:=cloadnode.create(srsym,srsymtable);
|
|
if tvarsym(srsym).varstate=vs_declared then
|
|
begin
|
|
include(p1.flags,nf_first);
|
|
{ set special between first loaded until checked in resulttypepass }
|
|
tvarsym(srsym).varstate:=vs_declared_and_first_found;
|
|
end;
|
|
end;
|
|
|
|
typedconstsym :
|
|
begin
|
|
p1:=cloadnode.create(srsym,srsymtable);
|
|
end;
|
|
|
|
syssym :
|
|
begin
|
|
p1:=statement_syssym(tsyssym(srsym).number);
|
|
end;
|
|
|
|
typesym :
|
|
begin
|
|
htype.setsym(srsym);
|
|
if not assigned(htype.def) then
|
|
begin
|
|
again:=false;
|
|
end
|
|
else
|
|
begin
|
|
if token=_LKLAMMER then
|
|
begin
|
|
consume(_LKLAMMER);
|
|
p1:=comp_expr(true);
|
|
consume(_RKLAMMER);
|
|
p1:=ctypeconvnode.create(p1,htype);
|
|
include(p1.flags,nf_explizit);
|
|
end
|
|
else { not LKLAMMER }
|
|
if (token=_POINT) and
|
|
is_object(htype.def) then
|
|
begin
|
|
consume(_POINT);
|
|
if assigned(procinfo) and
|
|
assigned(procinfo._class) and
|
|
not(getaddr) then
|
|
begin
|
|
if procinfo._class.is_related(tobjectdef(htype.def)) then
|
|
begin
|
|
p1:=ctypenode.create(htype);
|
|
{ search also in inherited methods }
|
|
srsym:=searchsym_in_class(tobjectdef(htype.def),pattern);
|
|
check_hints(srsym);
|
|
consume(_ID);
|
|
do_member_read(false,srsym,p1,again);
|
|
end
|
|
else
|
|
begin
|
|
Message(parser_e_no_super_class);
|
|
again:=false;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ allows @TObject.Load }
|
|
{ also allows static methods and variables }
|
|
p1:=ctypenode.create(htype);
|
|
{ TP allows also @TMenu.Load if Load is only }
|
|
{ defined in an anchestor class }
|
|
srsym:=search_class_member(tobjectdef(htype.def),pattern);
|
|
check_hints(srsym);
|
|
if not assigned(srsym) then
|
|
Message1(sym_e_id_no_member,pattern)
|
|
else if not(getaddr) and not(sp_static in srsym.symoptions) then
|
|
Message(sym_e_only_static_in_static)
|
|
else
|
|
begin
|
|
consume(_ID);
|
|
do_member_read(getaddr,srsym,p1,again);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ class reference ? }
|
|
if is_class(htype.def) then
|
|
begin
|
|
if getaddr and (token=_POINT) then
|
|
begin
|
|
consume(_POINT);
|
|
{ allows @Object.Method }
|
|
{ also allows static methods and variables }
|
|
p1:=ctypenode.create(htype);
|
|
{ TP allows also @TMenu.Load if Load is only }
|
|
{ defined in an anchestor class }
|
|
srsym:=search_class_member(tobjectdef(htype.def),pattern);
|
|
check_hints(srsym);
|
|
if not assigned(srsym) then
|
|
Message1(sym_e_id_no_member,pattern)
|
|
else
|
|
begin
|
|
consume(_ID);
|
|
do_member_read(getaddr,srsym,p1,again);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
p1:=ctypenode.create(htype);
|
|
{ For a type block we simply return only
|
|
the type. For all other blocks we return
|
|
a loadvmt node }
|
|
if (block_type<>bt_type) then
|
|
p1:=cloadvmtnode.create(p1);
|
|
end;
|
|
end
|
|
else
|
|
p1:=ctypenode.create(htype);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
enumsym :
|
|
begin
|
|
p1:=genenumnode(tenumsym(srsym));
|
|
end;
|
|
|
|
constsym :
|
|
begin
|
|
case tconstsym(srsym).consttyp of
|
|
constint :
|
|
begin
|
|
{ do a very dirty trick to bootstrap this code }
|
|
if (tconstsym(srsym).value.valueord>=-(int64(2147483647)+int64(1))) and
|
|
(tconstsym(srsym).value.valueord<=2147483647) then
|
|
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,s32bittype,true)
|
|
else if (tconstsym(srsym).value.valueord > maxlongint) and
|
|
(tconstsym(srsym).value.valueord <= int64(maxlongint)+int64(maxlongint)+1) then
|
|
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,u32bittype,true)
|
|
else
|
|
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,cs64bittype,true);
|
|
end;
|
|
conststring :
|
|
begin
|
|
len:=tconstsym(srsym).value.len;
|
|
if not(cs_ansistrings in aktlocalswitches) and (len>255) then
|
|
len:=255;
|
|
getmem(pc,len+1);
|
|
move(pchar(tconstsym(srsym).value.valueptr)^,pc^,len);
|
|
pc[len]:=#0;
|
|
p1:=cstringconstnode.createpchar(pc,len);
|
|
end;
|
|
constchar :
|
|
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,cchartype,true);
|
|
constreal :
|
|
p1:=crealconstnode.create(pbestreal(tconstsym(srsym).value.valueptr)^,pbestrealtype^);
|
|
constbool :
|
|
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,booltype,true);
|
|
constset :
|
|
p1:=csetconstnode.create(pconstset(tconstsym(srsym).value.valueptr),tconstsym(srsym).consttype);
|
|
constord :
|
|
p1:=cordconstnode.create(tconstsym(srsym).value.valueord,tconstsym(srsym).consttype,true);
|
|
constpointer :
|
|
p1:=cpointerconstnode.create(tconstsym(srsym).value.valueordptr,tconstsym(srsym).consttype);
|
|
constnil :
|
|
p1:=cnilnode.create;
|
|
constresourcestring:
|
|
begin
|
|
p1:=cloadnode.create(srsym,srsymtable);
|
|
do_resulttypepass(p1);
|
|
p1.resulttype:=cansistringtype;
|
|
end;
|
|
constguid :
|
|
p1:=cguidconstnode.create(pguid(tconstsym(srsym).value.valueptr)^);
|
|
end;
|
|
end;
|
|
|
|
procsym :
|
|
begin
|
|
{ are we in a class method ? }
|
|
possible_error:=(srsym.owner.symtabletype=objectsymtable) and
|
|
not(is_interface(tdef(srsym.owner.defowner))) and
|
|
assigned(aktprocsym) and
|
|
(po_classmethod in aktprocdef.procoptions);
|
|
do_proc_call(srsym,srsymtable,
|
|
(getaddr and not(token in [_CARET,_POINT])) or
|
|
(assigned(getprocvardef) and
|
|
((block_type=bt_const) or
|
|
((m_tp_procvar in aktmodeswitches) and
|
|
(proc_to_procvar_equal(tprocsym(srsym).first_procdef,getprocvardef)>te_incompatible)
|
|
)
|
|
)
|
|
),again,p1);
|
|
if (block_type=bt_const) and
|
|
assigned(getprocvardef) then
|
|
handle_procvar(getprocvardef,p1,getaddr);
|
|
{ we need to know which procedure is called }
|
|
if possible_error then
|
|
begin
|
|
do_resulttypepass(p1);
|
|
if not(po_classmethod in tcallnode(p1).procdefinition.procoptions) then
|
|
Message(parser_e_only_class_methods);
|
|
end;
|
|
end;
|
|
|
|
propertysym :
|
|
begin
|
|
{ access to property in a method }
|
|
{ are we in a class method ? }
|
|
if (srsym.owner.symtabletype=objectsymtable) and
|
|
assigned(aktprocsym) and
|
|
(po_classmethod in aktprocdef.procoptions) then
|
|
Message(parser_e_only_class_methods);
|
|
{ no method pointer }
|
|
p1:=nil;
|
|
handle_propertysym(srsym,srsymtable,p1,getaddr);
|
|
end;
|
|
|
|
labelsym :
|
|
begin
|
|
consume(_COLON);
|
|
if tlabelsym(srsym).defined then
|
|
Message(sym_e_label_already_defined);
|
|
tlabelsym(srsym).defined:=true;
|
|
p1:=clabelnode.create(tlabelsym(srsym),nil);
|
|
end;
|
|
|
|
errorsym :
|
|
begin
|
|
p1:=cerrornode.create;
|
|
if token=_LKLAMMER then
|
|
begin
|
|
consume(_LKLAMMER);
|
|
parse_paras(false,false);
|
|
consume(_RKLAMMER);
|
|
end;
|
|
end;
|
|
|
|
else
|
|
begin
|
|
p1:=cerrornode.create;
|
|
Message(cg_e_illegal_expression);
|
|
end;
|
|
end; { end case }
|
|
end;
|
|
end;
|
|
|
|
{---------------------------------------------
|
|
Factor_Read_Set
|
|
---------------------------------------------}
|
|
|
|
{ Read a set between [] }
|
|
function factor_read_set:tnode;
|
|
var
|
|
p1,p2 : tnode;
|
|
lastp,
|
|
buildp : tarrayconstructornode;
|
|
begin
|
|
buildp:=nil;
|
|
{ be sure that a least one arrayconstructn is used, also for an
|
|
empty [] }
|
|
if token=_RECKKLAMMER then
|
|
buildp:=carrayconstructornode.create(nil,buildp)
|
|
else
|
|
begin
|
|
while true do
|
|
begin
|
|
p1:=comp_expr(true);
|
|
if token=_POINTPOINT then
|
|
begin
|
|
consume(_POINTPOINT);
|
|
p2:=comp_expr(true);
|
|
p1:=carrayconstructorrangenode.create(p1,p2);
|
|
end;
|
|
{ insert at the end of the tree, to get the correct order }
|
|
if not assigned(buildp) then
|
|
begin
|
|
buildp:=carrayconstructornode.create(p1,nil);
|
|
lastp:=buildp;
|
|
end
|
|
else
|
|
begin
|
|
lastp.right:=carrayconstructornode.create(p1,nil);
|
|
lastp:=tarrayconstructornode(lastp.right);
|
|
end;
|
|
{ there could be more elements }
|
|
if token=_COMMA then
|
|
consume(_COMMA)
|
|
else
|
|
break;
|
|
end;
|
|
end;
|
|
factor_read_set:=buildp;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------
|
|
PostFixOperators
|
|
---------------------------------------------}
|
|
|
|
procedure postfixoperators(var p1:tnode;var again:boolean);
|
|
|
|
{ tries to avoid syntax errors after invalid qualifiers }
|
|
procedure recoverconsume_postfixops;
|
|
|
|
begin
|
|
while true do
|
|
begin
|
|
case token of
|
|
_CARET:
|
|
consume(_CARET);
|
|
_POINT:
|
|
begin
|
|
consume(_POINT);
|
|
if token=_ID then
|
|
consume(_ID);
|
|
end;
|
|
_LECKKLAMMER:
|
|
begin
|
|
consume(_LECKKLAMMER);
|
|
repeat
|
|
comp_expr(true);
|
|
if token=_COMMA then
|
|
consume(_COMMA)
|
|
else
|
|
break;
|
|
until false;
|
|
consume(_RECKKLAMMER);
|
|
end
|
|
else
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
store_static : boolean;
|
|
protsym : tpropertysym;
|
|
p2,p3 : tnode;
|
|
hsym : tsym;
|
|
classh : tobjectdef;
|
|
begin
|
|
again:=true;
|
|
while again do
|
|
begin
|
|
{ we need the resulttype }
|
|
do_resulttypepass(p1);
|
|
if codegenerror then
|
|
begin
|
|
recoverconsume_postfixops;
|
|
exit;
|
|
end;
|
|
{ handle token }
|
|
case token of
|
|
_CARET:
|
|
begin
|
|
consume(_CARET);
|
|
if (p1.resulttype.def.deftype<>pointerdef) then
|
|
begin
|
|
{ ^ as binary operator is a problem!!!! (FK) }
|
|
again:=false;
|
|
Message(cg_e_invalid_qualifier);
|
|
recoverconsume_postfixops;
|
|
p1.destroy;
|
|
p1:=cerrornode.create;
|
|
end
|
|
else
|
|
begin
|
|
p1:=cderefnode.create(p1);
|
|
end;
|
|
end;
|
|
|
|
_LECKKLAMMER:
|
|
begin
|
|
if is_class_or_interface(p1.resulttype.def) then
|
|
begin
|
|
{ default property }
|
|
protsym:=search_default_property(tobjectdef(p1.resulttype.def));
|
|
if not(assigned(protsym)) then
|
|
begin
|
|
p1.destroy;
|
|
p1:=cerrornode.create;
|
|
again:=false;
|
|
message(parser_e_no_default_property_available);
|
|
end
|
|
else
|
|
handle_propertysym(protsym,protsym.owner,p1,getaddr);
|
|
end
|
|
else
|
|
begin
|
|
consume(_LECKKLAMMER);
|
|
repeat
|
|
case p1.resulttype.def.deftype of
|
|
pointerdef:
|
|
begin
|
|
{ support delphi autoderef }
|
|
if (tpointerdef(p1.resulttype.def).pointertype.def.deftype=arraydef) and
|
|
(m_autoderef in aktmodeswitches) then
|
|
begin
|
|
p1:=cderefnode.create(p1);
|
|
end;
|
|
p2:=comp_expr(true);
|
|
p1:=cvecnode.create(p1,p2);
|
|
end;
|
|
stringdef :
|
|
begin
|
|
p2:=comp_expr(true);
|
|
p1:=cvecnode.create(p1,p2);
|
|
end;
|
|
arraydef :
|
|
begin
|
|
p2:=comp_expr(true);
|
|
{ support SEG:OFS for go32v2 Mem[] }
|
|
if (target_info.system=system_i386_go32v2) and
|
|
(p1.nodetype=loadn) and
|
|
assigned(tloadnode(p1).symtableentry) and
|
|
assigned(tloadnode(p1).symtableentry.owner.name) and
|
|
(tloadnode(p1).symtableentry.owner.name^='SYSTEM') and
|
|
((tloadnode(p1).symtableentry.name='MEM') or
|
|
(tloadnode(p1).symtableentry.name='MEMW') or
|
|
(tloadnode(p1).symtableentry.name='MEML')) then
|
|
begin
|
|
if (token=_COLON) then
|
|
begin
|
|
consume(_COLON);
|
|
p3:=caddnode.create(muln,cordconstnode.create($10,s32bittype,false),p2);
|
|
p2:=comp_expr(true);
|
|
p2:=caddnode.create(addn,p2,p3);
|
|
p1:=cvecnode.create(p1,p2);
|
|
include(tvecnode(p1).flags,nf_memseg);
|
|
include(tvecnode(p1).flags,nf_memindex);
|
|
end
|
|
else
|
|
begin
|
|
p1:=cvecnode.create(p1,p2);
|
|
include(tvecnode(p1).flags,nf_memindex);
|
|
end;
|
|
end
|
|
else
|
|
p1:=cvecnode.create(p1,p2);
|
|
end;
|
|
else
|
|
begin
|
|
Message(cg_e_invalid_qualifier);
|
|
p1.destroy;
|
|
p1:=cerrornode.create;
|
|
comp_expr(true);
|
|
again:=false;
|
|
end;
|
|
end;
|
|
do_resulttypepass(p1);
|
|
if token=_COMMA then
|
|
consume(_COMMA)
|
|
else
|
|
break;
|
|
until false;
|
|
consume(_RECKKLAMMER);
|
|
end;
|
|
end;
|
|
|
|
_POINT :
|
|
begin
|
|
consume(_POINT);
|
|
if (p1.resulttype.def.deftype=pointerdef) and
|
|
(m_autoderef in aktmodeswitches) then
|
|
begin
|
|
p1:=cderefnode.create(p1);
|
|
do_resulttypepass(p1);
|
|
end;
|
|
case p1.resulttype.def.deftype of
|
|
recorddef:
|
|
begin
|
|
hsym:=tsym(trecorddef(p1.resulttype.def).symtable.search(pattern));
|
|
check_hints(hsym);
|
|
if assigned(hsym) and
|
|
(hsym.typ=varsym) then
|
|
p1:=csubscriptnode.create(hsym,p1)
|
|
else
|
|
begin
|
|
Message1(sym_e_illegal_field,pattern);
|
|
p1.destroy;
|
|
p1:=cerrornode.create;
|
|
end;
|
|
consume(_ID);
|
|
end;
|
|
variantdef:
|
|
begin
|
|
end;
|
|
classrefdef:
|
|
begin
|
|
classh:=tobjectdef(tclassrefdef(p1.resulttype.def).pointertype.def);
|
|
hsym:=searchsym_in_class(classh,pattern);
|
|
check_hints(hsym);
|
|
if hsym=nil then
|
|
begin
|
|
Message1(sym_e_id_no_member,pattern);
|
|
p1.destroy;
|
|
p1:=cerrornode.create;
|
|
{ try to clean up }
|
|
consume(_ID);
|
|
end
|
|
else
|
|
begin
|
|
consume(_ID);
|
|
do_member_read(getaddr,hsym,p1,again);
|
|
end;
|
|
end;
|
|
|
|
objectdef:
|
|
begin
|
|
store_static:=allow_only_static;
|
|
allow_only_static:=false;
|
|
classh:=tobjectdef(p1.resulttype.def);
|
|
hsym:=searchsym_in_class(classh,pattern);
|
|
check_hints(hsym);
|
|
allow_only_static:=store_static;
|
|
if hsym=nil then
|
|
begin
|
|
Message1(sym_e_id_no_member,pattern);
|
|
p1.destroy;
|
|
p1:=cerrornode.create;
|
|
{ try to clean up }
|
|
consume(_ID);
|
|
end
|
|
else
|
|
begin
|
|
consume(_ID);
|
|
do_member_read(getaddr,hsym,p1,again);
|
|
end;
|
|
end;
|
|
|
|
pointerdef:
|
|
begin
|
|
Message(cg_e_invalid_qualifier);
|
|
if tpointerdef(p1.resulttype.def).pointertype.def.deftype in [recorddef,objectdef,classrefdef] then
|
|
Message(parser_h_maybe_deref_caret_missing);
|
|
end;
|
|
|
|
else
|
|
begin
|
|
Message(cg_e_invalid_qualifier);
|
|
p1.destroy;
|
|
p1:=cerrornode.create;
|
|
consume(_ID);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
else
|
|
begin
|
|
{ is this a procedure variable ? }
|
|
if assigned(p1.resulttype.def) then
|
|
begin
|
|
if (p1.resulttype.def.deftype=procvardef) then
|
|
begin
|
|
if assigned(getprocvardef) and
|
|
equal_defs(p1.resulttype.def,getprocvardef) then
|
|
again:=false
|
|
else
|
|
if (token=_LKLAMMER) or
|
|
((tprocvardef(p1.resulttype.def).para.empty) and
|
|
(not((token in [_ASSIGNMENT,_UNEQUAL,_EQUAL]))) and
|
|
(not afterassignment) and
|
|
(not in_args)) then
|
|
begin
|
|
{ do this in a strange way }
|
|
{ it's not a clean solution }
|
|
p2:=p1;
|
|
p1:=ccallnode.create(nil,nil,nil,nil);
|
|
tcallnode(p1).set_procvar(p2);
|
|
if try_to_consume(_LKLAMMER) then
|
|
begin
|
|
tcallnode(p1).left:=parse_paras(false,false);
|
|
consume(_RKLAMMER);
|
|
end;
|
|
{ proc():= is never possible }
|
|
if token=_ASSIGNMENT then
|
|
begin
|
|
Message(cg_e_illegal_expression);
|
|
p1:=cerrornode.create;
|
|
again:=false;
|
|
end;
|
|
end
|
|
else
|
|
again:=false;
|
|
end
|
|
else
|
|
again:=false;
|
|
end
|
|
else
|
|
again:=false;
|
|
end;
|
|
end;
|
|
end; { while again }
|
|
end;
|
|
|
|
|
|
{---------------------------------------------
|
|
Factor (Main)
|
|
---------------------------------------------}
|
|
|
|
var
|
|
l : longint;
|
|
card : cardinal;
|
|
ic : TConstExprInt;
|
|
oldp1,
|
|
p1 : tnode;
|
|
code : integer;
|
|
again : boolean;
|
|
sym : tsym;
|
|
classh : tobjectdef;
|
|
d : bestreal;
|
|
hs : string;
|
|
htype : ttype;
|
|
filepos : tfileposinfo;
|
|
|
|
{---------------------------------------------
|
|
Helpers
|
|
---------------------------------------------}
|
|
|
|
procedure check_tokenpos;
|
|
begin
|
|
if (p1<>oldp1) then
|
|
begin
|
|
if assigned(p1) then
|
|
p1.set_tree_filepos(filepos);
|
|
oldp1:=p1;
|
|
filepos:=akttokenpos;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
oldp1:=nil;
|
|
p1:=nil;
|
|
filepos:=akttokenpos;
|
|
again:=false;
|
|
if token=_ID then
|
|
begin
|
|
factor_read_id(p1,again);
|
|
if again then
|
|
begin
|
|
check_tokenpos;
|
|
|
|
{ handle post fix operators }
|
|
postfixoperators(p1,again);
|
|
end;
|
|
end
|
|
else
|
|
case token of
|
|
_SELF :
|
|
begin
|
|
again:=true;
|
|
consume(_SELF);
|
|
if not assigned(procinfo._class) then
|
|
begin
|
|
p1:=cerrornode.create;
|
|
again:=false;
|
|
Message(parser_e_self_not_in_method);
|
|
end
|
|
else
|
|
begin
|
|
if (po_classmethod in aktprocdef.procoptions) then
|
|
begin
|
|
{ self in class methods is a class reference type }
|
|
htype.setdef(procinfo._class);
|
|
p1:=cselfnode.create(tclassrefdef.create(htype));
|
|
end
|
|
else
|
|
p1:=cselfnode.create(procinfo._class);
|
|
postfixoperators(p1,again);
|
|
end;
|
|
end;
|
|
|
|
_INHERITED :
|
|
begin
|
|
again:=true;
|
|
consume(_INHERITED);
|
|
if assigned(procinfo._class) then
|
|
begin
|
|
{ if inherited; only then we need the method with
|
|
the same name }
|
|
if token=_SEMICOLON then
|
|
begin
|
|
hs:=aktprocsym.name;
|
|
auto_inherited:=true
|
|
end
|
|
else
|
|
begin
|
|
hs:=pattern;
|
|
consume(_ID);
|
|
auto_inherited:=false;
|
|
end;
|
|
classh:=procinfo._class.childof;
|
|
sym:=searchsym_in_class(classh,hs);
|
|
check_hints(sym);
|
|
if assigned(sym) then
|
|
begin
|
|
if sym.typ=procsym then
|
|
begin
|
|
htype.setdef(classh);
|
|
p1:=ctypenode.create(htype);
|
|
end;
|
|
do_member_read(false,sym,p1,again);
|
|
end
|
|
else
|
|
begin
|
|
{ we didn't find a member in the parents so
|
|
we do nothing. This is compatible with delphi (PFV) }
|
|
again:=false;
|
|
p1:=cnothingnode.create;
|
|
end;
|
|
{ turn auto inheriting off }
|
|
auto_inherited:=false;
|
|
end
|
|
else
|
|
begin
|
|
Message(parser_e_generic_methods_only_in_methods);
|
|
again:=false;
|
|
p1:=cerrornode.create;
|
|
end;
|
|
postfixoperators(p1,again);
|
|
end;
|
|
|
|
_INTCONST :
|
|
begin
|
|
{ try cardinal first }
|
|
val(pattern,card,code);
|
|
if code<>0 then
|
|
begin
|
|
{ then longint }
|
|
valint(pattern,l,code);
|
|
if code <> 0 then
|
|
begin
|
|
{ then int64 }
|
|
val(pattern,ic,code);
|
|
if code<>0 then
|
|
begin
|
|
{finally float }
|
|
val(pattern,d,code);
|
|
if code<>0 then
|
|
begin
|
|
Message(cg_e_invalid_integer);
|
|
consume(_INTCONST);
|
|
l:=1;
|
|
p1:=cordconstnode.create(l,s32bittype,true);
|
|
end
|
|
else
|
|
begin
|
|
consume(_INTCONST);
|
|
p1:=crealconstnode.create(d,pbestrealtype^);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
consume(_INTCONST);
|
|
p1:=cordconstnode.create(ic,cs64bittype,true);
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
consume(_INTCONST);
|
|
p1:=cordconstnode.create(l,s32bittype,true)
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
consume(_INTCONST);
|
|
{ check whether the value isn't in the longint range as well }
|
|
{ (longint is easier to perform calculations with) (JM) }
|
|
if card <= $7fffffff then
|
|
{ no sign extension necessary, so not longint typecast (JM) }
|
|
p1:=cordconstnode.create(card,s32bittype,true)
|
|
else
|
|
p1:=cordconstnode.create(card,u32bittype,true)
|
|
end;
|
|
end;
|
|
|
|
_REALNUMBER :
|
|
begin
|
|
val(pattern,d,code);
|
|
if code<>0 then
|
|
begin
|
|
Message(parser_e_error_in_real);
|
|
d:=1.0;
|
|
end;
|
|
consume(_REALNUMBER);
|
|
p1:=crealconstnode.create(d,pbestrealtype^);
|
|
end;
|
|
|
|
_STRING :
|
|
begin
|
|
string_dec(htype);
|
|
{ STRING can be also a type cast }
|
|
if token=_LKLAMMER then
|
|
begin
|
|
consume(_LKLAMMER);
|
|
p1:=comp_expr(true);
|
|
consume(_RKLAMMER);
|
|
p1:=ctypeconvnode.create(p1,htype);
|
|
include(p1.flags,nf_explizit);
|
|
{ handle postfix operators here e.g. string(a)[10] }
|
|
again:=true;
|
|
postfixoperators(p1,again);
|
|
end
|
|
else
|
|
p1:=ctypenode.create(htype);
|
|
end;
|
|
|
|
_FILE :
|
|
begin
|
|
htype:=cfiletype;
|
|
consume(_FILE);
|
|
{ FILE can be also a type cast }
|
|
if token=_LKLAMMER then
|
|
begin
|
|
consume(_LKLAMMER);
|
|
p1:=comp_expr(true);
|
|
consume(_RKLAMMER);
|
|
p1:=ctypeconvnode.create(p1,htype);
|
|
include(p1.flags,nf_explizit);
|
|
{ handle postfix operators here e.g. string(a)[10] }
|
|
again:=true;
|
|
postfixoperators(p1,again);
|
|
end
|
|
else
|
|
begin
|
|
p1:=ctypenode.create(htype);
|
|
end;
|
|
end;
|
|
|
|
_CSTRING :
|
|
begin
|
|
p1:=cstringconstnode.createstr(pattern,st_default);
|
|
consume(_CSTRING);
|
|
end;
|
|
|
|
_CCHAR :
|
|
begin
|
|
p1:=cordconstnode.create(ord(pattern[1]),cchartype,true);
|
|
consume(_CCHAR);
|
|
end;
|
|
|
|
_CWSTRING:
|
|
begin
|
|
p1:=cstringconstnode.createwstr(patternw);
|
|
consume(_CWSTRING);
|
|
end;
|
|
|
|
_CWCHAR:
|
|
begin
|
|
p1:=cordconstnode.create(ord(getcharwidestring(patternw,0)),cwidechartype,true);
|
|
consume(_CWCHAR);
|
|
end;
|
|
|
|
_KLAMMERAFFE :
|
|
begin
|
|
consume(_KLAMMERAFFE);
|
|
got_addrn:=true;
|
|
{ support both @<x> and @(<x>) }
|
|
if try_to_consume(_LKLAMMER) then
|
|
begin
|
|
p1:=factor(true);
|
|
if token in [_CARET,_POINT,_LECKKLAMMER] then
|
|
begin
|
|
again:=true;
|
|
postfixoperators(p1,again);
|
|
end;
|
|
consume(_RKLAMMER);
|
|
end
|
|
else
|
|
p1:=factor(true);
|
|
if token in [_CARET,_POINT,_LECKKLAMMER] then
|
|
begin
|
|
again:=true;
|
|
postfixoperators(p1,again);
|
|
end;
|
|
got_addrn:=false;
|
|
p1:=caddrnode.create(p1);
|
|
if assigned(getprocvardef) and
|
|
(taddrnode(p1).left.nodetype = loadn) and
|
|
{ make sure we found a valid procedure, otherwise the }
|
|
{ "getprocvardef" will become the default in taddrnode }
|
|
{ while there should be an error (JM) }
|
|
assigned(tloadnode(taddrnode(p1).left).procdef) then
|
|
taddrnode(p1).getprocvardef:=getprocvardef;
|
|
end;
|
|
|
|
_LKLAMMER :
|
|
begin
|
|
consume(_LKLAMMER);
|
|
p1:=comp_expr(true);
|
|
consume(_RKLAMMER);
|
|
{ it's not a good solution }
|
|
{ but (a+b)^ makes some problems }
|
|
if token in [_CARET,_POINT,_LECKKLAMMER] then
|
|
begin
|
|
again:=true;
|
|
postfixoperators(p1,again);
|
|
end;
|
|
end;
|
|
|
|
_LECKKLAMMER :
|
|
begin
|
|
consume(_LECKKLAMMER);
|
|
p1:=factor_read_set;
|
|
consume(_RECKKLAMMER);
|
|
end;
|
|
|
|
_PLUS :
|
|
begin
|
|
consume(_PLUS);
|
|
p1:=factor(false);
|
|
end;
|
|
|
|
_MINUS :
|
|
begin
|
|
consume(_MINUS);
|
|
p1:=sub_expr(oppower,false);
|
|
p1:=cunaryminusnode.create(p1);
|
|
end;
|
|
|
|
_OP_NOT :
|
|
begin
|
|
consume(_OP_NOT);
|
|
p1:=factor(false);
|
|
p1:=cnotnode.create(p1);
|
|
end;
|
|
|
|
_TRUE :
|
|
begin
|
|
consume(_TRUE);
|
|
p1:=cordconstnode.create(1,booltype,false);
|
|
end;
|
|
|
|
_FALSE :
|
|
begin
|
|
consume(_FALSE);
|
|
p1:=cordconstnode.create(0,booltype,false);
|
|
end;
|
|
|
|
_NIL :
|
|
begin
|
|
consume(_NIL);
|
|
p1:=cnilnode.create;
|
|
{ It's really ugly code nil^, but delphi allows it }
|
|
if token in [_CARET] then
|
|
begin
|
|
again:=true;
|
|
postfixoperators(p1,again);
|
|
end;
|
|
end;
|
|
|
|
else
|
|
begin
|
|
p1:=cerrornode.create;
|
|
consume(token);
|
|
Message(cg_e_illegal_expression);
|
|
end;
|
|
end;
|
|
|
|
{ generate error node if no node is created }
|
|
if not assigned(p1) then
|
|
begin
|
|
{$ifdef EXTDEBUG}
|
|
Comment(V_Warning,'factor: p1=nil');
|
|
{$endif}
|
|
p1:=cerrornode.create;
|
|
end;
|
|
|
|
{ get the resulttype for the node }
|
|
if (not assigned(p1.resulttype.def)) then
|
|
do_resulttypepass(p1);
|
|
|
|
{ tp7 procvar handling, but not if the next token
|
|
will be a := }
|
|
check_tp_procvar(p1);
|
|
|
|
factor:=p1;
|
|
check_tokenpos;
|
|
end;
|
|
{$ifdef fpc}
|
|
{$maxfpuregisters default}
|
|
{$endif fpc}
|
|
|
|
{****************************************************************************
|
|
Sub_Expr
|
|
****************************************************************************}
|
|
const
|
|
{ Warning these stay be ordered !! }
|
|
operator_levels:array[Toperator_precedence] of set of Ttoken=
|
|
([_LT,_LTE,_GT,_GTE,_EQUAL,_UNEQUAL,_OP_IN,_OP_IS],
|
|
[_PLUS,_MINUS,_OP_OR,_OP_XOR],
|
|
[_CARET,_SYMDIF,_STARSTAR,_STAR,_SLASH,
|
|
_OP_AS,_OP_AND,_OP_DIV,_OP_MOD,_OP_SHL,_OP_SHR],
|
|
[_STARSTAR] );
|
|
|
|
function sub_expr(pred_level:Toperator_precedence;accept_equal : boolean):tnode;
|
|
{Reads a subexpression while the operators are of the current precedence
|
|
level, or any higher level. Replaces the old term, simpl_expr and
|
|
simpl2_expr.}
|
|
var
|
|
p1,p2 : tnode;
|
|
oldt : Ttoken;
|
|
filepos : tfileposinfo;
|
|
begin
|
|
if pred_level=highest_precedence then
|
|
p1:=factor(false)
|
|
else
|
|
p1:=sub_expr(succ(pred_level),true);
|
|
repeat
|
|
if (token in operator_levels[pred_level]) and
|
|
((token<>_EQUAL) or accept_equal) then
|
|
begin
|
|
oldt:=token;
|
|
filepos:=akttokenpos;
|
|
consume(token);
|
|
if pred_level=highest_precedence then
|
|
p2:=factor(false)
|
|
else
|
|
p2:=sub_expr(succ(pred_level),true);
|
|
case oldt of
|
|
_PLUS :
|
|
p1:=caddnode.create(addn,p1,p2);
|
|
_MINUS :
|
|
p1:=caddnode.create(subn,p1,p2);
|
|
_STAR :
|
|
p1:=caddnode.create(muln,p1,p2);
|
|
_SLASH :
|
|
p1:=caddnode.create(slashn,p1,p2);
|
|
_EQUAL :
|
|
p1:=caddnode.create(equaln,p1,p2);
|
|
_GT :
|
|
p1:=caddnode.create(gtn,p1,p2);
|
|
_LT :
|
|
p1:=caddnode.create(ltn,p1,p2);
|
|
_GTE :
|
|
p1:=caddnode.create(gten,p1,p2);
|
|
_LTE :
|
|
p1:=caddnode.create(lten,p1,p2);
|
|
_SYMDIF :
|
|
p1:=caddnode.create(symdifn,p1,p2);
|
|
_STARSTAR :
|
|
p1:=caddnode.create(starstarn,p1,p2);
|
|
_OP_AS :
|
|
p1:=casnode.create(p1,p2);
|
|
_OP_IN :
|
|
p1:=cinnode.create(p1,p2);
|
|
_OP_IS :
|
|
p1:=cisnode.create(p1,p2);
|
|
_OP_OR :
|
|
p1:=caddnode.create(orn,p1,p2);
|
|
_OP_AND :
|
|
p1:=caddnode.create(andn,p1,p2);
|
|
_OP_DIV :
|
|
p1:=cmoddivnode.create(divn,p1,p2);
|
|
_OP_NOT :
|
|
p1:=cnotnode.create(p1);
|
|
_OP_MOD :
|
|
p1:=cmoddivnode.create(modn,p1,p2);
|
|
_OP_SHL :
|
|
p1:=cshlshrnode.create(shln,p1,p2);
|
|
_OP_SHR :
|
|
p1:=cshlshrnode.create(shrn,p1,p2);
|
|
_OP_XOR :
|
|
p1:=caddnode.create(xorn,p1,p2);
|
|
_ASSIGNMENT :
|
|
p1:=cassignmentnode.create(p1,p2);
|
|
_CARET :
|
|
p1:=caddnode.create(caretn,p1,p2);
|
|
_UNEQUAL :
|
|
p1:=caddnode.create(unequaln,p1,p2);
|
|
end;
|
|
p1.set_tree_filepos(filepos);
|
|
end
|
|
else
|
|
break;
|
|
until false;
|
|
sub_expr:=p1;
|
|
end;
|
|
|
|
|
|
function comp_expr(accept_equal : boolean):tnode;
|
|
var
|
|
oldafterassignment : boolean;
|
|
p1 : tnode;
|
|
begin
|
|
oldafterassignment:=afterassignment;
|
|
afterassignment:=true;
|
|
p1:=sub_expr(opcompare,accept_equal);
|
|
{ get the resulttype for this expression }
|
|
if not assigned(p1.resulttype.def) then
|
|
do_resulttypepass(p1);
|
|
afterassignment:=oldafterassignment;
|
|
comp_expr:=p1;
|
|
end;
|
|
|
|
|
|
function expr : tnode;
|
|
|
|
var
|
|
p1,p2 : tnode;
|
|
oldafterassignment : boolean;
|
|
oldp1 : tnode;
|
|
filepos : tfileposinfo;
|
|
|
|
begin
|
|
oldafterassignment:=afterassignment;
|
|
p1:=sub_expr(opcompare,true);
|
|
{ get the resulttype for this expression }
|
|
if not assigned(p1.resulttype.def) then
|
|
do_resulttypepass(p1);
|
|
filepos:=akttokenpos;
|
|
check_tp_procvar(p1);
|
|
if token in [_ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
|
|
afterassignment:=true;
|
|
oldp1:=p1;
|
|
case token of
|
|
_POINTPOINT :
|
|
begin
|
|
consume(_POINTPOINT);
|
|
p2:=sub_expr(opcompare,true);
|
|
p1:=crangenode.create(p1,p2);
|
|
end;
|
|
_ASSIGNMENT :
|
|
begin
|
|
consume(_ASSIGNMENT);
|
|
if (p1.resulttype.def.deftype=procvardef) then
|
|
getprocvardef:=tprocvardef(p1.resulttype.def);
|
|
p2:=sub_expr(opcompare,true);
|
|
if assigned(getprocvardef) then
|
|
handle_procvar(getprocvardef,p2,true);
|
|
getprocvardef:=nil;
|
|
p1:=cassignmentnode.create(p1,p2);
|
|
end;
|
|
_PLUSASN :
|
|
begin
|
|
consume(_PLUSASN);
|
|
p2:=sub_expr(opcompare,true);
|
|
p1:=cassignmentnode.create(p1,caddnode.create(addn,p1.getcopy,p2));
|
|
end;
|
|
_MINUSASN :
|
|
begin
|
|
consume(_MINUSASN);
|
|
p2:=sub_expr(opcompare,true);
|
|
p1:=cassignmentnode.create(p1,caddnode.create(subn,p1.getcopy,p2));
|
|
end;
|
|
_STARASN :
|
|
begin
|
|
consume(_STARASN );
|
|
p2:=sub_expr(opcompare,true);
|
|
p1:=cassignmentnode.create(p1,caddnode.create(muln,p1.getcopy,p2));
|
|
end;
|
|
_SLASHASN :
|
|
begin
|
|
consume(_SLASHASN );
|
|
p2:=sub_expr(opcompare,true);
|
|
p1:=cassignmentnode.create(p1,caddnode.create(slashn,p1.getcopy,p2));
|
|
end;
|
|
end;
|
|
{ get the resulttype for this expression }
|
|
if not assigned(p1.resulttype.def) then
|
|
do_resulttypepass(p1);
|
|
afterassignment:=oldafterassignment;
|
|
if p1<>oldp1 then
|
|
p1.set_tree_filepos(filepos);
|
|
expr:=p1;
|
|
end;
|
|
|
|
{$ifdef int64funcresok}
|
|
function get_intconst:TConstExprInt;
|
|
{$else int64funcresok}
|
|
function get_intconst:longint;
|
|
{$endif int64funcresok}
|
|
{Reads an expression, tries to evalute it and check if it is an integer
|
|
constant. Then the constant is returned.}
|
|
var
|
|
p:tnode;
|
|
begin
|
|
p:=comp_expr(true);
|
|
if not codegenerror then
|
|
begin
|
|
if (p.nodetype<>ordconstn) or
|
|
not(is_integer(p.resulttype.def)) then
|
|
Message(cg_e_illegal_expression)
|
|
else
|
|
get_intconst:=tordconstnode(p).value;
|
|
end;
|
|
p.free;
|
|
end;
|
|
|
|
|
|
function get_stringconst:string;
|
|
{Reads an expression, tries to evaluate it and checks if it is a string
|
|
constant. Then the constant is returned.}
|
|
var
|
|
p:tnode;
|
|
begin
|
|
get_stringconst:='';
|
|
p:=comp_expr(true);
|
|
if p.nodetype<>stringconstn then
|
|
begin
|
|
if (p.nodetype=ordconstn) and is_char(p.resulttype.def) then
|
|
get_stringconst:=char(tordconstnode(p).value)
|
|
else
|
|
Message(cg_e_illegal_expression);
|
|
end
|
|
else
|
|
get_stringconst:=strpas(tstringconstnode(p).value_str);
|
|
p.free;
|
|
end;
|
|
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.96 2002-12-11 22:40:36 peter
|
|
* assigned(procvar) fix for delphi mode, fixes tb0430
|
|
|
|
Revision 1.95 2002/11/30 11:12:48 carl
|
|
+ checking for symbols used with hint directives is done mostly in pexpr
|
|
only now
|
|
|
|
Revision 1.94 2002/11/27 15:33:47 peter
|
|
* the never ending story of tp procvar hacks
|
|
|
|
Revision 1.93 2002/11/26 22:58:24 peter
|
|
* fix for tw2178. When a ^ or . follows a procsym then the procsym
|
|
needs to be called
|
|
|
|
Revision 1.92 2002/11/25 17:43:22 peter
|
|
* splitted defbase in defutil,symutil,defcmp
|
|
* merged isconvertable and is_equal into compare_defs(_ext)
|
|
* made operator search faster by walking the list only once
|
|
|
|
Revision 1.91 2002/11/22 22:48:10 carl
|
|
* memory optimization with tconstsym (1.5%)
|
|
|
|
Revision 1.90 2002/11/20 22:49:55 pierre
|
|
* commented check code tht was invalid in 1.1
|
|
|
|
Revision 1.89 2002/11/18 18:34:41 peter
|
|
* fix crash with EXTDEBUG code
|
|
|
|
Revision 1.88 2002/11/18 17:48:21 peter
|
|
* fix tw2209 (merged)
|
|
|
|
Revision 1.87 2002/11/18 17:31:58 peter
|
|
* pass proccalloption to ret_in_xxx and push_xxx functions
|
|
|
|
Revision 1.86 2002/10/05 00:48:57 peter
|
|
* support inherited; support for overload as it is handled by
|
|
delphi. This is only for delphi mode as it is working is
|
|
undocumented and hard to predict what is done
|
|
|
|
Revision 1.85 2002/10/04 21:13:59 peter
|
|
* ignore vecn,subscriptn when checking for a procvar loadn
|
|
|
|
Revision 1.84 2002/10/02 20:51:22 peter
|
|
* don't check interfaces for class methods
|
|
|
|
Revision 1.83 2002/10/02 18:20:52 peter
|
|
* Copy() is now internal syssym that calls compilerprocs
|
|
|
|
Revision 1.82 2002/09/30 07:00:48 florian
|
|
* fixes to common code to get the alpha compiler compiled applied
|
|
|
|
Revision 1.81 2002/09/16 19:06:14 peter
|
|
* allow ^ after nil
|
|
|
|
Revision 1.80 2002/09/07 15:25:07 peter
|
|
* old logs removed and tabs fixed
|
|
|
|
Revision 1.79 2002/09/07 12:16:03 carl
|
|
* second part bug report 1996 fix, testrange in cordconstnode
|
|
only called if option is set (also make parsing a tiny faster)
|
|
|
|
Revision 1.78 2002/09/03 16:26:27 daniel
|
|
* Make Tprocdef.defs protected
|
|
|
|
Revision 1.77 2002/08/18 20:06:24 peter
|
|
* inlining is now also allowed in interface
|
|
* renamed write/load to ppuwrite/ppuload
|
|
* tnode storing in ppu
|
|
* nld,ncon,nbas are already updated for storing in ppu
|
|
|
|
Revision 1.76 2002/08/17 09:23:39 florian
|
|
* first part of procinfo rewrite
|
|
|
|
Revision 1.75 2002/08/01 16:37:47 jonas
|
|
- removed some superfluous "in_paras := true" statements
|
|
|
|
Revision 1.74 2002/07/26 21:15:41 florian
|
|
* rewrote the system handling
|
|
|
|
Revision 1.73 2002/07/23 09:51:23 daniel
|
|
* Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups
|
|
are worth comitting.
|
|
|
|
Revision 1.72 2002/07/20 11:57:55 florian
|
|
* types.pas renamed to defbase.pas because D6 contains a types
|
|
unit so this would conflicts if D6 programms are compiled
|
|
+ Willamette/SSE2 instructions to assembler added
|
|
|
|
Revision 1.71 2002/07/16 15:34:20 florian
|
|
* exit is now a syssym instead of a keyword
|
|
|
|
Revision 1.70 2002/07/06 20:18:02 carl
|
|
* longstring declaration now gives parser error since its not supported!
|
|
|
|
Revision 1.69 2002/06/12 15:46:14 jonas
|
|
* fixed web bug 1995
|
|
|
|
Revision 1.68 2002/05/18 13:34:12 peter
|
|
* readded missing revisions
|
|
|
|
Revision 1.67 2002/05/16 19:46:43 carl
|
|
+ defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
|
|
+ try to fix temp allocation (still in ifdef)
|
|
+ generic constructor calls
|
|
+ start of tassembler / tmodulebase class cleanup
|
|
|
|
Revision 1.65 2002/05/12 16:53:09 peter
|
|
* moved entry and exitcode to ncgutil and cgobj
|
|
* foreach gets extra argument for passing local data to the
|
|
iterator function
|
|
* -CR checks also class typecasts at runtime by changing them
|
|
into as
|
|
* fixed compiler to cycle with the -CR option
|
|
* fixed stabs with elf writer, finally the global variables can
|
|
be watched
|
|
* removed a lot of routines from cga unit and replaced them by
|
|
calls to cgobj
|
|
* u32bit-s32bit updates for and,or,xor nodes. When one element is
|
|
u32bit then the other is typecasted also to u32bit without giving
|
|
a rangecheck warning/error.
|
|
* fixed pascal calling method with reversing also the high tree in
|
|
the parast, detected by tcalcst3 test
|
|
|
|
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
|
|
requires EXTDEBUG define to actually write the info
|
|
* fixed various internal errors and crashes due recent code changes
|
|
|
|
Revision 1.62 2002/04/16 16:11:17 peter
|
|
* using inherited; without a parent having the same function
|
|
will do nothing like delphi
|
|
|
|
Revision 1.61 2002/04/07 13:31:36 carl
|
|
+ change unit use
|
|
|
|
Revision 1.60 2002/04/01 20:57:13 jonas
|
|
* fixed web bug 1907
|
|
* fixed some other procvar related bugs (all related to accepting procvar
|
|
constructs with either too many or too little parameters)
|
|
(both merged, includes second typo fix of pexpr.pas)
|
|
|
|
Revision 1.59 2002/03/31 20:26:35 jonas
|
|
+ a_loadfpu_* and a_loadmm_* methods in tcg
|
|
* register allocation is now handled by a class and is mostly processor
|
|
independent (+rgobj.pas and i386/rgcpu.pas)
|
|
* temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
|
|
* some small improvements and fixes to the optimizer
|
|
* some register allocation fixes
|
|
* some fpuvaroffset fixes in the unary minus node
|
|
* push/popusedregisters is now called rg.save/restoreusedregisters and
|
|
(for i386) uses temps instead of push/pop's when using -Op3 (that code is
|
|
also better optimizable)
|
|
* fixed and optimized register saving/restoring for new/dispose nodes
|
|
* LOC_FPU locations now also require their "register" field to be set to
|
|
R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
|
|
- list field removed of the tnode class because it's not used currently
|
|
and can cause hard-to-find bugs
|
|
|
|
}
|