-- (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: pcom.p
-- Author: David F. Bacon & Andy Lowry
-- SCCS Info: @(#)pcom.pp	1.16 4/25/90

-- This process drives the various phases in the compilation of one or
-- more Hermes process modules, namely: parsing, type checking,
-- typestate checking, and code generation.  Any phase can be
-- optionally suppressed by means of a command line switch.  The
-- switches and their consequences (roughly) are as follows:

--   -noParse
--	The source module is not parsed.  In order for any other stage
--	to succeed, an ".ao" file for the module must exist.
--   -noTCheck
--	The abstract program is not checked for type errors, and no
--	type inferencing is done.  Subsequent code generation may fail
--	if the source program was not completely typemarked.  Bizarre
--	run-time errors can result from incorrect programs, since
--	things like passing an object of the wrong type on an outport will 
--	be allowed.
--   -noTSCheck
--      The absprob is not checked for typestate errors, and no
--      coercions are generated.  Subsequent code generation should
--      produce an "apparently" correct compiled program, assuming the
--      program is correct.  Since coercions are not generated,
--      however, the resulting program will probably contain memory
--      leaks.  If the program is not typestate correct, skipping this
--      checking phase can result in bizarre runtime errors since
--      things like accessing fields of uninit records will be allowed.
--   -noObject
--	No compiled program object will be generated.  This is useful
--      for submitting a program to type or typestate checking only,
--      without overwriting an existing .po file, or in conjunction
--      with the -LIGen option
--   -LIGen
--      Disassemble the compiled module and write the result to a file
--      with extension '.li'

-- This module is compiled four (4) times with different conditional 
-- compilation switches during the process of bootstrapping the compiler.
-- The phases are as follows:
--
-- CGBOOT 
-- Initial bootstrapping of the code generator.  Compile without the integrated
-- parser (only use loadprog), the type checker, or the typestate checker.
-- stdenv comes with getCwd, setCwd, libWriteObj, libStore, and terminal
-- uninit.  unix.stdio is also uninit.
--
-- TCBOOT
-- Used to compile the type checker.  Gets a full stdenv and unix, but does no
-- type or typestate checking.
--
-- TSBOOT
-- Used to compile the typestate checker.  Does no typestate checking.
--
-- No #ifdefs
-- Compiles the whole module.

-- Enforce strict hierarchy in the xxBOOT cpp variables
#ifdef CGBOOT
#  ifndef TCBOOT
#    define TCBOOT
#  endif
#endif

#ifdef TCBOOT
#  ifndef TSBOOT
#    define TSBOOT
#  endif
#endif

#ifdef TSBOOT
#  define ANYBOOT
#endif

#include "typemark.h"

-- following is required as a workaround for an AIX bug on the Rios
#define addspace(x,y) x y

#define AREF(elt,t,i) elt in t where (B(I(addspace(position of,elt)) = i))

pCom: using (main, common, terminalIO,
  -- imports for all phases
  fileDef, posMap, errors, annotate, loadProg, parse, formatError, load
  -- imports for codegen
  , codegen, inferredType
#ifndef CGBOOT
  -- imports for parsing
  , getFile, initParse
#endif CGBOOT

#ifndef TCBOOT
  -- imports for type checking
  , typecheck, checking_table
#endif TCBOOT

#ifndef TSBOOT
  -- imports for typestate checking
  , typestate, coercions
#endif TSBOOT

#ifndef ANYBOOT
  -- imports for services beyond typestate checking
  , disassembler, unix, LIStuff, interpform
#endif ANYBOOT
)

process (Q: main_Q)
  
declare
  args: main_Intf;
  argv: charstringList;
  options: annotations;
  procErrors: procErrors;
  errors: errors;
  errorStrings: charStringList;
  codegen: codegenFn;
  fakeCodegen: codegenFn;
  loadProg: loadProgFunc;
  fakeLoadProg: loadProgFunc;
  putString: putStringFunc;
  putLine: putStringFunc;

#ifndef CGBOOT
  parse: parseProcFn;
  getFile: getFileFunc;
  getFileInit: getFileInitFunc;
  fakeGetFile: getFileFunc;
  formatError: formatErrorFn;
  fakeFormatError: formatErrorFn;
#endif CGBOOT

#ifndef TCBOOT
  checking_table: checking_table;
  typeCheck: typeCheckCapa;
  fakeTypeCheck: typeCheckCapa;
#endif TCBOOT

#ifndef TSBOOT
  tsCheck: typestateCheckOutport;
  fakeTsCheck: typestateCheckOutport;
#endif TSBOOT
  
#ifndef ANYBOOT
  disasm: disassemblerFn;
  fakeDisasm: disassemblerFn;
  LIUnstuff: LIUnstuffFn;
  fakeLIUnstuff: LIUnstuffFn;
#endif ANYBOOT
  
begin
  receive args from Q;
  
  -- Get capabilities to processes we may need, and get useless fake
  -- capabilities for processes that we might be able to avoid loading
  block declare
    loadIn: loadProgQ;
    cgIn: codegenQ;
  begin
    new loadIn;
    connect fakeLoadProg to loadIn;
    loadProg := fakeLoadProg;
    new cgIn;
    connect fakeCodegen to cgIn;
    codegen := fakeCodegen;
  end block;
  
#ifndef CGBOOT
  -- Set up the parser, which is a c-hermes function.  It is
  -- initialized with capas to some other standard processes.  Also
  -- get a fake capability to the error formatter and to getfile,
  -- which we may not need to load
  block declare
    initParse: initParseProcFn;
    fns: parseFns;
    fmtErrIn: formatErrorQ;
    getFileIn: getFileQ;
  begin
    unwrap initParse from polymorph#(args.CLoader(S("Parse Proc"))) {init};
    new fns;
    fns.load := args.std.pathload;
    fns.store := args.std.libStore;
    fns.readObj := args.std.pathReadObj;
    fns.writeObj := args.std.libWriteObj;
    fns.getCwd := args.std.getCwd;
    parse <- parseProcFn#(initParse(fns));
    new fmtErrIn;
    connect fakeFormatError to fmtErrIn;
    formatError := fakeFormatError;
    new getFileIn;
    connect fakeGetFile to getFileIn;
    getFile := fakeGetFile;
  end block;
#endif CGBOOT
  
#ifndef TCBOOT
  -- start with an empty checking table to satisfy typestate checking,
  -- but don't load it yet since we may not need it
  new checking_table;

  -- Get fake capabilities to the type checker, which we may not need
  -- to load
  block declare
    tcIn: typeCheckQueue;
  begin
    new tcIn;
    connect fakeTypeCheck to tcIn;
    typeCheck := fakeTypeCheck;
  end block;
#endif TCBOOT
  
#ifndef TSBOOT
  -- Get fake capability to typestate checker, in case we don't need
  -- to load them
  block declare
    tsIn: typestateCheckInport;
  begin
    new tsIn;
    connect fakeTsCheck to tsIn;
    tsCheck := fakeTsCheck;
  end block;
#endif TSBOOT

#ifndef ANYBOOT
  -- Get fake capabilities to disassembler in case we don't need it
  block declare
    disIn: disassemblerQ;
    unstuffIn: LIUnstuffQ;
  begin
    new disIn;
    connect fakeDisasm to disIn;
    disasm := fakeDisasm;
    new unstuffIn;
    connect fakeLIUnstuff to unstuffIn;
    LIUnstuff := fakeLIUnstuff;
  end block;
#endif ANYBOOT

#ifdef CGBOOT
  -- stdio not available during codegen boot phase... just use print stmt
  putLine <- putStringFunc#(procedure of program#(
      process (Q: putStringQ)
      declare
	args: putStringIntf;
      begin
	receive args from Q;
	print args.string;
	return args;
      end process));
  putString := putLine;
#else
  -- Shortcuts to simple i/o routines
  putLine := args.std.terminal.putLine;
  putString := args.std.terminal.putString;
#endif CGBOOT

  -- Pick out command line options
  new options;
  block declare
    option: annotation;
    optnames: charstringList;
    name: charstring;
    value: charstring;
    empty: empty;
    caseDiff: integer;
  begin
				-- for case conversions...
    caseDiff <- I(I(convert of char#'a') - I(convert of char#'A'));
    -- get all arg strings that begin with a hyphen
    argv := args.argv;
    extract optnames from word in argv 
	where (B(char#(AREF(tmp,word,ZERO)) = char#'-'));
    -- turn each word into an option in the options table.  If the
    -- word contains an embedded equal sign ('='), the portion before
    -- the equal sign becomes the option name, and the following
    -- portion becomes the option value (a charstring)
    for optname in optnames[] inspect
      new option;
      new option.name;
      block begin
	inspect c in optname where (B(c = char#'=')) begin
	  -- break up name and value
	  name <- charString#(every of c1 in optname 
		where (B(I(position of c1) < I(position of c))));
	  wrap value as option.thing;	
	end inspect;
      on (NotFound)
	-- no equal sign... value is empty
	name := optname;
	wrap empty as option.thing;
      end block;
      -- Convert option name to lower case
      for c in name where (B(I(position of c) > ZERO)) inspect
	if B(B(c >= char#'A') and B(c <= char#'Z')) then
	  insert char#(convert of I(I(convert of c) + caseDiff))
	      into option.name;
	else
	  insert char#(copy of c) into option.name;
	end if;
      end for;
      -- Finished forming this option
      insert option into options;
    end for;
  end block;
  
  -- Now process each module named on the command line in turn,
  -- skipping the first two argument words which are the name of the
  -- shell and this module's name
  for fileName in argv where (B(I(position of fileName) >= I(2))) inspect
    block declare
      modName: charString;
      absprog: program;
      links: linkedPrograms;
      defMaps: definitions_printmappings;
      procMaps: executable_printmappings;
      posMappings: position_mappings;
      infDefs: inferredDefinitions;
#ifndef TSBOOT
      coercions: coercions;
#endif TSBOOT
    begin

      -- extract module name by stripping leading path components
#ifdef ANYBOOT
      modName := fileName;
#else
      block declare
	slashPos: integer;
      begin
	slashPos <- size of fileName - 1;
	while slashPos >= 0 repeat
	  if fileName[slashPos] = '/' then
	    exit found;
	  end if;
	  slashpos <- slashpos - 1;
	end while;
	exit found;
      on exit(found)
	modName := every of c in fileName where (position of c > slashPos);
      end block;
#endif ANYBOOT      

      call putString(S(modname | S(":")));
      new infDefs;

      ---------------- parsing / loading ----------------

#ifndef CGBOOT
      if B(exists of options[S("noparse")]) then
#endif CGBOOT
	-- no parsing phase... read absprog from .ao file
	block declare
	  badMod: charstring;
	begin
	  call putString(S(S(" load[") | S(fileName | S(".ao]"))));
	  if B(loadProg = fakeLoadProg) then
	    loadProg <- loadProgFunc#(procedure of program#(
		args.std.pathLoad(S("loadprog"))));
	  end if;
	  call loadProg(fileName, args.std.pathReadobj,
	    absprog, links, defMaps, procMaps, posMappings, badMod);
	on (loadProgIntf.programNotFound)
	  call putLine(S(" ERRORS"));
	  call putLine
	      (S(S(S("Program module '") | modName) | S("' was not found.")));
	  exit failed;
	on (loadProgIntf.definitionNotFound)
	  call putLine(S(" ERRORS"));
	  call putLine
	      (S(S(S("Definitions module '") | badMod) 
		  | S("' was not found.")));
	  exit failed;
	on (loadProgIntf.definitionInconsistent)
	  call putLine(S(" ERRORS"));
	  call putLine
	      (S(S(S("Definitions module '") | badMod) 
		  | S("' is inconsistent.")));
	  exit failed;
	on (loadProgIntf.discarded)
	  call putLine(S("ERRORS"));
	  call putLine
	      (S(S(S("Unable to load program module '") | modName) | S("'")));
	  exit failed;
	end block;
      
#ifndef CGBOOT      
      else
	-- parse source file to yield absprog
	block declare
	  source: charstring;
	  imports: module_printmap;
	  pathName: charString;
	begin
	  call putString(S(S(" parse[") | S(fileName | S(".p]"))));
	  if B(getFile = fakeGetFile) then
	    getFileInit <- getFileInitFunc#(create of program#(
		args.std.pathLoad(S("getfile"))));
	    getFile <- getFileFunc#(getFileInit(
		args.unix.stdio.fopen, args.unix.stdio.fclose, 
		args.unix.stdio.fread));
	  end if;
#ifndef ANYBOOT
	  if fileName[0] = '/' then
#endif
	    pathName := fileName;
#ifndef ANYBOOT
	  else
	    pathName := S(S(S(args.std.getCwd()) | S("/")) | fileName);
	  end if;
#endif
	  source <- S(getfile(S(pathName | S(".p"))));
	  call parse(source, S(fileName | S(".p")), absprog,
	    defMaps, procMaps, posMappings, imports, links, errors);
	  if B(I(size of errors) <> ZERO) then
	    exit parseErrors;
	  end if;
	  
	on (getFile.cantRead)
	  call putLine(S(" ERRORS"));
	  call putLine
	      (S(S(S("Unable to read source file '") | fileName) | S(".p'.")));
	  exit failed;
	end block;
      end if;
#endif CGBOOT

#ifndef TCBOOT
      -- initialize the procErrors table used by type and typestate checking
      new procErrors;
      
      ---------------- type checking ----------------
      if B(not B(exists of options[S("notcheck")])) then
	-- Invoke the type checker on the absprog
	call putString(S(" typecheck"));
	if B(typeCheck = fakeTypeCheck) then
	  typeCheck <- typeCheckCapa#(procedure of program#(
	      args.std.pathload(S("type"))));
	end if;
	if B(I(size of checking_table) = ZERO) then
	  unwrap checking_table from polymorph#(
	    args.std.pathReadObj(S("checking_table.ho"))) {init};
	end if;
	for proc in absprog.programs[] inspect
	  block declare
	    newInfDefs: inferredDefinitions;
	  begin
	    call typeCheck(proc, absprog.definitions_modules,
	      checking_table, args.std, errors, newInfDefs);
	    merge newInfDefs into infDefs;
	  on (typeCheckCall.typeErrors)
	    -- problems... stash away the errors
	    for error in errors[] inspect
	      block declare
		procError: procError;
	      begin
		new procError;
		procError.procID := proc.id;
		procError.error := error;
		insert procError into procErrors;
	      end block;
	    end for;
	  end block;
	end for;
	-- Stop now if any errors were reported
	if B(I(size of procErrors) <> ZERO) then
	  exit errors;
	end if;
      end if;
#endif TCBOOT

#ifndef TSBOOT
      ---------------- typestate checking ----------------
      if B(exists of options[S("notscheck")]) then
	-- suppress typestate checking, and pass on an empty coercions
	-- list
	new coercions;
      else
	call putString(S(" typestate"));
	if B(tsCheck = fakeTsCheck) then
	  tsCheck <- typestateCheckOutport#(procedure of program#(
	      args.std.pathload(S("typestate"))));
	end if;
	if B(I(size of checking_table) = ZERO) then
	  unwrap checking_table from polymorph#(
	    args.std.pathReadObj(S("checking_table.ho"))) {init};
	end if;
	new coercions;
	for proc in absprog.programs[] inspect
	  block declare
	    newCoercions: coercions;
	  begin
	    call tscheck(args.std, absprog, proc, checking_table,
	      defMaps, procMaps, infDefs, newCoercions, errors);
	    merge newCoercions into coercions;
	  on (typestateCheckCall.typestateErrors)
	    -- problems... stash away the errors
	    for error in errors[] inspect
	      block declare
		procError: procError;
	      begin
		new procError;
		procError.procID := proc.id;
		procError.error := error;
		insert procError into procErrors;
	      end block;
	    end for;
	  end block;
	end for;
	-- stop now if any errors were reported
	if B(I(size of procErrors) <> ZERO) then
	  exit errors;
	end if;
      end if;
#endif TSBOOT

      ---------------- Code Generation ----------------
      if B(B(not B(exists of options[S("noobject")]))
	      or B(exists of options[S("ligen")])) then
	call putString(S(" codegen"));
	if B(codegen = fakeCodegen) then
	  codegen <- codegenFn#(procedure of program#(
	      args.std.pathLoad(S("codegen"))));
	end if;
	block declare
	  annotes: annotations;
	  annote: annotation;
	begin
	  -- Construct annotations for the codegen process
	  new annotes;

	  new annote;
	  annote.name <- S("Module Name");
	  wrap S(copy of modName) as annote.thing;
	  insert annote into annotes;

	  new annote;
	  annote.name <- S("Linked Programs");
	  wrap links as annote.thing;
	  insert annote into annotes;
	  
	  new annote;
	  annote.name <- S("Inferred Definitions");
	  wrap infDefs as annote.thing;
	  insert annote into annotes;
	  
#ifndef TSBOOT
	  new annote;
	  annote.name <- S("Coercions");
	  wrap coercions as annote.thing;
	  insert annote into annotes;
#endif TSBOOT  
	  
	  new annote;
	  annote.name <- S("Process Print Map");
	  wrap predefined!executable_printmappings#(copy of procMaps)
	      as annote.thing;
	  insert annote into annotes;
	  
	  new annote;
	  annote.name <- S("Definitions Print Map");
	  wrap predefined!definitions_printmappings#(copy of defMaps)
	      as annote.thing;
	  insert annote into annotes;
	  
	  call codegen(absprog, annotes, options, args.std, args.unix.stdio);

	  if B(not B(exists of options[S("noobject")])) then
	    call putString(S(S(" store[") | S(modName | S(".po]"))));
	    block begin
#ifdef CGBOOT
	      call args.std.store(S(modName | S(".po")), absprog);
#else
	      call args.std.libStore(modName, absprog);
#endif CGBOOT
	    on (others)
	      call putLine(S("ERRORS"));
	      call putLine(
		S(S(S("Problems writing program object file '")
			| S(modName | S(".po"))) | S("'")));
	      exit failed;
	    end block;
	  end if;
	end block;
      end if;
      
#ifndef ANYBOOT
      if B(exists of options[S("ligen")]) then
	block declare
	  disasmPMap: disassembler!printmaps;
	  source: charString;
	  LIfile: unix!handle;
	  retcode: unix!int;
	begin
	  call putString(S(" disassemble"));
	  if B(disasm = fakeDisasm) then
	    disasm <- disassemblerFn#(procedure of program#(
		args.std.pathLoad(S("disassembler"))));
	  end if;
	  if B(LIUnstuff = fakeLIUnstuff) then
	    LIUnstuff <- LIUnstuffFn#(procedure of program#(
		args.std.pathLoad(S("liunstuff"))));
	  end if;
	  new disasmPMap;
	  disasmPMap.execs <- procMaps;
	  disasmPMap.defs <- defMaps;
	  unite disasmPMap.progid.pid
	      from processid#(copy of absprog.main_program);
	  block begin
	    source <- S(disasm(interpform!prog#(LIUnstuff(absprog)),
		args.std, disasmPMap));
	  on (others)
	    call putLine(S(" ERRORS"));
	    call putLine(S("Disassembly failed"));
	    exit failed;
	  end block;

	  call putString(S(S(" write[") | S(modName | S(".li]"))));
	  block begin
	    LIfile <- unix!handle#(
	      args.unix.stdio.fopen(S(modname | S(".li")), S("w")));
	    retcode <- unix!int#(args.unix.stdio.fputs(source, LIfile));
	    call args.unix.stdio.fclose(LIfile);
	  on (others)
	    call putLine(S(" ERRORS"));
	    call putLine(S("Problems writing LI source file"));
	    exit failed;
	  end block;
	end block;
      end if;
      
#endif ANYBOOT

      call putLine(S(""));

#ifndef CGBOOT
    on exit (parseErrors)
      -- Here when there were parsing errors... we need to fake the
      -- normal arguments for formatError since we never got to the
      -- point of having a correct absprog (yuck!)
      call putLine(S(" ERRORS"));
      if B(formatError = fakeFormatError) then
	formatError <- formatErrorFn#(procedure of program#(
	    args.std.pathLoad(S("formaterror"))));
      end if;
      block declare
	scopes: scopes;
	defmods: definitions_modules;
	procMap: executable_printmap;
	posMaps: posMaps;
      begin
	new scopes;
	new defmods;
	new defMaps;
	new procMap;
	unite procMap.id.pid from processid#unique;
	new procMap.name;
	new procMap.roots;
	new procMap.exits;
	new posMaps;
	for error in errors[] inspect
	  block declare
	    msg: charString;
	  begin
	    msg <- charstring#(
	      formatError(error, scopes, infDefs, defmods, defMaps,
		procMap, posMaps));
	    call putLine(msg);
	  end block;
	end for;
      end block;
      call putLine
	  (S(S(S("Suppressing further processing for module '") | modName)
	      | S("'.")));
#endif CGBOOT

#ifndef TCBOOT
    on exit (errors)
      -- Here when there are type or typestate errors to report
      call putLine(S(" ERRORS"));
      if B(formatError = fakeFormatError) then
	formatError <- formatErrorFn#(procedure of program#(
	    args.std.pathLoad(S("formaterror"))));
      end if;
      for procError in procErrors[] inspect
	block declare
	  eid: executable_id;
	  msg: charString;
	begin
	  unite eid.pid from processid#(copy of procError.procID);
	  inspect proc in absprog.programs[procError.procID] begin
	    inspect procMap in procMaps[eid] begin
	      inspect posMap in posMappings[eid] begin
		msg <- charString#(
		  formatError(procError.error, proc.executable_part.scopes,
		    infDefs, absprog.definitions_modules, defMaps,
		    procMap, posMap.mapping));
		call putLine(msg);
	      end inspect;
	    end inspect;
	  end inspect;
	end block;
      end for;
      call putLine
	  (S(S(S("Suppressing further processing for module '") | modName)
	      | S("'.")));
#endif TCBOOT

    on exit (failed)
      -- Here when a module failed one of the processing phases
      call putLine
	  (S(S(S("Suppressing further processing for module '") | modName)
	      | S("'.")));
      
    end block;
  end for;
  
  -- all finished
  return args;
end process
