IPMasterImpl.mesa
Copyright (C) 1984 Xerox Corporation. All rights reserved.
Doug Wyatt, December 18, 1984 5:45:03 pm PST
DIRECTORY
Basics USING [bitsPerByte, bitsPerWord, HighHalf, LongMult, LongNumber, LowHalf],
IO USING [EndOfStream, GetBlock, GetChar, GetIndex, PutBlock, PutChar, RopeFromROS, ROS, SetIndex, STREAM],
IPMaster,
Real USING [NumberType, RealToPair, RoundLI],
RefText USING [ObtainScratch, ReleaseScratch],
Rope USING [Fetch, Index, Length, ROPE, Substr],
PrincOps USING [BBTableSpace, BitBltTablePtr, zBNDCK, zLINI],
PrincOpsUtils USING [AlignedBBTable, BITBLT, ZERO],
ShortRational USING [FromReal, Rational],
SymTab USING [Create, Fetch, Ref, Store];
IPMasterImpl: CEDAR PROGRAM
IMPORTS Basics, IO, PrincOpsUtils, Real, RefText, Rope, ShortRational, SymTab
EXPORTS IPMaster
~ BEGIN OPEN IPMaster;
NonNeg:
PROC[x:
INT]
RETURNS[
INT]
~ TRUSTED MACHINE CODE { PrincOps.zLINI; PrincOps.zBNDCK; };
Raises BoundsFault if x<0
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
Error: PUBLIC ERROR[code: ErrorCode, explanation: ROPE] ~ CODE;
evFromOp:
REF EvFromOpArray ~
NEW[EvFromOpArray ← [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, joinpixelarrays: joinpixelarrays,
finddecompressor: finddecompressor,
makegray: makegray, setgray: setgray,
findcolor: findcolor, findcoloroperator: findcoloroperator,
findcolormodeloperator: findcolormodeloperator,
makesampledcolor: makesampledcolor, makesampledblack: makesampledblack,
moveto: moveto, lineto: lineto, linetox: linetox, linetoy: linetoy,
curveto: curveto, conicto: conicto, arcto: arcto, makeoutline: makeoutline,
maskfill: maskfill, maskfillparity: maskfillparity,
maskstroke: maskstroke, maskstrokeclosed: maskstrokeclosed,
maskvector: maskvector, maskrectangle: maskrectangle,
startunderline: startunderline, maskunderline: maskunderline,
masktrapezoidx: masktrapezoidx, masktrapezoidy: masktrapezoidy,
maskpixel: maskpixel,
clipoutline: clipoutline, excludeoutline: excludeoutline,
cliprectangle: cliprectangle, excluderectangle: excluderectangle,
findfont: findfont, findfontvec: findfontvec,
modifyfont: modifyfont, setfont: setfont,
correctmask: correctmask, correctspace: correctspace, space: space,
setcorrectmeasure: setcorrectmeasure, setcorrecttolerance: setcorrecttolerance,
correct: correct,
beginBody: beginBody, endBody: endBody, beginBlock: beginBlock, endBlock: endBlock,
pageInstructions: pageInstructions, noPages: noPages,
metricMaster: metricMaster, environmentMaster: environmentMaster
]];
opFromEv:
REF OpFromEvArray ~ InvertEvFromOp[evFromOp];
InvertEvFromOp:
PROC[evFromOp:
REF EvFromOpArray]
RETURNS[
REF OpFromEvArray] ~ {
opFromEv: REF OpFromEvArray ~ NEW[OpFromEvArray ← ALL[nil]];
FOR op: Op IN Op DO opFromEv[evFromOp[op]] ← op ENDLOOP;
RETURN[opFromEv];
};
GetEvFromOp:
PUBLIC
PROC
RETURNS[
REF
READONLY EvFromOpArray] ~ {
RETURN[evFromOp];
};
GetOpFromEv:
PUBLIC
PROC
RETURNS[
REF
READONLY OpFromEvArray] ~ {
RETURN[opFromEv];
};
EncodingValueFromOp:
PUBLIC
PROC[op: Op]
RETURNS[EncodingValue] ~ {
RETURN[evFromOp[op]];
};
OpFromEncodingValue:
PUBLIC
PROC[ev: EncodingValue]
RETURNS[Op] ~ {
RETURN[opFromEv[ev]];
};
NonDefaultingRope: TYPE ~ ROPE ←
RopeFromOpArray:
TYPE ~
ARRAY Op
OF NonDefaultingRope;
ropeFromOp:
REF RopeFromOpArray ~
NEW[RopeFromOpArray ← [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", joinpixelarrays: "JOINPIXELARRAYS",
finddecompressor: "FINDDECOMPRESSOR",
makegray: "MAKEGRAY", setgray: "SETGRAY",
findcolor: "FINDCOLOR", findcoloroperator: "FINDCOLOROPERATOR",
findcolormodeloperator: "FINDCOLORMODELOPERATOR",
makesampledcolor: "MAKESAMPLEDCOLOR", makesampledblack: "MAKESAMPLEDBLACK",
moveto: "MOVETO", lineto: "LINETO", linetox: "LINETOX", linetoy: "LINETOY",
curveto: "CURVETO", conicto: "CONICTO", arcto: "ARCTO", makeoutline: "MAKEOUTLINE",
maskfill: "MASKFILL", maskfillparity: "MASKFILLPARITY",
maskstroke: "MASKSTROKE", maskstrokeclosed: "MASKSTROKECLOSED",
maskvector: "MASKVECTOR", maskrectangle: "MASKRECTANGLE",
startunderline: "STARTUNDERLINE", maskunderline: "MASKUNDERLINE",
masktrapezoidx: "MASKTRAPEZOIDX", masktrapezoidy: "MASKTRAPEZOIDY",
maskpixel: "MASKPIXEL",
clipoutline: "CLIPOUTLINE", excludeoutline: "EXCLUDEOUTLINE",
cliprectangle: "CLIPRECTANGLE", excluderectangle: "EXCLUDERECTANGLE",
findfont: "FINDFONT", findfontvec: "FINDFONTVEC",
modifyfont: "MODIFYFONT", setfont: "SETFONT",
correctmask: "CORRECTMASK", correctspace: "CORRECTSPACE", space: "SPACE",
setcorrectmeasure: "SETCORRECTMEASURE", setcorrecttolerance: "SETCORRECTTOLERANCE",
correct: "CORRECT",
beginBody: "{", endBody: "}", beginBlock: "BEGIN", endBlock: "END",
pageInstructions: "PAGEINSTRUCTIONS", noPages: "NOPAGES",
metricMaster: "METRICMASTER", environmentMaster: "ENVIRONMENTMASTER"
]];
opFromRope: SymTab.Ref ~ InvertRopeFromOp[ropeFromOp];
InvertRopeFromOp:
PROC[ropeFromOp:
REF RopeFromOpArray]
RETURNS[opFromRope: SymTab.Ref] ~ {
opFromRope ← SymTab.Create[mod: ORD[Op.LAST], case: FALSE];
FOR op: Op
IN Op
DO
key: ROPE ~ ropeFromOp[op];
val: OpVal ~ NEW[Op ← op];
IF SymTab.Store[x: opFromRope, key: key, val: val] THEN NULL
ELSE ERROR Error[bug, "duplicate name in ropeFromOp"];
ENDLOOP;
};
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: OpVal => RETURN[val^];
ENDCASE => ERROR Error[bug, "illegal value in opFromRope"];
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",
showVec: "showVec", color: "color", noImage: "noImage",
strokeWidth: "strokeWidth", strokeStyle: "strokeStyle",
underlineStart: "underlineStart", amplifySpace: "amplifySpace",
correctPass: "correctPass", correctShrink: "correctShrink",
correctTX: "correctTX", correctTY: "correctTY",
strokeDashes: "strokeDashes"
]];
RopeFromImagerVariable:
PUBLIC
PROC[var: ImagerVariable]
RETURNS[
ROPE] ~ {
RETURN[ropeFromImagerVar[var]];
};
MapName:
PUBLIC
PROC[rope:
ROPE, start:
INT ← 0, len:
INT ←
INT.
LAST,
action:
PROC[base:
ROPE, start, len:
INT]
RETURNS[quit:
BOOL ←
FALSE]]
RETURNS[
BOOL] ~ {
size: INT ~ Rope.Length[rope];
rem: INT ~ NonNeg[size-NonNeg[start]];
stop: INT ~ start+MIN[len, rem];
pos: INT ← start;
WHILE pos<stop
DO
slash: INT ~ MIN[stop, Rope.Index[s1: rope, pos1: pos, s2: "/"]];
IF action[base: rope, start: pos, len: slash-pos] THEN RETURN[TRUE];
pos ← slash+1;
ENDLOOP;
RETURN[FALSE];
};
ListFromName:
PUBLIC
PROC[rope:
ROPE, start:
INT ← 0, len:
INT ←
INT.
LAST]
RETURNS[list:
LIST
OF
ROPE ←
NIL] ~ {
tail: LIST OF ROPE ← NIL;
action:
PROC[base:
ROPE, start, len:
INT]
RETURNS[
BOOL ←
FALSE] ~ {
component: ROPE ~ Rope.Substr[base: base, start: start, len: len];
newTail: LIST OF ROPE ~ CONS[component, NIL];
IF tail=NIL THEN list ← newTail ELSE tail.rest ← newTail;
tail ← newTail;
};
[] ← MapName[rope, start, len, action];
};
ValidVersion:
PUBLIC
PROC[rope:
ROPE, start:
INT ← 0, len:
INT ←
INT.
LAST]
RETURNS[
BOOL] ~ {
size: INT ~ Rope.Length[rope];
rem: INT ~ NonNeg[size-NonNeg[start]];
length: INT ~ MIN[len, rem];
state: {begin, major, dot, minor} ← begin;
FOR i:
INT
IN[start..start+length)
DO
char: CHAR ~ Rope.Fetch[rope, i];
SELECT state
FROM
begin =>
SELECT char
FROM
IN['0..'9] => state ← major;
ENDCASE => RETURN[FALSE];
major =>
SELECT char
FROM
IN['0..'9] => NULL;
'. => state ← dot;
ENDCASE => RETURN[FALSE];
dot =>
SELECT char
FROM
IN['0..'9] => state ← minor;
ENDCASE => RETURN[FALSE];
minor =>
SELECT char
FROM
IN['0..'9] => NULL;
ENDCASE => RETURN[FALSE];
ENDCASE => ERROR;
ENDLOOP;
RETURN[state=minor];
};
VersionFromRope:
PUBLIC
PROC[rope:
ROPE, start:
INT ← 0, len:
INT ←
INT.
LAST]
RETURNS[version: Version ← [0, 0]] ~ {
InvalidVersion: PROC ~ { ERROR Error[invalidVersion, "invalid version number"] };
size: INT ~ Rope.Length[rope];
rem: INT ~ NonNeg[size-NonNeg[start]];
length: INT ~ MIN[len, rem];
state: {begin, major, dot, minor} ← begin;
FOR i:
INT
IN[start..start+length)
DO
char: CHAR ~ Rope.Fetch[rope, i];
SELECT state
FROM
begin =>
SELECT char
FROM
IN['0..'9] => { version.major ← (char-'0); state ← major };
ENDCASE => InvalidVersion[];
major =>
SELECT char
FROM
IN['0..'9] => version.major ← version.major*10+(char-'0);
'. => state ← dot;
ENDCASE => InvalidVersion[];
dot =>
SELECT char
FROM
IN['0..'9] => { version.minor ← (char-'0); state ← minor };
ENDCASE => InvalidVersion[];
minor =>
SELECT char
FROM
IN['0..'9] => version.minor ← version.minor*10+(char-'0);
ENDCASE => InvalidVersion[];
ENDCASE => ERROR;
ENDLOOP;
IF state#minor THEN InvalidVersion[];
};
ValidIdentifier:
PUBLIC
PROC[rope:
ROPE, start:
INT ← 0, len:
INT ←
INT.
LAST]
RETURNS[
BOOL] ~ {
size: INT ~ Rope.Length[rope];
rem: INT ~ NonNeg[size-NonNeg[start]];
length: INT ~ MIN[len, rem];
state: {first, rest} ← first;
FOR i:
INT
IN[start..start+length)
DO
char: CHAR ~ Rope.Fetch[rope, i];
SELECT state
FROM
first =>
SELECT char
FROM
IN['a..'z], IN['A..'Z] => state ← rest;
ENDCASE => RETURN[FALSE];
rest =>
SELECT char
FROM
IN['a..'z], IN['A..'Z], IN['0..'9], '- => NULL;
ENDCASE => RETURN[FALSE];
ENDCASE => ERROR;
ENDLOOP;
RETURN[state=rest];
};
ValidName:
PUBLIC
PROC[rope:
ROPE, start:
INT ← 0, len:
INT ←
INT.
LAST]
RETURNS[
BOOL] ~ {
action:
PROC[base:
ROPE, start, len:
INT]
RETURNS[quit:
BOOL] ~ {
RETURN[NOT ValidIdentifier[base, start, len]];
};
RETURN[NOT MapName[rope, start, len, action]];
};
ValidString:
PUBLIC
PROC[rope:
ROPE, start:
INT ← 0, len:
INT ←
INT.
LAST]
RETURNS[
BOOL] ~ {
size: INT ~ Rope.Length[rope];
rem: INT ~ NonNeg[size-NonNeg[start]];
length: INT ~ MIN[len, rem];
state: {run, escape, escape2, extended, extended2} ← run;
FOR i:
INT
IN[start..start+length)
DO
char: CHAR ~ Rope.Fetch[rope, i];
SELECT state
FROM
run => IF char='\377 THEN state ← escape;
escape => IF char='\377 THEN state ← escape2 ELSE state ← run;
escape2 => IF char='\000 THEN state ← extended ELSE RETURN[FALSE];
extended => IF char='\377 THEN state ← escape ELSE state ← extended2;
extended2 => IF char='\377 THEN RETURN[FALSE] ELSE state ← extended;
ENDCASE => ERROR;
ENDLOOP;
RETURN[state=run OR state=extended];
};
GetHeader:
PUBLIC
PROC[stream:
STREAM, prefix:
ROPE ←
NIL, maxLength:
INT ← 100]
RETURNS[
ROPE] ~ {
InvalidHeader: PROC ~ { ERROR Error[invalidHeader, "invalid header"] };
prefixLength: INT ~ Rope.Length[prefix];
ros: IO.STREAM ~ IO.ROS[];
FOR i:
INT
IN[0..
MAX[prefixLength, maxLength])
DO
char: CHAR ~ IO.GetChar[stream];
IF i<prefixLength
AND char#Rope.Fetch[prefix, i]
THEN InvalidHeader[];
IF char=' THEN EXIT ELSE IO.PutChar[ros, char];
REPEAT FINISHED => InvalidHeader[]; -- too long
ENDLOOP;
RETURN[IO.RopeFromROS[ros]];
};
GetSkeleton:
PUBLIC
PROC[stream:
STREAM]
RETURNS[Skeleton] ~ {
instructions: Body ← NIL;
block: Block ← NIL;
token: Token ← GetToken[stream];
IF token.ev=$beginBody
THEN {
instructions ← GetBody[stream, token];
token ← GetToken[stream];
};
block ← GetBlock[stream, token];
RETURN[NEW[SkeletonRep ← [instructions: instructions, topBlock: block]]];
};
SkipToEndOfBody:
PUBLIC
PROC[stream:
STREAM] ~ {
DO token: Token ~ GetToken[stream];
SELECT token.ev
FROM
beginBody => SkipToEndOfBody[stream];
endBody => EXIT;
ENDCASE => IF token.type=seq THEN SkipBytes[stream, token.len];
ENDLOOP;
};
GetBody:
PROC[stream:
STREAM, first: Token]
RETURNS[Body] ~ {
IF first.ev=$beginBody
THEN {
SkipToEndOfBody[stream];
RETURN[NEW[BodyRep ← [index: first.index, length: IO.GetIndex[stream]-first.index]]];
};
IO.SetIndex[stream, first.index];
ERROR Error[invalidSkeleton, "missing {"];
};
GetBlock:
PROC[stream:
STREAM, first: Token]
RETURNS[block: Block] = {
IF first.ev=$beginBlock
THEN {
noPages: BOOL ← FALSE;
preamble: Node ← NIL;
list: LIST OF Node ← NIL;
size: NAT ← 0;
token: Token ← GetToken[stream];
IF token.ev=$noPages THEN { noPages ← TRUE; token ← GetToken[stream] };
preamble ← GetNode[stream, token, TRUE];
DO token ← GetToken[stream];
IF token.ev=$endBlock THEN EXIT
ELSE {
page: Node ~ GetNode[stream, token];
list ← CONS[page, list]; size ← size+1;
};
ENDLOOP;
block ←
NEW[BlockRep[size] ← [
index: first.index, length: IO.GetIndex[stream]-first.index,
noPages: noPages, preamble: preamble, nodes: ]];
WHILE size>0 DO block[size ← size-1] ← list.first; list ← list.rest ENDLOOP;
RETURN[block];
};
IO.SetIndex[stream, first.index];
ERROR Error[invalidSkeleton, "missing BEGIN"];
};
GetNode:
PROC[stream:
STREAM, first: Token, preamble:
BOOL ←
FALSE]
RETURNS[Node] ~ {
pageInstructions: Body ← NIL;
token: Token ← first;
IF token.ev=$pageInstructions
THEN {
IF preamble
THEN {
IO.SetIndex[stream, token.index];
ERROR Error[invalidSkeleton, "misplaced PAGEINSTRUCTIONS"];
};
token ← GetToken[stream];
pageInstructions ← GetBody[stream, token];
token ← GetToken[stream];
};
SELECT token.ev
FROM
$beginBody => {
body: Body ~ GetBody[stream, token];
RETURN[
NEW[NodeRep.body ← [
index: first.index, length: IO.GetIndex[stream]-first.index,
pageInstructions: pageInstructions, content: body[body]]]];
};
$beginBlock => {
block: Block ~ GetBlock[stream, token];
RETURN[
NEW[NodeRep.block ← [
index: first.index, length: IO.GetIndex[stream]-first.index,
pageInstructions: pageInstructions, content: block[block]]]];
};
ENDCASE;
IO.SetIndex[stream, token.index];
ERROR Error[invalidSkeleton, "missing { or BEGIN"];
};
SetIndex:
PUBLIC
PROC[stream:
STREAM, index:
INT] ~ {
IO.SetIndex[stream, index];
};
CopyBytes:
PUBLIC
PROC[to:
STREAM, from:
STREAM, count:
INT]
RETURNS[copied:
INT] ~ {
rem: INT ← count;
inner:
PROC[buffer:
REF
TEXT] ~ {
WHILE rem>0
DO
ENABLE UNWIND => RefText.ReleaseScratch[buffer];
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 RETURN;
ERROR IO.EndOfStream[from];
};
GetToken:
PUBLIC
PROC[stream:
STREAM, flushComments:
BOOL ←
TRUE]
RETURNS[Token] ~ {
FOR first:
BOOL ←
TRUE,
FALSE
DO
token: Token ← [];
state: {null, shortNum2, longOp2, shortSeq2, longSeq2, longSeq3, longSeq4} ← null;
a: BYTE ← 0;
token.index ← IO.GetIndex[stream];
DO b:
BYTE ~
ORD[
CHAR[
IO.GetChar[stream]]];
SELECT state
FROM
null =>
SELECT b/40B
FROM
0, 1, 2, 3 => { a ← b; state ← shortNum2 };
4 => { token.ev ← VAL[b MOD 40B]; token.type ← op; EXIT };
5 => { a ← b MOD 40B; state ← longOp2 };
6 => { token.seq ← VAL[b MOD 40B]; state ← shortSeq2 };
7 => { token.seq ← VAL[b MOD 40B]; state ← longSeq2 };
ENDCASE => ERROR;
shortNum2 => { token.num ← VAL[a*400B+b]; token.type ← num; EXIT };
longOp2 => { token.ev ← VAL[a*400B+b]; token.type ← op; EXIT };
shortSeq2 => { token.len ← b; token.type ← seq; EXIT };
longSeq2 => { token.len ← b; state ← longSeq3 };
longSeq3 => { token.len ← token.len*400B+b; state ← longSeq4 };
longSeq4 => { token.len ← token.len*400B+b; token.type ← seq; EXIT };
ENDCASE => ERROR;
ENDLOOP;
IF flushComments
AND token.type=seq
THEN
SELECT token.seq
FROM
sequenceComment => LOOP;
sequenceContinued => IF NOT first THEN LOOP;
ENDCASE;
RETURN[token];
ENDLOOP;
};
SkipBytes:
PUBLIC
PROC[stream:
STREAM, len:
INT] ~ {
IO.SetIndex[stream, IO.GetIndex[stream]+len];
};
GetUnsigned:
PUBLIC
PROC[stream:
STREAM, length: [0..4]]
RETURNS[
LONG
CARDINAL] ~ {
x: LONG CARDINAL ← 0;
FOR i:
NAT
IN [0..length)
DO
b: BYTE ~ ORD[CHAR[IO.GetChar[stream]]];
x ← x*400B+b;
ENDLOOP;
RETURN[x];
};
IntFromData:
PUBLIC
PROC[text:
REF
READONLY
TEXT,
start:
NAT ← 0, len:
NAT ←
NAT.
LAST]
RETURNS[int:
INT ← 0] ~ {
rem: NAT ~ text.length-start;
neg: BOOL ~ ORD[text[start]]>=200B;
FOR i:
NAT
IN[start..start+
MIN[len, rem])
DO
byte: BYTE ← ORD[text[i]];
IF neg THEN byte ← 377B-byte;
IF int<=INT.LAST/400B THEN int ← int*400B+byte
ELSE ERROR Error[overflow, "overflow in IntFromData"];
ENDLOOP;
IF neg THEN int ← -1-int;
};
PutShortNumber:
PUBLIC PROC[stream:
STREAM, n: ShortNumber] ~ {
x: [0..17777B] ~ ORD[n];
IO.PutChar[stream, VAL[x/400B]];
IO.PutChar[stream, VAL[x MOD 400B]];
};
PutShortOp:
PUBLIC PROC[stream:
STREAM, ev: EncodingValue[
VAL[0]..
VAL[37B]]] ~ {
x: [0..37B] ~ ORD[ev];
IO.PutChar[stream, VAL[200B+x]];
};
PutLongOp:
PUBLIC PROC[stream:
STREAM, ev: EncodingValue] ~ {
x: [0..17777B] ~ ORD[ev];
IO.PutChar[stream, VAL[240B+x/400B]];
IO.PutChar[stream, VAL[x MOD 400B]];
};
PutShortSequence:
PUBLIC PROC[stream:
STREAM, seq: SequenceType, len: [0..377B]] ~ {
x: [0..37B] ~ ORD[seq];
IO.PutChar[stream, VAL[300B+x]];
IO.PutChar[stream, VAL[len]];
};
PutLongSequence:
PUBLIC PROC[stream:
STREAM, seq: SequenceType, len:
INT] ~ {
x: [0..37B] ~ ORD[seq];
lenH: [0..377B] ~ Basics.HighHalf[len]; -- this does the 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:
PROC[i:
INT]
RETURNS[[0..4]] ~ {
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];
};
PutUnsigned:
PUBLIC
PROC[stream:
STREAM, len: [0..4], val:
CARD] ~ {
IF len>3 THEN IO.PutChar[stream, VAL[LOOPHOLE[val, Basics.LongNumber].hh]];
IF len>2 THEN IO.PutChar[stream, VAL[LOOPHOLE[val, Basics.LongNumber].hl]];
IF len>1 THEN IO.PutChar[stream, VAL[LOOPHOLE[val, Basics.LongNumber].lh]];
IF len>0 THEN IO.PutChar[stream, VAL[LOOPHOLE[val, Basics.LongNumber].ll]];
};
PutSigned:
PUBLIC
PROC[stream:
STREAM, len: [0..4], val:
INT] ~ {
IF len>3 THEN IO.PutChar[stream, VAL[LOOPHOLE[val, Basics.LongNumber].hh]];
IF len>2 THEN IO.PutChar[stream, VAL[LOOPHOLE[val, Basics.LongNumber].hl]];
IF len>1 THEN IO.PutChar[stream, VAL[LOOPHOLE[val, Basics.LongNumber].lh]];
IF len>0 THEN IO.PutChar[stream, VAL[LOOPHOLE[val, Basics.LongNumber].ll]];
};
PutDescriptor:
PUBLIC
PROC[stream:
STREAM, seq: SequenceType, len:
INT] ~ {
IF len IN[0..377B] THEN PutShortSequence[stream, seq, len]
ELSE PutLongSequence[stream, seq, len];
};
PutOp:
PUBLIC
PROC[stream:
STREAM, op: Op] ~ {
ev: EncodingValue ~ evFromOp[op];
IF ORD[ev] IN[0..37B] THEN PutShortOp[stream, ev]
ELSE PutLongOp[stream, ev];
};
PutInt:
PUBLIC
PROC[stream:
STREAM, n:
INT] ~ {
Appends a Number literal.
IF n IN ShortNumber THEN PutShortNumber[stream, n]
ELSE {
len: [0..4] ~ BytesInInt[n];
PutShortSequence[stream, sequenceInteger, len];
PutSigned[stream, len, n];
};
};
PutBool:
PUBLIC
PROC[stream:
STREAM, bool:
BOOL] ~ {
PutShortNumber[stream, IF bool THEN 1 ELSE 0];
};
PutRational:
PUBLIC
PROC[stream:
STREAM, n, d:
INT] ~ {
len: [0..4] ~ MAX[BytesInInt[n], BytesInInt[d]];
PutShortSequence[stream, sequenceRational, 2*len];
PutSigned[stream, len, n];
PutSigned[stream, len, d];
};
tryDecimal: BOOL ← FALSE;
tryShortRational: 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;
PutDescriptor[stream, sequenceInteger, 4+tail];
PutSigned[stream, 4, Real.RoundLI[r]];
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 tryShortRational
THEN {
rat: ShortRational.Rational ← ShortRational.FromReal[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];
};
PutRope:
PROC[stream:
STREAM, seq: SequenceType,
rope:
ROPE, start:
INT ← 0, len:
INT ←
INT.
LAST] ~ {
size: INT ~ Rope.Length[rope];
rem: INT ~ NonNeg[size-NonNeg[start]];
length: INT ~ MIN[len, rem];
PutDescriptor[stream, seq, length];
FOR i:
INT
IN[start..start+length)
DO
IO.PutChar[stream, Rope.Fetch[rope, i]];
ENDLOOP;
};
PutIdentifier:
PUBLIC
PROC[stream:
STREAM, rope:
ROPE, start:
INT ← 0, len:
INT ←
INT.
LAST] ~ {
Appends an Identifier literal.
! Error[invalidIdentifier] if the rope is not a legal identifier.
IF ValidIdentifier[rope, start, len] THEN PutRope[stream, sequenceIdentifier, rope, start, len]
ELSE ERROR Error[invalidIdentifier, "invalid identifier"];
};
PutString:
PUBLIC
PROC[stream:
STREAM, rope:
ROPE, start:
INT ← 0, len:
INT ←
INT.
LAST] ~ {
Appends the encoding notation for a string. Treats '\377 as an escape code.
See the Character Code Standard, chapter 6, and Interpress, section 2.5.3.
! Error[invalidString] if the rope is not a legal string.
IF ValidString[rope, start, len] THEN PutRope[stream, sequenceString, rope, start, len]
ELSE ERROR Error[invalidString, "invalid string"];
};
PutComment:
PUBLIC
PROC[stream:
STREAM, rope:
ROPE, start:
INT ← 0, len:
INT ←
INT.
LAST] ~ {
Appends a comment token.
PutRope[stream, sequenceComment, rope, start, len];
};
PutInsertFile:
PUBLIC
PROC[stream:
STREAM, rope:
ROPE, start:
INT ← 0, len:
INT ←
INT.
LAST] ~ {
Appends a sequenceInsertFile.
PutRope[stream, sequenceInsertFile, rope, start, len];
};
PutName:
PUBLIC
PROC[stream:
STREAM, rope:
ROPE, start:
INT ← 0, len:
INT ←
INT.
LAST] ~ {
Parses a structured name and appends tokens to build a Vector of Identifiers.
For example, "a/b/c" produces < a b c 3 MAKEVEC >; "foo" produces < foo 1 MAKEVEC >.
See Interpress, section 3.2.1.
! Error[invalidIdentifier] if the name contains an invalid identifier.
depth: INT ← 0;
action:
PROC[base:
ROPE, start, len:
INT]
RETURNS[
BOOL ←
FALSE] ~ {
PutIdentifier[stream, base, start, len];
depth ← depth+1;
};
[] ← MapName[rope, start, len, action];
PutInt[stream, depth];
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.ZERO[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;
};
END.