-- CIFSInterface.mesa
-- last modified by Satterthwaite, May 10, 1983 9:04 am

DIRECTORY
  CharIO: TYPE USING [NumberFormat, CR, PutChar, PutDecimal, PutLine, PutNumber, PutString],
  CIFS: TYPE USING [OpenFile, Close, Delete, Error, GetFC, Open, read],
  CommandUtil: TYPE USING [
    PairList, CommandObject, CommandPtr, CopyString, Echo, Failed,
    FreePairList, FreeString, GetNth, ListLength, Parse, SetExtension],
  CompilerOps: TYPE USING [
    LetterSwitches, StreamId, Transaction,
    AppendHerald, DefaultSwitches, DoTransaction, Punt, Start, Stop],
  ConvertUnsafe: TYPE USING [ToRope],
  ExecOps: TYPE USING [Command, Outcome],
  Feedback: TYPE USING [Handle, Procs, ProcsHandle],
  File: TYPE USING [Capability, nullCapability],
  FileParms: TYPE USING [BindingProc, nullActual],
  FileParmOps: TYPE USING [ClearAList, Finalize, Initialize, SetAList],
  FileStream: TYPE USING [Create, GetLeaderProperties, SetLength],
  Heap: TYPE USING [Create, Delete],
  Inline: TYPE USING [DIVMOD, LongDivMod],
  IO: TYPE USING [UserAborted],
  OSMiscOps: TYPE USING [DeleteFile, FindFile],
  Stream: TYPE USING [Delete, Handle],
  String: TYPE USING [AppendDecimal],
  Strings: TYPE USING [String, SubStringDescriptor, AppendChar, AppendString],
  TemporarySpecialExecOps: TYPE USING [],
  Time: TYPE USING [Packed, AppendCurrent, Current],
  TimeStamp: TYPE USING [Null];

CIFSInterface: PROGRAM []
   IMPORTS
      CharIO, CIFS, CommandUtil, CompilerOps, ConvertUnsafe, FileStream,
      FileParmOps, Heap, Inline, IO, OSMiscOps, Stream, String, Strings, Time
   EXPORTS ExecOps, TemporarySpecialExecOps = { 

  Command: TYPE = ExecOps.Command;
  StreamHandle: TYPE = Stream.Handle;


-- feedback control

  feedback: Feedback.ProcsHandle;
  fbh: Feedback.Handle ← NIL;
  feedbackGoing: BOOL;
  userAbort: BOOL;	-- set by ↑DEL
  useLog: BOOL;		-- for compiler.log for error reporting
  

-- command line input control

  commandObject: CommandUtil.CommandObject ← [pos: 0, len: 0, data: NIL];
  commandPtr: CommandUtil.CommandPtr ← @commandObject;

  SetCommandInput: PROC [cmd: Command] = {
    commandObject.pos ← 0;
    commandObject.data ← cmd;
    FOR i: CARDINAL IN [0..CARDINAL.LAST] DO
      c: CHAR = commandObject.data[i];
      IF c # 11c AND c < 40c THEN {commandObject.len ← i; RETURN};
      ENDLOOP};  


-- special output stream control

  log: StreamHandle ← NIL;

  GetCompilerLog: PUBLIC PROC RETURNS [StreamHandle] = {RETURN [log]};

  SetTypescript: PROC = {IF log = NIL THEN log ← NewOutputStream["Compiler.Log"L]};

  NewLine: PROC = {CharIO.PutChar[log, CharIO.CR]};

  NewOutputStream: PROC [s: Strings.String] RETURNS [stream: StreamHandle] = {
    file: File.Capability;
    file ← OSMiscOps.FindFile[s, $write];
    stream ← FileStream.Create[file];
    FileStream.SetLength[stream, 0]}; 

  CIFSInputStream: PROC [file: CIFS.OpenFile] RETURNS [StreamHandle] = {
    RETURN [IF file # NIL THEN FileStream.Create[CIFS.GetFC[file]] ELSE NIL]};


  WriteHerald: PROC [s: StreamHandle, id: Strings.String] = {
    OPEN CharIO;
    herald: STRING ← [60];
    CompilerOps.AppendHerald[herald];
    PutLine[s, herald];
    IF ~feedbackGoing AND feedback.create # NIL THEN
      fbh ← feedback.create[system: "Compiler"L, herald: herald];
    feedbackGoing ← TRUE;
    IF id # NIL THEN {PutString[s, id]; PutString[s, " -- "L]};
    herald.length ← 0; Time.AppendCurrent[herald]; PutLine[s, herald]};

  WriteTime: PROC [time: LONG CARDINAL] = {
    OPEN CharIO;
    hr, min, sec: CARDINAL;
    f: NumberFormat ← [base: 10, unsigned: TRUE, zerofill: FALSE, columns: 1];
 
    W: PROC [t: CARDINAL] = {
      IF t # 0 OR f.zerofill THEN {
	PutNumber[log, t, f]; PutChar[log, ':];
	f ← [base: 10, unsigned: TRUE, zerofill: TRUE, columns: 2]}};
    
    [min, sec] ← Inline.LongDivMod[time, 60];
    [hr, min] ← Inline.DIVMOD[min, 60];
    W[hr]; W[min]; PutNumber[log, sec, f]};


  ErrorInit: PROC = {
    IF errorStream = NIL THEN
      IF useLog THEN errorStream ← log
      ELSE {
	errorName ← MakeErrorName[rootName];
	errorStream ← NewOutputStream[errorName];
	WriteHerald[errorStream, errorName];
	CharIO.PutChar[errorStream, CharIO.CR]}};

  MakeErrorName: PROC [root: Strings.String] RETURNS [Strings.String] = {
    RETURN [CommandUtil.SetExtension[
	      CommandUtil.CopyString[root, 2+("errlog"L).length],
	      "errlog"L]]};

  GetStream: PROC [id: CompilerOps.StreamId] RETURNS [s: Stream.Handle] = {
    SELECT id FROM
      $source => s ← sourceStream;
      $object => ERROR;	-- should be obtained from CIFSFileParmPack
      $log => {IF errorStream = NIL THEN ErrorInit[]; s ← errorStream};
      ENDCASE => ERROR;
    RETURN};


-- compiler sequencing

  Initialize: PROC = {
    sourceFile ← CIFS.Open[ConvertUnsafe.ToRope[sourceName], CIFS.read];
    parms.sourceStream ← sourceStream ← CIFSInputStream[sourceFile];
    parms.source.version ← TimeStamp.Null;
    parms.source.version.time ← FileStream.GetLeaderProperties[sourceStream].create};

  Finalize: PROC [started: BOOL] = {
    IF objectStream # NIL THEN Stream.Delete[objectStream];
    IF sourceStream # NIL THEN Stream.Delete[sourceStream];
    IF errorStream # NIL AND errorStream # log THEN Stream.Delete[errorStream];
    objectStream ← sourceStream ← errorStream ← NIL;
    IF sourceFile # NIL THEN CIFS.Close[sourceFile];
    sourceFile ← NIL;
    IF parms.nErrors # 0 AND started THEN
      CIFS.Delete[ConvertUnsafe.ToRope[objectName] ! CIFS.Error => TRUSTED {CONTINUE}];
    IF errorName = NIL THEN {
      errorName ← MakeErrorName[rootName]; OSMiscOps.DeleteFile[errorName]}};

  WriteErrlogName: PROC = {
    IF useLog OR log = NIL THEN RETURN;
    CharIO.PutString[log, " on "L];
    CharIO.PutString[log, rootName]; CharIO.PutString[log, ".errlog"L]};

  WriteClosing: PROC [startTime: Time.Packed] = {
    OPEN CharIO;
    PutString[log, sourceName];  PutString[log, " -- "L];
    IF parms.nErrors # 0 THEN {
      errors ← TRUE;  PutString[log, "aborted, "L];
      PutDecimal[log, parms.nErrors];  PutString[log, " errors"L];
      IF parms.nWarnings # 0 THEN {
	warnings ← TRUE;  PutString[log, " and "L];
	PutDecimal[log, parms.nWarnings];  PutString[log, " warnings"L]};
      WriteErrlogName[];
      PutString[log, ", time: "L];
      WriteTime[Time.Current[]-startTime]}
    ELSE {
      PutString[log, "source tokens: "L];
      PutDecimal[log, parms.sourceTokens];
      PutString[log, ", time: "L];
      WriteTime[Time.Current[]-startTime];
      IF parms.objectBytes # 0 THEN {
	NewLine[]; 
	PutString[log, "  code bytes: "L]; PutDecimal[log, parms.objectBytes];
	PutString[log, ", links: "L]; PutDecimal[log, parms.linkCount];
	PutString[log, ", frame size: "L];
	PutDecimal[log, parms.objectFrameSize];
	IF parms.matched THEN PutChar[log, '.]};
      IF parms.nWarnings # 0 THEN {
	warnings ← TRUE;  NewLine[];
	PutDecimal[log, parms.nWarnings];  PutString[log, " warnings"L];
	WriteErrlogName[]}};
    IF feedback.finishItem # NIL THEN {
      outcome: ExecOps.Outcome =
	SELECT TRUE FROM
	  userAbort => aborted,
	  parms.nErrors # 0 => IF parms.nWarnings # 0 THEN errorsAndWarnings ELSE errors,
	  parms.nWarnings # 0 => warnings,
	  ENDCASE => ok;
      msg: STRING ← [30];
      IF parms.nErrors = 0 THEN Strings.AppendString[msg, "no"L]
      ELSE String.AppendDecimal[msg, parms.nErrors];
      Strings.AppendString[msg, " errors"L];
      IF parms.nWarnings # 0 THEN {
	Strings.AppendString[msg, ", "L];
	String.AppendDecimal[msg, parms.nWarnings];
	Strings.AppendString[msg, " warnings"L]};
      feedback.finishItem[fbh, outcome, msg]}};

  StopCompiler: PROC [startTime: Time.Packed] = {
    IF feedback.destroy # NIL THEN feedback.destroy[fbh, "End of compilation"L];
    IF moduleCount > 1 THEN {
      NewLine[]; CharIO.PutString[log, "Total elapsed time: "L];
      WriteTime[Time.Current[]-startTime]};
    NewLine[]; Stream.Delete[log]; log ← NIL};

  transaction: CompilerOps.Transaction;
  parms: POINTER TO CompilerOps.Transaction = @transaction;

  standardDefaults: CompilerOps.LetterSwitches = CompilerOps.DefaultSwitches[];
  switchDefaults: CompilerOps.LetterSwitches;

  sourceName, objectName, errorName: Strings.String ← NIL;
  rootName: Strings.String ← NIL;
  sourceFile: CIFS.OpenFile ← NIL;
  sourceStream, objectStream, errorStream: StreamHandle ← NIL;

  errors, warnings: BOOL ← FALSE;
  moduleCount: CARDINAL;

  SetRoot: PROC [s: Strings.String] RETURNS [root: Strings.String] = {
    root ← CommandUtil.CopyString[s];
    FOR i: CARDINAL IN [0..s.length) DO
      IF s[i] = '. THEN {root.length ← i; EXIT};
      ENDLOOP};


  -- * * * * * *  M A I N   B O D Y   C O D E  * * * * * *

  Compile: PUBLIC PROC [cmd: Command] RETURNS [outcome: ExecOps.Outcome] = {
    fProcs: Feedback.Procs ← [];	-- all NIL
    RETURN [CompileUsingFeedback[cmd, @fProcs]]};


  CompileUsingFeedback: PUBLIC PROC [cmd: Command, feedbackProcs: Feedback.ProcsHandle]
      RETURNS [ExecOps.Outcome] = {

    StartPass: PROC [pass: CARDINAL] RETURNS [goOn: BOOL] = {
      IF feedback.noteProgress # NIL THEN
        feedback.noteProgress[fbh, pass ! IO.UserAborted => {userAbort ← TRUE; CONTINUE}];
      RETURN [~userAbort]};

    compilerStartTime, moduleStartTime: Time.Packed;
    scratchZone: UNCOUNTED ZONE ← Heap.Create[initial: 8, increment: 8];
    
    fbh ← NIL; feedbackGoing ← FALSE;
    switchDefaults ← CompilerOps.DefaultSwitches[];
    parms.fileParms ← FileParmOps.Initialize[scratchZone];
    CompilerOps.Start[scratchZone];

    compilerStartTime ← Time.Current[];
    moduleCount ← 0;
    userAbort ← FALSE;

    -- do the compilation

    SetCommandInput[cmd];  SetTypescript[];
    feedback ← feedbackProcs;
    WriteHerald[log, NIL];  -- starts feedback stuff also
    errors ← warnings ← FALSE;

    DO
      args, results: CommandUtil.PairList;
      switches: Strings.String ← NIL;
      localPause: BOOL;
      sense: BOOL;

        BEGIN OPEN CharIO;
        parms.switches ← switchDefaults;  parms.switches['p] ← FALSE;
        parms.debugPass ← CARDINAL.LAST;
        parms.getStream ← GetStream;  parms.startPass ← StartPass;
        parms.objectBytes ← 0;  parms.objectFrameSize ← 0;  parms.linkCount ← 0;
        parms.nErrors ← 0;  parms.nWarnings ← 0;
        parms.sourceTokens ← 0;
        [sourceName, args, results, switches] ←
	  CommandUtil.Parse[
		s: commandPtr,
		opX: 2+("mesa"L).length, resultX: 2+("bcd"L).length
	    ! CommandUtil.Failed => {GO TO badSyntax}];
        IF sourceName = NIL AND switches = NIL THEN EXIT;
        NewLine[];  PutString[log, "Command: "L];
        CommandUtil.Echo[log, sourceName, args, results, switches];
        IF CommandUtil.ListLength[results] > 1 THEN GO TO badSemantics;
        IF sourceName = NIL THEN GO TO globalSwitches;
        rootName ← SetRoot[IF CommandUtil.ListLength[results] = 1
	                     THEN CommandUtil.GetNth[results, 0]
	                     ELSE sourceName];
        IF switches # NIL THEN {
	  sense ← TRUE;
	  FOR i: CARDINAL IN [0..switches.length) DO
	    c: CHAR = switches[i];
	    SELECT c FROM
	      '-, '~ => sense ← ~sense;
	      IN ['a..'z] => {parms.switches[c] ← sense; sense ← TRUE};
	      IN ['A..'Z] => {
		parms.switches[c+('a-'A)] ← sense; sense ← TRUE};
	      IN ['1..'5] => {parms.debugPass ← c-'0; sense ← TRUE};
	      ENDCASE;
	    ENDLOOP;
	  switches ← CommandUtil.FreeString[switches]};
      
      sourceName ← CommandUtil.SetExtension[sourceName, "mesa"L];
      parms.source.locator ← [sourceName, 0, sourceName.length];

      IF CommandUtil.ListLength[results] # 0 THEN {
	objectName ← CommandUtil.GetNth[list: results, n: 0, delete: TRUE];
	results ← CommandUtil.FreePairList[results]}
      ELSE objectName ← CommandUtil.CopyString[rootName, 2+("bcd"L).length];
      objectName ← CommandUtil.SetExtension[objectName, "bcd"L];
      parms.objectName ← CommandUtil.CopyString[objectName];
      parms.objectFile ← File.nullCapability;

      moduleCount ← moduleCount + 1;

      IF feedback.beginItem # NIL THEN {
	item: Strings.String ← CommandUtil.CopyString[NIL, rootName.length + 12 + 53];
	first: BOOL ← TRUE;
	Strings.AppendString[item, "Compiling: "L]; Strings.AppendString[item, rootName];
	FOR c: CHAR IN ['a..'z] DO
	  sd: BOOL = IF c = 'p THEN FALSE ELSE standardDefaults[c];
	  IF parms.switches[c] # sd THEN {
	    IF first THEN {first ← FALSE; Strings.AppendChar[item, '/]};
            IF sd THEN Strings.AppendChar[item, '-];
            Strings.AppendChar[item, c]};
	  ENDLOOP;
	feedback.beginItem[fbh, item];
	item ← CommandUtil.FreeString[item]};
      useLog ← parms.switches['g];  parms.switches['g] ← FALSE;
      localPause ← parms.switches['p];  parms.switches['p] ← FALSE;

      Initialize[ ! ANY => {GOTO noSource}];
      FileParmOps.SetAList[args];
      -- pattern for replacement
        BEGIN
	
	BindPattern: FileParms.BindingProc = {
	  parms.pattern ← actual;
	  parms.op ← IF actual = FileParms.nullActual THEN $compile ELSE $replace};
	  
	parms.fileParms.Binding[
	  formalId: ["$"L, 0, 1], formalType: [NIL, 0, 0], binder: BindPattern];
	END;

      NewLine[];  moduleStartTime ← Time.Current[];
      CompilerOps.DoTransaction[parms ! CompilerOps.Punt => {GO TO punt}];
      Finalize[TRUE];
      FileParmOps.ClearAList[];
      WriteClosing[moduleStartTime];

      EXITS
	globalSwitches => {
	  objectName ← NIL;
	  sense ← TRUE;
	  FOR i: CARDINAL IN [0..switches.length) DO
	    c: CHAR = switches[i];
	    SELECT c FROM
	      '-, '~ => sense ← ~sense;
	      IN ['a..'z] => {switchDefaults[c] ← sense; sense ← TRUE};
	      IN ['A..'Z] => {switchDefaults[c+('a-'A)] ← sense; sense ← TRUE};
	      ENDCASE => EXIT;
	    ENDLOOP;
	  switches ← CommandUtil.FreeString[switches];
	  args ← CommandUtil.FreePairList[args]};
	noSource => {
          PutString[log, " -- source not found\n"L];
	  errors ← TRUE;  parms.nErrors ← 1;
	  WriteClosing[Time.Current[]];
	  args ← CommandUtil.FreePairList[args]};
	badSemantics => {
	  objectName ← NIL; errors ← TRUE;
          PutString[log, " -- Illegal command"L];
	  args ← CommandUtil.FreePairList[args]};
      END;

    sourceName ← CommandUtil.FreeString[sourceName];
    rootName ← CommandUtil.FreeString[rootName];
    objectName ← CommandUtil.FreeString[objectName];
    parms.objectName ← CommandUtil.FreeString[parms.objectName];
    errorName ← CommandUtil.FreeString[errorName];
    results ← CommandUtil.FreePairList[results];
    NewLine[];
    IF userAbort THEN {
      NewLine[]; CharIO.PutString[log, "... command aborted"L]; NewLine[];
      GO TO truncateList};
    IF (errors OR warnings) AND localPause THEN GO TO truncateList;

    REPEAT
      badSyntax => {
	NewLine[]; CharIO.PutString[log, "-- Illegal syntax"L]; errors ← TRUE};
      truncateList => switchDefaults['p] ← TRUE;
      punt => {Finalize[TRUE]; WriteClosing[moduleStartTime]; NewLine[]};
    ENDLOOP;

    StopCompiler[compilerStartTime];
    CompilerOps.Stop[];
    FileParmOps.Finalize[];
    Heap.Delete[scratchZone];
    RETURN [SELECT TRUE FROM
      userAbort => aborted,
      errors => errors,
      warnings => warnings,
      ENDCASE => ok]};

  }.