-- 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.