-- Copyright (C) 1981, 1982, 1983, 1984, 1985  by Xerox Corporation. All rights reserved. 
-- GlassImpl.mesa

-- HGM: 14-Sep-85 22:23:19
-- Gobbel.PA           10-Aug-83 13:37:52
-- Hankins.PA          23-Feb-83 17:42:10
-- Wobber.PA            1-Nov-82 15:05:23
-- AlHall.PA            9-Jun-82 13:19:27
-- Birrell.PA          17-May-82  9:59:51
-- MJohnson.PA         19-May-81 13:28:28

-- Transport mechanism: Telnet interface

DIRECTORY
  Ascii,
  GlassDefs USING [HandleObject, Handle, StringType],
  Inline USING [BITAND, BITOR],
  PolicyDefs USING [CheckOperation, EndOperation],
  Process USING [Pause, SecondsToTicks, SetTimeout, Yield],
  PupDefs USING [PupAddress, PupSocketID],
  PupStream USING [
    CreatePupByteStreamListener, RejectThisRequest, StreamClosing, veryLongWait],
  PupTypes USING [telnetSoc],
  Stream,
  String USING [AppendDecimal, AppendLongDecimal];

GlassImpl: MONITOR LOCKS slp USING slp: POINTER TO MONITORLOCK
  IMPORTS Inline, PolicyDefs, Process, PupStream, Stream, String EXPORTS GlassDefs
  =

  BEGIN
  TimeOut: PUBLIC SIGNAL = CODE;
  SynchReply: PUBLIC SIGNAL = CODE;
  ReaderDied: ERROR = CODE;
  MyStreamClosing: ERROR = CODE;

  ReadString: PUBLIC PROC [
    str: GlassDefs.Handle, prompt: LONG STRING, s: LONG STRING, type: GlassDefs.StringType]
    RETURNS [end: CHARACTER] =
    BEGIN OPEN str;
    dummy: CHARACTER = '*;  --used for echo if type = pwd--
    ShowIt: PROC =
      BEGIN
      IF type # pwd THEN WriteString[s]
      ELSE FOR i: CARDINAL IN [0..s.length) DO WriteChar[dummy] ENDLOOP;
      END;
    Unwrite: PROCEDURE =
      BEGIN
      IF s.length > 0 THEN
        BEGIN
        WriteChar['\\];
        WriteChar[IF type = pwd THEN dummy ELSE s[s.length - 1]];
        s.length ¬ s.length - 1;
        END;
      END;
    ClearWord: PROCEDURE =
      BEGIN
      state: {alpha, other} ¬ other;
      WHILE s.length > 0 DO
        SELECT s[s.length - 1] FROM
          IN ['a..'z], IN ['A..'Z], IN ['0..'9] => state ¬ alpha;
          ENDCASE => IF state # other THEN EXIT;
        Unwrite[];
        ENDLOOP;
      END;
    c: CHARACTER;
    WriteString[prompt];
    ShowIt[];
    c ¬ ReadChar[];
    SELECT c FROM
      Ascii.ControlA, Ascii.BS, Ascii.ControlW,  --client wants to edit it--
        Ascii.SP, Ascii.CR, Ascii.DEL => NULL;  --client accepts it--
      ENDCASE => IF s.length > 0 THEN {WriteString["¬ "L]; s.length ¬ 0; };  --client rejects it--
    DO
      SELECT c FROM
        Ascii.ControlA, Ascii.BS => Unwrite[];
        Ascii.ControlW => ClearWord[];
        Ascii.ControlR => {WriteChar[Ascii.CR]; WriteString[prompt]; ShowIt[]};
        ENDCASE =>
          BEGIN
          SELECT c FROM
            Ascii.SP => IF type # line AND type # any THEN {end ¬ c; EXIT};
            Ascii.CR => IF type # any THEN {end ¬ c; EXIT};
            Ascii.ESC, Ascii.DEL => {end ¬ c; EXIT};
            ENDCASE => NULL;
          IF s.length < s.maxlength THEN
            BEGIN
            s[s.length] ¬ c;
            s.length ¬ s.length + 1;
            WriteChar[IF type = pwd THEN dummy ELSE c];
            END
          ELSE WriteChar[Ascii.BEL];
          END;
      c ¬ ReadChar[];
      ENDLOOP;
    END;

  Listen: PUBLIC PROC [
    work: PROC [GlassDefs.Handle], socket: PupDefs.PupSocketID ¬ [0, 0]] =
    BEGIN
    TelnetWork: PROC [str: Stream.Handle, from: PupDefs.PupAddress] =
      BEGIN
      -- Note that there is an over-all assumption that the client calls
      -- the glass stream from only one process.  The monitor locks are
      -- used only to synchronize between the "Reader" process and the
      -- client.

      strLock: MONITORLOCK;  -- lock for this stream --
      readerPSB: PROCESS;
      readerWanted: BOOLEAN ¬ TRUE;
      -- we maintain a circular buffer of incoming characters,
      -- primarily to look ahead for DEL --
      -- rPos = next index for reading from buffer --
      -- wPos = next index for writing into buffer --
      -- rPos = wPos iff buffer is empty --
      -- (wPos+1)MOD bLength = rPos iff buffer is full --
      -- buffer data has "markBit" on iff datum is a "Mark" byte --
      charMask: WORD = 177B;
      markBit: WORD = 200B;
      bLength: CARDINAL = 100;
      buffer: PACKED ARRAY [0..bLength) OF CHARACTER;
      rPos: CARDINAL ¬ 0;
      wPos: CARDINAL ¬ 0;
      bFuller: CONDITION;
      bEmptier: CONDITION;
      delCount: CARDINAL ¬ 0;
      charsWritten: BOOLEAN ¬ FALSE;  --chars written but not sent--
      readerDead: BOOLEAN ¬ FALSE;
      NoteDeadReader: ENTRY PROC [slp: POINTER TO MONITORLOCK] = {
        readerDead ¬ TRUE; NOTIFY bFuller};
      ChangeWPos: ENTRY PROC [change: CARDINAL, slp: POINTER TO MONITORLOCK] =
        INLINE
        BEGIN
        ENABLE UNWIND => NULL;
        IF rPos = wPos THEN NOTIFY bFuller;
        wPos ¬ wPos + change;
        IF wPos = bLength THEN wPos ¬ 0;
        END;
      WLimit: ENTRY PROC [slp: POINTER TO MONITORLOCK] RETURNS [limit: CARDINAL] =
        INLINE
        BEGIN
        ENABLE UNWIND => NULL;
        WHILE
          (limit ¬
            IF wPos >= rPos THEN IF rPos = 0 THEN bLength - 1 ELSE bLength
            ELSE rPos - 1) = wPos DO WAIT bEmptier ENDLOOP;
        END;
      AddDel: ENTRY PROC [slp: POINTER TO MONITORLOCK] =
        BEGIN
        ENABLE UNWIND => NULL;
        delCount ¬ delCount + 1;
        Stream.SendAttention[str, 0];
        Stream.SetSST[str, 1 --data mark-- ];
        END;
      GetByte: ENTRY PROC [slp: POINTER TO MONITORLOCK] RETURNS [c: UNSPECIFIED] =
        BEGIN
        ENABLE UNWIND => NULL;
        WHILE rPos = wPos DO
          IF charsWritten THEN {charsWritten ¬ FALSE; Stream.SendNow[str]};
          IF readerDead THEN ERROR ReaderDied[];
          WAIT bFuller;
          IF rPos = wPos THEN SIGNAL TimeOut[];
          ENDLOOP;
        c ¬ buffer[rPos];
        rPos ¬ rPos + 1;
        IF rPos = bLength THEN rPos ¬ 0;
        NOTIFY bEmptier;  -- in case buffer was full --
        IF c = Ascii.DEL THEN delCount ¬ delCount - 1;
        END;
      TerminateReader: ENTRY PROC [slp: POINTER TO MONITORLOCK] =
        BEGIN
        -- ensure reader isn't waiting because of a full input buffer --
        UNTIL readerDead DO
          rPos ¬ wPos ¬ 0; NOTIFY bEmptier; WAIT bFuller ENDLOOP;
        END;
      Reader: PROC =
        BEGIN
        Stream.SetInputOptions[
          str, [
          terminateOnEndRecord: TRUE, signalLongBlock: FALSE,
          signalShortBlock: FALSE, signalSSTChange: FALSE,
          signalEndOfStream: FALSE, signalAttention: FALSE]];
        DO
          ENABLE
            BEGIN Stream.TimeOut => RESUME ; PupStream.StreamClosing => EXIT; END;
          used: CARDINAL;
          why: Stream.CompletionCode;
          sst: Stream.SubSequenceType;
          bufferAddr: LONG POINTER = @buffer;
          [used, why, sst] ¬ Stream.GetBlock[
            str, [bufferAddr, wPos, WLimit[@strLock]]];
          FOR index: CARDINAL IN [wPos..wPos + used) DO
            SELECT (buffer[index] ¬ Inline.BITAND[buffer[index], charMask]) FROM
              Ascii.ControlC => {buffer[index] ¬ Ascii.DEL; AddDel[@strLock]};
              Ascii.DEL => AddDel[@strLock];
              ENDCASE => NULL;
            ENDLOOP;
          ChangeWPos[used, @strLock];
          IF why = sstChange THEN
            BEGIN
            buffer[wPos] ¬ Inline.BITOR[sst, markBit];
            ChangeWPos[1, @strLock];
            IF sst = 6 --timing mark reply-- AND NOT readerWanted THEN EXIT;
            END;
          ENDLOOP;
        NoteDeadReader[@strLock];
        END;
      lineWidth: CARDINAL ¬ 0;
      pageHeight: CARDINAL ¬ 0;
      terminal: CARDINAL ¬ 0;
      charPos: CARDINAL ¬ 0;
      linePos: CARDINAL ¬ 0;
      ConsiderSST: PROC [thisSST: Stream.SubSequenceType] =
        BEGIN
        SELECT thisSST FROM
          1 => -- data mark -- NULL;
          2 => lineWidth ¬ GetByte[@strLock];
          3 => pageHeight ¬ GetByte[@strLock];
          4 => terminal ¬ GetByte[@strLock];
          5 => Stream.SetSST[str, 6 --timing mark reply-- ];
          6 => SIGNAL SynchReply[];
          ENDCASE => NULL --ignore-- ;
        END;
      ReadChar: PROC RETURNS [c: CHARACTER] =
        BEGIN
        ENABLE PupStream.StreamClosing => MyStreamClosing;
        DO
          c ¬ GetByte[@strLock];
          IF Inline.BITAND[c, markBit] # 0 THEN
            ConsiderSST[Inline.BITAND[c, charMask]]
          ELSE EXIT
          ENDLOOP;
        linePos ¬ 0; -- only count lines between input operations -- END;
      MyReadString: PROC [prompt: LONG STRING, s: LONG STRING, type: GlassDefs.StringType]
        RETURNS [end: CHARACTER] = {end ¬ ReadString[@obj, prompt, s, type]};
      WriteChar: PROC [c: CHARACTER] =
        -- assumed to be called from only one process --
        -- otherwise, we need two monitor locks: this may use ReadChar --
        BEGIN
        ENABLE PupStream.StreamClosing => MyStreamClosing;
        WS: PROC [s: STRING] =
          BEGIN  -- sneak in a string --
          FOR index: CARDINAL IN [0..s.length) WHILE charPos < lineWidth DO
            PutSingleWidth[s[index]] ENDLOOP;
          END;
        Lf: PROC =
          BEGIN
          IF linePos + 1 >= pageHeight AND pageHeight # 0 THEN
            BEGIN
            IF charPos > 0 THEN Stream.PutChar[str, Ascii.CR];
            charPos ¬ 0;
            Stream.PutChar[str, Ascii.LF];
            WS["Type ESC for next page ..."L];
            SendNow[];
            UNTIL ReadChar[] = Ascii.ESC DO ENDLOOP;
            Stream.PutChar[str, Ascii.CR];
            charPos ¬ 0;
            END;
          Stream.PutChar[str, Ascii.LF];
          linePos ¬ linePos + 1;
          END;
        Newline: PROC =
          BEGIN Stream.PutChar[str, Ascii.CR]; charPos ¬ 0; Lf[]; END;
        PutSingleWidth: PROC [c: CHARACTER] = INLINE
          BEGIN
          IF charPos = lineWidth AND lineWidth > 0 THEN Newline[];
          Stream.PutChar[str, c];
          charPos ¬ charPos + 1;
          END;
        NoteWritten: ENTRY PROC [slp: POINTER TO MONITORLOCK] = INLINE {
          charsWritten ¬ TRUE};
        Process.Yield[];
        IF delCount # 0 THEN RETURN;
        SELECT c FROM
          IN [40C..177C] => PutSingleWidth[c];
          Ascii.CR => Newline[];
          Ascii.LF => Lf[];
          Ascii.BEL => Stream.PutChar[str, c];
          Ascii.TAB =>
            DO PutSingleWidth[Ascii.SP]; IF charPos MOD 8 = 0 THEN EXIT; ENDLOOP;
          IN [0C..40C) => {PutSingleWidth['­]; PutSingleWidth[c + 100B]};
          ENDCASE => NULL -- illegal character values -- ;
        NoteWritten[@strLock];
        END;
      WriteString: PROC [s: LONG STRING] = {
        FOR i: CARDINAL IN [0..s.length) DO WriteChar[s[i]] ENDLOOP};
      WriteDecimal: PROC [n: CARDINAL] =
        BEGIN
        s: STRING = [6] -- -65536 -- ;
        String.AppendDecimal[s, n];
        WriteString[s];
        END;
      WriteLongDecimal: PROC [n: LONG CARDINAL] =
        BEGIN
        s: STRING = [11] -- -6553665536 -- ;
        String.AppendLongDecimal[s, n];
        WriteString[s];
        END;
      NoteSent: ENTRY PROC [slp: POINTER TO MONITORLOCK] = INLINE {
        charsWritten ¬ FALSE};
      SendNow: PROC = {
        ENABLE PupStream.StreamClosing => ERROR MyStreamClosing;
        NoteSent[@strLock];
        Stream.SendNow[str]};
      CharsLeft: PROC RETURNS [CARDINAL] = {
        RETURN[IF lineWidth > 0 THEN lineWidth - charPos ELSE LAST[CARDINAL]]};
      LinesLeft: PROC RETURNS [CARDINAL] = {
        RETURN[IF pageHeight > 0 THEN pageHeight - linePos ELSE LAST[CARDINAL]]};
      SetWidth: PROC [new: CARDINAL] = {lineWidth ¬ new};
      SetHeight: PROC [new: CARDINAL] = {pageHeight ¬ new};
      DelTyped: PROC RETURNS [BOOLEAN] =
        BEGIN
        InnerDelTyped: ENTRY PROC [slp: POINTER TO MONITORLOCK]
          RETURNS [BOOLEAN] = INLINE {RETURN[delCount # 0]};
        RETURN[InnerDelTyped[@strLock]];
        END;
      Synch: PROC = {
        ENABLE PupStream.StreamClosing => ERROR MyStreamClosing;
        Stream.SetSST[str, 5]};
      Flush: PROC = {WHILE delCount > 0 DO [] ¬ ReadChar[] ENDLOOP};
      obj: GlassDefs.HandleObject ¬ [
        ReadChar, MyReadString, WriteChar, WriteString, WriteDecimal,
        WriteLongDecimal, SendNow, CharsLeft, LinesLeft, SetWidth, SetHeight,
        DelTyped, Synch, Flush];
      Process.SetTimeout[@bFuller, Process.SecondsToTicks[300]];
      readerPSB ¬ FORK Reader[];
      BEGIN
      ENABLE { MyStreamClosing, ReaderDied => CONTINUE; TimeOut => RESUME };
      work[@obj ! SynchReply => RESUME ];
      readerWanted ¬ FALSE;
      Synch[];
      DO [] ¬ ReadChar[ ! SynchReply => EXIT] ENDLOOP;
      END;
      TerminateReader[@strLock];
      JOIN readerPSB;
      str.delete[str];
      PolicyDefs.EndOperation[telnet];
      END;
    TelnetFilter: PROC [addr: PupDefs.PupAddress] =
      BEGIN
      IF NOT PolicyDefs.CheckOperation[telnet] THEN
        PupStream.RejectThisRequest["Server full"L];
      END;
    [] ¬ PupStream.CreatePupByteStreamListener[
      IF socket = [0, 0] THEN PupTypes.telnetSoc ELSE socket, TelnetWork,
      PupStream.veryLongWait, TelnetFilter];
    DO Process.Pause[Process.SecondsToTicks[600]]; ENDLOOP;
    END;


  END.