layout.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
---------------------------> Sather 1.1 source file <--------------------------
abstract class $LAYOUT < $STR
abstract class $LAYOUT < $STR is
-- A layout for which a C typedef will have to be emitted. We
-- abstract these out because C requires that attribute
-- dependencies be respected; we have to build a table and then
-- generate the typedefs in topological order.
dependencies:FLIST{$LAYOUT}; -- Everything that this layout depends on.
-- This can be made into an iterator once dispatched iters work.
typedef(c:CGEN):STR; -- A C typedef for this layout
str:STR; -- To print out the layout
end;
class LAYOUT_TBL
class LAYOUT_TBL is
-- Registry between $TPs and $LAYOUTs. Just a place for a global.
shared layout_tbl:FMAP{$TP,$LAYOUT};
shared prog:PROG;
shared cgen:CGEN;
add(t:$TP,l:$LAYOUT) is
layout_tbl:=layout_tbl.insert(t,l);-- LAYOUT_TBL::layout_tbl LAYOUT_TBL::layout_tbl FMAP{2}::insert
end;
layout(t:$TP):$LAYOUT pre ~void(t) is-- BOOL::not
-- the $LAYOUT object corresponding to a type. If it doesn't
-- exist already, it will be made.
l:$LAYOUT;
if t.is_builtin then l:=#BUILTIN_LAYOUT(t);-- BUILTIN_LAYOUT::create
elsif t.is_external then l:=#EXTERNAL_LAYOUT(t);-- EXTERNAL_LAYOUT::create
elsif t.is_abstract then l:=#ABSTRACT_LAYOUT(t,prog);-- ABSTRACT_LAYOUT::create LAYOUT_TBL::prog
elsif t.is_bound then
if t.kind = TP_KIND::rout_tp then -- INT::is_eq TP_KIND::rout_tp
l:=#BOUND_TYPE_LAYOUT(t);-- BOUND_TYPE_LAYOUT::create
--#OUT+"layout called for : "+t.str+"\n";
--#OUT+"Nr of bnd rout types defined: "+ prog.tp_tbl.rout_tbl.size +"\n";
--loop
-- #OUT+prog.tp_tbl.rout_tbl.elt!.str +"\n";
--end;
elsif t.kind = TP_KIND::iter_tp then-- INT::is_eq TP_KIND::iter_tp
l:=#BOUND_ITER_TYPE_LAYOUT(t);-- BOUND_ITER_TYPE_LAYOUT::create
--#OUT+"layout called for: "+t.str+"\n";
--#OUT+"Nr of bnd iter types defined: "+ prog.tp_tbl.iter_tbl.size +"\n";
--loop
-- #OUT+prog.tp_tbl.iter_tbl.elt!.str +"\n";
--end;
else
#OUT+t.str+" unrecognized type \n";-- OUT::create OUT::plus OUT::plus
end;
elsif t.is_immutable then l:=#IMMUTABLE_CLASS_LAYOUT(t,prog);-- IMMUTABLE_CLASS_LAYOUT::create LAYOUT_TBL::prog
else l:=#CLASS_LAYOUT(t,prog);-- CLASS_LAYOUT::create LAYOUT_TBL::prog
end;
return l;
end;
end;
class TP_LAYOUT < $LAYOUT
class TP_LAYOUT < $LAYOUT is
-- Some default code for layout classes.
private attr tp:$TP; -- The type this layout is for
readonly attr str:STR;
shared layouts:FSET{SAME}; -- Registry of all layouts of this type
create(tp:$TP):SAME pre ~void(tp) is-- BOOL::not
r::=LAYOUT_TBL::layout_tbl.get(tp);-- LAYOUT_TBL::layout_tbl FMAP{2}::get
res:SAME;
if ~void(r) then-- BOOL::not
typecase r when SAME then
res:=r;
end;
else
res:=new;
res.tp:=tp;-- BUILTIN_LAYOUT::tp
res.str:=res.makestr;-- BUILTIN_LAYOUT::str BUILTIN_LAYOUT::makestr
layouts:=layouts.insert(res);-- BUILTIN_LAYOUT::layouts BUILTIN_LAYOUT::layouts FSET{1}::insert
LAYOUT_TBL::layout_tbl:=LAYOUT_TBL::layout_tbl.insert(tp,res);-- LAYOUT_TBL::layout_tbl LAYOUT_TBL::layout_tbl FMAP{2}::insert
end;
return res;
end;
dependencies:FLIST{$LAYOUT} is return #; end;-- FLIST{1}::create
-- By default, there are no dependencies
typedef(c:CGEN):STR is return ""; end;
-- By default, no typedef needs to be emitted
makestr:STR is raise "TP_LAYOUT::makestr undefined"; end;
sorted_fields(map:FMAP{IDENT,$TP}):LAYOUT_ARR is
res:LAYOUT_ARR:=#(map.size);-- LAYOUT_ARR::create FMAP{2}::size
loop res.set!(map.pairs!); end;-- LAYOUT_ARR::set! FMAP{2}::pairs!
res.sort;-- LAYOUT_ARR::sort
return res;
end;
end;
class LAYOUT_ARR
class LAYOUT_ARR is
-- Convenience class for sorting fields by alignment
-- to try to get better space usage. C guarantees that
-- the order we use in typedefs will be obeyed so we have
-- to worry about it here.
include ARRAY{TUP{IDENT,$TP}};
elt_lt(e1,e2:TUP{IDENT,$TP}):BOOL is
tp1::=e1.t2;-- TUP{2}::t2
tp2::=e2.t2;-- TUP{2}::t2
a1::=alignment(tp1);-- LAYOUT_ARR::alignment
a2::=alignment(tp2);-- LAYOUT_ARR::alignment
if a1/=a2 then return a1>a2;-- INT::is_eq BOOL::not INT::is_lt
-- Keep types together even if the alignment appears the
-- same; we might be wrong about the alignment.
elsif tp1/=tp2 then return tp1.str<tp2.str;-- BOOL::not STR::is_lt
-- Finally, sort by field name, just to keep deterministic.
else return e1.t1.str<e2.t1.str;-- TUP{2}::t1 IDENT::str STR::is_lt TUP{2}::t1 IDENT::str
end;
end;
private alignment(t:$TP):INT is
case t
when TP_BUILTIN::fltd then return 64;-- TP_BUILTIN::fltd
when TP_BUILTIN::char then return 8;-- TP_BUILTIN::char
when TP_BUILTIN::bool then return 1;-- TP_BUILTIN::bool
else
-- It's okay to get it wrong, just a heuristic.
return 32;
end;
end;
end;
class BUILTIN_LAYOUT < $LAYOUT
class BUILTIN_LAYOUT < $LAYOUT is
-- A layout for a Sather class object which is predefined.
-- Built-in layouts are all predefined in the system headers, so
-- nothing needs to be done here.
include TP_LAYOUT;
makestr:STR is return tp.str+" - Builtin"; end;-- BUILTIN_LAYOUT::tp STR::plus
end;
class EXTERNAL_LAYOUT < $LAYOUT
class EXTERNAL_LAYOUT < $LAYOUT is
-- A layout corresponding to a Sather external class object.
-- There aren't any C entities corresponding to external classes,
-- so don't do anything.
include TP_LAYOUT;
makestr:STR is return tp.str+" - External"; end;-- EXTERNAL_LAYOUT::tp STR::plus
end;
class ABSTRACT_LAYOUT < $LAYOUT
class ABSTRACT_LAYOUT < $LAYOUT is
-- A layout corresponding to a Sather abstract type.
-- Note that the layout of the abstract iter dispatch
-- tables depends on the iter yield value layout (if any)
--
-- For all abstract iters in it is also
-- necessary to generate typedefs for iter dispatch table entries
-- as they are different from the function dispatch table
include TP_LAYOUT;
attr prog:PROG;
attr dependencies:FLIST{$LAYOUT};
create(tp:$TP,p:PROG):SAME pre ~void(tp) is-- BOOL::not
r::=LAYOUT_TBL::layout_tbl.get(tp);-- LAYOUT_TBL::layout_tbl FMAP{2}::get
res:SAME;
if ~void(r) then-- BOOL::not
typecase r when SAME then
res:=r;
end;
else
res:=new;
res.tp:=tp;-- ABSTRACT_LAYOUT::tp
res.prog:=p;-- ABSTRACT_LAYOUT::prog
res.str:=res.makestr;-- ABSTRACT_LAYOUT::str ABSTRACT_LAYOUT::makestr
layouts:=layouts.insert(res);-- ABSTRACT_LAYOUT::layouts ABSTRACT_LAYOUT::layouts FSET{1}::insert
LAYOUT_TBL::layout_tbl:=LAYOUT_TBL::layout_tbl.insert(tp,res);-- LAYOUT_TBL::layout_tbl LAYOUT_TBL::layout_tbl FMAP{2}::insert
res.make_dependencies;-- ABSTRACT_LAYOUT::make_dependencies
end;
return res;
end;
private make_dependencies is
dependencies:=#FLIST{$LAYOUT};-- ABSTRACT_LAYOUT::dependencies FLIST{1}::create
--
-- abstract frame knows only about arguments!
-- it also depends on the layout of the return type
loop
sig::=tp.ifc.sigs.elt!; -- ABSTRACT_LAYOUT::tp IFC::sigs SIG_TBL::elt!
if sig.is_iter then-- SIG::is_iter
-- DPS: This was in 1.0.7, and looks totally confused. I changed
-- it to this:
--dependencies:=
-- dependencies.push(#ABSTRACT_FRAME_LAYOUT(sig, prog));
-- make sure an abstract frame gets created - this should be
-- moved into CGEN where other dispatching is handled.
--dummy::=#ABSTRACT_FRAME_LAYOUT(sig, prog);
--loop
-- dependencies:=
-- dependencies.push(LAYOUT_TBL::layout(sig.args.elt!));
--end;
--
--if ~void(sig.ret) then
-- dependencies:=
-- dependencies.push(LAYOUT_TBL::layout(sig.ret));
--end;
end;
end;
end;
typedef(c:CGEN):STR is
m::=c.mangler;-- CGEN::mangler
m.forbid(m.mangle(tp,void)+"_struct");-- MANGLE::forbid MANGLE::mangle ABSTRACT_LAYOUT::tp STR::plus
decl_str ::=
"typedef struct "+m.mangle(tp,void)+"_struct {\n"-- STR::plus MANGLE::mangle ABSTRACT_LAYOUT::tp
+" OB_HEADER header;\n"-- STR::plus
+" } *"+m.mangle(tp,void)+";\n\n";-- STR::plus STR::plus STR::plus MANGLE::mangle ABSTRACT_LAYOUT::tp STR::plus
return decl_str;
end;
makestr:STR is return tp.str+" - Abstract"; end;-- ABSTRACT_LAYOUT::tp STR::plus
end;
class ABSTRACT_FRAME_LAYOUT < $LAYOUT
class ABSTRACT_FRAME_LAYOUT < $LAYOUT is
-- A layout corresponding to a Sather abstract iterator frame.
-- The layout defines iter arguments only. Concrete iter frames
-- take care of all other stuff (i.e. locals, nested frames, etc)
include FIX_TYPE;
attr sig:SIG;
attr prog:PROG;
shared layouts:FMAP{SIG,ABSTRACT_FRAME_LAYOUT};
readonly attr str:STR;
create(sig:SIG,p:PROG):SAME is
res::=layouts.get(sig);-- ABSTRACT_FRAME_LAYOUT::layouts FMAP{2}::get
if void(res) then
res:=new;
res.sig:=sig;-- ABSTRACT_FRAME_LAYOUT::sig
res.prog:=p;-- ABSTRACT_FRAME_LAYOUT::prog
res.str:=res.sig.str+" - abstract frame";-- ABSTRACT_FRAME_LAYOUT::str ABSTRACT_FRAME_LAYOUT::sig SIG::str STR::plus
layouts:=layouts.insert(sig,res);-- ABSTRACT_FRAME_LAYOUT::layouts ABSTRACT_FRAME_LAYOUT::layouts FMAP{2}::insert
-- DPS: Somebody added this after 1.0.7, I believe it is
-- incorrect; the layout_tbl is only for types.
--LAYOUT_TBL::layout_tbl:=LAYOUT_TBL::layout_tbl.insert(sig.tp,res);
end;
return res;
end;
dependencies:FLIST{$LAYOUT} is
res::=#FLIST{$LAYOUT};-- FLIST{1}::create
-- abstract frame knows only about arguments!
-- it also depends on the layout of the return type
loop
res:=res.push(LAYOUT_TBL::layout(sig.args.elt!.tp));-- FLIST{1}::push LAYOUT_TBL::layout ABSTRACT_FRAME_LAYOUT::sig SIG::args ARRAY{1}::elt! ARG::tp
end;
if ~void(sig.ret) then-- ABSTRACT_FRAME_LAYOUT::sig SIG::ret BOOL::not
res:=res.push(LAYOUT_TBL::layout(sig.ret));-- FLIST{1}::push LAYOUT_TBL::layout ABSTRACT_FRAME_LAYOUT::sig SIG::ret
end;
return res;
end;
typedef(c:CGEN):STR is
-- generate the typedef for an "abstract" frame. The frame
-- knows only about arguments. The space for the entire
-- concrete frame is generated by the dispatched allocator
-- function at the time of the dispatched iter call.
m ::= c.mangler;-- CGEN::mangler
the_tp ::=sig.tp;-- ABSTRACT_FRAME_LAYOUT::sig SIG::tp
m.forbid(m.mangle(sig,void)+"_entry");-- MANGLE::forbid MANGLE::mangle ABSTRACT_FRAME_LAYOUT::sig STR::plus
res:STR;
res := "typedef struct "+m.mangle(sig,void)+"_frame_struct {\n";-- STR::plus MANGLE::mangle ABSTRACT_FRAME_LAYOUT::sig STR::plus
m.forbid(m.mangle(sig,void)+"_frame_struct");-- MANGLE::forbid MANGLE::mangle ABSTRACT_FRAME_LAYOUT::sig STR::plus
-- slot for state
-- Attention this was at the end of the layout
-- due to bound iters (casting) this had to be placed at
-- the beginning !! aj
res:=res+" INT state;\n";-- STR::plus
-- make slot for each argument
res := res +' '+m.mangle(sig.tp,void)+" self;\n";-- STR::plus STR::plus MANGLE::mangle ABSTRACT_FRAME_LAYOUT::sig SIG::tp STR::plus
loop
fi::=sig.args.elt!;-- ABSTRACT_FRAME_LAYOUT::sig SIG::args ARRAY{1}::elt!
res:=res+' '+fix_out_type(fi, m.mangle(fi.tp,void)+' ')+"arg"+1.up!+';';-- STR::plus STR::plus ABSTRACT_FRAME_LAYOUT::fix_out_type MANGLE::mangle ARG::tp STR::plus STR::plus STR::plus INT::up! STR::plus
res:=res+"/* Formal argument: "+fi.str+" */\n";-- STR::plus STR::plus ARG::str STR::plus
end;
--finally make a slot for state;
--res:=res+" INT state;\n";
-- space for everything including locals and nested iters
-- is generated by the specialized dispatched allocators
res := res +" } *"+m.mangle(sig,void)+"_frame;\n\n";-- STR::plus STR::plus MANGLE::mangle ABSTRACT_FRAME_LAYOUT::sig STR::plus
res := res + "/* Dispatch table entry for "
+ sig.str + " */\n";-- STR::plus ABSTRACT_FRAME_LAYOUT::sig SIG::str STR::plus
res := res+"typedef struct "+m.mangle(sig,void)-- STR::plus STR::plus MANGLE::mangle ABSTRACT_FRAME_LAYOUT::sig
+"_entry {\n"+ "const ";-- STR::plus STR::plus
if ~void(sig.ret) then-- ABSTRACT_FRAME_LAYOUT::sig SIG::ret BOOL::not
res := res + m.mangle(sig.ret,void); -- STR::plus MANGLE::mangle ABSTRACT_FRAME_LAYOUT::sig SIG::ret
else
res := res + "void";-- STR::plus
end;
res := res + " (*iter)("
+ m.mangle(sig,void) + "_frame frame";-- STR::plus STR::plus MANGLE::mangle ABSTRACT_FRAME_LAYOUT::sig STR::plus
if c.func_tables then-- CGEN::func_tables
res:=res+", struct _func_frame *";-- STR::plus
end;
res:=res+");\n";-- STR::plus
res := res
+ "const void* (*alloc_frame)();\n"
+ "} "+m.mangle(sig,void)+"_entry;\n\n";-- STR::plus STR::plus STR::plus MANGLE::mangle ABSTRACT_FRAME_LAYOUT::sig STR::plus
return res;
end;
end;
class CLASS_LAYOUT < $LAYOUT
class CLASS_LAYOUT < $LAYOUT is
-- A layout corresponding to a Sather reference class object.
include TP_LAYOUT create->;
attr l:AM_OB_DEF; -- The layout from the AM form.
attr prog:PROG;
attr dependencies:FLIST{$LAYOUT};
create(tp:$TP,prog:PROG):SAME is
r::=LAYOUT_TBL::layout_tbl.get(tp);-- LAYOUT_TBL::layout_tbl FMAP{2}::get
res:SAME;
if ~void(r) then-- BOOL::not
typecase r when SAME then
res:=r;
end;
else
res:=new;
res.tp:=tp;-- CLASS_LAYOUT::tp
res.prog:=prog;-- CLASS_LAYOUT::prog
res.l:=LAYOUT_TBL::cgen.am_ob_def_for_tp(tp);-- CLASS_LAYOUT::l LAYOUT_TBL::cgen CGEN::am_ob_def_for_tp
res.str:=res.tp.str+" - Class";-- CLASS_LAYOUT::str CLASS_LAYOUT::tp STR::plus
layouts:=layouts.insert(res);-- CLASS_LAYOUT::layouts CLASS_LAYOUT::layouts FSET{1}::insert
LAYOUT_TBL::layout_tbl:=LAYOUT_TBL::layout_tbl.insert(tp,res);-- LAYOUT_TBL::layout_tbl LAYOUT_TBL::layout_tbl FMAP{2}::insert
res.make_dependencies;-- CLASS_LAYOUT::make_dependencies
end;
return res;
end;
private make_dependencies is
res::=#FLIST{$LAYOUT};-- FLIST{1}::create
loop
tp::=l.at.targets!;-- CLASS_LAYOUT::l AM_OB_DEF::at FMAP{2}::targets!
if tp.is_immutable then
res:=res.push(LAYOUT_TBL::layout(tp));-- FLIST{1}::push LAYOUT_TBL::layout
end;
end;
if ~void(l.arr) and l.arr.is_immutable then-- CLASS_LAYOUT::l AM_OB_DEF::arr BOOL::not CLASS_LAYOUT::l AM_OB_DEF::arr
res:=res.push(LAYOUT_TBL::layout(l.arr));-- FLIST{1}::push LAYOUT_TBL::layout CLASS_LAYOUT::l AM_OB_DEF::arr
end;
dependencies:=res;-- CLASS_LAYOUT::dependencies
end;
typedef(c:CGEN):STR is
m::=c.mangler;-- CGEN::mangler
cname:STR:=m.mangle(l.tp,void);-- MANGLE::mangle CLASS_LAYOUT::l AM_OB_DEF::tp
res::="typedef struct "+cname+"_struct {";-- STR::plus STR::plus
res:=res+"/* layout for "+l.tp.str+" */\n";-- STR::plus CLASS_LAYOUT::l AM_OB_DEF::tp STR::plus
m.forbid(m.mangle(tp,void)+"_struct");-- MANGLE::forbid MANGLE::mangle CLASS_LAYOUT::tp STR::plus
res:=res+" OB_HEADER header;\n";-- STR::plus
if tp.is_subtype(TP_BUILTIN::dollar_lock) then-- CLASS_LAYOUT::tp TP_BUILTIN::dollar_lock
res:=res+" LOCK_HEADER_STRUCT\n";-- STR::plus
end;
if ~void(l.at) then-- CLASS_LAYOUT::l AM_OB_DEF::at BOOL::not
loop
--p::=l.at.pairs!;
p::=sorted_fields(l.at).elt!;-- CLASS_LAYOUT::l AM_OB_DEF::at LAYOUT_ARR::elt!
if p.t2.is_builtin then-- TUP{2}::t2
res:=res+' '+m.mangle(p.t2,void)-- STR::plus STR::plus MANGLE::mangle TUP{2}::t2
+' '+m.mangle(p.t1,l.tp)+";\n";-- STR::plus STR::plus MANGLE::mangle TUP{2}::t1 CLASS_LAYOUT::l AM_OB_DEF::tp STR::plus
elsif ~p.t2.is_immutable then-- TUP{2}::t2 BOOL::not
res:=res+" struct "+m.mangle(p.t2,void)-- STR::plus STR::plus MANGLE::mangle TUP{2}::t2
+"_struct *"+m.mangle(p.t1,l.tp)+";\n";-- STR::plus STR::plus MANGLE::mangle TUP{2}::t1 CLASS_LAYOUT::l AM_OB_DEF::tp STR::plus
else -- user-defined immutable class
res:=res+" struct "+m.mangle(p.t2,void)-- STR::plus STR::plus MANGLE::mangle TUP{2}::t2
+"_struct "+m.mangle(p.t1,l.tp)+";\n";-- STR::plus STR::plus MANGLE::mangle TUP{2}::t1 CLASS_LAYOUT::l AM_OB_DEF::tp STR::plus
end;
end;
end;
if ~void(l.arr) then-- CLASS_LAYOUT::l AM_OB_DEF::arr BOOL::not
res:=res+" INT asize;\n";-- STR::plus
if l.arr.is_builtin then-- CLASS_LAYOUT::l AM_OB_DEF::arr
res:=res+' '+m.mangle(l.arr,void)+" arr_part[";-- STR::plus STR::plus MANGLE::mangle CLASS_LAYOUT::l AM_OB_DEF::arr STR::plus
elsif ~l.arr.is_immutable then-- CLASS_LAYOUT::l AM_OB_DEF::arr BOOL::not
res:=res+" struct "+m.mangle(l.arr,void)+"_struct *arr_part[";-- STR::plus STR::plus MANGLE::mangle CLASS_LAYOUT::l AM_OB_DEF::arr STR::plus
else -- user-defined immutable class
res:=res+" struct "+m.mangle(l.arr,void)+"_struct arr_part[";-- STR::plus STR::plus MANGLE::mangle CLASS_LAYOUT::l AM_OB_DEF::arr STR::plus
end;
res:=res+1.max(l.asize)+"];\n";-- STR::plus INT::max CLASS_LAYOUT::l AM_OB_DEF::asize STR::plus
end;
if void(l.at) and void(l.arr) then-- CLASS_LAYOUT::l AM_OB_DEF::at CLASS_LAYOUT::l AM_OB_DEF::arr
-- C doesn't like empty structs
res:=res+" CHAR field_so_not_empty;\n";-- STR::plus
end;
res:=res+" } *"+cname+";\n\n";-- STR::plus STR::plus STR::plus
return res;
end;
end;
class IMMUTABLE_CLASS_LAYOUT < $LAYOUT
class IMMUTABLE_CLASS_LAYOUT < $LAYOUT is
-- A layout corresponding to a Sather immutable class object.
include TP_LAYOUT create->;
attr l:AM_OB_DEF; -- The layout from the AM form.
attr prog:PROG;
attr dependencies:FLIST{$LAYOUT};
create(tp:$TP,prog:PROG):SAME is
res:SAME;
r::=LAYOUT_TBL::layout_tbl.get(tp);-- LAYOUT_TBL::layout_tbl FMAP{2}::get
if ~void(r) then-- BOOL::not
typecase r when SAME then
res:=r;
end;
else
res:=new;
res.tp:=tp;-- IMMUTABLE_CLASS_LAYOUT::tp
res.prog:=prog;-- IMMUTABLE_CLASS_LAYOUT::prog
res.l:=LAYOUT_TBL::cgen.am_ob_def_for_tp(tp);-- IMMUTABLE_CLASS_LAYOUT::l LAYOUT_TBL::cgen CGEN::am_ob_def_for_tp
res.str:=res.tp.str+" - immutable";-- IMMUTABLE_CLASS_LAYOUT::str IMMUTABLE_CLASS_LAYOUT::tp STR::plus
layouts:=layouts.insert(res);-- IMMUTABLE_CLASS_LAYOUT::layouts IMMUTABLE_CLASS_LAYOUT::layouts FSET{1}::insert
LAYOUT_TBL::layout_tbl:=LAYOUT_TBL::layout_tbl.insert(tp,res);-- LAYOUT_TBL::layout_tbl LAYOUT_TBL::layout_tbl FMAP{2}::insert
res.make_dependencies;-- IMMUTABLE_CLASS_LAYOUT::make_dependencies
end;
return res;
end;
private make_dependencies is
res::=#FLIST{$LAYOUT};-- FLIST{1}::create
loop
tp::=l.at.targets!;-- IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::at FMAP{2}::targets!
if tp.is_immutable then
res:=res.push(LAYOUT_TBL::layout(tp));-- FLIST{1}::push LAYOUT_TBL::layout
end;
end;
if ~void(l.arr) and l.arr.is_immutable then-- IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::arr BOOL::not IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::arr
res:=res.push(LAYOUT_TBL::layout(l.arr));-- FLIST{1}::push LAYOUT_TBL::layout IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::arr
end;
--return res;
dependencies:=res;-- IMMUTABLE_CLASS_LAYOUT::dependencies
end;
typedef(c:CGEN):STR is
m::=c.mangler;-- CGEN::mangler
cname:STR:=m.mangle(l.tp,void);-- MANGLE::mangle IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::tp
res::="typedef struct "+cname+"_struct {";-- STR::plus STR::plus
res:=res+"/* layout for "+l.tp.str+" */\n";-- STR::plus IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::tp STR::plus
m.forbid(m.mangle(tp,void)+"_struct");-- MANGLE::forbid MANGLE::mangle IMMUTABLE_CLASS_LAYOUT::tp STR::plus
--res:=res+" OB_HEADER header;\n";
if ~void(l.at) then-- IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::at BOOL::not
chars_and_bools::=0; -- only used in pSather
loop
--p::=l.at.pairs!;
p::=sorted_fields(l.at).elt!;-- IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::at LAYOUT_ARR::elt!
if p.t2.is_builtin then-- TUP{2}::t2
if p.t2=TP_BUILTIN::char or p.t2=TP_BUILTIN::bool then-- TUP{2}::t2 TP_BUILTIN::char TUP{2}::t2 TP_BUILTIN::bool
chars_and_bools:=chars_and_bools+1;-- INT::plus
end;
res:=res+' '+m.mangle(p.t2,void) -- STR::plus STR::plus MANGLE::mangle TUP{2}::t2
+' '+m.mangle(p.t1,l.tp)+";\n";-- STR::plus STR::plus MANGLE::mangle TUP{2}::t1 IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::tp STR::plus
elsif ~p.t2.is_immutable then-- TUP{2}::t2 BOOL::not
res:=res+" struct "+m.mangle(p.t2,void)-- STR::plus STR::plus MANGLE::mangle TUP{2}::t2
+"_struct *"+m.mangle(p.t1,l.tp)+";\n";-- STR::plus STR::plus MANGLE::mangle TUP{2}::t1 IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::tp STR::plus
else -- user-defined immutable class
res:=res+" struct "+m.mangle(p.t2,void)-- STR::plus STR::plus MANGLE::mangle TUP{2}::t2
+"_struct "+m.mangle(p.t1,l.tp)+";\n";-- STR::plus STR::plus MANGLE::mangle TUP{2}::t1 IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::tp STR::plus
end;
end;
if chars_and_bools.is_odd and c.prog.psather then-- INT::is_odd CGEN::prog PROG::psather
res:=res+" char _dummy_to_pad; /* make struct size a multiple of 2 */\n";-- STR::plus
end;
end;
if ~void(l.arr) then-- IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::arr BOOL::not
if l.arr.is_builtin then-- IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::arr
res:=res+' '+m.mangle(l.arr,void)+" arr_part[";-- STR::plus STR::plus MANGLE::mangle IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::arr STR::plus
elsif ~l.arr.is_immutable then-- IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::arr BOOL::not
res:=res+" struct "+m.mangle(l.arr,void)+"_struct *arr_part[";-- STR::plus STR::plus MANGLE::mangle IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::arr STR::plus
else -- user-defined immutable class
res:=res+" struct "+m.mangle(l.arr,void)+"_struct arr_part[";-- STR::plus STR::plus MANGLE::mangle IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::arr STR::plus
end;
res:=res+1.max(l.asize)+"];\n";-- STR::plus INT::max IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::asize STR::plus
end;
if void(l.at) and void(l.arr) then-- IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::at IMMUTABLE_CLASS_LAYOUT::l AM_OB_DEF::arr
-- C doesn't like empty structs
res:=res+" CHAR field_so_not_empty;\n";-- STR::plus
end;
res:=res+" } "+cname+";\n"-- STR::plus STR::plus
+"static "+cname+" "+cname+"_zero;\n\n";-- STR::plus STR::plus STR::plus STR::plus STR::plus STR::plus
m.forbid(cname+"_zero");-- MANGLE::forbid STR::plus
res:=res+"typedef struct "+cname+"_boxed_struct {\n"-- STR::plus STR::plus
+" OB_HEADER header;\n"-- STR::plus
+' '+cname+" immutable_part;\n"-- STR::plus STR::plus STR::plus
+" } *"+cname+"_boxed;\n\n";-- STR::plus STR::plus STR::plus STR::plus
m.forbid(cname+"_boxed");-- MANGLE::forbid STR::plus
m.forbid(cname+"_boxed_struct");-- MANGLE::forbid STR::plus
return res;
end;
end;
-- stuff for bound iters --AJ-
class BOUND_ITER_FRAME_LAYOUT < $LAYOUT
class BOUND_ITER_FRAME_LAYOUT < $LAYOUT is
-- A layout corresponding to a Sather bound iter object (a function
-- pointer plus any bound arguments).
-- i.e. a laout serving as frame for bound iters
-- one such layout is generated for each bound iter creation
-- e.g bi := bind(a.foo!(_,_)) produces one such layout.
include FIX_TYPE; -- treatment of in out ... args
shared layouts:FMAP{AM_BND_CREATE_EXPR,BOUND_ITER_FRAME_LAYOUT};
attr e:AM_BND_CREATE_EXPR;
attr prog:PROG;
readonly attr str:STR;
create(e:AM_BND_CREATE_EXPR, p : PROG) : BOUND_ITER_FRAME_LAYOUT is
res::=layouts.get(e); -- BOUND_ITER_FRAME_LAYOUT::layouts FMAP{2}::get
if void(res) then
res:=new;
res.e:=e;-- BOUND_ITER_FRAME_LAYOUT::e
res.prog := p;-- BOUND_ITER_FRAME_LAYOUT::prog
res.str:=res.e.fun.str+" - bound iter object"; -- BOUND_ITER_FRAME_LAYOUT::str BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::str STR::plus
layouts:=layouts.insert(e,res);-- BOUND_ITER_FRAME_LAYOUT::layouts BOUND_ITER_FRAME_LAYOUT::layouts FMAP{2}::insert
end;
return res;
end;
dependencies:FLIST{$LAYOUT} is
res::=#FLIST{$LAYOUT};-- FLIST{1}::create
-- proclaim the dependency to the iterator frame within the bound iter ob
fl : $LAYOUT;
if e.fun.tp.is_abstract then -- BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::tp
fl := ABSTRACT_FRAME_LAYOUT::layouts.get(e.fun);-- ABSTRACT_FRAME_LAYOUT::layouts FMAP{2}::get BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun
else
fl := FRAME_LAYOUT::layouts.get(e.fun);-- FRAME_LAYOUT::layouts FMAP{2}::get BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun
end;
if void(fl) then
#OUT+"Error in Bnd iter obj\n";-- OUT::create OUT::plus
else
res := res.push(fl);-- FLIST{1}::push
end;
if ~void(e.fun.ret) then-- BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::ret BOOL::not
res:=res.push(LAYOUT_TBL::layout(e.fun.ret));-- FLIST{1}::push LAYOUT_TBL::layout BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::ret
end;
loop
i::=e.unbnd_args.elt!;-- BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::unbnd_args ARRAY{1}::elt!
if i=0 then-- INT::is_eq
res:=res.push(LAYOUT_TBL::layout(e.fun.tp));-- FLIST{1}::push LAYOUT_TBL::layout BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::tp
else res:=res.push(LAYOUT_TBL::layout(e.fun.args[i-1].tp));-- FLIST{1}::push LAYOUT_TBL::layout BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::args ARRAY{1}::aget INT::minus ARG::tp
end;
end;
loop
i::=e.bnd_args.ind!;-- BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::bnd_args ARRAY{1}::ind!
if e.bnd_args[i]=0 then-- BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::bnd_args ARRAY{1}::aget INT::is_eq
res:=res.push(LAYOUT_TBL::layout(e.fun.tp));-- FLIST{1}::push LAYOUT_TBL::layout BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::tp
else
res:=res.push(LAYOUT_TBL::layout(e.fun.args[e.bnd_args[i]-1].tp));-- FLIST{1}::push LAYOUT_TBL::layout BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::args BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::bnd_args ARRAY{1}::aget INT::minus ARG::tp
end;
end;
return res;
end;
-- the following typedef should be generated e.g.
-- typedef struct bound_iter_frame_struct {
-- INT state;
-- INT hotarg1;
-- INT oncearg2;
-- INT ret_val;
-- iter_frame_stub iter_frame;
-- INT (* call)(void *);
-- size_t size;
-- BAR boundarg0;
-- INT boundarg1;
-- } *bound_iter_ob;
-- problem: inout args, func_tables
typedef(c:CGEN):STR is
m::=c.mangler;-- CGEN::mangler
name::=m.mangle(e,void);-- MANGLE::mangle BOUND_ITER_FRAME_LAYOUT::e
m.forbid(name+"_iter_frame"); -- for ptr.-- MANGLE::forbid STR::plus
m.forbid(name+"_iter_frame_struct"); -- for struct -- MANGLE::forbid STR::plus
res::="typedef struct "+name+"_iter_ob_struct {\n";-- STR::plus STR::plus
res:=res+" OB_HEADER header;\n";-- STR::plus
res := res + " INT state; \n";-- STR::plus
hot : BOOL:= false;
loop a ::= e.unbnd_args.elt!; i ::= 0.up!;-- BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::unbnd_args ARRAY{1}::elt! INT::up!
if a = 0 then -- INT::is_eq
res := res + ' ' + m.mangle(e.fun.tp,void) + ' ';-- STR::plus STR::plus MANGLE::mangle BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::tp STR::plus
-- self has always 'in' mode
else
arg ::= e.fun.args[a-1]; -- BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::args ARRAY{1}::aget INT::minus
if ~void(e.fun.hot) then -- BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::hot BOOL::not
hot := e.fun.hot[a-1]; -- BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::hot ARRAY{1}::aget INT::minus
end;
--res := res + ' ' + m.mangle(arg.tp,void) + ' ';
res := res + " "+fix_out_type(arg, m.mangle(arg.tp,void)+' ');-- STR::plus STR::plus BOUND_ITER_FRAME_LAYOUT::fix_out_type MANGLE::mangle ARG::tp STR::plus
end;
if hot then res := res + "hotarg"+i;-- STR::plus STR::plus
else res := res + "oncearg" + i; end;-- STR::plus STR::plus
res := res + ";\n";-- STR::plus
end;
if ~void(e.fun.ret) then -- eg. INT ret_val-- BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::ret BOOL::not
res:=res+' '+m.mangle(e.fun.ret,void);-- STR::plus STR::plus MANGLE::mangle BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::ret
res := res +" ret_val;\n"; -- STR::plus
end;
res := res + " "+m.mangle(e.fun,void) + "_frame iter_frame;\n";-- STR::plus STR::plus MANGLE::mangle BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun STR::plus
if ~void(e.fun.ret) then -- BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::ret BOOL::not
res:=res+' '+m.mangle(e.fun.ret,void);-- STR::plus STR::plus MANGLE::mangle BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::ret
else res:=res+" void"; -- STR::plus
end;
res:=res+" (*call)(struct "+name+"_iter_ob_struct *";-- STR::plus STR::plus STR::plus
if c.func_tables then-- CGEN::func_tables
res:=res+", struct _func_frame *";-- STR::plus
end;
res := res + ");\n";-- STR::plus
res := res+" size_t size;\n";-- STR::plus
-- header completed
-- now generate bound arguments
-- bnd args are always `in` mode
loop
i ::= e.bnd_args.ind!;-- BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::bnd_args ARRAY{1}::ind!
if e.bnd_args[i]=0 then-- BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::bnd_args ARRAY{1}::aget INT::is_eq
if ~e.fun.tp.is_external then-- BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::tp BOOL::not
res:=res+' '+m.mangle(e.fun.tp,void);-- STR::plus STR::plus MANGLE::mangle BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::tp
res:=res+" bound_arg"+i+";\n";-- STR::plus STR::plus STR::plus
end;
else
bnd_a ::= e.fun.args[e.bnd_args[i]-1];-- BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::args BOUND_ITER_FRAME_LAYOUT::e AM_BND_CREATE_EXPR::bnd_args ARRAY{1}::aget INT::minus
res:=res+' '+ fix_out_type(bnd_a, m.mangle(bnd_a.tp,void));-- STR::plus STR::plus BOUND_ITER_FRAME_LAYOUT::fix_out_type MANGLE::mangle ARG::tp
res:=res+" bound_arg"+i+";\n";-- STR::plus STR::plus STR::plus
end;
end;
-- psather, slot for exception stack
if c.prog.psather then -- CGEN::prog PROG::psather
res:=res+" void *ex;\n";-- STR::plus
end;
res := res + "} *"+name+"_iter_ob;\n\n";-- STR::plus STR::plus STR::plus
return res;
end;
end;
-- possibly merge into one with BOUND_ROUT_TYPE
-- problem inout args and functables
class BOUND_ITER_TYPE_LAYOUT < $LAYOUT
class BOUND_ITER_TYPE_LAYOUT < $LAYOUT is
-- A layout corresponding to a Sather bound iter type
-- i.e. same as above, except no fields for bound args
-- e.g.: ITER(INT!,INT):INT
-- serves to represent the bnd TYPE
include FIX_TYPE;
attr tp:TP_ITER;
readonly attr str:STR;
shared layouts:FSET{BOUND_ITER_TYPE_LAYOUT};
create(arg_tp:$TP):BOUND_ITER_TYPE_LAYOUT is
res:SAME;
ares::=LAYOUT_TBL::layout_tbl.get(arg_tp);-- LAYOUT_TBL::layout_tbl FMAP{2}::get
--#OUT+"LAYOUT_TBL : \n" + LAYOUT_TBL::layout_tbl.str+"\n\n";
if ~void(ares) then-- BOOL::not
typecase ares when BOUND_ITER_TYPE_LAYOUT then res:=ares; end;
else
-- #OUT+"vreate a new bnd iter type layout\n";
res:=new;
typecase arg_tp when TP_ITER then
res.tp:=arg_tp;-- BOUND_ITER_TYPE_LAYOUT::tp
end;
LAYOUT_TBL::add(arg_tp,res);-- LAYOUT_TBL::add
layouts:=layouts.insert(res);-- BOUND_ITER_TYPE_LAYOUT::layouts BOUND_ITER_TYPE_LAYOUT::layouts FSET{1}::insert
res.str:=res.tp.str+" - bound iter type";-- BOUND_ITER_TYPE_LAYOUT::str BOUND_ITER_TYPE_LAYOUT::tp TP_ITER::str STR::plus
end;
return res;
end;
dependencies:FLIST{$LAYOUT} is
res::=#FLIST{$LAYOUT};-- FLIST{1}::create
loop res:=res.push(LAYOUT_TBL::layout(tp.args.elt!.tp)); end;-- FLIST{1}::push LAYOUT_TBL::layout BOUND_ITER_TYPE_LAYOUT::tp TP_ITER::args ARRAY{1}::elt! ARG::tp
if ~void(tp.ret) then res:=res.push(LAYOUT_TBL::layout(tp.ret)); end;-- BOUND_ITER_TYPE_LAYOUT::tp TP_ITER::ret BOOL::not FLIST{1}::push LAYOUT_TBL::layout BOUND_ITER_TYPE_LAYOUT::tp TP_ITER::ret
return res;
end;
-- we are not using the ..._ob and ..._ob_struct stuff here
-- might lead to casting problems, fix then aj
typedef(c:CGEN):STR is
m::=c.mangler;-- CGEN::mangler
name::=m.mangle(tp,void);-- MANGLE::mangle BOUND_ITER_TYPE_LAYOUT::tp
m.forbid(name+"_struct");-- MANGLE::forbid STR::plus
m.forbid(name);-- MANGLE::forbid
res::= "typedef struct " + name + "_struct {\n";-- STR::plus STR::plus
res:=res+" OB_HEADER header;\n";-- STR::plus
res := res + " INT state; \n";-- STR::plus
is_hot : BOOL;
loop
a ::= tp.args.elt!;-- BOUND_ITER_TYPE_LAYOUT::tp TP_ITER::args ARRAY{1}::elt!
if ~void(tp.hot) then -- BOUND_ITER_TYPE_LAYOUT::tp TP_ITER::hot BOOL::not
is_hot := tp.hot.elt!;-- BOUND_ITER_TYPE_LAYOUT::tp TP_ITER::hot ARRAY{1}::elt!
else
is_hot := false;
end;
i::=tp.args.ind!;-- BOUND_ITER_TYPE_LAYOUT::tp TP_ITER::args ARRAY{1}::ind!
-- generate the C type identifier
-- remember only hots can be of mode inout/out
-- this is, however, checked eralier
res := res + ' ' + fix_out_type(a,m.mangle(a.tp,void)+' ');-- STR::plus STR::plus BOUND_ITER_TYPE_LAYOUT::fix_out_type MANGLE::mangle ARG::tp STR::plus
-- put a hot, once before arg<nr>, not absolutely neccesary
if is_hot then
res := res + "hot";-- STR::plus
else -- a once argument
res := res + "once";-- STR::plus
end;
-- generate the 'arg<nr>' part
res := res + "arg"+i+";\n"; -- STR::plus STR::plus STR::plus
end; -- ends loop over arguments
if ~void(tp.ret) then -- BOUND_ITER_TYPE_LAYOUT::tp TP_ITER::ret BOOL::not
-- eg. INT ret_val;
res:=res+' '+m.mangle(tp.ret,void);-- STR::plus STR::plus MANGLE::mangle BOUND_ITER_TYPE_LAYOUT::tp TP_ITER::ret
res := res +" ret_val;\n";-- STR::plus
end;
res:=res+" iter_frame_stub iter_frame;\n"; -- STR::plus
if ~void(tp.ret) then -- BOUND_ITER_TYPE_LAYOUT::tp TP_ITER::ret BOOL::not
res:=res+' '+m.mangle(tp.ret,void);-- STR::plus STR::plus MANGLE::mangle BOUND_ITER_TYPE_LAYOUT::tp TP_ITER::ret
else res:=res+" void"; end;-- STR::plus
res:=res+" (*call)(struct "+name+"_struct *";-- STR::plus STR::plus STR::plus
if c.func_tables then-- CGEN::func_tables
res:=res+", struct _func_frame *";-- STR::plus
end;
res := res + ");\n";-- STR::plus
res := res+" size_t size;\n";-- STR::plus
res := res + "} *"+name+";\n\n";-- STR::plus STR::plus STR::plus
return res;
end;
end;
-- possibly rename to BOUND_ROUT_FRAME_LAYOUT
-- or consider to 'megre' BND_ROUTS and BND_ITERS in one class.
class BOUND_OBJECT_LAYOUT < $LAYOUT
class BOUND_OBJECT_LAYOUT < $LAYOUT is
-- A layout corresponding to a Sather bound object (a function
-- pointer plus any bound arguments). ie. the frame
include FIX_TYPE;
shared layouts:FMAP{AM_BND_CREATE_EXPR,BOUND_OBJECT_LAYOUT};
attr e:AM_BND_CREATE_EXPR;
readonly attr str:STR;
create(e:AM_BND_CREATE_EXPR):BOUND_OBJECT_LAYOUT is
res::=layouts.get(e);-- BOUND_OBJECT_LAYOUT::layouts FMAP{2}::get
if void(res) then
res:=new;
res.e:=e;-- BOUND_OBJECT_LAYOUT::e
res.str:=res.e.fun.str+" - bound object";-- BOUND_OBJECT_LAYOUT::str BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::str STR::plus
layouts:=layouts.insert(e,res);-- BOUND_OBJECT_LAYOUT::layouts BOUND_OBJECT_LAYOUT::layouts FMAP{2}::insert
end;
return res;
end;
dependencies:FLIST{$LAYOUT} is
res::=#FLIST{$LAYOUT};-- FLIST{1}::create
if ~void(e.fun.ret) then-- BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::ret BOOL::not
res:=res.push(LAYOUT_TBL::layout(e.fun.ret));-- FLIST{1}::push LAYOUT_TBL::layout BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::ret
end;
loop
i::=e.unbnd_args.elt!;-- BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::unbnd_args ARRAY{1}::elt!
if i=0 then-- INT::is_eq
if ~e.fun.tp.is_external then-- BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::tp BOOL::not
res:=res.push(LAYOUT_TBL::layout(e.fun.tp));-- FLIST{1}::push LAYOUT_TBL::layout BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::tp
end;
else res:=res.push(LAYOUT_TBL::layout(e.fun.args[i-1].tp));-- FLIST{1}::push LAYOUT_TBL::layout BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::args ARRAY{1}::aget INT::minus ARG::tp
end;
end;
loop
i::=e.bnd_args.ind!;-- BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::bnd_args ARRAY{1}::ind!
if e.bnd_args[i]=0 then-- BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::bnd_args ARRAY{1}::aget INT::is_eq
if ~e.fun.tp.is_external then-- BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::tp BOOL::not
res:=res.push(LAYOUT_TBL::layout(e.fun.tp));-- FLIST{1}::push LAYOUT_TBL::layout BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::tp
end;
else
res:=res.push(LAYOUT_TBL::layout(e.fun.args[e.bnd_args[i]-1].tp));-- FLIST{1}::push LAYOUT_TBL::layout BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::args BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::bnd_args ARRAY{1}::aget INT::minus ARG::tp
end;
end;
return res;
end;
typedef(c:CGEN):STR is
m::=c.mangler;-- CGEN::mangler
name::=m.mangle(e,void);-- MANGLE::mangle BOUND_OBJECT_LAYOUT::e
m.forbid(name+"_ob");-- MANGLE::forbid STR::plus
m.forbid(name+"_ob_struct");-- MANGLE::forbid STR::plus
res::="typedef struct "+name+"_ob_struct {\n";-- STR::plus STR::plus
res:=res+" OB_HEADER header;\n";-- STR::plus
if e.is_remote then-- BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::is_remote
res:=res+" struct "+name+"_ob_struct *local;\n";-- STR::plus STR::plus STR::plus
end;
if ~e.is_remote and ~void(e.fun.ret) then -- BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::is_remote BOOL::not BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::ret BOOL::not
res:=res+' '+m.mangle(e.fun.ret,void)+' ';-- STR::plus STR::plus MANGLE::mangle BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::ret STR::plus
else res:=res+" void ";-- STR::plus
end;
res:=res+"(*funcptr)(struct "+name+"_ob_struct *";-- STR::plus STR::plus STR::plus
loop
i::=e.unbnd_args.elt!;-- BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::unbnd_args ARRAY{1}::elt!
if i=0 then-- INT::is_eq
if ~e.fun.tp.is_external then-- BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::tp BOOL::not
res:=res+", "+m.mangle(e.fun.tp,void);-- STR::plus STR::plus MANGLE::mangle BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::tp
-- self always has ``in'' mode
end;
else res:=res+", "+fix_out_type(e.fun.args[i-1],-- STR::plus STR::plus BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::args ARRAY{1}::aget INT::minus
m.mangle(e.fun.args[i-1].tp,void));-- MANGLE::mangle BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::args ARRAY{1}::aget INT::minus ARG::tp
end;
end;
if c.func_tables then-- CGEN::func_tables
res:=res+", struct _func_frame *";-- STR::plus
end;
res:=res+");\n";-- STR::plus
if e.is_remote and ~void(e.fun.ret) then-- BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::is_remote BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::ret BOOL::not
res:=res+" "+m.mangle(e.fun.ret,void)+" ret_arg;\n";-- STR::plus STR::plus MANGLE::mangle BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::ret STR::plus
end;
loop
i::=e.bnd_args.ind!;-- BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::bnd_args ARRAY{1}::ind!
if e.bnd_args[i]=0 then-- BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::bnd_args ARRAY{1}::aget INT::is_eq
if ~e.fun.tp.is_external then-- BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::tp BOOL::not
res:=res+' '+m.mangle(e.fun.tp,void);-- STR::plus STR::plus MANGLE::mangle BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::tp
res:=res+" bound_arg"+i+";\n";-- STR::plus STR::plus STR::plus
end;
else
bnd_a ::= e.fun.args[e.bnd_args[i]-1];-- BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::fun SIG::args BOUND_OBJECT_LAYOUT::e AM_BND_CREATE_EXPR::bnd_args ARRAY{1}::aget INT::minus
-- even if bound args are of type out or inout we declare
-- them as values, not as pointers (this can only happen in pSather
-- for remote execution function)
res:=res+' '+ m.mangle(bnd_a.tp,void);-- STR::plus STR::plus MANGLE::mangle ARG::tp
res:=res+" bound_arg"+i+";\n";-- STR::plus STR::plus STR::plus
end;
end;
res:=res+" } *"+name+"_ob;\n\n";-- STR::plus STR::plus STR::plus
return res;
end;
end;
-- possibly rename to BOUND_ROUT_TYPE_LAYOUT
class BOUND_TYPE_LAYOUT < $LAYOUT
class BOUND_TYPE_LAYOUT < $LAYOUT is
-- A layout corresponding to a Sather bound type (just the
-- function pointer). i.e. the header
include FIX_TYPE;
attr tp:TP_ROUT;
readonly attr str:STR;
shared layouts:FSET{BOUND_TYPE_LAYOUT};
create(arg_tp:$TP):BOUND_TYPE_LAYOUT is
res:SAME;
ares::=LAYOUT_TBL::layout_tbl.get(arg_tp);-- LAYOUT_TBL::layout_tbl FMAP{2}::get
--#OUT+"LAYOUT_TBL : \n" + LAYOUT_TBL::layout_tbl.str+"\n\n";
if ~void(ares) then-- BOOL::not
typecase ares when BOUND_TYPE_LAYOUT then res:=ares; end;
else
-- #OUT+"vreate a new bnd rout type layout\n";
res:=new;
typecase arg_tp when TP_ROUT then
res.tp:=arg_tp;-- BOUND_TYPE_LAYOUT::tp
end;
LAYOUT_TBL::add(arg_tp,res);-- LAYOUT_TBL::add
layouts:=layouts.insert(res);-- BOUND_TYPE_LAYOUT::layouts BOUND_TYPE_LAYOUT::layouts FSET{1}::insert
res.str:=res.tp.str+" - bound type";-- BOUND_TYPE_LAYOUT::str BOUND_TYPE_LAYOUT::tp TP_ROUT::str STR::plus
end;
return res;
end;
dependencies:FLIST{$LAYOUT} is
res::=#FLIST{$LAYOUT};-- FLIST{1}::create
loop res:=res.push(LAYOUT_TBL::layout(tp.args.elt!.tp)); end;-- FLIST{1}::push LAYOUT_TBL::layout BOUND_TYPE_LAYOUT::tp TP_ROUT::args ARRAY{1}::elt! ARG::tp
if ~void(tp.ret) then res:=res.push(LAYOUT_TBL::layout(tp.ret)); end;-- BOUND_TYPE_LAYOUT::tp TP_ROUT::ret BOOL::not FLIST{1}::push LAYOUT_TBL::layout BOUND_TYPE_LAYOUT::tp TP_ROUT::ret
return res;
end;
typedef(c:CGEN):STR is
m::=c.mangler;-- CGEN::mangler
name::=m.mangle(tp,void);-- MANGLE::mangle BOUND_TYPE_LAYOUT::tp
m.forbid(name+"_struct");-- MANGLE::forbid STR::plus
res::="typedef struct "+name+"_struct {\n";-- STR::plus STR::plus
res:=res+" OB_HEADER header;\n";-- STR::plus
if ~void(tp.ret) then res:=res+' '+m.mangle(tp.ret,void);-- BOUND_TYPE_LAYOUT::tp TP_ROUT::ret BOOL::not STR::plus STR::plus MANGLE::mangle BOUND_TYPE_LAYOUT::tp TP_ROUT::ret
else res:=res+" void";-- STR::plus
end;
res:=res+" (*funcptr)(void *";-- STR::plus
loop
a::=tp.args.elt!;-- BOUND_TYPE_LAYOUT::tp TP_ROUT::args ARRAY{1}::elt!
res:=res+", "+fix_out_type(a, m.mangle(a.tp,void));-- STR::plus STR::plus BOUND_TYPE_LAYOUT::fix_out_type MANGLE::mangle ARG::tp
end;
if c.func_tables then-- CGEN::func_tables
res:=res+", struct _func_frame *";-- STR::plus
end;
res:=res+");\n} *"+name+";\n\n";-- STR::plus STR::plus STR::plus
return res;
end;
end;
class FRAME_LAYOUT < $LAYOUT
class FRAME_LAYOUT < $LAYOUT is
-- A layout corresponding to a Sather iterator frame.
-- Later this will be used for ordinary routines too for GC.
include FIX_TYPE;
attr f:AM_ROUT_DEF;
attr prog:PROG;
--shared layouts:FMAP{AM_ROUT_DEF,FRAME_LAYOUT};
shared layouts:FMAP{SIG,FRAME_LAYOUT};
readonly attr str:STR;
create(f:AM_ROUT_DEF,p:PROG):SAME is
res::=layouts.get(f.sig); -- changed to f.sig from f-- FRAME_LAYOUT::layouts FMAP{2}::get AM_ROUT_DEF::sig
if void(res) then
res:=new;
res.f:=f;-- FRAME_LAYOUT::f
res.prog:=p;-- FRAME_LAYOUT::prog
res.str:=res.f.sig.str+" - frame";-- FRAME_LAYOUT::str FRAME_LAYOUT::f AM_ROUT_DEF::sig SIG::str STR::plus
layouts:=layouts.insert(f.sig,res);-- FRAME_LAYOUT::layouts FRAME_LAYOUT::layouts FMAP{2}::insert AM_ROUT_DEF::sig
end;
return res;
end;
dependencies:FLIST{$LAYOUT} is
res::=#FLIST{$LAYOUT};-- FLIST{1}::create
loop
res:=res.push(LAYOUT_TBL::layout(f.elt!.tp));-- FLIST{1}::push LAYOUT_TBL::layout FRAME_LAYOUT::f AM_ROUT_DEF::elt! AM_FORMAL_ARG::tp
end;
loop
res:=res.push(LAYOUT_TBL::layout(f.locals.elt!.tp));-- FLIST{1}::push LAYOUT_TBL::layout FRAME_LAYOUT::f AM_ROUT_DEF::locals FLIST{1}::elt! AM_LOCAL_EXPR::tp
end;
-- not needed since we are defining somethin like
-- struct type *ptr which is legal in C, even if typedef
-- for type comes after this definition, therefore biter do
-- not need the dependency either
--loop
-- n::=BE::nested_its.get(f).elt!;
-- r::=BE::routs_with_frames.get(n.fun);
-- assert(~void(n));
-- res:=res.push(#FRAME_LAYOUT(r,prog));
--end;
return res;
end;
typedef(c:CGEN):STR is
m::=c.mangler;-- CGEN::mangler
res::="typedef struct "+m.mangle(f.sig,void)+"_frame_struct {\n";-- STR::plus MANGLE::mangle FRAME_LAYOUT::f AM_ROUT_DEF::sig STR::plus
m.forbid(m.mangle(f.sig,void)+"_frame_struct");-- MANGLE::forbid MANGLE::mangle FRAME_LAYOUT::f AM_ROUT_DEF::sig STR::plus
-- make slot for each argument
name:STR;
-- Make a slot for the state number
-- Attention this slot has been moved to the beginning of the
-- layout for casting purposes with bound iters!!
res:=res+" INT state;\n";-- STR::plus
loop
fi::=f.elt!;-- FRAME_LAYOUT::f AM_ROUT_DEF::elt!
name:=m.mangle(fi.expr,f.sig);-- MANGLE::mangle AM_FORMAL_ARG::expr FRAME_LAYOUT::f AM_ROUT_DEF::sig
res:=res+' '+fix_out_type(fi, m.mangle(fi.tp,void))+' '+name+';';-- STR::plus STR::plus FRAME_LAYOUT::fix_out_type MANGLE::mangle AM_FORMAL_ARG::tp STR::plus STR::plus STR::plus
res:=res+"/* Formal argument: "+fi.name.str+" */\n";-- STR::plus STR::plus AM_FORMAL_ARG::name IDENT::str STR::plus
end;
-- make slot for each local
if ~void(f.locals) then-- FRAME_LAYOUT::f AM_ROUT_DEF::locals BOOL::not
loop
fli::=f.locals.elt!; -- FRAME_LAYOUT::f AM_ROUT_DEF::locals FLIST{1}::elt!
name:=m.mangle(fli,f.sig);-- MANGLE::mangle FRAME_LAYOUT::f AM_ROUT_DEF::sig
res:=res+' '+m.mangle(fli.tp,void)+' '+name+";\n";-- STR::plus STR::plus MANGLE::mangle AM_LOCAL_EXPR::tp STR::plus STR::plus STR::plus
end;
end;
-- slot for any nested iter frames
loop
ni::=LAYOUT_TBL::cgen.nested_its.get(f).elt!;-- LAYOUT_TBL::cgen CGEN::nested_its FMAP{2}::get FRAME_LAYOUT::f FLIST{1}::elt!
nl::=1.up!;-- INT::up!
if ni.fun.is_builtin then-- AM_ITER_CALL_EXPR::fun SIG::is_builtin
res:=res+" BOOL f_"+ni.uniq+"; /* used by builtin iter */\n";-- STR::plus STR::plus AM_ITER_CALL_EXPR::uniq STR::plus
v::=ni.fun.builtin_info.var;-- AM_ITER_CALL_EXPR::fun SIG::builtin_info CONFIG_ROUT::var
if ~void(v) then-- BOOL::not
loop
s::=CGEN::expand_macro(v.elt!,ni.fun,void,ni.uniq);-- CGEN::expand_macro ARRAY{1}::elt! AM_ITER_CALL_EXPR::fun AM_ITER_CALL_EXPR::uniq
res:=res+" "+s+" /* used by builtin iter */\n";-- STR::plus STR::plus STR::plus
end;
end;
if ni.fun.builtin_info.use_index then-- AM_ITER_CALL_EXPR::fun SIG::builtin_info CONFIG_ROUT::use_index
s::=CGEN::expand_macro("INT $#;",ni.fun,void,ni.uniq);-- CGEN::expand_macro AM_ITER_CALL_EXPR::fun AM_ITER_CALL_EXPR::uniq
res:=res+" "+s+" /* used by builtin iter */\n";-- STR::plus STR::plus STR::plus
end;
else
res:=res+" struct "+m.mangle(ni.fun,void)+"_frame_struct *";-- STR::plus STR::plus MANGLE::mangle AM_ITER_CALL_EXPR::fun STR::plus
name:="nested"+nl;-- STR::plus
res:=res+name+"; /* nested iter frame */\n";-- STR::plus STR::plus
end;
end;
-- slots for nested bits
loop
nbi ::=LAYOUT_TBL::cgen.nested_bits.get(f).elt!;-- LAYOUT_TBL::cgen CGEN::nested_bits FMAP{2}::get FRAME_LAYOUT::f FLIST{1}::elt!
nb ::=1.up!;-- INT::up!
res:=res+" struct "+m.mangle(nbi.bi_tp,void)+"_struct *";-- STR::plus STR::plus MANGLE::mangle AM_BND_ITER_CALL_EXPR::bi_tp STR::plus
name:="nested_biter"+nb;-- STR::plus
res:=res+name+"; /* nested biter frame */\n";-- STR::plus STR::plus
end;
if c.prog.psather then -- slot for exception stack-- CGEN::prog PROG::psather
res:=res+" void *ex;\n";-- STR::plus
end;
res := res +" } *"+m.mangle(f.sig,void)+"_frame;\n\n";-- STR::plus STR::plus MANGLE::mangle FRAME_LAYOUT::f AM_ROUT_DEF::sig STR::plus
m.forbid(m.mangle(f.sig,void)+"_frame");-- MANGLE::forbid MANGLE::mangle FRAME_LAYOUT::f AM_ROUT_DEF::sig STR::plus
return res;
end;
end;
class FIX_TYPE
class FIX_TYPE is
fix_out_type(e:AM_FORMAL_ARG, s:STR):STR is
-- probably inadequate!
if (e.mode = MODES::out_mode or e.mode = MODES::inout_mode) then-- AM_FORMAL_ARG::mode MODES::out_mode AM_FORMAL_ARG::mode MODES::inout_mode
return s + "*";-- STR::plus
end;
return s;
end;
fix_out_type(e:ARG, s:STR):STR is
-- probably inadequate!
if (e.mode = MODES::out_mode or e.mode = MODES::inout_mode) then-- ARG::mode MODES::out_mode ARG::mode MODES::inout_mode
return s + "*";-- STR::plus
end;
return s;
end;
end;
class ARG_LAYOUT < $LAYOUT
class ARG_LAYOUT < $LAYOUT is
shared layouts:FMAP{SIG,ARG_LAYOUT};
attr sig:SIG;
readonly attr str:STR;
create(s:SIG):SAME is
res::=layouts.get(s);
if void(res) then
res:=new;
res.sig:=s;
res.str:=res.sig.str+" - arg";
layouts:=layouts.insert(s,res);
end;
return res;
end;
dependencies:FLIST{$LAYOUT} is
res::=#FLIST{$LAYOUT};-- FLIST{1}::create
res:=res.push(LAYOUT_TBL::layout(sig.tp));-- FLIST{1}::push LAYOUT_TBL::layout ARG_LAYOUT::sig SIG::tp
loop
res:=res.push(LAYOUT_TBL::layout(sig.args.elt!.tp));-- FLIST{1}::push LAYOUT_TBL::layout ARG_LAYOUT::sig SIG::args ARRAY{1}::elt! ARG::tp
end;
return res;
end;
typedef(c:CGEN):STR is
m::=c.mangler;-- CGEN::mangler
res::="typedef struct "+m.mangle(sig,sig)+"_arg_frame_struct {\n";-- STR::plus MANGLE::mangle ARG_LAYOUT::sig ARG_LAYOUT::sig STR::plus
res:=res+' '+m.mangle(sig.tp,sig)+" self;\n";-- STR::plus STR::plus MANGLE::mangle ARG_LAYOUT::sig SIG::tp ARG_LAYOUT::sig STR::plus
loop
res:=res+' '+m.mangle(sig.args.elt!.tp,sig)+" arg"+1.up!+";\n";-- STR::plus STR::plus MANGLE::mangle ARG_LAYOUT::sig SIG::args ARRAY{1}::elt! ARG::tp ARG_LAYOUT::sig STR::plus STR::plus INT::up! STR::plus
end;
res:=res+"} *"+m.mangle(sig,sig)+"_arg_frame;\n\n";-- STR::plus STR::plus MANGLE::mangle ARG_LAYOUT::sig ARG_LAYOUT::sig STR::plus
return res;
end;
end; -- class ARG_LAYOUT
-- vim:sw=3:nosmartindent