IPXeroxReaderImpl.mesa
Last edited by:
Doug Wyatt, March 8, 1984 6:46:24 pm PST
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.