gs_init.ps

GhostScript的源代码

} bind def
/.runexec2 {		% <continue> <file|fileproc> .runexec2 -
  exch {
    .runexec
  } {
    dup type /filetype ne { cvx exec } if
    closefile
  } ifelse
} bind def
/.runexec {		% <file|fileproc> .runexec -
  cvlit /.runexec1 cvx 1 index /.runexec2 cvx 4 .execn
} bind def
% The following is only for compatibility with Adobe interpreters.
/setdash {
	1 index length 11 gt { /setdash load /limitcheck signalerror } if
	//setdash
} odef
/setdevice
	{ .setdevice { erasepage } if } odef
/setlinecap {
	dup 2 gt { /setlinecap load /rangecheck signalerror } if
	.setlinecap
} odef
/setlinejoin {
	dup 2 gt { /setlinejoin load /rangecheck signalerror } if
	.setlinejoin
} odef
/setmatrix {
	dup aload pop .setmatrix pop
} odef
/showpage {
	0 .endpage .doneshowpage {
	  .currentnumcopies true .outputpage
	  (>>showpage, press <return> to continue<<\n) .confirm
	  erasepage
	} if initgraphics .beginpage
} odef
% Code output by Adobe Illustrator relies on the fact that
% `stack' is a procedure, not an operator!!!
/stack	{ 0 1 count 3 sub { index = } for } bind def
/start	{ BATCH { null 0 .quit } { executive } ifelse } def
% Internal uses of stopped that aren't going to do a stop if an error occurs
% should use .internalstopped to avoid setting newerror et al.
/.internalstopped { null 1 .stopped null ne } bind def
/store {	% Don't alter operands before completing.
	1 index where { 2 index 2 index put pop pop } { def } ifelse
} odef
% NOTE: the name typenames is known to (initialized by) the interpreter.
/type {
	//typenames .type
} odef
% When running in Level 1 mode, this interpreter is supposed to be
% compatible with PostScript "version" 54.0 (I think).
/version (54.0) readonly def

% internaldict is defined in systemdict, but is allocated in local VM.
% We make a procedure for creating it, since we must create a new one
% for each context with private local VM.
/.makeinternaldict {
  .currentglobal false .setglobal
    [ /dup .systemvar 1183615869 /eq .systemvar
	[ /pop .systemvar 10 dict ] cvx
	[ /internaldict /cvx .systemvar /invalidaccess /signalerror cvx ] cvx
      /ifelse .systemvar
    ] cvx executeonly
  exch .setglobal
} odef
systemdict /internaldict dup .makeinternaldict .makeoperator
.forceput		% proc is local, systemdict is global
% Move superexec to internaldict if superexec is defined.
currentdict /superexec .knownget {
  1183615869 internaldict /superexec 3 -1 roll put
  currentdict /superexec .undef
} if

% Define some additional built-in procedures (beyond the ones defined by
% the PostScript Language Reference Manual).
% Warning: these are not guaranteed to stay the same from one release
% to the next!
/concatstrings
	{ exch dup length 2 index length add string	% str2 str1 new
	  dup dup 4 2 roll copy		% str2 new new new1
	  length 4 -1 roll putinterval
	} bind def
/copyarray
	{ dup length array copy } bind def
% Copy a dictionary per the Level 2 spec even in Level 1.
/.copydict		% <fromdict> <todict> .copydict <todict>
	{ dup 3 -1 roll { put dup } forall pop } bind def
/copystring
	{ dup length string copy } bind def
/finddevice
	{ /devicedict .systemvar exch get
	  dup 1 get null eq
	   {		% This is the first request for this type of device.
			% Create a default instance now.
			% Stack: [proto null]
	     .currentglobal true .setglobal exch
	     dup dup 0 get copydevice 1 exch put
	     exch .setglobal
	   }
	  if 1 get
	} bind def
/.growdictlength	% get size for growing a dictionary
	{ length 3 mul 2 idiv 1 add
	} bind def
/.growdict		% grow a dictionary
	{ dup .growdictlength .setmaxlength
	} bind def
/.growput		% put, grow the dictionary if needed
	{ 2 index length 3 index maxlength eq
	   { 3 copy pop known not { 2 index .growdict } if
	   } if
	  put
	} bind def
/.packtomark
	{ counttomark packedarray exch pop } bind def
/ppstack
	{ 0 1 count 3 sub { index === } for } bind def
/runlibfile
	{		% We don't want to bind 'run' into this procedure,
			% since run may get redefined.
	  findlibfile
	   { exch pop /run .systemvar exec }
	   { /undefinedfilename signalerror }
	  ifelse
	} bind def
/selectdevice
	{ finddevice setdevice .setdefaultscreen } bind def
/signalerror		% <object> <errorname> signalerror -
	{ /errordict .systemvar exch get exec } bind def

% Define the =[only] procedures.  Also define =print,
% which is used by some PostScript programs even though
% it isn't documented anywhere.
/write=only {
	.writecvs
} bind def
/write= {
	1 index exch write=only (\n) writestring
} bind def
/=only	{ (%stdout) (w) file exch write=only } bind def
/=	{ =only (\n) print } bind def
/=print	/=only load def
% Temporarily define == as = for the sake of runlibfile0.
/== /= load def

% Define procedures for getting and setting the current device resolution.

/gsgetdeviceprop	% <device> <propname> gsgetdeviceprop <value>
 { 2 copy mark exch null .dicttomark .getdeviceparams
   dup mark eq		% if true, not found
    { pop dup /undefined signalerror }
    { 5 1 roll pop pop pop pop }
   ifelse
 } bind def
/gscurrentresolution	% - gscurrentresolution <[xres yres]>
 { currentdevice /HWResolution gsgetdeviceprop
 } bind def
/gssetresolution	% <[xres yres]> gssetresolution -
 { 2 array astore mark exch /HWResolution exch
   currentdevice copydevice putdeviceprops setdevice
 } bind def

% Define auxiliary procedures needed for the above.
/shellarguments		% -> shell_arguments true (or) false
	{ /ARGUMENTS where
	   { /ARGUMENTS get dup type /arraytype eq
	      { aload pop /ARGUMENTS null store true }
	      { pop false }
	     ifelse }
	   { false } ifelse
	} bind def
/.confirm
	{ DISPLAYING NOPAUSE not and
	   {	% Print a message (unless NOPAGEPROMPT or NOPROMPT is true)
		% and wait for the user to type something.
		% If the user just types a newline, flush it.
	     NOPAGEPROMPT NOPROMPT or { pop } { print flush } ifelse
	     .echo.mode false echo
	     (%stdin) (r) file dup read
	      { dup (\n) 0 get eq { pop pop } { unread } ifelse }
	      { pop }
	     ifelse echo
	   }
	   { pop
	   }
	  ifelse
	} bind def

% Define the procedure used by .runfile, .runstdin and .runstring
% for executing user input.
% This is called with a procedure or executable file on the operand stack.
/.execute {		% <obj> .execute <stopped>
  stopped $error /newerror get and
   { handleerror flush true } { false } ifelse
} bind def
/execute {		% <obj> execute -
  .execute pop
} odef
% Define an execute analogue of runlibfile0.
/execute0 {		% <obj> execute0 -
  .execute { /execute0 cvx 1 .quit } if
} bind def
% Define the procedure that the C code uses for running files
% named on the command line.
/.runfile {
  { runlibfile } execute
} def
% Define the procedure that the C code uses for running piped input.
% We don't use the obvious { (%stdin) run }, because we want the file to be
% reopened if a startjob does a restore.
/.runstdin {
  { { (%stdin) (r) file cvx } .runexec } execute0
} bind def
% Define the procedure that the C code uses for running commands
% given on the command line with -c.  We turn the string into a file so that
% .runexec can do the right thing with a startjob.
/.runstring {
  .currentglobal exch true .setglobal
  0 () .subfiledecode
  exch .setglobal cvx { .runexec } execute
} bind def
% Define the procedure that the C code uses to set up for executing
% a string that may be received in pieces.
/.runstringbegin {
  .currentglobal true .setglobal
  { .needinput } bind 0 () .subfiledecode
  exch .setglobal cvx .runexec
} bind def

% Define a special version of runlibfile that aborts on errors.
/runlibfile0
	{ cvlit dup /.currentfilename exch def
	   { findlibfile not { stop } if }
	  stopped
	   { (Can't find \(or open\) initialization file ) print
	     .currentfilename == flush /runlibfile0 cvx 1 .quit
	   } if
	  exch pop cvx stopped
	   { (While reading ) print .currentfilename print (:\n) print flush
	     handleerror /runlibfile0 1 .quit
	   } if
	} bind def
% Temporarily substitute it for the real runlibfile.
/.runlibfile /runlibfile load def
/runlibfile /runlibfile0 load def

% Create the error handling machinery.
% Define the standard error handlers.
% The interpreter has created the ErrorNames array.
/.unstoppederrorhandler	% <command> <errorname> .unstoppederrorhandler -
 {	% This is the handler that gets used for recursive errors,
	% or errors outside the scope of a 'stopped'.
   2 copy SHORTERRORS
    { (%%[ Error: ) print =only flush
      (; OffendingCommand: ) print =only ( ]%%\n) print
    }
    { (Unrecoverable error: ) print =only flush
      ( in ) print = flush
      count 2 gt
       { (Operand stack:\n  ) print
	 2 1 count 3 sub { (  ) print index =only flush } for
	 (\n) print flush
       } if
    }
   ifelse
   -1 0 1 //ErrorNames length 1 sub
    { dup //ErrorNames exch get 3 index eq
       { not exch pop exit } { pop } ifelse
    }
   for exch pop .quit
 } bind def
/.errorhandler		% <command> <errorname> .errorhandler -
  {		% Detect an internal 'stopped'.
    1 .instopped { null eq { pop pop stop } if } if
    $error /.inerror get 1 .instopped { pop } { pop true } ifelse
     { .unstoppederrorhandler
     } if	% detect error recursion
    $error /globalmode .currentglobal false .setglobal put
    $error /.inerror true put
    $error /newerror true put
    $error exch /errorname exch put
    $error exch /command exch put
    $error /recordstacks get $error /errorname get /VMerror ne and
     {		% Attempt to store the stack contents atomically.
       count array astore dup $error /ostack 4 -1 roll
       countexecstack array execstack $error /estack 3 -1 roll
       countdictstack array dictstack $error /dstack 3 -1 roll
       put put put aload pop
     }
     { $error /dstack .undef
       $error /estack .undef
       $error /ostack .undef
     }
    ifelse
    $error /position currentfile status
     { currentfile { fileposition } .internalstopped { pop null } if
     }
     {		% If this was a scanner error, the file is no longer current,
		% but the command holds the file, which may still be open.
       $error /command get dup type /filetype eq
        { { fileposition } .internalstopped { pop null } if }
        { pop null }
       ifelse
     }
    ifelse put
		% During initialization, we don't reset the allocation
		% mode on errors.
    $error /globalmode get $error /.nosetlocal get and .setglobal
    $error /.inerror false put
    stop
  } bind def
% Define the standard handleerror.  We break out the printing procedure
% (.printerror) so that it can be extended for binary output
% if the Level 2 facilities are present.
  /.printerror
   { $error begin
       /command load errorname SHORTERRORS
	{ (%%[ Error: ) print =only flush
	  (; OffendingCommand: ) print =only
	  currentdict /errorinfo .knownget
	   { (;\nErrorInfo:) print
	     dup type /arraytype eq
	      { { ( ) print =only } forall }
	      { ( ) print =only }
	     ifelse
	   } if
          ( ]%%\n) print flush
	}
	{ (Error: ) print ==only flush
	  ( in ) print ==only flush
	  currentdict /errorinfo .knownget
	   { (\nAdditional information: ) print ==only flush
	   } if
	  .printerror_long
	}
       ifelse
       .clearerror
     end
     flush
    } bind def     
  /.printerror_long			% long error printout,
					% $error is on the dict stack
   {	% Push the (anonymous) stack printing procedure.
	%  <heading> <==flag> <override-name> <stackname> proc
       {
	 currentdict exch .knownget	% stackname defined in $error?
	 {
	   4 1 roll			% stack: <stack> <head> <==flag> <over>
	   errordict exch .knownget	% overridename defined?
	   { 
	     exch pop exch pop exec	% call override with <stack>
	   }
	   { 
	     exch print exch		% print heading. stack <==flag> <stack>
	     1 index not { (\n) print } if
	     { 1 index { (\n    ) } { (   ) } ifelse print
	       dup type /dicttype eq
	       {
		 (--dict:) print
		 dup rcheck {
		   dup length =only (/) print dup maxlength =only
		 } if
		 /gcheck where {
		   pop gcheck { ((G)) } { ((L)) } ifelse print
		 } {
		   pop
		 } ifelse (--) print
	       }
	       {
		 dup type /stringtype eq 2 index or
		 { ==only } { =only } ifelse
	       } ifelse
	     } forall
	     pop
	   }
	   ifelse			% overridden
	 }
	 { pop pop pop
	 }
	 ifelse				% stack known
       }

       (\nOperand stack:) OSTACKPRINT /.printostack /ostack 4 index exec
       (\nExecution stack:) ESTACKPRINT /.printestack /estack 4 index exec
       (\nBacktrace:) true /.printbacktrace /backtrace 4 index exec
       (\nDictionary stack:) false /.printdstack /dstack 4 index exec
       (\n) print
       pop	% printing procedure

       errorname /VMerror eq
	{ (VM status:) print mark vmstatus
	  counttomark { ( ) print counttomark -1 roll dup =only } repeat
	  cleartomark (\n) print
	} if

       .languagelevel 2 ge
	{ (Current allocation mode is ) print
	  globalmode { (global\n) } { (local\n) } ifelse print
	} if

       .oserrno dup 0 ne
	{ (Last OS error: ) print
	  errorname /VMerror ne
	   { dup .oserrorstring { = pop } { = } ifelse }