<> <<>> <> <> 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]; }; <<>> <> <<>> <> <> <> <> 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; }; <> <> <> <> <> <> <> <> < NULL;>> < IF i>0 THEN NULL ELSE ERROR Error[$token, self.token.index];>> < ERROR Error[$token, self.token.index];>> <> <> <> <<};>> <<>> 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.