side_effect.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
---------------------------> Sather 1.1 source file <--------------------------
class SIDE_EFFECT < $HASH
class SIDE_EFFECT < $HASH is
include COMPARABLE;
attr tp:$TP; -- The class modified
attr name:IDENT; -- The name of the attribute, void(IDENT) for arrays
attr doeswrite:BOOL; -- Is this attribute written to?
-- are these two refrences to the same object?
-- don't check the doeswrite flag
is_eq(other:SAME):BOOL is
if void(self) or void(other) then return false end;
if is_array then-- SIDE_EFFECT::is_array
return(other.is_array and tp.is_eq(other.tp));-- SIDE_EFFECT::is_array SIDE_EFFECT::tp SIDE_EFFECT::tp
elsif is_local then-- SIDE_EFFECT::is_local
return(other.is_local and name.is_eq(other.name));-- SIDE_EFFECT::is_local SIDE_EFFECT::name IDENT::is_eq SIDE_EFFECT::name
else
return(tp.is_eq(other.tp) and name.is_eq(other.name));-- SIDE_EFFECT::tp SIDE_EFFECT::tp SIDE_EFFECT::name IDENT::is_eq SIDE_EFFECT::name
end;
end;
is_neq(other:SAME):BOOL is
return(~is_eq(other));
end;
-- this function is used to mainatin the FSET, combine the hash functions
-- of our refrences
hash:INT is
if is_array then return(tp.str.hash);-- SIDE_EFFECT::is_array SIDE_EFFECT::tp STR::hash
elsif is_local then return(name.hash);-- SIDE_EFFECT::is_local SIDE_EFFECT::name IDENT::hash
else return(tp.str.hash.bxor(name.hash));-- SIDE_EFFECT::tp STR::hash INT::bxor SIDE_EFFECT::name IDENT::hash
end;
end;
-- is this a local variable?
is_local:BOOL is
return void(tp);-- SIDE_EFFECT::tp
end;
-- is this an array refrence?
is_array:BOOL is
return void(name);-- SIDE_EFFECT::name
end;
create:SAME is return new; end;
-- here is our create function
create(amattr:$OB,doeswrite:BOOL):SAME is
r::=new;
r.doeswrite := doeswrite;-- SIDE_EFFECT::doeswrite
typecase amattr
when AM_ATTR_EXPR then
r.tp := amattr.self_tp;-- SIDE_EFFECT::tp AM_ATTR_EXPR::self_tp
r.name := amattr.at;-- SIDE_EFFECT::name AM_ATTR_EXPR::at
assert(~void(r.name));-- SIDE_EFFECT::name BOOL::not
assert(~void(r.tp));-- SIDE_EFFECT::tp BOOL::not
when AM_VATTR_ASSIGN_EXPR then
r.tp := amattr.ob.tp;-- SIDE_EFFECT::tp AM_VATTR_ASSIGN_EXPR::ob
r.name := amattr.at;-- SIDE_EFFECT::name AM_VATTR_ASSIGN_EXPR::at
assert(~void(r.name));-- SIDE_EFFECT::name BOOL::not
assert(~void(r.tp));-- SIDE_EFFECT::tp BOOL::not
assert(doeswrite);
when AM_GLOBAL_EXPR then
r.tp := amattr.class_tp;-- SIDE_EFFECT::tp AM_GLOBAL_EXPR::class_tp
r.name := amattr.name;-- SIDE_EFFECT::name AM_GLOBAL_EXPR::name
assert(~void(r.name));-- SIDE_EFFECT::name BOOL::not
assert(~void(r.tp));-- SIDE_EFFECT::tp BOOL::not
when AM_LOCAL_EXPR then
-- don't remember unnamed local variable
if void(amattr.name) then return void end; -- AM_LOCAL_EXPR::name
r.tp := void;-- SIDE_EFFECT::tp
r.name := amattr.name;-- SIDE_EFFECT::name AM_LOCAL_EXPR::name
when SIDE_EFFECT then
r.tp := amattr.tp;-- SIDE_EFFECT::tp SIDE_EFFECT::tp
r.name := amattr.name;-- SIDE_EFFECT::name SIDE_EFFECT::name
end;
return r;
end;
-- return a string for debugging
str:STR is
ret::="";
if ~is_local then-- SIDE_EFFECT::is_local BOOL::not
ret:= ret+tp.str;-- SIDE_EFFECT::tp
end;
if is_array then-- SIDE_EFFECT::is_array
ret := ret+ "[]";-- STR::plus
else
ret := ret + ":" + name.str;-- STR::plus SIDE_EFFECT::name IDENT::str
end;
if doeswrite then ret := ret + "*" end;-- SIDE_EFFECT::doeswrite STR::plus
return ret;
end;
end;
-- each side_effect context (routine, loop) carries one of these around
-- with them.
class SE_CONTEXT
class SE_CONTEXT is
private attr set:FSET{SIDE_EFFECT}; -- the set of attributes modified
private attr is_full:BOOL; -- do we assume everything is modified
attr unsafe:BOOL; -- is it unsafe to optimize this function out?
attr has_raise:BOOL; -- true if the function (or any function it calls) may raise an exception
attr has_import:BOOL; -- true if the function (or any function it calls) makes an import
attr has_export:BOOL; -- true if the function (or any function it calls) makes an import
attr has_fatal_error:BOOL; -- true if the function (or any function it calls) may encounter a fatal error
attr has_arith_error:BOOL; -- true if the function could break if arith checks are on and it is called with the wrong arguments
attr has_yield_in_lock:BOOL; -- true if an iter has a yield inside a lock
attr may_block:BOOL; -- true if the function could block (lock)
attr rsig:SIG; -- signature of the routine this is for
attr weight:INT; -- number that defines the weight of the function
shared prog:PROG;
shared cs_options:CS_OPTIONS; -- options for the compiler
full:BOOL is return is_full or has_import or has_export; end;-- SE_CONTEXT::is_full SE_CONTEXT::has_import SE_CONTEXT::has_export
full(b:BOOL) is is_full:=b; end;-- SE_CONTEXT::is_full
-- get the typesafe options from prog and save them for quick refrence
get_options is
if ~void(cs_options) then return; end;-- SE_CONTEXT::cs_options BOOL::not
temp::=prog.get_options;-- SE_CONTEXT::prog PROG::get_options
typecase temp
when CS_OPTIONS then cs_options := temp;-- SE_CONTEXT::cs_options
end;
end;
-- what is the maximum size of a context to keep?
maxsize:INT is
return 100;
end;
-- are we supposed to compute side effects?
do_side_effects:BOOL is
if void(self) then return false end;
return ~prog.all_reached and cs_options.side_effects;-- SE_CONTEXT::prog PROG::all_reached BOOL::not SE_CONTEXT::cs_options CS_OPTIONS::side_effects
end;
-- are we debugging side effects?
do_side_debug:BOOL is
if void(self) then return false end;
return cs_options.side_debug;-- SE_CONTEXT::cs_options CS_OPTIONS::side_debug
end;
-- an iter to iterate all of the elements in the set... just pass through
elt!:SIDE_EFFECT is
loop yield(set.elt!) end;-- SE_CONTEXT::set FSET{1}::elt!
end;
-- return the number of elements in the siedeffect set
size:INT is
return set.size;-- SE_CONTEXT::set FSET{1}::size
end;
-- return the sideeffect for a given attr
se_attr(tp:$TP,name:IDENT):SIDE_EFFECT is
s::=#SIDE_EFFECT;-- SIDE_EFFECT::create
s.tp:=tp;-- SIDE_EFFECT::tp
s.name:=name;-- SIDE_EFFECT::name
return set.get(s);-- SE_CONTEXT::set FSET{1}::get
end;
-- return the sideeffect for a given local var
se_local(name:IDENT):SIDE_EFFECT is
s::=#SIDE_EFFECT;
s.tp:=void;
s.name:=name;
return set.get(s);
end;
-- return the sideeffect for arrayt
se_array(tp:$TP):SIDE_EFFECT is
s::=#SIDE_EFFECT;
s.tp:=void;
s.name:=void;
return set.get(s);
end;
-- create a new, empty, SE_CONTEXT
create(prog:PROG,sig:SIG):SAME is
r::=new;
r.prog := prog;-- SE_CONTEXT::prog
r.rsig := sig;-- SE_CONTEXT::rsig
r.get_options;-- SE_CONTEXT::get_options
if void(cs_options) then return void end;-- SE_CONTEXT::cs_options
if ~r.do_side_effects then return void end;-- SE_CONTEXT::do_side_effects BOOL::not
if r.do_side_debug then-- SE_CONTEXT::do_side_debug
#OUT + "Created context for "+sig.str+"\n";-- OUT::create OUT::plus OUT::plus SIG::str OUT::plus
end;
r.weight:=1;-- SE_CONTEXT::weight
return r;
end;
expand_macro(r:STR,sig:SIG):STR is
res::="";
i:INT:=0;
loop while!(i<r.size);-- INT::is_lt STR::size
case r[i]-- STR::aget
when '@' then
i:=i+1;-- INT::plus
case r[i] -- STR::aget
when '0' then
res:=res+sig.tp.str;-- STR::plus SIG::tp
when '1','2','3','4','5','6','7','8','9' then
l:INT:=r[i].int-'1'.int;-- STR::aget CHAR::int INT::minus CHAR::int
res:=res+sig.args[l].tp.str;-- STR::plus SIG::args ARRAY{1}::aget ARG::tp
when 'r' then
res:=res+sig.ret.str;-- STR::plus SIG::ret
when 'P' then
l:INT:=r[i].int-'0'.int;-- STR::aget CHAR::int INT::minus CHAR::int
if l<0 or l>=sig.src_tparams.size then-- INT::is_lt INT::is_lt SIG::src_tparams ARRAY{1}::size BOOL::not
prog.barf("@Pn bound error in '"+r+'\'');-- SE_CONTEXT::prog PROG::barf STR::plus STR::plus
end;
res:=res+sig.src_tparams[l].str;-- STR::plus SIG::src_tparams ARRAY{1}::aget
else
prog.barf("unknown '@' macro in CONFIG for "+sig.str+" (reads/writes)");-- SE_CONTEXT::prog PROG::barf STR::plus SIG::str STR::plus
end;
when ' ' then
else res:=res+r[i];-- STR::plus STR::aget
end;
i:=i+1;-- INT::plus
end;
return res;
end;
private get_touched_attr(a:ARRAY{STR},doeswrite:BOOL) is
if void(a) then return; end;
loop s::=expand_macro(a.elt!,rsig);-- SE_CONTEXT::expand_macro ARRAY{1}::elt! SE_CONTEXT::rsig
i::=s.search(':');-- STR::search
tpname::=s.head(i);-- STR::head
aname::=s.tail(s.size-i-2);-- STR::tail STR::size INT::minus INT::minus
-- unless tp_class_for() does not handle ROUT and ITER, we mark
-- routines that use such types as mark_full.
if tpname.search("ROUT")/=-1 or tpname.search("ITER")/=-1 then-- STR::search INT::is_eq BOOL::not STR::search INT::is_eq BOOL::not
mark_full;-- SE_CONTEXT::mark_full
return;
end;
tp::=prog.tp_tbl.tp_class_for(tpname);-- SE_CONTEXT::prog PROG::tp_tbl TP_TBL::tp_class_for
se::=#SIDE_EFFECT;-- SIDE_EFFECT::create
se.tp:=tp;-- SIDE_EFFECT::tp
if aname/="[]" then-- STR::is_eq BOOL::not
se.name:=#IDENT(aname);-- SIDE_EFFECT::name IDENT::create
end;
se.doeswrite:=doeswrite;-- SIDE_EFFECT::doeswrite
mark_se(se);-- SE_CONTEXT::mark_se
end;
end;
private get_builtin_context
pre rsig.is_builtin is-- SE_CONTEXT::rsig SIG::is_builtin
if ~do_side_effects then return end;-- SE_CONTEXT::do_side_effects BOOL::not
if rsig.builtin_info.volatile or rsig.builtin_info.reads_any -- SE_CONTEXT::rsig SIG::builtin_info CONFIG_ROUT::volatile SE_CONTEXT::rsig SIG::builtin_info CONFIG_ROUT::reads_any
or rsig.builtin_info.writes_any then-- SE_CONTEXT::rsig SIG::builtin_info CONFIG_ROUT::writes_any
mark_full;-- SE_CONTEXT::mark_full
end;
if rsig.builtin_info.fragile then-- SE_CONTEXT::rsig SIG::builtin_info CONFIG_ROUT::fragile
mark_unsafe;-- SE_CONTEXT::mark_unsafe
end;
has_import:=rsig.builtin_info.does_import;-- SE_CONTEXT::has_import SE_CONTEXT::rsig SIG::builtin_info CONFIG_ROUT::does_import
has_export:=rsig.builtin_info.does_export;-- SE_CONTEXT::has_export SE_CONTEXT::rsig SIG::builtin_info CONFIG_ROUT::does_export
has_arith_error:=rsig.builtin_info.arith;-- SE_CONTEXT::has_arith_error SE_CONTEXT::rsig SIG::builtin_info CONFIG_ROUT::arith
may_block:=rsig.builtin_info.block;-- SE_CONTEXT::may_block SE_CONTEXT::rsig SIG::builtin_info CONFIG_ROUT::block
has_raise:=~rsig.builtin_info.raises_none;-- SE_CONTEXT::has_raise SE_CONTEXT::rsig SIG::builtin_info CONFIG_ROUT::raises_none
get_touched_attr(rsig.builtin_info.reads,false);-- SE_CONTEXT::rsig SIG::builtin_info CONFIG_ROUT::reads
get_touched_attr(rsig.builtin_info.writes,true);-- SE_CONTEXT::rsig SIG::builtin_info CONFIG_ROUT::writes
end;
-- register this context with my associated signature
register is
if void(self) then return end;
-- check to see if this is a builtin safe function
if rsig.is_builtin then-- SE_CONTEXT::rsig SIG::is_builtin
get_builtin_context;-- SE_CONTEXT::get_builtin_context
end;
-- all functions and iter in OPT_DEBUG have no sideeffects per definition
if prog.opt_debug and rsig.tp.str="OPT_DEBUG" then -- SE_CONTEXT::prog PROG::opt_debug SE_CONTEXT::rsig SIG::tp STR::is_eq
mark_clean;-- SE_CONTEXT::mark_clean
has_fatal_error:=false;-- SE_CONTEXT::has_fatal_error
has_raise:=false;-- SE_CONTEXT::has_raise
end;
rsig.set_se_context(self);-- SE_CONTEXT::rsig SIG::set_se_context
if do_side_debug then-- SE_CONTEXT::do_side_debug
#OUT + "Side effects for "+rsig.str;-- OUT::create OUT::plus SE_CONTEXT::rsig SIG::str
if full then #OUT + ", full" end;-- SE_CONTEXT::full OUT::create OUT::plus
if unsafe then #OUT + ", unsafe" end;-- SE_CONTEXT::unsafe OUT::create OUT::plus
if has_raise then #OUT + ", has_raise" end;-- SE_CONTEXT::has_raise OUT::create OUT::plus
if has_fatal_error then #OUT + ", has_fatal_error" end;-- SE_CONTEXT::has_fatal_error OUT::create OUT::plus
if has_import then #OUT + ", has_import" end;-- SE_CONTEXT::has_import OUT::create OUT::plus
if has_export then #OUT + ", has_export" end;-- SE_CONTEXT::has_export OUT::create OUT::plus
if has_arith_error then #OUT + ", has_arith_error" end;-- SE_CONTEXT::has_arith_error OUT::create OUT::plus
if may_block then #OUT + ", may_block" end;-- SE_CONTEXT::may_block OUT::create OUT::plus
#OUT + "\n";-- OUT::create OUT::plus
loop
#OUT + "\t" + elt!.str + "\n";-- OUT::create OUT::plus OUT::plus SE_CONTEXT::elt! SIDE_EFFECT::str OUT::plus
end;
#OUT + "\n"; -- this is because the loop above quits mid expr.-- OUT::create OUT::plus
end;
end;
-- diagnostic output, returns a string to describe this context
str:STR is
ret::= rsig.str;
if full then
ret := ret + " full";
return ret;
end;
ret := ret+" with";
loop e::=elt!;
ret := ret + " " + e.str;
end;
return ret;
end;
-- give up with this set, and mark it is as having full side effects
mark_full is
if ~do_side_effects then return end;-- SE_CONTEXT::do_side_effects BOOL::not
full := true;-- SE_CONTEXT::full
set := void;-- SE_CONTEXT::set
unsafe := true;-- SE_CONTEXT::unsafe
end;
-- mark the current context as unsafe
mark_unsafe is
if ~do_side_effects then return end;-- SE_CONTEXT::do_side_effects BOOL::not
unsafe := true;-- SE_CONTEXT::unsafe
end;
-- clean out this set, so that it has no side effects
mark_clean is
if ~do_side_effects then return end;-- SE_CONTEXT::do_side_effects BOOL::not
full := false;-- SE_CONTEXT::full
set := void;-- SE_CONTEXT::set
unsafe := false;-- SE_CONTEXT::unsafe
has_fatal_error:=false;-- SE_CONTEXT::has_fatal_error
has_import:=false;-- SE_CONTEXT::has_import
has_export:=false;-- SE_CONTEXT::has_export
has_arith_error:=false;-- SE_CONTEXT::has_arith_error
end;
-- check to see if the given sig is cyclic
is_recursive(sig:SIG):BOOL is
return prog.generate_am.sig_recursive.test(sig);-- SE_CONTEXT::prog PROG::generate_am FSET{1}::test
end;
-- make sure that the context has been generated, and then return it
get_se_context(sig:SIG):SE_CONTEXT is
-- make sure we don't try to do this for checking code
-- a check in do_side_effects should prevent this
assert ~prog.all_reached;-- SE_CONTEXT::prog PROG::all_reached
-- make sure this sig has been generated.
-- This will do nothing if this is a cyclic or recursive call,
-- or possibly if this is a builtin call.
prog.generate_am.output_sig(sig);-- SE_CONTEXT::prog PROG::generate_am
if do_side_debug then-- SE_CONTEXT::do_side_debug
#OUT + "Looking for signature "+sig.str+"\n";-- OUT::create OUT::plus OUT::plus SIG::str OUT::plus
end;
nsec ::= sig.get_se_context(prog);-- SIG::get_se_context SE_CONTEXT::prog
if void(nsec) then
nsec := #SE_CONTEXT(prog,sig);-- SE_CONTEXT::create SE_CONTEXT::prog
if sig.is_builtin then-- SIG::is_builtin
nsec.register; -- this will notice that its a builtin and mark it-- SE_CONTEXT::register
if do_side_debug then-- SE_CONTEXT::do_side_debug
#OUT + sig.str + " is builtin.\n";-- OUT::create OUT::plus SIG::str OUT::plus
end;
elsif sig.is_neq(rsig) and is_recursive(sig) then-- SIG::is_neq SE_CONTEXT::rsig SE_CONTEXT::is_recursive
-- check for cyclic calls, but allow recursive calls
nsec.mark_full; -- this would be cyclic, so it's full-- SE_CONTEXT::mark_full
-- we have to register this signature now, else we may try
-- to generate the code that calls this routine before the
-- complete side effects have been generated (which will be
-- be full anyway...)
nsec.register;-- SE_CONTEXT::register
if do_side_debug then-- SE_CONTEXT::do_side_debug
#OUT + "Marking full because "+rsig.str+" is cyclic\n";-- OUT::create OUT::plus SE_CONTEXT::rsig SIG::str OUT::plus
end;
elsif sig.is_eq(rsig) then-- SIG::is_eq SE_CONTEXT::rsig
-- recursive calls should be marked as clean
if do_side_debug then-- SE_CONTEXT::do_side_debug
#OUT + sig.str + " is recursive.\n";-- OUT::create OUT::plus SIG::str OUT::plus
end;
else
if do_side_debug then-- SE_CONTEXT::do_side_debug
#OUT + "Unknown signature "+rsig.str+", using full\n";-- OUT::create OUT::plus SE_CONTEXT::rsig SIG::str OUT::plus
end;
nsec.mark_full;-- SE_CONTEXT::mark_full
end;
end;
return nsec;
end;
-- make the union with the given context and this context
mark_se(nsec:SE_CONTEXT) is
if ~do_side_effects then return end;-- SE_CONTEXT::do_side_effects BOOL::not
-- check for existance
if void(nsec) then return end;
has_raise:=has_raise or nsec.has_raise;-- SE_CONTEXT::has_raise SE_CONTEXT::has_raise SE_CONTEXT::has_raise
has_fatal_error:=has_fatal_error or nsec.has_fatal_error;-- SE_CONTEXT::has_fatal_error SE_CONTEXT::has_fatal_error SE_CONTEXT::has_fatal_error
has_import:=has_import or nsec.has_import;-- SE_CONTEXT::has_import SE_CONTEXT::has_import SE_CONTEXT::has_import
has_export:=has_export or nsec.has_export;-- SE_CONTEXT::has_export SE_CONTEXT::has_export SE_CONTEXT::has_export
has_arith_error:=has_arith_error or nsec.has_arith_error;-- SE_CONTEXT::has_arith_error SE_CONTEXT::has_arith_error SE_CONTEXT::has_arith_error
may_block:=may_block or nsec.may_block;-- SE_CONTEXT::may_block SE_CONTEXT::may_block SE_CONTEXT::may_block
-- has_yield_in_lock is only relevant for iters
if rsig.is_iter then-- SE_CONTEXT::rsig SIG::is_iter
has_yield_in_lock:=has_yield_in_lock or nsec.has_yield_in_lock;-- SE_CONTEXT::has_yield_in_lock SE_CONTEXT::has_yield_in_lock SE_CONTEXT::has_yield_in_lock
end;
if INT::maxint-nsec.weight<weight then-- INT::maxint INT::minus SE_CONTEXT::weight SE_CONTEXT::weight
weight:=INT::maxint;-- SE_CONTEXT::weight INT::maxint
else
weight:=weight+nsec.weight;-- SE_CONTEXT::weight SE_CONTEXT::weight INT::plus SE_CONTEXT::weight
end;
if full then return end; -- already full, don't worry about it-- SE_CONTEXT::full
-- propigate the unsafe flag
if nsec.unsafe then mark_unsafe end;-- SE_CONTEXT::unsafe SE_CONTEXT::mark_unsafe
-- check to see if adding the other set would make us full
if ((set.size + nsec.set.size) > maxsize) then-- SE_CONTEXT::set FSET{1}::size INT::plus SE_CONTEXT::set FSET{1}::size SE_CONTEXT::maxsize
if do_side_debug then-- SE_CONTEXT::do_side_debug
#OUT + "Marking full because "+rsig.str+" is too big\n";-- OUT::create OUT::plus SE_CONTEXT::rsig SIG::str OUT::plus
end;
mark_full;-- SE_CONTEXT::mark_full
else
if nsec.full then-- SE_CONTEXT::full
mark_full;-- SE_CONTEXT::mark_full
else
-- loop through all the elements in the other set and incorperate
-- them. Don't use fset.union because we want to preserve the
-- doeswrite flag ordering.
loop
mark_se(nsec.elt!);-- SE_CONTEXT::mark_se SE_CONTEXT::elt!
end;
end;
end;
end;
-- add the given side effect to this context
mark_se(nse:SIDE_EFFECT) is
-- if we don't care about side effects, then return now
if ~do_side_effects then return end;-- SE_CONTEXT::do_side_effects BOOL::not
-- check for table full, so don't worry about inserting
if full then return end;-- SE_CONTEXT::full
-- don't mark accesses to local variables
if nse.is_local then return end;-- SIDE_EFFECT::is_local
-- check to see if this refrence is already in the table
old_se::= set.get(nse); -- get the old entry for this attribute-- SE_CONTEXT::set FSET{1}::get
if set.is_elt_nil(old_se) then -- not there, so add it-- SE_CONTEXT::set FSET{1}::is_elt_nil
set := set.insert(nse);-- SE_CONTEXT::set SE_CONTEXT::set FSET{1}::insert
else -- it's already in there, so update the write flag
if (nse.doeswrite and ~old_se.doeswrite) then-- SIDE_EFFECT::doeswrite SIDE_EFFECT::doeswrite BOOL::not
set := set.insert(nse); -- this overwrites the old refrence-- SE_CONTEXT::set SE_CONTEXT::set FSET{1}::insert
end;
end;
-- update our unsafe flag if this access is a write to a non-local
if nse.doeswrite and ~nse.is_local then mark_unsafe end;-- SIDE_EFFECT::doeswrite SIDE_EFFECT::is_local BOOL::not SE_CONTEXT::mark_unsafe
if set.size > maxsize then -- is the table full now?-- SE_CONTEXT::set FSET{1}::size SE_CONTEXT::maxsize
if do_side_debug then-- SE_CONTEXT::do_side_debug
#OUT + "Marking full because " + rsig.str + " is too big.\n";-- OUT::create OUT::plus SE_CONTEXT::rsig SIG::str OUT::plus
end;
mark_full;-- SE_CONTEXT::mark_full
end;
end;
-- add the given single access to the current context
mark_se(amattr:$AM,doeswrite:BOOL) is
if ~do_side_effects then return end;-- SE_CONTEXT::do_side_effects BOOL::not
nse::=#SIDE_EFFECT(amattr,doeswrite);-- SIDE_EFFECT::create
mark_se(nse);-- SE_CONTEXT::mark_se
end;
-- add the context of the given element to the current context
mark_context(amattr:$AM) is
if ~do_side_effects then return end;-- SE_CONTEXT::do_side_effects BOOL::not
typecase amattr
when AM_ROUT_CALL_EXPR then
new_sec ::= get_se_context(amattr.fun);-- SE_CONTEXT::get_se_context AM_ROUT_CALL_EXPR::fun
mark_se(new_sec);-- SE_CONTEXT::mark_se
when AM_ITER_CALL_EXPR then
new_sec ::= get_se_context(amattr.fun);-- SE_CONTEXT::get_se_context AM_ITER_CALL_EXPR::fun
mark_se(new_sec);-- SE_CONTEXT::mark_se
when AM_EXT_CALL_EXPR then
-- unknwon external function, marking it as full
mark_full;-- SE_CONTEXT::mark_full
if do_side_debug then-- SE_CONTEXT::do_side_debug
#OUT + "Marking full because of unknown external call\n";-- OUT::create OUT::plus
end;
when AM_BND_CREATE_EXPR then
-- we don't do anything because creating a BND_EXPR is 'safe'
when AM_BND_ROUT_CALL_EXPR then
mark_full;-- SE_CONTEXT::mark_full
if do_side_debug then-- SE_CONTEXT::do_side_debug
#OUT + "Marking full because "+rsig.str+" is bound\n";-- OUT::create OUT::plus SE_CONTEXT::rsig SIG::str OUT::plus
end;
when AM_BND_ITER_CALL_EXPR then
mark_full;-- SE_CONTEXT::mark_full
if do_side_debug then-- SE_CONTEXT::do_side_debug
#OUT + "Marking full because "+rsig.str+" is bound\n";-- OUT::create OUT::plus SE_CONTEXT::rsig SIG::str OUT::plus
end;
else end;
end;
-- make an SE_CONTEXT for an abstract signature. I'm putting this
-- here for now -- but it really should be in sig.sa
get_abstract_union(for_prog:PROG,for_sig:SIG):SE_CONTEXT is
new_sec::=#SE_CONTEXT(for_prog,for_sig);-- SE_CONTEXT::create
stp:TP_CLASS;
ostp::=for_sig.tp;-- SIG::tp
typecase ostp when TP_CLASS then stp:=ostp end;
desof::=for_prog.tp_graph_abs_des.des_of(stp);-- PROG::tp_graph_abs_des TP_GRAPH_ABS_DES::des_of
loop tp::=desof.elt!;-- FSET{1}::elt!
ifc:IFC:=tp.ifc;
cs:SIG:=ifc.sig_conforming_to(for_sig);-- IFC::sig_conforming_to
nse:SE_CONTEXT:= cs.get_se_context(for_prog);-- SIG::get_se_context
-- check to see if maybe the sig is cyclic or something... ?
if void(nse) then
if do_side_debug then-- SE_CONTEXT::do_side_debug
#OUT + "Missing signature " +cs.str+"; marking full\n";-- OUT::create OUT::plus OUT::plus SIG::str OUT::plus
end;
new_sec.mark_full;-- SE_CONTEXT::mark_full
else
new_sec.mark_se(nse);-- SE_CONTEXT::mark_se
end;
end;
return new_sec;
end;
end;
-- vim:sw=3:nosmartindent