mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-04 07:31:39 +02:00
* fixed 'with object do' bug
This commit is contained in:
peter
parent
a731c4ac0d
commit
7c8e445400
@ -729,6 +729,7 @@ implementation
|
|||||||
p^.methodpointer:=genzeronode(callparan);
|
p^.methodpointer:=genzeronode(callparan);
|
||||||
p^.methodpointer^.location.loc:=LOC_REGISTER;
|
p^.methodpointer^.location.loc:=LOC_REGISTER;
|
||||||
p^.methodpointer^.location.register:=R_ESI;
|
p^.methodpointer^.location.register:=R_ESI;
|
||||||
|
p^.methodpointer^.resulttype:=p^.symtable^.defowner;
|
||||||
{ make a reference }
|
{ make a reference }
|
||||||
new(r);
|
new(r);
|
||||||
reset_reference(r^);
|
reset_reference(r^);
|
||||||
@ -871,7 +872,8 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
{ direct call to class constructor, don't allocate memory }
|
{ direct call to class constructor, don't allocate memory }
|
||||||
if is_con_or_destructor and (p^.methodpointer^.resulttype^.deftype=objectdef) and
|
if is_con_or_destructor and
|
||||||
|
(p^.methodpointer^.resulttype^.deftype=objectdef) and
|
||||||
(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
|
(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
|
||||||
exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,0)))
|
exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,0)))
|
||||||
else
|
else
|
||||||
@ -2314,7 +2316,10 @@ implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.17 1998-08-19 16:07:36 jonas
|
Revision 1.18 1998-08-20 21:36:38 peter
|
||||||
|
* fixed 'with object do' bug
|
||||||
|
|
||||||
|
Revision 1.17 1998/08/19 16:07:36 jonas
|
||||||
* changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
|
* changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
|
||||||
|
|
||||||
Revision 1.16 1998/08/18 09:24:36 pierre
|
Revision 1.16 1998/08/18 09:24:36 pierre
|
||||||
|
|||||||
@ -646,172 +646,6 @@ unit pexpr;
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
{****************************************************************************
|
|
||||||
Factor_read_set
|
|
||||||
****************************************************************************}
|
|
||||||
|
|
||||||
{ Read a set between [] }
|
|
||||||
function factor_read_set:ptree;
|
|
||||||
var
|
|
||||||
constp,
|
|
||||||
buildp,
|
|
||||||
p2,p3,p4 : ptree;
|
|
||||||
pd : pdef;
|
|
||||||
constset : pconstset;
|
|
||||||
constsetlo,
|
|
||||||
constsethi : longint;
|
|
||||||
|
|
||||||
procedure update_constsethi(p:pdef);
|
|
||||||
begin
|
|
||||||
if ((p^.deftype=orddef) and
|
|
||||||
(porddef(p)^.high>constsethi)) then
|
|
||||||
constsethi:=porddef(p)^.high
|
|
||||||
else
|
|
||||||
if ((p^.deftype=enumdef) and
|
|
||||||
(penumdef(p)^.max>constsethi)) then
|
|
||||||
constsethi:=penumdef(p)^.max;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure do_set(pos : longint);
|
|
||||||
var
|
|
||||||
mask,l : longint;
|
|
||||||
begin
|
|
||||||
if (pos>255) or (pos<0) then
|
|
||||||
Message(parser_e_illegal_set_expr);
|
|
||||||
if pos>constsethi then
|
|
||||||
constsethi:=pos;
|
|
||||||
if pos<constsetlo then
|
|
||||||
constsetlo:=pos;
|
|
||||||
l:=pos shr 3;
|
|
||||||
mask:=1 shl (pos mod 8);
|
|
||||||
{ do we allow the same twice }
|
|
||||||
if (constset^[l] and mask)<>0 then
|
|
||||||
Message(parser_e_illegal_set_expr);
|
|
||||||
constset^[l]:=constset^[l] or mask;
|
|
||||||
end;
|
|
||||||
|
|
||||||
var
|
|
||||||
l : longint;
|
|
||||||
begin
|
|
||||||
new(constset);
|
|
||||||
FillChar(constset^,sizeof(constset^),0);
|
|
||||||
constsetlo:=0;
|
|
||||||
constsethi:=0;
|
|
||||||
|
|
||||||
constp:=gensinglenode(setconstrn,nil);
|
|
||||||
constp^.constset:=constset;
|
|
||||||
|
|
||||||
buildp:=constp;
|
|
||||||
pd:=nil;
|
|
||||||
|
|
||||||
if token<>RECKKLAMMER then
|
|
||||||
begin
|
|
||||||
while true do
|
|
||||||
begin
|
|
||||||
p4:=nil; { will contain the tree to create the set }
|
|
||||||
p2:=comp_expr(true);
|
|
||||||
do_firstpass(p2);
|
|
||||||
if codegenerror then
|
|
||||||
break;
|
|
||||||
case p2^.resulttype^.deftype of
|
|
||||||
enumdef,
|
|
||||||
orddef : begin
|
|
||||||
if (p2^.resulttype^.deftype=orddef) and
|
|
||||||
(porddef(p2^.resulttype)^.typ in [s8bit,s16bit,s32bit,u16bit,u32bit]) then
|
|
||||||
begin
|
|
||||||
p2:=gentypeconvnode(p2,u8bitdef);
|
|
||||||
do_firstpass(p2);
|
|
||||||
end;
|
|
||||||
{ set settype result }
|
|
||||||
if pd=nil then
|
|
||||||
pd:=p2^.resulttype;
|
|
||||||
if not(is_equal(pd,p2^.resulttype)) then
|
|
||||||
begin
|
|
||||||
Message(parser_e_typeconflict_in_set);
|
|
||||||
disposetree(p2);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
if token=POINTPOINT then
|
|
||||||
begin
|
|
||||||
consume(POINTPOINT);
|
|
||||||
p3:=comp_expr(true);
|
|
||||||
do_firstpass(p3);
|
|
||||||
if codegenerror then
|
|
||||||
break;
|
|
||||||
if (p3^.resulttype^.deftype=orddef) and
|
|
||||||
(porddef(p3^.resulttype)^.typ in [s8bit,s16bit,s32bit,u16bit,u32bit]) then
|
|
||||||
begin
|
|
||||||
p3:=gentypeconvnode(p3,u8bitdef);
|
|
||||||
do_firstpass(p3);
|
|
||||||
end;
|
|
||||||
if not(is_equal(pd,p3^.resulttype)) then
|
|
||||||
Message(parser_e_typeconflict_in_set)
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
if (p2^.treetype=ordconstn) and (p3^.treetype=ordconstn) then
|
|
||||||
begin
|
|
||||||
for l:=p2^.value to p3^.value do
|
|
||||||
do_set(l);
|
|
||||||
disposetree(p3);
|
|
||||||
disposetree(p2);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
update_constsethi(p3^.resulttype);
|
|
||||||
p4:=gennode(rangen,p2,p3);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
{ Single value }
|
|
||||||
if p2^.treetype=ordconstn then
|
|
||||||
begin
|
|
||||||
do_set(p2^.value);
|
|
||||||
disposetree(p2);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
update_constsethi(p2^.resulttype);
|
|
||||||
p4:=gensinglenode(setelen,p2);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
stringdef : 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(p2^.values)^) do
|
|
||||||
do_set(ord(pstring(p2^.values)^[l]));
|
|
||||||
disposetree(p2);
|
|
||||||
end;
|
|
||||||
else
|
|
||||||
Internalerror(4234);
|
|
||||||
end;
|
|
||||||
{ insert the set creation tree }
|
|
||||||
if assigned(p4) then
|
|
||||||
begin
|
|
||||||
buildp:=gennode(addn,buildp,p4);
|
|
||||||
end;
|
|
||||||
{ there could be more elements }
|
|
||||||
if token=COMMA then
|
|
||||||
consume(COMMA)
|
|
||||||
else
|
|
||||||
break;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
constp^.resulttype:=new(psetdef,init(pd,constsethi));
|
|
||||||
|
|
||||||
factor_read_set:=buildp;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
{****************************************************************************
|
{****************************************************************************
|
||||||
Factor
|
Factor
|
||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
@ -819,301 +653,26 @@ unit pexpr;
|
|||||||
function factor(getaddr : boolean) : ptree;
|
function factor(getaddr : boolean) : ptree;
|
||||||
var
|
var
|
||||||
l : longint;
|
l : longint;
|
||||||
|
oldp1,
|
||||||
p1,p2,p3 : ptree;
|
p1,p2,p3 : ptree;
|
||||||
code : word;
|
code : word;
|
||||||
pd,pd2 : pdef;
|
pd,pd2 : pdef;
|
||||||
unit_specific, again : boolean;
|
possible_error,
|
||||||
static_name : string;
|
unit_specific,
|
||||||
|
again : boolean;
|
||||||
sym : pvarsym;
|
sym : pvarsym;
|
||||||
classh : pobjectdef;
|
classh : pobjectdef;
|
||||||
d : bestreal;
|
d : bestreal;
|
||||||
|
static_name : string;
|
||||||
propsym : ppropertysym;
|
propsym : ppropertysym;
|
||||||
oldp1 : ptree;
|
|
||||||
filepos : tfileposinfo;
|
filepos : tfileposinfo;
|
||||||
|
|
||||||
procedure check_tokenpos;
|
{---------------------------------------------
|
||||||
begin
|
Factor_read_id
|
||||||
if (p1<>oldp1) then
|
---------------------------------------------}
|
||||||
begin
|
|
||||||
if assigned(p1) then
|
|
||||||
set_tree_filepos(p1,filepos);
|
|
||||||
oldp1:=p1;
|
|
||||||
filepos:=tokenpos;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure postfixoperators;
|
procedure factor_read_id;
|
||||||
{ p1 and p2 must contain valid values }
|
|
||||||
begin
|
begin
|
||||||
check_tokenpos;
|
|
||||||
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
|
|
||||||
if (pd^.deftype=objectdef) and pobjectdef(pd)^.isclass then
|
|
||||||
begin
|
|
||||||
{ default property }
|
|
||||||
propsym:=search_default_property(pobjectdef(pd));
|
|
||||||
if not(assigned(propsym)) then
|
|
||||||
begin
|
|
||||||
disposetree(p1);
|
|
||||||
p1:=genzeronode(errorn);
|
|
||||||
again:=false;
|
|
||||||
message(parser_e_no_default_property_available);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
p1:=nil;
|
|
||||||
handle_propertysym(propsym,p1,pd);
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
consume(LECKKLAMMER);
|
|
||||||
repeat
|
|
||||||
case pd^.deftype of
|
|
||||||
pointerdef : begin
|
|
||||||
p2:=comp_expr(true);
|
|
||||||
p1:=gennode(vecn,p1,p2);
|
|
||||||
pd:=ppointerdef(pd)^.definition;
|
|
||||||
end;
|
|
||||||
stringdef : begin
|
|
||||||
p2:=comp_expr(true);
|
|
||||||
p1:=gennode(vecn,p1,p2);
|
|
||||||
pd:=cchardef
|
|
||||||
end;
|
|
||||||
arraydef : begin
|
|
||||||
p2:=comp_expr(true);
|
|
||||||
{$ifdef i386}
|
|
||||||
{ support SEG:OFS for go32v2 Mem[] }
|
|
||||||
if (target_info.target=target_GO32V2) and
|
|
||||||
(p1^.treetype=loadn) 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:=comp_expr(true);
|
|
||||||
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
|
|
||||||
{$endif}
|
|
||||||
p1:=gennode(vecn,p1,p2);
|
|
||||||
pd:=parraydef(pd)^.definition;
|
|
||||||
end;
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
Message(cg_e_invalid_qualifier);
|
|
||||||
disposetree(p1);
|
|
||||||
p1:=genzeronode(errorn);
|
|
||||||
again:=false;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
if token=COMMA then
|
|
||||||
consume(COMMA)
|
|
||||||
else
|
|
||||||
break;
|
|
||||||
until false;
|
|
||||||
consume(RECKKLAMMER);
|
|
||||||
end;
|
|
||||||
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(false,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(false,sym,p1,pd,again);
|
|
||||||
end;
|
|
||||||
pointerdef : begin
|
|
||||||
Message(cg_e_invalid_qualifier);
|
|
||||||
if ppointerdef(pd)^.definition^.deftype in [recorddef,objectdef,classrefdef] then
|
|
||||||
Message(parser_h_maybe_deref_caret_missing);
|
|
||||||
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 and proc_to_procvar_equal(pprocvardef(pd),getprocvardef) then
|
|
||||||
again:=false
|
|
||||||
else
|
|
||||||
if (token=LKLAMMER) or
|
|
||||||
((pprocvardef(pd)^.para1=nil) 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:=gencallnode(nil,nil);
|
|
||||||
p1^.right:=p2;
|
|
||||||
p1^.unit_specific:=unit_specific;
|
|
||||||
p1^.symtableprocentry:=sym;
|
|
||||||
if token=LKLAMMER then
|
|
||||||
begin
|
|
||||||
consume(LKLAMMER);
|
|
||||||
p1^.left:=parse_paras(false,false);
|
|
||||||
consume(RKLAMMER);
|
|
||||||
end;
|
|
||||||
pd:=pprocvardef(pd)^.retdef;
|
|
||||||
{ proc():= is never possible }
|
|
||||||
if token=ASSIGNMENT then
|
|
||||||
begin
|
|
||||||
Message(cg_e_illegal_expression);
|
|
||||||
p1:=genzeronode(errorn);
|
|
||||||
again:=false;
|
|
||||||
end;
|
|
||||||
p1^.resulttype:=pd;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
again:=false;
|
|
||||||
p1^.resulttype:=pd;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
again:=false;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
again:=false;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
check_tokenpos;
|
|
||||||
end; { while again }
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
{$ifdef TEST_FUNCRET}
|
|
||||||
function is_func_ret(sym : psym) : boolean;
|
|
||||||
var
|
|
||||||
p : pprocinfo;
|
|
||||||
storesymtablestack : psymtable;
|
|
||||||
|
|
||||||
begin
|
|
||||||
is_func_ret:=false;
|
|
||||||
if (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 ? }
|
|
||||||
if assigned(p^.funcretsym) and
|
|
||||||
((sym=p^.funcretsym) or
|
|
||||||
((pvarsym(sym)=opsym) and
|
|
||||||
((p^.flags and pi_operator)<>0))) and
|
|
||||||
(p^.retdef<>pdef(voiddef)) and
|
|
||||||
(token<>LKLAMMER) and
|
|
||||||
(not ((cs_tp_compatible in aktmoduleswitches) and
|
|
||||||
(afterassignment or in_args))) then
|
|
||||||
begin
|
|
||||||
p1:=genzeronode(funcretn);
|
|
||||||
pd:=p^.retdef;
|
|
||||||
p1^.funcretprocinfo:=p;
|
|
||||||
p1^.retdef:=pd;
|
|
||||||
is_func_ret:=true;
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
p:=p^.parent;
|
|
||||||
end;
|
|
||||||
{ we must use the function call }
|
|
||||||
if(sym^.typ=funcretsym) then
|
|
||||||
begin
|
|
||||||
storesymtablestack:=symtablestack;
|
|
||||||
symtablestack:=srsymtable^.next;
|
|
||||||
getsym(sym^.name,true);
|
|
||||||
if srsym^.typ<>procsym then
|
|
||||||
Message(cg_e_illegal_expression);
|
|
||||||
symtablestack:=storesymtablestack;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
{$endif TEST_FUNCRET}
|
|
||||||
|
|
||||||
var
|
|
||||||
possible_error : boolean;
|
|
||||||
begin
|
|
||||||
oldp1:=nil;
|
|
||||||
filepos:=tokenpos;
|
|
||||||
case token of
|
|
||||||
ID : begin
|
|
||||||
{ allow post fix operators }
|
{ allow post fix operators }
|
||||||
again:=true;
|
again:=true;
|
||||||
if (cs_delphi2_compatible in aktmoduleswitches) and
|
if (cs_delphi2_compatible in aktmoduleswitches) and
|
||||||
@ -1376,9 +935,468 @@ unit pexpr;
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{---------------------------------------------
|
||||||
|
Factor_Read_Set
|
||||||
|
---------------------------------------------}
|
||||||
|
|
||||||
|
{ Read a set between [] }
|
||||||
|
function factor_read_set:ptree;
|
||||||
|
var
|
||||||
|
constp,
|
||||||
|
buildp,
|
||||||
|
p2,p3,p4 : ptree;
|
||||||
|
pd : pdef;
|
||||||
|
constset : pconstset;
|
||||||
|
constsetlo,
|
||||||
|
constsethi : longint;
|
||||||
|
|
||||||
|
procedure update_constsethi(p:pdef);
|
||||||
|
begin
|
||||||
|
if ((p^.deftype=orddef) and
|
||||||
|
(porddef(p)^.high>constsethi)) then
|
||||||
|
constsethi:=porddef(p)^.high
|
||||||
|
else
|
||||||
|
if ((p^.deftype=enumdef) and
|
||||||
|
(penumdef(p)^.max>constsethi)) then
|
||||||
|
constsethi:=penumdef(p)^.max;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure do_set(pos : longint);
|
||||||
|
var
|
||||||
|
mask,l : longint;
|
||||||
|
begin
|
||||||
|
if (pos>255) or (pos<0) then
|
||||||
|
Message(parser_e_illegal_set_expr);
|
||||||
|
if pos>constsethi then
|
||||||
|
constsethi:=pos;
|
||||||
|
if pos<constsetlo then
|
||||||
|
constsetlo:=pos;
|
||||||
|
l:=pos shr 3;
|
||||||
|
mask:=1 shl (pos mod 8);
|
||||||
|
{ do we allow the same twice }
|
||||||
|
if (constset^[l] and mask)<>0 then
|
||||||
|
Message(parser_e_illegal_set_expr);
|
||||||
|
constset^[l]:=constset^[l] or mask;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
l : longint;
|
||||||
|
begin
|
||||||
|
new(constset);
|
||||||
|
FillChar(constset^,sizeof(constset^),0);
|
||||||
|
constsetlo:=0;
|
||||||
|
constsethi:=0;
|
||||||
|
constp:=gensinglenode(setconstrn,nil);
|
||||||
|
constp^.constset:=constset;
|
||||||
|
buildp:=constp;
|
||||||
|
pd:=nil;
|
||||||
|
if token<>RECKKLAMMER then
|
||||||
|
begin
|
||||||
|
while true do
|
||||||
|
begin
|
||||||
|
p4:=nil; { will contain the tree to create the set }
|
||||||
|
p2:=comp_expr(true);
|
||||||
|
do_firstpass(p2);
|
||||||
|
if codegenerror then
|
||||||
|
break;
|
||||||
|
case p2^.resulttype^.deftype of
|
||||||
|
enumdef,
|
||||||
|
orddef : begin
|
||||||
|
if (p2^.resulttype^.deftype=orddef) and
|
||||||
|
(porddef(p2^.resulttype)^.typ in [s8bit,s16bit,s32bit,u16bit,u32bit]) then
|
||||||
|
begin
|
||||||
|
p2:=gentypeconvnode(p2,u8bitdef);
|
||||||
|
do_firstpass(p2);
|
||||||
|
end;
|
||||||
|
{ set settype result }
|
||||||
|
if pd=nil then
|
||||||
|
pd:=p2^.resulttype;
|
||||||
|
if not(is_equal(pd,p2^.resulttype)) then
|
||||||
|
begin
|
||||||
|
Message(parser_e_typeconflict_in_set);
|
||||||
|
disposetree(p2);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if token=POINTPOINT then
|
||||||
|
begin
|
||||||
|
consume(POINTPOINT);
|
||||||
|
p3:=comp_expr(true);
|
||||||
|
do_firstpass(p3);
|
||||||
|
if codegenerror then
|
||||||
|
break;
|
||||||
|
if (p3^.resulttype^.deftype=orddef) and
|
||||||
|
(porddef(p3^.resulttype)^.typ in [s8bit,s16bit,s32bit,u16bit,u32bit]) then
|
||||||
|
begin
|
||||||
|
p3:=gentypeconvnode(p3,u8bitdef);
|
||||||
|
do_firstpass(p3);
|
||||||
|
end;
|
||||||
|
if not(is_equal(pd,p3^.resulttype)) then
|
||||||
|
Message(parser_e_typeconflict_in_set)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (p2^.treetype=ordconstn) and (p3^.treetype=ordconstn) then
|
||||||
|
begin
|
||||||
|
for l:=p2^.value to p3^.value do
|
||||||
|
do_set(l);
|
||||||
|
disposetree(p3);
|
||||||
|
disposetree(p2);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
update_constsethi(p3^.resulttype);
|
||||||
|
p4:=gennode(rangen,p2,p3);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ Single value }
|
||||||
|
if p2^.treetype=ordconstn then
|
||||||
|
begin
|
||||||
|
do_set(p2^.value);
|
||||||
|
disposetree(p2);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
update_constsethi(p2^.resulttype);
|
||||||
|
p4:=gensinglenode(setelen,p2);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
stringdef : 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(p2^.values)^) do
|
||||||
|
do_set(ord(pstring(p2^.values)^[l]));
|
||||||
|
disposetree(p2);
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
Internalerror(4234);
|
||||||
|
end;
|
||||||
|
{ insert the set creation tree }
|
||||||
|
if assigned(p4) then
|
||||||
|
begin
|
||||||
|
buildp:=gennode(addn,buildp,p4);
|
||||||
|
end;
|
||||||
|
{ there could be more elements }
|
||||||
|
if token=COMMA then
|
||||||
|
consume(COMMA)
|
||||||
|
else
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
constp^.resulttype:=new(psetdef,init(pd,constsethi));
|
||||||
|
factor_read_set:=buildp;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{---------------------------------------------
|
||||||
|
Helpers
|
||||||
|
---------------------------------------------}
|
||||||
|
|
||||||
|
procedure check_tokenpos;
|
||||||
|
begin
|
||||||
|
if (p1<>oldp1) then
|
||||||
|
begin
|
||||||
|
if assigned(p1) then
|
||||||
|
set_tree_filepos(p1,filepos);
|
||||||
|
oldp1:=p1;
|
||||||
|
filepos:=tokenpos;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef TEST_FUNCRET}
|
||||||
|
function is_func_ret(sym : psym) : boolean;
|
||||||
|
var
|
||||||
|
p : pprocinfo;
|
||||||
|
storesymtablestack : psymtable;
|
||||||
|
|
||||||
|
begin
|
||||||
|
is_func_ret:=false;
|
||||||
|
if (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 ? }
|
||||||
|
if assigned(p^.funcretsym) and
|
||||||
|
((sym=p^.funcretsym) or
|
||||||
|
((pvarsym(sym)=opsym) and
|
||||||
|
((p^.flags and pi_operator)<>0))) and
|
||||||
|
(p^.retdef<>pdef(voiddef)) and
|
||||||
|
(token<>LKLAMMER) and
|
||||||
|
(not ((cs_tp_compatible in aktmoduleswitches) and
|
||||||
|
(afterassignment or in_args))) then
|
||||||
|
begin
|
||||||
|
p1:=genzeronode(funcretn);
|
||||||
|
pd:=p^.retdef;
|
||||||
|
p1^.funcretprocinfo:=p;
|
||||||
|
p1^.retdef:=pd;
|
||||||
|
is_func_ret:=true;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
p:=p^.parent;
|
||||||
|
end;
|
||||||
|
{ we must use the function call }
|
||||||
|
if(sym^.typ=funcretsym) then
|
||||||
|
begin
|
||||||
|
storesymtablestack:=symtablestack;
|
||||||
|
symtablestack:=srsymtable^.next;
|
||||||
|
getsym(sym^.name,true);
|
||||||
|
if srsym^.typ<>procsym then
|
||||||
|
Message(cg_e_illegal_expression);
|
||||||
|
symtablestack:=storesymtablestack;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
{$endif TEST_FUNCRET}
|
||||||
|
|
||||||
|
|
||||||
|
{---------------------------------------------
|
||||||
|
PostFixOperators
|
||||||
|
---------------------------------------------}
|
||||||
|
|
||||||
|
procedure postfixoperators;
|
||||||
|
{ p1 and p2 must contain valid values }
|
||||||
|
begin
|
||||||
|
check_tokenpos;
|
||||||
|
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
|
||||||
|
if (pd^.deftype=objectdef) and pobjectdef(pd)^.isclass then
|
||||||
|
begin
|
||||||
|
{ default property }
|
||||||
|
propsym:=search_default_property(pobjectdef(pd));
|
||||||
|
if not(assigned(propsym)) then
|
||||||
|
begin
|
||||||
|
disposetree(p1);
|
||||||
|
p1:=genzeronode(errorn);
|
||||||
|
again:=false;
|
||||||
|
message(parser_e_no_default_property_available);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
p1:=nil;
|
||||||
|
handle_propertysym(propsym,p1,pd);
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
consume(LECKKLAMMER);
|
||||||
|
repeat
|
||||||
|
case pd^.deftype of
|
||||||
|
pointerdef : begin
|
||||||
|
p2:=comp_expr(true);
|
||||||
|
p1:=gennode(vecn,p1,p2);
|
||||||
|
pd:=ppointerdef(pd)^.definition;
|
||||||
|
end;
|
||||||
|
stringdef : begin
|
||||||
|
p2:=comp_expr(true);
|
||||||
|
p1:=gennode(vecn,p1,p2);
|
||||||
|
pd:=cchardef
|
||||||
|
end;
|
||||||
|
arraydef : begin
|
||||||
|
p2:=comp_expr(true);
|
||||||
|
{$ifdef i386}
|
||||||
|
{ support SEG:OFS for go32v2 Mem[] }
|
||||||
|
if (target_info.target=target_GO32V2) and
|
||||||
|
(p1^.treetype=loadn) 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:=comp_expr(true);
|
||||||
|
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
|
||||||
|
{$endif}
|
||||||
|
p1:=gennode(vecn,p1,p2);
|
||||||
|
pd:=parraydef(pd)^.definition;
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Message(cg_e_invalid_qualifier);
|
||||||
|
disposetree(p1);
|
||||||
|
p1:=genzeronode(errorn);
|
||||||
|
again:=false;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if token=COMMA then
|
||||||
|
consume(COMMA)
|
||||||
|
else
|
||||||
|
break;
|
||||||
|
until false;
|
||||||
|
consume(RECKKLAMMER);
|
||||||
|
end;
|
||||||
|
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(false,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(false,sym,p1,pd,again);
|
||||||
|
end;
|
||||||
|
pointerdef : begin
|
||||||
|
Message(cg_e_invalid_qualifier);
|
||||||
|
if ppointerdef(pd)^.definition^.deftype in [recorddef,objectdef,classrefdef] then
|
||||||
|
Message(parser_h_maybe_deref_caret_missing);
|
||||||
|
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 and proc_to_procvar_equal(pprocvardef(pd),getprocvardef) then
|
||||||
|
again:=false
|
||||||
|
else
|
||||||
|
if (token=LKLAMMER) or
|
||||||
|
((pprocvardef(pd)^.para1=nil) 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:=gencallnode(nil,nil);
|
||||||
|
p1^.right:=p2;
|
||||||
|
p1^.unit_specific:=unit_specific;
|
||||||
|
p1^.symtableprocentry:=sym;
|
||||||
|
if token=LKLAMMER then
|
||||||
|
begin
|
||||||
|
consume(LKLAMMER);
|
||||||
|
p1^.left:=parse_paras(false,false);
|
||||||
|
consume(RKLAMMER);
|
||||||
|
end;
|
||||||
|
pd:=pprocvardef(pd)^.retdef;
|
||||||
|
{ proc():= is never possible }
|
||||||
|
if token=ASSIGNMENT then
|
||||||
|
begin
|
||||||
|
Message(cg_e_illegal_expression);
|
||||||
|
p1:=genzeronode(errorn);
|
||||||
|
again:=false;
|
||||||
|
end;
|
||||||
|
p1^.resulttype:=pd;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
again:=false;
|
||||||
|
p1^.resulttype:=pd;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
again:=false;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
again:=false;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
check_tokenpos;
|
||||||
|
end; { while again }
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{---------------------------------------------
|
||||||
|
Factor (Main)
|
||||||
|
---------------------------------------------}
|
||||||
|
|
||||||
|
begin
|
||||||
|
oldp1:=nil;
|
||||||
|
filepos:=tokenpos;
|
||||||
|
if token=ID then
|
||||||
|
begin
|
||||||
|
factor_read_id;
|
||||||
{ handle post fix operators }
|
{ handle post fix operators }
|
||||||
postfixoperators;
|
postfixoperators;
|
||||||
end;
|
end
|
||||||
|
else
|
||||||
|
case token of
|
||||||
_NEW : begin
|
_NEW : begin
|
||||||
consume(_NEW);
|
consume(_NEW);
|
||||||
consume(LKLAMMER);
|
consume(LKLAMMER);
|
||||||
@ -1855,7 +1873,10 @@ unit pexpr;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.40 1998-08-20 09:26:41 pierre
|
Revision 1.41 1998-08-20 21:36:39 peter
|
||||||
|
* fixed 'with object do' bug
|
||||||
|
|
||||||
|
Revision 1.40 1998/08/20 09:26:41 pierre
|
||||||
+ funcret setting in underproc testing
|
+ funcret setting in underproc testing
|
||||||
compile with _dTEST_FUNCRET
|
compile with _dTEST_FUNCRET
|
||||||
|
|
||||||
|
|||||||
@ -366,6 +366,7 @@ unit pstatmnt;
|
|||||||
|
|
||||||
withsymtable:=new(psymtable,init(symtable.withsymtable));
|
withsymtable:=new(psymtable,init(symtable.withsymtable));
|
||||||
withsymtable^.root:=obj^.publicsyms^.root;
|
withsymtable^.root:=obj^.publicsyms^.root;
|
||||||
|
withsymtable^.defowner:=obj;
|
||||||
symtab:=withsymtable;
|
symtab:=withsymtable;
|
||||||
levelcount:=1;
|
levelcount:=1;
|
||||||
obj:=obj^.childof;
|
obj:=obj^.childof;
|
||||||
@ -386,6 +387,7 @@ unit pstatmnt;
|
|||||||
withsymtable:=new(psymtable,init(symtable.withsymtable));
|
withsymtable:=new(psymtable,init(symtable.withsymtable));
|
||||||
withsymtable^.root:=symtab^.root;
|
withsymtable^.root:=symtab^.root;
|
||||||
withsymtable^.next:=symtablestack;
|
withsymtable^.next:=symtablestack;
|
||||||
|
withsymtable^.defowner:=obj;
|
||||||
symtablestack:=withsymtable;
|
symtablestack:=withsymtable;
|
||||||
end;
|
end;
|
||||||
else
|
else
|
||||||
@ -1236,7 +1238,10 @@ unit pstatmnt;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.35 1998-08-20 09:26:42 pierre
|
Revision 1.36 1998-08-20 21:36:41 peter
|
||||||
|
* fixed 'with object do' bug
|
||||||
|
|
||||||
|
Revision 1.35 1998/08/20 09:26:42 pierre
|
||||||
+ funcret setting in underproc testing
|
+ funcret setting in underproc testing
|
||||||
compile with _dTEST_FUNCRET
|
compile with _dTEST_FUNCRET
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user