PSControlImpl.mesa
Copyright Ó 1986 by Xerox Corporation. All rights reserved.
Doug Wyatt, May 13, 1987 5:05:46 pm PDT
PostScript implementation: execution.
DIRECTORY
PS;
PSControlImpl: CEDAR PROGRAM
IMPORTS PS
~ BEGIN OPEN PS;
Control operators
Exit: PUBLIC SIGNAL ~ CODE;
Stop: PUBLIC ERROR ~ CODE;
Quit: PUBLIC ERROR ~ CODE;
NameFromErrorArray: TYPE ~ ARRAY ErrorType OF Name;
nameFromError: REF NameFromErrorArray ~ NEW [NameFromErrorArray ← [
dictfull: NameFromRope["dictfull"],
dictstackoverflow: NameFromRope["dictstackoverflow"],
dictstackunderflow: NameFromRope["dictstackunderflow"],
execstackoverflow: NameFromRope["execstackoverflow"],
handleerror: NameFromRope["handleerror"],
interrupt: NameFromRope["interrupt"],
invalidaccess: NameFromRope["invalidaccess"],
invalidexit: NameFromRope["invalidexit"],
invalidfileaccess: NameFromRope["invalidfileaccess"],
invalidfont: NameFromRope["invalidfont"],
invalidrestore: NameFromRope["invalidrestore"],
ioerror: NameFromRope["ioerror"],
limitcheck: NameFromRope["limitcheck"],
nocurrentpoint: NameFromRope["nocurrentpoint"],
rangecheck: NameFromRope["rangecheck"],
stackoverflow: NameFromRope["stackoverflow"],
stackunderflow: NameFromRope["stackunderflow"],
syntaxerror: NameFromRope["syntaxerror"],
timeout: NameFromRope["timeout"],
typecheck: NameFromRope["typecheck"],
undefined: NameFromRope["undefined"],
undefinedfilename: NameFromRope["undefinedfilename"],
undefinedresult: NameFromRope["undefinedresult"],
unimplemented: NameFromRope["unimplemented"],
unmatchedmark: NameFromRope["unmatchedmark"],
unregistered: NameFromRope["unregistered"],
VMerror: NameFromRope["VMerror"]
]];
ExecuteError: PROC [self: Root, type: ErrorType] ~ {
errorName: Name ~ nameFromError[type];
errorHandler: Any ~ DictGet[self.errordict, AnyFromName[errorName]];
Execute[self, errorHandler];
};
ExecuteToken: PROC [self: Root, token: Any] ~ {
IF token.val.executable AND token.val.type#array
THEN Execute[self, token]
ELSE PushAny[self, token]; -- push literal or defer procedure
};
InnerExecute: PROC [self: Root, x: Any] ~ {
IF XCheck[x] THEN SELECT Type[x] FROM
operator => WITH x.ref SELECT FROM
ref: OperatorRef => ref.proc[self];
ENDCASE => ERROR Bug;
name => Execute[self, Load[self, x]];
array => {
array: Array ← ArrayFromAny[x];
IF ArrayAccess[array]<executeOnly THEN ERROR Error[invalidaccess];
DO found: BOOL; token: Any;
[found, token, array] ← ArrayToken[array];
IF found THEN ExecuteToken[self, token] ELSE EXIT;
ENDLOOP;
};
string => {
string: String ← StringFromAny[x];
IF StringAccess[string]<executeOnly THEN ERROR Error[invalidaccess];
DO found: BOOL; token: Any;
[found, token, string] ← StringToken[string];
IF found THEN ExecuteToken[self, token] ELSE EXIT;
ENDLOOP;
};
file => {
file: File ~ FileFromAny[x];
IF FileAccess[file]<executeOnly THEN ERROR Error[invalidaccess];
DO found: BOOL; token: Any;
[found, token] ← FileToken[file];
IF found THEN ExecuteToken[self, token] ELSE EXIT;
ENDLOOP;
};
null => NULL;
ENDCASE => PushAny[self, x] -- other types are always literal
ELSE PushAny[self, x]; -- literal
};
Execute: PUBLIC PROC [self: Root, x: Any] ~ {
initialCount: INT ~ Count[self];
InnerExecute[self, x !
Error => {
RestoreCount[self, initialCount];
PushAny[self, x]; -- ***** what if stackoverflow here?
ExecuteError[self, errorType];
};
];
};
Stopped: PROC [self: Root, x: Any] RETURNS [stopped: BOOL ← FALSE] ~ {
Execute[self, x !
Stop => { stopped ← TRUE; CONTINUE };
Exit => { RESUME };
];
};
END.