-- (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: dcom.p
-- Author: David F. Bacon and Rob Strom
-- SCCS Info: @(#)dcom.p	1.2 7/26/89

#include "typemark.h"

-- exclude fixdefs if we're in any boot phase
#ifdef CGBOOT
#  define NOFIX
#endif
#ifdef TCBOOT
#  define NOFIX
#endif
#ifdef TSBOOT
#  define NOFIX
#endif
#ifdef NOFIX
#  define ANYBOOT
#endif

dCom: using (parse, initParse, main, errors, common, getFile, fileDef,
  terminalIO, formatError, inferredType, posmap
#ifndef NOFIX
      , fixdefs, checkdefs
#endif
)
process (q: main_q)

declare
  args: main_intf;
  fns: parseFns;
  capability: polymorph;
  initParse: initParseDefFn;
  parse: parseDefFn;
  getFileInit: getFileInitFunc;
  getFile: getFileFunc;
  argv: charstringList;
  putString: putStringFunc;
  putLine: putStringFunc;
  formatError: formatErrorFn;
  fakeFormatError: formatErrorFn;
  
#ifndef NOFIX
  fix: FixdefsOutport;
  checkdefs: checkdefsFn;
#endif
  
begin
  receive args from q;
    
#ifndef NOFIX
  fix <- fixdefsOutport#(procedure of program#(
      args.std.pathLoad(S("fixdefsint"))));
  checkdefs := checkDefsFn#(procedure of program#(
      args.std.pathLoad(S("checkdefs"))));
#endif
  block declare
    fmtIn: formatErrorQ;
  begin
    new fmtIn;
    connect fakeFormatError to fmtIn;
    formatError := fakeFormatError;
  end block;
  
  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));
  
  putString := args.std.terminal.putString;
  putLine := args.std.terminal.putLine;
  
  capability := polymorph#(args.CLoader(S("Parse Def")));
  unwrap initParse from capability { 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 := parseDefFn#(initParse(fns));
  
  argv := args.argv;
  
  for fileName in argv where (B(I(position of fileName) >= I(2))) inspect
    block declare
      modName: charString;
      pathName: charString;
      errors: errors;
      file: charstring;
      filedef: filed_definition;
      object: polymorph;
      id: moduleid;
      defs: definitions_modules;
      maps: definitions_printmappings;
    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(":")));
      
      -- build the definitions module with the parser
      call putString(S(S(" parse[") | S(fileName | S(".d]"))));
#ifndef ANYBOOT
      if fileName[0] = '/' then
#endif
	pathName := fileName;
#ifndef ANYBOOT	
      else
	pathName := S(S(S(args.std.getCwd()) | S("/")) | fileName);
      end if;
#endif ANYBOOT      
      file := S(getFile(S(pathName | S(".d"))));
      new filedef;
      call parse(file, S(fileName | S(".d")), id, defs, maps,
	filedef.procMaps, filedef.direct_imports, errors);
      
      if B(I(size of errors) <> ZERO) then
	exit errors;
      end if;
      
      filedef.definitions_module <- definitions_module#(defs[id]);
      filedef.defmap <- definitions_printmap#(maps[id]);

#ifndef NOFIX
      -- run checkdefs on it
      call putString(S(" checkdefs"));
      call checkdefs(id, defs, errors);
      if B(I(size of errors) <> ZERO) then
	exit errors;
      end if;
      
      -- run fixdefs on it
      call putString(S(" fixdefs"));
      call fix(args.std, filedef, defs);
#endif
      
      -- write it out
      
      call putString(S(S(" store[") | S(modName | S(".do]"))));
      wrap filedef as object;
      block begin
#ifdef CGBOOT
	call args.std.store(S(modName | S(".po")), object);
#else      
	call args.std.libWriteObj(S(modName | S(".do")), object);
#endif CGBOOT
      on (others)
	call putLine(S("ERRORS"));
	call putline(
	  S(S(S("Unable to write object file '") |
		  S(modName | S(".do"))) | S("'")));
	exit failed;
      end block;
      call putLine(S(""));
    on (getFile.cantRead)
      call putLine(S(" ERRORS"));
      call putLine(
	S(S(S("Unable to read source file '") | fileName) | S(".d'")));
    on exit (errors)
      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;
	infDefs: inferredDefinitions;
	defMods: definitions_modules;
	defMaps: definitions_printmappings;
	procMap: executable_printmap;
	posMaps: posMaps;
      begin
	-- need to make fake stuff for formatError (yuck!)
	new scopes;
	new infDefs;
	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;
      
    on exit(failed)
      -- some failure that already wrote its error messages
    end block;
  end for;
  
  return args;
end process
