cursor.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
---------------------------> Sather 1.1 source file <--------------------------
-- Copyright (C) International Computer Science Institute, 1995. COPYRIGHT --
-- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
-- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in --
-- the file "Doc/License" of the Sather distribution. The license is also --
-- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA. --
--------> Please email comments to sather-bugs@icsi.berkeley.edu. <----------
-- this file defines a cursor object that is able to traverse the
-- AM tree evaluation order (mostly, with some exceptions, check out
-- next_branch). It also allows the deletion and insertion of
-- nodes during this traversal. To do this, an AM_CURSOR stores
-- its current position in the tree in a stack of AM_CURSOR_POS
-- objects. This object has a pointer to the am node in the treee
-- and a branch which defines which of the childs of this node is
-- currently used. Branch 999999 is used for statements and denotes
-- the next statement, Branch 888888 is used for some special nodes
-- to make it possible to visit childs before visiting the node itself
-- (used for example for function call expressions).
-- if you add or change some AM_NODES, you have to
-- fix next_branch, replace_expr and replace_stmt.
class AM_CURSOR_POS < $IS_EQ
class AM_CURSOR_POS < $IS_EQ is
include COMPARABLE;
attr stmt:$AM;
attr branch:INT;
attr mark:BOOL; -- used by several optimization phases
str:STR is
ret::="";
ret:=ret+"stmt="+SYS::str_for_tp(SYS::tp(stmt))+"["+SYS::id(stmt)+"]";-- STR::plus STR::plus SYS::str_for_tp SYS::tp AM_CURSOR_POS::stmt STR::plus STR::plus SYS::id AM_CURSOR_POS::stmt STR::plus
ret:=ret+" branch="+branch+" mark:"+mark;-- STR::plus AM_CURSOR_POS::branch STR::plus AM_CURSOR_POS::mark
return ret;
end;
is_eq(t:SAME):BOOL is
-- #OUT+"ob: ("+SYS::id(stmt)+","+branch+")\t("+SYS::id(t.stmt)+","+t.branch+"\n";
return SYS::ob_eq(stmt,t.stmt) and branch=t.branch and mark=t.mark;-- SYS::ob_eq AM_CURSOR_POS::stmt AM_CURSOR_POS::stmt AM_CURSOR_POS::branch INT::is_eq AM_CURSOR_POS::branch AM_CURSOR_POS::mark BOOL::is_eq AM_CURSOR_POS::mark
end;
is_neq(t:SAME):BOOL is return ~is_eq(t); end;
create(curr_stmt:$AM,m:BOOL,branch:INT):SAME is
r::=new;
r.stmt:=curr_stmt;-- AM_CURSOR_POS::stmt
r.branch:=branch;-- AM_CURSOR_POS::branch
r.mark:=m;-- AM_CURSOR_POS::mark
return r;
end;
end;
class AM_CURSOR < $IS_EQ
class AM_CURSOR < $IS_EQ is
include COMPARABLE;
attr cur:$AM;
attr top:$AM;
attr mark:BOOL;
attr stack:A_STACK{AM_CURSOR_POS};
attr loops:INT;
attr indent:INT;
attr prog:PROG;
attr with_side_effects:BOOL;
attr ignore_next:BOOL;
attr ignore_pre:BOOL;
attr ignore_post:BOOL;
attr ignore_assert:BOOL;
attr assign_in_order:BOOL; -- returns the expressions of assignments
-- before the assign stmt. Most of the time
-- this is not desired, but sometimes (like CSE)
-- we need it
str:STR is
ret::="";
ret:=ret+"AM_CURSOR: "+SYS::id(self)+"\n ";-- STR::plus STR::plus SYS::id STR::plus
if void(cur) then-- AM_CURSOR::cur
ret:=ret+"cur=VOID ";-- STR::plus
else
ret:=ret+"cur="+SYS::str_for_tp(SYS::tp(cur))+"["+SYS::id(cur)+"] ";-- STR::plus STR::plus SYS::str_for_tp SYS::tp AM_CURSOR::cur STR::plus STR::plus SYS::id AM_CURSOR::cur STR::plus
end;
if void(top) then-- AM_CURSOR::top
ret:=ret+"top=VOID"
else-- STR::plus
ret:=ret+"top="+SYS::str_for_tp(SYS::tp(top))+"["+SYS::id(top)+"]";-- STR::plus STR::plus SYS::str_for_tp SYS::tp AM_CURSOR::top STR::plus STR::plus SYS::id AM_CURSOR::top STR::plus
end;
ret:=ret+"loops="+loops+" indent="+indent+" {\n";-- STR::plus AM_CURSOR::loops STR::plus AM_CURSOR::indent STR::plus
loop
ret:=ret+" "+stack.reverse_elt!.str+"\n";-- STR::plus AM_CURSOR::stack A_STACK{1}::reverse_elt! AM_CURSOR_POS::str STR::plus
end;
ret:=ret+"}\n";-- STR::plus
return ret;
end;
is_eq(c:SAME):BOOL is
-- #OUT+"comparing two AM_CURSOR:\n";
-- #OUT+"top:\t"+SYS::id(top)+"\t"+SYS::id(c.top)+"\n";
-- #OUT+"cur:\t"+SYS::id(cur)+"\t"+SYS::id(c.cur)+"\n";
-- #OUT+"loops:\t"+loops+"\t"+c.loops+"\n";
-- #OUT+"indent:\t"+indent+"\t"+c.indent+"\n";
-- #OUT+"size:\t"+stack.size+"\t"+c.stack.size+"\n";
-- #OUT+str+c.str;
if void(self) then return void(c); end;
if void(c) then return false; end;
if ignore_pre /= c.ignore_pre or-- AM_CURSOR::ignore_pre BOOL::is_eq AM_CURSOR::ignore_pre BOOL::not
ignore_post /= c.ignore_post or-- AM_CURSOR::ignore_post BOOL::is_eq AM_CURSOR::ignore_post BOOL::not
assign_in_order /= c.assign_in_order or-- AM_CURSOR::assign_in_order BOOL::is_eq AM_CURSOR::assign_in_order BOOL::not
ignore_assert /= c.ignore_assert then return false; end;-- AM_CURSOR::ignore_assert BOOL::is_eq AM_CURSOR::ignore_assert BOOL::not
if ~SYS::ob_eq(cur,c.cur) or ~SYS::ob_eq(top,c.top)-- SYS::ob_eq AM_CURSOR::cur AM_CURSOR::cur BOOL::not SYS::ob_eq AM_CURSOR::top AM_CURSOR::top
or loops/=c.loops or indent/=c.indent or-- BOOL::not AM_CURSOR::loops INT::is_eq AM_CURSOR::loops BOOL::not AM_CURSOR::indent INT::is_eq AM_CURSOR::indent BOOL::not
stack.size/=c.stack.size then -- AM_CURSOR::stack A_STACK{1}::size INT::is_eq AM_CURSOR::stack A_STACK{1}::size BOOL::not
-- #OUT+"IS NOT EQUAL\n";
return false;
end;
loop
if stack.reverse_elt!/=c.stack.reverse_elt! then -- AM_CURSOR::stack A_STACK{1}::reverse_elt! AM_CURSOR_POS::is_eq AM_CURSOR::stack A_STACK{1}::reverse_elt! BOOL::not
-- #OUT+"IS NOT EQUAL\n";
return false;
end;
end;
-- #OUT+"IS EQUAL\n";
return true;
end;
is_neq(t:SAME):BOOL is return ~is_eq(t); end;
is_current_lhs:BOOL is
if stack.size=0 then return true; end;-- AM_CURSOR::stack A_STACK{1}::size INT::is_eq
p::=stack.top;-- AM_CURSOR::stack A_STACK{1}::top
tcur::=p.stmt;-- AM_CURSOR_POS::stmt
branch::=p.branch;-- AM_CURSOR_POS::branch
typecase tcur
when AM_WAITFOR_STMT then
-- if branch=1 or branch=3 then #OUT+"current_is_lhs in WAITFOR 1\n"; end;
return branch=1 or branch=3;-- INT::is_eq INT::is_eq
when AM_PREFETCH_STMT then
-- if branch=1 or branch=3 then #OUT+"current_is_lhs in PREFETCH 1\n"; end;
return branch=1 or branch=3;-- INT::is_eq INT::is_eq
when AM_ASSIGN_STMT then
-- if branch=1 then #OUT+"current_is_lhs in ASSIGN 1\n"; end;
return branch=1;-- INT::is_eq
when AM_CALL_ARG then
-- if tcur.mode/=MODES::in_mode then #OUT+"current_is_lhs in out/inout arg\n"; end;
return tcur.mode/=MODES::in_mode;-- AM_CALL_ARG::mode MODES::in_mode
else return false;
end;
end;
is_const(am:$AM):BOOL is
if void(am) then return true; end;
typecase am
when $AM_CONST then return true;
when AM_ROUT_CALL_EXPR then
if with_side_effects then-- AM_CURSOR::with_side_effects
c::=am.fun.get_se_context(prog);-- AM_ROUT_CALL_EXPR::fun SIG::get_se_context AM_CURSOR::prog
if c.size>0 or c.full or c.unsafe or c.has_raise then return false; end;-- SE_CONTEXT::size INT::is_lt SE_CONTEXT::full SE_CONTEXT::unsafe SE_CONTEXT::has_raise
loop if ~is_const(am.elt!.expr) then return false; end; end;-- AM_CURSOR::is_const AM_ROUT_CALL_EXPR::elt! AM_CALL_ARG::expr BOOL::not
return true;
else return false;
end;
when AM_GLOBAL_EXPR then
return am.is_const;-- AM_GLOBAL_EXPR::is_const
when AM_CLUSTER_EXPR then return true;
when AM_HERE_EXPR then return true;
when AM_CLUSTER_SIZE_EXPR then return true;
else return false;
end;
end;
private is_am_local_expr_const_in(c:AM_CURSOR,am:AM_LOCAL_EXPR):BOOL is
-- a hot argument local is never const
if am.is_hot then return false; end;-- AM_LOCAL_EXPR::is_hot
loop
t::=c.next!;-- AM_CURSOR::next!
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
#OUT+"is_am_local_expr_const_in "+SYS::str_for_tp(SYS::tp(am))+"\n";-- OUT::create OUT::plus OUT::plus SYS::str_for_tp SYS::tp OUT::plus
#OUT+"\n";-- OUT::create OUT::plus
end;
if c=self then if prog.opt_debug then #OUT+"TRUE\n";end;return true; end;-- AM_CURSOR::is_eq AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus
typecase t
when AM_CALL_ARG then
-- AM_CALL_ARG's are ignored, as next! will return the
-- expression anyway.
when AM_ASSIGN_STMT then
if SYS::ob_eq(t.dest,am) then -- SYS::ob_eq AM_ASSIGN_STMT::dest
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
#OUT+"there is an assignment to the local var ";-- OUT::create OUT::plus
AM_OUT::AM_out(am);#OUT+" namely:\n";-- AM_OUT::AM_out OUT::create OUT::plus
AM_OUT::AM_one_stmt(t);-- AM_OUT::AM_one_stmt
end;
return false;
end;
when AM_WAITFOR_STMT then
if SYS::ob_eq(t.dest,am) or SYS::ob_eq(t.prefetch,am) then -- SYS::ob_eq AM_WAITFOR_STMT::dest SYS::ob_eq AM_WAITFOR_STMT::prefetch
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
#OUT+"there is an assignment to the local var ";-- OUT::create OUT::plus
AM_OUT::AM_out(am);#OUT+" namely:\n";-- AM_OUT::AM_out OUT::create OUT::plus
AM_OUT::AM_one_stmt(t);-- AM_OUT::AM_one_stmt
end;
return false;
end;
when AM_PREFETCH_STMT then
if SYS::ob_eq(t.dest,am) or SYS::ob_eq(t.prefetch,am) then -- SYS::ob_eq AM_PREFETCH_STMT::dest SYS::ob_eq AM_PREFETCH_STMT::prefetch
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
#OUT+"there is an assignment to the local var ";-- OUT::create OUT::plus
AM_OUT::AM_out(am);#OUT+" namely:\n";-- AM_OUT::AM_out OUT::create OUT::plus
AM_OUT::AM_one_stmt(t);-- AM_OUT::AM_one_stmt
end;
return false;
end;
when $AM_CALL_EXPR then
loop
a::=t.aget(0.upto!(t.asize-1));-- INT::upto! INT::minus
if (a.mode=MODES::out_mode or a.mode=MODES::inout_mode) -- AM_CALL_ARG::mode MODES::out_mode AM_CALL_ARG::mode MODES::inout_mode
and SYS::ob_eq(a.expr,am) then -- SYS::ob_eq AM_CALL_ARG::expr
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
#OUT+"the local var ";-- OUT::create OUT::plus
AM_OUT::AM_out(am);#OUT+" is used as an (in)out arg in:\n";-- AM_OUT::AM_out OUT::create OUT::plus
AM_OUT::AM_out(t);-- AM_OUT::AM_out
end;
return false;
end;
end;
else end;
end;
return true;
end;
private is_am_global_expr_const_in(c1:AM_CURSOR,tp:$TP,name:IDENT):BOOL is
loop
t::=c1.next!;-- AM_CURSOR::next!
if c1=self then return true; end;-- AM_CURSOR::is_eq
typecase t
when AM_WAITFOR_STMT then
d::=t.dest;-- AM_WAITFOR_STMT::dest
typecase d when AM_GLOBAL_EXPR then
if d.class_tp=tp and d.name=name then -- AM_GLOBAL_EXPR::class_tp AM_GLOBAL_EXPR::name IDENT::is_eq
if prog.opt_debug then -- AM_CURSOR::prog PROG::opt_debug
#OUT+"there is an assignemnt to type "+tp.str+"::"+name.str+" namely:\n";-- OUT::create OUT::plus OUT::plus OUT::plus OUT::plus IDENT::str OUT::plus
AM_OUT::AM_one_stmt(t);-- AM_OUT::AM_one_stmt
end;
return false;
end;
else end;
d:=t.prefetch;-- AM_WAITFOR_STMT::prefetch
typecase d when AM_GLOBAL_EXPR then
if d.class_tp=tp and d.name=name then -- AM_GLOBAL_EXPR::class_tp AM_GLOBAL_EXPR::name IDENT::is_eq
-- if prog.opt_debug then
-- #OUT+"there is an assignemnt to type "+tp.str+"::"+name.str+" namely:\n";
-- AM_OUT::AM_one_stmt(t);
-- end;
return false;
end;
else end;
when AM_PREFETCH_STMT then
d::=t.dest;-- AM_PREFETCH_STMT::dest
typecase d when AM_GLOBAL_EXPR then
if d.class_tp=tp and d.name=name then -- AM_GLOBAL_EXPR::class_tp AM_GLOBAL_EXPR::name IDENT::is_eq
-- if prog.opt_debug then
-- #OUT+"there is an assignemnt to type "+tp.str+"::"+name.str+" namely:\n";
-- AM_OUT::AM_one_stmt(t);
-- end;
return false;
end;
else end;
d:=t.prefetch;-- AM_PREFETCH_STMT::prefetch
typecase d when AM_GLOBAL_EXPR then
if d.class_tp=tp and d.name=name then -- AM_GLOBAL_EXPR::class_tp AM_GLOBAL_EXPR::name IDENT::is_eq
-- if prog.opt_debug then
-- #OUT+"there is an assignemnt to type "+tp.str+"::"+name.str+" namely:\n";
-- AM_OUT::AM_one_stmt(t);
-- end;
return false;
end;
else end;
when AM_ASSIGN_STMT then
d::=t.dest;-- AM_ASSIGN_STMT::dest
typecase d when AM_GLOBAL_EXPR then
if d.class_tp=tp and d.name=name then -- AM_GLOBAL_EXPR::class_tp AM_GLOBAL_EXPR::name IDENT::is_eq
-- if prog.opt_debug then
-- #OUT+"there is an assignemnt to type "+tp.str+"::"+name.str+" namely:\n";
-- AM_OUT::AM_one_stmt(t);
-- end;
return false;
end;
else end;
when AM_ROUT_CALL_EXPR then
if with_side_effects then-- AM_CURSOR::with_side_effects
c::=t.fun.get_se_context(prog);-- AM_ROUT_CALL_EXPR::fun SIG::get_se_context AM_CURSOR::prog
if c.full then -- if prog.opt_debug then #OUT+"routine "+t.fun.str+" is marked full side effects\n";end;-- SE_CONTEXT::full
return false; end;
se::=c.se_attr(tp,name);-- SE_CONTEXT::se_attr
if ~void(se) and se.doeswrite then -- if prog.opt_debug then #OUT+"routine "+t.fun.str+" writes to type "+tp.str+"::"+name.str+"\n";end;-- BOOL::not SIDE_EFFECT::doeswrite
return false; end;
else return false;
end;
loop
a::=t.elt!;-- AM_ROUT_CALL_EXPR::elt!
if a.mode=MODES::inout_mode or a.mode=MODES::out_mode then-- AM_CALL_ARG::mode MODES::inout_mode AM_CALL_ARG::mode MODES::out_mode
e::=a.expr;-- AM_CALL_ARG::expr
typecase e when AM_GLOBAL_EXPR then
if e.class_tp=tp and e.name=name then return false; end;-- AM_GLOBAL_EXPR::class_tp AM_GLOBAL_EXPR::name IDENT::is_eq
else end
end;
end;
when AM_ITER_CALL_EXPR then
if with_side_effects then-- AM_CURSOR::with_side_effects
c::=t.fun.get_se_context(prog);-- AM_ITER_CALL_EXPR::fun SIG::get_se_context AM_CURSOR::prog
if c.full then -- if prog.opt_debug then #OUT+"iter "+t.fun.str+" is marked full side effects\n";end;-- SE_CONTEXT::full
return false; end;
se::=c.se_attr(tp,name);-- SE_CONTEXT::se_attr
if ~void(se) and se.doeswrite then if prog.opt_debug then #OUT+"iter "+t.fun.str+" writes to type "+tp.str+"::"+name.str+"\n";end;return false; end;-- BOOL::not SIDE_EFFECT::doeswrite AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus OUT::plus AM_ITER_CALL_EXPR::fun SIG::str OUT::plus OUT::plus OUT::plus OUT::plus IDENT::str OUT::plus
else return false;
end;
loop
a::=t.elt!;-- AM_ITER_CALL_EXPR::elt!
if a.mode=MODES::inout_mode or a.mode=MODES::out_mode then-- AM_CALL_ARG::mode MODES::inout_mode AM_CALL_ARG::mode MODES::out_mode
e::=a.expr;-- AM_CALL_ARG::expr
typecase e when AM_GLOBAL_EXPR then
if e.class_tp=tp and e.name=name then return false; end;-- AM_GLOBAL_EXPR::class_tp AM_GLOBAL_EXPR::name IDENT::is_eq
else end
end;
end;
when AM_BND_ROUT_CALL_EXPR then if prog.opt_debug then #OUT+"not const, because of AM_BND_ROUT_CALL\n";end;return false;-- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus
when AM_BND_ITER_CALL_EXPR then if prog.opt_debug then #OUT+"not const, because of AM_BND_ITER_CALL\n";end;return false; -- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus
when AM_EXT_CALL_EXPR then if prog.opt_debug then #OUT+"not const, because of AM_EXT_CALL "+t.fun.str+"\n";end;return false;-- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus OUT::plus AM_EXT_CALL_EXPR::fun SIG::str OUT::plus
else end;
end;
return true;
end;
private is_am_attr_expr_const_in(cr:AM_CURSOR,self_tp:$TP,name:IDENT):BOOL is
loop
t::=cr.next!;-- AM_CURSOR::next!
if cr=self then return true; end;-- AM_CURSOR::is_eq
typecase t
when AM_WAITFOR_STMT then
d::=t.dest;-- AM_WAITFOR_STMT::dest
typecase d when AM_ATTR_EXPR then
if d.self_tp=self_tp and d.at=name then -- AM_ATTR_EXPR::self_tp AM_ATTR_EXPR::at IDENT::is_eq
if prog.opt_debug then -- AM_CURSOR::prog PROG::opt_debug
#OUT+"there is an assignemnt to type "+self_tp.str+"::"+name.str+" namely:\n";-- OUT::create OUT::plus OUT::plus OUT::plus OUT::plus IDENT::str OUT::plus
AM_OUT::AM_one_stmt(t);-- AM_OUT::AM_one_stmt
end;
return false;
end;
else end;
d:=t.prefetch;-- AM_WAITFOR_STMT::prefetch
typecase d when AM_ATTR_EXPR then
if d.self_tp=self_tp and d.at=name then -- AM_ATTR_EXPR::self_tp AM_ATTR_EXPR::at IDENT::is_eq
if prog.opt_debug then -- AM_CURSOR::prog PROG::opt_debug
#OUT+"there is an assignemnt to type "+self_tp.str+"::"+name.str+" namely:\n";-- OUT::create OUT::plus OUT::plus OUT::plus OUT::plus IDENT::str OUT::plus
AM_OUT::AM_one_stmt(t);-- AM_OUT::AM_one_stmt
end;
return false;
end;
else end;
when AM_PREFETCH_STMT then
d::=t.dest;-- AM_PREFETCH_STMT::dest
typecase d when AM_ATTR_EXPR then
if d.self_tp=self_tp and d.at=name then -- AM_ATTR_EXPR::self_tp AM_ATTR_EXPR::at IDENT::is_eq
if prog.opt_debug then -- AM_CURSOR::prog PROG::opt_debug
#OUT+"there is an assignemnt to type "+self_tp.str+"::"+name.str+" namely:\n";-- OUT::create OUT::plus OUT::plus OUT::plus OUT::plus IDENT::str OUT::plus
AM_OUT::AM_one_stmt(t);-- AM_OUT::AM_one_stmt
end;
return false;
end;
else end;
d:=t.prefetch;-- AM_PREFETCH_STMT::prefetch
typecase d when AM_ATTR_EXPR then
if d.self_tp=self_tp and d.at=name then -- AM_ATTR_EXPR::self_tp AM_ATTR_EXPR::at IDENT::is_eq
if prog.opt_debug then -- AM_CURSOR::prog PROG::opt_debug
#OUT+"there is an assignemnt to type "+self_tp.str+"::"+name.str+" namely:\n";-- OUT::create OUT::plus OUT::plus OUT::plus OUT::plus IDENT::str OUT::plus
AM_OUT::AM_one_stmt(t);-- AM_OUT::AM_one_stmt
end;
return false;
end;
else end;
when AM_ASSIGN_STMT then
d::=t.dest;-- AM_ASSIGN_STMT::dest
typecase d when AM_ATTR_EXPR then
if d.self_tp=self_tp and d.at=name then -- AM_ATTR_EXPR::self_tp AM_ATTR_EXPR::at IDENT::is_eq
if prog.opt_debug then -- AM_CURSOR::prog PROG::opt_debug
#OUT+"there is an assignemnt to type "+self_tp.str+"::"+name.str+" namely:\n";-- OUT::create OUT::plus OUT::plus OUT::plus OUT::plus IDENT::str OUT::plus
AM_OUT::AM_one_stmt(t);-- AM_OUT::AM_one_stmt
end;
return false;
end;
else end;
when AM_ROUT_CALL_EXPR then
if with_side_effects then-- AM_CURSOR::with_side_effects
c::=t.fun.get_se_context(prog);-- AM_ROUT_CALL_EXPR::fun SIG::get_se_context AM_CURSOR::prog
if c.full then -- if prog.opt_debug then #OUT+"routine "+t.fun.str+" is marked full side effects\n";end;-- SE_CONTEXT::full
return false; end;
se::=c.se_attr(self_tp,name);-- SE_CONTEXT::se_attr
if ~void(se) and se.doeswrite then if prog.opt_debug then #OUT+"routine "+t.fun.str+" writes to type "+self_tp.str+"::"+name.str+"\n";end;return false; end;-- BOOL::not SIDE_EFFECT::doeswrite AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus OUT::plus AM_ROUT_CALL_EXPR::fun SIG::str OUT::plus OUT::plus OUT::plus OUT::plus IDENT::str OUT::plus
else return false;
end;
loop
a::=t.elt!;-- AM_ROUT_CALL_EXPR::elt!
if a.mode=MODES::inout_mode or a.mode=MODES::out_mode then-- AM_CALL_ARG::mode MODES::inout_mode AM_CALL_ARG::mode MODES::out_mode
e::=a.expr;-- AM_CALL_ARG::expr
typecase e when AM_ATTR_EXPR then
if e.self_tp=self_tp and e.at=name then return false; end;-- AM_ATTR_EXPR::self_tp AM_ATTR_EXPR::at IDENT::is_eq
else end
end;
end;
when AM_ITER_CALL_EXPR then
if with_side_effects then-- AM_CURSOR::with_side_effects
c::=t.fun.get_se_context(prog);-- AM_ITER_CALL_EXPR::fun SIG::get_se_context AM_CURSOR::prog
if c.full then -- if prog.opt_debug then #OUT+"iter "+t.fun.str+" is marked full side effects\n";end;-- SE_CONTEXT::full
return false; end;
se::=c.se_attr(self_tp,name);-- SE_CONTEXT::se_attr
if ~void(se) and se.doeswrite then if prog.opt_debug then #OUT+"iter "+t.fun.str+" writes to type "+self_tp.str+"::"+name.str+"\n";end;return false; end;-- BOOL::not SIDE_EFFECT::doeswrite AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus OUT::plus AM_ITER_CALL_EXPR::fun SIG::str OUT::plus OUT::plus OUT::plus OUT::plus IDENT::str OUT::plus
else return false;
end;
loop
a::=t.elt!;-- AM_ITER_CALL_EXPR::elt!
if a.mode=MODES::inout_mode or a.mode=MODES::out_mode then-- AM_CALL_ARG::mode MODES::inout_mode AM_CALL_ARG::mode MODES::out_mode
e::=a.expr;-- AM_CALL_ARG::expr
typecase e when AM_ATTR_EXPR then
if e.self_tp=self_tp and e.at=name then return false; end;-- AM_ATTR_EXPR::self_tp AM_ATTR_EXPR::at IDENT::is_eq
else end
end;
end;
when AM_BND_ROUT_CALL_EXPR then if prog.opt_debug then #OUT+"not const, because of AM_BND_ROUT_CALL\n";end;return false;-- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus
when AM_BND_ITER_CALL_EXPR then if prog.opt_debug then #OUT+"not const, because of AM_BND_ITER_CALL\n";end;return false; -- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus
when AM_EXT_CALL_EXPR then if prog.opt_debug then #OUT+"not const, because of AM_EXT_CALL "+t.fun.str+"\n";end;return false;-- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus OUT::plus AM_EXT_CALL_EXPR::fun SIG::str OUT::plus
else end;
end;
return true;
end;
private is_am_rout_call_expr_const_in(c1:AM_CURSOR,am:AM_ROUT_CALL_EXPR):BOOL is
if with_side_effects then-- AM_CURSOR::with_side_effects
c::=am.fun.get_se_context(prog);-- AM_ROUT_CALL_EXPR::fun SIG::get_se_context AM_CURSOR::prog
if c.full or c.unsafe or c.has_raise then-- SE_CONTEXT::full SE_CONTEXT::unsafe SE_CONTEXT::has_raise
-- if prog.opt_debug then
-- #OUT+"found full, unsafe or has_raise for routine "+am.fun.str+"\n";
-- end;
return false;
end;
loop e::=c.elt!;-- SE_CONTEXT::elt!
if e.doeswrite or void(e.tp) or void(e.name) then-- SIDE_EFFECT::doeswrite SIDE_EFFECT::tp SIDE_EFFECT::name
-- if prog.opt_debug then
-- #OUT+"routine "+am.fun.str+", attr tp=";
-- if void(e.tp) then #OUT+"void";
-- else #OUT+e.tp.str; end;
-- #OUT+" name=";
-- if void(e.name) then #OUT+"void";
-- else #OUT+e.name.str; end;
-- #OUT+" doeswrite="+e.doeswrite+"\n"
-- end;
return false;
else
if ~is_am_attr_expr_const_in(#(c1),e.tp,e.name) then return false; end;-- AM_CURSOR::is_am_attr_expr_const_in AM_CURSOR::create SIDE_EFFECT::tp SIDE_EFFECT::name BOOL::not
end;
end;
loop
if am.elt!.mode/=MODES::in_mode then return false; end;-- AM_ROUT_CALL_EXPR::elt! AM_CALL_ARG::mode MODES::in_mode BOOL::not
if ~is_const_in(#(c1),am.elt!) then return false; end; -- AM_CURSOR::is_const_in AM_CURSOR::create AM_ROUT_CALL_EXPR::elt! BOOL::not
end;
return true;
else return false;
end;
end;
private is_am_rout_call_expr_non_fatal_and_const_in(c1:AM_CURSOR,am:AM_ROUT_CALL_EXPR):BOOL is
if with_side_effects and ~prog.arith_checks then-- AM_CURSOR::with_side_effects AM_CURSOR::prog PROG::arith_checks BOOL::not
c::=am.fun.get_se_context(prog);-- AM_ROUT_CALL_EXPR::fun SIG::get_se_context AM_CURSOR::prog
if c.full or c.unsafe or c.has_raise or c.has_fatal_error then-- SE_CONTEXT::full SE_CONTEXT::unsafe SE_CONTEXT::has_raise SE_CONTEXT::has_fatal_error
if prog.opt_debug then -- AM_CURSOR::prog PROG::opt_debug
#OUT+"found full, unsafe, has_fatal_error or has_raise for routine "+am.fun.str+"\n";-- OUT::create OUT::plus OUT::plus AM_ROUT_CALL_EXPR::fun SIG::str OUT::plus
end;
return false;
end;
loop e::=c.elt!;-- SE_CONTEXT::elt!
if e.doeswrite or void(e.tp) or void(e.name) then -- SIDE_EFFECT::doeswrite SIDE_EFFECT::tp SIDE_EFFECT::name
-- if prog.opt_debug then
-- #OUT+"routine "+am.fun.str+", attr tp=";
-- if void(e.tp) then #OUT+"void";
-- else #OUT+e.tp.str; end;
-- #OUT+" name=";
-- if void(e.name) then #OUT+"void";
-- else #OUT+e.name.str; end;
-- #OUT+" doeswrite="+e.doeswrite+"\n"
-- end;
return false;
else
if ~is_am_attr_expr_const_in(#(c1),e.tp,e.name) then return false; end;-- AM_CURSOR::is_am_attr_expr_const_in AM_CURSOR::create SIDE_EFFECT::tp SIDE_EFFECT::name BOOL::not
end;
end;
loop
if am.elt!.mode/=MODES::in_mode then return false; end;-- AM_ROUT_CALL_EXPR::elt! AM_CALL_ARG::mode MODES::in_mode BOOL::not
if ~is_non_fatal_and_const_in(#(c1),am.elt!) then return false; end; -- AM_CURSOR::is_non_fatal_and_const_in AM_CURSOR::create AM_ROUT_CALL_EXPR::elt! BOOL::not
end;
return true;
else return false;
end;
end;
private is_const_in(c:AM_CURSOR,am:$AM):BOOL is
--if prog.opt_debug then
--#OUT+"is_const_in: self="+str+"c=\n"+c.str+"am=";
--AM_OUT::AM_out(am);
--end;
if is_const(am) then return true; end;-- AM_CURSOR::is_const
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
#OUT+"is_const_in +"+SYS::str_for_tp(SYS::tp(am))+"\n";-- OUT::create OUT::plus OUT::plus SYS::str_for_tp SYS::tp OUT::plus
end;
typecase am
when AM_LOCAL_EXPR then
return is_am_local_expr_const_in(c,am);-- AM_CURSOR::is_am_local_expr_const_in
when AM_ROUT_CALL_EXPR then
return is_am_rout_call_expr_const_in(c,am);-- AM_CURSOR::is_am_rout_call_expr_const_in
when AM_ATTR_EXPR then
return is_am_attr_expr_const_in(#(c),am.self_tp,am.at) and is_const_in(c,am.ob);-- AM_CURSOR::is_am_attr_expr_const_in AM_CURSOR::create AM_ATTR_EXPR::self_tp AM_ATTR_EXPR::at AM_CURSOR::is_const_in AM_ATTR_EXPR::ob
when AM_GLOBAL_EXPR then
return is_am_global_expr_const_in(c,am.class_tp,am.name);-- AM_CURSOR::is_am_global_expr_const_in AM_GLOBAL_EXPR::class_tp AM_GLOBAL_EXPR::name
when AM_IS_VOID_EXPR then
return is_const_in(c,am.arg);-- AM_CURSOR::is_const_in AM_IS_VOID_EXPR::arg
when AM_CALL_ARG then
return is_const_in(c,am.expr);-- AM_CURSOR::is_const_in AM_CALL_ARG::expr
when AM_IF_EXPR then
return is_const_in(#(c),am.test) and -- AM_CURSOR::is_const_in AM_CURSOR::create AM_IF_EXPR::test
is_const_in(#(c),am.if_true) and-- AM_CURSOR::is_const_in AM_CURSOR::create AM_IF_EXPR::if_true
is_const_in(c,am.if_false);-- AM_CURSOR::is_const_in AM_IF_EXPR::if_false
when AM_STMT_EXPR then
-- normally AM_STMT_EXPR is considered to be non const. However,
-- if those statments replaced an expression, we assume that if
-- this replaced expression is const, then the AM_STMT_EXPR is
-- const too.
if ~void(am.replaced) then return is_const_in(#(c),am.replaced);-- AM_STMT_EXPR::replaced BOOL::not AM_CURSOR::is_const_in AM_CURSOR::create AM_STMT_EXPR::replaced
else
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
#OUT+"the following AM_NODE is considered to be non const: "+SYS::str_for_tp(SYS::tp(am))+"\n";-- OUT::create OUT::plus OUT::plus SYS::str_for_tp SYS::tp OUT::plus
end;
return false;
end;
else
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
#OUT+"the following AM_NODE is considered to be non const: "+SYS::str_for_tp(SYS::tp(am))+"\n";-- OUT::create OUT::plus OUT::plus SYS::str_for_tp SYS::tp OUT::plus
end;
return false;
end;
end;
private is_non_fatal_and_const_in(c:AM_CURSOR,am:$AM):BOOL is
if is_const(am) then return true; end;-- AM_CURSOR::is_const
typecase am
when AM_LOCAL_EXPR then
return is_am_local_expr_const_in(c,am);-- AM_CURSOR::is_am_local_expr_const_in
when AM_ROUT_CALL_EXPR then
return is_am_rout_call_expr_non_fatal_and_const_in(c,am);-- AM_CURSOR::is_am_rout_call_expr_non_fatal_and_const_in
when AM_ATTR_EXPR then
return is_am_attr_expr_const_in(#(c),am.self_tp,am.at) and is_non_fatal_and_const_in(c,am.ob);-- AM_CURSOR::is_am_attr_expr_const_in AM_CURSOR::create AM_ATTR_EXPR::self_tp AM_ATTR_EXPR::at AM_CURSOR::is_non_fatal_and_const_in AM_ATTR_EXPR::ob
when AM_GLOBAL_EXPR then
return is_am_global_expr_const_in(c,am.class_tp,am.name);-- AM_CURSOR::is_am_global_expr_const_in AM_GLOBAL_EXPR::class_tp AM_GLOBAL_EXPR::name
when AM_IS_VOID_EXPR then
return is_non_fatal_and_const_in(c,am.arg);-- AM_CURSOR::is_non_fatal_and_const_in AM_IS_VOID_EXPR::arg
when AM_CALL_ARG then
return is_non_fatal_and_const_in(c,am.expr);-- AM_CURSOR::is_non_fatal_and_const_in AM_CALL_ARG::expr
when AM_IF_EXPR then
return is_non_fatal_and_const_in(#(c),am.test) and -- AM_CURSOR::is_non_fatal_and_const_in AM_CURSOR::create AM_IF_EXPR::test
is_non_fatal_and_const_in(#(c),am.if_true) and-- AM_CURSOR::is_non_fatal_and_const_in AM_CURSOR::create AM_IF_EXPR::if_true
is_non_fatal_and_const_in(c,am.if_false);-- AM_CURSOR::is_non_fatal_and_const_in AM_IF_EXPR::if_false
when AM_STMT_EXPR then
-- normally AM_STMT_EXPR is considered to be fatal and non const. However,
-- if those statments replaced an expression, we assume that if
-- this replaced expression is const, then the AM_STMT_EXPR is
-- const too.
if ~void(am.replaced) then return is_non_fatal_and_const_in(#(c),am.replaced);-- AM_STMT_EXPR::replaced BOOL::not AM_CURSOR::is_non_fatal_and_const_in AM_CURSOR::create AM_STMT_EXPR::replaced
else
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
#OUT+"the following AM_NODE is considered to be non const: "+SYS::str_for_tp(SYS::tp(am))+"\n";-- OUT::create OUT::plus OUT::plus SYS::str_for_tp SYS::tp OUT::plus
end;
return false;
end;
else
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
#OUT+"the following AM_NODE is considered to be non const: "+SYS::str_for_tp(SYS::tp(am))+"\n";-- OUT::create OUT::plus OUT::plus SYS::str_for_tp SYS::tp OUT::plus
end;
return false;
end;
end;
is_const_in_loop(am:$AM):BOOL is
return is_const_in(#AM_CURSOR(prog,loop_stmt.body),am);-- AM_CURSOR::is_const_in AM_CURSOR::create AM_CURSOR::prog AM_CURSOR::loop_stmt AM_LOOP_STMT::body
end;
is_const_in_func(am:$AM):BOOL is
return is_const_in(#AM_CURSOR(prog,top),am);
end;
is_const_in_func_before_eval_cur_expr(am:$AM):BOOL is
c1:SAME:=#(self);-- AM_CURSOR::create
c1.init_next;-- AM_CURSOR::init_next
return is_const_in(c1,am);-- AM_CURSOR::is_const_in
end;
is_const_in_loop_before_eval_cur_expr(am:$AM):BOOL is
c1:SAME:=#(self);-- AM_CURSOR::create
c1.innermost_loop;-- AM_CURSOR::innermost_loop
c1.begin_of_loop_body;-- AM_CURSOR::begin_of_loop_body
return is_const_in(c1,am);-- AM_CURSOR::is_const_in
end;
is_non_fatal_and_const_in_loop(am:$AM):BOOL is
return is_non_fatal_and_const_in(#AM_CURSOR(prog,loop_stmt.body),am);-- AM_CURSOR::is_non_fatal_and_const_in AM_CURSOR::create AM_CURSOR::prog AM_CURSOR::loop_stmt AM_LOOP_STMT::body
end;
is_non_fatal_and_const_in_func(am:$AM):BOOL is
return is_non_fatal_and_const_in(#AM_CURSOR(prog,top),am);
end;
is_non_fatal_and_const_in_func_before_eval_cur_expr(am:$AM):BOOL is
c1:SAME:=#(self);
c1.init_next;
return is_non_fatal_and_const_in(c1,am);
end;
is_non_fatal_and_const_in_loop_before_eval_cur_expr(am:$AM):BOOL is
c1:SAME:=#(self);-- AM_CURSOR::create
c1.innermost_loop;-- AM_CURSOR::innermost_loop
c1.begin_of_loop_body;-- AM_CURSOR::begin_of_loop_body
return is_non_fatal_and_const_in(c1,am);-- AM_CURSOR::is_non_fatal_and_const_in
end;
private is_am_global_expr_not_used_in(c1:AM_CURSOR,tp:$TP,name:IDENT):BOOL is
loop
t::=c1.next!;-- AM_CURSOR::next!
if c1=self then return true; end;-- AM_CURSOR::is_eq
typecase t when AM_GLOBAL_EXPR then
if t.class_tp=tp and t.name=name then return false; end;-- AM_GLOBAL_EXPR::class_tp AM_GLOBAL_EXPR::name IDENT::is_eq
when AM_ROUT_CALL_EXPR then
if with_side_effects then-- AM_CURSOR::with_side_effects
c::=t.fun.get_se_context(prog);-- AM_ROUT_CALL_EXPR::fun SIG::get_se_context AM_CURSOR::prog
if c.full then return false; end; -- SE_CONTEXT::full
se::=c.se_attr(tp,name);-- SE_CONTEXT::se_attr
if ~void(se) then -- BOOL::not
-- if prog.opt_debug then #OUT+"found doeswrite or read ("+se.str+") in "+t.fun.str+"\n"; end;
return false; end;
else return false;
end;
when AM_ITER_CALL_EXPR then
if with_side_effects then-- AM_CURSOR::with_side_effects
c::=t.fun.get_se_context(prog);-- AM_ITER_CALL_EXPR::fun SIG::get_se_context AM_CURSOR::prog
if c.full then return false; end; -- SE_CONTEXT::full
se::=c.se_attr(tp,name);-- SE_CONTEXT::se_attr
if ~void(se) then return false; end;-- BOOL::not
else return false;
end;
when AM_BND_ROUT_CALL_EXPR then if prog.opt_debug then #OUT+"not unused, because of AM_BND_ROUT_CALL\n";end;return false;-- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus
when AM_BND_ITER_CALL_EXPR then if prog.opt_debug then #OUT+"not unused, because of AM_BND_ITER_CALL\n";end;return false; -- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus
when AM_EXT_CALL_EXPR then if prog.opt_debug then #OUT+"not unused, because of AM_EXT_CALL "+t.fun.str+"\n";end;return false;-- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus OUT::plus AM_EXT_CALL_EXPR::fun SIG::str OUT::plus
else end;
end;
end;
private is_am_attr_expr_not_used_in(c1:AM_CURSOR,tp:$TP,name:IDENT):BOOL is
loop
t::=c1.next!;-- AM_CURSOR::next!
if c1=self then return true; end;-- AM_CURSOR::is_eq
typecase t
when AM_ATTR_EXPR then
if t.tp=tp and t.at=name then return false; end;-- AM_ATTR_EXPR::tp AM_ATTR_EXPR::at IDENT::is_eq
when AM_ROUT_CALL_EXPR then
if with_side_effects then-- AM_CURSOR::with_side_effects
c::=t.fun.get_se_context(prog);-- AM_ROUT_CALL_EXPR::fun SIG::get_se_context AM_CURSOR::prog
if c.full then return false; end; -- SE_CONTEXT::full
se::=c.se_attr(tp,name);-- SE_CONTEXT::se_attr
if ~void(se) then return false; end;-- BOOL::not
else return false;
end;
when AM_ITER_CALL_EXPR then
if with_side_effects then-- AM_CURSOR::with_side_effects
c::=t.fun.get_se_context(prog);-- AM_ITER_CALL_EXPR::fun SIG::get_se_context AM_CURSOR::prog
if c.full then return false; end; -- SE_CONTEXT::full
se::=c.se_attr(tp,name);-- SE_CONTEXT::se_attr
if ~void(se) then return false; end;-- BOOL::not
else return false;
end;
when AM_BND_ROUT_CALL_EXPR then if prog.opt_debug then #OUT+"not unused, because of AM_BND_ROUT_CALL\n";end;return false;-- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus
when AM_BND_ITER_CALL_EXPR then if prog.opt_debug then #OUT+"not unused, because of AM_BND_ITER_CALL\n";end;return false; -- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus
when AM_EXT_CALL_EXPR then if prog.opt_debug then #OUT+"not unused, because of AM_EXT_CALL "+t.fun.str+"\n";end;return false;-- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus OUT::plus AM_EXT_CALL_EXPR::fun SIG::str OUT::plus
else end;
end;
return true;
end;
private is_am_local_expr_not_used_in(c1:AM_CURSOR,am:AM_LOCAL_EXPR):BOOL is
loop
t::=c1.next!;-- AM_CURSOR::next!
if c1=self then return true; end;-- AM_CURSOR::is_eq
typecase t
when AM_LOCAL_EXPR then
if am=t then return false; end; -- AM_LOCAL_EXPR::is_eq
else end;
end;
return true;
end;
private is_not_used_in(c:AM_CURSOR,am:$AM):BOOL is
typecase am
when AM_LOCAL_EXPR then
return is_am_local_expr_not_used_in(c,am);-- AM_CURSOR::is_am_local_expr_not_used_in
when AM_ATTR_EXPR then
return is_am_attr_expr_not_used_in(#(c),am.self_tp,am.at)-- AM_CURSOR::is_am_attr_expr_not_used_in AM_CURSOR::create AM_ATTR_EXPR::self_tp AM_ATTR_EXPR::at
and is_not_used_in(c,am.ob);-- AM_CURSOR::is_not_used_in AM_ATTR_EXPR::ob
when AM_GLOBAL_EXPR then
return is_am_global_expr_not_used_in(c,am.class_tp,am.name)-- AM_CURSOR::is_am_global_expr_not_used_in AM_GLOBAL_EXPR::class_tp AM_GLOBAL_EXPR::name
else
return false;
end;
end;
is_not_used_in_loop_before_eval_cur_expr(am:$AM):BOOL is
c1:SAME:=#(self);-- AM_CURSOR::create
c1.innermost_loop;-- AM_CURSOR::innermost_loop
c1.begin_of_loop_body;-- AM_CURSOR::begin_of_loop_body
return is_not_used_in(c1,am);-- AM_CURSOR::is_not_used_in
end;
private is_not_used_in_loop(am:AM_LOCAL_EXPR):BOOL is
return is_not_used_in(#AM_CURSOR(prog,loop_stmt.body),am);
end;
is_not_used_in_func(am:$AM):BOOL is
return is_not_used_in(#AM_CURSOR(prog,top),am);
end;
is_not_used_in_func_before_eval_cur_expr(am:$AM):BOOL is
c1:SAME:=#(self);-- AM_CURSOR::create
c1.init_next;-- AM_CURSOR::init_next
return is_not_used_in(c1,am);-- AM_CURSOR::is_not_used_in
end;
is_not_used_outside_innermost_loop(am:$AM):BOOL is
typecase am
when AM_LOCAL_EXPR then
lp::=loop_stmt;-- AM_CURSOR::loop_stmt
c1::=#AM_CURSOR(prog,top);-- AM_CURSOR::create AM_CURSOR::prog AM_CURSOR::top
loop
t::=c1.next!;-- AM_CURSOR::next!
typecase t
when AM_LOCAL_EXPR then
if am=t then return false; end;-- AM_LOCAL_EXPR::is_eq
when AM_LOOP_STMT then
if SYS::id(lp)=SYS::id(t) then-- SYS::id INT::is_eq SYS::id
c1.after_loop;-- AM_CURSOR::after_loop
end;
else end;
end;
return true;
else end;
return false;
end;
-- returns true if the expression am is only executed
-- after the current one. This can be used for pre fetching
-- data in pSather or for CSE (if am is the same expr as the
-- current one and is executed after the current one,
-- cse is possible).
is_exec_after_and_const_from_there(after:AM_CURSOR,am:$AM):BOOL is
-- first we check if we are in a part of the code that
-- is only executed if some conditions are true
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
#OUT+"****** is_exec_after_and_const_from_there:\nself=\n";-- OUT::create OUT::plus
#OUT+str+"after="+after.str;-- OUT::create AM_CURSOR::str OUT::plus OUT::plus AM_CURSOR::str
#OUT+"am= ";AM_OUT::AM_out(am);-- OUT::create OUT::plus AM_OUT::AM_out
end;
dummy_cursor::=#AM_CURSOR(prog,void);-- AM_CURSOR::create AM_CURSOR::prog
if is_current_lhs then return false; end;-- AM_CURSOR::is_current_lhs
c::=#AM_CURSOR(after);-- AM_CURSOR::create
branch::=0;
tcur::=c.cur;-- AM_CURSOR::cur
no_cond::=false;
-- #OUT+"1. is_exec_after_and_const_from_there:after\n"+after.str;
loop
typecase tcur
when AM_IF_STMT then if branch>1 and branch<999999 then break!; end;-- INT::is_lt INT::is_lt
when AM_IF_EXPR then if branch>1 then break!; end;-- INT::is_lt
when AM_TYPECASE_STMT then if branch>1 and branch<999999 then break!; end;-- INT::is_lt INT::is_lt
when AM_CASE_STMT then if branch>1 and branch<999999 then break!; end;-- INT::is_lt INT::is_lt
when AM_LOCK_STMT then if branch>tcur.guards.size and branch<999999 then break!; end;-- INT::is_lt AM_LOCK_STMT::guards FLIST{1}::size INT::is_lt
when AM_WITH_NEAR_STMT then if branch>tcur.objects.size and branch<999999 then break!; end;-- INT::is_lt AM_WITH_NEAR_STMT::objects ARRAY{1}::size INT::is_lt
else end;
if c.stack.size=0 then no_cond:=true;break!; end;-- AM_CURSOR::stack A_STACK{1}::size INT::is_eq
p::=c.stack.pop;-- AM_CURSOR::stack A_STACK{1}::pop
tcur:=p.stmt;-- AM_CURSOR_POS::stmt
branch:=p.branch;-- AM_CURSOR_POS::branch
end;
-- #OUT+"2. is_exec_after_and_const_from_there:after\n"+after.str;
-- check if the am statement is in the same branch of a conditional
-- and if it is a loop constant in all loops executed after
-- the first statement.
if ~is_const_in(#(after),am) then -- AM_CURSOR::is_const_in AM_CURSOR::create BOOL::not
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
#OUT+"is_exec_after_and_const_from_there faild in is_const_in\n"; -- OUT::create OUT::plus
end;
return false;
end;
c:=#AM_CURSOR(self);-- AM_CURSOR::create
a_branch::=0;
a_tcur::=c.cur;-- AM_CURSOR::cur
-- #OUT+"2.1 is_exec_after_and_const_from_there:after\n"+after.str;
loop
if ~no_cond and SYS::id(tcur)=SYS::id(a_tcur) then-- BOOL::not SYS::id INT::is_eq SYS::id
if branch/=a_branch and prog.opt_debug then-- INT::is_eq BOOL::not AM_CURSOR::prog PROG::opt_debug
#OUT+"is_exec_after_and_const_from_there failed in cond test\n";-- OUT::create OUT::plus
#OUT+"the expression is in another conditional branch\n";-- OUT::create OUT::plus
end;
-- #OUT+"2.2 is_exec_after_and_const_from_there:after\n"+after.str;
return branch=a_branch;-- INT::is_eq
end;
typecase a_tcur
when AM_LOOP_STMT then
if prog.opt_debug then -- AM_CURSOR::prog PROG::opt_debug
#OUT+"\nbranch="+branch+" testing for loop constant in following loop:\nam=";AM_OUT::AM_out(am);-- OUT::create OUT::plus OUT::plus OUT::plus AM_OUT::AM_out
#OUT+"\nLOOP:\n";-- OUT::create OUT::plus
AM_OUT::AM_out(a_tcur.body);-- AM_OUT::AM_out AM_LOOP_STMT::body
end;
if branch>1 and ~dummy_cursor.is_const_in(#AM_CURSOR(prog,a_tcur.body),am) then-- INT::is_lt AM_CURSOR::is_const_in AM_CURSOR::create AM_CURSOR::prog AM_LOOP_STMT::body BOOL::not
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
#OUT+"is_exec_after_and_const_from_there failed in is_const_in for loop\n";-- OUT::create OUT::plus
end;
-- #OUT+"2.3 is_exec_after_and_const_from_there:after\n"+after.str;
return false;
end;
else end;
if c.stack.size=0 then -- AM_CURSOR::stack A_STACK{1}::size INT::is_eq
if prog.opt_debug and ~no_cond then-- AM_CURSOR::prog PROG::opt_debug BOOL::not
#OUT+"is_exec_after_and_const_from_there failed in cond test\n";-- OUT::create OUT::plus
#OUT+"the expression is in another conditional branch\n";-- OUT::create OUT::plus
end;
return no_cond;
end;
p::=c.stack.pop;-- AM_CURSOR::stack A_STACK{1}::pop
a_tcur:=p.stmt;-- AM_CURSOR_POS::stmt
a_branch:=p.branch;-- AM_CURSOR_POS::branch
end;
return true;
end;
in_iter_init:BOOL is
c::=#AM_CURSOR(self);-- AM_CURSOR::create
branch::=0;
tcur::=c.cur;-- AM_CURSOR::cur
loop
typecase tcur
when AM_ITER_CALL_EXPR then if branch=1 then return true end;-- INT::is_eq
else end;
if c.stack.size=0 then break!; end;-- AM_CURSOR::stack A_STACK{1}::size INT::is_eq
p::=c.stack.pop;-- AM_CURSOR::stack A_STACK{1}::pop
tcur:=p.stmt;-- AM_CURSOR_POS::stmt
branch:=p.branch;-- AM_CURSOR_POS::branch
end;
return false;
end;
not_prefetch_attr:BOOL is
s::=stack.top.stmt;-- AM_CURSOR::stack A_STACK{1}::top AM_CURSOR_POS::stmt
typecase s when AM_PREFETCH_STMT then
return false;
else end;
return true;
end;
is_lhs_of_at_expr:BOOL is
s::=stack.top.stmt;-- AM_CURSOR::stack A_STACK{1}::top AM_CURSOR_POS::stmt
b::=stack.top.branch;-- AM_CURSOR::stack A_STACK{1}::top AM_CURSOR_POS::branch
typecase s when AM_AT_EXPR then
if b=2 then return true; end;-- INT::is_eq
else end;
return false;
end;
not_in_a_conditional_in_loop:BOOL is
c::=#AM_CURSOR(self);-- AM_CURSOR::create
branch::=0;
tcur::=c.cur;-- AM_CURSOR::cur
loop
typecase tcur
when AM_LOOP_STMT then return true;
when AM_IF_STMT then if branch>1 then return false; end;-- INT::is_lt
when AM_IF_EXPR then if branch>1 then return false; end;-- INT::is_lt
when AM_TYPECASE_STMT then if branch>1 then return false; end;-- INT::is_lt
when AM_CASE_STMT then if branch>1 then return false; end;-- INT::is_lt
when AM_LOCK_STMT then if branch>tcur.guards.size then return false; end;-- INT::is_lt AM_LOCK_STMT::guards FLIST{1}::size
when AM_WITH_NEAR_STMT then if branch>tcur.objects.size then return false; end;-- INT::is_lt AM_WITH_NEAR_STMT::objects ARRAY{1}::size
else end;
if c.stack.size=0 then break!; end;-- AM_CURSOR::stack A_STACK{1}::size INT::is_eq
p::=c.stack.pop;-- AM_CURSOR::stack A_STACK{1}::pop
tcur:=p.stmt;-- AM_CURSOR_POS::stmt
branch:=p.branch;-- AM_CURSOR_POS::branch
end;
return true;
end;
not_in_a_case_in_a_loop:BOOL is
c::=#AM_CURSOR(self);-- AM_CURSOR::create
branch::=0;
tcur::=c.cur;-- AM_CURSOR::cur
loop
typecase tcur
when AM_LOOP_STMT then return true;
when AM_CASE_STMT then if branch>1 then return false; end;-- INT::is_lt
when AM_TYPECASE_STMT then if branch>1 then return false; end;-- INT::is_lt
else end;
if c.stack.size=0 then break!; end;-- AM_CURSOR::stack A_STACK{1}::size INT::is_eq
p::=c.stack.pop;-- AM_CURSOR::stack A_STACK{1}::pop
tcur:=p.stmt;-- AM_CURSOR_POS::stmt
branch:=p.branch;-- AM_CURSOR_POS::branch
end;
return true;
end;
-- go to the next statement. If the current statement has sub
-- statements, visit them too.
private next_branch(cur:$AM,branch:INT):$AM is
indent:=indent+1;-- AM_CURSOR::indent AM_CURSOR::indent INT::plus
-- special value 888888 is used to stop eval. of node
-- (only useful for stmts). Only used if assign_in_order=true.
if stack.size>0 and stack.top.branch=888888 then return void; end;-- AM_CURSOR::stack A_STACK{1}::size INT::is_lt AM_CURSOR::stack A_STACK{1}::top AM_CURSOR_POS::branch INT::is_eq
typecase cur
when AM_ASSIGN_STMT then
-- we may want the assign stmt returned after the arguments.
if ~void(cur.dest) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.dest; end;-- AM_ASSIGN_STMT::dest BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_ASSIGN_STMT::dest
if ~void(cur.src) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.src; end;-- AM_ASSIGN_STMT::src BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_ASSIGN_STMT::src
if branch<3 and assign_in_order then stack.push(#AM_CURSOR_POS(cur,mark,888888));indent:=indent-1;return cur; end;-- INT::is_lt AM_CURSOR::assign_in_order AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_CURSOR::indent AM_CURSOR::indent INT::minus
when AM_WAITFOR_STMT then
-- we may want the assign stmt returned after the arguments.
if ~void(cur.dest) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.dest; end;-- AM_WAITFOR_STMT::dest BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_WAITFOR_STMT::dest
if ~void(cur.src) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.src; end;-- AM_WAITFOR_STMT::src BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_WAITFOR_STMT::src
if ~void(cur.prefetch) and branch<3 then stack.push(#AM_CURSOR_POS(cur,mark,3));return cur.prefetch; end;-- AM_WAITFOR_STMT::prefetch BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_WAITFOR_STMT::prefetch
if branch<4 and assign_in_order then stack.push(#AM_CURSOR_POS(cur,mark,888888));indent:=indent-1;return cur; end;-- INT::is_lt AM_CURSOR::assign_in_order AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_CURSOR::indent AM_CURSOR::indent INT::minus
when AM_PREFETCH_STMT then
-- we may want the assign stmt returned after the arguments.
if ~void(cur.dest) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.dest; end;-- AM_PREFETCH_STMT::dest BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_PREFETCH_STMT::dest
if ~void(cur.src) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.src; end;-- AM_PREFETCH_STMT::src BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_PREFETCH_STMT::src
if ~void(cur.prefetch) and branch<3 then stack.push(#AM_CURSOR_POS(cur,mark,3));return cur.prefetch; end;-- AM_PREFETCH_STMT::prefetch BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_PREFETCH_STMT::prefetch
if branch<4 and assign_in_order then stack.push(#AM_CURSOR_POS(cur,mark,888888));indent:=indent-1;return cur; end;-- INT::is_lt AM_CURSOR::assign_in_order AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_CURSOR::indent AM_CURSOR::indent INT::minus
when AM_IF_STMT then
if ~void(cur.test) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.test; end;-- AM_IF_STMT::test BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_IF_STMT::test
if ~void(cur.if_true) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.if_true; end;-- AM_IF_STMT::if_true BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_IF_STMT::if_true
if ~void(cur.if_false) and branch<3 then stack.push(#AM_CURSOR_POS(cur,mark,3));return cur.if_false; end;-- AM_IF_STMT::if_false BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_IF_STMT::if_false
when AM_LOOP_STMT then
if ~void(cur.init) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.init; end;-- AM_LOOP_STMT::init BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_LOOP_STMT::init
if ~void(cur.body) and branch<2 then -- AM_LOOP_STMT::body BOOL::not INT::is_lt
stack.push(#AM_CURSOR_POS(cur,mark,2));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark
loops:=loops+1;-- AM_CURSOR::loops AM_CURSOR::loops INT::plus
return cur.body;-- AM_LOOP_STMT::body
end;
when AM_RETURN_STMT then
if ~void(cur.val) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.val; end;-- AM_RETURN_STMT::val BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_RETURN_STMT::val
when AM_YIELD_STMT then
if ~void(cur.val) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.val; end;-- AM_YIELD_STMT::val BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_YIELD_STMT::val
when AM_CASE_STMT then
if ~void(cur.test) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.test;end;-- AM_CASE_STMT::test BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_CASE_STMT::test
if cur.stmts.size>0 then -- AM_CASE_STMT::stmts FLIST{1}::size INT::is_lt
loop
a::=cur.stmts.ind!;-- AM_CASE_STMT::stmts FLIST{1}::ind!
if ~void(cur.stmts[a]) and branch<a+2 then stack.push(#AM_CURSOR_POS(cur,mark,a+2));return cur.stmts[a];end;-- AM_CASE_STMT::stmts FLIST{1}::aget BOOL::not INT::is_lt INT::plus AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark INT::plus AM_CASE_STMT::stmts FLIST{1}::aget
end;
end;
if ~void(cur.else_stmts) and branch<cur.stmts.size+2 then stack.push(#AM_CURSOR_POS(cur,mark,cur.stmts.size+2));return cur.else_stmts;end;-- AM_CASE_STMT::else_stmts BOOL::not INT::is_lt AM_CASE_STMT::stmts FLIST{1}::size INT::plus AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_CASE_STMT::stmts FLIST{1}::size INT::plus AM_CASE_STMT::else_stmts
when AM_TYPECASE_STMT then
if ~void(cur.test) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.test;end;-- AM_TYPECASE_STMT::test BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_TYPECASE_STMT::test
if cur.stmts.size>0 then -- AM_TYPECASE_STMT::stmts FLIST{1}::size INT::is_lt
loop
a::=cur.stmts.ind!;-- AM_TYPECASE_STMT::stmts FLIST{1}::ind!
if ~void(cur.stmts[a]) and branch<a+2 then stack.push(#AM_CURSOR_POS(cur,mark,a+2));return cur.stmts[a];end;-- AM_TYPECASE_STMT::stmts FLIST{1}::aget BOOL::not INT::is_lt INT::plus AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark INT::plus AM_TYPECASE_STMT::stmts FLIST{1}::aget
end;
end;
if ~void(cur.else_stmts) and branch<cur.stmts.size+2 then stack.push(#AM_CURSOR_POS(cur,mark,cur.stmts.size+2));return cur.else_stmts;end;-- AM_TYPECASE_STMT::else_stmts BOOL::not INT::is_lt AM_TYPECASE_STMT::stmts FLIST{1}::size INT::plus AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_TYPECASE_STMT::stmts FLIST{1}::size INT::plus AM_TYPECASE_STMT::else_stmts
when AM_PRE_STMT then
if ~void(cur.test) and branch<1 and ~ignore_pre then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.test;end;-- AM_PRE_STMT::test BOOL::not INT::is_lt AM_CURSOR::ignore_pre BOOL::not AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_PRE_STMT::test
when AM_POST_STMT then
if ~void(cur.test) and branch<1 and ~ignore_post then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.test;end;-- AM_POST_STMT::test BOOL::not INT::is_lt AM_CURSOR::ignore_post BOOL::not AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_POST_STMT::test
when AM_INITIAL_STMT then
if ~void(cur.stmts) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.stmts; end;-- AM_INITIAL_STMT::stmts BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_INITIAL_STMT::stmts
when AM_ASSERT_STMT then
if ~void(cur.test) and branch<1 and ~ignore_assert then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.test;end;-- AM_ASSERT_STMT::test BOOL::not INT::is_lt AM_CURSOR::ignore_assert BOOL::not AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_ASSERT_STMT::test
when AM_PROTECT_STMT then
if ~void(cur.body) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.body; end;-- AM_PROTECT_STMT::body BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_PROTECT_STMT::body
if cur.stmts.size>0 then -- AM_PROTECT_STMT::stmts FLIST{1}::size INT::is_lt
loop
a::=cur.stmts.ind!;-- AM_PROTECT_STMT::stmts FLIST{1}::ind!
if ~void(cur.stmts[a]) and branch<a+2 then stack.push(#AM_CURSOR_POS(cur,mark,a+2));return cur.stmts[a];end;-- AM_PROTECT_STMT::stmts FLIST{1}::aget BOOL::not INT::is_lt INT::plus AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark INT::plus AM_PROTECT_STMT::stmts FLIST{1}::aget
end;
end;
if ~void(cur.else_stmts) and branch<cur.stmts.size+2 then stack.push(#AM_CURSOR_POS(cur,mark,cur.stmts.size+2));return cur.else_stmts;end;-- AM_PROTECT_STMT::else_stmts BOOL::not INT::is_lt AM_PROTECT_STMT::stmts FLIST{1}::size INT::plus AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_PROTECT_STMT::stmts FLIST{1}::size INT::plus AM_PROTECT_STMT::else_stmts
when AM_RAISE_STMT then
if ~void(cur.val) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.val;end;-- AM_RAISE_STMT::val BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_RAISE_STMT::val
when AM_EXPR_STMT then
if ~void(cur.expr) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.expr;end;-- AM_EXPR_STMT::expr BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_EXPR_STMT::expr
-- pSather
when AM_LOCK_STMT then
b::=branch;
if branch<cur.guards.size then-- INT::is_lt AM_LOCK_STMT::guards FLIST{1}::size
stack.push(#AM_CURSOR_POS(cur,mark,branch+1));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark INT::plus
return cur.guards[branch];-- AM_LOCK_STMT::guards FLIST{1}::aget
end;
b:=b-cur.guards.size;-- INT::minus AM_LOCK_STMT::guards FLIST{1}::size
loop
l::=cur.locks.elt!;-- AM_LOCK_STMT::locks FLIST{1}::elt!
if l.size>b then-- ARRAY{1}::size INT::is_lt
stack.push(#AM_CURSOR_POS(cur,mark,branch+1));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark INT::plus
return l[b];-- ARRAY{1}::aget
end;
b:=b-l.size;-- INT::minus ARRAY{1}::size
end;
if cur.stmts.size>b then-- AM_LOCK_STMT::stmts FLIST{1}::size INT::is_lt
if ~void(cur.stmts[b]) then-- AM_LOCK_STMT::stmts FLIST{1}::aget BOOL::not
stack.push(#AM_CURSOR_POS(cur,mark,branch+1));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark INT::plus
return cur.stmts[b];-- AM_LOCK_STMT::stmts FLIST{1}::aget
else
branch:=branch+1;-- INT::plus
end;
end;
b:=b-cur.stmts.size;-- INT::minus AM_LOCK_STMT::stmts FLIST{1}::size
if b=0 and ~void(cur.else_stmts) then stack.push(#AM_CURSOR_POS(cur,mark,branch+1));return cur.else_stmts; end;-- INT::is_eq AM_LOCK_STMT::else_stmts BOOL::not AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark INT::plus AM_LOCK_STMT::else_stmts
when AM_ATTACH_STMT then
if ~void(cur.at) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.at; end;-- AM_ATTACH_STMT::at BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_ATTACH_STMT::at
when AM_SYNC_STMT then
when AM_UNLOCK_STMT then
if ~void(cur.lock_ob) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.lock_ob; end;-- AM_UNLOCK_STMT::lock_ob BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_UNLOCK_STMT::lock_ob
when AM_WITH_NEAR_STMT then
if ~void(cur.objects) and branch<cur.objects.size then-- AM_WITH_NEAR_STMT::objects BOOL::not INT::is_lt AM_WITH_NEAR_STMT::objects ARRAY{1}::size
stack.push(#AM_CURSOR_POS(cur,mark,branch+1));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark INT::plus
return cur.objects[branch];-- AM_WITH_NEAR_STMT::objects ARRAY{1}::aget
end;
if branch<cur.objects.size+1 and ~void(cur.near_part) then-- INT::is_lt AM_WITH_NEAR_STMT::objects ARRAY{1}::size INT::plus AM_WITH_NEAR_STMT::near_part BOOL::not
stack.push(#AM_CURSOR_POS(cur,mark,cur.objects.size+1));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_WITH_NEAR_STMT::objects ARRAY{1}::size INT::plus
return cur.near_part;-- AM_WITH_NEAR_STMT::near_part
end;
if branch<cur.objects.size+2 and ~void(cur.else_part) then-- INT::is_lt AM_WITH_NEAR_STMT::objects ARRAY{1}::size INT::plus AM_WITH_NEAR_STMT::else_part BOOL::not
stack.push(#AM_CURSOR_POS(cur,mark,cur.objects.size+2));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_WITH_NEAR_STMT::objects ARRAY{1}::size INT::plus
return cur.else_part;-- AM_WITH_NEAR_STMT::else_part
end;
-- CALLS
when AM_CALL_ARG then
if ~void(cur.expr) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.expr;end;-- AM_CALL_ARG::expr BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_CALL_ARG::expr
when AM_ROUT_CALL_EXPR then
loop
a::=cur.ind!;-- AM_ROUT_CALL_EXPR::ind!
if ~void(cur[a]) and branch<a+1 then stack.push(#AM_CURSOR_POS(cur,mark,a+1));return cur[a];end;-- AM_ROUT_CALL_EXPR::aget BOOL::not INT::is_lt INT::plus AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark INT::plus AM_ROUT_CALL_EXPR::aget
end;
when AM_EXT_CALL_EXPR then
loop
a::=cur.ind!;-- AM_EXT_CALL_EXPR::ind!
if ~void(cur[a]) and branch<a+1 then stack.push(#AM_CURSOR_POS(cur,mark,a+1));return cur[a];end;-- AM_EXT_CALL_EXPR::aget BOOL::not INT::is_lt INT::plus AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark INT::plus AM_EXT_CALL_EXPR::aget
end;
when AM_ITER_CALL_EXPR then
if ~void(cur.init) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.init;end;-- AM_ITER_CALL_EXPR::init BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_ITER_CALL_EXPR::init
loop
a::=cur.ind!;-- AM_ITER_CALL_EXPR::ind!
if ~void(cur[a]) and branch<a+2 then stack.push(#AM_CURSOR_POS(cur,mark,a+2));return cur[a];end;-- AM_ITER_CALL_EXPR::aget BOOL::not INT::is_lt INT::plus AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark INT::plus AM_ITER_CALL_EXPR::aget
end;
when AM_BND_ROUT_CALL_EXPR then
if ~void(cur.br) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.br;end;-- AM_BND_ROUT_CALL_EXPR::br BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_BND_ROUT_CALL_EXPR::br
loop
a::=cur.ind!;-- AM_BND_ROUT_CALL_EXPR::ind!
if ~void(cur[a]) and branch<a+2 then stack.push(#AM_CURSOR_POS(cur,mark,a+2));return cur[a];end;-- AM_BND_ROUT_CALL_EXPR::aget BOOL::not INT::is_lt INT::plus AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark INT::plus AM_BND_ROUT_CALL_EXPR::aget
end;
when AM_BND_ITER_CALL_EXPR then
if ~void(cur.bi) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.bi;end;-- AM_BND_ITER_CALL_EXPR::bi BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_BND_ITER_CALL_EXPR::bi
if ~void(cur.init) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.init;end;-- AM_BND_ITER_CALL_EXPR::init BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_BND_ITER_CALL_EXPR::init
loop
a::=cur.ind!;-- AM_BND_ITER_CALL_EXPR::ind!
if ~void(cur[a]) and branch<a+3 then stack.push(#AM_CURSOR_POS(cur,mark,a+3));return cur[a];end;-- AM_BND_ITER_CALL_EXPR::aget BOOL::not INT::is_lt INT::plus AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark INT::plus AM_BND_ITER_CALL_EXPR::aget
end;
-- EXPRESSIONS
when AM_ARRAY_EXPR then
loop
a::=cur.ind!;-- AM_ARRAY_EXPR::ind!
if ~void(cur[a]) and branch<a+1 then stack.push(#AM_CURSOR_POS(cur,mark,a+1));return cur[a];end;-- AM_ARRAY_EXPR::aget BOOL::not INT::is_lt INT::plus AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark INT::plus AM_ARRAY_EXPR::aget
end;
when AM_BND_CREATE_EXPR then
loop
a::=cur.ind!;-- AM_BND_CREATE_EXPR::ind!
if ~void(cur[a]) and branch<a+1 then stack.push(#AM_CURSOR_POS(cur,mark,a+1));return cur[a];end;-- AM_BND_CREATE_EXPR::aget BOOL::not INT::is_lt INT::plus AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark INT::plus AM_BND_CREATE_EXPR::aget
end;
when AM_IF_EXPR then
if ~void(cur.test) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.test;end;-- AM_IF_EXPR::test BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_IF_EXPR::test
if ~void(cur.if_true) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.if_true;end;-- AM_IF_EXPR::if_true BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_IF_EXPR::if_true
if ~void(cur.if_false) and branch<3 then stack.push(#AM_CURSOR_POS(cur,mark,3));return cur.if_false;end;-- AM_IF_EXPR::if_false BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_IF_EXPR::if_false
when AM_NEW_EXPR then
if ~void(cur.asz) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.asz;end;-- AM_NEW_EXPR::asz BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_NEW_EXPR::asz
when AM_IS_VOID_EXPR then
if ~void(cur.arg) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.arg;end;-- AM_IS_VOID_EXPR::arg BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_IS_VOID_EXPR::arg
when AM_GLOBAL_EXPR then
-- as the init expression is evaluated outside the scope of the function where
-- the global expression is stored, we do neither inline it, hoist it or check
-- for constant attributes. Therefore it is ignored by the cursor
-- if ~void(cur.init) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.init;end;
when AM_ATTR_EXPR then
if ~void(cur.ob) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.ob;end;-- AM_ATTR_EXPR::ob BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_ATTR_EXPR::ob
when AM_VATTR_ASSIGN_EXPR then
if ~void(cur.ob) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.ob;end;-- AM_VATTR_ASSIGN_EXPR::ob BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_VATTR_ASSIGN_EXPR::ob
if ~void(cur.val) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.val;end;-- AM_VATTR_ASSIGN_EXPR::val BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_VATTR_ASSIGN_EXPR::val
when AM_VARR_ASSIGN_EXPR then
if ~void(cur.ob) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.ob;end;-- AM_VARR_ASSIGN_EXPR::ob BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_VARR_ASSIGN_EXPR::ob
if ~void(cur.ind) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.ind;end;-- AM_VARR_ASSIGN_EXPR::ind BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_VARR_ASSIGN_EXPR::ind
if ~void(cur.val) and branch<3 then stack.push(#AM_CURSOR_POS(cur,mark,3));return cur.val;end;-- AM_VARR_ASSIGN_EXPR::val BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_VARR_ASSIGN_EXPR::val
when AM_STMT_EXPR then
if ~void(cur.stmts) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.stmts;end;-- AM_STMT_EXPR::stmts BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_STMT_EXPR::stmts
if ~void(cur.expr) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.expr;end;-- AM_STMT_EXPR::expr BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_STMT_EXPR::expr
when AM_LOCAL_EXPR then
when AM_BREAK_STMT then
when AM_COMMENT_STMT then
when $AM_CONST then
when AM_EXCEPT_EXPR then
when AM_INVARIANT_STMT then
-- pSather expr
when AM_ANY_EXPR then
when AM_HERE_EXPR then
when AM_WHERE_EXPR then
if ~void(cur.arg) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.arg;end;-- AM_WHERE_EXPR::arg BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_WHERE_EXPR::arg
when AM_FAR_EXPR then
if ~void(cur.arg) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.arg;end;-- AM_FAR_EXPR::arg BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_FAR_EXPR::arg
when AM_NEAR_EXPR then
if ~void(cur.arg) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.arg;end;-- AM_NEAR_EXPR::arg BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_NEAR_EXPR::arg
when AM_AT_EXPR then
if ~void(cur.at) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.at;end;-- AM_AT_EXPR::at BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_AT_EXPR::at
if ~void(cur.e) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.e;end;-- AM_AT_EXPR::e BOOL::not INT::is_lt AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark AM_AT_EXPR::e
when AM_CLUSTER_EXPR then
when AM_CLUSTER_SIZE_EXPR then
else
#OUT+"the following AM node is missing (CURSOR::next_branch), please add it.\n"-- OUT::create
+SYS::str_for_tp(SYS::tp(cur))+"\n";-- OUT::plus OUT::plus SYS::str_for_tp SYS::tp OUT::plus
end;
indent:=indent-1;-- AM_CURSOR::indent AM_CURSOR::indent INT::minus
typecase cur
when $AM_STMT then
if ~void(cur.next) and branch<999999 then -- BOOL::not INT::is_lt
stack.push(#AM_CURSOR_POS(cur,mark,999999));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::mark
mark:=false;-- AM_CURSOR::mark
return cur.next;
end;
else
end;
return void;
end;
next! is loop n::=next!; yield; end; end;-- AM_CURSOR::next!
next!:$AM is
loop
n::=next;-- AM_CURSOR::next
if void(n) then quit; else yield n; end;
end;
end;
init_next is
loop
while!(~stack.is_empty);-- AM_CURSOR::stack A_STACK{1}::is_empty BOOL::not
p::=stack.pop;-- AM_CURSOR::stack A_STACK{1}::pop
end;
cur:=void;-- AM_CURSOR::cur
mark:=false;-- AM_CURSOR::mark
indent:=0;-- AM_CURSOR::indent
loops:=0;-- AM_CURSOR::loops
started:=false;-- AM_CURSOR::started
end;
next_stmt is d::=next_stmt; end;-- AM_CURSOR::next_stmt
next_stmt:$AM is -- moves the cursor to the next stmt (cur.next). if cur.next is void
-- the cursor is moved to next Node after cur.
tcur::=cur;-- AM_CURSOR::cur
typecase tcur
when $AM_STMT then
stack.push(#AM_CURSOR_POS(cur,mark,999999));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::cur AM_CURSOR::mark
if void(tcur.next) then
cur::=#AM_COMMENT_STMT(void); -- hack to ensure that next returns the correct-- AM_COMMENT_STMT::create
return next; -- value.-- AM_CURSOR::next
else
cur:=tcur.next;-- AM_CURSOR::cur
mark:=false;-- AM_CURSOR::mark
return cur;-- AM_CURSOR::cur
end;
else
#OUT+"calling AM_CURSOR::next_stmt and cur is not a $STMT!\n";-- OUT::create OUT::plus
UNIX::exit(-1);-- UNIX::exit
return void; -- to keep the compiler happ;
end;
end;
attr started:BOOL; -- can be deleted after fullt debugging this class
next is dummy::=next; end;-- AM_CURSOR::next
next:$AM is -- may only be called during a loop that uses next!,
-- or after calling init_next
if ignore_next then-- AM_CURSOR::ignore_next
ignore_next:=false;-- AM_CURSOR::ignore_next
return cur;-- AM_CURSOR::cur
end;
branch::=0;
n:$AM;
assert((~void(cur) and started) or (void(cur) and ~started));-- AM_CURSOR::cur BOOL::not AM_CURSOR::started AM_CURSOR::cur AM_CURSOR::started BOOL::not
started:=true;-- AM_CURSOR::started
loop
x::=cur; -- nasty hack to return args of a function call before -- AM_CURSOR::cur
-- the function call itself. If cur is a function call,
-- its arguments have already been returned.
typecase x
when $AM_CALL_EXPR then
else
loop
if void(cur) then-- AM_CURSOR::cur
cur:=top;-- AM_CURSOR::cur AM_CURSOR::top
mark:=false;-- AM_CURSOR::mark
n:=cur;-- AM_CURSOR::cur
else
--# if assign_in_order and prog.opt_debug then
--# #OUT+"calling next_branch with branch="+branch+", stack="+str;
--# end;
n:=next_branch(cur,branch);-- AM_CURSOR::cur
--# if assign_in_order and prog.opt_debug then
--# if void(n) then
--# #OUT+"got: (void)\n";
--# else
--# #OUT+"got: n="+SYS::str_for_tp(SYS::tp(n))+"\n";
--# end;
--# end;
mark:=false;-- AM_CURSOR::mark
end;
if ~void(n) then -- BOOL::not
cur:=n;-- AM_CURSOR::cur
d::=cur;-- AM_CURSOR::cur
typecase d
when AM_WAITFOR_STMT then
if ~assign_in_order then return cur; end;-- AM_CURSOR::assign_in_order BOOL::not AM_CURSOR::cur
if stack.size>0 and stack.top.branch=888888 then return cur; end;-- AM_CURSOR::stack A_STACK{1}::size INT::is_lt AM_CURSOR::stack A_STACK{1}::top AM_CURSOR_POS::branch INT::is_eq AM_CURSOR::cur
branch:=0;
when AM_PREFETCH_STMT then
if ~assign_in_order then return cur; end;-- AM_CURSOR::assign_in_order BOOL::not AM_CURSOR::cur
if stack.size>0 and stack.top.branch=888888 then return cur; end;-- AM_CURSOR::stack A_STACK{1}::size INT::is_lt AM_CURSOR::stack A_STACK{1}::top AM_CURSOR_POS::branch INT::is_eq AM_CURSOR::cur
branch:=0;
when AM_ASSIGN_STMT then
if ~assign_in_order then return cur; end;-- AM_CURSOR::assign_in_order BOOL::not AM_CURSOR::cur
if stack.size>0 and stack.top.branch=888888 then return cur; end;-- AM_CURSOR::stack A_STACK{1}::size INT::is_lt AM_CURSOR::stack A_STACK{1}::top AM_CURSOR_POS::branch INT::is_eq AM_CURSOR::cur
branch:=0;
when $AM_CALL_EXPR then
if void(next_branch(cur,0)) then mark:=false;return cur; -- AM_CURSOR::cur AM_CURSOR::mark AM_CURSOR::cur
else
dummy::=stack.pop;-- AM_CURSOR::stack A_STACK{1}::pop
mark:=false;-- AM_CURSOR::mark
indent:=indent-1;-- AM_CURSOR::indent AM_CURSOR::indent INT::minus
branch:=0;
mark:=false;-- AM_CURSOR::mark
end;
else
return cur;-- AM_CURSOR::cur
end;
else
break!;
end;
end;
end;
if stack.size=0 then return void; end;-- AM_CURSOR::stack A_STACK{1}::size INT::is_eq
s::=stack.pop;-- AM_CURSOR::stack A_STACK{1}::pop
branch:=s.branch;-- AM_CURSOR_POS::branch
if branch<999999 then indent:=indent-1; end;-- INT::is_lt AM_CURSOR::indent AM_CURSOR::indent INT::minus
cur:=s.stmt;-- AM_CURSOR::cur AM_CURSOR_POS::stmt
mark:=s.mark;-- AM_CURSOR::mark AM_CURSOR_POS::mark
tcur::=cur;-- AM_CURSOR::cur
typecase tcur
when AM_LOOP_STMT then if branch=2 then loops:=loops-1;end;-- INT::is_eq AM_CURSOR::loops AM_CURSOR::loops INT::minus
when $AM_CALL_EXPR then -- if there are arguments left to return, return them
-- otherwise return the call itself.
loop
n:=next_branch(cur,branch);-- AM_CURSOR::cur
mark:=false;-- AM_CURSOR::mark
if void(n) then
return cur;-- AM_CURSOR::cur
else
cur:=n;-- AM_CURSOR::cur
end;
typecase n when $AM_CALL_EXPR then
branch:=0;
else return n;
end;
end;
else end;
end;
end;
surr_stmt is
tmcur::=cur;-- AM_CURSOR::cur
loop
if stack.size=0 then cur:=void;return; end;-- AM_CURSOR::stack A_STACK{1}::size INT::is_eq AM_CURSOR::cur
s::=stack.pop;-- AM_CURSOR::stack A_STACK{1}::pop
st::=s.stmt;-- AM_CURSOR_POS::stmt
if s.branch<999999 then indent:=indent-1; end;-- AM_CURSOR_POS::branch INT::is_lt AM_CURSOR::indent AM_CURSOR::indent INT::minus
typecase st
when $AM_STMT then
if s.branch<999999 then-- AM_CURSOR_POS::branch INT::is_lt
cur:=s.stmt;-- AM_CURSOR::cur AM_CURSOR_POS::stmt
mark:=s.mark;-- AM_CURSOR::mark AM_CURSOR_POS::mark
tcur::=cur;-- AM_CURSOR::cur
typecase tcur
when AM_LOOP_STMT then
if s.branch>1 then loops:=loops-1;end;-- AM_CURSOR_POS::branch INT::is_lt AM_CURSOR::loops AM_CURSOR::loops INT::minus
return;
when $AM_STMT then return;
end;
#OUT+"Internal Compiler Error 10098\n";-- OUT::create OUT::plus
UNIX::exit(1);-- UNIX::exit
end;
else end;
end;
end;
innermost_loop is
cur_loop::=loops;-- AM_CURSOR::loops
loop
surr_stmt;-- AM_CURSOR::surr_stmt
am::=cur;-- AM_CURSOR::cur
if void(am) then #OUT+"oops, searching nonexisting loop!\n";UNIX::exit(1); end;-- OUT::create OUT::plus UNIX::exit
if cur_loop/=loops then return; end;-- AM_CURSOR::loops BOOL::not
-- the following typecase does not work. If the current statement
-- is in the init statements of a loop, it would return
-- this loop stmt instead of the enclosing one. The above "if" does
-- work in such cases too.
-- typecase am
-- when AM_LOOP_STMT then return; else end;
end;
end;
after_if is
-- sets the current position to the last statement of the test/if_true/if_false
-- of the if stmt, such that the next next! will return the first statement after
-- the if; We use the same trick as below in after_loop
tcur::=cur;-- AM_CURSOR::cur
typecase tcur when AM_IF_STMT then
if void(tcur.if_false) then-- AM_IF_STMT::if_false
if void(tcur.if_true) then -- AM_IF_STMT::if_true
if void(tcur.test) then return; -- AM_IF_STMT::test
else
stack.push(#AM_CURSOR_POS(cur,mark,1));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::cur AM_CURSOR::mark
end;
else
stack.push(#AM_CURSOR_POS(cur,mark,2));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::cur AM_CURSOR::mark
end;
else
stack.push(#AM_CURSOR_POS(cur,mark,3));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::cur AM_CURSOR::mark
end;
cur:=#AM_COMMENT_STMT(void);-- AM_CURSOR::cur AM_COMMENT_STMT::create
mark:=false;-- AM_CURSOR::mark
indent:=indent+1; -- xxxx-- AM_CURSOR::indent AM_CURSOR::indent INT::plus
else
#OUT+"Internal Compiler Error 0997\n";-- OUT::create OUT::plus
UNIX::exit(1);-- UNIX::exit
end;
end;
after_loop is
-- sets the current position to the last statement of the body list of
-- a loop, or, if empty, to the last list of the init part (if it is not
-- empty). The next! will return the first statement after the loop.
tcur::=cur;-- AM_CURSOR::cur
typecase tcur when AM_LOOP_STMT then
-- this is a rather nasty hack: we push the loop statement onto the stack,
-- with the indication that the next branch should be the loop body,
-- and we set the current position to a COMMENT_STMT. As this statement hat
-- no nodes below it, next! will pop up the stack, and resume with the loop
-- body.
if void(tcur.body) then-- AM_LOOP_STMT::body
if void(tcur.init) then return; end;-- AM_LOOP_STMT::init
stack.push(#AM_CURSOR_POS(cur,mark,1));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::cur AM_CURSOR::mark
else
stack.push(#AM_CURSOR_POS(cur,mark,2));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::cur AM_CURSOR::mark
end;
indent:=indent+1; -- xxxx-- AM_CURSOR::indent AM_CURSOR::indent INT::plus
cur:=#AM_COMMENT_STMT(void);-- AM_CURSOR::cur AM_COMMENT_STMT::create
mark:=false;-- AM_CURSOR::mark
else
#OUT+"Internal Compiler Error 0997\n";-- OUT::create OUT::plus
UNIX::exit(1);-- UNIX::exit
end;
end;
begin_of_loop_body is
-- sets the current position to the last statement of the init list of
-- a loop, or, if init is empty, to the loop statement. The next next! will
-- then return the first statement of the loop body.
tcur::=cur;-- AM_CURSOR::cur
typecase tcur when AM_LOOP_STMT then
if void(tcur.init) then return; end;-- AM_LOOP_STMT::init
-- this is a rather nasty hack: we push the loop statement onto the stack,
-- with the indication that the next branch should be the loop body,
-- and we set the current position to a COMMENT_STMT. As this statement hat
-- no nodes below it, next! will pop up the stack, and resume with the loop
-- body.
stack.push(#AM_CURSOR_POS(cur,mark,1));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::cur AM_CURSOR::mark
indent:=indent+1; -- xxxx-- AM_CURSOR::indent AM_CURSOR::indent INT::plus
cur:=#AM_COMMENT_STMT(void);-- AM_CURSOR::cur AM_COMMENT_STMT::create
mark:=false;-- AM_CURSOR::mark
else
#OUT+"Internal Compiler Error 0998\n";-- OUT::create OUT::plus
UNIX::exit(1);-- UNIX::exit
end;
end;
get_surr_stmt:$AM_STMT is
c:SAME:=#(self);-- AM_CURSOR::create
c.surr_stmt;-- AM_CURSOR::surr_stmt
t::=c.cur;-- AM_CURSOR::cur
typecase t when $AM_STMT then return t;
else return void;
end;
end;
-- returns all the am nodes that are not yet completely evaluated
private stack!:$AM is
loop
a::=stack.top!;
if a.branch<999999 then yield a.stmt; end;
end;
end;
-- marks all nodes returned by stack!
mark_stack is
loop
a::=stack.top!;-- AM_CURSOR::stack A_STACK{1}::top!
if a.mark then break!; end;-- AM_CURSOR_POS::mark
if a.branch<999999 then a.mark:=true; end;-- AM_CURSOR_POS::branch INT::is_lt AM_CURSOR_POS::mark
end;
mark:=true;-- AM_CURSOR::mark
end;
back_to_mark is
-- #OUT+"before executing back_to_mark. Current position: \n"+str;
if mark then return; end;-- AM_CURSOR::mark
loop
while!(stack.size>0);-- AM_CURSOR::stack A_STACK{1}::size INT::is_lt
a::=stack.top;-- AM_CURSOR::stack A_STACK{1}::top
if a.mark then break!; end;-- AM_CURSOR_POS::mark
if a.branch<999999 then indent:=indent-1; end;-- AM_CURSOR_POS::branch INT::is_lt AM_CURSOR::indent AM_CURSOR::indent INT::minus
cur:=stack.pop.stmt;-- AM_CURSOR::cur AM_CURSOR::stack A_STACK{1}::pop AM_CURSOR_POS::stmt
tcur::=cur;-- AM_CURSOR::cur
typecase tcur when AM_LOOP_STMT then if a.branch=2 then loops:=loops-1;end; else end;-- AM_CURSOR_POS::branch INT::is_eq AM_CURSOR::loops AM_CURSOR::loops INT::minus
mark:=false;-- AM_CURSOR::mark
end;
-- #OUT+"after executing back_to_mark. Current position: \n"+str+"============\n";
end;
-- inserts the statement such that it is executed after a marked
-- statement and before the current statement.
-- This is done by stepping through the function starting at the
-- last marked statement in the stack.
-- Note that the algorithm is extremly poor and slow, but suffices
-- for test purposes. If it turns out to be a real win, it should
-- be changed to something like
-- go back to mark
-- store current pos as insertion point
-- loop
-- next!;
-- if cur a write to am, delete insertion point
-- else if insertion point deleted and current pos a valid
-- insertion point store it.
-- end;
-- store am at last insertion point
-- returns true if the statement has been inserted and false
-- if this was not possible. This happens if the weight is >
-- than the weight calculated between the point of insertion and
-- the current point.
insert_after_mark_after_prefetch(am:$AM_STMT,weight:INT):BOOL is return insert_after_mark(am,weight,true); end;-- AM_CURSOR::insert_after_mark
insert_after_mark(am:$AM_STMT,weight:INT):BOOL is return insert_after_mark(am,weight,false); end;
insert_after_mark(am:$AM_STMT,weight:INT,after_prefetch:BOOL):BOOL
-- if cur is AM_LOCAL_EXPR, we could not find it again in
-- find_node at the end of the function (the same is actually true for
-- constants, but we don't check them here)
pre SYS::tp(cur)/=SYS::tp(#AM_LOCAL_EXPR(void))-- SYS::tp AM_CURSOR::cur INT::is_eq SYS::tp AM_LOCAL_EXPR::create
is-- BOOL::not
-- store current position
cstore::=#AM_CURSOR(self);-- AM_CURSOR::create
back_to_mark;-- AM_CURSOR::back_to_mark
loop
if cstore=self then return false; end;-- AM_CURSOR::is_eq
typecase am
when AM_PREFETCH_STMT then
until!(cstore.is_exec_after_and_const_from_there(self,am.src) -- AM_CURSOR::is_exec_after_and_const_from_there AM_PREFETCH_STMT::src
and cstore.is_not_used_in(#(self),am.dest));-- AM_CURSOR::is_not_used_in AM_CURSOR::create AM_PREFETCH_STMT::dest
else
until!(cstore.is_exec_after_and_const_from_there(self,am));-- AM_CURSOR::is_exec_after_and_const_from_there
end;
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
n::=next!;-- AM_CURSOR::next!
#OUT+"IAM: ";-- OUT::create OUT::plus
loop indent.times!; #OUT+" "; end;-- AM_CURSOR::indent INT::times! OUT::create OUT::plus
#OUT+SYS::str_for_tp(SYS::tp(n))+"\n";-- OUT::create OUT::plus SYS::str_for_tp SYS::tp OUT::plus
else
next!;-- AM_CURSOR::next!
end;
end;
w::=cstore.weight_after(self);-- AM_CURSOR::weight_after
if w>=weight then -- INT::is_lt BOOL::not
if after_prefetch then
loop
tcur::=cur;-- AM_CURSOR::cur
typecase tcur when $AM_STMT then
tcur2::=tcur.next;
typecase tcur2 when AM_PREFETCH_STMT then next_stmt;-- AM_CURSOR::next_stmt
else break!;
end;
else break!;
end;
end;
end;
insert_stmt_after(am);-- AM_CURSOR::insert_stmt_after
if SYS::id(cstore.top)/=SYS::id(top) then-- SYS::id AM_CURSOR::top INT::is_eq SYS::id AM_CURSOR::top BOOL::not
cstore.top:=top;-- AM_CURSOR::top AM_CURSOR::top
end;
d::=find_node(cstore.cur);-- AM_CURSOR::find_node AM_CURSOR::cur
assert(d);
return true;
end;
d::=find_node(cstore.cur);-- AM_CURSOR::find_node AM_CURSOR::cur
assert(d);
adjust_marks_on_stack(cstore);-- AM_CURSOR::adjust_marks_on_stack
return false;
end;
adjust_marks_on_stack(c:SAME) is
-- we need two loops as we do not know if some new nodes have
-- been inserted or deleted.
loop
orig::=c.stack.top!;-- AM_CURSOR::stack A_STACK{1}::top!
loop
sf::=stack.top!;-- AM_CURSOR::stack A_STACK{1}::top!
if SYS::id(sf.stmt)=SYS::id(orig.stmt) and sf.branch=orig.branch then-- SYS::id AM_CURSOR_POS::stmt INT::is_eq SYS::id AM_CURSOR_POS::stmt AM_CURSOR_POS::branch INT::is_eq AM_CURSOR_POS::branch
sf.mark:=orig.mark;-- AM_CURSOR_POS::mark AM_CURSOR_POS::mark
break!;
end;
end;
end;
end;
find_node(am:$AM):BOOL is
loop -- go from current position
if (SYS::id(next!)=SYS::id(am)) then return true; end;-- SYS::id AM_CURSOR::next! INT::is_eq SYS::id
end;
-- restart over from beginning
init_next;-- AM_CURSOR::init_next
loop
if (SYS::id(next!)=SYS::id(am)) then return true; end;-- SYS::id AM_CURSOR::next! INT::is_eq SYS::id
end;
return false;
end;
weight_after(cc:AM_CURSOR):INT
pre with_side_effects-- AM_CURSOR::with_side_effects
is
c::=#AM_CURSOR(cc);-- AM_CURSOR::create
w::=0;
loop
until!(c=self);-- AM_CURSOR::is_eq
am::=c.next!;-- AM_CURSOR::next!
typecase am
when AM_ROUT_CALL_EXPR then
w:=w+am.fun.get_se_context(prog).weight;-- INT::plus AM_ROUT_CALL_EXPR::fun SIG::get_se_context AM_CURSOR::prog SE_CONTEXT::weight
when AM_ITER_CALL_EXPR then
w:=w+am.fun.get_se_context(prog).weight;-- INT::plus AM_ITER_CALL_EXPR::fun SIG::get_se_context AM_CURSOR::prog SE_CONTEXT::weight
when AM_BND_ROUT_CALL_EXPR then
w:=w+100; -- we could take the average, but this is faster-- INT::plus
when AM_BND_ITER_CALL_EXPR then
w:=w+100; -- we could take the average, but this is faster-- INT::plus
when AM_LOOP_STMT then
w:=w+10;-- INT::plus
else end;
end;
return w;
end;
-- returns the last not fully evaluted statement of type t
-- (t is returned from SYS::tp);
private find_stmt(t:INT):$AM is
loop
a::=stack.top!;-- AM_CURSOR::stack A_STACK{1}::top!
if a.branch<999999 and SYS::tp(a.stmt)=t then return a.stmt; end;-- AM_CURSOR_POS::branch INT::is_lt SYS::tp AM_CURSOR_POS::stmt INT::is_eq AM_CURSOR_POS::stmt
end;
return void;
end;
-- Same as find_stmt, but returns either one of two different types.
private find_stmts(t1:INT,t2:INT):$AM is
loop
a::=stack.top!;
if a.branch<999999 and (SYS::tp(a.stmt)=t1 or SYS::tp(a.stmt)=t2) then return a.stmt; end;
end;
return void;
end;
loop_stmt:AM_LOOP_STMT is
loop
a::=stack.top!;-- AM_CURSOR::stack A_STACK{1}::top!
s::=a.stmt;-- AM_CURSOR_POS::stmt
typecase s when AM_LOOP_STMT then
if a.branch>1 and a.branch<999999 then return s; end;-- AM_CURSOR_POS::branch INT::is_lt AM_CURSOR_POS::branch INT::is_lt
else end;
end;
end;
waitfor_stmt:AM_WAITFOR_STMT is
a::=find_stmt(SYS::tp(#AM_WAITFOR_STMT(void)));-- AM_CURSOR::find_stmt SYS::tp AM_WAITFOR_STMT::create
if void(a) then return void; end;
typecase a when AM_WAITFOR_STMT then return a; end;
end;
prefetch_stmt:AM_PREFETCH_STMT is
a::=find_stmt(SYS::tp(#AM_PREFETCH_STMT(void)));-- AM_CURSOR::find_stmt SYS::tp AM_PREFETCH_STMT::create
if void(a) then return void; end;
typecase a when AM_PREFETCH_STMT then return a; end;
end;
lock_stmt:AM_LOCK_STMT is
a::=find_stmt(SYS::tp(#AM_LOCK_STMT(void)));-- AM_CURSOR::find_stmt SYS::tp AM_LOCK_STMT::create
if void(a) then return void; end;
typecase a when AM_LOCK_STMT then return a; end;
end;
loop_or_lock_stmt:$AM_STMT is
loop
a::=stack.top!;-- AM_CURSOR::stack A_STACK{1}::top!
s::=a.stmt;-- AM_CURSOR_POS::stmt
if a.branch<999999 then-- AM_CURSOR_POS::branch INT::is_lt
typecase s
when AM_LOOP_STMT then
if a.branch>1 then return s; end;-- AM_CURSOR_POS::branch INT::is_lt
when AM_LOCK_STMT then
return s;
else end;
end;
end;
end;
in_loop:BOOL is return loops>0; end;
replace_stmt(am:$AM_STMT) is
-- if prog.opt_debug
-- then #OUT+"CURSOR: replace_stmt, before replacing:\n"+str;end;
tcur:$AM_STMT;
tc::=cur;-- AM_CURSOR::cur
typecase tc when $AM_STMT then
tcur:=tc;
else
#OUT+"Error in AM_CURSOR::replace_stmt: you can only replace a $AM_STMT\n";-- OUT::create OUT::plus
UNIX::exit(-1);-- UNIX::exit
end;
if stack.size>0 and stack.top.branch=888888 then dx::=stack.pop; end;-- AM_CURSOR::stack A_STACK{1}::size INT::is_lt AM_CURSOR::stack A_STACK{1}::top AM_CURSOR_POS::branch INT::is_eq AM_CURSOR::stack A_STACK{1}::pop
last:$AM_STMT;
if ~void(am) then-- BOOL::not
last:=am;
loop while!(~void(last.next));-- BOOL::not
last:=last.next;
end;
last.next:=tcur.next;
end;
if SYS::id(top)=SYS::id(cur) then-- SYS::id AM_CURSOR::top INT::is_eq SYS::id AM_CURSOR::cur
if void(am) then
top:=tcur.next;-- AM_CURSOR::top
else
top:=am;-- AM_CURSOR::top
end;
init_next;-- AM_CURSOR::init_next
return;
end;
cur:=am;-- AM_CURSOR::cur
ignore_next:=true;-- AM_CURSOR::ignore_next
f::=stack.top.stmt;-- AM_CURSOR::stack A_STACK{1}::top AM_CURSOR_POS::stmt
branch::=stack.top.branch;-- AM_CURSOR::stack A_STACK{1}::top AM_CURSOR_POS::branch
if branch=999999 then-- INT::is_eq
typecase f when $AM_STMT then
if void(am) then
f.next:=f.next.next;
else
f.next:=am;
end;
return;
end;
end;
mark:=false;-- AM_CURSOR::mark
typecase f
when AM_IF_STMT then
if branch=2 then if void(am) then f.if_true:=f.if_true.next;cur:=f.if_true;ignore_next:=true; else f.if_true:=am; end;-- INT::is_eq AM_IF_STMT::if_true AM_IF_STMT::if_true AM_CURSOR::cur AM_IF_STMT::if_true AM_CURSOR::ignore_next AM_IF_STMT::if_true
elsif branch=3 then if void(am) then f.if_false:=f.if_false.next;cur:=f.if_false;ignore_next:=true; else f.if_false:=am; end; end;-- INT::is_eq AM_IF_STMT::if_false AM_IF_STMT::if_false AM_CURSOR::cur AM_IF_STMT::if_false AM_CURSOR::ignore_next AM_IF_STMT::if_false
when AM_LOOP_STMT then
if branch=1 then if void(am) then f.init:=f.init.next;cur:=f.init;ignore_next:=true; else f.init:=am; end;-- INT::is_eq AM_LOOP_STMT::init AM_LOOP_STMT::init AM_CURSOR::cur AM_LOOP_STMT::init AM_CURSOR::ignore_next AM_LOOP_STMT::init
elsif branch=2 then if void(am) then f.body:=f.body.next;cur:=f.body;ignore_next:=true; else f.body:=am; end; end;-- INT::is_eq AM_LOOP_STMT::body AM_LOOP_STMT::body AM_CURSOR::cur AM_LOOP_STMT::body AM_CURSOR::ignore_next AM_LOOP_STMT::body
when AM_CASE_STMT then
if branch=f.stmts.size+2 then if void(am) then f.else_stmts:=f.else_stmts.next;cur:=f.else_stmts;ignore_next:=true; else; f.else_stmts:=am; end;-- INT::is_eq AM_CASE_STMT::stmts FLIST{1}::size INT::plus AM_CASE_STMT::else_stmts AM_CASE_STMT::else_stmts AM_CURSOR::cur AM_CASE_STMT::else_stmts AM_CURSOR::ignore_next AM_CASE_STMT::else_stmts
else
if void(am) then f.stmts[branch-2].next:=f.stmts[branch-2].next;cur:=f.stmts[branch-2];ignore_next:=true; else f.stmts[branch-2]:=am; end;-- AM_CASE_STMT::stmts FLIST{1}::aget INT::minus AM_CASE_STMT::stmts FLIST{1}::aget INT::minus AM_CURSOR::cur AM_CASE_STMT::stmts FLIST{1}::aget INT::minus AM_CURSOR::ignore_next AM_CASE_STMT::stmts FLIST{1}::aset INT::minus
end;
when AM_TYPECASE_STMT then
if branch=f.stmts.size+2 then if void(am) then f.else_stmts:=f.else_stmts.next;cur:=f.else_stmts;ignore_next:=true; else; f.else_stmts:=am; end;-- INT::is_eq AM_TYPECASE_STMT::stmts FLIST{1}::size INT::plus AM_TYPECASE_STMT::else_stmts AM_TYPECASE_STMT::else_stmts AM_CURSOR::cur AM_TYPECASE_STMT::else_stmts AM_CURSOR::ignore_next AM_TYPECASE_STMT::else_stmts
else
if void(am) then f.stmts[branch-2].next:=f.stmts[branch-2].next;cur:=f.stmts[branch-2];ignore_next:=true; else f.stmts[branch-2]:=am; end;-- AM_TYPECASE_STMT::stmts FLIST{1}::aget INT::minus AM_TYPECASE_STMT::stmts FLIST{1}::aget INT::minus AM_CURSOR::cur AM_TYPECASE_STMT::stmts FLIST{1}::aget INT::minus AM_CURSOR::ignore_next AM_TYPECASE_STMT::stmts FLIST{1}::aset INT::minus
end;
when AM_PROTECT_STMT then
if branch=1 then if void(am) then f.body:=f.body.next;cur:=f.body;ignore_next:=true; else f.body:=am; end;-- INT::is_eq AM_PROTECT_STMT::body AM_PROTECT_STMT::body AM_CURSOR::cur AM_PROTECT_STMT::body AM_CURSOR::ignore_next AM_PROTECT_STMT::body
elsif branch=f.stmts.size+2 then if void(am) then f.else_stmts:=f.else_stmts.next;cur:=f.else_stmts;ignore_next:=true; else; f.else_stmts:=am; end;-- INT::is_eq AM_PROTECT_STMT::stmts FLIST{1}::size INT::plus AM_PROTECT_STMT::else_stmts AM_PROTECT_STMT::else_stmts AM_CURSOR::cur AM_PROTECT_STMT::else_stmts AM_CURSOR::ignore_next AM_PROTECT_STMT::else_stmts
else
if void(am) then f.stmts[branch-2].next:=f.stmts[branch-2].next;cur:=f.stmts[branch-2];ignore_next:=true; else f.stmts[branch-2]:=am; end;-- AM_PROTECT_STMT::stmts FLIST{1}::aget INT::minus AM_PROTECT_STMT::stmts FLIST{1}::aget INT::minus AM_CURSOR::cur AM_PROTECT_STMT::stmts FLIST{1}::aget INT::minus AM_CURSOR::ignore_next AM_PROTECT_STMT::stmts FLIST{1}::aset INT::minus
end;
when AM_ITER_CALL_EXPR then
if branch=1 then-- INT::is_eq
if void(am) then
f.init:=f.init.next;cur:=f.init;ignore_next:=true; -- AM_ITER_CALL_EXPR::init AM_ITER_CALL_EXPR::init AM_CURSOR::cur AM_ITER_CALL_EXPR::init AM_CURSOR::ignore_next
else f.init:=am; end; -- AM_ITER_CALL_EXPR::init
end;
when AM_BND_ITER_CALL_EXPR then
if branch=2 then -- INT::is_eq
if void(am) then
f.init:=f.init.next;cur:=f.init;ignore_next:=true; else f.init:=am; -- AM_BND_ITER_CALL_EXPR::init AM_BND_ITER_CALL_EXPR::init AM_CURSOR::cur AM_BND_ITER_CALL_EXPR::init AM_CURSOR::ignore_next AM_BND_ITER_CALL_EXPR::init
end; end;
when AM_STMT_EXPR then
if branch=1 then -- INT::is_eq
if void(am) then
f.stmts:=f.stmts.next; else f.stmts:=am; -- AM_STMT_EXPR::stmts AM_STMT_EXPR::stmts AM_STMT_EXPR::stmts
end; end;
when AM_LOCK_STMT then
b::=branch;
b:=b-f.guards.size-1;-- INT::minus AM_LOCK_STMT::guards FLIST{1}::size INT::minus
loop
l::=f.locks.elt!;-- AM_LOCK_STMT::locks FLIST{1}::elt!
b:=b-l.size;-- INT::minus ARRAY{1}::size
end;
if f.stmts.size>b then-- AM_LOCK_STMT::stmts FLIST{1}::size INT::is_lt
if ~void(f.stmts[b]) then-- AM_LOCK_STMT::stmts FLIST{1}::aget BOOL::not
if void(am) then
f.stmts[b]:=f.stmts[b].next;cur:=f.stmts[b];ignore_next:=true; -- AM_LOCK_STMT::stmts FLIST{1}::aset AM_LOCK_STMT::stmts FLIST{1}::aget AM_CURSOR::cur AM_LOCK_STMT::stmts FLIST{1}::aget AM_CURSOR::ignore_next
else
f.stmts[b]:=am;-- AM_LOCK_STMT::stmts FLIST{1}::aset
end;
end;
end;
b:=b-f.stmts.size;-- INT::minus AM_LOCK_STMT::stmts FLIST{1}::size
if b=0 and ~void(f.else_stmts) then -- INT::is_eq AM_LOCK_STMT::else_stmts BOOL::not
if void(am) then
f.else_stmts:=f.else_stmts.next;cur:=f.else_stmts;ignore_next:=true; -- AM_LOCK_STMT::else_stmts AM_LOCK_STMT::else_stmts AM_CURSOR::cur AM_LOCK_STMT::else_stmts AM_CURSOR::ignore_next
else
f.else_stmts:=am;-- AM_LOCK_STMT::else_stmts
end;
end;
when AM_WITH_NEAR_STMT then
if branch=f.objects.size+1 then -- INT::is_eq AM_WITH_NEAR_STMT::objects ARRAY{1}::size INT::plus
if void(am) then
f.near_part:=f.near_part.next;cur:=f.near_part;ignore_next:=true; -- AM_WITH_NEAR_STMT::near_part AM_WITH_NEAR_STMT::near_part AM_CURSOR::cur AM_WITH_NEAR_STMT::near_part AM_CURSOR::ignore_next
else
f.near_part:=am;-- AM_WITH_NEAR_STMT::near_part
end;
elsif branch=f.objects.size+2 then-- INT::is_eq AM_WITH_NEAR_STMT::objects ARRAY{1}::size INT::plus
if void(am) then
f.else_part:=f.else_part.next;cur:=f.else_part;ignore_next:=true; -- AM_WITH_NEAR_STMT::else_part AM_WITH_NEAR_STMT::else_part AM_CURSOR::cur AM_WITH_NEAR_STMT::else_part AM_CURSOR::ignore_next
else
f.else_part:=am;-- AM_WITH_NEAR_STMT::else_part
end;
end;
end;
if void(cur) then -- cur may not stay void, so we invent a statement-- AM_CURSOR::cur
cur:=#AM_COMMENT_STMT(void);-- AM_CURSOR::cur AM_COMMENT_STMT::create
ignore_next:=false;-- AM_CURSOR::ignore_next
end;
-- if prog.opt_debug then #OUT+"CURSOR: replace_stmt, after replacing:\n"+str;end;
end;
replace_expr(w:$AM_EXPR) is
-- if prog.opt_debug then #OUT+"CURSOR: replace_expr, before replacing:\n"+str;end;
if void(stack) or stack.size=0 then-- AM_CURSOR::stack AM_CURSOR::stack A_STACK{1}::size INT::is_eq
top:=w;-- AM_CURSOR::top
cur:=w;-- AM_CURSOR::cur
return;
end;
am::=stack.top.stmt;-- AM_CURSOR::stack A_STACK{1}::top AM_CURSOR_POS::stmt
branch::=stack.top.branch;-- AM_CURSOR::stack A_STACK{1}::top AM_CURSOR_POS::branch
cur:=w;-- AM_CURSOR::cur
mark:=false;-- AM_CURSOR::mark
typecase am
when AM_WAITFOR_STMT then
if branch=1 then am.dest:=w; end;-- INT::is_eq AM_WAITFOR_STMT::dest
if branch=2 then am.src:=w; end;-- INT::is_eq AM_WAITFOR_STMT::src
if branch=3 then -- INT::is_eq
typecase w when AM_LOCAL_EXPR then am.prefetch:=w; end;-- AM_WAITFOR_STMT::prefetch
end;
when AM_PREFETCH_STMT then
if branch=1 then am.dest:=w; end;-- INT::is_eq AM_PREFETCH_STMT::dest
if branch=2 then am.src:=w; end;-- INT::is_eq AM_PREFETCH_STMT::src
if branch=3 then -- INT::is_eq
typecase w when AM_LOCAL_EXPR then am.prefetch:=w; end;-- AM_PREFETCH_STMT::prefetch
end;
when AM_ASSIGN_STMT then
if branch=1 then am.dest:=w; end;-- INT::is_eq AM_ASSIGN_STMT::dest
if branch=2 then am.src:=w; end;-- INT::is_eq AM_ASSIGN_STMT::src
when AM_IF_STMT then if branch=1 then am.test:=w; end;-- INT::is_eq AM_IF_STMT::test
when AM_RETURN_STMT then if branch=1 then am.val:=w; end;-- INT::is_eq AM_RETURN_STMT::val
when AM_YIELD_STMT then if branch=1 then am.val:=w; end;-- INT::is_eq AM_YIELD_STMT::val
when AM_CASE_STMT then if branch=1 then am.test:=w; end;-- INT::is_eq AM_CASE_STMT::test
when AM_TYPECASE_STMT then
if branch=1 then -- INT::is_eq
typecase w
when AM_LOCAL_EXPR then
am.test:=w; -- AM_TYPECASE_STMT::test
else
#OUT+"internal error: replacing AM_LOCAL_EXPR of typecase with "+SYS::str_for_tp(SYS::tp(w))+"\n";-- OUT::create OUT::plus OUT::plus SYS::str_for_tp SYS::tp OUT::plus
UNIX::exit(1);-- UNIX::exit
end;
end;
when AM_PRE_STMT then if branch=1 then am.test:=w; end;-- INT::is_eq AM_PRE_STMT::test
when AM_POST_STMT then if branch=1 then am.test:=w; end;-- INT::is_eq AM_POST_STMT::test
when AM_ASSERT_STMT then if branch=1 then am.test:=w; end;-- INT::is_eq AM_ASSERT_STMT::test
when AM_RAISE_STMT then if branch=1 then am.val:=w; end;-- INT::is_eq AM_RAISE_STMT::val
when AM_EXPR_STMT then if branch=1 then am.expr:=w; end;-- INT::is_eq AM_EXPR_STMT::expr
-- pSather
when AM_LOCK_STMT then
b::=branch;
if branch<=am.guards.size then-- INT::is_lt AM_LOCK_STMT::guards FLIST{1}::size BOOL::not
am.guards[branch-1]:=w;-- AM_LOCK_STMT::guards FLIST{1}::aset INT::minus
else
b:=b-am.guards.size-1;-- INT::minus AM_LOCK_STMT::guards FLIST{1}::size INT::minus
loop
l::=am.locks.elt!;-- AM_LOCK_STMT::locks FLIST{1}::elt!
if l.size>b then-- ARRAY{1}::size INT::is_lt
l[b]:=w;-- ARRAY{1}::aset
break!;
end;
b:=b-l.size;-- INT::minus ARRAY{1}::size
end;
end;
when AM_ATTACH_STMT then
if branch=1 then am.at:=w; end;-- INT::is_eq AM_ATTACH_STMT::at
when AM_UNLOCK_STMT then
if branch=1 then am.lock_ob:=w; end;-- INT::is_eq AM_UNLOCK_STMT::lock_ob
when AM_WITH_NEAR_STMT then
if branch<=am.objects.size then-- INT::is_lt AM_WITH_NEAR_STMT::objects ARRAY{1}::size BOOL::not
am.objects[branch-1]:=w;-- AM_WITH_NEAR_STMT::objects ARRAY{1}::aset INT::minus
end;
-- CALLS
when AM_CALL_ARG then if branch=1 then am.expr:=w; end;-- INT::is_eq AM_CALL_ARG::expr
when AM_ROUT_CALL_EXPR then
am[branch-1].expr:=w;-- AM_ROUT_CALL_EXPR::aget INT::minus AM_CALL_ARG::expr
when AM_EXT_CALL_EXPR then
am[branch-1].expr:=w;-- AM_EXT_CALL_EXPR::aget INT::minus AM_CALL_ARG::expr
when AM_ITER_CALL_EXPR then
am[branch-2].expr:=w;-- AM_ITER_CALL_EXPR::aget INT::minus AM_CALL_ARG::expr
when AM_BND_ROUT_CALL_EXPR then
if branch=1 then-- INT::is_eq
am.br:=w;-- AM_BND_ROUT_CALL_EXPR::br
else
am[branch-2].expr:=w;-- AM_BND_ROUT_CALL_EXPR::aget INT::minus AM_CALL_ARG::expr
end;
when AM_BND_ITER_CALL_EXPR then
if branch=1 then-- INT::is_eq
am.bi:=w;-- AM_BND_ITER_CALL_EXPR::bi
else
am[branch-3].expr:=w;-- AM_BND_ITER_CALL_EXPR::aget INT::minus AM_CALL_ARG::expr
end;
-- EXPRESSIONS
when AM_ARRAY_EXPR then
am[branch-1]:=w;-- AM_ARRAY_EXPR::aset INT::minus
when AM_BND_CREATE_EXPR then
am[branch-1].expr:=w;-- AM_BND_CREATE_EXPR::aget INT::minus AM_CALL_ARG::expr
when AM_IF_EXPR then
if branch=1 then am.test:=w; end;-- INT::is_eq AM_IF_EXPR::test
if branch=2 then am.if_true:=w; end;-- INT::is_eq AM_IF_EXPR::if_true
if branch=3 then am.if_false:=w;end;-- INT::is_eq AM_IF_EXPR::if_false
when AM_NEW_EXPR then
if branch=1 then am.asz:=w;end;-- INT::is_eq AM_NEW_EXPR::asz
when AM_IS_VOID_EXPR then
if branch=1 then am.arg:=w;end;-- INT::is_eq AM_IS_VOID_EXPR::arg
when AM_GLOBAL_EXPR then
-- see comments in next_branch regarding the init expr of GLOBAL_EXPR
--if branch=1 then am.init:=w;end;
when AM_ATTR_EXPR then
if branch=1 then am.ob:=w;end;-- INT::is_eq AM_ATTR_EXPR::ob
when AM_VATTR_ASSIGN_EXPR then
if branch=1 then am.ob:=w;end;-- INT::is_eq AM_VATTR_ASSIGN_EXPR::ob
if branch=2 then am.val:=w;end;-- INT::is_eq AM_VATTR_ASSIGN_EXPR::val
when AM_VARR_ASSIGN_EXPR then
if branch=1 then am.ob:=w;end;-- INT::is_eq AM_VARR_ASSIGN_EXPR::ob
if branch=2 then am.ind:=w;end;-- INT::is_eq AM_VARR_ASSIGN_EXPR::ind
if branch=3 then am.val:=w;end;-- INT::is_eq AM_VARR_ASSIGN_EXPR::val
when AM_STMT_EXPR then
if branch=1 then #OUT+"Internal error: replacing stmt with expr in AM_STMT_EXPR\n";UNIX::exit(1);end;-- INT::is_eq OUT::create OUT::plus UNIX::exit
if branch=2 then am.expr:=w;end;-- INT::is_eq AM_STMT_EXPR::expr
-- pSather expr
when AM_WHERE_EXPR then
if branch=1 then am.arg:=w;end;-- INT::is_eq AM_WHERE_EXPR::arg
when AM_FAR_EXPR then
if branch=1 then am.arg:=w;end;-- INT::is_eq AM_FAR_EXPR::arg
when AM_NEAR_EXPR then
if branch=1 then am.arg:=w;end;-- INT::is_eq AM_NEAR_EXPR::arg
when AM_AT_EXPR then
if branch=1 then am.at:=w;end;-- INT::is_eq AM_AT_EXPR::at
if branch=2 then am.e:=w;end;-- INT::is_eq AM_AT_EXPR::e
end;
if void(cur) then -- the current expression has been replaced with void.-- AM_CURSOR::cur
-- but cur may not stay void, so we assign a dummy expression.
-- the next next! will
t:$TP;
cur:=#AM_EXCEPT_EXPR(t);-- AM_CURSOR::cur AM_EXCEPT_EXPR::create
end;
-- if prog.opt_debug then #OUT+"CURSOR: replace_expr, after replacing:\n"+str;end;
end;
insert_stmt_before(am:$AM_STMT) is
if prog.opt_debug then #OUT+"CURSOR: insert_stmt_before, before inserting:\n"+str;end;-- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus AM_CURSOR::str
tcur::=cur;-- AM_CURSOR::cur
typecase tcur
when $AM_EXPR then
se::=#AM_STMT_EXPR(void);-- AM_STMT_EXPR::create
se.stmts:=am;-- AM_STMT_EXPR::stmts
se.expr:=tcur;-- AM_STMT_EXPR::expr
replace_expr(se);-- AM_CURSOR::replace_expr
cur:=next_branch(se,1);-- AM_CURSOR::cur AM_CURSOR::next_branch
mark:=false;-- AM_CURSOR::mark
else
insert_stmt_before_stmt(am);-- AM_CURSOR::insert_stmt_before_stmt
end;
if prog.opt_debug then #OUT+"CURSOR: insert_stmt_before, after inserting:\n"+str;end;-- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus AM_CURSOR::str
end;
insert_stmt_after(am:$AM_STMT) is
if prog.opt_debug then #OUT+"CURSOR: insert_stmt_after, before inserting:\n"+str;end;-- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus AM_CURSOR::str
tcur::=cur;-- AM_CURSOR::cur
typecase tcur
when $AM_EXPR then
c::=#AM_CURSOR(self);-- AM_CURSOR::create
c.cur:=#AM_STMT_EXPR(void); -- create bogus expression to ensure that next moves-- AM_CURSOR::cur AM_STMT_EXPR::create
-- to the right expression (one up on the stack and
-- then the next one, but not to a child of the current
-- expression).
c.next;-- AM_CURSOR::next
c.insert_stmt_before(am);-- AM_CURSOR::insert_stmt_before
else
insert_stmt(cur,999999,am);-- AM_CURSOR::cur
end;
if prog.opt_debug then #OUT+"CURSOR: insert_stmt_after, after inserting:\n"+str;end;-- AM_CURSOR::prog PROG::opt_debug OUT::create OUT::plus AM_CURSOR::str
end;
private insert_stmt(am:$AM,branch:INT,w:$AM_STMT) is
last::=w;loop while!(~void(last.next));last:=last.next;end;-- BOOL::not
if void(am) then
tmp::=top;-- AM_CURSOR::top
typecase tmp
when $AM_STMT then last.next:=tmp;
end;
top:=w;-- AM_CURSOR::top
return;
end;
assert(branch/=888888);-- INT::is_eq BOOL::not
typecase am
when $AM_STMT then
if branch=999999 then-- INT::is_eq
last.next:=am.next;
am.next:=w;
return;
end;
else end;
typecase am
when AM_IF_STMT then
if branch=2 then last.next:=am.if_true;am.if_true:=w;end;-- INT::is_eq AM_IF_STMT::if_true AM_IF_STMT::if_true
if branch=3 then last.next:=am.if_false;am.if_false:=w;end;-- INT::is_eq AM_IF_STMT::if_false AM_IF_STMT::if_false
when AM_LOOP_STMT then
if branch=1 then last.next:=am.init;am.init:=w;end;-- INT::is_eq AM_LOOP_STMT::init AM_LOOP_STMT::init
if branch=2 then last.next:=am.body;am.body:=w;end;-- INT::is_eq AM_LOOP_STMT::body AM_LOOP_STMT::body
when AM_CASE_STMT then
if branch=am.stmts.size+2 then -- INT::is_eq AM_CASE_STMT::stmts FLIST{1}::size INT::plus
last.next:=am.else_stmts;am.else_stmts:=w;-- AM_CASE_STMT::else_stmts AM_CASE_STMT::else_stmts
else;
last.next:=am.stmts[branch-2];am.stmts[branch-2]:=w;-- AM_CASE_STMT::stmts FLIST{1}::aget INT::minus AM_CASE_STMT::stmts FLIST{1}::aset INT::minus
end;
when AM_TYPECASE_STMT then
if branch=am.stmts.size+2 then -- INT::is_eq AM_TYPECASE_STMT::stmts FLIST{1}::size INT::plus
last.next:=am.else_stmts;am.else_stmts:=w;-- AM_TYPECASE_STMT::else_stmts AM_TYPECASE_STMT::else_stmts
else
last.next:=am.stmts[branch-2];am.stmts[branch-2]:=w;-- AM_TYPECASE_STMT::stmts FLIST{1}::aget INT::minus AM_TYPECASE_STMT::stmts FLIST{1}::aset INT::minus
end;
when AM_INITIAL_STMT then
if branch=1 then last.next:=am.stmts;am.stmts:=w;end;-- INT::is_eq AM_INITIAL_STMT::stmts AM_INITIAL_STMT::stmts
when AM_PROTECT_STMT then
if branch=1 then -- INT::is_eq
last.next:=am.body;am.body:=w; -- AM_PROTECT_STMT::body AM_PROTECT_STMT::body
elsif branch=am.stmts.size+2 then-- INT::is_eq AM_PROTECT_STMT::stmts FLIST{1}::size INT::plus
last.next:=am.else_stmts;am.else_stmts:=w; -- AM_PROTECT_STMT::else_stmts AM_PROTECT_STMT::else_stmts
else
last.next:=am.stmts[branch-2];am.stmts[branch-2]:=w;-- AM_PROTECT_STMT::stmts FLIST{1}::aget INT::minus AM_PROTECT_STMT::stmts FLIST{1}::aset INT::minus
end;
when AM_STMT_EXPR then
if branch=1 then-- INT::is_eq
last.next:=am.stmts;-- AM_STMT_EXPR::stmts
am.stmts:=w;-- AM_STMT_EXPR::stmts
end;
else
#OUT+"Trying to insert a statement, but this does not work:\n";-- OUT::create OUT::plus
#OUT+"Statement to be inserted:\n";-- OUT::create OUT::plus
AM_OUT::AM_out(w);-- AM_OUT::AM_out
#OUT+"Trying to insert at the following position:\n";-- OUT::create OUT::plus
#OUT+"$AM: "+SYS::str_for_tp(SYS::tp(am))+" branch="+branch+"\n";-- OUT::create OUT::plus OUT::plus SYS::str_for_tp SYS::tp OUT::plus OUT::plus OUT::plus
AM_OUT::AM_out(am);-- AM_OUT::AM_out
UNIX::exit(-1);-- UNIX::exit
end;
end;
insert_stmt_before_stmt(am:$AM_STMT) is
-- if prog.opt_debug then
-- #OUT+"CURSOR: insert_stmt_before_stmt, before inserting:\n"+str;
-- #OUT+"Statement to insert:\n";
-- AM_OUT::AM_out(am);
-- #OUT+"inserting it in\n";
-- AM_OUT::AM_out(top);
-- end;
tst::=#A_STACK{AM_CURSOR_POS};-- A_STACK{1}::create
branch::=0;
loop
tcur::=cur;-- AM_CURSOR::cur
typecase tcur
when $AM_STMT then break!;
else end;
tst.push(#AM_CURSOR_POS(cur,mark,branch));-- A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::cur AM_CURSOR::mark
if stack.size=0 then-- AM_CURSOR::stack A_STACK{1}::size INT::is_eq
#OUT+"Internal error 98871: stack size 0, statement not found!\n";-- OUT::create OUT::plus
UNIX::exit(1);-- UNIX::exit
end;
s::=stack.pop;-- AM_CURSOR::stack A_STACK{1}::pop
cur:=s.stmt;-- AM_CURSOR::cur AM_CURSOR_POS::stmt
mark:=s.mark;-- AM_CURSOR::mark AM_CURSOR_POS::mark
branch:=s.branch;-- AM_CURSOR_POS::branch
end;
tst.push(#AM_CURSOR_POS(cur,mark,branch));-- A_STACK{1}::push AM_CURSOR_POS::create AM_CURSOR::cur AM_CURSOR::mark
if stack.top.branch=888888 then dummy::=stack.pop; end;-- AM_CURSOR::stack A_STACK{1}::top AM_CURSOR_POS::branch INT::is_eq AM_CURSOR::stack A_STACK{1}::pop
if stack.size=0 then-- AM_CURSOR::stack A_STACK{1}::size INT::is_eq
insert_stmt(void,0,am);-- AM_CURSOR::insert_stmt
else
s::=stack.pop;-- AM_CURSOR::stack A_STACK{1}::pop
insert_stmt(s.stmt,s.branch,am);-- AM_CURSOR::insert_stmt AM_CURSOR_POS::stmt AM_CURSOR_POS::branch
stack.push(s);-- AM_CURSOR::stack A_STACK{1}::push
end;
aml::=am;
loop
assert ~void(aml);-- BOOL::not
while!(SYS::id(aml)/=SYS::id(tst.top.stmt));-- SYS::id INT::is_eq SYS::id A_STACK{1}::top AM_CURSOR_POS::stmt BOOL::not
stack.push(#AM_CURSOR_POS(aml,false,999999));-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR_POS::create
aml:=aml.next;
end;
loop
while!(tst.size>0);-- A_STACK{1}::size INT::is_lt
stack.push(tst.pop);-- AM_CURSOR::stack A_STACK{1}::push A_STACK{1}::pop
end;
s::=stack.pop;-- AM_CURSOR::stack A_STACK{1}::pop
cur:=s.stmt;-- AM_CURSOR::cur AM_CURSOR_POS::stmt
mark:=s.mark;-- AM_CURSOR::mark AM_CURSOR_POS::mark
-- if prog.opt_debug then
-- #OUT+"CURSOR: insert_stmt_before_stmt, after inserting:\n"+str;
-- #OUT+"code looks now as follows: \n";
-- AM_OUT::AM_out(top);
-- end;
end;
-- insert_stmt_after_stmt(am:$AM_STMT) is end;
replace(am:$AM) is
typecase am
when $AM_STMT then
replace_stmt(am);
when $AM_EXPR then
replace_expr(am);
else
#OUT+"Internal Compiler Error 6582, got type "+SYS::str_for_tp(SYS::tp(am))+"\n";
UNIX::exit(-1);
end;
end;
delete_current is
tcur::=cur;-- AM_CURSOR::cur
-- if prog.opt_debug then
-- #OUT+"CURSOR: Deleting current object, before deleting:\n"+str;
-- AM_OUT::AM_out(top);
-- end;
typecase tcur
when $AM_STMT then
t::=tcur.next;
tcur.next:=void;
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
#OUT+"object to delete:\n";-- OUT::create OUT::plus
AM_OUT::AM_out(tcur);-- AM_OUT::AM_out
end;
replace_stmt(t);-- AM_CURSOR::replace_stmt
when $AM_EXPR then
if prog.opt_debug then-- AM_CURSOR::prog PROG::opt_debug
#OUT+"object to delete:\n";-- OUT::create OUT::plus
AM_OUT::AM_out(tcur);-- AM_OUT::AM_out
#OUT+"\n";-- OUT::create OUT::plus
end;
replace_expr(void);-- AM_CURSOR::replace_expr
else
#OUT+"Internal Compiler Error 882\n";-- OUT::create OUT::plus
UNIX::exit(-1);-- UNIX::exit
end;
-- if prog.opt_debug then
-- #OUT+"CURSOR: Deleting current object, after deleting:\n"+str;
-- AM_OUT::AM_out(top);
-- end;
end;
-- insert_before_surr_stmt(am:$AM_STMT) is end;
-- insert_after_surr_stmt(am:$AM_STMT) is end;
insert_stmt_before_loop(am:$AM_STMT) is
-- if prog.opt_debug then #OUT+"CURSOR: insert stmt before loop, before inserting:\n"+str;end;
tst:A_STACK{AM_CURSOR_POS};
tst:=#A_STACK{AM_CURSOR_POS};
branch::=0;
loop
tcur::=cur;
typecase tcur
when AM_LOOP_STMT then break!;
else end;
tst.push(#AM_CURSOR_POS(cur,mark,branch));
if stack.size=0 then
#OUT+"Internal error 98872: stack size 0, loop statement not found!\n";
UNIX::exit(1);
end;
s::=stack.pop;
cur:=s.stmt;
branch:=s.branch;
mark:=s.mark;
end;
tst.push(#AM_CURSOR_POS(cur,mark,branch));
if stack.size=0 then
aml::=am;
loop
while!(~void(aml));
stack.push(#AM_CURSOR_POS(aml,false,999999));
aml:=aml.next;
end;
insert_stmt(void,0,am);
else
s::=stack.top;
aml::=am;
loop
while!(~void(aml));
stack.push(#AM_CURSOR_POS(aml,false,999999));
aml:=aml.next;
end;
insert_stmt(s.stmt,s.branch,am);
stack.push(s);
end;
loop
while!(tst.size>0);
stack.push(tst.pop);
end;
s::=stack.pop;
cur:=s.stmt;
mark:=s.mark;
-- if prog.opt_debug then #OUT+"CURSOR: insert stmt before loop, after inserting:\n"+str;end;
end;
insert_in_loop_init(am:$AM_STMT) is
-- if prog.opt_debug then #OUT+"CURSOR: insert stmt in loop init, before inserting:\n"+str;end;
lp::=loop_stmt;-- AM_CURSOR::loop_stmt
if void(loop_stmt.init) then-- AM_CURSOR::loop_stmt AM_LOOP_STMT::init
loop_stmt.init:=am;-- AM_CURSOR::loop_stmt AM_LOOP_STMT::init
return;
else
loop_stmt.init.append(am);-- AM_CURSOR::loop_stmt AM_LOOP_STMT::init
end;
-- if prog.opt_debug then #OUT+"CURSOR: insert stmt in loop init, after inserting:\n"+str;end;
end;
append_to_loop(am:$AM_STMT) is
lp::=loop_stmt.body;-- AM_CURSOR::loop_stmt AM_LOOP_STMT::body
am.next:=void;
if void(lp) then
loop_stmt.body:=am;-- AM_CURSOR::loop_stmt AM_LOOP_STMT::body
else
loop until!(void(lp.next));
lp:=lp.next;
end;
lp.next:=am;
end;
end;
create(prog:PROG,am:$AM):SAME is
r::=new;
r.stack:=#A_STACK{AM_CURSOR_POS};-- AM_CURSOR::stack A_STACK{1}::create
r.cur:=void;-- AM_CURSOR::cur
r.top:=am;-- AM_CURSOR::top
r.loops:=0;-- AM_CURSOR::loops
r.indent:=0;-- AM_CURSOR::indent
r.prog:=prog;-- AM_CURSOR::prog
r.started:=false;-- AM_CURSOR::started
tmp::=prog.get_options;-- PROG::get_options
typecase tmp when CS_OPTIONS then r.with_side_effects:=tmp.side_effects;-- AM_CURSOR::with_side_effects CS_OPTIONS::side_effects
else r.with_side_effects:=false;-- AM_CURSOR::with_side_effects
end;
return r;
end;
create(c:SAME):SAME is
r::=new;
r.stack:=#A_STACK{AM_CURSOR_POS};-- AM_CURSOR::stack A_STACK{1}::create
r.cur:=c.cur;-- AM_CURSOR::cur AM_CURSOR::cur
r.mark:=c.mark;-- AM_CURSOR::mark AM_CURSOR::mark
r.top:=c.top;-- AM_CURSOR::top AM_CURSOR::top
r.loops:=c.loops;-- AM_CURSOR::loops AM_CURSOR::loops
r.indent:=c.indent;-- AM_CURSOR::indent AM_CURSOR::indent
r.prog:=c.prog;-- AM_CURSOR::prog AM_CURSOR::prog
r.with_side_effects:=c.with_side_effects;-- AM_CURSOR::with_side_effects AM_CURSOR::with_side_effects
r.started:=c.started;-- AM_CURSOR::started AM_CURSOR::started
r.ignore_pre:=c.ignore_pre;-- AM_CURSOR::ignore_pre AM_CURSOR::ignore_pre
r.ignore_post:=c.ignore_post;-- AM_CURSOR::ignore_post AM_CURSOR::ignore_post
r.ignore_assert:=c.ignore_assert;-- AM_CURSOR::ignore_assert AM_CURSOR::ignore_assert
r.assign_in_order:=c.assign_in_order;-- AM_CURSOR::assign_in_order AM_CURSOR::assign_in_order
loop
r.stack.push(c.stack.reverse_elt!);-- AM_CURSOR::stack A_STACK{1}::push AM_CURSOR::stack A_STACK{1}::reverse_elt!
end;
return r;
end;
print_cur is
c::=cur;
typecase c
when $AM_STMT then
n::=c.next;
c.next:=void;
AM_OUT::AM_out(c);
c.next:=n;
else
AM_OUT::AM_out(c);
end;
end;
test_am_cursor is
init_next;-- AM_CURSOR::init_next
#OUT+"------------------------------------\n";-- OUT::create OUT::plus
loop
c::=next!;-- AM_CURSOR::next!
loop indent.times!; #OUT+" "; end;-- AM_CURSOR::indent INT::times! OUT::create OUT::plus
#OUT+SYS::str_for_tp(SYS::tp(c))+"\n";-- OUT::create OUT::plus SYS::str_for_tp SYS::tp OUT::plus
end;
#OUT+"------------------------------------\n";-- OUT::create OUT::plus
end;
end;
-- vim:sw=3:nosmartindent