harvey/sys/lib/ghostscript/gs_lev2.ps

%    Copyright (C) 1990, 2000 Aladdin Enterprises.  All rights reserved.
% 
% This file is part of AFPL Ghostscript.
% 
% AFPL Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author or
% distributor accepts any responsibility for the consequences of using it, or
% for whether it serves any particular purpose or works at all, unless he or
% she says so in writing.  Refer to the Aladdin Free Public License (the
% "License") for full details.
% 
% Every copy of AFPL Ghostscript must include a copy of the License, normally
% in a plain ASCII text file named PUBLIC.  The License grants you the right
% to copy, modify and redistribute AFPL Ghostscript, but only under certain
% conditions described in the License.  Among other things, the License
% requires that the copyright notice and this notice be preserved on all
% copies.

% $Id: gs_lev2.ps,v 1.7.2.2 2002/01/25 06:33:09 rayjj Exp $
% Initialization file for Level 2 functions.
% When this is run, systemdict is still writable,
% but (almost) everything defined here goes into level2dict.

level2dict begin

% ------ System and user parameters ------ %

% User parameters must obey save/restore, and must also be maintained
% per-context.  We implement the former, and some of the latter, here
% with PostScript code.  NOTE: our implementation assumes that user
% parameters change only as a result of setuserparams -- that there are
% no user parameters that are ever changed dynamically by the interpreter
% (although the interpreter may adjust the value presented to setuserparams)
%
% There are two types of user parameters: those which are actually
% maintained in the interpreter, and those which exist only at the
% PostScript level.  We maintain the current state of both types in
% a read-only local dictionary named userparams, defined in systemdict.
% In a multi-context system, each context has its own copy of this
% dictionary.  In addition, there is a constant dictionary named
% psuserparams where each key is the name of a user parameter that exists
% only in PostScript and the value is a procedure to check that the value
% is legal: setuserparams uses this for checking the values.
% setuserparams updates userparams explicitly, in addition to setting
% any user parameters in the interpreter; thus we can use userparams
% to reset those parameters after a restore or a context switch.
% NOTE: the name userparams is known to the interpreter, and in fact
% the interpreter creates the userparams dictionary.

% Check parameters that are managed at the PostScript level.
/.checkparamtype {		% <newvalue> <type> .checkparamtype <bool>
  exch type eq
} .bind def
/.checksetparams {		% <newdict> <opname> <checkdict>
				%   .checksetparams <newdict>
  2 index {
		% Stack: newdict opname checkdict key newvalue
    3 copy 3 1 roll .knownget {
      exec not {
	pop pop pop load /typecheck signalerror
      } if
      dup type /stringtype eq {
	dup rcheck not {
	  pop pop pop load /invalidaccess signalerror
	} if
      } if
    } {
      pop
    } ifelse pop pop
  } forall pop pop
} .bind def	% not odef, shouldn't reset stacks

% currentuser/systemparams creates and returns a dictionary in the
% current VM.  The easiest way to make this work is to copy any composite
% PostScript-level parameters to global VM.  Currently, the only such
% parameters are strings.  In fact, we always copy string parameters,
% so that we can be sure the contents won't be changed.
/.copyparam {			% <value> .copyparam <value'>
  dup type /stringtype eq {
    .currentglobal true .setglobal
    1 index length string exch .setglobal
    copy readonly
  } if
} .bind def

% Some user parameters are managed entirely at the PostScript level.
% We take care of that here.
systemdict begin
/psuserparams 48 dict def
/getuserparam {			% <name> getuserparam <value>
  /userparams .systemvar 1 index get exch pop
} odef
% Fill in userparams (created by the interpreter) with current values.
mark .currentuserparams
counttomark 2 idiv {
  userparams 3 1 roll put
} repeat pop
/.definepsuserparam {		% <name> <value> .definepsuserparam -
  psuserparams 3 copy pop
  type cvlit /.checkparamtype cvx 2 packedarray cvx put
  userparams 3 1 roll put
} .bind def
end
/currentuserparams {		% - currentuserparams <dict>
  /userparams .systemvar dup length dict .copydict
} odef
/setuserparams {		% <dict> setuserparams -
	% Check that we will be able to set the PostScript-level
	% user parameters.
  /setuserparams /psuserparams .systemvar .checksetparams
	% Set the C-level user params.  If this succeeds, we know that
	% the password check succeeded.
  dup .setuserparams
	% Now set the PostScript-level params.
	% The interpreter may have adjusted the values of some of the
	% parameters, so we have to read them back.
  dup {
    /userparams .systemvar 2 index known {
      psuserparams 2 index known not {
	pop dup .getuserparam
      } if
      .copyparam
      /userparams .systemvar 3 1 roll .forceput  % userparams is read-only
    } {
      pop pop
    } ifelse
  } forall
	% A context switch might have occurred during the above loop,
	% causing the interpreter-level parameters to be reset.
	% Set them again to the new values.  From here on, we are safe,
	% since a context switch will consult userparams.
  .setuserparams
} .bind odef
% Initialize user parameters managed here.
/JobName () .definepsuserparam

% Restore must restore the user parameters.
% (Since userparams is in local VM, save takes care of saving them.)
/restore {		% <save> restore -
  //restore /userparams .systemvar .setuserparams
} .bind odef

% The pssystemparams dictionary holds some system parameters that
% are managed entirely at the PostScript level.
systemdict begin
currentdict /pssystemparams known not {
  /pssystemparams 40 dict readonly def
} if
/getsystemparam {		% <name> getsystemparam <value>
  //pssystemparams 1 index .knownget { exch pop } { .getsystemparam } ifelse
} odef
end
/currentsystemparams {		% - currentsystemparams <dict>
  mark .currentsystemparams //pssystemparams { } forall .dicttomark
} odef
/setsystemparams {		% <dict> setsystemparams -
	% Check that we will be able to set the PostScript-level
	% system parameters.
   /SAFETY .systemvar /safe get {
     % SAFER mode disallows some changes
     [ /GenericResourceDir /FontResourceDir /GenericResourcePathSep ] {
       2 copy .knownget {
	 exch //pssystemparams exch .knownget {
           ne { /setsystemparams /invalidaccess signalerror } if
         } {
           pop
         } ifelse
       } {
         pop
       } ifelse
     } forall
   } if
   /setsystemparams //pssystemparams mark exch {
     type cvlit /.checkparamtype cvx 2 packedarray cvx
   } forall .dicttomark .checksetparams
	% Set the C-level system params.  If this succeeds, we know that
	% the password check succeeded.
   dup .setsystemparams
	% Now set the PostScript-level params.  We must copy local strings
	% into global VM.
   dup
    { //pssystemparams 2 index known
       {		% Stack: key newvalue
	 .copyparam
	 //pssystemparams 3 1 roll .forceput	% pssystemparams is read-only
       }
       { pop pop
       }
      ifelse
    }
   forall pop
} .bind odef

% Initialize the passwords.
% NOTE: the names StartJobPassword and SystemParamsPassword are known to
% the interpreter, and must be bound to noaccess strings.
% The length of these strings must be max_password (iutil2.h) + 1.
/StartJobPassword 65 string noaccess def
/SystemParamsPassword 65 string noaccess def

% Redefine cache parameter setting to interact properly with userparams.
/setcachelimit {
  mark /MaxFontItem 2 index .dicttomark setuserparams pop
} .bind odef
/setcacheparams {
	% The MaxFontCache parameter is a system parameter, which we might
	% not be able to set.  Fortunately, this doesn't matter, because
	% system parameters don't have to be synchronized between this code
	% and the VM.
  counttomark 1 add copy setcacheparams
  currentcacheparams	% mark size lower upper
    3 -1 roll pop
    /MinFontCompress 3 1 roll
    /MaxFontItem exch
  .dicttomark setuserparams
  cleartomark
} .bind odef

% Add bogus user and system parameters to satisfy badly written PostScript
% programs that incorrectly assume the existence of all the parameters
% listed in Appendix C of the Red Book.  Note that some of these may become
% real parameters later: code near the end of gs_init.ps takes care of
% removing any such parameters from ps{user,system}params.

% psuserparams
  /MaxFormItem 100000 .definepsuserparam
  /MaxPatternItem 20000 .definepsuserparam
  /MaxScreenItem 48000 .definepsuserparam
  /MaxUPathItem 5000 .definepsuserparam

% File Access Permission parameters
  .currentglobal true .setglobal
  /.checkFilePermitparams {
    type /arraytype eq {
      currentuserparams /LockFilePermissions get {
        5 { pop } repeat /setuserparams /invalidaccess signalerror
      }
      if
    } {
      5 { pop } repeat /setuserparams /typecheck signalerror
    }
    ifelse
    true
  } .bind def
% Initialize the File Permission access control to wide open
% These will only be accessed via current/set userparams.
% Values are a string containing multiple nul terminated path strings
  /PermitFileReading dup [ (*) ] .definepsuserparam
    psuserparams exch /.checkFilePermitparams load put
  /PermitFileWriting dup [ (*) ] .definepsuserparam
    psuserparams exch /.checkFilePermitparams load put
  /PermitFileControl dup [ (*) ] .definepsuserparam
    psuserparams exch /.checkFilePermitparams load put
  .setglobal

pssystemparams begin
  /CurDisplayList 0 .forcedef
  /CurFormCache 0 .forcedef
  /CurOutlineCache 0 .forcedef
  /CurPatternCache 0 .forcedef
  /CurUPathCache 0 .forcedef
  /CurScreenStorage 0 .forcedef
  /CurSourceList 0 .forcedef
  /DoPrintErrors false .forcedef
  /MaxDisplayList 140000 .forcedef
  /MaxFormCache 100000 .forcedef
  /MaxOutlineCache 65000 .forcedef
  /MaxPatternCache 100000 .forcedef
  /MaxUPathCache 300000 .forcedef
  /MaxScreenStorage 84000 .forcedef
  /MaxSourceList 25000 .forcedef
  /RamSize 4194304 .forcedef
end

% Define the procedures for handling comment scanning.  The names
% %ProcessComment and %ProcessDSCComment are known to the interpreter.
% These procedures take the file and comment string and file as operands.
/.checkprocesscomment {
  dup null eq {
    pop true
  } {
    dup xcheck {
      type dup /arraytype eq exch /packedarraytype eq or
    } {
      pop false
    } ifelse
  } ifelse
} .bind def
/ProcessComment null .definepsuserparam
psuserparams /ProcessComment {.checkprocesscomment} put
(%ProcessComment) cvn {
  /ProcessComment getuserparam
  dup null eq { pop pop pop } { exec } ifelse
} bind def
/ProcessDSCComment null .definepsuserparam
psuserparams /ProcessDSCComment {.checkprocesscomment} put
(%ProcessDSCComment) cvn {
  /ProcessDSCComment getuserparam
  dup null eq { pop pop pop } { exec } ifelse
} bind def

% ------ Miscellaneous ------ %

(<<) cvn			% - << -mark-
  /mark load def
(>>) cvn			% -mark- <key1> <value1> ... >> <dict>
  /.dicttomark load def
/languagelevel 2 def
% When running in Level 2 mode, this interpreter is supposed to be
% compatible with Adobe version 2017.
/version (2017) readonly def

% If binary tokens are supported by this interpreter,
% set an appropriate default binary object format.
/setobjectformat where
 { pop
   /RealFormat getsystemparam (IEEE) eq { 1 } { 3 } ifelse
   /ByteOrder getsystemparam { 1 add } if
   setobjectformat
 } if

% Aldus Freehand versions 2.x check for the presence of the
% setcolor operator, and if it is missing, substitute a procedure.
% Unfortunately, the procedure takes different parameters from
% the operator.  As a result, files produced by this application
% cause an error if the setcolor operator is actually defined
% and 'bind' is ever used.  Aldus fixed this bug in Freehand 3.0,
% but there are a lot of files created by the older versions
% still floating around.  Therefore, at Adobe's suggestion,
% we implement the following dreadful hack in the 'where' operator:
%      If the key is /setcolor, and
%        there is a dictionary named FreeHandDict, and
%        currentdict is that dictionary,
%      then "where" consults only that dictionary and not any other
%        dictionaries on the dictionary stack.
.wheredict /setcolor {
  /FreeHandDict .where {
    /FreeHandDict get currentdict eq {
      pop currentdict /setcolor known { currentdict true } { false } ifelse
    } {
      .where
    } ifelse
  } {
    .where
  } ifelse
} bind put

% ------ Virtual memory ------ %

/currentglobal			% - currentglobal <bool>
  /currentshared load def
/gcheck				% <obj> gcheck <bool>
  /scheck load def
/setglobal			% <bool> setglobal -
  /setshared load def
% We can make the global dictionaries very small, because they auto-expand.
/globaldict currentdict /shareddict .knownget not { 4 dict } if def
/GlobalFontDirectory SharedFontDirectory def

% VMReclaim and VMThreshold are user parameters.
/setvmthreshold {		% <int> setvmthreshold -
  mark /VMThreshold 2 index .dicttomark setuserparams pop
} odef
/vmreclaim {			% <int> vmreclaim -
  dup 0 gt {
    .vmreclaim
  } {
    mark /VMReclaim 2 index .dicttomark setuserparams pop
  } ifelse
} odef
-1 setvmthreshold

% ------ IODevices ------ %

/.getdevparams where {
  pop /currentdevparams {	% <iodevice> currentdevparams <dict>
    .getdevparams .dicttomark
  } odef
} if
/.putdevparams where {
  pop /setdevparams {		% <iodevice> <dict> setdevparams -
    mark 1 index { } forall counttomark 2 add index
    .putdevparams pop pop
  } odef
} if

% ------ Job control ------ %

serverdict begin

% We could protect the job information better, but we aren't attempting
% (currently) to protect ourselves against maliciousness.

/.jobsave null def		% top-level save object
/.jobsavelevel 0 def		% save depth of job (0 if .jobsave is null,
				% 1 otherwise)
/.adminjob true def		% status of current unencapsulated job

end		% serverdict

% Because there may be objects on the e-stack created since the job save,
% we have to clear the e-stack before doing the end-of-job restore.
% We do this by executing a 2 .stop, which is caught by the 2 .stopped
% in .runexec; we leave on the o-stack a procedure to execute aftewards.
%
%**************** The definition of startjob is not complete yet, since
% it doesn't reset stdin/stdout.
/.startnewjob {			% <exit_bool> <password_level>
				%   .startnewjob -
    serverdict /.jobsave get dup null eq { pop } { restore } ifelse
    exch {
			% Unencapsulated job
      serverdict /.jobsave null put
      serverdict /.jobsavelevel 0 put
      serverdict /.adminjob 3 -1 roll 1 gt put
		% The Adobe documentation doesn't say what happens to the
		% graphics state stack in this case, but an experiment
		% produced results suggesting that a grestoreall occurs.
      grestoreall
    } {
			% Encapsulated job
      pop
      serverdict /.jobsave save put
      serverdict /.jobsavelevel 1 put
    } ifelse
		% Reset the interpreter state.
  clear cleardictstack
  initgraphics
  false setglobal
} bind def
/.startjob {			% <exit_bool> <password> <finish_proc>
				%   .startjob <ok_bool>
  vmstatus pop pop serverdict /.jobsavelevel get eq
  2 index .checkpassword 0 gt and {
    exch .checkpassword exch count 3 roll count 3 sub { pop } repeat
    cleardictstack
		% Reset the e-stack back to the 2 .stopped in .runexec,
		% passing the finish_proc to be executed afterwards.
    2 .stop
  } {		% Password check failed
    pop pop pop false
  } ifelse
} odef
/startjob {			% <exit_bool> <password> startjob <ok_bool>
	% This is a hack.  We really need some way to indicate explicitly
	% to the interpreter that we are under control of a job server.
  .userdict /quit /stop load put
  { .startnewjob true } .startjob
} odef

systemdict begin
/quit {				% - quit -
  //systemdict begin serverdict /.jobsave get null eq
   { end //quit }
   { /quit load /invalidaccess /signalerror load end exec }
  ifelse
} bind odef
end

% We would like to define exitserver as a procedure, using the code
% that the Red Book says is equivalent to it.  However, since startjob
% resets the exec stack, we can't do this, because control would never
% proceed past the call on startjob if the exitserver is successful.
% Instead, we need to construct exitserver out of pieces of startjob.

serverdict begin

/exitserver {			% <password> exitserver -
  true exch { .startnewjob } .startjob not {
    /exitserver /invalidaccess signalerror
  } if
} bind def

end		% serverdict

% ------ Compatibility ------ %

% In Level 2 mode, the following replace the definitions that gs_statd.ps
% installs in statusdict and serverdict.
% Note that statusdict must be allocated in local VM.
% We don't bother with many of these yet.

/.dict1 { exch mark 3 1 roll .dicttomark } bind def

currentglobal false setglobal 25 dict exch setglobal begin
currentsystemparams

% The following do not depend on the presence of setpagedevice.
/buildtime 1 index /BuildTime get def
/byteorder 1 index /ByteOrder get def
/checkpassword { .checkpassword 0 gt } bind def
dup /DoStartPage known
 { /dostartpage { /DoStartPage getsystemparam } bind def
   /setdostartpage { /DoStartPage .dict1 setsystemparams } bind def
 } if
dup /StartupMode known
 { /dosysstart { /StartupMode getsystemparam 0 ne } bind def
   /setdosysstart { { 1 } { 0 } ifelse /StartupMode .dict1 setsystemparams } bind def
 } if
%****** Setting jobname is supposed to set userparams.JobName, too.
/jobname { /JobName getuserparam } bind def
/jobtimeout { /JobTimeout getuserparam } bind def
/ramsize { /RamSize getsystemparam } bind def
/realformat 1 index /RealFormat get def
dup /PrinterName known
 { /setprintername { /PrinterName .dict1 setsystemparams } bind def
 } if
/printername
 { currentsystemparams /PrinterName .knownget not { () } if exch copy
 } bind def
currentuserparams /WaitTimeout known
 { /waittimeout { /WaitTimeout getuserparam } bind def
 } if

% The following do require setpagedevice.
/.setpagedevice where { pop } { (%END PAGEDEVICE) .skipeof } ifelse
/defaulttimeouts
 { currentsystemparams dup
   /JobTimeout .knownget not { 0 } if
   exch /WaitTimeout .knownget not { 0 } if
   currentpagedevice /ManualFeedTimeout .knownget not { 0 } if
 } bind def
/margins
 { currentpagedevice /Margins .knownget { exch } { [0 0] } ifelse
 } bind def
/pagemargin
 { currentpagedevice /PageOffset .knownget { 0 get } { 0 } ifelse
 } bind def
/pageparams
 { currentpagedevice
   dup /Orientation .knownget { 1 and ORIENT1 { 1 xor } if } { 0 } ifelse exch
   dup /PageSize get aload pop 3 index 0 ne { exch } if 3 2 roll
   /PageOffset .knownget { 0 get } { 0 } ifelse 4 -1 roll
 } bind def
/setdefaulttimeouts
 { exch mark /ManualFeedTimeout 3 -1 roll
   /Policies mark /ManualFeedTimeout 1 .dicttomark
   .dicttomark setpagedevice
   /WaitTimeout exch mark /JobTimeout 5 2 roll .dicttomark setsystemparams
 } bind def
/.setpagesize { 2 array astore /PageSize .dict1 setpagedevice } bind def
/setduplexmode { /Duplex .dict1 setpagedevice } bind def
/setmargins
 { exch 2 array astore /Margins .dict1 setpagedevice
 } bind def
/setpagemargin { 0 2 array astore /PageOffset .dict1 setpagedevice } bind def
/setpageparams
 { mark /PageSize 6 -2 roll
   4 index 1 and ORIENT1 { 1 } { 0 } ifelse ne { exch } if 2 array astore
   /Orientation 5 -1 roll ORIENT1 { 1 xor } if
   /PageOffset counttomark 2 add -1 roll 0 2 array astore
   .dicttomark setpagedevice
 } bind def
/setresolution
 { dup 2 array astore /HWResolution .dict1 setpagedevice
 } bind def
%END PAGEDEVICE

% The following are not implemented yet.
%manualfeed
%manualfeedtimeout
%pagecount
%pagestackorder
%setpagestackorder

pop		% currentsystemparams

% Flag the current dictionary so it will be swapped when we
% change language levels.  (See zmisc2.c for more information.)
/statusdict currentdict def

currentdict end
/statusdict exch .forcedef	% statusdict is local, systemdict is global

% The following compatibility operators are in systemdict.  They are
% defined here, rather than in gs_init.ps, because they require the
% resource machinery.

/devforall {		% <pattern> <proc> <scratch> devforall -
  exch {
    1 index currentdevparams
    /Type .knownget { /FileSystem eq } { false } ifelse
    { exec } { pop pop } ifelse
  } /exec load 3 packedarray cvx exch
  (*) 3 1 roll ppstack flush /IODevice resourceforall
} odef
/devstatus {		% <(%disk*%)> devstatus <searchable> <writable>
			%   <hasNames> <mounted> <removable> <searchOrder>
			%   <freePages> <size> true
			% <string> devstatus false
  dup length 5 ge {
    dup 0 5 getinterval (%disk) eq {
      dup /IODevice resourcestatus {
	pop pop dup currentdevparams
	dup /Searchable get
	exch dup /Writable get
	exch dup /HasNames get
	exch dup /Mounted get
	exch dup /Removable get
	exch dup /SearchOrder get
	exch dup /Free get
	exch /LogicalSize get
	9 -1 roll pop true
      } {
	pop false
      } ifelse
    } {
      pop false
    } ifelse
  } {
    pop false
  } ifelse
} odef

% ------ Color spaces ------ %

% Attempt to convert a tint transformation procedure to a type 4 Function.
% The value <m> is the number  of function inputs
% The current color space defines the number of function output values.
% The current color space will be the alternate color space for the function.
% If the conversion fails then build a color cube function.

/.converttinttransform {	% [.. .. .. proc ] <m>
				%   .converttinttransform [.. .. .. proc']
  .currentglobal			% Save current global memory state
  2 index gcheck .setglobal		% Set gobal mode to match the array's mode
  4 dict				% Build a dictionary for our type 4 function
    dup /FunctionType 4 put		% Set FunctionType
    dup /Function 5 index 3 get put	% Set function expression
		% Stack: orig m global func
    dup /Domain
    [ 5 index {0 1} repeat ] put	% set Domain values
    dup /Range
    [ mark currentcolor counttomark
    dup 2 add 1 roll cleartomark	% # of components in alternate space
    {0 1} repeat ] put			% Set Range values
  { .buildfunction } .internalstopped	% Try to build a type 4 function
  dup
  {				% type 4 function failed - Collect data for a color cube
    pop					% Remove duplicate copy of stopped status
    pop					% Remove invalid type 4 function
    1 index				% Get number of inputs
    mark currentcolor counttomark	% Count number of output colors
    dup 2 add 1 roll cleartomark	% # of components in alternate space
    4 index 3 get			% Get tint transform function
    { .buildcolorcube } .internalstopped 
  } if
  {					% Color cube build failed
    pop pop pop exch pop exch pop	% Remove unused parameters
    .setglobal				% Restore global state
  } {					% Function build succeeded - install function
					% Stack: orig m global func
    3 -1 roll pop			% Stack: orig global func
    2 index 4 array copy dup 3 4 -1 roll put
    exch .setglobal exch pop
  } ifelse
} bind def

% Define the setcolorspace procedures:
%	<colorspace> proc <colorspace'|null>
% We have to define the dictionary first, so it can be bound into the
% implementation procedure, but we can't populate it until the procedure
% has been defined, so that the procedure can get bound into recursive calls.
/colorspacedict 20 dict def

/.devcs [
  /DeviceGray /DeviceRGB /DeviceCMYK /DevicePixel
] readonly def
/currentcolorspace {		% - currentcolorspace <array>
  .currentcolorspace dup type /integertype eq {
    //.devcs exch 1 getinterval
  } if
} odef
currentdict /.devcs .undef

/setcolorspace {		% <name|array> setcolorspace -
  dup dup dup type /nametype ne { 0 get } if
  //colorspacedict exch get exec
  dup null eq { pop } { .setcolorspace } ifelse pop
} odef

colorspacedict
  dup /DeviceGray { pop 0 setgray null } bind put
  dup /DeviceRGB { pop 0 0 0 setrgbcolor null } bind put
  /setcmykcolor where
   { pop dup /DeviceCMYK { pop 0 0 0 1 setcmykcolor null } bind put
   } if
  /.setcieaspace where
   { pop dup /CIEBasedA { NOCIE { pop 0 setgray null } { dup 1 get .setcieaspace } ifelse } bind put
   } if
  /.setcieabcspace where
   { pop dup /CIEBasedABC { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setcieabcspace } ifelse } bind put
   } if
  /.setciedefspace where
   { pop dup /CIEBasedDEF { NOCIE { pop 0 0 0 setrgbcolor null } { dup 1 get .setciedefspace } ifelse } bind put
   } if
  /.setciedefgspace where
   { pop dup /CIEBasedDEFG { NOCIE { pop 0 0 0 1 setcmykcolor null } { dup 1 get .setciedefgspace } ifelse } bind put
   } if
  /.setseparationspace where
   { pop dup /Separation { dup 2 get setcolorspace dup 1 .converttinttransform .setseparationspace } bind put
   } if
  /.setindexedspace where
   { pop dup /Indexed { dup 1 get setcolorspace dup .setindexedspace } bind put
   } if
  /.nullpatternspace [/Pattern] readonly def
  /.setpatternspace where
   { pop dup /Pattern
      { dup type /nametype eq { pop //.nullpatternspace } if
	dup length 1 gt { dup 1 get setcolorspace } if
        dup .setpatternspace
      } bind put
   } if
	% If DeviceN space is included, gs_ll3.ps registers it.
  /.setdevicepixelspace where
   { pop dup /DevicePixel { dup .setdevicepixelspace } bind put
   } if
  currentdict /.nullpatternspace .undef
pop

% ------ CIE color rendering ------ %

% Define findcolorrendering and a default ColorRendering ProcSet.

/findcolorrendering {		% <intentname> findcolorrendering
				%   <crdname> <found>
  /ColorRendering /ProcSet findresource
  1 index .namestring (.) concatstrings
  1 index /GetPageDeviceName get exec .namestring (.) concatstrings
  2 index /GetHalftoneName get exec .namestring
  concatstrings concatstrings
  dup /ColorRendering resourcestatus {
    pop pop exch pop exch pop true
  } {
    pop /GetSubstituteCRD get exec false
  } ifelse
} odef

5 dict dup begin

/GetPageDeviceName {		% - GetPageDeviceName <name>
  currentpagedevice dup /PageDeviceName .knownget {
    exch pop dup null eq { pop /none } if
  } {
    pop /none
  } ifelse
} bind def

/GetHalftoneName {		% - GetHalftoneName <name>
  currenthalftone /HalftoneName .knownget not { /none } if
} bind def

/GetSubstituteCRD {		% <intentname> GetSubstituteCRD <crdname>
  pop /DefaultColorRendering
} bind def

end
% The resource machinery hasn't been activated, so just save the ProcSet
% and let .fixresources finish the installation process.
/ColorRendering exch def

% Define setcolorrendering.

/.colorrenderingtypes 5 dict def

/setcolorrendering {		% <crd> setcolorrendering -
  dup /ColorRenderingType get //.colorrenderingtypes exch get exec
} odef

/.setcolorrendering1 where { pop } { (%END CRD) .skipeof } ifelse

.colorrenderingtypes 1 {
  dup .buildcolorrendering1 .setcolorrendering1
} .bind put

% Note: the value 101 in the next line must be the same as the value of
% GX_DEVICE_CRD1_TYPE in gscrdp.h.
.colorrenderingtypes 101 {
  dup .builddevicecolorrendering1 .setdevicecolorrendering1
} .bind put

% Initialize the default CIE rendering dictionary.
% The most common CIE files seem to assume the "calibrated RGB color space"
% described on p. 189 of the PostScript Language Reference Manual,
% 2nd Edition; we simply invert this transformation back to RGB.
mark
   /ColorRenderingType 1
% We must make RangePQR and RangeLMN large enough so that values computed by
% the assumed encoding MatrixLMN don't get clamped.
   /RangePQR [0 0.9505 0 1 0 1.0890] readonly
% This TransformPQR implements a relative colorimetric intent by scaling
% the XYZ values relative to the white and black points.
   /TransformPQR
     [ { 5 1 roll                    % p Ws Bs Wd Bd
         4 {3 get 5 1 roll} repeat   % ws bs wd bd p 
         3 index sub                 % ws bs wd bd p-bs 
         1 index                     % ws bs wd bd p-bs bd
         6 2 roll                    % p-bs bd ws bs wd bd 
         sub                         % p-bs bd ws bs wd-bd 
         5 1 roll                    % wd-bd p-bs bd ws bs  
         sub                         % wd-bd p-bs bd ws-bs  
         4 2 roll                    % bd ws-bs wd-bd p-bs 
         mul                         % bd ws-bs (wd-bd)*(p-bs)
         exch div add                % bd + (wd-bd)*(p-bs)/(ws-bs)
       } bind
       { 5 1 roll
         4 {4 get 5 1 roll} repeat
         3 index sub 1 index 6 2 roll sub 5 1 roll
         sub 4 2 roll mul exch div add
       } bind
       { 5 1 roll
         4 {5 get 5 1 roll} repeat
         3 index sub 1 index 6 2 roll sub 5 1 roll
         sub 4 2 roll mul exch div add
       } bind
     ] readonly
   /RangeLMN [0 0.9505 0 1 0 1.0890] readonly
   /MatrixABC
    [ 3.24063 -0.96893  0.05571
     -1.53721  1.87576 -0.20402
     -0.49863  0.04152  1.05700
    ] readonly
   /EncodeABC [ {0 .max 0.45 exp} bind dup dup] readonly
   /WhitePoint [0.9505 1 1.0890] readonly
	% Some Genoa tests seem to require the presence of BlackPoint.
   /BlackPoint [0 0 0] readonly
.dicttomark setcolorrendering

%END CRD

% Initialize a CIEBased color space for sRGB.
/CIEsRGB [ /CIEBasedABC
  mark
    /DecodeLMN [ {
      dup 0.03928 le { 12.92321 div } { 0.055 add 1.055 div 2.4 exp } ifelse
    } bind dup dup ] readonly
    /MatrixLMN [
      0.412457 0.212673 0.019334
      0.357576 0.715152 0.119192
      0.180437 0.072175 0.950301
    ] readonly
    /WhitePoint [0.9505 1.0 1.0890] readonly
  .dicttomark readonly
] readonly def

% ------ Painting ------ %

% A straightforward definition of execform that doesn't actually
% do any caching.
/.execform1 {
	% This is a separate operator so that the stacks will be restored
	% properly if an error occurs.
  dup /Matrix get concat
  dup /BBox get aload pop
  exch 3 index sub exch 2 index sub rectclip
  dup /PaintProc get
  1 index /Implementation known not {
    1 index dup /Implementation null .forceput readonly pop
  } if
  exec
} .bind odef	% must bind .forceput

/.formtypes 5 dict
  dup 1 /.execform1 load put
def

/execform {			% <form> execform -
  gsave {
    dup /FormType get //.formtypes exch get exec
  } stopped grestore { stop } if
} odef

/.patterntypes 5 dict
  dup 1 /.buildpattern1 load put
def

/makepattern {			% <proto_dict> <matrix> makepattern <pattern>
  //.patterntypes 2 index /PatternType get get
  .currentglobal false .setglobal exch
		% Stack: proto matrix global buildproc
  3 index dup length 1 add dict .copydict
  3 index 3 -1 roll exec 3 -1 roll .setglobal
  1 index /Implementation 3 -1 roll put
  readonly exch pop exch pop
} odef

/setpattern {			% [<comp1> ...] <pattern> setpattern -
  currentcolorspace 0 get /Pattern ne {
    [ /Pattern currentcolorspace ] setcolorspace
  } if setcolor
} odef

% Extend image and imagemask to accept dictionaries.
% We must create .imagetypes and .imagemasktypes outside level2dict,
% and leave some extra space because we're still in Level 1 mode.
systemdict begin
/.imagetypes 5 dict
  dup 1 /.image1 load put
def
/.imagemasktypes 5 dict
  dup 1 /.imagemask1 load put
def
end

/.image /image load def
/image {
  dup type /dicttype eq {
    dup /ImageType get //.imagetypes exch get exec
  } {
    //.image
  } ifelse
} odef
currentdict /.image undef

/.imagemask /imagemask load def
/imagemask {
  dup type /dicttype eq {
    dup /ImageType get //.imagemasktypes exch get exec
  } {
    //.imagemask
  } ifelse
} odef
currentdict /.imagemask undef

end				% level2dict