-- File: MakeExceptions.mesa
-- Last edit:  Levin at June 9, 1980  4:22 PM.

DIRECTORY
  AltoFileDefs: FROM "AltoFileDefs" USING [CFA],
  ExceptionTableDefs: FROM "ExceptionTableDefs" USING [endMarker, Exception, ExceptionTableEntry,
     ExceptionTableProper, InputEntry, InputEntryPtr, Offset],
  ImageDefs: FROM "ImageDefs" USING [BcdTime, StopMesa],
  InlineDefs: FROM "InlineDefs" USING [COPY],
  IODefs: FROM "IODefs" USING [
    ControlZ, CR, GetInputStream, ReadChar, ReadID, SetEcho, SetInputStream, SP,
    TAB, WriteChar, WriteDecimal, WriteLine, WriteString],
  MiscDefs: FROM "MiscDefs" USING [CommandLineCFA],
  SegmentDefs: FROM "SegmentDefs" USING [FileNameError, InsertFile, Read],
  StreamDefs: FROM "StreamDefs" USING [
    Append, CreateByteStream, GetFA, GetIndex, JumpToFA, ModifyIndex,
    NewByteStream, NewWordStream, Read, SetIndex, StreamError, StreamErrorCode,
    StreamHandle, Write, WriteBlock],
  StringDefs: FROM "StringDefs" USING [AppendChar, AppendString, StringToDecimal],
  SystemDefs: FROM "SystemDefs" USING [
    AllocateHeapNode, AllocateHeapString, AllocatePages, AllocateSegment, FreeHeapNode,
    FreeHeapString, FreePages, FreeSegment],
  TimeDefs: FROM "TimeDefs" USING [AppendDayTime, UnpackDT];

MakeExceptions: PROGRAM
  IMPORTS ImageDefs, InlineDefs, IODefs, MiscDefs, SegmentDefs, StreamDefs, StringDefs,
    SystemDefs, TimeDefs =

BEGIN

OPEN ExceptionTableDefs, IODefs, StreamDefs;

-- Types and Related Constants --

ExceptionTable: TYPE =
  RECORD[
    proper: POINTER TO ExceptionTableProper,
    maxLength: CARDINAL
    ];

ExceptionTablePtr: TYPE = POINTER TO ExceptionTable;

initialInputTableSize: CARDINAL = 200;
initialExceptionTableSize: CARDINAL = 100;
percentToIncrease: [0..100] = 50;

StringPageDescriptor: TYPE =
  RECORD[
    link: StringPage,
    buffer: POINTER TO PACKED ARRAY [0..charsPerPage) OF CHARACTER
    ];

StringPage: TYPE = POINTER TO StringPageDescriptor;

charsPerPage: CARDINAL = 512;

-- Global variables --

inFileName: STRING;
inputStream: StreamHandle;
outFileName: STRING;
outputStream: StreamHandle;

savedInputStream: StreamHandle;
savedEchoState: BOOLEAN;

input: POINTER TO ARRAY OF InputEntry;
inputLength, inputMaxLength: CARDINAL;

tableN: ExceptionTable;
tableX: ExceptionTable;

firstPage, currentPage: StringPage;
stringBase, stringSpaceFF: Offset;
pageFF: [0..charsPerPage];

success: BOOLEAN;

-- Errors --

EndOfInput: ERROR = CODE;
SyntaxError: ERROR = CODE;
BadInputFile: ERROR = CODE;


-- String Space Procedures --

InitializeStringSpace: PROCEDURE =
  BEGIN
  firstPage _ currentPage _ CreateStringSpacePage[];
  stringSpaceFF _ 0;
  PutCharInStringSpace[endMarker];	-- used by omitted entries
  END;

CreateStringSpacePage: PROCEDURE RETURNS[page: StringPage] =
  BEGIN
  page _ SystemDefs.AllocateHeapNode[SIZE[StringPageDescriptor]];
  page^ _ [link: NIL, buffer: SystemDefs.AllocatePages[1]];
  pageFF _ 0;
  END;

PutCharInStringSpace: PROCEDURE[char: CHARACTER] =
  BEGIN
  IF pageFF >= charsPerPage THEN
    BEGIN
    currentPage.link _ CreateStringSpacePage[];
    currentPage _ currentPage.link;
    END;
  currentPage.buffer[pageFF] _ char;
  pageFF _ pageFF + 1;
  stringSpaceFF _ stringSpaceFF + 1;
  END;

-- Input Procedures --

InitializeInput: PROCEDURE =
  BEGIN
  inputStream _ NewByteStream[inFileName, Read
                              ! SegmentDefs.FileNameError => ERROR BadInputFile];
  SetInputStream[inputStream];
  InitializeInputEntryTable[];
  InitializeExceptionTable[@tableN];
  InitializeExceptionTable[@tableX];
  WriteString["Reading "L];
  WriteString[inFileName];
  WriteString["..."L];
  END;

FinalizeInput: PROCEDURE =
  BEGIN
  inputStream.destroy[inputStream];
  END;

InitializeInputEntryTable: PROCEDURE =
  BEGIN
  input _ SystemDefs.AllocateSegment[initialInputTableSize*SIZE[InputEntry]];
  inputLength _ 0;
  inputMaxLength _ initialInputTableSize;
  END;

InitializeExceptionTable: PROCEDURE[table: ExceptionTablePtr] =
  BEGIN
  i: CARDINAL;
  table.proper _
    SystemDefs.AllocateSegment[1+initialExceptionTableSize*SIZE[ExceptionTableEntry]];
  FOR i IN [0..initialExceptionTableSize) DO table.proper.entries[i].input _ NIL ENDLOOP;
  table.proper.length _ 0;
  table.maxLength _ initialExceptionTableSize;
  END;

BackUpInput: PROCEDURE =
  BEGIN
  SetIndex[inputStream, ModifyIndex[GetIndex[inputStream], -1]];
  END;

GetChar: PROCEDURE RETURNS[CHARACTER] =
  BEGIN
  char: CHARACTER _ ReadChar[ ! StreamError => HandleStreamTrouble[error]];
  IF char ~= ControlZ THEN RETURN[char];
  UNTIL ReadChar[ ! StreamError => HandleStreamTrouble[error]] = CR DO NULL ENDLOOP;
  RETURN[CR];
  END;

GetRequiredChar: PROCEDURE[c: CHARACTER] =
  BEGIN
  IF GetChar[] ~= c THEN ERROR SyntaxError;
  END;

-- Input Parsing Procedures --

SkipWhiteSpace: PROCEDURE =
  BEGIN
  DO
    SELECT GetChar[] FROM
      SP, TAB, CR => NULL;
      '- =>
        IF GetChar[] = '- THEN UNTIL GetChar[] = CR DO NULL ENDLOOP
        ELSE BEGIN BackUpInput[]; EXIT END;
      ENDCASE => EXIT;
    ENDLOOP;
  BackUpInput[];
  END;

GetInputEntrySlot: PROCEDURE RETURNS [InputEntryPtr] =
  BEGIN
  IF (inputLength _ inputLength + 1) > inputMaxLength THEN
    BEGIN
    newInput: POINTER TO ARRAY OF InputEntry;
    oldLength: CARDINAL _ inputMaxLength;
    inputMaxLength _ inputMaxLength+percentToIncrease*inputMaxLength/100;
    newInput _ SystemDefs.AllocateSegment[inputMaxLength*SIZE[InputEntry]];
    InlineDefs.COPY[from: input, to: newInput, nwords: oldLength*SIZE[InputEntry]];
    SystemDefs.FreeSegment[input];
    input _ newInput;
    END;
  RETURN[@input[inputLength-1]]
  END;

GetExceptionNumber: PROCEDURE RETURNS[Exception] =
  BEGIN
  s: STRING _ [5];
  char: CHARACTER;
  DO
    SELECT char _ GetChar[] FROM
      IN ['0..'9] => StringDefs.AppendChar[s, char];
      ENDCASE => EXIT;
    ENDLOOP;
  BackUpInput[];
  RETURN[StringDefs.StringToDecimal[s]]
  END;

RecordEntryInExceptionTable: PROCEDURE[entry: InputEntryPtr, table: ExceptionTablePtr] =
  BEGIN
  IF entry.exception >= table.maxLength THEN
    BEGIN
    i: CARDINAL;
    newMaxLength: CARDINAL =
      MAX[entry.exception+1, table.maxLength+percentToIncrease*table.maxLength/100];
    newTable: POINTER TO ExceptionTableProper _
      SystemDefs.AllocateSegment[1+newMaxLength*SIZE[ExceptionTableEntry]];
    InlineDefs.COPY[from: table.proper, to: newTable, nwords: 1+table.proper.length*SIZE[ExceptionTableEntry]];
    SystemDefs.FreeSegment[table.proper];
    table.proper _ newTable;
    FOR i IN [table.maxLength..newMaxLength) DO
      table.proper.entries[i].input _ NIL ENDLOOP;
    table.maxLength _ newMaxLength;
    END;
  IF table.proper.entries[entry.exception].input = NIL THEN
    BEGIN
    table.proper.entries[entry.exception].input _ entry;
    table.proper.length _ MAX[table.proper.length, entry.exception+1];
    END
  ELSE WarnUserOfDuplicate[entry, table];
  END;

RecordEntryInExceptionTables: PROCEDURE[entry: InputEntryPtr] =
  BEGIN
  char: CHARACTER = GetChar[];
  SELECT char FROM
    'N, 'n => RecordEntryInExceptionTable[entry, @tableN];
    'X, 'x => RecordEntryInExceptionTable[entry, @tableX];
    ': =>
      BEGIN
      BackUpInput[];
      RecordEntryInExceptionTable[entry, @tableN];
      RecordEntryInExceptionTable[entry, @tableX];
      END;
    ENDCASE => ERROR SyntaxError;
  END;

SkipToString: PROCEDURE =
  BEGIN
  SkipWhiteSpace[];
  GetRequiredChar[':];
  SkipWhiteSpace[];
  GetRequiredChar['"];
  END;

GetString: PROCEDURE RETURNS[offset: Offset] =
  BEGIN
  char: CHARACTER;
  offset _ stringSpaceFF;
  DO
    SELECT char _ GetChar[] FROM
       '" =>
        IF GetChar[] = '" THEN PutCharInStringSpace['"]
        ELSE BEGIN BackUpInput[]; EXIT END;
       ENDCASE => PutCharInStringSpace[char];
    ENDLOOP;
  PutCharInStringSpace[endMarker];
  END;

GetNextInputEntry: PROCEDURE =
  BEGIN
  entry: InputEntryPtr _ GetInputEntrySlot[];
  entry.exception _ GetExceptionNumber[];
  SkipWhiteSpace[];
  RecordEntryInExceptionTables[entry];
  SkipToString[];
  entry.stringStart _ GetString[];
  END;

-- Error Reporting Procedures --

HandleStreamTrouble: PROCEDURE[error: StreamErrorCode] =
  BEGIN
  SELECT error FROM
    StreamAccess => ERROR EndOfInput;
    ENDCASE => WriteLine["Trouble on input stream -- I give up."L];
  END;

WarnUserOfDuplicate: PROCEDURE[entry: InputEntryPtr, table: ExceptionTablePtr] =
  BEGIN
  WriteChar[CR];
  WriteString["Warning:  duplicate entries for exception #"L];
  WriteDecimal[entry.exception];
  WriteString[" in table '"L];
  WriteChar[IF table = @tableN THEN 'N ELSE 'X];
  WriteLine["'"L];
  END;

-- Output Procedures --

InitializeOutput: PROCEDURE =
  BEGIN
  stringBase _
    ((tableN.proper.length+tableX.proper.length)*SIZE[output ExceptionTableEntry]+2)*2;
  outputStream _ NewWordStream[outFileName, Read+Write+Append];
  WriteString["Writing "L];
  WriteString[outFileName];
  WriteString["..."L];
  END;

ConvertAndOutputExceptionTable: PROCEDURE[table: ExceptionTablePtr] =
  BEGIN
  i: CARDINAL;
  FOR i IN [0..table.proper.length) DO
    IF table.proper.entries[i].input = NIL THEN table.proper.entries[i].offset _ stringBase
    ELSE
      BEGIN
      entry: InputEntryPtr = table.proper.entries[i].input;
      table.proper.entries[i].offset _ stringBase + entry.stringStart;
      END;
    ENDLOOP;
  [] _ WriteBlock[stream: outputStream, address: table.proper,
      words: SIZE[ExceptionTableProper]+table.proper.length*SIZE[ExceptionTableEntry]];
  END;

OutputStringSpace: PROCEDURE =
  BEGIN
  FOR currentPage _ firstPage, currentPage.link UNTIL currentPage.link = NIL DO
    [] _ WriteBlock[stream: outputStream, address: currentPage.buffer, words: 256];
    ENDLOOP;
  [] _ WriteBlock[stream: outputStream, address: currentPage.buffer, words: (pageFF+1)/2];
  END;

FinalizeOutput: PROCEDURE =
  BEGIN
  outputStream.destroy[outputStream];
  END;

-- Command Processing --

ProcessCommandInput: PROCEDURE =
  BEGIN
  OPEN StringDefs;
  cfa: POINTER TO AltoFileDefs.CFA _ MiscDefs.CommandLineCFA[];
  i: CARDINAL;
  inputStream _ CreateByteStream[SegmentDefs.InsertFile[@cfa.fp, SegmentDefs.Read], Read];
  inFileName _ SystemDefs.AllocateHeapString[40];
  outFileName _ SystemDefs.AllocateHeapString[40];
  JumpToFA[inputStream, @cfa.fa];
  SetInputStream[inputStream];
  BEGIN
  ENABLE StreamError, EndOfInput => CONTINUE;
  SkipWhiteSpace[];
  ReadID[inFileName];
  END;
  GetFA[inputStream, @cfa.fa];
  inputStream.destroy[inputStream];
  SetInputStream[savedInputStream];
  IF inFileName.length = 0 THEN AppendString[inFileName, "LaurelExceptions.txt"L];
  FOR i IN [0..inFileName.length) DO
    IF inFileName[i] = '. THEN EXIT;
    AppendChar[outFileName, inFileName[i]];
    ENDLOOP;
  AppendString[outFileName, ".binary"];
  success _ FALSE;
  END;

-- Miscellaneous --

WriteHerald: PROCEDURE =
  BEGIN
  s: STRING _ [50];
  WriteChar[CR];
  WriteLine["Laurel Exception File Builder."];
  WriteString["Version of "];
  TimeDefs.AppendDayTime[s, TimeDefs.UnpackDT[ImageDefs.BcdTime[]]];
  WriteLine[s];
  WriteChar[CR];
  END;

Cleanup: PROCEDURE =
  BEGIN
  OPEN SystemDefs;
  next: StringPage;
  SetInputStream[savedInputStream];
  [] _ SetEcho[savedEchoState];
  FreeSegment[tableN.proper];
  FreeSegment[tableX.proper];
  FreeSegment[input];
  UNTIL firstPage = NIL DO
    next _ firstPage.link;
    FreePages[firstPage.buffer];
    FreeHeapNode[firstPage];
    firstPage _ next;
    ENDLOOP;
  FreeHeapString[inFileName];
  FreeHeapString[outFileName];
  END;


-- Main program --

savedInputStream _ GetInputStream[];
savedEchoState _ SetEcho[FALSE];

WriteHerald[];
ProcessCommandInput[];

BEGIN

InitializeInput[ ! BadInputFile => GO TO BadFileName];
InitializeStringSpace[];

DO
  SkipWhiteSpace[ ! EndOfInput => EXIT];
  GetNextInputEntry[
      ! EndOfInput => GO TO PrematureEnd;
        SyntaxError => GO TO InputFormatTrouble
      ];
  ENDLOOP;

FinalizeInput[];

WriteDecimal[inputLength];
WriteLine[" exception messages read."];
WriteChar[CR];

InitializeOutput[];

ConvertAndOutputExceptionTable[@tableN];
ConvertAndOutputExceptionTable[@tableX];
OutputStringSpace[];

FinalizeOutput[];

success _ TRUE;

EXITS
  BadFileName =>
    BEGIN
    WriteString["? Can't find file: "];
    WriteLine[inFileName];
    END;
  PrematureEnd =>
    BEGIN
    WriteChar[CR];
    WriteLine["? Unexpected end of input file."L];
    END;
  InputFormatTrouble =>
    BEGIN
    WriteChar[CR];
    WriteString["? Syntax error in input file.  Last valid exception number processed was "L];
    WriteDecimal[input[inputLength-1].exception];
    WriteLine["."L];
    END;
END;

Cleanup[];

IF success THEN WriteLine["Done."]
ELSE
  BEGIN
  WriteString["Type any character to exit..."];
  [] _ ReadChar[];
  END;

ImageDefs.StopMesa[];

END.