home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-11-15 | 34.7 KB | 1,166 lines |
- % Copyright (C) 1989, 1995 Aladdin Enterprises. All rights reserved.
- % Licensed to Zenographics Inc. (Irvine, California) by Artifex Software Inc.
- % under the OEM Agreement of December 21st, 1993.
-
- % 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.
-
- % Check the interpreter revision. NOTE: the interpreter code requires
- % that the first non-comment token in this file be an integer.
- 333
- 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
- { % userdict wasn't already set up by iinit.c.
- /userdict
- currentdict dup 200 .setmaxlength % userdict
- systemdict begin def % can't use 'put', userdict is local
- }
- { systemdict begin
- }
- ifelse
-
- % Define true and false.
- /true 0 0 eq def
- /false 0 1 eq def
-
- % Define dummy local/global operators if needed.
- systemdict /.setglobal known
- { true .setglobal
- }
- { /.setglobal { pop } def
- /.currentglobal { false } def
- /.gcheck { pop false } 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
-
- % Acquire the debugging flags.
- currentdict /DEBUG known /DEBUG exch def
- /VMDEBUG
- DEBUG {{print mark
- systemdict /level2dict known
- { .currentglobal 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 count ( ) cvs print (>\n) print flush
- }}
- {{pop
- }}
- ifelse
- def
-
- currentdict /DISKFONTS known /DISKFONTS exch def
- currentdict /ESTACKPRINT known /ESTACKPRINT exch def
- currentdict /FAKEFONTS known /FAKEFONTS exch def
- currentdict /NOBIND known /NOBIND exch def
- /.bind /bind load def
- NOBIND { /bind { } def } if
- currentdict /NOCACHE known /NOCACHE exch def
- currentdict /NOCIE known /NOCIE exch def
- currentdict /NODISPLAY known not /DISPLAYING exch def
- currentdict /NOGC known /NOGC exch def
- currentdict /NOPAUSE known /NOPAUSE exch def
- currentdict /NOPLATFONTS known /NOPLATFONTS exch def
- currentdict /ORIENT1 known /ORIENT1 exch def
- currentdict /OSTACKPRINT known /OSTACKPRINT exch def
- currentdict /OUTPUTFILE known % obsolete
- { /OutputFile /OUTPUTFILE load def
- currentdict /OUTPUTFILE undef
- } if
- currentdict /QUIET known /QUIET exch def
- currentdict /SAFER known /SAFER 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
-
- % Define a procedure for skipping over an unneeded section of code.
- % This avoids allocating space for the skipped procedures.
- /.skipeof % string ->
- { { dup currentfile =string readline pop eq { exit } if } loop pop
- } bind def
-
- % 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 128 string put
-
- % Print the greeting.
-
- /printgreeting
- { mark
- (\n) copyright
- (\)\n) revisiondate 10000 idiv (/)
- revisiondate 100 mod (/)
- revisiondate 100 idiv 100 mod ( \()
- revision 10 mod
- revision 10 idiv 10 mod (.)
- revision 100 idiv ( )
- product
- counttomark
- { (%stdout) (w) file exch .writecvs
- } repeat pop
- } bind def
-
- % QUIET not { printgreeting flush } if
-
- % Define a special version of def for making operator procedures.
- /odef
- {1 index exch .makeoperator def} bind def
-
- %**************** BACKWARD COMPATIBILITY
- /getdeviceprops
- { null .getdeviceparams
- } bind odef
- /.putdeviceprops
- { null true counttomark 1 add 3 roll .putdeviceparams
- dup type /nametype eq
- { counttomark 4 add 1 roll cleartomark pop pop pop
- /.putdeviceprops load exch signalerror
- }
- if
- } bind odef
- /.devicenamedict 1 dict dup /OutputDevice dup put def
- /.devicename
- { //.devicenamedict .getdeviceparams exch pop exch pop
- } bind odef
- /max { .max } bind def
- /min { .min } bind def
-
- % Define predefined procedures substituting for operators,
- % in alphabetical order.
-
- userdict /#copies 1 put
- /[ /mark load def
- /] {counttomark array astore exch pop} odef
- /abs {dup 0 lt {neg} if} odef
- % .beginpage is an operator in Level 2.
- /.beginpage { } odef
- /copypage
- { 1 .endpage
- { #copies false .outputpage
- % (>>copypage, press <return> to continue<<\n) .confirm
- }
- if .beginpage
- } odef
- /setcolorscreen where { pop % not in all Level 1 configurations
- /currentcolorscreen
- { .currenthalftone
- { { 60 exch 0 exch 3 copy 6 copy } % halftone
- { 3 copy 6 copy } % screen
- { } % colorscreen
- }
- exch get exec
- } odef
- } if
- /currentscreen
- { .currenthalftone
- { { 60 exch 0 exch } % halftone
- { } % 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
- { 55665 //filterdict /eexecDecode get exec
- cvx systemdict begin stopped
- % Only pop systemdict if it is still the top element,
- % because this is apparently what Adobe interpreters do.
- currentdict systemdict eq { end } if
- { stop } if
- } odef
- % .endpage is an operator in Level 2.
- /.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
- /executive
- { { prompt
- { (%statementedit) (r) file } stopped
- { pop pop $error /errorname get /undefinedfilename eq
- { exit } if % EOF
- handleerror null % ioerror??
- }
- if
- cvx execute
- } loop
- } odef
- /filter
- { //filterdict 1 index .knownget
- { exch pop exec }
- { /filter load /undefined signalerror }
- ifelse
- } odef
- /handleerror
- { errordict /handleerror get exec } bind def
- /identmatrix [1.0 0.0 0.0 1.0 0.0 0.0] readonly def
- /identmatrix
- { //identmatrix exch copy } odef
- /initgraphics
- { initmatrix newpath initclip
- 1 setlinewidth 0 setlinecap 0 setlinejoin
- [] 0 setdash 0 setgray 10 setmiterlimit
- } odef
- /languagelevel 1 def % gs_lev2.ps may change this
- /matrix { 6 array identmatrix } odef
- /prompt { flush flushpage
- (GS) print
- count 0 ne { (<) print count =only } if
- (>) print flush
- } bind def
- /pstack { 0 1 count 3 sub { index == } for } bind def
- /putdeviceprops
- { .putdeviceprops { erasepage } if } odef
- /quit { /quit load 0 .quit } odef
-
- %kept John's definition of '/run', discarded GS330
- /run { dup type /filetype ne
- { (r) file }
- if
- { dup bytesavailable 0 gt { dup read }{ false } ifelse
- { dup 4 eq { pop }{ 1 index exch unread exit } ifelse }
- { exit }
- ifelse
- }
- loop
- cvx execute
- } odef
-
- /setdevice
- { .setdevice { erasepage } if } odef
- /showpage
- { 0 .endpage
- { #copies 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 { executive } def
- /stop { true .stop } odef
- /stopped { false .stopped } odef
- /store { 1 index where { 3 1 roll put } { def } ifelse } odef
- % When running in Level 1 mode, this interpreter is supposed to be
- % compatible with PostScript "version" 54.0 (I think).
- /version (54.0) def
-
- % 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
- { 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
- /copystring
- { dup length string copy } bind def
- /.dicttomark % (the Level 2 >> operator)
- { counttomark dup 1 and 0 ne
- { pop /.dicttomark cvx /rangecheck signalerror
- }
- { 2 idiv dict dup
- 2 2 2 index maxlength 2 mul
- { { % Stack: mark key1 value1 ... keyN valueN dict dict index
- dup 2 add index exch 1 add index put dup
- } for
- }
- stopped
- { % The error must have occurred in the 'put'.
- pop pop pop pop stop
- }
- { counttomark 1 add 1 roll cleartomark
- }
- ifelse
- }
- ifelse
- } bind def
- /finddevice
- { systemdict /devicedict get exch get
- } bind def
- /.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
- /.packtomark
- { counttomark packedarray exch pop } bind def
- /runlibfile
- { findlibfile
- { exch pop run }
- { /undefinedfilename signalerror }
- ifelse
- } bind def
- /selectdevice
- { finddevice setdevice } bind def
- /signalerror % <object> <errorname> signalerror -
- { errordict 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 } null .stopped null ne
- { pop (--nostringval--) writestring
- }
- if
- } 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
-
- % 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 and
- { % Print a message and wait for the user to type something.
- % If the user just types a newline, flush it.
- print flush
- .echo.mode false echo
- (%stdin) (r) file dup read
- { dup (\n) 0 get eq { pop pop } { unread } ifelse }
- { pop }
- ifelse echo
- }
- { pop
- }
- 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
- { stopped $error /newerror get and
- { handleerror flush
- } if
- } odef
- % Define an execute analogue of runlibfile0.
- /execute0
- { stopped $error /newerror get and
- { handleerror flush /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 } execute } def
- % Define the procedure that the C code uses for running piped input.
- /.runstdin { (%stdin) (r) file cvx execute0 } bind def
- % Define the procedure that the C code uses for running commands
- % given on the command line with -c.
- /.runstring { cvx execute } 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'.
- (Unrecoverable error: ) print dup =only flush
- ( in ) print 1 index = flush
- count 2 gt
- { (Operand stack:\n ) print
- 2 1 count 3 sub { ( ) print index =only flush } for
- (\n) print flush
- } if
- -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'.
- .instopped { null eq { pop pop stop } if } if
- $error /.inerror get .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 } null .stopped null ne { pop null } if
- }
- { null
- }
- 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: ) print
- $error begin
- errorname ==only flush
- ( in ) print
- /command load ==only flush
- currentdict /errorinfo .knownget
- { (\nAdditional information: ) print ==only flush
- } if
-
- % 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 { (\n) print } if
- { 1 index { (\n ) } { ( ) } ifelse print
- dup type /dicttype eq
- {
- (--dict:) print
- dup rcheck
- { dup length =only (/) print maxlength =only }
- { 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
- (\n) print
- pop % printing procedure
-
- errorname /VMerror eq
- { (VM status:) print mark vmstatus
- counttomark { ( ) print counttomark -1 roll dup =only } repeat
- cleartomark (\n) print
- } 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
-
- .clearerror
- end
- flush
- } bind def
- % Define a procedure for clearing the error indication.
- /.clearerror
- { $error /newerror false put
- $error /errorinfo undef
- 0 .setoserrno
- } bind def
-
- % Define $error. This must be in local VM.
- .currentglobal false .setglobal
- /$error 40 dict def % 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.
- /errordict ErrorNames length 1 add dict def
- .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
- { systemdict /.printerror get exec
- } bind def
- end
-
- % Define the [write]==[only] procedures.
- /.dict 26 dict dup
- begin def
- /.cvp {1 index exch .writecvs} bind def
- /.nop {exch pop .p} 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
- { dup type /stringtype eq { .nop } { exec } ifelse }
- { (-) .p1 type .cvp (-) .p }
- ifelse
- } bind def
- /.pstring
- { { dup dup 32 lt exch 127 ge or
- { (\\) .p1 2 copy -6 bitshift 48 add write
- 2 copy -3 bitshift 7 and 48 add write
- 7 and 48 add
- }
- { dup dup -2 and 40 eq exch 92 eq or {(\\) .p1} if
- }
- ifelse 1 index exch write
- }
- forall
- } bind def
- /booleantype /.cvp load def
- /conditiontype (-condition-) def
- /devicetype (-device-) def
- /dicttype (-dict-) def
- /filetype (-file-) def
- /fonttype (-fontID-) def
- /gstatetype (-gstate-) def
- /integertype /.cvp load def
- /locktype (-lock-) def
- /marktype (-mark-) def
- /nulltype (-null-) def
- /realtype /.cvp load def
- /savetype (-save-) def
- /nametype
- {dup xcheck not {(/) .p1} if
- 1 index exch .writecvs} 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}
- {(-array-) .nop}
- ifelse} bind def
- /operatortype
- {(--) .p1 .cvp (--) .p} bind def
- /packedarraytype
- { dup rcheck
- { arraytype }
- { (-packedarray-) .nop }
- ifelse
- } bind def
- /stringtype
- { dup rcheck
- { (\() .p1 dup length 200 le
- { .pstring }
- { 0 200 getinterval .pstring (...) .p }
- ifelse (\)) .p
- }
- { (-string-) .nop
- }
- ifelse
- } bind def
- {//.dict begin .print pop end}
- bind cvx
- 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.
- % Make it big to leave room for transformed fonts.
- /FontDirectory false .setglobal 100 dict true .setglobal def
-
- % Define the encoding dictionary.
- /.encodingdict 10 dict def % enough for Level 2 + PDF standard encodings
-
- % Define findencoding. (This is redefined in Level 2.)
- /.findencoding
- { //.encodingdict exch get exec
- } bind def
- /.defineencoding
- { //.encodingdict 3 1 roll put
- } bind def
-
- % Load StandardEncoding.
- %% Replace 1 (gs_std_e.ps)
- (gs_std_e.ps) dup runlibfile VMDEBUG
-
- % Load ISOLatin1Encoding.
- %% Replace 1 (gs_iso_e.ps)
- (gs_iso_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)
- .encodingdict /SymbolEncoding
- { (gs_sym_e.ps) systemdict begin runlibfile SymbolEncoding end }
- bind put
-
- /DingbatsEncoding { /DingbatsEncoding .findencoding } bind def
- %% Replace 3 (gs_dbt_e.ps)
- .encodingdict /DingbatsEncoding
- { (gs_dbt_e.ps) systemdict begin runlibfile DingbatsEncoding end }
- bind put
-
- (END FONTDIR/ENCS) VMDEBUG
-
- % Construct a dictionary of all available devices.
- mark
- % 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} stopped pop
- dict /devicedict exch def
- devicedict begin % 2nd copy of count is on stack
- { dup .devicename dup 3 -1 roll def
- counttomark 1 roll
- } repeat
- end put
- counttomark packedarray /devicenames exch def pop
- .clearerror
-
- (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
-
- % 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, but remove it from FontDirectory.
- /NullFont currentfont def
- FontDirectory /NullFont undef
- (zsfont.ps)runlibfile
- (END FONTS) VMDEBUG
-
- % Load the initialization files for optional features.
- %% Replace 4 INITFILES
- systemdict /INITFILES known
- { INITFILES { dup runlibfile VMDEBUG } forall
- }
- if
-
- % If Level 2 functionality is implemented, enable it now.
- /.setlanguagelevel where
- { pop 2 .setlanguagelevel
- } if
-
- % If the resource machinery was loaded, convert encodings to resources.
- /defineresource where
- { pop .encodingdict
- { dup length 256 eq
- { /Encoding defineresource pop }
- { pop pop }
- ifelse
- } forall
- } if
-
- (END INITFILES) 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 not { .bindoperators } if
-
- % Establish a default environment.
-
- DISPLAYING not
- { nulldevice (%END DISPLAYING) .skipeof
- } if
- /defaultdevice 0 .getdevice systemdict /DEVICE known
- { pop devicedict DEVICE known not
- { (Unknown device: ) print DEVICE =
- flush /defaultdevice cvx 1 .quit
- }
- if DEVICE finddevice
- }
- if def
- defaultdevice
- 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
- systemdict /PAPERSIZE known
- { % 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 (.\n) print
- }
- 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.
- dup getdeviceprops
- counttomark 2 idiv
- { systemdict 2 index known
- { pop dup load counttomark 2 roll }
- { pop pop }
- ifelse
- } repeat
- systemdict /BufferSpace known
- systemdict /MaxBitmap known not and
- { /MaxBitmap BufferSpace
- } if
- counttomark dup 0 ne
- { 2 add -1 roll putdeviceprops }
- { pop pop }
- ifelse
- setdevice % does an erasepage
- %END DISPLAYING
-
- (END DEVICE) VMDEBUG
-
-
- % Establish a default upper limit in the character cache,
- % namely, enough room for a 1/4" x 1/4" character at the resolution
- % of the default device, or for 5 x the "average" character size,
- % whichever is larger.
- mark
- % Compute limit based on character size.
- 3 72 mul dup dtransform % 3" x 3"
- % 18 dup dtransform % 1/4" x 1/4"
- exch abs cvi 31 add 32 idiv 4 mul % X raster
- exch abs cvi mul % Y
- % Compute limit based on allocated space.
- cachestatus 5 2 roll pop pop pop pop div 5 mul cvi exch pop
- .max dup 10 idiv exch
- setcacheparams
- % Conditionally disable the character cache.
- NOCACHE { 0 setcachelimit } if
-
- (END CONFIG) VMDEBUG
-
- % Establish an appropriate halftone screen.
-
- 72 72 dtransform abs exch abs .min % min(|dpi x|,|dpi y|)
- dup 150 lt systemdict /DITHERPPI known not and
- { % Low-res device, use ordered dither spot function
- % 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 all CMYK devices.
- systemdict /setcolorscreen known processcolors 4 eq and
- { 3 copy 6 copy setcolorscreen }
- { setscreen }
- ifelse
- 0 array cvx % transfer -- Genoa CET won't accept a packed array!
- true % strokeadjust
- }
- { % Hi-res device, use 45 degree dot spot function.
- % 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.
- % 46 was suggested as a good frequency value for printers
- % between 200 and 400 DPI, so we use it for lower resolutions.
- systemdict /DITHERPPI known
- { DITHERPPI }
- { dup cvi 100 idiv 6 .min {null 46 46 60 60 60 85} 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
- % 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 defaultdevice getdeviceprops .dicttomark
- dup dup dup /RedValues known exch /GreenValues known and
- exch /BlueValues known and
- { dup dup /RedValues get 32 lt
- exch /GreenValues get 32 lt and
- exch /BlueValues get 32 lt and
- { 3 copy 6 copy
- % 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.
- %**************** Uncomment the next line for high-quality screening.
- % { 45 90 15 75 } { 3 1 roll exch pop 12 3 roll } forall
- setcolorscreen
- }
- { setscreen
- }
- ifelse
- }
- { pop setscreen
- }
- ifelse
- }
- { setscreen
- }
- ifelse
- }
- { setscreen
- }
- ifelse
- % 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!
- {
- %Null Transfer function
- % 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
- } % transfer
- false % strokeadjust
- % Increase fill adjustment so that we effectively use Adobe's
- % any-part-of-pixel rule.
- 0.5 .setfilladjust
- }
- ifelse
- /setstrokeadjust where { pop setstrokeadjust } { pop } ifelse
- settransfer
- 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.
- % Note that <04> and <1a> are self-delimiting characters, like [.
- <04> cvn { } def % Apple job separator
- %<0404> cvn { } def % two of the same
- <1b> cvn { } def % MS Windows LaserJet 4 prologue
- %<041b> cvn { } def % MS Windows LaserJet 4 epilogue
- <1a> cvn { } def % MS-DOS EOF
- (\001M) cvn { } def % TBCP initiator
- /@PJL % H-P job control
- { currentfile //=string readline { pop } if
- } bind def
-
- % If we want a "safer" system, disable some obvious ways to cause havoc.
- SAFER not { (%END SAFER) .skipeof } if
- /file
- { dup (r) eq 2 index (%pipe*) .stringmatch not and
- { file }
- { /invalidfileaccess signalerror }
- ifelse
- } bind odef
- /renamefile { /invalidfileaccess signalerror } odef
- /deletefile { /invalidfileaccess signalerror } odef
- /putdeviceprops
- { counttomark
- dup 2 mod 0 eq { pop /rangecheck signalerror } if
- 3 2 3 2 roll
- { dup index /OutputFile eq
- { -2 roll
- dup () ne { /putdeviceprops load /invalidfileaccess signalerror } if
- 3 -1 roll
- }
- { pop
- }
- ifelse
- } for
- putdeviceprops
- } bind odef
-
- %END SAFER
-
-
- % Turn off array packing, since some PostScript code assumes that
- % procedures are writable.
- false setpacking
-
- (zserver.ps)runlibfile
-
- % Close up systemdict.
- currentdict /.forceput undef % remove temptation
- currentdict /filterdict undef % bound in where needed
- end
- WRITESYSTEMDICT not { systemdict readonly pop } if
-
-
- (END INIT) VMDEBUG
-
- % Establish local VM as the default.
- false /setglobal where { pop setglobal } { .setglobal } ifelse
- $error /.nosetlocal false put
-
- % Clean up VM, and enable GC.
- %/vmreclaim where
- % { pop NOGC not { 2 vmreclaim 0 vmreclaim } if
- % } if
-
- (END GC) VMDEBUG
-
- % The interpreter will run the initial procedure (start).
-