get_options.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. <----------
class GET_OPTIONS < $GET_OPTIONS
class GET_OPTIONS < $GET_OPTIONS is
-- This is the standard options module for the Sather compiler.
-- It is meant to be included in classes which specialize for a
-- particular configuration; for example, there is a special
-- version for the C back-end that handles any options it needs.
include CS_COMPONENT;
attr module_inclusion:FMAP{STR,STR};
private attr paths:FSET{STR};
-- Resolved Sather source paths (to allow redundancy in on command line)
create(p:PROG):SAME is
r::=new;
r.prog:=p;-- CS_OPTIONS::prog
p.main_class:="MAIN";-- PROG::main_class
r.module_inclusion:=#;-- CS_OPTIONS::module_inclusion FMAP{2}::create
return r;
end;
private mention(name,s1,s2:STR):STR is
if s2/="" then return s1+'\n'+name+": "+s2;-- STR::is_eq BOOL::not STR::plus STR::plus STR::plus STR::plus
else return s1;
end;
end;
str:STR is
-- diagnostic for printing the state of a command line parse
r,s:STR;
r:=""; loop r:=r+' '+prog.sather_files.elt!; end;-- STR::plus CODE_OPTIONS::prog PROG::sather_files FSET{1}::elt!
s:=mention("Sather files","",r);-- CODE_OPTIONS::mention
s:=mention("Main class",s,prog.main_class);-- CODE_OPTIONS::mention CODE_OPTIONS::prog PROG::main_class
s:=s+"\nHome directory: "+prog.home;-- STR::plus CODE_OPTIONS::prog PROG::home
if prog.prolix then s:=s+"\nProlix."; end;-- CODE_OPTIONS::prog PROG::prolix STR::plus
if prog.verbose then s:=s+"\nVerbose."; end;-- CODE_OPTIONS::prog PROG::verbose STR::plus
return s;
end;
private attr args:ARRAY{STR};
private attr arg_locations:ARRAY{STR};
private attr next:INT;
private attr classes:FSET{STR};
private attr all:BOOL;
private attr got_libs:BOOL;
interpret(a:ARRAY{STR}) is
-- interpret command lines.
args:=a;-- CODE_OPTIONS::args
arg_locations := #(a.size);-- CODE_OPTIONS::arg_locations ARRAY{1}::create ARRAY{1}::size
loop arg_locations.set!("command line"); end;-- CODE_OPTIONS::arg_locations ARRAY{1}::set!
next:=1;-- CODE_OPTIONS::next
get_files;-- CODE_OPTIONS::get_files
loop while!(more_args);-- CODE_OPTIONS::more_args
s::=next_arg;-- CODE_OPTIONS::next_arg
if prog.prolix then -- CODE_OPTIONS::prog PROG::prolix
#OUT+"Processing option:"+s+"\n";-- OUT::create OUT::plus OUT::plus OUT::plus
end;
case s
when "-main" then prog.main_class:=next_arg;-- STR::is_eq CODE_OPTIONS::prog PROG::main_class CODE_OPTIONS::next_arg
when "-home" then-- STR::is_eq
barf("\"-home\" is not used any more; use SATHER_HOME instead.");-- CODE_OPTIONS::barf
when "-verbose" then prog.verbose:=true;-- STR::is_eq CODE_OPTIONS::prog PROG::verbose
when "-prolix" then-- STR::is_eq
prog.verbose:=true;-- CODE_OPTIONS::prog PROG::verbose
prog.prolix:=true;-- CODE_OPTIONS::prog PROG::prolix
when "-O_debug" then prog.opt_debug:=true;prog.opt_verbose:=true;-- STR::is_eq CODE_OPTIONS::prog PROG::opt_debug CODE_OPTIONS::prog PROG::opt_verbose
when "-O_debug_func" then prog.opt_debug_func:=prog.opt_debug_func.push(next_arg);prog.opt_verbose:=true;-- STR::is_eq CODE_OPTIONS::prog PROG::opt_debug_func CODE_OPTIONS::prog PROG::opt_debug_func FLIST{1}::push CODE_OPTIONS::next_arg CODE_OPTIONS::prog PROG::opt_verbose
when "-O_verbose" then prog.opt_verbose:=true;-- STR::is_eq CODE_OPTIONS::prog PROG::opt_verbose
when "-end" then -- do nothing-- STR::is_eq
else
handle_other_options(s);-- CODE_OPTIONS::handle_other_options
end;
end;
if void(prog.home) then-- CODE_OPTIONS::prog PROG::home
barf("No home directory specified. Make sure SATHER_HOME is set correctly.");-- CODE_OPTIONS::barf
end;
--# if ~got_libs then
--# got_libs:=true;
--# interpret(library_file);
--# end;
end;
private handle_files(s:STR) is
if is_filename(s) then rewind; get_files;-- CODE_OPTIONS::is_filename CODE_OPTIONS::rewind CODE_OPTIONS::get_files
else rewind; usage; return;-- CODE_OPTIONS::rewind CODE_OPTIONS::usage
end;
end;
private handle_other_options(s:STR) is
-- This is meant to be overridden in classes which include
-- GET_OPTIONS, for other command lines options.
handle_files(s);-- GET_OPTIONS::handle_files
end;
private home_expand(s:STR):STR is
-- Expand any occurances of '%' with the Sather home directory.
res::="";
loop c::=s.elt!;
if c/='%' then res:=res+c;
elsif prog.home=".." then -- for the bootstrap
res:=res+"../..";
else
res:=res+prog.home;
end;
end;
return res;
end;
private barf(msg:STR) is
#ERR + msg + '\n';-- ERR::create ERR::plus ERR::plus
UNIX::exit(1);-- UNIX::exit
end;
private more_args:BOOL is return next<args.size end;-- CODE_OPTIONS::next CODE_OPTIONS::args ARRAY{1}::size
private next_arg:STR is
if more_args then res::=args[next]; next:=next+1; return res;-- CODE_OPTIONS::more_args CODE_OPTIONS::args CODE_OPTIONS::next CODE_OPTIONS::next CODE_OPTIONS::next INT::plus
else usage; return "";-- CODE_OPTIONS::usage
end;
end;
rewind is next:=next-1; end;-- CODE_OPTIONS::next CODE_OPTIONS::next INT::minus
private get_classes is
-- get a list of classes from the argument list
classes:=#;-- CODE_OPTIONS::classes FSET{1}::create
loop while!(more_args);-- CODE_OPTIONS::more_args
arg::=next_arg;-- CODE_OPTIONS::next_arg
all:=arg="all";-- CODE_OPTIONS::all STR::is_eq
if all then return;-- CODE_OPTIONS::all
elsif is_class_name(arg) then classes:=classes.insert(arg);-- CODE_OPTIONS::is_class_name CODE_OPTIONS::classes CODE_OPTIONS::classes FSET{1}::insert
else rewind; return;-- CODE_OPTIONS::rewind
end;
end;
end;
private is_class_name(nm:STR):BOOL is
-- is this string a viable class name?
if nm[0]/='$' and ~nm[0].is_upper then return false; end;-- STR::aget CHAR::is_eq BOOL::not STR::aget CHAR::is_upper BOOL::not
loop c::=nm.elt!(1);-- STR::elt!
case c
when 'A','B','C','D','E','F','G','H','I','J',
'K','L','M','N','O','P','Q','R','S','T',
'U','V','W','X','Y','Z','0','1','2','3',
'4','5','6','7','8','9','_' then
else return false;
end;
end;
return true;
end;
private files:FSET{STR} is
-- get a list of files from the command line
r::=#FSET{STR};-- FSET{1}::create
loop while!(more_args);-- CS_OPTIONS::more_args
arg::=next_arg;-- CS_OPTIONS::next_arg
-- These guys might have come from the literal string,
-- so need to process accordingly
if ~void(arg) then-- BOOL::not
loop
piece ::= arg.split!(' ');-- STR::split!
-- pass -l and -L to the linker as is
if piece[0] = '-' and (piece[1] = 'l' or piece[1] = 'L') then-- STR::aget CHAR::is_eq STR::aget CHAR::is_eq STR::aget CHAR::is_eq
r:=r.insert(piece);-- FSET{1}::insert
else
if is_filename(piece) then r:=r.insert(piece);-- CS_OPTIONS::is_filename FSET{1}::insert
else rewind; return r;-- CS_OPTIONS::rewind
end;
end;
end;
end;
end;
return r;
end;
private get_files is
-- get list of files from the command line and put in appropriate set
loop
while!(more_args);-- CODE_OPTIONS::more_args
arg::=next_arg;-- CODE_OPTIONS::next_arg
if ~is_filename(arg) then rewind; break!; end;-- CODE_OPTIONS::is_filename BOOL::not CODE_OPTIONS::rewind
suf::=suffix(arg);-- CODE_OPTIONS::suffix
if suf=".sa" then-- STR::is_eq
-- make sure isn't found by a different name already
path::=FILE::resolve_path(arg);-- FILE::resolve_path
if ~paths.test(path) then-- CODE_OPTIONS::paths FSET{1}::test BOOL::not
prog.sather_files:=prog.sather_files.insert(arg);-- CODE_OPTIONS::prog PROG::sather_files CODE_OPTIONS::prog PROG::sather_files FSET{1}::insert
paths:=paths.insert(path);-- CODE_OPTIONS::paths CODE_OPTIONS::paths FSET{1}::insert
end;
elsif suf=".module" then insert_here(args_from_file(arg),arg);-- STR::is_eq CODE_OPTIONS::insert_here CODE_OPTIONS::args_from_file
else handle_other_file_suffix(arg,suf); return;-- CODE_OPTIONS::handle_other_file_suffix
end;
end;
end;
private handle_other_file_suffix(arg,suf:STR) is
-- Meant to be overridden
case suf
when ".c", ".o", ".a", ".obj", ".lib" then return;-- STR::is_eq STR::is_eq STR::is_eq STR::is_eq STR::is_eq
else
#ERR + "Didn't understand apparent file name: " + arg + '\n';-- ERR::create ERR::plus ERR::plus ERR::plus
usage;-- CODE_OPTIONS::usage
-- rewind;
end;
end;
private usage is
#ERR + "Command line error near: " + args[next.min(args.size-1)] ;-- ERR::create ERR::plus CODE_OPTIONS::args CODE_OPTIONS::next INT::min CODE_OPTIONS::args ARRAY{1}::size INT::minus
#ERR + " in "+arg_locations[next.min(args.size-1)]+'\n';-- ERR::create ERR::plus CODE_OPTIONS::arg_locations CODE_OPTIONS::next INT::min CODE_OPTIONS::args ARRAY{1}::size INT::minus ERR::plus
#ERR + "(See man page.)\n";-- ERR::create ERR::plus
UNIX::exit(1);-- UNIX::exit
end;
private suffix(a:STR):STR is
pos:INT;
loop pos:=(a.length-1).downto!(0); until!(a[pos]='.'); end;-- STR::length INT::minus INT::downto! STR::aget CHAR::is_eq
return a.tail(a.length-pos);-- STR::tail STR::length INT::minus
end;
private is_filename(fn:STR):BOOL is
if fn[0]='-' then return false; end;-- STR::aget CHAR::is_eq
if fn[0]='/' then return true; end;-- STR::aget CHAR::is_eq
return fn.search('.')/= -1;-- STR::search INT::is_eq BOOL::not
--case suffix(fn)
-- when ".c", ".sa", ".o", ".a", ".lib", ".obj" then return true;
-- else return false;
--end;
end;
private insert_here(cl:FLIST{STR},filename: STR) is
-- insert a list of args so it will be read next
tail,tail_names:ARRAY{STR};
if more_args then -- CODE_OPTIONS::more_args
tail:=args.subarr(next,args.size-next);-- CODE_OPTIONS::args ARRAY{1}::subarr CODE_OPTIONS::next CODE_OPTIONS::args ARRAY{1}::size CODE_OPTIONS::next
tail_names := #(args.size-next);-- ARRAY{1}::create CODE_OPTIONS::args ARRAY{1}::size CODE_OPTIONS::next
else
tail:=#(0);-- ARRAY{1}::create
tail_names := #(0);-- ARRAY{1}::create
end;
args:=cl.array.append(tail);-- CODE_OPTIONS::args FLIST{1}::array ARRAY{1}::append
arg_locations := #ARRAY{STR}(cl.size);-- CODE_OPTIONS::arg_locations ARRAY{1}::create FLIST{1}::size
loop arg_locations.set!(filename) end;-- CODE_OPTIONS::arg_locations ARRAY{1}::set!
arg_locations := arg_locations.append(tail_names);-- CODE_OPTIONS::arg_locations CODE_OPTIONS::arg_locations ARRAY{1}::append
next:=0;-- CODE_OPTIONS::next
end;
private args_from_file(name:STR):FLIST{STR} is
-- #OUT+"reading module "+name+"\n";
wd::=directory(name);-- CODE_OPTIONS::directory
cl::=#FLIST{STR};-- FLIST{1}::create
f::=FILE::open_for_read(name);-- FILE::open_for_read
if f.error then #ERR + "Couldn't open file: " + name + '\n'; usage; end;-- FILE::error ERR::create ERR::plus ERR::plus ERR::plus CODE_OPTIONS::usage
fs::=f.fstr+' ';-- FILE::fstr FSTR::plus
f.close;-- FILE::close
tok::="";
pos::=0;
loop
until!(pos>=fs.size);-- INT::is_lt FSTR::size BOOL::not
c::=fs[pos];-- FSTR::aget
if c='-' then-- CHAR::is_eq
if fs[pos+1]='-' then-- FSTR::aget INT::plus CHAR::is_eq
loop
pos:=pos+1;-- INT::plus
until!(pos>=fs.size or fs[pos]='\n' or fs[pos]='\r');-- INT::is_lt FSTR::size BOOL::not FSTR::aget CHAR::is_eq FSTR::aget CHAR::is_eq
end;
else tok:=tok+'-';-- STR::plus
end;
elsif c = '(' then-- CHAR::is_eq
if fs[pos+1]='*' then-- FSTR::aget INT::plus CHAR::is_eq
loop
pos:=pos+1;-- INT::plus
if pos>=fs.size-1 then-- INT::is_lt FSTR::size INT::minus BOOL::not
#ERR + "Unterminated comment in " + name + '\n';-- ERR::create ERR::plus ERR::plus ERR::plus
break!;
end;
until!(fs[pos]='*' and fs[pos+1]=')');-- FSTR::aget CHAR::is_eq FSTR::aget INT::plus CHAR::is_eq
end;
pos:=pos+1;-- INT::plus
else tok:=tok+'(';-- STR::plus
end;
elsif c = '"' then-- CHAR::is_eq
start::=pos;
loop
pos:=pos+1;-- INT::plus
if pos>=fs.size-1 then-- INT::is_lt FSTR::size INT::minus BOOL::not
#ERR + "Unterminated string in " + name + '\n';-- ERR::create ERR::plus ERR::plus ERR::plus
break!;
end;
until!(fs[pos]='"');-- FSTR::aget CHAR::is_eq
end;
tok := fs.substring(start, pos-start+1).str;-- FSTR::substring INT::minus INT::plus FSTR::str
tok := tok.as_literal;-- STR::as_literal
tok := expand_str(name, tok);-- CODE_OPTIONS::expand_str
cl := cl.push(tok);-- FLIST{1}::push
tok := "";
pos:=pos+1;-- INT::plus
elsif c = '$' then; -- environment substitution-- CHAR::is_eq
if fs[pos+1] = '(' or fs[pos+1] = '{' then-- FSTR::aget INT::plus CHAR::is_eq FSTR::aget INT::plus CHAR::is_eq
tok := tok + expand_env_var(name, fs, inout pos);-- STR::plus CODE_OPTIONS::expand_env_var
if ~void(tok) then-- BOOL::not
loop while! (~fs[pos].is_space and pos < fs.size);-- FSTR::aget CHAR::is_space BOOL::not INT::is_lt FSTR::size
tok := tok + fs[pos];-- STR::plus FSTR::aget
pos := pos + 1-- INT::plus
end; -- loop
cl := cl.push(tok);-- FLIST{1}::push
end; -- if - "void(tok)"
tok := "";
else
tok := tok + '$'-- STR::plus
end; -- if c = '$'
elsif ~c.is_space then tok:=tok+c;-- CHAR::is_space BOOL::not STR::plus
elsif tok/="" then-- STR::is_eq BOOL::not
if is_filename(tok) and tok[0]/='/' then-- CODE_OPTIONS::is_filename STR::aget CHAR::is_eq BOOL::not
-- This will fail for files with all upper names
tok:=wd+'/'+tok;-- STR::plus STR::plus
end;
if is_filename(tok) then-- CODE_OPTIONS::is_filename
module_inclusion:=module_inclusion.insert(tok,name);-- CODE_OPTIONS::module_inclusion CODE_OPTIONS::module_inclusion FMAP{2}::insert
end;
cl:=cl.push(tok);-- FLIST{1}::push
tok:="";
end;
pos:=pos+1;-- INT::plus
end;
return cl;
end;
expand_str(fname:STR, arg_str:$STR):STR is
-- expand all env vars in arg_str
s:STR := arg_str.str;
i:INT := 0;
res:STR;
loop
while!(i<s.size);-- INT::is_lt STR::size
if s[i] = '$' then-- STR::aget CHAR::is_eq
res := res + expand_env_var(fname, s, inout i);-- STR::plus CODE_OPTIONS::expand_env_var
else
res := res + s[i];-- STR::plus STR::aget
i := i + 1;-- INT::plus
end;
end;
return res;
end;
expand_env_var(fname:STR, arg_str:$STR, inout pos:INT):STR is
-- convert env var starting in position pos in arg_str, coming from
-- file fname.
s:STR := arg_str.str;
e:STR;
op ::= s[pos + 1];-- STR::aget INT::plus
if op = '{' or op = '(' then;-- CHAR::is_eq CHAR::is_eq
skip ::= false;
cp ::= '}';
if op = '(' then cp := ')'; end;-- CHAR::is_eq
tenv ::= "";
pos := pos + 2;-- INT::plus
loop while! (pos < s.size and s[pos] /= cp);-- INT::is_lt STR::size STR::aget CHAR::is_eq BOOL::not
if s[pos] = ')' or s[pos] = '}' or-- STR::aget CHAR::is_eq STR::aget CHAR::is_eq
s[pos]='\n' or s[pos]='\r' then;-- STR::aget CHAR::is_eq STR::aget CHAR::is_eq
#ERR +-- ERR::create
"Unterminated environment variable spec. near \n" +-- ERR::plus
" "+tenv+" in "+fname+", assume \'" + cp + "\'\n" +-- ERR::plus ERR::plus ERR::plus ERR::plus ERR::plus ERR::plus ERR::plus
" skip this token.\n";-- ERR::plus
-- #ERR + "op = " + op + "fp[pos] = " + fs[pos] + '\n';
skip := true;
break!
end; -- if
tenv := tenv + s[pos];-- STR::plus STR::aget
pos := pos + 1;-- INT::plus
end; -- loop
if ~skip then;-- BOOL::not
if pos < s.size then pos := pos + 1; end;-- INT::is_lt STR::size INT::plus
e := UNIX::get_env(tenv);-- UNIX::get_env
-- if ~void(e) then tok := tok + e; end;
-- #ERR + "tenv = " + tenv + ", getenv = " + tok + '\n';
end; -- if ~skip
--tok := "";
end;
return e;
end;
private directory(nm:STR):STR is
-- The directory in which nm resides
pos:INT;
loop pos:=(nm.size-1).downto!(0); if nm[pos]='/' then break!; end; end;-- STR::size INT::minus INT::downto! STR::aget CHAR::is_eq
r::=nm.head(pos);-- STR::head
if r="" then r:="."; end;-- STR::is_eq
return r;
end;
read_env is
sc::=UNIX::get_env("SATHER_COMMANDS");-- UNIX::get_env
if ~void(sc) then-- BOOL::not
barf("The SATHER_COMMANDS variable has been replaced by SATHER_HOME;\nsee man page for details.");-- CODE_OPTIONS::barf
end;
sh::=UNIX::get_env("SATHER_HOME");-- UNIX::get_env
if void(sh) then
barf("The SATHER_HOME environment variable must be set.");-- CODE_OPTIONS::barf
end;
prog.home:=sh;-- CODE_OPTIONS::prog PROG::home
end;
--# private library_file:ARRAY{STR} is
--# cl::=#FLIST{STR};
--# sl:STR;
--# if prog.psather then
--# sl:=UNIX::get_env("PSATHER_LIBRARY");
--# if void(sl) then sl:=prog.home+"/pLibrary/Library.module"; end;
--# else
--# sl:=UNIX::get_env("SATHER_LIBRARY");
--# if void(sl) then sl:=prog.home+"/Library/Library.module"; end;
--# end;
--# if void(sl) then barf("I cannot find the Library\n"); end;
--#
--# tok::="";
--# loop c::=sl.elt!;
--# if ~c.is_space then tok:=tok+c;
--# elsif tok/="" then cl:=cl.push(tok); tok:="";
--# end;
--# end;
--# if tok/="" then cl:=cl.push(tok); end;
--# -- the first element of the array is ignored
--# a::=#ARRAY{STR}(cl.size+1);
--# loop a[1.up!]:=(cl.elt!); end;
--# return a;
--# end;
end;