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. XIPXeroxReaderImpl.mesa Last edited by: Doug Wyatt, March 8, 1984 6:46:24 pm PST Ê ~˜Jšœ™J™šœ™Jšœ(™(J˜—šÏk ˜ Jšœœœ˜JšœœIœ˜YJšœœ˜Jšœ œX˜fJšœœM˜ZJšœœ˜#Jšœœœ˜J˜—Jšœœ˜ Jšœœ˜&Jšœœœ˜J˜Jšœœœ˜Jšœœœœ˜Jšœœ œ˜J˜Jšœœ˜Jšœ œ˜"J˜Jšœœœ˜+Jš œœœœœ˜:J˜šÏnœœœ˜KJšœœœ˜9Jšœœœœ˜4Jšœ ˜J˜J˜—Jšœ@˜@J˜Jšœœ˜-Jšœœœœ˜@Jšœœ%˜;šžœœœœ˜9Jšœœœ˜#Jšœ˜Jšœ!˜!Jšœ˜Jšœ%˜%Jšœ˜Jšœ"˜"Jšœ(˜(Jšœ,˜,Jšœ*˜*Jšœ˜Jšœ%˜%J˜J˜—šžœœ˜0JšœB˜GJ˜J˜—šžœœœ˜'Jšœ=˜BJ˜J˜—J˜šœœ ˜%J˜Jšœ˜Jšœ˜Jšœ ˜ Jšœ˜Jšœ˜Jšœ˜Jšœ˜J˜—š žœœ œœœœ˜6Jšœœ˜"Jšœ˜J˜—šž œœ œ œ˜/Jšœœ˜Jšœœ˜!Jšœœ˜:Jšœœœ˜?Jšœ˜J˜—š ž œœœœœ˜*Jšœœœœ˜Jšœœœœ(˜BJ˜J˜—šž œœ œœ˜CJšœœ˜Jšœ˜Jšœœ˜%šœœ˜ Jšœ!˜!Jšœœ%œÏc ˜PšœœŸ˜ Jšœ!œ˜>Jšœœ˜ J˜—šœœœŸ˜Jšœœ˜JšœœœŸ˜JšœŸ˜*Jšœœ˜/Jšœœ˜/Jšœœ˜J˜—šœŸ ˜Jšœœœ˜(Jšœœœ˜J˜šœ'˜1Jšœœ˜Jšœ œœœ˜-Jšœ˜—šœŸ.˜1Jšœœ˜JšœœœŸ˜šœŸ˜Jšœ%˜%Jšœ%˜%J˜—Jšœœœ˜*šœ˜Jšœœ ˜Jšœ/˜/JšœKœ˜VJšœœœ˜"J˜—J˜%JšœœœŸ˜BJš œœœœœŸ˜MJšœ˜—šœ ˜Jšœ!˜!Jšœ œœœ˜'Jšœ˜—J˜Jšœ˜J˜—Jšœ˜—Jšœ˜J˜J˜—šžœœ˜)Jšœœ˜Jšœ(œ˜,šœœ˜ JšœŸ ˜ šœœŸ˜ Jšœ˜J˜—šœœœŸ˜Jšœœ˜JšœœœŸ˜JšœŸ˜*šœœ˜'J˜&Jšœ œ˜Jšœ˜—J˜—šœŸ ˜Jšœœ˜JšœœœŸ˜šœŸ˜Jšœ%˜%Jšœ%˜%J˜—JšœŸ˜-J˜—Jšœ˜—J˜J˜—šžœœœœœœœ˜@Jšœœ˜ J˜!Jšœœœ3˜Fšœœœ˜"Jšœœœ ˜šœ˜Jšœ œœœ˜TJ˜Jšœ˜Jšœ˜—Jšœ˜—Jšœœ œœ˜*J˜—J˜šž œœœœœœœ˜BJšœœ˜J˜!šœœœ˜"Jšœœœ ˜šœ˜Jšœ œœœ˜TJ˜Jšœ˜Jšœ˜—Jšœ˜—Jšœœ œœ˜*J˜—J˜šž œœœœ˜3Jšœ˜Jšœœœ˜šœ ˜Jšœ œ3˜EJšœœ2˜B—J˜J˜—šžœœœ˜=Jšœ˜Jšœœœ˜šœ ˜˜šœœœ˜Jšœœ˜Jšœœ.˜6Jšœœ0˜8Jšœ ˜J˜—Jšœœ9˜CJ˜—Jšœœ3˜C—J˜J˜—šž œœœœ˜5Jšœ˜Jšœœœ˜šœ ˜Jšœ œ4˜F˜šœœœ˜Jšœœ˜Jšœœ/˜8Jšœœ1˜:Jšœ ˜J˜—Jšœœ9˜CJ˜—Jšœ œ-˜;Jšœœ;˜K—J˜J˜—šžœœœ˜@Jšœ˜Jšœœœ˜šœ ˜Jšœ œ;˜KJšœœ-˜=—J˜J˜—J˜J˜J˜Jšœ˜—…—Ø(®