prog.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. <----------
-- prog.sa: Classes relating to entire Sather programs.
-- PROG: The most common program object.
-- $PROG_ERR:Parent for classes which can identify error locations.
-- PROG_AS_TBL: Table mapping a classname idents to source trees.
-- CS_COMPONENT: Included by those who want delegated access to prog.
class PROG
class PROG is
-- These tables are shared by the different phases of the compiler.
attr config:CONFIG_TBL; -- the configuration table
attr tp_tbl:TP_TBL; -- The type table.
attr tp_graph:TP_GRAPH; -- The type graph.
attr tp_graph_abs_des:TP_GRAPH_ABS_DES; -- Abstract descendants.
attr tp_done:FSET{$TP}; -- Table of types which have already
-- been examined to get other types.
attr as_tbl:PROG_AS_TBL; -- The table of code trees.
attr stat:$STAT; -- used to gather statistics;
-- These objects control the various stages of compilation.
-- See the file `stages.sa' for their interfaces.
attr get_options:$GET_OPTIONS;
attr parse:$PARSE;
attr find_types:$FIND_TYPES;
attr build_type_graph:$BUILD_TYPE_GRAPH;
attr check_ifc_conformance:$CHECK_IFC_CONFORMANCE;
attr get_main_sig:$GET_MAIN_SIG;
attr generate_am:$GENERATE_AM;
attr inliner:$INLINE;
attr optimizer:$OPTIMIZE;
attr back_end:$BACK_END;
attr check_am:$CHECK_AM;
-- These are general options. Other options are found in the
-- components which need them.
attr sather_files:FSET{STR}; -- Sather source files
attr main_class:STR; -- The class with main
attr home:STR; -- home
attr verbose:BOOL; -- Be noisy
attr print_version:BOOL; -- Prints info about compiler version. etc
attr prolix:BOOL; -- Be really noisy
attr platforms:FLIST{STR}; -- list of platforms to be used
attr genuine_platforms:INT; -- counter, incremented each time a "real" platform (as
-- opposed to bogus platforms like -gui) is used.
-- At most one real platfomr can be specified.
attr boot:BOOL; -- true if a boot compiler is beeing generated
attr threads:BOOL; -- Accept pSather code and generate code for one cluster
attr distributed:BOOL; -- Accept pSather code and generate code for more than one cluster
psather:BOOL is return threads or distributed; end;-- PROG::threads PROG::distributed
attr zones:BOOL; -- use zones
attr trace:BOOL;
attr arch:STR; -- Architecture to compile for (pSather only)
attr opt_debug:BOOL; -- print out optimizer debug info
attr opt_verbose:BOOL; -- print out opt. info
attr opt_debug_func:FLIST{STR}; -- if not void only functions with a signature that contains one of these strings are "opt_debuggged"
attr inline_iters:BOOL; -- true if iters are to be inlined
attr inline_routs:BOOL; -- true if routines are to be inlined
attr hoist_const:BOOL; -- true if loop constants should be hoisted
attr yields_in_locks:BOOL; -- true if yields in locks should be optimized
attr locks_on_stack:BOOL; -- true if locks that don't have to be on the exc. stack should not be put there
attr replace_iters:BOOL; -- true if array and some int iters should be replaced
attr move_while:BOOL; -- true if while!/until! have to be moved to the end of loops
attr hoist_iter_init:BOOL; -- true if the initialization of iters has to be hoisted
attr pre_checks:BOOL; -- true if at least one class makes pre checks
attr post_checks:BOOL; -- true if at least one class makes post checks
attr assert_checks:BOOL; -- true if at least one class makes assert checks
attr arith_checks:BOOL; -- true if at least one class makes arith. checks
attr void_checks:BOOL; -- true if at least one class makes void access checks
attr parse_nonlib_classes:BOOL;
-- true if non library classes should be parsed, and not only
-- classes reachable from the main class.
attr show_calls: STR; -- If non-void, print out all function calls
-- These attributes are used to control debugging output.
attr show_parse_file:BOOL; -- Show files parsed.
attr show_tr:BOOL; -- Show TR.
attr show_as_insert:BOOL; -- Show trees inserted.
attr show_impl_create:BOOL; -- Show when an impl is created.
attr show_ifc_abs_create:BOOL; -- Show when abstract ifc's are created.
attr show_include:BOOL; -- Show when an include is processed.
attr show_types:BOOL; -- Show all types found.
attr show_graphs:BOOL; -- Show the type graphs.
attr show_ifc:BOOL; -- Show all interfaces.
attr show_main:BOOL; -- Show the main sig.
attr show_generated_sig:BOOL; -- Show the sigs with code generated.
attr show_am:BOOL; -- Show the am code generated.
attr show_checked_sig:BOOL; -- Show the sigs as they are checked.
attr show_am_check:BOOL; -- Show am for for checked sigs.
attr no_new_types: BOOL; -- True, when find_types has finished.
-- for debugging
-- These are to use in the presence of errors:
attr generate_checked_code:BOOL; -- Generate all code if true.
attr all_reached:BOOL; -- True when all reachable code emitted
-- Used for collecting statistics:
attr itercounts:ARRAY{INT};
attr hotcounts:ARRAY{INT};
attr loops_seen:FSET{SFILE_ID};
create:SAME is
-- A new program object. All the components have to be filled
-- in from outside, after creation.
r::=new;
IDENT_BUILTIN::init;-- IDENT_BUILTIN::init
return r;
end;
-- The following routines handle error messages.
attr eloc:SFILE_ID; -- Current error location.
attr err_seen:BOOL; -- True if an error has been seen.
attr err_list:FLIST{SFILE_ID};
err_loc(t:$PROG_ERR) is
-- Make the node held by
-- `t' be the culprit for the next error, if any. If `t' is void,
-- then don't print a location with the next message.
if void(t) then eloc:=void; return end;-- PROG::eloc
eloc:=t.source end;-- PROG::eloc
set_eloc(l:SFILE_ID) is
-- Set `eloc' to `l'.
eloc:=l end;-- PROG::eloc
err(s:STR) is
-- Report an error with `s' as the error
-- string and the last tree node given to `err_loc' as the
-- location. This string shouldn't have information like "Error"
-- and should be an unformatted line of text. It should be a
-- complete sentence beginning with a capital letter and ending
-- with a period. If this is called during a compile, source code
-- will not be generated, but the compile will proceed as far as
-- possible.
if verbose and ~err_seen then #OUT + '\n'; end;-- PROG::verbose PROG::err_seen BOOL::not OUT::create OUT::plus
err_seen:=true;-- PROG::err_seen
if ~void(eloc) then if err_loc_old(eloc) then return end end;-- PROG::eloc BOOL::not PROG::eloc
if ~void(eloc) then #OUT + eloc.str + ": " end;-- PROG::eloc BOOL::not OUT::create PROG::eloc SFILE_ID::str OUT::plus
#OUT + s + "\n";-- OUT::create OUT::plus OUT::plus
end;
warning(s:STR) is
-- Report a warning. Like an error, but doesn't stop compile.
-- In general, our philosophy is that warnings are poor compiler
-- interface and their use should be avoided.
-- if ~void(eloc) then if err_loc_old(eloc) then return end end;
if ~void(eloc) then #OUT + eloc.str + ": " end;-- PROG::eloc BOOL::not OUT::create PROG::eloc SFILE_ID::str OUT::plus
#OUT + "WARNING: " + s + "\n" end;-- OUT::create OUT::plus OUT::plus OUT::plus
err_loc_old(l:SFILE_ID):BOOL is
-- Return true if `l' has been seen before, otherwise add
-- it to the list.
i::=0;
if void(err_list) then err_list:=err_list.push(l); return false end;-- PROG::err_list PROG::err_list PROG::err_list FLIST{1}::push
loop while!(i<err_list.size);-- PROG::err_list FLIST{1}::size
if l=err_list[i] then return true end;-- PROG::err_list FLIST{1}::aget
i:=i+1 end;-- INT::plus
err_list:=err_list.push(l);-- PROG::err_list PROG::err_list FLIST{1}::push
return false end;
barf(msg:STR) is barf_at(msg,void); end;-- PROG::barf_at
-- Something wrong within the compiler, but we can't say where.
barf_at(msg:STR,at:$PROG_ERR) is
-- Something wrong, and we know where.
err_loc(at);-- PROG::err_loc
err("Internal compiler error: "+msg);-- PROG::err STR::plus
UNIX::exit(1); -- Why bother continuing? Something's very wrong.-- UNIX::exit
end;
end; -- class PROG
abstract class $PROG_ERR
abstract class $PROG_ERR is
-- Parent class for classes which can identify error locations.
source:SFILE_ID; -- The origin of a node in a Sather
-- source file.
end;
class PROG_AS_TBL
class PROG_AS_TBL is
-- Table mapping a classname idents to source trees.
--
-- `get_query(TUP{IDENT,INT}):AS_CLASS_DEF' looks up a class.
-- `test_query(TUP{IDENT,INT}):BOOL' tests for a class.
-- `test(AS_CLASS_DEF):BOOL' tests for a tree.
-- `insert(AS_CLASS_DEF):SAME' inserts a tree.
-- `delete(AS_CLASS_DEF):SAME' deletes a tree.
include FQSET{TUP{IDENT,INT},AS_CLASS_DEF};
query_test(q:TUP{IDENT,INT}, t:AS_CLASS_DEF):BOOL is
-- True if `t' is the type described by `q'.
if void(t) then return false end;
if q.t1/=t.name then return false end;-- TUP{2}::t1 IDENT::is_eq AS_CLASS_DEF::name BOOL::not
if q.t2/=t.params.size then return false end;-- TUP{2}::t2 INT::is_eq AS_CLASS_DEF::params AS_PARAM_DEC::size BOOL::not
return true end;
query_hash(q:TUP{IDENT,INT}):INT is
-- A hash value computed from the query types.
return q.t1.hash+1111*q.t2 end;-- TUP{2}::t1 IDENT::hash INT::plus INT::times TUP{2}::t2
elt_hash(e:AS_CLASS_DEF):INT is
-- Hash on the types in `e'.
return e.name.hash+1111*e.params.size end;-- AS_CLASS_DEF::name IDENT::hash INT::plus INT::times AS_CLASS_DEF::params AS_PARAM_DEC::size
-- Output of TR for debugging purposes
as_out(p:PROG) is
AS_OUT::prog:=p;-- AS_OUT::prog
loop
classdef ::= elt!;-- PROG_AS_TBL::elt!
-- only print out those that are not in has map.
fn::=classdef.source.file_in;-- AS_CLASS_DEF::source SFILE_ID::file_in
parse ::= p.parse;-- PROG::parse
typecase parse
when PARSE then
if ~parse.known_files.test(fn) then-- PARSE::known_files FSET{1}::test BOOL::not
AS_OUT::AS_NODE_out(classdef);-- AS_OUT::AS_NODE_out
end;
else
end;
end;
end;
dump is
loop
classdef ::= elt!;-- PROG_AS_TBL::elt!
res ::= classdef.name.str + "{";-- AS_CLASS_DEF::name IDENT::str STR::plus
param ::= classdef.params;-- AS_CLASS_DEF::params
loop until!(void(param));
res := res + ",".separate!(param.name.str);-- STR::plus STR::separate! AS_PARAM_DEC::name IDENT::str
param := param.next-- AS_PARAM_DEC::next
end;
#OUT + res + "}\n";-- OUT::create OUT::plus OUT::plus
end
end;
end; -- class PROG_AS_TBL
class CS_COMPONENT
class CS_COMPONENT is
-- gives delegated access to the central PROG object.
attr prog:PROG;
barf(msg:STR) is prog.barf(msg); end;-- MANGLE::prog PROG::barf
-- Something wrong within the compiler, but we can't say where.
barf_at(msg:STR,at:$PROG_ERR) is prog.barf_at(msg,at); end;-- CGEN::prog PROG::barf_at
-- Something wrong, and we know where.
err(s:STR) is prog.err(s); end;-- SCANNER::prog PROG::err
-- Report an error.
err_loc(t:$PROG_ERR) is prog.err_loc(t); end;-- PARSE::prog PROG::err_loc
-- Set where a future error should be reported at.
warning(s:STR) is prog.warning(s); end;-- CGEN::prog PROG::warning
-- report a warning (doesn't stop compile);
end;