mangle.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, 1994. 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 NAMEMAP
class NAMEMAP is
-- Mapping $OB -> STR, with special knowledge about compiler
-- entities' equality conventions. In particular, SIGs do not
-- use object equality.
include FMAP{$OB,STR};
key_eq(k1,k2:$OB):BOOL is
-- See comments in fmap.sa for the subtleties of redefining
-- this.
typecase k1
when STR then
typecase k2
when STR then return k1=k2-- STR::is_eq
else return false
end;
-- when SIG then
-- typecase k2
-- when SIG then return k1=k2
-- else return false
-- end;
-- when $AM_EXPR then
-- typecase k2
-- when $AM_EXPR then return k1 = k2
-- else return false
-- end;
else return SYS::ob_eq(k1,k2);-- SYS::ob_eq
end
end;
end;
class NAMESPACE
class NAMESPACE is
-- An object which is a C namespace.
attr map:NAMEMAP;
attr set:FSET{STR};
attr counter:INT;
attr uniques:FMAP{STR,INT};
create:SAME is
r::=new;
r.map:=#;-- NAMESPACE::map NAMEMAP::create
r.set:=#;-- NAMESPACE::set FSET{1}::create
r.counter:=0;-- NAMESPACE::counter
r.uniques:=#;-- NAMESPACE::uniques FMAP{2}::create
return r;
end;
is_taken(s:STR):BOOL is
return set.test(s);-- NAMESPACE::set FSET{1}::test
end;
insert(ob:$OB,nm:STR) is
map:=map.insert(ob,nm);-- NAMESPACE::map NAMESPACE::map NAMEMAP::insert
set:=set.insert(nm);-- NAMESPACE::set NAMESPACE::set FSET{1}::insert
end;
get(ob:$OB):STR is
return map.get(ob);-- NAMESPACE::map NAMEMAP::get
end;
with_prefix(s:STR):STR is
-- Starts at '1' each time, to try to minimize the extent
-- of namespace changes between compiles.
-- A special table is kept to avoid quadratic behavior.
res:STR;
i::=uniques.get(s);-- NAMESPACE::uniques FMAP{2}::get
if void(i) then i:=0; end; -- Pretend you don't know it already is
loop
i:=i+1;-- INT::plus
res:=s+i;-- STR::plus
until!(~set.test(res));-- NAMESPACE::set FSET{1}::test BOOL::not
end;
uniques:=uniques.insert(s,i);-- NAMESPACE::uniques NAMESPACE::uniques FMAP{2}::insert
return res;
end;
unique_with_prefix(s:STR):STR is
-- Generate a unique name. This one doesn't start trying
-- suffixes at '1', so it won't be quadratic in finding names.
-- Use this for names that don't make it into header files,
-- so that recompilations won't occur.
res:STR;
loop
counter:=counter+1;-- NAMESPACE::counter NAMESPACE::counter INT::plus
res:=s+counter;-- NAMESPACE::counter
until!(~set.test(res));-- NAMESPACE::set FSET{1}::test BOOL::not
end;
set:=set.insert(res);-- NAMESPACE::set NAMESPACE::set FSET{1}::insert
return res;
end;
next_unique_with_prefix(s:STR):STR is
-- Gets next unique name. This one doesn't start trying
-- suffixes at '1', so it won't be quadratic in finding names.
-- Note that the returned name is not inserted! In general
-- use unique_with_prefix instead.
res:STR;
loop
counter:=counter+1;-- NAMESPACE::counter NAMESPACE::counter INT::plus
res:=s+counter;-- NAMESPACE::counter
until!(~set.test(res));-- NAMESPACE::set FSET{1}::test BOOL::not
end;
return res;
end;
forbid(s:STR) is
set:=set.insert(s);
end;
end;
class MANGLE
class MANGLE is
include CS_COMPONENT;
-- An object that manages the C namespace. All requests for a
-- C identifier should come through this.
private attr namespaces:FMAP{$OB,NAMESPACE};
private attr global_space:NAMESPACE;
private attr used_by_local:FSET{STR};
attr forbidden:FSET{STR};
-- Strings which may not be used as identifiers
create(p:PROG):SAME is
res::=new;
res.prog:=p;-- MANGLE::prog
res.namespaces:=#;-- MANGLE::namespaces FMAP{2}::create
res.forbidden:=#;-- MANGLE::forbidden FSET{1}::create
res.used_by_local:=#;-- MANGLE::used_by_local FSET{1}::create
res.global_space:=res.space(void);-- MANGLE::global_space MANGLE::space
-- Insert names which must not be taken.
l::=#SYSTEM_LEX(p.home+"/System/FORBID");-- SYSTEM_LEX::create PROG::home STR::plus
loop res.forbid(l.elt!); end;-- MANGLE::forbid SYSTEM_LEX::elt!
-- After bootstrap past 1.0.5, remove
res.forbid("self");-- MANGLE::forbid
return res;
end;
forbid(s:STR) is forbidden:=forbidden.insert(s); end;-- MANGLE::forbidden MANGLE::forbidden FSET{1}::insert
-- make sure this identifier never gets used
space(ns:$OB):NAMESPACE is
-- The namespace associated with some object. If it
-- doesn't exist yet, make one.
-- void specifies the global namespace... which we key
-- to self (before, 'self' of some external object was passed in)
if void(ns) then ns:=self end;
r::=namespaces.get(ns);-- MANGLE::namespaces FMAP{2}::get
if void(r) then
r:=#NAMESPACE;-- NAMESPACE::create
namespaces:=namespaces.insert(ns,r);-- MANGLE::namespaces MANGLE::namespaces FMAP{2}::insert
end;
return r;
end;
dispose_namespace(ns:$OB) is
-- The namespace 'ns' isn't going to be used in the future,
-- so it's okay to get rid of it now.
namespaces:=namespaces.delete(ns);-- MANGLE::namespaces MANGLE::namespaces FMAP{2}::delete
end;
force_mangle(ob:$OB, s:STR, ns:$OB) pre ~void(ob) is-- BOOL::not
-- see to it that a particular object gets a particular name.
-- if this is not possible, that is an error. 'ns' is the
-- namespace to use.
sp::=space(ns);-- MANGLE::space
x:STR:=sp.get(ob);-- NAMESPACE::get
if void(x) then
if sp.is_taken(s) then-- NAMESPACE::is_taken
warning("Name "+s+" already in use (same name in more than one external class?)");-- MANGLE::warning STR::plus STR::plus
end;
--if forbidden.test(s) then
-- warning("Name \""+s+"\" is in System/FORBID");
--end;
sp.insert(ob,s);-- NAMESPACE::insert
elsif x/=s then-- STR::is_eq BOOL::not
barf("Name "+s+" could not be assigned by the mangler, already had the name: "+x);-- MANGLE::barf STR::plus STR::plus STR::plus
end;
end;
genlocal(ns:$OB):STR is
-- generate a unique identifier used for intermediate results
name::=space(ns).unique_with_prefix("L");-- MANGLE::space NAMESPACE::unique_with_prefix
used_by_local:=used_by_local.insert(name);-- MANGLE::used_by_local MANGLE::used_by_local FSET{1}::insert
return name;
end;
genother(ns:$OB):STR is
-- generate a unique identifier for anything
return space(ns).with_prefix("other");-- MANGLE::space NAMESPACE::with_prefix
end;
mangle(ob,ns:$OB):STR pre ~void(ob) is-- BOOL::not
-- Generate unique id that C will be happy with for each
-- unique $OB. Truncates at 24 chars and then puts in number
-- in rightmost part to ensure is unique, if necessary. Also
-- drops any non-alphanumerics.
sp::=space(ns);-- MANGLE::space
res::=sp.get(ob);-- NAMESPACE::get
if void(res) then
s:STR;
is_local:BOOL:=false;
typecase ob
when SIG then
s:=ob.tp.str.append("_",ob.name.str);-- SIG::tp STR::append SIG::name IDENT::str
if ~void(ob.args) then-- SIG::args BOOL::not
loop s:=s.append("_",ob.args.elt!.str); end;-- STR::append SIG::args ARRAY{1}::elt! ARG::str
end;
if ~void(ob.ret) then s:=s.append("_",ob.ret.str); end;-- SIG::ret BOOL::not STR::append SIG::ret
--if ob.name.str="doo" then
-- #OUT + "Mangled "+ob.str+" to "+s
-- + " ob id = "+SYS::id(s)+" ns = "+SYS::id(ns)+'\n';
--end;
when INT then -- used for builtin locals
-- Must be careful with locals; they can
-- potentially shadow globals, so have to
-- check that specially.
s:=sp.unique_with_prefix("L");-- NAMESPACE::unique_with_prefix
is_local:=true;
when AM_LOCAL_EXPR then
-- Must be careful with locals; they can
-- potentially shadow globals, so have to
-- check that specially.
if ~void(ob.name) then s:=ob.name.str;-- AM_LOCAL_EXPR::name BOOL::not AM_LOCAL_EXPR::name IDENT::str
else s:=sp.unique_with_prefix("L");-- NAMESPACE::unique_with_prefix
end;
is_local:=true;
when TP_CLASS then s:=ob.str;-- TP_CLASS::str
when TP_ROUT then s:=ob.str;-- TP_ROUT::str
when TP_ITER then s:=ob.str;-- TP_ITER::str
when AM_BND_CREATE_EXPR then s:="bound";
when STR then s:=ob;
when IDENT then s:=ob.str;-- IDENT::str
when AM_GLOBAL_EXPR then
s:=ob.class_tp.str+'_'+ob.name.str;-- AM_GLOBAL_EXPR::class_tp STR::plus STR::plus AM_GLOBAL_EXPR::name IDENT::str
when AM_LOOP_STMT then
s:="after_loop";
when AM_STR_CONST then s:=ob.bval;-- AM_STR_CONST::bval
else -- pick a default name
end;
if void(s) then
res:=sp.with_prefix("noname");-- NAMESPACE::with_prefix
else
tmp::=#FSTR; -- Use an FSTR for speed here-- FSTR::create
loop c::=s.elt!;-- 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','_',
'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' then
tmp:=tmp+c;-- FSTR::plus
when '$' then tmp:=tmp+'d';-- FSTR::plus
when '!' then tmp:=tmp+'b'-- FSTR::plus
else -- don't put anything else in
end;
end;
-- make sure there's something left
if tmp.length = 0 then tmp := tmp+"name" end;-- FSTR::length INT::is_eq FSTR::plus
-- make sure it starts with a letter
case tmp[0]-- FSTR::aget
when '0','1','2','3','4','5','6','7','8','9','_' then
tmp:=#FSTR+"S"+tmp;-- FSTR::create FSTR::plus FSTR::plus
else
end;
res:=tmp.str;-- FSTR::str
-- truncate if too long
if res.length>24 then res:=res.head(24); end;-- STR::length INT::is_lt STR::head
-- make sure it's unique
loop
while!(sp.is_taken(res) or forbidden.test(res)-- NAMESPACE::is_taken MANGLE::forbidden FSET{1}::test
or (is_local and global_space.is_taken(res))-- MANGLE::global_space NAMESPACE::is_taken
or (~is_local and used_by_local.test(res)));-- BOOL::not MANGLE::used_by_local FSET{1}::test
-- not unique, better mangle more
res:=sp.with_prefix(res.head(24.min(res.length)));-- NAMESPACE::with_prefix STR::head INT::min STR::length
end;
end;
sp.insert(ob,res);-- NAMESPACE::insert
if is_local then
used_by_local:=used_by_local.insert(res);-- MANGLE::used_by_local MANGLE::used_by_local FSET{1}::insert
end;
end;
return res;
end;
Cify(c:CHAR):STR is
-- return an escaped version of c suitable for C.
res::="";
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',
'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',
'!','@','#','$','%','^','&',
'*','(',')','-','=','+',
'|',':',';','`','~','_',' ',
',','.','<','>','/','?','[',
']','{','}' then -- an acceptable character
res:=res+c;-- STR::plus
-- Some versions of gcc can't do this so we won't either,
-- for now. Alex Cozzi is the only one who reported a
-- problem with this, but don't take chances for now.
-- when '\a' then
-- res:=res+"\\a";
when '\b' then
res:=res+"\\b";-- STR::plus
when '\f' then
res:=res+"\\f";-- STR::plus
when '\n' then
res:=res+"\\n";-- STR::plus
when '\r' then
res:=res+"\\r";-- STR::plus
when '\t' then
res:=res+"\\t";-- STR::plus
when '\v' then
res:=res+"\\v";-- STR::plus
when '\\' then
res:=res+"\\\\";-- STR::plus
when '\'' then
res:=res+"\\'";-- STR::plus
when '\"' then
res:=res+"\\\"";-- STR::plus
else -- must give octal
oc:STR:=c.int.octal_str;-- CHAR::int INT::octal_str
oc:=oc.substring(2,oc.length-2);-- STR::substring STR::length INT::minus
res:=res+'\\'+oc;-- STR::plus STR::plus
end; -- case
return res;
end;
Cify(arg:STR):STR is
-- transform a string into a '\' escaped version suitable for C.
res::=#FSTR;-- FSTR::create
loop res:=res+Cify(arg.elt!);-- FSTR::plus MANGLE::Cify STR::elt!
end;
return res.str;-- FSTR::str
end;
end; -- MANGLE