sys/lib/ghostscript/gs_lev2.ps

   1 %    Copyright (C) 1990, 2000 Aladdin Enterprises.  All rights reserved.
   2 %
   3 % This software is provided AS-IS with no warranty, either express or
   4 % implied.
   5 %
   6 % This software is distributed under license and may not be copied,
   7 % modified or distributed except as expressly authorized under the terms
   8 % of the license contained in the file LICENSE in this distribution.
   9 %
  10 % For more information about licensing, please refer to
  11 % http://www.ghostscript.com/licensing/. For information on
  12 % commercial licensing, go to http://www.artifex.com/licensing/ or
  13 % contact Artifex Software, Inc., 101 Lucas Valley Road #110,
  14 % San Rafael, CA  94903, U.S.A., +1(415)492-9861.
  15
  16 % $Id: gs_lev2.ps,v 1.38 2005/10/04 17:51:52 ray Exp $
  17 % Initialization file for Level 2 functions.
  18 % When this is run, systemdict is still writable,
  19 % but (almost) everything defined here goes into level2dict.
  20
  21 level2dict begin
  22
  23 % ------ System and user parameters ------ %
  24
  25 % User parameters must obey save/restore, and must also be maintained
  26 % per-context.  We implement the former, and some of the latter, here
  27 % with PostScript code.  NOTE: our implementation assumes that user
  28 % parameters change only as a result of setuserparams -- that there are
  29 % no user parameters that are ever changed dynamically by the interpreter
  30 % (although the interpreter may adjust the value presented to setuserparams)
  31 %
  32 % There are two types of user parameters: those which are actually
  33 % maintained in the interpreter, and those which exist only at the
  34 % PostScript level.  We maintain the current state of both types in
  35 % a read-only local dictionary named userparams, defined in systemdict.
  36 % In a multi-context system, each context has its own copy of this
  37 % dictionary.  In addition, there is a constant dictionary named
  38 % psuserparams where each key is the name of a user parameter that exists
  39 % only in PostScript and the value is a procedure to check that the value
  40 % is legal: setuserparams uses this for checking the values.
  41 % setuserparams updates userparams explicitly, in addition to setting
  42 % any user parameters in the interpreter; thus we can use userparams
  43 % to reset those parameters after a restore or a context switch.
  44 % NOTE: the name userparams is known to the interpreter, and in fact
  45 % the interpreter creates the userparams dictionary.
  46
  47 % Check parameters that are managed at the PostScript level.
  48 /.checkparamtype {              % <newvalue> <type> .checkparamtype <bool>
  49   exch type eq
  50 } .bind def
  51 /.checksetparams {              % <newdict> <opname> <checkdict>
  52                                 %   .checksetparams <newdict>
  53   2 index {
  54                 % Stack: newdict opname checkdict key newvalue
  55     3 copy 3 1 roll .knownget {
  56       exec not {
  57         pop pop pop load /typecheck signalerror
  58       } if
  59       dup type /stringtype eq {
  60         dup rcheck not {
  61           pop pop pop load /invalidaccess signalerror
  62         } if
  63       } if
  64     } {
  65       pop
  66     } ifelse pop pop
  67   } forall pop pop
  68 } .bind def     % not odef, shouldn't reset stacks
  69
  70 % currentuser/systemparams creates and returns a dictionary in the
  71 % current VM.  The easiest way to make this work is to copy any composite
  72 % PostScript-level parameters to global VM.  Currently we have strings
  73 % as well as arrays. For arrays, we also need to copy any contents that
  74 % are in VM. Also copying string parameters insures the contents won't
  75 % be changed. Also be careful to preserve 'executable' state.
  76 /.copyparam {                   % <value> .copyparam <value'>
  77   dup type /arraytype eq {
  78     .currentglobal true .setglobal exch
  79     dup wcheck exch dup xcheck exch             % original attributes
  80     dup length array exch dup { % stack: destination_array original_array original_array
  81       dup type /arraytype eq {
  82         dup 2 index ne {        % avoid recursion
  83           .copyparam    % recurse to handle composite array elements
  84         } {
  85           % this array self referenced, do it again (yuk!)
  86           pop 1 index           % get copy of destination array
  87         } ifelse
  88       } {
  89         dup type /stringtype eq {
  90           .copyparam
  91         } if
  92       }
  93       ifelse 3 1 roll           % keep arrays on top
  94     } forall pop astore
  95     exch { cvx } if             % set executable state
  96     exch not { readonly } if    % set readonly attribute as original
  97     exch .setglobal
  98   } if
  99   dup type /stringtype eq {
 100     dup wcheck exch     % save attr for setting readonly
 101     .currentglobal true .setglobal
 102     1 index length string exch .setglobal
 103     copy exch not { readonly } if
 104   } if
 105 } .bind def
 106
 107 % Some user parameters are managed entirely at the PostScript level.
 108 % We take care of that here.
 109 systemdict begin
 110 /psuserparams 48 dict def
 111 /getuserparam {                 % <name> getuserparam <value>
 112   /userparams .systemvar 1 index get exch pop
 113 } odef
 114 % Fill in userparams (created by the interpreter) with current values.
 115 mark .currentuserparams
 116 counttomark 2 idiv {
 117   userparams 3 1 roll put
 118 } repeat pop
 119 /.definepsuserparam {           % <name> <value> .definepsuserparam -
 120   psuserparams 3 copy pop
 121   type cvlit /.checkparamtype cvx 2 packedarray cvx put
 122   userparams 3 1 roll put
 123 } .bind def
 124 end
 125 /currentuserparams {            % - currentuserparams <dict>
 126   /userparams .systemvar dup length dict .copydict
 127 } odef
 128 /setuserparams {                % <dict> setuserparams -
 129         % Check that we will be able to set the PostScript-level
 130         % user parameters.
 131   /setuserparams /psuserparams .systemvar .checksetparams
 132         % Set the C-level user params.  If this succeeds, we know that
 133         % the password check succeeded.
 134   dup .setuserparams
 135         % Now set the PostScript-level params.
 136         % The interpreter may have adjusted the values of some of the
 137         % parameters, so we have to read them back.
 138   dup {
 139     /userparams .systemvar 2 index known {
 140       psuserparams 2 index known not {
 141         pop dup .getuserparam
 142       } if
 143       .copyparam
 144       % special protection for the security related parameters
 145       [ /PermitFileReading /PermitFileWriting /PermitFileControl ]
 146       { 2 index eq { % force all strings to readonly but make sure the
 147                      % array is in the correct VM space (local/global).
 148         currentglobal exch dup gcheck setglobal
 149         dup length array exch { readonly exch } forall astore
 150         exch setglobal
 151         } if
 152       } forall
 153       % protect top level of parameters that we copied
 154       dup type dup /arraytype eq exch /stringtype eq or { readonly } if
 155       /userparams .systemvar 3 1 roll .forceput  % userparams is read-only
 156     } {
 157       pop pop
 158     } ifelse
 159   } forall
 160         % A context switch might have occurred during the above loop,
 161         % causing the interpreter-level parameters to be reset.
 162         % Set them again to the new values.  From here on, we are safe,
 163         % since a context switch will consult userparams.
 164   .setuserparams
 165 } .bind odef
 166 % Initialize user parameters managed here.
 167 /JobName () .definepsuserparam
 168
 169 % Restore must restore the user parameters.
 170 % (Since userparams is in local VM, save takes care of saving them.)
 171 /restore {              % <save> restore -
 172   //restore /userparams .systemvar .setuserparams
 173 } .bind odef
 174
 175 % The pssystemparams dictionary holds some system parameters that
 176 % are managed entirely at the PostScript level.
 177 systemdict begin
 178 currentdict /pssystemparams known not {
 179   /pssystemparams 40 dict readonly def
 180 } if
 181 /getsystemparam {               % <name> getsystemparam <value>
 182   //pssystemparams 1 index .knownget { exch pop } { .getsystemparam } ifelse
 183 } odef
 184 end
 185 /currentsystemparams {          % - currentsystemparams <dict>
 186   mark .currentsystemparams //pssystemparams { } forall .dicttomark
 187 } odef
 188 /setsystemparams {              % <dict> setsystemparams -
 189         % Check that we will be able to set the PostScript-level
 190         % system parameters.
 191    /SAFETY .systemvar /safe get {
 192      % SAFER mode disallows some changes
 193      [ /GenericResourceDir /FontResourceDir /GenericResourcePathSep ] {
 194        2 copy .knownget {
 195          exch //pssystemparams exch .knownget {
 196            ne { /setsystemparams /invalidaccess signalerror } if
 197          } {
 198            pop
 199          } ifelse
 200        } {
 201          pop
 202        } ifelse
 203      } forall
 204    } if
 205    /setsystemparams //pssystemparams mark exch {
 206      type cvlit /.checkparamtype cvx 2 packedarray cvx
 207    } forall .dicttomark .checksetparams
 208         % Set the C-level system params.  If this succeeds, we know that
 209         % the password check succeeded.
 210    dup .setsystemparams
 211         % Now set the PostScript-level params.  We must copy local strings
 212         % into global VM.
 213    dup
 214     { //pssystemparams 2 index known
 215        {                % Stack: key newvalue
 216          .copyparam
 217          % protect top level parameters that we copied
 218          dup type dup /arraytype eq exch /stringtype eq or { readonly } if
 219          //pssystemparams 3 1 roll .forceput    % pssystemparams is read-only
 220        }
 221        { pop pop
 222        }
 223       ifelse
 224     }
 225    forall pop
 226 } .bind odef
 227
 228 % Initialize the passwords.
 229 % NOTE: the names StartJobPassword and SystemParamsPassword are known to
 230 % the interpreter, and must be bound to noaccess strings.
 231 % The length of these strings must be max_password (iutil2.h) + 1.
 232 /StartJobPassword 65 string noaccess def
 233 /SystemParamsPassword 65 string noaccess def
 234
 235 % Redefine cache parameter setting to interact properly with userparams.
 236 /setcachelimit {
 237   mark /MaxFontItem 2 index .dicttomark setuserparams pop
 238 } .bind odef
 239 /setcacheparams {
 240         % The MaxFontCache parameter is a system parameter, which we might
 241         % not be able to set.  Fortunately, this doesn't matter, because
 242         % system parameters don't have to be synchronized between this code
 243         % and the VM.
 244   counttomark 1 add copy setcacheparams
 245   currentcacheparams    % mark size lower upper
 246     3 -1 roll pop
 247     /MinFontCompress 3 1 roll
 248     /MaxFontItem exch
 249   .dicttomark setuserparams
 250   cleartomark
 251 } .bind odef
 252
 253 % Add bogus user and system parameters to satisfy badly written PostScript
 254 % programs that incorrectly assume the existence of all the parameters
 255 % listed in Appendix C of the Red Book.  Note that some of these may become
 256 % real parameters later: code near the end of gs_init.ps takes care of
 257 % removing any such parameters from ps{user,system}params.
 258
 259 % psuserparams
 260   /MaxFormItem 100000 .definepsuserparam
 261   /MaxPatternItem 20000 .definepsuserparam
 262   /MaxScreenItem 48000 .definepsuserparam
 263   /MaxUPathItem 5000 .definepsuserparam
 264
 265 % File Access Permission parameters
 266   .currentglobal true .setglobal
 267   /.checkFilePermitparams {
 268     type /arraytype eq {
 269       currentuserparams /LockFilePermissions get {
 270         5 { pop } repeat /setuserparams /invalidaccess signalerror
 271       }{
 272         % in addition to validating the value, ensure the value is read/only
 273         dup { readonly exch } forall
 274         .currentglobal exch dup gcheck .setglobal length array exch .setglobal
 275         astore readonly
 276       }
 277       ifelse
 278     } {
 279       5 { pop } repeat /setuserparams /typecheck signalerror
 280     }
 281     ifelse
 282     true
 283   } .bind def
 284 % Initialize the File Permission access control to wide open
 285 % These will only be accessed via current/set userparams.
 286 % Values are a string containing multiple nul terminated path strings
 287   /PermitFileReading dup [ (*) ] .definepsuserparam
 288     psuserparams exch /.checkFilePermitparams load put
 289   /PermitFileWriting dup [ (*) ] .definepsuserparam
 290     psuserparams exch /.checkFilePermitparams load put
 291   /PermitFileControl dup [ (*) ] .definepsuserparam
 292     psuserparams exch /.checkFilePermitparams load put
 293   .setglobal
 294
 295 pssystemparams begin
 296   /CurDisplayList 0 .forcedef
 297   /CurFormCache 0 .forcedef
 298   /CurOutlineCache 0 .forcedef
 299   /CurPatternCache 0 .forcedef
 300   /CurUPathCache 0 .forcedef
 301   /CurScreenStorage 0 .forcedef
 302   /CurSourceList 0 .forcedef
 303   /DoPrintErrors false .forcedef
 304   /MaxDisplayList 140000 .forcedef
 305   /MaxFormCache 100000 .forcedef
 306   /MaxOutlineCache 65000 .forcedef
 307   /MaxPatternCache 100000 .forcedef
 308   /MaxUPathCache 300000 .forcedef
 309   /MaxScreenStorage 84000 .forcedef
 310   /MaxSourceList 25000 .forcedef
 311   /RamSize 4194304 .forcedef
 312 end
 313
 314 % Define the procedures for handling comment scanning.  The names
 315 % %ProcessComment and %ProcessDSCComment are known to the interpreter.
 316 % These procedures take the file and comment string and file as operands.
 317 /.checkprocesscomment {
 318   dup null eq {
 319     pop true
 320   } {
 321     dup xcheck {
 322       type dup /arraytype eq exch /packedarraytype eq or
 323     } {
 324       pop false
 325     } ifelse
 326   } ifelse
 327 } .bind def
 328 /ProcessComment null .definepsuserparam
 329 psuserparams /ProcessComment {.checkprocesscomment} put
 330 (%ProcessComment) cvn {
 331   /ProcessComment getuserparam
 332   dup null eq { pop pop pop } { exec } ifelse
 333 } bind def
 334 /ProcessDSCComment null .definepsuserparam
 335 psuserparams /ProcessDSCComment {.checkprocesscomment} put
 336 /.loadingfont false def
 337 (%ProcessDSCComment) cvn {
 338   /ProcessDSCComment getuserparam
 339   dup null eq .loadingfont or { pop pop pop } { exec } ifelse
 340 } bind def
 341
 342 % ------ Miscellaneous ------ %
 343
 344 (<<) cvn                        % - << -mark-
 345   /mark load def
 346 (>>) cvn                        % -mark- <key1> <value1> ... >> <dict>
 347   /.dicttomark load def
 348 /languagelevel 2 def
 349 % When running in Level 2 mode, this interpreter is supposed to be
 350 % compatible with Adobe version 2017.
 351 /version (2017) readonly def
 352
 353 % If binary tokens are supported by this interpreter,
 354 % set an appropriate default binary object format.
 355 /setobjectformat where
 356  { pop
 357    /RealFormat getsystemparam (IEEE) eq { 1 } { 3 } ifelse
 358    /ByteOrder getsystemparam { 1 add } if
 359    setobjectformat
 360  } if
 361
 362 % Aldus Freehand versions 2.x check for the presence of the
 363 % setcolor operator, and if it is missing, substitute a procedure.
 364 % Unfortunately, the procedure takes different parameters from
 365 % the operator.  As a result, files produced by this application
 366 % cause an error if the setcolor operator is actually defined
 367 % and 'bind' is ever used.  Aldus fixed this bug in Freehand 3.0,
 368 % but there are a lot of files created by the older versions
 369 % still floating around.  Therefore, at Adobe's suggestion,
 370 % we implement the following dreadful hack in the 'where' operator:
 371 %      If the key is /setcolor, and
 372 %        there is a dictionary named FreeHandDict, and
 373 %        currentdict is that dictionary,
 374 %      then "where" consults only that dictionary and not any other
 375 %        dictionaries on the dictionary stack.
 376 .wheredict /setcolor {
 377   /FreeHandDict .where {
 378     /FreeHandDict get currentdict eq {
 379       pop currentdict /setcolor known { currentdict true } { false } ifelse
 380     } {
 381       .where
 382     } ifelse
 383   } {
 384     .where
 385   } ifelse
 386 } bind put
 387
 388 % ------ Virtual memory ------ %
 389
 390 /currentglobal                  % - currentglobal <bool>
 391   /currentshared load def
 392 /gcheck                         % <obj> gcheck <bool>
 393   /scheck load def
 394 /setglobal                      % <bool> setglobal -
 395   /setshared load def
 396 % We can make the global dictionaries very small, because they auto-expand.
 397 /globaldict currentdict /shareddict .knownget not { 4 dict } if def
 398 /GlobalFontDirectory SharedFontDirectory def
 399
 400 % VMReclaim and VMThreshold are user parameters.
 401 /setvmthreshold {               % <int> setvmthreshold -
 402   mark /VMThreshold 2 index .dicttomark setuserparams pop
 403 } odef
 404 /vmreclaim {                    % <int> vmreclaim -
 405   dup 0 gt {
 406     .vmreclaim
 407   } {
 408     mark /VMReclaim 2 index .dicttomark setuserparams pop
 409   } ifelse
 410 } odef
 411 -1 setvmthreshold
 412
 413 % ------ IODevices ------ %
 414
 415 /.getdevparams where {
 416   pop /currentdevparams {       % <iodevice> currentdevparams <dict>
 417     .getdevparams .dicttomark
 418   } odef
 419 } if
 420 /.putdevparams where {
 421   pop /setdevparams {           % <iodevice> <dict> setdevparams -
 422     mark 1 index { } forall counttomark 2 add index
 423     .putdevparams pop pop
 424   } odef
 425 } if
 426
 427 % ------ Job control ------ %
 428
 429 serverdict begin
 430
 431 % We could protect the job information better, but we aren't attempting
 432 % (currently) to protect ourselves against maliciousness.
 433
 434 /.jobsave null def              % top-level save object
 435 /.jobsavelevel 0 def            % save depth of job (0 if .jobsave is null,
 436                                 % 1 otherwise)
 437 /.adminjob true def             % status of current unencapsulated job
 438
 439 end             % serverdict
 440
 441 % Because there may be objects on the e-stack created since the job save,
 442 % we have to clear the e-stack before doing the end-of-job restore.
 443 % We do this by executing a 2 .stop, which is caught by the 2 .stopped
 444 % in .runexec; we leave on the o-stack a procedure to execute aftewards.
 445 %
 446 %**************** The definition of startjob is not complete yet, since
 447 % it doesn't reset stdin/stdout.
 448 /.startnewjob {                 % <exit_bool> <password_level>
 449                                 %   .startnewjob -
 450     serverdict /.jobsave get dup null eq { pop } { restore } ifelse
 451     exch {
 452                         % Unencapsulated job
 453       serverdict /.jobsave null put
 454       serverdict /.jobsavelevel 0 put
 455       serverdict /.adminjob 3 -1 roll 1 gt put
 456                 % The Adobe documentation doesn't say what happens to the
 457                 % graphics state stack in this case, but an experiment
 458                 % produced results suggesting that a grestoreall occurs.
 459       grestoreall
 460     } {
 461                         % Encapsulated job
 462       pop
 463       serverdict /.jobsave save put
 464       serverdict /.jobsavelevel 1 put
 465       .userdict /quit /stop load put
 466     } ifelse
 467                 % Reset the interpreter state.
 468   clear cleardictstack
 469   initgraphics
 470   false setglobal
 471   2 vmreclaim   % Make sure GC'ed memory is reclaimed and freed.
 472 } bind def
 473 /.startjob {                    % <exit_bool> <password> <finish_proc>
 474                                 %   .startjob <ok_bool>
 475   vmstatus pop pop serverdict /.jobsavelevel get eq
 476   2 index .checkpassword 0 gt and {
 477     exch .checkpassword exch count 3 roll count 3 sub { pop } repeat
 478     cleardictstack
 479                 % Reset the e-stack back to the 2 .stopped in .runexec,
 480                 % passing the finish_proc to be executed afterwards.
 481     2 .stop
 482   } {           % Password check failed
 483     pop pop pop false
 484   } ifelse
 485 } odef
 486 /startjob {                     % <exit_bool> <password> startjob <ok_bool>
 487         % This is a hack.  We really need some way to indicate explicitly
 488         % to the interpreter that we are under control of a job server.
 489   { .startnewjob true } .startjob
 490 } odef
 491
 492 % The procedure to undo the job encapsulation
 493 /.endjob {
 494   clear cleardictstack
 495   serverdict /.jobsave get dup null eq { pop } { restore } ifelse
 496   serverdict /.jobsave null put
 497   2 vmreclaim   % recover local and global VM
 498 } odef
 499
 500 systemdict begin
 501 /quit {                         % - quit -
 502   //systemdict begin serverdict /.jobsave get null eq
 503    { end //quit }
 504    { /quit load /invalidaccess /signalerror load end exec }
 505   ifelse
 506 } bind odef
 507 end
 508
 509 % We would like to define exitserver as a procedure, using the code
 510 % that the Red Book says is equivalent to it.  However, since startjob
 511 % resets the exec stack, we can't do this, because control would never
 512 % proceed past the call on startjob if the exitserver is successful.
 513 % Instead, we need to construct exitserver out of pieces of startjob.
 514
 515 serverdict begin
 516
 517 /exitserver {                   % <password> exitserver -
 518   true exch { .startnewjob } .startjob not {
 519     /exitserver /invalidaccess signalerror
 520   } if
 521 } bind def
 522
 523 end             % serverdict
 524
 525 % ------ Compatibility ------ %
 526
 527 % In Level 2 mode, the following replace the definitions that gs_statd.ps
 528 % installs in statusdict and serverdict.
 529 % Note that statusdict must be allocated in local VM.
 530 % We don't bother with many of these yet.
 531
 532 /.dict1 { exch mark 3 1 roll .dicttomark } bind def
 533
 534 currentglobal false setglobal 25 dict exch setglobal begin
 535 currentsystemparams
 536
 537 % The following do not depend on the presence of setpagedevice.
 538 /buildtime 1 index /BuildTime get def
 539 % Also define /buildtime in systemdict because Adobe does so and some fonts use it as ID
 540 systemdict /buildtime dup load put
 541 /byteorder 1 index /ByteOrder get def
 542 /checkpassword { .checkpassword 0 gt } bind def
 543 dup /DoStartPage known
 544  { /dostartpage { /DoStartPage getsystemparam } bind def
 545    /setdostartpage { /DoStartPage .dict1 setsystemparams } bind def
 546  } if
 547 dup /StartupMode known
 548  { /dosysstart { /StartupMode getsystemparam 0 ne } bind def
 549    /setdosysstart { { 1 } { 0 } ifelse /StartupMode .dict1 setsystemparams } bind def
 550  } if
 551 %****** Setting jobname is supposed to set userparams.JobName, too.
 552 /jobname { /JobName getuserparam } bind def
 553 /jobtimeout { /JobTimeout getuserparam } bind def
 554 /ramsize { /RamSize getsystemparam } bind def
 555 /realformat 1 index /RealFormat get def
 556 dup /PrinterName known
 557  { /setprintername { /PrinterName .dict1 setsystemparams } bind def
 558  } if
 559 /printername
 560  { currentsystemparams /PrinterName .knownget not { () } if exch copy
 561  } bind def
 562 currentuserparams /WaitTimeout known
 563  { /waittimeout { /WaitTimeout getuserparam } bind def
 564  } if
 565
 566 % The following do require setpagedevice.
 567 /.setpagedevice where { pop } { (%END PAGEDEVICE) .skipeof } ifelse
 568 /defaulttimeouts
 569  { currentsystemparams dup
 570    /JobTimeout .knownget not { 0 } if
 571    exch /WaitTimeout .knownget not { 0 } if
 572    currentpagedevice /ManualFeedTimeout .knownget not { 0 } if
 573  } bind def
 574 /margins
 575  { currentpagedevice /Margins .knownget { exch } { [0 0] } ifelse
 576  } bind def
 577 /pagemargin
 578  { currentpagedevice /PageOffset .knownget { 0 get } { 0 } ifelse
 579  } bind def
 580 /pageparams
 581  { currentpagedevice
 582    dup /Orientation .knownget { 1 and ORIENT1 { 1 xor } if } { 0 } ifelse exch
 583    dup /PageSize get aload pop 3 index 0 ne { exch } if 3 2 roll
 584    /PageOffset .knownget { 0 get } { 0 } ifelse 4 -1 roll
 585  } bind def
 586 /setdefaulttimeouts
 587  { exch mark /ManualFeedTimeout 3 -1 roll
 588    /Policies mark /ManualFeedTimeout 1 .dicttomark
 589    .dicttomark setpagedevice
 590    /WaitTimeout exch mark /JobTimeout 5 2 roll .dicttomark setsystemparams
 591  } bind def
 592 /.setpagesize { 2 array astore /PageSize .dict1 setpagedevice } bind def
 593 /setduplexmode { /Duplex .dict1 setpagedevice } bind def
 594 /setmargins
 595  { exch 2 array astore /Margins .dict1 setpagedevice
 596  } bind def
 597 /setpagemargin { 0 2 array astore /PageOffset .dict1 setpagedevice } bind def
 598 /setpageparams
 599  { mark /PageSize 6 -2 roll
 600    4 index 1 and ORIENT1 { 1 } { 0 } ifelse ne { exch } if 2 array astore
 601    /Orientation 5 -1 roll ORIENT1 { 1 xor } if
 602    /PageOffset counttomark 2 add -1 roll 0 2 array astore
 603    .dicttomark setpagedevice
 604  } bind def
 605 /setresolution
 606  { dup 2 array astore /HWResolution .dict1 setpagedevice
 607  } bind def
 608 %END PAGEDEVICE
 609
 610 % The following are not implemented yet.
 611 %manualfeed
 612 %manualfeedtimeout
 613 %pagecount
 614 %pagestackorder
 615 %setpagestackorder
 616
 617 pop             % currentsystemparams
 618
 619 % Flag the current dictionary so it will be swapped when we
 620 % change language levels.  (See zmisc2.c for more information.)
 621 /statusdict currentdict def
 622
 623 currentdict end
 624 /statusdict exch .forcedef      % statusdict is local, systemdict is global
 625
 626 % The following compatibility operators are in systemdict.  They are
 627 % defined here, rather than in gs_init.ps, because they require the
 628 % resource machinery.
 629
 630 /devforall {            % <proc> <scratch> devforall -
 631   exch {
 632     1 index currentdevparams
 633     /Type .knownget { /FileSystem eq } { false } ifelse
 634     { exec } { pop pop } ifelse
 635   } /exec load 3 packedarray cvx exch
 636   (*) 3 1 roll /IODevice resourceforall
 637 } odef
 638 /devstatus {            % <(%disk*%)> devstatus <searchable> <writable>
 639                         %   <hasNames> <mounted> <removable> <searchOrder>
 640                         %   <freePages> <size> true
 641                         % <string> devstatus false
 642   dup length 5 ge {
 643     dup 0 5 getinterval (%disk) eq {
 644       dup /IODevice resourcestatus {
 645         pop pop dup currentdevparams
 646         dup /Searchable get
 647         exch dup /Writeable get
 648         exch dup /HasNames get
 649         exch dup /Mounted get
 650         exch dup /Removable get
 651         exch dup /SearchOrder get
 652         exch dup /Free get
 653         exch /LogicalSize get
 654         9 -1 roll pop true
 655       } {
 656         pop false
 657       } ifelse
 658     } {
 659       pop false
 660     } ifelse
 661   } {
 662     pop false
 663   } ifelse
 664 } odef
 665
 666 % ------ Color spaces ------ %
 667
 668 % Move setcolorsapce, setcolor, and colorspacedict to level2dict
 669 level2dict /setcolorspace .cspace_util 1 index get put
 670 level2dict /setcolor .cspace_util 1 index get put
 671 level2dict /colorspacedict .cspace_util 1 index get put
 672
 673 % Add the level 2 color spaces
 674 % DevicePixel is actually a LanguageLevel 3 feature; it is here for
 675 % historical reasons.
 676 %% Replace 1 (gs_devpxl.ps)
 677 (gs_devpxl.ps) runlibfile
 678
 679 %% Replace 1 (gs_ciecs2.ps)
 680 (gs_ciecs2.ps) runlibfile
 681
 682 %% Replace 1 (gs_indxd.ps)
 683 (gs_indxd.ps) runlibfile
 684
 685 %% Replace 1 (gs_sepr.ps)
 686 (gs_sepr.ps) runlibfile
 687
 688 %% Replace 1 (gs_patrn.ps)
 689 (gs_patrn.ps) runlibfile
 690
 691
 692
 693 % ------ CIE color rendering ------ %
 694
 695 % Define findcolorrendering and a default ColorRendering ProcSet.
 696
 697 /findcolorrendering {           % <intentname> findcolorrendering
 698                                 %   <crdname> <found>
 699   /ColorRendering /ProcSet findresource
 700   1 index .namestring (.) concatstrings
 701   1 index /GetPageDeviceName get exec .namestring (.) concatstrings
 702   2 index /GetHalftoneName get exec .namestring
 703   concatstrings concatstrings
 704   dup /ColorRendering resourcestatus {
 705     pop pop exch pop exch pop true
 706   } {
 707     pop /GetSubstituteCRD get exec false
 708   } ifelse
 709 } odef
 710
 711 5 dict dup begin
 712
 713 /GetPageDeviceName {            % - GetPageDeviceName <name>
 714   currentpagedevice dup /PageDeviceName .knownget {
 715     exch pop dup null eq { pop /none } if
 716   } {
 717     pop /none
 718   } ifelse
 719 } bind def
 720
 721 /GetHalftoneName {              % - GetHalftoneName <name>
 722   currenthalftone /HalftoneName .knownget not { /none } if
 723 } bind def
 724
 725 /GetSubstituteCRD {             % <intentname> GetSubstituteCRD <crdname>
 726   pop /DefaultColorRendering
 727 } bind def
 728
 729 end
 730 % The resource machinery hasn't been activated, so just save the ProcSet
 731 % and let .fixresources finish the installation process.
 732 /ColorRendering exch def
 733
 734 % Define setcolorrendering.
 735
 736 /.colorrenderingtypes 5 dict def
 737
 738 /setcolorrendering {            % <crd> setcolorrendering -
 739   dup /ColorRenderingType get //.colorrenderingtypes exch get exec
 740 } odef
 741
 742 /.setcolorrendering1 where { pop } { (%END CRD) .skipeof } ifelse
 743
 744 .colorrenderingtypes 1 {
 745   dup .buildcolorrendering1 .setcolorrendering1
 746 } .bind put
 747
 748 % Note: the value 101 in the next line must be the same as the value of
 749 % GX_DEVICE_CRD1_TYPE in gscrdp.h.
 750 .colorrenderingtypes 101 {
 751   dup .builddevicecolorrendering1 .setdevicecolorrendering1
 752 } .bind put
 753
 754 % sRGB output CRD, D65 white point
 755 mark
 756 /ColorRenderingType 1
 757 /RangePQR [ -0.5 2 -0.5 2 -0.5 2 ] readonly
 758
 759 % Bradford Cone Space
 760 /MatrixPQR [ 0.8951 -0.7502  0.0389
 761              0.2664  1.7135 -0.0685
 762             -0.1614  0.0367  1.0296] readonly
 763
 764 /MatrixLMN [ 3.240449 -0.969265  0.055643
 765             -1.537136  1.876011 -0.204026
 766             -0.498531  0.041556  1.057229 ] readonly
 767
 768 % Inverse sRGB gamma transform
 769 /EncodeABC [ { dup 0.00304 le
 770                 { 12.92321 mul }
 771                 { 1 2.4 div exp 1.055 mul 0.055 sub }
 772                ifelse
 773              } bind dup dup
 774            ] readonly
 775
 776 /WhitePoint [ 0.9505 1 1.0890 ] readonly % D65
 777 /BlackPoint [ 0 0 0 ] readonly
 778
 779 % VonKries-like transform in Bradford Cone Space
 780    /TransformPQR
 781      % The implementations have been moved to C for performance.
 782      [ { .TransformPQR_scale_WB0 } bind
 783        { .TransformPQR_scale_WB1 } bind
 784        { .TransformPQR_scale_WB2 } bind
 785      ] readonly
 786 .dicttomark setcolorrendering
 787
 788 %END CRD
 789
 790 % Initialize a CIEBased color space for sRGB.
 791 /CIEsRGB [ /CIEBasedABC
 792   mark
 793     /DecodeLMN [ {
 794       dup 0.03928 le { 12.92321 div } { 0.055 add 1.055 div 2.4 exp } ifelse
 795     } bind dup dup ] readonly
 796     /MatrixLMN [
 797       0.412457 0.212673 0.019334
 798       0.357576 0.715152 0.119192
 799       0.180437 0.072175 0.950301
 800     ] readonly
 801     /WhitePoint [0.9505 1.0 1.0890] readonly
 802   .dicttomark readonly
 803 ] readonly def
 804
 805 % ------ Painting ------ %
 806
 807 % A straightforward definition of execform that doesn't actually
 808 % do any caching.
 809 /.execform1 {
 810         % This is a separate operator so that the stacks will be restored
 811         % properly if an error occurs.
 812   dup /Matrix get concat
 813   dup /BBox get aload pop
 814   exch 3 index sub exch 2 index sub rectclip
 815   dup /PaintProc get
 816   1 index /Implementation known not {
 817     1 index dup /Implementation null .forceput readonly pop
 818   } if
 819   exec
 820 } .bind odef    % must bind .forceput
 821
 822 /.formtypes 5 dict
 823   dup 1 /.execform1 load put
 824 def
 825
 826 /execform {                     % <form> execform -
 827   gsave {
 828     dup /FormType get //.formtypes exch get exec
 829   } stopped grestore { stop } if
 830 } odef
 831
 832 /.patterntypes 5 dict
 833   dup 1 /.buildpattern1 load put
 834 def
 835
 836 /makepattern {                  % <proto_dict> <matrix> makepattern <pattern>
 837   //.patterntypes 2 index /PatternType get get
 838   .currentglobal false .setglobal exch
 839                 % Stack: proto matrix global buildproc
 840   3 index dup length 1 add dict .copydict
 841   3 index 3 -1 roll exec 3 -1 roll .setglobal
 842   1 index /Implementation 3 -1 roll put
 843   readonly exch pop exch pop
 844 } odef
 845
 846 /setpattern {                   % [<comp1> ...] <pattern> setpattern -
 847   currentcolorspace 0 get /Pattern ne {
 848     [ /Pattern currentcolorspace ] setcolorspace
 849   } if setcolor
 850 } odef
 851
 852 % The following functions emulate the actions of findcmykcustomcolor and
 853 % setcustomcolor.  These functions are described in Adobe's TN 5044.  That
 854 % same document also says "The following \93operators\94 are not defined in the
 855 % PostScript Language Reference Manual, but should be used as pseudo-operators
 856 % in your PostScript language output. Separation applications from Adobe
 857 % Systems and other vendors will redefine these convention operators to
 858 % separate your documents.  Your application should conditionally define
 859 % procedures with these special names, as shown later in this document."
 860 %
 861 % We are providing these functions because we have found files created by
 862 % "QuarkXPress: pictwpstops filter 1.0" which produce bad shading dictionaries
 863 % if these operators are not defined.
 864
 865 % Conditionally disable the TN 5044 psuedo-ops if NO_TN5044 specified
 866 /NO_TN5044 where { pop (%END TN 5044 psuedo-ops) .skipeof } if
 867
 868 % TN 5044 does not define the contents of the array.  We are simply putting
 869 % the values given into an array.  This is consistent with what we see when
 870 % testing with Adobe Distiller 6.0.
 871 %   <cyan> <magenta> <yellow> <black> <key> findcmykcustomcolor <array>
 872 /findcmykcustomcolor { 5 array astore } bind def
 873
 874 % Build a tint transform function for use by setcustomcolor.  This function
 875 % is for a Separation color space which has a DeviceCMYK base color space
 876 % (i.e. 1 input and 4 outputs).  The input to buildcustomtinttransform is the
 877 % array created by findcmykcustomcolor.  The resulting function is:
 878 %   { dup cyan mul exch dup magenta mul exch dup yellow mul exch black mul }
 879 %   Where cyan, magenta, yellow, and black are values from the array.
 880 /buildcustomtinttransform       % <array> buildcustomtinttransform <function>
 881 { [ /dup load 2 index 0 get /mul load
 882   /exch load /dup load 6 index 1 get /mul load
 883   /exch load /dup load 10 index 2 get /mul load
 884   /exch load 13 index 3 get /mul load
 885   ] cvx bind
 886   exch pop                      % Remove the input array
 887 } bind def
 888
 889 % Set a custom color based upon a tint and array which describes the custom
 890 % color.  See findcmykcustomcolor.  First we create and then set a Separation
 891 % colorspace.  Then we set the specified color.
 892 % Note that older Adobe ProcSets apparently allow for 'null' as the tint
 893 % for some reason, so an alternate operational mode is tolerated:
 894 %                                           null setcustomcolor -
 895 /setcustomcolor                 % <array> <tint> setcustomcolor -
 896 { dup //null ne {
 897     % Start building Separation colorspace
 898     [ /Separation 3 index 4 get % Get separation name from array's key
 899     /DeviceCMYK
 900     5 index buildcustomtinttransform ]  % build the tint transform function
 901     setcolorspace                       % Set the Separation color space as current
 902     setcolor                    % Set the tint as the current color
 903     pop                         % Remove the input array
 904   }
 905   { pop }       % 'null' as the tint is ignored
 906   ifelse
 907 } bind def
 908
 909 % This proc is supposed to implement a version of overprinting. TN 5044 says
 910 % that this proc is not used by any shipping host-based application. We have
 911 % only found it being used in a proc set in files by Canvas from Deneba Systems.
 912 % Even their proc set does not actually do any overprinting.  However their
 913 % files crash if this is not defined.  Thus we have a copy of this proc but
 914 % we are simply checking for inputs being -1 and if so then we set the value
 915 % to 0.
 916 /setcmykoverprint {
 917   4 { dup -1 eq { pop 0 } if 4 1 roll } repeat setcmykcolor
 918 } bind def
 919
 920 %END TN 5044 psuedo-ops
 921
 922 end                             % level2dict