mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-06 19:28:38 +02:00
1666 lines
74 KiB
ObjectPascal
1666 lines
74 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998 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;
|
|
|
|
interface
|
|
|
|
uses symtable,tree;
|
|
|
|
{ reads a whole expression }
|
|
function expr : ptree;
|
|
|
|
{ reads a single factor }
|
|
function factor(getaddr : boolean) : ptree;
|
|
|
|
{ the ID token has to be consumed before calling this function }
|
|
procedure do_member_read(const sym : psym;var p1 : ptree;
|
|
var pd : pdef;var again : boolean);
|
|
|
|
function get_intconst:longint;
|
|
|
|
function get_stringconst:string;
|
|
|
|
implementation
|
|
|
|
uses
|
|
cobjects,globals,scanner,aasm,pass_1,systems,
|
|
hcodegen,types,verbose
|
|
{ parser specific stuff }
|
|
,pbase,pdecl
|
|
{ processor specific stuff }
|
|
{$ifdef i386}
|
|
,i386
|
|
{$endif}
|
|
{$ifdef m68k}
|
|
,m68k
|
|
{$endif}
|
|
;
|
|
|
|
function parse_paras(_colon,in_prop_paras : boolean) : ptree;
|
|
|
|
var
|
|
p1,p2 : ptree;
|
|
end_of_paras : ttoken;
|
|
|
|
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;
|
|
p2:=nil;
|
|
inc(parsing_para_level);
|
|
while true do
|
|
begin
|
|
p1:=expr;
|
|
p2:=gencallparanode(p1,p2);
|
|
|
|
{ it's for the str(l:5,s); }
|
|
if _colon and (token=COLON) then
|
|
begin
|
|
consume(COLON);
|
|
p1:=expr;
|
|
p2:=gencallparanode(p1,p2);
|
|
p2^.is_colon_para:=true;
|
|
if token=COLON then
|
|
begin
|
|
consume(COLON);
|
|
p1:=expr;
|
|
p2:=gencallparanode(p1,p2);
|
|
p2^.is_colon_para:=true;
|
|
end
|
|
end;
|
|
if token=COMMA then
|
|
consume(COMMA)
|
|
else
|
|
break;
|
|
end;
|
|
dec(parsing_para_level);
|
|
parse_paras:=p2;
|
|
end;
|
|
|
|
function statement_syssym(l : longint;var pd : pdef) : ptree;
|
|
{ const regnames:array[R_EAX..R_EDI] of string[3]=
|
|
('EAX','ECX','EDX','EBX','','','ESI','EDI'); }
|
|
|
|
var
|
|
p1,p2 : ptree;
|
|
paras : ptree;
|
|
prev_in_args : boolean;
|
|
Store_valid : boolean;
|
|
|
|
begin
|
|
prev_in_args:=in_args;
|
|
Store_valid:=Must_be_valid;
|
|
case l of
|
|
in_ord_x :
|
|
begin
|
|
consume(LKLAMMER);
|
|
in_args:=true;
|
|
Must_be_valid:=true;
|
|
p1:=expr;
|
|
consume(RKLAMMER);
|
|
do_firstpass(p1);
|
|
p1:=geninlinenode(in_ord_x,p1);
|
|
do_firstpass(p1);
|
|
statement_syssym := p1;
|
|
pd:=p1^.resulttype;
|
|
end;
|
|
in_typeof_x : begin
|
|
consume(LKLAMMER);
|
|
in_args:=true;
|
|
p1:=expr;
|
|
consume(RKLAMMER);
|
|
pd:=voidpointerdef;
|
|
if p1^.treetype=typen then
|
|
begin
|
|
if (p1^.resulttype=nil) then
|
|
begin
|
|
Message(sym_e_type_mismatch);
|
|
statement_syssym:=genzeronode(errorn);
|
|
end
|
|
else
|
|
if p1^.resulttype^.deftype=objectdef then
|
|
statement_syssym:=geninlinenode(in_typeof_x,p1)
|
|
else
|
|
begin
|
|
Message(sym_e_type_mismatch);
|
|
statement_syssym:=genzeronode(errorn);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Must_be_valid:=false;
|
|
do_firstpass(p1);
|
|
if (p1^.resulttype=nil) then
|
|
begin
|
|
Message(sym_e_type_mismatch);
|
|
statement_syssym:=genzeronode(errorn)
|
|
end
|
|
else
|
|
if p1^.resulttype^.deftype=objectdef then
|
|
statement_syssym:=geninlinenode(in_typeof_x,p1)
|
|
else
|
|
begin
|
|
Message(sym_e_type_mismatch);
|
|
statement_syssym:=genzeronode(errorn)
|
|
end;
|
|
end;
|
|
end;
|
|
in_sizeof_x : begin
|
|
consume(LKLAMMER);
|
|
in_args:=true;
|
|
p1:=expr;
|
|
consume(RKLAMMER);
|
|
pd:=s32bitdef;
|
|
if p1^.treetype=typen then
|
|
begin
|
|
statement_syssym:=genordinalconstnode(
|
|
p1^.resulttype^.size,pd);
|
|
{ p1 not needed !}
|
|
disposetree(p1);
|
|
end
|
|
else
|
|
begin
|
|
Must_be_valid:=false;
|
|
do_firstpass(p1);
|
|
if p1^.resulttype^.deftype<>objectdef then
|
|
begin
|
|
statement_syssym:=genordinalconstnode(
|
|
p1^.resulttype^.size,pd);
|
|
{ p1 not needed !}
|
|
disposetree(p1);
|
|
end
|
|
else
|
|
begin
|
|
statement_syssym:=geninlinenode(in_sizeof_x,p1);
|
|
end;
|
|
end;
|
|
end;
|
|
in_assigned_x : begin
|
|
consume(LKLAMMER);
|
|
in_args:=true;
|
|
p1:=expr;
|
|
Must_be_valid:=true;
|
|
do_firstpass(p1);
|
|
case p1^.resulttype^.deftype of
|
|
pointerdef,procvardef,
|
|
classrefdef:
|
|
;
|
|
objectdef:
|
|
if not(pobjectdef(p1^.resulttype)^.isclass) then
|
|
Message(parser_e_illegal_parameter_list);
|
|
else Message(parser_e_illegal_parameter_list);
|
|
end;
|
|
p2:=gencallparanode(p1,nil);
|
|
p2:=geninlinenode(in_assigned_x,p2);
|
|
consume(RKLAMMER);
|
|
pd:=booldef;
|
|
statement_syssym:=p2;
|
|
end;
|
|
in_ofs_x : begin
|
|
consume(LKLAMMER);
|
|
in_args:=true;
|
|
p1:=expr;
|
|
p1:=gensinglenode(addrn,p1);
|
|
Must_be_valid:=false;
|
|
do_firstpass(p1);
|
|
{ Ofs() returns a longint, not a pointer }
|
|
p1^.resulttype:=u32bitdef;
|
|
pd:=p1^.resulttype;
|
|
consume(RKLAMMER);
|
|
statement_syssym:=p1;
|
|
end;
|
|
in_seg_x : begin
|
|
consume(LKLAMMER);
|
|
in_args:=true;
|
|
p1:=expr;
|
|
do_firstpass(p1);
|
|
if p1^.location.loc<>LOC_REFERENCE then
|
|
Message(cg_e_illegal_expression);
|
|
p1:=genordinalconstnode(0,s32bitdef);
|
|
Must_be_valid:=false;
|
|
pd:=s32bitdef;
|
|
consume(RKLAMMER);
|
|
statement_syssym:=p1;
|
|
end;
|
|
in_high_x,
|
|
in_low_x : begin
|
|
consume(LKLAMMER);
|
|
in_args:=true;
|
|
p1:=expr;
|
|
do_firstpass(p1);
|
|
Must_be_valid:=false;
|
|
p2:=geninlinenode(l,p1);
|
|
consume(RKLAMMER);
|
|
pd:=s32bitdef;
|
|
statement_syssym:=p2;
|
|
end;
|
|
in_succ_x,
|
|
in_pred_x : begin
|
|
consume(LKLAMMER);
|
|
in_args:=true;
|
|
p1:=expr;
|
|
do_firstpass(p1);
|
|
Must_be_valid:=false;
|
|
p2:=geninlinenode(l,p1);
|
|
consume(RKLAMMER);
|
|
pd:=p1^.resulttype;
|
|
statement_syssym:=p2;
|
|
end;
|
|
in_inc_x,
|
|
in_dec_x : begin
|
|
consume(LKLAMMER);
|
|
in_args:=true;
|
|
p1:=expr;
|
|
p2:=gencallparanode(p1,nil);
|
|
Must_be_valid:=false;
|
|
if token=COMMA then
|
|
begin
|
|
consume(COMMA);
|
|
p1:=expr;
|
|
p2:=gencallparanode(p1,p2);
|
|
end;
|
|
statement_syssym:=geninlinenode(l,p2);
|
|
consume(RKLAMMER);
|
|
pd:=voiddef;
|
|
end;
|
|
in_concat_x : begin
|
|
consume(LKLAMMER);
|
|
in_args:=true;
|
|
p2:=nil;
|
|
while true do
|
|
begin
|
|
p1:=expr;
|
|
Must_be_valid:=true;
|
|
do_firstpass(p1);
|
|
if not((p1^.resulttype^.deftype=stringdef) or
|
|
((p1^.resulttype^.deftype=orddef) and
|
|
(porddef(p1^.resulttype)^.typ=uchar)
|
|
)
|
|
) then Message(parser_e_illegal_parameter_list);
|
|
if p2<>nil then
|
|
p2:=gennode(addn,p2,p1)
|
|
else p2:=p1;
|
|
if token=COMMA then
|
|
consume(COMMA)
|
|
else break;
|
|
end;
|
|
consume(RKLAMMER);
|
|
pd:=cstringdef;
|
|
statement_syssym:=p2;
|
|
end;
|
|
in_read_x,
|
|
in_readln_x : begin
|
|
if token=LKLAMMER then
|
|
begin
|
|
consume(LKLAMMER);
|
|
in_args:=true;
|
|
Must_be_valid:=false;
|
|
paras:=parse_paras(false,false);
|
|
consume(RKLAMMER);
|
|
end
|
|
else
|
|
paras:=nil;
|
|
pd:=voiddef;
|
|
p1:=geninlinenode(l,paras);
|
|
do_firstpass(p1);
|
|
statement_syssym := p1;
|
|
end;
|
|
in_write_x,
|
|
in_writeln_x : begin
|
|
if token=LKLAMMER then
|
|
begin
|
|
consume(LKLAMMER);
|
|
in_args:=true;
|
|
Must_be_valid:=true;
|
|
paras:=parse_paras(true,false);
|
|
consume(RKLAMMER);
|
|
end
|
|
else
|
|
paras:=nil;
|
|
pd:=voiddef;
|
|
p1 := geninlinenode(l,paras);
|
|
do_firstpass(p1);
|
|
statement_syssym := p1;
|
|
end;
|
|
in_str_x_string : begin
|
|
consume(LKLAMMER);
|
|
in_args:=true;
|
|
paras:=parse_paras(true,false);
|
|
consume(RKLAMMER);
|
|
p1 := geninlinenode(l,paras);
|
|
do_firstpass(p1);
|
|
statement_syssym := p1;
|
|
pd:=voiddef;
|
|
end;
|
|
{in_val_x : begin
|
|
consume(LKLAMMER);
|
|
paras:=parse_paras(false);
|
|
consume(RKLAMMER);
|
|
p1 := geninlinenode(l,paras);
|
|
do_firstpass(p1);
|
|
statement_syssym := p1;
|
|
pd:=voiddef;
|
|
end; }
|
|
else internalerror(15);
|
|
end;
|
|
in_args:=prev_in_args;
|
|
Must_be_valid:=Store_valid;
|
|
end;
|
|
|
|
{ reads the parameter for a subroutine call }
|
|
procedure do_proc_call(getaddr : boolean;var again : boolean;var p1:Ptree;var pd:Pdef);
|
|
|
|
var
|
|
prev_in_args : boolean;
|
|
prevafterassn : boolean;
|
|
|
|
begin
|
|
prev_in_args:=in_args;
|
|
prevafterassn:=afterassignment;
|
|
afterassignment:=false;
|
|
{ want we only determine the address of }
|
|
{ a subroutine }
|
|
if not(getaddr) then
|
|
begin
|
|
if token=LKLAMMER then
|
|
begin
|
|
consume(LKLAMMER);
|
|
in_args:=true;
|
|
p1^.left:=parse_paras(false,false);
|
|
consume(RKLAMMER);
|
|
end
|
|
else p1^.left:=nil;
|
|
|
|
{ do firstpass because we need the }
|
|
{ result type }
|
|
do_firstpass(p1);
|
|
end
|
|
else
|
|
begin
|
|
{ address operator @: }
|
|
p1^.left:=nil;
|
|
{ forget pd }
|
|
pd:=nil;
|
|
{ no postfix operators }
|
|
again:=false;
|
|
end;
|
|
pd:=p1^.resulttype;
|
|
in_args:=prev_in_args;
|
|
afterassignment:=prevafterassn;
|
|
end;
|
|
|
|
{ the ID token has to be consumed before calling this function }
|
|
procedure do_member_read(const sym : psym;var p1 : ptree;
|
|
var pd : pdef;var again : boolean);
|
|
|
|
var
|
|
static_name : string;
|
|
paras : ptree;
|
|
oldafterassignment,isclassref : boolean;
|
|
p2 : ptree;
|
|
|
|
begin
|
|
if sym=nil then
|
|
begin
|
|
Message(sym_e_id_no_member);
|
|
disposetree(p1);
|
|
p1:=genzeronode(errorn);
|
|
{ try to clean up }
|
|
pd:=generrordef;
|
|
again:=false;
|
|
end
|
|
else
|
|
begin
|
|
isclassref:=pd^.deftype=classrefdef;
|
|
{ we assume, that only procsyms and varsyms are in an object }
|
|
{ symbol table, for classes, properties are allowed }
|
|
case sym^.typ of
|
|
procsym:
|
|
begin
|
|
p1:=genmethodcallnode(pprocsym(sym),srsymtable,p1);
|
|
do_proc_call(false,again,p1,pd);
|
|
{ now we know the real method e.g. we can check for }
|
|
{ a class method }
|
|
if isclassref and ((p1^.procdefinition^.options and (poclassmethod or poconstructor))=0) 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 (sym^.properties and sp_static)<>0 then
|
|
begin
|
|
static_name:=lowercase(srsymtable^.name^)+'_'+sym^.name;
|
|
getsym(static_name,true);
|
|
disposetree(p1);
|
|
p1:=genloadnode(pvarsym(srsym),srsymtable);
|
|
end
|
|
else
|
|
p1:=gensubscriptnode(pvarsym(sym),p1);
|
|
pd:=pvarsym(sym)^.definition;
|
|
end;
|
|
propertysym:
|
|
begin
|
|
if isclassref then
|
|
Message(parser_e_only_class_methods_via_class_ref);
|
|
paras:=nil;
|
|
{ property parameters? }
|
|
if token=LECKKLAMMER then
|
|
begin
|
|
consume(LECKKLAMMER);
|
|
paras:=parse_paras(false,true);
|
|
consume(RECKKLAMMER);
|
|
end;
|
|
{ indexed property }
|
|
if (ppropertysym(sym)^.options and ppo_indexed)<>0 then
|
|
begin
|
|
p2:=genordinalconstnode(ppropertysym(sym)^.index,s32bitdef);
|
|
paras:=gencallparanode(p2,paras);
|
|
end;
|
|
if not(afterassignment) and not(in_args) then
|
|
begin
|
|
{ write property: }
|
|
{ no result }
|
|
pd:=voiddef;
|
|
if assigned(ppropertysym(sym)^.writeaccesssym) then
|
|
begin
|
|
if ppropertysym(sym)^.writeaccesssym^.typ=procsym then
|
|
begin
|
|
{ generate the method call }
|
|
p1:=genmethodcallnode(pprocsym(
|
|
ppropertysym(sym)^.writeaccesssym),
|
|
ppropertysym(sym)^.writeaccesssym^.owner,p1);
|
|
p1^.left:=paras;
|
|
{ to be on the save side }
|
|
oldafterassignment:=afterassignment;
|
|
consume(ASSIGNMENT);
|
|
{ read the expression }
|
|
afterassignment:=true;
|
|
p2:=expr;
|
|
p1^.left:=gencallparanode(p2,p1^.left);
|
|
afterassignment:=oldafterassignment;
|
|
end
|
|
else if ppropertysym(sym)^.writeaccesssym^.typ=varsym then
|
|
begin
|
|
if assigned(paras) then
|
|
message(parser_e_no_paras_allowed);
|
|
p1:=gensubscriptnode(pvarsym(
|
|
ppropertysym(sym)^.readaccesssym),p1);
|
|
{ to be on the save side }
|
|
oldafterassignment:=afterassignment;
|
|
consume(ASSIGNMENT);
|
|
{ read the expression }
|
|
afterassignment:=true;
|
|
p2:=expr;
|
|
p1:=gennode(assignn,p1,p2);
|
|
afterassignment:=oldafterassignment;
|
|
end
|
|
else
|
|
begin
|
|
p1:=genzeronode(errorn);
|
|
Message(parser_e_no_procedure_to_access_property);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
p1:=genzeronode(errorn);
|
|
Message(parser_e_no_procedure_to_access_property);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ read property: }
|
|
pd:=ppropertysym(sym)^.proptype;
|
|
if assigned(ppropertysym(sym)^.readaccesssym) then
|
|
begin
|
|
if ppropertysym(sym)^.readaccesssym^.typ=varsym then
|
|
begin
|
|
if assigned(paras) then
|
|
message(parser_e_no_paras_allowed);
|
|
p1:=gensubscriptnode(pvarsym(
|
|
ppropertysym(sym)^.readaccesssym),p1);
|
|
pd:=pvarsym(sym)^.definition;
|
|
end
|
|
else if ppropertysym(sym)^.readaccesssym^.typ=procsym then
|
|
begin
|
|
{ generate the method call }
|
|
p1:=genmethodcallnode(pprocsym(
|
|
ppropertysym(sym)^.readaccesssym),
|
|
ppropertysym(sym)^.readaccesssym^.owner,p1);
|
|
{ insert paras }
|
|
p1^.left:=paras;
|
|
{ if we should be delphi compatible }
|
|
{ then force type conversion }
|
|
if cs_delphi2_compatible in aktswitches then
|
|
p1:=gentypeconvnode(p1,pd);
|
|
end
|
|
else
|
|
begin
|
|
p1:=genzeronode(errorn);
|
|
Message(sym_e_type_mismatch);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ error, no function to read property }
|
|
p1:=genzeronode(errorn);
|
|
Message(parser_e_no_procedure_to_access_property);
|
|
end;
|
|
end;
|
|
end;
|
|
else internalerror(16);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function factor(getaddr : boolean) : ptree;
|
|
|
|
var
|
|
l : longint;
|
|
p1,p2,p3 : ptree;
|
|
code : word;
|
|
pd,pd2 : pdef;
|
|
unit_specific, again : boolean;
|
|
static_name : string;
|
|
sym : pvarsym;
|
|
classh : pobjectdef;
|
|
d : bestreal;
|
|
constset : pconstset;
|
|
|
|
|
|
{ p1 and p2 must contain valid values }
|
|
procedure postfixoperators;
|
|
|
|
begin
|
|
while again do
|
|
begin
|
|
case token of
|
|
CARET:
|
|
begin
|
|
consume(CARET);
|
|
if pd^.deftype<>pointerdef then
|
|
begin
|
|
{ ^ as binary operator is a problem!!!! (FK) }
|
|
again:=false;
|
|
Message(cg_e_invalid_qualifier);
|
|
disposetree(p1);
|
|
p1:=genzeronode(errorn);
|
|
end
|
|
else
|
|
begin
|
|
p1:=gensinglenode(derefn,p1);
|
|
pd:=ppointerdef(pd)^.definition;
|
|
end;
|
|
end;
|
|
LECKKLAMMER : begin
|
|
consume(LECKKLAMMER);
|
|
repeat
|
|
if (pd^.deftype<>arraydef) and
|
|
(pd^.deftype<>stringdef) and
|
|
(pd^.deftype<>pointerdef) then
|
|
begin
|
|
Message(cg_e_invalid_qualifier);
|
|
disposetree(p1);
|
|
p1:=genzeronode(errorn);
|
|
end
|
|
else if (pd^.deftype=pointerdef) then
|
|
begin
|
|
p2:=expr;
|
|
p1:=gennode(vecn,p1,p2);
|
|
pd:=ppointerdef(pd)^.definition;
|
|
end
|
|
else
|
|
begin
|
|
p2:=expr;
|
|
{ support SEG:OFS for go32v2 Mem[] }
|
|
if (target_info.target=target_GO32V2) and
|
|
assigned(p1^.symtableentry) and
|
|
assigned(p1^.symtableentry^.owner^.name) and
|
|
(p1^.symtableentry^.owner^.name^='SYSTEM') and
|
|
((p1^.symtableentry^.name='MEM') or
|
|
(p1^.symtableentry^.name='MEMW') or
|
|
(p1^.symtableentry^.name='MEML')) then
|
|
begin
|
|
if (token=COLON) then
|
|
begin
|
|
consume(COLON);
|
|
p3:=gennode(muln,genordinalconstnode($10,s32bitdef),p2);
|
|
p2:=expr;
|
|
p2:=gennode(addn,p2,p3);
|
|
p1:=gennode(vecn,p1,p2);
|
|
p1^.memseg:=true;
|
|
p1^.memindex:=true;
|
|
end
|
|
else
|
|
begin
|
|
p1:=gennode(vecn,p1,p2);
|
|
p1^.memindex:=true;
|
|
end;
|
|
end
|
|
else
|
|
p1:=gennode(vecn,p1,p2);
|
|
if pd^.deftype=stringdef then
|
|
pd:=cchardef
|
|
else
|
|
pd:=parraydef(pd)^.definition;
|
|
end;
|
|
if token=COMMA then consume(COMMA)
|
|
else break;
|
|
until false;
|
|
consume(RECKKLAMMER);
|
|
end;
|
|
POINT : begin
|
|
consume(POINT);
|
|
case pd^.deftype of
|
|
recorddef:
|
|
begin
|
|
sym:=pvarsym(precdef(pd)^.symtable^.search(pattern));
|
|
consume(ID);
|
|
if sym=nil then
|
|
begin
|
|
Message(sym_e_illegal_field);
|
|
disposetree(p1);
|
|
p1:=genzeronode(errorn);
|
|
end
|
|
else
|
|
begin
|
|
p1:=gensubscriptnode(sym,p1);
|
|
pd:=sym^.definition;
|
|
end;
|
|
end;
|
|
classrefdef:
|
|
begin
|
|
classh:=pobjectdef(pclassrefdef(pd)^.definition);
|
|
sym:=nil;
|
|
while assigned(classh) do
|
|
begin
|
|
sym:=pvarsym(classh^.publicsyms^.search(pattern));
|
|
srsymtable:=classh^.publicsyms;
|
|
if assigned(sym) then
|
|
break;
|
|
classh:=classh^.childof;
|
|
end;
|
|
consume(ID);
|
|
do_member_read(sym,p1,pd,again);
|
|
end;
|
|
objectdef:
|
|
begin
|
|
classh:=pobjectdef(pd);
|
|
sym:=nil;
|
|
while assigned(classh) do
|
|
begin
|
|
sym:=pvarsym(classh^.publicsyms^.search(pattern));
|
|
srsymtable:=classh^.publicsyms;
|
|
if assigned(sym) then
|
|
break;
|
|
classh:=classh^.childof;
|
|
end;
|
|
consume(ID);
|
|
do_member_read(sym,p1,pd,again);
|
|
end;
|
|
pointerdef:
|
|
begin
|
|
if ppointerdef(pd)^.definition^.deftype
|
|
in [recorddef,objectdef,classrefdef] then
|
|
begin
|
|
Message(cg_e_invalid_qualifier);
|
|
{ exterror:=strpnew(' may be pointer deref ^ is missing');
|
|
error(invalid_qualifizier); }
|
|
Comment(V_hint,' may be pointer deref ^ is missing');
|
|
end
|
|
else
|
|
Message(cg_e_invalid_qualifier);
|
|
end
|
|
else
|
|
begin
|
|
Message(cg_e_invalid_qualifier);
|
|
disposetree(p1);
|
|
p1:=genzeronode(errorn);
|
|
end;
|
|
end;
|
|
end;
|
|
else
|
|
begin
|
|
{ is this a procedure variable ? }
|
|
if assigned(pd) then
|
|
begin
|
|
if (pd^.deftype=procvardef) then
|
|
begin
|
|
if getprocvar then
|
|
again:=false
|
|
else
|
|
if (token=LKLAMMER) or
|
|
((pprocvardef(pd)^.para1=nil) and
|
|
(token<>ASSIGNMENT) and (not in_args)) then
|
|
begin
|
|
{ do this in a strange way }
|
|
{ it's not a clean solution }
|
|
p2:=p1;
|
|
p1:=gencallnode(nil,
|
|
nil);
|
|
p1^.right:=p2;
|
|
p1^.unit_specific:=unit_specific;
|
|
if token=LKLAMMER then
|
|
begin
|
|
consume(LKLAMMER);
|
|
p1^.left:=parse_paras(false,false);
|
|
consume(RKLAMMER);
|
|
end;
|
|
pd:=pprocvardef(pd)^.retdef;
|
|
p1^.resulttype:=pd;
|
|
end
|
|
else again:=false;
|
|
p1^.resulttype:=pd;
|
|
end
|
|
else again:=false;
|
|
end
|
|
else again:=false;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure do_set(p : pconstset;pos : longint);
|
|
|
|
var
|
|
l : longint;
|
|
|
|
begin
|
|
if (pos>255) or
|
|
(pos<0) then
|
|
Message(parser_e_illegal_set_expr);
|
|
l:=pos div 8;
|
|
{ do we allow the same twice }
|
|
if (p^[l] and (1 shl (pos mod 8)))<>0 then
|
|
Message(parser_e_illegal_set_expr);
|
|
p^[l]:=p^[l] or (1 shl (pos mod 8));
|
|
end;
|
|
|
|
var
|
|
possible_error : boolean;
|
|
storesymtablestack : psymtable;
|
|
actprocsym : pprocsym;
|
|
|
|
begin
|
|
case token of
|
|
ID:
|
|
begin
|
|
{ allow post fix operators }
|
|
again:=true;
|
|
if (cs_delphi2_compatible in aktswitches) and
|
|
(pattern='RESULT') and
|
|
assigned(aktprocsym) and
|
|
(procinfo.retdef<>pdef(voiddef)) then
|
|
begin
|
|
consume(ID);
|
|
p1:=genzeronode(funcretn);
|
|
pd:=procinfo.retdef;
|
|
{$ifdef TEST_FUNCRET}
|
|
p1^.funcretprocinfo:=pointer(@procinfo);
|
|
p1^.retdef:=pd;
|
|
{$endif TEST_FUNCRET}
|
|
end
|
|
else
|
|
begin
|
|
getsym(pattern,true);
|
|
consume(ID);
|
|
{ is this an access to a function result ? }
|
|
if assigned(aktprocsym) and
|
|
((srsym^.name=aktprocsym^.name) or
|
|
((pvarsym(srsym)=opsym) and
|
|
((pprocdef(aktprocsym^.definition)^.options and pooperator)<>0))) and
|
|
(procinfo.retdef<>pdef(voiddef)) and
|
|
(token<>LKLAMMER) and
|
|
(not ((cs_tp_compatible in aktswitches) and
|
|
(afterassignment or in_args))) then
|
|
begin
|
|
p1:=genzeronode(funcretn);
|
|
pd:=procinfo.retdef;
|
|
{$ifdef TEST_FUNCRET}
|
|
p1^.funcretprocinfo:=pointer(@procinfo);
|
|
p1^.retdef:=pd;
|
|
{$endif TEST_FUNCRET}
|
|
end
|
|
else
|
|
{ else it's a normal symbol }
|
|
begin
|
|
if srsym^.typ=unitsym then
|
|
begin
|
|
consume(POINT);
|
|
getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
|
|
unit_specific:=true;
|
|
consume(ID);
|
|
end
|
|
else
|
|
unit_specific:=false;
|
|
case srsym^.typ of
|
|
absolutesym:
|
|
begin
|
|
p1:=genloadnode(pvarsym(srsym),srsymtable);
|
|
pd:=pabsolutesym(srsym)^.definition;
|
|
end;
|
|
varsym:
|
|
begin
|
|
{ are we in a class method ? }
|
|
if (srsymtable^.symtabletype=objectsymtable) and
|
|
assigned(aktprocsym) and
|
|
((aktprocsym^.definition^.options and poclassmethod)<>0) then
|
|
Message(parser_e_only_class_methods);
|
|
|
|
if (srsym^.properties and sp_static)<>0 then
|
|
begin
|
|
static_name:=lowercase(srsymtable^.name^)+'_'+srsym^.name;
|
|
getsym(static_name,true);
|
|
end;
|
|
p1:=genloadnode(pvarsym(srsym),srsymtable);
|
|
if pvarsym(srsym)^.is_valid=0 then
|
|
begin
|
|
p1^.is_first := true;
|
|
{ set special between first loaded
|
|
until checked in firstpass }
|
|
pvarsym(srsym)^.is_valid:=2;
|
|
end;
|
|
pd:=pvarsym(srsym)^.definition;
|
|
end;
|
|
typedconstsym:
|
|
begin
|
|
p1:=gentypedconstloadnode(ptypedconstsym(srsym),srsymtable);
|
|
pd:=ptypedconstsym(srsym)^.definition;
|
|
end;
|
|
syssym:
|
|
p1:=statement_syssym(psyssym(srsym)^.number,pd);
|
|
typesym:
|
|
begin
|
|
pd:=ptypesym(srsym)^.definition;
|
|
if token=LKLAMMER then
|
|
begin
|
|
consume(LKLAMMER);
|
|
p1:=expr;
|
|
consume(RKLAMMER);
|
|
p1:=gentypeconvnode(p1,pd);
|
|
p1^.explizit:=true;
|
|
end
|
|
else if (token=POINT) and
|
|
(pd^.deftype=objectdef) and
|
|
((pobjectdef(pd)^.options and oois_class)=0) then
|
|
begin
|
|
consume(POINT);
|
|
if assigned(procinfo._class) then
|
|
begin
|
|
if procinfo._class^.isrelated(pobjectdef(pd)) then
|
|
begin
|
|
p1:=genzeronode(typen);
|
|
p1^.resulttype:=pd;
|
|
srsymtable:=pobjectdef(pd)^.publicsyms;
|
|
sym:=pvarsym(srsymtable^.search(pattern));
|
|
consume(ID);
|
|
do_member_read(sym,p1,pd,again);
|
|
end
|
|
else
|
|
begin
|
|
Message(parser_e_no_super_class);
|
|
pd:=generrordef;
|
|
again:=false;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ allows @TObject.Load }
|
|
{ also allows static methods and variables }
|
|
|
|
p1:=genzeronode(typen);
|
|
p1^.resulttype:=pd;
|
|
srsymtable:=pobjectdef(pd)^.publicsyms;
|
|
sym:=pvarsym(srsymtable^.search(pattern));
|
|
if not(getaddr) and
|
|
((sym^.properties and sp_static)=0) then
|
|
Message(sym_e_only_static_in_static)
|
|
else
|
|
begin
|
|
consume(ID);
|
|
do_member_read(sym,p1,pd,again);
|
|
end;
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
{ class reference ? }
|
|
if (pd^.deftype=objectdef)
|
|
and ((pobjectdef(pd)^.options and oois_class)<>0) then
|
|
begin
|
|
p1:=genzeronode(typen);
|
|
p1^.resulttype:=pd;
|
|
pd:=new(pclassrefdef,init(pd));
|
|
p1:=gensinglenode(loadvmtn,p1);
|
|
p1^.resulttype:=pd;
|
|
end
|
|
else
|
|
begin
|
|
{ generate a type node }
|
|
{ (for typeof etc) }
|
|
p1:=genzeronode(typen);
|
|
p1^.resulttype:=pd;
|
|
pd:=voiddef;
|
|
end;
|
|
end;
|
|
end;
|
|
enumsym:
|
|
begin
|
|
p1:=genenumnode(penumsym(srsym));
|
|
pd:=p1^.resulttype;
|
|
end;
|
|
constsym:
|
|
begin
|
|
case pconstsym(srsym)^.consttype of
|
|
constint:
|
|
p1:=genordinalconstnode(pconstsym(srsym)^.value,s32bitdef);
|
|
conststring:
|
|
p1:=genstringconstnode(pstring(pconstsym(srsym)^.value)^);
|
|
constchar:
|
|
p1:=genordinalconstnode(pconstsym(srsym)^.value,cchardef);
|
|
constreal:
|
|
p1:=genrealconstnode(pdouble(pconstsym(srsym)^.value)^);
|
|
constbool:
|
|
p1:=genordinalconstnode(pconstsym(srsym)^.value,booldef);
|
|
constseta:
|
|
p1:=gensetconstruktnode(pconstset(pconstsym(srsym)^.value),
|
|
psetdef(pconstsym(srsym)^.definition));
|
|
constord:
|
|
p1:=genordinalconstnode(pconstsym(srsym)^.value,
|
|
pconstsym(srsym)^.definition);
|
|
end;
|
|
pd:=p1^.resulttype;
|
|
end;
|
|
procsym:
|
|
begin
|
|
{ are we in a class method ? }
|
|
possible_error:=(srsymtable^.symtabletype=objectsymtable) and
|
|
assigned(aktprocsym) and
|
|
((aktprocsym^.definition^.options and poclassmethod)<>0);
|
|
p1:=gencallnode(pprocsym(srsym),srsymtable);
|
|
p1^.unit_specific:=unit_specific;
|
|
do_proc_call(getaddr,again,p1,pd);
|
|
if possible_error and
|
|
((p1^.procdefinition^.options and poclassmethod)=0) then
|
|
Message(parser_e_only_class_methods);
|
|
end;
|
|
propertysym:
|
|
begin
|
|
{ access to property in a method }
|
|
|
|
{ are we in a class method ? }
|
|
if (srsymtable^.symtabletype=objectsymtable) and
|
|
assigned(aktprocsym) and
|
|
((aktprocsym^.definition^.options and poclassmethod)<>0) then
|
|
Message(parser_e_only_class_methods);
|
|
{ !!!!! }
|
|
end;
|
|
errorsym:
|
|
begin
|
|
p1:=genzeronode(errorn);
|
|
pd:=generrordef;
|
|
if token=LKLAMMER then
|
|
begin
|
|
consume(LKLAMMER);
|
|
parse_paras(false,false);
|
|
consume(RKLAMMER);
|
|
end;
|
|
end;
|
|
else
|
|
begin
|
|
p1:=genzeronode(errorn);
|
|
pd:=generrordef;
|
|
Message(cg_e_illegal_expression);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{ handle post fix operators }
|
|
postfixoperators;
|
|
end;
|
|
_NEW : begin
|
|
consume(_NEW);
|
|
consume(LKLAMMER);
|
|
p1:=factor(false);
|
|
if p1^.treetype<>typen then
|
|
Message(sym_e_type_id_expected);
|
|
pd:=p1^.resulttype;
|
|
pd2:=pd;
|
|
if (pd^.deftype<>pointerdef) or
|
|
(ppointerdef(pd)^.definition^.deftype<>objectdef) then
|
|
begin
|
|
Message(parser_e_pointer_to_class_expected);
|
|
|
|
{ if an error occurs, read til the end of the new }
|
|
{ statement }
|
|
p1:=genzeronode(errorn);
|
|
l:=1;
|
|
while true do
|
|
begin
|
|
case token of
|
|
LKLAMMER : inc(l);
|
|
RKLAMMER : dec(l);
|
|
end;
|
|
consume(token);
|
|
if l=0 then
|
|
break;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
disposetree(p1);
|
|
p1:=genzeronode(hnewn);
|
|
p1^.resulttype:=ppointerdef(pd)^.definition;
|
|
consume(COMMA);
|
|
|
|
afterassignment:=false;
|
|
{ determines the current object defintion }
|
|
classh:=pobjectdef(ppointerdef(pd)^.definition);
|
|
|
|
{ check for an abstract class }
|
|
if (classh^.options and oois_abstract)<>0 then
|
|
Message(sym_e_no_instance_of_abstract_object);
|
|
|
|
{ search the constructor also in the symbol tables of }
|
|
{ the parents }
|
|
|
|
{ no constructor found }
|
|
sym:=nil;
|
|
while assigned(classh) do
|
|
begin
|
|
sym:=pvarsym(classh^.publicsyms^.search(pattern));
|
|
srsymtable:=classh^.publicsyms;
|
|
if assigned(sym) then
|
|
break;
|
|
classh:=classh^.childof;
|
|
end;
|
|
|
|
consume(ID);
|
|
do_member_read(sym,p1,pd,again);
|
|
if (p1^.treetype<>calln) or
|
|
(assigned(p1^.procdefinition) and
|
|
((p1^.procdefinition^.options and poconstructor)=0)) then
|
|
Message(parser_e_expr_have_to_be_constructor_call);
|
|
p1:=gensinglenode(newn,p1);
|
|
|
|
{ set the resulttype }
|
|
p1^.resulttype:=pd2;
|
|
consume(RKLAMMER);
|
|
end;
|
|
end;
|
|
_SELF:
|
|
begin
|
|
again:=true;
|
|
consume(_SELF);
|
|
if not assigned(procinfo._class) then
|
|
begin
|
|
p1:=genzeronode(errorn);
|
|
pd:=generrordef;
|
|
again:=false;
|
|
Message(parser_e_self_not_in_method);
|
|
end
|
|
else
|
|
begin
|
|
if (aktprocsym^.definition^.options and poclassmethod)<>0 then
|
|
begin
|
|
{ self in class methods is a class reference type }
|
|
pd:=new(pclassrefdef,init(procinfo._class));
|
|
p1:=genselfnode(pd);
|
|
p1^.resulttype:=pd;
|
|
end
|
|
else
|
|
begin
|
|
p1:=genselfnode(procinfo._class);
|
|
p1^.resulttype:=procinfo._class;
|
|
end;
|
|
pd:=p1^.resulttype;
|
|
postfixoperators;
|
|
end;
|
|
end;
|
|
_INHERITED : begin
|
|
again:=true;
|
|
consume(_INHERITED);
|
|
if assigned(procinfo._class) then
|
|
begin
|
|
classh:=procinfo._class^.childof;
|
|
while assigned(classh) do
|
|
begin
|
|
srsymtable:=pobjectdef(classh)^.publicsyms;
|
|
sym:=pvarsym(srsymtable^.search(pattern));
|
|
if assigned(sym) then
|
|
begin
|
|
p1:=genzeronode(typen);
|
|
p1^.resulttype:=classh;
|
|
pd:=p1^.resulttype;
|
|
consume(ID);
|
|
do_member_read(sym,p1,pd,again);
|
|
break;
|
|
end;
|
|
classh:=classh^.childof;
|
|
end;
|
|
if classh=nil then
|
|
begin
|
|
Message1(sym_e_id_no_member,pattern);
|
|
again:=false;
|
|
pd:=generrordef;
|
|
p1:=genzeronode(errorn);
|
|
end;
|
|
end
|
|
else
|
|
Message(parser_e_generic_methods_only_in_methods);
|
|
postfixoperators;
|
|
end;
|
|
INTCONST : begin
|
|
valint(pattern,l,code);
|
|
if code<>0 then
|
|
begin
|
|
val(pattern,d,code);
|
|
if code<>0 then
|
|
begin
|
|
Message(cg_e_invalid_integer);
|
|
l:=1;
|
|
consume(INTCONST);
|
|
p1:=genordinalconstnode(l,s32bitdef);
|
|
end
|
|
else
|
|
begin
|
|
consume(INTCONST);
|
|
p1:=genrealconstnode(d);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
consume(INTCONST);
|
|
p1:=genordinalconstnode(l,s32bitdef);
|
|
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:=genrealconstnode(d);
|
|
end;
|
|
{ FILE and STRING can be also a type cast }
|
|
_STRING:
|
|
begin
|
|
pd:=stringtype;
|
|
consume(LKLAMMER);
|
|
p1:=expr;
|
|
consume(RKLAMMER);
|
|
p1:=gentypeconvnode(p1,pd);
|
|
p1^.explizit:=true;
|
|
{ handle postfix operators here e.g. string(a)[10] }
|
|
again:=true;
|
|
postfixoperators;
|
|
end;
|
|
_FILE:
|
|
begin
|
|
pd:=cfiledef;
|
|
consume(_FILE);
|
|
consume(LKLAMMER);
|
|
p1:=expr;
|
|
consume(RKLAMMER);
|
|
p1:=gentypeconvnode(p1,pd);
|
|
p1^.explizit:=true;
|
|
{ handle postfix operators here e.g. string(a)[10] }
|
|
again:=true;
|
|
postfixoperators;
|
|
end;
|
|
CSTRING:
|
|
begin
|
|
p1:=genstringconstnode(pattern);
|
|
consume(CSTRING);
|
|
end;
|
|
CCHAR:
|
|
begin
|
|
p1:=genordinalconstnode(ord(pattern[1]),cchardef);
|
|
consume(CCHAR);
|
|
end;
|
|
KLAMMERAFFE : begin
|
|
consume(KLAMMERAFFE);
|
|
p1:=factor(true);
|
|
p1:=gensinglenode(addrn,p1);
|
|
end;
|
|
LKLAMMER : begin
|
|
consume(LKLAMMER);
|
|
p1:=expr;
|
|
consume(RKLAMMER);
|
|
{ it's not a good solution }
|
|
{ but (a+b)^ makes some problems }
|
|
case token of
|
|
CARET,POINT,LECKKLAMMER:
|
|
begin
|
|
{ we need the resulttype }
|
|
{ of the expression in pd }
|
|
do_firstpass(p1);
|
|
pd:=p1^.resulttype;
|
|
|
|
again:=true;
|
|
postfixoperators;
|
|
end;
|
|
end;
|
|
end;
|
|
LECKKLAMMER : begin
|
|
consume(LECKKLAMMER);
|
|
new(constset);
|
|
for l:=0 to 31 do
|
|
constset^[l]:=0;
|
|
p2:=nil;
|
|
pd:=nil;
|
|
if token<>RECKKLAMMER then
|
|
while true do
|
|
begin
|
|
p1:=expr;
|
|
do_firstpass(p1);
|
|
case p1^.treetype of
|
|
ordconstn : begin
|
|
if pd=nil then
|
|
pd:=p1^.resulttype;
|
|
if not(is_equal(pd,p1^.resulttype)) then
|
|
Message(parser_e_typeconflict_in_set)
|
|
else
|
|
do_set(constset,p1^.value);
|
|
disposetree(p1);
|
|
end;
|
|
rangen : begin
|
|
if pd=nil then
|
|
pd:=p1^.left^.resulttype;
|
|
if not(is_equal(pd,p1^.left^.resulttype)) then
|
|
Message(parser_e_typeconflict_in_set)
|
|
else
|
|
for l:=p1^.left^.value to p1^.right^.value do
|
|
do_set(constset,l);
|
|
disposetree(p1);
|
|
end;
|
|
stringconstn : begin
|
|
if pd=nil then
|
|
pd:=cchardef;
|
|
if not(is_equal(pd,cchardef)) then
|
|
Message(parser_e_typeconflict_in_set)
|
|
else
|
|
for l:=1 to length(pstring(p1^.values)^) do
|
|
do_set(constset,ord(pstring(p1^.values)^[l]));
|
|
disposetree(p1);
|
|
end;
|
|
else
|
|
begin
|
|
if pd=nil then
|
|
pd:=p1^.resulttype;
|
|
if not(is_equal(pd,p1^.resulttype)) then
|
|
Message(parser_e_typeconflict_in_set);
|
|
p2:=gennode(setelen,p1,p2);
|
|
end;
|
|
end;
|
|
if token=COMMA then
|
|
consume(COMMA)
|
|
else break;
|
|
end;
|
|
consume(RECKKLAMMER);
|
|
p1:=gensinglenode(setconstrn,p2);
|
|
p1^.resulttype:=new(psetdef,init(pd,255));
|
|
p1^.constset:=constset;
|
|
end;
|
|
PLUS : begin
|
|
consume(PLUS);
|
|
p1:=factor(false);
|
|
end;
|
|
MINUS : begin
|
|
consume(MINUS);
|
|
p1:=factor(false);
|
|
p1:=gensinglenode(umminusn,p1);
|
|
end;
|
|
_NOT : begin
|
|
consume(_NOT);
|
|
p1:=factor(false);
|
|
p1:=gensinglenode(notn,p1);
|
|
end;
|
|
_TRUE : begin
|
|
consume(_TRUE);
|
|
p1:=genordinalconstnode(1,booldef);
|
|
end;
|
|
_FALSE : begin
|
|
consume(_FALSE);
|
|
p1:=genordinalconstnode(0,booldef);
|
|
end;
|
|
_NIL : begin
|
|
consume(_NIL);
|
|
p1:=genzeronode(niln);
|
|
end;
|
|
else
|
|
begin
|
|
p1:=genzeronode(errorn);
|
|
consume(token);
|
|
Message(cg_e_illegal_expression);
|
|
end;
|
|
end;
|
|
factor:=p1;
|
|
end;
|
|
|
|
type Toperator_precedence=(opcompare,opaddition,opmultiply);
|
|
|
|
const tok2node:array[PLUS.._XOR] of Ttreetyp=
|
|
(addn,subn,muln,slashn,equaln,gtn,ltn,gten,lten,
|
|
isn,asn,inn,
|
|
nothingn,caretn,nothingn,unequaln,nothingn,
|
|
nothingn,nothingn,nothingn,nothingn,nothingn,
|
|
nothingn,nothingn,nothingn,nothingn,nothingn,
|
|
nothingn,nothingn,nothingn,nothingn,nothingn,
|
|
nothingn,andn,nothingn,nothingn,nothingn,
|
|
nothingn,nothingn,nothingn,nothingn,nothingn,
|
|
nothingn,nothingn,divn,nothingn,nothingn,
|
|
nothingn,nothingn,nothingn,nothingn,nothingn,
|
|
nothingn,nothingn,nothingn,nothingn,nothingn,
|
|
nothingn,nothingn,nothingn,nothingn,nothingn,
|
|
modn,nothingn,nothingn,nothingn,nothingn,
|
|
nothingn,nothingn,orn,
|
|
nothingn,nothingn,nothingn,nothingn,nothingn,
|
|
nothingn,nothingn,shln,shrn,
|
|
nothingn,nothingn,nothingn,nothingn,nothingn,
|
|
nothingn,nothingn,nothingn,nothingn,nothingn,
|
|
nothingn,xorn);
|
|
operator_levels:array[Toperator_precedence] of set of Ttoken=
|
|
([LT,LTE,GT,GTE,EQUAL,UNEQUAL,_IN,_IS],
|
|
[PLUS,MINUS,_OR,_XOR],
|
|
[CARET,SYMDIF,STAR,SLASH,_DIV,_MOD,_AND,_SHL,_SHR,_AS]);
|
|
|
|
function sub_expr(pred_level:Toperator_precedence):Ptree;
|
|
|
|
{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:Ptree;
|
|
oldt:Ttoken;
|
|
|
|
begin
|
|
{ if pred_level=high(Toperator_precedence) then }
|
|
if pred_level=opmultiply then
|
|
p1:=factor(getprocvar)
|
|
else
|
|
p1:=sub_expr(succ(pred_level));
|
|
repeat
|
|
if token in operator_levels[pred_level] then
|
|
begin
|
|
oldt:=token;
|
|
consume(token);
|
|
{ if pred_level=high(Toperator_precedence) then }
|
|
if pred_level=opmultiply then
|
|
p2:=factor(getprocvar)
|
|
else
|
|
p2:=sub_expr(succ(pred_level));
|
|
p1:=gennode(tok2node[oldt],p1,p2);
|
|
end
|
|
else
|
|
break;
|
|
until false;
|
|
sub_expr:=p1;
|
|
end;
|
|
|
|
function expr : ptree;
|
|
|
|
var
|
|
p1,p2 : ptree;
|
|
oldafterassignment : boolean;
|
|
|
|
begin
|
|
oldafterassignment:=afterassignment;
|
|
p1:=sub_expr(opcompare);
|
|
if token in [ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then
|
|
afterassignment:=true;
|
|
case token of
|
|
POINTPOINT : begin
|
|
consume(POINTPOINT);
|
|
p2:=sub_expr(opcompare);
|
|
p1:=gennode(rangen,p1,p2);
|
|
end;
|
|
ASSIGNMENT : begin
|
|
consume(ASSIGNMENT);
|
|
{ avoid a firstpass of a procedure if
|
|
it must be assigned to a procvar }
|
|
{ should be recursive for a:=b:=c !!! }
|
|
if (p1^.resulttype<>nil) and (p1^.resulttype^.deftype=procvardef) then
|
|
getprocvar:=true;
|
|
p2:=sub_expr(opcompare);
|
|
if getprocvar and (p2^.treetype=calln) then
|
|
begin
|
|
p2^.treetype:=loadn;
|
|
p2^.resulttype:=pprocsym(p2^.symtableprocentry)^.definition;
|
|
p2^.symtableentry:=p2^.symtableprocentry;
|
|
end;
|
|
getprocvar:=false;
|
|
p1:=gennode(assignn,p1,p2);
|
|
end;
|
|
{ this is the code for C like assignements }
|
|
{ from an improvement of Peter Schaefer }
|
|
_PLUSASN : begin
|
|
consume(_PLUSASN );
|
|
p2:=sub_expr(opcompare);
|
|
p1:=gennode(assignn,p1,gennode(addn,getcopy(p1),p2));
|
|
{ was first
|
|
p1:=gennode(assignn,p1,gennode(addn,p1,p2));
|
|
but disposetree assumes that we have a real
|
|
*** tree *** }
|
|
end;
|
|
|
|
_MINUSASN : begin
|
|
consume(_MINUSASN );
|
|
p2:=sub_expr(opcompare);
|
|
p1:=gennode(assignn,p1,gennode(subn,getcopy(p1),p2));
|
|
end;
|
|
_STARASN : begin
|
|
consume(_STARASN );
|
|
p2:=sub_expr(opcompare);
|
|
p1:=gennode(assignn,p1,gennode(muln,getcopy(p1),p2));
|
|
end;
|
|
_SLASHASN : begin
|
|
consume(_SLASHASN );
|
|
p2:=sub_expr(opcompare);
|
|
p1:=gennode(assignn,p1,gennode(slashn,getcopy(p1),p2));
|
|
end;
|
|
end;
|
|
afterassignment:=oldafterassignment;
|
|
expr:=p1;
|
|
end;
|
|
|
|
function get_intconst:longint;
|
|
|
|
{Reads an expression, tries to evalute it and check if it is an integer
|
|
constant. Then the constant is returned.}
|
|
|
|
var p:Ptree;
|
|
|
|
begin
|
|
p:=expr;
|
|
do_firstpass(p);
|
|
if (p^.treetype<>ordconstn) and
|
|
(p^.resulttype^.deftype=orddef) and
|
|
not (Porddef(p^.resulttype)^.typ in
|
|
[uvoid,uchar,bool8bit]) then
|
|
Message(cg_e_illegal_expression)
|
|
else
|
|
get_intconst:=p^.value;
|
|
disposetree(p);
|
|
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:Ptree;
|
|
|
|
begin
|
|
get_stringconst:='';
|
|
p:=expr;
|
|
do_firstpass(p);
|
|
if p^.treetype<>stringconstn then
|
|
if (p^.treetype=ordconstn) and
|
|
(p^.resulttype^.deftype=orddef) and
|
|
(Porddef(p^.resulttype)^.typ=uchar) then
|
|
get_stringconst:=char(p^.value)
|
|
else
|
|
Message(cg_e_illegal_expression)
|
|
else
|
|
get_stringconst:=p^.values^;
|
|
disposetree(p);
|
|
end;
|
|
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.2 1998-03-26 11:18:31 florian
|
|
- switch -Sa removed
|
|
- support of a:=b:=0 removed
|
|
|
|
Revision 1.1.1.1 1998/03/25 11:18:14 root
|
|
* Restored version
|
|
|
|
Revision 1.26 1998/03/24 21:48:33 florian
|
|
* just a couple of fixes applied:
|
|
- problem with fixed16 solved
|
|
- internalerror 10005 problem fixed
|
|
- patch for assembler reading
|
|
- small optimizer fix
|
|
- mem is now supported
|
|
|
|
Revision 1.25 1998/03/21 23:59:39 florian
|
|
* indexed properties fixed
|
|
* ppu i/o of properties fixed
|
|
* field can be also used for write access
|
|
* overriding of properties
|
|
|
|
Revision 1.24 1998/03/16 22:42:21 florian
|
|
* some fixes of Peter applied:
|
|
ofs problem, profiler support
|
|
|
|
Revision 1.23 1998/03/11 11:23:57 florian
|
|
* bug0081 and bug0109 fixed
|
|
|
|
Revision 1.22 1998/03/10 16:27:42 pierre
|
|
* better line info in stabs debug
|
|
* symtabletype and lexlevel separated into two fields of tsymtable
|
|
+ ifdef MAKELIB for direct library output, not complete
|
|
+ ifdef CHAINPROCSYMS for overloaded seach across units, not fully
|
|
working
|
|
+ ifdef TESTFUNCRET for setting func result in underfunction, not
|
|
working
|
|
|
|
Revision 1.21 1998/03/10 01:17:24 peter
|
|
* all files have the same header
|
|
* messages are fully implemented, EXTDEBUG uses Comment()
|
|
+ AG... files for the Assembler generation
|
|
|
|
Revision 1.20 1998/03/06 00:52:44 peter
|
|
* replaced all old messages from errore.msg, only ExtDebug and some
|
|
Comment() calls are left
|
|
* fixed options.pas
|
|
|
|
Revision 1.19 1998/03/02 01:49:02 peter
|
|
* renamed target_DOS to target_GO32V1
|
|
+ new verbose system, merged old errors and verbose units into one new
|
|
verbose.pas, so errors.pas is obsolete
|
|
|
|
Revision 1.18 1998/03/01 22:46:18 florian
|
|
+ some win95 linking stuff
|
|
* a couple of bugs fixed:
|
|
bug0055,bug0058,bug0059,bug0064,bug0072,bug0093,bug0095,bug0098
|
|
|
|
Revision 1.17 1998/02/27 21:24:06 florian
|
|
* dll support changed (dll name can be also a string contants)
|
|
|
|
Revision 1.16 1998/02/24 00:19:17 peter
|
|
* makefile works again (btw. linux does like any char after a \ )
|
|
* removed circular unit with assemble and files
|
|
* fixed a sigsegv in pexpr
|
|
* pmodule init unit/program is the almost the same, merged them
|
|
|
|
Revision 1.15 1998/02/13 10:35:24 daniel
|
|
* Made Motorola version compilable.
|
|
* Fixed optimizer
|
|
|
|
Revision 1.14 1998/02/12 17:19:20 florian
|
|
* fixed to get remake3 work, but needs additional fixes (output, I don't like
|
|
also that aktswitches isn't a pointer)
|
|
|
|
Revision 1.13 1998/02/12 11:50:26 daniel
|
|
Yes! Finally! After three retries, my patch!
|
|
|
|
Changes:
|
|
|
|
Complete rewrite of psub.pas.
|
|
Added support for DLL's.
|
|
Compiler requires less memory.
|
|
Platform units for each platform.
|
|
|
|
Revision 1.12 1998/02/11 21:56:37 florian
|
|
* bugfixes: bug0093, bug0053, bug0088, bug0087, bug0089
|
|
|
|
Revision 1.11 1998/02/01 22:41:11 florian
|
|
* clean up
|
|
+ system.assigned([class])
|
|
+ system.assigned([class of xxxx])
|
|
* first fixes of as and is-operator
|
|
|
|
Revision 1.10 1998/02/01 15:04:15 florian
|
|
* better error recovering
|
|
* some clean up
|
|
|
|
Revision 1.9 1998/01/30 21:27:05 carl
|
|
* partial bugfix #88, #89 and typeof and other inline functions
|
|
(these bugs have a deeper nesting level, and therefore i only fixed
|
|
the parser crashes - there is also a tree crash).
|
|
|
|
Revision 1.8 1998/01/26 17:31:01 florian
|
|
* stupid bug with self in class methods fixed
|
|
|
|
Revision 1.7 1998/01/25 22:29:02 florian
|
|
* a lot bug fixes on the DOM
|
|
|
|
Revision 1.6 1998/01/23 10:46:41 florian
|
|
* small problems with FCL object model fixed, objpas?.inc is compilable
|
|
|
|
Revision 1.5 1998/01/16 22:34:42 michael
|
|
* Changed 'conversation' to 'conversion'. Waayyy too much chatting going on
|
|
in this compiler :)
|
|
|
|
Revision 1.4 1998/01/16 18:03:15 florian
|
|
* small bug fixes, some stuff of delphi styled constructores added
|
|
|
|
Revision 1.3 1998/01/13 23:11:14 florian
|
|
+ class methods
|
|
|
|
Revision 1.2 1998/01/09 09:09:59 michael
|
|
+ Initial implementation, second try
|
|
|
|
}
|