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

-- This module strings together the code fragments from a collection
-- of basic blocks into a single list of instructions.  Branches are
-- inserted as necessary to implement proper flow between BB's.  The
-- BB's are strung together in the order specified by BBData.BBOrder.
-- If BBData.entry is not the id associated with the first BB, a jump
-- to the entry BB is generated as the first instruction.

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

BBAssemble: using (cgInternal, interpform, bbassemble)

process (Q: BBAssembleQ)
  
declare
  args: BBAssemble;
  addrs: BBAddrs;
begin
  receive args from Q;
  
  new addrs;

  -- Make a first pass over the BB's to determine the starting address
  -- of each
  block declare
    sofar: integer;
    addr: BBAddr;
    lastExit: BBExit;
  begin
    -- Start assigning addresses at zero
    sofar <- ZERO;
    
    -- Fake up a "prior BB's exit structure" indicating an
    -- unconditional branch to the entry BB
    unite lastExit.jump from BBid#(copy of args.BBData.entry);

    -- Now loop over all the BB's in order
    for id in args.BBData.BBOrder[] inspect
      -- Compute the amount of glue that will be necessary for the
      -- prior BB's exit structure
      select BBExitType#(case of lastExit)
      where (BBExitType#'jump')
	-- Unconditional jump... no glue needed if we happen to be the
	-- target of the jump
	reveal lastExit.jump;
	if B(id <> lastExit.jump) then
	  sofar <- I(sofar + ONE);
	end if;
	
      where (BBExitType#'ifelse')
	-- Conditional jump... In addition to the associated final
	-- instruction already in the BB, we may need a branch to the
	-- second target if it does not immediately follow
	reveal lastExit.ifelse;
	if B(B(id <> lastExit.ifelse.ifTarget) 
		<> B(id = lastExit.ifelse.elseTarget)) then
	  sofar <- I(sofar + ONE);
	end if;
	  
      where (BBExitType#'select')
	-- Select stmt...  In addition to the associated final
	-- 'select' instruction already in the BB, we may need a
	-- branch to the otherwise target if it does not immediately
	-- follow
	reveal lastExit.selection;
	if B(id <> lastExit.selection.other) then
	  sofar <- I(sofar + ONE);
	end if;

      where (BBExitType#'test')
	-- Test instruction... if we happen to be the 'nojump' branch
	-- target, then only the test instruction (already present as
	-- the associated final BB instruction) is needed, else we
	-- need an additional branch
	reveal lastExit.test;
	if B(id <> lastExit.test.nojump) then
	  sofar <- I(sofar + ONE);
	end if;
	    
      where (BBExitType#'handlers')
	-- Block instruction... If we happen to be the entry BB for
	-- the block, then we only need the 'block' instruction, else
	-- we need an additional branch
	reveal lastExit.handlers;
	if B(id = lastExit.handlers.entry) then
	  sofar <- I(sofar + ONE);
	else
	  sofar <- I(sofar + I(2));
	end if;
	      
      where (BBExitType#'none')
	-- This only happens when there's no exit from a BB (e.g. end
	-- of process, or BB ends with a 'raise' instruction).  No
	-- glue is needed

      otherwise
	exit cantHappen;
      end select;
      
      -- Address for this BB is code size so far
      new addr;
      addr.BBid := id;
      addr.addr := sofar;
      insert addr into addrs;
      
      -- now account for code contained in this BB, and make a copy of
      -- its exit structure for processing the next BB
      inspect BB in args.BBData.BBs[id] begin
	sofar <- I(sofar + I(size of BB.code));
	lastExit := BB.exit;
      end inspect;
    end for;
  end block;
  
  -- Now we know precisely where each BB will be placed... we make a
  -- second pass over the BB's, this time accumulating the necessary
  -- code.
  new args.code;		-- empty out the code array
  block declare
    op: interpform!operation;
    b_op: interpform!operation;
    bt_op: interpform!operation;
    bf_op: interpform!operation;
    lastExit: BBExit;
    fakeBBid: BBid;
  begin
    -- Build up some instruction templates for branch instructions...
    new b_op;
    b_op.opcode <- interpform!opcode#'branch';
    new b_op.operands;
    new bt_op;
    bt_op.opcode <- interpform!opcode#'branch_true';
    new bt_op.operands;
    new bf_op;
    bf_op.opcode <- interpform!opcode#'branch_false';
    new bf_op.operands;

    -- Fake up a jump-to-entry exit structure as in pass 1
    unite lastExit.jump from BBid#(copy of args.BBData.entry);
    
    -- Add a fake BBid to the ID list so glue will be set after the
    -- last BB...  remember the ID so we avoid post-glue processing
    -- the last time through the loop
    fakeBBid <- BBid#unique;
    insert BBid#(copy of fakeBBid) into args.BBData.BBOrder;
    
    -- Now loop over each BB; in each case, we generate any glue
    -- required from the previous BB, then merge in the code from this
    -- BB.
    for id in args.BBData.BBOrder[] inspect
      -- Set glue according to last BB's exit structure
      select BBExitType#(case of lastExit)
      where (BBExitType#'jump')
	-- Unconditional jump... generate a branch if we're not the target
	reveal lastExit.jump;
	if B(id <> lastExit.jump) then
	  op := b_op;
	  inspect a in addrs[lastExit.jump] begin
	    unite op.qualifier.integer from I(copy of a.addr);
	  end inspect;
	  insert op into args.code;
	end if;
	
      where (BBExitType#'ifelse')
	-- Conditional jump... if either target is the current BB,
	-- turn the final BB instruction into a conditional jump for
	-- the other case and fall through... otherwise we need a
	-- conditional and an unconditional jump
	reveal lastExit.ifelse;
	block declare
	  otherTarg: BBid;
	  BB: basicBlock;
	begin
	  remove op from AREF(tmp,args.code,I(I(size of args.code)-ONE));
	  if B(id = lastExit.ifelse.ifTarget) then
	    op.opcode <- interpform!opcode#'branch_false';
	    inspect a in addrs[lastExit.ifelse.elseTarget] begin
	      unite op.qualifier.integer from I(copy of a.addr);
	    end inspect;
	    otherTarg := lastExit.ifelse.ifTarget;
	  else
	    op.opcode <- interpform!opcode#'branch_true';
	    inspect a in addrs[lastExit.ifelse.ifTarget] begin
	      unite op.qualifier.integer from I(copy of a.addr);
	    end inspect;
	    otherTarg := lastExit.ifelse.elseTarget;
	  end if;
	  -- Install the conditional branch
	  insert op into args.code;
	  -- Now the unconditional branch if needed
	  if B(otherTarg <> id) then
	    op := b_op;
	    inspect a in addrs[otherTarg] begin
	      unite op.qualifier.integer from I(copy of a.addr);
	    end inspect;
	    insert op into args.code;
	  end if;
	end block;
	
      where (BBExitType#'test')
	-- Test statement... add the jump label to the test
	-- instruction and generate a branch for the 'nojump' case if
	-- needed
	reveal lastExit.test;
	remove op from AREF(tmp,args.code,I(I(size of args.code)-ONE));
	-- insert the LI address into the appropriate spot based on
	-- the LI opcode
	inspect a in addrs[lastExit.test.jump] begin
	  select op.opcode
	  where (interpform!opcode#'get_or_goto')
	    reveal op.qualifier.integer;
	    op.qualifier.integer := a.addr;
	    
	  where (interpform!opcode#'find_or_goto')
	    reveal op.qualifier.integer_pair;
	    op.qualifier.integer_pair.int_two := a.addr;
	    
	  where (interpform!opcode#'idxfind_or_goto')
	    reveal op.qualifier.integer;
	    op.qualifier.integer := a.addr;
	    
	  where (interpform!opcode#'lookup_at_or_goto')
	    reveal op.qualifier.integer;
	    op.qualifier.integer := a.addr;
	    
	  where (interpform!opcode#'oeloop')
	    reveal op.qualifier.integer_pair;
	    op.qualifier.integer_pair.int_one := a.addr;
	    
	  otherwise
	    -- no other opcodes used in this type of exit structure
	    exit cantHappen;
	  end select;
	end inspect;
	insert op into args.code;
	if B(id <> lastExit.test.nojump) then
	  op := b_op;
	  inspect a in addrs[lastExit.test.nojump] begin
	    unite op.qualifier.integer from I(copy of a.addr);
	  end inspect;
	  insert op into args.code;
	end if;
	

      where (BBExitType#'select')
	-- Select statement... generate the 'select' instruction
	-- with all clause addresses coded in the qualifier, and then
	-- a 'branch' instruction if the otherwise target does not
	-- immediately follow
	reveal lastExit.selection;
	remove op from AREF(tmp,args.code,I(I(size of args.code)-ONE));
	unite op.qualifier.select from
	    select_qual#(evaluate sq:select_qual from new sq; end);
	for targ in lastExit.selection.targets[] inspect
	  inspect a in addrs[targ] begin
	    insert I(copy of a.addr) into op.qualifier.select;
	  end inspect;
	end for;
	insert op into args.code;
	if B(id <> lastExit.selection.other) then
	  op := b_op;
	  inspect a in addrs[lastExit.selection.other] begin
	    unite op.qualifier.integer from I(copy of a.addr);
	  end inspect;
	  insert op into args.code;
	end if;
	
      where (BBExitType#'handlers')
	-- Need to generate a 'block' statement with all the handler
	-- addresses.  If the block entry BBid is not the current one,
	-- we also need a branch statement
	reveal lastExit.handlers;
	new op;
	op.opcode <- interpform!opcode#'block';
	new op.operands;
	
	block declare
	  bh: interpform!block_handler;
	  bq: interpform!block_qual;
	begin
	  new bq;
	  for h in lastExit.handlers.names[] inspect
	    new bh;		-- assemble a handler name/addr pair
	    bh.handler := h;
	    inspect AREF(targ,lastExit.handlers.targets,I(position of h)) begin
	      inspect a in addrs[targ] begin
		bh.label := a.addr;
	      end inspect;
	    end inspect;
	    insert bh into bq;
	  end for;
	  unite op.qualifier.block from bq;
	end block;
	insert op into args.code;
	-- Now generate the branch to the block entry if needed
	if B(id <> lastExit.handlers.entry) then
	  op := b_op;
	  inspect a in addrs[lastExit.handlers.entry] begin
	    unite op.qualifier.integer from I(copy of a.addr);
	  end inspect;
	  insert op into args.code;
	end if;
	
      where (BBExitType#'none')
	-- No glue needed in this case
	
      otherwise
	exit cantHappen;
	
      end select;
      
      -- Glue has been set... now we need to add code from the current
      -- basic block
      if B(id <> fakeBBid) then
	block declare
	  BB: basicBlock;
	begin
	  remove BB from args.BBData.BBs[id];
	  merge BB.code into args.code;
	  -- Hang on to this BB's exit structure so we can set glue next
	  -- time through the loop
	  lastExit <- BB.exit;
	end block;
      end if;
      
    end for;
    
  end block;
  
  -- All done!
  return args;
  
on exit(cantHappen)
  print S("CantHappen exit taken in bbassemble");
end process
