<> <<>> <> <> DIRECTORY Basics USING [BYTE], IO USING [Backup, EndOfStream, GetBlock, GetChar, GetIndex, GetLength, SetIndex, STREAM], IPBasic USING [Op, Rational], IPReader USING [Class, ClassRep, EncodedVector, Error, nullToken, Reader, Register, Token, TokenType], IPXerox USING [EncodingTable, EncodingValue, GetEncodingTable, SequenceType, ShortNumber], RefText USING [InlineReserveChars], Rope USING [ROPE]; IPXeroxReaderImpl: CEDAR PROGRAM IMPORTS IO, IPReader, IPXerox, RefText ~ BEGIN OPEN IPReader, IPXerox; ROPE: TYPE ~ Rope.ROPE; STREAM: TYPE ~ IO.STREAM; BYTE: TYPE ~ Basics.BYTE; Op: TYPE ~ IPBasic.Op; Rational: TYPE ~ IPBasic.Rational; DecodingTable: TYPE ~ REF DecodingTableRep; DecodingTableRep: TYPE ~ PACKED ARRAY EncodingValue OF Op; InvertEncodingTable: PROC[encode: EncodingTable] RETURNS[DecodingTable] ~ { decode: DecodingTable ~ NEW[DecodingTableRep _ ALL[nil]]; FOR op: Op IN Op DO decode[encode[op]] _ op ENDLOOP; RETURN[decode]; }; decode: DecodingTable ~ InvertEncodingTable[GetEncodingTable[]]; DefaultingTokenType: TYPE ~ TokenType _ $nil; SequenceTable: TYPE ~ ARRAY SequenceType OF DefaultingTokenType; sequenceTokenType: REF SequenceTable ~ InitSequenceTable[]; InitSequenceTable: PROC RETURNS[s: REF SequenceTable] ~ { s _ NEW[SequenceTable _ ALL[$nil]]; s[$sequenceInteger] _ $integer; s[$sequenceRational] _ $rational; s[$sequenceFloating] _ $real; s[$sequenceIdentifier] _ $identifier; s[$sequenceString] _ $string; s[$sequenceLargeVector] _ $vector; s[$sequencePackedPixelVector] _ $vector; s[$sequenceCompressedPixelVector] _ $vector; s[$sequenceAdaptivePixelVector] _ $vector; s[$sequenceComment] _ $comment; s[$sequenceInsertfile] _ $insertfile; }; InvalidSequenceType: PROC[seq: SequenceType] ~ { ERROR Error[$illegalToken, "Sequence token has illegal SequenceType."]; }; InvalidEncodingValue: PROC[ev: NAT] ~ { ERROR Error[$illegalToken, "Op token has illegal EncodingValue."]; }; xeroxReader: Class ~ NEW[ClassRep _ [ encoding: $Xerox, getToken: XeroxGetToken, readInt: XeroxReadInt, readRational: XeroxReadRational, readReal: XeroxReadReal, readVector: XeroxReadVector, finishBody: XeroxFinishBody ]]; GetByte: PROC[stream: STREAM] RETURNS[BYTE] ~ INLINE { RETURN[LOOPHOLE[stream.GetChar[]]] }; SkipBytes: PROC[stream: STREAM, count: INT] ~ { index: INT ~ stream.GetIndex[]; length: INT ~ stream.GetLength[]; IF count<=(length-index) THEN stream.SetIndex[index+count] ELSE { stream.SetIndex[length]; ERROR IO.EndOfStream[stream] }; }; Continued: PROC[a: BYTE] RETURNS[BOOL] ~ { IF a<300B THEN RETURN[FALSE] ELSE RETURN[LOOPHOLE[a MOD 40B, SequenceType]=$sequenceContinued]; }; XeroxGetToken: PROC[reader: Reader, flushComments: BOOL _ TRUE] ~ { stream: STREAM ~ reader.stream; token: Token _ nullToken; reader.text _ NIL; reader.length _ 0; DO a: BYTE; reader.index _ stream.GetIndex[]; a _ GetByte[stream ! IO.EndOfStream => { token.type _ $eof; EXIT }]; -- 1st byte IF a<200B THEN { -- Short Number reader.shortNumber _ ShortNumber.FIRST+a*400B+GetByte[stream]; token.type _ $shortNumber; EXIT; } ELSE IF a<300B THEN { -- Op ev: [0..17777B] _ a MOD 40B; IF a<240B THEN NULL -- short ELSE ev _ ev*400B+GetByte[stream]; -- long token.op _ decode[LOOPHOLE[ev, EncodingValue]]; IF token.op=$nil THEN InvalidEncodingValue[ev]; token.type _ $op; EXIT; } ELSE { -- Sequence seq: SequenceType ~ LOOPHOLE[a MOD 40B]; text: REF TEXT _ reader.buffer; text.length _ 0; SELECT (token.type _ sequenceTokenType[seq]) FROM $nil, $vector => text _ NIL; $comment => IF flushComments THEN text _ NIL; ENDCASE; DO -- scan sequence data, including continuations length: INT _ GetByte[stream]; IF a<340B THEN NULL -- short ELSE { -- long length _ length*400B+GetByte[stream]; length _ length*400B+GetByte[stream]; }; IF text=NIL THEN SkipBytes[stream, length] ELSE { count: NAT ~ length; text _ RefText.InlineReserveChars[text, count]; IF stream.GetBlock[block: text, startIndex: text.length, count: count]=count THEN NULL ELSE ERROR IO.EndOfStream[stream]; }; reader.length _ reader.length+length; a _ GetByte[stream ! IO.EndOfStream => EXIT]; -- peek at next byte IF NOT Continued[a] THEN { stream.Backup[LOOPHOLE[a]]; EXIT }; -- put it back ENDLOOP; SELECT token.type FROM $nil => InvalidSequenceType[seq]; $comment => IF flushComments THEN LOOP; ENDCASE; reader.text _ text; EXIT; }; ENDLOOP; reader.token _ token; }; XeroxFinishBody: PROC[reader: Reader] ~ { stream: STREAM ~ reader.stream; reader.token _ nullToken; reader.text _ NIL; DO a: BYTE; a _ GetByte[stream]; -- 1st byte IF a<200B THEN { -- Short Number [] _ GetByte[stream]; } ELSE IF a<300B THEN { -- Op ev: [0..17777B] _ a MOD 40B; IF a<240B THEN NULL -- short ELSE ev _ ev*400B+GetByte[stream]; -- long SELECT LOOPHOLE[ev, EncodingValue] FROM $beginBody => XeroxFinishBody[reader]; $endBody => EXIT; ENDCASE; } ELSE { -- Sequence length: INT _ GetByte[stream]; IF a<340B THEN NULL -- short ELSE { -- long length _ length*400B+GetByte[stream]; length _ length*400B+GetByte[stream]; }; SkipBytes[stream, length]; -- skip data bytes }; ENDLOOP; }; ParseInt: PROC[text: REF TEXT, start, len: NAT] RETURNS[INT] ~ { val: INT _ 0; state: {first, pos, neg} _ first; IF len>4 THEN ERROR Error[$overflow, "Number is too big for an INT."]; FOR i: NAT IN[start..start+len) DO b: BYTE ~ LOOPHOLE[text[i]]; SELECT state FROM first => IF b<200B THEN { val _ b; state _ pos } ELSE { val _ 377B-b; state _ neg }; pos => val _ val*400B+b; neg => val _ val*400B+(377B-b); ENDCASE; ENDLOOP; RETURN[IF state=neg THEN -1-val ELSE val]; }; ParseReal: PROC[text: REF TEXT, start, len: NAT] RETURNS[REAL] ~ { val: REAL _ 0; state: {first, pos, neg} _ first; FOR i: NAT IN[start..start+len) DO b: BYTE ~ LOOPHOLE[text[i]]; SELECT state FROM first => IF b<200B THEN { val _ b; state _ pos } ELSE { val _ 377B-b; state _ neg }; pos => val _ val*400B+b; neg => val _ val*400B+(377B-b); ENDCASE; ENDLOOP; RETURN[IF state=neg THEN -1-val ELSE val]; }; XeroxReadInt: PROC[reader: Reader] RETURNS[INT] ~ { token: Token ~ reader.token; text: REF TEXT ~ reader.text; SELECT token.type FROM $integer => RETURN[ParseInt[text: text, start: 0, len: text.length]]; ENDCASE => ERROR Error[$wrongType, "Token type is not $integer."]; }; XeroxReadRational: PROC[reader: Reader] RETURNS[Rational] ~ { token: Token ~ reader.token; text: REF TEXT ~ reader.text; SELECT token.type FROM $rational => { IF (text.length MOD 2)=0 THEN { half: NAT ~ text.length/2; num: INT ~ ParseInt[text: text, start: 0, len: half]; den: INT ~ ParseInt[text: text, start: half, len: half]; RETURN[[num, den]]; } ELSE ERROR Error[$illegalToken, "sequenceRational has odd length."] }; ENDCASE => ERROR Error[$wrongType, "Token type is not $rational."]; }; XeroxReadReal: PROC[reader: Reader] RETURNS[REAL] ~ { token: Token ~ reader.token; text: REF TEXT ~ reader.text; SELECT token.type FROM $integer => RETURN[ParseReal[text: text, start: 0, len: text.length]]; $rational => { IF (text.length MOD 2)=0 THEN { half: NAT ~ text.length/2; num: REAL ~ ParseReal[text: text, start: 0, len: half]; den: REAL ~ ParseReal[text: text, start: half, len: half]; RETURN[num/den]; } ELSE ERROR Error[$illegalToken, "sequenceRational has odd length."] }; $real => ERROR Error[$bug, "Token type $real unexpected."]; ENDCASE => ERROR Error[$wrongType, "Token type is not $integer or $real."]; }; XeroxReadVector: PROC[reader: Reader] RETURNS[EncodedVector] ~ { token: Token ~ reader.token; text: REF TEXT ~ reader.text; SELECT token.type FROM $vector => ERROR Error[$unimplemented, "Can't handle a Vector token yet."]; ENDCASE => ERROR Error[$wrongType, "Token is not a vector."]; }; Register[xeroxReader]; END.