inline.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
---------------------------> Sather 1.1 source file <--------------------------
-- Copyright (C) International Computer Science Institute, 1995. COPYRIGHT --
-- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
-- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in --
-- the file "Doc/License" of the Sather distribution. The license is also --
-- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA. --
--------> Please email comments to sather-bugs@icsi.berkeley.edu. <----------
-- inline.sa: Code for inlining calls.
abstract class $INLINE_ROUT_SIG
abstract class $INLINE_ROUT_SIG is
-- Information about a signature to enable it to be inlined.
sig:SIG; -- The signature this is info for.
is_special:BOOL; -- True if the inlined code is due
-- to special purpose inlining,
-- false otherwise
inline(call:AM_ROUT_CALL_EXPR):$AM_EXPR;
-- Return a replacement for the call `call'.
end;
abstract class $INLINE_ITER_SIG
abstract class $INLINE_ITER_SIG is
-- Information about a signature to enable it to be inlined.
sig:SIG; -- The signature this is info for.
is_special:BOOL;
inline(call:AM_ITER_CALL_EXPR):$AM_EXPR;
-- Return a replacement for the call `call'.
end;
class INLINE_ATTR_READ < $INLINE_ROUT_SIG
class INLINE_ATTR_READ < $INLINE_ROUT_SIG is
-- A reference/value attribute read.
-- The signature has the form: "FOO::name:BAR".
shared inlined,routines:INT;
attr sig:SIG;
attr is_special:BOOL;
attr self_tp:$TP;
attr at:IDENT;
attr tp_at:$TP;
inline(call:AM_ROUT_CALL_EXPR):$AM_EXPR is
inlined:=inlined+1;-- INLINE_ATTR_READ::inlined INLINE_ATTR_READ::inlined INT::plus
r::=#AM_ATTR_EXPR(call.source);-- AM_ATTR_EXPR::create AM_ROUT_CALL_EXPR::source
r.ob:=call[0].expr;-- AM_ATTR_EXPR::ob AM_ROUT_CALL_EXPR::aget AM_CALL_ARG::expr
r.self_tp:=self_tp;-- AM_ATTR_EXPR::self_tp INLINE_ATTR_READ::self_tp
r.at:=at;-- AM_ATTR_EXPR::at INLINE_ATTR_READ::at
r.tp_at:=tp_at;-- AM_ATTR_EXPR::tp_at INLINE_ATTR_READ::tp_at
return r;
end;
create(am:AM_ROUT_DEF):SAME is
r::=new;
r.sig:=am.sig;-- INLINE_ATTR_READ::sig AM_ROUT_DEF::sig
r.is_special := true;-- INLINE_ATTR_READ::is_special
stmt::=am.code;-- AM_ROUT_DEF::code
typecase stmt when AM_RETURN_STMT then
val::=stmt.val;-- AM_RETURN_STMT::val
typecase val when AM_ATTR_EXPR then
r.at:=val.at;-- INLINE_ATTR_READ::at AM_ATTR_EXPR::at
r.self_tp:=val.self_tp;-- INLINE_ATTR_READ::self_tp AM_ATTR_EXPR::self_tp
r.tp_at:=val.tp_at;-- INLINE_ATTR_READ::tp_at AM_ATTR_EXPR::tp_at
end;
end;
routines:=routines+1;-- INLINE_ATTR_READ::routines INLINE_ATTR_READ::routines INT::plus
return r;
end;
end;
class INLINE_ATTR_WRITE < $INLINE_ROUT_SIG
class INLINE_ATTR_WRITE < $INLINE_ROUT_SIG is
-- A reference attribute write.
-- The signature has the form: "FOO::name(BAR)".
shared inlined,routines:INT;
attr sig:SIG;
attr is_special:BOOL;
attr self_tp:$TP;
attr at:IDENT;
attr tp_at:$TP;
inline(call:AM_ROUT_CALL_EXPR):$AM_EXPR is
inlined:=inlined+1;-- INLINE_ATTR_WRITE::inlined INLINE_ATTR_WRITE::inlined INT::plus
a::=#AM_ATTR_EXPR(call.source);-- AM_ATTR_EXPR::create AM_ROUT_CALL_EXPR::source
a.ob:=call[0].expr;-- AM_ATTR_EXPR::ob AM_ROUT_CALL_EXPR::aget AM_CALL_ARG::expr
a.self_tp:=self_tp;-- AM_ATTR_EXPR::self_tp INLINE_ATTR_WRITE::self_tp
a.at:=at;-- AM_ATTR_EXPR::at INLINE_ATTR_WRITE::at
a.tp_at:=tp_at;-- AM_ATTR_EXPR::tp_at INLINE_ATTR_WRITE::tp_at
as::=#AM_ASSIGN_STMT(call.source);-- AM_ASSIGN_STMT::create AM_ROUT_CALL_EXPR::source
as.dest:=a;-- AM_ASSIGN_STMT::dest
as.src:=call[1].expr;-- AM_ASSIGN_STMT::src AM_ROUT_CALL_EXPR::aget AM_CALL_ARG::expr
r::=#AM_STMT_EXPR(call.source); r.stmts:=as; return r end;-- AM_STMT_EXPR::create AM_ROUT_CALL_EXPR::source AM_STMT_EXPR::stmts
create(am:AM_ROUT_DEF):SAME is
r::=new;
r.sig:=am.sig;-- INLINE_ATTR_WRITE::sig AM_ROUT_DEF::sig
r.is_special := true;-- INLINE_ATTR_WRITE::is_special
stmt::=am.code;-- AM_ROUT_DEF::code
typecase stmt when AM_ASSIGN_STMT then
dest::=stmt.dest;-- AM_ASSIGN_STMT::dest
typecase dest when AM_ATTR_EXPR then
r.self_tp:=dest.self_tp;-- INLINE_ATTR_WRITE::self_tp AM_ATTR_EXPR::self_tp
r.at:=dest.at;-- INLINE_ATTR_WRITE::at AM_ATTR_EXPR::at
r.tp_at:=dest.tp_at;-- INLINE_ATTR_WRITE::tp_at AM_ATTR_EXPR::tp_at
end;
end;
routines:=routines+1;-- INLINE_ATTR_WRITE::routines INLINE_ATTR_WRITE::routines INT::plus
return r;
end;
end;
class INLINE_INT_FOLD < $INLINE_ROUT_SIG
class INLINE_INT_FOLD < $INLINE_ROUT_SIG is
-- Constant folding for INT::plus(INT):INT
shared inlined,routines:INT;
attr sig:SIG;
attr is_special:BOOL;
inline(call:AM_ROUT_CALL_EXPR):$AM_EXPR is
arg1::=call[0].expr;-- AM_ROUT_CALL_EXPR::aget AM_CALL_ARG::expr
arg2::=call[1].expr;-- AM_ROUT_CALL_EXPR::aget AM_CALL_ARG::expr
typecase arg1
when AM_INT_CONST then
typecase arg2
when AM_INT_CONST then
r::=#AM_INT_CONST(arg1.source);-- AM_INT_CONST::create AM_INT_CONST::source
r.val:=arg1.val+arg2.val;-- AM_INT_CONST::val AM_INT_CONST::val INTI::plus AM_INT_CONST::val
r.tp_at:=arg1.tp_at;-- AM_INT_CONST::tp_at AM_INT_CONST::tp_at
-- this isn't quite right if it should
-- have overflowed.
inlined:=inlined+1;-- INLINE_INT_FOLD::inlined INLINE_INT_FOLD::inlined INT::plus
return r;
else
end;
else
end;
return call;
end;
create(s:SIG):SAME is
r::=new;
r.sig:=s;-- INLINE_INT_FOLD::sig
r.is_special:=true;-- INLINE_INT_FOLD::is_special
routines:=routines+1;-- INLINE_INT_FOLD::routines INLINE_INT_FOLD::routines INT::plus
return r;
end;
end;
class INLINE_GLOBAL_READ < $INLINE_ROUT_SIG
class INLINE_GLOBAL_READ < $INLINE_ROUT_SIG is
-- A value attribute read.
-- The signature has the form: "FOO::name:BAR".
shared inlined,routines:INT;
attr sig:SIG;
attr is_special:BOOL;
attr tp_at:$TP;
attr class_tp:$TP;
attr is_const:BOOL;
attr init:$AM_EXPR;
attr name:IDENT;
attr as_type:AS_TYPE_SPEC;
inline(call:AM_ROUT_CALL_EXPR):$AM_EXPR is
inlined:=inlined+1;-- INLINE_GLOBAL_READ::inlined INLINE_GLOBAL_READ::inlined INT::plus
r::=#AM_GLOBAL_EXPR(call.source);-- AM_GLOBAL_EXPR::create AM_ROUT_CALL_EXPR::source
r.tp_at:=tp_at;-- AM_GLOBAL_EXPR::tp_at INLINE_GLOBAL_READ::tp_at
r.name := name;-- AM_GLOBAL_EXPR::name INLINE_GLOBAL_READ::name
r.class_tp:=class_tp;-- AM_GLOBAL_EXPR::class_tp INLINE_GLOBAL_READ::class_tp
r.init := init;-- AM_GLOBAL_EXPR::init INLINE_GLOBAL_READ::init
r.is_const := is_const;-- AM_GLOBAL_EXPR::is_const INLINE_GLOBAL_READ::is_const
r.as_type := as_type;-- AM_GLOBAL_EXPR::as_type INLINE_GLOBAL_READ::as_type
return r;
end;
create(am:AM_ROUT_DEF):SAME is
r::=new;
r.sig:=am.sig;-- INLINE_GLOBAL_READ::sig AM_ROUT_DEF::sig
r.is_special:=true;-- INLINE_GLOBAL_READ::is_special
stmt::=am.code;-- AM_ROUT_DEF::code
typecase stmt when AM_RETURN_STMT then
val::=stmt.val;-- AM_RETURN_STMT::val
typecase val when AM_GLOBAL_EXPR then
r.tp_at:=val.tp_at;-- INLINE_GLOBAL_READ::tp_at AM_GLOBAL_EXPR::tp_at
r.name := val.name;-- INLINE_GLOBAL_READ::name AM_GLOBAL_EXPR::name
r.class_tp:=val.class_tp;-- INLINE_GLOBAL_READ::class_tp AM_GLOBAL_EXPR::class_tp
r.init := val.init;-- INLINE_GLOBAL_READ::init AM_GLOBAL_EXPR::init
r.is_const := val.is_const;-- INLINE_GLOBAL_READ::is_const AM_GLOBAL_EXPR::is_const
r.as_type := val.as_type;-- INLINE_GLOBAL_READ::as_type AM_GLOBAL_EXPR::as_type
end;
end;
routines:=routines+1;-- INLINE_GLOBAL_READ::routines INLINE_GLOBAL_READ::routines INT::plus
return r;
end;
end;
class INLINE_VATTR_WRITE < $INLINE_ROUT_SIG
class INLINE_VATTR_WRITE < $INLINE_ROUT_SIG is
-- A value attribute write.
-- The signature has the form: "FOO::name(BAR)".
shared inlined,routines:INT;
attr sig:SIG;
attr is_special:BOOL;
attr at:IDENT;
inline(call:AM_ROUT_CALL_EXPR):$AM_EXPR is
inlined:=inlined+1;-- INLINE_VATTR_WRITE::inlined INLINE_VATTR_WRITE::inlined INT::plus
r::=#AM_VATTR_ASSIGN_EXPR(call.source);-- AM_VATTR_ASSIGN_EXPR::create AM_ROUT_CALL_EXPR::source
r.ob:=call[0].expr;-- AM_VATTR_ASSIGN_EXPR::ob AM_ROUT_CALL_EXPR::aget AM_CALL_ARG::expr
r.val:=call[1].expr;-- AM_VATTR_ASSIGN_EXPR::val AM_ROUT_CALL_EXPR::aget AM_CALL_ARG::expr
r.at:=at;-- AM_VATTR_ASSIGN_EXPR::at INLINE_VATTR_WRITE::at
r.real_tp:=call.fun.args[0].tp;-- AM_VATTR_ASSIGN_EXPR::real_tp AM_ROUT_CALL_EXPR::fun SIG::args ARRAY{1}::aget ARG::tp
return r;
end;
create(am:AM_ROUT_DEF):SAME is
r::=new;
r.sig:=am.sig;-- INLINE_VATTR_WRITE::sig AM_ROUT_DEF::sig
r.is_special:=true;-- INLINE_VATTR_WRITE::is_special
stmt::=am.code;-- AM_ROUT_DEF::code
typecase stmt when AM_RETURN_STMT then
val::=stmt.val;-- AM_RETURN_STMT::val
typecase val when AM_VATTR_ASSIGN_EXPR then
r.at:=val.at;-- INLINE_VATTR_WRITE::at AM_VATTR_ASSIGN_EXPR::at
end;
end;
routines:=routines+1;-- INLINE_VATTR_WRITE::routines INLINE_VATTR_WRITE::routines INT::plus
return r;
end;
end;
class INLINE_ARR_READ < $INLINE_ROUT_SIG
class INLINE_ARR_READ < $INLINE_ROUT_SIG is
-- A reference array read.
-- The signature has the form: "FOO::name(ind:INT):BAR".
attr sig:SIG;
attr is_special:BOOL;
inline(call:AM_ROUT_CALL_EXPR):$AM_EXPR is
return call
end;
end;
class INLINE_ARR_WRITE < $INLINE_ROUT_SIG
class INLINE_ARR_WRITE < $INLINE_ROUT_SIG is
-- A reference array write.
-- The signature has the form: "FOO::name(ind:INT,val:BAR)".
attr sig:SIG;
attr is_special:BOOL;
inline(call:AM_ROUT_CALL_EXPR):$AM_EXPR is
return call
end;
end;
class INLINE_VARR_READ < $INLINE_ROUT_SIG
class INLINE_VARR_READ < $INLINE_ROUT_SIG is
-- A value array read.
-- The signature has the form: "FOO::name(ind:INT):BAR".
attr sig:SIG;
attr is_special:BOOL;
inline(call:AM_ROUT_CALL_EXPR):$AM_EXPR is
return call
end;
end;
class INLINE_VARR_WRITE < $INLINE_ROUT_SIG
class INLINE_VARR_WRITE < $INLINE_ROUT_SIG is
-- A value array write.
-- The signature has the form: "FOO::name(ind:INT,val:BAR):FOO".
attr sig:SIG;
attr is_special:BOOL;
inline(call:AM_ROUT_CALL_EXPR):$AM_EXPR is
return call
end;
end;
class INLINE_BUILTIN < $INLINE_ROUT_SIG
class INLINE_BUILTIN < $INLINE_ROUT_SIG is
-- A builtin routine call.
-- Any signature.
attr sig:SIG;
attr is_special:BOOL;
inline(call:AM_ROUT_CALL_EXPR):$AM_EXPR is
return call
end;
end;
-- Helper for the below classes. Code considered for inlining has to be
-- short, and have a very definite structure. Brevity is measured by
-- the number of call expressions, assignments, and control structures
-- in the code.
class WEIGH_CODE
class WEIGH_CODE is
readonly attr weight:INT; -- "Weight" of the code encountered so far.
readonly attr max_weight:INT; -- Maximum weight of an inlined routine.
const rout_call_weight:INT:=2;
const iter_call_weight:INT:=4;
const assign_weight:INT:=1;
const if_weight:INT:=1;
readonly attr level:INT; -- Current level of nesting.
uplevel is level:=level-1 end;-- WEIGH_CODE::level WEIGH_CODE::level INT::minus
readonly attr badstmt:$AM_STMT; -- The unacceptable statement.
clear_badstmt is badstmt:=void end;-- WEIGH_CODE::badstmt
-- A hack used in inlining iterators.
readonly attr enclosing_if:AM_IF_STMT;
readonly attr true_branch:BOOL;
-- Ivin: Structure (there is no particular reason for it, except without
-- gotos in AM you can't implement a return not from the end).
-- basic block;
-- [if expr then same structure else same structure end]*
-- basic block;
-- [return expr] -- must be last statement of a routine.
-- basic block consists of precondition, postcondition, initial value,
-- assert, invariant, assignment and side-effect statements.
-- This covers everything simple in the runtime library except, of course,
-- the built-in routines, which conveniently have raise statements.
calc_stmt_list_weight (code:$AM_STMT) is
level:=level+1;-- WEIGH_CODE::level WEIGH_CODE::level INT::plus
loop
while! (~void(code));-- BOOL::not
calc_stmt_weight(code);-- WEIGH_CODE::calc_stmt_weight
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
code:=code.next
end;
level:=level-1-- WEIGH_CODE::level WEIGH_CODE::level INT::minus
end;
calc_stmt_weight (stmt:$AM_STMT) is
typecase stmt
when AM_ASSIGN_STMT then
weight:=weight+assign_weight;-- WEIGH_CODE::weight WEIGH_CODE::weight WEIGH_CODE::assign_weight
if weight>max_weight then return end;-- WEIGH_CODE::weight WEIGH_CODE::max_weight
calc_expr_weight(stmt.dest);-- WEIGH_CODE::calc_expr_weight AM_ASSIGN_STMT::dest
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
calc_expr_weight(stmt.src);-- WEIGH_CODE::calc_expr_weight AM_ASSIGN_STMT::src
when AM_PRE_STMT then
calc_expr_weight(stmt.test);-- WEIGH_CODE::calc_expr_weight AM_PRE_STMT::test
when AM_POST_STMT then
calc_expr_weight(stmt.test);-- WEIGH_CODE::calc_expr_weight AM_POST_STMT::test
when AM_INITIAL_STMT then
calc_stmt_list_weight(stmt.stmts);-- WEIGH_CODE::calc_stmt_list_weight AM_INITIAL_STMT::stmts
when AM_ASSERT_STMT then
calc_expr_weight(stmt.test);-- WEIGH_CODE::calc_expr_weight AM_ASSERT_STMT::test
when AM_INVARIANT_STMT then
weight:=weight+rout_call_weight+if_weight;-- WEIGH_CODE::weight WEIGH_CODE::weight WEIGH_CODE::rout_call_weight WEIGH_CODE::if_weight
if weight>max_weight then return end;-- WEIGH_CODE::weight WEIGH_CODE::max_weight
when AM_EXPR_STMT then
calc_expr_weight(stmt.expr);-- WEIGH_CODE::calc_expr_weight AM_EXPR_STMT::expr
when AM_BREAK_STMT then -- costs nothing.
when AM_IF_STMT then
weight:=weight+if_weight;-- WEIGH_CODE::weight WEIGH_CODE::weight WEIGH_CODE::if_weight
if weight>max_weight then return end;-- WEIGH_CODE::weight WEIGH_CODE::max_weight
calc_expr_weight(stmt.test);-- WEIGH_CODE::calc_expr_weight AM_IF_STMT::test
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
old_eif::=enclosing_if;-- WEIGH_CODE::enclosing_if
enclosing_if:=stmt;-- WEIGH_CODE::enclosing_if
true_branch:=true;-- WEIGH_CODE::true_branch
calc_stmt_list_weight(stmt.if_true);-- WEIGH_CODE::calc_stmt_list_weight AM_IF_STMT::if_true
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
true_branch:=false;-- WEIGH_CODE::true_branch
calc_stmt_list_weight(stmt.if_false);-- WEIGH_CODE::calc_stmt_list_weight AM_IF_STMT::if_false
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
enclosing_if:=old_eif;-- WEIGH_CODE::enclosing_if
when AM_CASE_STMT then
calc_expr_weight(stmt.test);-- WEIGH_CODE::calc_expr_weight AM_CASE_STMT::test
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
loop
weight:=weight+if_weight;-- WEIGH_CODE::weight WEIGH_CODE::weight WEIGH_CODE::if_weight
if weight>max_weight then return end;-- WEIGH_CODE::weight WEIGH_CODE::max_weight
calc_stmt_list_weight(stmt.stmts.elt!);-- WEIGH_CODE::calc_stmt_list_weight AM_CASE_STMT::stmts FLIST{1}::elt!
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
end;
calc_stmt_list_weight(stmt.else_stmts);-- WEIGH_CODE::calc_stmt_list_weight AM_CASE_STMT::else_stmts
when AM_TYPECASE_STMT then
loop
calc_stmt_list_weight(stmt.stmts.elt!);-- WEIGH_CODE::calc_stmt_list_weight AM_TYPECASE_STMT::stmts FLIST{1}::elt!
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
end;
calc_stmt_list_weight(stmt.else_stmts);-- WEIGH_CODE::calc_stmt_list_weight AM_TYPECASE_STMT::else_stmts
when AM_WAITFOR_STMT then
when AM_PREFETCH_STMT then
weight:=weight+assign_weight;-- WEIGH_CODE::weight WEIGH_CODE::weight WEIGH_CODE::assign_weight
if weight>max_weight then return end;-- WEIGH_CODE::weight WEIGH_CODE::max_weight
calc_expr_weight(stmt.dest);-- WEIGH_CODE::calc_expr_weight AM_PREFETCH_STMT::dest
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
calc_expr_weight(stmt.src);-- WEIGH_CODE::calc_expr_weight AM_PREFETCH_STMT::src
else
badstmt:=stmt; -- An illegal statement.-- WEIGH_CODE::badstmt
end
end;
calc_expr_weight (expr:$AM_EXPR) is
if ~void(expr) then-- BOOL::not
typecase expr
when AM_LOCAL_EXPR then -- No cost.
when AM_ARRAY_EXPR then
weight:=weight+rout_call_weight;-- WEIGH_CODE::weight WEIGH_CODE::weight WEIGH_CODE::rout_call_weight
if weight>max_weight then return end;-- WEIGH_CODE::weight WEIGH_CODE::max_weight
loop
calc_expr_weight(expr.elt!);-- WEIGH_CODE::calc_expr_weight AM_ARRAY_EXPR::elt!
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
end
when AM_BND_CREATE_EXPR then
loop
calc_expr_weight(expr.elt!.expr);-- WEIGH_CODE::calc_expr_weight AM_BND_CREATE_EXPR::elt! AM_CALL_ARG::expr
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
end
when AM_IF_EXPR then
weight:=weight+if_weight;-- WEIGH_CODE::weight WEIGH_CODE::weight WEIGH_CODE::if_weight
if weight>max_weight then return end;-- WEIGH_CODE::weight WEIGH_CODE::max_weight
calc_expr_weight(expr.test);-- WEIGH_CODE::calc_expr_weight AM_IF_EXPR::test
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
calc_expr_weight(expr.if_true);-- WEIGH_CODE::calc_expr_weight AM_IF_EXPR::if_true
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
calc_expr_weight(expr.if_false);-- WEIGH_CODE::calc_expr_weight AM_IF_EXPR::if_false
when AM_NEW_EXPR then
weight:=weight+rout_call_weight;-- WEIGH_CODE::weight WEIGH_CODE::weight WEIGH_CODE::rout_call_weight
when AM_IS_VOID_EXPR then
weight:=weight+if_weight;-- WEIGH_CODE::weight WEIGH_CODE::weight WEIGH_CODE::if_weight
when AM_GLOBAL_EXPR then -- No cost.
when AM_ATTR_EXPR then
calc_expr_weight(expr.ob);-- WEIGH_CODE::calc_expr_weight AM_ATTR_EXPR::ob
when AM_VATTR_ASSIGN_EXPR then
weight:=weight+assign_weight;-- WEIGH_CODE::weight WEIGH_CODE::weight WEIGH_CODE::assign_weight
if weight>max_weight then return end;-- WEIGH_CODE::weight WEIGH_CODE::max_weight
calc_expr_weight(expr.ob);-- WEIGH_CODE::calc_expr_weight AM_VATTR_ASSIGN_EXPR::ob
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
calc_expr_weight(expr.val);-- WEIGH_CODE::calc_expr_weight AM_VATTR_ASSIGN_EXPR::val
when AM_EXCEPT_EXPR then -- No cost.
when AM_STMT_EXPR then
calc_expr_weight(expr.expr);-- WEIGH_CODE::calc_expr_weight AM_STMT_EXPR::expr
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
level:=level-1; -- Same level as this code.-- WEIGH_CODE::level WEIGH_CODE::level INT::minus
calc_stmt_list_weight(expr.stmts);-- WEIGH_CODE::calc_stmt_list_weight AM_STMT_EXPR::stmts
level:=level+1;-- WEIGH_CODE::level WEIGH_CODE::level INT::plus
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
when AM_ROUT_CALL_EXPR then
-- don't inline routines containing calls to
-- inline_C. We currently don't have any knowledge
-- of semantics of the literal representing C code,
-- and there could be different kinds of name capture
-- effects if inlining were enabled.
if ((expr.fun.tp.str = "SYS") and-- AM_ROUT_CALL_EXPR::fun SIG::tp STR::is_eq
(expr.fun.name.str ="inlined_C")) then-- AM_ROUT_CALL_EXPR::fun SIG::name IDENT::str STR::is_eq
weight := max_weight+1;-- WEIGH_CODE::weight WEIGH_CODE::max_weight INT::plus
return;
end;
weight:=weight+rout_call_weight;-- WEIGH_CODE::weight WEIGH_CODE::weight WEIGH_CODE::rout_call_weight
if weight>max_weight then return end;-- WEIGH_CODE::weight WEIGH_CODE::max_weight
loop
calc_expr_weight(expr.elt!.expr);-- WEIGH_CODE::calc_expr_weight AM_ROUT_CALL_EXPR::elt! AM_CALL_ARG::expr
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
end;
when AM_ITER_CALL_EXPR then
weight:=weight+iter_call_weight;-- WEIGH_CODE::weight WEIGH_CODE::weight WEIGH_CODE::iter_call_weight
if weight>max_weight then return end;-- WEIGH_CODE::weight WEIGH_CODE::max_weight
loop
calc_expr_weight(expr.elt!.expr);-- WEIGH_CODE::calc_expr_weight AM_ITER_CALL_EXPR::elt! AM_CALL_ARG::expr
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
end;
level:=level-1; -- Same level as this code.-- WEIGH_CODE::level WEIGH_CODE::level INT::minus
calc_stmt_list_weight(expr.init);-- WEIGH_CODE::calc_stmt_list_weight AM_ITER_CALL_EXPR::init
level:=level+1;-- WEIGH_CODE::level WEIGH_CODE::level INT::plus
when AM_BND_ROUT_CALL_EXPR then
weight:=weight+rout_call_weight;-- WEIGH_CODE::weight WEIGH_CODE::weight WEIGH_CODE::rout_call_weight
if weight>max_weight then return end;-- WEIGH_CODE::weight WEIGH_CODE::max_weight
loop
calc_expr_weight(expr.elt!.expr);-- WEIGH_CODE::calc_expr_weight AM_BND_ROUT_CALL_EXPR::elt! AM_CALL_ARG::expr
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
end;
calc_expr_weight(expr.br);-- WEIGH_CODE::calc_expr_weight AM_BND_ROUT_CALL_EXPR::br
when AM_BND_ITER_CALL_EXPR then
-- inliner gets confused if iters containing calls to bound iter
-- objects, we prevent therefore the inlining of these kind of
-- iters. If you want to know more about it talk to Arno.
-- this prevents anything calling a bnd iter from being inlined,
-- will be fixed later.
weight := max_weight+1; -- so that weight > max_weight ! -- WEIGH_CODE::weight WEIGH_CODE::max_weight INT::plus
return;
--weight:=weight+iter_call_weight;
--if weight>max_weight then return end;
--loop
-- calc_expr_weight(expr.elt!.expr);
--if ~void(badstmt) or weight>max_weight then return end;
--end;
--level:=level-1; -- Same level as this code.
--calc_stmt_list_weight(expr.init);
--level:=level+1;
--if ~void(badstmt) or weight>max_weight then return end;
--calc_expr_weight(expr.bi);
when AM_EXT_CALL_EXPR then
weight:=weight+rout_call_weight;-- WEIGH_CODE::weight WEIGH_CODE::weight WEIGH_CODE::rout_call_weight
if weight>max_weight then return end;-- WEIGH_CODE::weight WEIGH_CODE::max_weight
loop
calc_expr_weight(expr.elt!.expr);-- WEIGH_CODE::calc_expr_weight AM_EXT_CALL_EXPR::elt! AM_CALL_ARG::expr
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
end;
-- I don't have a cost model for pSather extensions.
when AM_HERE_EXPR then -- No cost.
when AM_ANY_EXPR then -- No cost.
when AM_CLUSTER_EXPR then -- No cost.
when AM_CLUSTER_SIZE_EXPR then -- No cost.
when AM_WHERE_EXPR then -- No cost.
when AM_NEAR_EXPR then -- No cost.
when AM_FAR_EXPR then -- No cost.
when AM_AT_EXPR then
calc_expr_weight(expr.at);-- WEIGH_CODE::calc_expr_weight AM_AT_EXPR::at
if ~void(badstmt) or weight>max_weight then return end;-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight WEIGH_CODE::max_weight
calc_expr_weight(expr.e);-- WEIGH_CODE::calc_expr_weight AM_AT_EXPR::e
when $AM_CONST then -- No cost.
end
end;
end;
create (threshold:INT):SAME is
r::=new;
r.max_weight:=threshold;-- WEIGH_CODE::max_weight
r.weight:=0;-- WEIGH_CODE::weight
r.level:=0;-- WEIGH_CODE::level
return r
end
end;
-- Another helper class used to copy code.
class XFORM_CODE
class XFORM_CODE is
attr record_calls:BOOL;
readonly attr calls:FLIST{$AM_EXPR}; -- Calls made out of the body.
readonly attr return_val:$AM_EXPR; -- Value returned in the code.
readonly attr yield_val:$AM_EXPR; -- Ditto for iterators.
readonly attr loop_stmt:AM_LOOP_STMT; -- The loop we stopped inside.
attr new_loop_stmt:AM_LOOP_STMT; -- When transforming stuff inside a loop.
-- A hack used in inlining iterators.
private attr enclosing_if:AM_IF_STMT;
private attr true_branch:BOOL;
-- The if statement containing the yield, if any.
readonly attr if_encl_yield:AM_IF_STMT;
-- True if the yield is in the then branch.
readonly attr true_br_yield:BOOL;
-- The statements following the yield.
readonly attr after_yield:$AM_STMT;
-- Parameter & local variable -> new local variable.
private attr subst:FMAP{AM_LOCAL_EXPR,AM_LOCAL_EXPR};
create (subst:FMAP{AM_LOCAL_EXPR,AM_LOCAL_EXPR}):SAME is
xc::=new;
xc.subst:=subst;-- XFORM_CODE::subst
return xc
end;
-- Copy the body of the routine, replacing references to formal parameters
-- and local variables with references to "new" local variables.
xform_stmt_list (code:$AM_STMT):$AM_STMT is
if void(code) then return void end;
temp::=xform_stmt(code);-- XFORM_CODE::xform_stmt
if void(temp) then return void end;
copy::=temp;
loop
code:=code.next;
until!(void(code));
temp.next:=xform_stmt(code);-- XFORM_CODE::xform_stmt
temp:=temp.next;
until!(void(temp))
end;
return copy
end;
xform_stmt (stmt:$AM_STMT):$AM_STMT is
typecase stmt
when AM_ASSIGN_STMT then
snew::=#AM_ASSIGN_STMT(stmt.source);-- AM_ASSIGN_STMT::create AM_ASSIGN_STMT::source
snew.dest:=xform_expr(stmt.dest);-- AM_ASSIGN_STMT::dest XFORM_CODE::xform_expr AM_ASSIGN_STMT::dest
snew.src:=xform_expr(stmt.src);-- AM_ASSIGN_STMT::src XFORM_CODE::xform_expr AM_ASSIGN_STMT::src
return snew
when AM_PRE_STMT then
snew::=#AM_PRE_STMT(stmt.source);-- AM_PRE_STMT::create AM_PRE_STMT::source
snew.tp:=stmt.tp;-- AM_PRE_STMT::tp AM_PRE_STMT::tp
snew.test:=xform_expr(stmt.test);-- AM_PRE_STMT::test XFORM_CODE::xform_expr AM_PRE_STMT::test
return snew
when AM_POST_STMT then
snew::=#AM_POST_STMT(stmt.source);-- AM_POST_STMT::create AM_POST_STMT::source
snew.tp:=stmt.tp;-- AM_POST_STMT::tp AM_POST_STMT::tp
snew.test:=xform_expr(stmt.test);-- AM_POST_STMT::test XFORM_CODE::xform_expr AM_POST_STMT::test
return snew
when AM_INITIAL_STMT then
snew::=#AM_INITIAL_STMT(stmt.source);-- AM_INITIAL_STMT::create AM_INITIAL_STMT::source
snew.tp:=stmt.tp;-- AM_INITIAL_STMT::tp AM_INITIAL_STMT::tp
snew.stmts:=xform_stmt_list(stmt.stmts);-- AM_INITIAL_STMT::stmts XFORM_CODE::xform_stmt_list AM_INITIAL_STMT::stmts
return snew
when AM_ASSERT_STMT then
snew::=#AM_ASSERT_STMT(stmt.source);-- AM_ASSERT_STMT::create AM_ASSERT_STMT::source
snew.tp:=stmt.tp;-- AM_ASSERT_STMT::tp AM_ASSERT_STMT::tp
snew.test:=xform_expr(stmt.test);-- AM_ASSERT_STMT::test XFORM_CODE::xform_expr AM_ASSERT_STMT::test
return snew
when AM_INVARIANT_STMT then
snew::=#AM_INVARIANT_STMT(stmt.source);-- AM_INVARIANT_STMT::create AM_INVARIANT_STMT::source
snew.sig:=stmt.sig;-- AM_INVARIANT_STMT::sig AM_INVARIANT_STMT::sig
return snew
when AM_EXPR_STMT then
snew::=#AM_EXPR_STMT(stmt.source);-- AM_EXPR_STMT::create AM_EXPR_STMT::source
snew.expr:=xform_expr(stmt.expr);-- AM_EXPR_STMT::expr XFORM_CODE::xform_expr AM_EXPR_STMT::expr
return snew
when AM_IF_STMT then
snew::=#AM_IF_STMT(stmt.source);-- AM_IF_STMT::create AM_IF_STMT::source
old_eif::=enclosing_if;-- XFORM_CODE::enclosing_if
enclosing_if:=snew;-- XFORM_CODE::enclosing_if
snew.test:=xform_expr(stmt.test);-- AM_IF_STMT::test XFORM_CODE::xform_expr AM_IF_STMT::test
true_branch:=true;-- XFORM_CODE::true_branch
snew.if_true:=xform_stmt_list(stmt.if_true);-- AM_IF_STMT::if_true XFORM_CODE::xform_stmt_list AM_IF_STMT::if_true
true_branch:=false;-- XFORM_CODE::true_branch
snew.if_false:=xform_stmt_list(stmt.if_false);-- AM_IF_STMT::if_false XFORM_CODE::xform_stmt_list AM_IF_STMT::if_false
enclosing_if:=old_eif;-- XFORM_CODE::enclosing_if
return snew
when AM_CASE_STMT then
snew::=#AM_CASE_STMT(stmt.source);-- AM_CASE_STMT::create AM_CASE_STMT::source
snew.test:=xform_expr(stmt.test);-- AM_CASE_STMT::test XFORM_CODE::xform_expr AM_CASE_STMT::test
snew.tgts:=stmt.tgts;-- AM_CASE_STMT::tgts AM_CASE_STMT::tgts
snew.stmts:=#FLIST{$AM_STMT}(stmt.stmts.size);-- AM_CASE_STMT::stmts FLIST{1}::create AM_CASE_STMT::stmts FLIST{1}::size
loop
snew.stmts := snew.stmts.push-- AM_CASE_STMT::stmts AM_CASE_STMT::stmts FLIST{1}::push
(xform_stmt_list(stmt.stmts.elt!))-- XFORM_CODE::xform_stmt_list AM_CASE_STMT::stmts FLIST{1}::elt!
end;
snew.no_else:=stmt.no_else;-- AM_CASE_STMT::no_else AM_CASE_STMT::no_else
if ~snew.no_else then-- AM_CASE_STMT::no_else BOOL::not
snew.else_stmts:=xform_stmt_list(stmt.else_stmts) end;-- AM_CASE_STMT::else_stmts XFORM_CODE::xform_stmt_list AM_CASE_STMT::else_stmts
return snew
when AM_TYPECASE_STMT then
snew::=#AM_TYPECASE_STMT(stmt.source);-- AM_TYPECASE_STMT::create AM_TYPECASE_STMT::source
snew.test:=subst.get(stmt.test);-- AM_TYPECASE_STMT::test XFORM_CODE::subst FMAP{2}::get AM_TYPECASE_STMT::test
snew.tgts:=stmt.tgts;-- AM_TYPECASE_STMT::tgts AM_TYPECASE_STMT::tgts
snew.stmts:=#FLIST{$AM_STMT}(stmt.stmts.size);-- AM_TYPECASE_STMT::stmts FLIST{1}::create AM_TYPECASE_STMT::stmts FLIST{1}::size
loop
snew.stmts := snew.stmts.push-- AM_TYPECASE_STMT::stmts AM_TYPECASE_STMT::stmts FLIST{1}::push
(xform_stmt_list(stmt.stmts.elt!))-- XFORM_CODE::xform_stmt_list AM_TYPECASE_STMT::stmts FLIST{1}::elt!
end;
snew.no_else:=stmt.no_else;-- AM_TYPECASE_STMT::no_else AM_TYPECASE_STMT::no_else
if ~snew.no_else then-- AM_TYPECASE_STMT::no_else BOOL::not
snew.else_stmts:=xform_stmt_list(stmt.else_stmts) end;-- AM_TYPECASE_STMT::else_stmts XFORM_CODE::xform_stmt_list AM_TYPECASE_STMT::else_stmts
return snew
when AM_RETURN_STMT then
return_val:=xform_expr(stmt.val);-- XFORM_CODE::return_val XFORM_CODE::xform_expr AM_RETURN_STMT::val
return void
when AM_YIELD_STMT then
yield_val:=xform_expr(stmt.val);-- XFORM_CODE::yield_val XFORM_CODE::xform_expr AM_YIELD_STMT::val
if_encl_yield:=enclosing_if;-- XFORM_CODE::if_encl_yield XFORM_CODE::enclosing_if
true_br_yield:=true_branch;-- XFORM_CODE::true_br_yield XFORM_CODE::true_branch
after_yield:=xform_stmt_list(stmt.next);-- XFORM_CODE::after_yield XFORM_CODE::xform_stmt_list AM_YIELD_STMT::next
return void
when AM_BREAK_STMT then
return #AM_BREAK_STMT(stmt.source);-- AM_BREAK_STMT::create AM_BREAK_STMT::source
when AM_LOOP_STMT then
loop_stmt:=stmt;-- XFORM_CODE::loop_stmt
return void
end
end;
-- any node that can be optimized MUST be a copy, so that the optimizer
-- can use the node to store optimization results. There is an
-- assertion in INVAR_OPT::get_ent that checks for this.
xform_expr (expr:$AM_EXPR):$AM_EXPR is
arg: AM_CALL_ARG;
if void(expr) then return void end;
typecase expr
when AM_LOCAL_EXPR then
return subst.get(expr);-- XFORM_CODE::subst FMAP{2}::get
when AM_ARRAY_EXPR then
enew::=#AM_ARRAY_EXPR(expr.asize,expr.source);-- AM_ARRAY_EXPR::create AM_ARRAY_EXPR::asize AM_ARRAY_EXPR::source
enew.tp_at:=expr.tp_at;-- AM_ARRAY_EXPR::tp_at AM_ARRAY_EXPR::tp_at
loop enew.set!(xform_expr(expr.elt!)) end;-- AM_ARRAY_EXPR::set! XFORM_CODE::xform_expr AM_ARRAY_EXPR::elt!
return enew;
when AM_BND_CREATE_EXPR then
enew::=#AM_BND_CREATE_EXPR(expr.asize,expr.source);-- AM_BND_CREATE_EXPR::create AM_BND_CREATE_EXPR::asize AM_BND_CREATE_EXPR::source
enew.fun:=expr.fun;-- AM_BND_CREATE_EXPR::fun AM_BND_CREATE_EXPR::fun
enew.bnd_args:=expr.bnd_args;-- AM_BND_CREATE_EXPR::bnd_args AM_BND_CREATE_EXPR::bnd_args
enew.unbnd_args:=expr.unbnd_args;-- AM_BND_CREATE_EXPR::unbnd_args AM_BND_CREATE_EXPR::unbnd_args
enew.tp_at:=expr.tp_at;-- AM_BND_CREATE_EXPR::tp_at AM_BND_CREATE_EXPR::tp_at
loop
arg:= expr.elt!;-- AM_BND_CREATE_EXPR::elt!
enew.set!(#AM_CALL_ARG(xform_expr(arg.expr), arg.mode));-- AM_BND_CREATE_EXPR::set! AM_CALL_ARG::create XFORM_CODE::xform_expr AM_CALL_ARG::expr AM_CALL_ARG::mode
end;
return enew;
when AM_IF_EXPR then
enew::=#AM_IF_EXPR(expr.source);-- AM_IF_EXPR::create AM_IF_EXPR::source
enew.test:=xform_expr(expr.test);-- AM_IF_EXPR::test XFORM_CODE::xform_expr AM_IF_EXPR::test
enew.if_true:=xform_expr(expr.if_true);-- AM_IF_EXPR::if_true XFORM_CODE::xform_expr AM_IF_EXPR::if_true
enew.if_false:=xform_expr(expr.if_false);-- AM_IF_EXPR::if_false XFORM_CODE::xform_expr AM_IF_EXPR::if_false
enew.tp_at:=expr.tp_at;-- AM_IF_EXPR::tp_at AM_IF_EXPR::tp_at
return enew;
when AM_NEW_EXPR then
enew::=#AM_NEW_EXPR(expr.source);-- AM_NEW_EXPR::create AM_NEW_EXPR::source
enew.tp_at:=expr.tp_at;-- AM_NEW_EXPR::tp_at AM_NEW_EXPR::tp_at
enew.asz:=xform_expr(expr.asz);-- AM_NEW_EXPR::asz XFORM_CODE::xform_expr AM_NEW_EXPR::asz
return enew;
when AM_IS_VOID_EXPR then
enew::=#AM_IS_VOID_EXPR(expr.source);-- AM_IS_VOID_EXPR::create AM_IS_VOID_EXPR::source
enew.tp_at:=expr.tp_at;-- AM_IS_VOID_EXPR::tp_at AM_IS_VOID_EXPR::tp_at
enew.arg:=xform_expr(expr.arg);-- AM_IS_VOID_EXPR::arg XFORM_CODE::xform_expr AM_IS_VOID_EXPR::arg
return enew;
when AM_GLOBAL_EXPR then
enew::=#AM_GLOBAL_EXPR(expr.source);-- AM_GLOBAL_EXPR::create AM_GLOBAL_EXPR::source
enew.tp_at:=expr.tp_at;-- AM_GLOBAL_EXPR::tp_at AM_GLOBAL_EXPR::tp_at
enew.name :=expr.name;-- AM_GLOBAL_EXPR::name AM_GLOBAL_EXPR::name
enew.class_tp:=expr.class_tp;-- AM_GLOBAL_EXPR::class_tp AM_GLOBAL_EXPR::class_tp
enew.init := expr.init;-- AM_GLOBAL_EXPR::init AM_GLOBAL_EXPR::init
enew.is_const := expr.is_const;-- AM_GLOBAL_EXPR::is_const AM_GLOBAL_EXPR::is_const
enew.as_type := expr.as_type;-- AM_GLOBAL_EXPR::as_type AM_GLOBAL_EXPR::as_type
return enew;
when AM_ATTR_EXPR then
enew::=#AM_ATTR_EXPR(expr.source);-- AM_ATTR_EXPR::create AM_ATTR_EXPR::source
enew.ob:=xform_expr(expr.ob);-- AM_ATTR_EXPR::ob XFORM_CODE::xform_expr AM_ATTR_EXPR::ob
enew.self_tp:=expr.self_tp;-- AM_ATTR_EXPR::self_tp AM_ATTR_EXPR::self_tp
enew.at:=expr.at;-- AM_ATTR_EXPR::at AM_ATTR_EXPR::at
enew.tp_at:=expr.tp_at;-- AM_ATTR_EXPR::tp_at AM_ATTR_EXPR::tp_at
enew.as_type:=expr.as_type;-- AM_ATTR_EXPR::as_type AM_ATTR_EXPR::as_type
return enew;
when AM_VATTR_ASSIGN_EXPR then
enew::=#AM_VATTR_ASSIGN_EXPR(expr.source);-- AM_VATTR_ASSIGN_EXPR::create AM_VATTR_ASSIGN_EXPR::source
enew.ob:=xform_expr(expr.ob);-- AM_VATTR_ASSIGN_EXPR::ob XFORM_CODE::xform_expr AM_VATTR_ASSIGN_EXPR::ob
enew.at:=expr.at;-- AM_VATTR_ASSIGN_EXPR::at AM_VATTR_ASSIGN_EXPR::at
enew.val:=xform_expr(expr.val);-- AM_VATTR_ASSIGN_EXPR::val XFORM_CODE::xform_expr AM_VATTR_ASSIGN_EXPR::val
enew.real_tp:=expr.real_tp;-- AM_VATTR_ASSIGN_EXPR::real_tp AM_VATTR_ASSIGN_EXPR::real_tp
return enew;
when AM_VARR_ASSIGN_EXPR then
enew::=#AM_VARR_ASSIGN_EXPR(expr.source);-- AM_VARR_ASSIGN_EXPR::create AM_VARR_ASSIGN_EXPR::source
enew.ob:=xform_expr(expr.ob);-- AM_VARR_ASSIGN_EXPR::ob XFORM_CODE::xform_expr AM_VARR_ASSIGN_EXPR::ob
enew.ind:=xform_expr(expr.ind);-- AM_VARR_ASSIGN_EXPR::ind XFORM_CODE::xform_expr AM_VARR_ASSIGN_EXPR::ind
enew.val:=xform_expr(expr.val);-- AM_VARR_ASSIGN_EXPR::val XFORM_CODE::xform_expr AM_VARR_ASSIGN_EXPR::val
return enew;
when AM_EXCEPT_EXPR then
return expr;
when AM_HERE_EXPR then
return expr;
when AM_ANY_EXPR then
return expr;
when AM_CLUSTER_EXPR then
return expr;
when AM_WHERE_EXPR then
enew::=#AM_WHERE_EXPR(expr.source);-- AM_WHERE_EXPR::create AM_WHERE_EXPR::source
enew.arg:=xform_expr(expr.arg);-- AM_WHERE_EXPR::arg XFORM_CODE::xform_expr AM_WHERE_EXPR::arg
return enew;
when AM_NEAR_EXPR then
enew::=#AM_NEAR_EXPR(expr.source);-- AM_NEAR_EXPR::create AM_NEAR_EXPR::source
enew.arg:=xform_expr(expr.arg);-- AM_NEAR_EXPR::arg XFORM_CODE::xform_expr AM_NEAR_EXPR::arg
return enew;
when AM_FAR_EXPR then
enew::=#AM_FAR_EXPR(expr.source);-- AM_FAR_EXPR::create AM_FAR_EXPR::source
enew.arg:=xform_expr(expr.arg);-- AM_FAR_EXPR::arg XFORM_CODE::xform_expr AM_FAR_EXPR::arg
return enew;
when AM_AT_EXPR then
enew::=#AM_AT_EXPR(expr.source);-- AM_AT_EXPR::create AM_AT_EXPR::source
enew.at:=xform_expr(expr.at);-- AM_AT_EXPR::at XFORM_CODE::xform_expr AM_AT_EXPR::at
enew.e:=xform_expr(expr.e);-- AM_AT_EXPR::e XFORM_CODE::xform_expr AM_AT_EXPR::e
return enew;
when AM_ROUT_CALL_EXPR then
enew::=#AM_ROUT_CALL_EXPR(expr.asize,expr.source);-- AM_ROUT_CALL_EXPR::create AM_ROUT_CALL_EXPR::asize AM_ROUT_CALL_EXPR::source
enew.fun:=expr.fun;-- AM_ROUT_CALL_EXPR::fun AM_ROUT_CALL_EXPR::fun
enew.as_type:=expr.as_type;-- AM_ROUT_CALL_EXPR::as_type AM_ROUT_CALL_EXPR::as_type
loop arg:=expr.elt!;-- AM_ROUT_CALL_EXPR::elt!
enew.set!(#AM_CALL_ARG(xform_expr(arg.expr),arg.mode)); -- AM_ROUT_CALL_EXPR::set! AM_CALL_ARG::create XFORM_CODE::xform_expr AM_CALL_ARG::expr AM_CALL_ARG::mode
end;
if record_calls then calls:=calls.push(enew) end;-- XFORM_CODE::record_calls XFORM_CODE::calls XFORM_CODE::calls FLIST{1}::push
return enew;
when AM_ITER_CALL_EXPR then
enew::=#AM_ITER_CALL_EXPR(expr.asize,expr.source);-- AM_ITER_CALL_EXPR::create AM_ITER_CALL_EXPR::asize AM_ITER_CALL_EXPR::source
enew.fun:=expr.fun;-- AM_ITER_CALL_EXPR::fun AM_ITER_CALL_EXPR::fun
enew.init:=xform_stmt_list(expr.init);-- AM_ITER_CALL_EXPR::init XFORM_CODE::xform_stmt_list AM_ITER_CALL_EXPR::init
enew.lp:=new_loop_stmt;-- AM_ITER_CALL_EXPR::lp XFORM_CODE::new_loop_stmt
new_loop_stmt.its:=new_loop_stmt.its.push(enew);-- XFORM_CODE::new_loop_stmt AM_LOOP_STMT::its XFORM_CODE::new_loop_stmt AM_LOOP_STMT::its FLIST{1}::push
loop
arg := expr.elt!;-- AM_ITER_CALL_EXPR::elt!
enew.set!(#AM_CALL_ARG(xform_expr(arg.expr), arg.mode)); -- AM_ITER_CALL_EXPR::set! AM_CALL_ARG::create XFORM_CODE::xform_expr AM_CALL_ARG::expr AM_CALL_ARG::mode
end;
if record_calls then calls:=calls.push(enew) end;-- XFORM_CODE::record_calls XFORM_CODE::calls XFORM_CODE::calls FLIST{1}::push
return enew;
when AM_BND_ROUT_CALL_EXPR then
enew::=#AM_BND_ROUT_CALL_EXPR(expr.asize,expr.source);-- AM_BND_ROUT_CALL_EXPR::create AM_BND_ROUT_CALL_EXPR::asize AM_BND_ROUT_CALL_EXPR::source
enew.br:=xform_expr(expr.br);-- AM_BND_ROUT_CALL_EXPR::br XFORM_CODE::xform_expr AM_BND_ROUT_CALL_EXPR::br
enew.br_tp:=expr.br_tp;-- AM_BND_ROUT_CALL_EXPR::br_tp AM_BND_ROUT_CALL_EXPR::br_tp
loop
arg := expr.elt!;-- AM_BND_ROUT_CALL_EXPR::elt!
enew.set!(#AM_CALL_ARG( xform_expr(arg.expr), arg.mode)); -- AM_BND_ROUT_CALL_EXPR::set! AM_CALL_ARG::create XFORM_CODE::xform_expr AM_CALL_ARG::expr AM_CALL_ARG::mode
end;
if record_calls then calls:=calls.push(enew) end;-- XFORM_CODE::record_calls XFORM_CODE::calls XFORM_CODE::calls FLIST{1}::push
return enew;
when AM_BND_ITER_CALL_EXPR then
enew::=#AM_BND_ITER_CALL_EXPR(expr.asize,expr.source);-- AM_BND_ITER_CALL_EXPR::create AM_BND_ITER_CALL_EXPR::asize AM_BND_ITER_CALL_EXPR::source
enew.bi:=xform_expr(expr.bi);-- AM_BND_ITER_CALL_EXPR::bi XFORM_CODE::xform_expr AM_BND_ITER_CALL_EXPR::bi
enew.bi_tp:=expr.bi_tp;-- AM_BND_ITER_CALL_EXPR::bi_tp AM_BND_ITER_CALL_EXPR::bi_tp
enew.init:=xform_stmt_list(expr.init);-- AM_BND_ITER_CALL_EXPR::init XFORM_CODE::xform_stmt_list AM_BND_ITER_CALL_EXPR::init
enew.lp:=new_loop_stmt;-- AM_BND_ITER_CALL_EXPR::lp XFORM_CODE::new_loop_stmt
new_loop_stmt.bits:=new_loop_stmt.bits.push(enew);-- XFORM_CODE::new_loop_stmt AM_LOOP_STMT::bits XFORM_CODE::new_loop_stmt AM_LOOP_STMT::bits FLIST{1}::push
loop
arg := expr.elt!;-- AM_BND_ITER_CALL_EXPR::elt!
enew.set!(#AM_CALL_ARG(xform_expr(arg.expr), arg.mode)); -- AM_BND_ITER_CALL_EXPR::set! AM_CALL_ARG::create XFORM_CODE::xform_expr AM_CALL_ARG::expr AM_CALL_ARG::mode
end;
if record_calls then calls:=calls.push(enew) end;-- XFORM_CODE::record_calls XFORM_CODE::calls XFORM_CODE::calls FLIST{1}::push
return enew;
when AM_EXT_CALL_EXPR then
enew::=#AM_EXT_CALL_EXPR(expr.asize,expr.source,expr.nm);-- AM_EXT_CALL_EXPR::create AM_EXT_CALL_EXPR::asize AM_EXT_CALL_EXPR::source AM_EXT_CALL_EXPR::nm
enew.fun:=expr.fun;-- AM_EXT_CALL_EXPR::fun AM_EXT_CALL_EXPR::fun
loop
arg := expr.elt!;-- AM_EXT_CALL_EXPR::elt!
enew.set!(#AM_CALL_ARG(xform_expr(arg.expr), arg.mode)); -- AM_EXT_CALL_EXPR::set! AM_CALL_ARG::create XFORM_CODE::xform_expr AM_CALL_ARG::expr AM_CALL_ARG::mode
end;
if record_calls then calls:=calls.push(enew) end;-- XFORM_CODE::record_calls XFORM_CODE::calls XFORM_CODE::calls FLIST{1}::push
return enew;
when $AM_CONST then
return expr;
when AM_STMT_EXPR then
enew::=#AM_STMT_EXPR(expr.source);-- AM_STMT_EXPR::create AM_STMT_EXPR::source
save_calls::=calls;-- XFORM_CODE::calls
calls:=void;-- XFORM_CODE::calls
enew.stmts:=xform_stmt_list(expr.stmts);-- AM_STMT_EXPR::stmts XFORM_CODE::xform_stmt_list AM_STMT_EXPR::stmts
enew.calls:=calls;-- AM_STMT_EXPR::calls XFORM_CODE::calls
calls:=save_calls.concat(calls);-- XFORM_CODE::calls FLIST{1}::concat XFORM_CODE::calls
enew.locals:=#(expr.locals.size);-- AM_STMT_EXPR::locals FLIST{1}::create AM_STMT_EXPR::locals FLIST{1}::size
loop enew.locals := enew.locals.push-- AM_STMT_EXPR::locals AM_STMT_EXPR::locals FLIST{1}::push
(subst.get(expr.locals.elt!)) end;-- XFORM_CODE::subst FMAP{2}::get AM_STMT_EXPR::locals FLIST{1}::elt!
enew.expr:=xform_expr(expr.expr);-- AM_STMT_EXPR::expr XFORM_CODE::xform_expr AM_STMT_EXPR::expr
return enew;
end
end
end;
-- Helper to deal with local variables.
class CHANGE_VARS
class CHANGE_VARS is
-- The routine's parameters and local variables.
readonly attr saved_vars:FLIST{AM_LOCAL_EXPR};
-- Statements parm1:=void; on instantiation become parm1:=arg1.
-- One list for routines, and two for iterators. Also, for iterators
-- lists of indices of hot and non-hot parameters. Also, a list of
-- initialization statements for variables that need them.
readonly attr init_parms,init_hot,init_nonhot:$AM_STMT;
readonly attr pind_hot,pind_nonhot:ARRAY{INT};
readonly attr init_vars:$AM_STMT;
-- Variables in the routine -> variables in the saved routine.
readonly attr saved_subst:FMAP{AM_LOCAL_EXPR,AM_LOCAL_EXPR};
-- New routine's parameters and local variables.
readonly attr new_vars:FLIST{AM_LOCAL_EXPR};
-- Variables in the saved routine -> variables in the new routine.
readonly attr new_subst:FMAP{AM_LOCAL_EXPR,AM_LOCAL_EXPR};
-- For every argument and local variable in the routine,
-- create a new local variable and record this in the substitutions table.
-- Also generate statements to initialize the local variables that need
-- to be initialized, and to assign actual arguments to formal parameters.
create (rout:AM_ROUT_DEF):SAME is
r::=new;
r.saved_subst:=#(rout.size+rout.locals.size);-- CHANGE_VARS::saved_subst FMAP{2}::create AM_ROUT_DEF::size INT::plus AM_ROUT_DEF::locals FLIST{1}::size
r.saved_vars:=#(rout.size+rout.locals.size);-- CHANGE_VARS::saved_vars FLIST{1}::create AM_ROUT_DEF::size INT::plus AM_ROUT_DEF::locals FLIST{1}::size
if rout.is_iter then-- AM_ROUT_DEF::is_iter
r.init_hot:=void;-- CHANGE_VARS::init_hot
r.pind_hot:=#(rout.size);-- CHANGE_VARS::pind_hot ARRAY{1}::create AM_ROUT_DEF::size
r.init_nonhot:=void;-- CHANGE_VARS::init_nonhot
r.pind_nonhot:=#(rout.size);-- CHANGE_VARS::pind_nonhot ARRAY{1}::create AM_ROUT_DEF::size
else
r.init_parms:=void;-- CHANGE_VARS::init_parms
end;
r.init_vars:=void;-- CHANGE_VARS::init_vars
loop
l::=rout.elt!.expr;-- AM_ROUT_DEF::elt! AM_FORMAL_ARG::expr
m::=#AM_LOCAL_EXPR(rout.source);-- AM_LOCAL_EXPR::create AM_ROUT_DEF::source
m.is_volatile:=l.is_volatile;-- AM_LOCAL_EXPR::is_volatile AM_LOCAL_EXPR::is_volatile
m.name:=#IDENT(rout.sig.name.str+"_"+l.name.str);-- AM_LOCAL_EXPR::name IDENT::create AM_ROUT_DEF::sig SIG::name IDENT::str STR::plus STR::plus AM_LOCAL_EXPR::name IDENT::str
m.tp_at:=l.tp_at;-- AM_LOCAL_EXPR::tp_at AM_LOCAL_EXPR::tp_at
m.needs_init:=l.needs_init;-- AM_LOCAL_EXPR::needs_init AM_LOCAL_EXPR::needs_init
-- For iterators, only initialize hot arguments; once arguments
-- are dealt with elsewhere.
if rout.is_iter then-- AM_ROUT_DEF::is_iter
as::=#AM_ASSIGN_STMT(rout.source);-- AM_ASSIGN_STMT::create AM_ROUT_DEF::source
as.dest:=m;-- AM_ASSIGN_STMT::dest
as.src:=void; -- Will become something else later.-- AM_ASSIGN_STMT::src
i::=0.up!;-- INT::up!
if void(rout.sig.hot) or i=0 or ~rout.sig.hot[i-1] then-- AM_ROUT_DEF::sig SIG::hot INT::is_eq AM_ROUT_DEF::sig SIG::hot ARRAY{1}::aget INT::minus BOOL::not
if void(r.init_nonhot) then r.init_nonhot:=as-- CHANGE_VARS::init_nonhot CHANGE_VARS::init_nonhot
else r.init_nonhot.append(as) end;-- CHANGE_VARS::init_nonhot
r.pind_nonhot.set!(i);-- CHANGE_VARS::pind_nonhot ARRAY{1}::set!
else
if void(r.init_hot) then r.init_hot:=as-- CHANGE_VARS::init_hot CHANGE_VARS::init_hot
else r.init_hot.append(as) end;-- CHANGE_VARS::init_hot
r.pind_hot.set!(i);-- CHANGE_VARS::pind_hot ARRAY{1}::set!
end
else
as::=#AM_ASSIGN_STMT(rout.source);-- AM_ASSIGN_STMT::create AM_ROUT_DEF::source
as.dest:=m;-- AM_ASSIGN_STMT::dest
as.src:=void; -- Will become something else later.-- AM_ASSIGN_STMT::src
if void(r.init_parms) then r.init_parms:=as-- CHANGE_VARS::init_parms CHANGE_VARS::init_parms
else r.init_parms.append(as) end;-- CHANGE_VARS::init_parms
end;
m.no_assign:=l.no_assign;-- AM_LOCAL_EXPR::no_assign AM_LOCAL_EXPR::no_assign
r.saved_subst:=r.saved_subst.insert(l,m);-- CHANGE_VARS::saved_subst CHANGE_VARS::saved_subst FMAP{2}::insert
r.saved_vars:=r.saved_vars.push(m)-- CHANGE_VARS::saved_vars CHANGE_VARS::saved_vars FLIST{1}::push
end;
loop
l::=rout.locals.elt!;-- AM_ROUT_DEF::locals FLIST{1}::elt!
m::=#AM_LOCAL_EXPR(rout.source);-- AM_LOCAL_EXPR::create AM_ROUT_DEF::source
m.is_volatile:=l.is_volatile;-- AM_LOCAL_EXPR::is_volatile AM_LOCAL_EXPR::is_volatile
m.name:=l.name;-- AM_LOCAL_EXPR::name AM_LOCAL_EXPR::name
m.tp_at:=l.tp_at;-- AM_LOCAL_EXPR::tp_at AM_LOCAL_EXPR::tp_at
m.needs_init:=l.needs_init;-- AM_LOCAL_EXPR::needs_init AM_LOCAL_EXPR::needs_init
if m.needs_init then-- AM_LOCAL_EXPR::needs_init
as::=#AM_ASSIGN_STMT(rout.source);-- AM_ASSIGN_STMT::create AM_ROUT_DEF::source
as.dest:=m;-- AM_ASSIGN_STMT::dest
vconst::=#AM_VOID_CONST(rout.source);-- AM_VOID_CONST::create AM_ROUT_DEF::source
vconst.tp_at:=m.tp_at;-- AM_VOID_CONST::tp_at AM_LOCAL_EXPR::tp_at
as.src:=vconst;-- AM_ASSIGN_STMT::src
if void(r.init_vars) then r.init_vars:=as-- CHANGE_VARS::init_vars CHANGE_VARS::init_vars
else r.init_vars.append(as) end-- CHANGE_VARS::init_vars
end;
m.no_assign:=l.no_assign;-- AM_LOCAL_EXPR::no_assign AM_LOCAL_EXPR::no_assign
r.saved_subst:=r.saved_subst.insert(l,m);-- CHANGE_VARS::saved_subst CHANGE_VARS::saved_subst FMAP{2}::insert
r.saved_vars:=r.saved_vars.push(m)-- CHANGE_VARS::saved_vars CHANGE_VARS::saved_vars FLIST{1}::push
end;
return r
end;
-- Destroy the stuff only useful in INLINE_{ROUT,ITER}::create
after_saving is
SYS::destroy (saved_subst)-- SYS::destroy CHANGE_VARS::saved_subst
end;
-- Copy the list of local variables from the saved code to the new code
-- (every inlined copy has to have its own local variables).
new_copy (source:SFILE_ID) is
new_subst:=#(saved_vars.size);-- CHANGE_VARS::new_subst FMAP{2}::create CHANGE_VARS::saved_vars FLIST{1}::size
new_vars:=#(saved_vars.size);-- CHANGE_VARS::new_vars FLIST{1}::create CHANGE_VARS::saved_vars FLIST{1}::size
loop
l::=saved_vars.elt!;-- CHANGE_VARS::saved_vars FLIST{1}::elt!
m::=#AM_LOCAL_EXPR(source);-- AM_LOCAL_EXPR::create
m.is_volatile:=l.is_volatile;-- AM_LOCAL_EXPR::is_volatile AM_LOCAL_EXPR::is_volatile
m.name:=l.name;-- AM_LOCAL_EXPR::name AM_LOCAL_EXPR::name
m.tp_at:=l.tp_at;-- AM_LOCAL_EXPR::tp_at AM_LOCAL_EXPR::tp_at
m.needs_init:=l.needs_init;-- AM_LOCAL_EXPR::needs_init AM_LOCAL_EXPR::needs_init
m.no_assign:=l.no_assign;-- AM_LOCAL_EXPR::no_assign AM_LOCAL_EXPR::no_assign
new_subst:=new_subst.insert(l,m);-- CHANGE_VARS::new_subst CHANGE_VARS::new_subst FMAP{2}::insert
new_vars:=new_vars.push(m)-- CHANGE_VARS::new_vars CHANGE_VARS::new_vars FLIST{1}::push
end
end;
-- Destroy the stuff useful in inlining a single routine.
after_one_use is
SYS::destroy (new_subst)-- SYS::destroy CHANGE_VARS::new_subst
end;
end;
-- Iterator of the form
-- flatiter!(nonhot:T1,hot:T2) is
-- var::=iv; BEFLOOP;
-- loop IINIT; yield yield_val; ITERM end
-- end
-- called from
-- loop
-- ...
-- x:=flatiter!(nh1,h1)
-- ...
-- end
-- is transformed into
-- flatiter_if_first:BOOL;
-- flatiter_if_first:=true;
-- loop
-- ...
-- if flatiter_if_first then
-- flatiter_nonhot:=nh1
-- end;
-- flatiter_hot:=h1;
-- if flatiter_if_first then
-- flatiter_var:=iv;
-- BEFLOOP;
-- flatiter_if_first:=false
-- else
-- ITERM
-- end;
-- IINIT;
-- x:=yield_val;
-- ...
-- end
-- Iterator of the form
-- conditer!(nonhot:T1,hot:T2) is
-- var::=iv; BEFLOOP;
-- loop
-- IINIT;
-- if yield_cond then WYBEF; yield yield_val; WYAFT else WNOY end;
-- ITERM
-- end
-- end
-- called from
-- loop
-- ...
-- x:=conditer!(nh1,h1)
-- ...
-- end
-- is transformed into
-- conditer_if_first:BOOL;
-- conditer_if_first:=true;
-- conditer_if_yld:BOOL;
-- loop
-- ...
-- if conditer_if_first then
-- conditer_nonhot:=nh1
-- end;
-- conditer_hot:=h1;
-- if conditer_if_first then
-- conditer_var:=iv;
-- BEFLOOP;
-- conditer_if_first:=false
-- else
-- WYAFT;
-- ITERM
-- end;
-- conditer_if_yld:=false;
-- loop
-- IINIT;
-- if yield_cond then conditer_if_yld:=true; break! end;
-- WNOY;
-- ITERM
-- end;
-- if conditer_if_yld then
-- WYBEF
-- else
-- break!
-- end;
-- x:=yield_val;
-- ...
-- end
class INLINE_ITER < $INLINE_ITER_SIG
class INLINE_ITER < $INLINE_ITER_SIG is
shared inlined,iters:INT;
attr is_special:BOOL;
-- Mechanism for transforming local variables and parameters.
private attr change_vars:CHANGE_VARS;
-- The code before the regular loop structure.
private attr BEFLOOP_code:$AM_STMT;
-- Yield directly in the loop?
private attr flat_yield:BOOL;
-- The code before flat yield (or if); after flat yield (or if).
-- In other words, initialize or terminate the iteration.
private attr IINIT_code:$AM_STMT;
private attr ITERM_code:$AM_STMT;
-- Non-flat yield: condition when to yield, code before yield, code after
-- yield, the other branch of the if statement.
private attr yield_cond:$AM_EXPR;
private attr WYBEF_code,WYAFT_code,WNOY_code:$AM_STMT;
-- The value yielded.
private attr yield_val:$AM_EXPR;
-- Variables that used to be set to true before the loop. They have to be
-- set to true before the new loop, too.
private attr loop_firsts:FLIST{AM_LOCAL_EXPR};
private attr signature:SIG;
sig:SIG is return signature end;-- INLINE_ITER::signature
-- Note that the way DFS is done on routines, there can be no recursive
-- expansion (and the body of the routine is already expanded).
-- Can an iterator be inlined?
is_inlineable (rout:AM_ROUT_DEF,threshold:INT, prog:PROG):BOOL is
if prog.generate_am.sig_recursive.test(rout.sig) then-- PROG::generate_am FSET{1}::test AM_ROUT_DEF::sig
return false;
end;
-- Skip the beginning.
sb::=#WEIGH_CODE(threshold);-- WEIGH_CODE::create
sb.calc_stmt_list_weight(rout.code);-- WEIGH_CODE::calc_stmt_list_weight AM_ROUT_DEF::code
if sb.weight>threshold then SYS::destroy(sb); return false end;-- WEIGH_CODE::weight INT::is_lt SYS::destroy
loopstmt:AM_LOOP_STMT;
badstmt::=sb.badstmt;-- WEIGH_CODE::badstmt
sb.clear_badstmt;-- WEIGH_CODE::clear_badstmt
typecase badstmt
when AM_LOOP_STMT then
if sb.level/=1 or ~badstmt.has_yield then-- WEIGH_CODE::level INT::is_eq BOOL::not AM_LOOP_STMT::has_yield BOOL::not
SYS::destroy(sb); return false-- SYS::destroy
else
loopstmt:=badstmt
end;
else
SYS::destroy(sb); return false-- SYS::destroy
end;
-- Find the single yield statement - either unconditional or
-- under one condition.
sb.calc_stmt_list_weight(loopstmt.body);-- WEIGH_CODE::calc_stmt_list_weight AM_LOOP_STMT::body
if sb.weight>threshold then SYS::destroy(sb); return false end;-- WEIGH_CODE::weight INT::is_lt SYS::destroy
yieldstmt:AM_YIELD_STMT;
badstmt:=sb.badstmt;-- WEIGH_CODE::badstmt
sb.clear_badstmt;-- WEIGH_CODE::clear_badstmt
typecase badstmt
when AM_YIELD_STMT then
-- we ignore complex iters completely, as they are very rare,
-- and the way they are inlined here poses some problems. The
-- resulting code may have iters that are not associated with
-- the innermost loop. The optimizer gets very confused with
-- iters.
-- if ~(sb.level=2 or (sb.level=3 and ~void(sb.enclosing_if))) then
if ~(sb.level=2) then-- WEIGH_CODE::level INT::is_eq BOOL::not
SYS::destroy(sb); return false-- SYS::destroy
else
yieldstmt:=badstmt
end;
else
SYS::destroy(sb); return false-- SYS::destroy
end;
sb.calc_expr_weight(yieldstmt.val);-- WEIGH_CODE::calc_expr_weight AM_YIELD_STMT::val
if sb.weight>threshold then SYS::destroy(sb); return false end;-- WEIGH_CODE::weight INT::is_lt SYS::destroy
-- Skip stuff after the single yield.
sb.calc_stmt_list_weight(yieldstmt.next);-- WEIGH_CODE::calc_stmt_list_weight AM_YIELD_STMT::next
if ~void(sb.badstmt) or sb.weight>threshold then-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight INT::is_lt
SYS::destroy(sb); return false end;-- SYS::destroy
sb.uplevel;-- WEIGH_CODE::uplevel
if sb.level=2 then-- WEIGH_CODE::level INT::is_eq
if sb.true_branch then-- WEIGH_CODE::true_branch
sb.calc_stmt_list_weight(sb.enclosing_if.if_false);-- WEIGH_CODE::calc_stmt_list_weight WEIGH_CODE::enclosing_if AM_IF_STMT::if_false
else
sb.calc_stmt_list_weight(sb.enclosing_if.if_true);-- WEIGH_CODE::calc_stmt_list_weight WEIGH_CODE::enclosing_if AM_IF_STMT::if_true
end;
if ~void(sb.badstmt) or sb.weight>threshold then-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight INT::is_lt
SYS::destroy(sb); return false end;-- SYS::destroy
sb.calc_stmt_list_weight(sb.enclosing_if.next);-- WEIGH_CODE::calc_stmt_list_weight WEIGH_CODE::enclosing_if AM_IF_STMT::next
if ~void(sb.badstmt) or sb.weight>threshold then-- WEIGH_CODE::badstmt BOOL::not WEIGH_CODE::weight INT::is_lt
SYS::destroy(sb); return false end;-- SYS::destroy
sb.uplevel;-- WEIGH_CODE::uplevel
end;
-- Nothing should come after the loop.
if ~void(loopstmt.next) then-- AM_LOOP_STMT::next BOOL::not
SYS::destroy(sb); return false end;-- SYS::destroy
sb.uplevel;-- WEIGH_CODE::uplevel
SYS::destroy(sb);-- SYS::destroy
return true
end;
-- Create a new inlineable iterator. Copy the code, so that when the code
-- is emitted and destroyed, the inlined table will remain intact.
-- Add initializations of local variables.
create (rout:AM_ROUT_DEF):SAME is
r::=new;
r.signature:=rout.sig;-- INLINE_ITER::signature AM_ROUT_DEF::sig
r.is_special := false; -- general purpose inlining-- INLINE_ITER::is_special
r.copy_iter (rout);-- INLINE_ITER::copy_iter
iters:=iters+1;-- INLINE_ITER::iters INLINE_ITER::iters INT::plus
-- #OUT + "Able to inline: " +rout.sig.str+'\n';
return r
end;
copy_iter (rout:AM_ROUT_DEF) is
change_vars:=#(rout);-- INLINE_ITER::change_vars CHANGE_VARS::create
xc::=#XFORM_CODE(change_vars.saved_subst);-- XFORM_CODE::create INLINE_ITER::change_vars CHANGE_VARS::saved_subst
xc.record_calls:=false;-- XFORM_CODE::record_calls
proxy_loop_stmt::=#AM_LOOP_STMT(void);-- AM_LOOP_STMT::create
xc.new_loop_stmt:=proxy_loop_stmt;-- XFORM_CODE::new_loop_stmt
-- The code before the loop statement.
BEFLOOP_code:=xc.xform_stmt_list(rout.code);-- INLINE_ITER::BEFLOOP_code XFORM_CODE::xform_stmt_list AM_ROUT_DEF::code
if void(xc.loop_stmt) then-- XFORM_CODE::loop_stmt
flat_yield:=true;-- INLINE_ITER::flat_yield
change_vars.after_saving;-- INLINE_ITER::change_vars CHANGE_VARS::after_saving
SYS::destroy(xc);-- SYS::destroy
return
end;
loop_firsts:=#(xc.loop_stmt.firsts.size);-- INLINE_ITER::loop_firsts FLIST{1}::create XFORM_CODE::loop_stmt AM_LOOP_STMT::firsts FLIST{1}::size
loop
loop_firsts:=loop_firsts.push-- INLINE_ITER::loop_firsts INLINE_ITER::loop_firsts FLIST{1}::push
(change_vars.saved_subst.get(xc.loop_stmt.firsts.elt!))-- INLINE_ITER::change_vars CHANGE_VARS::saved_subst FMAP{2}::get XFORM_CODE::loop_stmt AM_LOOP_STMT::firsts FLIST{1}::elt!
end;
-- The code before and after the yield.
IINIT_code:=xc.xform_stmt_list(xc.loop_stmt.body);-- INLINE_ITER::IINIT_code XFORM_CODE::xform_stmt_list XFORM_CODE::loop_stmt AM_LOOP_STMT::body
iey::=xc.if_encl_yield;-- XFORM_CODE::if_encl_yield
flat_yield:=void(iey);-- INLINE_ITER::flat_yield
if flat_yield then-- INLINE_ITER::flat_yield
ITERM_code:=xc.after_yield;-- INLINE_ITER::ITERM_code XFORM_CODE::after_yield
else
s1::=IINIT_code;-- INLINE_ITER::IINIT_code
if SYS::ob_eq(s1,iey) then-- SYS::ob_eq
IINIT_code:=void-- INLINE_ITER::IINIT_code
else
loop until!(SYS::ob_eq(s1.next,iey)) end;-- SYS::ob_eq
s1.next:=void
end;
ITERM_code:=iey.next;-- INLINE_ITER::ITERM_code AM_IF_STMT::next
end;
yield_val:=xc.yield_val;-- INLINE_ITER::yield_val XFORM_CODE::yield_val
-- For a yield inside an if:
if ~flat_yield then-- INLINE_ITER::flat_yield BOOL::not
#OUT+"found complex iter to be inlined: "+rout.sig.str+" ("+rout.sig.srcsig.str+")\n";-- OUT::create OUT::plus OUT::plus AM_ROUT_DEF::sig SIG::str OUT::plus OUT::plus AM_ROUT_DEF::sig SIG::srcsig SIG::str OUT::plus
if xc.true_br_yield then-- XFORM_CODE::true_br_yield
yield_cond:=iey.test;-- INLINE_ITER::yield_cond AM_IF_STMT::test
WYBEF_code:=iey.if_true;-- INLINE_ITER::WYBEF_code AM_IF_STMT::if_true
WYAFT_code:=xc.after_yield;-- INLINE_ITER::WYAFT_code XFORM_CODE::after_yield
WNOY_code:=iey.if_false;-- INLINE_ITER::WNOY_code AM_IF_STMT::if_false
else
-- the yield condition is not (the if statement condition).
bool_tp::=TP_BUILTIN::bool;-- TP_BUILTIN::bool
notsig::=#SIG(bool_tp,#ARRAY{$TP}(0),-- SIG::create ARRAY{1}::create
IDENT_BUILTIN::not_ident,void,bool_tp,false);-- IDENT_BUILTIN::not_ident
--notsig.tp:=bool_tp;
--notsig.name:=IDENT_BUILTIN::not_ident;
--notsig.ret:=bool_tp;
yc::=#AM_ROUT_CALL_EXPR(1,iey.test.source);-- AM_ROUT_CALL_EXPR::create AM_IF_STMT::test
yc.fun:=notsig;-- AM_ROUT_CALL_EXPR::fun
yc[0]:=#(iey.test);-- AM_ROUT_CALL_EXPR::aset AM_CALL_ARG::create AM_IF_STMT::test
yield_cond:=yc;-- INLINE_ITER::yield_cond
WYBEF_code:=iey.if_false;-- INLINE_ITER::WYBEF_code AM_IF_STMT::if_false
WYAFT_code:=xc.after_yield;-- INLINE_ITER::WYAFT_code XFORM_CODE::after_yield
WNOY_code:=iey.if_true;-- INLINE_ITER::WNOY_code AM_IF_STMT::if_true
end
end;
SYS::destroy(proxy_loop_stmt);-- SYS::destroy
change_vars.after_saving;-- INLINE_ITER::change_vars CHANGE_VARS::after_saving
SYS::destroy(xc)-- SYS::destroy
end;
-- Do inline the iterator.
inline (call:AM_ITER_CALL_EXPR):$AM_EXPR is
inlined:=inlined+1;-- INLINE_ITER::inlined INLINE_ITER::inlined INT::plus
-- Useful stuff.
bcfalse::=#AM_BOOL_CONST(call.source);-- AM_BOOL_CONST::create AM_ITER_CALL_EXPR::source
bcfalse.tp_at:=TP_BUILTIN::bool;-- AM_BOOL_CONST::tp_at TP_BUILTIN::bool
bcfalse.val:=false;-- AM_BOOL_CONST::val
bctrue::=#AM_BOOL_CONST(call.source);-- AM_BOOL_CONST::create AM_ITER_CALL_EXPR::source
bctrue.tp_at:=TP_BUILTIN::bool;-- AM_BOOL_CONST::tp_at TP_BUILTIN::bool
bctrue.val:=true;-- AM_BOOL_CONST::val
-- Make new copies of all variables.
se::=#AM_STMT_EXPR(call.source);-- AM_STMT_EXPR::create AM_ITER_CALL_EXPR::source
change_vars.new_copy(call.source);-- INLINE_ITER::change_vars CHANGE_VARS::new_copy AM_ITER_CALL_EXPR::source
se.locals:=change_vars.new_vars;-- AM_STMT_EXPR::locals INLINE_ITER::change_vars CHANGE_VARS::new_vars
-- Code transformer.
xc::=#XFORM_CODE(change_vars.new_subst);-- XFORM_CODE::create INLINE_ITER::change_vars CHANGE_VARS::new_subst
xc.record_calls:=true;-- XFORM_CODE::record_calls
proxy_loop_stmt::=#AM_LOOP_STMT(call.source);-- AM_LOOP_STMT::create AM_ITER_CALL_EXPR::source
xc.new_loop_stmt:=proxy_loop_stmt;-- XFORM_CODE::new_loop_stmt
-- Once parameters. Implicit ``in'' mode
init_nonhot::=xc.xform_stmt_list(change_vars.init_nonhot);-- XFORM_CODE::xform_stmt_list INLINE_ITER::change_vars CHANGE_VARS::init_nonhot
s::=init_nonhot;
loop
until!(void(s));
typecase s when AM_ASSIGN_STMT then
if void(s.src) then-- AM_ASSIGN_STMT::src
s.src:=call[change_vars.pind_nonhot.elt!].expr;-- AM_ASSIGN_STMT::src INLINE_ITER::change_vars CHANGE_VARS::pind_nonhot ARRAY{1}::elt! AM_CALL_ARG::expr
end
end;
s:=s.next
end;
-- Parameters that will be passed on every iteration.
init_hot::=xc.xform_stmt_list(change_vars.init_hot);-- XFORM_CODE::xform_stmt_list INLINE_ITER::change_vars CHANGE_VARS::init_hot
s:=init_hot;
loop
until!(void(s));
typecase s when AM_ASSIGN_STMT then
if void(s.src) then-- AM_ASSIGN_STMT::src
ind ::= change_vars.pind_hot.elt!;-- INLINE_ITER::change_vars CHANGE_VARS::pind_hot ARRAY{1}::elt!
ca ::= call[ind];-- AM_ITER_CALL_EXPR::aget
stp ::=call.fun.args[ind-1].tp;-- AM_ITER_CALL_EXPR::fun SIG::args ARRAY{1}::aget INT::minus ARG::tp
if ~SYS::ob_eq(ca.mode, MODES::out_mode) then-- SYS::ob_eq AM_CALL_ARG::mode MODES::out_mode BOOL::not
s.src:=ca.expr;-- AM_ASSIGN_STMT::src AM_CALL_ARG::expr
else
vconst::=#AM_VOID_CONST(ca.source);-- AM_VOID_CONST::create AM_CALL_ARG::source
vconst.tp_at:=stp;-- AM_VOID_CONST::tp_at
s.src := vconst;-- AM_ASSIGN_STMT::src
end;
end
end;
s:=s.next
end;
-- Statements to execute the first time over - initializing non-hot
-- parameters (comes in 2 stages - the general non-inlined iterator
-- code assigns actual arguments to nameless variables in call.init;
-- we have to assign these to formal parameters). Also initialize all
-- hot parameters and local variables of the iterator, and execute
-- the code before the loop statement. Hot parameters should be
-- initialized once, so emit two if statements.
ftm1::=call.init;-- AM_ITER_CALL_EXPR::init
if ~void(ftm1) then ftm1.append(init_nonhot) else ftm1:=init_nonhot end;-- BOOL::not
if_first::=#AM_LOCAL_EXPR(call.source,-- AM_LOCAL_EXPR::create AM_ITER_CALL_EXPR::source
#IDENT(sig.name.str+"_if_first"),TP_BUILTIN::bool);-- IDENT::create INLINE_ITER::sig SIG::name IDENT::str STR::plus TP_BUILTIN::bool
se.locals:=se.locals.push(if_first);-- AM_STMT_EXPR::locals AM_STMT_EXPR::locals FLIST{1}::push
iffstmt1::=#AM_IF_STMT(call.source);-- AM_IF_STMT::create AM_ITER_CALL_EXPR::source
iffstmt1.test:=if_first;-- AM_IF_STMT::test
iffstmt1.if_true:=ftm1;-- AM_IF_STMT::if_true
iffstmt1.if_false:=void;-- AM_IF_STMT::if_false
se.stmts:=iffstmt1;-- AM_STMT_EXPR::stmts
init_vars::=xc.xform_stmt_list(change_vars.init_vars);-- XFORM_CODE::xform_stmt_list INLINE_ITER::change_vars CHANGE_VARS::init_vars
ftm2::=init_vars;
BEFLOOP::=xc.xform_stmt_list(BEFLOOP_code);-- XFORM_CODE::xform_stmt_list INLINE_ITER::BEFLOOP_code
if ~void(ftm2) then ftm2.append(BEFLOOP) else ftm2:=BEFLOOP end;-- BOOL::not
ass::=#AM_ASSIGN_STMT(call.source);-- AM_ASSIGN_STMT::create AM_ITER_CALL_EXPR::source
ass.dest:=if_first;-- AM_ASSIGN_STMT::dest
ass.src:=bcfalse;-- AM_ASSIGN_STMT::src
if ~void(ftm2) then ftm2.append(ass) else ftm2:=ass end;-- BOOL::not
nftm2:$AM_STMT;
if ~flat_yield then nftm2:=xc.xform_stmt_list(WYAFT_code) end;-- INLINE_ITER::flat_yield BOOL::not XFORM_CODE::xform_stmt_list INLINE_ITER::WYAFT_code
ITERM::=xc.xform_stmt_list(ITERM_code);-- XFORM_CODE::xform_stmt_list INLINE_ITER::ITERM_code
if ~void(nftm2) then nftm2.append(ITERM) else nftm2:=ITERM end;-- BOOL::not
if ~void(init_hot) then-- BOOL::not
se.stmts.append(init_hot);-- AM_STMT_EXPR::stmts
iffstmt2::=#AM_IF_STMT(call.source);-- AM_IF_STMT::create AM_ITER_CALL_EXPR::source
iffstmt2.test:=if_first;-- AM_IF_STMT::test
iffstmt2.if_true:=ftm2;-- AM_IF_STMT::if_true
iffstmt2.if_false:=nftm2;-- AM_IF_STMT::if_false
se.stmts.append(iffstmt2)-- AM_STMT_EXPR::stmts
else
if ~void(iffstmt1.if_true) then-- AM_IF_STMT::if_true BOOL::not
iffstmt1.if_true.append(ftm2)-- AM_IF_STMT::if_true
else
iffstmt1.if_true:=ftm2-- AM_IF_STMT::if_true
end;
iffstmt1.if_false:=nftm2-- AM_IF_STMT::if_false
end;
-- To distinguish breaks in embedded iterators from yielding on
-- the condition, both of which break out of the inner loop of
-- a "conditional" iterator.
if ~flat_yield then-- INLINE_ITER::flat_yield BOOL::not
if_yld::=#AM_LOCAL_EXPR(call.source,-- AM_LOCAL_EXPR::create AM_ITER_CALL_EXPR::source
#IDENT(sig.name.str+"_if_yld"),TP_BUILTIN::bool);-- IDENT::create INLINE_ITER::sig SIG::name IDENT::str STR::plus TP_BUILTIN::bool
se.locals:=se.locals.push(if_yld);-- AM_STMT_EXPR::locals AM_STMT_EXPR::locals FLIST{1}::push
ass:=#AM_ASSIGN_STMT(call.source);-- AM_ASSIGN_STMT::create AM_ITER_CALL_EXPR::source
ass.dest:=if_yld;-- AM_ASSIGN_STMT::dest
ass.src:=bcfalse;-- AM_ASSIGN_STMT::src
se.stmts.append(ass);-- AM_STMT_EXPR::stmts
-- loop IINIT; if C then if_yld:=true; break! end; WNOY; ITERM end
loopstmt::=#AM_LOOP_STMT(call.source);-- AM_LOOP_STMT::create AM_ITER_CALL_EXPR::source
loopstmt.has_yield:=false;-- AM_LOOP_STMT::has_yield
lbd::=xc.xform_stmt_list(IINIT_code);-- XFORM_CODE::xform_stmt_list INLINE_ITER::IINIT_code
ass:=#AM_ASSIGN_STMT(call.source);-- AM_ASSIGN_STMT::create AM_ITER_CALL_EXPR::source
ass.dest:=if_yld;-- AM_ASSIGN_STMT::dest
ass.src:=bctrue;-- AM_ASSIGN_STMT::src
ass.append(#AM_BREAK_STMT(call.source));-- AM_ASSIGN_STMT::append AM_BREAK_STMT::create AM_ITER_CALL_EXPR::source
ifcstmt::=#AM_IF_STMT(call.source);-- AM_IF_STMT::create AM_ITER_CALL_EXPR::source
ifcstmt.test:=xc.xform_expr(yield_cond);-- AM_IF_STMT::test XFORM_CODE::xform_expr INLINE_ITER::yield_cond
ifcstmt.if_true:=ass;-- AM_IF_STMT::if_true
ifcstmt.if_false:=void;-- AM_IF_STMT::if_false
if ~void(lbd) then lbd.append(ifcstmt) else lbd:=ifcstmt end;-- BOOL::not
lbd.append(xc.xform_stmt_list(WNOY_code));-- XFORM_CODE::xform_stmt_list INLINE_ITER::WNOY_code
lbd.append(xc.xform_stmt_list(ITERM_code));-- XFORM_CODE::xform_stmt_list INLINE_ITER::ITERM_code
loopstmt.body:=lbd;-- AM_LOOP_STMT::body
se.stmts.append(loopstmt);-- AM_STMT_EXPR::stmts
-- if if_yld then WYBEF else break! end
ifzstmt::=#AM_IF_STMT(call.source);-- AM_IF_STMT::create AM_ITER_CALL_EXPR::source
ifzstmt.test:=if_yld;-- AM_IF_STMT::test
ifzstmt.if_true:=xc.xform_stmt_list(WYBEF_code);-- AM_IF_STMT::if_true XFORM_CODE::xform_stmt_list INLINE_ITER::WYBEF_code
ifzstmt.if_false:=#AM_BREAK_STMT(call.source);-- AM_IF_STMT::if_false AM_BREAK_STMT::create AM_ITER_CALL_EXPR::source
se.stmts.append(ifzstmt);-- AM_STMT_EXPR::stmts
else -- Execute INIT;
se.stmts.append(xc.xform_stmt_list(IINIT_code))-- AM_STMT_EXPR::stmts XFORM_CODE::xform_stmt_list INLINE_ITER::IINIT_code
end;
-- Yielded value; calls; stuff having to do with nested iter calls.
if ~void(yield_val) then se.expr:=xc.xform_expr(yield_val) end;-- INLINE_ITER::yield_val BOOL::not AM_STMT_EXPR::expr XFORM_CODE::xform_expr INLINE_ITER::yield_val
-- For out/inout args, copy back the results
s := init_hot;
loop
until!(void(s));
ca ::= call[change_vars.pind_hot.elt!];-- INLINE_ITER::change_vars CHANGE_VARS::pind_hot ARRAY{1}::elt!
if SYS::ob_eq(ca.mode, MODES::out_mode) or -- SYS::ob_eq AM_CALL_ARG::mode MODES::out_mode
SYS::ob_eq(ca.mode,MODES::inout_mode)-- SYS::ob_eq AM_CALL_ARG::mode MODES::inout_mode
then
typecase s when AM_ASSIGN_STMT then
cp_stmt ::= #AM_ASSIGN_STMT(call.source);-- AM_ASSIGN_STMT::create AM_ITER_CALL_EXPR::source
cp_stmt.dest := ca.expr;-- AM_ASSIGN_STMT::dest AM_CALL_ARG::expr
cp_stmt.src := s.dest;-- AM_ASSIGN_STMT::src AM_ASSIGN_STMT::dest
se.stmts.append(cp_stmt); -- AM_STMT_EXPR::stmts
end;
end;
s := s.next;
end;
se.calls:=xc.calls;-- AM_STMT_EXPR::calls XFORM_CODE::calls
se.its:=proxy_loop_stmt.its;-- AM_STMT_EXPR::its AM_LOOP_STMT::its
se.bits:=proxy_loop_stmt.bits;-- AM_STMT_EXPR::bits AM_LOOP_STMT::bits
se.firsts:=#(loop_firsts.size+1);-- AM_STMT_EXPR::firsts FLIST{1}::create INLINE_ITER::loop_firsts FLIST{1}::size INT::plus
se.firsts:=se.firsts.push(if_first);-- AM_STMT_EXPR::firsts AM_STMT_EXPR::firsts FLIST{1}::push
loop
se.firsts:=se.firsts.push-- AM_STMT_EXPR::firsts AM_STMT_EXPR::firsts FLIST{1}::push
(change_vars.new_subst.get(loop_firsts.elt!))-- INLINE_ITER::change_vars CHANGE_VARS::new_subst FMAP{2}::get INLINE_ITER::loop_firsts FLIST{1}::elt!
end;
SYS::destroy(proxy_loop_stmt);-- SYS::destroy
change_vars.after_one_use;-- INLINE_ITER::change_vars CHANGE_VARS::after_one_use
SYS::destroy(xc);-- SYS::destroy
return se
end
end;
class INLINE_ROUT < $INLINE_ROUT_SIG
class INLINE_ROUT < $INLINE_ROUT_SIG is
shared inlined,routines:INT;
-- Mechanism for transforming local variables and parameters.
private attr change_vars:CHANGE_VARS;
-- The routine's transformed code without the final return.
private attr code:$AM_STMT;
-- The value returned.
private attr return_val:$AM_EXPR;
attr is_special:BOOL;
private attr signature:SIG;
sig:SIG is return signature end;-- INLINE_ROUT::signature
-- Note that the way DFS is done on routines, there can be no recursive
-- expansion (and the body of the routine is already expanded).
-- Can a routine be inlined?
is_inlineable (rout:AM_ROUT_DEF,threshold:INT, prog:PROG):BOOL is
if prog.generate_am.sig_recursive.test(rout.sig) then-- PROG::generate_am FSET{1}::test AM_ROUT_DEF::sig
return false;
end;
-- #OUT+"testing if "+rout.sig.str+" is inlineable: ";
sb::=#WEIGH_CODE(threshold);-- WEIGH_CODE::create
sb.calc_stmt_list_weight(rout.code);-- WEIGH_CODE::calc_stmt_list_weight AM_ROUT_DEF::code
if sb.weight>threshold then SYS::destroy(sb); -- WEIGH_CODE::weight INT::is_lt SYS::destroy
-- #OUT+"no, weight "+sb.weight+" too high\n";
return false end;
badstmt::=sb.badstmt;-- WEIGH_CODE::badstmt
sb.clear_badstmt;-- WEIGH_CODE::clear_badstmt
if ~void(badstmt) then-- BOOL::not
typecase badstmt
when AM_RETURN_STMT then -- only top-level returns are allowed.
if sb.level > 1 then -- WEIGH_CODE::level INT::is_lt
-- #OUT+"no, I found a non toplevel return at level " + sb.level + "\n";
SYS::destroy(sb); -- SYS::destroy
return false
end;
sb.calc_expr_weight(badstmt.val);-- WEIGH_CODE::calc_expr_weight AM_RETURN_STMT::val
if sb.weight>threshold then-- WEIGH_CODE::weight INT::is_lt
SYS::destroy(sb); -- #OUT+"no, weight "+sb.weight+" too high\n";-- SYS::destroy
return false
end;
else SYS::destroy(sb); -- #OUT+"no, expected a AM_RETURN_STMT, got a "+SYS::str_for_tp(SYS::tp(badstmt))+"\n";-- SYS::destroy
return false
end
end;
SYS::destroy(sb);-- SYS::destroy
-- #OUT+"yes\n";
return true
end;
-- Create a new inlineable routine. Copy the code, so that when the code
-- is emitted and destroyed, the inlined table will remain intact.
-- Add initializations of local variables, and strip the final return.
create (rout:AM_ROUT_DEF):SAME is
r::=new;
r.signature:=rout.sig;-- INLINE_ROUT::signature AM_ROUT_DEF::sig
r.is_special:=false; -- general purpose inlining-- INLINE_ROUT::is_special
r.copy_rout(rout);-- INLINE_ROUT::copy_rout
routines:=routines+1;-- INLINE_ROUT::routines INLINE_ROUT::routines INT::plus
return r
end;
private copy_rout (rout:AM_ROUT_DEF) is
change_vars:=#(rout);-- INLINE_ROUT::change_vars CHANGE_VARS::create
xc::=#XFORM_CODE(change_vars.saved_subst);-- XFORM_CODE::create INLINE_ROUT::change_vars CHANGE_VARS::saved_subst
xc.record_calls:=false;-- XFORM_CODE::record_calls
code:=xc.xform_stmt_list(rout.code);-- INLINE_ROUT::code XFORM_CODE::xform_stmt_list AM_ROUT_DEF::code
return_val:=xc.return_val;-- INLINE_ROUT::return_val XFORM_CODE::return_val
change_vars.after_saving;-- INLINE_ROUT::change_vars CHANGE_VARS::after_saving
SYS::destroy(xc)-- SYS::destroy
end;
-- Do inline the routine. Copy the statements (since they are going
-- to be inserted into several lists).
inline (call:AM_ROUT_CALL_EXPR):$AM_EXPR is
inlined:=inlined+1;-- INLINE_ROUT::inlined INLINE_ROUT::inlined INT::plus
-- Make new copies of all variables.
se::=#AM_STMT_EXPR(call.source);-- AM_STMT_EXPR::create AM_ROUT_CALL_EXPR::source
change_vars.new_copy(call.source);-- INLINE_ROUT::change_vars CHANGE_VARS::new_copy AM_ROUT_CALL_EXPR::source
se.locals:=change_vars.new_vars;-- AM_STMT_EXPR::locals INLINE_ROUT::change_vars CHANGE_VARS::new_vars
-- Initialize the formal parameters with actual arguments.
xc::=#XFORM_CODE(change_vars.new_subst);-- XFORM_CODE::create INLINE_ROUT::change_vars CHANGE_VARS::new_subst
xc.record_calls:=false;-- XFORM_CODE::record_calls
init_parms::=xc.xform_stmt_list(change_vars.init_parms);-- XFORM_CODE::xform_stmt_list INLINE_ROUT::change_vars CHANGE_VARS::init_parms
s::=init_parms;
i::=-1;
loop
until!(void(s));
stp:$TP;
typecase s when AM_ASSIGN_STMT then
if void(s.src) then-- AM_ASSIGN_STMT::src
ca ::= call.elt!;-- AM_ROUT_CALL_EXPR::elt!
if i = -1 then-- INT::is_eq
stp := call.fun.tp;-- AM_ROUT_CALL_EXPR::fun SIG::tp
else
stp := call.fun.args[i].tp;-- AM_ROUT_CALL_EXPR::fun SIG::args ARRAY{1}::aget ARG::tp
end;
i := i+1;-- INT::plus
if ~SYS::ob_eq(ca.mode, MODES::out_mode) then-- SYS::ob_eq AM_CALL_ARG::mode MODES::out_mode BOOL::not
s.src:=ca.expr;-- AM_ASSIGN_STMT::src AM_CALL_ARG::expr
else
vconst::=#AM_VOID_CONST(ca.source);-- AM_VOID_CONST::create AM_CALL_ARG::source
vconst.tp_at:=stp;-- AM_VOID_CONST::tp_at
s.src := vconst; -- AM_ASSIGN_STMT::src
end;
end
end;
s:=s.next
end;
-- Copy the statements.
xc.record_calls:=true;-- XFORM_CODE::record_calls
se.stmts:=xc.xform_stmt_list(code);-- AM_STMT_EXPR::stmts XFORM_CODE::xform_stmt_list INLINE_ROUT::code
if ~void(init_parms) then-- BOOL::not
init_parms.append(se.stmts); se.stmts:=init_parms end;-- AM_STMT_EXPR::stmts AM_STMT_EXPR::stmts
-- For out/inout args, copy back the results
s := init_parms;
loop
until!(void(s));
ca ::= call.elt!;-- AM_ROUT_CALL_EXPR::elt!
if SYS::ob_eq(ca.mode, MODES::out_mode) or -- SYS::ob_eq AM_CALL_ARG::mode MODES::out_mode
SYS::ob_eq(ca.mode,MODES::inout_mode)-- SYS::ob_eq AM_CALL_ARG::mode MODES::inout_mode
then
typecase s when AM_ASSIGN_STMT then
cp_stmt ::= #AM_ASSIGN_STMT(call.source);-- AM_ASSIGN_STMT::create AM_ROUT_CALL_EXPR::source
cp_stmt.dest := ca.expr;-- AM_ASSIGN_STMT::dest AM_CALL_ARG::expr
-- AM_OUT::AM_out(ca.expr);
cp_stmt.src := s.dest;-- AM_ASSIGN_STMT::src AM_ASSIGN_STMT::dest
se.stmts.append(cp_stmt); -- AM_STMT_EXPR::stmts
end;
end;
s := s.next;
end;
if ~void(return_val) then-- INLINE_ROUT::return_val BOOL::not
se.expr:=xc.xform_expr(return_val) end;-- AM_STMT_EXPR::expr XFORM_CODE::xform_expr INLINE_ROUT::return_val
se.calls:=xc.calls;-- AM_STMT_EXPR::calls XFORM_CODE::calls
SYS::destroy(xc);-- SYS::destroy
change_vars.after_one_use;-- INLINE_ROUT::change_vars CHANGE_VARS::after_one_use
return se
end;
end;
class INLINE < $INLINE
class INLINE < $INLINE is
include CS_COMPONENT;
const default_rout_thres := 16; -- default thresholds for inlining
const default_iter_thres := 16; -- found/guessed to be best on Sparcs
attr inline_routs:BOOL;
attr inline_iters:BOOL;
private attr rtbl:INLINE_ROUT_TBL;
private attr itbl:INLINE_ITER_TBL;
attr rout_thres:INT;
attr iter_thres:INT;
create(p:PROG):SAME is
r::=new;
r.rtbl:=#(1024);-- INLINE::rtbl INLINE_ROUT_TBL::create
r.itbl:=#(64);-- INLINE::itbl INLINE_ITER_TBL::create
r.prog:=p;-- INLINE::prog
r.inline_routs:=false; -- no default inlining-- INLINE::inline_routs
r.inline_iters:=false;-- INLINE::inline_iters
r.rout_thres:=default_rout_thres;-- INLINE::rout_thres INLINE::default_rout_thres
r.iter_thres:=default_iter_thres;-- INLINE::iter_thres INLINE::default_iter_thres
return r;
end;
init is
-- Insert translator for folding integer addition
int_tp::=TP_BUILTIN::int;-- TP_BUILTIN::int
ar::=#ARRAY{ARG}(1);-- ARRAY{1}::create
ar[0]:=#(int_tp);-- ARRAY{1}::aset ARG::create
ipiis::=#SIG(int_tp, #ARRAY{$TP}(0),-- SIG::create ARRAY{1}::create
IDENT_BUILTIN::plus_ident, ar, int_tp,true);-- IDENT_BUILTIN::plus_ident
rtbl:=rtbl.insert(#INLINE_INT_FOLD(ipiis));-- INLINE::rtbl INLINE::rtbl INLINE_ROUT_TBL::insert INLINE_INT_FOLD::create
end;
-- Consider a procedure for inlining. If it is known to be recursive,
-- make sure it is emitted, unlike most inline procedures.
consider (am:AM_ROUT_DEF) is
-- don't inline built in routines and iters!
if ~am.sig.is_builtin then-- AM_ROUT_DEF::sig SIG::is_builtin BOOL::not
-- #OUT+"testing function/iter "+am.sig.str+" if it may be inlined\n";
if am.is_iter then-- AM_ROUT_DEF::is_iter
itbl:=itbl.test_and_insert(am,inline_iters,iter_thres,prog)-- INLINE::itbl INLINE::itbl INLINE_ITER_TBL::test_and_insert INLINE::inline_iters INLINE::iter_thres INLINE::prog
else
rtbl:=rtbl.test_and_insert(am,inline_routs,rout_thres,prog)-- INLINE::rtbl INLINE::rtbl INLINE_ROUT_TBL::test_and_insert INLINE::inline_routs INLINE::rout_thres INLINE::prog
end
else
-- #OUT+"the builtin function/iter "+am.sig.str+" will not be inlined\n";
end;
end;
special_inline(call:AM_ROUT_CALL_EXPR):$AM_EXPR is
in::=rtbl.get_query(call.fun);-- INLINE::rtbl INLINE_ROUT_TBL::get_query AM_ROUT_CALL_EXPR::fun
if void(in) then return call end;
if in.is_special then
return in.inline(call);
else
return call;
end;
end;
-- general_inline(call:AM_ROUT_CALL_EXPR):$AM_EXPR is
-- in::=rtbl.get_query(call.fun);
-- if void(in) then return call end;
-- if ~in.is_special then
-- return in.inline(call);
-- else
-- return call;
-- end;
-- end;
-- Returns the expression that should replace the "call" routine call
-- It will make the necessary changes to add new calls and locals to
-- the routine definition, but it will not change the AM_TREE of the
-- routine.
general_inline(rout:AM_ROUT_DEF,call:AM_ROUT_CALL_EXPR):$AM_EXPR is
in::=rtbl.get_query(call.fun);-- INLINE::rtbl INLINE_ROUT_TBL::get_query AM_ROUT_CALL_EXPR::fun
if void(in) then return call end;
if ~in.is_special then-- BOOL::not
n::=in.inline(call);
typecase n when AM_STMT_EXPR then
rout.calls:=rout.calls.concat(n.calls);-- AM_ROUT_DEF::calls AM_ROUT_DEF::calls FLIST{1}::concat AM_STMT_EXPR::calls
rout.locals:=rout.locals.concat(n.locals);-- AM_ROUT_DEF::locals AM_ROUT_DEF::locals FLIST{1}::concat AM_STMT_EXPR::locals
if rout.calls.index_of(call)<0 then-- AM_ROUT_DEF::calls FLIST{1}::index_of INT::is_lt
if prog.opt_debug then-- INLINE::prog PROG::opt_debug
#OUT+"WARNING: function "+call.fun.str+" is not registered in "+rout.sig.str+"\n";-- OUT::create OUT::plus OUT::plus AM_ROUT_CALL_EXPR::fun SIG::str OUT::plus OUT::plus AM_ROUT_DEF::sig SIG::str OUT::plus
end;
else
rout.calls.delete_elt_ordered(call);-- AM_ROUT_DEF::calls FLIST{1}::delete_elt_ordered
end;
else end;
return n;
else
return call;
end;
end;
special_inline(call:AM_ITER_CALL_EXPR):$AM_EXPR is
inl::=itbl.get_query(call.fun);-- INLINE::itbl INLINE_ITER_TBL::get_query AM_ITER_CALL_EXPR::fun
if void(inl) then return call end;
if inl.is_special then
return inl.inline(call);
else
return call;
end;
end;
-- general_inline(call:AM_ITER_CALL_EXPR):$AM_EXPR is
-- inl::=itbl.get_query(call.fun);
-- if void(inl) then return call end;
-- if ~inl.is_special then
-- return inl.inline(call);
-- else
-- return call;
-- end;
-- end;
-- Returns the expression that should replace the "call" iter call
-- It will make the necessary changes to add new calls and locals to
-- the routine definition, but it will not change the AM_TREE of the
-- routine.
general_inline(rout:AM_ROUT_DEF,lp:AM_LOOP_STMT,call:AM_ITER_CALL_EXPR):$AM_EXPR is
inl::=itbl.get_query(call.fun);-- INLINE::itbl INLINE_ITER_TBL::get_query AM_ITER_CALL_EXPR::fun
if void(inl) then return call end;
if ~inl.is_special then-- BOOL::not
n::=inl.inline(call);
typecase n when AM_STMT_EXPR then
rout.calls:=rout.calls.concat(n.calls);-- AM_ROUT_DEF::calls AM_ROUT_DEF::calls FLIST{1}::concat AM_STMT_EXPR::calls
rout.locals:=rout.locals.concat(n.locals);-- AM_ROUT_DEF::locals AM_ROUT_DEF::locals FLIST{1}::concat AM_STMT_EXPR::locals
loop n.its.elt!.lp:=lp; end;-- AM_STMT_EXPR::its FLIST{1}::elt! AM_ITER_CALL_EXPR::lp
loop n.bits.elt!.lp:=lp; end;-- AM_STMT_EXPR::bits FLIST{1}::elt! AM_BND_ITER_CALL_EXPR::lp
lp.its:=lp.its.concat(n.its);-- AM_LOOP_STMT::its AM_LOOP_STMT::its FLIST{1}::concat AM_STMT_EXPR::its
lp.bits:=lp.bits.concat(n.bits);-- AM_LOOP_STMT::bits AM_LOOP_STMT::bits FLIST{1}::concat AM_STMT_EXPR::bits
lp.firsts:=lp.firsts.concat(n.firsts);-- AM_LOOP_STMT::firsts AM_LOOP_STMT::firsts FLIST{1}::concat AM_STMT_EXPR::firsts
if lp.its.index_of(call)<0 then-- AM_LOOP_STMT::its FLIST{1}::index_of INT::is_lt
if prog.opt_debug then-- INLINE::prog PROG::opt_debug
#OUT+"WARNING: iter "+call.fun.str+" is not registered in LOOP_STMT\n";-- OUT::create OUT::plus OUT::plus AM_ITER_CALL_EXPR::fun SIG::str OUT::plus
AM_OUT::AM_out(lp);-- AM_OUT::AM_out
#OUT+"END_OF_LOOP\n";-- OUT::create OUT::plus
end;
else
lp.its.delete_elt_ordered(call);-- AM_LOOP_STMT::its FLIST{1}::delete_elt_ordered
end;
if rout.calls.index_of(call)<0 then-- AM_ROUT_DEF::calls FLIST{1}::index_of INT::is_lt
if prog.opt_debug then-- INLINE::prog PROG::opt_debug
#OUT+"WARNING: iter "+call.fun.str+" is not registered in "+rout.sig.str+"\n";-- OUT::create OUT::plus OUT::plus AM_ITER_CALL_EXPR::fun SIG::str OUT::plus OUT::plus AM_ROUT_DEF::sig SIG::str OUT::plus
end;
else
rout.calls.delete_elt_ordered(call);-- AM_ROUT_DEF::calls FLIST{1}::delete_elt_ordered
end;
else end;
return n;
else
return call;
end;
end;
inlined(s:SIG):BOOL is
if s.is_iter then-- SIG::is_iter
inl::=itbl.get_query(s);-- INLINE::itbl INLINE_ITER_TBL::get_query
return ~void(inl)
else-- BOOL::not
inl::=rtbl.get_query(s);-- INLINE::rtbl INLINE_ROUT_TBL::get_query
return ~void(inl)
end-- BOOL::not
end;
end;
class INLINE_ROUT_TBL
class INLINE_ROUT_TBL is
-- A table of $INLINE_ROUT_SIG objects retrievable by signature.
-- Only those objects which are to be inlined are in here. If a
-- signature has been transformed and it isn't in here, then
-- it isn't inlinable.
--
-- `get_query(s:SIG):$INLINE_ROUT_SIG' yields the info for the sig `s'.
-- `test($INLINE_ROUT_SIG):BOOL' tests for the given $INLINE_ROUT_SIG.
-- `insert($INLINE_ROUT_SIG):SAME' inserts an inline.
-- `delete($INLINE_ROUT_SIG):SAME' deletes an inline.
-- `elt!:ELT' yields each inline.
include FQSET{SIG,$INLINE_ROUT_SIG};
query_test(s:SIG, in:$INLINE_ROUT_SIG):BOOL is
-- True if `in' is info for the signature `s'.
if void(in) then return false end;
return in.sig=s end;-- SIG::is_eq
query_hash(s:SIG):INT is
-- A hash value computed from the sig `s'.
sc::=3;
r::=s.name.hash; -- Make depend on name.-- SIG::name IDENT::hash
r:=r.bxor(SYS::id(s.tp)*sc); -- Make depend on type-- INT::bxor SYS::id SIG::tp INT::times
loop sc:=sc.mplus(98); r:=r.bxor(SYS::id(s.args.elt!.tp).mtimes(sc)) end; -- And on params.-- INT::mplus INT::bxor SYS::id SIG::args ARRAY{1}::elt! ARG::tp INT::mtimes
return r end;
elt_hash(in:$INLINE_ROUT_SIG):INT is
-- A hash value computed from the signature of `in'.
return query_hash(in.sig) end;-- INLINE_ROUT_TBL::query_hash
test_and_insert(am:AM_ROUT_DEF,inline_short:BOOL,threshold:INT,prog:PROG):SAME is
-- Test `am' for whether it should be inlinable, if it should
-- insert it into the table and return the table. If not,
-- leave the table alone.
if am.is_abstract or am.is_external or void(am.code) then return self; end;-- AM_ROUT_DEF::is_abstract AM_ROUT_DEF::is_external AM_ROUT_DEF::code
-- if am.is_abstract or am.is_external or void(am.code) or
-- (TRANS::is_some_array_sig(am.srcsig) and ~TRANS::is_array_sig(am.srcsig)) then return self end;
-- Add modes everywhere !!!!
-- Special cases.
if void(am.code.next) then-- AM_ROUT_DEF::code
stmts::=am.code;-- AM_ROUT_DEF::code
typecase stmts
when AM_RETURN_STMT then
val::=stmts.val;-- AM_RETURN_STMT::val
typecase val
when AM_ATTR_EXPR then
if SYS::ob_eq(val.ob,am[0].expr) then -- must be self.-- SYS::ob_eq AM_ATTR_EXPR::ob AM_ROUT_DEF::aget AM_FORMAL_ARG::expr
return insert(#INLINE_ATTR_READ(am));-- INLINE_ROUT_TBL::insert INLINE_ATTR_READ::create
end;
when AM_VATTR_ASSIGN_EXPR then --value attr write
if SYS::ob_eq(val.ob,am[0].expr) then-- SYS::ob_eq AM_VATTR_ASSIGN_EXPR::ob AM_ROUT_DEF::aget AM_FORMAL_ARG::expr
return insert(#INLINE_VATTR_WRITE(am));-- INLINE_ROUT_TBL::insert INLINE_VATTR_WRITE::create
end;
when AM_GLOBAL_EXPR then
return insert(#INLINE_GLOBAL_READ(am));-- INLINE_ROUT_TBL::insert INLINE_GLOBAL_READ::create
else -- don't inline
end;
when AM_ASSIGN_STMT then
dest::=stmts.dest;-- AM_ASSIGN_STMT::dest
src::=stmts.src;-- AM_ASSIGN_STMT::src
typecase dest
when AM_ATTR_EXPR then --reference attribute write
if am.asize>1 and SYS::ob_eq(dest.ob,am[0].expr) -- AM_ROUT_DEF::asize INT::is_lt SYS::ob_eq AM_ATTR_EXPR::ob AM_ROUT_DEF::aget AM_FORMAL_ARG::expr
and SYS::ob_eq(src,am[1].expr) then-- SYS::ob_eq AM_ROUT_DEF::aget AM_FORMAL_ARG::expr
return insert(#INLINE_ATTR_WRITE(am));-- INLINE_ROUT_TBL::insert INLINE_ATTR_WRITE::create
end;
else -- don't inline
end;
else -- don't inline
end;
end;
-- if we compile with -O_debug we don't inline any iter/routine from the
-- OPT_DEBUG class
if prog.opt_debug and am.sig.tp.str="OPT_DEBUG" then return self; end;-- PROG::opt_debug AM_ROUT_DEF::sig SIG::tp STR::is_eq
-- Try the general-purpose inliner.
if inline_short and
INLINE_ROUT::is_inlineable(am,threshold, prog) then-- INLINE_ROUT::is_inlineable
return insert(#INLINE_ROUT(am))-- INLINE_ROUT_TBL::insert INLINE_ROUT::create
end;
return self
end;
end;
class INLINE_ITER_TBL
class INLINE_ITER_TBL is
-- A table of $INLINE_ITER_SIG objects retrievable by signature.
-- Only those objects which are to be inlined are in here. If a
-- signature has been transformed and it isn't in here, then
-- it isn't inlinable.
--
-- `get_query(s:SIG):$INLINE_ITER_SIG' yields the info for the sig `s'.
-- `test($INLINE_ITER_SIG):BOOL' tests for the given $INLINE_ITER_SIG.
-- `insert($INLINE_ITER_SIG):SAME' inserts an inline.
-- `delete($INLINE_ITER_SIG):SAME' deletes an inline.
-- `elt!:ELT' yields each inline.
include FQSET{SIG,$INLINE_ITER_SIG};
query_test(s:SIG, in:$INLINE_ITER_SIG):BOOL is
-- True if `in' is info for the signature `s'.
if void(in) then return false end;
return in.sig=s end;-- SIG::is_eq
query_hash(s:SIG):INT is
-- A hash value computed from the sig `s'.
sc::=3;
r::=s.name.hash; -- Make depend on name.-- SIG::name IDENT::hash
r:=r.bxor(SYS::id(s.tp)*sc); -- Make depend on type-- INT::bxor SYS::id SIG::tp INT::times
loop sc:=sc.mplus(98); r:=r.bxor(SYS::id(s.args.elt!.tp).mtimes(sc)) end; -- And on params.-- INT::mplus INT::bxor SYS::id SIG::args ARRAY{1}::elt! ARG::tp INT::mtimes
return r end;
elt_hash(in:$INLINE_ITER_SIG):INT is
-- A hash value computed from the signature of `in'.
return query_hash(in.sig) end;-- INLINE_ITER_TBL::query_hash
test_and_insert(am:AM_ROUT_DEF,inline_short:BOOL,threshold:INT,prog:PROG):SAME is
-- Test `am' for whether it should be inlinable, if it should
-- insert it into the table and return the table. If not,
-- leave the table alone.
if am.is_abstract or am.is_external or void(am.code) then-- AM_ROUT_DEF::is_abstract AM_ROUT_DEF::is_external AM_ROUT_DEF::code
return self end;
-- if we compile with -O_debug we don't inline any iter/routine from the
-- OPT_DEBUG class
if prog.opt_debug and am.sig.tp.str="OPT_DEBUG" then return self; end;-- PROG::opt_debug AM_ROUT_DEF::sig SIG::tp STR::is_eq
if inline_short and INLINE_ITER::is_inlineable(am,threshold, prog) then-- INLINE_ITER::is_inlineable
return insert(#INLINE_ITER(am))-- INLINE_ITER_TBL::insert INLINE_ITER::create
else
return self
end
end;
end;