DIRECTORY
Atom,
PS,
RefText,
Rope;

PS2Impl: CEDAR PROGRAM
IMPORTS Atom, PS, RefText, Rope
~ BEGIN OPEN PS;

ROPE: TYPE ~ Rope.ROPE;
ArrayNew: PUBLIC PROC [size: INT] RETURNS [Array] ~ {
IF size IN ArrayIndex THEN {
base: ArrayBase ~ NEW[ArrayBaseRep[size]];
RETURN[[executable: FALSE, access: unlimited, start: 0, length: size, base: base]];
}
ELSE ERROR Error[IF size<0 THEN rangecheck ELSE limitcheck];
};

ArrayTransfer: PUBLIC PROC [to: ArrayBase, toStart: ArrayIndex, 
from: ArrayBase, fromStart: ArrayIndex, length: ArrayIndex] ~ {
FOR i: ArrayIndex IN[0..length) DO
to[toStart+i] _ from[fromStart+i];
ENDLOOP;
};

ArrayGet: PUBLIC PROC [array: Array, index: INT] RETURNS [Any] ~ {
IF index NOT IN[0..array.length) THEN ERROR Error[rangecheck];
RETURN [array.base[array.start+index]];
};

ArrayPut: PUBLIC PROC [array: Array, index: INT, x: Any] ~ {
IF index NOT IN[0..array.length) THEN ERROR Error[rangecheck];
array.base[array.start+index] _ x;
};

ArrayGetInterval: PUBLIC PROC [array: Array, index, count: INT] RETURNS [Array] ~ {
IF index NOT IN[0..array.length] THEN ERROR Error[rangecheck];
IF count NOT IN[0..array.length-index] THEN ERROR Error[rangecheck];
RETURN [[executable: array.executable, access: array.access, 
start: array.start+index, length: count, base: array.base]];
};

ArrayPutInterval: PUBLIC PROC [array: Array, index: INT, interval: Array] ~ {
IF index NOT IN[0..array.length] THEN ERROR Error[rangecheck];
IF interval.length NOT IN[0..array.length-index] THEN ERROR Error[rangecheck];
ArrayTransfer[to: array.base, toStart: array.start+index, 
from: interval.base, fromStart: interval.start, length: interval.length];
};

ArrayCopy: PUBLIC PROC [array1, array2: Array] RETURNS [Array] ~ {
subarray2: Array ~ ArrayGetInterval[array2, 0, array1.length];
ArrayPutInterval[subarray2, 0, array1];
RETURN [subarray2];
};

ArrayStore: PUBLIC PROC [stack: Stack, array: Array] ~ {
IF stack.count<array.length THEN ERROR Error[stack.underflow];
stack.count _ stack.count-array.length;
ArrayTransfer[to: array.base, toStart: array.start, 
from: stack.base, fromStart: stack.count, length: array.length];
};

ArrayLoad: PUBLIC PROC [stack: Stack, array: Array] ~ {
IF (stack.size-stack.count)<array.length THEN ERROR Error[stack.overflow];
ArrayTransfer[to: stack.base, toStart: stack.count, 
from: array.base, fromStart: array.start, length: array.length];
stack.count _ stack.count+array.length;
};

StringNew: PUBLIC PROC [size: INT] RETURNS [String] ~ {
IF size IN StringIndex THEN {
base: StringBase ~ NEW[TEXT[size]];
RETURN[[executable: FALSE, access: unlimited, start: 0, length: size, base: base]];
}
ELSE ERROR Error[IF size<0 THEN rangecheck ELSE limitcheck];
};

StringTransfer: PROC [to: StringBase, toStart: StringIndex, 
from: StringBase, fromStart: StringIndex, length: StringIndex] ~ {
FOR i: StringIndex IN[0..length) DO
to[toStart+i] _ from[fromStart+i];
ENDLOOP;
};

StringGet: PUBLIC PROC [string: String, index: INT] RETURNS [INT] ~ {
IF index NOT IN[0..string.length) THEN ERROR Error[rangecheck];
RETURN [ORD[string.base[string.start+index]]];
};

StringPut: PUBLIC PROC [string: String, index: INT, x: INT] ~ {
IF index NOT IN[0..string.length) THEN ERROR Error[rangecheck];
IF x NOT IN[0..256) THEN ERROR Error[rangecheck];
string.base[string.start+index] _ VAL[CARDINAL[x]];
};

StringGetInterval: PUBLIC PROC [string: String, index, count: INT] RETURNS [String] ~ {
IF index NOT IN[0..string.length] THEN ERROR Error[rangecheck];
IF count NOT IN[0..string.length-index] THEN ERROR Error[rangecheck];
RETURN [[executable: string.executable, access: string.access, 
start: string.start+index, length: count, base: string.base]];
};

StringPutInterval: PUBLIC PROC [string: String, index: INT, interval: String] ~ {
IF index NOT IN[0..string.length] THEN ERROR Error[rangecheck];
IF interval.length NOT IN[0..string.length-index] THEN ERROR Error[rangecheck];
StringTransfer[to: string.base, toStart: string.start+index, 
from: interval.base, fromStart: interval.start, length: interval.length];
};

StringCopy: PUBLIC PROC [string1, string2: String] RETURNS [String] ~ {
substring2: String ~ StringGetInterval[string2, 0, string1.length];
StringPutInterval[substring2, 0, string1];
RETURN [substring2];
};

StringFromRope: PROC [rope: ROPE] RETURNS [String] ~ {
string: String ~ StringNew[Rope.Size[rope]];
FOR i: NAT IN[0..string.length) DO
string.base[i] _ Rope.Fetch[rope, i];
ENDLOOP;
RETURN [string];
};

AtomFromString: PROC [string: String] RETURNS [atom: ATOM] ~ {
scratch: REF TEXT ~ RefText.ObtainScratch[string.length];
text: REF TEXT _ scratch;
text _ RefText.Append[to: text, from: string.base, start: string.start, len: string.length];
atom _ Atom.MakeAtomFromRefText[text];
RefText.ReleaseScratch[scratch];
};

NameFromRope: PROC [rope: ROPE, executable: BOOL _ TRUE] RETURNS [Name] ~ {
atom: ATOM ~ Atom.MakeAtom[rope];
RETURN [[executable, atom]];
};

NameFromString: PROC [string: String, executable: BOOL _ TRUE] RETURNS [Name] ~ {
atom: ATOM ~ AtomFromString[string];
RETURN [[executable, atom]];
};

NameToString: PROC [name: Name, string: String] RETURNS [String] ~ {
rope: ROPE ~ Atom.GetPName[name.atom];
result: String ~ StringGetInterval[string, 0, Rope.Size[rope]];
FOR i: NAT IN[0..result.length) DO
result.base[result.start+i] _ Rope.Fetch[rope, i];
ENDLOOP;
RETURN [result];
};

Parray: PROC [self: Root] ~ {
size: INT ~ PopInt[self.ostack];
PushArray[self.ostack, ArrayNew[size]];
};

Pstartarray: PROC [self: Root] ~ { -- [
PushMark[self.ostack];
};

Pendarray: PROC [self: Root] ~ { -- ]
size: INT ~ CountToMark[self.ostack];
array: Array ~ ArrayNew[size];
ArrayStore[self.ostack, array];
PopMark[self.ostack];
PushArray[self.ostack, array];
};

Paload: PROC [self: Root] ~ {
array: Array ~ PopArray[self.ostack];
IF array.access<readOnly THEN ERROR Error[invalidaccess];
ArrayLoad[self.ostack, array];
PushArray[self.ostack, array];
};

Pastore: PROC [self: Root] ~ {
array: Array ~ PopArray[self.ostack];
IF array.access<unlimited THEN ERROR Error[invalidaccess];
ArrayStore[self.ostack, array];
PushArray[self.ostack, array];
};


Pstring: PROC [self: Root] ~ {
size: INT ~ PopInt[self.ostack];
PushString[self.ostack, StringNew[size]];
};

Panchorsearch: PROC [self: Root] ~ {
seek: String ~ PopString[self.ostack];
string: String ~ PopString[self.ostack];
found: BOOL _ FALSE;
IF string.access<readOnly OR seek.access<readOnly THEN ERROR Error[invalidaccess];
IF seek.length<=string.length THEN {
FOR i: StringIndex IN[0..seek.length) DO
IF string.base[string.start+i]#seek.base[seek.start+i] THEN EXIT;
REPEAT FINISHED => found _ TRUE;
ENDLOOP;
};
IF found THEN {
match: String ~ StringGetInterval[string, 0, seek.length];
post: String ~ StringGetInterval[string, seek.length, string.length-seek.length];
PushString[self.ostack, post];
PushString[self.ostack, match];
PushBool[self.ostack, TRUE];
}
ELSE {
PushString[self.ostack, string];
PushBool[self.ostack, FALSE];
};
};

Psearch: PROC [self: Root] ~ {
seek: String ~ PopString[self.ostack];
string: String ~ PopString[self.ostack];
found: BOOL _ FALSE;
skip: StringIndex _ 0;
IF string.access<readOnly OR seek.access<readOnly THEN ERROR Error[invalidaccess];
FOR skip _ 0, skip+1 UNTIL found OR (string.length-skip)<seek.length DO
FOR i: StringIndex IN[0..seek.length) DO
IF string.base[string.start+skip+i]#seek.base[seek.start+i] THEN EXIT;
REPEAT FINISHED => found _ TRUE;
ENDLOOP;
ENDLOOP;
IF found THEN {
pre: String ~ StringGetInterval[string, 0, skip];
match: String ~ StringGetInterval[string, skip, seek.length];
post: String ~ StringGetInterval[string, skip+seek.length, string.length-(skip+seek.length)];
PushString[self.ostack, post];
PushString[self.ostack, match];
PushString[self.ostack, pre];
PushBool[self.ostack, TRUE];
}
ELSE {
PushString[self.ostack, string];
PushBool[self.ostack, FALSE];
};
};


Plength: PROC [self: Root] ~ {
x: Any ~ Pop[self.ostack];
length: INT _ 1;
SELECT Type[x] FROM
array => {
array: Array ~ ArrayFromAny[x];
IF array.access<readOnly THEN ERROR Error[invalidaccess];
length _ array.length;
};
string => {
string: String ~ StringFromAny[x];
IF string.access<readOnly THEN ERROR Error[invalidaccess];
length _ string.length;
};
dict => {
dict: Dict ~ DictFromAny[x];
IF dict.base.access<readOnly THEN ERROR Error[invalidaccess];
length _ dict.base.length;
};
ENDCASE;
PushInt[self.ostack, length];
};

Pget: PROC [self: Root] ~ {
index: Any ~ Pop[self.ostack];
x: Any ~ Pop[self.ostack];
SELECT Type[x] FROM
array => {
array: Array ~ ArrayFromAny[x];
i: INT ~ IntFromAny[index];
IF array.access<readOnly THEN ERROR Error[invalidaccess];
Push[self.ostack, ArrayGet[array, i]];
};
string => {
string: String ~ StringFromAny[x];
i: INT ~ IntFromAny[index];
IF string.access<readOnly THEN ERROR Error[invalidaccess];
PushInt[self.ostack, StringGet[string, i]];
};
dict => {
dict: Dict ~ DictFromAny[x];
IF dict.base.access<readOnly THEN ERROR Error[invalidaccess];
Push[self.ostack, DictGet[dict, index]];
};
ENDCASE => ERROR Error[typecheck];
};

Pput: PROC [self: Root] ~ {
val: Any ~ Pop[self.ostack];
key: Any ~ Pop[self.ostack];
x: Any ~ Pop[self.ostack];
SELECT Type[x] FROM
array => {
array: Array ~ ArrayFromAny[x];
index: INT ~ IntFromAny[key];
IF array.access<unlimited THEN ERROR Error[invalidaccess];
ArrayPut[array, index, val];
};
string => {
string: String ~ StringFromAny[x];
index: INT ~ IntFromAny[key];
int: INT ~ IntFromAny[val];
IF string.access<unlimited THEN ERROR Error[invalidaccess];
StringPut[string, index, int];
};
dict => {
dict: Dict ~ DictFromAny[x];
IF dict.base.access<unlimited THEN ERROR Error[invalidaccess];
DictPut[dict, key, val];
};
ENDCASE => ERROR Error[typecheck];
};

Pgetinterval: PROC [self: Root] ~ {
count: INT ~ PopInt[self.ostack];
index: INT ~ PopInt[self.ostack];
x: Any ~ Pop[self.ostack];
SELECT Type[x] FROM
array => {
array: Array ~ ArrayFromAny[x];
IF array.access<readOnly THEN ERROR Error[invalidaccess];
PushArray[self.ostack, ArrayGetInterval[array, index, count]];
};
string => {
string: String ~ StringFromAny[x];
IF string.access<readOnly THEN ERROR Error[invalidaccess];
PushString[self.ostack, StringGetInterval[string, index, count]];
};
ENDCASE => ERROR Error[typecheck];
};

Pputinterval: PROC [self: Root] ~ {
x2: Any ~ Pop[self.ostack];
index: INT ~ PopInt[self.ostack];
x1: Any ~ Pop[self.ostack];
SELECT Type[x1] FROM
array => {
array1: Array ~ ArrayFromAny[x1];
array2: Array ~ ArrayFromAny[x2];
IF array1.access<readOnly THEN ERROR Error[invalidaccess];
IF array2.access<unlimited THEN ERROR Error[invalidaccess];
ArrayPutInterval[array1, index, array2];
};
string => {
string1: String ~ StringFromAny[x1];
string2: String ~ StringFromAny[x2];
IF string1.access<readOnly THEN ERROR Error[invalidaccess];
IF string2.access<unlimited THEN ERROR Error[invalidaccess];
StringPutInterval[string1, index, string2];
};
ENDCASE => ERROR Error[typecheck];
};

Pcopy: PROC [self: Root] ~ {
x2: Any ~ Pop[self.ostack];
SELECT Type[x2] FROM
integer => {
n: INT ~ IntFromAny[x2];
Copy[self.ostack, n];
};
array => {
array2: Array ~ ArrayFromAny[x2];
array1: Array ~ PopArray[self.ostack];
IF array1.access<readOnly THEN ERROR Error[invalidaccess];
IF array2.access<unlimited THEN ERROR Error[invalidaccess];
PushArray[self.ostack, ArrayCopy[array1, array2]];
};
string => {
string2: String ~ StringFromAny[x2];
string1: String ~ PopString[self.ostack];
IF string1.access<readOnly THEN ERROR Error[invalidaccess];
IF string2.access<unlimited THEN ERROR Error[invalidaccess];
PushString[self.ostack, StringCopy[string1, string2]];
};
dict => {
dict2: Dict ~ DictFromAny[x2];
dict1: Dict ~ PopDict[self.ostack];
IF dict1.base.access<readOnly THEN ERROR Error[invalidaccess];
IF dict2.base.access<unlimited THEN ERROR Error[invalidaccess];
PushDict[self.ostack, DictCopy[dict1, dict2]];
};
ENDCASE => ERROR Error[typecheck];
};


Register2: PROC [self: Root] ~ {
Register[self, "array", Parray];
Register[self, "[", Pstartarray];
Register[self, "]", Pendarray];
Register[self, "aload", Paload];
Register[self, "astore", Pastore];
Register[self, "string", Pstring];
Register[self, "anchorsearch", Panchorsearch];
Register[self, "search", Psearch];
Register[self, "length", Plength];
Register[self, "get", Pget];
Register[self, "put", Pput];
Register[self, "getinterval", Pgetinterval];
Register[self, "putinterval", Pputinterval];
Register[self, "copy", Pcopy];
};

RegisterPrimitives[Register2];

END.

PS2Impl.mesa
Copyright Σ 1986 by Xerox Corporation.  All rights reserved.
Doug Wyatt, October 29, 1986 5:22:52 pm PST
PostScript implementation: array, string, and name operations.

Array operations
String operations
***** use ByteBlt here ? *****
Name operations
Primitives
Κw˜
codeš
œ™Kš
œ<™<K™+—K˜K™>K™š
Οk	˜	K˜Kšœ
˜K˜Kš
œ˜—K˜KšΟnœœ
˜Kšœœ˜šœœ
œ
œ
˜K˜Kšœœœ
˜—
head™š
žœœ
œœœ˜5šœœœ˜Kšœœ˜*Kšœœ:˜SK˜
—Kš
œ
œœœœ
˜<K˜K˜—šž
œœ
œf˜€
šœœ˜"Kš
œ"˜"Kšœ
˜—K˜K˜—š
žœœ
œœœ
˜BKš
œœ
œœ
œ˜>Kšœ!˜'K˜K˜—šžœœ
œœ
˜<Kš
œœ
œœ
œ˜>Kš
œ"˜"K˜K˜—š
žœœ
œœœ˜SKš
œœ
œœ
œ˜>Kš
œœ
œœ
œ˜DKšœt˜zK˜K˜—šžœœ
œœ˜MKš
œœ
œœ
œ˜>Kš
œœ
œœ
œ˜NKš
œ„
˜„
K˜K˜—šž	œœ
œœ˜BK˜>K˜'Kšœ
˜K˜K˜—šž
œœ
œ!˜8Kšœœ
œ˜>Kš
œ'˜'K˜uK˜K˜—šž	œœ
œ!˜7Kšœ'œ
œ˜JK˜uKš
œ'˜'K˜K˜——™š
ž	œœ
œœœ
˜7šœœ
œ˜Kšœœ
œ˜#Kšœœ:˜SK˜
—Kš
œ
œœœœ
˜<K˜K˜—šžœœk˜šœœ˜#Kš
œ"˜"K™Kšœ
˜—K˜K˜—šž	œœ
œœœœ˜EKš
œœ
œœ
œ˜?Kšœœ#˜.K˜K˜—š
ž	œœ
œœœ˜?Kš
œœ
œœ
œ˜?Kš
œœ
œ	œ
œ˜1Kšœ"œ
œ˜3K˜K˜—š
žœœ
œ œœ
˜WKš
œœ
œœ
œ˜?Kš
œœ
œœ
œ˜EKšœx˜~K˜K˜—šžœœ
œœ˜QKš
œœ
œœ
œ˜?Kš
œœ
œœ
œ˜OKš
œ‡
˜‡
K˜K˜—šž
œœ
œœ
˜GK˜CK˜*Kšœ˜K˜K˜—šžœœœœ
˜6K˜,šœœ
œ˜"Kš
œ%˜%Kšœ
˜—Kšœ
˜K˜K˜—šžœœœœ˜>Kšœ	œ
œ(˜9Kšœœ
œ˜Kš
œ\˜\Kš
œ&˜&K˜ K˜K˜——™šžœœœœœœ˜KKšœœ˜!Kšœ˜K˜K˜—š
žœœœœœ˜QKšœœ˜$Kšœ˜K˜K˜—šžœœœ
˜DKšœœ˜&Kš
œ?˜?šœœ
œ˜"Kš
œ2˜2Kšœ
˜—Kšœ
˜K˜K˜——™
šžœœ˜Kšœœ˜ Kš
œ'˜'K˜K˜—šžœœΟc˜'K˜K˜K˜—šž	œœŸ˜%Kšœœ˜%Kš
œ˜K˜K˜K˜K˜K˜—šžœœ˜K˜%Kšœœ
œ˜9K˜K˜K˜K˜—šžœœ˜K˜%Kšœœ
œ˜:K˜K˜K˜K˜—K˜šžœœ˜Kšœœ˜ Kš
œ)˜)K˜K˜—šž
œœ˜$K˜&K˜(Kšœœœ
˜Kšœœœ
œ˜Ršœœ˜$šœœ˜(Kšœ5œ
œ
˜AKšœ
œœ
˜ Kšœ
˜—K˜—šœœ˜K˜:K˜QKš
œ˜K˜Kšœœ˜K˜
—šœ˜Kš
œ ˜ Kšœœ˜K˜—K˜K˜—šžœœ˜K˜&K˜(Kšœœœ
˜K˜Kšœœœ
œ˜Ršœœœ"˜Gšœœ˜(Kšœ:œ
œ
˜FKšœ
œœ
˜ Kšœ
˜—Kšœ
˜—šœœ˜K˜1K˜=K˜]Kš
œ˜K˜K˜Kšœœ˜K˜
—šœ˜Kš
œ ˜ Kšœœ˜K˜—K˜K˜—J˜šžœœ˜K˜Kšœœ˜šœ	˜š
œ
˜
Kš
œ˜Kšœœ
œ˜9K˜Kš
œ˜—š
œ˜Kš
œ"˜"Kšœœ
œ˜:K˜Kš
œ˜—š
œ	˜	Kš
œ˜Kšœœ
œ˜=K˜Kš
œ˜—Kšœ
˜—K˜K˜K˜—šžœœ˜Kš
œ˜K˜šœ	˜š
œ
˜
K˜Kšœœ˜Kšœœ
œ˜9J˜&Kš
œ˜—š
œ˜K˜"Kšœœ˜Kšœœ
œ˜:J˜+Kš
œ˜—š
œ	˜	K˜Kšœœ
œ˜=J˜(Kš
œ˜—Kšœœ˜"—K˜K˜—šžœœ˜Kš
œ˜Kš
œ˜K˜šœ	˜š
œ
˜
K˜Kšœœ˜Kšœœ
œ˜:Jš
œ˜Kš
œ˜—š
œ˜K˜"Kšœœ˜Kšœœ˜Kšœœ
œ˜;J˜Kš
œ˜—š
œ	˜	K˜Kšœœ
œ˜>Jš
œ˜Kš
œ˜—Kšœœ˜"—K˜K˜—šžœœ˜#Kšœœ˜!Kšœœ˜!K˜šœ	˜š
œ
˜
K˜Kšœœ
œ˜9J˜>Kš
œ˜—š
œ˜K˜"Kšœœ
œ˜:J˜AKš
œ˜—Kšœœ˜"—K˜K˜—šžœœ˜#K˜Kšœœ˜!K˜šœ
˜š
œ
˜
K˜!K˜!Kšœœ
œ˜:Kšœœ
œ˜;J˜(Kš
œ˜—š
œ˜K˜$K˜$Kšœœ
œ˜;Kšœœ
œ˜<J˜+Kš
œ˜—Kšœœ˜"—K˜K˜—šžœœ˜Kš
œ˜šœ
˜š
œ˜Kšœœ˜Kš
œ˜K˜—š
œ
˜
K˜!Kš
œ&˜&Kšœœ
œ˜:Kšœœ
œ˜;J˜2Kš
œ˜—š
œ˜K˜$Kš
œ)˜)Kšœœ
œ˜;Kšœœ
œ˜<J˜6Kš
œ˜—š
œ	˜	K˜Kš
œ#˜#Kšœœ
œ˜>Kšœœ
œ˜?J˜.Kš
œ˜—Kšœœ˜"—K˜K˜—J˜šž	œœ˜ Kš
œ ˜ Kš
œ!˜!Kš
œ˜Kš
œ ˜ Kš
œ"˜"Kš
œ"˜"Kš
œ.˜.Kš
œ"˜"Kš
œ"˜"Kš
œ˜Kš
œ˜Kš
œ,˜,Kš
œ,˜,Kš
œ˜J˜J˜—J˜—J˜Jšœ
˜—…—0’@3