PSControlImpl.mesa
Copyright Ó 1986 by Xerox Corporation. All rights reserved.
Doug Wyatt, May 14, 1987 5:59:14 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] ~ --INLINE-- {
IF token.val.executable AND token.val.type#array
THEN Execute[self, token]
ELSE PushAny[self, token]; -- push literal or defer procedure
};
ExecuteArray: PROC [self: Root, array: Array] ~ {
action: PROC [x: Any] ~ { ExecuteToken[self, x] };
ArrayForAll[array, action];
};
ExecuteString: PROC [self: Root, string: String] ~ {
post: String ← string;
DO found: BOOL; token: Any;
[found, token, post] ← StringToken[post];
IF found THEN ExecuteToken[self, token] ELSE EXIT;
ENDLOOP;
};
ExecuteFile: PUBLIC PROC [self: Root, file: File] ~ {
ENABLE CurrentFile => RESUME [file];
DO found: BOOL; token: Any;
[found, token] ← FileToken[file];
IF found THEN ExecuteToken[self, token] ELSE EXIT;
ENDLOOP;
};
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];
};
];
};
InnerExecute: PROC [self: Root, x: Any] ~ {
IF XCheck[x] THEN SELECT Type[x] FROM
name => Execute[self, Load[self, x]];
operator => {
operator: Operator ~ OperatorFromAny[x];
operator.ref.proc[self];
};
array => {
array: Array ~ ArrayFromAny[x];
IF ArrayAccess[array]<executeOnly THEN ERROR Error[invalidaccess];
ExecuteArray[self, array];
};
string => {
string: String ~ StringFromAny[x];
IF StringAccess[string]<executeOnly THEN ERROR Error[invalidaccess];
ExecuteString[self, string];
};
file => {
file: File ~ FileFromAny[x];
IF FileAccess[file]<executeOnly THEN ERROR Error[invalidaccess];
ExecuteFile[self, file !
GetCurrentFile => RETURN [file];
];
};
null => NULL;
ENDCASE => PushAny[self, x] -- other types are always literal
ELSE PushAny[self, x]; -- literal
};
Main: PROC [self: Root] ~ {
action[self !
GetCurrentFile => RETURN [nullFile];
Exit => RESUME;
Stop => CONTINUE;
Quit => CONTINUE;
];
};
END.