-- TableControl.Mesa  Edited by Satterthwaite on August 29, 1980  1:33 PM

DIRECTORY
  AltoDisplay: TYPE USING [DCB, DCBHandle, DCBchainHead],
  AltoFileDefs: TYPE USING [CFA],
  BcdDefs: TYPE USING [BCD, VersionStamp],
  CharIO: TYPE USING [CR, SP, PutChar, PutDecimal, PutString],
  FrameOps: TYPE USING [CodeHandle, MyGlobalFrame],
  Inline: TYPE USING [LongDiv, LongMult],
  ImageDefs: TYPE USING [FileRequest, RunImage, StopMesa],
  MiscDefs: TYPE USING [CommandLineCFA],
  OsStaticDefs: TYPE USING [OsStatics],
  SegmentDefs: TYPE USING [
    Append, DefaultVersion, DeleteFileSegment, FileError, FileHandle, FileNameError,
    FileSegmentHandle, GetFileTimes, InsertFile, NewFile, NewFileSegment,
    Read, SegmentAddress, SwapIn, Unlock, Write],
  StreamDefs: TYPE USING [
    Append, CreateByteStream, JumpToFA,
    Read, StreamError, StreamHandle, Write],
  StringDefs: TYPE USING [
    AppendChar, AppendString, EquivalentString, MesaToBcplString,
    WordsForBcplString],
  TableCommand: TYPE USING [CompileStrings, MakeModule],
  TimeDefs: TYPE USING [AppendDayTime, DefaultTime, UnpackDT];

TableControl: PROGRAM
    IMPORTS
      CharIO, FrameOps, ImageDefs, Inline, MiscDefs, SegmentDefs,
      StreamDefs, StringDefs, TableCommand, TimeDefs
    EXPORTS TableCommand =
  BEGIN OPEN StreamDefs;

  CR: CHARACTER = CharIO.CR;

 -- cursor control

  CursorBits: TYPE = ARRAY [0..16) OF WORD;

  TheCursor: POINTER TO CursorBits = LOOPHOLE[431B];
  savedCursor: CursorBits;

  TableCursor: CursorBits = [
    177777b, 177777b, 177777b, 160007b,
    160007b, 160007b, 160007b, 160007b, 160007b, 160007b, 160007b, 160007b,
    160007b, 177777b, 177777b, 177777b];


 -- command gathering and logging

  log: StreamHandle;
  logName: STRING = "TableCompiler.Log.";
  logRequest: ImageDefs.FileRequest _ [
    name: logName, file: NIL, access: Write+Append, link: ];

  commandStream: StreamHandle;
  comCmRequest: ImageDefs.FileRequest _ [
    name: "Com.Cm.", file: NIL, access: Read, link: ];

  Rubout: ERROR = CODE;

  ReadCommand: PROC [name, switches: STRING] RETURNS [BOOLEAN] = {
    input: STRING _ [80];
    i: CARDINAL;
    activeString: STRING _ name;
    c: CHARACTER;
      DO
      c _ commandStream.get[commandStream ! StreamDefs.StreamError => EXIT];
      SELECT c FROM
        CharIO.SP => IF input.length # 0 THEN EXIT;
        CR => EXIT;
        ENDCASE => StringDefs.AppendChar[input, c];
      ENDLOOP;
    i _ name.length _ switches.length _ 0;
    WHILE i < input.length AND input[i] = CharIO.SP DO i _ i+1  ENDLOOP;
    --parse command--
    FOR i IN [i..input.length)
      DO
      SELECT (c_input[i]) FROM
        '/ => activeString _ switches;
        CharIO.SP, CR => EXIT;
        ENDCASE => StringDefs.AppendChar[activeString,c];
      ENDLOOP;
    FOR i IN [0..switches.length)
      DO -- convert all to lower case
      IF (c_switches[i]) IN ['A..'Z] THEN switches[i] _ c + ('a-'A);
      ENDLOOP;
    RETURN [name.length # 0 OR switches.length # 0]};
  
  DefaultFileName: PROC [name, defaultExtension: STRING] = {
    FOR i: CARDINAL IN [0..name.length) DO IF name[i] = '. THEN RETURN ENDLOOP;
    StringDefs.AppendString[name, defaultExtension]};

  input: {strings, binary};		-- compiling strings
  compact: BOOLEAN;
  dStar: BOOLEAN;
  
  sourceName: STRING _ [40];
  rootName: STRING _ [40];
  interfaceName: STRING _ [40];
  formatName: STRING _ [40];
  bcdName: STRING _ [40];

  GetCommand: PROC = {
    file: STRING _ [40];
    sw: STRING _ [10];
    i: CARDINAL;
    c: CHARACTER;
    done: BOOLEAN _ FALSE;
    sense: BOOLEAN;

    GetSwitch: PROC RETURNS [c: CHARACTER] = {
      sense _ TRUE;
      WHILE i < sw.length
	DO
        c _ sw[i];  i _ i + 1;
        IF c = '- OR c = '~ THEN sense _ ~sense ELSE EXIT;
        ENDLOOP;
      RETURN};

    sourceName.length _ bcdName.length _ interfaceName.length _ formatName.length _ 0;
    dStar _ FALSE;
    file.length _ 0;
    IF ~ReadCommand[file, sw] OR file.length = 0 THEN RETURN;
    DefaultFileName[file, ".mesa"L];
    IF ExtensionIs[file, ".mesa"L]
      THEN {input _ strings; compact _ TRUE}
      ELSE input _ binary; 
    i _ 0;
    WHILE i < sw.length DO
      SELECT (c_GetSwitch[]) FROM
        'a => dStar _ sense;
        'c => compact _ sense;
        'm => input _ binary;
        's => {input _ strings; compact _ FALSE};
        't => {input _ strings; compact _ TRUE};
        'g => done _ TRUE;
        'r => {
	  FOR j: CARDINAL IN [i..sw.length) DO sw[j-i] _ sw[j] ENDLOOP;
	  sw.length _ sw.length - i;
	  DefaultFileName[file, ".image"L];
	  Run[file, sw ! UNWIND => NULL; ANY => GO TO barf]};
	ENDCASE => GO TO barf;
      REPEAT
	barf => ERROR Rubout;
      ENDLOOP;
    StringDefs.AppendString[sourceName, file];
    WHILE ~done AND ReadCommand[file, sw] DO
      i _ 0;
      WHILE i < sw.length DO
        SELECT (c_GetSwitch[]) FROM
          'f => {
            DefaultFileName[file, ".format"L];
            formatName.length _ 0; StringDefs.AppendString[formatName, file]};
          'i => {
            DefaultFileName[file, ".bcd"L];
            interfaceName.length _ 0; StringDefs.AppendString[interfaceName, file]};
          'o => {
            DefaultFileName[file, ".bcd"L];
            bcdName.length _ 0; StringDefs.AppendString[bcdName, file]};
          'g => done _ TRUE;
          ENDCASE => ERROR Rubout;
        ENDLOOP;
      ENDLOOP};

  Run: PROC [name, otherSwitches: STRING] = {
    OPEN SegmentDefs;
    c: CHARACTER;
    i: CARDINAL;
    copy: StreamDefs.StreamHandle;
    copy _ StreamDefs.CreateByteStream[comCmRequest.file, Write+Append];
    FOR i IN [0..name.length) DO copy.put[copy, name[i]] ENDLOOP;
    IF otherSwitches.length # 0
      THEN {
	copy.put[copy, '/];
	FOR i IN [0..otherSwitches.length) DO copy.put[copy, otherSwitches[i]] ENDLOOP};
    copy.put[copy, ' ];
      DO
      c _ commandStream.get[commandStream ! StreamDefs.StreamError => GO TO done];
      copy.put[copy, c];
      REPEAT
	done => commandStream.destroy[commandStream];
      ENDLOOP;
    copy.destroy[copy];
    IF ExtensionIs[name, ".run"L]
      THEN {
	p: POINTER = OsStaticDefs.OsStatics.EventVector;
	EVItem: TYPE = MACHINE DEPENDENT RECORD [
	    type: [0..7777B], length: [0..17B]];
	p^ _ EVItem[6, StringDefs.WordsForBcplString[name.length]+1];
	StringDefs.MesaToBcplString[name, p+1];
	ImageDefs.StopMesa[]}
      ELSE ImageDefs.RunImage[
	NewFileSegment[NewFile[name, Read, DefaultVersion], 1, 1, Read]]};

  ExtensionIs: PROC [name, ext: STRING] RETURNS [BOOLEAN] = {
    t: STRING _ [40];
    IF name.length <= ext.length THEN RETURN[FALSE];
    FOR i: CARDINAL IN [name.length-ext.length .. name.length)
      DO  StringDefs.AppendChar[t,name[i]]  ENDLOOP;
    RETURN [StringDefs.EquivalentString[t,ext]]};

  RepeatCommand: PROC [s: StreamHandle] = {
    OPEN CharIO;
    PutChar[s, CR];
    SELECT input FROM
      strings => {
        PutString[s, "Compiling "L]; PutString[s, sourceName];
        PutString[s, ", exporting "L]; PutString[s, rootName];
        PutString[s, " to "L]; PutString[s, interfaceName];
	IF bcdName.length # 0
	  THEN {PutString[s, ", BCD to "L]; PutString[s, bcdName]};
	PutChar[s, CR];
	PutString[s, "Record format on "L]; PutString[s, formatName]};
      binary => {
        PutString[s, "Processing "L]; PutString[s, sourceName];
        PutString[s, ", exporting "L]; PutString[s, rootName];
        PutString[s, " to "L]; PutString[s, interfaceName];
	IF bcdName.length # 0
	  THEN {PutString[s, ", BCD to "L]; PutString[s, bcdName]}};
      ENDCASE;
    PutChar[s, CR]};


  CreateTime: PUBLIC PROC [s: StreamDefs.StreamHandle]
      RETURNS [time: LONG INTEGER] = {
    RETURN [WITH s: s SELECT FROM
      Disk => SegmentDefs.GetFileTimes[s.file].create,
      ENDCASE => 0]};

  MyBcdVersion: PUBLIC PROC RETURNS [version: BcdDefs.VersionStamp] = {
    OPEN SegmentDefs;
    cseg: FileSegmentHandle = FrameOps.CodeHandle[FrameOps.MyGlobalFrame[]];
    bcdseg: FileSegmentHandle = NewFileSegment[cseg.file, 1, 1, Read];
    bcd: POINTER TO BcdDefs.BCD;
    SwapIn[bcdseg];
    bcd _ SegmentAddress[bcdseg];
    version _ bcd.version;
    Unlock[bcdseg];  DeleteFileSegment[bcdseg];
    RETURN};


  WriteHerald: PROC [stream: StreamHandle, name: STRING] = {
    OPEN TimeDefs, CharIO;
    version: BcdDefs.VersionStamp = MyBcdVersion[];
    t: STRING _ [20];
    PutString[stream, "Alto/Mesa TableCompiler 6.0C of "L];
    AppendDayTime[t, UnpackDT[version.time]];
    t.length _ t.length - 3;
    PutString[stream, t]; PutChar[stream, CR];
    t.length _ 0;
    AppendDayTime[t,UnpackDT[DefaultTime]];
    t.length _ t.length - 3;
    IF name # NIL THEN {PutString[stream, name]; PutString[stream, " -- "L]};
    PutString[stream, t];  PutChar[stream, CR]};

  -- timing procedures

  timer: POINTER TO CARDINAL = LOOPHOLE[430B];

  TimeNow: PROC RETURNS [CARDINAL] = INLINE {RETURN [timer^]};

  TimeSince: PROC [start: CARDINAL] RETURNS [CARDINAL] = {
    OPEN Inline; RETURN [(LongDiv[LongMult[timer^-start, 2*39], 1000]+1)/2]};


 -- initialization

  dcbSpace: ARRAY [0..SIZE[AltoDisplay.DCB]+1) OF UNSPECIFIED;
  dcb, saveDCB: AltoDisplay.DCBHandle;

  dcb _ @dcbSpace[0];
  IF LOOPHOLE[dcb, CARDINAL] MOD 2 # 0 THEN dcb _ dcb + 1;
  dcb^ _ AltoDisplay.DCB[NIL, high, black, 0, 0, NIL, 0];
  saveDCB _ AltoDisplay.DCBchainHead^;  AltoDisplay.DCBchainHead^ _ dcb;

  -- find the command stream
    BEGIN OPEN StreamDefs;
    cfa: POINTER TO AltoFileDefs.CFA = MiscDefs.CommandLineCFA[];
    comCmRequest.file _ SegmentDefs.InsertFile[@cfa.fp, Read];
    commandStream _ CreateByteStream[comCmRequest.file, Read];
    StreamDefs.JumpToFA[commandStream, @cfa.fa];
    END;
  -- find the log stream
    BEGIN OPEN SegmentDefs;
    s: STRING _ [40];
    IF logRequest.file = NIL
      THEN logRequest.file _ NewFile[logName, Write+Append, DefaultVersion];
    log _ CreateByteStream[logRequest.file, Write+Append];
    END;

  WriteHerald[log, NIL];


 -- main loop

  DO
    BEGIN
    ENABLE {
      SegmentDefs.FileNameError => {
        OPEN CharIO; PutString[log, "Can't open "]; PutString[log, name]; PutChar[log, CR];
	GO TO FileFault};
      SegmentDefs.FileError => {
	OPEN CharIO; PutString[log, "File problem"]; PutChar[log, CR];  GO TO FileFault}};
    startTime: CARDINAL;
    GetCommand[ ! Rubout => GOTO Abort];
    IF sourceName.length = 0 THEN EXIT;
    startTime _ TimeNow[];
    rootName.length _ 0;
    FOR i: CARDINAL IN [0..sourceName.length)
      DO
      IF sourceName[i] = '. THEN EXIT;
      StringDefs.AppendChar[rootName, sourceName[i]];
      ENDLOOP;
    IF interfaceName.length = 0
      THEN StringDefs.AppendString[interfaceName, "SELF"];
    IF formatName.length = 0
      THEN {
	StringDefs.AppendString[formatName, rootName];
	StringDefs.AppendString[formatName, "Format."]};
    RepeatCommand[log];
    IF bcdName.length = 0
      THEN {
	StringDefs.AppendString[bcdName, rootName];
	StringDefs.AppendString[bcdName, ".bcd"]};

    savedCursor _ TheCursor^;  TheCursor^ _ TableCursor;
    SELECT input FROM
      strings => {
	OPEN CharIO;
        nChars, nStrings: CARDINAL;
	[nStrings, nChars] _ TableCommand.CompileStrings[
	  inputFile: sourceName,
	  interfaceId: interfaceName,
	  formatId: formatName,
	  moduleId: bcdName,
	  compact: compact,
	  altoCode: ~dStar];
	PutString[log, "Strings: "];  CharIO.PutDecimal[log, nStrings];
	PutString[log, ", characters: "];  CharIO.PutDecimal[log, nChars];
	PutChar[log, CR]};
      binary =>
        TableCommand.MakeModule[
	  inputFile: sourceName,
	  interfaceId: interfaceName,
	  moduleId: bcdName,
	  altocode: ~dStar];
      ENDCASE;
    CharIO.PutChar[log, CR];
    TheCursor^ _ savedCursor;
    EXITS
      FileFault => NULL;
      Abort => CharIO.PutChar[log, '?];
    END;
    ENDLOOP;

  IF log # NIL THEN log.destroy[log];
  AltoDisplay.DCBchainHead^ _ saveDCB;
  ImageDefs.StopMesa[];

  END.