-- (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, load, unix, CLoad,
  stdenv
#ifndef NOFIX
      , fixdefs, checkdefs, positions
#endif
)
process (q: mainQ)

declare
  args: main;
  fns: parseFns;
  capability: polymorph;
  initParse: initParseDefFn;
  parse: parseDefFn;
  getFileInit: getFileInitFunc;
  getFile: getFileFunc;
  argv: charstringList;
  putString: putStringFunc;
  putLine: putStringFunc;
  formatError: formatErrorFn;
  fakeFormatError: formatErrorFn;
  stdenv: stdenv;
  CLoad: CLoadFn;
  stdio: stdio;
  
#ifndef NOFIX
  fixabbrevs: FixdefsOutport;
  shorten: FixdefsOutport;
  checkdefs: checkdefsFn;
  debug: boolean;
#endif
begin
  receive args from q;
    
  -- Get some capabilities we need from the resource manager
  unwrap CLoad from polymorph#(args.rm.get(S("CLoader"), S(""))) {init};
  unwrap stdio from polymorph#(args.rm.get(S("stdio"), S(""))) {
    init, init(fopen) };

  -- build up stdenv to pass to modules that were written with the old
  -- main interface in mind.  For CGBOOT the stdenv is not completely
  -- initialized, though our interfaces say it is.
  new stdenv;
  unwrap stdenv.load from polymorph#(args.rm.get(S("load"), S(""))) {init};
  unwrap stdenv.pathLoad from polymorph#(args.rm.get(S("pathLoad"), S("")))
      {init};
  unwrap stdenv.readObj from polymorph#(args.rm.get(S("readObj"), S(""))) 
      {init};
  unwrap stdenv.pathReadObj from polymorph#(
    args.rm.get(S("pathReadObj"), S(""))) {init};
  unwrap stdenv.writeObj from polymorph#(args.rm.get(S("writeObj"), S(""))) 
      {init};
  unwrap stdenv.store from polymorph#(args.rm.get(S("store"), S(""))) {init};

#ifndef CGBOOT
  unwrap stdenv.libWriteObj from polymorph#(
    args.rm.get(S("libWriteObj"), S(""))) {init};
  unwrap stdenv.libStore from polymorph#(args.rm.get(S("libStore"), S(""))) 
      {init};
  unwrap stdenv.getCwd from polymorph#(args.rm.get(S("getCwd"), S(""))) {init};
  unwrap stdenv.setCwd from polymorph#(args.rm.get(S("setCwd"), S(""))) {init};
  stdenv.terminal := args.terminal;
#endif CGBOOT

#ifndef NOFIX
  fixabbrevs <- fixdefsOutport#(procedure of program#(
      stdenv.pathLoad(S("abbrev_expand"))));
  shorten <- fixdefsOutport#(procedure of program#(
      stdenv.pathLoad(S("do_shorten"))));
  checkdefs := checkDefsFn#(procedure of program#(
      stdenv.pathLoad(S("checkdefs"))));
#endif
  block declare
    fmtIn: formatErrorQ;
  begin
    new fmtIn;
    connect fakeFormatError to fmtIn;
    formatError := fakeFormatError;
  end block;
  
  getFileInit := getFileInitFunc#(create of program#(
      stdenv.pathLoad(S("getfile"))));
  getFile := getFileFunc#(getFileInit(stdio.fopen));
  
  putString := args.terminal.putString;
  putLine := args.terminal.putLine;
  
  capability := polymorph#(CLoad(S("Parse Def")));
  unwrap initParse from capability { init };
  
  new fns;
  fns.load := stdenv.pathLoad;
  fns.store := stdenv.libStore;
  fns.readObj := stdenv.pathReadObj;
  fns.writeObj := stdenv.libWriteObj;
  fns.getCwd := stdenv.getCwd;
  
  parse := parseDefFn#(initParse(fns));
  
  argv := args.argv;
#ifndef ANYBOOT
  debug := B('false');
#endif
  for fileN in argv where (B(I(position of fileN) >= I(2))) inspect
    block declare
      fileName: charString;
      modName: charString;
      pathName: charString;
      errors: errors;
      file: charstring;
      filedef: filed_definition;
      object: polymorph;
      id: moduleid;
      defs: definitions_modules;
      maps: definitions_printmappings;
      predef_defmod_typename: predefined!typename;
      predef_program_typename: predefined!typename;
      thismodule: predefined!definitions_module;
    begin
      
      -- extract module name by stripping leading path components
#ifdef ANYBOOT
      fileName := fileN;
      modName := fileName;
#else      
      if fileN = "-d" then
          debug := not debug;
          exit failed;
        end if;
      
      
      -- strip leading cwd and/or trailing .d
      block
        declare
          fileNcopy: charstring;
          junk: charstring;
	  cwd: charstring;
        begin
          fileNcopy := fileN;
	  cwd <- stdenv.getCwd();
          extract junk from c in fileNcopy where 
	      (position of c >= size of fileNcopy - 2);
          if (junk = ".d") then
              fileName := fileNcopy;
            else
              fileName := fileN;
            end if;
	  fileNcopy := fileName;
	  extract junk from c in fileNcopy where
	      (position of c <= size of cwd);
	  if (junk = cwd | "/") then
	      fileName := fileNCopy;
	    end if;
        end block;
	
      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(fns.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;
    
    remove thismodule from defs[id];

#ifndef NOFIX
    -- initialize the typenames from predefined
    if modName = "predefined" then
        inspect def_map in maps[id]
          begin
            new predef_defmod_typename;
            predef_defmod_typename.moduleid := id;
            new predef_program_typename;
            predef_program_typename.moduleid := id;
            block
              begin
                inspect defmod_printrec in def_map.types where
                       (defmod_printrec.name = "definitions_module")
                  begin
                    predef_defmod_typename.typeid := defmod_printrec.id;
                  end inspect;
                inspect program_printrec in def_map.types where
                       (program_printrec.name = "program")
                  begin
                    predef_program_typename.typeid := program_printrec.id;
                  end inspect;
              on (NotFound)
                block
                  declare
                    error: error;
                    errObj: errorObject;
                  begin
                    new errors;
                    new error;
                    error.code := 'general error';
                    unite error.position.apos from 
                      (evaluate pos: aposition from
                            new pos; 
                            pos.clause := unique;
                            pos.statement := unique;
                          end);
                    new error.objects;
                    unite errObj.charstring from
                    "definitions module 'predefined' without type definitions for 'program' and 'definitions_module'";
                    insert errObj into error.objects;
                    insert error into errors;
                    exit errors;
                  end block;
              end block;
          end inspect;
      else
        predef_defmod_typename := \typename predefined!definitions_module\;
        predef_program_typename := \typename predefined!program\;
      end if;
    
    
    -- expand abbreviations
    call putString((predefined!charstring#(" fixabbrevs")));
    call fixabbrevs(stdenv, thismodule, defs, errors);
    if (predefined!boolean#((predefined!integer#(size of errors)) 
                   <> (predefined!integer#0))) then
        exit errors;
      end if;

    if debug then
        print thismodule;
      end if;

    -- run checkdefs on it
    call putString((predefined!charstring#(" checkdefs")));
    call checkdefs(stdenv, thismodule, defs, 
          (evaluate typenames: checkdefs!typename_rec from
                new typenames;
                typenames.defmod := predef_defmod_typename;
                typenames.program := predef_program_typename;
              end),
        errors);
    if (predefined!boolean#((predefined!integer#(size of errors)) 
                   <> (predefined!integer#0))) then
        exit errors;
      end if;

    -- do the shortening
    call putString((predefined!charstring#(" shorten")));
    call shorten(stdenv, thismodule, defs, errors);
    if (predefined!boolean#((predefined!integer#(size of errors)) 
                   <> (predefined!integer#0))) then
        exit errors;
      end if;
    
#endif
    -- fix up filedef now that checkdefs is finished
      filedef.definitions_module <- thismodule;
      filedef.defmap <- definitions_printmap#(maps[id]);
      
      -- write it out
      
      call putString(S(S(" store[") | S(modName | S(".do]"))));
      wrap filedef as object;
      
      block begin
#ifdef CGBOOT
	call stdenv.store(S(modName | S(".po")), object);
#else      
	call stdenv.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#(
	      stdenv.pathLoad(S("formaterror"))));
      end if;
      block declare
          scopes: scopes;
          infDefs: inferredDefinitions;
          defMaps: definitions_printmappings;
          procMap: executable_printmap;
          posMaps: posMaps;
        begin
          -- need to make some fake stuff for formatError (yuck!)
          new scopes;
          new infDefs;
          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, defs, maps,
                          procMap, posMaps, stdenv.pathLoad));
                  call putLine(S(fileName | S(S(": ") | msg)));
                end block;
            end for;
        end block;
      
    on exit(failed)
      -- some failure that already wrote its error messages
      -- or we've just toggled debug printing
    end block;
  end for;  /* fileN */
  
  return args;
end process
