home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1996 February / PCWK0296.iso / sharewar / dos / inne / gs300ini / gs_init.ps < prev    next >
Encoding:
Text File  |  1994-08-02  |  32.2 KB  |  1,090 lines

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