------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 1995 by International Computer Science Institute            --
-- This file is part of the GNU Sather package. It is free software; you may --
-- redistribute  and/or modify it under the terms of the  GNU General Public --
-- License (GPL)  as  published  by the  Free  Software  Foundation;  either --
-- version 2 of the license, or (at your option) any later version.          --
-- This  program  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/GPL for more details.        --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------

-- 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 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)+"]";
      ret:=ret+"  branch="+branch+"  mark:"+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;
   end;

   create(curr_stmt:$AM,m:BOOL,branch:INT):SAME is
      r::=new;
      r.stmt:=curr_stmt;
      r.branch:=branch;
      r.mark:=m;
      return r;
   end;
end;
--------------------------------------------------------------------------
class AM_CURSOR < $IS_EQ is
   include COMPARABLE;
   
   shared debug:BOOL:=false;
   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 all_in_eval_order:BOOL;
   attr all_in_pre_order:BOOL; -- overwrites all other order flags
   attr calls_in_eval_order: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 ";
      if void(cur) then
         ret:=ret+"cur=VOID  ";
      else
	 ret:=ret+"cur="+SYS::str_for_tp(SYS::tp(cur))+"["+SYS::id(cur)+"]  ";
      end;
      if void(top) then
         ret:=ret+"top=VOID"
      else
	 ret:=ret+"top="+SYS::str_for_tp(SYS::tp(top))+"["+SYS::id(top)+"]";
      end;
      ret:=ret+"\n all_in_pre_order="+all_in_pre_order+" all_in_eval_order="+all_in_eval_order+"\n";
      ret:=ret+" assign_in_order="+assign_in_order+" calls_in_eval_order="+calls_in_eval_order+"\n";
      ret:=ret+" loops="+loops+"   indent="+indent+"   {\n";
      loop
         ret:=ret+"   "+stack.elt!.str+"\n";
      end;
      ret:=ret+"}\n";
      return ret;
   end;

   in_order(am:$AM):BOOL is
      if all_in_pre_order then return false; end;
      if all_in_eval_order then return true; end;
      typecase am
      when $AM_CALL_EXPR then return calls_in_eval_order; 
      when AM_ASSIGN_STMT then return assign_in_order;
      when AM_WAITFOR_STMT then return assign_in_order;
      when AM_PREFETCH_STMT then return assign_in_order;
      else return false; end;
   end;

   is_eq(c:SAME):BOOL is
      if debug then 
	 #OUT+"comparing two AM_CURSOR:\n";
	 #OUT+"top:\t";
         if void(top) then #OUT+"(void)"; else #OUT+SYS::id(top); end;
	 #OUT+"\t";
	 if void(c.top) then #OUT+"(void)"; else #OUT+SYS::id(c.top); end;
	 #OUT+"\n";
	 #OUT+"cur:\t";
	 if void(cur) then #OUT+"(void)" else #OUT+SYS::id(cur); end;
	 if void(c.cur) then #OUT+"\t(void)\n" else #OUT+"\t"+SYS::id(c.cur)+"\n"; end;
	 #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;
      end;
      if void(self) then return void(c); end;
      if void(c) then return false; end;
      if ignore_pre /= c.ignore_pre or
         ignore_post /= c.ignore_post or
	 ignore_assert /= c.ignore_assert then return false; end;
      if ~SYS::ob_eq(cur,c.cur) or ~SYS::ob_eq(top,c.top)
         or loops/=c.loops or indent/=c.indent or
	 stack.size/=c.stack.size then 
	 --	 #OUT+"IS NOT EQUAL\n";
	 return false; 
      end;
      loop
         if stack.reverse_elt!/=c.stack.reverse_elt! then 
	    --	    #OUT+"IS NOT EQUAL\n";
	    return false;
	 end;
      end;
      --      #OUT+"IS EQUAL\n";
      return true;
   end;

   is_current_lhs:BOOL is
      if stack.size=0 then return true; end;
      p::=stack.top;
      tcur::=p.stmt;
      branch::=p.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;
      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;
      when AM_ASSIGN_STMT then
	 -- if branch=1 then #OUT+"current_is_lhs in ASSIGN 1\n"; end;
         return branch=1;
      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;
      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
	    c::=am.fun.get_se_context(prog);
	    if c.size>0 or c.full or c.unsafe or c.has_raise then return false; end;
	    loop if ~is_const(am.elt!.expr) then return false; end; end;
	    return true;
	 else return false;
	 end;
      when AM_SHARED_EXPR then
         return am.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;
      loop 
	 t::=c.next!;
	 if debug then--OUT
	    #OUT+"is_am_local_expr_const_in "+SYS::str_for_tp(SYS::tp(t))+"\n";--OUT
	    #OUT+"\n";--OUT
	 end;--OUT
	 if c=self then 
	    if debug then #OUT+"TRUE\n";end;--OUT
	    return true; 
	 end;
	 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 
	       if debug then--OUT
		  #OUT+"there is an assignment to the local var ";--OUT
		  AM_OUT::AM_out(am);#OUT+"  namely:\n";--OUT
		  AM_OUT::AM_one_stmt(t);--OUT
	       end;--OUT
	       return false; 
	    end;
	 when AM_WAITFOR_STMT then
	    if SYS::ob_eq(t.dest,am) or SYS::ob_eq(t.prefetch,am) then 
	       if debug then--OUT
		  #OUT+"there is an assignment to the local var ";--OUT
		  AM_OUT::AM_out(am);#OUT+"  namely:\n";--OUT
		  AM_OUT::AM_one_stmt(t);--OUT
	       end;--OUT
	       return false; 
	    end;
	 when AM_PREFETCH_STMT then
	    if SYS::ob_eq(t.dest,am) or SYS::ob_eq(t.prefetch,am) then 
	       if debug then--OUT
		  #OUT+"there is an assignment to the local var ";--OUT
		  AM_OUT::AM_out(am);#OUT+"  namely:\n";--OUT
		  AM_OUT::AM_one_stmt(t);--OUT
	       end;--OUT
	       return false; 
	    end;
	 when $AM_CALL_EXPR then
	    loop
	       a::=t.aget(0.upto!(t.asize-1));
	       if (a.mode=MODES::out_mode or a.mode=MODES::inout_mode) 
	          and SYS::ob_eq(a.expr,am) then 
		  if debug then--OUT
		     #OUT+"the local var ";--OUT
		     AM_OUT::AM_out(am);#OUT+" is used as an (in)out arg in:\n";--OUT
		     AM_OUT::AM_out(t);--OUT
		  end;--OUT
		  return false;
	       end;
	    end;
	 else end;
      end;
      return true;
   end;

   private is_am_shared_expr_const_in(c1:AM_CURSOR,tp:$TP,name:IDENT):BOOL is
      loop 
	 t::=c1.next!;
	 if c1=self then return true; end;
	 typecase t
	 when AM_WAITFOR_STMT then
	    d::=t.dest;
	    typecase d when AM_SHARED_EXPR then
	       if d.class_tp=tp and d.name=name then 
	          if debug then --OUT
		     #OUT+"there is an assignemnt to type "+tp.str+"::"+name.str+"   namely:\n";--OUT
		     AM_OUT::AM_one_stmt(t);--OUT
		  end;--OUT
		  return false; 
	       end;
	    else end;
	    d:=t.prefetch;
	    typecase d when AM_SHARED_EXPR then
	       if d.class_tp=tp and d.name=name then 
	          if debug then --OUT
		     #OUT+"there is an assignemnt to type "+tp.str+"::"+name.str+"   namely:\n";--OUT
		     AM_OUT::AM_one_stmt(t);--OUT
		  end;--OUT
		  return false; 
	       end;
	    else end;
	 when AM_PREFETCH_STMT then
	    d::=t.dest;
	    typecase d when AM_SHARED_EXPR then
	       if d.class_tp=tp and d.name=name then 
	          if debug then --OUT
		     #OUT+"there is an assignemnt to type "+tp.str+"::"+name.str+"   namely:\n";--OUT
		     AM_OUT::AM_one_stmt(t);--OUT
		  end;--OUT
		  return false; 
	       end;
	    else end;
	    d:=t.prefetch;
	    typecase d when AM_SHARED_EXPR then
	       if d.class_tp=tp and d.name=name then 
	          if debug then --OUT
		     #OUT+"there is an assignemnt to type "+tp.str+"::"+name.str+"   namely:\n";--OUT
		     AM_OUT::AM_one_stmt(t);--OUT
		  end;--OUT
		  return false; 
	       end;
	    else end;
	 when AM_ASSIGN_STMT then
	    d::=t.dest;
	    typecase d when AM_SHARED_EXPR then
	       if d.class_tp=tp and d.name=name then 
	          if debug then --OUT
		     #OUT+"there is an assignemnt to type "+tp.str+"::"+name.str+"   namely:\n";--OUT
		     AM_OUT::AM_one_stmt(t);--OUT
		  end;--OUT
		  return false; 
	       end;
	    else end;
	 when AM_ROUT_CALL_EXPR then
	    if with_side_effects then
	       c::=t.fun.get_se_context(prog);
	       if c.full then -- if debug then #OUT+"routine "+t.fun.str+" is marked full side effects\n";end;
	          return false; end; 
	       se::=c.se_attr(tp,name);
	       if ~void(se) and se.doeswrite then -- if debug then #OUT+"routine "+t.fun.str+" writes to type "+tp.str+"::"+name.str+"\n";end;
	          return false; end;
	    else return false;
	    end;
	    loop
	       a::=t.elt!;
	       if a.mode=MODES::inout_mode or a.mode=MODES::out_mode then
		  e::=a.expr;
		  typecase e when AM_SHARED_EXPR then
		     if e.class_tp=tp and e.name=name then return false; end;
		  else end
	       end;
	    end;
	 when AM_ITER_CALL_EXPR then
	    if with_side_effects then
	       c::=t.fun.get_se_context(prog);
	       if c.full then -- if debug then #OUT+"iter "+t.fun.str+" is marked full side effects\n";end;
	           return false; end; 
	       se::=c.se_attr(tp,name);
	       if ~void(se) and se.doeswrite then 
		  if debug then #OUT+"iter "+t.fun.str+" writes to type "+tp.str+"::"+name.str+"\n";end;--OUT
		  return false; 
	       end;
	    else return false;
	    end;
	    loop
	       a::=t.elt!;
	       if a.mode=MODES::inout_mode or a.mode=MODES::out_mode then
	          e::=a.expr;
		  typecase e when AM_SHARED_EXPR then
		     if e.class_tp=tp and e.name=name then return false; end;
		  else end
	       end;
	    end;
	 when AM_BND_ROUT_CALL_EXPR then 
	    if debug then #OUT+"not const, because of AM_BND_ROUT_CALL\n";end;--OUT
	    return false;
	 when AM_BND_ITER_CALL_EXPR then 
	    if debug then #OUT+"not const, because of AM_BND_ITER_CALL\n";end;--OUT
	    return false; 
	 when AM_EXT_CALL_EXPR then 
	    if debug then #OUT+"not const, because of AM_EXT_CALL "+t.fun.str+"\n";end;--OUT
	    return false;
	 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!;
	 if cr=self then return true; end;
	 typecase t
	 when AM_WAITFOR_STMT then
	    d::=t.dest;
	    typecase d when AM_ATTR_EXPR then
	       if d.self_tp=self_tp and d.at=name then 
	          if debug then --OUT
		     #OUT+"there is an assignemnt to type "+self_tp.str+"::"+name.str+"   namely:\n";--OUT
		     AM_OUT::AM_one_stmt(t);--OUT
		  end;--OUT
		  return false; 
	       end;
	    else end;
	    d:=t.prefetch;
	    typecase d when AM_ATTR_EXPR then
	       if d.self_tp=self_tp and d.at=name then 
	          if debug then --OUT
		     #OUT+"there is an assignemnt to type "+self_tp.str+"::"+name.str+"   namely:\n";--OUT
		     AM_OUT::AM_one_stmt(t);--OUT
		  end;--OUT
		  return false; 
	       end;
	    else end;
	 when AM_PREFETCH_STMT then
	    d::=t.dest;
	    typecase d when AM_ATTR_EXPR then
	       if d.self_tp=self_tp and d.at=name then 
	          if debug then --OUT
		     #OUT+"there is an assignemnt to type "+self_tp.str+"::"+name.str+"   namely:\n";--OUT
		     AM_OUT::AM_one_stmt(t);--OUT
		  end;--OUT
		  return false; 
	       end;
	    else end;
	    d:=t.prefetch;
	    typecase d when AM_ATTR_EXPR then
	       if d.self_tp=self_tp and d.at=name then 
	          if debug then --OUT
		     #OUT+"there is an assignemnt to type "+self_tp.str+"::"+name.str+"   namely:\n";--OUT
		     AM_OUT::AM_one_stmt(t);--OUT
		  end;--OUT
		  return false; 
	       end;
	    else end;
	 when AM_ASSIGN_STMT then
	    d::=t.dest;
	    typecase d when AM_ATTR_EXPR then
	       if d.self_tp=self_tp and d.at=name then 
	          if debug then --OUT
		     #OUT+"there is an assignemnt to type "+self_tp.str+"::"+name.str+"   namely:\n";--OUT
		     AM_OUT::AM_one_stmt(t);--OUT
		  end;--OUT
		  return false; 
	       end;
	    else end;
	 when AM_ROUT_CALL_EXPR then
	    if with_side_effects then
	       c::=t.fun.get_se_context(prog);
	       if c.full then 
	          if debug then #OUT+"routine "+t.fun.str+" is marked full side effects\n";end;--OUT
	          return false; end; 
	       se::=c.se_attr(self_tp,name);
	       if ~void(se) and se.doeswrite then 
	          if debug then #OUT+"routine "+t.fun.str+" writes to type "+self_tp.str+"::"+name.str+"\n";end;--OUT
		  return false; 
	       end;
	    else return false;
	    end;
	    loop
	       a::=t.elt!;
	       if a.mode=MODES::inout_mode or a.mode=MODES::out_mode then
		  e::=a.expr;
		  typecase e when AM_ATTR_EXPR then
		     if e.self_tp=self_tp and e.at=name then 
			if debug then --OUT
			   #OUT+"attr is used as out/inout in routine "+t.fun.str+"\n";--OUT
			end;--OUT
			return false; 
		     end;
		  else end
	       end;
	    end;
	 when AM_ITER_CALL_EXPR then
	    if with_side_effects then
	       c::=t.fun.get_se_context(prog);
	       if c.full then 
	          if debug then #OUT+"iter "+t.fun.str+" is marked full side effects\n";end;--OUT
	          return false; 
	       end; 
	       se::=c.se_attr(self_tp,name);
	       if ~void(se) and se.doeswrite then 
	          if debug then #OUT+"iter "+t.fun.str+" writes to type "+self_tp.str+"::"+name.str+"\n";end;--OUT
	          return false; 
	       end;
	    else return false;
	    end;
	    loop
	       a::=t.elt!;
	       if a.mode=MODES::inout_mode or a.mode=MODES::out_mode then
		  e::=a.expr;
		  typecase e when AM_ATTR_EXPR then
		     if e.self_tp=self_tp and e.at=name then 
			if debug then --OUT
			   #OUT+"attr is used as out/inout in iter "+t.fun.str+"\n";--OUT
			end;--OUT
		        return false; 
		     end;
		 else end
	       end;
	    end;
	 when AM_BND_ROUT_CALL_EXPR then 
	    if debug then #OUT+"not const, because of AM_BND_ROUT_CALL\n";end;--OUT
	    return false;
	 when AM_BND_ITER_CALL_EXPR then 
	    if debug then #OUT+"not const, because of AM_BND_ITER_CALL\n";end;--OUT
	    return false; 
	 when AM_EXT_CALL_EXPR then 
	    if debug then #OUT+"not const, because of AM_EXT_CALL "+t.fun.str+"\n";end;--OUT
	    return false;
	 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
	 c::=am.fun.get_se_context(prog);
	 if c.full or c.unsafe or c.has_raise then
	    if debug then --OUT
	       #OUT+"found full, unsafe or has_raise for routine "+am.fun.str+"\n";--OUT
	    end;--OUT
	    return false;
	 end;
	 loop e::=c.elt!;
	    if e.doeswrite or void(e.tp) or void(e.name) then
	       if debug then--OUT
		  #OUT+"routine "+am.fun.str+", attr tp=";--OUT
		  if void(e.tp) then #OUT+"void";--OUT
		  else #OUT+e.tp.str; end;--OUT
		  #OUT+"  name=";--OUT
		  if void(e.name) then #OUT+"void";--OUT
		  else #OUT+e.name.str; end;--OUT
		  #OUT+" doeswrite="+e.doeswrite+"\n"--OUT
	       end;--OUT
	       return false;
	    else 
	       if ~is_am_attr_expr_const_in(#(c1),e.tp,e.name) then return false; end;
	    end;
	 end;
	 loop 
	    if am.elt!.mode/=MODES::in_mode then 
	       if debug then--OUT
	          #OUT+"found arg with OUT or INOUT mode in "+am.fun.str+"\n";--OUT
	       end;--OUT
	       return false; 
	    end;
	    if ~is_const_in(#(c1),am.elt!) then return false; end; 
	 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
	 c::=am.fun.get_se_context(prog);
	 if c.full or c.unsafe or c.has_raise or c.has_fatal_error then
	    if debug then --OUT
	       #OUT+"found full, unsafe, has_fatal_error or has_raise for routine "+am.fun.str+"\n";--OUT
	    end;--OUT
	    return false;
	 end;
	 loop e::=c.elt!;
	    if e.doeswrite or void(e.tp) or void(e.name) then 
	       if debug then--OUT
		  #OUT+"routine "+am.fun.str+", attr tp=";--OUT
		  if void(e.tp) then #OUT+"void";--OUT
		  else #OUT+e.tp.str; end;--OUT
		  #OUT+"  name=";--OUT
		  if void(e.name) then #OUT+"void";--OUT
		  else #OUT+e.name.str; end;--OUT
		  #OUT+" doeswrite="+e.doeswrite+"\n"--OUT
	       end;--OUT
	       return false;
	    else 
	       if ~is_am_attr_expr_const_in(#(c1),e.tp,e.name) then return false; end;
	    end;
	 end;
	 loop 
	    if am.elt!.mode/=MODES::in_mode then return false; end;
	    if ~is_non_fatal_and_const_in(#(c1),am.elt!) then return false; end; 
	 end;
	 return true;
      else return false;
      end;
   end;

   private is_const_in(c:AM_CURSOR,am:$AM):BOOL is 
      if debug then--OUT
         #OUT+"is_const_in: self="+str+"c=\n"+c.str+"am=";--OUT
	 AM_OUT::AM_out(am);--OUT
      end;--OUT
      if is_const(am) then return true; end;
      if debug then--OUT
         #OUT+"is_const_in +"+SYS::str_for_tp(SYS::tp(am))+"\n";--OUT
      end;--OUT
      typecase am
      when AM_LOCAL_EXPR then
	 return is_am_local_expr_const_in(c,am);
      when AM_ROUT_CALL_EXPR then
         return is_am_rout_call_expr_const_in(c,am);
      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);
      when AM_SHARED_EXPR then
         return is_am_shared_expr_const_in(c,am.class_tp,am.name);
      when AM_IS_VOID_EXPR then
         return is_const_in(c,am.arg);
      when AM_CALL_ARG then
         return is_const_in(c,am.expr);
      when AM_IF_EXPR then
         return is_const_in(#(c),am.test) and 
	        is_const_in(#(c),am.if_true) and
		is_const_in(c,am.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);
	 else
	    if debug then--OUT
	       #OUT+"the following AM_NODE is considered to be non const: "+SYS::str_for_tp(SYS::tp(am))+"\n";--OUT
	    end;--OUT
	    return false;
	end;
      else 
	 if debug then--OUT
	    #OUT+"the following AM_NODE is considered to be non const: "+SYS::str_for_tp(SYS::tp(am))+"\n";--OUT
	 end;--OUT
	 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;
      typecase am
      when AM_LOCAL_EXPR then
	 return is_am_local_expr_const_in(c,am);
      when AM_ROUT_CALL_EXPR then
         return is_am_rout_call_expr_non_fatal_and_const_in(c,am);
      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);
      when AM_SHARED_EXPR then
         return is_am_shared_expr_const_in(c,am.class_tp,am.name);
      when AM_IS_VOID_EXPR then
         return is_non_fatal_and_const_in(c,am.arg);
      when AM_CALL_ARG then
         return is_non_fatal_and_const_in(c,am.expr);
      when AM_IF_EXPR then
         return is_non_fatal_and_const_in(#(c),am.test) and 
	        is_non_fatal_and_const_in(#(c),am.if_true) and
		is_non_fatal_and_const_in(c,am.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);
	 else
	    if debug then--OUT
	       #OUT+"the following AM_NODE is considered to be non const: "+SYS::str_for_tp(SYS::tp(am))+"\n";--OUT
	    end;--OUT
	    return false;
	end;
      else 
	 if debug then--OUT
	    #OUT+"the following AM_NODE is considered to be non const: "+SYS::str_for_tp(SYS::tp(am))+"\n";--OUT
	 end;--OUT
	 return false;
      end;
   end;

   is_const_in_loop(am:$AM):BOOL is
      return is_const_in(#AM_CURSOR(prog,loop_stmt.body),am);
   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);
      c1.init_next;
      return is_const_in(c1,am);
   end;

   is_const_in_loop_before_eval_cur_expr(am:$AM):BOOL is
      c1:SAME:=#(self);
      c1.innermost_loop;
      c1.begin_of_loop_body;
      return is_const_in(c1,am);
   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);
   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);
      c1.innermost_loop;
      c1.begin_of_loop_body;
      return is_non_fatal_and_const_in(c1,am);
   end;

   private is_am_shared_expr_not_used_in(c1:AM_CURSOR,tp:$TP,name:IDENT):BOOL is
      loop 
	 t::=c1.next!;
	 if c1=self then return true; end;
	 typecase t when AM_SHARED_EXPR then
	    if t.class_tp=tp and t.name=name then return false; end;
	 when AM_ROUT_CALL_EXPR then
	    if with_side_effects then
	       c::=t.fun.get_se_context(prog);
	       if c.full then return false; end; 
	       se::=c.se_attr(tp,name);
	       if ~void(se) then 
		  if debug then #OUT+"found doeswrite or read ("+se.str+") in "+t.fun.str+"\n"; end;--OUT
		  return false; end;
	    else return false;
	    end;
	 when AM_ITER_CALL_EXPR then
	    if with_side_effects then
	       c::=t.fun.get_se_context(prog);
	       if c.full then return false; end; 
	       se::=c.se_attr(tp,name);
	       if ~void(se) then return false; end;
	    else return false;
	    end;
	 when AM_BND_ROUT_CALL_EXPR then 
	    if debug then #OUT+"not unused, because of AM_BND_ROUT_CALL\n";end;--OUT
	    return false;
	 when AM_BND_ITER_CALL_EXPR then 
	    if debug then #OUT+"not unused, because of AM_BND_ITER_CALL\n";end;--OUT
	    return false; 
	 when AM_EXT_CALL_EXPR then 
	    if debug then #OUT+"not unused, because of AM_EXT_CALL "+t.fun.str+"\n";end;--OUT
	    return false;
	 else end;
      end;
      return true;
   end;

   private is_am_attr_expr_not_used_in(c1:AM_CURSOR,tp:$TP,name:IDENT):BOOL is
      loop 
	 t::=c1.next!;
	 if c1=self then return true; end;
	 typecase t
	 when AM_ATTR_EXPR then
	    if t.tp=tp and t.at=name then return false; end;
	 when AM_ROUT_CALL_EXPR then
	    if with_side_effects then
	       c::=t.fun.get_se_context(prog);
	       if c.full then return false; end; 
	       se::=c.se_attr(tp,name);
	       if ~void(se) then return false; end;
	    else return false;
	    end;
	 when AM_ITER_CALL_EXPR then
	    if with_side_effects then
	       c::=t.fun.get_se_context(prog);
	       if c.full then return false; end; 
	       se::=c.se_attr(tp,name);
	       if ~void(se) then return false; end;
	    else return false;
	    end;
	 when AM_BND_ROUT_CALL_EXPR then 
	    if debug then #OUT+"not unused, because of AM_BND_ROUT_CALL\n";end;--OUT
	    return false;
	 when AM_BND_ITER_CALL_EXPR then 
	    if debug then #OUT+"not unused, because of AM_BND_ITER_CALL\n";end;--OUT
	    return false; 
	 when AM_EXT_CALL_EXPR then 
	    if debug then #OUT+"not unused, because of AM_EXT_CALL "+t.fun.str+"\n";end;--OUT
	    return false;
	 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!;
	 if c1=self then return true; end;
	 typecase t
	 when AM_LOCAL_EXPR then
	    if am=t then return false; end;	       
	 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);
      when AM_ATTR_EXPR then
         return is_am_attr_expr_not_used_in(#(c),am.self_tp,am.at)
	        and is_not_used_in(c,am.ob);
      when AM_SHARED_EXPR then
         return is_am_shared_expr_not_used_in(c,am.class_tp,am.name)
      else
         return false;
      end;
   end;

   is_not_used_in_loop_before_eval_cur_expr(am:$AM):BOOL is
      c1:SAME:=#(self);
      c1.innermost_loop;
      c1.begin_of_loop_body;
      return is_not_used_in(c1,am);
   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);
      c1.init_next;
      return is_not_used_in(c1,am);
   end;

   is_not_used_outside_innermost_loop(am:$AM):BOOL is
      typecase am
      when AM_LOCAL_EXPR then
         lp::=loop_stmt;
	 c1::=#AM_CURSOR(prog,top);
	 loop
	    t::=c1.next!;
	    typecase t 
	    when AM_LOCAL_EXPR then
	       if am=t then return false; end;
	    when AM_LOOP_STMT then
	       if SYS::id(lp)=SYS::id(t) then
	          c1.after_loop;
	       end;
	    else end;
	 end;
	 return true;
      else end;
      return false;
   end;

   -- returns true if the current expression of self is only executed
   -- after the current one of after and that am is const
   -- during this time.
   -- 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).
   -- Warning: if pafter.cur is used several times
   -- withing the code (that is, several places in the expression
   -- tree point to the same object) this routine may incorrectly
   -- return false.
   is_exec_after_and_const_from_there(pafter:AM_CURSOR,am:$AM):BOOL is
      if debug then		--OUT
         #OUT+"****** is_exec_after_and_const_from_there:\nself=\n";		--OUT
	 #OUT+str+"after="+pafter.str;		--OUT
	 #OUT+"am= ";AM_OUT::AM_out(am);		--OUT
      end;		--OUT
      dummy_cursor::=#AM_CURSOR(prog,void);
      if is_current_lhs then return false; end;
      after:AM_CURSOR;
      old_dest:$AM_EXPR;
      old_as:AM_ASSIGN_STMT;

      -- Now we check if we are in the RHS of an assignment to am. In this case
      -- we return false
      a::=#AM_CURSOR(pafter);
      loop
	 a.surr_stmt;
	 s::=a.cur;
	 until!(void(s));
	 typecase s when AM_ASSIGN_STMT then
	    if prog.opt_debug then 
	       #OUT+"is_not_used_in dest of \n";
	       AM_OUT::AM_one_stmt(s);
	       #OUT+"expressio to test: ";AM_OUT::AM_out(am);
	       #OUT+"\n";
	    end;
	    if ~is_not_used_in(#AM_CURSOR(prog,s.dest),am) then
	       if prog.opt_debug then #OUT+"RESULT: false\n"; end;
	       return false; 
	    end;
	    if prog.opt_debug then #OUT+"RESULT: false\n"; end;
	 else end;
      end;

      
      -- check if the expression is in the src of the assignment.
      -- and after is its destination. In this case we have obviously 
      -- a non const expression.
      if pafter.assign_in_order and pafter.is_current_lhs then
         after:=#AM_CURSOR(pafter);
	 after.surr_stmt;
	 as::=after.cur;
	 typecase as when AM_ASSIGN_STMT then
	    cx::=#AM_CURSOR(prog,as.src);
	    loop
	       if SYS::id(cx.next!)=SYS::id(am) then return false; end;
	    end;
	    -- it is not in the source, but if we leave everything the
	    -- the way it is, we will return false, as there is an 
	    -- assignment to the expr am. So we replace that assign expression
	    -- with something that does not pose a problem, namely an AM_VOID_CONST;
	    -- We just have to undo this before we return from this function.
	    old_dest:=as.dest;
	    old_as:=as;
	    as.dest:=#AM_VOID_CONST(void);
	 else end;
      else
	 after:=pafter;
      end;

      -- first we check if we are in a part of the code that 
      -- is only executed if some conditions are true
      c::=#AM_CURSOR(after);
      branch::=0;
      tcur::=c.cur;
      no_cond::=false;
      loop
	 if debug then 	--OUT
	    #OUT+"no_cond-loop: branch="+branch+"   tcur=";AM_OUT::AM_one_stmt(tcur); 	--OUT
	    #OUT+"\n"; 	--OUT
	 end; 	--OUT
	 typecase tcur
	 when AM_IF_STMT then if branch>1 and branch<999999 then break!; end;
	 when AM_IF_EXPR then if branch>1 then break!; end;
	 when AM_TYPECASE_STMT then if branch>1 and branch<999999 then break!; end;
	 when AM_CASE_STMT then if branch>1 and branch<999999 then break!; end;
	 when AM_LOCK_STMT then if branch>tcur.guards.size and branch<999999 then break!; end;
	 when AM_WITH_NEAR_STMT then if branch>tcur.objects.size and branch<999999 then break!; end;
	 else end;
	 if c.stack.size=0 then no_cond:=true;break!; end;
	 branch:=c.pop_stack.branch;
	 tcur:=c.cur;
      end;
      -- #OUT+"2. is_exec_after_and_const_from_there:after\n"+after.str;

      -- Check if the function is actually const from current position in 
      -- self to the position in after.
      if ~is_const_in(#(after),am) then 
	 if debug then		--OUT
            #OUT+"is_exec_after_and_const_from_there faild in is_const_in\n"; 		--OUT
	 end;		--OUT
	 if ~void(old_as) then old_as.dest:=old_dest; end;
	 return false; 
      end;
      -- 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.
      c:=#AM_CURSOR(self);
      a_branch::=0;
      a_tcur::=c.cur;

      if debug then	--OUT
	 #OUT+"tcur=";AM_OUT::AM_one_stmt(tcur);#OUT+"\n";	--OUT
	 #OUT+"no_cond="+no_cond+"\n";--OUT
      end;	--OUT
      -- reset the expression if it was an assign destination (we have to do it here
      -- as otherwise the check for loop constants will miserably fail (and report
      -- true)).
      if ~void(old_as) then old_as.dest:=old_dest; end;


      -- first, we make sure that the first expression is not in loop
      -- that may quit before the expression is evaluated (obviously, it
      -- does not matter if both expressions are inside the same loop);
      in_same_branch::=true;
      loop
	 ts::=pafter.stack.reverse_elt!;
	 if in_same_branch then
	    tself::=stack.reverse_elt!;
	    in_same_branch:=ts.branch=tself.branch;
	 end;
	 if ~in_same_branch then
	    s::=ts.stmt;
	    typecase s when AM_LOOP_STMT then
	       if ts.branch=2 then
	          cx::=#AM_CURSOR(prog,s.body);
		  loop
		     x::=cx.next!;
		     if SYS::id(x)=SYS::id(pafter.cur) then
		        break!;
		     end;
		     typecase x 
		     when AM_ITER_CALL_EXPR then return false; 
		     when AM_BND_ITER_CALL_EXPR then return false;
		     when AM_BREAK_STMT then return false;
		     else end;
	          end;
	       end;
	       break!;
	    else end;
         end;
      end;

      loop
	 if debug then--OUT
	    #OUT+"a_tcur=";AM_OUT::AM_one_stmt(a_tcur);#OUT+"\n";--OUT
	 end;--OUT
	 if ~no_cond and SYS::id(tcur)=SYS::id(a_tcur) then
	    if branch/=a_branch and debug then		--OUT
	       #OUT+"is_exec_after_and_const_from_there failed in cond test\n";		--OUT
	       #OUT+"the expression is in another conditional branch\n";		--OUT
	    end;	--OUT
	    return branch=a_branch;
	 end;
	 typecase a_tcur 
	 when AM_LOOP_STMT then
	    if debug then 		--OUT
	       #OUT+"\nbranch="+branch+"   testing for loop constant in following loop:\nam=";AM_OUT::AM_out(am);		--OUT
	       #OUT+"\nLOOP:\n";		--OUT
	       AM_OUT::AM_out(a_tcur.body);		--OUT
	    end;		--OUT

	    -- check if it is a loop constant 
	    if branch>1 and ~dummy_cursor.is_const_in(#AM_CURSOR(prog,a_tcur.body),am) then
	       if debug then		--OUT
		  #OUT+"is_exec_after_and_const_from_there failed in is_const_in for loop\n";		--OUT
	       end;		--OUT
	       return false;
	    end;
	 else end;
	 if c.stack.size=0 then 
	    if debug and ~no_cond then		--OUT
	       #OUT+"is_exec_after_and_const_from_there failed in cond test\n";		--OUT
	       #OUT+"the expression is in another conditional branch\n";		--OUT
	    end;		--OUT
	    return no_cond; 
	 end;
	 p::=c.pop_stack;
	 a_tcur:=p.stmt;
	 a_branch:=p.branch;
      end;

      return true;
   end;

   in_iter_init:BOOL is
      c::=#AM_CURSOR(self);
      branch::=0;
      tcur::=c.cur;
      loop
	 typecase tcur
	 when AM_ITER_CALL_EXPR then if branch=1 then return true end;
	 else end;
	 if c.stack.size=0 then break!; end;
	 p::=c.stack.pop;
	 tcur:=p.stmt;
	 branch:=p.branch;
      end;
      return false;
   end;

   not_prefetch_attr:BOOL is
      s::=stack.top.stmt;
      typecase s when AM_PREFETCH_STMT then
         return false;
      else end;
      return true;
   end;

   get_with_near_stmt:AM_WITH_NEAR_STMT is
      loop
	 s::=stack.elt!.stmt;
	 typecase s when AM_WITH_NEAR_STMT then return s;
	 else end;
      end;
      return void;
   end;

   is_first_stmt_of_with_near_else:BOOL is
      if stack.size=0 then return false; end;
      s::=stack.top.stmt;
      typecase s when AM_WITH_NEAR_STMT then
	 return stack.top.branch=s.objects.size+2;
      else end;
      return false;
   end;

   is_lhs_of_at_expr:BOOL is
      s::=stack.top.stmt;
      b::=stack.top.branch;
      typecase s when AM_AT_EXPR then
         if b=2 then return true; end;
      else end;
      return false;
   end;
   
   -- this is used to prevent inlining of fork bodies for -O_fast_fork
   -- inlining of simple fork bodies is bad since it destorys simple
   -- function calls that can be packed in a single active message
   in_body_of_fork_stmt:BOOL is
      c::=#AM_CURSOR(self);
      if c.stack.size < 2 then return false; end;
      p ::= c.stack.pop;
      s1 ::= p.stmt;
      b1 ::= p.branch; 
      typecase s1
      when AM_EXPR_STMT then
	 if b1=1 then 
	    -- check if in fork stmt
	    p := c.stack.pop;
	    s2 ::= p.stmt;  
	    b2 ::= p.branch;
	    typecase s2
	    when AM_FORK_STMT then
	       if b2=2 then
		  return true;
	       end;
	    else
	    end;
	 end;
      else
      end;
      return false;
   end;

   not_in_a_conditional_in_loop:BOOL is 
      c::=#AM_CURSOR(self);
      branch::=0;
      tcur::=c.cur;
      loop
	 typecase tcur
	 when AM_LOOP_STMT then return true;
	 when AM_IF_STMT then if branch>1 then return false; end;
	 when AM_IF_EXPR then if branch>1 then return false; end;
	 when AM_TYPECASE_STMT then if branch>1 then return false; end;
	 when AM_CASE_STMT then if branch>1 then return false; end;
	 when AM_LOCK_STMT then if branch>tcur.guards.size then return false; end;
	 when AM_WITH_NEAR_STMT then if branch>tcur.objects.size then return false; end;
	 else end;
	 if c.stack.size=0 then break!; end;
	 p::=c.stack.pop;
	 tcur:=p.stmt;
	 branch:=p.branch;
      end;
      return true;
   end;

   not_in_a_case_in_a_loop:BOOL is
      c::=#AM_CURSOR(self);
      branch::=0;
      tcur::=c.cur;
      loop
	 typecase tcur
	 when AM_LOOP_STMT then return true;
	 when AM_CASE_STMT then if branch>1 then return false; end;
	 when AM_TYPECASE_STMT then if branch>1 then return false; end;
	 else end;
	 if c.stack.size=0 then break!; end;
	 p::=c.stack.pop;
	 tcur:=p.stmt;
	 branch:=p.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;
      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;
         if ~void(cur.src) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.src; end;
      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;
         if ~void(cur.src) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.src; end;
         if ~void(cur.prefetch) and branch<3 then stack.push(#AM_CURSOR_POS(cur,mark,3));return cur.prefetch; end;
      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;
         if ~void(cur.src) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.src; end;
         if ~void(cur.prefetch) and branch<3 then stack.push(#AM_CURSOR_POS(cur,mark,3));return cur.prefetch; end;
      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;
         if ~void(cur.if_true) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.if_true; end;
         if ~void(cur.if_false) and branch<3 then stack.push(#AM_CURSOR_POS(cur,mark,3));return cur.if_false; end;
      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;
         if ~void(cur.body) and branch<2 then 
	    stack.push(#AM_CURSOR_POS(cur,mark,2));
	    loops:=loops+1;
	    return cur.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;
      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;
      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;
         if cur.stmts.size>0 then 
	    loop
	       a::=cur.stmts.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;
	    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;
      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;
         if cur.stmts.size>0 then 
	    loop
	       a::=cur.stmts.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;
	    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;
      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;
      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;
      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;
      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;
      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;
         if cur.stmts.size>0 then 
	    loop
	       a::=cur.stmts.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;
	    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;
      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;
      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;
      
      -- pSather
      when AM_LOCK_STMT then
	 b::=branch;
      	 if branch<cur.guards.size then
	    stack.push(#AM_CURSOR_POS(cur,mark,branch+1));
	    return cur.guards[branch];
	 end;
	 b:=b-cur.guards.size;
	 loop
	    l::=cur.locks.elt!;
	    if l.size>b then
	       stack.push(#AM_CURSOR_POS(cur,mark,branch+1));
	       return l[b];
	    end;
	    b:=b-l.size;
	 end;
	 if cur.stmts.size>b then
	    if ~void(cur.stmts[b]) then
	       stack.push(#AM_CURSOR_POS(cur,mark,branch+1));
	       return cur.stmts[b];
	    else
	       branch:=branch+1;
	    end;
	 end;
	 b:=b-cur.stmts.size;
	 if b=0 and ~void(cur.else_stmts) then stack.push(#AM_CURSOR_POS(cur,mark,branch+1));return cur.else_stmts; end;
      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;
      when AM_FORK_STMT then
         if ~void(cur.at) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.at; end;
         if ~void(cur.body) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.body; end;	 
      when AM_PAR_STMT then
         if ~void(cur.body) and branch<1 then stack.push(#AM_CURSOR_POS(cur,mark,1));return cur.body; end;
      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;
      when AM_WITH_NEAR_STMT then
         if ~void(cur.objects) and branch<cur.objects.size then
	    stack.push(#AM_CURSOR_POS(cur,mark,branch+1));
	    return cur.objects[branch];
	 end;
	 if branch<cur.objects.size+1 and ~void(cur.near_part) then
	    stack.push(#AM_CURSOR_POS(cur,mark,cur.objects.size+1));
	    return cur.near_part;
	 end;
	 if branch<cur.objects.size+2 and ~void(cur.else_part) then
	    stack.push(#AM_CURSOR_POS(cur,mark,cur.objects.size+2));
	    return cur.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;
      when AM_ROUT_CALL_EXPR then
	 loop
	    a::=cur.ind!;
	    if ~void(cur[a]) and branch<a+1 then stack.push(#AM_CURSOR_POS(cur,mark,a+1));return cur[a];end;
	 end;
      when AM_EXT_CALL_EXPR then
	 loop
	    a::=cur.ind!;
	    if ~void(cur[a]) and branch<a+1 then stack.push(#AM_CURSOR_POS(cur,mark,a+1));return cur[a];end;
	 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;
	 loop
	    a::=cur.ind!;
	    if ~void(cur[a]) and branch<a+2 then stack.push(#AM_CURSOR_POS(cur,mark,a+2));return cur[a];end;
	 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;
	 loop
	    a::=cur.ind!;
	    if ~void(cur[a]) and branch<a+2 then stack.push(#AM_CURSOR_POS(cur,mark,a+2));return cur[a];end;
	 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;
	 if ~void(cur.init) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.init;end;
	 loop
	    a::=cur.ind!;
	    if ~void(cur[a]) and branch<a+3 then stack.push(#AM_CURSOR_POS(cur,mark,a+3));return cur[a];end;
	 end;

      -- EXPRESSIONS
      when AM_ARRAY_EXPR then 
	 loop
	    a::=cur.ind!;
	    if ~void(cur[a]) and branch<a+1 then stack.push(#AM_CURSOR_POS(cur,mark,a+1));return cur[a];end;
	 end;
      when AM_BND_CREATE_EXPR then 
	 loop
	    a::=cur.ind!;
	    if ~void(cur[a]) and branch<a+1 then stack.push(#AM_CURSOR_POS(cur,mark,a+1));return cur[a];end;
	 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;
	 if ~void(cur.if_true) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.if_true;end;
	 if ~void(cur.if_false) and branch<3 then stack.push(#AM_CURSOR_POS(cur,mark,3));return cur.if_false;end;
      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;
      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;
      when AM_SHARED_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;
      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;
	 if ~void(cur.val) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.val;end;
      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;
	 if ~void(cur.ind) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.ind;end;
	 if ~void(cur.val) and branch<3 then stack.push(#AM_CURSOR_POS(cur,mark,3));return cur.val;end;
      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;
      	 if ~void(cur.expr) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.expr;end;
      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;
      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;
      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;
      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;
      	 if ~void(cur.e) and branch<2 then stack.push(#AM_CURSOR_POS(cur,mark,2));return cur.e;end;
      when AM_CLUSTER_EXPR then
      when AM_CLUSTER_SIZE_EXPR then
      when AM_GLOBAL_EXPR then
      else 
         #OUT+"the following AM node is missing (CURSOR::next_branch), please add it.\n"
	     +SYS::str_for_tp(SYS::tp(cur))+"\n";
      end;
      indent:=indent-1;
      typecase cur
      when $AM_STMT then
         if ~void(cur.next) and branch<999999 then 
	    stack.push(#AM_CURSOR_POS(cur,mark,999999));
	    mark:=false;
	    return cur.next; 
	 end;
      else 
      end;
      return void;
   end;

   next! is loop n::=next!; yield; end; end;
   next!:$AM is
      if started and void(cur) then init_next; end;
      loop
         n::=next;
	 if void(n) then quit; else yield n; end;
      end;
   end;
   
   init_next is
      loop
	 while!(~stack.is_empty);
	 p::=stack.pop;
      end;
      cur:=void;
      mark:=false;
      indent:=0;
      loops:=0;
      started:=false;
   end;

   next_stmt is d::=next_stmt; end;
   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.
      if void(cur) then return void; end;
      tcur::=cur;
      typecase tcur 
      when $AM_STMT then
         if void(tcur.next) then 
	    surr_stmt;
	    return next_stmt;
	 else
	    stack.push(#AM_CURSOR_POS(cur,mark,999999));
	    cur:=tcur.next;
	    mark:=false;
	    return cur;
	 end;
      else
         #OUT+"calling AM_CURSOR::next_stmt and cur is not a $STMT!\n";
	 UNIX::exit(-1);
	 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;
   next:$AM is
      if ignore_next then
         ignore_next:=false;
	 return cur;
      end;
      branch::=0;
      n:$AM;
      assert((~void(cur) and started) or (void(cur) and ~started));
      started:=true;

      n:=void;
      -- if the current AM node was not in order, we check for the
      -- childern
      if void(cur) then
         cur:=top;
	 mark:=false;
	 n:=cur;
      elsif ~in_order(cur) then
	 n:=next_branch(cur,0);
      else
	 -- if it is an AM_STMT, we have to return the last child, namely
	 -- the next statment NOW (this last child is not returned in
	 -- preorder like the other ones are)
         tcur::=cur;
	 typecase tcur when $AM_STMT then
	    n:=next_branch(cur,999998);
	    branch:=0;
	 else end;
      end;
      loop while!(void(n));
	 if stack.size=0 then cur:=void;return void; end;
	 s::=stack.pop;
	 branch:=s.branch;
	 tcur::=s.stmt;
	 typecase tcur when AM_LOOP_STMT then if branch=2 then loops:=loops-1;end;else end;
	 if branch<999999 then indent:=indent-1; end;
	 cur:=s.stmt;
	 mark:=s.mark;
	 n:=next_branch(cur,branch);
	 if in_order(cur) then
	    if ~void(n) and stack.top.branch=999999 then
	       d::=stack.pop;
	       return cur;
	    elsif void(n) and branch/=999999 then return cur; end;
	 end;
	 branch:=0;
      end;
      loop
	 if in_order(n) then
	    m::=next_branch(n,branch);
	    if void(m) or stack.top.branch=999999 then
	       if ~void(m) then 
	          d::=stack.pop; 
	       end;
	       cur:=n;
	       return n;
	    else
	       -- indent:=indent+1;
	       n:=m;
	       branch:=0;
	    end;
	 else
	    cur:=n;
	    return n;
	 end;
      end;
   end;

   pop_stack is d::=pop_stack; end;
   pop_stack:AM_CURSOR_POS is
      if stack.size=0 then cur:=void;return void; end;
      s::=stack.pop;
      st::=s.stmt;
      if s.branch<999999 then indent:=indent-1; end;
      cur:=s.stmt;
      mark:=s.mark;
      typecase st
      when $AM_STMT then
	 if s.branch<999999 then
	    tcur::=cur;
	    typecase tcur
	    when AM_LOOP_STMT then 
	       if s.branch>1 then loops:=loops-1;end;
	    else end;
	 end;
      else end;
      return s;
   end;

   surr_stmt is 
      tmcur::=cur;
      loop
	 if stack.size=0 then cur:=void;return; end;
	 s::=stack.pop;
	 st::=s.stmt;
	 if s.branch<999999 then indent:=indent-1; end;
	 typecase st
	 when $AM_STMT then
	    if s.branch<999999 then
	       cur:=s.stmt;
	       mark:=s.mark;
	       tcur::=cur;
	       typecase tcur
	       when AM_LOOP_STMT then 
	          if s.branch>1 then loops:=loops-1;end;
		  return;
	       when $AM_STMT then return;
	       end;
	       #OUT+"Internal Compiler Error 10098\n";
	       UNIX::exit(1);
	    end;
	 else end;
      end;
   end;

   innermost_loop is 
      cur_loop::=loops;
      loop
	 surr_stmt;
         am::=cur;
	 if void(am) then #OUT+"oops, searching nonexisting loop!\n";UNIX::exit(1); end;
	 if cur_loop/=loops then return; end;
	 -- 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;
      typecase tcur when AM_IF_STMT then
	 if void(tcur.if_false) then
	    if void(tcur.if_true) then 
	       if void(tcur.test) then return; 
	       else
		  stack.push(#AM_CURSOR_POS(cur,mark,1));
	       end;
	    else
	       stack.push(#AM_CURSOR_POS(cur,mark,2));
	    end;
	 else
	    stack.push(#AM_CURSOR_POS(cur,mark,3));
	 end;
	 cur:=#AM_COMMENT_STMT(void);
	 mark:=false;
	 indent:=indent+1; -- xxxx
      else 
         #OUT+"Internal Compiler Error 0997\n";
	 UNIX::exit(1);
      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;
      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
	    if void(tcur.init) then return; end;
	    stack.push(#AM_CURSOR_POS(cur,mark,1));
	 else
	    stack.push(#AM_CURSOR_POS(cur,mark,2));
	 end;
	 indent:=indent+1; -- xxxx
	 cur:=#AM_COMMENT_STMT(void);
	 mark:=false;
      else 
         #OUT+"Internal Compiler Error 0997\n";
	 UNIX::exit(1);
      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;
      typecase tcur when AM_LOOP_STMT then
         if void(tcur.init) then return; end;
	 -- 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));
	 indent:=indent+1; -- xxxx
	 cur:=#AM_COMMENT_STMT(void);
	 mark:=false;
      else 
         #OUT+"Internal Compiler Error 0998\n";
	 UNIX::exit(1);
      end;
   end;

   get_surr_stmt:$AM_STMT is
      c:SAME:=#(self);
      c.surr_stmt;
      t::=c.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!;
	 if a.mark then break!; end;
	 if a.branch<999999 then a.mark:=true; end;
      end;
      mark:=true;
   end;

   private adjust_stack is
   -- only called by back to mark to adjust the stack
   -- such that it works even if the current node
   -- is one that is returned as "in_eval_order"
      loop
         while!(in_order(cur));
	 n::=next_branch(cur,0);
	 if void(n) then return; end;
	 if stack.top.branch=999999 then
	    d::=stack.pop;
	    return;
	 end;
	 cur:=n;
      end;
   end;

   back_to_mark is
      if debug then 
	 #OUT+"before executing back_to_mark. Current position: \n"+str;
      end;
      if mark then return; end;
      loop
	 while!(stack.size>0);
         a::=stack.top;
	 if a.mark then break!; end;
	 pop_stack;
	 mark:=false;
      end;
      if stack.size=0 then 
	 init_next; 
      else 
	 adjust_stack; 
      end;
      ignore_next:=~void(cur);
      if debug then 
	 #OUT+"after executing back_to_mark. Current position: \n"+str;
      end;
   end;

   back_to_mark_or_loop is
      if debug then 
	 #OUT+"before executing back_to_mark_or_loop. Current position: \n"+str;
      end;
      if mark then return; end;
      loop
	 while!(stack.size>0);
         a::=stack.top;
	 s::=a.stmt;
	 typecase s when AM_LOOP_STMT then break!; else end; 
	 if a.mark then break!; end;
	 pop_stack;
	 mark:=false;
      end;
      if stack.size=0 then 
	 init_next; 
      else 
	 adjust_stack; 
      end;
      ignore_next:=~void(cur);
      if debug then 
         #OUT+"after executing back_to_mark. Current position: \n"+str+"============\n";
      end;
   end;

   has_iter_call(am:$AM):BOOL is
      c::=#AM_CURSOR(prog,am);
      loop
         t::=c.next!;
	 typecase t 
	 when AM_ITER_CALL_EXPR then return true;
	 when AM_BND_ITER_CALL_EXPR then return true;
	 else end;
      end;
      return false;
   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;
   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 void(cur) or SYS::tp(cur)/=SYS::tp(#AM_LOCAL_EXPR(void))
   is
      -- store current position
      debug:=prog.opt_debug;
      if debug then 
	 #OUT+"insert_after_mark starting\n";
	 #OUT+"self="+str;
	 #OUT+"am=";AM_OUT::AM_one_stmt(am);
	 #OUT+"\nweight="+weight+"   after_prefetch="+after_prefetch+"\n";
      end;

      cstore::=#AM_CURSOR(self);
      if has_iter_call(am) then
	 if debug then 
	    #OUT+"HAS_ITER_CALL: has iter call\n";
	 end;
         back_to_mark_or_loop
      else
         back_to_mark;
      end;
      debug:=false;
      first_try::=true;
      loop
         if debug then #OUT+"LOOP, self="+self.str;end;--OUT
	 if cstore=self then return false; end;
	 cstore.debug:=prog.opt_debug;
	 typecase am
	 when AM_PREFETCH_STMT then
	    until!(cstore.is_exec_after_and_const_from_there(self,am.src) 
	           and cstore.is_not_used_in(#(self),am.dest));
	 else
            until!(cstore.is_exec_after_and_const_from_there(self,am));
	 end;
	 cstore.debug:=false;
	 if debug then--OUT
            #OUT+"LOOP2, self="+self.str;--OUT
	    n::=next!;--OUT
	    #OUT+"IAM: ";--OUT
	    loop indent.times!; #OUT+" "; end;--OUT
	    #OUT+SYS::str_for_tp(SYS::tp(n))+"\n";--OUT
	 else--OUT
	    next!;
	 end;--OUT
	 first_try:=false;
      end;
      
      cstore.debug:=false;
      w::=cstore.weight_after(self);
      if debug then #OUT+"WEIGHT: "+w+"\n"; end;--OUT
      if w>=weight then 
	 if after_prefetch then 
	    loop
	       tcur::=cur;
	       typecase tcur when $AM_STMT then
	          tcur2::=tcur.next;
		  typecase tcur2 when AM_PREFETCH_STMT then next_stmt;
		  else break!;
		  end;
	       else break!;
	       end;
	    end;
	 end;
	 debug:=prog.opt_debug;
	 -- if the current node is an AM_STMT (but not an AM_ASSIGN_STMT)
	 -- we can (actually, we must) insert the statement before, 
	 -- otherwise after.
	 t::=cur;
	 typecase t 
	 when AM_ASSIGN_STMT then insert_stmt_after(am);
	 when $AM_STMT then insert_stmt_before(am);
	 else insert_stmt_after(am);
	 end;
	 debug:=false;
	 if SYS::id(cstore.top)/=SYS::id(top) then
	    cstore.top:=top;
	 end;
	 d::=find_node(cstore.cur);
	 assert(d);
	 -- when prefetching we may be at the wrong place, (the am of the 
	 -- prefetch statement) instead of the correct one. So we may have
	 -- to search again.
	 if SYS::id(cstore.stack.top.stmt)/=SYS::id(stack.top.stmt) then 
	    d:=find_node(cstore.cur);
	 end;
	 return true;
      end;
      d::=find_node(cstore.cur);
      assert(d);
      adjust_marks_on_stack(cstore);

      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!;
         loop
	    sf::=stack.top!;
	    if SYS::id(sf.stmt)=SYS::id(orig.stmt) and sf.branch=orig.branch then
	       sf.mark:=orig.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;
      end;
      -- restart over from beginning
      init_next;
      loop 
         if (SYS::id(next!)=SYS::id(am)) then return true; end;
      end;
      return false;
   end;

   weight_after(cc:AM_CURSOR):INT 
   pre with_side_effects
   is
      if debug then --OUT
         #OUT+"WEIGHT CALCULATION: self=\n"+str+"c="+cc.str;--OUT
      end;--OUT
      c::=#AM_CURSOR(cc);
      w::=0;
      loop
	 until!(c=self);
         am::=c.next!;
	 if debug then--OUT
	    #OUT+"WW: ";--OUT
	    loop c.indent.times!; #OUT+" "; end;--OUT
	    #OUT+SYS::str_for_tp(SYS::tp(am))+"\n"+c.str;--OUT
	 end;--OUT
	 typecase am
	 when AM_ROUT_CALL_EXPR then
	    w:=w+am.fun.get_se_context(prog).weight;
	 when AM_ITER_CALL_EXPR then
	    w:=w+am.fun.get_se_context(prog).weight;
	 when AM_BND_ROUT_CALL_EXPR then
	    w:=w+100; -- we could take the average, but this is faster
	 when AM_BND_ITER_CALL_EXPR then
	    w:=w+100; -- we could take the average, but this is faster
	 when AM_LOOP_STMT then
	    w:=w+10;
	 when AM_WAITFOR_STMT then
	    w:=w+10;
	 when AM_PREFETCH_STMT then
	    w:=w+10;
	 when AM_AT_EXPR then 
	    w:=w+2;
	 else end;
	 w:=w.min(100000);
      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!;
         if a.branch<999999 and SYS::tp(a.stmt)=t then return a.stmt; end;
      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!;
	 s::=a.stmt;
	 typecase s when AM_LOOP_STMT then
	    if a.branch>1 and a.branch<999999 then return s; end;
	 else end;
      end;
      return void;
   end;

   waitfor_stmt:AM_WAITFOR_STMT is
      a::=find_stmt(SYS::tp(#AM_WAITFOR_STMT(void)));
      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)));
      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)));
      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!;
	 s::=a.stmt;
	 if a.branch<999999 then
	    typecase s 
	    when AM_LOOP_STMT then
	       if a.branch>1 then return s; end;
	    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 debug 
      -- then #OUT+"CURSOR: replace_stmt, before replacing:\n"+str;end;
      tcur:$AM_STMT;
      tc::=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";
	 UNIX::exit(-1);
      end;

      last:$AM_STMT;
      if ~void(am) then
	 last:=am;
	 loop while!(~void(last.next));
	    last:=last.next;
	 end;
	 last.next:=tcur.next;
      end;

      if SYS::id(top)=SYS::id(cur) then
         if void(am) then
	    top:=tcur.next;
	 else
	    top:=am;
	 end;
	 init_next;
	 return;
      end; 

      cur:=am;
      ignore_next:=true;
      f::=stack.top.stmt;
      branch::=stack.top.branch;
      if branch=999999 then
         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;
      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;
	 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;
      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;
	 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;
      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;
	 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;
	 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;
      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;
	 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;
         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;
	 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;
	 end;
      when AM_ITER_CALL_EXPR 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; 
	 end;
      when AM_BND_ITER_CALL_EXPR then
	 if branch=2 then 
	    if void(am) then 
	       f.init:=f.init.next;cur:=f.init;ignore_next:=true; else f.init:=am; 
	    end; end;
      when AM_STMT_EXPR then
	 if branch=1 then 
	    if void(am) then 
	       f.stmts:=f.stmts.next; else f.stmts:=am; 
	 end; end;
      when AM_LOCK_STMT then
	 b::=branch;
	 b:=b-f.guards.size-1;
	 loop
	    l::=f.locks.elt!;
	    b:=b-l.size;
	 end;
	 if f.stmts.size>b then
	    if ~void(f.stmts[b]) then
	       if void(am) then 
	          f.stmts[b]:=f.stmts[b].next;cur:=f.stmts[b];ignore_next:=true; 
	       else 
		  f.stmts[b]:=am;
	       end;
	    end;
	 end;
	 b:=b-f.stmts.size;
	 if b=0 and ~void(f.else_stmts) 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;
	 end;
      when AM_WITH_NEAR_STMT then
         if branch=f.objects.size+1 then 
	    if void(am) then
	       f.near_part:=f.near_part.next;cur:=f.near_part;ignore_next:=true; 
	    else 
	       f.near_part:=am;
	    end;
	 elsif branch=f.objects.size+2 then
	    if void(am) then
	       f.else_part:=f.else_part.next;cur:=f.else_part;ignore_next:=true; 
	    else 
	       f.else_part:=am;
	    end;
	 end;
      when AM_FORK_STMT then
	 if branch=2 then 
	    if void(am) then 
	       f.body:=f.body.next;cur:=f.body;ignore_next:=true; 
	    else f.body:=am; 
	    end;
	 end;
      when AM_PAR_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;
	 end;	 
      end;
	 
      if void(cur) then -- cur may not stay void, so we invent a statement
         cur:=#AM_COMMENT_STMT(void);
	 ignore_next:=false;
      end;
      -- if debug then #OUT+"CURSOR: replace_stmt, after replacing:\n"+str;end;
   end;

   replace_expr(w:$AM_EXPR) is
      -- if debug then #OUT+"CURSOR: replace_expr, before replacing:\n"+str;end;
      if void(stack) or stack.size=0 then
         top:=w;
	 cur:=w;
	 return;
      end;
      am::=stack.top.stmt;
      branch::=stack.top.branch;
      cur:=w;
      mark:=false;
      typecase am
      when AM_WAITFOR_STMT then 
         if branch=1 then am.dest:=w; end;
         if branch=2 then am.src:=w; end;
         if branch=3 then 
	    typecase w when AM_LOCAL_EXPR then am.prefetch:=w; end;
	 end;
      when AM_PREFETCH_STMT then 
         if branch=1 then am.dest:=w; end;
         if branch=2 then am.src:=w; end;
         if branch=3 then 
	    typecase w when AM_LOCAL_EXPR then am.prefetch:=w; end;
	 end;
      when AM_ASSIGN_STMT then 
         if branch=1 then am.dest:=w; end;
         if branch=2 then am.src:=w; end;
      when AM_IF_STMT then 	 if branch=1 then am.test:=w; end;
      when AM_RETURN_STMT then 	 if branch=1 then am.val:=w; end;
      when AM_YIELD_STMT then 	 if branch=1 then am.val:=w; end;
      when AM_CASE_STMT then 	 if branch=1 then am.test:=w; end;
      when AM_TYPECASE_STMT then 
	 if branch=1 then 
	    typecase w
	    when AM_LOCAL_EXPR then
	       am.test:=w; 
	    else
	       #OUT+"internal error: replacing AM_LOCAL_EXPR of typecase with "+SYS::str_for_tp(SYS::tp(w))+"\n";
	       UNIX::exit(1);
	    end;
	 end;
      when AM_PRE_STMT then 	 if branch=1 then am.test:=w; end;
      when AM_POST_STMT then 	 if branch=1 then am.test:=w; end;
      when AM_ASSERT_STMT then 	 if branch=1 then am.test:=w; end;
      when AM_RAISE_STMT then 	 if branch=1 then am.val:=w; end;
      when AM_EXPR_STMT then 	 if branch=1 then am.expr:=w; end;

      -- pSather
      when AM_LOCK_STMT then
	 b::=branch;
      	 if branch<=am.guards.size then
	    am.guards[branch-1]:=w;
	 else
	    b:=b-am.guards.size-1;
	    loop
	       l::=am.locks.elt!;
	       if l.size>b then
		  l[b]:=w;
		  break!;
	       end;
	       b:=b-l.size;
	    end;
	 end;
      when AM_ATTACH_STMT then
	 if branch=1 then am.at:=w; end;
      when AM_FORK_STMT then 
	 if branch=1 then am.at:=w; end;
      when AM_UNLOCK_STMT then
	 if branch=1 then am.lock_ob:=w; end;
      when AM_WITH_NEAR_STMT then
         if branch<=am.objects.size then
	    am.objects[branch-1]:=w;
	 end;

      -- CALLS
      when AM_CALL_ARG then 	 if branch=1 then am.expr:=w; end;
      when AM_ROUT_CALL_EXPR then
	 am[branch-1].expr:=w;
      when AM_EXT_CALL_EXPR then
	 am[branch-1].expr:=w;
      when AM_ITER_CALL_EXPR then
	 am[branch-2].expr:=w;
      when AM_BND_ROUT_CALL_EXPR then
	 if branch=1 then
	    am.br:=w;
	 else
	    am[branch-2].expr:=w;
	 end;
      when AM_BND_ITER_CALL_EXPR then
	 if branch=1 then
	    am.bi:=w;
	 else
	    am[branch-3].expr:=w;
	 end;

      -- EXPRESSIONS
      when AM_ARRAY_EXPR then 
	 am[branch-1]:=w;
      when AM_BND_CREATE_EXPR then 
	 am[branch-1].expr:=w;
      when AM_IF_EXPR then 
	 if branch=1 then am.test:=w;    end;
	 if branch=2 then am.if_true:=w; end;
	 if branch=3 then am.if_false:=w;end;
      when AM_NEW_EXPR then 
	 if branch=1 then am.asz:=w;end;
      when AM_IS_VOID_EXPR then
	 if branch=1 then am.arg:=w;end;
      when AM_SHARED_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;
      when AM_VATTR_ASSIGN_EXPR then
	 if branch=1 then am.ob:=w;end;
	 if branch=2 then am.val:=w;end;
      when AM_VARR_ASSIGN_EXPR then
	 if branch=1 then am.ob:=w;end;
	 if branch=2 then am.ind:=w;end;
	 if branch=3 then am.val:=w;end;
      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;
      	 if branch=2 then am.expr:=w;end;

      -- pSather expr
      when AM_WHERE_EXPR then
	 if branch=1 then am.arg:=w;end;
      when AM_FAR_EXPR then
	 if branch=1 then am.arg:=w;end;
      when AM_NEAR_EXPR then
	 if branch=1 then am.arg:=w;end;
      when AM_AT_EXPR then
	 if branch=1 then am.at:=w;end;
	 if branch=2 then am.e:=w;end;
      end;
      if void(cur) then -- the current expression has been replaced with void.
      			-- but cur may not stay void, so we assign a dummy expression.
			-- the next next! will 
	 t:$TP;
	 cur:=#AM_EXCEPT_EXPR(t);
      end;

      -- if debug then #OUT+"CURSOR: replace_expr, after replacing:\n"+str;end;
   end;

   insert_stmt_before(am:$AM_STMT) is 
      if debug then #OUT+"CURSOR: insert_stmt_before, before inserting:\n"+str;end;--OUT
      tcur::=cur;
      typecase tcur
      when AM_CALL_ARG then
         se::=#AM_STMT_EXPR(void);
	 se.stmts:=am;
	 se.expr:=tcur.expr;
	 tcur.expr:=se;
      when $AM_EXPR then
         se::=#AM_STMT_EXPR(void);
	 se.stmts:=am;
	 se.expr:=tcur;
	 replace_expr(se);
         cur:=next_branch(se,1);
	 mark:=false;
      else
      	 insert_stmt_before_stmt(am);
      end;
      if debug then #OUT+"CURSOR: insert_stmt_before, after inserting:\n"+str;end;--OUT
   end;

   insert_stmt_after(am:$AM_STMT) is 
      if debug then --OUT
         #OUT+"CURSOR: insert_stmt_after, inserting ";AM_OUT::AM_out(am);--OUT
         #OUT+"\nbefore inserting:\n"+str;--OUT
      end;--OUT
      -- if we are a call arg, move to the expression of the call arg
      tcur:$AM;
      loop
         tcur:=cur;
	 typecase tcur when AM_CALL_ARG then next; else break!; end;
      end;
      typecase tcur
      when $AM_EXPR then
	 c::=#AM_CURSOR(self);
	 c.cur:=#AM_STMT_EXPR(void); -- create bogus expression to ensure that next moves
				     -- 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;
	 c.insert_stmt_before(am);
      else
      	 insert_stmt(cur,999999,am);
      end;
      if debug then #OUT+"CURSOR: insert_stmt_after, after inserting:\n"+str;end;--OUT
   end;

   private insert_stmt(am:$AM,branch:INT,w:$AM_STMT) is
      last::=w;loop while!(~void(last.next));last:=last.next;end;
      if void(am) then
         tmp::=top;
	 typecase tmp
	 when $AM_STMT then last.next:=tmp;
	 end;
	 top:=w;
	 return;
      end;
      typecase am
      when $AM_STMT then
	 if branch=999999 then
	    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;
         if branch=3 then last.next:=am.if_false;am.if_false:=w;end;
      when AM_LOOP_STMT then 
         if branch=1 then last.next:=am.init;am.init:=w;end;
         if branch=2 then last.next:=am.body;am.body:=w;end;
      when AM_CASE_STMT then 
	 if branch=am.stmts.size+2 then 
	    last.next:=am.else_stmts;am.else_stmts:=w;
	 else;
	    last.next:=am.stmts[branch-2];am.stmts[branch-2]:=w;
	 end;
      when AM_TYPECASE_STMT then 
	 if branch=am.stmts.size+2 then 
	    last.next:=am.else_stmts;am.else_stmts:=w;
	 else
	    last.next:=am.stmts[branch-2];am.stmts[branch-2]:=w;
	 end;
      when AM_INITIAL_STMT then 
         if branch=1 then last.next:=am.stmts;am.stmts:=w;end;
      when AM_PROTECT_STMT then 
         if branch=1 then 
	    last.next:=am.body;am.body:=w; 
	 elsif branch=am.stmts.size+2 then
	    last.next:=am.else_stmts;am.else_stmts:=w; 
	 else
	    last.next:=am.stmts[branch-2];am.stmts[branch-2]:=w;
	 end;
      when AM_STMT_EXPR then
         if branch=1 then
	    last.next:=am.stmts;
	    am.stmts:=w;
	 end;
      else
         #OUT+"Trying to insert a statement, but this does not work:\n";
	 #OUT+"Statement to be inserted:\n";
	 AM_OUT::AM_out(w);
	 #OUT+"Trying to insert at the following position:\n";
	 #OUT+"$AM: "+SYS::str_for_tp(SYS::tp(am))+"   branch="+branch+"\n";
	 AM_OUT::AM_out(am);
	 UNIX::exit(-1);
      end;
   end;

   insert_stmt_before_stmt(am:$AM_STMT) is 
      -- if 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};
      branch::=0;
      loop
	 tcur::=cur;
         typecase tcur
	 when $AM_STMT then break!;
	 else end;
	 tst.push(#AM_CURSOR_POS(cur,mark,branch));
	 if stack.size=0 then -- inserting it as first of function
	    -- #OUT+"Internal error 98871: stack size 0, statement not found!\n";
	    -- UNIX::exit(1);
	    t::=top;
	    typecase t when $AM_STMT then
	       am.next:=t;
	    end;
	    top:=am;
	    init_next;
	    return;
	 end;
	 s::=stack.pop;
	 cur:=s.stmt;
	 mark:=s.mark;
	 branch:=s.branch;
      end;
      tst.push(#AM_CURSOR_POS(cur,mark,branch));
      if stack.size=0 then
         insert_stmt(void,0,am);
      else
         s::=stack.pop;
         insert_stmt(s.stmt,s.branch,am);
         stack.push(s);
      end;
      aml::=am;
      loop
	 assert ~void(aml);
	 while!(SYS::id(aml)/=SYS::id(tst.top.stmt));
	 stack.push(#AM_CURSOR_POS(aml,false,999999));
	 aml:=aml.next;
      end;
      loop
         while!(tst.size>0);
	 stack.push(tst.pop);
      end;
      s::=stack.pop;
      cur:=s.stmt;
      mark:=s.mark;
      -- if 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;
       if debug then --OUT
 	 #OUT+"CURSOR: Deleting current object, before deleting:\n"+str;--OUT
 	 AM_OUT::AM_out(top);--OUT
       end;--OUT
      typecase tcur 
      when $AM_STMT then
	 t::=tcur.next;
	 tcur.next:=void;
         if debug then--OUT
	    #OUT+"object to delete:\n";--OUT
	    AM_OUT::AM_out(tcur);--OUT
	 end;--OUT
         replace_stmt(t);
      when $AM_EXPR then
         if debug then--OUT
	    #OUT+"object to delete:\n";--OUT
	    AM_OUT::AM_out(tcur);--OUT
	    #OUT+"\n";--OUT
	 end;--OUT
         replace_expr(void);
      else
         #OUT+"Internal Compiler Error 882\n";
	 UNIX::exit(-1);
      end;
       if debug then --OUT
 	 #OUT+"CURSOR: Deleting current object, after deleting:\n"+str;--OUT
 	 AM_OUT::AM_out(top);--OUT
       end;--OUT
   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 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 debug then #OUT+"CURSOR: insert stmt before loop, after inserting:\n"+str;end;
   end;

   insert_in_loop_init(am:$AM_STMT) is
      -- if debug then #OUT+"CURSOR: insert stmt in loop init, before inserting:\n"+str;end;
      lp::=loop_stmt;
      if void(loop_stmt.init) then
         loop_stmt.init:=am;
	 return;
      else
	 loop_stmt.init.append(am);
      end;
      -- if 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.next:=void;
     if void(lp) then
        loop_stmt.body:=am;
     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};
      r.cur:=void;
      r.top:=am;
      r.loops:=0;
      r.indent:=0;
      r.prog:=prog;
      r.started:=false;
      r.calls_in_eval_order:=true;
      tmp::=prog.get_options;
      typecase tmp when CS_OPTIONS then r.with_side_effects:=tmp.side_effects;
      else r.with_side_effects:=false;
      end;
      return r;
   end;

   create(c:SAME):SAME is
      r::=new;
      r.stack:=#A_STACK{AM_CURSOR_POS};
      r.cur:=c.cur;
      r.mark:=c.mark;
      r.top:=c.top;
      r.loops:=c.loops;
      r.indent:=c.indent;
      r.debug:=c.debug;
      r.prog:=c.prog;
      r.with_side_effects:=c.with_side_effects;
      r.started:=c.started;
      r.ignore_pre:=c.ignore_pre;
      r.ignore_post:=c.ignore_post;
      r.ignore_assert:=c.ignore_assert;
      r.assign_in_order:=c.assign_in_order;
      r.calls_in_eval_order:=c.calls_in_eval_order;
      r.all_in_eval_order:=c.all_in_eval_order;
      r.all_in_pre_order:=c.all_in_pre_order;
      loop
         r.stack.push(c.stack.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;
      #OUT+"------------------------------------\n";
      loop
	 c::=next!;
         loop indent.times!; #OUT+" "; end;
	 #OUT+SYS::str_for_tp(SYS::tp(c))+"\n";
      end;
      #OUT+"------------------------------------\n";
   end;
end;
-- vim:sw=3:nosmartindent
