home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / GhostScript / !GhostScr / 6_01 / lib / gs_init.ps < prev    next >
Text File  |  2000-03-29  |  54KB  |  1,697 lines
  1. %    Copyright (C) 1989, 2000 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of Aladdin Ghostscript.
  4. % 
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. % 
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % $Id: gs_init.ps,v 1.3 2000/03/10 18:47:31 lpd Exp $
  19. % Initialization file for the interpreter.
  20. % When this is run, systemdict is still writable.
  21.  
  22. % Comment lines of the form
  23. %    %% Replace <n> <file(s)>
  24. % indicate places where the next <n> lines should be replaced by
  25. % the contents of <file(s)>, when creating a single merged init file.
  26.  
  27. % The interpreter can call out to PostScript code.  All procedures
  28. % called in this way, and no other procedures defined in these
  29. % initialization files, have names that begin with %, e.g.,
  30. % (%Type1BuildChar) cvn.
  31.  
  32. % Check the interpreter revision.  NOTE: the interpreter code requires
  33. % that the first non-comment token in this file be an integer.
  34. 601
  35. dup revision ne
  36.  { (gs: Interpreter revision \() print revision 10 string cvs print
  37.    (\) does not match gs_init.ps revision \() print 10 string cvs print
  38.    (\).\n) print flush null 1 .quit
  39.  }
  40. if pop
  41.  
  42. % Acquire userdict, and set its length if necessary.
  43. /userdict where
  44.  { pop userdict maxlength 0 eq }
  45.  { true }
  46. ifelse
  47. systemdict exch
  48.  {        % userdict wasn't already set up by iinit.c.
  49.    dup /userdict
  50.    currentdict dup 200 .setmaxlength        % userdict
  51.    .forceput            % userdict is local, systemdict is global
  52.  }
  53. if begin
  54.  
  55. % Define dummy local/global operators if needed.
  56. systemdict /.setglobal known
  57.  { true .setglobal
  58.  }
  59.  { /.setglobal { pop } bind def
  60.    /.currentglobal { false } bind def
  61.    /.gcheck { pop false } bind def
  62.  }
  63. ifelse
  64.  
  65. % Define .languagelevel if needed.
  66. systemdict /.languagelevel known not { /.languagelevel 1 def } if
  67.  
  68. % Optionally choose a default paper size other than U.S. letter.
  69. % (a4) /PAPERSIZE where { pop pop } { /PAPERSIZE exch def } ifelse
  70.  
  71. % Turn on array packing for the rest of initialization.
  72. true setpacking
  73.  
  74. % Define the old MS-DOS EOF character as a no-op.
  75. % This is a hack to get around the absurd habit of MS-DOS editors
  76. % of adding an EOF character at the end of the file.
  77. <1a> cvn { } def
  78.  
  79. % Acquire the debugging flags.
  80. currentdict /DEBUG known   /DEBUG exch def
  81.   /VMDEBUG
  82.     DEBUG {{print mark
  83.             systemdict /level2dict known
  84.          { .currentglobal dup false .setglobal vmstatus
  85.            true .setglobal vmstatus 3 -1 roll pop
  86.            6 -2 roll pop .setglobal
  87.          }
  88.          { vmstatus 3 -1 roll pop
  89.          }
  90.         ifelse usertime 16#fffff and counttomark
  91.           { ( ) print (           ) cvs print }
  92.         repeat pop
  93.         ( ) print systemdict length (    ) cvs print
  94.         ( ) print countdictstack (  ) cvs print
  95.         ( <) print count (    ) cvs print (>\n) print flush
  96.       }}
  97.       {{pop
  98.       }}
  99.      ifelse
  100.   def
  101.  
  102. currentdict /BATCH known   /BATCH exch def
  103. currentdict /DELAYBIND known   /DELAYBIND exch def
  104. currentdict /DISKFONTS known   /DISKFONTS exch def
  105. currentdict /DOINTERPOLATE .knownget { /INTERPOLATE exch def } if
  106. currentdict /ESTACKPRINT known   /ESTACKPRINT exch def
  107. currentdict /FAKEFONTS known   /FAKEFONTS exch def
  108. currentdict /FIXEDMEDIA known   /FIXEDMEDIA exch def
  109. currentdict /FIXEDRESOLUTION known   /FIXEDRESOLUTION exch def
  110. currentdict /LOCALFONTS known   /LOCALFONTS exch def
  111. currentdict /NOBIND known   /NOBIND exch def
  112. /.bind /bind load def
  113. NOBIND { /bind { } def } if
  114. currentdict /NOCACHE known   /NOCACHE exch def
  115. currentdict /NOCIE known   /NOCIE exch def
  116. currentdict /NODISPLAY known   not /DISPLAYING exch def
  117. currentdict /NOFONTMAP known   /NOFONTMAP exch def
  118. currentdict /NOFONTPATH known   /NOFONTPATH exch def
  119. currentdict /NOGC known   /NOGC exch def
  120. currentdict /NOINTERPOLATE .knownget { /INTERPOLATE exch not def } if
  121. currentdict /NOPAGEPROMPT known   /NOPAGEPROMPT exch def
  122. currentdict /NOPAUSE known   /NOPAUSE exch def
  123. currentdict /NOPLATFONTS known   /NOPLATFONTS exch def
  124. currentdict /NOPROMPT known   /NOPROMPT exch def
  125. % The default value of ORIENT1 is true, not false.
  126. currentdict /ORIENT1 known not { /ORIENT1 true def } if
  127. currentdict /OSTACKPRINT known   /OSTACKPRINT exch def
  128. currentdict /OUTPUTFILE known    % obsolete
  129.  { /OutputFile /OUTPUTFILE load def
  130.    currentdict /OUTPUTFILE .undef
  131.  } if
  132. currentdict /QUIET known   /QUIET exch def
  133. currentdict /SAFER known   /SAFER exch def
  134. currentdict /SHORTERRORS known   /SHORTERRORS exch def
  135. currentdict /STRICT known   /STRICT exch def
  136. currentdict /TTYPAUSE known   /TTYPAUSE exch def
  137. currentdict /WRITESYSTEMDICT known   /WRITESYSTEMDICT exch def
  138.  
  139. % Acquire environment variables.
  140. currentdict /DEVICE known not
  141.  { (GS_DEVICE) getenv { /DEVICE exch def } if } if
  142.  
  143. (START) VMDEBUG
  144.  
  145. % Open the standard files, so they will be open at the outermost save level.
  146. (%stdin) (r) file pop
  147. (%stdout) (w) file pop
  148. (%stderr) (w) file pop
  149.  
  150. /.currentuserparams where {
  151.   pop mark
  152.     % The Adobe implementations appear to have very large maximum
  153.     % stack sizes.  This turns out to actually make a difference,
  154.     % since some badly-behaved files include extremely long procedures,
  155.     % or construct huge arrays on the operand stack.
  156.     % We reset the stack sizes now so that we don't have to worry
  157.     % about overflowing the (rather small) built-in stack sizes
  158.     % during initialization.
  159.   /MaxDictStack 500
  160.   /MaxExecStack 5000
  161.   /MaxOpStack 50000
  162.   .dicttomark .setuserparams
  163. } if
  164.  
  165. % Define a procedure for skipping over an unneeded section of code.
  166. % This avoids allocating space for the skipped procedures.
  167. % We can't use readline, because that imposes a line length limit.
  168. /.skipeof    % <string> .skipeof -
  169.  { currentfile exch 1 exch .subfiledecode flushfile
  170.  } .bind def
  171.  
  172. % Define procedures to assist users who don't read the documentation.
  173. userdict begin
  174. /help
  175.  { (Enter PostScript commands.  '(filename) run' runs a file, 'quit' exits.\n)
  176.    print flush
  177.  } .bind def
  178. /? /help load def
  179. end
  180.  
  181. % Define =string, which is used by some PostScript programs even though
  182. % it isn't documented anywhere.
  183. % Put it in userdict so that each context can have its own copy.
  184. userdict /=string 256 string put
  185.  
  186. % Print the greeting.
  187.  
  188. /printgreeting
  189.  { mark
  190.    product (Ghostscript) search
  191.     { pop pop pop
  192.       (This software comes with NO WARRANTY: see the file PUBLIC for details.\n)
  193.     }
  194.     { pop
  195.     }
  196.    ifelse
  197.    (\n) copyright
  198.    (\)\n) revisiondate 10 mod revisiondate 10 idiv 10 mod (-)
  199.    revisiondate 100 idiv 10 mod revisiondate 1000 idiv 10 mod (-)
  200.    revisiondate 10000 idiv ( \()
  201.    revision 10 mod
  202.    revision 100 mod dup 0 ne { 10 idiv } { pop } ifelse (.)
  203.    revision 100 idiv ( )
  204.    product
  205.    counttomark
  206.     { (%stdout) (w) file exch 0 .writecvp
  207.     } repeat pop
  208.  } .bind def
  209.  
  210. QUIET not { printgreeting flush } if
  211.  
  212. % Define a special version of def for making operator procedures.
  213. /obind {    % <name> <proc> obind <name> <oper>
  214.   1 index exch .makeoperator
  215. } .bind def
  216. /odef {        % <name> <proc> odef -
  217.   1 index exch .makeoperator def
  218. } .bind def
  219.  
  220. % Define a special version of def for storing local objects into global
  221. % dictionaries.  Like .forceput, this exists only during initialization.
  222. /.forcedef {        % <key> <value> .forcedef -
  223.   currentdict 3 1 roll .forceput
  224. } .bind odef
  225.  
  226. % Define procedures for accessing variables in systemdict and userdict
  227. % regardless of the contents of the dictionary stack.
  228. /.systemvar {        % <name> .systemvar <value>
  229.   //systemdict exch get
  230. } .bind odef
  231. /.userdict {        % - .userdict <dict>
  232.   /userdict .systemvar
  233. } .bind odef
  234. /.uservar {        % <name> .uservar <value>
  235.   .userdict exch get
  236. } .bind odef
  237.  
  238. % If we're delaying binding, remember everything that needs to be bound later.
  239. DELAYBIND NOBIND not and
  240.  { .currentglobal false .setglobal
  241.    systemdict /.delaybind 1500 array .forceput
  242.    .setglobal
  243.    userdict /.delaycount 0 put
  244.     % When we've done the delayed bind, we want to stop saving.
  245.     % Detect this by the disappearance of .delaybind.
  246.    /bind
  247.     { /.delaybind .systemvar dup length 0 ne
  248.        { .delaycount 2 index put
  249.          .userdict /.delaycount .delaycount 1 add put
  250.        }
  251.        { pop .bind
  252.        }
  253.       ifelse
  254.     } .bind def
  255.  } if
  256.  
  257. %**************** BACKWARD COMPATIBILITY
  258. /hwsizedict mark /HWSize null .dicttomark readonly def
  259. /copyscanlines {        % <device> <y> <string> copyscanlines <substr>
  260.   0 3 1 roll 3 index //hwsizedict .getdeviceparams
  261.   exch pop exch pop aload pop 3 2 roll
  262.   0 exch null exch .getbitsrect exch pop
  263. } bind odef
  264. currentdict /hwsizedict .undef
  265. /getdeviceprops
  266.  { null .getdeviceparams
  267.  } bind odef
  268. /.putdeviceprops
  269.  { null true counttomark 1 add 3 roll .putdeviceparams
  270.    dup type /booleantype ne
  271.     { dup mark eq { /unknown /rangecheck } if
  272.       counttomark 4 add 1 roll cleartomark pop pop pop
  273.       /.putdeviceprops load exch signalerror
  274.     }
  275.    if
  276.  } bind odef
  277. /max { .max } bind def
  278. /min { .min } bind def
  279. /.currentfilladjust { .currentfilladjust2 pop } bind odef
  280. /.setfilladjust { dup .setfilladjust2 } bind odef
  281. /.writecvs { 0 .writecvp } bind odef
  282.  
  283. % Define predefined procedures substituting for operators,
  284. % in alphabetical order.
  285.  
  286. userdict /#copies 1 put
  287. % Adobe implementations don't accept /[ or /], so we don't either.
  288. ([) cvn
  289.     /mark load def
  290. (]) cvn
  291.     {counttomark array astore exch pop} odef
  292. % .beginpage is redefined if setpagedevice is present.
  293. /.beginpage { } odef
  294. % In LanguageLevel 3, copypage erases the page.
  295. /copypage {
  296.     .languagelevel 3 ge
  297.     dup { 0 } { 1 } ifelse .endpage {
  298.       .currentnumcopies 1 index .outputpage
  299.       (>>copypage, press <return> to continue<<\n) .confirm
  300.       dup { erasepage } if
  301.     } if pop .beginpage
  302. } odef
  303. /currentmatrix {
  304.     .currentmatrix 6 index astore pop
  305. } odef
  306. % .currentnumcopies is redefined in Level 2.
  307. /.currentnumcopies { #copies } odef
  308. /setcolorscreen where { pop        % not in all Level 1 configurations
  309.    /currentcolorscreen
  310.     { .currenthalftone
  311.        { { 60 exch 0 exch 3 copy 6 copy }    % halftone - not possible
  312.          { 3 copy 6 copy }            % screen
  313.          { }                % colorscreen
  314.        }
  315.       exch get exec
  316.     } odef
  317. } if
  318. /currentscreen
  319.     { .currenthalftone
  320.        { { 60 exch 0 exch }            % halftone - not possible
  321.          { }                % screen
  322.          { 12 3 roll 9 { pop } repeat }    % colorscreen
  323.        }
  324.       exch get exec
  325.     } odef
  326. /.echo /echo load def
  327. userdict /.echo.mode true put
  328. /echo    {dup /.echo.mode exch store .echo} odef
  329. /eexec {
  330.     % Rebind .currentresourcefile if it is the source for the eexec.
  331.   dup 55665 //filterdict /eexecDecode get exec
  332.   cvx exch .currentresourcefile eq
  333.   //systemdict begin { {exec} .execasresource } { exec } ifelse
  334.     % Only pop systemdict if it is still the top element,
  335.     % because this is apparently what Adobe interpreters do.
  336.   currentdict //systemdict eq { end } if
  337. } odef
  338. % .endpage is redefined if setpagedevice is present.
  339. /.endpage { 2 ne } odef
  340. % erasepage mustn't use gsave/grestore, because we call it before
  341. % the graphics state stack has been fully initialized.
  342. /erasepage
  343.     { /currentcolor where
  344.        { pop currentcolor currentcolorspace { setcolorspace setcolor } }
  345.        { /currentcmykcolor where
  346.           { pop currentcmykcolor { setcmykcolor } }
  347.           { currentrgbcolor { setrgbcolor } }
  348.          ifelse
  349.        }
  350.       ifelse 1 setgray .fillpage exec
  351.     } odef
  352. % To satisfy the Genoa FTS, executive must be a procedure, not an operator.
  353. /executive
  354.     { { NOPROMPT not { prompt } if
  355.          { (%statementedit) (r) file } stopped
  356.          { pop pop $error /errorname get /undefinedfilename eq
  357.         { .clearerror exit } if        % EOF
  358.            handleerror null        % ioerror??
  359.          }
  360.         if
  361.         cvx { .runexec } execute
  362.       } loop
  363.     } bind def
  364. /filter
  365.     { //filterdict 1 index .knownget
  366.        { exch pop exec }
  367.        { /filter load /undefined signalerror }
  368.       ifelse
  369.     } odef
  370. /handleerror
  371.     { /errordict .systemvar /handleerror get exec } bind def
  372. /identmatrix [1.0 0.0 0.0 1.0 0.0 0.0] readonly def
  373. /identmatrix
  374.     { dup 0 //identmatrix putinterval } odef
  375. /languagelevel 1 def        % gs_lev2.ps may change this
  376. /makeimagedevice { false makewordimagedevice } odef
  377. /matrix    { 6 array identmatrix } odef
  378. /pathbbox
  379.     { false .pathbbox
  380.     } odef
  381. % .promptmsg is redefined if the interpreter includes readline support.
  382. /.promptmsg {
  383.     (GS) print
  384.     count 0 ne { (<) print count =only } if
  385.     (>) print flush
  386. } bind def
  387. /prompt    { flush flushpage .promptmsg } bind def
  388. /pstack    { 0 1 count 3 sub { index == } for } bind def
  389. /putdeviceprops
  390.     { .putdeviceprops { erasepage } if } odef
  391. /quit    { /quit load 0 .quit } odef
  392. /run    { dup type /filetype ne { (r) file } if
  393.         % We must close the file when execution terminates,
  394.         % regardless of the state of the stack,
  395.         % and then propagate an error, if any.
  396.       cvx .runexec
  397.     } odef
  398. % Execute a file.
  399. % Level 2 uses 2 .stop to clear the e-stack for a successful startjob:
  400. % we detect that here, since we need to handle this even if we start out
  401. % without job control in effect.
  402. %
  403. % What we push on the e-stack is the following to be executed in this order:
  404. %    <lit-file|fileproc> .runexec1 <lit-file|fileproc> .runexec2
  405. /.runexec1 {        % <file|fileproc> .runexec1 -
  406.   dup type /filetype ne { cvx exec } if
  407.   cvx null 2 .stopped
  408.     % If we got back here from a startjob, just keep going.
  409.     % startjob replaces the null on the o-stack with a procedure
  410.     % to be executed when we get back here.
  411.   dup null ne { exec true } { pop false } ifelse
  412. } bind def
  413. /.runexec2 {        % <continue> <file|fileproc> .runexec2 -
  414.   exch {
  415.     .runexec
  416.   } {
  417.     dup type /filetype ne { cvx exec } if
  418.     closefile
  419.   } ifelse
  420. } bind def
  421. /.runexec {        % <file|fileproc> .runexec -
  422.   cvlit /.runexec1 cvx 1 index /.runexec2 cvx 4 .execn
  423. } bind def
  424. % The following is only for compatibility with Adobe interpreters.
  425. /setdash {
  426.     1 index length 11 gt { /setdash load /limitcheck signalerror } if
  427.     //setdash
  428. } odef
  429. /setdevice
  430.     { .setdevice { erasepage } if } odef
  431. /setlinecap {
  432.     dup 2 gt { /setlinecap load /rangecheck signalerror } if
  433.     .setlinecap
  434. } odef
  435. /setlinejoin {
  436.     dup 2 gt { /setlinejoin load /rangecheck signalerror } if
  437.     .setlinejoin
  438. } odef
  439. /setmatrix {
  440.     dup aload pop .setmatrix pop
  441. } odef
  442. /showpage {
  443.     0 .endpage .doneshowpage {
  444.       .currentnumcopies true .outputpage
  445.       (>>showpage, press <return> to continue<<\n) .confirm
  446.       erasepage
  447.     } if initgraphics .beginpage
  448. } odef
  449. % Code output by Adobe Illustrator relies on the fact that
  450. % `stack' is a procedure, not an operator!!!
  451. /stack    { 0 1 count 3 sub { index = } for } bind def
  452. /start    { BATCH { null 0 .quit } { executive } ifelse } def
  453. % Internal uses of stopped that aren't going to do a stop if an error occurs
  454. % should use .internalstopped to avoid setting newerror et al.
  455. /.internalstopped { null 1 .stopped null ne } bind def
  456. /store {    % Don't alter operands before completing.
  457.     1 index where { 2 index 2 index put pop pop } { def } ifelse
  458. } odef
  459. /.typenames mark .typenames counttomark packedarray exch pop def
  460. /type {
  461.     //.typenames .type
  462. } odef
  463. currentdict /.typenames .undef
  464. % When running in Level 1 mode, this interpreter is supposed to be
  465. % compatible with PostScript "version" 54.0 (I think).
  466. /version (54.0) readonly def
  467. /.wheredict 10 dict def
  468. /.where /where load def
  469. /where {
  470.     //.wheredict 1 index .knownget { exec } { .where } ifelse
  471. } odef
  472.  
  473. % internaldict is defined in systemdict, but is allocated in local VM.
  474. % We make a procedure for creating it, since we must create a new one
  475. % for each context with private local VM.
  476. /.makeinternaldict {
  477.   .currentglobal false .setglobal
  478.     [ /dup .systemvar 1183615869 /eq .systemvar
  479.     [ /pop .systemvar 10 dict ] cvx
  480.     [ /internaldict /cvx .systemvar /invalidaccess /signalerror cvx ] cvx
  481.       /ifelse .systemvar
  482.     ] cvx executeonly
  483.   exch .setglobal
  484. } odef
  485. systemdict /internaldict dup .makeinternaldict .makeoperator
  486. .forceput        % proc is local, systemdict is global
  487. % Move superexec to internaldict if superexec is defined.
  488. currentdict /superexec .knownget {
  489.   1183615869 internaldict /superexec 3 -1 roll put
  490.   currentdict /superexec .undef
  491. } if
  492.  
  493. % Define some additional built-in procedures (beyond the ones defined by
  494. % the PostScript Language Reference Manual).
  495. % Warning: these are not guaranteed to stay the same from one release
  496. % to the next!
  497. /concatstrings
  498.     { exch dup length 2 index length add string    % str2 str1 new
  499.       dup dup 4 2 roll copy        % str2 new new new1
  500.       length 4 -1 roll putinterval
  501.     } bind def
  502. /copyarray
  503.     { dup length array copy } bind def
  504. % Copy a dictionary per the Level 2 spec even in Level 1.
  505. /.copydict        % <fromdict> <todict> .copydict <todict>
  506.     { dup 3 -1 roll { put dup } forall pop } bind def
  507. /copystring
  508.     { dup length string copy } bind def
  509. /finddevice
  510.     { /devicedict .systemvar exch get
  511.       dup 1 get null eq
  512.        {        % This is the first request for this type of device.
  513.             % Create a default instance now.
  514.             % Stack: [proto null]
  515.          .currentglobal true .setglobal exch
  516.          dup dup 0 get copydevice 1 exch put
  517.          exch .setglobal
  518.        }
  519.       if 1 get
  520.     } bind def
  521. /.growdictlength    % get size for growing a dictionary
  522.     { length 3 mul 2 idiv 1 add
  523.     } bind def
  524. /.growdict        % grow a dictionary
  525.     { dup .growdictlength .setmaxlength
  526.     } bind def
  527. /.growput        % put, grow the dictionary if needed
  528.     { 2 index length 3 index maxlength eq
  529.        { 3 copy pop known not { 2 index .growdict } if
  530.        } if
  531.       put
  532.     } bind def
  533. /.packtomark
  534.     { counttomark packedarray exch pop } bind def
  535. /ppstack
  536.     { 0 1 count 3 sub { index === } for } bind def
  537. /runlibfile
  538.     {        % We don't want to bind 'run' into this procedure,
  539.             % since run may get redefined.
  540.       findlibfile
  541.        { exch pop /run .systemvar exec }
  542.        { /undefinedfilename signalerror }
  543.       ifelse
  544.     } bind def
  545. /selectdevice
  546.     { finddevice setdevice .setdefaultscreen } bind def
  547. /signalerror        % <object> <errorname> signalerror -
  548.     { /errordict .systemvar exch get exec } bind def
  549.  
  550. % Define the =[only] procedures.  Also define =print,
  551. % which is used by some PostScript programs even though
  552. % it isn't documented anywhere.
  553. /write=only {
  554.     .writecvs
  555. } bind def
  556. /write= {
  557.     1 index exch write=only (\n) writestring
  558. } bind def
  559. /=only    { (%stdout) (w) file exch write=only } bind def
  560. /=    { =only (\n) print } bind def
  561. /=print    /=only load def
  562. % Temporarily define == as = for the sake of runlibfile0.
  563. /== /= load def
  564.  
  565. % Run a resource file.  This allows us to distinguish resource objects
  566. % from objects coming from input files.
  567. userdict /.currentresourcefile null put
  568. /.execasresource {    % <file> <proc|runfile> .execasresource -
  569.   /stopped .systemvar
  570.   /.currentresourcefile .uservar
  571.         % Stack: file proc -stopped- currfile
  572.   .userdict /.currentresourcefile 5 index cvlit put
  573.   2 .execn        % stopped <file>
  574.   .userdict /.currentresourcefile 3 -1 roll put
  575.   { stop } if
  576. } bind def
  577. /.runresource {        % <file> .runresource -
  578.   { /run .systemvar exec } .execasresource
  579. } bind def
  580.  
  581. % Define procedures for getting and setting the current device resolution.
  582.  
  583. /gsgetdeviceprop    % <device> <propname> gsgetdeviceprop <value>
  584.  { 2 copy mark exch null .dicttomark .getdeviceparams
  585.    dup mark eq        % if true, not found
  586.     { pop dup /undefined signalerror }
  587.     { 5 1 roll pop pop pop pop }
  588.    ifelse
  589.  } bind def
  590. /gscurrentresolution    % - gscurrentresolution <[xres yres]>
  591.  { currentdevice /HWResolution gsgetdeviceprop
  592.  } bind def
  593. /gssetresolution    % <[xres yres]> gssetresolution -
  594.  { 2 array astore mark exch /HWResolution exch
  595.    currentdevice copydevice putdeviceprops setdevice
  596.  } bind def
  597.  
  598. % Define auxiliary procedures needed for the above.
  599. /shellarguments        % -> shell_arguments true (or) false
  600.     { /ARGUMENTS where
  601.        { /ARGUMENTS get dup type /arraytype eq
  602.           { aload pop /ARGUMENTS null store true }
  603.           { pop false }
  604.          ifelse }
  605.        { false } ifelse
  606.     } bind def
  607. /.confirm {
  608.   DISPLAYING NOPAUSE not TTYPAUSE or and {
  609.     % Print a message (unless NOPAGEPROMPT or NOPROMPT is true)
  610.     % and wait for the user to type something.
  611.     % If the user just types a newline, flush it.
  612.     NOPAGEPROMPT NOPROMPT or { pop } { print flush } ifelse
  613.     .confirmread
  614.   } {
  615.     pop
  616.   } ifelse
  617. } bind def
  618. /.confirmread {
  619.   TTYPAUSE {
  620.     (/dev/tty) (r) file dup read pop pop closefile
  621.   } {
  622.     .echo.mode false echo
  623.     (%stdin) (r) file dup read {
  624.       dup (\n) 0 get eq { pop pop } { unread } ifelse
  625.     } {
  626.       pop
  627.     } ifelse echo
  628.   } ifelse
  629. } bind def
  630.  
  631. % Define the procedure used by .runfile, .runstdin and .runstring
  632. % for executing user input.
  633. % This is called with a procedure or executable file on the operand stack.
  634. /.execute {        % <obj> .execute <stopped>
  635.   stopped $error /newerror get and
  636.    { handleerror flush true } { false } ifelse
  637. } bind def
  638. /execute {        % <obj> execute -
  639.   .execute pop
  640. } odef
  641. % Define an execute analogue of runlibfile0.
  642. /execute0 {        % <obj> execute0 -
  643.   .execute { /execute0 cvx 1 .quit } if
  644. } bind def
  645. % Define the procedure that the C code uses for running files
  646. % named on the command line.
  647. /.runfile {
  648.   { runlibfile } execute0
  649. } def
  650. % Define the procedure that the C code uses for running piped input.
  651. % We don't use the obvious { (%stdin) run }, because we want the file to be
  652. % reopened if a startjob does a restore.
  653. /.runstdin {
  654.   { { (%stdin) (r) file cvx } .runexec } execute0
  655. } bind def
  656. % Define the procedure that the C code uses for running commands
  657. % given on the command line with -c.  We turn the string into a file so that
  658. % .runexec can do the right thing with a startjob.
  659. /.runstring {
  660.   .currentglobal exch true .setglobal
  661.   0 () .subfiledecode
  662.   exch .setglobal cvx { .runexec } execute0
  663. } bind def
  664. % Define the procedure that the C code uses to set up for executing
  665. % a string that may be received in pieces.
  666. /.runstringbegin {
  667.   .currentglobal true .setglobal
  668.   { .needinput } bind 0 () .subfiledecode
  669.   exch .setglobal cvx .runexec
  670. } bind def
  671.  
  672. % Define a special version of runlibfile that aborts on errors.
  673. /runlibfile0
  674.     { cvlit dup /.currentfilename exch def
  675.        { findlibfile not { stop } if }
  676.       stopped
  677.        { (Can't find \(or open\) initialization file ) print
  678.          .currentfilename == flush /runlibfile0 cvx 1 .quit
  679.        } if
  680.       exch pop cvx stopped
  681.        { (While reading ) print .currentfilename print (:\n) print flush
  682.          handleerror /runlibfile0 1 .quit
  683.        } if
  684.     } bind def
  685. % Temporarily substitute it for the real runlibfile.
  686. /.runlibfile /runlibfile load def
  687. /runlibfile /runlibfile0 load def
  688.  
  689. % Create the error handling machinery.
  690. % Define the standard error handlers.
  691. % The interpreter has created the ErrorNames array.
  692. /.unstoppederrorhandler    % <command> <errorname> .unstoppederrorhandler -
  693.  {    % This is the handler that gets used for recursive errors,
  694.     % or errors outside the scope of a 'stopped'.
  695.    2 copy SHORTERRORS
  696.     { (%%[ Error: ) print =only flush
  697.       (; OffendingCommand: ) print =only ( ]%%) =
  698.     }
  699.     { (Unrecoverable error: ) print =only flush
  700.       ( in ) print = flush
  701.       count 2 gt
  702.        { (Operand stack:\n  ) print
  703.      2 1 count 3 sub { (  ) print index =only flush } for
  704.      () = flush
  705.        } if
  706.     }
  707.    ifelse
  708.    -1 0 1 //ErrorNames length 1 sub
  709.     { dup //ErrorNames exch get 3 index eq
  710.        { not exch pop exit } { pop } ifelse
  711.     }
  712.    for exch pop .quit
  713.  } bind def
  714. /.errorhandler        % <command> <errorname> .errorhandler -
  715.   {        % Detect an internal 'stopped'.
  716.     1 .instopped { null eq { pop pop stop } if } if
  717.     $error /.inerror get 1 .instopped { pop } { pop true } ifelse
  718.      { .unstoppederrorhandler
  719.      } if    % detect error recursion
  720.     $error /globalmode .currentglobal false .setglobal put
  721.     $error /.inerror true put
  722.     $error /newerror true put
  723.     $error exch /errorname exch put
  724.     $error exch /command exch put
  725.     $error /recordstacks get $error /errorname get /VMerror ne and
  726.      {        % Attempt to store the stack contents atomically.
  727.        count array astore dup $error /ostack 4 -1 roll
  728.        countexecstack array execstack $error /estack 3 -1 roll
  729.        countdictstack array dictstack $error /dstack 3 -1 roll
  730.        put put put aload pop
  731.      }
  732.      { $error /dstack .undef
  733.        $error /estack .undef
  734.        $error /ostack .undef
  735.      }
  736.     ifelse
  737.     $error /position currentfile status
  738.      { currentfile { fileposition } .internalstopped { pop null } if
  739.      }
  740.      {        % If this was a scanner error, the file is no longer current,
  741.         % but the command holds the file, which may still be open.
  742.        $error /command get dup type /filetype eq
  743.         { { fileposition } .internalstopped { pop null } if }
  744.         { pop null }
  745.        ifelse
  746.      }
  747.     ifelse put
  748.         % During initialization, we don't reset the allocation
  749.         % mode on errors.
  750.     $error /globalmode get $error /.nosetlocal get and .setglobal
  751.     $error /.inerror false put
  752.     stop
  753.   } bind def
  754. % Define the standard handleerror.  We break out the printing procedure
  755. % (.printerror) so that it can be extended for binary output
  756. % if the Level 2 facilities are present.
  757.   /.printerror
  758.    { $error begin
  759.        /command load errorname SHORTERRORS
  760.     { (%%[ Error: ) print =only flush
  761.       (; OffendingCommand: ) print =only
  762.       errorinfo dup null eq {
  763.         pop
  764.       } {
  765.         (;\nErrorInfo:) print
  766.         dup type /arraytype eq
  767.           { { ( ) print =only } forall }
  768.           { ( ) print =only }
  769.         ifelse
  770.       } ifelse
  771.           ( ]%%) = flush
  772.     }
  773.     { (Error: ) print ==only flush
  774.       ( in ) print ==only flush
  775.       errorinfo dup null eq {
  776.         pop
  777.       } {
  778.         (\nAdditional information: ) print ==only flush
  779.       } ifelse
  780.       .printerror_long
  781.     }
  782.        ifelse
  783.        .clearerror
  784.      end
  785.      flush
  786.     } bind def     
  787.   /.printerror_long            % long error printout,
  788.                     % $error is on the dict stack
  789.    {    % Push the (anonymous) stack printing procedure.
  790.     %  <heading> <==flag> <override-name> <stackname> proc
  791.        {
  792.      currentdict exch .knownget    % stackname defined in $error?
  793.      {
  794.        4 1 roll            % stack: <stack> <head> <==flag> <over>
  795.        errordict exch .knownget    % overridename defined?
  796.        { 
  797.          exch pop exch pop exec    % call override with <stack>
  798.        }
  799.        { 
  800.          exch print exch        % print heading. stack <==flag> <stack>
  801.          1 index not { () = } if
  802.          { 1 index { (\n    ) } { (   ) } ifelse print
  803.            dup type /dicttype eq
  804.            {
  805.          (--dict:) print
  806.          dup rcheck {
  807.            dup length =only (/) print dup maxlength =only
  808.            dup wcheck not { ((ro)) print } if
  809.          } if
  810.          /gcheck where {
  811.            pop gcheck { ((G)) } { ((L)) } ifelse print
  812.          } {
  813.            pop
  814.          } ifelse (--) print
  815.            }
  816.            {
  817.          dup type /stringtype eq 2 index or
  818.          { ==only } { =only } ifelse
  819.            } ifelse
  820.          } forall
  821.          pop
  822.        }
  823.        ifelse            % overridden
  824.      }
  825.      { pop pop pop
  826.      }
  827.      ifelse                % stack known
  828.        }
  829.  
  830.        (\nOperand stack:) OSTACKPRINT /.printostack /ostack 4 index exec
  831.        (\nExecution stack:) ESTACKPRINT /.printestack /estack 4 index exec
  832.        (\nBacktrace:) true /.printbacktrace /backtrace 4 index exec
  833.        (\nDictionary stack:) false /.printdstack /dstack 4 index exec
  834.        () =
  835.        pop    % printing procedure
  836.  
  837.        errorname /VMerror eq
  838.     { (VM status:) print mark vmstatus
  839.       counttomark { ( ) print counttomark -1 roll dup =only } repeat
  840.       cleartomark () =
  841.     } if
  842.  
  843.        .languagelevel 2 ge
  844.     { (Current allocation mode is ) print
  845.       globalmode { (global\n) } { (local\n) } ifelse print
  846.     } if
  847.  
  848.        .oserrno dup 0 ne
  849.     { (Last OS error: ) print
  850.       errorname /VMerror ne
  851.        { dup .oserrorstring { = pop } { = } ifelse }
  852.        { = }
  853.       ifelse
  854.     }
  855.     { pop
  856.     }
  857.        ifelse
  858.  
  859.        position null ne
  860.     { (Current file position is ) print position = }
  861.        if
  862.  
  863.    } bind def
  864. % Define a procedure for clearing the error indication.
  865. /.clearerror
  866.  { $error /newerror false put
  867.    $error /errorname null put
  868.    $error /errorinfo null put
  869.    0 .setoserrno
  870.  } bind def
  871.  
  872. % Define $error.  This must be in local VM.
  873. .currentglobal false .setglobal
  874. /$error 40 dict .forcedef    % $error is local, systemdict is global
  875.         % newerror, errorname, command, errorinfo,
  876.         % ostack, estack, dstack, recordstacks,
  877.         % binary, globalmode,
  878.         % .inerror, .nosetlocal, position,
  879.         % plus extra space for badly designed error handers.
  880. $error begin
  881.   /newerror false def
  882.   /recordstacks true def
  883.   /binary false def
  884.   /globalmode .currentglobal def
  885.   /.inerror false def
  886.   /.nosetlocal true def
  887.   /position null def
  888. end
  889. % Define errordict similarly.  It has one entry per error name,
  890. %   plus handleerror.
  891. /errordict ErrorNames length 1 add dict
  892. .forcedef        % errordict is local, systemdict is global
  893. .setglobal        % contents of errordict are global
  894. errordict begin
  895.   ErrorNames
  896.    { mark 1 index systemdict /.errorhandler get /exec load .packtomark cvx def
  897.    } forall
  898. % The handlers for interrupt and timeout are special; there is no
  899. % 'current object', so they push their own name.
  900.    { /interrupt /timeout }
  901.    { mark 1 index dup systemdict /.errorhandler get /exec load .packtomark cvx def
  902.    } forall
  903. /handleerror
  904.  { /.printerror .systemvar exec
  905.  } bind def
  906. end
  907.  
  908. % Define the [write]==[only] procedures.
  909. /.dict 8 dict dup
  910. begin def
  911.   /.cvp {1 index exch 1 .writecvp} bind def
  912.   /.p {1 index exch writestring} bind def
  913.   /.p1 {2 index exch writestring} bind def
  914.   /.p2 {3 index exch writestring} bind def
  915.   /.print
  916.     { dup type .dict exch .knownget { exec } { .cvp } ifelse
  917.     } bind def
  918.   /arraytype
  919.     {dup rcheck
  920.       {() exch dup xcheck
  921.         {({) .p2
  922.          {exch .p1
  923.           1 index exch .print pop ( )} forall
  924.          (})}
  925.         {([) .p2
  926.          {exch .p1
  927.           1 index exch .print pop ( )} forall
  928.          (])}
  929.        ifelse exch pop .p}
  930.       {.cvp}
  931.      ifelse} bind def
  932.   /packedarraytype /arraytype load def
  933. {//.dict begin .print pop end}
  934.   bind
  935. end
  936.  
  937. /write==only exch def
  938. /write== {1 index exch write==only (\n) writestring} bind def
  939. /==only { (%stdout) (w) file exch write==only } bind def
  940. /== {==only (\n) print} bind def
  941.  
  942. % Define [write]===[only], an extension that prints dictionaries
  943. % in readable form and doesn't truncate strings.
  944. /.dict /write==only load 0 get dup length 2 add dict .copydict dup
  945. begin def
  946.   /dicttype
  947.     { dup rcheck
  948.        { (<< ) .p1
  949.           { 2 index 3 -1 roll .print pop ( ) .p1
  950.         1 index exch .print pop ( ) .p
  951.           }
  952.          forall (>>) .p
  953.        }
  954.        { .cvp
  955.        }
  956.       ifelse
  957.     } bind def
  958.   /stringtype
  959.     { 1 index exch 2 .writecvp
  960.     } bind def
  961.  
  962. {//.dict begin .print pop end}
  963.   bind
  964. end
  965.  
  966. /write===only exch def
  967. /write=== {1 index exch write===only (\n) writestring} bind def
  968. /===only { (%stdout) (w) file exch write===only } bind def
  969. /=== { ===only (\n) print } bind def
  970.  
  971. (END PROCS) VMDEBUG
  972.  
  973. % Define the font directory.
  974. /FontDirectory false .setglobal 100 dict true .setglobal
  975. .forcedef        % FontDirectory is local, systemdict is global
  976.  
  977. % Define the encoding dictionary.
  978. /EncodingDirectory 10 dict def    % enough for Level 2 + PDF standard encodings
  979.  
  980. % Define .findencoding.  (This is redefined in Level 2.)
  981. /.findencoding
  982.  { //EncodingDirectory exch get exec
  983.  } bind def
  984. /.defineencoding
  985.  { //EncodingDirectory 3 1 roll put
  986.  } bind def
  987. % If we've got the composite font extensions, define findencoding.
  988. % To satisfy the Genoa FTS, findencoding must be a procedure, not an operator.
  989. /rootfont where { pop /findencoding { .findencoding } def } if
  990.  
  991. % Define .registerencoding.
  992. % NOTE: the name registeredencodings is known to (initialized by and shared
  993. % with) the interpreter.
  994. /.registerencoding {    % <index> <array> .registerencoding -
  995.     % Check that the array is indexable.
  996.     % (It might still be a string, but then the .namestring will fail.)
  997.   dup 0 0 getinterval pop
  998.     % Check that all the elements of the array are names.
  999.   dup { .namestring pop } forall
  1000.     % Do the store.
  1001.   //registeredencodings 2 index 2 index readonly put pop pop
  1002. } bind odef
  1003. systemdict /registeredencodings .undef
  1004.  
  1005. % Load StandardEncoding.
  1006. %% Replace 1 (gs_std_e.ps)
  1007. (gs_std_e.ps) dup runlibfile VMDEBUG
  1008.  
  1009. % Load ISOLatin1Encoding.
  1010. %% Replace 1 (gs_il1_e.ps)
  1011. (gs_il1_e.ps) dup runlibfile VMDEBUG
  1012.  
  1013. % Define stubs for the Symbol and Dingbats encodings.
  1014. % Note that the first element of the procedure must be the file name,
  1015. % since gs_lev2.ps extracts it to set up the Encoding resource category.
  1016.  
  1017.   /SymbolEncoding { /SymbolEncoding .findencoding } bind def
  1018. %% Replace 3 (gs_sym_e.ps)
  1019.   EncodingDirectory /SymbolEncoding
  1020.    { (gs_sym_e.ps) //systemdict begin runlibfile SymbolEncoding end }
  1021.   bind put
  1022.  
  1023.   /DingbatsEncoding { /DingbatsEncoding .findencoding } bind def
  1024. %% Replace 3 (gs_dbt_e.ps)
  1025.   EncodingDirectory /DingbatsEncoding
  1026.    { (gs_dbt_e.ps) //systemdict begin runlibfile DingbatsEncoding end }
  1027.   bind put
  1028.  
  1029. (END FONTDIR/ENCS) VMDEBUG
  1030.  
  1031. % Construct a dictionary of all available devices.
  1032. % These are (read-only) device prototypes that can't be
  1033. % installed or have their parameters changed.  For this reason,
  1034. % the value in the dictionary is actually a 2-element writable array,
  1035. % to allow us to create a default instance of the prototype on demand.
  1036.  
  1037.     % Loop until the .getdevice gets a rangecheck.
  1038. errordict /rangecheck 2 copy get
  1039. errordict /rangecheck { pop stop } put    % pop the command
  1040.   0 { {dup .getdevice exch 1 add} loop} .internalstopped pop
  1041.   1 add dict  /devicedict 1 index def
  1042.   begin            % 2nd copy of count is on stack
  1043.    { dup .devicename exch
  1044.      dup wcheck { dup } { null } ifelse 2 array astore def
  1045.    } repeat
  1046.   end
  1047. put        % errordict /rangecheck
  1048. .clearerror
  1049. /devicenames devicedict { pop } forall devicedict length packedarray def
  1050.  
  1051. % Determine the default device.
  1052. /defaultdevice DISPLAYING
  1053.  { systemdict /DEVICE .knownget
  1054.     { devicedict 1 index known not
  1055.        { (Unknown device: ) print =
  1056.      flush /defaultdevice cvx 1 .quit
  1057.        }
  1058.       if
  1059.     }
  1060.     { 0 .getdevice .devicename
  1061.     }
  1062.    ifelse
  1063.  }
  1064.  { /nullpage
  1065.  }
  1066. ifelse
  1067. /.defaultdevicename 1 index def
  1068. finddevice    % make a copy
  1069. def
  1070. devicedict /Default devicedict .defaultdevicename get put
  1071.  
  1072. (END DEVS) VMDEBUG
  1073.  
  1074. % Define statusdict, for the benefit of programs
  1075. % that think they are running on a LaserWriter or similar printer.
  1076. %% Replace 1 (gs_statd.ps)
  1077. (gs_statd.ps) runlibfile
  1078.  
  1079. (END STATD) VMDEBUG
  1080.  
  1081. % Load the standard font environment.
  1082. %% Replace 1 (gs_fonts.ps)
  1083. (gs_fonts.ps) runlibfile
  1084.  
  1085. (END GS_FONTS) VMDEBUG
  1086.  
  1087. % Define the default halftone screen and BG/UCR functions now, so that
  1088. % it will bind in the original definitions of set[color]screen.
  1089. % We make this a procedure so we can call it again when switching devices.
  1090.  
  1091. % Use an ordered dither for low-resolution devices.
  1092. /.setloreshalftone {    % <dpi> .setloreshalftone -
  1093.     % The following 'ordered dither' spot function was contributed by
  1094.     % Gregg Townsend.  Thanks, Gregg!
  1095.    16.001 div 0            % not 16: avoids rounding problems
  1096.     { 1 add 7.9999 mul cvi exch 1 add 7.9999 mul cvi 16 mul add <
  1097.     0E 8E 2E AE 06 86 26 A6 0C 8C 2C AC 04 84 24 A4
  1098.     CE 4E EE 6E C6 46 E6 66 CC 4C EC 6C C4 44 E4 64
  1099.     3E BE 1E 9E 36 B6 16 96 3C BC 1C 9C 34 B4 14 94
  1100.     FE 7E DE 5E F6 76 D6 56 FC 7C DC 5C F4 74 D4 54
  1101.     01 81 21 A1 09 89 29 A9 03 83 23 A3 0B 8B 2B AB
  1102.     C1 41 E1 61 C9 49 E9 69 C3 43 E3 63 CB 4B EB 6B
  1103.     31 B1 11 91 39 B9 19 99 33 B3 13 93 3B BB 1B 9B
  1104.     F1 71 D1 51 F9 79 D9 59 F3 73 D3 53 FB 7B DB 5B
  1105.     0D 8D 2D AD 05 85 25 A5 0F 8F 2F AF 07 87 27 A7
  1106.     CD 4D ED 6D C5 45 E5 65 CF 4F EF 6F C7 47 E7 67
  1107.     3D BD 1D 9D 35 B5 15 95 3F BF 1F 9F 37 B7 17 97
  1108.     FD 7D DD 5D F5 75 D5 55 FF 7F DF 5F F7 77 D7 57
  1109.     02 82 22 A2 0A 8A 2A AA 00 80 20 A0 08 88 28 A8
  1110.     C2 42 E2 62 CA 4A EA 6A C0 40 E0 60 C8 48 E8 68
  1111.     32 B2 12 92 3A BA 1A 9A 30 B0 10 90 38 B8 18 98
  1112.     F2 72 D2 52 FA 7A DA 5A F0 70 D0 50 F8 78 D8 58
  1113.      > exch get 256 div
  1114.     }
  1115.    bind
  1116.         % Use correct, per-plane screens for CMYK devices only.
  1117.    //systemdict /setcolorscreen known processcolors 4 eq and
  1118.     { 3 copy 6 copy //setcolorscreen }
  1119.     { //setscreen }
  1120.    ifelse
  1121. } bind def
  1122. /.setloresscreen {    % <dpi> .setloresscreen -
  1123.   .setloreshalftone
  1124.   0 array cvx settransfer    % Genoa CET won't accept a packed array!
  1125.   /setstrokeadjust where { pop true setstrokeadjust } if
  1126. } bind def
  1127. % Use a 45-degree spot screen for high-resolution devices.
  1128. /.sethireshalftone {    % <dpi> .sethireshalftone <doscreen>
  1129.     % According to information published by Hewlett-Packard,
  1130.     % they use a 60 line screen on 300 DPI printers and
  1131.     % an 85 line screen on 600 DPI printers.
  1132.     % However, we use a 106 line screen, which produces smoother-
  1133.     % looking shades but fewer of them (32 vs. 50).
  1134.     % 46 was suggested as a good frequency value for printers
  1135.     % between 200 and 400 DPI, so we use it for lower resolutions.
  1136.     % Imagesetters need even higher frequency screens.
  1137.    //systemdict /DITHERPPI known
  1138.     { DITHERPPI
  1139.     }
  1140.     { dup cvi 100 idiv 15 .min
  1141.        {null 46 46 60 60 60 106 106 106 106 133 133 133 133 133 150}
  1142.       exch get
  1143.      }
  1144.    ifelse
  1145.    1 index 4.01 div .min    % at least a 4x4 cell
  1146.    45
  1147.     % The following screen algorithm is used by permission of the author.
  1148.     { 1 add 180 mul cos 1 0.08 add mul exch 2 add 180 mul cos 
  1149.       1 0.08 sub mul add 2 div % (C) 1989 Berthold K.P. Horn
  1150.     }
  1151.    bind
  1152.     % Determine whether we have lots of process colors.
  1153.     % If so, don't bother with color screening or gamma correction.
  1154.     % Also don't do gamma correction on very high-resolution devices.
  1155.     % (This should depend on dot gain, not resolution, but we don't
  1156.     % currently have a way to determine this.)
  1157.    currentdevice mark
  1158.      /RedValues 0 /GreenValues 0 /BlueValues 0 /GrayValues 0
  1159.    .dicttomark .getdeviceparams
  1160.    counttomark 2 idiv 1 sub { exch pop min } repeat
  1161.    exch pop exch pop 32 lt 4 index 800 lt and 5 1 roll
  1162.     % Stack: doscreen dpi freq angle proc
  1163.     % Ghostscript currently doesn't use correct, per-plane halftones
  1164.     % unless setcolorscreen has been executed.  Since these are
  1165.     % computationally much more expensive than binary halftones,
  1166.     % we check to make sure they are really warranted, i.e., we have
  1167.     % a high-resolution CMYK device (i.e., not a display) with
  1168.     % fewer than 5 bits per plane (i.e., not a true-color device).
  1169.    4 -1 roll 150 ge
  1170.     { /setcolorscreen where
  1171.        { pop //systemdict /COLORSCREEN known
  1172.       { COLORSCREEN }
  1173.       { 3 index }
  1174.      ifelse
  1175.      dup false ne
  1176.       { 4 1 roll 3 copy 6 copy 13 -1 roll
  1177.     % For really high-quality screening on printers, we need to
  1178.     % give each plane its own screen angle.  Unfortunately,
  1179.     % this currently has very large space and time costs.
  1180.         true eq        % true => different angles,
  1181.                 % 0 => same angles
  1182.          { { 45 90 15 75 } { 3 1 roll exch pop 12 3 roll } forall
  1183.          }
  1184.         if //setcolorscreen
  1185.       }
  1186.       { pop //setscreen    % false => single binary screen
  1187.       }
  1188.      ifelse
  1189.        }
  1190.        { //setscreen        % setcolorscreen not known
  1191.        }
  1192.       ifelse
  1193.     }
  1194.     { //setscreen            % not high resolution
  1195.     }
  1196.    ifelse
  1197. } bind def
  1198. /.sethiresscreen {    % <dpi> .sethiresscreen -
  1199.   .sethireshalftone
  1200.             % Stack: doscreen
  1201.     {    % Set the transfer function to lighten up the grays.
  1202.     % We correct at the high end so that very light grays
  1203.     % don't disappear completely if they darken <1 screen pixel.
  1204.     % Parameter values closer to 1 are better for devices with
  1205.     % less dot spreading; lower values are better with more spreading.
  1206.     % The value 0.8 is a compromise that will probably please no one!
  1207.     %
  1208.     % Because of a bug in FrameMaker, we have to accept operands
  1209.     % outside the valid range of [0..1].
  1210.       { dup dup 0.0 gt exch 1.0 lt and
  1211.      { 0.8 exp dup dup 0.9375 gt exch 0.999 lt and    % > 15/16
  1212.         { .currentscreenlevels 1 sub    % tweak to avoid boundary
  1213.           1 exch div 1 exch sub .min
  1214.         }
  1215.        if
  1216.      }
  1217.     if
  1218.       }
  1219.     }
  1220.     {    % Set the transfer function to the identity.
  1221.       0 array cvx        % Genoa CET won't accept a packed array!
  1222.     }
  1223.    ifelse settransfer
  1224.    /setstrokeadjust where { pop false setstrokeadjust } if
  1225.     % Increase fill adjustment so that we effectively use Adobe's
  1226.     % any-part-of-pixel rule.
  1227.    0.5 .setfilladjust
  1228. } bind def
  1229. % Set the default screen and BG/UCR.
  1230. /.setdefaultbgucr {
  1231.   systemdict /setblackgeneration known {
  1232.     { pop 0 } dup setblackgeneration setundercolorremoval
  1233.   } if
  1234. } bind def
  1235. /.useloresscreen {    % - .useloresscreen <bool>
  1236.     % Compute min(|dpi x|,|dpi y|) as the definition of the resolution.
  1237.   72 72 matrix defaultmatrix dtransform abs exch abs .min
  1238.   dup 150 lt //systemdict /DITHERPPI known not and
  1239. } bind def
  1240.  
  1241. % The following implementation uses LL2 extensions, but only in stopped
  1242. % contexts so that with LL1, the .set??reshalftone will be used.
  1243. %
  1244. %    - .getdefaulthalftone <halftonedict> true    if default found
  1245. %                  false            
  1246. /.getdefaulthalftone {
  1247.   % try the device to see if it has a default halftone
  1248.   { currentdevice /HalftoneDefault gsgetdeviceprop } stopped
  1249.   { pop pop false }        % no device property
  1250.   { dup type /dicttype eq { true } { pop false } ifelse }
  1251.   ifelse
  1252.   % stack: <halftonedict> true    if default found
  1253.   %         false          not found
  1254.   dup not
  1255.   { % device did not provide a default, try Resource
  1256.     pop { /Default /Halftone /findresource .systemvar exec } stopped 
  1257.     { pop pop false } { true } ifelse
  1258.   }
  1259.   if
  1260. } bind def
  1261.  
  1262. /.setdefaulthalftone {
  1263.   .getdefaulthalftone 
  1264.   { sethalftone }
  1265.   { % default not found
  1266.     .useloresscreen { .setloreshalftone } { .sethireshalftone pop } ifelse
  1267.   }
  1268.   ifelse
  1269. } bind def
  1270.  
  1271. /.setdefaultscreen {
  1272.   .useloresscreen { .setloresscreen } { .sethiresscreen } ifelse
  1273.   .setdefaultbgucr
  1274. } bind def
  1275.  
  1276. % Load the initialization files for optional features.
  1277. %% Replace 4 INITFILES
  1278. systemdict /INITFILES known
  1279.  { INITFILES { dup runlibfile VMDEBUG } forall
  1280.  }
  1281. if
  1282.  
  1283. % If Level 2 (or higher) functionality is implemented, enable it now.
  1284. /.setlanguagelevel where {
  1285.   pop 2 .setlanguagelevel
  1286.     % If the resource machinery is loaded, fix up some things now.
  1287.   /.fixresources where { pop .fixresources } if
  1288. } if
  1289. /ll3dict where {
  1290.   pop 3 .setlanguagelevel
  1291. } if
  1292.  
  1293. (END INITFILES) VMDEBUG
  1294.  
  1295. % Create a null font.  This is the initial font.
  1296. 8 dict dup begin
  1297.   /FontMatrix [ 1 0 0 1 0 0 ] readonly def
  1298.   /FontType 3 def
  1299.   /FontName () def
  1300.   /Encoding StandardEncoding def
  1301.   /FontBBox { 0 0 0 0 } readonly def % executable is bogus, but customary ...
  1302.   /BuildChar { pop pop 0 0 setcharwidth } bind def
  1303.   /PaintType 0 def        % shouldn't be needed!
  1304. end
  1305. /NullFont exch definefont setfont
  1306.  
  1307. % Define NullFont as the font.
  1308. /NullFont currentfont def
  1309.  
  1310. % Load initial fonts from FONTPATH directories, Fontmap file,
  1311. % and/or .getccfont as appropriate.
  1312. .loadinitialfonts
  1313.  
  1314. % Remove NullFont from FontDirectory, so it can't be accessed by mistake.
  1315. /undefinefont where {
  1316.   pop /NullFont undefinefont
  1317. } {
  1318.   FontDirectory /NullFont .undef
  1319. } ifelse
  1320.  
  1321. (END FONTS) VMDEBUG
  1322.  
  1323. % Restore the real definition of runlibfile.
  1324. /runlibfile /.runlibfile load def
  1325. currentdict /.runlibfile .undef
  1326.  
  1327. % Bind all the operators defined as procedures.
  1328. /.bindoperators        % binds operators in currentdict
  1329.  { % Temporarily disable the typecheck error.
  1330.    errordict /typecheck 2 copy get
  1331.    errordict /typecheck { pop } put    % pop the command
  1332.    currentdict
  1333.     { dup type /operatortype eq
  1334.        { % This might be a real operator, so bind might cause a typecheck,
  1335.      % but we've made the error a no-op temporarily.
  1336.      .bind        % do a real bind even if NOBIND is set
  1337.        }
  1338.       if pop pop
  1339.     } forall
  1340.    put
  1341.  } def
  1342. NOBIND DELAYBIND or not { .bindoperators } if
  1343.  
  1344. % Establish a default environment.
  1345.  
  1346. defaultdevice
  1347. % The following line used to skip setting of page size and resolution if
  1348. % NODISPLAY was selected.  We think this was only to save time and memory,
  1349. % and it is a bad idea because it prevents setting the resolution in this
  1350. % situation, which pstoedit (among other programs) relies on.
  1351. %DISPLAYING not { setdevice (%END DISPLAYING) .skipeof } if
  1352. systemdict /DEVICEWIDTH known
  1353. systemdict /DEVICEHEIGHT known or
  1354. systemdict /DEVICEWIDTHPOINTS known or
  1355. systemdict /DEVICEHEIGHTPOINTS known or
  1356. systemdict /DEVICEXRESOLUTION known or
  1357. systemdict /DEVICEYRESOLUTION known or
  1358. systemdict /PAPERSIZE known or
  1359. not { (%END DEVICE) .skipeof } if
  1360. % Let DEVICE{WIDTH,HEIGHT}[POINTS] override PAPERSIZE.
  1361. systemdict /PAPERSIZE known
  1362. systemdict /DEVICEWIDTH known not and
  1363. systemdict /DEVICEHEIGHT known not and
  1364. systemdict /DEVICEWIDTHPOINTS known not and
  1365. systemdict /DEVICEHEIGHTPOINTS known not and
  1366.  {    % Convert the paper size to device dimensions.
  1367.    true statusdict /.pagetypenames get
  1368.     { PAPERSIZE eq
  1369.        { PAPERSIZE load
  1370.          dup 0 get /DEVICEWIDTHPOINTS exch def
  1371.          1 get /DEVICEHEIGHTPOINTS exch def
  1372.          pop false exit
  1373.        }
  1374.       if
  1375.     }
  1376.    forall
  1377.     { (Unknown paper size: ) print PAPERSIZE ==only (.) =
  1378.     }
  1379.    if
  1380.  }
  1381. if
  1382. % Adjust the device parameters per the command line.
  1383. % It is possible to specify resolution, pixel size, and page size;
  1384. % since any two of these determine the third, conflicts are possible.
  1385. % We simply pass them to .setdeviceparams and let it sort things out.
  1386.    mark /HWResolution null /HWSize null /PageSize null .dicttomark
  1387.    .getdeviceparams .dicttomark begin
  1388.    mark
  1389.     % Check for resolution.
  1390.    /DEVICEXRESOLUTION where dup
  1391.     { exch pop HWResolution 0 DEVICEXRESOLUTION put }
  1392.    if
  1393.    /DEVICEYRESOLUTION where dup
  1394.     { exch pop HWResolution 1 DEVICEYRESOLUTION put }
  1395.    if
  1396.    or { /HWResolution HWResolution } if
  1397.     % Check for device sizes specified in pixels.
  1398.    /DEVICEWIDTH where dup
  1399.     { exch pop HWSize 0 DEVICEWIDTH put }
  1400.    if
  1401.    /DEVICEHEIGHT where dup
  1402.     { exch pop HWSize 1 DEVICEHEIGHT put }
  1403.    if
  1404.    or { /HWSize HWSize } if
  1405.     % Check for device sizes specified in points.
  1406.    /DEVICEWIDTHPOINTS where dup
  1407.     { exch pop PageSize 0 DEVICEWIDTHPOINTS put }
  1408.    if
  1409.    /DEVICEHEIGHTPOINTS where dup
  1410.     { exch pop PageSize 1 DEVICEHEIGHTPOINTS put }
  1411.    if
  1412.    or { /PageSize PageSize } if
  1413.     % Check whether any parameters were set.
  1414.    dup mark eq { pop } { defaultdevice putdeviceprops } ifelse
  1415.    end
  1416. %END DEVICE
  1417. % Set any device properties defined on the command line.
  1418. % If BufferSpace is defined but not MaxBitmap, set MaxBitmap to BufferSpace.
  1419. systemdict /BufferSpace known
  1420. systemdict /MaxBitmap known not and
  1421.  { systemdict /MaxBitmap BufferSpace put
  1422.  } if
  1423. dup getdeviceprops
  1424. counttomark 2 idiv
  1425.  { systemdict 2 index known
  1426.     { pop dup load counttomark 2 roll }
  1427.     { pop pop }
  1428.    ifelse
  1429.  } repeat
  1430. counttomark dup 0 ne
  1431.  { 2 add -1 roll putdeviceprops }
  1432.  { pop pop }
  1433. ifelse
  1434. % If the initial device parameters are invalid, the setdevice may fail.
  1435. % Trap this and produce a reasonable error message.
  1436. { setdevice }        % does an erasepage
  1437. DEBUG { exec false } { .internalstopped } ifelse {
  1438.   (**** Unable to open the initial device, quitting.) = 1 .quit
  1439. } if
  1440.  
  1441. % If the media size is fixed, update the current page device dictionary.
  1442. FIXEDMEDIA
  1443. dup { pop systemdict /.currentpagedevice known } if
  1444. dup { pop .currentpagedevice exch pop } if
  1445. not { (%END MEDIA) .skipeof } if
  1446. currentpagedevice dup length dict .copydict
  1447. dup /Policies
  1448.     % Stack: <pagedevice> <pagedevice> /Policies
  1449. 1 index /InputAttributes
  1450. 2 copy get dup length dict .copydict
  1451.     % Stack: <pagedevice> <pagedevice> /Policies <pagedevice>
  1452.     %   /InputAttributes <inputattrs'>
  1453. dup 0 2 copy get dup length dict .copydict
  1454.     % Stack: <pagedevice> <pagedevice> /Policies <pagedevice>
  1455.     %   /InputAttributes <inputattrs'> <inputattrs'> 0 <attrs0'>
  1456. dup /PageSize 7 index /PageSize get
  1457. put                % PageSize in 0
  1458. put                % 0 in InputAttributes
  1459. put                % InputAttributes in pagedevice
  1460. % Also change the page size policy so we don't get an error.
  1461.     % Stack: <pagedevice> <pagedevice> /Policies
  1462. 2 copy get dup length dict .copydict
  1463.     % Stack: <pagedevice> <pagedevice> /Policies <policies'>
  1464. dup /PageSize 7 put        % PageSize in Policies
  1465. put                % Policies in pagedevice
  1466. .setpagedevice
  1467. %END MEDIA
  1468. %END DISPLAYING
  1469.  
  1470. (END DEVICE) VMDEBUG
  1471.  
  1472. % Establish a default upper limit in the character cache,
  1473. % namely, enough room for a 18-point character at the resolution
  1474. % of the default device, or for a character consuming 1% of the
  1475. % maximum cache size, whichever is larger.
  1476. mark
  1477.     % Compute limit based on character size.
  1478.   18 dup dtransform
  1479.   exch abs cvi 31 add 32 idiv 4 mul    % X raster
  1480.   exch abs cvi mul        % Y
  1481.     % Compute limit based on allocated space.
  1482.   cachestatus pop pop pop pop pop exch pop 0.01 mul cvi
  1483.   .max dup 10 idiv exch
  1484. setcacheparams
  1485. % Conditionally disable the character cache.
  1486. NOCACHE { 0 setcachelimit } if
  1487.  
  1488. (END CONFIG) VMDEBUG
  1489.  
  1490. % Initialize graphics.
  1491.  
  1492. .setdefaultscreen
  1493. initgraphics
  1494.  
  1495. % The interpreter relies on there being at least 2 entries
  1496. % on the graphics stack.  Establish the second one now.
  1497. gsave
  1498.  
  1499. % Define some control sequences as no-ops.
  1500. % This is a hack to get around problems
  1501. % in some common PostScript-generating applications.
  1502. <04> cvn { } def        % Apple job separator
  1503. <0404> cvn { } def        % two of the same
  1504. <1b> cvn { } def        % MS Windows LaserJet 4 prologue
  1505.                 % (UEL = ESC %-12345X)
  1506. <1b45> cvn { } def        % PJL reset prologue (ESC E)
  1507. <1b451b> cvn { } def        % PJL reset epilogue (ESC E + UEL)
  1508. <041b> cvn { } def        % MS Windows LaserJet 4 epilogue (^D + UEL)
  1509. (\001M) cvn            % TBCP initiator
  1510.  { currentfile /TBCPDecode filter cvx exec
  1511.  } bind def
  1512. /@PJL                % H-P job control
  1513.  { currentfile //=string readline { pop } if
  1514.  } bind def
  1515.  
  1516. % If we want a "safer" system, disable some obvious ways to cause havoc.
  1517. SAFER not { (%END SAFER) .skipeof } if
  1518. /file
  1519.  { dup (r) eq 2 index (%pipe*) .stringmatch not and
  1520.    2 index (%std*) .stringmatch or
  1521.     { file }
  1522.     { /invalidfileaccess signalerror }
  1523.    ifelse
  1524.  } .bind odef
  1525. /renamefile { /invalidfileaccess signalerror } odef
  1526. /deletefile { /invalidfileaccess signalerror } odef
  1527. /putdeviceprops
  1528.  { counttomark
  1529.    dup 2 mod 0 eq { pop /rangecheck signalerror } if
  1530.    3 2 3 2 roll
  1531.     { dup index /OutputFile eq  
  1532.        { -2 roll 
  1533.          dup () ne { /putdeviceprops load /invalidfileaccess signalerror } if
  1534.          3 -1 roll
  1535.        }
  1536.        { pop
  1537.        }
  1538.       ifelse
  1539.     } for
  1540.    putdeviceprops
  1541.  } .bind odef
  1542.  
  1543. %END SAFER
  1544.  
  1545. % If we delayed binding, make it possible to do it later.
  1546. /.bindnow {
  1547.   //systemdict begin .bindoperators end
  1548.   % Temporarily disable the typecheck error.
  1549.   errordict /typecheck 2 copy get
  1550.   errordict /typecheck { pop } put    % pop the command
  1551.   0 1 .delaycount 1 sub { .delaybind exch get .bind pop } for
  1552.   //systemdict /.delaybind {} .forceput    % reclaim the space
  1553.   //systemdict /.bindnow .forceundef    % ditto
  1554.   put
  1555.   //systemdict /.forcedef .forceundef        % remove temptation
  1556.   //systemdict /.forceput .forceundef        % ditto
  1557.   //systemdict /.forceundef .forceundef        % ditto
  1558. } .bind odef
  1559.  
  1560. % Turn off array packing, since some PostScript code assumes that
  1561. % procedures are writable.
  1562. false setpacking
  1563.  
  1564. (END INIT) VMDEBUG
  1565.  
  1566. /.currentuserparams where {
  1567.   pop
  1568.     % Remove real user params from psuserparams.
  1569.   mark .currentuserparams counttomark 2 idiv {
  1570.     pop psuserparams exch undef
  1571.   } repeat pop
  1572.     % Update the copy of the user parameters.
  1573.   mark .currentuserparams counttomark 2 idiv {
  1574.     userparams 3 1 roll .forceput    % userparams is read-only
  1575.   } repeat pop
  1576.     % Turn on idiom recognition, if available.
  1577.   currentuserparams /IdiomRecognition known {
  1578.     /IdiomRecognition true .definepsuserparam
  1579.   } if
  1580.   psuserparams readonly pop
  1581.   systemdict /.definepsuserparam undef
  1582.     % Save a copy of userparams for use with save/restore
  1583.     % (and, if implemented, context switching).
  1584.   .currentglobal false .setglobal
  1585.      mark .currentuserparams psuserparams { } forall .dicttomark readonly
  1586.      /userparams exch .forcedef        % systemdict is read-only
  1587.   .setglobal
  1588. } if
  1589. /.currentsystemparams where {
  1590.   pop
  1591.     % Remove real system params from pssystemparams.
  1592.   mark .currentsystemparams counttomark 2 idiv {
  1593.     pop pssystemparams exch .forceundef
  1594.   } repeat pop
  1595. } if
  1596.  
  1597. % Conditionally turn image interpolation on or off.
  1598. currentdict /INTERPOLATE known not { (%END INTERPOLATE) .skipeof } if
  1599. /.interpolate {
  1600.   dup /Interpolate .knownget not { false } if
  1601.   /INTERPOLATE .systemvar ne {
  1602.     dup gcheck .currentglobal exch .setglobal
  1603.     exch dup length dict copy
  1604.     dup /Interpolate /INTERPOLATE .systemvar put
  1605.     exch .setglobal
  1606.   } if
  1607. } bind odef
  1608. /image {
  1609.   dup type /dicttype eq {
  1610.     .interpolate image
  1611.   } {
  1612.     /INTERPOLATE .systemvar {
  1613.       8 dict begin
  1614.       /ImageType 1 def
  1615.       /DataSource 1 index def
  1616.       /ImageMatrix 2 index def
  1617.       /BitsPerComponent 3 index def
  1618.       /Decode {0 1} def
  1619.       /Height 4 index def
  1620.       /Width 5 index def
  1621.       /Interpolate true def
  1622.       currentdict end
  1623.       gsave /DeviceGray setcolorspace image grestore
  1624.       5 { pop } repeat
  1625.     } {
  1626.       image
  1627.     } ifelse
  1628.   } ifelse
  1629. } bind odef
  1630. /imagemask {
  1631.   dup type /dicttype eq {
  1632.     .interpolate imagemask
  1633.   } {
  1634.     /INTERPOLATE .systemvar {
  1635.       8 dict begin
  1636.       /ImageType 1 def
  1637.       /DataSource 1 index def
  1638.       /ImageMatrix 2 index def
  1639.       /BitsPerComponent 1 def
  1640.       2 index { {1 0} } { {0 1} } ifelse /Decode exch def
  1641.       /Height 4 index def
  1642.       /Width 5 index def
  1643.       /Interpolate true def
  1644.       currentdict end imagemask 5 { pop } repeat
  1645.     } {
  1646.       imagemask
  1647.     } ifelse
  1648.   } ifelse
  1649. } bind odef
  1650. %END INTERPOLATE
  1651.  
  1652. % Establish local VM as the default.
  1653. false /setglobal where { pop setglobal } { .setglobal } ifelse
  1654. $error /.nosetlocal false put
  1655.  
  1656. (END GLOBAL) VMDEBUG
  1657.  
  1658. /.savelocalstate where {
  1659.     % If we might create new contexts, save away copies of all dictionaries
  1660.     % referenced from systemdict that are stored in local VM,
  1661.     % and also save a copy of the initial gstate.
  1662.   pop .savelocalstate
  1663. } {
  1664.     % If we're *not* running in a multi-context system and FAKEFONTS is
  1665.     % defined, add the fake fonts to LocalFontDirectory.
  1666.   .definefakefonts    % current VM is local
  1667. } ifelse
  1668.  
  1669. % Remove systemdict entries for things that have been bound in where used
  1670. % and that shouldn't be accessible by name, and close up systemdict.
  1671. currentdict /filterdict .undef
  1672. currentdict /.cidfonttypes .undef
  1673. currentdict /.colorrenderingtypes .undef
  1674. currentdict /.formtypes .undef
  1675. currentdict /.halftonetypes .undef
  1676. currentdict /.imagetypes .undef
  1677. currentdict /.imagemasktypes .undef
  1678. currentdict /.patterntypes .undef
  1679. currentdict /.shadingtypes .undef
  1680. currentdict /.wheredict .undef
  1681. end
  1682.  
  1683. % Clean up VM, and enable GC.
  1684. /vmreclaim where
  1685.  { pop NOGC not { 2 vmreclaim 0 vmreclaim } if
  1686.  } if
  1687. DELAYBIND not {
  1688.   systemdict /.forcedef .undef        % remove temptation
  1689.   systemdict /.forceput .undef        % ditto
  1690.   systemdict /.forceundef .undef    % ditto
  1691. } if
  1692. WRITESYSTEMDICT not { systemdict readonly pop } if
  1693.  
  1694. (END GC) VMDEBUG
  1695.  
  1696. % The interpreter will run the initial procedure (start).
  1697.