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

-- This process generates code for REMOVE operation.  The code is
-- based on an 'exactlyOne' loop skeleton produced by cgSelector.
-- In the body of the loop, a matching table element is removed from
-- the source table.

-- A 'scan' style loop ends up looking like this:
--
--	privatize	t
-- 	initget 	r,t
-- loop:get_or_err 	r,t
--	[additional tests, result in 'test']
--	bfalse 		test {loop}
--      remove 		dst,r,t
--	endget		r,t
--

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

cgRemove: using (cgInternal, interpform)

process (Q: cgStmtQ)

declare
  args: cgStmt;
  tbl: objectname;		-- source table
  tblAddr: interpform!operand;	-- source table LI address
  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 source table object and its LI address
  tbl := objectname#(AREF(tmp,args.stmt.operands,ONE));
  tblAddr <- interpform!operand#(args.cgData.Proc.objAddr(tbl));

  -- Make sure the table is not shared, else 'remove' operation will
  -- not work properly (it will cause its operand to be privatized,
  -- but the selector will still be based on the old shared copy).
  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#'exactlyOne', lk, tblAddr));

  -- Now generate the loop body, which needs to remove the
  -- representative element from the source table
  block declare
     op: interpform!operation;
  begin
    new op;
    -- The actual form of the 'remove' instruction depends on the type
    -- of lookup being used
    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 destination object, 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#(args.cgData.Proc.objAddr(
	objectname#(AREF(tmp,args.stmt.operands,ZERO)))) into op.operands;
    if B(lookupType#(case of lk) = lookupType#'position') then
      reveal lk.posn;
      insert 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 tblAddr into op.operands;
    end if;

    ADDINSTR(op);

  end block;

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

  return args;

end process
