IPXeroxReaderImpl.mesa
Copyright © 1984 Xerox Corporation. All rights reserved.
Doug Wyatt, August 24, 1984 10:41:00 am PDT
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];
};
};
Continued: PROC[a: BYTE] RETURNS[BOOL] ~ INLINE {
RETURN[a>=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] ~ {
Invariant: IF MoreData[data] THEN data.rem>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<block.count
AND MoreData[data]
DO
got: INT;
chunk.startIndex ← block.startIndex+nBytesRead;
chunk.count ← MIN[data.rem, block.count-nBytesRead];
TRUSTED { got ← IO.UnsafeGetBlock[data.master, chunk] };
IF got<chunk.count THEN ERROR IO.EndOfStream[data.master];
nBytesRead ← nBytesRead+got;
data.index ← data.index+got;
data.rem ← data.rem-got;
ENDLOOP;
};
LVEndOf:
PROC[self:
STREAM]
RETURNS[
BOOL] ~ {
data: LVData ~ NARROW[self.streamData];
RETURN[NOT MoreData[data]];
};
LVGetIndex:
PROC[self:
STREAM]
RETURNS[
INT] ~ {
data: LVData ~ NARROW[self.streamData];
RETURN[data.index];
};
LVSetIndex:
PROC[self:
STREAM, index:
INT] ~ {
data: LVData ~ NARROW[self.streamData];
IF index<0 THEN ERROR IO.Error[$BadIndex, self];
IF index<data.index THEN LVInit[data];
WHILE data.index<index
AND MoreData[data]
DO
count: INT ~ MIN[data.rem, index-data.index];
SkipBytes[data.master, count];
data.rem ← data.rem-count;
data.index ← data.index+count;
ENDLOOP;
IF data.index<index THEN ERROR IO.EndOfStream[self];
};
LVGetLength:
PROC[self:
STREAM]
RETURNS[
INT] ~ {
data: LVData ~ NARROW[self.streamData];
IF data.length=unknownLength THEN ERROR;
RETURN[data.length];
};
XeroxReadLargeVector:
PROC[reader: Reader, token: Token]
RETURNS[IPReader.LargeVector] ~ {
SELECT token.type
FROM
$largeVector => {
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.