-- (C) Copyright International Business Machines Corporation 23 January 
-- 1990.  All Rights Reserved. 
--  
-- See the file USERAGREEMENT distributed with this software for full 
-- terms and conditions of use. 
-- File: cgforall.pp
-- Author: Andy Lowry
-- SCCS Info: @(#)cgforall.pp	1.5 3/13/90

-- This module translates a FORALL statement into LI code.  We can't
-- make use of the cgSelector utility in this case because, unlike the
-- other selector-based statements, the loop generated for this
-- statement should exit as soon as a single non-matching element is
-- located.  cgSelector will always loop at least until the first
-- match is found or the table is exhausted.  Fortunately, this is no
-- great loss since we don't need to get involved with the
-- complications of quick lookup methods in any case.  In fact, quick
-- lookup methods would probably hurt us on average.  Consider a
-- selector that is completely captured by an indexed lookup.  If we
-- were to search using the index, we would loop through all the
-- matching elements and then would have to check the table size to
-- see if any were left out.  By using stupid lookup instead, we're
-- likely to hit a nonmatching element before all the matching
-- elements have been seen.

-- A FORALL loop ends up looking like this, then:
--
--	boolean		result {'true'}
--	initget		r,t
-- loop:get_or_goto	r,t {endloop}
--	[additional tests, result in 'test']
--	btrue		test {loop}
--	boolean		result {'false'}
-- endloop:
--	endget		r,t

#include "typemark.h"
#include "codegen.h"

cgForAll: using (cgInternal, interpform)

process (Q: cgStmtQ)
  
declare
  args: cgStmt;
  dstAddr: interpform!operand;	-- result LI address
  tblAddr: interpform!operand;	-- source table LI address
  eltRoot: rootname;		-- selector element root name
  eltAddr: interpform!operand;	-- selector element LI address
  op: interpform!operation;
  loopBBid: BBid;		-- top of loop
  bodyBBid: BBid;		-- loop body
  failBBid: BBid;		-- here when an element fails the selector
  doneBBid: BBid;		-- loop exit
  empty: empty;
begin
  receive args from Q;
  reveal args.stmt.qualifier.selector;
  
  -- Get LI addresses for destination, source table, and element
  dstAddr <- interpform!operand#(args.cgData.Proc.objAddr(
      objectname#(AREF(tmp,args.stmt.operands,ZERO))));
  tblAddr <- interpform!operand#(args.cgData.Proc.objAddr(
      objectname#(AREF(tmp,args.stmt.operands,ONE))));
  eltAddr <- interpform!operand#(args.cgData.Proc.rootAddr(
      args.stmt.qualifier.selector.element, 
      args.stmt.qualifier.selector.scope));
  -- Build root name for element varable
  new eltRoot;
  eltRoot.root := args.stmt.qualifier.selector.element;
  eltRoot.scope := args.stmt.qualifier.selector.scope;
  -- Add a selectorInfo entry to the scratch pad for this selector
  block declare
    si: selectorInfoEntry;
  begin
    new si;
    si.elt := eltRoot;
    si.tblAddr := tblAddr;
    si.lkup <- lookupType#'scan';
    insert si into args.cgData.scratch.selInfo;
  end block;
  
  -- Establish BB ID's for all the basic blocks we'll be introducing
  loopBBid <- BBId#unique;
  bodyBBid <- BBId#unique;
  failBBid <- BBId#unique;
  doneBBid <- BBId#unique;

  -- Initialize the destination to 'true' before the loop
  op := args.cgData.Tplt.boolT;
  insert interpform!operand#(copy of dstAddr) into op.operands;
  ADDINSTR(op);
  
  -- Next comes an 'initget' instruction to establish a looping
  -- context
  new op;
  op.opcode <- interpform!opcode#'initget';
  new op.operands;
  insert interpform!operand#(copy of eltAddr) into op.operands;
  insert interpform!operand#(copy of tblAddr) into op.operands;
  unite op.qualifier.empty from empty;
  ADDINSTR(op);
  
  -- Tie off the current basic block with a jump to the loop top, and
  -- and start a new BB
  unite CURBB.exit.jump from BBid#(copy of loopBBid);
  NEWBB(copy of loopBBid);

  -- Now build the 'get_or_goto' instruction that will be used in a
  -- test-style exit structure for the current basic block
  new op;
  op.opcode <- interpform!opcode#'get_or_goto';
  new op.operands;
  insert interpform!operand#(copy of eltAddr) into op.operands;
  insert interpform!operand#(copy of tblAddr) into op.operands;
  -- correct label will be filled in during basic block assembly
  unite op.qualifier.integer from ZERO;
  -- Construct a test-style exit structure for the current basic block
  block declare
    te: BBTestExit;
  begin
    new te;
    te.jump := doneBBid;
    te.nojump := bodyBBid;
    unite CURBB.exit.test from te;
  end block;
  -- Install the final BB instruction to go with the above;
  ADDINSTR(op);
  
  -- Open a new BB for the loop body, and codegen the test clause
  NEWBB(copy of bodyBBid);
  inspect prog in ABSPROG.programs[args.cgData.Proc.id] begin
    inspect scope in prog.executable_part.scopes
	  [args.stmt.qualifier.selector.scope] begin
      call FNS.cgClause(scope.clause,args.cgData);
    end inspect;
  end inspect;
  
  -- Tie off the current BB with an ifelse-style exit depending on the
  -- result of the test computation.  On a match (true), we keep
  -- looping, else we branch to the failure handler
  block declare
    ie: BBIfElseExit;
  begin
    new ie;
    ie.ifTarget <- loopBBid;
    ie.elseTarget := failBBid;
    unite CURBB.exit.ifelse from ie;
  end block;
  -- Add a final instruction to go with that exit structure
  op := args.cgData.Tplt.noop;
  insert interpform!operand#(args.cgData.Proc.objAddr(
      args.stmt.qualifier.selector.result)) into op.operands;
  ADDINSTR(op);
  
  -- Now open up the failure section, which is executed when a
  -- nonmatching element is encountered.  We replace the current
  -- destination value with 'false' and drop through.
  NEWBB(failBBid);
  op := args.cgData.Tplt.boolF;
  insert dstAddr into op.operands;
  ADDINSTR(op);
  unite CURBB.exit.jump from BBid#(copy of doneBBid);
  
  -- Now the loop exit, where we need an 'endget' instruction to
  -- terminate the selector scope
  NEWBB(doneBBid);
  new op;
  op.opcode <- interpform!opcode#'endget';
  new op.operands;
  insert eltAddr into op.operands;
  insert tblAddr into op.operands;
  unite op.qualifier.empty from empty;
  ADDINSTR(op);
  
  -- Remove selectorInfo for this selector from the scratch pad
  block declare
    si: selectorInfoEntry;
  begin
    remove si from args.cgData.scratch.selInfo[eltRoot];
  end block;

  -- All done!
  return args;
  
end process
