home *** CD-ROM | disk | FTP | other *** search
/ swCHIP 1991 January / swCHIP_95-1.bin / utility / gs333ini / gs3.33 / gs_init.ps < prev    next >
Text File  |  1995-12-09  |  36KB  |  1,170 lines
  1. %    Copyright (C) 1989, 1995 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. % Initialization file for the interpreter.
  19. % When this is run, systemdict is still writable.
  20.  
  21. % Comment lines of the form
  22. %    %% Replace <n> <file(s)>
  23. % indicate places where the next <n> lines should be replaced by
  24. % the contents of <file(s)>, when creating a single merged init file.
  25.  
  26. % Check the interpreter revision.  NOTE: the interpreter code requires
  27. % that the first non-comment token in this file be an integer.
  28. 333
  29. dup revision ne
  30.  { (gs: Interpreter revision \() print revision 10 string cvs print
  31.    (\) does not match gs_init.ps revision \() print 10 string cvs print
  32.    (\).\n) print flush null 1 .quit
  33.  }
  34. if pop
  35.  
  36. % Acquire userdict, and set its length if necessary.
  37. /userdict where
  38.  { pop userdict maxlength 0 eq }
  39.  { true }
  40. ifelse
  41.  {        % userdict wasn't already set up by iinit.c.
  42.    /userdict
  43.    currentdict dup 200 .setmaxlength        % userdict
  44.    systemdict begin def        % can't use 'put', userdict is local
  45.  }
  46.  { systemdict begin
  47.  }
  48. ifelse
  49.  
  50. % Define true and false.
  51. /true 0 0 eq def
  52. /false 0 1 eq def
  53.  
  54. % Define dummy local/global operators if needed.
  55. systemdict /.setglobal known
  56.  { true .setglobal
  57.  }
  58.  { /.setglobal { pop } def
  59.    /.currentglobal { false } def
  60.    /.gcheck { pop false } def
  61.  }
  62. ifelse
  63.  
  64. % Define .languagelevel if needed.
  65. systemdict /.languagelevel known not { /.languagelevel 1 def } if
  66.  
  67. % Optionally choose a default paper size other than U.S. letter.
  68. % (a4) /PAPERSIZE where { pop pop } { /PAPERSIZE exch def } ifelse
  69.  
  70. % Turn on array packing for the rest of initialization.
  71. true setpacking
  72.  
  73. % Acquire the debugging flags.
  74. currentdict /DEBUG known   /DEBUG exch def
  75.   /VMDEBUG
  76.     DEBUG {{print mark
  77.             systemdict /level2dict known
  78.          { .currentglobal false .setglobal vmstatus
  79.            true .setglobal vmstatus 3 -1 roll pop
  80.            6 -2 roll pop .setglobal
  81.          }
  82.          { vmstatus 3 -1 roll pop
  83.          }
  84.         ifelse usertime 16#fffff and counttomark
  85.           { ( ) print (           ) cvs print }
  86.         repeat pop
  87.         ( ) print systemdict length (    ) cvs print
  88.         ( <) print count (    ) cvs print (>\n) print flush
  89.       }}
  90.       {{pop
  91.       }}
  92.      ifelse
  93.   def
  94.  
  95. currentdict /DISKFONTS known   /DISKFONTS exch def
  96. currentdict /ESTACKPRINT known   /ESTACKPRINT exch def
  97. currentdict /FAKEFONTS known   /FAKEFONTS exch def
  98. currentdict /NOBIND known   /NOBIND exch def
  99. /.bind /bind load def
  100. NOBIND { /bind { } def } if
  101. currentdict /NOCACHE known   /NOCACHE exch def
  102. currentdict /NOCIE known   /NOCIE exch def
  103. currentdict /NODISPLAY known   not /DISPLAYING exch def
  104. currentdict /NOGC known   /NOGC exch def
  105. currentdict /NOPAUSE known   /NOPAUSE exch def
  106. currentdict /NOPLATFONTS known   /NOPLATFONTS exch def
  107. currentdict /ORIENT1 known   /ORIENT1 exch def
  108. currentdict /OSTACKPRINT known   /OSTACKPRINT exch def
  109. currentdict /OUTPUTFILE known    % obsolete
  110.  { /OutputFile /OUTPUTFILE load def
  111.    currentdict /OUTPUTFILE undef
  112.  } if
  113. currentdict /QUIET known   /QUIET exch def
  114. currentdict /SAFER known   /SAFER exch def
  115. currentdict /WRITESYSTEMDICT known   /WRITESYSTEMDICT exch def
  116.  
  117. % Acquire environment variables.
  118. currentdict /DEVICE known not
  119.  { (GS_DEVICE) getenv { /DEVICE exch def } if } if
  120.  
  121. (START) VMDEBUG
  122.  
  123. % Open the standard files, so they will be open at the outermost save level.
  124. (%stdin) (r) file pop
  125. (%stdout) (w) file pop
  126. (%stderr) (w) file pop
  127.  
  128. % Define a procedure for skipping over an unneeded section of code.
  129. % This avoids allocating space for the skipped procedures.
  130. /.skipeof    % string ->
  131.  { { dup currentfile =string readline pop eq { exit } if } loop pop
  132.  } bind def
  133.  
  134. % Define =string, which is used by some PostScript programs even though
  135. % it isn't documented anywhere.
  136. % Put it in userdict so that each context can have its own copy.
  137. userdict /=string 128 string put
  138.  
  139. % Print the greeting.
  140.  
  141. /printgreeting
  142.  { mark
  143.    product (Ghostscript) search
  144.     { pop pop pop
  145.       (This software comes with NO WARRANTY: see the file PUBLIC for details.\n)
  146.     }
  147.     { pop
  148.     }
  149.    ifelse
  150.    (\n) copyright
  151.    (\)\n) revisiondate 10000 idiv (/)
  152.    revisiondate 100 mod (/)
  153.    revisiondate 100 idiv 100 mod ( \()
  154.    revision 10 mod
  155.    revision 10 idiv 10 mod (.)
  156.    revision 100 idiv ( )
  157.    product
  158.    counttomark
  159.     { (%stdout) (w) file exch .writecvs
  160.     } repeat pop
  161.  } bind def
  162.  
  163. QUIET not { printgreeting flush } if
  164.  
  165. % Define a special version of def for making operator procedures.
  166. /odef
  167.     {1 index exch .makeoperator def} bind def
  168.  
  169. %**************** BACKWARD COMPATIBILITY
  170. /getdeviceprops
  171.  { null .getdeviceparams
  172.  } bind odef
  173. /.putdeviceprops
  174.  { null true counttomark 1 add 3 roll .putdeviceparams
  175.    dup type /nametype eq
  176.     { counttomark 4 add 1 roll cleartomark pop pop pop
  177.       /.putdeviceprops load exch signalerror
  178.     }
  179.    if
  180.  } bind odef
  181. /.devicenamedict 1 dict dup /OutputDevice dup put def
  182. /.devicename
  183.  { //.devicenamedict .getdeviceparams exch pop exch pop
  184.  } bind odef
  185. /max { .max } bind def
  186. /min { .min } bind def
  187.  
  188. % Define predefined procedures substituting for operators,
  189. % in alphabetical order.
  190.  
  191. userdict /#copies 1 put
  192. /[    /mark load def
  193. /]     {counttomark array astore exch pop} odef
  194. /abs    {dup 0 lt {neg} if} odef
  195. % .beginpage is an operator in Level 2.
  196. /.beginpage { } odef
  197. /copypage
  198.     { 1 .endpage
  199.        { #copies false .outputpage
  200.          (>>copypage, press <return> to continue<<\n) .confirm
  201.        }
  202.       if .beginpage
  203.     } odef
  204. /setcolorscreen where { pop        % not in all Level 1 configurations
  205.    /currentcolorscreen
  206.     { .currenthalftone
  207.        { { 60 exch 0 exch 3 copy 6 copy }    % halftone
  208.          { 3 copy 6 copy }            % screen
  209.          { }                % colorscreen
  210.        }
  211.       exch get exec
  212.     } odef
  213. } if
  214. /currentscreen
  215.     { .currenthalftone
  216.        { { 60 exch 0 exch }            % halftone
  217.          { }                % screen
  218.          { 12 3 roll 9 { pop } repeat }    % colorscreen
  219.        }
  220.       exch get exec
  221.     } odef
  222. /.echo /echo load def
  223. userdict /.echo.mode true put
  224. /echo    {dup /.echo.mode exch store .echo} odef
  225. /eexec
  226.     { 55665 //filterdict /eexecDecode get exec
  227.       cvx systemdict begin stopped
  228.         % Only pop systemdict if it is still the top element,
  229.         % because this is apparently what Adobe interpreters do.
  230.       currentdict systemdict eq { end } if
  231.       { stop } if
  232.     } odef
  233. % .endpage is an operator in Level 2.
  234. /.endpage { 2 ne } odef
  235. % erasepage mustn't use gsave/grestore, because we call it before
  236. % the graphics state stack has been fully initialized.
  237. /erasepage
  238.     { /currentcolor where
  239.        { pop currentcolor currentcolorspace { setcolorspace setcolor } }
  240.        { /currentcmykcolor where
  241.           { pop currentcmykcolor { setcmykcolor } }
  242.           { currentrgbcolor { setrgbcolor } }
  243.          ifelse
  244.        }
  245.       ifelse 1 setgray .fillpage exec
  246.     } odef
  247. /executive
  248.     { { prompt
  249.          { (%statementedit) (r) file } stopped
  250.          { pop pop $error /errorname get /undefinedfilename eq
  251.         { exit } if        % EOF
  252.            handleerror null        % ioerror??
  253.          }
  254.         if
  255.         cvx execute
  256.       } loop
  257.     } odef
  258. /filter
  259.     { //filterdict 1 index .knownget
  260.        { exch pop exec }
  261.        { /filter load /undefined signalerror }
  262.       ifelse
  263.     } odef
  264. /handleerror
  265.     { errordict /handleerror get exec } bind def
  266. /identmatrix [1.0 0.0 0.0 1.0 0.0 0.0] readonly def
  267. /identmatrix
  268.     { //identmatrix exch copy } odef
  269. /initgraphics
  270.     { initmatrix newpath initclip
  271.       1 setlinewidth 0 setlinecap 0 setlinejoin
  272.       [] 0 setdash 0 setgray 10 setmiterlimit
  273.     } odef
  274. /languagelevel 1 def        % gs_lev2.ps may change this
  275. /matrix    { 6 array identmatrix } odef
  276. /prompt    { flush flushpage
  277.       (GS) print
  278.       count 0 ne { (<) print count =only } if
  279.       (>) print flush
  280.     } bind def
  281. /pstack    { 0 1 count 3 sub { index == } for } bind def
  282. /putdeviceprops
  283.     { .putdeviceprops { erasepage } if } odef
  284. /quit    { /quit load 0 .quit } odef
  285. /run    { dup type /filetype ne { (r) file } if cvx
  286.         % We must close the file when execution terminates,
  287.         % regardless of the state of the stack,
  288.         % and then propagate an error, if any.
  289.       cvx .runexec
  290.     } odef
  291. /setdevice
  292.     { .setdevice { erasepage } if } odef
  293. /showpage
  294.     { 0 .endpage
  295.        { #copies true .outputpage
  296.          (>>showpage, press <return> to continue<<\n) .confirm
  297.          erasepage
  298.        }
  299.       if initgraphics .beginpage
  300.     } odef
  301. % Code output by Adobe Illustrator relies on the fact that
  302. % `stack' is a procedure, not an operator!!!
  303. /stack    { 0 1 count 3 sub { index = } for } bind def
  304. /start    { executive } def
  305. /stop    { true .stop } odef
  306. /stopped { false .stopped } odef
  307. /store    { 1 index where { 3 1 roll put } { def } ifelse } odef
  308. % When running in Level 1 mode, this interpreter is supposed to be
  309. % compatible with PostScript "version" 54.0 (I think).
  310. /version (54.0) def
  311.  
  312. % Define some additional built-in procedures (beyond the ones defined by
  313. % the PostScript Language Reference Manual).
  314. % Warning: these are not guaranteed to stay the same from one release
  315. % to the next!
  316. /concatstrings
  317.     { exch dup length 2 index length add string    % str2 str1 new
  318.       dup dup 4 2 roll copy        % str2 new new new1
  319.       length 4 -1 roll putinterval
  320.     } bind def
  321. /copyarray
  322.     { dup length array copy } bind def
  323. /copystring
  324.     { dup length string copy } bind def
  325. /.dicttomark        % (the Level 2 >> operator)
  326.     { counttomark dup 1 and 0 ne
  327.        { pop /.dicttomark cvx /rangecheck signalerror
  328.        }
  329.        { 2 idiv dict dup
  330.          2 2 2 index maxlength 2 mul
  331.           {  {    % Stack: mark key1 value1 ... keyN valueN dict dict index
  332.            dup 2 add index exch 1 add index put dup
  333.          } for
  334.           }
  335.          stopped
  336.           {    % The error must have occurred in the 'put'.
  337.         pop pop pop pop stop
  338.           }
  339.           { counttomark 1 add 1 roll cleartomark
  340.           }
  341.          ifelse
  342.        }
  343.       ifelse
  344.     } bind def
  345. /finddevice
  346.     { systemdict /devicedict get exch get
  347.     } bind def
  348. /.growdictlength    % get size for growing a dictionary
  349.     { length 3 mul 2 idiv 1 add
  350.     } bind def
  351. /.growdict        % grow a dictionary
  352.     { dup .growdictlength .setmaxlength
  353.     } bind def
  354. /.growput        % put, grow the dictionary if needed
  355.     { 2 index length 3 index maxlength eq
  356.        { 3 copy pop known not { 2 index .growdict } if
  357.        } if
  358.       put
  359.     } bind def
  360. /.packtomark
  361.     { counttomark packedarray exch pop } bind def
  362. /runlibfile
  363.     { findlibfile
  364.        { exch pop run }
  365.        { /undefinedfilename signalerror }
  366.       ifelse
  367.     } bind def
  368. /selectdevice
  369.     { finddevice setdevice } bind def
  370. /signalerror        % <object> <errorname> signalerror -
  371.     { errordict exch get exec } bind def
  372.  
  373. % Define the =[only] procedures.  Also define =print,
  374. % which is used by some PostScript programs even though
  375. % it isn't documented anywhere.
  376. /write=only
  377.     { { .writecvs } null .stopped null ne
  378.        { pop (--nostringval--) writestring
  379.        }
  380.       if
  381.     } bind def
  382. /write=
  383.     { 1 index exch write=only (\n) writestring
  384.     } bind def
  385. /=only    { (%stdout) (w) file exch write=only } bind def
  386. /=    { =only (\n) print } bind def
  387. /=print    /=only load def
  388. % Temporarily define == as = for the sake of runlibfile0.
  389. /== /= load def
  390.  
  391. % Define procedures for getting and setting the current device resolution.
  392.  
  393. /gsgetdeviceprop    % <device> <propname> gsgetdeviceprop <value>
  394.  { 2 copy mark exch null .dicttomark .getdeviceparams
  395.    dup mark eq        % if true, not found
  396.     { pop dup /undefined signalerror }
  397.     { 5 1 roll pop pop pop pop }
  398.    ifelse
  399.  } bind def
  400. /gscurrentresolution    % - gscurrentresolution <[xres yres]>
  401.  { currentdevice /HWResolution gsgetdeviceprop
  402.  } bind def
  403. /gssetresolution    % <[xres yres]> gssetresolution -
  404.  { 2 array astore mark exch /HWResolution exch
  405.    currentdevice copydevice putdeviceprops setdevice
  406.  } bind def
  407.  
  408. % Define auxiliary procedures needed for the above.
  409. /shellarguments        % -> shell_arguments true (or) false
  410.     { /ARGUMENTS where
  411.        { /ARGUMENTS get dup type /arraytype eq
  412.           { aload pop /ARGUMENTS null store true }
  413.           { pop false }
  414.          ifelse }
  415.        { false } ifelse
  416.     } bind def
  417. /.confirm
  418.     { DISPLAYING NOPAUSE not and
  419.        {    % Print a message and wait for the user to type something.
  420.         % If the user just types a newline, flush it.
  421.          print flush
  422.          .echo.mode false echo
  423.          (%stdin) (r) file dup read
  424.           { dup (\n) 0 get eq { pop pop } { unread } ifelse }
  425.           { pop }
  426.          ifelse echo
  427.        }
  428.        { pop
  429.        }
  430.       ifelse
  431.     } bind def
  432.  
  433. % Define the procedure used by .runfile, .runstdin and .runstring
  434. % for executing user input.
  435. % This is called with a procedure or executable file on the operand stack.
  436. /execute
  437.     { stopped $error /newerror get and
  438.        { handleerror flush
  439.        } if
  440.     } odef
  441. % Define an execute analogue of runlibfile0.
  442. /execute0
  443.     { stopped $error /newerror get and
  444.        { handleerror flush /execute0 cvx 1 .quit
  445.        } if
  446.     } bind def
  447. % Define the procedure that the C code uses for running files
  448. % named on the command line.
  449. /.runfile { { runlibfile } execute } def
  450. % Define the procedure that the C code uses for running piped input.
  451. /.runstdin { (%stdin) (r) file cvx execute0 } bind def
  452. % Define the procedure that the C code uses for running commands
  453. % given on the command line with -c.
  454. /.runstring { cvx execute } def
  455.  
  456. % Define a special version of runlibfile that aborts on errors.
  457. /runlibfile0
  458.     { cvlit dup /.currentfilename exch def
  459.        { findlibfile not { stop } if }
  460.       stopped
  461.        { (Can't find \(or open\) initialization file ) print
  462.          .currentfilename == flush /runlibfile0 cvx 1 .quit
  463.        } if
  464.       exch pop cvx stopped
  465.        { (While reading ) print .currentfilename print (:\n) print flush
  466.          handleerror /runlibfile0 1 .quit
  467.        } if
  468.     } bind def
  469. % Temporarily substitute it for the real runlibfile.
  470. /.runlibfile /runlibfile load def
  471. /runlibfile /runlibfile0 load def
  472.  
  473. % Create the error handling machinery.
  474. % Define the standard error handlers.
  475. % The interpreter has created the ErrorNames array.
  476. /.unstoppederrorhandler    % <command> <errorname> .unstoppederrorhandler -
  477.  {    % This is the handler that gets used for recursive errors,
  478.     % or errors outside the scope of a 'stopped'.
  479.    (Unrecoverable error: ) print dup =only flush
  480.    ( in ) print 1 index = flush
  481.    count 2 gt
  482.     { (Operand stack:\n  ) print
  483.       2 1 count 3 sub { (  ) print index =only flush } for
  484.       (\n) print flush
  485.     } if
  486.    -1 0 1 //ErrorNames length 1 sub
  487.     { dup //ErrorNames exch get 3 index eq
  488.        { not exch pop exit } { pop } ifelse
  489.     }
  490.    for exch pop .quit
  491.  } bind def
  492. /.errorhandler        % <command> <errorname> .errorhandler -
  493.   {        % Detect an internal 'stopped'.
  494.     .instopped { null eq { pop pop stop } if } if
  495.     $error /.inerror get .instopped { pop } { pop true } ifelse
  496.      { .unstoppederrorhandler
  497.      } if    % detect error recursion
  498.     $error /globalmode .currentglobal false .setglobal put
  499.     $error /.inerror true put
  500.     $error /newerror true put
  501.     $error exch /errorname exch put
  502.     $error exch /command exch put
  503.     $error /recordstacks get $error /errorname get /VMerror ne and
  504.      {        % Attempt to store the stack contents atomically.
  505.        count array astore dup $error /ostack 4 -1 roll
  506.        countexecstack array execstack $error /estack 3 -1 roll
  507.        countdictstack array dictstack $error /dstack 3 -1 roll
  508.        put put put aload pop
  509.      }
  510.      { $error /dstack undef
  511.        $error /estack undef
  512.        $error /ostack undef
  513.      }
  514.     ifelse
  515.     $error /position currentfile status
  516.      { currentfile { fileposition } null .stopped null ne { pop null } if
  517.      }
  518.      { null
  519.      }
  520.     ifelse put
  521.         % During initialization, we don't reset the allocation
  522.         % mode on errors.
  523.     $error /globalmode get $error /.nosetlocal get and .setglobal
  524.     $error /.inerror false put
  525.     stop
  526.   } bind def
  527. % Define the standard handleerror.  We break out the printing procedure
  528. % (.printerror) so that it can be extended for binary output
  529. % if the Level 2 facilities are present.
  530.   /.printerror
  531.    { (Error: ) print
  532.      $error begin
  533.        errorname ==only flush
  534.        ( in ) print
  535.        /command load ==only flush
  536.        currentdict /errorinfo .knownget
  537.     { (\nAdditional information: ) print ==only flush
  538.     } if
  539.  
  540.        % Push the (anonymous) stack printing procedure.
  541.        %  <heading> <==flag> <override-name> <stackname> proc
  542.        {
  543.      currentdict exch .knownget    % stackname defined in $error?
  544.      {
  545.        4 1 roll            % stack: <stack> <head> <==flag> <over>
  546.        errordict exch .knownget    % overridename defined?
  547.        { 
  548.          exch pop exch pop exec    % call override with <stack>
  549.        }
  550.        { 
  551.          exch print exch        % print heading. stack <==flag> <stack>
  552.          1 index not { (\n) print } if
  553.          { 1 index { (\n    ) } { (   ) } ifelse print
  554.            dup type /dicttype eq
  555.            {
  556.          (--dict:) print
  557.          dup rcheck
  558.           { dup length =only (/) print maxlength =only }
  559.           { pop }
  560.          ifelse
  561.          (--) print
  562.            }
  563.            {
  564.          dup type /stringtype eq 2 index or
  565.          { ==only } { =only } ifelse
  566.            } ifelse
  567.          } forall
  568.          pop
  569.        }
  570.        ifelse            % overridden
  571.      }
  572.      { pop pop pop
  573.      }
  574.      ifelse                % stack known
  575.        }
  576.  
  577.        (\nOperand stack:) OSTACKPRINT /.printostack /ostack 4 index exec
  578.        (\nExecution stack:) ESTACKPRINT /.printestack /estack 4 index exec
  579.        (\nBacktrace:) true /.printbacktrace /backtrace 4 index exec
  580.        (\nDictionary stack:) false /.printdstack /dstack 4 index exec
  581.        (\n) print
  582.        pop    % printing procedure
  583.  
  584.        errorname /VMerror eq
  585.     { (VM status:) print mark vmstatus
  586.       counttomark { ( ) print counttomark -1 roll dup =only } repeat
  587.       cleartomark (\n) print
  588.     } if
  589.  
  590.        .languagelevel 2 ge
  591.     { (Current allocation mode is ) print
  592.       globalmode { (global\n) } { (local\n) } ifelse print
  593.     } if
  594.  
  595.        .oserrno dup 0 ne
  596.     { (Last OS error: ) print
  597.       errorname /VMerror ne
  598.        { dup .oserrorstring { = pop } { = } ifelse }
  599.        { = }
  600.       ifelse
  601.     }
  602.     { pop
  603.     }
  604.        ifelse
  605.  
  606.        position null ne
  607.     { (Current file position is ) print position = }
  608.        if
  609.  
  610.        .clearerror
  611.      end
  612.      flush
  613.    } bind def
  614. % Define a procedure for clearing the error indication.
  615. /.clearerror
  616.  { $error /newerror false put
  617.    $error /errorinfo undef
  618.    0 .setoserrno
  619.  } bind def
  620.  
  621. % Define $error.  This must be in local VM.
  622. .currentglobal false .setglobal
  623. /$error 40 dict def        % newerror, errorname, command, errorinfo,
  624.                 % ostack, estack, dstack, recordstacks,
  625.                 % binary, globalmode,
  626.                 % .inerror, .nosetlocal, position,
  627.         % plus extra space for badly designed error handers.
  628. $error begin
  629.   /newerror false def
  630.   /recordstacks true def
  631.   /binary false def
  632.   /globalmode .currentglobal def
  633.   /.inerror false def
  634.   /.nosetlocal true def
  635.   /position null def
  636. end
  637. % Define errordict similarly.  It has one entry per error name,
  638. %   plus handleerror.
  639. /errordict ErrorNames length 1 add dict def
  640. .setglobal        % contents of errordict are global
  641. errordict begin
  642.   ErrorNames
  643.    { mark 1 index systemdict /.errorhandler get /exec load .packtomark cvx def
  644.    } forall
  645. % The handlers for interrupt and timeout are special; there is no
  646. % 'current object', so they push their own name.
  647.    { /interrupt /timeout }
  648.    { mark 1 index dup systemdict /.errorhandler get /exec load .packtomark cvx def
  649.    } forall
  650. /handleerror
  651.  { systemdict /.printerror get exec
  652.  } bind def
  653. end
  654.  
  655. % Define the [write]==[only] procedures.
  656. /.dict 26 dict dup
  657. begin def
  658.   /.cvp {1 index exch .writecvs} bind def
  659.   /.nop {exch pop .p} bind def
  660.   /.p {1 index exch writestring} bind def
  661.   /.p1 {2 index exch writestring} bind def
  662.   /.p2 {3 index exch writestring} bind def
  663.   /.print
  664.     { dup type .dict exch .knownget
  665.        { dup type /stringtype eq { .nop } { exec } ifelse }
  666.        { (-) .p1 type .cvp (-) .p }
  667.       ifelse
  668.     } bind def
  669.   /.pstring
  670.     {  { dup dup 32 lt exch 127 ge or
  671.           { (\\) .p1 2 copy -6 bitshift 48 add write
  672.         2 copy -3 bitshift 7 and 48 add write
  673.         7 and 48 add
  674.           }
  675.           { dup dup -2 and 40 eq exch 92 eq or {(\\) .p1} if
  676.           }
  677.          ifelse 1 index exch write
  678.        }
  679.       forall
  680.     } bind def  
  681.   /booleantype /.cvp load def
  682.   /conditiontype (-condition-) def
  683.   /devicetype (-device-) def
  684.   /dicttype (-dict-) def
  685.   /filetype (-file-) def
  686.   /fonttype (-fontID-) def
  687.   /gstatetype (-gstate-) def
  688.   /integertype /.cvp load def
  689.   /locktype (-lock-) def
  690.   /marktype (-mark-) def
  691.   /nulltype (-null-) def
  692.   /realtype /.cvp load def
  693.   /savetype (-save-) def
  694.   /nametype
  695.     {dup xcheck not {(/) .p1} if
  696.      1 index exch .writecvs} bind def
  697.   /arraytype
  698.     {dup rcheck
  699.       {() exch dup xcheck
  700.         {({) .p2
  701.          {exch .p1
  702.           1 index exch .print pop ( )} forall
  703.          (})}
  704.         {([) .p2
  705.          {exch .p1
  706.           1 index exch .print pop ( )} forall
  707.          (])}
  708.        ifelse exch pop .p}
  709.       {(-array-) .nop}
  710.      ifelse} bind def
  711.   /operatortype
  712.       {(--) .p1 .cvp (--) .p} bind def
  713.   /packedarraytype
  714.     { dup rcheck
  715.        { arraytype }
  716.        { (-packedarray-) .nop }
  717.       ifelse
  718.     } bind def
  719.   /stringtype
  720.     { dup rcheck
  721.        { (\() .p1 dup length 200 le
  722.           { .pstring }
  723.           { 0 200 getinterval .pstring (...) .p }
  724.          ifelse (\)) .p
  725.        }
  726.        { (-string-) .nop
  727.        }
  728.       ifelse
  729.     } bind def
  730. {//.dict begin .print pop end}
  731.   bind cvx
  732. end
  733.  
  734. /write==only exch def
  735. /write==
  736.     {1 index exch write==only (\n) writestring} bind def
  737. /==only    { (%stdout) (w) file exch write==only } bind def
  738. /==    {==only (\n) print} bind def
  739.  
  740. (END PROCS) VMDEBUG
  741.  
  742. % Define the font directory.
  743. % Make it big to leave room for transformed fonts.
  744. /FontDirectory false .setglobal 100 dict true .setglobal def
  745.  
  746. % Define the encoding dictionary.
  747. /.encodingdict 10 dict def    % enough for Level 2 + PDF standard encodings
  748.  
  749. % Define findencoding.  (This is redefined in Level 2.)
  750. /.findencoding
  751.  { //.encodingdict exch get exec
  752.  } bind def
  753. /.defineencoding
  754.  { //.encodingdict 3 1 roll put
  755.  } bind def
  756.  
  757. % Load StandardEncoding.
  758. %% Replace 1 (gs_std_e.ps)
  759. (gs_std_e.ps) dup runlibfile VMDEBUG
  760.  
  761. % Load ISOLatin1Encoding.
  762. %% Replace 1 (gs_iso_e.ps)
  763. (gs_iso_e.ps) dup runlibfile VMDEBUG
  764.  
  765. % Define stubs for the Symbol and Dingbats encodings.
  766. % Note that the first element of the procedure must be the file name,
  767. % since gs_lev2.ps extracts it to set up the Encoding resource category.
  768.  
  769.   /SymbolEncoding { /SymbolEncoding .findencoding } bind def
  770. %% Replace 3 (gs_sym_e.ps)
  771.   .encodingdict /SymbolEncoding
  772.    { (gs_sym_e.ps) systemdict begin runlibfile SymbolEncoding end }
  773.   bind put
  774.  
  775.   /DingbatsEncoding { /DingbatsEncoding .findencoding } bind def
  776. %% Replace 3 (gs_dbt_e.ps)
  777.   .encodingdict /DingbatsEncoding
  778.    { (gs_dbt_e.ps) systemdict begin runlibfile DingbatsEncoding end }
  779.   bind put
  780.  
  781. (END FONTDIR/ENCS) VMDEBUG
  782.  
  783. % Construct a dictionary of all available devices.
  784. mark
  785.     % Loop until the .getdevice gets a rangecheck.
  786.   errordict /rangecheck 2 copy get
  787.   errordict /rangecheck { pop stop } put    % pop the command
  788.   0 { {dup .getdevice exch 1 add} loop} stopped pop
  789.   dict /devicedict exch def
  790.   devicedict begin        % 2nd copy of count is on stack
  791.    { dup .devicename dup 3 -1 roll def
  792.      counttomark 1 roll
  793.    } repeat
  794.   end put
  795. counttomark packedarray /devicenames exch def pop
  796. .clearerror
  797.  
  798. (END DEVS) VMDEBUG
  799.  
  800. % Define statusdict, for the benefit of programs
  801. % that think they are running on a LaserWriter or similar printer.
  802. %% Replace 1 (gs_statd.ps)
  803. (gs_statd.ps) runlibfile
  804.  
  805. (END STATD) VMDEBUG
  806.  
  807. % Load the standard font environment.
  808. %% Replace 1 (gs_fonts.ps)
  809. (gs_fonts.ps) runlibfile
  810.  
  811. (END GS_FONTS) VMDEBUG
  812.  
  813. % Create a null font.  This is the initial font.
  814. 8 dict dup begin
  815.   /FontMatrix [ 1 0 0 1 0 0 ] readonly def
  816.   /FontType 3 def
  817.   /FontName () def
  818.   /Encoding StandardEncoding def
  819.   /FontBBox { 0 0 0 0 } readonly def % executable is bogus, but customary ...
  820.   /BuildChar { pop pop 0 0 setcharwidth } bind def
  821.   /PaintType 0 def        % shouldn't be needed!
  822. end
  823. /NullFont exch definefont setfont
  824.  
  825. % Define NullFont as the font, but remove it from FontDirectory.
  826. /NullFont currentfont def
  827. FontDirectory /NullFont undef
  828.  
  829. (END FONTS) VMDEBUG
  830.  
  831. % Load the initialization files for optional features.
  832. %% Replace 4 INITFILES
  833. systemdict /INITFILES known
  834.  { INITFILES { dup runlibfile VMDEBUG } forall
  835.  }
  836. if
  837.  
  838. % If Level 2 functionality is implemented, enable it now.
  839. /.setlanguagelevel where
  840.  { pop 2 .setlanguagelevel
  841.  } if
  842.  
  843. % If the resource machinery was loaded, convert encodings to resources.
  844. /defineresource where
  845.  { pop .encodingdict
  846.     { dup length 256 eq
  847.        { /Encoding defineresource pop }
  848.        { pop pop }
  849.       ifelse
  850.     } forall
  851.  } if
  852.  
  853. (END INITFILES) VMDEBUG
  854.  
  855. % Restore the real definition of runlibfile.
  856. /runlibfile /.runlibfile load def
  857. currentdict /.runlibfile undef
  858.  
  859. % Bind all the operators defined as procedures.
  860. /.bindoperators        % binds operators in currentdict
  861.  { % Temporarily disable the typecheck error.
  862.    errordict /typecheck 2 copy get
  863.    errordict /typecheck { pop } put    % pop the command
  864.    currentdict
  865.     { dup type /operatortype eq
  866.        { % This might be a real operator, so bind might cause a typecheck,
  867.      % but we've made the error a no-op temporarily.
  868.      .bind        % do a real bind even if NOBIND is set
  869.        }
  870.       if pop pop
  871.     } forall
  872.    put
  873.  } def
  874. NOBIND not { .bindoperators } if
  875.  
  876. % Establish a default environment.
  877.  
  878. DISPLAYING not
  879.  { nulldevice (%END DISPLAYING) .skipeof
  880.  } if
  881. /defaultdevice 0 .getdevice systemdict /DEVICE known
  882.  { pop devicedict DEVICE known not
  883.     { (Unknown device: ) print DEVICE =
  884.       flush /defaultdevice cvx 1 .quit
  885.     }
  886.    if DEVICE finddevice
  887.  }
  888. if def
  889. defaultdevice
  890. systemdict /DEVICEWIDTH known
  891. systemdict /DEVICEHEIGHT known or
  892. systemdict /DEVICEWIDTHPOINTS known or
  893. systemdict /DEVICEHEIGHTPOINTS known or
  894. systemdict /DEVICEXRESOLUTION known or
  895. systemdict /DEVICEYRESOLUTION known or
  896. systemdict /PAPERSIZE known or
  897. not { (%END DEVICE) .skipeof } if
  898. systemdict /PAPERSIZE known
  899.  {    % Convert the paper size to device dimensions.
  900.    true statusdict /.pagetypenames get
  901.     { PAPERSIZE eq
  902.        { PAPERSIZE load
  903.          dup 0 get /DEVICEWIDTHPOINTS exch def
  904.          1 get /DEVICEHEIGHTPOINTS exch def
  905.          pop false exit
  906.        }
  907.       if
  908.     }
  909.    forall
  910.     { (Unknown paper size: ) print PAPERSIZE ==only (.\n) print
  911.     }
  912.    if
  913.  }
  914. if
  915. % Adjust the device parameters per the command line.
  916. % It is possible to specify resolution, pixel size, and page size;
  917. % since any two of these determine the third, conflicts are possible.
  918. % We simply pass them to .setdeviceparams and let it sort things out.
  919.    mark /HWResolution null /HWSize null /PageSize null .dicttomark
  920.    .getdeviceparams .dicttomark begin
  921.    mark
  922.     % Check for resolution.
  923.    /DEVICEXRESOLUTION where dup
  924.     { exch pop HWResolution 0 DEVICEXRESOLUTION put }
  925.    if
  926.    /DEVICEYRESOLUTION where dup
  927.     { exch pop HWResolution 1 DEVICEYRESOLUTION put }
  928.    if
  929.    or { /HWResolution HWResolution } if
  930.     % Check for device sizes specified in pixels.
  931.    /DEVICEWIDTH where dup
  932.     { exch pop HWSize 0 DEVICEWIDTH put }
  933.    if
  934.    /DEVICEHEIGHT where dup
  935.     { exch pop HWSize 1 DEVICEHEIGHT put }
  936.    if
  937.    or { /HWSize HWSize } if
  938.     % Check for device sizes specified in points.
  939.    /DEVICEWIDTHPOINTS where dup
  940.     { exch pop PageSize 0 DEVICEWIDTHPOINTS put }
  941.    if
  942.    /DEVICEHEIGHTPOINTS where dup
  943.     { exch pop PageSize 1 DEVICEHEIGHTPOINTS put }
  944.    if
  945.    or { /PageSize PageSize } if
  946.     % Check whether any parameters were set.
  947.    dup mark eq { pop } { defaultdevice putdeviceprops } ifelse
  948.    end
  949. %END DEVICE
  950. % Set any device properties defined on the command line.
  951. dup getdeviceprops
  952. counttomark 2 idiv
  953.  { systemdict 2 index known
  954.     { pop dup load counttomark 2 roll }
  955.     { pop pop }
  956.    ifelse
  957.  } repeat
  958. systemdict /BufferSpace known
  959. systemdict /MaxBitmap known not and
  960.  { /MaxBitmap BufferSpace
  961.  } if
  962. counttomark dup 0 ne
  963.  { 2 add -1 roll putdeviceprops }
  964.  { pop pop }
  965. ifelse
  966. setdevice        % does an erasepage
  967. %END DISPLAYING
  968.  
  969. (END DEVICE) VMDEBUG
  970.  
  971. % Establish a default upper limit in the character cache,
  972. % namely, enough room for a 1/4" x 1/4" character at the resolution
  973. % of the default device, or for 5 x the "average" character size,
  974. % whichever is larger.
  975. mark
  976.     % Compute limit based on character size.
  977.   18 dup dtransform        % 1/4" x 1/4"
  978.   exch abs cvi 31 add 32 idiv 4 mul    % X raster
  979.   exch abs cvi mul        % Y
  980.     % Compute limit based on allocated space.
  981.   cachestatus 5 2 roll pop pop pop pop div 5 mul cvi exch pop
  982.   .max dup 10 idiv exch
  983. setcacheparams
  984. % Conditionally disable the character cache.
  985. NOCACHE { 0 setcachelimit } if
  986.  
  987. (END CONFIG) VMDEBUG
  988.  
  989. % Establish an appropriate halftone screen.
  990.  
  991. 72 72 dtransform abs exch abs .min    % min(|dpi x|,|dpi y|)
  992. dup 150 lt systemdict /DITHERPPI known not and
  993.  {        % Low-res device, use ordered dither spot function
  994.     % The following 'ordered dither' spot function was contributed by
  995.     % Gregg Townsend.  Thanks, Gregg!
  996.   16.001 div 0            % not 16: avoids rounding problems
  997.    { 1 add 7.9999 mul cvi exch 1 add 7.9999 mul cvi 16 mul add <
  998.     0E 8E 2E AE 06 86 26 A6 0C 8C 2C AC 04 84 24 A4
  999.     CE 4E EE 6E C6 46 E6 66 CC 4C EC 6C C4 44 E4 64
  1000.     3E BE 1E 9E 36 B6 16 96 3C BC 1C 9C 34 B4 14 94
  1001.     FE 7E DE 5E F6 76 D6 56 FC 7C DC 5C F4 74 D4 54
  1002.     01 81 21 A1 09 89 29 A9 03 83 23 A3 0B 8B 2B AB
  1003.     C1 41 E1 61 C9 49 E9 69 C3 43 E3 63 CB 4B EB 6B
  1004.     31 B1 11 91 39 B9 19 99 33 B3 13 93 3B BB 1B 9B
  1005.     F1 71 D1 51 F9 79 D9 59 F3 73 D3 53 FB 7B DB 5B
  1006.     0D 8D 2D AD 05 85 25 A5 0F 8F 2F AF 07 87 27 A7
  1007.     CD 4D ED 6D C5 45 E5 65 CF 4F EF 6F C7 47 E7 67
  1008.     3D BD 1D 9D 35 B5 15 95 3F BF 1F 9F 37 B7 17 97
  1009.     FD 7D DD 5D F5 75 D5 55 FF 7F DF 5F F7 77 D7 57
  1010.     02 82 22 A2 0A 8A 2A AA 00 80 20 A0 08 88 28 A8
  1011.     C2 42 E2 62 CA 4A EA 6A C0 40 E0 60 C8 48 E8 68
  1012.     32 B2 12 92 3A BA 1A 9A 30 B0 10 90 38 B8 18 98
  1013.     F2 72 D2 52 FA 7A DA 5A F0 70 D0 50 F8 78 D8 58
  1014.      > exch get 256 div
  1015.    }
  1016.   bind
  1017.         % Use correct, per-plane screens for all CMYK devices.
  1018.   systemdict /setcolorscreen known processcolors 4 eq and
  1019.    { 3 copy 6 copy setcolorscreen }
  1020.    { setscreen }
  1021.   ifelse
  1022.   0 array cvx    % transfer -- Genoa CET won't accept a packed array!
  1023.   true        % strokeadjust
  1024.  }
  1025.  {        % Hi-res device, use 45 degree dot spot function.
  1026.     % According to information published by Hewlett-Packard,
  1027.     % they use a 60 line screen on 300 DPI printers and
  1028.     % an 85 line screen on 600 DPI printers.
  1029.     % 46 was suggested as a good frequency value for printers
  1030.     % between 200 and 400 DPI, so we use it for lower resolutions.
  1031.    systemdict /DITHERPPI known
  1032.     { DITHERPPI }
  1033.     { dup cvi 100 idiv 6 .min {null 46 46 60 60 60 85} exch get }
  1034.    ifelse
  1035.    1 index 4.01 div .min    % at least a 4x4 cell
  1036.    45
  1037.     % The following screen algorithm is used by permission of the author.
  1038.     { 1 add 180 mul cos 1 0.08 add mul exch 2 add 180 mul cos 
  1039.       1 0.08 sub mul add 2 div % (C) 1989 Berthold K.P. Horn
  1040.     }
  1041.    bind
  1042.     % Ghostscript currently doesn't use correct, per-plane halftones
  1043.     % unless setcolorscreen has been executed.  Since these are
  1044.     % computationally much more expensive than binary halftones,
  1045.     % we check to make sure they are really warranted, i.e., we have
  1046.     % a high-resolution CMYK device (i.e., not a display) with
  1047.     % fewer than 5 bits per plane (i.e., not a true-color device).
  1048.    4 -1 roll 150 ge
  1049.     { /setcolorscreen where
  1050.        { pop defaultdevice getdeviceprops .dicttomark
  1051.          dup dup dup /RedValues known exch /GreenValues known and
  1052.        exch /BlueValues known and
  1053.       { dup dup /RedValues get 32 lt
  1054.           exch /GreenValues get 32 lt and
  1055.           exch /BlueValues get 32 lt and
  1056.          { 3 copy 6 copy
  1057.     % For really high-quality screening on printers, we need to
  1058.     % give each plane its own screen angle.  Unfortunately,
  1059.     % this currently has very large space and time costs.
  1060.     %**************** Uncomment the next line for high-quality screening.
  1061.     %    { 45 90 15 75 } { 3 1 roll exch pop 12 3 roll } forall
  1062.            setcolorscreen
  1063.          }
  1064.          { setscreen
  1065.          }
  1066.         ifelse
  1067.       }
  1068.       { pop setscreen
  1069.       }
  1070.      ifelse
  1071.        }
  1072.        { setscreen
  1073.        }
  1074.       ifelse
  1075.     }
  1076.     { setscreen
  1077.     }
  1078.    ifelse
  1079.     % Set the transfer function to lighten up the grays.
  1080.     % We correct at the high end so that very light grays
  1081.     % don't disappear completely if they darken <1 screen pixel.
  1082.     % Parameter values closer to 1 are better for devices with
  1083.     % less dot spreading; lower values are better with more spreading.
  1084.     % The value 0.8 is a compromise that will probably please no one!
  1085.     { 0.8 exp dup dup 0.9375 gt exch 0.999 lt and    % > 15/16
  1086.        { .currentscreenlevels 1 sub    % tweak to avoid boundary
  1087.      1 exch div 1 exch sub .min
  1088.        }
  1089.       if
  1090.     }        % transfer
  1091.    false    % strokeadjust
  1092.     % Increase fill adjustment so that we effectively use Adobe's
  1093.     % any-part-of-pixel rule.
  1094.    0.5 .setfilladjust
  1095.  }
  1096. ifelse
  1097.   /setstrokeadjust where { pop setstrokeadjust } { pop } ifelse
  1098.   settransfer
  1099. initgraphics
  1100. % The interpreter relies on there being at least 2 entries
  1101. % on the graphics stack.  Establish the second one now.
  1102. gsave
  1103.  
  1104. % Define some control sequences as no-ops.
  1105. % This is a hack to get around problems
  1106. % in some common PostScript-generating applications.
  1107. % Note that <04> and <1a> are self-delimiting characters, like [.
  1108. <04> cvn { } def        % Apple job separator
  1109. %<0404> cvn { } def        % two of the same
  1110. <1b> cvn { } def        % MS Windows LaserJet 4 prologue
  1111. %<041b> cvn { } def        % MS Windows LaserJet 4 epilogue
  1112. <1a> cvn { } def        % MS-DOS EOF
  1113. (\001M) cvn { } def        % TBCP initiator
  1114. /@PJL                % H-P job control
  1115.  { currentfile //=string readline { pop } if
  1116.  } bind def
  1117.  
  1118. % If we want a "safer" system, disable some obvious ways to cause havoc.
  1119. SAFER not { (%END SAFER) .skipeof } if
  1120. /file
  1121.  { dup (r) eq 2 index (%pipe*) .stringmatch not and
  1122.     { file }
  1123.     { /invalidfileaccess signalerror }
  1124.    ifelse
  1125.  } bind odef
  1126. /renamefile { /invalidfileaccess signalerror } odef
  1127. /deletefile { /invalidfileaccess signalerror } odef
  1128. /putdeviceprops
  1129.  { counttomark
  1130.    dup 2 mod 0 eq { pop /rangecheck signalerror } if
  1131.    3 2 3 2 roll
  1132.     { dup index /OutputFile eq  
  1133.        { -2 roll 
  1134.          dup () ne { /putdeviceprops load /invalidfileaccess signalerror } if
  1135.          3 -1 roll
  1136.        }
  1137.        { pop
  1138.        }
  1139.       ifelse
  1140.     } for
  1141.    putdeviceprops
  1142.  } bind odef
  1143.  
  1144. %END SAFER
  1145.  
  1146. % Turn off array packing, since some PostScript code assumes that
  1147. % procedures are writable.
  1148. false setpacking
  1149.  
  1150. % Close up systemdict.
  1151. currentdict /.forceput undef        % remove temptation
  1152. currentdict /filterdict undef        % bound in where needed
  1153. end
  1154. WRITESYSTEMDICT not { systemdict readonly pop } if
  1155.  
  1156. (END INIT) VMDEBUG
  1157.  
  1158. % Establish local VM as the default.
  1159. false /setglobal where { pop setglobal } { .setglobal } ifelse
  1160. $error /.nosetlocal false put
  1161.  
  1162. % Clean up VM, and enable GC.
  1163. /vmreclaim where
  1164.  { pop NOGC not { 2 vmreclaim 0 vmreclaim } if
  1165.  } if
  1166.  
  1167. (END GC) VMDEBUG
  1168.  
  1169. % The interpreter will run the initial procedure (start).
  1170.