home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / COMPILER / INLINE.SA < prev    next >
Text File  |  1994-11-15  |  10KB  |  367 lines
  1. -- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
  2. -- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
  3. -- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
  4. -- the file "Doc/License" of the Sather distribution.  The license is also   --
  5. -- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
  6. --------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
  7.  
  8. -- inline.sa: Code for inlining calls.
  9. -------------------------------------------------------------------
  10. type $INLINE is
  11.    -- Information about a signature to enable it to be inlined.
  12.    
  13.    sig:SIG;            -- The signature this is info for.
  14.    
  15.    inline(call:AM_ROUT_CALL_EXPR, trans:TRANS):$AM_EXPR;
  16.       -- Return a replacement for the call `call' in the context 
  17.       -- defined by `trans'. The result is a tuple, the first component 
  18.       -- is a list of statments which must be executed before
  19.       -- the expression is evaluated, the second is the expression.
  20.  
  21. end;
  22.    
  23. -------------------------------------------------------------------   
  24. class INLINE_ATTR_READ < $INLINE is
  25.    -- A reference attribute read.
  26.    -- The signature has the form: "FOO::name:BAR".
  27.  
  28.    shared inlined,routines:INT;
  29.  
  30.    attr sig:SIG;
  31.    attr self_tp:$TP;
  32.    attr at:IDENT;
  33.    attr tp_at:$TP;
  34.    
  35.    inline(call:AM_ROUT_CALL_EXPR, trans:TRANS):$AM_EXPR is
  36.     inlined:=inlined+1;
  37.     r::=#AM_ATTR_EXPR(call.source);
  38.     r.ob:=call[0];
  39.     r.self_tp:=self_tp;
  40.     r.at:=at;
  41.     r.tp_at:=tp_at;
  42.         return r;
  43.     end;
  44.  
  45.     create(am:AM_ROUT_DEF):SAME is
  46.     r::=new;
  47.     r.sig:=am.sig;
  48.     stmt::=am.code;
  49.     typecase stmt when AM_RETURN_STMT then
  50.       val::=stmt.val;
  51.       typecase val when AM_ATTR_EXPR then
  52.           r.at:=val.at;
  53.           r.self_tp:=val.self_tp;
  54.           r.tp_at:=val.tp_at;
  55.       end;
  56.     end;
  57.     routines:=routines+1;
  58.     return r;
  59.     end;
  60.    
  61. end;
  62.  
  63. -------------------------------------------------------------------
  64. class INLINE_ATTR_WRITE < $INLINE is 
  65.    -- A reference attribute write.
  66.    -- The signature has the form: "FOO::name(BAR)".
  67.  
  68.    shared inlined,routines:INT;
  69.  
  70.    attr sig:SIG;
  71.    attr self_tp:$TP;
  72.    attr at:IDENT;
  73.    attr tp_at:$TP;
  74.    
  75.    inline(call:AM_ROUT_CALL_EXPR, trans:TRANS):$AM_EXPR is
  76.       inlined:=inlined+1;
  77.       a::=#AM_ATTR_EXPR(call.source);
  78.       a.ob:=call[0];
  79.       a.self_tp:=self_tp;
  80.       a.at:=at;
  81.       a.tp_at:=tp_at;
  82.       as::=#AM_ASSIGN_STMT(call.source);
  83.       as.dest:=a;
  84.       as.src:=call[1];
  85.       r::=#AM_STMT_EXPR(call.source); r.stmts:=as; return r end;
  86.       
  87.     create(am:AM_ROUT_DEF):SAME is
  88.     r::=new;
  89.     r.sig:=am.sig;
  90.     stmt::=am.code;
  91.     typecase stmt when AM_ASSIGN_STMT then
  92.       dest::=stmt.dest;
  93.       typecase dest when AM_ATTR_EXPR then
  94.           r.self_tp:=dest.self_tp;
  95.           r.at:=dest.at;
  96.           r.tp_at:=dest.tp_at;
  97.       end;
  98.     end;
  99.     routines:=routines+1;
  100.     return r;
  101.     end;
  102.  
  103. end;
  104.  
  105. -------------------------------------------------------------------
  106. class INLINE_INT_FOLD < $INLINE is
  107.    -- Constant folding for INT::plus(INT):INT
  108.  
  109.    shared inlined,routines:INT;
  110.    
  111.    attr sig:SIG;
  112.  
  113.    inline(call:AM_ROUT_CALL_EXPR, trans:TRANS):$AM_EXPR is
  114.       arg1::=call[0];
  115.       arg2::=call[1];
  116.       typecase arg1
  117.       when AM_INT_CONST then
  118.           typecase arg2
  119.           when AM_INT_CONST then
  120.               r::=#AM_INT_CONST(arg1.source);
  121.               r.val:=arg1.val+arg2.val;
  122.               r.tp_at:=arg1.tp_at;
  123.               -- this isn't quite right if it should
  124.               -- have overflowed.
  125.               inlined:=inlined+1;
  126.               return r;
  127.           else
  128.           end;
  129.       else
  130.       end;
  131.       return call;
  132.    end;
  133.  
  134.    create(s:SIG):SAME is
  135.        r::=new;
  136.        r.sig:=s;
  137.        routines:=routines+1;
  138.        return r;
  139.    end;    
  140.    
  141. end;
  142.  
  143. -------------------------------------------------------------------
  144. class INLINE_GLOBAL_READ < $INLINE is
  145.    -- A value attribute read.
  146.    -- The signature has the form: "FOO::name:BAR".
  147.  
  148.    shared inlined,routines:INT;
  149.    
  150.    attr sig:SIG;
  151.    attr age:AM_GLOBAL_EXPR;
  152.  
  153.    inline(call:AM_ROUT_CALL_EXPR, trans:TRANS):$AM_EXPR is
  154.       inlined:=inlined+1;
  155.       return age;
  156.    end;
  157.  
  158.     create(am:AM_ROUT_DEF):SAME is
  159.     r::=new;
  160.     r.sig:=am.sig;
  161.     stmt::=am.code;
  162.     typecase stmt when AM_RETURN_STMT then
  163.       val::=stmt.val;
  164.       typecase val when AM_GLOBAL_EXPR then r.age:=val; end;
  165.     end;
  166.     routines:=routines+1;
  167.     return r;
  168.     end;
  169.    
  170. end;
  171.  
  172. -------------------------------------------------------------------
  173. class INLINE_VATTR_READ < $INLINE is
  174.    -- A value attribute read.
  175.    -- The signature has the form: "FOO::name:BAR".
  176.    
  177.    attr sig:SIG;
  178.  
  179.    inline(call:AM_ROUT_CALL_EXPR, trans:TRANS):$AM_EXPR is
  180.       return call
  181.       end;
  182.    
  183. end;
  184.  
  185. -------------------------------------------------------------------
  186. class INLINE_VATTR_WRITE < $INLINE is 
  187.    -- A value attribute write.
  188.    -- The signature has the form: "FOO::name(BAR):FOO".   
  189.    
  190.    attr sig:SIG;
  191.  
  192.    inline(call:AM_ROUT_CALL_EXPR, trans:TRANS):$AM_EXPR is
  193.       return call
  194.       end;
  195.    
  196. end;
  197.  
  198. -------------------------------------------------------------------
  199. class INLINE_ARR_READ < $INLINE is 
  200.    -- A reference array read.
  201.    -- The signature has the form: "FOO::name(ind:INT):BAR".   
  202.    
  203.    attr sig:SIG;
  204.  
  205.    inline(call:AM_ROUT_CALL_EXPR, trans:TRANS):$AM_EXPR is
  206.       return call
  207.       end;
  208.    
  209. end;
  210.  
  211. -------------------------------------------------------------------
  212. class INLINE_ARR_WRITE < $INLINE is 
  213.    -- A reference array write.
  214.    -- The signature has the form: "FOO::name(ind:INT,val:BAR)".   
  215.    
  216.    attr sig:SIG;
  217.  
  218.    inline(call:AM_ROUT_CALL_EXPR, trans:TRANS):$AM_EXPR is
  219.       return call
  220.       end;
  221.    
  222. end;
  223.  
  224. -------------------------------------------------------------------
  225. class INLINE_VARR_READ < $INLINE is 
  226.    -- A value array read.
  227.    -- The signature has the form: "FOO::name(ind:INT):BAR".      
  228.    
  229.    attr sig:SIG;
  230.  
  231.    inline(call:AM_ROUT_CALL_EXPR, trans:TRANS):$AM_EXPR is
  232.       return call
  233.       end;
  234.    
  235. end;
  236.  
  237. -------------------------------------------------------------------
  238. class INLINE_VARR_WRITE < $INLINE is
  239.    -- A value array write.   
  240.    -- The signature has the form: "FOO::name(ind:INT,val:BAR):FOO".      
  241.    
  242.    attr sig:SIG;
  243.  
  244.    inline(call:AM_ROUT_CALL_EXPR, trans:TRANS):$AM_EXPR is
  245.       return call
  246.       end;
  247. end;
  248.  
  249. -------------------------------------------------------------------
  250. class INLINE_BUILTIN < $INLINE is
  251.    -- A builtin routine call.
  252.    -- Any signature.
  253.    
  254.    attr sig:SIG;
  255.  
  256.    inline(call:AM_ROUT_CALL_EXPR, trans:TRANS):$AM_EXPR is
  257.       return call
  258.       end;
  259.    
  260. end;
  261.  
  262. -------------------------------------------------------------------
  263. class INLINE_ROUT < $INLINE is
  264.    -- A routine which is short enough to be directly inlined.
  265.    -- Any signature.   
  266.  
  267.    attr am:AM_ROUT_DEF;
  268.  
  269.    sig:SIG is return am.sig; end;
  270.  
  271.    inline(call:AM_ROUT_CALL_EXPR, trans:TRANS):$AM_EXPR is
  272.       return call
  273.       end;
  274.  
  275.    create(sig:SIG, am:AM_ROUT_DEF):SAME is r::=new; r.am:=am; return r; end;
  276.    
  277. end;
  278.  
  279. -------------------------------------------------------------------
  280. class INLINE_TBL is
  281.    -- A table of $INLINE objects retrievable by signature.
  282.    -- Only those objects which are to be inlined are in here. If a
  283.    -- signature has been transformed and it isn't in here, then
  284.    -- it isn't inlinable.
  285.    -- 
  286.    -- `get_query(s:SIG):$INLINE' yields the info for the sig `s'.
  287.    -- `test($INLINE):BOOL' tests for the given $INLINE.
  288.    -- `insert($INLINE):SAME' inserts an inline.
  289.    -- `delete($INLINE):SAME' deletes an inline.
  290.    -- `elt!:ELT' yields each inline.   
  291.    include FQSET{SIG,$INLINE} create->old_create;   
  292.  
  293.    attr prog:PROG;
  294.  
  295.    create(p:PROG):SAME is
  296.       r::=old_create(1024);
  297.       r.prog:=p;
  298.       ipiis::=#SIG;
  299.       int_tp::=p.tp_builtin.int;
  300.       ipiis.tp:=int_tp;
  301.       ipiis.name:=p.ident_for("plus");
  302.       ipiis.args:=#ARRAY{$TP}(1);
  303.       ipiis.args[0]:=int_tp;
  304.       ipiis.ret:=int_tp;
  305.       ipiis.is_builtin:=true;
  306.       r:=r.insert(#INLINE_INT_FOLD(ipiis));
  307.       return r;
  308.    end;
  309.  
  310.    query_test(s:SIG, in:$INLINE):BOOL is
  311.       -- True if `in' is info for the signature `s'.
  312.       if void(in) then return false end;
  313.       return in.sig=s end;
  314.    
  315.    query_hash(s:SIG):INT is
  316.       -- A hash value computed from the sig `s'.
  317.       sc::=3; 
  318.       r::=s.name.hash;        -- Make depend on name.
  319.       r:=r.bxor(s.tp.hash*sc);    -- Make depend on type
  320.       loop sc:=sc+98; r:=r.bxor(s.args.elt!.hash*sc) end; -- And on params.
  321.       return r end;
  322.  
  323.    elt_hash(in:$INLINE):INT is
  324.       -- A hash value computed from the signature of `in'.
  325.       return query_hash(in.sig) end;
  326.  
  327.    test_and_insert(am:AM_ROUT_DEF):SAME is
  328.       -- Test `am' for whether it should be inlinable, if it should
  329.       -- insert it into the table and return the table. If not, 
  330.       -- leave the table alone.
  331.       r::=self;
  332.       if ~am.is_abstract
  333.          and ~am.is_external
  334.          and ~void(am.code) then
  335.      stmts::=am.code;
  336.      typecase stmts
  337.          when AM_RETURN_STMT then
  338.          val::=stmts.val;
  339.          typecase val 
  340.              when AM_ATTR_EXPR then
  341.              if SYS::ob_eq(val.ob,am[0]) then -- must be self.
  342.                  r:=r.insert(#INLINE_ATTR_READ(am));
  343.              end;
  344.              when AM_GLOBAL_EXPR then
  345.              r:=r.insert(#INLINE_GLOBAL_READ(am));
  346.              else -- don't inline
  347.          end;
  348.          when AM_ASSIGN_STMT then
  349.          dest::=stmts.dest;
  350.          src::=stmts.src;
  351.          typecase dest
  352.              when AM_ATTR_EXPR then
  353.              if SYS::ob_eq(dest.ob,am[0]) 
  354.                    and SYS::ob_eq(src,am[1]) then
  355.                  r:=r.insert(#INLINE_ATTR_WRITE(am));
  356.              end;
  357.              else -- don't inline
  358.          end;
  359.          else -- don't inline
  360.      end;
  361.       end;
  362.       return r end;
  363.    
  364. end; -- class INLINE_TBL
  365.  
  366. -------------------------------------------------------------------
  367.