Plan 9 from Bell Labs’s /usr/web/sources/plan9/sys/src/cmd/gs/lib/gs_res.ps

Copyright © 2021 Plan 9 Foundation.
Distributed under the MIT License.
Download the Plan 9 distribution.


%    Copyright (C) 1994, 1996, 1997, 1998, 1999, 2000 Aladdin Enterprises.  All rights reserved.
% 
% This software is provided AS-IS with no warranty, either express or
% implied.
% 
% This software is distributed under license and may not be copied,
% modified or distributed except as expressly authorized under the terms
% of the license contained in the file LICENSE in this distribution.
% 
% For more information about licensing, please refer to
% http://www.ghostscript.com/licensing/. For information on
% commercial licensing, go to http://www.artifex.com/licensing/ or
% contact Artifex Software, Inc., 101 Lucas Valley Road #110,
% San Rafael, CA  94903, U.S.A., +1(415)492-9861.

% $Id: gs_res.ps,v 1.38 2004/10/26 17:07:18 igor Exp $
% Initialization file for Level 2 resource machinery.
% When this is run, systemdict is still writable,
% but (almost) everything defined here goes into level2dict.

level2dict begin

(BEGIN RESOURCES) VMDEBUG

% We keep track of (global) instances with another entry in the resource
% dictionary, an .Instances dictionary.  For categories with implicit
% instances, the values in .Instances are the same as the keys;
% for other categories, the values are [instance status size].

% Note that the dictionary that defines a resource category is stored
% in global VM.  The PostScript manual says that each category must
% manage global and local instances separately.  However, objects in
% global VM other than systemdict can't reference objects in local VM.
% This means that the resource category dictionary, which would otherwise be
% the obvious place to keep track of the instances, can't be used to keep
% track of local instances.  Instead, we define a dictionary in local VM
% called localinstancedict, in which the key is the category name and
% the value is the analogue of .Instances for local instances.

% We don't currently implement automatic resource unloading.
% When and if we do, it should be hooked to the garbage collector.
% However, Ed Taft of Adobe says their interpreters don't implement this
% either, so we aren't going to worry about it for a while.

currentglobal false setglobal systemdict begin
  /localinstancedict 5 dict
  .forcedef	% localinstancedict is local, systemdict is global
end true setglobal
/.emptydict 0 dict readonly def
setglobal

% Resource category dictionaries have the following keys (those marked with
% * are optional):
%	Standard, defined in the Red Book:
%		Category (name)
%		*InstanceType (name)
%		DefineResource
%			<key> <instance> DefineResource <instance>
%		UndefineResource
%			<key> UndefineResource -
%		FindResource
%			<key> FindResource <instance>
%		ResourceStatus
%			<key> ResourceStatus <status> <size> true
%			<key> ResourceStatus false
%		ResourceForAll
%			<template> <proc> <scratch> ResourceForAll -
%		*ResourceFileName
%			<key> <scratch> ResourceFileName <filename>
%	Additional, specific to our implementation:
%		.Instances (dictionary)
%		.LocalInstances
%			- .LocalInstances <dict>
%		.GetInstance
%			<key> .GetInstance <instance> -true-
%			<key> .GetInstance -false-
%		.CheckResource
%			<key> <value> .CheckResource <key> <value> <ok>
%			  (or may give an error if not OK)
%		.DoLoadResource
%			<key> .DoLoadResource <key> (may give an error)
%		.LoadResource
%			<key> .LoadResource - (may give an error)
%		.ResourceFile
%			<key> .ResourceFile <file> -true-
%			<key> .ResourceFile <key> -false-
%		.ResourceFileStatus
%			<key> .ResourceFileStatus 2 <vmusage> -true-
%			<key> .ResourceFileStatus -false-
% All the above procedures expect that the top dictionary on the d-stack
% is the resource dictionary.

% Define enough of the Category category so we can define other categories.
% The dictionary we're about to create will become the Category
% category definition dictionary.

% .findcategory and .resourceexec are only called from within the
% implementation of the resource 'operators', so they doesn't have to worry
% about cleaning up the stack if they fail (the interpreter's stack
% protection machinery for pseudo-operators takes care of this).
/.findcategory {	% <name> .findcategory -
			%   (pushes the category on the dstack)
  /Category findresource begin
} bind def

/.resourceexec {	% <key> /xxxResource .resourceexec -
			%   (also pops the category from the dstack)
  load exec end
} bind def

% .getvminstance treats instances on disk as undefined.
/.getvminstance {	% <key> .getvminstance <instance> -true-
			% <key> .getvminstance -false-
  .GetInstance {
    dup 1 get 2 ne { true } { pop false } ifelse
  } {
    false
  } ifelse
} bind def

20 dict begin

		% Standard entries

/Category /Category def
/InstanceType /dicttype def

/DefineResource {
	.CheckResource {
	  dup /Category 3 index cvlit .growput
	  dup [ exch 0 -1 ] exch
	  .Instances 4 2 roll put
		% Make the Category dictionary read-only.  We will have to
		% use .forceput / .forcedef later to replace the dummy,
		% empty .Instances dictionary with the real one later.
	  readonly
	} {
	  /defineresource load /typecheck signalerror
	} ifelse
} bind def
/FindResource		% (redefined below)
	{ .Instances exch get 0 get
	} bind def

		% Additional entries

/.Instances 30 dict def
.Instances /Category [currentdict 0 -1] put

/.LocalInstances 0 dict def
/.GetInstance
	{ .Instances exch .knownget
	} bind def
/.CheckResource
	{ dup gcheck currentglobal and
	   { /DefineResource /FindResource /ResourceForAll /ResourceStatus
	     /UndefineResource }
	   { 2 index exch known and }
	  forall
	  not { /defineresource load /invalidaccess signalerror } if
	  true
	} bind def

.Instances end begin	% for the base case of findresource

(END CATEGORY) VMDEBUG

% Define the resource operators.  We use the "stack protection" feature of
% odef to make sure the stacks are restored properly on an error.
% This requires that the operators not pop anything from the stack until
% they have executed their logic successfully.  We can't make this
% work for resourceforall, because the procedure it executes mustn't see
% the operands of resourceforall on the stack, but we can make it work for
% the others.

% findresource is the only operator that needs to bind //Category.
/findresource {		% <key> <category> findresource <instance>
	2 copy dup /Category eq
	  { pop //Category 0 get begin } { .findcategory } ifelse
	/FindResource .resourceexec exch pop exch pop
} bind
end		% .Instances of Category
odef

/defineresource {	% <key> <instance> <category> defineresource <instance>
	3 copy .findcategory
	currentdict /InstanceType known {
	  dup type InstanceType ne {
	    dup type /packedarraytype eq InstanceType /arraytype eq and
	    not { /defineresource load /typecheck signalerror } if
	  } if
	} if
	/DefineResource .resourceexec
	4 1 roll pop pop pop
} bind odef
% We must prevent resourceforall from automatically restoring the stacks,
% because we don't want the stacks restored if proc causes an error or
% executes a 'stop'. On the other hand, resourceforall is defined in the
% PLRM as an operator, so it must have type /operatortype.  We hack this
% by taking advantage of the fact that the interpreter optimizes tail
% calls, so stack protection doesn't apply to the very last token of an
% operator procedure.
/resourceforall1 {	% <template> <proc> <scratch> <category> resourceforall1 -
	dup /Category findresource begin
	/ResourceForAll load
	% Stack: <template> <proc> <scratch> <category> proc
	exch pop		% pop the category
	exec end
} bind def
/resourceforall {	% <template> <proc> <scratch> <category> resourceforall1 -
	//resourceforall1 exec		% see above
} bind odef
/resourcestatus {	% <key> <category> resourcestatus <status> <size> true
			% <key> <category> resourcestatus false
	2 copy .findcategory /ResourceStatus .resourceexec
	 { 4 2 roll pop pop true } { pop pop false } ifelse
} bind odef
/undefineresource {	% <key> <category> undefineresource -
	2 copy .findcategory /UndefineResource .resourceexec pop pop
} bind odef

% Define the system parameters used for the Generic implementation of
% ResourceFileName.
systemdict begin

%     - .default_resource_dir <string>
/.default_resource_dir {
  .file_name_parent .file_name_directory_separator concatstrings
  (Resource) concatstrings
  /LIBPATH .systemvar {
    dup .file_name_current eq {
      pop
    } {
      1 index false .file_name_combine {
        exch pop exit
      } {
        pop pop
      } ifelse
    } ifelse
  } forall
} bind def

%  <path> <name> <string> .resource_dir_name <path> <name> <string>
/.resource_dir_name
{  systemdict 2 index .knownget {
     exch pop
     systemdict 1 index undef
   } {
     dup () ne {
     .file_name_directory_separator concatstrings
    } if
    2 index exch false .file_name_combine not {
      (Error: .default_resource_dir returned ) print exch print ( that can't combine with ) print =
      /.default_resource_dir /configurationerror .signalerror
    } if
  } ifelse
} bind def

currentdict /pssystemparams known not {
  /pssystemparams 10 dict readonly def
} if
pssystemparams begin
  .default_resource_dir
  /FontResourceDir (Font) .resource_dir_name
     readonly .forcedef	% pssys'params is r-o
  /GenericResourceDir () .resource_dir_name
     readonly .forcedef	% pssys'params is r-o
  pop % .default_resource_dir
  /GenericResourcePathSep
  	.file_name_separator readonly .forcedef		% pssys'params is r-o
  (%diskFontResourceDir) cvn (/Resource/Font/) readonly .forcedef	% pssys'params is r-o
  (%diskGenericResourceDir) cvn (/Resource/) readonly .forcedef	% pssys'params is r-o
end
end

% Check if GenericResourceDir presents in LIBPATH.

% The value of GenericResourceDir must end with directory separator.
% We use .file_name_combine to check it. 
% Comments use OpenVMS syntax, because it is the most complicated case.
(x) pssystemparams /GenericResourcePathSep get
(y) concatstrings concatstrings dup length              % (x]y) l1
pssystemparams /GenericResourceDir get dup length exch  % (x]y) l1 l2 (dir)
3 index true .file_name_combine not {
  exch
  (File name ) print print ( cant combine with ) print =
  /GenericResourceDir cvx /configurationerror signalerror
} if
dup length                                              % (x]y) l1 l2 (dir.x]y) l
4 2 roll add                                            % (x]y) (dir.x]y) l ll
ne {
  (GenericResourceDir value does not end with directory separator.\n) =
  /GenericResourceDir cvx /configurationerror signalerror
} if
pop pop

% Define the generic algorithm for computing resource file names.
/.rfnstring 8192 string def
/.genericrfn		% <key> <scratch> <prefix> .genericrfn <filename>
 { 3 -1 roll //.rfnstring cvs concatstrings exch copy
 } bind def

% Define a procedure for making a packed array in local VM.
/.localpackedarray {	% <obj1> ... <objn> <n> .localpackedarray <packedarray>
  .currentglobal false .setglobal 1 index 2 add 1 roll
  packedarray exch .setglobal
} bind def

% Define the Generic category.

/Generic mark

		% Standard entries

% We're still running in Level 1 mode, so dictionaries won't expand.
% Leave room for the /Category entry.
/Category null

% Implement the body of Generic resourceforall for local, global, and
% external cases.  'args' is [template proc scratch resdict].
/.enumerateresource {	% <key> [- <proc> <scratch>] .enumerateresource -
  1 index type dup /stringtype eq exch /nametype eq or {
    exch 1 index 2 get cvs exch
  } if
	% Use .setstackprotect to prevent the stacks from being restored if
	% an error occurs during execution of proc.
  1 get false .setstackprotect exec true .setstackprotect
} bind def
/.localresourceforall {		% <key> <value> <args> .localr'forall -
  exch pop
  2 copy 0 get .stringmatch { .enumerateresource } { pop pop } ifelse
} bind def
/.globalresourceforall {	% <key> <value> <args> .globalr'forall -
  exch pop
  2 copy 0 get .stringmatch {
    dup 3 get begin .LocalInstances end 2 index known not {
      .enumerateresource
    } {
      pop pop
    } ifelse
  } {
    pop pop
  } ifelse
} bind def
/.externalresourceforall {	% <filename> <len> <args> .externalr'forall -
  3 1 roll 1 index length 1 index sub getinterval exch
  dup 3 get begin .Instances .LocalInstances end
		% Stack: key args insts localinsts
  3 index known {
    pop pop pop
  } {
    2 index known { pop pop } { .enumerateresource } ifelse
  } ifelse
} bind def

/DefineResource {
	.CheckResource
	   { dup [ exch 0 -1 ]
			% Stack: key value instance
	     currentglobal
	      { false setglobal 2 index UndefineResource	% remove local def if any
		true setglobal
		.Instances dup //.emptydict eq {
		  pop 3 dict
			% As noted above, Category dictionaries are read-only,
			% so we have to use .forcedef here.
		  /.Instances 1 index .forcedef	% Category dict is read-only
		} if
	      }
	      { .LocalInstances dup //.emptydict eq
	         { pop 3 dict localinstancedict Category 2 index put
		 }
		if
	      }
	     ifelse
			% Stack: key value instance instancedict
	     3 index 2 index .growput
			% Now make the resource value read-only.
	     0 2 copy get { readonly } .internalstopped pop
	     dup 4 1 roll put exch pop exch pop
	   }
	   { /defineresource load /typecheck signalerror
	   }
	ifelse
} .bind executeonly		% executeonly to prevent access to .forcedef
/UndefineResource
	{  { dup 2 index .knownget
	      { dup 1 get 1 ge
		 { dup 0 null put 1 2 put pop pop }
		 { pop exch .undef }
		ifelse
	      }
	      { pop pop
	      }
	     ifelse
	   }
	  currentglobal
	   { 2 copy .Instances exch exec
	   }
	  if .LocalInstances exch exec
	} bind
% Because of some badly designed code in Adobe's CID font downloader that
% makes findresource and resourcestatus deliberately inconsistent with each
% other, the default FindResource must not call ResourceStatus if there is
% an instance of the desired name already defined in VM.
/FindResource {
	dup .getvminstance {
	  exch pop 0 get
	} {
	  dup ResourceStatus {
	    pop 1 gt {
	      .DoLoadResource .getvminstance not {
		/findresource load /undefinedresource signalerror
	      } if 0 get
	    } {
	      .GetInstance pop 0 get
	    } ifelse
	  } {
	   /findresource load /undefinedresource signalerror
	  } ifelse
	} ifelse
} bind
% Because of some badly designed code in Adobe's CID font downloader, the
% definition of ResourceStatus for Generic and Font must be the same (!).
% We patch around this by using an intermediate .ResourceFileStatus procedure.
/ResourceStatus {
	dup .GetInstance {
	  exch pop dup 1 get exch 2 get true
	} {
	  .ResourceFileStatus
	} ifelse
} bind
/.ResourceFileStatus {
	.ResourceFile { closefile 2 -1 true } { pop false } ifelse
} bind
/ResourceForAll {
		% Construct a new procedure to hold the arguments.
		% All objects constructed here must be in local VM to avoid
		% a possible invalidaccess.
	currentdict 4 .localpackedarray	% [template proc scratch resdict]
		% We must pop the resource dictionary off the dict stack
		% when doing the actual iteration, and restore it afterwards.
	.currentglobal not {
	  .LocalInstances length 0 ne {
		% We must do local instances, and do them first.
	    //.localresourceforall {exec} 0 get 3 .localpackedarray cvx
	    .LocalInstances exch {forall} 0 get 1 index 0 get
	    currentdict end 3 .execn begin
	  } if
	} if
		% Do global instances next.
	//.globalresourceforall {exec} 0 get 3 .localpackedarray cvx
	.Instances exch cvx {forall} 0 get 1 index 0 get
	currentdict end 3 .execn begin
        mark                                             % args [
        Category .namestring .file_name_separator concatstrings
        2 index 0 get                                    % args [ (c/) (t)
        dup length 3 1 roll                              % args [ l (c/) (t)
        concatstrings                                    % args [ l (c/t)
	[ 
	  /LIBPATH .systemvar 2 index
	  .generate_dir_list_templates                   % args (t) [ l [(pt)]
	    % also add on the Resources as specified by the GenericResourceDir
          [ currentsystemparams /GenericResourceDir get]
	  counttomark 1 add index .generate_dir_list_templates
            % Resource files on OpenVMS requires a separate template (gs:[dir.*]*)
          [ currentsystemparams /GenericResourceDir get]
	  counttomark 1 add index .file_name_separator (*)
          concatstrings concatstrings .generate_dir_list_templates
	  ] exch pop
	{                                                % args [ l (pt)
	  dup length 2 index sub exch                    % args [ l Lp (pt)

	  {                                              % args [ l Lp (pf)
	    dup length                                   % args [ l Lp (pf) Lpf
	    2 index sub                                  % args [ l Lp (pf) Lf
	    2 index exch                                 % args [ l Lp (pf) Lp Lf
	    getinterval cvn dup                          % args [ l Lp /n /n
	    4 2 roll                                     % args [ /n /n l Lp
	  } //.rfnstring filenameforall
	  pop                                            % args [ l /n1 /n1 ... /nN /nN l
	} forall                                         % args [ l /n1 /n1 ... /nN /nN
	pop
	.dicttomark % An easy way to exclude duplicates. % args <</n/n>>
	  % {
	  { pop } 0 get
          2 index 2 get { cvs 0 } aload pop 5 index
          //.externalresourceforall {exec} 0 get
          % }
        7 .localpackedarray cvx
        3 2 roll pop % args
	{ forall } 0 get
  	currentdict end 2 .execn begin
} bind
/ResourceFileName
	  {                                             % /in (scr)
	    exch //.rfnstring cvs                       % (scr) (n)
            /GenericResourcePathSep getsystemparam exch % (scr) (/) (n)
            Category .namestring                        % (scr) (/) (n) (c)
            3 1 roll                                    % (scr) (c) (/) (n)
	    concatstrings concatstrings                 % (scr) (c/n)
            /GenericResourceDir getsystemparam .file_name_is_absolute not {
              /GenericResourceDir getsystemparam exch concatstrings
	      findlibfile
	      {                                         % (scr) (p/c/n) file
	        pop exch copy true                      % (p/c/n) true
	      } {                                       % (scr) (c/n)
	        false                                   % (scr) (c/n) false
	      } ifelse
	    } {                                         % (scr) (c/n)
	      false                                     % (scr) (c/n) false
	    } ifelse
	    not {                                       % (scr) (c/n)
              /GenericResourceDir getsystemparam        % (scr) (c/n) (d/)
              dup length exch                           % (scr) (c/n) Ld (d/)
              3 index copy pop                          % (scr') (c/n) Ld
              1 index length                            % (scr') (c/n) Ld Lcn
              3 index 3 copy pop                        % (scr') (c/n) Ld Lcn (scr') Ld Lcn
              getinterval                               % (scr') (c/n) Ld Lcn (scr[Ld:Lcn])
              4 3 roll exch                             % (scr') Ld Lcn (c/n) (scr[Ld:Lcn])
              copy pop                                  % (scr'') Ld Lcn
              add 0 exch getinterval                    % (scr''[0:Ld+Lcn])
	    } if
	  } bind

		% Additional entries

% Unfortunately, we can't create the real .Instances dictionary now,
% because if someone copies the Generic category (which pp. 95-96 of the
% 2nd Edition Red Book says is legitimate), they'll wind up sharing
% the .Instances.  Instead, we have to create .Instances on demand,
% just like the entry in localinstancedict.
% We also have to prevent anyone from creating instances of Generic itself.
/.Instances //.emptydict

/.LocalInstances
	{ localinstancedict Category .knownget not { //.emptydict } if
	} bind
/.GetInstance
	{ currentglobal
	   { .Instances exch .knownget }
	   { .LocalInstances 1 index .knownget
	      { exch pop true }
	      { .Instances exch .knownget }
	     ifelse
	   }
	  ifelse
	} bind
/.CheckResource
	{ true
	} bind
/.vmused {
		% - .vmused <usedvalue>
		% usedvalue = vmstatus in global + vmstatus in local.
  0 2 {
    .currentglobal not .setglobal
    vmstatus pop exch pop add
  } repeat
} bind def
/.DoLoadResource {
		% .LoadResource may push entries on the operand stack.
		% It is an undocumented feature of Adobe implementations,
		% which we must match for the sake of some badly written
		% font downloading code, that such entries are popped
		% automatically.
	count 1 index cvlit .vmused
		% Stack: key count litkey memused
	{.LoadResource} 4 1 roll 4 .execn
		% Stack: ... count key memused
	.vmused exch sub
	1 index .getvminstance not {
	  pop dup /undefinedresource signalerror	% didn't load
	} if
	dup 1 1 put
	2 3 -1 roll put
		% Stack: ... count key
	exch count 1 sub exch sub {exch pop} repeat
} bind
/.LoadResource
	{ dup .ResourceFile
	   { exch pop currentglobal
	      { .runresource }
	      { true setglobal { .runresource } stopped false setglobal { stop } if }
	     ifelse
	   }
	   { dup /undefinedresource signalerror
	   }
	 ifelse
	} bind
/.ResourceFile
        {
          Category //.rfnstring cvs length                      % key l
          dup //.rfnstring dup length 2 index sub               % key l l (buf) L-l
          3 2 roll exch getinterval                             % key l ()
          .file_name_directory_separator exch copy length add   % key l1
          dup //.rfnstring dup length 2 index sub               % key l1 l1 (buf) L-l
          3 2 roll exch getinterval                             % key l1 ()
          2 index exch cvs length add                           % key l2
          //.rfnstring exch 0 exch getinterval                  % key (relative_path)
          .libfile {
            exch pop true
          } {
            pop
            currentdict /ResourceFileName known {
	      mark 1 index //.rfnstring { ResourceFileName } .internalstopped {
	        cleartomark false
	      } {
	        dup status {
	          pop pop pop pop
	          (r) file
	          exch pop exch pop true
	        } {
	          cleartomark false
	        } ifelse
	      } ifelse
	     } {
	       pop false
	     } ifelse
          } ifelse
	} bind



.dicttomark
/Category defineresource pop

% Fill in the rest of the Category category.
/Category /Category findresource dup
/Generic /Category findresource begin {
  /FindResource /ResourceForAll /ResourceStatus /.ResourceFileStatus
  /UndefineResource /ResourceFileName
  /.ResourceFile /.LoadResource /.DoLoadResource
} { dup load put dup } forall
pop readonly pop end

(END GENERIC) VMDEBUG

% Define the fixed categories.

mark
	% Non-Type categories with existing entries.
 /ColorSpaceFamily
   { }	% These must be deferred, because optional features may add some.
 /Emulator
   mark EMULATORS { cvn } forall .packtomark
 /Filter
   { }	% These must be deferred, because optional features may add some.
 /IODevice
	% Loop until the .getiodevice gets a rangecheck.
   errordict /rangecheck 2 copy get
   errordict /rangecheck { pop stop } put	% pop the command
   mark 0 { {
    dup .getiodevice dup null eq { pop } { exch } ifelse 1 add
   } loop} .internalstopped
   pop pop pop .packtomark
   4 1 roll put
   .clearerror
	% Type categories listed in the Red Book.
 /ColorRenderingType
   { }	% These must be deferred, because optional features may add some.
 /FMapType
   { }	% These must be deferred, because optional features may add some.
 /FontType
   { }	% These must be deferred, because optional features may add some.
 /FormType
   { }	% These must be deferred, because optional features may add some.
 /HalftoneType
   { }	% These must be deferred, because optional features may add some.
 /ImageType
   { }	% Deferred, optional features may add some.
 /PatternType
   { }  % Deferred, optional features may add some.
	% Type categories added since the Red Book.
 /setsmoothness where {
   pop /ShadingType { }	% Deferred, optional features may add some.
 } if
counttomark 2 idiv
 { mark

		% Standard entries

		% We'd like to prohibit defineresource,
		% but because optional features may add entries, we can't.
		% We can at least require that the key and value match.
   /DefineResource
	{ currentglobal not
	   { /defineresource load /invalidaccess signalerror }
	   { 2 copy ne
	      { /defineresource load /rangecheck signalerror }
	      { dup .Instances 4 -2 roll .growput }
	     ifelse
	   }
	  ifelse
	} bind
   /UndefineResource
	{ /undefineresource load /invalidaccess signalerror } bind
   /FindResource
	{ .Instances 1 index .knownget
	   { exch pop }
	   { /findresource load /undefinedresource signalerror }
	  ifelse
	} bind
   /ResourceStatus
	{ .Instances exch known { 0 0 true } { false } ifelse } bind
   /ResourceForAll
	/Generic /Category findresource /ResourceForAll get

		% Additional entries

   counttomark 2 add -1 roll
   dup length dict dup begin exch { dup def } forall end
		% We'd like to make the .Instances readonly here,
		% but because optional features may add entries, we can't.
   /.Instances exch
   /.LocalInstances	% used by ResourceForAll
	0 dict def

   .dicttomark /Category defineresource pop
 } repeat pop

(END FIXED) VMDEBUG

% Define the other built-in categories.

/.definecategory	% <name> -mark- <key1> ... <valuen> .definecategory -
 { counttomark 2 idiv 2 add		% .Instances, Category
   /Generic /Category findresource dup maxlength 3 -1 roll add
   dict .copydict begin
   counttomark 2 idiv { def } repeat pop	% pop the mark
   currentdict end /Category defineresource pop
 } bind def

/ColorRendering mark /InstanceType /dicttype .definecategory
% ColorSpace is defined below
% Encoding is defined below
% Font is defined below
/Form mark /InstanceType /dicttype .definecategory
/Halftone mark /InstanceType /dicttype .definecategory
/Pattern mark /InstanceType /dicttype .definecategory
/ProcSet mark /InstanceType /dicttype .definecategory
% Added since the Red Book:
/ControlLanguage mark /InstanceType /dicttype .definecategory
/HWOptions mark /InstanceType /dicttype .definecategory
/Localization mark /InstanceType /dicttype .definecategory
/OutputDevice mark /InstanceType /dicttype .definecategory
/PDL mark /InstanceType /dicttype .definecategory
% CIDFont, CIDMap, and CMap are defined in gs_cidfn.ps
% FontSet is defined in gs_cff.ps
% IdiomSet is defined in gs_ll3.ps
% InkParams and TrapParams are defined in gs_trap.ps

(END MISC) VMDEBUG

% Define the ColorSpace category.

/.defaultcsnames mark
  /DefaultGray 0
  /DefaultRGB 1
  /DefaultCMYK 2
.dicttomark readonly def

% The "hooks" are no-ops here, redefined in LL3.
/.definedefaultcs {	% <index> <value> .definedefaultcs -
  pop pop
} bind def
/.undefinedefaultcs {	% <index> .undefinedefaultcs -
  pop
} bind def

/ColorSpace mark

/InstanceType /arraytype

% We keep track of whether there are any local definitions for any of
% the Default keys.  This information must get saved and restored in
% parallel with the local instance dictionary, so it must be stored in
% local VM.
userdict /.localcsdefaults false put

/DefineResource {
  2 copy /Generic /Category findresource /DefineResource get exec
  exch pop
  exch //.defaultcsnames exch .knownget {
    1 index .definedefaultcs
    currentglobal not { .userdict /.localcsdefaults true put } if
  } if
} bind

/UndefineResource {
  dup /Generic /Category findresource /UndefineResource get exec
  //.defaultcsnames 1 index .knownget {
	% Stack: resname index
    currentglobal {
      .undefinedefaultcs pop
    } {
	% We removed the local definition, but there might be a global one.
      exch .GetInstance {
	0 get .definedefaultcs
      } {
	.undefinedefaultcs
      } ifelse
	% Recompute .localcsdefaults by scanning.  This is rarely needed.
      .userdict /.localcsdefaults false //.defaultcsnames {
	pop .LocalInstances exch known { pop true exit } if
      } forall put
    } ifelse
  } {
    pop
  } ifelse
} bind

.definecategory			% ColorSpace

% Define the Encoding category.

/Encoding mark

/InstanceType /arraytype

% Handle already-registered encodings, including lazily loaded encodings
% that aren't loaded yet.

/.Instances mark
  EncodingDirectory
   { dup length 256 eq { [ exch readonly 0 -1 ] } { pop [null 2 -1] } ifelse
   } forall
.dicttomark

/.ResourceFileDict mark
  EncodingDirectory
   { dup length 256 eq { pop pop } { 0 get } ifelse
   } forall
.dicttomark

/ResourceFileName
 { .ResourceFileDict 2 index .knownget
    { exch copy exch pop }
    { /Generic /Category findresource /ResourceFileName get exec }
   ifelse
 } bind

.definecategory			% Encoding

% Make placeholders in level2dict for the redefined Encoding operators,
% so that they will be swapped properly when we switch language levels.

/.findencoding /.findencoding load def
/findencoding /findencoding load def
/.defineencoding /.defineencoding load def

(END ENCODING) VMDEBUG

% Define the Font category.

/.fontstatus {		% <fontname> .fontstatus <fontname> <found>
  {		% Create a loop context just so we can exit it early.
		% Check Fontmap.
    Fontmap 1 index .knownget {
      {
	dup type /nametype eq {
	  .fontstatus { pop null exit } if
	} {
	  dup type /stringtype eq {
	    findlibfile { closefile pop null exit } if pop
	  } {
		% Procedure, assume success.
	    pop null exit
	  } ifelse
	} ifelse
      } forall dup null eq { pop true exit } if
    } if
		% Convert names to strings; give up on other types.
    dup type /nametype eq { .namestring } if
    dup type /stringtype ne { false exit } if
		% Check the resource directory.
    dup .fonttempstring /FontResourceDir getsystemparam .genericrfn
    status {
      pop pop pop pop true exit
    } if
		% Check for a file on the search path with the same name
		% as the font.
    findlibfile { closefile true exit } if
		% Scan a FONTPATH directory and try again.
    .scannextfontdir not { false exit } if
  } loop
} bind def

/Font mark

/InstanceType /dicttype

/DefineResource
	{ 2 copy //definefont exch pop
	  /Generic /Category findresource /DefineResource get exec
	} bind
/UndefineResource
	{ dup //undefinefont
	  /Generic /Category findresource /UndefineResource get exec
	} bind
/FindResource {
	dup .getvminstance {
	  exch pop 0 get
	} {
	  dup ResourceStatus {
	    pop 1 gt { .loadfontresource } { .GetInstance pop 0 get } ifelse
	  } {
	    .loadfontresource
	  } ifelse
	} ifelse
} bind
/ResourceForAll {
	{ .scannextfontdir not { exit } if } loop
	/Generic /Category findresource /ResourceForAll get exec
} bind
/.ResourceFileStatus {
	.fontstatus { pop 2 -1 true } { pop false } ifelse
} bind

/.loadfontresource {
	dup vmstatus pop exch pop exch
		% Hack: rebind .currentresourcefile so that all calls of
		% definefont will know these are built-in fonts.
	currentfile {pop //findfont exec} .execasresource  % (findfont is a procedure)
	exch vmstatus pop exch pop exch sub
		% stack: name font vmused
		% findfont has the prerogative of not calling definefont
		% in certain obscure cases of font substitution.
	2 index .getvminstance {
	  dup 1 1 put
	  2 3 -1 roll put
	} {
	  pop
	} ifelse exch pop
} bind

/.Instances FontDirectory length 2 mul dict

.definecategory			% Font

% Redefine font "operators".
/.definefontmap
 { /Font /Category findresource /.Instances get
   dup 3 index known
    { pop
    }
    { 2 index
		% Make sure we create the array in global VM.
      .currentglobal true .setglobal
      [null 2 -1] exch .setglobal
      .growput
    }
   ifelse
   //.definefontmap exec
 } bind def

% Make sure the old definitions are still in systemdict so that
% they will get bound properly.
systemdict begin
  /.origdefinefont /definefont load def
  /.origundefinefont /undefinefont load def
  /.origfindfont /findfont load def
end
/definefont {
  /Font defineresource
} bind odef
/undefinefont {
  /Font undefineresource
} bind odef
% The Red Book requires that findfont be a procedure, not an operator,
% but it still needs to restore the stacks reliably if it fails.
/.findfontop {
  /Font findresource
} bind odef
/findfont {
  .findfontop
} bind def	% Must be a procedure, not an operator

% Remove initialization utilities.
currentdict /.definecategory .undef
currentdict /.emptydict .undef

end				% level2dict

% Convert deferred resources after we finally switch to Level 2.

/.fixresources {
	% Encoding resources
  EncodingDirectory
   { dup length 256 eq
      { /Encoding defineresource pop }
      { pop pop }
     ifelse
   } forall
  /.findencoding { /Encoding findresource } bind def
  /findencoding /.findencoding load def		% must be a procedure
  /.defineencoding { /Encoding defineresource pop } bind def
	% ColorRendering resources and ProcSet
  systemdict /ColorRendering .knownget {
    /ColorRendering exch /ProcSet defineresource pop
    systemdict /ColorRendering undef
    /DefaultColorRendering currentcolorrendering /ColorRendering defineresource pop
  } if
	% ColorSpace resources
  systemdict /CIEsRGB .knownget {
    /sRGB exch /ColorSpace defineresource pop
    systemdict /CIEsRGB undef
  } if
	% ColorSpaceFamily resources
  colorspacedict { pop dup /ColorSpaceFamily defineresource pop } forall
	% Filter resources
  filterdict { pop dup /Filter defineresource pop } forall
	% FontType and FMapType resources
  buildfontdict { pop dup /FontType defineresource pop } forall
  mark
    buildfontdict 0 known { 2 3 4 5 6 7 8 } if
    buildfontdict 9 known { 9 } if
  counttomark { dup /FMapType defineresource pop } repeat pop
	% FormType resources
  .formtypes { pop dup /FormType defineresource pop } forall
	% HalftoneType resources
  .halftonetypes { pop dup /HalftoneType defineresource pop } forall
	% ColorRenderingType resources
  .colorrenderingtypes {pop dup /ColorRenderingType defineresource pop} forall
	% ImageType resources
  .imagetypes { pop dup /ImageType defineresource pop } forall
	% PatternType resources
  .patterntypes { pop dup /PatternType defineresource pop } forall
	% Make the fixed resource categories immutable.
  /.shadingtypes where {
    pop .shadingtypes { pop dup /ShadingType defineresource pop } forall
  } if
  [ /ColorSpaceFamily /Emulator /Filter /IODevice /ColorRenderingType
    /FMapType /FontType /FormType /HalftoneType /ImageType /PatternType
    /.shadingtypes where { pop /ShadingType } if
  ] {
    /Category findresource
    dup /.Instances get readonly pop
    .LocalInstances readonly pop
    readonly pop
  } forall
	% clean up
  systemdict /.fixresources undef
} bind def

%% Replace 1 (gs_resmp.ps)
(gs_resmp.ps)  dup runlibfile VMDEBUG
%% Replace 1 (gs_resst.ps)
(gs_resst.ps)  dup runlibfile VMDEBUG

Bell Labs OSI certified Powered by Plan 9

(Return to Plan 9 Home Page)

Copyright © 2021 Plan 9 Foundation. All Rights Reserved.
Comments to webmaster@9p.io.