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

-- This process generates code for an EXTRACT operation.  The code is
-- based on a 'allOrNone' loop skeleton produced by cgSelector.  Prior
-- to the loop, the destination table is initialized via 'new_table'.
-- In the body of the loop, a matching table element is removed from
-- the source table and then inserted into the destination table.

-- A complication arises from the possibility that the selector
-- condition makes use of the source table, which in a careless
-- implementation might make the semantics of the operation depend on
-- the order in which the elements are considered.  For example,
-- consider an undered table t of integers, containing 1 through 10,
-- and the statement: extract t2 from x in t[exists of y in t[x=y+1]];
-- A forward scan would result in t2={2,4,6,8,10} and t={1,3,5,7,9},
-- while a backward scan would yield t2={2,3,4,5,6,7,8,9,10} and
-- t={1}.  Since t is unordered, no scan order can be presumed, so
-- this is unacceptable.

-- To get around this problem, we check the selector condition to see
-- whether or not the source table is mentioned as an operand in any
-- statement in the condition code.  If so, we copy the source table
-- into a temp object prior to the extract, and use the temp object in
-- place of the original table inside the selector.  Since the
-- 'remove' operation does not work on a shared table, we must
-- privatize the table being looped over at the top of the loop.
-- Unfortunately, this forces the aforementioned table copy to always
-- be a deep copy.  (But remember that the copy is only made if the
-- selector might reference the table.)

-- A 'scan' style loop (with copying) ends up looking like this:
--
--	new_table	t1
--	copy		t0,t
--      privatize       t
-- 	initget 	r,t
-- loop:get_or_goto 	r,t {endloop}
--	[additional tests, result in 'test', with references to t
--	 redirected to t0]
--	bfalse 		test {loop}
--      remove 		tmp,r,t
--	insert 		t1,tmp
--	branch 		{loop}
-- endloop:
--	endget		r,t
--	discard		t0
--

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

cgExtract: using (cgInternal, interpform)

process (Q: cgStmtQ)

declare
  args: cgStmt;
  dst: objectname;		-- table to be created
  dstTdef: type_definition;	-- its type
  dstAddr: interpform!operand;	-- its LI address
  tbl: objectname;		-- source table
  tblAddr: interpform!operand;	-- source table LI address
  selTAddr: interpform!operand;	-- LI addr of table to reference
				-- within selector
  lk: lookupInfo;		-- describes lookup method used in loop
  endLoop: cgSelectorContinueFn; -- call this to tie off the loop
  empty: empty;

begin
  receive args from Q;
  reveal args.stmt.qualifier.selector;

  -- get the destination table and its type and LI address
  dst := objectname#(AREF(tmp,args.stmt.operands,ZERO));
  dstAddr <- interpform!operand#(args.cgData.Proc.objAddr(dst));
  dstTdef <- type_definition#(FNS.typeDef(
      typename#(args.cgData.Proc.objType(dst))));
  reveal dstTdef.specification.table_info;

  -- Generate a 'new_table' instruction for the destination table
  block declare
    op: interpform!operation;
  begin
    new op;
    op.opcode <- interpform!opcode#'new_table';
    new op.operands;
    insert interpform!operand#(copy of dstAddr) into op.operands;
    unite op.qualifier.new_table from new_table_info#(
	FNS.newTableInfo(dstTdef.specification.table_info,
	    FNS.typeDef,FNS.compOffsets));
    ADDINSTR(op);
  end block;

  -- Get source table object and its LI address
  tbl := objectname#(AREF(tmp,args.stmt.operands,ONE));
  tblAddr <- interpform!operand#(args.cgData.Proc.objAddr(tbl));

  -- Check whether we need to do the crufty copy of the source
  -- table...
  inspect proc in ABSPROG.programs[args.cgData.Proc.id] begin
    inspect scope in proc.executable_part.scopes
	[args.stmt.qualifier.selector.scope] begin
      if (B(FNS.clauseUsesObj(scope.clause,tbl,args.cgData))) then
	-- Need to copy... allocate an object, then generate the copy
	selTAddr <- interpform!operand#(args.cgData.Proc.tmpAddr());
	block declare
	  op: interpform!operation;
	begin
	  new op;
	  op.opcode <- interpform!opcode#'copy';
	  new op.operands;
	  insert interpform!operand#(copy of selTAddr) into op.operands;
	  insert interpform!operand#(copy of tblAddr) into op.operands;
	  unite op.qualifier.empty from empty;
	  ADDINSTR(op);
	end block;
	-- Now redirect future address queries for the source table to
	-- its copy
	call args.cgData.Proc.setAddr(tbl,selTAddr);
      else
	-- No copy needed... selector will reference source table
        selTAddr := tblAddr;
      end if;
    end inspect;
  end inspect;

  -- Make sure the table we'll be looping over is not shared
  block declare
    op: interpform!operation;
  begin
    new op;
    op.opcode <- interpform!opcode#'privatize';
    new op.operands;
    insert interpform!operand#(copy of tblAddr) into op.operands;
    unite op.qualifier.empty from empty;
    ADDINSTR(op);
  end block;
  
  -- Now generate the top part of the loop skeleton
  endLoop <- cgSelectorContinueFn#(FNS.cgSelector(
      args.stmt.qualifier.selector, args.cgData,
      typename#(args.cgData.Proc.objType(tbl)),
      selectorLoopType#'allOrNone', lk, tblAddr));

  -- Now generate the loop body, which needs to remove the
  -- representative element from the source table and then insert it
  -- into the destination table
  block declare
    tmpAddr: interpform!operand;
    op: interpform!operation;
  begin
    tmpAddr <- interpform!operand#(args.cgData.Proc.tmpAddr());

    -- First the 'remove' instruction... the actual form of the
    -- instruction depends on the type of lookup being used
    new op;
    select lookupType#(case of lk)
    where (lookupType#'scan')
      op.opcode <- interpform!opcode#'remove';
      unite op.qualifier.empty from empty;
    where (lookupType#'index')
      reveal lk.index;
      op.opcode <- interpform!opcode#'fremove';
      unite op.qualifier.integer from I(copy of lk.index.repno);
    where (lookupType#'key')
      reveal lk.key;
      op.opcode <- interpform!opcode#'fremove';
      unite op.qualifier.integer from I(copy of lk.key.repno);
    where (lookupType#'position')
      op.opcode <- interpform!opcode#'remove_at';
      unite op.qualifier.empty from empty;
    otherwise
      exit cantHappen;
    end select;

    -- operands include tmp object as destination, and element object
    -- and table as sources for all but position-style lookup; for
    -- that, the two source operands are the the source table and the
    -- object containing the integer position value
    new op.operands;
    insert interpform!operand#(copy of tmpAddr) into op.operands;
    if B(lookupType#(case of lk) = lookupType#'position') then
      reveal lk.posn;
      insert interpform!operand#(copy of tblAddr) into op.operands;
      insert interpform!operand#(args.cgData.Proc.objAddr(lk.posn.result))
	  into op.operands;
    else
      insert interpform!operand#(args.cgData.Proc.rootAddr(
	      args.stmt.qualifier.selector.element,
	      args.stmt.qualifier.selector.scope))
	  into op.operands;
      insert interpform!operand#(copy of tblAddr) into op.operands;
    end if;

    ADDINSTR(op);

    -- Now the 'insert' instruction
    new op;
    op.opcode <- interpform!opcode#'insert';
    new op.operands;
    insert dstAddr into op.operands;
    insert tmpAddr into op.operands;
    unite op.qualifier.empty from empty;
    ADDINSTR(op);

  end block;

  -- Now finish up the loop skeleton
  call endLoop(args.cgData);

  -- If we created a table copy for use in the selector, we need to
  -- discard it and undo the redirection of the source table address
  if B(selTAddr <> tblAddr) then
    block declare
      op: interpform!operation;
      null: interpform!operand;
    begin
      op <- interpform!operation#(copy of args.cgData.Tplt.discard);
      insert selTAddr into op.operands;
      ADDINSTR(op);
      new null;
      call args.cgData.Proc.setAddr(tbl,null);
    end block;
  end if;

  return args;

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