diff options
Diffstat (limited to 'Master/xemtex/gslib/gs_init.ps')
| -rw-r--r-- | Master/xemtex/gslib/gs_init.ps | 1885 |
1 files changed, 1885 insertions, 0 deletions
diff --git a/Master/xemtex/gslib/gs_init.ps b/Master/xemtex/gslib/gs_init.ps new file mode 100644 index 00000000000..b8938dd0750 --- /dev/null +++ b/Master/xemtex/gslib/gs_init.ps @@ -0,0 +1,1885 @@ +% (C) 1989, 2000 Aladdin Enterprises. All rights reserved. +% +% This program is free software; you can redistribute it and/or modify it +% under the terms of the GNU General Public License as published by the +% Free Software Foundation; either version 2 of the License, or (at your +% option) any later version. +% +% This program is distributed in the hope that it will be useful, but +% WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General +% Public License for more details. +% +% You should have received a copy of the GNU General Public License along +% with this program; if not, write to the Free Software Foundation, Inc., +% 59 Temple Place, Suite 330, Boston, MA, 02111-1307. + +% $Id: gs_init.ps,v 1.40.2.12.2.3 2003/04/12 14:02:38 giles Exp $ +% Initialization file for the interpreter. +% When this is run, systemdict is still writable. + +% Comment lines of the form +% %% Replace <n> <file(s)> +% indicate places where the next <n> lines should be replaced by +% the contents of <file(s)>, when creating a single merged init file. + +% The interpreter can call out to PostScript code. All procedures +% called in this way, and no other procedures defined in these +% initialization files, have names that begin with %, e.g., +% (%Type1BuildChar) cvn. + +% Check the interpreter revision. NOTE: the interpreter code requires +% that the first non-comment token in this file be an integer. +707 +dup revision ne + { (gs: Interpreter revision \() print revision 10 string cvs print + (\) does not match gs_init.ps revision \() print 10 string cvs print + (\).\n) print flush null 1 .quit + } +if pop + +% Acquire userdict, and set its length if necessary. +/userdict where + { pop userdict maxlength 0 eq } + { true } +ifelse +systemdict exch + { % userdict wasn't already set up by iinit.c. + dup /userdict + currentdict dup 200 .setmaxlength % userdict + .forceput % userdict is local, systemdict is global + } +if begin + +% Define dummy local/global operators if needed. +systemdict /.setglobal known + { true .setglobal + } + { /.setglobal { pop } bind def + /.currentglobal { false } bind def + /.gcheck { pop false } bind def + } +ifelse + +% Define .languagelevel if needed. +systemdict /.languagelevel known not { /.languagelevel 1 def } if + +% Optionally choose a default paper size other than U.S. letter. +% (a4) /PAPERSIZE where { pop pop } { /PAPERSIZE exch def } ifelse + +% Turn on array packing for the rest of initialization. +true setpacking + +% Define the old MS-DOS EOF character as a no-op. +% This is a hack to get around the absurd habit of MS-DOS editors +% of adding an EOF character at the end of the file. +<1a> cvn { } def + +% Acquire the debugging flags. +currentdict /DEBUG known /DEBUG exch def + /VMDEBUG + DEBUG {{print mark + systemdict /level2dict known + { .currentglobal dup false .setglobal vmstatus + true .setglobal vmstatus 3 -1 roll pop + 6 -2 roll pop .setglobal + } + { vmstatus 3 -1 roll pop + } + ifelse usertime 16#fffff and counttomark + { ( ) print ( ) cvs print } + repeat pop + ( ) print systemdict length ( ) cvs print + ( ) print countdictstack ( ) cvs print + ( <) print count ( ) cvs print (>\n) print flush + }} + {{pop + }} + ifelse + def + +currentdict /BATCH known /BATCH exch def +currentdict /DELAYBIND known /DELAYBIND exch def +currentdict /DISKFONTS known /DISKFONTS exch def +currentdict /DOINTERPOLATE .knownget { /INTERPOLATE exch def } if +currentdict /ESTACKPRINT known /ESTACKPRINT exch def +currentdict /FAKEFONTS known /FAKEFONTS exch def +currentdict /FIXEDMEDIA known /FIXEDMEDIA exch def +currentdict /FIXEDRESOLUTION known /FIXEDRESOLUTION exch def +currentdict /LOCALFONTS known /LOCALFONTS exch def +currentdict /NOBIND known /NOBIND exch def +/.bind /bind load def +NOBIND { /bind { } def } if +currentdict /NOCACHE known /NOCACHE exch def +currentdict /NOCCFONTS known /NOCCFONTS exch def +currentdict /NOCIE known /NOCIE exch def +currentdict /NODISPLAY known not /DISPLAYING exch def +currentdict /NOFONTMAP known /NOFONTMAP exch def +currentdict /NOCIDFONTMAP known /NOCIDFONTMAP exch def +currentdict /NOFONTPATH known /NOFONTPATH exch def +currentdict /NOGC known /NOGC exch def +currentdict /NOINTERPOLATE .knownget { /INTERPOLATE exch not def } if +currentdict /NOPAGEPROMPT known /NOPAGEPROMPT exch def +currentdict /NOPAUSE known /NOPAUSE exch def +currentdict /NOPLATFONTS known /NOPLATFONTS exch def +currentdict /NOPROMPT known /NOPROMPT exch def +% The default value of ORIENT1 is true, not false. +currentdict /ORIENT1 known not { /ORIENT1 true def } if +currentdict /OSTACKPRINT known /OSTACKPRINT exch def +currentdict /OUTPUTFILE known % obsolete + { /OutputFile /OUTPUTFILE load def + currentdict /OUTPUTFILE .undef + } if +currentdict /QUIET known /QUIET exch def +% DELAYSAFER is effectively the same as newer NOSAFER +currentdict /DELAYSAFER known { /DELAYSAFER true def /NOSAFER true def } if +currentdict /PARANOIDSAFER known /PARANOIDSAFER exch def +/SAFER currentdict /NOSAFER known { + false +} { + currentdict /SAFER known PARANOIDSAFER or +} +ifelse def +currentdict /SHORTERRORS known /SHORTERRORS exch def +currentdict /STRICT known /STRICT exch def +currentdict /TTYPAUSE known /TTYPAUSE exch def +currentdict /WRITESYSTEMDICT known /WRITESYSTEMDICT exch def + +% Acquire environment variables. +currentdict /DEVICE known not + { (GS_DEVICE) getenv { /DEVICE exch def } if } if + +(START) VMDEBUG + +% Open the standard files, so they will be open at the outermost save level. +(%stdin) (r) file pop +(%stdout) (w) file pop +(%stderr) (w) file pop + +/.currentuserparams where { + pop mark + % The Adobe implementations appear to have very large maximum + % stack sizes. This turns out to actually make a difference, + % since some badly-behaved files include extremely long procedures, + % or construct huge arrays on the operand stack. + % We reset the stack sizes now so that we don't have to worry + % about overflowing the (rather small) built-in stack sizes + % during initialization. + /MaxDictStack 500 + /MaxExecStack 5000 + /MaxOpStack 50000 + .dicttomark .setuserparams +} if + +% Define a procedure for skipping over an unneeded section of code. +% This avoids allocating space for the skipped procedures. +% We can't use readline, because that imposes a line length limit. +/.skipeof % <string> .skipeof - + { currentfile exch 1 exch .subfiledecode flushfile + } .bind def + +% Define procedures to assist users who don't read the documentation. +userdict begin +/help + { (Enter PostScript commands. '(filename) run' runs a file, 'quit' exits.\n) + print flush + } .bind def +end + +% Define =string, which is used by some PostScript programs even though +% it isn't documented anywhere. +% Put it in userdict so that each context can have its own copy. +userdict /=string 256 string put + +% Print the greeting. + +/printgreeting + { mark + product (Ghostscript) search + { pop pop pop + (This software comes with NO WARRANTY: see the file PUBLIC for details.\n) + } + { pop + } + ifelse + (\n) copyright + (\)\n) revisiondate 10 mod revisiondate 10 idiv 10 mod (-) + revisiondate 100 idiv 10 mod revisiondate 1000 idiv 10 mod (-) + revisiondate 10000 idiv ( \() + revision 10 mod + revision 100 mod 10 idiv (.) + revision 100 idiv ( ) + product + counttomark + { (%stdout) (w) file exch 0 .writecvp + } repeat pop + } .bind def + +QUIET not { printgreeting flush } if + +% Define a special version of def for making operator procedures. +/obind { % <name> <proc> obind <name> <oper> + 1 index exch .makeoperator +} .bind def +/odef { % <name> <proc> odef - + 1 index exch .makeoperator def +} .bind def + +% Define a special version of def for storing local objects into global +% dictionaries. Like .forceput, this exists only during initialization. +/.forcedef { % <key> <value> .forcedef - + currentdict 3 1 roll .forceput +} .bind odef + +% Define procedures for accessing variables in systemdict and userdict +% regardless of the contents of the dictionary stack. +/.systemvar { % <name> .systemvar <value> + //systemdict exch get +} .bind odef +/.userdict { % - .userdict <dict> + /userdict .systemvar +} .bind odef +/.uservar { % <name> .uservar <value> + .userdict exch get +} .bind odef + +% If we're delaying binding, remember everything that needs to be bound later. +DELAYBIND NOBIND not and + { .currentglobal false .setglobal + systemdict /.delaybind 1500 array .forceput + .setglobal + userdict /.delaycount 0 put + % When we've done the delayed bind, we want to stop saving. + % Detect this by the disappearance of .delaybind. + /bind + { /.delaybind .systemvar dup length 0 ne + { .delaycount 2 index put + .userdict /.delaycount .delaycount 1 add put + } + { pop .bind + } + ifelse + } .bind def + } if + +%**************** BACKWARD COMPATIBILITY **************** +/hwsizedict mark /HWSize null .dicttomark readonly def +/copyscanlines { % <device> <y> <string> copyscanlines <substr> + 0 3 1 roll 3 index //hwsizedict .getdeviceparams + exch pop exch pop aload pop 3 2 roll + 0 exch null exch .getbitsrect exch pop +} bind odef +currentdict /hwsizedict .undef +/getdeviceprops + { null .getdeviceparams + } bind odef +/.putdeviceprops + { null true counttomark 1 add 3 roll .putdeviceparams + dup type /booleantype ne + { dup mark eq { /unknown /rangecheck } if + counttomark 4 add 1 roll cleartomark pop pop pop + /.putdeviceprops load exch signalerror + } + if + } bind odef +/.currentfilladjust { .currentfilladjust2 pop } bind odef +/.setfilladjust { dup .setfilladjust2 } bind odef +/.writecvs { 0 .writecvp } bind odef +%**************** DEPRECATED PROCEDURES **************** +%**************** DO NOT USE THESE IN NEW CODE **************** +/max { .max } bind def % use .max instead +/min { .min } bind def % use .min instead +/unread /.unread load def % use .peekstring instead +%**************** END OF BACKWARD COMPATIBILITY SECTION **************** + +% Define predefined procedures substituting for operators, +% in alphabetical order. + +userdict /#copies 1 put +% Adobe implementations don't accept /[ or /], so we don't either. +([) cvn + /mark load def +(]) cvn + {counttomark array astore exch pop} odef +% .beginpage is redefined if setpagedevice is present. +/.beginpage { } odef +% In LanguageLevel 3, copypage erases the page. +/copypage { + .languagelevel 3 ge + dup { 0 } { 1 } ifelse .endpage { + .currentnumcopies 1 index .outputpage + (>>copypage, press <return> to continue<<\n) .confirm + dup { erasepage } if + } if pop .beginpage +} odef +/currentmatrix { + .currentmatrix 6 index astore pop +} odef +% .currentnumcopies is redefined in Level 2. +/.currentnumcopies { #copies } odef +/setcolorscreen where { pop % not in all Level 1 configurations + /currentcolorscreen + { .currenthalftone + { { 60 exch 0 exch 3 copy 6 copy } % halftone - not possible + { 3 copy 6 copy } % screen + { } % colorscreen + } + exch get exec + } odef +} if +/currentscreen + { .currenthalftone + { { 60 exch 0 exch } % halftone - not possible + { } % screen + { 12 3 roll 9 { pop } repeat } % colorscreen + } + exch get exec + } odef +/.echo /echo load def +userdict /.echo.mode true put +/echo {dup /.echo.mode exch store .echo} odef +/eexec { + % Rebind .currentresourcefile if it is the source for the eexec. + dup 55665 //filterdict /eexecDecode get exec + cvx exch .currentresourcefile eq + //systemdict begin { {exec} .execasresource } { exec } ifelse + % Only pop systemdict if it is still the top element, + % because this is apparently what Adobe interpreters do. + currentdict //systemdict eq { end } if +} odef +% .endpage is redefined if setpagedevice is present. +/.endpage { 2 ne } odef +% erasepage mustn't use gsave/grestore, because we call it before +% the graphics state stack has been fully initialized. +/erasepage + { /currentcolor where + { pop currentcolor currentcolorspace { setcolorspace setcolor } } + { /currentcmykcolor where + { pop currentcmykcolor { setcmykcolor } } + { currentrgbcolor { setrgbcolor } } + ifelse + } + ifelse 1 setgray .fillpage exec + } odef +% To satisfy the Genoa FTS, executive must be a procedure, not an operator. +/executive + { { prompt + { (%statementedit) (r) file } stopped + { pop pop $error /errorname get /undefinedfilename eq + { .clearerror exit } if % EOF + handleerror null % ioerror?? + } + if + cvx { .runexec } execute + } loop + } bind def +/filter + { //filterdict 1 index .knownget + { exch pop exec } + { /filter load /undefined signalerror } + ifelse + } odef +/handleerror + { /errordict .systemvar /handleerror get exec } bind def +/identmatrix [1.0 0.0 0.0 1.0 0.0 0.0] readonly def +/identmatrix + { dup 0 //identmatrix putinterval } odef +/languagelevel 1 def % gs_lev2.ps may change this +/makeimagedevice { false makewordimagedevice } odef +/matrix { 6 array identmatrix } odef +/pathbbox + { false .pathbbox + } odef +% .promptmsg is redefined if the interpreter includes readline support. +/.promptmsg { + (GS) print + count 0 ne { (<) print count =only } if + (>) print flush +} bind def +/prompt { flush flushpage NOPROMPT not { .promptmsg } if } bind def +/pstack { 0 1 count 3 sub { index == } for } bind def +/putdeviceprops + { .putdeviceprops { erasepage } if } odef +/quit { /quit load 0 .quit } odef +/run { dup type /filetype ne { (r) file } if + % We must close the file when execution terminates, + % regardless of the state of the stack, + % and then propagate an error, if any. + cvx .runexec + } odef +% Execute a file. +% Level 2 uses 2 .stop to clear the e-stack for a successful startjob: +% we detect that here, since we need to handle this even if we start out +% without job control in effect. +% +% What we push on the e-stack is the following to be executed in this order: +% <lit-file|fileproc> .runexec1 <lit-file|fileproc> .runexec2 +/.runexec1 { % <file|fileproc> .runexec1 - + dup type /filetype ne { cvx exec } if + cvx null 2 .stopped + % If we got back here from a startjob, just keep going. + % startjob replaces the null on the o-stack with a procedure + % to be executed when we get back here. + dup null ne { exec true } { pop false } ifelse +} bind def +/.runexec2 { % <continue> <file|fileproc> .runexec2 - + exch { + .runexec + } { + dup type /filetype ne { cvx exec } if + closefile + } ifelse +} bind def +/.runexec { % <file|fileproc> .runexec - + cvlit /.runexec1 cvx 1 index /.runexec2 cvx 4 .execn +} bind def +% The following is only for compatibility with Adobe interpreters. +/setdash { + 1 index length 11 gt { /setdash load /limitcheck signalerror } if + //setdash +} odef +/setdevice + { .setdevice { erasepage } if } odef +/setlinecap { + dup 2 gt { /setlinecap load /rangecheck signalerror } if + .setlinecap +} odef +/setlinejoin { + dup 2 gt { /setlinejoin load /rangecheck signalerror } if + .setlinejoin +} odef +/setmatrix { + dup aload pop .setmatrix pop +} odef +/showpage { + 0 .endpage .doneshowpage { + .currentnumcopies true .outputpage + (>>showpage, press <return> to continue<<\n) .confirm + erasepage + } if initgraphics .beginpage +} odef +% Code output by Adobe Illustrator relies on the fact that +% `stack' is a procedure, not an operator!!! +/stack { 0 1 count 3 sub { index = } for } bind def +/start { BATCH { null 0 .quit } { executive } ifelse } def +% Internal uses of stopped that aren't going to do a stop if an error occurs +% should use .internalstopped to avoid setting newerror et al. +/.internalstopped { null 1 .stopped null ne } bind def +/store { % Don't alter operands before completing. + 1 index where { 2 index 2 index put pop pop } { def } ifelse +} odef +/.typenames mark .typenames counttomark packedarray exch pop def +/type { + //.typenames .type +} odef +currentdict /.typenames .undef +% When running in Level 1 mode, this interpreter is supposed to be +% compatible with PostScript "version" 54.0 (I think). +/version (54.0) readonly def +/.wheredict 10 dict def +/.where /where load def +/where { + //.wheredict 1 index .knownget { exec } { .where } ifelse +} odef + +% internaldict is defined in systemdict, but the dictionary is allocated +% in local VM. However, the procedure must be global, since it is an +% "operator" and must be bind-able into global procedures. +% We make a procedure for creating it, since we must create a new one +% for each context with private local VM. +/.makeinternaldict { + .currentglobal true .setglobal + [ /dup .systemvar 1183615869 /eq .systemvar + [ /pop .systemvar null ] cvx + false .setglobal + dup 1 10 dict .forceput % proc is global, dict is local + true .setglobal + [ /internaldict /cvx .systemvar /invalidaccess /signalerror cvx ] cvx + /ifelse .systemvar + ] cvx executeonly + exch .setglobal +} odef +systemdict /internaldict dup .makeinternaldict .makeoperator +.forceput % proc is local, systemdict is global +% Move superexec to internaldict if superexec is defined. +currentdict /superexec .knownget { + 1183615869 internaldict /superexec 3 -1 roll put + currentdict /superexec .undef +} if + +% Define some additional built-in procedures (beyond the ones defined by +% the PostScript Language Reference Manual). +% Warning: these are not guaranteed to stay the same from one release +% to the next! +/concatstrings % (str1) (str2) concatstrings (str1str2) + { exch dup length 2 index length add string % str2 str1 new + dup dup 4 2 roll copy % str2 new new new1 + length 4 -1 roll putinterval + } bind def +/copyarray + { dup length array copy } bind def +% Copy a dictionary per the Level 2 spec even in Level 1. +/.copydict % <fromdict> <todict> .copydict <todict> + { dup 3 -1 roll { put dup } forall pop } bind def +/copystring + { dup length string copy } bind def +/findlibfile { + .libfile { dup .filename pop exch true } { false } ifelse +} odef +/.growdictlength % get size for growing a dictionary + { length 3 mul 2 idiv 1 add + } bind def +/.growdict % grow a dictionary + { dup .growdictlength .setmaxlength + } bind def +/.growput % put, grow the dictionary if needed + { 2 index length 3 index maxlength eq + { 3 copy pop known not { 2 index .growdict } if + } if + put + } bind def +% .localvmarray may be an operator: see zsysvm.c. +/.localvmarray where { + pop +} { + /.localvmarray { + .currentglobal false .setglobal + exch array exch .setglobal + } bind def +} ifelse +/.localvmdict where { + pop +} { + /.localvmdict { + .currentglobal false .setglobal + exch dict exch .setglobal + } bind def +} ifelse +/.packtomark + { counttomark packedarray exch pop } bind def +/ppstack + { 0 1 count 3 sub { index === } for } bind def +/runlibfile + { % We don't want to bind 'run' into this procedure, + % since run may get redefined. + findlibfile + { exch pop /run .systemvar exec } + { /undefinedfilename signalerror } + ifelse + } bind def +/selectdevice + { finddevice setdevice .setdefaultscreen } bind def +/signalerror % <object> <errorname> signalerror - + { /errordict .systemvar exch get exec } bind def + +% Define the =[only] procedures. Also define =print, +% which is used by some PostScript programs even though +% it isn't documented anywhere. +/write=only { + .writecvs +} bind def +/write= { + 1 index exch write=only (\n) writestring +} bind def +/=only { (%stdout) (w) file exch write=only } bind def +/= { =only (\n) print } bind def +/=print /=only load def +% Temporarily define == as = for the sake of runlibfile0. +/== /= load def + +% The following procedures are documented. +/copydevice { % <device> copydevice <newdevice> + false .copydevice2 +} odef +/finddevice { % <devicename> finddevice <device> + /devicedict .systemvar exch get + dup 1 get null eq { + % This is the first request for this type of device. + % Create a default instance now. + % Stack: [proto null] + .currentglobal true .setglobal exch + dup dup 0 get copydevice 1 exch put + exch .setglobal + } if 1 get +} bind def +/findprotodevice { % <devicename> findprotodevice <protodevice> + /devicedict .systemvar exch get 0 get +} bind def + +% Run a resource file. This allows us to distinguish resource objects +% from objects coming from input files. +userdict /.currentresourcefile null put +/.execasresource { % <file> <proc|runfile> .execasresource - + /stopped .systemvar + /.currentresourcefile .uservar + % Stack: file proc -stopped- currfile + .userdict /.currentresourcefile 5 index cvlit put + 2 .execn % stopped <file> + .userdict /.currentresourcefile 3 -1 roll put + { stop } if +} bind def +/.runresource { % <file> .runresource - + { /run .systemvar exec } .execasresource +} bind def + +% Define procedures for getting and setting the current device resolution. + +/gsgetdeviceprop % <device> <propname> gsgetdeviceprop <value> + { 2 copy mark exch null .dicttomark .getdeviceparams + dup mark eq % if true, not found + { pop dup /undefined signalerror } + { 5 1 roll pop pop pop pop } + ifelse + } bind def +/gscurrentresolution % - gscurrentresolution <[xres yres]> + { currentdevice /HWResolution gsgetdeviceprop + } bind def +/gssetresolution % <[xres yres]> gssetresolution - + { 2 array astore mark exch /HWResolution exch + currentdevice copydevice putdeviceprops setdevice + } bind def + +% Define auxiliary procedures needed for the above. +/shellarguments % -> shell_arguments true (or) false + { /ARGUMENTS where + { /ARGUMENTS get dup type /arraytype eq + { aload pop /ARGUMENTS null store true } + { pop false } + ifelse } + { false } ifelse + } bind def +/.confirm { + DISPLAYING NOPAUSE not TTYPAUSE or and { + % Print a message (unless NOPAGEPROMPT or NOPROMPT is true) + % and wait for the user to type something. + % If the user just types a newline, flush it. + NOPAGEPROMPT NOPROMPT or { pop } { print flush } ifelse + .confirmread + } { + pop + } ifelse +} bind def +/.confirmread { + TTYPAUSE { + (/dev/tty) (r) file dup read pop pop closefile + } { + .echo.mode false echo + (%stdin) (r) file dup read { + dup (\n) 0 get eq { pop pop } { unread } ifelse + } { + pop + } ifelse echo + } ifelse +} bind def + +% Define the procedure used by .runfile, .runstdin and .runstring +% for executing user input. +% This is called with a procedure or executable file on the operand stack. +/.execute { % <obj> .execute <stopped> + stopped $error /newerror get and + { handleerror flush true } { false } ifelse +} bind def +/execute { % <obj> execute - + .execute pop +} odef +% Define an execute analogue of runlibfile0. +/execute0 { % <obj> execute0 - + .execute { /execute0 cvx 1 .quit } if +} bind def +% Define the procedure that the C code uses for running files +% named on the command line. +/.runfile { + { runlibfile } execute0 +} def +% Define the procedure that the C code uses for running piped input. +% We don't use the obvious { (%stdin) run }, because we want the file to be +% reopened if a startjob does a restore. +/.runstdin { + { { (%stdin) (r) file cvx } .runexec } execute0 +} bind def +% Define the procedure that the C code uses for running commands +% given on the command line with -c. We turn the string into a file so that +% .runexec can do the right thing with a startjob. +/.runstring { + .currentglobal exch true .setglobal + 0 () .subfiledecode + exch .setglobal cvx { .runexec } execute0 +} bind def +% Define the procedure that the C code uses to set up for executing +% a string that may be received in pieces. +/.runstringbegin { + .currentglobal true .setglobal + { .needinput } bind 0 () .subfiledecode + exch .setglobal cvx .runexec +} bind def + +% Define a special version of runlibfile that aborts on errors. +/runlibfile0 + { cvlit dup /.currentfilename exch def + { findlibfile not { stop } if } + stopped + { (Can't find \(or open\) initialization file ) print + .currentfilename == flush /runlibfile0 cvx 1 .quit + } if + exch pop cvx stopped + { (While reading ) print .currentfilename print (:\n) print flush + handleerror /runlibfile0 1 .quit + } if + } bind def +% Temporarily substitute it for the real runlibfile. +/.runlibfile /runlibfile load def +/runlibfile /runlibfile0 load def + +% Create the error handling machinery. +% Define the standard error handlers. +% The interpreter has created the ErrorNames array. +/.unstoppederrorhandler % <command> <errorname> .unstoppederrorhandler - + { % This is the handler that gets used for recursive errors, + % or errors outside the scope of a 'stopped'. + 2 copy SHORTERRORS + { (%%[ Error: ) print =only flush + (; OffendingCommand: ) print =only ( ]%%) = + } + { (Unrecoverable error: ) print =only flush + ( in ) print = flush + count 2 gt + { (Operand stack:\n ) print + count 1 sub -1 2 { ( ) print index =only flush } for + () = flush + } if + } + ifelse + -1 0 1 //ErrorNames length 1 sub + { dup //ErrorNames exch get 3 index eq + { not exch pop exit } { pop } ifelse + } + for exch pop .quit + } bind def +/.errorhandler % <command> <errorname> .errorhandler - + { % Detect an internal 'stopped'. + 1 .instopped { null eq { pop pop stop } if } if + $error /.inerror get 1 .instopped { pop } { pop true } ifelse + { .unstoppederrorhandler + } if % detect error recursion + $error /globalmode .currentglobal false .setglobal put + $error /.inerror true put + $error /newerror true put + $error exch /errorname exch put + $error exch /command exch put + $error /recordstacks get $error /errorname get /VMerror ne and + { % Attempt to store the stack contents atomically. + count array astore dup $error /ostack 4 -1 roll + countexecstack array execstack $error /estack 3 -1 roll + countdictstack array dictstack $error /dstack 3 -1 roll + put put put aload pop + } + { $error /dstack .undef + $error /estack .undef + $error /ostack .undef + } + ifelse + $error /position currentfile status + { currentfile { fileposition } .internalstopped { pop null } if + } + { % If this was a scanner error, the file is no longer current, + % but the command holds the file, which may still be open. + $error /command get dup type /filetype eq + { { fileposition } .internalstopped { pop null } if } + { pop null } + ifelse + } + ifelse put + % During initialization, we don't reset the allocation + % mode on errors. + $error /globalmode get $error /.nosetlocal get and .setglobal + $error /.inerror false put + stop + } bind def +% Define the standard handleerror. We break out the printing procedure +% (.printerror) so that it can be extended for binary output +% if the Level 2 facilities are present. + /.printerror + { $error begin + /command load errorname SHORTERRORS + { (%%[ Error: ) print =only flush + (; OffendingCommand: ) print =only + errorinfo dup null eq { + pop + } { + (;\nErrorInfo:) print + dup type /arraytype eq + { { ( ) print =only } forall } + { ( ) print =only } + ifelse + } ifelse + ( ]%%) = flush + } + { (Error: ) print ==only flush + ( in ) print ==only flush + errorinfo dup null eq { + pop + } { + (\nAdditional information: ) print ==only flush + } ifelse + .printerror_long + } + ifelse + .clearerror + end + flush + } bind def + /.printerror_long % long error printout, + % $error is on the dict stack + { % Push the (anonymous) stack printing procedure. + % <heading> <==flag> <override-name> <stackname> proc + { + currentdict exch .knownget % stackname defined in $error? + { + 4 1 roll % stack: <stack> <head> <==flag> <over> + errordict exch .knownget % overridename defined? + { + exch pop exch pop exec % call override with <stack> + } + { + exch print exch % print heading. stack <==flag> <stack> + 1 index not { () = } if + { 1 index { (\n ) } { ( ) } ifelse print + dup type /dicttype eq + { + (--dict:) print + dup rcheck { + dup length =only (/) print dup maxlength =only + dup wcheck not { ((ro)) print } if + } if + /gcheck where { + pop gcheck { ((G)) } { ((L)) } ifelse print + } { + pop + } ifelse (--) print + } + { + dup type /stringtype eq 2 index or + { ==only } { =only } ifelse + } ifelse + } forall + pop + } + ifelse % overridden + } + { pop pop pop + } + ifelse % stack known + } + + (\nOperand stack:) OSTACKPRINT /.printostack /ostack 4 index exec + (\nExecution stack:) ESTACKPRINT /.printestack /estack 4 index exec + (\nBacktrace:) true /.printbacktrace /backtrace 4 index exec + (\nDictionary stack:) false /.printdstack /dstack 4 index exec + () = + pop % printing procedure + + errorname /VMerror eq + { (VM status:) print mark vmstatus + counttomark { ( ) print counttomark -1 roll dup =only } repeat + cleartomark () = + } if + + .languagelevel 2 ge + { (Current allocation mode is ) print + globalmode { (global\n) } { (local\n) } ifelse print + } if + + .oserrno dup 0 ne + { (Last OS error: ) print + errorname /VMerror ne + { dup .oserrorstring { = pop } { = } ifelse } + { = } + ifelse + } + { pop + } + ifelse + + position null ne + { (Current file position is ) print position = } + if + + } bind def +% Define a procedure for clearing the error indication. +/.clearerror + { $error /newerror false put + $error /errorname null put + $error /errorinfo null put + 0 .setoserrno + } bind def + +% Define $error. This must be in local VM. +.currentglobal false .setglobal +/$error 40 dict .forcedef % $error is local, systemdict is global + % newerror, errorname, command, errorinfo, + % ostack, estack, dstack, recordstacks, + % binary, globalmode, + % .inerror, .nosetlocal, position, + % plus extra space for badly designed error handers. +$error begin + /newerror false def + /recordstacks true def + /binary false def + /globalmode .currentglobal def + /.inerror false def + /.nosetlocal true def + /position null def +end +% Define errordict similarly. It has one entry per error name, +% plus handleerror. However, some astonishingly badly written PostScript +% files require it to have at least one empty slot. +/errordict ErrorNames length 2 add dict +.forcedef % errordict is local, systemdict is global +.setglobal % contents of errordict are global +errordict begin + ErrorNames + { mark 1 index systemdict /.errorhandler get /exec load .packtomark cvx def + } forall +% The handlers for interrupt and timeout are special; there is no +% 'current object', so they push their own name. + { /interrupt /timeout } + { mark 1 index dup systemdict /.errorhandler get /exec load .packtomark cvx def + } forall +/handleerror + { /.printerror .systemvar exec + } bind def +end + +% Define the [write]==[only] procedures. +/.dict 8 dict dup +begin def + /.cvp {1 index exch 1 .writecvp} bind def + /.p {1 index exch writestring} bind def + /.p1 {2 index exch writestring} bind def + /.p2 {3 index exch writestring} bind def + /.print + { dup type .dict exch .knownget { exec } { .cvp } ifelse + } bind def + /arraytype + {dup rcheck + {() exch dup xcheck + {({) .p2 + {exch .p1 + 1 index exch .print pop ( )} forall + (})} + {([) .p2 + {exch .p1 + 1 index exch .print pop ( )} forall + (])} + ifelse exch pop .p} + {.cvp} + ifelse} bind def + /packedarraytype /arraytype load def +{//.dict begin .print pop end} + bind +end + +/write==only exch def +/write== {1 index exch write==only (\n) writestring} bind def +/==only { (%stdout) (w) file exch write==only } bind def +/== {==only (\n) print} bind def + +% Define [write]===[only], an extension that prints dictionaries +% in readable form and doesn't truncate strings. +/.dict /write==only load 0 get dup length 2 add dict .copydict dup +begin def + /dicttype + { dup rcheck + { (<< ) .p1 + { 2 index 3 -1 roll .print pop ( ) .p1 + 1 index exch .print pop ( ) .p + } + forall (>>) .p + } + { .cvp + } + ifelse + } bind def + /stringtype + { 1 index exch 2 .writecvp + } bind def + +{//.dict begin .print pop end} + bind +end + +/write===only exch def +/write=== {1 index exch write===only (\n) writestring} bind def +/===only { (%stdout) (w) file exch write===only } bind def +/=== { ===only (\n) print } bind def + +(END PROCS) VMDEBUG + +% Define the font directory. +/FontDirectory false .setglobal 100 dict true .setglobal +.forcedef % FontDirectory is local, systemdict is global + +% Define the encoding dictionary. +/EncodingDirectory 16 dict def % enough for Level 2 + PDF standard encodings + +% Define .findencoding. (This is redefined in Level 2.) +/.findencoding + { //EncodingDirectory exch get exec + } bind def +/.defineencoding + { //EncodingDirectory 3 1 roll put + } bind def +% If we've got the composite font extensions, define findencoding. +% To satisfy the Genoa FTS, findencoding must be a procedure, not an operator. +/rootfont where { pop /findencoding { .findencoding } def } if + +% Define .registerencoding. +% NOTE: the name registeredencodings is known to (initialized by and shared +% with) the interpreter. +/.registerencoding { % <index> <array> .registerencoding - + % Check that the array is indexable. + % (It might still be a string, but then the .namestring will fail.) + dup 0 0 getinterval pop + % Check that all the elements of the array are names. + dup { .namestring pop } forall + % Do the store. + //registeredencodings 2 index 2 index readonly put pop pop +} bind odef +systemdict /registeredencodings .undef + +% Load StandardEncoding. +%% Replace 1 (gs_std_e.ps) +(gs_std_e.ps) dup runlibfile VMDEBUG + +% Load ISOLatin1Encoding. +%% Replace 1 (gs_il1_e.ps) +(gs_il1_e.ps) dup runlibfile VMDEBUG + +% Define stubs for the Symbol and Dingbats encodings. +% Note that the first element of the procedure must be the file name, +% since gs_lev2.ps extracts it to set up the Encoding resource category. + + /SymbolEncoding { /SymbolEncoding .findencoding } bind def +%% Replace 3 (gs_sym_e.ps) + EncodingDirectory /SymbolEncoding + { (gs_sym_e.ps) //systemdict begin runlibfile SymbolEncoding end } + bind put + + /DingbatsEncoding { /DingbatsEncoding .findencoding } bind def +%% Replace 3 (gs_dbt_e.ps) + EncodingDirectory /DingbatsEncoding + { (gs_dbt_e.ps) //systemdict begin runlibfile DingbatsEncoding end } + bind put + +(END FONTDIR/ENCS) VMDEBUG + +% Construct a dictionary of all available devices. +% These are (read-only) device prototypes that can't be +% installed or have their parameters changed. For this reason, +% the value in the dictionary is actually a 2-element writable array, +% to allow us to create a default instance of the prototype on demand. + + % Loop until the .getdevice gets a rangecheck. +errordict /rangecheck 2 copy get +errordict /rangecheck { pop stop } put % pop the command + 0 { {dup .getdevice exch 1 add} loop} .internalstopped pop + 1 add dict /devicedict 1 index def + begin % 2nd copy of count is on stack + { dup .devicename exch + dup wcheck { dup } { null } ifelse 2 array astore def + } repeat + end +put % errordict /rangecheck +.clearerror +/devicenames devicedict { pop } forall devicedict length packedarray def + +% Determine the default device. +/defaultdevice DISPLAYING + { systemdict /DEVICE .knownget + { devicedict 1 index known not + { (Unknown device: ) print = + flush /defaultdevice cvx 1 .quit + } + if + } + { 0 .getdevice .devicename + } + ifelse + } + { /nullpage + } +ifelse +/.defaultdevicename 1 index def +finddevice % make a copy +def +devicedict /Default devicedict .defaultdevicename get put + +(END DEVS) VMDEBUG + +% Define statusdict, for the benefit of programs +% that think they are running on a LaserWriter or similar printer. +%% Replace 1 (gs_statd.ps) +(gs_statd.ps) runlibfile + +(END STATD) VMDEBUG + +% Load the standard font environment. +%% Replace 1 (gs_fonts.ps) +(gs_fonts.ps) runlibfile + +(END GS_FONTS) VMDEBUG + +% Define the default halftone screen and BG/UCR functions now, so that +% it will bind in the original definitions of set[color]screen. +% We make this a procedure so we can call it again when switching devices. + +% Use an ordered dither for low-resolution devices. +/.setloreshalftone { % <dpi> .setloreshalftone - + % The following 'ordered dither' spot function was contributed by + % Gregg Townsend. Thanks, Gregg! + 16.001 div 0 % not 16: avoids rounding problems + { 1 add 7.9999 mul cvi exch 1 add 7.9999 mul cvi 16 mul add < + 0E 8E 2E AE 06 86 26 A6 0C 8C 2C AC 04 84 24 A4 + CE 4E EE 6E C6 46 E6 66 CC 4C EC 6C C4 44 E4 64 + 3E BE 1E 9E 36 B6 16 96 3C BC 1C 9C 34 B4 14 94 + FE 7E DE 5E F6 76 D6 56 FC 7C DC 5C F4 74 D4 54 + 01 81 21 A1 09 89 29 A9 03 83 23 A3 0B 8B 2B AB + C1 41 E1 61 C9 49 E9 69 C3 43 E3 63 CB 4B EB 6B + 31 B1 11 91 39 B9 19 99 33 B3 13 93 3B BB 1B 9B + F1 71 D1 51 F9 79 D9 59 F3 73 D3 53 FB 7B DB 5B + 0D 8D 2D AD 05 85 25 A5 0F 8F 2F AF 07 87 27 A7 + CD 4D ED 6D C5 45 E5 65 CF 4F EF 6F C7 47 E7 67 + 3D BD 1D 9D 35 B5 15 95 3F BF 1F 9F 37 B7 17 97 + FD 7D DD 5D F5 75 D5 55 FF 7F DF 5F F7 77 D7 57 + 02 82 22 A2 0A 8A 2A AA 00 80 20 A0 08 88 28 A8 + C2 42 E2 62 CA 4A EA 6A C0 40 E0 60 C8 48 E8 68 + 32 B2 12 92 3A BA 1A 9A 30 B0 10 90 38 B8 18 98 + F2 72 D2 52 FA 7A DA 5A F0 70 D0 50 F8 78 D8 58 + > exch get 256 div + } + bind + % Use correct, per-plane screens for CMYK devices only. + //systemdict /setcolorscreen known processcolors 4 eq and + { 3 copy 6 copy //setcolorscreen } + { //setscreen } + ifelse +} bind def +/.setloresscreen { % <dpi> .setloresscreen - + .setloreshalftone + 0 array cvx settransfer % Genoa CET won't accept a packed array! + /setstrokeadjust where { pop true setstrokeadjust } if +} bind def +% Use a 45-degree spot screen for high-resolution devices. +/.sethireshalftone { % <dpi> .sethireshalftone <doscreen> + % According to information published by Hewlett-Packard, + % they use a 60 line screen on 300 DPI printers and + % an 85 line screen on 600 DPI printers. + % However, we use a 106 line screen, which produces smoother- + % looking shades but fewer of them (32 vs. 50). + % 46 was suggested as a good frequency value for printers + % between 200 and 400 DPI, so we use it for lower resolutions. + % Imagesetters need even higher frequency screens. + //systemdict /DITHERPPI known + { DITHERPPI + } + { dup cvi 100 idiv 15 .min + {null 46 46 60 60 60 106 106 106 106 133 133 133 133 133 150} + exch get + } + ifelse + 1 index 4.01 div .min % at least a 4x4 cell + 45 + % The following screen algorithm is used by permission of the author. + { 1 add 180 mul cos 1 0.08 add mul exch 2 add 180 mul cos + 1 0.08 sub mul add 2 div % (C) 1989 Berthold K.P. Horn + } + bind + % Determine whether we have lots of process colors. + % If so, don't bother with color screening or gamma correction. + % Also don't do gamma correction on very high-resolution devices. + % (This should depend on dot gain, not resolution, but we don't + % currently have a way to determine this.) + currentdevice mark + /RedValues 0 /GreenValues 0 /BlueValues 0 /GrayValues 0 + .dicttomark .getdeviceparams + counttomark 2 idiv 1 sub { exch pop .min } repeat + exch pop exch pop 32 lt 4 index 800 lt and 5 1 roll + % Stack: doscreen dpi freq angle proc + % Ghostscript currently doesn't use correct, per-plane halftones + % unless setcolorscreen has been executed. Since these are + % computationally much more expensive than binary halftones, + % we check to make sure they are really warranted, i.e., we have + % a high-resolution CMYK device (i.e., not a display) with + % fewer than 5 bits per plane (i.e., not a true-color device). + 4 -1 roll 150 ge + { /setcolorscreen where + { pop //systemdict /COLORSCREEN known + { COLORSCREEN } + { 3 index } + ifelse + dup false ne + { 4 1 roll 3 copy 6 copy 13 -1 roll + % For really high-quality screening on printers, we need to + % give each plane its own screen angle. Unfortunately, + % this currently has very large space and time costs. + true eq % true => different angles, + % 0 => same angles + { { 45 90 15 75 } { 3 1 roll exch pop 12 3 roll } forall + } + if //setcolorscreen + } + { pop //setscreen % false => single binary screen + } + ifelse + } + { //setscreen % setcolorscreen not known + } + ifelse + } + { //setscreen % not high resolution + } + ifelse +} bind def +/.sethiresscreen { % <dpi> .sethiresscreen - + .sethireshalftone + % Stack: doscreen + { % Set the transfer function to lighten up the grays. + % We correct at the high end so that very light grays + % don't disappear completely if they darken <1 screen pixel. + % Parameter values closer to 1 are better for devices with + % less dot spreading; lower values are better with more spreading. + % The value 0.8 is a compromise that will probably please no one! + % + % Because of a bug in FrameMaker, we have to accept operands + % outside the valid range of [0..1]. + { dup dup 0.0 gt exch 1.0 lt and + { 0.8 exp dup dup 0.9375 gt exch 0.999 lt and % > 15/16 + { .currentscreenlevels 1 sub % tweak to avoid boundary + 1 exch div 1 exch sub .min + } + if + } + if + } + } + { % Set the transfer function to the identity. + 0 array cvx % Genoa CET won't accept a packed array! + } + ifelse settransfer + /setstrokeadjust where { pop false setstrokeadjust } if + % Increase fill adjustment so that we effectively use Adobe's + % any-part-of-pixel rule. + 0.5 .setfilladjust +} bind def +% Set the default screen and BG/UCR. +/.setdefaultbgucr { + systemdict /setblackgeneration known { + { pop 0 } dup setblackgeneration setundercolorremoval + } if +} bind def +/.useloresscreen { % - .useloresscreen <bool> + % Compute min(|dpi x|,|dpi y|) as the definition of the resolution. + 72 72 matrix defaultmatrix dtransform abs exch abs .min + dup 150 lt //systemdict /DITHERPPI known not and +} bind def + +% The following implementation uses LL2 extensions, but only in stopped +% contexts so that with LL1, the .set??reshalftone will be used. +% +% - .getdefaulthalftone <halftonedict> true if default found +% false +/.getdefaulthalftone { + % try the device to see if it has a default halftone + { currentdevice /HalftoneDefault gsgetdeviceprop } stopped + { pop pop false } % no device property + { dup type /dicttype eq { true } { pop false } ifelse } + ifelse + % stack: <halftonedict> true if default found + % false not found + dup not + { % device did not provide a default, try Resource + pop { /Default /Halftone /findresource .systemvar exec } stopped + { pop pop false } { true } ifelse + } + if +} bind def + +/.setdefaulthalftone { + .getdefaulthalftone + { sethalftone } + { % default not found + .useloresscreen { .setloreshalftone } { .sethireshalftone pop } ifelse + } + ifelse +} bind def + +/.setdefaultscreen { + .useloresscreen { .setloresscreen } { .sethiresscreen } ifelse + .setdefaultbgucr +} bind def + +% Load the initialization files for optional features. +%% Replace 4 INITFILES +systemdict /INITFILES known + { INITFILES { dup runlibfile VMDEBUG } forall + } +if + +% If Level 2 (or higher) functionality is implemented, enable it now. +/.setlanguagelevel where { + pop 2 .setlanguagelevel + % If the resource machinery is loaded, fix up some things now. + /.fixresources where { pop .fixresources } if +} if +/ll3dict where { + pop 3 .setlanguagelevel +} if + +(END INITFILES) VMDEBUG + +% Create a null font. This is the initial font. +8 dict dup begin + /FontMatrix [ 1 0 0 1 0 0 ] readonly def + /FontType 3 def + /FontName () def + /Encoding StandardEncoding def + /FontBBox { 0 0 0 0 } readonly def % executable is bogus, but customary ... + /BuildChar { pop pop 0 0 setcharwidth } bind def + /PaintType 0 def % shouldn't be needed! +end +/NullFont exch definefont setfont + +% Define NullFont as the font. +/NullFont currentfont def + +% Load initial fonts from FONTPATH directories, Fontmap file, +% and/or .getccfont as appropriate. +.loadinitialfonts + +% Remove NullFont from FontDirectory, so it can't be accessed by mistake. +/undefinefont where { + pop /NullFont undefinefont +} { + FontDirectory /NullFont .undef +} ifelse + +(END FONTS) VMDEBUG + +% Restore the real definition of runlibfile. +/runlibfile /.runlibfile load def +currentdict /.runlibfile .undef + +% Bind all the operators defined as procedures. +/.bindoperators % binds operators in currentdict + { % Temporarily disable the typecheck error. + errordict /typecheck 2 copy get + errordict /typecheck { pop } put % pop the command + currentdict + { dup type /operatortype eq + { % This might be a real operator, so bind might cause a typecheck, + % but we've made the error a no-op temporarily. + .bind % do a real bind even if NOBIND is set + } + if pop pop + } forall + put + } def +NOBIND DELAYBIND or not { .bindoperators } if + +% Establish a default environment. + +defaultdevice +% The following line used to skip setting of page size and resolution if +% NODISPLAY was selected. We think this was only to save time and memory, +% and it is a bad idea because it prevents setting the resolution in this +% situation, which pstoedit (among other programs) relies on. +%DISPLAYING not { setdevice (%END DISPLAYING) .skipeof } if +systemdict /DEVICEWIDTH known +systemdict /DEVICEHEIGHT known or +systemdict /DEVICEWIDTHPOINTS known or +systemdict /DEVICEHEIGHTPOINTS known or +systemdict /DEVICEXRESOLUTION known or +systemdict /DEVICEYRESOLUTION known or +systemdict /PAPERSIZE known or +not { (%END DEVICE) .skipeof } if +% Let DEVICE{WIDTH,HEIGHT}[POINTS] override PAPERSIZE. +systemdict /PAPERSIZE known +systemdict /DEVICEWIDTH known not and +systemdict /DEVICEHEIGHT known not and +systemdict /DEVICEWIDTHPOINTS known not and +systemdict /DEVICEHEIGHTPOINTS known not and + { % Convert the paper size to device dimensions. + true statusdict /.pagetypenames get + { PAPERSIZE eq + { PAPERSIZE load + dup 0 get /DEVICEWIDTHPOINTS exch def + 1 get /DEVICEHEIGHTPOINTS exch def + pop false exit + } + if + } + forall + { (Unknown paper size: ) print PAPERSIZE ==only (.) = + } + if + } +if +% Adjust the device parameters per the command line. +% It is possible to specify resolution, pixel size, and page size; +% since any two of these determine the third, conflicts are possible. +% We simply pass them to .setdeviceparams and let it sort things out. + mark /HWResolution null /HWSize null /PageSize null .dicttomark + .getdeviceparams .dicttomark begin + mark + % Check for resolution. + /DEVICEXRESOLUTION where dup + { exch pop HWResolution 0 DEVICEXRESOLUTION put } + if + /DEVICEYRESOLUTION where dup + { exch pop HWResolution 1 DEVICEYRESOLUTION put } + if + or { /HWResolution HWResolution } if + % Check for device sizes specified in pixels. + /DEVICEWIDTH where dup + { exch pop HWSize 0 DEVICEWIDTH put } + if + /DEVICEHEIGHT where dup + { exch pop HWSize 1 DEVICEHEIGHT put } + if + or { /HWSize HWSize } if + % Check for device sizes specified in points. + /DEVICEWIDTHPOINTS where dup + { exch pop PageSize 0 DEVICEWIDTHPOINTS put } + if + /DEVICEHEIGHTPOINTS where dup + { exch pop PageSize 1 DEVICEHEIGHTPOINTS put } + if + or { /PageSize PageSize } if + % Check whether any parameters were set. + dup mark eq { pop } { defaultdevice putdeviceprops } ifelse + end +%END DEVICE +% Set any device properties defined on the command line. +% If BufferSpace is defined but not MaxBitmap, set MaxBitmap to BufferSpace. +systemdict /BufferSpace known +systemdict /MaxBitmap known not and + { systemdict /MaxBitmap BufferSpace put + } if +dup getdeviceprops +counttomark 2 idiv + { systemdict 2 index known + { pop dup load counttomark 2 roll } + { pop pop } + ifelse + } repeat +counttomark dup 0 ne + { 2 add -1 roll putdeviceprops } + { pop pop } +ifelse +% If the initial device parameters are invalid, the setdevice may fail. +% Trap this and produce a reasonable error message. +{ setdevice } % does an erasepage +DEBUG { exec false } { .internalstopped } ifelse { + (**** Unable to open the initial device, quitting.) = flush 1 .quit +} if + +% If the media size is fixed, update the current page device dictionary. +FIXEDMEDIA +dup { pop systemdict /.currentpagedevice known } if +dup { pop .currentpagedevice exch pop } if +not { (%END MEDIA) .skipeof } if +currentpagedevice dup length dict .copydict +dup /Policies + % Stack: <pagedevice> <pagedevice> /Policies +1 index /InputAttributes +2 copy get dup length dict .copydict + % Stack: <pagedevice> <pagedevice> /Policies <pagedevice> + % /InputAttributes <inputattrs'> +dup 0 2 copy get dup length dict .copydict + % Stack: <pagedevice> <pagedevice> /Policies <pagedevice> + % /InputAttributes <inputattrs'> <inputattrs'> 0 <attrs0'> +dup /PageSize 7 index /PageSize get +put % PageSize in 0 +put % 0 in InputAttributes +put % InputAttributes in pagedevice +% Also change the page size policy so we don't get an error. + % Stack: <pagedevice> <pagedevice> /Policies +2 copy get dup length dict .copydict + % Stack: <pagedevice> <pagedevice> /Policies <policies'> +dup /PageSize 7 put % PageSize in Policies +put % Policies in pagedevice +.setpagedevice +%END MEDIA +%END DISPLAYING + +(END DEVICE) VMDEBUG + +% Establish a default upper limit in the character cache, +% namely, enough room for a 18-point character at the resolution +% of the default device, or for a character consuming 1% of the +% maximum cache size, whichever is larger. +mark + % Compute limit based on character size. + 18 dup dtransform + exch abs cvi 31 add 32 idiv 4 mul % X raster + exch abs cvi mul % Y + % Compute limit based on allocated space. + cachestatus pop pop pop pop pop exch pop 0.01 mul cvi + .max dup 10 idiv exch +setcacheparams +% Conditionally disable the character cache. +NOCACHE { 0 setcachelimit } if + +(END CONFIG) VMDEBUG + +% Initialize graphics. + +.setdefaultscreen +initgraphics + +% The interpreter relies on there being at least 2 entries +% on the graphics stack. Establish the second one now. +gsave + +% Define some control sequences as no-ops. +% This is a hack to get around problems +% in some common PostScript-generating applications. +<04> cvn { } def % Apple job separator +<0404> cvn { } def % two of the same +<1b> cvn { } def % MS Windows LaserJet 4 prologue + % (UEL = ESC %-12345X) +<1b45> cvn { } def % PJL reset prologue (ESC E) +<1b451b> cvn { } def % PJL reset epilogue (ESC E + UEL) +<041b> cvn { } def % MS Windows LaserJet 4 epilogue (^D + UEL) +(\001M) cvn % TBCP initiator + { currentfile /TBCPDecode filter cvx exec + } bind def +/@PJL % H-P job control + { currentfile //=string readline { pop } if + } bind def + +% Install the EPS handler if needed +systemdict /EPSBoundingBoxInit known { EPSBoundingBoxInit } if + +% If we want a "safer" system, disable some obvious ways to cause havoc. +.currentglobal true .setglobal +/SAFETY 2 dict + dup /safe false put + dup /tempfiles 10 dict readonly put +readonly def +.setglobal + +% Convert a path name into a string suitable for filenameforall +% For example: (a\\b*?c) to (a\\\\b\\*\\?c) +/.makepathtemplate { % str1 -- str2 + dup length dup add string 0 % result string up to twice the size + 0 1 4 index length 1 sub { + 3 index exch get + dup 92 eq { % \ -> \\ + 2 index 2 index 92 + put + exch 1 add exch + } + if + dup 42 eq { % * -> \* + 2 index 2 index 92 + put + exch 1 add exch + } + if + dup 63 eq { % ? -> \? + 2 index 2 index 92 + put + exch 1 add exch + } + if + 2 index 2 index 3 -1 roll put 1 add + } for + 0 exch getinterval exch pop +} bind def + +/.locksafe { + SAFETY /safe get not { + << + /PermitFileReading [ + currentuserparams /PermitFileReading get aload pop + { .makepathtemplate + dup .filenamedirseparator concatstrings (*) concatstrings + exch % put string below this procedure + } + /LIBPATH .systemvar { 1 index exec } forall + /FONTPATH .systemvar { 1 index exec } forall + currentsystemparams /GenericResourceDir get 1 index exec + currentsystemparams /FontResourceDir get exch exec + ] + /LockFilePermissions true + >> setuserparams + } + if + % setpagedevice has the side effect of clearing the page, but + % we will just document that. Using setpagedevice keeps the device + % properties and pagedevice .LockSafetyParams in agreement even + % after a restore that changes the value to false. + currentglobal currentpagedevice gcheck setglobal % use correct VM space + << /.LockSafetyParams true >> setpagedevice + setglobal + //SAFETY /safe //true .forceput % overrides readonly +} .bind executeonly odef + +/.setsafe +{ + SAFETY /safe get not { + << + PARANOIDSAFER { % only PARANOIDSAFER locks down reading files + /PermitFileReading [ ] + } if + /PermitFileWriting [ ] + /PermitFileControl [ ] + >> setuserparams + } + if + .locksafe +} .bind executeonly odef + +/deletefile { + count 1 lt { + //deletefile /stackunderflow signalerror + } + if + dup { deletefile } stopped { + pop //deletefile $error /errorname get signalerror + } { + % deletefile succeeded. Remove from tempfile list if present + //SAFETY /tempfiles get exch cvn 2 copy known { + .forceundef + } { + pop pop + } + ifelse + } + ifelse +} .bind executeonly odef + +% If a file is opened with .tempfile with SAFER not (yet) set, +% the file can be deleted later, even if SAFER is set. +/.tempfile { + .tempfile % filename file + //SAFETY /tempfiles get 2 index true .forceput +} .bind executeonly odef + +% If we are running in SAFER mode, lock things down +SAFER { .setsafe } if + +% If we delayed binding, make it possible to do it later. +/.bindnow { + //systemdict begin .bindoperators end + % Temporarily disable the typecheck error. + errordict /typecheck 2 copy get + errordict /typecheck { pop } put % pop the command + 0 1 .delaycount 1 sub { .delaybind exch get .bind pop } for + //systemdict /.delaybind {} .forceput % reclaim the space + //systemdict /.bindnow .forceundef % ditto + put + //systemdict /.forcedef .forceundef % remove temptation + //systemdict /.forceput .forceundef % ditto + //systemdict /.forceundef .forceundef % ditto +} .bind odef + +% Turn off array packing, since some PostScript code assumes that +% procedures are writable. +false setpacking + +(END INIT) VMDEBUG + +/.currentuserparams where { + pop + % Remove real user params from psuserparams. + mark .currentuserparams counttomark 2 idiv { + pop psuserparams exch undef + } repeat pop + % Update the copy of the user parameters. + mark .currentuserparams counttomark 2 idiv { + userparams 3 1 roll .forceput % userparams is read-only + } repeat pop + % Turn on idiom recognition, if available. + currentuserparams /IdiomRecognition known { + /IdiomRecognition true .definepsuserparam + } if + psuserparams readonly pop + systemdict /.definepsuserparam undef + % Save a copy of userparams for use with save/restore + % (and, if implemented, context switching). + .currentglobal false .setglobal + mark userparams { } forall .dicttomark readonly + /userparams exch .forcedef % systemdict is read-only + .setglobal +} if +/.currentsystemparams where { + pop + % Remove real system params from pssystemparams. + mark .currentsystemparams counttomark 2 idiv { + pop pssystemparams exch .forceundef + } repeat pop +} if + +% Conditionally turn image interpolation on or off. +currentdict /INTERPOLATE known not { (%END INTERPOLATE) .skipeof } if + +/.interpolate { + dup /Interpolate .knownget not { //false } if + /INTERPOLATE .systemvar ne { + dup gcheck .currentglobal exch .setglobal + exch dup length dict copy + dup /Interpolate /INTERPOLATE .systemvar put + exch .setglobal + } if +} bind odef + +/colorimage + { /INTERPOLATE .systemvar + { .currentglobal % w h bit [] {}...{} multi ncomp glob + //false .setglobal + 9 dict begin % w h bit [] {}...{} multi ncomp glob + 2 index { 1 index 7 add } { 8 } ifelse + copy gsave pop % preserve the arguments + { 0 /DeviceGray 0 /DeviceRGB /DeviceCMYK } + 1 index get setcolorspace % ... glob w h bit [] {}...{} multi ncomp + {0 1 0 1 0 1 0 1} + 1 index 2 mul 0 exch % ... glob w h bit [] {}...{} multi ncomp {0 1 ...} 0 2*ncomp + getinterval /Decode exch def % ... glob w h bit [] {}...{} multi ncomp + exch dup % ... glob w h bit [] {}...{} ncomp multi multi + /MultipleDataSources exch def % ... glob w h bit [] {}...{} ncomp multi + { array astore} { pop } ifelse % ... glob w h bit [] [{}...{}] + /DataSource exch def % ... glob w h bit [] + /ImageMatrix exch def % ... glob w h bit + /BitsPerComponent exch def % ... glob w h + /Height exch def % ... glob w + /Width exch def % ... glob + /ImageType 1 def + /Interpolate //true def + .setglobal currentdict end % ... <<>> + image grestore + exch { 4 add } { 6 } ifelse + { pop } repeat % - + } + { colorimage + } + ifelse + } bind odef + +/image + { dup type /dicttype eq + { dup /ImageType get 3 eq + { .currentglobal //false .setglobal exch + dup length dict copy begin .setglobal + /DataDict DataDict .interpolate def + /MaskDict MaskDict .interpolate def + currentdict end + } + { .interpolate + } + ifelse + image + } + { /INTERPOLATE .systemvar + { .currentglobal //false .setglobal + 8 dict begin .setglobal + /ImageType 1 def + /DataSource 1 index def + /ImageMatrix 2 index def + /BitsPerComponent 3 index def + /Decode {0 1} def + /Height 4 index def + /Width 5 index def + /Interpolate //true def + currentdict end + gsave /DeviceGray setcolorspace image grestore + 5 { pop } repeat + } + { image + } + ifelse + } + ifelse + } bind odef + +/imagemask { + dup type /dicttype eq { + .interpolate imagemask + } { + /INTERPOLATE .systemvar { + .currentglobal //false .setglobal + 8 dict begin .setglobal + /ImageType 1 def + /DataSource 1 index def + /ImageMatrix 2 index def + /BitsPerComponent 1 def + 2 index { {1 0} } { {0 1} } ifelse /Decode exch def + /Height 4 index def + /Width 5 index def + /Interpolate //true def + currentdict end imagemask 5 { pop } repeat + } { + imagemask + } ifelse + } ifelse +} bind odef + +currentdict /.interpolate undef + +%END INTERPOLATE + +% Establish local VM as the default. +false /setglobal where { pop setglobal } { .setglobal } ifelse +$error /.nosetlocal false put + +(END GLOBAL) VMDEBUG + +/.savelocalstate where { + % If we might create new contexts, save away copies of all dictionaries + % referenced from systemdict that are stored in local VM, + % and also save a copy of the initial gstate. + pop .savelocalstate +} { + % If we're *not* running in a multi-context system and FAKEFONTS is + % defined, add the fake fonts to LocalFontDirectory. + .definefakefonts % current VM is local +} ifelse + +% Remove systemdict entries for things that have been bound in where used +% and that shouldn't be accessible by name, and close up systemdict. +currentdict /filterdict .undef +currentdict /.cidfonttypes .undef +currentdict /.colorrenderingtypes .undef +currentdict /.formtypes .undef +currentdict /.halftonetypes .undef +currentdict /.imagetypes .undef +currentdict /.imagemasktypes .undef +currentdict /.patterntypes .undef +currentdict /.shadingtypes .undef +currentdict /.wheredict .undef +end + +% Clean up VM, and enable GC. +/vmreclaim where + { pop NOGC not { 2 vmreclaim 0 vmreclaim } if + } if +DELAYBIND not { + systemdict /.forcedef .undef % remove temptation + systemdict /.forceput .undef % ditto + systemdict /.forceundef .undef % ditto +} if +WRITESYSTEMDICT not { systemdict readonly pop } if + +(END GC) VMDEBUG + +% The Adobe AGM_Core used by Illustrator 9 has some code that breaks +% if the 'product' is not (Adobe PostScript Parser). A bug has been +% submitted to Adobe since this also fails with Acrobat Distiller. +% As a temporary work around, the following HACK will work for +% devices without spot color support. Once Ghostscript can +% support DeviceN and spot color separations this will need to +% be 'true' in some cases. +userdict /AGM_preserve_spots false put + +% The interpreter will run the initial procedure (start). |