IPVectorImpl.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Doug Wyatt, May 30, 1985 6:01:25 pm PDT
Michael Plass, January 28, 1986 1:35:51 pm PST
DIRECTORY
Basics,
ImagerFont USING [BYTE, MapRope, XChar, XCharProc, XStringProc],
ImagerSample,
IO USING [PutChar, RopeFromROS, ROS, STREAM],
IPInterpreter USING [Any, Array, ArrayRep, BoundsCheckInteger, Bug, EqName, Even, Integer, IntegerFromAny, MasterError, maxInteger, NumberRep, RealFromAny, Vector, VectorClass, VectorClassRep, VectorRep, VectorShape],
PrincOps,
PrincOpsUtils,
Rope;
IPVectorImpl: CEDAR MONITOR
IMPORTS Basics, IO, IPInterpreter, ImagerFont, ImagerSample, PrincOpsUtils, Rope
EXPORTS IPInterpreter
~ BEGIN OPEN IPInterpreter;
ROPE: TYPE ~ Rope.ROPE;
BYTE: TYPE ~ ImagerFont.BYTE;
XChar: TYPE ~ ImagerFont.XChar;
XCharProc: TYPE ~ ImagerFont.XCharProc;
XStringProc: TYPE ~ ImagerFont.XStringProc;
Shape:
PUBLIC
PROC [v: Vector]
RETURNS [VectorShape] ~ {
shape: VectorShape ~ v.class.shape[v];
[] ← BoundsCheckInteger[shape.lowerBound];
IF shape.size=0 THEN NULL
ELSE [] ← BoundsCheckInteger[shape.lowerBound+BoundsCheckInteger[shape.size-1]];
RETURN[shape];
};
Get:
PUBLIC
PROC [v: Vector, i: Integer]
RETURNS [Any] ~ {
IF v.class.get # NIL THEN RETURN[v.class.get[v, BoundsCheckInteger[i]]]
ELSE {
val: INT ← v.class.getInteger[v, BoundsCheckInteger[i]];
RETURN[IF val=0 THEN zeroObj ELSE IF val=1 THEN oneObj ELSE NEW[NumberRep ← [int[val]]]];
};
};
zeroObj: Any ~ NEW[NumberRep ← [zero[0]]];
oneObj: Any ~ NEW[NumberRep ← [int[1]]];
GetInteger:
PUBLIC
PROC [v: Vector, i: Integer]
RETURNS [Integer] ~ {
IF v.class.getInteger # NIL THEN RETURN[v.class.getInteger[v, BoundsCheckInteger[i]]];
RETURN[IntegerFromAny[v.class.get[v, BoundsCheckInteger[i]]]];
};
GetReal:
PUBLIC
PROC [v: Vector, i: Integer]
RETURNS [
REAL] ~ {
RETURN[RealFromAny[v.class.get[v, BoundsCheckInteger[i]]]];
};
GetProp:
PUBLIC
PROC [v: Vector, propName: Any]
RETURNS [found:
BOOL, value: Any] ~ {
IF v.class.getProp#NIL THEN [found, value] ← v.class.getProp[v, propName]
ELSE {
shape: VectorShape ~ Shape[v];
IF NOT Even[shape.size] THEN MasterError[$invalidPropVec,
"Property vector has odd length"];
FOR i:
INT ← 0, i+2
WHILE i<shape.size
DO
j: Integer ~ BoundsCheckInteger[shape.lowerBound+i];
IF EqName[propName, Get[v, j]] THEN RETURN[found: TRUE, value: Get[v, j+1]];
ENDLOOP;
RETURN[found: FALSE, value: NIL];
};
};
GetP:
PUBLIC
PROC [v: Vector, propName: Any]
RETURNS [value: Any] ~ {
found: BOOL ← FALSE;
[found, value] ← GetProp[v, propName];
IF NOT found THEN MasterError[$undefinedProperty, "Property not found"];
};
OutOfBounds:
PROC ~ { MasterError[$boundsFault, "Vector index out of bounds"] };
RunSize:
PUBLIC
PROC [r: Vector]
RETURNS [Integer] ~ {
shape: VectorShape ~ Shape[r];
sum: Integer ← 0; -- sum of the run lengths
IF shape.lowerBound#0 OR NOT Even[shape.size] THEN MasterError[$invalidRunVec,
"Run vector has nonzero lower bound or odd length"];
FOR i: Integer ← 0, i+2
WHILE i<shape.size
DO
run: Integer ~ GetInteger[r, i];
IF run>(maxInteger-sum) THEN MasterError[$boundsFault,
"Sum of run sizes exceeds maxInteger"];
sum ← BoundsCheckInteger[sum+run];
ENDLOOP;
RETURN[sum];
};
RunGet:
PUBLIC
PROC [r: Vector, i: Integer]
RETURNS [Any] ~ {
shape: VectorShape ~ Shape[r];
sum: Integer ← 0; -- sum of the run lengths
IF shape.lowerBound#0 OR NOT Even[shape.size] THEN MasterError[$invalidRunVec,
"Run vector has nonzero lower bound or odd length"];
IF BoundsCheckInteger[i]=0 THEN OutOfBounds[];
FOR i: Integer ← 0, i+2
WHILE i<shape.size
DO
run: Integer ~ GetInteger[r, i];
IF run>(maxInteger-sum) THEN MasterError[$boundsFault,
"Sum of run sizes exceeds maxInteger"];
sum ← BoundsCheckInteger[sum+run];
IF i<=sum THEN RETURN[Get[r, i+1]];
ENDLOOP;
OutOfBounds[];
RETURN[NIL];
};
arrayClass: VectorClass ~
NEW[VectorClassRep ← [type: $Array,
shape: ArrayShape, get: ArrayGet]];
ArrayShape:
PROC [v: Vector]
RETURNS [VectorShape] ~ {
array: Array ~ NARROW[v.data];
RETURN[[lowerBound: BoundsCheckInteger[array.lowerBound], size: array.size]];
};
ArrayGet:
PROC [v: Vector, i: Integer]
RETURNS [Any] ~ {
array: Array ~ NARROW[v.data];
RETURN[array[BoundsCheckInteger[i]-BoundsCheckInteger[array.lowerBound]]];
};
MakeVecLU:
PUBLIC
PROC [l, u: Integer, pop:
PROC
RETURNS [Any]]
RETURNS [Vector] ~ {
array: Array ~ NEW[ArrayRep[BoundsCheckInteger[u]-BoundsCheckInteger[l]+1] ← [lowerBound: l, array: ]];
FOR i: NAT DECREASING IN[0..array.size) DO array[i] ← pop[] ENDLOOP;
RETURN[NEW[VectorRep ← [class: arrayClass, data: array]]];
};
MakeVec:
PUBLIC
PROC [n: Integer, pop:
PROC
RETURNS [Any]]
RETURNS [Vector] ~ {
array: Array ~ NEW[ArrayRep[n] ← [lowerBound: 0, array: ]];
FOR i: NAT DECREASING IN[0..array.size) DO array[i] ← pop[] ENDLOOP;
RETURN[NEW[VectorRep ← [class: arrayClass, data: array]]];
};
CopyArray:
PROC [old: Array]
RETURNS [new: Array] ~ {
new ← NEW[ArrayRep[old.size] ← [lowerBound: BoundsCheckInteger[old.lowerBound], array: ]];
FOR i: NAT IN[0..new.size) DO new[i] ← old[i] ENDLOOP;
};
VectorFromArray:
PUBLIC
PROC [array: Array]
RETURNS [Vector] ~ {
RETURN[NEW[VectorRep ← [class: arrayClass, data: CopyArray[array]]]];
};
ArrayFromVector:
PUBLIC
PROC [v: Vector]
RETURNS [Array] ~ {
IF v.class.type=$Array
THEN {
array: Array ~ NARROW[v.data];
RETURN[CopyArray[array]];
}
ELSE {
shape: VectorShape ~ Shape[v];
array: Array ~ NEW[ArrayRep[shape.size] ← [lowerBound: BoundsCheckInteger[shape.lowerBound], array: ]];
FOR i: NAT IN[0..array.size) DO array[i] ← Get[v, array.lowerBound+i] ENDLOOP;
RETURN[array];
};
};
ZeroData: TYPE ~ REF ZeroDataRep;
ZeroDataRep: TYPE ~ RECORD[n: Integer];
zeroClass: VectorClass ~
NEW[VectorClassRep ← [type: $Zero,
shape: ZeroShape, get: ZeroGet]];
ZeroShape:
PROC [v: Vector]
RETURNS [VectorShape] ~ {
data: ZeroData ~ NARROW[v.data];
RETURN[[lowerBound: 0, size: data.n]];
};
ZeroGet:
PROC [v: Vector, i: Integer]
RETURNS [Any] ~ {
data: ZeroData ~ NARROW[v.data];
IF NOT i IN[0..data.n) THEN OutOfBounds[];
RETURN[NIL];
};
ZeroVec:
PUBLIC
PROC [n: Integer]
RETURNS [Vector] ~ {
data: ZeroData ~ NEW[ZeroDataRep ← [n: BoundsCheckInteger[n]]];
RETURN[NEW[VectorRep ← [class: zeroClass, data: data]]];
};
MergedData: TYPE ~ REF MergedDataRep;
MergedDataRep: TYPE ~ RECORD[v1, v2: Vector];
mergedClass: VectorClass ~
NEW[VectorClassRep ← [type: $Merged,
shape: MergedShape, get: MergedGet, getProp: MergedGetProp]];
MergedShape:
PROC [v: Vector]
RETURNS [VectorShape] ~ {
data: MergedData ~ NARROW[v.data];
MasterError[$undefinedOperation, "SHAPE is undefined for merged property vector"];
RETURN[[0, 0]];
};
MergedGet:
PROC [v: Vector, i: Integer]
RETURNS [Any] ~ {
data: MergedData ~ NARROW[v.data];
MasterError[$undefinedOperation, "GET is undefined for merged property vector"];
RETURN[NIL];
};
MergedGetProp:
PROC [v: Vector, propName: Any]
RETURNS [found:
BOOL, value: Any] ~ {
data: MergedData ~ NARROW[v.data];
[found, value] ← GetProp[data.v2, propName];
IF NOT found THEN [found, value] ← GetProp[data.v1, propName];
};
MergeProp:
PUBLIC
PROC [v1, v2: Vector]
RETURNS [Vector] ~ {
data: MergedData ~ NEW[MergedDataRep ← [v1: v1, v2: v2]];
RETURN[NEW[VectorRep ← [class: mergedClass, data: data]]];
};
StringData: TYPE ~ REF StringDataRep;
StringDataRep: TYPE ~ RECORD[SEQUENCE size: NAT OF XChar];
stringClass: VectorClass ~
NEW[VectorClassRep ← [type: $String,
shape: StringShape, get: StringGet]];
StringShape:
PROC [v: Vector]
RETURNS [VectorShape] ~ {
s: StringData ~ NARROW[v.data];
RETURN[[lowerBound: 0, size: s.size]];
};
StringGet:
PROC [v: Vector, i: Integer]
RETURNS [Any] ~ {
s: StringData ~ NARROW[v.data];
char: XChar ~ s[i];
RETURN[NEW[NumberRep ← [int[LOOPHOLE[char, CARDINAL]]]]];
};
VectorFromString:
PUBLIC
PROC [string: XStringProc]
RETURNS [Vector] ~ {
size, i: NAT ← 0;
s: StringData ← NIL;
count: XCharProc ~ { size ← size+1 };
store: XCharProc ~ { s[i] ← char; i ← i+1 };
string[count]; -- determine size
s ← NEW[StringDataRep[size]];
string[store]; -- store the characters
IF i#size THEN ERROR Bug;
RETURN[NEW[VectorRep ← [class: stringClass, data: s]]];
};
VectorFromRope:
PUBLIC
PROC [rope:
ROPE]
RETURNS [Vector] ~ {
xStringProc: XStringProc ~ {ImagerFont.MapRope[rope: rope, charAction: charAction]};
RETURN [VectorFromString[xStringProc]]
};
StringFromVector:
PUBLIC
PROC [v: Vector, charAction: XCharProc] ~ {
IF v.class.type=$String
THEN {
s: StringData ~ NARROW[v.data];
FOR i: NAT IN[0..s.size) DO charAction[s[i]] ENDLOOP;
}
ELSE {
shape: VectorShape ~ Shape[v];
FOR i:
INT
IN[0..shape.size)
DO
char: CARDINAL ~ GetInteger[v, shape.lowerBound+i];
charAction[LOOPHOLE[char]];
ENDLOOP;
};
};
RopeFromVector:
PUBLIC
PROC [v: Vector]
RETURNS [
ROPE] ~ {
stream: IO.STREAM ~ IO.ROS[];
set: BYTE ← 0;
charAction:
PROC [char: XChar] ~ {
IF char.set#set
THEN {
IO.PutChar[stream, VAL[255]];
IO.PutChar[stream, VAL[set ← char.set]];
};
IO.PutChar[stream, VAL[char.code]];
};
StringFromVector[v, charAction];
RETURN[IO.RopeFromROS[stream]];
};
packedByteClass: VectorClass ~
NEW[VectorClassRep ← [type: $PackedByte,
shape: PackedByteShape, getInteger: PackedByteGetInteger]];
PackedByteData: TYPE ~ REF PackedByteDataRep;
PackedByteDataRep:
TYPE ~
RECORD [
bytes: ROPE,
size: INT,
bytesPerElement: NAT,
signed: BOOL
];
PackedByteShape:
PROC [v: Vector]
RETURNS [VectorShape] ~ {
data: PackedByteData ~ NARROW[v.data];
RETURN[[lowerBound: 0, size: data.size]];
};
PackedByteGetInteger:
PROC [v: Vector, i: Integer]
RETURNS [Integer] ~ {
data: PackedByteData ~ NARROW[v.data];
start: INT ~ BoundsCheckInteger[i]*data.bytesPerElement;
char: CHAR ← Rope.Fetch[data.bytes, start];
val: INT ← ORD[char];
IF data.signed AND val >= 128 THEN val ← val - 256;
FOR i:
INT
IN [1..data.bytesPerElement)
DO
char ← Rope.Fetch[data.bytes, start+i];
val ← Basics.DoubleShiftLeft[[li[val]], 8].li + ORD[char];
ENDLOOP;
RETURN[val];
};
VectorFromBytes:
PUBLIC
PROC [bytes:
ROPE, bytesPerElement:
NAT, signed:
BOOL]
RETURNS [Vector] ~ {
ropeSize: INT ~ Rope.Size[bytes];
bpe: [1..4] ~ bytesPerElement;
data: PackedByteData ← NEW[PackedByteDataRep ← [bytes: bytes, size: ropeSize/bpe, bytesPerElement: bytesPerElement, signed: signed]];
IF data.size*bpe # ropeSize THEN ERROR;
RETURN[NEW[VectorRep ← [class: packedByteClass, data: data]]];
};
packedBitClass: VectorClass ~
NEW[VectorClassRep ← [type: $PackedBits,
shape: PackedBitShape, getInteger: PackedBitGetInteger]];
PackedBitData: TYPE ~ REF PackedBitDataRep;
PackedBitDataRep:
TYPE ~
RECORD [
bytes: ROPE,
size: INT,
dataBitsPerLine: NAT,
bytesPerLine: NAT
];
PackedBitShape:
PROC [v: Vector]
RETURNS [VectorShape] ~ {
data: PackedBitData ~ NARROW[v.data];
RETURN[[lowerBound: 0, size: data.size]];
};
PackedBitGetInteger:
PROC [v: Vector, i: Integer]
RETURNS [Integer] ~ {
data: PackedBitData ~ NARROW[v.data];
index: LONG CARDINAL ~ BoundsCheckInteger[i];
line, dot, val: CARDINAL;
char: CHAR;
[quotient: line, remainder: dot] ← Basics.LongDivMod[index, data.dataBitsPerLine];
char ← Rope.Fetch[data.bytes, Basics.LongMult[line, data.bytesPerLine]+dot/8];
val ← Basics.BITSHIFT[ORD[char], INTEGER[dot MOD 8]-7] MOD 2;
RETURN[val];
};
VectorFromBits:
PUBLIC
PROC [bytes:
ROPE, dataBitsPerLine, padBitsPerLine:
NAT]
RETURNS [Vector] ~ {
ropeSize: INT ~ Rope.Size[bytes];
totalBitsPerLine: NAT ~ dataBitsPerLine+padBitsPerLine;
bytesPerLine: NAT ~ totalBitsPerLine/8;
slop: [0..0] ~ totalBitsPerLine MOD 8;
lines: INT ~ ropeSize/bytesPerLine;
data: PackedBitData ~ NEW[PackedBitDataRep ← [bytes: bytes, size: lines*dataBitsPerLine, dataBitsPerLine: dataBitsPerLine, bytesPerLine: bytesPerLine]];
RETURN [NEW[VectorRep ← [class: packedBitClass, data: data]]]
};
scratchText: REF TEXT ← NIL;
ObtainScratch:
ENTRY
PROC [size:
NAT]
RETURNS [text:
REF
TEXT ←
NIL] ~ {
ENABLE UNWIND => NULL;
IF scratchText#NIL AND scratchText.maxLength >= size THEN {text ← scratchText; text.length ← 0; scratchText ← NIL}
ELSE text ← NEW[TEXT[size]];
};
ReleaseScratch:
ENTRY
PROC [text:
REF
TEXT] ~ {
scratchText ← text;
};
UnsafeGetElements:
PUBLIC
UNSAFE
PROC [vector: Vector, buffer:
LONG
POINTER
TO Basics.RawWords, start:
INT, count:
NAT] ~
UNCHECKED {
IF vector.class = packedByteClass
THEN {
data: PackedByteData ~ NARROW[vector.data];
byteCount: NAT ~ Basics.LongMult[count, data.bytesPerElement];
text: REF TEXT ~ ObtainScratch[byteCount];
startByte: INT ~ BoundsCheckInteger[start]*data.bytesPerElement;
zero: [0..0] ~ Rope.AppendChars[buffer: text, rope: data.bytes, start: startByte, len: byteCount]-byteCount;
bytePtr: LONG POINTER ~ LOOPHOLE[text, LONG POINTER] + SIZE[TEXT[0]];
ImagerSample.UnsafeGetF[samples: buffer, count: count, s: 0, f: 0, base: bytePtr, wordsPerLine: LAST[NAT], bitsPerSample: data.bytesPerElement*8];
ReleaseScratch[text];
}
ELSE {
We hope this does not happen very often.
FOR i:
INT
IN [0..count)
DO
buffer[i] ← GetInteger[vector, start+i];
ENDLOOP;
};
};
bitsPerWord: NAT ~ Basics.bitsPerWord;
nullBitBltTable: PrincOps.BitBltTable ~ [
dst: [word: NIL, bit: 0], dstBpl: 0,
src: [word: NIL, bit: 0], srcDesc: [srcBpl[0]],
width: 0, height: 0, flags: []
];
UnsafeGetBits:
PUBLIC
UNSAFE
PROC [vector: Vector, dst: PrincOps.BitAddress, start:
INT, count:
NAT, srcFunc: PrincOps.SrcFunc, dstFunc: PrincOps.DstFunc] ~
UNCHECKED {
IF vector.class = packedBitClass
THEN {
data: PackedBitData ~ NARROW[vector.data];
text: REF TEXT ~ ObtainScratch[(CARDINAL[count]+7)/8];
index: INT ← BoundsCheckInteger[start];
residual: CARDINAL ← count;
dstBase: LONG POINTER ← dst.word;
dstBit: CARDINAL ← dst.bit;
bbTableSpace: PrincOps.BBTableSpace;
bb: PrincOps.BBptr ~ PrincOpsUtils.AlignedBBTable[@bbTableSpace];
bb^ ← nullBitBltTable;
bb.flags ← [disjoint: TRUE, gray: FALSE, srcFunc: srcFunc, dstFunc: dstFunc];
bb.height ← 1;
bb.src.word ← LOOPHOLE[text, LONG POINTER] + SIZE[TEXT[0]];
UNTIL residual = 0
DO
zero: [0..0];
line, dot, delta, byteCount: CARDINAL;
[quotient: line, remainder: dot] ← Basics.LongDivMod[index, data.dataBitsPerLine];
bb.width ← delta ← MIN[residual, NAT[data.dataBitsPerLine-dot]];
byteCount ← (delta+7)/8;
text.length ← 0;
zero ← Rope.AppendChars[buffer: text, rope: data.bytes, start: Basics.LongMult[line, data.bytesPerLine]+dot/8, len: byteCount]-byteCount;
bb.dst ← [word: dstBase, bit: dstBit];
bb.src.bit ← dot MOD 8;
PrincOpsUtils.BITBLT[bb];
dstBase ← dstBase + NAT[dstBit + delta] / bitsPerWord;
dstBit ← NAT[dstBit + delta] MOD bitsPerWord;
index ← index + delta;
residual ← residual - delta;
ENDLOOP;
ReleaseScratch[text];
}
ELSE ERROR; -- could do it, but it would be slow; avoid at a higher level.
};
InputVectorStreamData: TYPE ~ REF InputVectorStreamRecord;
InputVectorStreamRecord: TYPE ~ RECORD [
v: Vector,
length: INT,
index: INT
];
InputVectorStreamProcs: REF StreamProcs ~ IO.CreateStreamProcs[
variety: $input, class: $InterpressVector,
getChar: InputVectorStreamGetChar,
endOf: InputVectorStreamEndOf,
getIndex: InputVectorStreamGetIndex,
setIndex: InputVectorStreamSetIndex,
getLength: InputVectorStreamGetLength
];
StreamFromVector: PUBLIC PROC [v: Vector, xxx: Xxx]
RETURNS [stream: STREAM] ~ {
RETURN[IO.CreateStream[InputVectorStreamProcs,
NEW[InputVectorStreamRecord ← [v: v, length: rope.Length[], index: 0]]]];
};
InputVectorStreamGetChar: PROC [self: STREAM] RETURNS [char: CHAR] ~ {
data: InputVectorStreamData ~ NARROW[self.streamData];
IF data.index >= data.length THEN ERROR IO.EndOfStream[self]
ELSE {
i: Integer ~ data.index/data.bytesPerElement;
char ← data.rope.InlineFetch[data.index];
data.index ← data.index + 1;
};
};
InputVectorStreamEndOf: PROC [self: STREAM] RETURNS [BOOL] ~ {
data: InputVectorStreamData ~ NARROW[self.streamData];
RETURN[data.index >= data.length];
};
InputVectorStreamGetIndex: PROC [self: STREAM] RETURNS [INT] ~ {
data: InputVectorStreamData ~ NARROW[self.streamData];
RETURN[data.index];
};
InputVectorStreamSetIndex: PROC [self: STREAM, index: INT] ~ {
data: InputVectorStreamData ~ NARROW[self.streamData];
IF index NOT IN [0 .. data.length] THEN ERROR IO.Error[$BadIndex, self];
data.index ← index;
};
InputVectorStreamGetLength: PROC [self: STREAM] RETURNS [length: INT] ~ {
data: InputVectorStreamData ~ NARROW[self.streamData];
RETURN[data.length];
};
END.