IPMasterImpl.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Michael Plass, November 15, 1985 2:13:48 pm PST
Doug Wyatt, December 4, 1985 5:11:59 pm PST
DIRECTORY
Basics USING [BYTE, CARD, Comparison, HighHalf, LongNumber, LowHalf, NonNegative],
Convert USING [IntFromRope],
IO USING [EndOfStream, GetBlock, GetChar, GetIndex, PutBlock, PutChar, PutFR1, rope, SetIndex, STREAM],
IPMaster USING [Block, BlockRep, Body, BodyRep, ByteCount, EncodingValue, ErrorDesc, ImagerVariable, LongSequenceLength, MaxLen, MaxTextLen, Node, NodeRep, Op, OpFromEv, OpFromEvArray, PartActionType, SequenceType, ShortEncodingValue, ShortNumber, ShortSequenceLength, Skeleton, SkeletonRep, Token, Version],
IPReal USING [Rational, RationalFromReal],
Real USING [FScale, NumberType, RealToPair, RoundLI],
RefText USING [AppendChar, ObtainScratch, ReleaseScratch],
Rope USING [ActionType, FromRefText, Length, Map, ROPE, Substr],
SymTab USING [Create, Fetch, Ref, Store];
IPMasterImpl: CEDAR PROGRAM
IMPORTS Basics, Convert, IO, IPReal, Real, RefText, Rope, SymTab
EXPORTS IPMaster
~ BEGIN OPEN IPMaster;
BYTE: TYPE ~ Basics.BYTE;
CARD: TYPE ~ Basics.CARD;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
Error: PUBLIC ERROR [error: ErrorDesc] ~ CODE;
Bug: PROC [x: ROPE] ~ { ERROR Error[[code: $bug, explanation: x]] };
InvalidIdentifier: PROC [x: ROPE] ~ { ERROR Error[[code: $invalidIdentifier, explanation: x]] };
InvalidString: PROC [x: ROPE] ~ { ERROR Error[[code: $invalidString, explanation: x]] };
InvalidName: PROC [x: ROPE] ~ { ERROR Error[[code: $invalidName, explanation: x]] };
InvalidVersion:
PROC [x:
ROPE] ~ {
ERROR Error[[code: $invalidVersion, explanation: x]] };
EvFromOp: TYPE ~ REF READONLY EvFromOpArray;
EvFromOpArray:
TYPE ~
PACKED
ARRAY Op
OF EncodingValue;
encodingValueFromOp: EvFromOp ~
NEW[EvFromOpArray = [
nil: nil,
get: get, makeveclu: makeveclu, makevec: makevec, shape: shape,
getprop: getprop, getp: getp, mergeprop: mergeprop,
fget: fget, fset: fset, makesimpleco: makesimpleco, findoperator: findoperator,
do: do, dosave: dosave, dosaveall: dosaveall, dosavesimplebody: dosavesimplebody,
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,
eq: eq, 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,
iget: iget, iset: iset,
maket: maket, translate: translate, rotate: rotate, scale: scale, scale2: scale2,
concat: concat, concatt: concatt, move: move, trans: trans,
setxy: setxy, setxyrel: setxyrel, setxrel: setxrel, setyrel: setyrel, getcp: getcp,
makepixelarray: makepixelarray, finddecompressor: finddecompressor,
extractpixelarray: extractpixelarray, makegray: makegray,
findcolor: findcolor, findcoloroperator: findcoloroperator,
findcolormodeloperator: findcolormodeloperator,
makesampledcolor: makesampledcolor, makesampledblack: makesampledblack,
setgray: setgray, setsampledcolor: setsampledcolor, setsampledblack: setsampledblack,
moveto: moveto, lineto: lineto, linetox: linetox, linetoy: linetoy,
curveto: curveto, conicto: conicto, arcto: arcto, makeoutline: makeoutline,
makeoutlineodd: makeoutlineodd, maskfill: maskfill, maskrectangle: maskrectangle,
startunderline: startunderline, maskunderline: maskunderline,
masktrapezoidx: masktrapezoidx, masktrapezoidy: masktrapezoidy,
maskstroke: maskstroke, maskstrokeclosed: maskstrokeclosed, maskvector: maskvector,
maskdashedstroke: maskdashedstroke, maskpixel: maskpixel,
clipoutline: clipoutline, cliprectangle: cliprectangle,
maskchar: maskchar, makefont: makefont,
findfont: findfont, modifyfont: modifyfont, setfont: setfont,
show: show, showandxrel: showandxrel, showandfixedxrel: showandfixedxrel,
correctmask: correctmask, correctspace: correctspace, correct: correct, space: space,
setcorrectmeasure: setcorrectmeasure, setcorrecttolerance: setcorrecttolerance,
beginBody: beginBody, endBody: endBody,
beginBlock: beginBlock, endBlock: endBlock, contentInstructions: contentInstructions
]];
opFromEncodingValue: OpFromEv ~ InvertEvFromOp[encodingValueFromOp];
InvertEvFromOp:
PROC [encodingValueFromOp: EvFromOp]
RETURNS [OpFromEv] ~ {
opFromEncodingValue: REF OpFromEvArray ~ NEW[OpFromEvArray ← ALL[nil]];
FOR op: Op IN Op DO opFromEncodingValue[encodingValueFromOp[op]] ← op ENDLOOP;
RETURN[opFromEncodingValue];
};
EncodingValueFromOp:
PUBLIC
PROC [op: Op]
RETURNS [EncodingValue] ~ {
RETURN[encodingValueFromOp[op]];
};
OpFromEncodingValue:
PUBLIC
PROC [ev: EncodingValue]
RETURNS [Op] ~ {
RETURN[opFromEncodingValue[ev]];
};
GetOpFromEv:
PUBLIC
PROC
RETURNS [OpFromEv] ~ {
RETURN[opFromEncodingValue];
};
NonDefaultingRope: TYPE ~ ROPE ←
RopeFromOpArray:
TYPE ~
ARRAY Op
OF NonDefaultingRope;
ropeFromOp:
REF RopeFromOpArray ~
NEW[RopeFromOpArray ← [nil:
NIL,
get: "GET", makeveclu: "MAKEVECLU", makevec: "MAKEVEC", shape: "SHAPE",
getprop: "GETPROP", getp: "GETP", mergeprop: "MERGEPROP",
fget: "FGET", fset: "FSET", makesimpleco: "MAKESIMPLECO", findoperator: "FINDOPERATOR",
do: "DO", dosave: "DOSAVE", dosaveall: "DOSAVEALL",
dosavesimplebody: "DOSAVESIMPLEBODY",
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",
eq: "EQ", 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",
iget: "IGET", iset: "ISET", maket: "MAKET",
translate: "TRANSLATE", rotate: "ROTATE", scale: "SCALE", scale2: "SCALE2",
concat: "CONCAT", concatt: "CONCATT", move: "MOVE", trans: "TRANS",
setxy: "SETXY", setxyrel: "SETXYREL", setxrel: "SETXREL", setyrel: "SETYREL",
getcp: "GETCP", makepixelarray: "MAKEPIXELARRAY",
finddecompressor: "FINDDECOMPRESSOR", extractpixelarray: "EXTRACTPIXELARRAY",
makegray: "MAKEGRAY", setgray: "SETGRAY",
findcolor: "FINDCOLOR", findcoloroperator: "FINDCOLOROPERATOR",
findcolormodeloperator: "FINDCOLORMODELOPERATOR",
makesampledcolor: "MAKESAMPLEDCOLOR", makesampledblack: "MAKESAMPLEDBLACK",
setsampledcolor: "SETSAMPLEDCOLOR", setsampledblack: "SETSAMPLEDBLACK",
moveto: "MOVETO", lineto: "LINETO", linetox: "LINETOX", linetoy: "LINETOY",
curveto: "CURVETO", conicto: "CONICTO", arcto: "ARCTO",
makeoutline: "MAKEOUTLINE", makeoutlineodd: "MAKEOUTLINEODD",
maskfill: "MASKFILL", maskrectangle: "MASKRECTANGLE",
startunderline: "STARTUNDERLINE", maskunderline: "MASKUNDERLINE",
masktrapezoidx: "MASKTRAPEZOIDX", masktrapezoidy: "MASKTRAPEZOIDY",
maskstroke: "MASKSTROKE", maskstrokeclosed: "MASKSTROKECLOSED",
maskvector: "MASKVECTOR", maskdashedstroke: "MASKDASHEDSTROKE",
maskpixel: "MASKPIXEL",
clipoutline: "CLIPOUTLINE", cliprectangle: "CLIPRECTANGLE",
maskchar: "MASKCHAR", makefont: "MAKEFONT", findfont: "FINDFONT",
modifyfont: "MODIFYFONT", setfont: "SETFONT",
show: "SHOW", showandxrel: "SHOWANDXREL", showandfixedxrel: "SHOWANDFIXEDXREL",
correctmask: "CORRECTMASK", correctspace: "CORRECTSPACE", space: "SPACE",
setcorrectmeasure: "SETCORRECTMEASURE", setcorrecttolerance: "SETCORRECTTOLERANCE",
correct: "CORRECT",
beginBody: "{", endBody: "}", beginBlock: "BEGIN", endBlock: "END",
contentInstructions: "CONTENTINSTRUCTIONS"
]];
opFromRope: SymTab.Ref ~ InvertRopeFromOp[ropeFromOp];
OpFromRopeVal: TYPE ~ REF OpFromRopeValRep;
OpFromRopeValRep:
TYPE ~
RECORD[op: Op];
InvertRopeFromOp:
PROC [ropeFromOp:
REF RopeFromOpArray]
RETURNS [SymTab.Ref] ~ {
opFromRope: SymTab.Ref ~ SymTab.Create[mod: ORD[Op.LAST], case: FALSE];
FOR op: Op
IN Op
DO
key: ROPE ~ ropeFromOp[op];
val: OpFromRopeVal ~ NEW[OpFromRopeValRep ← [op: op]];
IF SymTab.Store[x: opFromRope, key: key, val: val] THEN NULL
ELSE Bug["Duplicate name in opFromRope table."];
ENDLOOP;
RETURN[opFromRope];
};
RopeFromOp:
PUBLIC
PROC [op: Op]
RETURNS [
ROPE] ~ {
RETURN[ropeFromOp[op]];
};
OpFromRope:
PUBLIC
PROC [rope:
ROPE]
RETURNS [Op] ~ {
found: BOOL; val: REF;
[found, val] ← SymTab.Fetch[x: opFromRope, key: rope];
IF found
THEN
WITH val
SELECT
FROM
val: OpFromRopeVal => RETURN[val.op];
ENDCASE => Bug["Bogus value in opFromRope table."];
RETURN[nil];
};
RopeFromImagerVarArray: TYPE ~ ARRAY ImagerVariable OF NonDefaultingRope;
ropeFromImagerVar:
REF RopeFromImagerVarArray ~
NEW[RopeFromImagerVarArray ← [
DCScpx: "DCScpx", DCScpy: "DCScpy",
correctMX: "correctMX", correctMY: "correctMY",
T: "T", priorityImportant: "priorityImportant",
mediumXSize: "mediumXSize", mediumYSize: "mediumYSize",
fieldXMin: "fieldXMin", fieldYMin: "fieldYMin",
fieldXMax: "fieldXMax", fieldYMax: "fieldYMax",
font: "font", color: "color", noImage: "noImage",
strokeWidth: "strokeWidth", strokeEnd: "strokeEnd",
underlineStart: "underlineStart", amplifySpace: "amplifySpace",
correctPass: "correctPass", correctShrink: "correctShrink",
correctTX: "correctTX", correctTY: "correctTY",
strokeJoint: "strokeJoint", clipper: "clipper"
]];
RopeFromImagerVariable:
PUBLIC
PROC [var: ImagerVariable]
RETURNS [
ROPE] ~ {
RETURN[ropeFromImagerVar[var]];
};
MapParts:
PUBLIC
PROC [base:
ROPE, start:
INT ← 0, len:
INT ← MaxLen,
delimiter:
CHAR, action: PartActionType]
RETURNS [
BOOL] ~ {
next, pos: INT ← start; -- next = next char index, pos = start of part
mapPartsAction: Rope.ActionType ~ {
index: INT ~ next; next ← next+1;
IF c=delimiter THEN { quit ← action[base: base, start: pos, len: index-pos]; pos ← next };
};
IF Rope.Map[base: base, start: start, len: len, action: mapPartsAction] THEN RETURN[TRUE];
RETURN[action[base: base, start: pos, len: next-pos]]; -- don't forget the last one!
};
ValidateIdentifier:
PUBLIC
PROC [rope:
ROPE, start:
INT ← 0, len:
INT ← MaxLen] ~ {
state: {first, rest} ← first;
identifierChar: Rope.ActionType ~ {
SELECT state
FROM
first =>
SELECT c
FROM
IN['a..'z], IN['A..'Z] => state ← rest;
ENDCASE => RETURN[quit: TRUE]; -- illegal first char
rest =>
SELECT c
FROM
IN['a..'z], IN['A..'Z], IN['0..'9], '- => NULL;
ENDCASE => RETURN[quit: TRUE]; -- illegal char
ENDCASE => Bug["Undefined state in ValidateIdentifier."];
};
IF Rope.Map[base: rope, start: start, len: len, action: identifierChar]
THEN
SELECT state
FROM
first => InvalidIdentifier["Identifier begins with an illegal character."];
rest => InvalidIdentifier["Identifier contains an illegal character."];
ENDCASE => Bug["Undefined state in ValidateIdentifier."];
IF state=first THEN InvalidIdentifier["Identifier is empty."];
};
ValidateName:
PUBLIC
PROC [rope:
ROPE, start:
INT ← 0, len:
INT ← MaxLen] ~ {
parts: INT ← 0;
namePart: PartActionType ~ { parts ← parts+1; ValidateIdentifier[base, start, len] };
[] ← MapParts[base: rope, start: start, len: len, delimiter: '/, action: namePart];
IF parts=0 THEN InvalidName["Name is empty."];
};
ValidateString:
PUBLIC
PROC [rope:
ROPE, start:
INT ← 0, len:
INT ← MaxLen] ~ {
state: {run, escape, escape2, extended, extended2} ← run;
index: INT ← start;
stringChar: Rope.ActionType ~ {
SELECT state
FROM
run => IF c='\377 THEN state ← escape;
escape => IF c='\377 THEN state ← escape2 ELSE state ← run;
escape2 => IF c='\000 THEN state ← extended ELSE quit ← TRUE;
extended => IF c='\377 THEN state ← escape ELSE state ← extended2;
extended2 => IF c='\377 THEN quit ← TRUE ELSE state ← extended;
ENDCASE => Bug["Undefined state in ValidateString."];
index ← index+1;
};
IF Rope.Map[base: rope, start: start, len: len, action: stringChar]
THEN
InvalidString["String contains an invalid escape sequence."];
IF state=run OR state=extended THEN NULL
ELSE InvalidString["String ends in the middle of an escape sequence."];
};
ValidateNumber:
PROC [rope:
ROPE, start:
INT ← 0, len:
INT ← MaxLen] ~ {
chars: INT ← 0;
numberChar: Rope.ActionType ~ { chars ← chars+1; RETURN[quit: NOT (c IN['0..'9])] };
IF Rope.Map[base: rope, start: start, len: len, action: numberChar]
THEN
InvalidVersion["Version number contains an illegal character."];
IF chars=0 THEN InvalidVersion["Version number part is empty."];
};
ValidateVersion:
PUBLIC
PROC [rope:
ROPE, start:
INT ← 0, len:
INT ← MaxLen] ~ {
parts: NAT ← 0;
versionPart: PartActionType ~ { parts ← parts+1; ValidateNumber[base, start, len] };
[] ← MapParts[base: rope, start: start, len: len, delimiter: '., action: versionPart];
SELECT parts
FROM
0 => InvalidVersion["Version number is empty."];
1 => InvalidVersion["Version number has no dot."];
2 => NULL;
ENDCASE => InvalidVersion["Version number has too many parts."];
};
VersionFromRope:
PUBLIC
PROC [rope:
ROPE, start:
INT ← 0, len:
INT ← MaxLen]
RETURNS [version: Version] ~ {
parts: NAT ← 0;
versionPart: PartActionType ~ {
val: INT ~ Convert.IntFromRope[Rope.Substr[base, start, len]];
IF val NOT IN CARDINAL THEN InvalidVersion["Version number part is too big."];
SELECT parts
FROM
0 => version.major ← val;
1 => version.minor ← val;
ENDCASE => Bug["ValidateVersion failed."];
parts ← parts+1;
};
ValidateVersion[rope, start, len];
[] ← MapParts[base: rope, start: start, len: len, delimiter: '., action: versionPart];
IF parts#2 THEN Bug["ValidateVersion failed."];
};
CompareVersion:
PUBLIC
PROC [a, b: Version]
RETURNS [Basics.Comparison] ~ {
SELECT a.major
FROM
<b.major => RETURN[less];
>b.major => RETURN[greater];
ENDCASE =>
SELECT a.minor
FROM
<b.minor => RETURN[less];
>b.minor => RETURN[greater];
ENDCASE => RETURN[equal];
};
PutShortNumber:
PUBLIC PROC [stream:
STREAM, n: ShortNumber] ~ {
x: [0..77777B] ~ n-ShortNumber.FIRST;
IO.PutChar[stream, VAL[x/400B]];
IO.PutChar[stream, VAL[x MOD 400B]];
};
PutShortOp:
PUBLIC PROC [stream:
STREAM, op: ShortEncodingValue] ~ {
x: [0..37B] ~ ORD[op];
IO.PutChar[stream, VAL[200B+x]];
};
PutLongOp:
PUBLIC PROC [stream:
STREAM, op: EncodingValue] ~ {
x: [0..17777B] ~ ORD[op];
IO.PutChar[stream, VAL[240B+x/400B]];
IO.PutChar[stream, VAL[x MOD 400B]];
};
PutShortSequence:
PUBLIC
PROC [
stream:
STREAM, seq: SequenceType, len: ShortSequenceLength] ~ {
x: [0..37B] ~ ORD[seq];
IO.PutChar[stream, VAL[300B+x]];
IO.PutChar[stream, VAL[len]];
};
PutLongSequence:
PUBLIC PROC [
stream:
STREAM, seq: SequenceType, len: LongSequenceLength] ~ {
x: [0..37B] ~ ORD[seq];
lenH: [0..377B] ~ Basics.HighHalf[len]; -- bounds check
lenL: CARDINAL ~ Basics.LowHalf[len];
IO.PutChar[stream, VAL[340B+x]];
IO.PutChar[stream, VAL[lenH]];
IO.PutChar[stream, VAL[lenL/400B]];
IO.PutChar[stream, VAL[lenL MOD 400B]];
};
BytesInInt:
PUBLIC
PROC [val:
INT]
RETURNS [ByteCount] ~ {
x: CARD ~ IF val<0 THEN -(val+1) ELSE val;
SELECT x
FROM
<00000080H => RETURN[1];
<00008000H => RETURN[2];
<00800000H => RETURN[3];
ENDCASE => RETURN[4];
};
PutIntBytes:
PUBLIC
PROC [stream:
STREAM, val:
INT, len: ByteCount] ~ {
bytes: Basics.LongNumber ~ [li[val]];
IF len>3 THEN IO.PutChar[stream, VAL[bytes.hh]];
IF len>2 THEN IO.PutChar[stream, VAL[bytes.hl]];
IF len>1 THEN IO.PutChar[stream, VAL[bytes.lh]];
IF len>0 THEN IO.PutChar[stream, VAL[bytes.ll]];
};
PutByte:
PUBLIC
PROC [stream:
STREAM, byte:
BYTE] ~ {
IO.PutChar[stream, VAL[byte]];
};
PutOp:
PUBLIC
PROC [stream:
STREAM, op: EncodingValue] ~ {
IF op IN ShortEncodingValue THEN PutShortOp[stream, op]
ELSE PutLongOp[stream, op];
};
PutSequence:
PUBLIC
PROC [stream:
STREAM, seq: SequenceType, len:
INT] ~ {
IF len IN ShortSequenceLength THEN PutShortSequence[stream, seq, len]
ELSE PutLongSequence[stream, seq, len];
};
PutInt:
PUBLIC
PROC [stream:
STREAM, n:
INT] ~ {
IF n IN ShortNumber THEN PutShortNumber[stream, n]
ELSE {
len: ByteCount ~ BytesInInt[n];
PutShortSequence[stream, sequenceInteger, len];
PutIntBytes[stream: stream, val: n, len: len];
};
};
PutRational:
PUBLIC
PROC [stream:
STREAM, n, d:
INT] ~ {
len: ByteCount ~ MAX[BytesInInt[n], BytesInInt[d]];
PutShortSequence[stream, sequenceRational, len+len];
PutIntBytes[stream: stream, val: n, len: len];
PutIntBytes[stream: stream, val: d, len: len];
};
tryDecimal: BOOL ← FALSE;
tryRational: BOOL ← TRUE;
decimalPrecision: NAT ← 6;
maxRelativeError:
REAL ← 0.00001;
PutReal:
PUBLIC
PROC [stream:
STREAM, val:
REAL] ~ {
Appends a Number literal. Chooses a rational approximation if necessary.
r: REAL ← val;
n: INT ← 0; d: INT ← 1;
IF
ABS[r]>
INT.
LAST
THEN {
tail: NAT ← 0; -- number of trailing zero bytes
WHILE ABS[r]>INT.LAST DO r ← r/256; tail ← tail+1 ENDLOOP;
PutSequence[stream, sequenceInteger, 4+tail];
PutIntBytes[stream: stream, val: Real.RoundLI[r], len: 4];
THROUGH [0..tail) DO IO.PutChar[stream, VAL[0]] ENDLOOP;
RETURN;
};
IF (n ← Real.RoundLI[r])=r THEN { PutInt[stream, n]; RETURN };
IF tryDecimal
THEN {
type: Real.NumberType; exp10: INTEGER;
[type: type, fr: n, exp10: exp10] ← Real.RealToPair[r: r, precision: decimalPrecision];
IF type=$normal
AND exp10
IN[-9..0)
THEN {
e: NAT ← -exp10;
WHILE (n MOD 10)=0 AND e>0 DO n ← n/10; e ← e-1 ENDLOOP;
THROUGH [0..e) DO d ← d*10 ENDLOOP;
PutRational[stream, n, d]; RETURN;
};
};
IF tryRational
THEN {
rat: IPReal.Rational ← IPReal.RationalFromReal[r];
IF rat.denominator # 0
AND
ABS[
REAL[rat.numerator]/
REAL[rat.denominator] - r] <= maxRelativeError *
ABS[r]
THEN {
IF rat.denominator = 1 THEN PutInt[stream, rat.numerator]
ELSE PutRational[stream, rat.numerator, rat.denominator];
RETURN;
};
};
THROUGH [0..30)
DO
r ← r*2; d ← d*2;
IF (n ← Real.RoundLI[r])=r THEN EXIT;
REPEAT FINISHED => { d ← INT.LAST; n ← Real.RoundLI[d*val] };
ENDLOOP;
PutRational[stream, n, d];
};
PutSequenceRope:
PUBLIC
PROC [stream:
STREAM, seq: SequenceType,
rope:
ROPE, start:
INT ← 0, len:
INT ← MaxLen] ~ {
count: INT ← 0;
charAction: Rope.ActionType ~ { IO.PutChar[stream, c]; count ← count+1 };
size: INT ~ Rope.Length[rope];
length: INT ~ MIN[MAX[0, len], Basics.NonNegative[size-Basics.NonNegative[start]]];
PutSequence[stream, seq, length];
[] ← Rope.Map[base: rope, start: start, len: length, action: charAction];
IF count#length THEN ERROR Error[[code: $bug, explanation: "Bug in PutSequenceRope."]];
};
PutSequenceText:
PUBLIC
PROC [stream:
STREAM, seq: SequenceType,
text:
REF
READONLY
TEXT, start:
NAT ← 0, len:
NAT ← MaxTextLen] ~ {
length: INT ~ MIN[len, NAT[text.length-start]];
PutSequence[stream, seq, length];
IO.PutBlock[self: stream, block: text, startIndex: start, count: length];
};
PutIdentifier:
PUBLIC
PROC [stream:
STREAM, rope:
ROPE, start:
INT ← 0, len:
INT ← MaxLen] ~ {
ValidateIdentifier[rope, start, len];
PutSequenceRope[stream, sequenceIdentifier, rope, start, len];
};
PutString:
PUBLIC
PROC [stream:
STREAM, rope:
ROPE, start:
INT ← 0, len:
INT ← MaxLen] ~ {
ValidateString[rope, start, len];
PutSequenceRope[stream, sequenceString, rope, start, len];
};
PutName:
PUBLIC
PROC [stream:
STREAM, rope:
ROPE, start:
INT ← 0, len:
INT ← MaxLen] ~ {
count: INT ← 0;
namePart: PartActionType ~ { PutIdentifier[stream, base, start, len]; count ← count+1 };
[] ← MapParts[base: rope, start: start, len: len, delimiter: '/, action: namePart];
PutInt[stream, count]; PutOp[stream, makevec];
};
PutBits: PUBLIC PROC [stream: STREAM,
base: LONG POINTER, wordsPerLine: NAT, sMin, fMin, sSize, fSize: NAT] ~ {
scanBytes: NAT ~ 4*((fSize+31)/32); -- bytes per output scan line
block: REF TEXT ~ NEW[TEXT[scanBytes]]; -- scan line buffer
length: INT ~ LONG[4]+LONG[scanBytes]*LONG[sSize]; -- length of token data
bbspace: PrincOps.BBTableSpace;
bb: PrincOps.BitBltTablePtr;
PutDescriptor[stream, sequencePackedPixelVector, length];
PutSigned[stream, 2, 1]; -- BitsPerSample
PutSigned[stream, 2, fSize]; -- ScanLength
TRUSTED {
bb ← PrincOpsUtils.AlignedBBTable[@bbspace];
bb^ ← [dst: [word: NIL, bit: 0], dstBpl: 0, src: [word: NIL, bit: 0], srcDesc: [srcBpl[0]],
width: 0, height: 0, flags: [disjoint: TRUE, gray: FALSE]];
bb.dst.word ← LOOPHOLE[block, LONG POINTER]+SIZE[TEXT[0]];
bb.dstBpl ← scanBytes*Basics.bitsPerByte;
bb.src.word ← base+Basics.LongMult[sMin, wordsPerLine]+fMin/Basics.bitsPerWord;
bb.src.bit ← fMin MOD Basics.bitsPerWord;
bb.srcDesc.srcBpl ← wordsPerLine*Basics.bitsPerWord;
bb.width ← fSize;
bb.height ← 1;
PrincOpsUtils.LongZero[where: bb.dst.word, nwords: scanBytes/2];
};
THROUGH [0..sSize) DO
TRUSTED { PrincOpsUtils.BITBLT[bb] };
IO.PutBlock[self: stream, block: block, startIndex: 0, count: scanBytes];
TRUSTED { bb.src.word ← bb.src.word+wordsPerLine };
ENDLOOP;
};
GetByte:
PROC [stream:
STREAM]
RETURNS [
BYTE] ~
INLINE {
RETURN[ORD[CHAR[IO.GetChar[stream]]]];
};
GetToken:
PUBLIC
PROC [stream:
STREAM, flushComments:
BOOL ←
TRUE]
RETURNS [Token] ~ {
FOR first:
BOOL ←
TRUE,
FALSE
DO
token: Token ← [];
index: INT ~ IO.GetIndex[stream];
b0: BYTE ~ GetByte[stream];
SELECT b0
FROM
<200B => {
b1: BYTE ~ GetByte[stream];
token.num ← ShortNumber.FIRST+(b0*400B+b1);
token.type ← num;
};
<240B => {
token.op ← VAL[b0 MOD 40B];
token.type ← op;
};
<300B => {
b1: BYTE ~ GetByte[stream];
token.op ← VAL[(b0 MOD 40B)*400B+b1];
token.type ← op;
};
<340B => {
b1: BYTE ~ GetByte[stream];
token.seq ← VAL[b0 MOD 40B];
token.len ← b1;
token.type ← seq;
};
ENDCASE => {
b1: BYTE ~ GetByte[stream];
b2: BYTE ~ GetByte[stream];
b3: BYTE ~ GetByte[stream];
token.seq ← VAL[b0 MOD 40B];
token.len ← LONG[b1*400B+b2]*400B+b3;
token.type ← seq;
};
IF flushComments
THEN {
SELECT token.seq
FROM
sequenceComment => GOTO Skip;
sequenceContinued => IF NOT first THEN GOTO Skip;
ENDCASE;
EXITS Skip => { SkipBytes[stream, token.len]; LOOP };
};
token.index ← index;
RETURN[token];
ENDLOOP;
};
GetHeader:
PUBLIC
PROC [stream:
STREAM, prefix:
ROPE]
RETURNS [rope:
ROPE] ~ {
prefixChar: Rope.ActionType ~ {
index: INT ~ IO.GetIndex[stream];
char: CHAR ~ IO.GetChar[stream];
IF char#c THEN ERROR Error[[code: $invalidHeader, explanation:
IO.PutFR1["Header does not begin with \"%g\".", IO.rope[prefix]]]];
};
scratch: REF TEXT ~ RefText.ObtainScratch[100];
text: REF TEXT ← scratch;
[] ← Rope.Map[base: prefix, action: prefixChar];
DO char:
CHAR ~
IO.GetChar[stream];
IF char=' THEN EXIT;
text ← RefText.AppendChar[text, char];
ENDLOOP;
rope ← Rope.FromRefText[text];
RefText.ReleaseScratch[scratch];
};
GetSkeleton:
PUBLIC
PROC [stream:
STREAM]
RETURNS [Skeleton] ~ {
instructions: Body ← NIL;
block: Block ← NIL;
inner:
PROC ~ {
token: Token ← GetToken[stream];
IF token.op=$beginBody
THEN {
instructions ← GetBody[stream, token];
token ← GetToken[stream];
};
block ← GetBlock[stream, token];
};
inner[! IO.EndOfStream => GOTO EndError];
RETURN[NEW[SkeletonRep ← [instructions: instructions, topBlock: block]]];
EXITS
EndError => ERROR Error[[code: $invalidSkeleton,
explanation: "File ends in middle of skeleton."]];
};
SkipToEndOfBody:
PUBLIC
PROC [stream:
STREAM] ~ {
DO token: Token ~ GetToken[stream];
IF token.len#0 THEN SkipBytes[stream, token.len];
SELECT token.op
FROM
beginBody => SkipToEndOfBody[stream];
endBody => EXIT;
ENDCASE;
ENDLOOP;
};
GetBody:
PROC [stream:
STREAM, first: Token]
RETURNS [Body] ~ {
IF first.op=$beginBody
THEN {
SkipToEndOfBody[stream];
RETURN[NEW[BodyRep ← [index: first.index, length: IO.GetIndex[stream]-first.index]]];
};
ERROR Error[[code: $invalidSkeleton, explanation: "Missing { in skeleton."]];
};
GetBlock:
PROC [stream:
STREAM, first: Token]
RETURNS [block: Block] = {
IF first.op=$beginBlock
THEN {
preamble: Node ← NIL;
list: LIST OF Node ← NIL;
size: NAT ← 0; -- number of content nodes
token: Token ← GetToken[stream];
preamble ← GetNode[stream, token];
DO token ← GetToken[stream];
IF token.op=$endBlock THEN EXIT
ELSE {
node: Node ~ GetNode[stream, token];
list ← CONS[node, list]; size ← size+1;
};
ENDLOOP;
block ←
NEW[BlockRep[size] ← [
index: first.index, length: IO.GetIndex[stream]-first.index,
preamble: preamble, nodes: ]];
WHILE size>0 DO block[size ← size-1] ← list.first; list ← list.rest ENDLOOP;
RETURN[block];
};
ERROR Error[[code: $invalidSkeleton, explanation: "Missing BEGIN in skeleton."]];
};
GetNode:
PROC [stream:
STREAM, first: Token]
RETURNS [Node] ~ {
token: Token ← first;
IF token.op=$pageInstructions THEN {
IF preamble THEN ERROR Error[[code: $invalidSkeleton, explanation:
"Misplaced PAGEINSTRUCTIONS in skeleton."]];
token ← GetToken[stream];
pageInstructions ← GetBody[stream, token];
token ← GetToken[stream];
};
SELECT token.op
FROM
$beginBody => {
body: Body ~ GetBody[stream, token];
RETURN[
NEW[NodeRep.body ← [
index: first.index, length: IO.GetIndex[stream]-first.index, bodyOrBlock: body[body]]]];
};
$beginBlock => {
block: Block ~ GetBlock[stream, token];
RETURN[
NEW[NodeRep.block ← [
index: first.index, length: IO.GetIndex[stream]-first.index, bodyOrBlock: block[block]]]];
};
ENDCASE;
ERROR Error[[code: $invalidSkeleton, explanation: "Missing { or BEGIN in skeleton."]];
};
CountPages:
PUBLIC
PROC [block: Block]
RETURNS [pages:
INT ← 0] ~ {
FOR i:
NAT
IN[0..block.size)
DO
WITH block[i]
SELECT
FROM
node: REF NodeRep.body => pages ← pages+1;
node: REF NodeRep.block => pages ← pages+CountPages[node.block];
ENDCASE => ERROR;
ENDLOOP;
};
SetIndex:
PUBLIC
PROC [stream:
STREAM, index:
INT] ~ {
IO.SetIndex[stream, index];
};
SkipBytes:
PUBLIC
PROC [stream:
STREAM, len:
INT] ~ {
IO.SetIndex[stream, IO.GetIndex[stream]+len];
};
CopyBytes:
PUBLIC
PROC [to:
STREAM, from:
STREAM, count:
INT]
RETURNS [copied:
INT] ~ {
rem: INT ← count;
inner:
PROC [buffer:
REF
TEXT] ~ {
WHILE rem>0
DO
request: NAT ~ MIN[rem, buffer.maxLength];
length: NAT ~ IO.GetBlock[self: from, block: buffer, startIndex: 0, count: request];
IO.PutBlock[self: to, block: buffer, startIndex: 0, count: length];
rem ← rem-length;
IF length<request THEN EXIT;
ENDLOOP;
};
scratch: REF TEXT ~ RefText.ObtainScratch[512];
inner[scratch ! UNWIND => RefText.ReleaseScratch[scratch]];
RefText.ReleaseScratch[scratch];
RETURN[count-rem];
};
CopySegment:
PUBLIC
PROC [to:
STREAM, from:
STREAM, start, length:
INT] ~ {
IO.SetIndex[from, start];
IF CopyBytes[to: to, from: from, count: length]#length THEN ERROR IO.EndOfStream[from];
};
IntFromLong:
PROC [long: Basics.LongNumber]
RETURNS [
INT] ~
INLINE {
RETURN [long.li]
};
IntFromSequenceData:
PUBLIC
PROC [text:
REF
READONLY
TEXT,
start:
NAT ← 0, len:
NAT ←
NAT.
LAST]
RETURNS [
INT] ~ {
b: ARRAY [0..4) OF BYTE ← ALL[0];
j: NAT ← 4;
len ← MIN[len, NAT[text.length-start]];
FOR i:
NAT
DECREASING IN[start..start+len)
DO
b[j ← j-1] ← ORD[text[i]];
IF j = 0 THEN EXIT; bounds fault without this
ENDLOOP;
IF b[j] >= 200B THEN {WHILE j > 0 DO b[j ← j-1] ← 377B ENDLOOP};
RETURN [IntFromLong[[bytes[hh: b[0], hl: b[1], lh: b[2], ll: b[3]]]]];
};
RealFromSequenceData:
PUBLIC
PROC [text:
REF
READONLY
TEXT,
start:
NAT ← 0, len:
NAT ←
NAT.
LAST]
RETURNS [val:
REAL ← 0] ~ {
len ← MIN[len, NAT[text.length-start]];
IF
ORD[text[start]]<200B
THEN {
FOR i: NAT IN[start..start+len) DO val ← Real.FScale[val, 8]+ORD[text[i]] ENDLOOP;
}
ELSE {
FOR i: NAT IN[start..start+len) DO val ← Real.FScale[val, 8]+(377B-ORD[text[i]]) ENDLOOP;
val ← -1-val;
};
};
END.