|
12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127 |
- % 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 10678 2010-01-31 20:30:13Z alexcher $
- % 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 don'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).
- % Note that all places that look up categories must use .findcategory
- % so that the command in case of error will be correct rather than an
- % internal invocation of findresource.
- /.findcategory { % <name> .findcategory -
- % (pushes the category on the dstack)
- /Category .findresource begin % note: *not* findresource
- } bind def
-
- % If an error occurs within the logic of a resource operator (after operand
- % acquisition and checking), the Adobe interpreters report the operator name,
- % not the operator object, as the command in $error. For this reason, and
- % this reason only, all resource operators must wrap their logic code in
- % /<opername> cvx { ...logic... } .errorexec
-
- % The Category resource signals /undefined rather than /undefinedresource,
- % both when referenced implicitly (to look up the category for a general
- % resource operation) and when it is accessed directly (/Category /xxx
- % findresource). Because of this, all resource operators must use
- % .undefinedresource rather than signalling undefinedresource directly.
- /.undefinedresource { % <command> .undefinedresource -
- /Category dup load eq { /undefined } { /undefinedresource } ifelse
- signaloperror
- } 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 cvx /typecheck signaloperror
- } 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 cvx /invalidaccess signaloperror } 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.
- % We define its contents as a separate procedure so that .findcategory
- % can use it without entering another level of pseudo-operator.
- /.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
- def
- /findresource {
- % See above re .errorexec.
- 1 .argindex % also catch stackunderflow
- dup type /stringtype eq { cvn } if % for CET 23-13-04
- 3 1 roll exch pop
- dup type /nametype ne {
- /findresource .systemvar /typecheck signalerror
- } if
- /findresource cvx //.findresource .errorexec
- } odef
-
- /defineresource { % <key> <instance> <category> defineresource <instance>
- 2 .argindex 2 index 2 index % catch stackunderflow
- % See above re .errorexec.
- /defineresource cvx {
- .findcategory
- currentdict /InstanceType known {
- dup type InstanceType ne {
- dup type /packedarraytype eq InstanceType /arraytype eq and
- not { /defineresource cvx /typecheck signaloperror } if
- } if
- } if
- /DefineResource .resourceexec
- 4 1 roll pop pop pop
- } .errorexec
- } 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 .findcategory
- /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
- {
- 0 .argindex type /nametype ne {
- % CET 23-26 wants typecheck here, not undefineresource that happens
- % without the check.
- /resourcestatus cvx /typecheck signalerror
- } if
- 2 copy .findcategory /ResourceStatus .resourceexec
- { 4 2 roll pop pop true } { pop pop false } ifelse
- } stopped {
- % Although resourcestatus is an operator, Adobe uses executable name
- % for error reporting. CET 23-26
- /resourcestatus cvx $error /errorname get signalerror
- } if
- } bind odef
- /undefineresource { % <key> <category> undefineresource -
- 0 .argindex type /nametype ne {
- /undefinedresource cvx /typecheck signaloperror
- } if
- 1 .argindex 1 index % catch stackunderflow
-
- { .findcategory /UndefineResource .resourceexec pop pop
- } stopped {
- % Although undefineresource is an operator, Adobe uses executable name
- % here but uses operator for the errors above. CET 23-33
- /undefineresource cvx $error /errorname get signalerror
- } if
- } bind odef
-
- % Define the system parameters used for the Generic implementation of
- % ResourceFileName.
- systemdict begin
-
- % - .default_resource_dir <string>
- /.default_resource_dir {
- /LIBPATH .systemvar {
- dup .file_name_current eq {
- pop
- } {
- (Resource) search {
- exch concatstrings
- exch 0 1 getinterval concatstrings exit
- } {
- 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 cvx /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 signaloperror
- } 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 signaloperror
- } if
- pop pop
-
- pssystemparams dup /GenericResourceDir get exch /GenericResourcePathSep get
- (Init) exch (gs_init.ps) concatstrings concatstrings concatstrings
- status {
- pop pop pop pop
- } {
- (\n*** Warning: GenericResourceDir doesn't point to a valid resource directory.) =
- ( the -sGenericResourceDir=... option can be used to set this.\n) =
- } ifelse
-
- % 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 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 cvx /typecheck signaloperror
- }
- 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 //null eq {
- % CET 13-06 wants /typecheck for "null findencoding" but
- % .knownget doesn't fail on null
- /findresource cvx /typecheck signaloperror
- } if
- dup .getvminstance {
- exch pop 0 get
- } {
- dup ResourceStatus {
- pop 1 gt {
- .DoLoadResource .getvminstance not {
- /findresource cvx .undefinedresource
- } if 0 get
- } {
- .GetInstance pop 0 get
- } ifelse
- } {
- /findresource cvx .undefinedresource
- } 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 .localvmpackedarray % [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 .localvmpackedarray 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 .localvmpackedarray 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)
- [
- true /LIBPATH .systemvar 3 index
- .generate_dir_list_templates_with_length % args (t) [ l [(pt) Lp ...]
- % also add on the Resources as specified by the GenericResourceDir
- true [ currentsystemparams /GenericResourceDir get]
- counttomark 1 add index .generate_dir_list_templates_with_length
- % Resource files on OpenVMS require a separate template (gs:[dir.*]*)
- true [ currentsystemparams /GenericResourceDir get]
- counttomark 1 add index .file_name_separator (*)
- concatstrings concatstrings .generate_dir_list_templates_with_length
- ] exch pop
- dup length 1 sub 0 exch 2 exch { % args [ l [] i
- 2 copy get % args [ l [] i (pt)
- exch 2 index exch 1 add get % args [ l [] (pt) Lp
- 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
- 5 2 roll % args [ /n /n l [] Lp
- } //.rfnstring filenameforall
- pop % args [ /n1 /n1 ... /nN /nN l []
- } for % args [ /n1 /n1 ... /nN /nN l []
- pop 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 .localvmpackedarray cvx
- 3 2 roll pop % args
- { forall } 0 get
- currentdict end 2 .execn begin
- } bind
- /.file_name_is_iodevice_or_absolute
- { {
- dup length 0 gt {
- dup 0 get (%) 0 get eq {
- pop true exit
- } if
- } if
- .file_name_is_absolute exit
- } loop
- } bind def
- /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_iodevice_or_absolute exec 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 % 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
- }
- 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
- } {
- (r) { file } .internalstopped {
- cleartomark false
- } {
- exch pop exch pop true
- } 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 cvx /invalidaccess signaloperror }
- { 2 copy ne
- { /defineresource cvx /rangecheck signaloperror }
- { dup .Instances 4 -2 roll .growput }
- ifelse
- }
- ifelse
- } bind
- /UndefineResource
- { /undefineresource cvx /invalidaccess signaloperror } bind
- /FindResource
- { .Instances 1 index .knownget
- { exch pop }
- { /findresource cvx .undefinedresource }
- ifelse
- } bind
- /ResourceStatus
- { .Instances exch known { 0 0 true } { false } ifelse } bind
- /ResourceForAll
- /Generic .findcategory /ResourceForAll load end
-
- % 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 .vmused 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 .vmused 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 } stopped {
- /definefont cvx $error /errorname get signalerror
- } if
- } 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 } stopped {
- pop /findfont $error /errorname get signalerror
- } if
- } 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 } stopped {
- pop /findencoding $error /errorname get signalerror
- } if
- } 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
|