home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1996 February / PCWK0296.iso / sharewar / dos / inne / gs300ini / gs_lev2.ps < prev    next >
Encoding:
Text File  |  1994-08-02  |  27.0 KB  |  946 lines
  1. %    Copyright (C) 1990, 1991, 1992, 1993, 1994 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 Level 2 functions.
  19. % When this is run, systemdict is still writable,
  20. % but everything defined here goes into level2dict.
  21.  
  22. level2dict begin
  23.  
  24. % ------ Miscellaneous ------ %
  25.  
  26. (<<) cvn /mark load def
  27. (>>) cvn /.dicttomark load odef
  28. /currentsystemparams { mark .currentsystemparams .dicttomark } odef
  29. /currentuserparams { mark .currentuserparams .dicttomark } odef
  30. /deviceinfo { currentdevice getdeviceprops .dicttomark } odef
  31. /languagelevel 2 def
  32. /realtime /usertime load def
  33. % When running in Level 2 mode, this interpreter is supposed to be
  34. % compatible with PostScript version 2010 (I think).
  35. /version (2010) def
  36.  
  37. % Choose an appropriate default binary object format.
  38. currentsystemparams dup
  39. /RealFormat get (IEEE) eq { 1 } { 3 } ifelse
  40. exch /ByteOrder get { 1 add } if
  41. setobjectformat
  42.  
  43. % ------ Virtual memory ------ %
  44.  
  45. /currentglobal /.currentglobal load def
  46. /gcheck /.gcheck load def
  47. /setglobal /.setglobal load def
  48. % We can make the global dictionaries very small, because they auto-expand.
  49. /globaldict currentdict /shareddict .knownget not { 4 dict } if def
  50. /GlobalFontDirectory currentdict SharedFontDirectory .knownget not { 4 dict } if def
  51.  
  52. % ------ IODevices ------ %
  53.  
  54. /currentdevparams { .getdevparams .dicttomark } odef
  55. /setdevparams { mark { } forall counttomark 2 add -1 roll .putdevparams } odef
  56.  
  57. % ------ Job control ------ %
  58.  
  59. serverdict begin
  60.  
  61. % We could protect the job information better, but we aren't attempting
  62. % (currently) to protect ourselves against maliciousness.
  63.  
  64. /.jobsave null def        % top-level save object
  65. /.jobsavelevel 0 def        % save depth of job (0 if .jobsave is null,
  66.                 % 1 otherwise)
  67. /.adminjob true def        % status of current unencapsulated job
  68.  
  69. /exitserver
  70.  { true exch startjob not { /exitserver /invalidaccess signalerror } if
  71.  } bind def
  72.  
  73. end        % serverdict
  74.  
  75. %**************** The definition of startjob is not complete yet, since
  76. % it doesn't clear the exec stack, doesn't reset stdin/stdout,
  77. % doesn't run the job under its own control, and doesn't reset
  78. % other aspects of the interpreter.
  79. /startjob
  80.  { vmstatus pop pop serverdict /.jobsavelevel get eq
  81.    1 index .checkpassword 0 gt and
  82.     { .checkpassword count 2 roll count 2 sub { pop } repeat
  83.       cleardictstack
  84.       serverdict /.jobsave get dup null eq { pop } { restore } ifelse
  85.       exch
  86.        {    % unencapsulated job
  87.      serverdict /.jobsave null put
  88.      serverdict /.jobsavelevel 0 put
  89.      serverdict /.adminjob 3 -1 roll 1 gt put
  90.        }
  91.        {    % encapsulated job
  92.      serverdict /.jobsave save put
  93.      serverdict /.jobsavelevel 1 put
  94.      pop
  95.        }
  96.       ifelse true
  97.     }
  98.     { pop pop false
  99.     }
  100.    ifelse
  101.  } odef
  102.  
  103. % ------ Compatibility ------ %
  104.  
  105. % In Level 2 mode, the following replace the definitions that gs_statd.ps
  106. % installs in statusdict and serverdict.
  107. % Note that statusdict must be allocated in local VM.
  108. % We don't bother with many of these yet, and the ones defined in terms
  109. % of currentsystemparams are cavalier about allocating a dictionary
  110. % in order to retrieve a single element from it....
  111.  
  112. .currentglobal false .setglobal 25 dict exch .setglobal begin
  113. currentsystemparams
  114.  
  115. /.dict1 { exch mark 3 1 roll .dicttomark } bind def
  116.  
  117. /buildtime 1 index /BuildTime get def
  118. /byteorder 1 index /ByteOrder get def
  119. /checkpassword { .checkpassword 0 gt } bind def
  120. /defaulttimeouts
  121.  { currentsystemparams dup
  122.    /JobTimeout .knownget not { 0 } if
  123.    exch /WaitTimeout .knownget not { 0 } if
  124.    currentpagedevice /ManualFeedTimeout .knownget not { 0 } if
  125.  } bind def
  126. dup /DoStartPage known
  127.  { /dostartpage { currentsystemparams /DoStartPage get } bind def
  128.    /setdostartpage { /DoStartPage .dict1 setsystemparams } bind def
  129.  } if
  130. dup /StartupMode known
  131.  { /dosysstart { currentsystemparams /StartupMode get 0 ne } bind def
  132.    /setdosysstart { { 1 } { 0 } ifelse /StartupMode .dict1 setsystemparams } bind def
  133.  } if
  134. %****** Setting jobname is supposed to set userparams.JobName, too.
  135. /jobname { currentuserparams /JobName get } bind def
  136. /jobtimeout { currentuserparams /JobTimeout get } bind def
  137. %manualfeed
  138. %manualfeedtimeout
  139. /margins { currentpagedevice /Margins get } bind def
  140. %pagecount
  141. %pagestackorder
  142. /printername
  143.  { currentsystemparams /PrinterName .knownget not { () } if exch copy
  144.  } bind def
  145. %/ramsize { currentsystemparams /RamSize get } bind def
  146. /realformat 1 index /RealFormat get def
  147. /setdefaulttimeouts
  148.  { exch mark /ManualFeedTimeout 3 -1 roll
  149.    /Policies mark /ManualFeedTimeout 0 .dicttomark
  150.    .dicttomark setpagedevice
  151.    /WaitTimeout exch mark /JobTimeout 5 2 roll .dicttomark setsystemparams
  152.  } bind def
  153. /setmargins { /Margins .dict1 setpagedevice } bind def
  154. %setpagestackorder
  155. dup /PrinterName known
  156.  { /setprintername { /PrinterName .dict1 setsystemparams } bind def
  157.  } if
  158. currentuserparams /WaitTimeout known
  159.  { /waittimeout { currentuserparams /WaitTimeout get } bind def
  160.  } if
  161.  
  162. /.setpagesize { 2 array astore /PageSize .dict1 setpagedevice } bind def
  163.  
  164. pop        % currentsystemparams
  165.  
  166. % Flag the current dictionary so it will be swapped when we
  167. % change language levels.  (See zmisc2.c for more information.)
  168. /statusdict currentdict def
  169.  
  170. currentdict end
  171. /statusdict exch def
  172.  
  173. % ------ Page devices ------ %
  174.  
  175. % The implementation of setpagedevice is quite complex.  Currently,
  176. % everything but the media matching algorithm is implemented here.
  177. %**************** Incomplete implementation, see NEWS.
  178.  
  179. % Define the parameters that require special action to merge into the
  180. % combined page device dictionary.  The procedures are called as follows:
  181. %    <merged> <key> <new_value> -proc- <merged> <key> <new_value'>
  182. /.mergespecial mark
  183.   /InputAttributes
  184.    { dup null eq
  185.       { pop null
  186.       }
  187.       { 3 copy pop .knownget
  188.      { dup null eq
  189.         { pop dup length dict }
  190.         { dup length 2 index length add dict copy }
  191.        ifelse
  192.      }
  193.      { dup length dict
  194.      }
  195.         ifelse copy readonly
  196.       }
  197.      ifelse
  198.    } bind
  199.   /OutputAttributes 1 index
  200.   /Policies
  201.     { 3 copy pop .knownget
  202.        { dup length 2 index length add dict copy }
  203.        { dup length dict }
  204.       ifelse copy readonly
  205.     } bind
  206. .dicttomark readonly def
  207.  
  208. % Define the keys used in input attribute matching.
  209. /.inputattrkeys [
  210.   /PageSize /MediaColor /MediaWeight /MediaType /InsertSheet
  211. ] readonly def
  212.  
  213. % Define the keys used in output attribute matching.
  214. /.outputattrkeys [
  215.   /OutputType
  216. ] readonly def
  217.  
  218. % Define the parameters that should not be presented to the device.
  219. % The procedures are called as follows:
  220. %    <merged> <key> <value> -proc-
  221. % The procedure leaves all its operands on the stack and returns
  222. % true iff the key/value pair should be presented to .putdeviceparams.
  223. /.presentspecial mark
  224.   /Name false
  225.   /OutputDevice false
  226.   /InputAttributes false
  227.   .inputattrkeys { pop { 2 index /InputAttributes get null eq } } forall
  228.   /OutputAttributes false
  229.   .outputattrkeys { pop { 2 index /OutputAttributes get null eq } } forall
  230.   /Install false
  231.   /BeginPage false
  232.   /EndPage false
  233.   /Policies false
  234. .dicttomark readonly def
  235.  
  236. % Define the required attributes of all page devices.
  237. % We don't include attributes such as PageSize, which all devices
  238. % are guaranteed to supply on their own.
  239. /.requiredattrs mark
  240.   /InputAttributes null
  241.   /OutputAttributes null
  242.   /Install {.callinstall} bind
  243.   /BeginPage {.callbeginpage} bind
  244.   /EndPage {.callendpage} bind
  245.   /Policies mark
  246.     /PolicyNotFound 1
  247.     /PageSize 0
  248.     /PolicyReport {pop} bind
  249.   .dicttomark readonly
  250. .dicttomark readonly def
  251.  
  252. % Define access to device defaults.
  253. /.defaultdevicename
  254.  { 0 .getdevice .devicename
  255.  } bind def
  256. /.defaultdeviceparams
  257.  { finddevice null .getdeviceparams
  258.  } bind def
  259.  
  260. % Select media (input or output).
  261. /.selectmedia        % <orig> <request> <merged> <failed>
  262.             %   (these are retained)
  263.             %   <attrdict> <attrkeys> <mediakey> .selectmedia
  264.  { 4 index 4 -1 roll 3 index .matchmedia
  265.     { 4 index 3 1 roll put pop
  266.     }
  267.     {    % Adobe's implementations have a "big hairy heuristic"
  268.     % to choose the set of keys to report as having failed the match.
  269.     % For the moment, we report any keys that are in the request
  270.     % and don't have the same value as in the original dictionary.
  271.       3 index exch undef
  272.        {    % Stack: <orig> <request> <merged> <failed> <attrkey>
  273.      3 index 1 index .knownget
  274.       { 5 index 2 index .knownget { ne } { pop true } ifelse }
  275.       { true }
  276.      ifelse        % Stack: ... <failed> <attrkey> <report>
  277.       { 2 copy /rangecheck put }
  278.      if pop
  279.        }
  280.       forall
  281.     }
  282.    ifelse
  283.  } bind def
  284.  
  285. % Apply Policies to any unprocessed failed requests.
  286. % As we process each request entry, we replace the error name
  287. % in the <failed> dictionary with the policy value,
  288. % and we remove the key from the <merged> dictionary.
  289. /.applypolicies        % <merged> <failed> .applypolicies <merged'> <failed'>
  290.  { 1 index /Policies get 1 index
  291.     { type /integertype eq
  292.        { pop        % already processed
  293.        }
  294.        { 2 copy .knownget not { 1 index /PolicyNotFound get } if
  295.             % Stack: <merged> <failed> <Policies> <key> <policy>
  296.      dup 1 ne
  297.       {    % Set errorinfo and signal a configurationerror.
  298.         % Note that we currently treat all Policy values other than 1
  299.         % the same as 0.
  300.         pop dup 4 index exch get 2 array astore
  301.         $error /errorinfo 3 -1 roll put
  302.         cleartomark
  303.         /setpagedevice load /configurationerror signalerror
  304.       }
  305.       {    % Ignore the failed request.
  306.         3 index 2 index 3 -1 roll put
  307.         3 index exch undef
  308.       }
  309.      ifelse
  310.        }
  311.       ifelse
  312.     }
  313.    forall pop
  314.  } bind def
  315.  
  316. % Try setting the device parameters from the merged request.
  317. /.trysetparams        % ... <merged> <(ignored)> <device> <Policies>
  318.             %   .trysetparams
  319.  { mark 4 index dup
  320.     {            % Stack: <merged> <key> <value>
  321.       .presentspecial 2 index .knownget
  322.        { exec { 3 -1 roll } { pop pop } ifelse }
  323.        { 3 -1 roll }
  324.       ifelse
  325.     }
  326.    forall pop
  327. DEBUG { (Putting.\n) print pstack flush } if
  328.    .putdeviceparams
  329. DEBUG { (Result of putting.\n) print pstack flush } if
  330.  } bind def
  331.  
  332. % Finally, define setpagedevice.
  333. /setpagedevice
  334.  {
  335.    mark exch currentpagedevice
  336.  
  337.         % Check whether we are changing OutputDevice;
  338.         % also handle the case where the current device
  339.         % is not a page device.
  340.         % Stack: mark <request> <current>
  341. DEBUG { (Checking.\n) print pstack flush } if
  342.  
  343.    dup /OutputDevice .knownget
  344.     {        % Current device is a page device.
  345.       2 index /OutputDevice .knownget
  346.        {    % A specific OutputDevice was requested.
  347.      2 copy eq
  348.       { pop pop null }
  349.       { exch pop }
  350.      ifelse
  351.        }
  352.        { pop null
  353.        }
  354.       ifelse
  355.     }
  356.     {        % Current device is not a page device.
  357.         % Use the default device.
  358.       1 index /OutputDevice .knownget not { .defaultdevicename } if
  359.     }
  360.    ifelse
  361.    dup null eq
  362.     { pop
  363.     }
  364.     { exch pop .defaultdeviceparams
  365.       counttomark 2 idiv .requiredattrs length add dict
  366.       .requiredattrs exch copy
  367.       begin counttomark 2 idiv { def } repeat pop currentdict end
  368.     }
  369.    ifelse
  370.  
  371.         % Merge the current and requested dictionaries.
  372.         % Stack: mark <request> <orig>
  373. DEBUG { (Merging.\n) print pstack flush } if
  374.  
  375.    exch 1 index dup length 2 index length add dict copy
  376.    dup 2 index
  377.     {        % stack: <orig> <request> <merged> <merged> <rkey> <rvalue>
  378.       .mergespecial 2 index .knownget { exec } if
  379.       put dup
  380.     }
  381.    forall pop
  382.  
  383.         % Select input and output media.
  384.         % Stack: mark <orig> <request> <merged>
  385. DEBUG { (Selecting.\n) print pstack flush } if
  386.  
  387.    0 dict    % <failed>
  388.    1 index /InputAttributes get .inputattrkeys (%MediaSource) cvn .selectmedia
  389.    1 index /OutputAttributes get .outputattrkeys (%MediaDestination) cvn .selectmedia
  390.    .applypolicies
  391.  
  392.         % Construct the new device, and attempt to set its attributes.
  393.         % Stack: mark <orig> <request> <merged> <failed>
  394. DEBUG { (Constructing.\n) print pstack flush } if
  395.  
  396.    currentdevice .devicename 2 index /OutputDevice get eq
  397.     { currentdevice }
  398.     { 1 index /OutputDevice get finddevice }
  399.    ifelse
  400.         %**************** We should copy the device here,
  401.         %**************** but since we can't close the old device,
  402.         %**************** we don't.  This is WRONG.
  403.     %****************copydevice
  404.    2 index /Policies get
  405.    .trysetparams
  406.    dup type /nametype eq
  407.     {        % The request failed.
  408.         % Stack: ... <failed> <device> <Policies> <mark>
  409.         %   <name> <value> ...
  410.       counttomark 4 add -1 roll
  411.       counttomark 2 idiv { dup 4 -2 roll put } repeat
  412.       exch pop 3 1 roll
  413.         % Stack: mark ... <merged> <failed> <device> <Policies>
  414.       4 2 roll .applypolicies 4 -2 roll
  415.       .trysetparams        % shouldn't fail!
  416.       dup type /booleantype ne
  417.        { 2 { counttomark 1 add 1 roll cleartomark } repeat
  418.          /setpagedevice load exch signalerror
  419.        }
  420.       if
  421.     }
  422.    if
  423.  
  424.         % The attempt succeeded.  Install the new device.
  425.         % Stack: mark ... <merged> <failed> <device> <eraseflag>
  426. DEBUG { (Installing.\n) print pstack flush } if
  427.  
  428.    pop 2 .endpage
  429.     { 1 true .outputpage
  430.       (>>setpagedevice, press <return> to continue<<\n) .confirm
  431.     }
  432.    if
  433.    .setdevice pop
  434.    1 index /Install .knownget { exec } if
  435.    erasepage initgraphics
  436.    1 index .setpagedevice .beginpage
  437.  
  438.         % Clean up, calling PolicyReport if needed.
  439.         % Stack: mark ... <merged> <failed>
  440. DEBUG { (Finishing.\n) print pstack flush } if
  441.  
  442.    dup length 0 ne
  443.     { 1 index /Policies get /PolicyReport get
  444.       counttomark 1 add 2 roll cleartomark
  445.       exec
  446.     }
  447.     { cleartomark
  448.     }
  449.    ifelse
  450.  
  451.  } odef
  452.  
  453. %**************** setpagedevice doesn't work well enough to use yet.
  454. /setpagedevice { pop } odef
  455. statusdict /.setpagesize undef
  456.  
  457. % ------ Painting ------ %
  458.  
  459. % A straightforward definition of execform that doesn't actually
  460. % do any caching.
  461. /execform
  462.  { dup /Implementation known not
  463.     { dup /FormType get 1 ne { /rangecheck signalerror } if
  464.       dup /Implementation null put readonly
  465.     } if
  466.    gsave dup /Matrix get concat
  467.    dup /BBox get aload pop
  468.    exch 3 index sub exch 2 index sub rectclip
  469.    dup /PaintProc get exec
  470.    grestore
  471.  } odef
  472.  
  473. /makepattern
  474.  { currentglobal
  475.     { false setglobal .buildpattern true setglobal }
  476.     { .buildpattern }
  477.    ifelse
  478.    exch dup length 1 add dict copy
  479.    dup /Implementation 4 -1 roll put
  480.    readonly
  481.  } odef
  482.  
  483. /setpattern
  484.  { currentcolorspace 0 get /Pattern ne
  485.     { [ /Pattern currentcolorspace ] setcolorspace } if
  486.    setcolor
  487.  } odef
  488.  
  489. % ------ Resources ------ %
  490.  
  491. (BEGIN RESOURCES) VMDEBUG
  492.  
  493. % We keep track of (global) instances with another entry in the resource
  494. % dictionary, an Instances dictionary.  For categories with implicit
  495. % instances, the values in Instances are the same as the keys;
  496. % for other categories, the values are [instance status size].
  497.  
  498. % Note that the dictionary that defines a resource category is stored
  499. % in global memory.  The PostScript manual says that each category must
  500. % manage global and local instances separately.  However, objects in
  501. % global memory can't reference objects in local memory.  This means
  502. % that the resource category dictionary, which would otherwise be the
  503. % obvious place to keep track of the instances, can't be used to keep
  504. % track of local instances.  Instead, we define a dictionary in local VM
  505. % called localinstancedict, in which the key is the category name and
  506. % the value is the analogue of Instances for local instances.
  507.  
  508. % We don't currently implement automatic resource unloading.
  509. % When we do, it should be hooked to the garbage collector.
  510.  
  511. currentglobal false setglobal systemdict begin
  512.   /localinstancedict 5 dict def
  513. end setglobal
  514. /.emptydict 0 dict readonly def
  515.  
  516. % Resource category dictionaries have the following keys (those marked with
  517. % * are optional):
  518. %    Defined in the Red Book:
  519. %        DefineResource
  520. %        UndefineResource
  521. %        FindResource
  522. %        ResourceStatus
  523. %        ResourceForAll
  524. %        Category
  525. %        *InstanceType
  526. %        *ResourceFileName
  527. %    Specific to our implementation:
  528. %        LocalInstances
  529. %            - LocalInstances <dict>
  530. %        GetInstance
  531. %            <key> GetInstance <instance> -true-
  532. %            <key> GetInstance -false-
  533. %        .CheckResource
  534. %            <value> .CheckResource <ok>
  535. %        .LoadResource
  536. %            <key> .LoadResource - (may give an error)
  537. %        .ResourceFile
  538. %            <key> .ResourceFile <file> -true-
  539. %            <key> .ResourceFile -false-
  540.  
  541. % Define the Category category, except for most of the procedures.
  542. % The dictionary we're about to create will become the Category
  543. % category definition dictionary.
  544.  
  545. 12 dict begin
  546. /Category /Category def
  547. /GetInstance
  548.     { Instances exch .knownget
  549.     } bind def
  550. /LocalInstances [] def
  551. /.CheckResource
  552.     { dup gcheck currentglobal and
  553.        { /DefineResource /FindResource /ResourceForAll /ResourceStatus
  554.          /UndefineResource }
  555.        { 2 index exch known and }
  556.       forall exch pop
  557.     } bind def
  558. /DefineResource
  559.     { dup .CheckResource
  560.        { dup /Category 3 index cvlit .growput readonly
  561.          dup [ exch 0 -1 ] exch
  562.          Instances 4 2 roll put
  563.        }
  564.        { /typecheck signalerror
  565.        }
  566.       ifelse
  567.     } bind def
  568. /FindResource        % (redefined below)
  569.     { Instances exch get 0 get
  570.     } bind def
  571. /Instances 25 dict def
  572. /InstanceType /dicttype def
  573.  
  574. Instances /Category [currentdict 0 -1] put
  575. Instances end begin    % so we can name the Category definition
  576.  
  577. (END CATEGORY) VMDEBUG
  578.  
  579. % Define the resource operators.  I don't see how we can possibly restore
  580. % the stacks after an error, since the procedure may have popped and
  581. % pushed elements arbitrarily....
  582.  
  583. mark
  584. /defineresource
  585.     { /Category findresource dup begin
  586.       /InstanceType known
  587.        { dup type InstanceType ne
  588.          { dup type /packedarraytype eq InstanceType /arraytype eq and
  589.         not { /typecheck signalerror } if } if } if
  590.       /DefineResource load stopped end { stop } if
  591.     }
  592. /findresource
  593.     { dup /Category eq
  594.        { pop //Category 0 get } { /Category findresource } ifelse
  595.       begin
  596.       /FindResource load stopped end { stop } if
  597.     }
  598. /resourceforall
  599.     { /Category findresource begin
  600.       /ResourceForAll load stopped end { stop } if
  601.     }
  602. /resourcestatus
  603.     { /Category findresource begin
  604.       /ResourceStatus load stopped end { stop } if
  605.     }
  606. /undefineresource
  607.     { /Category findresource begin
  608.       /UndefineResource load stopped end { stop } if
  609.     }
  610. end        % Instances
  611. counttomark 2 idiv { bind odef } repeat pop
  612.  
  613. % Define the Generic category.
  614.  
  615. /Generic mark
  616.  
  617. /Instances 0 dict
  618. /LocalInstances        % not a standard entry -- a shared utility
  619.     { localinstancedict Category .knownget not { //.emptydict } if
  620.     } bind
  621. /GetInstance        % not a standard entry -- a shared utility
  622.     { currentglobal
  623.        { Instances exch .knownget }
  624.        { LocalInstances 1 index .knownget
  625.           { exch pop true }
  626.           { Instances exch .knownget }
  627.          ifelse
  628.        }
  629.       ifelse
  630.     } bind
  631. /.CheckResource        % not a standard entry
  632.     { pop true
  633.     } bind
  634. /DefineResource
  635.     { dup .CheckResource
  636.        { { readonly } stopped pop
  637.          dup [ exch 0 -1 ] exch
  638.          currentglobal
  639.           { 2 index UndefineResource    % remove local def if any
  640.         Instances
  641.           }
  642.           { LocalInstances dup //.emptydict eq
  643.              { pop 3 dict localinstancedict Category 2 index put
  644.          }
  645.         if
  646.           }
  647.          ifelse
  648.          4 2 roll .growput
  649.        }
  650.        { /typecheck signalerror
  651.        }
  652.       ifelse
  653.     } bind
  654. /FindResource
  655.     { dup ResourceStatus
  656.        { pop 1 gt        % not in VM
  657.           { dup vmstatus pop exch pop exch
  658.         .LoadResource
  659.         vmstatus pop exch pop exch sub
  660.         1 index GetInstance not
  661.          { pop /undefinedresource signalerror }    % didn't load
  662.         if
  663.         dup 1 1 put
  664.         2 3 -1 roll put
  665.           }
  666.          if
  667.          GetInstance pop        % can't fail
  668.          0 get
  669.        }
  670.        { /undefinedresource signalerror
  671.        }
  672.       ifelse
  673.     } bind
  674. /.LoadResource        % not a standard entry; may fail
  675.     { dup .ResourceFile
  676.        { exch pop currentglobal
  677.           { run }
  678.           { true setglobal { run } stopped false setglobal { stop } if }
  679.          ifelse
  680.        }
  681.        { /undefinedresource signalerror
  682.        }
  683.      ifelse
  684.     } bind
  685. /.ResourceFile        % not a standard entry; returns <file> true or false
  686.     { currentdict /ResourceFileName known
  687.        { mark exch 100 string { ResourceFileName }
  688.          stopped
  689.           { cleartomark false }
  690.           { exch pop findlibfile
  691.          { exch pop true }
  692.          { pop false }
  693.         ifelse
  694.           }
  695.          ifelse
  696.        }
  697.        { pop false }
  698.       ifelse
  699.     } bind
  700. /ResourceForAll
  701.     { % **************** Doesn't present instance groups in
  702.       % **************** the correct order yet.
  703.       % We construct a new procedure so we don't have to use
  704.       % static resources to hold the iteration state.
  705.       3 packedarray        % template, proc, scratch
  706.       { exch pop    % stack contains: key, {template, proc, scratch}
  707.         2 copy 0 get .stringmatch
  708.          { 1 index type dup /stringtype eq exch /nametype eq or
  709.         { 2 copy 2 get cvs
  710.           exch 1 get 3 -1 roll pop
  711.         }
  712.         { 1 get
  713.         }
  714.            ifelse exec
  715.          }
  716.          { pop pop
  717.          }
  718.         ifelse
  719.       } /exec cvx 3 packedarray cvx
  720.       currentglobal LocalInstances length 0 eq or not
  721.        {        % We must do local instances, and do them first.
  722.          /forall cvx 1 index 2 packedarray cvx
  723.          LocalInstances 3 1 roll exec
  724.        }
  725.       if
  726.       Instances exch forall
  727.     } bind
  728. /ResourceStatus
  729.     { dup GetInstance
  730.        { exch pop dup 1 get exch 2 get true }
  731.        { .ResourceFile
  732.           { closefile 2 -1 true }
  733.           { false }
  734.          ifelse
  735.        }
  736.       ifelse
  737.     } bind
  738. /UndefineResource
  739.     {  { dup 2 index .knownget
  740.           { dup 1 get 1 ge
  741.          { dup 0 null put 1 2 put pop pop }
  742.          { pop exch undef }
  743.         ifelse
  744.           }
  745.           { pop pop
  746.           }
  747.          ifelse
  748.        }
  749.       currentglobal
  750.        { 2 copy Instances exch exec
  751.        }
  752.       if LocalInstances exch exec
  753.     } bind
  754.  
  755. % We're still running in Level 1 mode, so dictionaries won't expand.
  756. % Leave room for the /Category entry.
  757. /Category null
  758.  
  759. .dicttomark
  760. /Category defineresource pop
  761.  
  762. % Fill in the rest of the Category category.
  763. /Category /Category findresource dup
  764. /Generic /Category findresource begin
  765.  { /FindResource /ResourceStatus /ResourceForAll /.ResourceFile }
  766.  { dup load put dup } forall
  767. pop readonly pop end
  768.  
  769. (END GENERIC) VMDEBUG
  770.  
  771. % Define the fixed categories.
  772.  
  773. mark
  774.     % Things other than types
  775.  /ColorSpaceFamily
  776.    {/CIEBasedA /CIEBasedABC /DeviceCMYK /DeviceGray /DeviceRGB
  777.     /Indexed /Pattern /Separation
  778.    }
  779.  /Emulator
  780.    {}
  781.  /Filter
  782.    mark systemdict
  783.      { pop =string cvs (.filter_) anchorsearch
  784.         { pop cvn }
  785.         { pop }
  786.        ifelse
  787.      }
  788.     forall
  789.    .packtomark
  790.  /IODevice
  791.     % Loop until the .getiodevice gets a rangecheck.
  792.    errordict /rangecheck 2 copy get
  793.    errordict /rangecheck { pop stop } put    % pop the command
  794.    mark 0 { {dup .getiodevice exch 1 add} loop} stopped pop pop .packtomark
  795.    4 1 roll put
  796.    .clearerror
  797.     % Types
  798.  /ColorRenderingType
  799.    {1}
  800.  /FMapType
  801.    {2 3 4 5 6 7 8}
  802.  /FontType
  803.    [/.buildfont0 where {pop 0} if 1 3]
  804.  /FormType
  805.    {1}
  806.  /HalftoneType
  807.    {1 2 3 4 5}
  808.  /ImageType
  809.    {1}
  810.  /PatternType
  811.    {1}
  812. counttomark 2 idiv
  813.  { 8 dict begin        % 5 procedures, Category, Instances, LocalInstances
  814.    /DefineResource
  815.     { /invalidaccess signalerror } bind def
  816.    /FindResource
  817.     { Instances exch get } bind def
  818.    /LocalInstances    % used by ResourceForAll
  819.     [] def
  820.    /ResourceForAll
  821.     /Generic /Category findresource /ResourceForAll get def
  822.    /ResourceStatus
  823.     { Instances exch known { 0 0 true } { false } ifelse } bind def
  824.    /UndefineResource
  825.     { /invalidaccess signalerror } bind def
  826.    dup length dict dup begin exch { dup def } forall end readonly
  827.    /Instances exch def
  828.    currentdict end /Category defineresource pop
  829.  } repeat pop
  830.  
  831. (END FIXED) VMDEBUG
  832.  
  833. % Define the other built-in categories.
  834.  
  835. /.definecategory    % <name> -mark- <key1> ... <valuen> .definecategory -
  836.  { counttomark 2 idiv 2 add        % Instances, Category
  837.    /Generic /Category findresource dup maxlength 3 -1 roll add dict copy begin
  838.    counttomark 2 idiv { def } repeat pop    % pop the mark
  839.    currentdict /Instances known not { /Instances 10 dict def } if
  840.    currentdict end /Category defineresource pop
  841.  } bind def
  842.  
  843. /ColorRendering mark /InstanceType /dicttype .definecategory
  844. /ColorSpace mark /InstanceType /arraytype .definecategory
  845. /Form mark /InstanceType /dicttype .definecategory
  846. /Halftone mark /InstanceType /dicttype .definecategory
  847. /Pattern mark /InstanceType /dicttype .definecategory
  848. /ProcSet mark /InstanceType /dicttype .definecategory
  849.  
  850. (END MISC) VMDEBUG
  851.  
  852. % Define the Encoding category.
  853.  
  854. /Encoding mark /InstanceType /arraytype
  855.  
  856. % Handle lazily loaded encodings that aren't loaded yet.
  857.  
  858. /Instances mark
  859.   .encodingdict
  860.    { length 256 eq { pop } { [null 2 -1] } ifelse
  861.    } forall
  862. .dicttomark
  863.  
  864. /.ResourceFileDict mark
  865.   .encodingdict
  866.    { dup length 256 eq { pop pop } { 0 get } ifelse
  867.    } forall
  868. .dicttomark
  869.  
  870. /ResourceFileName
  871.  { exch dup .ResourceFileDict exch .knownget
  872.     { exch pop exch copy }
  873.     { exch pop /undefinedresource signalerror }
  874.    ifelse
  875.  } bind
  876.  
  877. .definecategory            % Encoding
  878.  
  879. /.findencoding { /Encoding findresource } bind def
  880. /findencoding /.findencoding load odef
  881. /.defineencoding
  882.  { 2 copy /Encoding defineresource pop
  883.    //.encodingdict 3 1 roll put
  884.  } bind def
  885.  
  886. .encodingdict
  887.  { dup length 256 eq
  888.     { /Encoding defineresource pop }
  889.     { pop pop }
  890.    ifelse
  891.  }
  892. forall
  893.  
  894. (END ENCODING) VMDEBUG
  895.  
  896. % Define the Font category.
  897.  
  898. /Font mark /InstanceType /dicttype
  899.  
  900. /DefineResource
  901.     { 2 copy //definefont exch pop
  902.       /Generic /Category findresource /DefineResource get exec
  903.     } bind
  904. /.LoadResource
  905.     { //findfont pop
  906.     } bind
  907.  
  908. .definecategory            % Font
  909.  
  910. % Make entries for fonts already loaded.
  911. /.resourceFromFontmap
  912.  { /Font /Category findresource begin
  913.    Fontmap
  914.     { pop dup Instances exch known
  915.        { pop }
  916.        { [null 2 -1] Instances 3 1 roll .growput }
  917.       ifelse
  918.     }
  919.    forall
  920.    end
  921.  } bind def
  922. .resourceFromFontmap
  923. /Font /Category findresource begin
  924. FontDirectory
  925.  { dup .gcheck { Instances } { LocalInstances } ifelse
  926.    3 1 roll [exch 0 -1] .growput
  927.  }
  928. forall end
  929.  
  930. % Redefine font "operators".
  931. /.loadFontmap { //.loadFontmap exec .resourceFromFontmap } def
  932.  
  933. /definefont
  934.     { /Font defineresource } bind odef
  935. %**************** Don't redefine findfont yet.
  936. %/findfont
  937. %    { /Font findresource } bind def    % Must be a procedure, not an operator
  938. /undefinefont
  939.     { /Font undefineresource } bind odef
  940.  
  941. % Remove initialization utilities.
  942. currentdict /.definecategory undef
  943. currentdict /.emptydict undef
  944.  
  945. end    % level2dict
  946.