-- (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: cgselector.pp
-- Author: Andy Lowry
-- SCCS Info: @(#)cgselector.pp	1.13 3/13/90

-- This module produces skeleton code for table operations using
-- selectors.  It acts as a coroutine: the initial call generates the
-- beginning of the skeleton and returns a continuation capability;
-- the caller generates appropriate body code and then calls the
-- continuation to finish off the skeleton.

-- The form of the skeleton depends on the lookup method recommended
-- by breakSelector, as follows (assuming an 'allOrNone' looptype;
-- for 'oneOrNone' and 'exactlyOne', slight modifications are made):


------------------------------------------------------------------------------
--		scan		      | 	index                       --
------------------------------------------------------------------------------
--		initget r,t	      |         initidxfind r,t,val1,val2,..--
--	loop:	get_or_goto r,t,done  | loop:	idxfind_or_goto r,t,done    --
--		[selector tests]      | 	[selector tests]	    --
--		bfalse result,loop    | 	bfalse result,loop	    --
--		[body code by caller] | 	[body code by caller]	    --
--		branch loop	      | 	branch loop		    --
--	done:	endget r,t	      | done:	endidxfind r,t		    --
------------------------------------------------------------------------------
--		key		      | 	position		    --
------------------------------------------------------------------------------
--              find_or_goto r,t,     |         lookup_at_or_goto r,t,pos,  --
--      	        k1,k2,...,done| 	        done    	    --
--              [selector tests]      |	        [selector tests]	    --
--      	bfalse result,done    |		bfalse result,done          --
--      	[body code by caller] |	        [body code by caller]       --
--      done:                         |	done:                               --
------------------------------------------------------------------------------

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

cgSelector: using (cgInternal, interpform)

process (Q: cgSelectorQ)

declare
  continueQ: cgSelectorContinueQ;
  op: interpform!operation;
  addtests: statements;
  newresult: objectname;
  loopBBid: BBid;
  doneBBid: BBid;
  foundBBid: BBid;
  bodyBBid: BBid;
  NFBBid: BBid;
  eltRoot: predefined!rootname;
  eltAddr: interpform!operand;
  tblAddr: interpform!operand;
  lkType: lookupType;
  lpType: selectorLoopType;
  looping: predefined!boolean;
  NFok: predefined!boolean;
  empty: empty;
begin

  block declare
    args: cgSelector;
  begin
    receive args from Q;

    -- Analyze the selector to decide which lookup strategy to use...
    call FNS.breakSelector(args.selector, args.tblType, args.cgData,
      args.lookupInfo, addtests, newresult);
    lkType <- lookupType#(case of args.lookupInfo);

    -- Establish the inport for the end processing and set up capability
    -- to be sent back
    new continueQ;
    connect args.continuation to continueQ;

    -- We need to save the loopType and tblAddr parameters for use in the
    -- continuation
    lpType := args.loopType;
    tblAddr := args.tblAddr;

    -- Get the rootname and LI address of the selector element variable
    new eltRoot;
    eltRoot.root := args.selector.element;
    eltRoot.scope := args.selector.scope;
    eltAddr <- interpform!operand#(args.cgData.Proc.rootAddr(
	args.selector.element, args.selector.scope));

    -- Establish ids for BB's we'll be creating... not all will be used
    -- in all cases (but they must be allocated because of typestate)
    loopBBid <- BBid#unique;	-- for top of loop
    foundBBid <- BBid#unique;	-- for successful get/idxfind_or_goto
    bodyBBid <- BBid#unique;	-- for caller-supplied loop body code
    NFBBid <- BBid#unique;	-- to raise 'NotFound' exception
    doneBBid <- BBid#unique;	-- for loop exit

    -- Precompute a few often-needed booleans...
    looping <- B(B(lkType = lookupType#'scan')
	  or B(lkType = lookupType#'index'));
    NFok <- B(lpType <> selectorLoopType#'exactlyOne');

    -- Stash info for this selector away in case it's needed to
    -- translate a POSITION OF expression in the statement body
    block declare
      si: selectorInfoEntry;
    begin
      new si;
      si.elt := eltRoot;
      si.tblAddr := args.tblAddr;
      si.lkup := lkType;
      insert si into args.cgData.scratch.selInfo;
    end block;

    -- Some lookup types require calculation of lookup parameters prior
    -- to the loop... generate code for that first
    block declare
      vals: lookupValueList;
    begin
      select lkType
      where (lookupType#'scan')
	-- no values to compute
	new vals;
      where (lookupType#'key')
	-- compute key attribute values
	reveal args.lookupInfo.key;
	vals := args.lookupInfo.key.values;
      where (lookupType#'index')
	-- compute index attribute values
	reveal args.lookupInfo.index;
	vals := args.lookupInfo.index.values;
      where (lookupType#'position')
	-- compute position value
	reveal args.lookupInfo.posn;
	new vals;
	insert lookupValue#(copy of args.lookupInfo.posn) into vals;
      otherwise
	exit cantHappen;
      end select;

      -- Now generate the code required for each of the lookup values
      -- needed
      for val in vals[] inspect
	for stmt in val.computation[] inspect
	  call FNS.cgStmt(stmt,args.cgData);
	end for;
      end for;
    end block;

    -- The loop-style lookups need a loop initialization instruction
    -- (initget or initidxfind)... first two operands are the element
    -- variable and the source table.
    if looping then
      new op;
      new op.operands;
      insert interpform!operand#(copy of eltAddr) into op.operands;
      insert interpform!operand#(copy of tblAddr) into op.operands;
      if B(lkType = lookupType#'scan') then
	op.opcode <- interpform!opcode#'initget';
	-- qualifier gives table rep number and starting position...
	-- both zero for now
	block declare
	  ip: integer_pair;
	begin
	  new ip;
	  ip.int_one <- ZERO;
	  ip.int_two <- ZERO;
	  unite op.qualifier.integer_pair from ip;
	end block;
      else
	op.opcode <- interpform!opcode#'initidxfind';
	-- lookup parameters are additional operands to this instruction
	reveal args.lookupInfo.index;
	for val in args.lookupInfo.index.values[] inspect
	  insert interpform!operand#(args.cgData.Proc.objAddr(val.result))
	      into op.operands;
	end for;
	-- qualifier establishes the table representation used for lookup
	unite op.qualifier.integer from I(copy of args.lookupInfo.index.repno);
      end if;
      ADDINSTR(op);
    end if;

    -- Establish a new BB for the top of the loop if a loop is required
    -- for this lookup type
    if looping then
      unite CURBB.exit.jump from BBid#(copy of loopBBid);
      NEWBB(copy of loopBBid);
    end if;

    -- Now generate loop top according to lookup type and loop type.  In
    -- all cases, the first two operands are the selector element and
    -- source table, respectively
    new op;
    new op.operands;
    insert interpform!operand#(copy of eltAddr) into op.operands;
    insert interpform!operand#(copy of tblAddr) into op.operands;
    select lkType
    where (lookupType#'scan')
      -- looptype 'exactlyOne' uses a get_or_err instruction... others
      -- use a get_or_goto targeted to the loop exit.
      if B(not NFok) then
	op.opcode <- interpform!opcode#'get_or_err';
	unite op.qualifier.empty from empty;
	ADDINSTR(op);
      else
	-- need to build a test-style exit structure for current BB
	-- and start a new BB
	block declare
	  te: BBTestExit;
	begin
	  new te;
	  te.jump := doneBBid;
	  te.nojump := foundBBid;
	  unite CURBB.exit.test from te;
	  op.opcode <- interpform!opcode#'get_or_goto';
	  unite op.qualifier.integer from ZERO;
	  ADDINSTR(op);
	  NEWBB(foundBBid);
	end block;
      end if;

    where (lookupType#'index')
      -- This is just like the 'scan' case, but idxfind_or_xxx instructions
      -- are used instead of get_or_xxx
      if B(not NFok) then
	op.opcode <- interpform!opcode#'idxfind_or_err';
	unite op.qualifier.empty from empty;
	ADDINSTR(op);
      else
	block declare
	  te: BBTestExit;
	begin
	  new te;
	  te.jump := doneBBid;
	  te.nojump := foundBBid;
	  unite CURBB.exit.test from te;
	  op.opcode <- interpform!opcode#'idxfind_or_goto';
	  unite op.qualifier.integer from ZERO;
	  ADDINSTR(op);
	  NEWBB(foundBBid);
	end block;
      end if;

    where (lookupType#'key')
      -- We use a 'find' instruction for an extactlyOne lookup, otherwise
      -- 'find_or_goto'.  There is no looping here, since the find
      -- operation can only succeed on at most one element.
      -- Additional operands give the key values
      reveal args.lookupInfo.key;
      for val in args.lookupInfo.key.values[] inspect
	insert interpform!operand#(args.cgData.Proc.objAddr(val.result))
	    into op.operands;
      end for;
      if NFok then
	block declare
	  te: BBTestExit;
	  ip: integer_pair;
	begin
	  new te;
	  te.jump := doneBBid;
	  te.nojump := foundBBid;
	  unite CURBB.exit.test from te;
	  op.opcode <- interpform!opcode#'find_or_goto';
	  new ip;
	  ip.int_one := args.lookupInfo.key.repno;
	  ip.int_two <- ZERO;
	  unite op.qualifier.integer_pair from ip;
	  ADDINSTR(op);
	  NEWBB(foundBBid);
	end block;
      else
	op.opcode <- interpform!opcode#'find';
	unite op.qualifier.integer from I(copy of args.lookupinfo.key.repno);
	ADDINSTR(op);
      end if;
      
    where (lookupType#'position')
      -- Here we generate either a 'lookup_at' or a
      -- 'lookup_at_or_goto' instruction, depending on whether this is
      -- an extactlyOne style lookup or not, respectively.  Third
      -- source arg is holds the position to be accessed.
      reveal args.lookupInfo.posn;
      insert interpform!operand#(args.cgData.Proc.objAddr(
	  args.lookupInfo.posn.result)) into op.operands;
      if NFok then
	block declare
	  te: BBTestExit;
	begin
	  new te;
	  te.jump := doneBBid;
	  te.nojump := foundBBid;
	  unite CURBB.exit.test from te;
	  op.opcode <- interpform!opcode#'lookup_at_or_goto';
	  unite op.qualifier.integer from ZERO;
	  ADDINSTR(op);
	  NEWBB(foundBBid);
	end block;
      else
	op.opcode <- interpform!opcode#'lookup_at';
	unite op.qualifier.empty from empty;
	ADDINSTR(op);
      end if;
      
    otherwise
      exit cantHappen;
    end select;


    -- Following the primary lookup instructions we need to generate
    -- code for any additional tests that may be required.  If the tests
    -- fail, we either generate a branch back to the top of the loop or
    -- raise 'NotFound', depending on the looptype
    if B(I(size of addtests) <> ZERO) then
      for stmt in addtests[] inspect
	call FNS.cgStmt(stmt,args.cgData);
      end for;
      block declare
	ie: BBIfElseExit;
      begin
	-- build an 'ifElse' style BB exit structure
	new ie;
	ie.ifTarget := bodyBBid;	-- continue to loop body on success
	-- If 'NotFound' needs to be raised on failure for this
	-- operation, and if the lookupType is one of the one-shot types
	-- (so there is no loop with a xxx_or_err instruction to branch
	-- back to), then on failure we branch to code that will raise
	-- 'NotFound'.  Otherwise we branch back to the loop, or to the
	-- exit point if there is no loop.
	if B(not NFok) then
	  if looping then
	    ie.elseTarget := loopBBid;
	  else
	    ie.elseTarget := NFBBid;
	  end if;
	else
	  if looping then
	    ie.elseTarget := loopBBid;
	  else
	    ie.elseTarget := doneBBid;
	  end if;
	end if;
	unite CURBB.exit.ifelse from ie;
      end block;
      -- build a 'noop' statement to accompany the above exit
      -- structure
      op := args.cgData.Tplt.noop;
      insert interpform!operand#(args.cgData.Proc.objAddr(newresult))
	  into op.operands;
      ADDINSTR(op);
      -- tie off the current BB and start the body BB
      NEWBB(bodyBBid);
    end if;

    -- Now we're ready for the caller to generate the body code...
    return args;
  end block;

  block declare
    args: cgSelectorContinue;
  begin
    receive Args from continueQ;

    -- We're back... if we are in an 'allOrNone' style loop with a
    -- looping lookup method, we need to branch back to the top of the
    -- loop and open up the exit BB...
    if B(B(lpType = selectorLoopType#'allOrNone') and looping) then
      unite CURBB.exit.jump from loopBBid;
      NEWBB(doneBBid);
    else
      -- no branch back to loop top... if this is not an 'exactlyOne'
      -- type loop, then branch to the exit BB and open it up
      if NFok then
	unite CURBB.exit.jump from BBid#(copy of doneBBid);
	NEWBB(doneBBid);
      else
	-- This is an 'exactlyOne' style operation... if a looping
	-- lookup method was used and there were additional tests, we
	-- need to branch to the exit point and then generate code
	-- that will raise 'NotFound', and finally open the exit point
	-- BB.  Otherwise we don't need to do anything here
	if B(B(not looping) and B(I(size of addtests) <> ZERO)) then
	  unite CURBB.exit.jump from BBid#(copy of doneBBid);
	  NEWBB(NFBBid);
	  new op;
	  op.opcode <- interpform!opcode#'raise';
	  new op.operands;
	  -- Following qualifier is hardcoded as the integer value
	  -- associated with the 'NotFound' element of
	  -- predefined!builtin_exception.  interpform!qualifier needs
	  -- a new component to hold a predefined!builtin_exception,
	  -- and then this ugliness can be removed
	  unite op.qualifier.integer from I(8);-- *** FIX THIS! ***
	  -- should be:
	  -- unite op.qualifier.builtin_exception
	  --     from predefined!builtin_exception#'NotFound';
	  ADDINSTR(op);
	  unite CURBB.exit.none from empty;
	  NEWBB(doneBBid);
	end if;
      end if;
    end if;

    -- Finally... if we used a loop-style lookup method, we need the
    -- loop terminating instruction (endget or endidxfind).
    if looping then
      new op;
      if B(lkType = lookupType#'scan') then
	op.opcode <- interpform!opcode#'endget';
      else
	op.opcode <- interpform!opcode#'endidxfind';
      end if;
      -- operands include the selector element variable and the source table
      new op.operands;
      insert eltAddr into op.operands;
      insert tblAddr into op.operands;
      unite op.qualifier.empty from empty;
      ADDINSTR(op);
    end if;

    -- Remove info for this selector from the scratchpad
    block declare
      si: selectorInfoEntry;
    begin
      remove si from args.cgData.scratch.selInfo[eltRoot];
    end block;
    
    return Args;		-- all done!
  end block;

on exit(cantHappen)
  print S("CantHappen exit taken in cgselector");
end process
