IPXeroxMasterImpl.mesa
Last edited by:
Doug Wyatt, March 1, 1984 2:57:47 pm PST
DIRECTORY
Basics USING [BYTE, LongNumber],
IO USING [Backup, EndOfStream, GetBlock, GetChar, GetIndex, GetLength, PutChar, PutRope, SetIndex, STREAM],
IP USING [Op, Vector],
IPMaster USING [Error, nullToken, Rational, Reader, ReaderProcs, ReaderProcsRep, RegisterEncoding, Token, TokenType, Writer, WriterProcs, WriterProcsRep],
IPXeroxEncoding USING [EncodingValue, SequenceType],
Real USING [DefaultSinglePrecision, NumberType, RealToPair],
RefText USING [InlineReserveChars],
Rope USING [Fetch, Length, ROPE];
IPXeroxMasterImpl: CEDAR PROGRAM
IMPORTS IO, IPMaster, Real, RefText, Rope
SHARES IPMaster
~ BEGIN OPEN IPMaster, IP;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
BYTE: TYPE ~ Basics.BYTE;
ShortNumber: TYPE ~ [-4000..28767];
EncodingValue: TYPE ~ IPXeroxEncoding.EncodingValue;
SequenceType: TYPE ~ IPXeroxEncoding.SequenceType;
EncodeTable: TYPE ~ ARRAY Op OF EncodingValue;
DecodeTable: TYPE ~ PACKED ARRAY EncodingValue OF Op;
encode: REF EncodeTable ~ NEW[EncodeTable ← [nil: nil, get: get, makeveclu: makeveclu, makevec: makevec, shape: shape, openvec: openvec, getprop: getprop, getp: getp, mergeprop: mergeprop, frame: frame, fget: fget, fset: fset, poolop: poolop, pool: pool, pget: pget, pset: pset, env: env, makepool: makepool, nopool: nopool, makeco: makeco, makesimpleco: makesimpleco, do: do, dosave: dosave, dosaveall: dosaveall, dobody: dobody, dosavebody: dosavebody, dosaveallbody: dosaveallbody, dosavesimplebody: dosavesimplebody, makecompiledimage: makecompiledimage, pop: pop, copy: copy, dup: dup, roll: roll, exch: exch, mark: mark, unmark: unmark, unmark0: unmark0, count: count, nop: nop, error: error, if: if, ifelse: ifelse, ifcopy: ifcopy, loop: loop, eq: eq, eqname: eqname, gt: gt, ge: ge, and: and, or: or, not: not, type: type, add: add, sub: sub, neg: neg, abs: abs, floor: floor, ceiling: ceiling, trunc: trunc, round: round, mul: mul, div: div, mod: mod, rem: rem, max: max, min: min, sqrt: sqrt, exp: exp, log: log, sin: sin, cos: cos, atan: atan, iget: iget, iset: iset, dround: dround, maket: maket, opent: opent, translate: translate, rotate: rotate, scale: scale, scale2: scale2, concat: concat, invert: invert, transform: transform, transformvec: transformvec, roundxy: roundxy, roundxyvec: roundxyvec, concatt: concatt, move: move, trans: trans, show: show, showandxrel: showandxrel, setxy: setxy, setxyrel: setxyrel, setxrel: setxrel, setyrel: setyrel, getcp: getcp, getcprounded: getcprounded, makepixelarray: makepixelarray, extractpixelarray: extractpixelarray, finddecompressor: finddecompressor, makegray: makegray, findcolor: findcolor, findcoloroperator: findcoloroperator, findcolormodeloperator: findcolormodeloperator, makesampledcolor: makesampledcolor, makesampledblack: makesampledblack, setgray: setgray, moveto: moveto, lineto: lineto, linetox: linetox, linetoy: linetoy, curveto: curveto, conicto: conicto, arcto: arcto, makeoutline: makeoutline, maskfill: maskfill, maskstroke: maskstroke, maskstrokeclosed: maskstrokeclosed, maskvector: maskvector, maskrectangle: maskrectangle, startunderline: startunderline, maskunderline: maskunderline, masktrapezoidx: masktrapezoidx, masktrapezoidy: masktrapezoidy, maskpixel: maskpixel, clipoutline: clipoutline, cliprectangle: cliprectangle, findfont: findfont, findfontvec: findfontvec, modifyfont: modifyfont, setfont: setfont, correctmask: correctmask, correctspace: correctspace, correct: correct, setcorrectmeasure: setcorrectmeasure, setcorrecttolerance: setcorrecttolerance, space: space, beginBody: beginBody, endBody: endBody, beginBlock: beginBlock, endBlock: endBlock, pageInstructions: pageInstructions, noPages: noPages, metricMaster: metricMaster, environmentMaster: environmentMaster, beginVec: nil, comma: nil, endVec: nil]];
decode: REF DecodeTable ~ InvertEncodeTable[encode];
InvertEncodeTable:
PROC[encode:
REF EncodeTable]
RETURNS[
REF DecodeTable] ~ {
decode: REF DecodeTable ~ NEW[DecodeTable ← ALL[nil]];
FOR op: Op IN Op DO decode[encode[op]] ← op ENDLOOP;
RETURN[decode];
};
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."];
};
xeroxReaderProcs: ReaderProcs ~
NEW[ReaderProcsRep ← [
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, "Too many bytes 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[$illegalArgument, "Token type is not $integer."];
};
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]];
$real => ERROR Error[$bug, "Token type $real unexpected."];
ENDCASE => ERROR Error[$illegalArgument, "Token type is not $integer or $real."];
};
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;
IF half<=4
THEN {
num: INT ~ ParseInt[text: text, start: 0, len: half];
den: INT ~ ParseInt[text: text, start: half, len: half];
RETURN[[int[num, den]]];
}
ELSE {
num: REAL ~ ParseReal[text: text, start: 0, len: half];
den: REAL ~ ParseReal[text: text, start: half, len: half];
RETURN[[real[num, den]]];
};
}
ELSE ERROR Error[$illegalToken, "sequenceRational has odd length."]
};
ENDCASE => ERROR Error[$illegalArgument, "Token type is not $rational."];
};
XeroxReadVector:
PROC[reader: Reader]
RETURNS[Vector] ~ {
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[$illegalArgument, "Token is not a vector."];
};
xeroxWriterProcs: WriterProcs ~
NEW[WriterProcsRep ← [
putOp: XeroxPutOp,
putInt: XeroxPutInt,
putReal: XeroxPutReal,
putRational: XeroxPutRational,
putIdentifier: XeroxPutIdentifier,
putString: XeroxPutString,
putInsertfile: XeroxPutInsertfile,
putComment: XeroxPutComment,
putAnnotation: XeroxPutAnnotation
]];
AppendByte:
PROC[stream:
STREAM, byte:
BYTE] ~
INLINE {
stream.PutChar[LOOPHOLE[byte]];
};
NBytes: TYPE ~ [0..4];
BytesInInt:
PROC[i:
INT]
RETURNS[NBytes] ~ {
SELECT i
FROM
IN[-LONG[200B]..LONG[200B]) => RETURN[1];
IN[-LONG[100000B]..LONG[100000B]) => RETURN[2];
IN[-40000000B..40000000B) => RETURN[3];
ENDCASE => RETURN[4];
};
AppendInt:
PROC[stream:
STREAM, int:
INT, b: NBytes] ~ {
IF b>3 THEN AppendByte[stream, LOOPHOLE[int, Basics.LongNumber].hh];
IF b>2 THEN AppendByte[stream, LOOPHOLE[int, Basics.LongNumber].hl];
IF b>1 THEN AppendByte[stream, LOOPHOLE[int, Basics.LongNumber].lh];
IF b>0 THEN AppendByte[stream, LOOPHOLE[int, Basics.LongNumber].ll];
};
AppendSequenceDescriptor:
PROC[stream:
STREAM, type: SequenceType, length:
INT] ~ {
x: [0..40B) ~ LOOPHOLE[type];
SELECT length
FROM
<0 => ERROR Error[$bug, "Sequence length is negative."];
<=377B => { AppendByte[stream, 300B+x]; AppendInt[stream, length, 1] }; -- short
<=77777777B => { AppendByte[stream, 340B+x]; AppendInt[stream, length, 3] }; -- long
ENDCASE => ERROR Error[$bug, "Sequence length is too big."];
};
XeroxPutOp:
PROC[writer: Writer, op: Op] ~ {
stream: STREAM ~ writer.stream;
ev: EncodingValue ~ encode[op];
IF ev#nil
THEN {
x: [0..17777B] ~ LOOPHOLE[ev];
IF x<40B THEN AppendByte[stream, 200B+x] -- short
ELSE { AppendByte[stream, 240B+x/400B]; AppendByte[stream, x MOD 400B] }; -- long
}
ELSE ERROR Error[$illegalArgument, "PutOp[nil] is illegal."];
};
XeroxPutInt:
PROC[writer: Writer, value:
INT] ~ {
stream: STREAM ~ writer.stream;
IF value
IN[ShortNumber.
FIRST .. ShortNumber.
LAST]
THEN {
x: [0..77777B] ~ value-ShortNumber.FIRST;
AppendByte[stream, x/400B]; AppendByte[stream, x MOD 400B];
}
ELSE {
b: NBytes ~ BytesInInt[value];
AppendSequenceDescriptor[stream, sequenceInteger, b];
AppendInt[stream, value, b];
};
};
XeroxPutRational:
PROC[writer: Writer, value: Rational] ~ {
stream: STREAM ~ writer.stream;
WITH value: value
SELECT
FROM
int => {
bn: NBytes ~ BytesInInt[value.num];
bd: NBytes ~ BytesInInt[value.den];
b: NBytes ~ MAX[bn, bd];
AppendSequenceDescriptor[stream, sequenceRational, 2*b];
AppendInt[stream, value.num, b];
AppendInt[stream, value.den, b];
};
real => Error[$unimplemented, "Can't handle real variant of Rational."];
ENDCASE => ERROR;
};
PowerIndex: TYPE ~ [0..9];
PowerArray: TYPE ~ ARRAY PowerIndex OF INT;
power:
REF
READONLY PowerArray ~
NEW[PowerArray =
[1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000]];
XeroxPutReal:
PROC[writer: Writer, value:
REAL] ~ {
type: Real.NumberType; fr: INT; exp10: INTEGER;
[type, fr, exp10] ← Real.RealToPair[value, Real.DefaultSinglePrecision];
SELECT type
FROM
normal =>
IF exp10=0 THEN XeroxPutInt[writer, fr]
ELSE {
e: INTEGER ← -exp10;
f: INT ← fr;
THROUGH[0..10) WHILE (f MOD 10)=0 DO f ← f/10; e ← e-1 ENDLOOP;
IF e IN PowerIndex THEN XeroxPutRational[writer, [int[f, power[e]]]]
ELSE ERROR Error[$bug, "Failed to convert a REAL to a RATIONAL."];
};
zero => XeroxPutInt[writer, 0];
ENDCASE => ERROR Error[$illegalArgument, "Illegal value for a REAL."];
};
XeroxPutIdentifier:
PROC[writer: Writer, rope:
ROPE] ~ {
stream: STREAM ~ writer.stream;
len: INT ~ rope.Length[];
IF len=0 THEN ERROR Error[$illegalArgument, "Identifier may not have zero length."];
FOR i:
INT
IN[0..len)
DO
char: CHAR ~ rope.Fetch[i];
IF i=0
THEN
SELECT char
FROM
IN['a..'z], IN['A..'Z] => NULL;
ENDCASE => ERROR Error[$illegalArgument, "Identifier must begin with a letter."]
ELSE
SELECT char
FROM
IN['a..'z], IN['A..'Z], IN['0..'9], '- => NULL;
ENDCASE => ERROR Error[$illegalArgument, "Illegal character in identifier."];
ENDLOOP;
AppendSequenceDescriptor[stream, sequenceIdentifier, len];
stream.PutRope[rope];
};
XeroxPutString:
PROC[writer: Writer, rope:
ROPE] ~ {
stream: STREAM ~ writer.stream;
AppendSequenceDescriptor[stream, sequenceString, rope.Length[]];
stream.PutRope[rope];
};
XeroxPutInsertfile:
PROC[writer: Writer, rope:
ROPE] ~ {
stream: STREAM ~ writer.stream;
AppendSequenceDescriptor[stream, sequenceInsertfile, rope.Length[]];
stream.PutRope[rope];
};
XeroxPutComment:
PROC[writer: Writer, rope:
ROPE] ~ {
stream: STREAM ~ writer.stream;
AppendSequenceDescriptor[stream, sequenceComment, rope.Length[]];
stream.PutRope[rope];
};
XeroxPutAnnotation:
PROC[writer: Writer, rope:
ROPE] ~ {
ERROR Error[$unimplemented, "Xerox encoding doesn't have annotations."];
};
RegisterEncoding[name: "Xerox", version: [2, 1],
readerProcs: xeroxReaderProcs, writerProcs: xeroxWriterProcs];
END.
StringMap: PROC[rope: ROPE, action: PROC[CARDINAL] RETURNS[BOOL]] RETURNS[BOOL] ~ {
size: INT ~ rope.Size[];
i: INT ← 0; -- current index into rope
offset: CARDINAL ← 0; -- current offset
Get: PROC RETURNS[BYTE] ~ INLINE {
c: CHAR ~ rope.Fetch[i]; i ← i+1; RETURN[LOOPHOLE[c]] };
WHILE i<size DO
c: BYTE ~ Get[];
IF c=255 THEN { IF i<size THEN offset ← Get[]*256 }
ELSE IF action[offset+c] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
};
StringShape: PROC[self: Vector] RETURNS[VectorShape] ~ {
rope: ROPE ~ NARROW[self.data];
n: Integer ← 0; -- vector element count
action: PROC[c: CARDINAL] RETURNS[BOOL] ~ {
IF n<maxInteger THEN { n ← n+1; RETURN[FALSE] }
ELSE RETURN[TRUE];
};
IF StringMap[rope, action] THEN ERROR IPOps.MasterError[LimitExceeded]
ELSE RETURN[[l: 0, n: n]];
};
StringGet: PROC[self: Vector, n: Integer] RETURNS[Any] ~ {
rope: ROPE ~ NARROW[self.data];
i: INT ← 0; -- current vector index
result: CARDINAL ← 0;
action: PROC[c: CARDINAL] RETURNS[BOOL] ~ {
IF i=n THEN { result ← c; RETURN[TRUE] }
ELSE { i ← i+1; RETURN[FALSE] };
};
IF StringMap[rope, action] THEN RETURN[IPOps.IntegerToAny[result]]
ELSE ERROR IPOps.MasterError[BoundsFault];
};
GetVector: PROC[self: Ref, token: Token] RETURNS[Vector] ~ {
IF token.type=vector THEN {
stream: STREAM ~ GetRR[self, token.index];
seq: SequenceDescriptor ~ GetDescriptor[stream];
IF seq.type=sequenceString THEN {
get: PROC RETURNS[CHAR] ~ { RETURN[stream.Get[]] };
rope: ROPE ~ Rope.FromProc[seq.length, get];
RETURN[NEW[VectorRep ← [class: $String,
shape: StringShape, get: StringGet, data: rope]]];
}
ELSE ERROR Error["unimplemented vector type"];
}
ELSE ERROR Error["wrong token type"];
};