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

-- This process is invoked by the objAddr process whenever a setAddr
-- call comes in.  From that point forward, until there is no more
-- aliasing in effect, this process intercepts certain of the calls
-- normally meant for objAddr and handles them if aliasing is
-- involved.  If no aliasing is involved in an intercepted call, the
-- callmessage is forwarded to the original objAddr process for normal
-- handling.

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

objalias: using (cgInternal, objAddr, interpform)

process (Q: objAliasQ)
declare
  initArgs: objAlias;
  objQ: objAddrQ;
  objAddr: objAddrFn;
  rootQ: rootAddrQ;
  rootAddr: rootAddrFn;
  setQ: setAddrQ;
  compOffsets: compOffsetsFn;
  objType: objTypeFn;
  noAlias: noAliasFn;
  aliases: objectMap;
begin
block begin
  receive initArgs from Q;
  -- grab the inports they gave us and give back new ports that we
  -- will use for forwarding when needed
  objQ <- initArgs.objAddrQ;
  new initArgs.objAddrQ;
  connect objAddr to initArgs.objAddrQ;
  rootQ <- initArgs.rootAddrQ;
  new initArgs.rootAddrQ;
  connect rootAddr to initArgs.rootAddrQ;
  setQ <- initArgs.setAddrQ;
  new initArgs.setAddrQ;
  -- Stash away capability to give above inports back when the
  -- alias map becomes empty
  noAlias <- initArgs.noAlias;
  -- Other capabilities...
  compOffsets <- initArgs.compOffsets;
  objType <- initArgs.objType;
  -- Now return and set up to field service requests
  return initArgs;

  new aliases;		-- start with an empty alias map
  while (TRUE) repeat
    select
    event objQ
      -- Look up the given objectname and all prefixes in our
      -- alias map.  If not found, forward the request on to the
      -- standard handler
      block declare
	args: objAddr;
	prefix: objectname;
	suffix: component_list;
	addr: interpform!operand;
	type: typename;
      begin
	receive args from objQ;
	-- look for an alias on a prefix of the object name
	prefix := args.objname;
	new suffix;
	block begin
	  while TRUE repeat
	    block begin
	      inspect entry in aliases[prefix] begin
		-- Found a matching entry
		args.offsets := entry.addr;
		type := entry.type;
		-- handle remaining components
		call compOffsets(type,suffix,addr);
		merge addr into args.offsets;
		return args;
		exit objAddrDone;
	      end inspect;
	    on (NotFound)
	      -- Try a smaller prefix
	      block declare
		comp: componentid;
	      begin
		remove comp from AREF(tmp,prefix.components,
		  I(I(size of prefix.components)-ONE));
		insert comp into suffix at ZERO;
	      on (NotFound)
		-- No smaller prefix... just forward the original
		-- message to the non-Aliasing server
		send args to objAddr;
		exit objAddrDone;
	      end block;
	    end block;
	  end while;
	on exit(objAddrDone)
	  -- Here when the request has been handled or forwarded
	end block;
      end block;

    event rootQ
      -- Look up the given root name as an object in the alias
      -- map.  If not found, forward the request on to the
      -- standard handler.
      block declare
	args: rootAddr;
	obj: objectname;
      begin
	receive args from rootQ;
	-- Build a full objectname for the root object
	new obj;
	new obj.root;
	obj.root.root := args.root;
	obj.root.scope := args.scope;
	new obj.components;
	-- check for an alias...
	inspect entry in aliases[obj] begin
	  args.offsets := entry.addr;
	  return args;
	end inspect;
      on (NotFound)
	-- No alias... forward to nonaliasing handler
	send args to rootAddr;
      end block;

    event setQ
      -- Establish a new entry in the alias map or (if the given
      -- LI address is empty), remove an existing entry
      block declare
	args: setAddr;
	entry: objectMapEntry;
      begin
	receive args from setQ;
	if B(I(size of args.addr) = ZERO) then
	  -- remove an existing alias and check for empty map
	  remove entry from aliases[args.obj];
	  return args;
	  if B(I(size of aliases) = ZERO) then
	    exit noMoreAliases;
	  end if;
	else
	  -- build a new alias...
	  new entry;
	  entry.obj := args.obj;
	  entry.addr := args.addr;
	  entry.type := typename#(objType(entry.obj));
	  insert entry into aliases;
	  return args;
	end if;
      end block;

    otherwise
      exit cantHappen;
    end select;
  end while;
on exit(noMoreAliases)
  -- here when the alias map empties out... we need to send the
  -- inports we got during initialization back to the standard
  -- handler so further requests will be handled directly.
  call noAlias(objQ, rootQ, setQ);

on exit(cantHappen)
  print S("CantHappen exit taken in objalias");

end block;
end process
