DIRECTORY
PS,
Basics,
Convert,
EditedStream,
IO,
Real,
SafeStorage;

PSLanguage1Impl: CEDAR PROGRAM
IMPORTS PS, Basics, Convert, EditedStream, IO, Real, SafeStorage
EXPORTS PS
~ BEGIN OPEN PS;
TextFromTypeArray: TYPE ~ ARRAY TypeCode OF Text;
textFromType: REF TextFromTypeArray ~ NEW [TextFromTypeArray _ [
null: "nulltype",
integer: "integertype",
real: "realtype",
boolean: "booleantype",
array: "arraytype",
string: "stringtype",
name: "nametype",
dict: "dicttype",
operator: "operatortype",
file: "filetype",
mark: "marktype",
save: "savetype",
font: "fonttype"
]];

NameFromType: PUBLIC PROC [self: Root, type: TypeCode] RETURNS [Name] ~ {
RETURN [NameFromText[self, textFromType[type]]];
};


IntFromAny: PUBLIC PROC [x: Any] RETURNS [INT] ~ {
WITH val: x.val SELECT FROM
integer => RETURN [val.int];
ENDCASE => ERROR Error[typecheck];
};

RealFromAny: PUBLIC PROC [x: Any] RETURNS [REAL] ~ {
WITH val: x.val SELECT FROM
integer => RETURN [REAL[val.int]];
real => RETURN [val.real];
ENDCASE => ERROR Error[typecheck];
};

BoolFromAny: PUBLIC PROC [x: Any] RETURNS [BOOL] ~ {
WITH val: x.val SELECT FROM
boolean => RETURN [val.bool];
ENDCASE => ERROR Error[typecheck];
};

ArrayFromAny: PUBLIC PROC [x: Any, access: Access] RETURNS [Array] ~ {
WITH val: x.val SELECT FROM
array => WITH x.ref SELECT FROM
ref: ArrayRef => {
IF val.access<access THEN ERROR Error[invalidaccess];
RETURN [[val: val, ref: ref]];
};
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};

StringFromAny: PUBLIC PROC [x: Any, access: Access] RETURNS [String] ~ {
WITH val: x.val SELECT FROM
string => WITH x.ref SELECT FROM
ref: StringRef => {
IF val.access<access THEN ERROR Error[invalidaccess];
RETURN [[val: val, ref: ref]];
};
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};

DictFromAny: PUBLIC PROC [x: Any, access: Access] RETURNS [Dict] ~ {
WITH val: x.val SELECT FROM
dict => WITH x.ref SELECT FROM
ref: DictRef => {
IF ref.access<access THEN ERROR Error[invalidaccess];
RETURN [[val: val, ref: ref]];
};
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};

FileFromAny: PUBLIC PROC [x: Any, access: Access] RETURNS [File] ~ {
WITH val: x.val SELECT FROM
file => WITH x.ref SELECT FROM
ref: FileRef => {
IF val.access<access THEN ERROR Error[invalidaccess];
RETURN [[val: val, ref: ref]];
};
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};

NameFromAny: PUBLIC PROC [x: Any] RETURNS [Name] ~ {
WITH val: x.val SELECT FROM
name => WITH x.ref SELECT FROM
ref: NameRef => RETURN [[val: val, ref: ref]];
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};

OperatorFromAny: PUBLIC PROC [x: Any] RETURNS [Operator] ~ {
WITH val: x.val SELECT FROM
operator => WITH x.ref SELECT FROM
ref: OperatorRef => RETURN [[val: val, ref: ref]];
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};


AnyFromInt: PUBLIC PROC [int: INT] RETURNS [Any] ~ {
RETURN [[val: [executable: FALSE, variant: integer[int: int]], ref: NIL]];
};

AnyFromReal: PUBLIC PROC [real: REAL] RETURNS [Any] ~ {
RETURN [[val: [executable: FALSE, variant: real[real: real]], ref: NIL]];
};

AnyFromBool: PUBLIC PROC [bool: BOOL] RETURNS [Any] ~ {
RETURN [[val: [executable: FALSE, variant: boolean[bool: bool]], ref: NIL]];
};

AnyFromArray: PUBLIC PROC [array: Array] RETURNS [Any] ~ {
RETURN [[val: array.val, ref: array.ref]];
};

AnyFromString: PUBLIC PROC [string: String] RETURNS [Any] ~ {
RETURN [[val: string.val, ref: string.ref]];
};

AnyFromDict: PUBLIC PROC [dict: Dict] RETURNS [Any] ~ {
RETURN [[val: dict.val, ref: dict.ref]];
};

AnyFromFile: PUBLIC PROC [file: File] RETURNS [Any] ~ {
RETURN [[val: file.val, ref: file.ref]];
};

AnyFromName: PUBLIC PROC [name: Name] RETURNS [Any] ~ {
RETURN [[val: name.val, ref: name.ref]];
};

AnyFromOperator: PUBLIC PROC [op: Operator] RETURNS [Any] ~ {
RETURN [[val: op.val, ref: op.ref]];
};

PushAny: PUBLIC PROC [self: Root, x: Any] ~ {
IF NOT self.ocount<self.osize THEN ERROR Error[stackoverflow];
self.ostack[self.ocount] _ x;
self.ocount _ self.ocount+1;
};

InlinePushAny: PROC [self: Root, x: Any] ~ INLINE {
IF NOT self.ocount<self.osize THEN ERROR Error[stackoverflow];
self.ostack[self.ocount] _ x;
self.ocount _ self.ocount+1;
};

PopAny: PUBLIC PROC [self: Root] RETURNS [x: Any] ~ {
IF NOT self.ocount>0 THEN ERROR Error[stackunderflow];
self.ocount _ self.ocount-1;
RETURN [self.ostack[self.ocount]];
};

InlinePopAny: PROC [self: Root] RETURNS [x: Any] ~ INLINE {
IF NOT self.ocount>0 THEN ERROR Error[stackunderflow];
self.ocount _ self.ocount-1;
RETURN [self.ostack[self.ocount]];
};


PushInt: PUBLIC PROC [self: Root, int: INT] ~ {
InlinePushAny[self, [val: [executable: FALSE, variant: integer[int: int]], ref: NIL]];
};

PushReal: PUBLIC PROC [self: Root, real: REAL] ~ {
InlinePushAny[self, [val: [executable: FALSE, variant: real[real: real]], ref: NIL]];
};

PushBool: PUBLIC PROC [self: Root, bool: BOOL] ~ {
InlinePushAny[self, [val: [executable: FALSE, variant: boolean[bool: bool]], ref: NIL]];
};

PushArray: PUBLIC PROC [self: Root, array: Array] ~ {
PushAny[self, [val: array.val, ref: array.ref]];
};

PushString: PUBLIC PROC [self: Root, string: String] ~ {
PushAny[self, [val: string.val, ref: string.ref]];
};

PushDict: PUBLIC PROC [self: Root, dict: Dict] ~ {
PushAny[self, [val: dict.val, ref: dict.ref]];
};

PushFile: PUBLIC PROC [self: Root, file: File] ~ {
PushAny[self, [val: file.val, ref: file.ref]];
};

PushName: PUBLIC PROC [self: Root, name: Name] ~ {
PushAny[self, [val: name.val, ref: name.ref]];
};

PushLevel: PUBLIC PROC [self: Root, level: Level] ~ {
PushAny[self, [val: [executable: FALSE, variant: save[level]], ref: NIL]];
};


PopInt: PUBLIC PROC [self: Root] RETURNS [INT] ~ {
x: Any ~ InlinePopAny[self];
WITH val: x.val SELECT FROM
integer => RETURN [val.int];
ENDCASE => ERROR Error[typecheck];
};

PopReal: PUBLIC PROC [self: Root] RETURNS [REAL] ~ {
x: Any ~ InlinePopAny[self];
WITH val: x.val SELECT FROM
integer => RETURN [REAL[val.int]];
real => RETURN [val.real];
ENDCASE => ERROR Error[typecheck];
};

PopBool: PUBLIC PROC [self: Root] RETURNS [BOOL] ~ {
x: Any ~ InlinePopAny[self];
WITH val: x.val SELECT FROM
boolean => RETURN [val.bool];
ENDCASE => ERROR Error[typecheck];
};

PopArray: PUBLIC PROC [self: Root, access: Access] RETURNS [Array] ~ {
RETURN [ArrayFromAny[PopAny[self], access]];
};

PopString: PUBLIC PROC [self: Root, access: Access] RETURNS [String] ~ {
RETURN [StringFromAny[PopAny[self], access]];
};

PopDict: PUBLIC PROC [self: Root, access: Access] RETURNS [Dict] ~ {
RETURN [DictFromAny[PopAny[self], access]];
};

PopFile: PUBLIC PROC [self: Root, access: Access] RETURNS [File] ~ {
RETURN [FileFromAny[PopAny[self], access]];
};

PopName: PUBLIC PROC [self: Root] RETURNS [Name] ~ {
RETURN [NameFromAny[PopAny[self]]];
};

PopOperator: PUBLIC PROC [self: Root] RETURNS [Operator] ~ {
RETURN [OperatorFromAny[PopAny[self]]];
};

PopLevel: PUBLIC PROC [self: Root] RETURNS [Level] ~ {
x: Any ~ InlinePopAny[self];
WITH val: x.val SELECT FROM
save => RETURN [val.level];
ENDCASE => ERROR Error[typecheck];
};

PopProc: PUBLIC PROC [self: Root] RETURNS [Any] ~ {
x: Any ~ PopAny[self];
SELECT Type[x] FROM
array => RETURN [x];
ENDCASE => ERROR Error[typecheck];
};


PushMark: PUBLIC PROC [self: Root] ~ {
PushAny[self, [val: [executable: FALSE, variant: mark[]], ref: NIL]];
};

PopMark: PUBLIC PROC [self: Root] ~ {
x: Any ~ PopAny[self];
SELECT Type[x] FROM
mark => NULL;
ENDCASE => ERROR Error[typecheck];
};


Copy: PUBLIC PROC [self: Root, n: INT] ~ {
IF n<0 THEN ERROR Error[rangecheck];
IF n>self.ocount THEN ERROR Error[stackunderflow];
IF n>(self.osize-self.ocount) THEN ERROR Error[stackoverflow];
FOR i: ArrayIndex IN [self.ocount..ArrayIndex[self.ocount+n]) DO
self.ostack[i] _ self.ostack[i-n];
ENDLOOP;
self.ocount _ self.ocount+n;
};

Roll: PUBLIC PROC [self: Root, n, j: INT] ~ {
IF n<0 THEN ERROR Error[rangecheck];
IF n>self.ocount THEN ERROR Error[stackunderflow];
IF j NOT IN [0..n) THEN { j _ j MOD n; IF j<0 THEN j _ j+n };
IF j#0 THEN {
Reverse: PROC [ostack: OStack, m1, m2: StackIndex] ~ {
FOR i: StackIndex IN[0..(m2-m1)/2) DO
i1: StackIndex ~ m1+i;
i2: StackIndex ~ m2-1-i;
x1: Any ~ ostack[i1];
x2: Any ~ ostack[i2];
ostack[i1] _ x2;
ostack[i2] _ x1;
ENDLOOP;
};
k3: StackIndex ~ self.ocount;
k2: StackIndex ~ k3-j;
k1: StackIndex ~ k3-n;
IF (k2-k1)>1 THEN Reverse[self.ostack, k1, k2];
IF (k3-k2)>1 THEN Reverse[self.ostack, k2, k3];
IF (k3-k1)>1 THEN Reverse[self.ostack, k1, k3];
};
};

Index: PUBLIC PROC [self: Root, n: INT] RETURNS [Any] ~ {
IF n<0 THEN ERROR Error[rangecheck];
IF NOT n<self.ocount THEN ERROR Error[stackunderflow];
RETURN [self.ostack[self.ocount-1-n]];
};

Clear: PUBLIC PROC [self: Root] ~ {
self.ocount _ 0;
};

ClearToMark: PUBLIC PROC [self: Root] ~ {
FOR i: StackIndex DECREASING IN [0..self.ocount) DO
IF self.ostack[i].val.type=mark THEN { self.ocount _ i; RETURN };
ENDLOOP;
ERROR Error[unmatchedmark];
};

CountToMark: PUBLIC PROC [self: Root] RETURNS [StackIndex] ~ {
FOR i: ArrayIndex DECREASING IN [0..self.ocount) DO
IF self.ostack[i].val.type=mark THEN RETURN [self.ocount-1-i];
ENDLOOP;
ERROR Error[unmatchedmark];
};

TypeIndex: PUBLIC PROC [self: Root, n: StackIndex] RETURNS [TypeCode] ~ {
IF NOT n<self.ocount THEN ERROR Error[stackunderflow];
RETURN [self.ostack[self.ocount-1-n].val.type];
};
Ceiling: PUBLIC PROC [x: REAL] RETURNS [z: REAL] ~ {
z _ Real.Ceiling[x ! Real.RealException => GOTO Big];
EXITS Big => RETURN [x];
};

Floor: PUBLIC PROC [x: REAL] RETURNS [z: REAL] ~ {
z _ Real.Floor[x ! Real.RealException => GOTO Big];
EXITS Big => RETURN [x];
};

Round: PUBLIC PROC [x: REAL] RETURNS [z: REAL] ~ {
RETURN [Floor[x+0.5]];
};

Truncate: PUBLIC PROC [x: REAL] RETURNS [z: REAL] ~ {
z _ Real.Fix[x ! Real.RealException => GOTO Big];
EXITS Big => RETURN [x];
};

Rand: PUBLIC PROC [self: Root] RETURNS [INT] ~ {
RETURN [0];
};

SRand: PUBLIC PROC [self: Root, seed: INT] ~ {
};

RRand: PUBLIC PROC [self: Root] RETURNS [INT] ~ {
RETURN [0];
};

Eq: PUBLIC PROC [x1, x2: Any] RETURNS [BOOL] ~ {
WITH v1: x1.val SELECT FROM
null => WITH v2: x2.val SELECT FROM
null => RETURN [TRUE];
ENDCASE;
integer => WITH v2: x2.val SELECT FROM
integer => RETURN [v1.int=v2.int];
real => RETURN [v1.int=v2.real];
ENDCASE;
real => WITH v2: x2.val SELECT FROM
integer => RETURN [v1.real=v2.int];
real => RETURN [v1.real=v2.real];
ENDCASE;
boolean => WITH v2: x2.val SELECT FROM
boolean => RETURN [v1.bool=v2.bool];
ENDCASE;
operator => WITH v2: x2.val SELECT FROM
operator => RETURN [x1.ref=x2.ref];
ENDCASE;
array => WITH v2: x2.val SELECT FROM
array => RETURN [x1.ref=x2.ref AND v1.start=v2.start AND v1.length=v2.length];
ENDCASE;
string => WITH v2: x2.val SELECT FROM
string => {
string1: String ~ StringFromAny[x1, readOnly];
string2: String ~ StringFromAny[x2, readOnly];
RETURN [StringEq[string1, string2]];
};
name => {
string1: String ~ StringFromAny[x1, readOnly];
string2: String ~ NameFromAny[x2].ref.string;
RETURN [StringEq[string1, string2]];
};
ENDCASE;
file => WITH v2: x2.val SELECT FROM
file => RETURN [x1.ref=x2.ref];
ENDCASE;
name => WITH v2: x2.val SELECT FROM
name => RETURN [x1.ref=x2.ref];
string => {
string1: String ~ NameFromAny[x1].ref.string;
string2: String ~ StringFromAny[x2, readOnly];
RETURN [StringEq[string1, string2]];
};
ENDCASE;
dict => WITH v2: x2.val SELECT FROM
dict => RETURN [x1.ref=x2.ref];
ENDCASE;
mark => WITH v2: x2.val SELECT FROM
mark => RETURN [TRUE];
ENDCASE;
font => WITH v2: x2.val SELECT FROM
font => RETURN [x1.ref=x2.ref];
ENDCASE;
ENDCASE;
RETURN [FALSE];
};

Compare: PUBLIC PROC [x1, x2: Any] RETURNS [Comparison] ~ {
WITH v1: x1.val SELECT FROM
integer => WITH v2: x2.val SELECT FROM
integer => RETURN [Basics.CompareInt[v1.int, v2.int]];
real => RETURN [Real.CompareREAL[v1.int, v2.real]];
ENDCASE;
real => WITH v2: x2.val SELECT FROM
integer => RETURN [Real.CompareREAL[v1.real, v2.int]];
real => RETURN [Real.CompareREAL[v1.real, v2.real]];
ENDCASE;
string => WITH v2: x2.val SELECT FROM
string => {
string1: String ~ StringFromAny[x1, readOnly];
string2: String ~ StringFromAny[x2, readOnly];
RETURN [StringCompare[string1, string2]];
};
ENDCASE;
ENDCASE;
ERROR Error[typecheck];
};

CharFromInt: PUBLIC PROC [int: INT] RETURNS [CHAR] ~ {
CharRange: TYPE ~ [0..CHAR.LAST.ORD];
IF int IN CharRange THEN RETURN [VAL[CharRange[int]]];
ERROR Error[rangecheck];
};

IntFromReal: PUBLIC PROC [real: REAL] RETURNS [INT] ~ {
RETURN [Real.Fix[real ! Real.RealException => CONTINUE]];
ERROR Error[rangecheck];
};

IntFromString: PUBLIC PROC [string: String] RETURNS [INT] ~ {
found: BOOL; token: Any; post: String;
[found, token, post] _ StringToken[NIL, string];
SELECT Type[token] FROM
integer => RETURN [IntFromAny[token]];
real => RETURN [IntFromReal[RealFromAny[token]]];
ENDCASE => ERROR Error[typecheck];
};

RealFromString: PUBLIC PROC [string: String] RETURNS [REAL] ~ {
found: BOOL; token: Any; post: String;
[found, token, post] _ StringToken[NIL, string];
SELECT Type[token] FROM
integer => RETURN [RealFromInt[IntFromAny[token]]];
real => RETURN [RealFromAny[token]];
ENDCASE => ERROR Error[typecheck];
};


StringFromInt: PUBLIC PROC [self: Root, string: String, int, radix: INT] RETURNS [String] ~ {
text: MutableText ~ self.buffer; -- assume maxLength>=32
start: NAT _ text.length _ text.maxLength; -- result is in text[start..maxLength)
base: NAT ~ IF radix IN [2..36] THEN radix ELSE ERROR Error[rangecheck];
minus: BOOL ~ base=10 AND int<0; -- only base 10 numbers are signed
val: CARD _ LOOPHOLE[IF minus THEN -int ELSE int];
DO digit: [0..36) ~ val MOD base;
text[start _ start-1] _ IF digit<10 THEN '0+digit ELSE 'A+(digit-10);
IF val<base THEN EXIT ELSE val _ val/base;
ENDLOOP;
IF minus THEN text[start _ start-1] _ '-;
RETURN [StringFromText[self, string, text, start]];
};

StringFromReal: PUBLIC PROC [self: Root, string: String, real: REAL] RETURNS [String] ~ {
text: MutableText ~ self.buffer;
text.length _ 0;
RETURN [StringFromText[self, string, Convert.AppendReal[to: text, from: real]]];
};

StringFromName: PUBLIC PROC [self: Root, string: String, name: Name] RETURNS [String] ~ {
RETURN [StringCopy[self: self, string: string, from: name.ref.string]];
};

StringFromOperator: PUBLIC PROC [self: Root, string: String, operator: Operator] RETURNS [String] ~ {
RETURN [StringFromText[self, string, operator.ref.text]];
};

StringFromText: PUBLIC PROC [self: Root, string: String, text: Text, 
start: NAT _ 0, len: NAT _ NAT.LAST] RETURNS [String] ~ {
length: NAT ~ MIN[NAT[text.length-start], len];
target: String ~ StringGetInterval[string, 0, length];
FOR index: NAT IN [0..length) DO
StringPut[self, target, index, text[start+index]];
ENDLOOP;
RETURN [target];
};


Error: PUBLIC ERROR [error: ErrorCode] ~ CODE;
Bug: PUBLIC ERROR ~ CODE;
CurrentFile: PUBLIC SIGNAL RETURNS [File] ~ CODE;
Exit: PUBLIC SIGNAL ~ CODE;
Stop: PUBLIC ERROR ~ CODE;
Quit: PUBLIC ERROR ~ CODE;

TextFromErrorArray: TYPE ~ ARRAY ErrorCode OF Text;
textFromError: REF TextFromErrorArray ~ NEW [TextFromErrorArray _ [
dictfull: "dictfull",
dictstackoverflow: "dictstackoverflow",
dictstackunderflow: "dictstackunderflow",
execstackoverflow: "execstackoverflow",
interrupt: "interrupt",
invalidaccess: "invalidaccess",
invalidexit: "invalidexit",
invalidfileaccess: "invalidfileaccess",
invalidfont: "invalidfont",
invalidrestore: "invalidrestore",
ioerror: "ioerror",
limitcheck: "limitcheck",
nocurrentpoint: "nocurrentpoint",
rangecheck: "rangecheck",
stackoverflow: "stackoverflow",
stackunderflow: "stackunderflow",
syntaxerror: "syntaxerror",
timeout: "timeout",
typecheck: "typecheck",
undefined: "undefined",
undefinedfilename: "undefinedfilename",
undefinedresult: "undefinedresult",
unimplemented: "unimplemented",
unmatchedmark: "unmatchedmark",
unregistered: "unregistered",
VMerror: "VMerror"
]];

ExecuteArray: PROC [self: Root, array: Array] ~ {
action: PROC [x: Any] ~ { Execute[self, x, TRUE] };
ArrayForAll[array, action];
};

ExecuteString: PROC [self: Root, string: String] ~ {
post: String _ string;
DO found: BOOL; token: Any;
[found, token, post] _ StringToken[self, post];
IF found THEN Execute[self, token, TRUE] ELSE EXIT;
ENDLOOP;
};

ExecuteFile: PROC [self: Root, file: File] ~ {
ENABLE CurrentFile => RESUME [file];
DO found: BOOL; token: Any;
[found, token] _ FileToken[self, file];
IF found THEN Execute[self, token, TRUE] ELSE EXIT;
ENDLOOP;
};

EStackOverflow: ERROR ~ CODE;

Execute: PUBLIC PROC [self: Root, x: Any, directly: BOOL _ FALSE] ~ {
innerExecute: PROC [self: Root, x: Any] ~ {
IF x.val.executable
THEN WITH val: x.val SELECT FROM
operator => WITH x.ref SELECT FROM
ref: OperatorRef => ref.proc[self];
ENDCASE => ERROR Bug;
name => Execute[self, Load[self, x]];
array => IF directly
THEN PushAny[self, x] -- defer execution of procedure
ELSE ExecuteArray[self, ArrayFromAny[x, executeOnly]];
string => ExecuteString[self, StringFromAny[x, executeOnly]];
file => ExecuteFile[self, FileFromAny[x, executeOnly]];
null => NULL;
ENDCASE => PushAny[self, x] -- other types are always literal
ELSE PushAny[self, x]; -- literal
};
savedCount: ArrayIndex ~ self.ocount;
errorCaught: BOOL _ FALSE; errorCode: ErrorCode;
IF NOT self.ecount<self.esize THEN ERROR EStackOverflow;
self.ecount _ self.ecount+1;
innerExecute[self, x ! Error => { errorCaught _ TRUE; errorCode _ error; CONTINUE }];
self.ecount _ self.ecount-1;
IF errorCaught THEN {
errorText: Text ~ textFromError[errorCode];
errorName: Name ~ NameFromText[self, errorText];
errorHandler: Any ~ DictGet[self.errordict, AnyFromName[errorName]];
self.ocount _ savedCount; -- restore ostack
PushAny[self, x]; -- ***** what if stackoverflow here?
Execute[self, errorHandler];
};
};

InitializationList: TYPE ~ LIST OF PROC [Root];
initializationHead, initializationTail: InitializationList _ NIL;

NoteInitialization: PUBLIC PROC [initialization: PROC [Root]] ~ {
list: InitializationList _ LIST [initialization];
IF initializationHead=NIL THEN initializationHead _ list ELSE initializationTail.rest _ list;
initializationTail _ list;
};

DoInitialization: PROC [self: Root] ~ {
FOR list: InitializationList _ initializationHead, list.rest UNTIL list=NIL DO
list.first[self];
ENDLOOP; 
};

Register: PUBLIC PROC [self: Root, text: Text, val: Any] ~ {
key: Any ~ AnyFromName[NameFromText[self, text]];
Def[self, key, val];
};

RegisterOperator: PUBLIC PROC [self: Root, text: Text, proc: OperatorProc] ~ {
operator: Operator ~ [
val: [executable: TRUE, variant: operator[]],
ref: NEW [OperatorRep _ [proc: proc, text: text]]
];
Register[self, text, AnyFromOperator[operator]];
};

systemdictSize: INT ~ 256;
userdictSize: INT ~ 200;
errordictSize: INT ~ 28;
nameDictSize: INT ~ 500;
bufferSize: NAT ~ 200;

Create: PUBLIC PROC [in, out: STREAM, 
osize: StackIndex _ 500, dsize: StackIndex _ 20, esize: StackIndex _ 250] ~ {
self: Root ~ NEW [RootRep];
self.zone _ SafeStorage.GetSystemZone[];
self.buffer _ NEW[TEXT[bufferSize]];
self.ostack _ NEW[OStackRep[osize]];
self.osize _ osize;
self.ocount _ 0;
self.dstack _ NEW[DStackRep[dsize]];
self.dsize _ dsize;
self.dcount _ 0;
self.esize _ esize;
self.ecount _ 0;
self.restore _ NEW[RestoreStackRep _ ALL[NIL]];
self.level _ 0;
self.systemdict _ DictCreate[self, systemdictSize];
self.userdict _ DictCreate[self, userdictSize];
self.errordict _ DictCreate[self, errordictSize];
self.nameDict _ DictCreate[self, nameDictSize];
self.stdin _ FileFromStream[self, in];
self.stdout _ FileFromStream[self, out];
self.stderr _ self.stdout;

Begin[self, self.systemdict];
DoInitialization[self];
Register[self, "null", null];
Register[self, "true", AnyFromBool[TRUE]];
Register[self, "false", AnyFromBool[FALSE]];
Register[self, "systemdict", AnyFromDict[self.systemdict]];
Register[self, "userdict", AnyFromDict[self.userdict]];
Register[self, "errordict", AnyFromDict[self.errordict]];
Register[self, "version", AnyFromString[StringSetAccess[
StringCreateFromText[self, "38.0"], readOnly]]];
Begin[self, self.userdict];
Register[self, "start", CvX[AnyFromString[StringCreateFromText[self,
"{prompt(%statementedit)(r)file cvx exec}loop"]]]];
Register[self, "prompt", CvX[AnyFromString[StringCreateFromText[self,
"(*)print"]]]];
Execute[self, AnyFromName[NameFromText[self, "start"]] !
CurrentFile => RESUME [FileFromStream[self, IO.noInputStream]];
Exit => RESUME;
Stop => RETRY;
EditedStream.Rubout => { self.stdout.ref.stream.PutRope[" XXX\n"]; RETRY };
Quit => CONTINUE;
];
};


END.
$PSLanguage1Impl.mesa
Copyright Σ 1986, 1987 by Xerox Corporation.  All rights reserved.
Doug Wyatt, August 21, 1987 4:57:10 pm PDT
PostScript implementation: base language.

Types and attributes
Operand stack
FOR i: NAT IN[0..self.ocount) DO self.ostack[i].ref _ NIL ENDLOOP;
Arithmetic and math operators
Relational operators
Conversion
IF NOT found THEN ERROR Error[syntaxerror];
IF StringToken[post].found THEN ERROR Error[syntaxerror];
IF NOT found THEN ERROR Error[syntaxerror];
IF StringToken[post].found THEN ERROR Error[syntaxerror];
StringFromRope: PUBLIC PROC [self: Root, string: String, rope: ROPE, 
start: INT _ 0, len: INT _ INT.LAST] RETURNS [substring: String] ~ {
rem: INT ~ Basics.NonNegative[Rope.Size[rope]-Basics.NonNegative[start]];
length: INT ~ MIN[MAX[len, 0], rem];
substring _ StringGetInterval[string, 0, length];
FOR index: INT IN [0..length) DO
StringPut[self, substring, index, Rope.Fetch[rope, start+index]];
ENDLOOP;
};

Control operators
operator => (self.procFromOperator[val.index])[self];
Registration
Initialization
Κ9˜
codeš
œ™Kš
œB™BK™*—K˜K™)K™š
Οk	˜	Kšœ
˜Kš
œ˜Kš
œ˜Kš
œ
˜
Kšœ
˜Kš
œ˜Kš
œ˜—K˜KšΟnœœ
˜Kšœ
œ!œ˜@Kšœ
˜
Kšœœ
œ
œ
˜
head™Kšœœœ
œ˜1šœœœ˜@Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜—šžœœ
œœ˜IKšœ*˜0K˜K˜—K˜š
ž
œœ
œ
œœ˜2šœœ
˜Kšœœ˜Kšœœ˜"—K˜K˜—š
žœœ
œ
œœ˜4šœœ
˜Kšœœœ˜"Kšœœ˜Kšœœ˜"—K˜K˜—š
žœœ
œ
œœ˜4šœœ
˜Kšœœ˜Kšœœ˜"—K˜K˜—šžœœ
œœ˜Fšœœ
˜šœ	œœ
˜š
œ˜Kšœœ
œ˜5Kšœ˜K˜—Kšœœ˜—Kšœœ˜"—K˜K˜—šž
œœ
œœ
˜Hšœœ
˜šœ
œœ
˜ š
œ˜Kšœœ
œ˜5Kšœ˜K˜—Kšœœ˜—Kšœœ˜"—K˜K˜—šžœœ
œœ˜Dšœœ
˜šœœœ
˜š
œ˜Kšœœ
œ˜5Kšœ˜K˜—Kšœœ˜—Kšœœ˜"—K˜K˜—šžœœ
œœ˜Dšœœ
˜šœœœ
˜š
œ˜Kšœœ
œ˜5Kšœ˜K˜—Kšœœ˜—Kšœœ˜"—K˜K˜—šžœœ
œ
œ˜4šœœ
˜šœœœ
˜Kšœœ˜.Kšœœ˜—Kšœœ˜"—K˜K˜—šžœœ
œ
œ˜<šœœ
˜šœœœ
˜"Kšœœ˜2Kšœœ˜—Kšœœ˜"—K˜K˜—K˜š
ž
œœ
œœœ
˜4Kšœœ$œ˜JK˜K˜—š
žœœ
œœœ
˜7Kšœœ#œ˜IK˜K˜—š
žœœ
œœœ
˜7Kšœœ&œ˜LK˜K˜—šžœœ
œœ
˜:Kšœ$˜*K˜K˜—šž
œœ
œœ
˜=Kšœ&˜,K˜K˜—šžœœ
œœ
˜7Kšœ"˜(K˜K˜—šžœœ
œœ
˜7Kšœ"˜(K˜K˜—šžœœ
œœ
˜7Kšœ"˜(K˜K˜—šžœœ
œœ
˜=Kšœ˜$K˜K˜——™
šžœœ
œ˜-Kšœ
œœ
œ˜>Kš
œ˜Kš
œ˜K˜K˜—šž
œœœ˜3Kšœ
œœ
œ˜>Kš
œ˜Kš
œ˜K˜K˜—šžœœ
œœ
˜5Kšœ
œœ
œ˜6Kš
œ˜Kšœ˜"K˜K˜—šžœœœœ˜;Kšœ
œœ
œ˜6Kš
œ˜Kšœ˜"K˜K˜—K˜šžœœ
œœ˜/Kšœ'œ$œ˜VK˜K˜—šžœœ
œœ˜2Kšœ'œ#œ˜UK˜K˜—šžœœ
œœ˜2Kšœ'œ&œ˜XK˜K˜—šž	œœ
œ˜5Kš
œ0˜0K˜K˜—šž
œœ
œ!˜8Kš
œ2˜2K˜K˜—šžœœ
œ˜2Kš
œ.˜.K˜K˜—šžœœ
œ˜2Kš
œ.˜.K˜K˜—šžœœ
œ˜2Kš
œ.˜.K˜K˜—šž	œœ
œ˜5Kšœ!œœ˜JK˜K˜—K˜š
žœœ
œœœ˜2K˜šœœ
˜Kšœœ˜Kšœœ˜"—K˜K˜—š
žœœ
œœœ˜4K˜šœœ
˜Kšœœœ˜"Kšœœ˜Kšœœ˜"—K˜K˜—š
žœœ
œœœ˜4K˜šœœ
˜Kšœœ˜Kšœœ˜"—K˜K˜—šžœœ
œœ˜FKšœ&˜,K˜K˜—šž	œœ
œœ
˜HKšœ'˜-K˜K˜—šžœœ
œœ˜DKšœ%˜+K˜K˜—šžœœ
œœ˜DKšœ%˜+K˜K˜—šžœœ
œœ˜4Kšœ˜#K˜K˜—šžœœ
œœ˜<Kšœ!˜'K˜K˜—šžœœ
œœ˜6K˜šœœ
˜Kšœœ
˜Kšœœ˜"—K˜K˜—šžœœ
œœ
˜3K˜šœ	˜Kšœ	œ˜Kšœœ˜"—K˜K˜—K˜šžœœ
œ˜&Kšœ!œœ˜EK˜K˜—šžœœ
œ˜%K˜šœ	˜Kšœœ
˜
Kšœœ˜"—K˜K˜—K˜šžœœ
œœ˜*Kšœœ
œ˜$Kšœœ
œ˜2Kšœœ
œ˜>šœœ*˜@Kš
œ"˜"Kšœ
˜—Kš
œ˜K˜K˜—šžœœ
œœ˜-Kšœœ
œ˜$Kšœœ
œ˜2Kšœœ
œœ	œœœ˜=šœœ˜
šžœœ)˜6šœœ˜%Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœ
˜—K˜—Kš
œ˜Kš
œ˜Kš
œ˜Kšœœ˜/Kšœœ˜/Kšœœ˜/K˜—K˜K˜—š
žœœ
œœœ
˜9Kšœœ
œ˜$Kšœ
œœ
œ˜6Kšœ ˜&K˜K˜—šžœœ
œ˜#Kšœœœœ
™BKš
œ˜Kš
œ˜K˜—šžœœ
œ˜)šœ
œ
œ˜3Kšœœœ˜AKšœ
˜—Kšœ˜K˜K˜—šžœœ
œœ˜>šœ
œ
œ˜3Kšœœ
œ˜>Kšœ
˜—Kšœ˜K˜K˜—
unitšž	œœ
œœ˜IKšœ
œœ
œ˜6Kšœ)˜/K˜——™šžœœ
œœœœ˜4Kšœ+œ˜5Jšœœ˜K˜K˜—šžœœ
œœœœ˜2Kšœ)œ˜3Jšœœ˜K˜K˜—šžœœ
œœœœ˜2Kšœ˜K˜K˜—šžœœ
œœœœ˜5Kšœ'œ˜1Jšœœ˜K˜K˜—š
žœœ
œœœ˜0Kšœ˜K˜K˜—šžœœ
œœ˜.K˜K˜—š
žœœ
œœœ˜1Kšœ˜K˜K˜——™š
žœœ
œœœ˜0šœœ
˜šœœœ
˜#Kšœœœ˜Kšœ
˜—šœœœ
˜&Kšœœ˜"Kšœœ˜ Kšœ
˜—šœœœ
˜#Kšœœ˜#Kšœœ˜!Kšœ
˜—šœœœ
˜&Kšœœ˜$Kšœ
˜—šœœœ
˜'Kšœœ˜#Kšœ
˜—šœ	œœ
˜$Kšœ	œœœ˜NKšœ
˜—šœ
œœ
˜%š
œ˜Kš
œ.˜.Kš
œ.˜.Kšœ˜$K˜—š
œ	˜	Kš
œ.˜.Kš
œ-˜-Kšœ˜$K˜—Kšœ
˜—šœœœ
˜#Kšœœ˜Kšœ
˜—šœœœ
˜#Kšœœ˜š
œ˜Kš
œ-˜-Kš
œ.˜.Kšœ˜$K˜—Kšœ
˜—šœœœ
˜#Kšœœ˜Kšœ
˜—šœœœ
˜#Kšœœœ˜Kšœ
˜—šœœœ
˜#Kšœœ˜Kšœ
˜—Kšœ
˜—Kšœœ˜K˜K˜—šžœœ
œœ˜;šœœ
˜šœœœ
˜&Kšœœ%˜6Kšœœ%˜3Kšœ
˜—šœœœ
˜#Kšœœ%˜6Kšœœ&˜4Kšœ
˜—šœ
œœ
˜%š
œ˜Kš
œ.˜.Kš
œ.˜.Kšœ#˜)K˜—Kšœ
˜—Kšœ
˜—Kšœ˜K˜K˜——™
šžœœ
œœœœ˜6Kš	œœœ
œ
œ˜%Kš
œœœ
œœ˜6Kšœ˜K˜K˜—šžœœ
œœœœ˜7Kšœ(œ˜9Kšœ˜K˜K˜—š
ž
œœ
œœœ˜=Kšœœ˜&Kšœ#œ
˜0Kšœ
œœ
œ™+Kšœœ
œ™9šœ
˜Kšœœ˜&Kšœœ#˜1Kšœœ˜"—K˜K˜—š
žœœ
œœœ˜?Kšœœ˜&Kšœ#œ
˜0Kšœ
œœ
œ™+Kšœœ
œ™9šœ
˜Kšœœ"˜3Kšœœ˜$Kšœœ˜"—K˜K˜—K˜š
ž
œœ
œ*œœ
˜]Jšœ!Οc˜8Jšœœ!Ÿ&˜QJš
œœœœ	œœ
œ˜HJšœœœŸ"˜CJšœœœ
œœœ˜2šœœ˜!Jšœœ
œ
œ˜EJšœ
œ
œ
œ˜*Jšœ
˜—Jšœœ˜)Jšœ-˜3K˜K˜—š
žœœ
œ$œœ
˜YKš
œ ˜ Kš
œ˜KšœJ˜PK˜K˜—šžœœ
œ*œ
˜YKšœA˜GK˜K˜—šžœœ
œ2œ
˜eKšœ3˜9K˜K˜—šžœœ
œ2œœœ
œœ
˜Kšœœœ
œ˜/Kš
œ6˜6šœœ
œ
˜ Jš
œ2˜2Jšœ
˜—Kšœ
˜K˜K˜—šžœœ
œ$œ
œœœ
œœ™Š
KšœœA™IKšœœœ
œ™$Kš
œ1™1šœœ
œ
™ Jš
œA™AJšœ
™—K™K™—K˜—™Kšžœœ
œœ
˜.Kšžœœ
œœ
˜Kš
žœœ
œ
œ
œ
˜1Kšžœœ
œœ
˜Kšžœœ
œœ
˜Kšžœœ
œœ
˜K˜Kšœœœœ˜3šœœœ˜CKš
œ˜Kš
œ'˜'Kš
œ)˜)Kš
œ'˜'Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ'˜'Kš
œ˜Kš
œ!˜!Kš
œ˜Kš
œ˜Kš
œ!˜!Kš
œ˜Kš
œ˜Kš
œ!˜!Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ'˜'Kš
œ#˜#Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜—šžœœ˜1Kšœœœ˜3K˜K˜K˜—šž
œœ!˜4Kš
œ˜šœœ
˜Kš
œ/˜/Kš
œœœœ
œ
˜3Kšœ
˜—K˜K˜—šžœœ˜.Kšœœ˜$šœœ
˜Kš
œ'˜'Kš
œœœœ
œ
˜3Kšœ
˜—K˜K˜—šžœœœ
˜K˜—š
žœœ
œ œœ˜Ešœœ˜+šœ˜šœ
œœ
˜ šœœœ
˜"Kš
œ#˜#Kšœœ˜—Kš
œ5™5Kš
œ%˜%šœ	œ	˜KšœŸ˜5Kšœ2˜6—Kš
œ=˜=Kš
œ7˜7Kšœœ
˜
KšœŸ!˜=—KšœŸ
˜!—K˜—Kš
œ%˜%Jšœ
œœ˜0Kšœ
œœ
œ˜8K˜Kšœ0œœ˜UK˜šœ
œ˜K˜+K˜0K˜DKšœŸ˜+KšœŸ$˜6Kš
œ˜K˜—K˜K˜——™Kš	œœœ
œ
œ˜/šœ=œ
˜AK˜—šžœœ
œœ˜AKšœœ˜1Kšœœ
œœ ˜]K˜K˜K˜—šžœœ˜'šœ:œœ
˜NKš
œ˜Kšœ˜	—K˜K˜—šžœœ
œ'˜<Kš
œ1˜1Kš
œ˜K˜K˜—šžœœ
œ1˜N˜Kšœœ˜-Kšœœ)˜1K˜—K˜0K˜K˜——™Kšœœ˜Kšœœ˜Kšœœ˜Kšœœ˜šœœ˜K˜—šžœœ
œœP˜tKšœ
œ˜K˜(Kšœœ
œ˜$Kšœœ˜$Kš
œ˜K˜Kšœœ˜$Kš
œ˜K˜K˜K˜Kšœœœ
œ˜/K˜K˜3K˜/K˜1K˜/K˜&K˜(K˜K˜K˜Kš
œ˜K˜Kšœ#œ˜*Kšœ$œ˜,Kš
œ;˜;Kš
œ7˜7Kš
œ9˜9Kš
œi˜iK˜Kš
œx˜xKš
œU˜Uš
œ8˜8Kšœœœ˜?Kšœœ
˜Kšœœ
˜KšœCœ˜KKšœœ
˜Kš
œ˜—K˜K˜——J˜Jšœ
˜—…—OΎq