path: root/lib/hg_init.ps

%!PS-Adobe-1.0

%% NOTE: don't use "end" operator until initialization is finished
%% NOTE: and push userdict into the dictionary stack.
%% NOTE: otherwise all initialization will fails due to invalid
%% NOTE: dictionary stack. at this time, systemdict is only in
%% NOTE: the dictionary stack.

% create userdict if it's not defined
false .setglobal
systemdict /userdict known not {
    systemdict /userdict 200 dict .forceput % need to avoid the object sanity check.
} if

% change an allocation mode to global
true .setglobal

%%
%% Define procedures
%%

%%%
%%% pre-required operators
% key any odef -
/odef {
    {
	% prepare for error recovery
	count copy count 2 idiv array astore
	$error /.ostack 3 -1 roll put
	null stopped {
	    $error /command null put
	    clear $error /.ostack get aload pop
	    stop
	} if
    }                          % -key- -any- -proc-
    dup 13 4 -1 roll .forceput % -key- -proc-
    dup 15 get                 % -key- -proc- -proc-
    2 3 index .forceput
    .odef
} bind .odef
%% disable .forceput for security reason
systemdict /.forceput .undef
systemdict /.odef .undef

%%%
%%% these aren't official operators/procedures for PostScript
% -string- runlibfile -
/runlibfile {
    .findlibfile {
	run
    } if
} bind odef
% -file- any write=only -
/write=only {
    .stringcvs writestring
} bind odef
% -file- any write==only -
/write==only {
    .write==only
} bind odef
% any =only -
/=only {
    (%stdout) (w) file exch write=only
} bind odef
% any ==only -
/==only {
    (%stdout) (w) file exch write==only
} bind odef
% -string- -string- .concatstring -string-
/.concatstring {
    exch dup length 2 index length add string
    dup dup 4 2 roll copy
    length 4 -1 roll putinterval
} bind def
% - .printversion -
/.printversion {
    .product print .revision dup 1000000 idiv exch 1000000 mod dup 1000 idiv exch 1000 mod
    ( ) print 3 -1 roll ==only (.) print exch ==only (.) print ==only
    ( \(r) print .hgrevision ==only (\)\n\n) print
} bind def
% - .promptmsg -string-
/.promptmsg {
    count mark (PS) 3 -1 roll dup 0 ne {
	([) exch 4 string cvs (])
	counttomark 1 sub {
	    .concatstring
	} repeat
    } {
	pop
    } ifelse
    (>) .concatstring
    exch pop
} bind def
systemdict /.statementedit known {
    /..statementedit {
	% null isn't exactly used. it's just pushed to align the depth of the stack.
	.promptmsg //null exch .statementedit exch pop
    } bind def
} {
    /..statementedit {
	prompt (%statementedit) (r) file
    } bind def
} ifelse

%%%
%%% Level 1 operators
% string seek anchorsearch post match true | string false
/anchorsearch {
    1 index 3 1 roll search {
	length 0 eq {
	    3 -1 roll pop true
	} {
	    pop pop false
	} ifelse
    } if
} bind odef
% any -string- cvs -substring-
/cvs {
    exch .stringcvs exch copy
} bind odef
% key font|cidfont definefont font|cidfont
/definefont {
    .definefont
} bind odef
% - executive -
/executive {
    {
	{
	    {..statementedit} stopped {
		% need to detect an empty line separately to take care of /undefinedfilename.
		$error /newerror get {
		    $error /errorname get /undefinedfilename eq {
			pop pop .clearerror exit
		    } {
			% we don't care of this error here.
			stop
		    } ifelse
		} if
	    } if
	    dup type /filetype eq {cvx exec} if
	} stopped {
	    $error /newerror get {
		errordict /handleerror get exec
		.clearerror
	    } if
	} if
    } loop
} bind def
% key findfont -dict-
/findfont {
    .findfont
} bind odef
% num floor num
/floor {
    dup cvi
    1 index 1 index sub
    0 lt {
	1 sub
    } if
    exch type /realtype eq {cvr} if
} bind odef
% -key- load -value-
/load {
    dup where {
	exch get
    } {
	/load errordict /undefined get exec
    } ifelse
} bind odef
% matrix -matrix-
/matrix {
    6 array identmatrix
} bind odef
% pstack -
/pstack {
    0 1 count 3 sub {index ==} for
} bind odef
% - prompt -
/prompt {
    .promptmsg print flush
} bind odef
% -array- index -array- putinterval -
% -string- index -string- putinterval -
/putinterval {
    dup length
    2 index add
    3 index length gt {
	/putinterval cvx
	errordict /rangecheck get exec
    } if
    {2 index 2 index 3 -1 roll put 1 add} forall
    pop pop
} bind odef
% - quit -
/quit {
    0 .quit
} bind odef
% -string- run -
/run {
    (r) file cvx exec
} bind odef
% stack -
/stack {
    0 1 count 3 sub {index =} for
} bind odef
% key value store -
/store {
    1 index where {
    } {
	currentdict
    } ifelse
    3 1 roll put
} bind odef
% key undefinefont -
/undefinefont {
    .undefinefont
} bind odef
% - version -string-
/version {
    (1000)
} odef
% any = -
/= {
    =only (\n) print
} bind odef
% any == -
/== {
    ==only (\n) print
} bind odef

%% Initialize error procedures
% <command> <error> .seterror -
/.seterror {
    $error /newerror true put
    $error exch /errorname exch put
    $error exch /command exch put
    $error /.isstop true put
    $error /recordstacks known {
	$error /recordstacks get
    } {
	true
    } ifelse {
	% record stacks
	count copy count 2 idiv array astore $error /ostack 3 -1 roll put
	countexecstack array execstack $error /estack 3 -1 roll % -dict- /estack -array-
	% modify estack to make a correct stack when an error actually happened
	dup length 1 sub 0 exch getinterval % -dict- /estack -array-
	dup length array copy               % -dict- /estack -array-
	dup dup length 1 sub $error /command get put put
	countdictstack array dictstack $error /dstack 3 -1 roll put
    } if
} bind def
% <command> <error> .defaulterrorhandler -
/.defaulterrorhandler {
    % enter the local allocation mode in advance to avoid /invalidaccess again.
    false .setglobal
    .seterror
    stop
} bind def
% - handleerror -
/handleerror {
    errordict /handleerror get exec
} bind odef
% - .printerror -
/.printerror {
    % stacking $error and evaluate the value doesn't work.
    % because the executable object may be in the dictionary.
    % it will does into the estack directly then.
    $error /newerror get {
	(Error: ) print $error /errorname get ==only
	( in ) print $error /command get ==only
	(\n) print
	% save objects in current ostack
	count array astore
	$error /ostack known {
	    $error /ostack get dup length
	    (Operand Stack[) print =only (]:\n) print
	    {(  ) print ==only} forall
	    (\n) print
	} if
	$error /estack known {
	    $error /estack get dup length
	    (Execution Stack[) print =only (]:\n) print
	    {(  ) print ==only} forall
	    (\n) print
	} if
	$error /dstack known {
	    $error /dstack get dup length
	    (Dictionary stack[) print =only (]:\n) print
	    {
		(  ) print
		dup type /dicttype eq {
		    (--dict:) print
		    dup length ==only (/) print dup maxlength ==only
		    dup wcheck not {
			((ro)) print
		    } if
		    /gcheck where {
			pop gcheck {
			    ((G))
			} {
			    ((L))
			} ifelse print
		    } {
			pop
		    } ifelse (--) print
		} {
		    ==only
		} ifelse
	    } forall
	    (\n) print
	} if
	% restore objects
	aload pop
    } if
} bind def

mark /dictfull /dictstackoverflow /dictstackunderflow /execstackoverflow
/interrupt /invalidaccess /invalidexit /invalidfileaccess /invalidfont
/invalidrestore /ioerror /limitcheck /nocurrentpoint /rangecheck
/stackoverflow /stackunderflow /syntaxerror /timeout /typecheck /undefined
/undefinedfilename /undefinedresult /unmatchedmark /unregistered /VMerror
counttomark {
    dup [exch {.defaulterrorhandler} /exec load] cvx bind errordict 3 1 roll put
} repeat
cleartomark

% initialize PostScript Level specific things.
systemdict /languagelevel known {
    languagelevel 2 gt {
	(hg_init_lv2.ps) run
    } if
} if

false .setglobal
userdict begin

%%
%% almost initialization finished here
%% and allows 'end' operator to be described now.
%%

%% initialize $error dictionary
%   $error is a built-in dictionary on hieroglyph.
$error begin
    /newerror false def
    /command null def
end
%% initialize handleerror in errordict
errordict begin
    /handleerror /.printerror load def
end
%% initialize serverdict
serverdict begin
    /exitserver { } def
end

%%
%% Initialize the plugins
%%
.initplugins

%%
%% ready to go
%%
.printversion

% if JOBSERVER isn't true, it means one gives the initializer to libretto_vm_startjob().
% so no need to read PS from stdin.
serverdict /JOBSERVER get {
    systemdict /.loadhistory known {
	(.hghistory) .loadhistory
    } if
    .startjobserver executive
    systemdict /.savehistory known {
	(.hghistory) .savehistory
    } if
} if