IPMasterImpl.mesa
Last edited by:
Doug Wyatt, March 1, 1984 10:14:52 am PST
DIRECTORY
Atom USING [MakeAtomFromRefText],
FS USING [StreamOpen],
IO USING [Backup, Close, GetChar, GetIndex, int, PutF, PutFR, rope, SetIndex, STREAM, text],
IP USING [Block, BlockRep, Identifier, Index, Node, NodeRep, nullIndex, Op, Primitive, Vector],
IPMaster USING [GetToken, ErrorCode, nullToken, Rational, Reader, ReaderProcs, ReaderRep, Token, Version, Writer, WriterProcs, WriterRep],
RefText USING [AppendChar, ObtainScratch, ReleaseScratch],
Rope USING [Equal, Fetch, FromProc, FromRefText, ROPE, Size];
IPMasterImpl: CEDAR MONITOR
IMPORTS Atom, FS, IO, IPMaster, RefText, Rope
EXPORTS IPMaster
~ BEGIN OPEN IPMaster, IP;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
Error:
PUBLIC
ERROR[code: ErrorCode, explanation:
ROPE ←
NIL] ~
CODE;
Encoding: TYPE ~ REF EncodingRep;
EncodingRep:
TYPE ~
RECORD[
name: ROPE, version: Version,
readerProcs: ReaderProcs, writerProcs: WriterProcs
];
registeredEncodings: LIST OF Encoding ← NIL; -- monitored data
RegisterEncoding:
PUBLIC
ENTRY
PROC[name:
ROPE, version: Version,
readerProcs: ReaderProcs, writerProcs: WriterProcs] ~ {
encoding: Encoding ~
NEW[EncodingRep ← [name: name, version: version,
readerProcs: readerProcs, writerProcs: writerProcs]];
registeredEncodings ← CONS[encoding, registeredEncodings];
};
CompatibleNames:
PROC[need, have:
ROPE]
RETURNS[
BOOL] = {
RETURN[Rope.Equal[need, have, FALSE]];
};
FindEncoding:
ENTRY
PROC[name:
ROPE, version: Version]
RETURNS[Encoding] = {
CompatibleVersions:
PROC[need, have: Version]
RETURNS[
BOOL] = {
RETURN[have.major>need.major
OR (have.major=need.major AND have.minor>=need.minor)];
};
FOR list:
LIST
OF Encoding ← registeredEncodings, list.rest
UNTIL list=
NIL
DO
encoding: Encoding ~ list.first;
IF Rope.Equal[name, encoding.name, FALSE]
AND CompatibleVersions[need: version, have: encoding.version] THEN RETURN[encoding];
ENDLOOP;
RETURN[NIL];
};
UnknownEncoding:
PROC[name:
ROPE, version: Version] ~ {
ERROR Error[$unknownEncoding,
IO.PutFR["\"%g/%g.%g\" is an unrecognized encoding.",
IO.rope[name], IO.int[version.major], IO.int[version.minor]]];
};
GetReaderProcs:
PUBLIC
PROC[encodingName:
ROPE, encodingVersion: Version]
RETURNS[procs: ReaderProcs ← NIL] ~ {
encoding: Encoding ~ FindEncoding[encodingName, encodingVersion];
IF encoding#NIL THEN procs ← encoding.readerProcs
ELSE UnknownEncoding[encodingName, encodingVersion];
};
MatchRope:
PROC[stream:
STREAM, rope:
ROPE]
RETURNS[
BOOL] ~ {
FOR i:
INT
IN[0..rope.Size[])
DO
char: CHAR ~ stream.GetChar[];
IF char#rope.Fetch[i] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
};
RopeFromText:
PROC[text:
REF
TEXT, start, len:
NAT]
RETURNS[
ROPE] ~ {
i: NAT ← start;
proc: PROC RETURNS[char: CHAR] ~ { char ← text[i]; i ← i+1 };
RETURN[Rope.FromProc[len: len, p: proc]];
};
CardinalFromText:
PROC[text:
REF
TEXT, start, len:
NAT]
RETURNS[
CARDINAL] ~ {
value: LONG CARDINAL ← 0;
FOR i:
NAT
IN[start..start+len)
DO
char: CHAR ~ text[i];
IF char IN['0..'9] THEN value ← value*10+(char-'0) ELSE ERROR Error[$bug];
IF value>CARDINAL.LAST THEN ERROR Error[$overflow, "Version number is too big."];
ENDLOOP;
RETURN[value];
};
bufferSize: NAT ~ 200;
CreateReader:
PUBLIC
PROC[stream:
STREAM,
encodingName: ROPE, encodingVersion: Version] RETURNS[Reader] ~ {
procs: ReaderProcs ~ GetReaderProcs[encodingName, encodingVersion];
RETURN[
NEW[ReaderRep ← [procs: procs, stream: stream,
index: 0, token: nullToken, shortNumber: 0, text: NIL,
buffer: NEW[TEXT[bufferSize]]]]];
};
OpenReader:
PUBLIC
PROC[name:
ROPE]
RETURNS[Reader] ~ {
stream: STREAM ~ FS.StreamOpen[name];
buffer: REF TEXT ← NIL;
encodingName: ROPE; encodingVersion: Version;
IF stream.GetIndex[]=0
THEN {
-- ignore leading CR that Tioga might have inserted
char: CHAR ~ stream.GetChar[];
IF char='\n THEN NULL ELSE stream.Backup[char];
};
IF
NOT MatchRope[stream, "Interpress/"]
THEN
ERROR Error[$illegalHeader, "Header does not begin with \"Interpress/\"."];
buffer ← RefText.ObtainScratch[100];
{ ENABLE UNWIND => RefText.ReleaseScratch[buffer];
text: REF TEXT ← buffer;
nameStart, nameLen, majorStart, majorLen, minorStart, minorLen: NAT ← 0;
state: {null, name, slash, major, dot, minor} ← null;
text.length ← 0;
THROUGH[0..
NAT.
LAST)
DO
char: CHAR ~ stream.GetChar[];
i: NAT ~ text.length;
text ← RefText.AppendChar[text, char];
SELECT state
FROM
$null =>
SELECT char
FROM
IN['A..'Z], IN['a..'z] => { nameStart ← i; state ← $name };
ENDCASE => GOTO BadSyntax;
$name =>
SELECT char
FROM
IN['A..'Z], IN['a..'z] => NULL;
'/ => { nameLen ← i-nameStart; state ← $slash };
ENDCASE => GOTO BadSyntax;
$slash =>
SELECT char
FROM
IN['A..'Z], IN['a..'z] => state ← $name;
IN['0..'9] => { majorStart ← i; state ← $major };
ENDCASE => GOTO BadSyntax;
$major =>
SELECT char
FROM
IN['0..'9] => NULL;
'. => { majorLen ← i-majorStart; state ← $dot };
ENDCASE => GOTO BadSyntax;
$dot =>
SELECT char
FROM
IN['0..'9] => { minorStart ← i; state ← $minor };
ENDCASE => GOTO BadSyntax;
$minor =>
SELECT char
FROM
IN['0..'9] => NULL;
' => { minorLen ← i-minorStart; EXIT };
ENDCASE => GOTO BadSyntax;
ENDCASE => ERROR;
REPEAT
BadSyntax => ERROR Error[$illegalHeader, "Header has invalid syntax."];
FINISHED => ERROR Error[$illegalHeader, "Header is too long!"];
ENDLOOP;
encodingName ← RopeFromText[text: text, start: nameStart, len: nameLen];
encodingVersion.major ← CardinalFromText[text: text, start: majorStart, len: majorLen];
encodingVersion.minor ← CardinalFromText[text: text, start: minorStart, len: minorLen];
};
RefText.ReleaseScratch[buffer];
RETURN[CreateReader[stream, encodingName, encodingVersion]];
};
CloseReader:
PUBLIC
PROC[reader: Reader] ~ {
reader.stream.Close[];
};
GetIndex:
PUBLIC
PROC[reader: Reader]
RETURNS[
INT] ~ {
RETURN[reader.stream.GetIndex[]];
};
SetIndex:
PUBLIC
PROC[reader: Reader, index:
INT] ~ {
reader.stream.SetIndex[index];
reader.token ← nullToken; reader.text ← NIL;
};
ReadInt:
PUBLIC
PROC[reader: Reader]
RETURNS[
INT] ~ {
RETURN reader.procs.readInt[reader];
};
ReadRational:
PUBLIC
PROC[reader: Reader]
RETURNS[Rational] ~ {
RETURN reader.procs.readRational[reader];
};
ReadReal:
PUBLIC
PROC[reader: Reader]
RETURNS[
REAL] ~ {
SELECT reader.token.type
FROM
$integer, $real => RETURN reader.procs.readReal[reader];
$rational => {
r: Rational ~ reader.procs.readRational[reader];
WITH r: r
SELECT
FROM
int => RETURN[REAL[r.num]/REAL[r.den]];
real => RETURN[r.num/r.den];
ENDCASE => ERROR;
};
ENDCASE => ERROR Error[$illegalArgument, "Token is not a number."];
};
ReadIdentifier:
PUBLIC
PROC[reader: Reader]
RETURNS[Identifier] ~ {
text: REF TEXT ~ reader.text;
err: {ok, zeroLength, badBegin, badChar} ← ok;
atom: ATOM ← NIL;
scratch: REF TEXT ~ RefText.ObtainScratch[text.length];
{
ENABLE
UNWIND => RefText.ReleaseScratch[scratch];
id: REF TEXT ← scratch;
FOR i:
NAT
IN[0..text.length)
DO
char: CHAR ← text[i];
SELECT char
FROM
IN['a..'z] => NULL;
IN['A..'Z] => char ← char+('a-'A);
IN['0..'9], '- => IF i=0 THEN err ← $badBegin;
ENDCASE => err ← $badChar;
id ← RefText.AppendChar[id, char];
ENDLOOP;
IF id.length=0 THEN err ← $zeroLength;
IF err=ok THEN atom ← Atom.MakeAtomFromRefText[id];
};
RefText.ReleaseScratch[scratch];
IF err=ok THEN RETURN[atom]
ELSE
ERROR Error[$illegalIdentifier,
SELECT err
FROM
zeroLength => "An Identifier may not have zero length.",
badBegin => IO.PutFR["The Identifier \"%g\" does not begin with a letter.", IO.text[text]],
badChar => IO.PutFR["The Identifier \"%g\" contains an illegal character.", IO.text[text]],
ENDCASE => NIL];
};
ReadRope:
PUBLIC
PROC[reader: Reader]
RETURNS[rope:
ROPE] ~ {
RETURN[Rope.FromRefText[reader.text]];
};
ReadVector:
PUBLIC
PROC[reader: Reader]
RETURNS[Vector] ~ {
RETURN reader.procs.readVector[reader];
};
Parsing the skeleton:
skeleton ::= [body] block
block ::= BEGIN [NOPAGES] content node* END
content ::= body | block
node ::= [PAGEINSTRUCTIONS body] content
GetSkeleton:
PUBLIC
PROC[reader: Reader]
RETURNS[block: Block] ~ {
instructions: Index ← nullIndex;
reader.GetToken[];
IF reader.token.op=$beginBody
THEN {
instructions ← ReadBody[reader];
reader.GetToken[];
};
block ← ReadBlock[reader];
block.preamble.instructions ← instructions;
};
ReadBlock:
PROC[reader: Reader]
RETURNS[block: Block] = {
IF reader.token.op=$beginBlock
THEN {
noPages: BOOL ← FALSE;
preamble: Node ← NIL;
list: LIST OF Node ← NIL;
size: NAT ← 0;
reader.GetToken[];
IF reader.token.op=$noPages THEN { noPages ← TRUE; reader.GetToken[] };
preamble ← ReadContent[reader];
DO reader.GetToken[];
IF reader.token.op=$endBlock THEN EXIT
ELSE { list ← CONS[ReadNode[reader], list]; size ← size+1 };
ENDLOOP;
block ← NEW[BlockRep[size] ← [noPages: noPages, preamble: preamble, nodes: ]];
WHILE size>0 DO block[size ← size-1] ← list.first; list ← list.rest; ENDLOOP;
RETURN[block];
}
ELSE ERROR Error[$illegalStructure, "Missing block in skeleton."];
};
ReadNode:
PROC[reader: Reader]
RETURNS[node: Node] ~ {
instructions: Index ← nullIndex;
IF reader.token.op=$pageInstructions
THEN {
reader.GetToken[];
instructions ← ReadBody[reader];
reader.GetToken[];
};
node ← ReadContent[reader];
node.instructions ← instructions;
};
ReadContent:
PROC[reader: Reader]
RETURNS[node: Node] ~ {
SELECT reader.token.op
FROM
$beginBody => node ← NEW[NodeRep[body] ← [content: body[ReadBody[reader]]]];
$beginBlock => node ← NEW[NodeRep[block] ← [content: block[ReadBlock[reader]]]];
ENDCASE => ERROR Error[$illegalStructure, "Missing body or block in skeleton."];
};
ReadBody:
PROC[reader: Reader]
RETURNS[index: Index] ~ {
IF reader.token.op=$beginBody THEN { index ← reader.index; FinishBody[reader] }
ELSE ERROR Error[$illegalStructure, "Missing body in skeleton."];
};
FinishBody:
PUBLIC
PROC[reader: Reader] ~ {
IF reader.procs.finishBody#NIL THEN reader.procs.finishBody[reader]
ELSE
DO reader.GetToken[];
SELECT reader.token.op
FROM
IN Primitive => NULL;
$endBody => EXIT;
$beginBody => FinishBody[reader];
$beginVec => FinishVec[reader];
ENDCASE => ERROR Error[$illegalStructure, "Misplaced token inside body."];
ENDLOOP;
};
FinishVec:
PROC[reader: Reader] ~ {
DO reader.GetToken[];
SELECT reader.token.op
FROM
IN Primitive => NULL;
$comma => NULL;
$endVec => EXIT;
$beginBody => FinishBody[reader];
$beginVec => FinishVec[reader];
ENDCASE => ERROR Error[$illegalStructure, "Misplaced token inside vector."];
ENDLOOP;
};
ReadIdentifier: PUBLIC PROC[self: Reader] RETURNS[ATOM] ~ {
text: REF TEXT ~ self.text;
LowerCase: PROC[old: CHAR] RETURNS[CHAR] ~ {
RETURN[IF old IN['A..'Z] THEN old+('a-'A) ELSE old] };
IF text.length=0 THEN ERROR Error[$token, self.token.index];
FOR i: NAT IN[0..text.length) DO
char: CHAR ~ text[i];
SELECT char FROM
IN['a..'z], IN['A..'Z] => NULL;
IN['0..'9], '- => IF i>0 THEN NULL ELSE ERROR Error[$token, self.token.index];
ENDCASE => ERROR Error[$token, self.token.index];
ENDLOOP;
RETURN[Atom.MakeAtom[Rope.Translate[
base: RefText.TrustTextAsRope[text], translator: LowerCase]]];
};
GetWriterProcs:
PUBLIC
PROC[encodingName:
ROPE, encodingVersion: Version]
RETURNS[procs: WriterProcs ← NIL] ~ {
encoding: Encoding ~ FindEncoding[encodingName, encodingVersion];
IF encoding#NIL THEN procs ← encoding.writerProcs
ELSE UnknownEncoding[encodingName, encodingVersion];
};
CreateWriter:
PUBLIC
PROC[stream:
STREAM,
encodingName: ROPE, encodingVersion: Version] RETURNS[Writer] ~ {
procs: WriterProcs ~ GetWriterProcs[encodingName, encodingVersion];
RETURN[NEW[WriterRep ← [procs: procs, stream: stream]]];
};
OpenWriter:
PUBLIC
PROC[name:
ROPE,
encodingName: ROPE, encodingVersion: Version] RETURNS[Writer] ~ {
stream: STREAM ~ FS.StreamOpen[name, $create];
stream.PutF["Interpress/%g/%g.%g ",
IO.rope[encodingName], IO.int[encodingVersion.major], IO.int[encodingVersion.minor]];
RETURN[CreateWriter[stream, encodingName, encodingVersion]];
};
CloseWriter:
PUBLIC
PROC[self: Writer] ~ {
self.stream.Close[];
};
END.