code_file.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
--------------------------> Sather 1.1 source file <--------------------------
class CODE_FILE
class CODE_FILE is
-- This class controls C code generated by the compiler.
-- For incremental compilation, files are built in memory
-- as FSTRs and then conditionally written out only if their
-- signature differs from what already exists. There is one
-- file per Sather class, although as an optimization these
-- could be combined for classes that have the same checking
-- modes.
-- Code files have to big enough to make the amortised time of
-- reading the big header file worth it. This means that a
-- separate file for every dinky class won't cut it; they have to
-- be merged. However, we have to only merge files with the same
-- options settings because many of the checks are done in-line
-- with macro calls in "runtime.h".
-- This class is not re-entrant.
private attr text:FLIST{FSTR};
private attr ntext:FSTR;
private attr length:INT;
--private attr text:FSTR;
attr name:STR;
attr is_c_code:BOOL; -- Header info for the flags below
-- will only be emitted if it is a C file
attr do_not_merge:BOOL; -- True if should remain separate file
attr chk_pre:BOOL;
attr chk_post:BOOL;
attr chk_invariant:BOOL;
attr chk_assert:BOOL;
attr chk_arith:BOOL;
attr chk_bounds:BOOL;
attr chk_void:BOOL;
attr chk_when:BOOL;
attr chk_return:BOOL;
attr decs:FSET{SIG}; -- declarations have to be emitted
-- for these signatures.
readonly attr layouts:FSET{$LAYOUT}; -- typedefs have to be emitted for
-- these layouts
attr globals:FSET{AM_GLOBAL_EXPR}; -- declarations have to be emitted
-- for these global const or shareds
attr bnd_rout_creates:FLIST{AM_BND_CREATE_EXPR};
-- decls have to be emitted for these
attr bnd_iter_creates:FLIST{AM_BND_CREATE_EXPR};
-- decls have to be emitted for these
attr unboxes:FSET{TUP{SIG,SIG}}; -- decls have to be emitted for these
-- functions which unbox types on dispatching
attr externs:FSET{STR}; -- Decls have to be emitted for these
-- external calls
attr iters:FSET{SIG}; -- These iters are used by this file
shared all,todo:FLIST{SAME};
shared dir:STR;
shared thumbprints:FMAP{STR,STR};
shared prog:PROG;
shared cgen:CGEN;
shared iter_sigs:FMAP{SIG,AM_ROUT_DEF};
private same_options_as(s:SAME):BOOL is
return chk_pre=s.chk_pre-- CODE_FILE::chk_pre BOOL::is_eq CODE_FILE::chk_pre
and chk_post=s.chk_post-- CODE_FILE::chk_post BOOL::is_eq CODE_FILE::chk_post
and chk_invariant=s.chk_invariant-- CODE_FILE::chk_invariant BOOL::is_eq CODE_FILE::chk_invariant
and chk_assert=s.chk_assert-- CODE_FILE::chk_assert BOOL::is_eq CODE_FILE::chk_assert
and chk_arith=s.chk_arith-- CODE_FILE::chk_arith BOOL::is_eq CODE_FILE::chk_arith
and chk_bounds=s.chk_bounds-- CODE_FILE::chk_bounds BOOL::is_eq CODE_FILE::chk_bounds
and chk_void=s.chk_void-- CODE_FILE::chk_void BOOL::is_eq CODE_FILE::chk_void
and chk_when=s.chk_when-- CODE_FILE::chk_when BOOL::is_eq CODE_FILE::chk_when
and chk_return=s.chk_return;-- CODE_FILE::chk_return BOOL::is_eq CODE_FILE::chk_return
end;
set_directory(p:PROG,s:STR) is
-- Set the target directory to be 's'. If it doesn't exist,
-- make it. Otherwise, try to use what's already in it if the
-- signatures match.
-- This should be called before ever calling 'create'.
-- At the moment, we always just start from scratch.
prog:=p;-- CODE_FILE::prog
cg::=prog.back_end;-- CODE_FILE::prog PROG::back_end
typecase cg when CGEN then cgen:=cg; end;-- CODE_FILE::cgen
dir:=s;-- CODE_FILE::dir
iter_sigs:=#;-- CODE_FILE::iter_sigs FMAP{2}::create
FILE::create_directory(dir);-- FILE::create_directory CODE_FILE::dir
th::=FILE::open_for_read(s+'/'+"THUMBPRINTS");-- FILE::open_for_read STR::plus STR::plus
if ~th.error then-- FILE::error BOOL::not
loop
fn::="";
c::=th.get_char;-- FILE::get_char
until!(th.eof or th.error);-- FILE::eof FILE::error
loop
until!(c=' ' or th.error);-- CHAR::is_eq FILE::error
fn:=fn+c;-- STR::plus
c:=th.get_char;-- FILE::get_char
end;
thumbprints:=thumbprints.insert(fn,th.get_str);-- CODE_FILE::thumbprints CODE_FILE::thumbprints FMAP{2}::insert FILE::get_str
-- Notice trailing newline.
end;
end;
end;
create(s:STR):SAME is
-- Create a new CODE_FILE.
r::=new;
r.text:=#FLIST{FSTR};-- CODE_FILE::text FLIST{1}::create
r.ntext:=#FSTR;-- CODE_FILE::ntext FSTR::create
r.length:=0;-- CODE_FILE::length
--r.text:=#;
r.name:=s;-- CODE_FILE::name
r.decs:=#;-- CODE_FILE::decs FSET{1}::create
r.layouts:=#;-- CODE_FILE::layouts FSET{1}::create
r.globals:=#;-- CODE_FILE::globals FSET{1}::create
r.bnd_rout_creates:=#;-- CODE_FILE::bnd_rout_creates FLIST{1}::create
r.bnd_iter_creates:=#; -- CODE_FILE::bnd_iter_creates FLIST{1}::create
r.unboxes:=#;-- CODE_FILE::unboxes FSET{1}::create
r.externs:=#;-- CODE_FILE::externs FSET{1}::create
r.iters:=#;-- CODE_FILE::iters FSET{1}::create
r.do_not_merge:=false;-- CODE_FILE::do_not_merge
all:=all.push(r);-- CODE_FILE::all CODE_FILE::all FLIST{1}::push
return r;
end;
plus(s:$STR):SAME is
-- Output some code
ntext:=ntext+s.str;-- CODE_FILE::ntext CODE_FILE::ntext FSTR::plus
--text:=text+s.str;
return self;
end;
plus(s:$STR) is
-- Output some code
ntext:=ntext+s.str;-- CODE_FILE::ntext CODE_FILE::ntext FSTR::plus
--text:=text+s.str;
end;
good_place_to_split is
text:=text.push(ntext);-- CODE_FILE::text CODE_FILE::text FLIST{1}::push CODE_FILE::ntext
length:=length+ntext.length;-- CODE_FILE::length CODE_FILE::length CODE_FILE::ntext FSTR::length
ntext:=#FSTR;-- CODE_FILE::ntext FSTR::create
if length>cgen.threshold and is_c_code then-- CODE_FILE::length CODE_FILE::cgen CGEN::threshold CODE_FILE::is_c_code
-- If it's too big, stop here and start a new file.
old::=#SAME(name);-- CODE_FILE::create CODE_FILE::name
old.text:=text;-- CODE_FILE::text CODE_FILE::text
old.ntext:=ntext;-- CODE_FILE::ntext CODE_FILE::ntext
old.length:=length;-- CODE_FILE::length CODE_FILE::length
old.chk_pre:=chk_pre;-- CODE_FILE::chk_pre CODE_FILE::chk_pre
old.chk_post:=chk_post;-- CODE_FILE::chk_post CODE_FILE::chk_post
old.chk_invariant:=chk_invariant;-- CODE_FILE::chk_invariant CODE_FILE::chk_invariant
old.chk_assert:=chk_assert;-- CODE_FILE::chk_assert CODE_FILE::chk_assert
old.chk_arith:=chk_arith;-- CODE_FILE::chk_arith CODE_FILE::chk_arith
old.chk_bounds:=chk_bounds;-- CODE_FILE::chk_bounds CODE_FILE::chk_bounds
old.chk_void:=chk_void;-- CODE_FILE::chk_void CODE_FILE::chk_void
old.chk_when:=chk_when;-- CODE_FILE::chk_when CODE_FILE::chk_when
old.chk_return:=chk_return;-- CODE_FILE::chk_return CODE_FILE::chk_return
old.is_c_code:=true;-- CODE_FILE::is_c_code
old.do_not_merge:=do_not_merge;-- CODE_FILE::do_not_merge CODE_FILE::do_not_merge
old.decs:=decs;-- CODE_FILE::decs CODE_FILE::decs
old.layouts:=layouts;-- CODE_FILE::layouts CODE_FILE::layouts
old.globals:=globals;-- CODE_FILE::globals CODE_FILE::globals
old.bnd_rout_creates:=bnd_rout_creates;-- CODE_FILE::bnd_rout_creates CODE_FILE::bnd_rout_creates
old.bnd_iter_creates:=bnd_iter_creates;-- CODE_FILE::bnd_iter_creates CODE_FILE::bnd_iter_creates
old.unboxes:=unboxes;-- CODE_FILE::unboxes CODE_FILE::unboxes
old.externs:=externs;-- CODE_FILE::externs CODE_FILE::externs
old.iters:=iters;-- CODE_FILE::iters CODE_FILE::iters
text:=#FLIST{FSTR};-- CODE_FILE::text FLIST{1}::create
ntext:=#FSTR; -- ("/* Continuation of "+name+" */\n\n");-- CODE_FILE::ntext FSTR::create
length:=0;-- CODE_FILE::length
--text:=#FSTR("/* Continuation of "+name+" */\n\n");
name:=name.replace_suffix(".c","x.c");-- CODE_FILE::name CODE_FILE::name STR::replace_suffix
decs:=#;-- CODE_FILE::decs FSET{1}::create
layouts:=#;-- CODE_FILE::layouts FSET{1}::create
globals:=#;-- CODE_FILE::globals FSET{1}::create
bnd_rout_creates:=#;-- CODE_FILE::bnd_rout_creates FLIST{1}::create
bnd_iter_creates:=#; -- CODE_FILE::bnd_iter_creates FLIST{1}::create
unboxes:=#;-- CODE_FILE::unboxes FSET{1}::create
externs:=#;-- CODE_FILE::externs FSET{1}::create
iters:=#;-- CODE_FILE::iters FSET{1}::create
end;
end;
-- Topological ordering and corresponding text for all typedefs
shared layout_order:FLIST{$LAYOUT};
shared layout_text:FLIST{STR};
private generate_layouts is
-- emit typedefs/structs
-- C requires that typedefs only refer to types previously
-- defined in the text. This means we have to do a
-- topological sort on all the layouts. To do this, we make
-- multiple passes, each time emitting only those typedefs for
-- which all dependencies have already been emitted. The
-- technique used for this is quadratic but because the
-- dependence graph is sparse, I suspect it won't matter in
-- practice.
-- Each generated C file must get its own transitive closure
-- of struct reference. To do this, each CODE_FILE keeps
-- an FSET of those layouts it needs. The outer loop computes
-- a topological sort over the entire set, adding the the FSET
-- of individual files as dependencies are found.
done::=#FSET{$LAYOUT}; -- those layouts which have been emitted-- FSET{1}::create
layout_order:=#; -- List in topo order should be generated-- CODE_FILE::layout_order FLIST{1}::create
layout_text:=#; -- Text of each layout in layout_order-- CODE_FILE::layout_text FLIST{1}::create
-- at this point, we expect all $TP layouts to be in layout_tbl.
stilltodo::=#FLIST{$LAYOUT}; -- FLIST{1}::create
-- Make sure all iters will be generated
loop
cc::=todo.elt!;-- CODE_FILE::todo FLIST{1}::elt!
loop
sig::=cc.iters.elt!;-- CODE_FILE::iters FSET{1}::elt!
if ~sig.tp.is_abstract then-- SIG::tp BOOL::not
a:AM_ROUT_DEF:=iter_sigs.get(sig);-- CODE_FILE::iter_sigs FMAP{2}::get
if ~void(a) then -- builtin iters are not stored in iter_sigs-- BOOL::not
cc.uses_layout(#FRAME_LAYOUT(a,prog));-- CODE_FILE::uses_layout FRAME_LAYOUT::create CODE_FILE::prog
end;
else
cc.uses_layout(#ABSTRACT_FRAME_LAYOUT(sig,prog));-- CODE_FILE::uses_layout ABSTRACT_FRAME_LAYOUT::create CODE_FILE::prog
end;
end;
end;
-- Get a list of everything we could possibly need to generate
loop stilltodo:=stilltodo.push(BUILTIN_LAYOUT::layouts.elt!); end;-- FLIST{1}::push BUILTIN_LAYOUT::layouts FSET{1}::elt!
loop stilltodo:=stilltodo.push(EXTERNAL_LAYOUT::layouts.elt!); end;-- FLIST{1}::push EXTERNAL_LAYOUT::layouts FSET{1}::elt!
loop stilltodo:=stilltodo.push(ABSTRACT_LAYOUT::layouts.elt!); end;-- FLIST{1}::push ABSTRACT_LAYOUT::layouts FSET{1}::elt!
loop
stilltodo:=stilltodo.push(ABSTRACT_FRAME_LAYOUT::layouts.targets!);-- FLIST{1}::push ABSTRACT_FRAME_LAYOUT::layouts FMAP{2}::targets!
end;
loop stilltodo:=stilltodo.push(CLASS_LAYOUT::layouts.elt!); end;-- FLIST{1}::push CLASS_LAYOUT::layouts FSET{1}::elt!
loop stilltodo:=stilltodo.push(IMMUTABLE_CLASS_LAYOUT::layouts.elt!); end;-- FLIST{1}::push IMMUTABLE_CLASS_LAYOUT::layouts FSET{1}::elt!
-- bound routines
loop
stilltodo:=stilltodo.push(BOUND_OBJECT_LAYOUT::layouts.targets!);-- FLIST{1}::push BOUND_OBJECT_LAYOUT::layouts FMAP{2}::targets!
end;
loop stilltodo:=stilltodo.push(BOUND_TYPE_LAYOUT::layouts.elt!); end;-- FLIST{1}::push BOUND_TYPE_LAYOUT::layouts FSET{1}::elt!
-- bound iters
loop
stilltodo:=stilltodo.push(BOUND_ITER_FRAME_LAYOUT::layouts.targets!);-- FLIST{1}::push BOUND_ITER_FRAME_LAYOUT::layouts FMAP{2}::targets!
end;
loop stilltodo:=stilltodo.push(BOUND_ITER_TYPE_LAYOUT::layouts.elt!);end;-- FLIST{1}::push BOUND_ITER_TYPE_LAYOUT::layouts FSET{1}::elt!
loop stilltodo:=stilltodo.push(FRAME_LAYOUT::layouts.targets!); end;-- FLIST{1}::push FRAME_LAYOUT::layouts FMAP{2}::targets!
loop stilltodo:=stilltodo.push(ARG_LAYOUT::layouts.targets!); end;-- FLIST{1}::push ARG_LAYOUT::layouts FMAP{2}::targets!
-- Try to make canonical
stillarr::=#LAYOUT_ARRAY(stilltodo.size);-- LAYOUT_ARRAY::create FLIST{1}::size
loop stillarr.set!(stilltodo.elt!); end;-- LAYOUT_ARRAY::set! FLIST{1}::elt!
stillarr.sort;-- LAYOUT_ARRAY::sort
stilltodo:=#;-- FLIST{1}::create
loop stilltodo:=stilltodo.push(stillarr.elt!); end;-- FLIST{1}::push LAYOUT_ARRAY::elt!
SYS::destroy(stillarr);-- SYS::destroy
loop until!(stilltodo.is_empty);-- FLIST{1}::is_empty
next_stilltodo::=#FLIST{$LAYOUT};-- FLIST{1}::create
loop
l::=stilltodo.elt!;-- FLIST{1}::elt!
-- find out if it is okay to emit yet
deps::=l.dependencies;
okay:BOOL:=true;
loop
while!(okay);
d::=deps.elt!;-- FLIST{1}::elt!
if ~done.test(d) then-- FSET{1}::test BOOL::not
--#OUT+"Can't emit "+l.str+", waiting on "+d.str+'\n';
okay:=false;
end;
end;
if okay then
layout_order:=layout_order.push(l);-- CODE_FILE::layout_order CODE_FILE::layout_order FLIST{1}::push
layout_text:=layout_text.push(l.typedef(cgen));-- CODE_FILE::layout_text CODE_FILE::layout_text FLIST{1}::push CODE_FILE::cgen
--typedefs_h+l.typedef(self);
done:=done.insert(l);-- FSET{1}::insert
--#OUT+"Emitted "+l.str+'\n';
else
next_stilltodo:=next_stilltodo.push(l);-- FLIST{1}::push
end;
end;
-- Make sure progress occurs
if next_stilltodo.size=stilltodo.size then -- FLIST{1}::size INT::is_eq FLIST{1}::size
#OUT+"There appears to be cycle(s) in the layouts usage.\n";-- OUT::create OUT::plus
#OUT+"Here's one cycle: \n\n";-- OUT::create OUT::plus
e::=stilltodo[0];-- FLIST{1}::aget
seen::=#FSET{$LAYOUT};-- FSET{1}::create
loop
#OUT+e.str+'\n';-- OUT::create OUT::plus OUT::plus
seen:=seen.insert(e);-- FSET{1}::insert
e2:$LAYOUT;
loop
e2:=e.dependencies.elt!;-- FLIST{1}::elt!
until!(~done.test(e2));-- FSET{1}::test BOOL::not
end;
e:=e2;
until!(seen.test(e));-- FSET{1}::test
end;
#OUT+e.str+'\n';-- OUT::create OUT::plus OUT::plus
cgen.barf("giving up.");-- CODE_FILE::cgen CGEN::barf
end;
stilltodo:=next_stilltodo;
end; -- loop
end;
header_info:FSTR is
f::=#FSTR;-- FSTR::create
if chk_pre then f:=f+"#define PRE_CHK\n"; end;-- CODE_FILE::chk_pre FSTR::plus
if chk_post then f:=f+"#define POST_CHK\n"; end;-- CODE_FILE::chk_post FSTR::plus
if chk_invariant then f:=f+"#define INVARIANT_CHK\n"; end;-- CODE_FILE::chk_invariant FSTR::plus
if chk_assert then f:=f+"#define ASSERT_CHK\n"; end;-- CODE_FILE::chk_assert FSTR::plus
if chk_arith then f:=f+"#define ARITH_CHK\n"; end;-- CODE_FILE::chk_arith FSTR::plus
if chk_bounds then f:=f+"#define BOUNDS_CHK\n"; end;-- CODE_FILE::chk_bounds FSTR::plus
if chk_void then f:=f+"#define VOID_CHK\n"; end;-- CODE_FILE::chk_void FSTR::plus
if chk_when then f:=f+"#define WHEN_CHK\n"; end;-- CODE_FILE::chk_when FSTR::plus
if chk_return then f:=f+"#define RETURN_CHK\n"; end;-- CODE_FILE::chk_return FSTR::plus
f:=f+"#include \"sather.h\"\n\n";-- FSTR::plus
f:=f+"/* Layouts */\n\n";-- FSTR::plus
loop
l::=layout_order.elt!;-- CODE_FILE::layout_order FLIST{1}::elt!
t::=layout_text.elt!;-- CODE_FILE::layout_text FLIST{1}::elt!
if layouts.test(l) then f:=f+t; end;-- CODE_FILE::layouts FSET{1}::test FSTR::plus
end;
f:=f+"#include \"tags.h\"\n";-- FSTR::plus
f:=f+"\n/* Globals */\n\n";-- FSTR::plus
globstr::=#ARRAY{STR}(globals.size);-- ARRAY{1}::create CODE_FILE::globals FSET{1}::size
loop
age::=globals.elt!;-- CODE_FILE::globals FSET{1}::elt!
globstr.set!("extern "+mang(age.tp)+' '+mang(age)+";\n");-- ARRAY{1}::set! STR::plus CODE_FILE::mang AM_GLOBAL_EXPR::tp STR::plus STR::plus CODE_FILE::mang STR::plus
end;
globstr.sort;-- ARRAY{1}::sort
loop f:=f+globstr.elt!; end;-- FSTR::plus ARRAY{1}::elt!
SYS::destroy(globstr);-- SYS::destroy
f:=f+"\n/* Function declarations */\n\n";-- FSTR::plus
decstr::=#ARRAY{STR}(decs.size);-- ARRAY{1}::create CODE_FILE::decs FSET{1}::size
loop decstr.set!(declaration_for(decs.elt!)); end;-- ARRAY{1}::set! CODE_FILE::decs FSET{1}::elt!
decstr.sort;-- ARRAY{1}::sort
loop f:=f+decstr.elt!; end;-- FSTR::plus ARRAY{1}::elt!
SYS::destroy(decstr);-- SYS::destroy
f:=f+"\n/* Bound rout stubs decls */\n\n";-- FSTR::plus
f:=f+bnd_rout_declarations;-- CODE_FILE::bnd_rout_declarations
f:=f+"\n/* Bound iter stubs decls */\n\n"; --AJ--- FSTR::plus
f:=f+bnd_iter_declarations;-- CODE_FILE::bnd_iter_declarations
f:=f+"\n/* Unbox decls */\n\n";-- FSTR::plus
unstr::=#ARRAY{STR}(unboxes.size);-- ARRAY{1}::create CODE_FILE::unboxes FSET{1}::size
loop
pair::=unboxes.elt!;-- CODE_FILE::unboxes FSET{1}::elt!
unstr.set!(unbox_dec(pair.t1,pair.t2));-- ARRAY{1}::set! CODE_FILE::unbox_dec TUP{2}::t1 TUP{2}::t2
end;
unstr.sort;-- ARRAY{1}::sort
loop f:=f+unstr.elt!; end;-- FSTR::plus ARRAY{1}::elt!
SYS::destroy(unstr);-- SYS::destroy
f:=f+"\n/* External calls */\n\n";-- FSTR::plus
exstr::=#ARRAY{STR}(externs.size);-- ARRAY{1}::create CODE_FILE::externs FSET{1}::size
loop exstr.set!(externs.elt!); end;-- ARRAY{1}::set! CODE_FILE::externs FSET{1}::elt!
exstr.sort;-- ARRAY{1}::sort
-- loop
-- #OUT + exstr.elt! + "\n";
-- end;
loop f:=f+exstr.elt!; end;-- FSTR::plus ARRAY{1}::elt!
SYS::destroy(exstr);-- SYS::destroy
f:=f+"\n/* Code */\n\n";-- FSTR::plus
return f;
end;
private mang(ob:$OB):STR is
return cgen.mangler.mangle(ob,void);-- CODE_FILE::cgen CGEN::mangler MANGLE::mangle
end;
uses_sig(s:SIG) is
-- This also sees to it that all types in the signature
-- are referenced; they don't need to be done separately.
decs:=decs.insert(s);-- CODE_FILE::decs CODE_FILE::decs FSET{1}::insert
uses_tp(s.tp);-- CODE_FILE::uses_tp SIG::tp
if ~void(s.ret) then uses_tp(s.ret); end;-- SIG::ret BOOL::not CODE_FILE::uses_tp SIG::ret
loop
uses_tp(s.args.elt!.tp);-- CODE_FILE::uses_tp SIG::args ARRAY{1}::elt! ARG::tp
end;
-- dispatched iters need special handling. Could be cleaned up.
if s.is_iter and s.tp.is_abstract then uses_iter(s) end;-- SIG::is_iter SIG::tp CODE_FILE::uses_iter
end;
uses_layout(l:$LAYOUT) is
s::=layouts.size; -- we want to know if the layout is added.-- CODE_FILE::layouts FSET{1}::size
-- We could check this with test, but then
-- we have to check it twice (once for test,
-- and insert will test it too.). If the size
-- changes, the element has been added
layouts:=layouts.insert(l);-- CODE_FILE::layouts CODE_FILE::layouts FSET{1}::insert
if layouts.size/=s then -- has been added, add all dependencies too-- CODE_FILE::layouts FSET{1}::size INT::is_eq BOOL::not
d::=l.dependencies;
loop uses_layout(d.elt!); end;-- CODE_FILE::uses_layout FLIST{1}::elt!
end;
end;
uses_iter(s:SIG) is
iters:=iters.insert(s);-- CODE_FILE::iters CODE_FILE::iters FSET{1}::insert
end;
here_is_iter(a:AM_ROUT_DEF) is
iter_sigs:=iter_sigs.insert(a.sig,a);-- CODE_FILE::iter_sigs CODE_FILE::iter_sigs FMAP{2}::insert AM_ROUT_DEF::sig
end;
uses_tp(t:$TP) is
uses_layout(LAYOUT_TBL::layout(t));-- CODE_FILE::uses_layout LAYOUT_TBL::layout
end;
uses_global(age:AM_GLOBAL_EXPR) is
globals:=globals.insert(age);-- CODE_FILE::globals CODE_FILE::globals FSET{1}::insert
end;
uses_bnd_rout_create(brc:AM_BND_CREATE_EXPR) is
bnd_rout_creates:=bnd_rout_creates.push(brc);-- CODE_FILE::bnd_rout_creates CODE_FILE::bnd_rout_creates FLIST{1}::push
end;
uses_bnd_iter_create(bic:AM_BND_CREATE_EXPR) is
bnd_iter_creates:=bnd_iter_creates.push(bic);-- CODE_FILE::bnd_iter_creates CODE_FILE::bnd_iter_creates FLIST{1}::push
end;
uses_unbox(s,abs:SIG) is
unboxes:=unboxes.insert(#(s,abs));-- CODE_FILE::unboxes CODE_FILE::unboxes FSET{1}::insert TUP{2}::create
end;
uses_extern(dec:STR) is
externs:=externs.insert(dec);-- CODE_FILE::externs CODE_FILE::externs FSET{1}::insert
end;
fix_out_type(e:ARG, s:STR):STR is
if (e.mode = MODES::out_mode or e.mode = MODES::inout_mode or-- ARG::mode MODES::out_mode ARG::mode MODES::inout_mode
e.tp.kind = TP_KIND::ext_fortran_tp) then-- ARG::tp INT::is_eq TP_KIND::ext_fortran_tp
return s + "*";-- STR::plus
end;
return s;
end;
private declaration_for(sig:SIG):STR is
-- emit ANSI header, and also struct to hold locals if an iter
res::="";
if sig.tp.is_abstract then -- SIG::tp
-- Have to emit dispatch table declarations
-- res:="extern const int "+mang(sig)+"_offset;\n";
decl::="RETURNED_CONST ";
-- iter dispatch tables differ from ordinary ones
if sig.is_iter then-- SIG::is_iter
decl := decl + mang(sig)+"_entry *"+mang(sig);-- STR::plus CODE_FILE::mang STR::plus STR::plus CODE_FILE::mang
else
if ~void(sig.ret) then-- SIG::ret BOOL::not
decl:=decl+mang(sig.ret);-- STR::plus CODE_FILE::mang SIG::ret
else
decl:=decl+"void";-- STR::plus
end;
decl:=decl+" (**"+mang(sig)+")("+mang(sig.tp);-- STR::plus STR::plus CODE_FILE::mang STR::plus STR::plus CODE_FILE::mang SIG::tp
if ~void(sig.args) then-- SIG::args BOOL::not
loop
e::=sig.args.elt!;-- SIG::args ARRAY{1}::elt!
decl:=decl+", "+mang(e.tp);-- STR::plus STR::plus CODE_FILE::mang ARG::tp
decl := fix_out_type(e, decl);-- CODE_FILE::fix_out_type
end;
end;
if cgen.func_tables then-- CODE_FILE::cgen CGEN::func_tables
decl:=decl+",struct _func_frame *";-- STR::plus
end;
decl:=decl+")";-- STR::plus
end;
res:=res+"\nextern "+decl+";\n";-- STR::plus STR::plus STR::plus
return res;
end;
if ~void(sig.ret) then res:=res+mang(sig.ret)+' ';-- SIG::ret BOOL::not STR::plus CODE_FILE::mang SIG::ret STR::plus
else res:=res+"void ";-- STR::plus
end;
res:=res+mang(sig)+'(';-- STR::plus CODE_FILE::mang STR::plus
-- if an iter, just a pointer for frame struct
-- otherwise, pass arguments the usual way
if sig.is_iter then res:=res+mang(sig)+"_frame";-- SIG::is_iter STR::plus CODE_FILE::mang STR::plus
if cgen.func_tables then-- CODE_FILE::cgen CGEN::func_tables
res:=res+", struct _func_frame *";-- STR::plus
end;
--elsif sig.is_abstract then
-- res:=res+mang(sig.tp);
-- loop res:=res+", "+mang(sig.args.elt!); end;
-- -- The mangle was wrt ,sig. WHY?
elsif sig.tp.is_external then-- SIG::tp
-- an external routine with a body still doesn't have a self
loop
e::= sig.args.elt!;-- SIG::args ARRAY{1}::elt!
res:=res+", ".separate!(mang(e.tp)); -- STR::plus STR::separate! CODE_FILE::mang ARG::tp
res := fix_out_type(e, res);-- CODE_FILE::fix_out_type
end;
elsif sig.is_forked then-- SIG::is_forked
res:=res+"OB";-- STR::plus
loop
e ::=sig.args.elt!;-- SIG::args ARRAY{1}::elt!
res:=res+", "+mang(e.tp); -- STR::plus STR::plus CODE_FILE::mang ARG::tp
res := fix_out_type(e, res); -- CODE_FILE::fix_out_type
end;
else
res:=res+mang(sig.tp);-- STR::plus CODE_FILE::mang SIG::tp
loop
e::= sig.args.elt!;-- SIG::args ARRAY{1}::elt!
res:=res+", "+mang(e.tp); -- STR::plus STR::plus CODE_FILE::mang ARG::tp
res := fix_out_type(e, res);-- CODE_FILE::fix_out_type
end;
if cgen.func_tables then-- CODE_FILE::cgen CGEN::func_tables
res:=res+", struct _func_frame *";-- STR::plus
end;
end;
res:=res+");\n";-- STR::plus
return res;
end;
private bnd_rout_declarations:STR is
-- Generate declarations for bound routine objects
bstr::=#ARRAY{STR}(bnd_rout_creates.size);-- ARRAY{1}::create CODE_FILE::bnd_rout_creates FLIST{1}::size
loop
s:STR;
e::=bnd_rout_creates.elt!;-- CODE_FILE::bnd_rout_creates FLIST{1}::elt!
name::=mang(e);-- CODE_FILE::mang
if ~e.is_remote and ~void(e.fun.ret) then s:=mang(e.fun.ret)+' ';-- AM_BND_CREATE_EXPR::is_remote BOOL::not AM_BND_CREATE_EXPR::fun SIG::ret BOOL::not CODE_FILE::mang AM_BND_CREATE_EXPR::fun SIG::ret STR::plus
else s:="void ";
end;
s:=s+name+'('+name+"_ob";-- STR::plus STR::plus STR::plus STR::plus
loop
i::=e.unbnd_args.elt!;-- AM_BND_CREATE_EXPR::unbnd_args ARRAY{1}::elt!
num::=0.up!;-- INT::up!
if i=0 then-- INT::is_eq
if ~e.fun.tp.is_external then-- AM_BND_CREATE_EXPR::fun SIG::tp BOOL::not
s:=s+", "+mang(e.fun.tp);-- STR::plus STR::plus CODE_FILE::mang AM_BND_CREATE_EXPR::fun SIG::tp
end;
else
s:=s+", "+ fix_out_type(e.fun.args[i-1], -- STR::plus STR::plus CODE_FILE::fix_out_type AM_BND_CREATE_EXPR::fun SIG::args ARRAY{1}::aget INT::minus
mang(e.fun.args[i-1].tp));-- CODE_FILE::mang AM_BND_CREATE_EXPR::fun SIG::args ARRAY{1}::aget INT::minus ARG::tp
end;
end;
if cgen.func_tables then-- CODE_FILE::cgen CGEN::func_tables
s:=s+",struct _func_frame *";-- STR::plus
end;
s:=s+");\n";-- STR::plus
bstr.set!(s);-- ARRAY{1}::set!
end;
bstr.sort;-- ARRAY{1}::sort
res::="";
loop res:=res+bstr.elt!; end;-- STR::plus ARRAY{1}::elt!
SYS::destroy(bstr);-- SYS::destroy
return res;
end;
private bnd_iter_declarations:STR is --AJ-
-- Generate declarations for bound iter objects
bstr::=#ARRAY{STR}(bnd_iter_creates.size);-- ARRAY{1}::create CODE_FILE::bnd_iter_creates FLIST{1}::size
loop
s:STR;
e::=bnd_iter_creates.elt!;-- CODE_FILE::bnd_iter_creates FLIST{1}::elt!
name::=mang(e);-- CODE_FILE::mang
if ~void(e.fun.ret) then s:=mang(e.fun.ret)+' '; -- generates RETTYPE-- AM_BND_CREATE_EXPR::fun SIG::ret BOOL::not CODE_FILE::mang AM_BND_CREATE_EXPR::fun SIG::ret STR::plus
else s:="void "; end;
--name_call_function(name_iter_ob)
s:=s+name+"_call_function"+'('+name+"_iter_ob";-- STR::plus STR::plus STR::plus STR::plus STR::plus
if cgen.func_tables then-- CODE_FILE::cgen CGEN::func_tables
s:=s+",struct _func_frame *";-- STR::plus
end;
s := s + ");\n" ;-- STR::plus
-- that is it unbnd args are passed in the frame by the caller
bstr.set!(s);-- ARRAY{1}::set!
end;
bstr.sort; -- ARRAY{1}::sort
res::="";
loop res:=res+bstr.elt!+"\n"; end;-- STR::plus ARRAY{1}::elt! STR::plus
SYS::destroy(bstr);-- SYS::destroy
return res;
end;
private unbox_dec(s,abs:SIG):STR is
res::="";
-- until mangling is really correct, use func_unbox as name
name::=mang(s)+"_unbox";-- CODE_FILE::mang STR::plus
if void(s.ret) then-- SIG::ret
res:=res+"void ";-- STR::plus
-- DPS: These lines aren't right, so they've been commented out.
-- The unboxing function *never* returns a "_boxed" type.
--elsif abs.ret.is_abstract and s.ret.is_immutable then
-- res:=res+mang(abs.ret)+"_boxed ";
else
res:=res+mang(abs.ret)+' '; -- STR::plus CODE_FILE::mang SIG::ret STR::plus
end;
-- indentation screwed up here
if s.is_iter then-- SIG::is_iter
res:=res+name+'('+mang(abs)+"_frame";-- STR::plus STR::plus STR::plus CODE_FILE::mang STR::plus
else
if abs.tp.is_abstract and s.tp.is_immutable then-- SIG::tp SIG::tp
res:=res+name+"("+mang(s.tp)+"_boxed";-- STR::plus STR::plus STR::plus CODE_FILE::mang SIG::tp STR::plus
else
res:=res+name+"("+mang(s.tp);-- STR::plus STR::plus STR::plus CODE_FILE::mang SIG::tp
end;
loop
sa::= s.args.elt!;-- SIG::args ARRAY{1}::elt!
se::=sa.tp;-- ARG::tp
abse::=abs.args.elt!.tp;-- SIG::args ARRAY{1}::elt! ARG::tp
idx::=1.up!;-- INT::up!
if abse.is_abstract and se.is_immutable then
res:=res+", "+mang(se)+"_boxed";-- STR::plus STR::plus CODE_FILE::mang STR::plus
else
res:=res+", "+fix_out_type(sa, mang(se));-- STR::plus STR::plus CODE_FILE::fix_out_type CODE_FILE::mang
end;
end;
end;
if cgen.func_tables then-- CODE_FILE::cgen CGEN::func_tables
res:=res+",struct _func_frame *";-- STR::plus
end;
res:=res+");\n";-- STR::plus
if s.is_iter then-- SIG::is_iter
--emit the frame allocator decl
res := res + "void* "+mang(s)+"_frame_alloc();\n";-- STR::plus STR::plus CODE_FILE::mang STR::plus
end;
return res;
end;
merge:STR is
-- There is a tension between having lots of files to increase
-- parallelism and having few to decrease overhead. In addition,
-- The mechanism used to decide what files routines' definitions
-- should go to must be deterministic and attempt to cluster
-- those routines likely to be changed together (in order to
-- minimize the number of files that must be recompiled.)
-- The heuristic used here is to always put routines belonging
-- to the same class in the same file. In addition, classes
-- are grouped alphabetically as long as the result doesn't
-- make the file size go over a threshold. This means that
-- the actual number of files to be output isn't known until
-- after all code has been generated. For this reason,
-- 'merge' returns a list of code files actually output to
-- be placed in the Makefile.
-- 'finalize' must b called after 'merge'. The text of the
-- Makefile can't be known until 'merge' returns, which is
-- why these two phases are split up.
-- First, sort all classes alphabetically. This improves the
-- chance that changes will remain local, and also makes it
-- easier to browse through the C code.
sorted::=#CODE_FILE_ARRAY(all.size);-- CODE_FILE_ARRAY::create CODE_FILE::all FLIST{1}::size
loop sorted.set!(all.elt!); end;-- CODE_FILE_ARRAY::set! CODE_FILE::all FLIST{1}::elt!
sorted.sort;-- CODE_FILE_ARRAY::sort
todo:=#FLIST{CODE_FILE};-- CODE_FILE::todo FLIST{1}::create
last:CODE_FILE:=void;
loop
next::=sorted.elt!;-- CODE_FILE_ARRAY::elt!
next.text:=next.text.push(next.ntext);-- CODE_FILE::text CODE_FILE::text FLIST{1}::push CODE_FILE::ntext
next.length:=next.length+next.ntext.length;-- CODE_FILE::length CODE_FILE::length INT::plus CODE_FILE::ntext FSTR::length
next.ntext:=#FSTR;-- CODE_FILE::ntext FSTR::create
if ~next.is_c_code or next.do_not_merge then-- CODE_FILE::is_c_code BOOL::not CODE_FILE::do_not_merge
todo:=todo.push(next);-- CODE_FILE::todo CODE_FILE::todo FLIST{1}::push
elsif void(last) then
last:=next;
elsif ~last.same_options_as(next)-- CODE_FILE::same_options_as
or last.length+next.length>cgen.threshold then-- BOOL::not CODE_FILE::length INT::plus CODE_FILE::length CODE_FILE::cgen CGEN::threshold
todo:=todo.push(last);-- CODE_FILE::todo CODE_FILE::todo FLIST{1}::push
last:=next;
else
-- Merge this C file with the last one.
last.text:=last.text.concat(next.text);-- CODE_FILE::text CODE_FILE::text FLIST{1}::concat CODE_FILE::text
last.length:=last.length+next.length;-- CODE_FILE::length CODE_FILE::length INT::plus CODE_FILE::length
--last.text:=last.text+next.text;
last.decs:=last.decs.union(next.decs);-- CODE_FILE::decs CODE_FILE::decs FSET{1}::union CODE_FILE::decs
last.layouts:=last.layouts.union(next.layouts);-- CODE_FILE::layouts CODE_FILE::layouts FSET{1}::union CODE_FILE::layouts
last.globals:=last.globals.union(next.globals);-- CODE_FILE::globals CODE_FILE::globals FSET{1}::union CODE_FILE::globals
last.bnd_rout_creates:=-- CODE_FILE::bnd_rout_creates
last.bnd_rout_creates.union(next.bnd_rout_creates);-- CODE_FILE::bnd_rout_creates FLIST{1}::union CODE_FILE::bnd_rout_creates
last.bnd_iter_creates:=-- CODE_FILE::bnd_iter_creates
last.bnd_iter_creates.union(next.bnd_iter_creates); --AJ--- CODE_FILE::bnd_iter_creates FLIST{1}::union CODE_FILE::bnd_iter_creates
last.unboxes:=last.unboxes.union(next.unboxes);-- CODE_FILE::unboxes CODE_FILE::unboxes FSET{1}::union CODE_FILE::unboxes
last.externs:=last.externs.union(next.externs);-- CODE_FILE::externs CODE_FILE::externs FSET{1}::union CODE_FILE::externs
last.iters:=last.iters.union(next.iters);-- CODE_FILE::iters CODE_FILE::iters FSET{1}::union CODE_FILE::iters
SYS::destroy(next.text);-- SYS::destroy CODE_FILE::text
if ~void(next.layouts) then SYS::destroy(next.layouts); end;-- CODE_FILE::layouts BOOL::not SYS::destroy CODE_FILE::layouts
if ~void(next.decs) then SYS::destroy(next.decs); end;-- CODE_FILE::decs BOOL::not SYS::destroy CODE_FILE::decs
end;
end;
todo:=todo.push(last);-- CODE_FILE::todo CODE_FILE::todo FLIST{1}::push
res::="";
loop
next::=todo.elt!;-- CODE_FILE::todo FLIST{1}::elt!
if next.is_c_code then -- CODE_FILE::is_c_code
res:=res+' '+next.name.replace_suffix(prog.config.get_str("C_EXT",0),prog.config.get_str("OBJECT_EXT",0));-- STR::plus STR::plus CODE_FILE::name STR::replace_suffix CODE_FILE::prog PROG::config CONFIG_TBL::get_str CODE_FILE::prog PROG::config CONFIG_TBL::get_str
end;
end;
return res;
end;
finalize is
-- Indicate done with all files. This causes any files which
-- have changed to be written out.
generate_layouts;-- CODE_FILE::generate_layouts
-- esc: Create list of all old files
to_delete::=#FSET{STR};-- FSET{1}::create
loop
to_delete:=to_delete.insert(thumbprints.keys!);-- FSET{1}::insert CODE_FILE::thumbprints FMAP{2}::keys!
end; -- loop
total::=0;
regen::=0;
th::=FILE::open_for_write(dir+'/'+"THUMBPRINTS");-- FILE::open_for_write CODE_FILE::dir STR::plus STR::plus
if th.error then prog.barf("Couldn't write thumbprints"); end;-- FILE::error CODE_FILE::prog PROG::barf
loop
cc::=todo.elt!;-- CODE_FILE::todo FLIST{1}::elt!
to_delete:=to_delete.delete(cc.name); -- esc: Remove name from list-- FSET{1}::delete CODE_FILE::name
oldthp::=thumbprints.get(cc.name);-- CODE_FILE::thumbprints FMAP{2}::get CODE_FILE::name
wholetext::=#FSTR;-- FSTR::create
if cc.is_c_code then-- CODE_FILE::is_c_code
header::=cc.header_info;-- CODE_FILE::header_info
wholetext:=wholetext+header;-- FSTR::plus
SYS::destroy(header);-- SYS::destroy
end;
textarr:ARRAY{FSTR}:=#(cc.text.size+1);-- ARRAY{1}::create CODE_FILE::text FLIST{1}::size INT::plus
loop textarr.set!(cc.text.elt!); end;-- ARRAY{1}::set! CODE_FILE::text FLIST{1}::elt!
textarr[textarr.size-1]:=cc.ntext;-- ARRAY{1}::aset ARRAY{1}::size INT::minus CODE_FILE::ntext
textarr.sort;-- ARRAY{1}::sort
loop
t::=textarr.elt!;-- ARRAY{1}::elt!
wholetext:=wholetext+t;-- FSTR::plus
SYS::destroy(t);-- SYS::destroy
end;
if ~void(cc.text) then SYS::destroy(cc.text); end;-- CODE_FILE::text BOOL::not SYS::destroy CODE_FILE::text
if ~void(textarr) then SYS::destroy(textarr); end;-- BOOL::not SYS::destroy
--wholetext:=wholetext+cc.text;
--wholetext:=wholetext+cc.ntext;
newthp::=wholetext.thumbprint;-- FSTR::thumbprint
if oldthp/=(newthp+'\n') then-- STR::is_eq STR::plus BOOL::not
f::=FILE::open_for_write(dir+'/'+cc.name);-- FILE::open_for_write CODE_FILE::dir STR::plus STR::plus CODE_FILE::name
if f.error then prog.barf("Couldn't write "+cc.name); end;-- FILE::error CODE_FILE::prog PROG::barf STR::plus CODE_FILE::name
f+wholetext+'\n'; -- FILE::plus FILE::plus
f.close;-- FILE::close
regen:=regen+1;-- INT::plus
end;
th+cc.name+' '+newthp+'\n';-- FILE::plus CODE_FILE::name FILE::plus FILE::plus FILE::plus
SYS::destroy(wholetext);-- SYS::destroy
total:=total+1;-- INT::plus
end;
th.close;-- FILE::close
-- esc: Delete old files
loop
name::=dir+'/'+to_delete.elt!;-- CODE_FILE::dir STR::plus STR::plus FSET{1}::elt!
FILE::delete(name);-- FILE::delete
FILE::delete(name.replace_suffix(prog.config.get_str("C_EXT",0),prog.config.get_str("OBJECT_EXT",0)));-- FILE::delete STR::replace_suffix CODE_FILE::prog PROG::config CONFIG_TBL::get_str CODE_FILE::prog PROG::config CONFIG_TBL::get_str
end; -- loop
if prog.verbose then-- CODE_FILE::prog PROG::verbose
(#OUT+"Regenerated "+regen+" of "+total+" files... ").flush;-- OUT::create OUT::plus OUT::plus OUT::plus OUT::plus OUT::plus OUT::flush
end;
end;
end; -- class CODE_FILE
class CODE_FILE_ARRAY
class CODE_FILE_ARRAY is
-- This makes it easy to sort.
include ARRAY{CODE_FILE};
elt_lt(x,y:CODE_FILE):BOOL is
return x.name<y.name;-- CODE_FILE::name STR::is_lt CODE_FILE::name
end;
end;
class LAYOUT_ARRAY
class LAYOUT_ARRAY is
-- This makes it easy to sort.
include ARRAY{$LAYOUT};
elt_lt(x,y:$LAYOUT):BOOL is
return x.str<y.str;-- STR::is_lt
end;
end;
-- vim:sw=3:nosmartindent