<> <> <> <<>> DIRECTORY Basics USING [BYTE, UnsafeBlock], IO, IPBasic USING [Op, Rational, XeroxPixelVectorType], IPReader USING [Class, ClassRep, Error, LargeVector, LargeVectorRep, nullToken, Reader, Register, StreamFromInputStream, Token, TokenType], IPXerox USING [EncodingTable, EncodingValue, GetEncodingTable, SequenceType, ShortNumber], RefText USING [InlineReserveChars], Rope USING [ROPE]; IPXeroxReaderImpl: CEDAR PROGRAM IMPORTS IO, IPReader, IPXerox, RefText ~ BEGIN ROPE: TYPE ~ Rope.ROPE; STREAM: TYPE ~ IO.STREAM; BYTE: TYPE ~ Basics.BYTE; Op: TYPE ~ IPBasic.Op; Rational: TYPE ~ IPBasic.Rational; Reader: TYPE ~ IPReader.Reader; Token: TYPE ~ IPReader.Token; DecodingTable: TYPE ~ REF DecodingTableRep; DecodingTableRep: TYPE ~ PACKED ARRAY IPXerox.EncodingValue OF Op; InvertEncodingTable: PROC[encode: IPXerox.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[IPXerox.GetEncodingTable[]]; SequenceTable: TYPE ~ REF SequenceTableRep; SequenceTableRep: TYPE ~ ARRAY IPXerox.SequenceType OF IPReader.TokenType; sequenceTokenType: SequenceTable ~ InitSequenceTable[]; InitSequenceTable: PROC RETURNS[SequenceTable] ~ { s: SequenceTable ~ NEW[SequenceTableRep _ ALL[$nil]]; s[$sequenceInteger] _ $integer; s[$sequenceRational] _ $rational; s[$sequenceFloating] _ $real; s[$sequenceIdentifier] _ $identifier; s[$sequenceString] _ $string; s[$sequenceLargeVector] _ $largeVector; s[$sequencePackedPixelVector] _ $largeVector; s[$sequenceCompressedPixelVector] _ $largeVector; s[$sequenceAdaptivePixelVector] _ $largeVector; s[$sequenceComment] _ $comment; s[$sequenceInsertfile] _ $insertfile; RETURN[s]; }; InvalidSequenceType: PROC[seq: IPXerox.SequenceType] ~ { ERROR IPReader.Error[$illegalToken, "Sequence token has illegal SequenceType."]; }; InvalidEncodingValue: PROC[ev: IPXerox.EncodingValue] ~ { ERROR IPReader.Error[$illegalToken, "Op token has illegal EncodingValue."]; }; xeroxReader: IPReader.Class ~ NEW[IPReader.ClassRep _ [ encoding: $Xerox, getToken: XeroxGetToken, readInt: XeroxReadInt, readRational: XeroxReadRational, readReal: XeroxReadReal, readLargeVector: XeroxReadLargeVector, finishBody: XeroxFinishBody ]]; GetByte: PROC[stream: STREAM] RETURNS[BYTE] ~ INLINE { RETURN[LOOPHOLE[IO.GetChar[stream]]] }; SkipBytes: PROC[stream: STREAM, count: INT] ~ INLINE { IO.SetIndex[stream, IO.GetIndex[stream]+count] }; SequenceDescriptor: TYPE ~ RECORD[type: IPXerox.SequenceType, length: INT]; GetSequenceDescriptor: PROC[stream: STREAM] RETURNS[SequenceDescriptor] ~ { a: BYTE ~ GetByte[stream]; IF a<300B THEN ERROR IPReader.Error[$bug, "Expected a sequence token."] ELSE RETURN[[type: VAL[a MOD 40B], length: GetSequenceLength[stream, a]]]; }; GetSequenceLength: PROC[stream: STREAM, a: BYTE] RETURNS[length: INT] ~ { IF a<300B THEN ERROR; length _ GetByte[stream]; IF a<340B THEN NULL -- short ELSE { -- long length _ length*400B+GetByte[stream]; length _ length*400B+GetByte[stream]; }; }; <> <=300B AND (a MOD 40B)=ORD[IPXerox.SequenceType[$sequenceContinued]]];>> <<};>> <<>> Continued: PROC[a: BYTE] RETURNS[BOOL] ~ INLINE { RETURN[a>=300B AND IPXerox.SequenceType[VAL[a MOD 40B]]=$sequenceContinued]; }; XeroxGetSimpleToken: PROC[reader: Reader, flushComments: BOOL _ TRUE] RETURNS[token: Token _ IPReader.nullToken] ~ { stream: STREAM ~ reader.stream; DO a: BYTE; token.index _ IO.GetIndex[stream]; a _ GetByte[stream ! IO.EndOfStream => { token.type _ $eof; EXIT }]; -- 1st byte IF a<200B THEN { -- Short Number [] _ GetByte[stream]; token.type _ $shortNumber; EXIT; } ELSE IF a<300B THEN { -- Op ev: IPXerox.EncodingValue; IF a<240B THEN ev _ VAL[a MOD 40B] -- short ELSE ev _ VAL[(a MOD 40B)*400B+GetByte[stream]]; -- long token.op _ decode[ev]; IF token.op=$nil THEN InvalidEncodingValue[ev]; token.type _ $op; EXIT; } ELSE { -- Sequence seq: IPXerox.SequenceType ~ VAL[a MOD 40B]; token.type _ sequenceTokenType[seq]; IF token.type=$nil THEN InvalidSequenceType[seq]; DO -- scan sequence data length: INT ~ GetSequenceLength[stream, a]; SkipBytes[stream, length]; a _ GetByte[stream ! IO.EndOfStream => EXIT]; -- peek at next byte IF Continued[a] THEN LOOP -- append continuation ELSE { stream.Backup[VAL[a]]; EXIT }; -- put it back ENDLOOP; IF flushComments AND token.type=$comment THEN LOOP ELSE EXIT; }; ENDLOOP; }; XeroxGetToken: PROC[reader: Reader, buffer: REF TEXT _ NIL, flushComments: BOOL _ TRUE] RETURNS[token: Token _ IPReader.nullToken, text: REF TEXT _ NIL] ~ { stream: STREAM ~ reader.stream; DO a: BYTE; token.index _ stream.GetIndex[]; a _ GetByte[stream ! IO.EndOfStream => { token.type _ $eof; EXIT }]; -- 1st byte IF a<200B THEN { -- Short Number token.shortNumber _ IPXerox.ShortNumber.FIRST+a*400B+GetByte[stream]; token.type _ $shortNumber; EXIT; } ELSE IF a<300B THEN { -- Op ev: IPXerox.EncodingValue _ VAL[a MOD 40B]; IF a<240B THEN NULL -- short ELSE ev _ VAL[ORD[ev]*400B+GetByte[stream]]; -- long token.op _ decode[ev]; IF token.op=$nil THEN InvalidEncodingValue[ev]; token.type _ $op; EXIT; } ELSE { -- Sequence seq: IPXerox.SequenceType ~ VAL[a MOD 40B]; skip: BOOL _ FALSE; token.type _ sequenceTokenType[seq]; SELECT token.type FROM $nil => InvalidSequenceType[seq]; $largeVector => skip _ TRUE; $comment => skip _ flushComments; ENDCASE; IF skip OR buffer=NIL THEN text _ NIL ELSE { text _ buffer; text.length _ 0 }; DO -- scan sequence data length: INT ~ GetSequenceLength[stream, a]; 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]; }; a _ GetByte[stream ! IO.EndOfStream => EXIT]; -- peek at next byte IF Continued[a] THEN LOOP -- append continuation ELSE { stream.Backup[VAL[a]]; EXIT }; -- put it back ENDLOOP; IF flushComments AND token.type=$comment THEN LOOP ELSE EXIT; }; ENDLOOP; }; XeroxFinishBody: PROC[reader: Reader] ~ { stream: STREAM ~ reader.stream; DO a: BYTE ~ GetByte[stream]; -- 1st byte IF a<200B THEN [] _ GetByte[stream] -- Short Number ELSE IF a<300B THEN { -- Op ev: IPXerox.EncodingValue; IF a<240B THEN ev _ VAL[a MOD 40B] -- short ELSE ev _ VAL[(a MOD 40B)*400B+GetByte[stream]]; -- long IF ev=$endBody THEN EXIT; IF ev=$beginBody THEN XeroxFinishBody[reader]; } ELSE { -- Sequence length: INT ~ GetSequenceLength[stream, a]; 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 IPReader.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, token: Token, text: REF TEXT] RETURNS[INT] ~ { SELECT token.type FROM $shortNumber => RETURN[token.shortNumber]; $integer => RETURN[ParseInt[text: text, start: 0, len: text.length]]; ENDCASE => ERROR IPReader.Error[$wrongType, "Token type is not $integer."]; }; XeroxReadRational: PROC[reader: Reader, token: Token, text: REF TEXT] RETURNS[Rational] ~ { 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 IPReader.Error[$illegalToken, "sequenceRational has odd length."] }; ENDCASE => ERROR IPReader.Error[$wrongType, "Token type is not $rational."]; }; XeroxReadReal: PROC[reader: Reader, token: Token, text: REF TEXT] RETURNS[REAL] ~ { SELECT token.type FROM $shortNumber => RETURN[token.shortNumber]; $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 IPReader.Error[$illegalToken, "sequenceRational has odd length."] }; $real => ERROR IPReader.Error[$bug, "Token type $real unexpected."]; ENDCASE => ERROR IPReader.Error[$wrongType, "Token type is not $integer, $rational, or $real."]; }; lvProcs: REF IO.StreamProcs ~ IO.CreateStreamProcs[ variety: $input, class: $InterpressLargeVectorXerox, getChar: LVGetChar, unsafeGetBlock: LVUnsafeGetBlock, endOf: LVEndOf, getIndex: LVGetIndex, setIndex: LVSetIndex, getLength: LVGetLength ]; LVData: TYPE ~ REF LVDataRep; LVDataRep: TYPE ~ RECORD[ master: STREAM, -- stream on the master file tokenIndex: INT, -- index in master of first sequence token seqType: IPXerox.SequenceType _ $nil, -- sequence type bytesPerElement: BYTE _ 0, -- data bytes per vector element rem: INT _ 0, -- number of data bytes remaining in current sequence token index: INT _ 0, -- current stream index length: INT _ unknownLength -- stream length, if known ]; unknownLength: INT ~ -1; LVInit: PROC[data: LVData] ~ { sd: SequenceDescriptor; IO.SetIndex[data.master, data.tokenIndex]; sd _ GetSequenceDescriptor[data.master]; data.rem _ sd.length; data.index _ 0; SELECT (data.seqType _ sd.type) FROM $sequenceLargeVector => { IF MoreData[data] THEN { char: CHAR ~ IO.GetChar[data.master]; data.rem _ data.rem-1; data.bytesPerElement _ ORD[char]; } ELSE ERROR IPReader.Error[$illegalToken, "sequenceLargeVector has zero length."]; }; $sequencePackedPixelVector, $sequenceCompressedPixelVector, $sequenceAdaptivePixelVector => data.bytesPerElement _ 2; ENDCASE => ERROR IPReader.Error[$bug, "Invalid SequenceType for large vector."]; }; MoreData: PROC[data: LVData] RETURNS[BOOL] ~ { <0 ELSE data.index=data.length>> IF data.length=unknownLength OR data.index#data.length THEN { UNTIL data.rem>0 DO peek: BYTE ~ GetByte[data.master ! IO.EndOfStream => GOTO End]; -- peek at next byte IF Continued[peek] THEN data.rem _ GetSequenceLength[data.master, peek] ELSE { IO.Backup[data.master, VAL[peek]]; GOTO End }; -- put it back ENDLOOP; RETURN[TRUE]; EXITS End => data.length _ data.index; }; RETURN[FALSE]; }; LVGetChar: PROC[self: STREAM] RETURNS[CHAR] ~ { data: LVData ~ NARROW[self.streamData]; IF MoreData[data] THEN { char: CHAR ~ IO.GetChar[data.master]; data.rem _ data.rem-1; data.index _ data.index+1; RETURN[char]; } ELSE ERROR IO.EndOfStream[self]; }; LVUnsafeGetBlock: UNSAFE PROC[self: STREAM, block: Basics.UnsafeBlock] RETURNS[nBytesRead: INT _ 0] ~ { data: LVData ~ NARROW[self.streamData]; chunk: Basics.UnsafeBlock _ block; WHILE nBytesRead { stream: STREAM ~ IPReader.StreamFromInputStream[reader.stream]; lvData: LVData ~ NEW[LVDataRep _ [master: stream, tokenIndex: token.index]]; LVInit[lvData]; RETURN[NEW[IPReader.LargeVectorRep _ [ source: IO.CreateStream[streamProcs: lvProcs, streamData: lvData], bytesPerElement: lvData.bytesPerElement, type: SELECT lvData.seqType FROM $sequenceLargeVector => $nil, $sequencePackedPixelVector => $packed, $sequenceCompressedPixelVector => $compressed, $sequenceAdaptivePixelVector => $adaptive, ENDCASE => ERROR ]]]; }; ENDCASE => ERROR IPReader.Error[$wrongType, "Token type is not $largeVector."]; }; IPReader.Register[xeroxReader]; END.