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

-- This module performs object addressing operations for the code
-- generator.  The following facilities are provided:

--   * Lookup the LI address for a full object name
--   * Lookup the LI address for a root object
--   * Return the type name for a full object name
--   * Allocate a new data vector slot for a compiler temp
--   * Temporarily set an explicit address for a given object
--     (inherited by all its contained objects)
--   * Report the number of data vector slots allocated so far

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

objAddr: using (cgInternal, interpform, common, inferredtype, objAddr)
  linking (objAlias)

process (initQ: objAddrInitQ)
  
declare
  initArgs: objAddrInit;
  objQ: objAddrQ;
  rootQ: rootAddrQ;
  typeQ: objTypeQ;
  tmpQ: tmpAddrQ;
  setQ: setAddrQ;
  noAliasQ: noAliasQ;
  nRegQ: nregUsedQ;
  shutQ: signalQ;
  infDefs: inferredDefinitions;
  scopes: predefined!scopes;
  rootMap: rootMap;
  nReg: integer;
  compOffsets: compOffsetsFn;
  lkupType: lkupTypeFn;
  objAlias: objAliasFn;
begin
  receive initArgs from initQ;
  -- Pull a couple of things out of cgData now...
  block declare
    poly: polymorph;
  begin
    inspect x in initArgs.progData.annotations[S("Inferred Definitions")] begin
      poly := x.thing;
      unwrap infDefs from poly {init};
    end inspect;
  on (NotFound)
    new infDefs;		-- no inferred defs available
  end block;
  compOffsets := initArgs.compOffsets;
  lkupType := initArgs.lkupType;
  -- Start with a new, empty root map
  new rootMap;
  -- Data vector size starts out with enough room for
  -- fixed-position objects
  nReg <- I(FIRSTOBJECT);
  -- Grab onto the scopes associated with the process being
  -- mapped, and install the initport object at its fixed address
  inspect proc in initArgs.progData.absprog.programs[initArgs.processid]
  begin
    scopes := proc.executable_part.scopes;
    block declare
      initport: rootname;
      entry: rootMapEntry;
    begin
      new initport;
      initport.root := proc.initport;
      initport.scope := proc.executable_part.main_scope;
      new entry;
      entry.root <- initport;
      new entry.addr;
      insert I(INITPORT) into entry.addr;
      entry.type <- typename#(lkupType(entry.root,scopes,infDefs));
      insert entry into rootMap;
    end block;
  end inspect;

  -- Set up connections for all the services we'll offer
  new objQ; connect initArgs.objAddr to objQ;
  new rootQ; connect initArgs.rootAddr to rootQ;
  new typeQ; connect initArgs.objType to typeQ;
  new tmpQ; connect initArgs.tmpAddr to tmpQ;
  new setQ; connect initArgs.setAddr to setQ;
  new noAliasQ;
  new nRegQ; connect initArgs.nRegUsed to nRegQ;
  new shutQ; connect initArgs.shutdown to shutQ;
  
  -- Give back all the capabilities
  return initArgs;

  -- Here's the alias mapper, which intercepts certain service calls
  -- only when aliases are in effect
  objAlias <- objAliasFn#(procedure of program#(process objAlias));
      
  -- Now take requests for this process until another objOpenProc
  -- call is made
  while (TRUE) repeat
    select
    event objQ
      -- Here to look up the address of a full objectname
      block declare
	args: objAddr;
	addr: interpform!operand;
	type: typename;
      begin
	receive args from objQ;
	-- try to find the rootname in the rootMap
	block begin
	  inspect entry in rootMap[args.objname.root] begin
	    addr := entry.addr;
	    type := entry.type;
	    exit doComps;
	  end inspect;
	on (NotFound)
	  -- Here when no rootmap entry exists... create a new
	  -- rootmap entry 
	  block declare
	    entry: rootMapEntry;
	  begin
	    new addr;
	    insert I(copy of nReg) into addr;
	    nreg <- I(nReg + ONE);
	    new entry;
	    entry.root := args.objname.root;
	    entry.addr := addr;
	    -- Locate the type corresponding to this root object
	    type <- typename#(lkupType(args.objname.root,scopes,infDefs));
	    entry.type := type;
	    insert entry into rootMap;
	    exit doComps;
	  end block;
	end block;
      on exit(doComps)
	-- here when we have an address for the root of the object...
	-- now resolve its components
	block declare
	  offsets: interpform!operand;
	begin
	  call compOffsets(type,args.objname.components,offsets);
	  merge offsets into addr;
	  args.offsets <- addr;
	  return args;
	end block;
      end block;
      
      
    event rootQ
      -- Get an address for a root object
      block declare
	args: rootAddr;
	root: rootname;
      begin
	receive args from rootQ;
	new root;		-- make a full root name
	root.root := args.root;
	root.scope := args.scope;
	-- check the root map
	block begin
	  inspect entry in rootMap[root] begin
	    args.offsets := entry.addr;
	    return args;
	  end inspect;
	on (NotFound)
	  -- Nothing root map... we need a new entry
	  block declare
	    entry: rootMapEntry;
	  begin
	    new entry;
	    entry.root := root;
	    new entry.addr;
	    insert I(copy of nReg) into entry.addr;
	    nReg <- I(nReg + ONE);
	    entry.type <- 
		typename#(lkupType(entry.root,scopes,infDefs));
	    args.offsets := entry.addr;
	    insert entry into rootMap;
	    return args;
	  end block;
	end block;
      end block;
      
    event typeQ
      -- Look up the type of the given objectname
      block declare
	args: objType;
	dummy: interpform!operand;
      begin
	receive args from typeQ;
	-- Get the root object type
	args.typename <- 
	    typename#(lkupType(args.objname.root,scopes,infDefs));
	-- Now follow down the components to arrive at the final type
	call compOffsets(args.typename,args.objname.components,dummy);
	return args;
      end block;
      
    event tmpQ
      -- Here we need to allocate a new data vector slot for a
      -- compiler temporary.  The slot can never be used for
      -- anything else, so it doesn't go into any table
      block declare
	args: tmpAddr;
      begin
	receive args from tmpQ;
	new args.offsets;
	insert I(copy of nReg) into args.offsets;
	nReg <- I(nReg + ONE);
	return args;
      end block;
      
    event setQ
      -- Here when they want to add(remove) an entry to(from) our
      -- object lookup table... This only happens when the alias map
      -- is empty, since we immediately splice in an objAlias process
      -- to intercept all related calls until the alias map is empty
      -- again.
      
      block declare
	objType: objTypeFn;
	noAlias: noAliasFn;
      begin
	-- Fire up the alias mapper and give it the inports it should
	-- intercept for us (it gives back new inports that we will
	-- use to receive requests not involving aliases).  Note that
	-- it will immediately receive the setAddr message that caused
	-- all this, as we never received it.
	connect objType to typeQ;
	connect noAlias to noAliasQ;
	call objAlias(objQ, rootQ, setQ, noAlias,
	  objType, compOffsetsFn#(copy of compOffsets));
      end block;
      
    event noAliasQ
      -- Here when an alias mapping process has just emptied its alias
      -- map and thus need not intercept requests anymore until
      -- another setAddr call establishes a new alias.
      block declare
	args: noAlias;
      begin
	receive args from noAliasQ;
	-- reinstall our original service inports
	objQ <- args.objAddrQ;
	rootQ <- args.rootAddrQ;
	setQ <- args.setAddrQ;
	return args;
      end block;
      
    event nRegQ
      -- Here when they just want to know how big the data vector
      -- has gotten
      block declare
	args: nRegUsed;
      begin
	receive args from nRegQ;
	args.nRegUsed := nReg;
	return args;
      end block;
      
    event shutQ
      -- Here when we're told to shut down altogether...
      exit shutdown;
      
    otherwise
      exit cantHappen;
    end select;
  end while;
  
on exit(shutdown)
  -- here when this process is no longer needed
on exit(cantHappen)
  print S("CantHappen exit taken in objaddr");
end process
