/* Copyright (C) 1989, 1992 Aladdin Enterprises. All rights reserved.
Distributed by Free Software Foundation, Inc.
This file is part of Ghostscript.
Ghostscript is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY. No author or distributor accepts responsibility
to anyone for the consequences of using it or for whether it serves any
particular purpose or works at all, unless he says so in writing. Refer
to the Ghostscript General Public License for full details.
Everyone is granted permission to copy, modify and redistribute
Ghostscript, but only under the conditions described in the Ghostscript
General Public License. A copy of this license is supposed to have been
given to you along with Ghostscript so you can know your rights and
responsibilities. It should be in a file named COPYING. Among other
things, the copyright notice and this notice must be preserved on all
/* Ghostscript language interpreter */
/* Imported operator procedures */
extern int obj_le(P2(os_ptr
, os_ptr
));
extern int zop_add(P1(os_ptr
));
extern int zop_def(P1(os_ptr
));
extern int zop_sub(P1(os_ptr
));
/* The procedure to call if an operator requests rescheduling. */
/* This causes an error unless the context machinery has been installed. */
private int no_reschedule() { return e_invalidcontext
; }
int (*gs_interp_reschedule_proc
)(P0()) = no_reschedule
;
/* The procedure to call for time-slicing. */
/* This is a no-op unless the context machinery has been installed. */
private int no_time_slice() { return 0; }
int (*gs_interp_time_slice_proc
)(P0()) = no_time_slice
;
private int interp(P1(ref
*pref
));
private int interp_exit(P1(os_ptr
));
private int i_interp_exit
;
private int copy_stack(P3(ref
*, uint
, ref
*));
/* Configuration parameters */
#define num_clear_dstack 2
/* See estack.h for a description of the execution stack. */
/* The logic for managing icount and iref below assumes that */
/* there are no control operators which pop and then push */
/* information on the execution stack. */
#define os_guard_under 10
private ref ostack
[os_guard_under
+max_ostack
+os_guard_over
];
private ref estack
[max_estack
];
os_ptr osp_nargs
[os_max_nargs
]; /* for checking osp */
os_ptr osbot
, osp
, ostop
;
es_ptr esbot
, esp
, estop
;
es_ptr esfile
; /* cache pointer to currentfile */
/* The object that caused an error */
/* Object related to error handling */
extern ref name_errordict
;
extern ref name_ErrorNames
;
/* Extended types. The interpreter may replace the type of operators */
/* in procedures with these, to speed up the interpretation loop. */
#define tx_op t_next_index
extern int zadd(P1(os_ptr
));
extern int zdef(P1(os_ptr
));
extern int zdup(P1(os_ptr
));
extern int zexch(P1(os_ptr
));
extern int zif(P1(os_ptr
));
extern int zifelse(P1(os_ptr
));
extern int zle(P1(os_ptr
));
extern int zpop(P1(os_ptr
));
extern int zroll(P1(os_ptr
));
extern int zsub(P1(os_ptr
));
private op_proc_p special_ops
[] = {
zadd
, zdef
, zdup
, zexch
, zif
, zifelse
, zle
, zpop
, zroll
, zsub
#define num_special_ops ((int)tx_next_op - tx_op)
#define t_invalid tx_next_op /* first invalid type */
/* The following is a special "error" code that is used internally */
/* to cause the interpreter to exit. */
#define e_InterpreterExit (-100)
/* Initialize the interpreter */
{ /* Initialize the guard entries on the operand stack */
/* with objects that have invalid type and attributes. */
osbot
= ostack
+ os_guard_under
;
osp
= osbot
- 1, ostop
= osbot
+ (max_ostack
-1);
for ( op
= ostack
; op
< osbot
; op
++ )
make_tav(op
, t_invalid
, 0, index
, 0);
for ( i
= 1; i
<= os_max_nargs
; i
++ )
op_nargs_check(i
) = osbot
+ i
- 1;
esbot
= estack
, esp
= estack
- 1, estop
= estack
+ (max_estack
-1);
/* Initialize the dictionary stack to the first ndict */
/* dictionaries. ndict is a parameter because during */
/* initialization, only systemdict exists. */
dsp
= dstack
+ ndict
- 1, dstop
= dstack
+ (max_dstack
-1);
/* Look up an operator during initialization, */
/* changing its type if appropriate. */
interp_fix_op(ref
*opref
)
{ register int i
= num_special_ops
;
op_proc_p proc
= real_opproc(opref
);
while ( --i
>= 0 && proc
!= special_ops
[i
] ) ;
make_tav(opref
, tx_op
+ i
, a_executable
, opproc
,
/* Invoke the interpreter. If execution completes normally, return 0. */
/* if an error occurs, then if user_errors is true and the error is a */
/* recoverable one (not an overflow condition), let the user handle it; */
/* otherwise, return the error code. */
gs_interpret(ref
*pref
, int user_errors
)
ref
*perrordict
, *pErrorNames
;
/* Push a special exit procedure on the execution stack */
make_oper(esp0
, i_interp_exit
, (dummy_op_proc_p
)interp_exit
);
retry
: code
= interp(epref
);
if ( code
== e_InterpreterExit
) return 0;
/* Adjust osp in case of operand stack underflow */
if ( !user_errors
) return code
;
if ( dict_find(&systemdict
, &name_errordict
, &perrordict
) <= 0 ||
dict_find(&systemdict
, &name_ErrorNames
, &pErrorNames
) <= 0
return code
; /* errordict or ErrorNames not found?? */
case e_dictstackoverflow
:
if ( osp
+ 1 >= ostop
) return e_stackoverflow
;
ccode
= copy_stack(dstack
, dsp
- dstack
+ 1, &saref
);
if ( ccode
< 0 ) return ccode
;
dsp
= &dstack
[num_clear_dstack
- 1];
case e_execstackoverflow
:
if ( osp
+ 1 >= ostop
) return e_stackoverflow
;
ccode
= copy_stack(estack
, esp
- estack
+ 1, &saref
);
if ( ccode
< 0 ) return ccode
;
ccode
= copy_stack(ostack
, osp
- osbot
+ 1, &saref
);
if ( ccode
< 0 ) return ccode
;
if ( -code
> r_size(pErrorNames
) )
return code
; /* unknown error??? */
if ( dict_find(perrordict
, &pErrorNames
->value
.refs
[-code
- 1], &epref
) <= 0 )
return code
; /* error name not in errordict??? */
/* Push the error object on the operand stack */
{ return e_InterpreterExit
;
/* Copy the contents of an overflowed stack into an array. */
copy_stack(ref
*stk
, uint size
, ref
*arr
)
{ ref
*abody
= alloc_refs(size
, "overflowed stack");
if ( abody
== 0 ) return e_VMerror
;
refcpy_to_new(abody
, stk
, size
);
make_tasv(arr
, t_array
, a_all
, size
, refs
, abody
);
/* If execution terminates normally, return e_InterpreterExit. */
/* If an error occurs, leave the current object in error_object */
/* and return a (negative) error code. */
#define return_with_error(code, objp)\
{ esp = iesp; osp = iosp; error_object = *(objp); return_error(code); }
interp(ref
*pref
/* object to interpret */)
{ register ref
*iref
= pref
;
register int icount
= 0; /* # of consecutive tokens at iref */
register os_ptr iosp
= osp
; /* private copy of osp */
register es_ptr iesp
= esp
; /* private copy of esp */
ref token
; /* token read from file or string, */
/* must be declared in this scope */
esfile
= 0; /* clear cache */
/* We want to recognize executable arrays here, */
/* so we push the argument on the estack and enter */
/* the loop at the bottom. */
if ( iesp
>= estop
) return_with_error (e_execstackoverflow
, pref
);
/* At this point, if icount > 0, iref and icount correspond */
/* to the top entry on the execution stack: icount is the */
/* count of sequential entries remaining AFTER the current one. */
#define add1_short(pref) (ref *)((ushort *)(pref) + 1)
( icount > 0 ? (ep->value.refs = iref + 1, r_set_size(ep, icount)) : 0 )
#define store_state_short(ep)\
( icount > 0 ? (ep->value.refs = add1_short(iref), r_set_size(ep, icount)) : 0 )
if ( --icount > 0 ) { iref++; goto top; } else goto out
if ( --icount <= 0 ) { if ( icount < 0 ) goto up; iesp--; }\
iref = add1_short(iref); goto top;
* This is the top of the interpreter loop.
* iref points to the ref being interpreted.
* Note that this might be an element of a packed array,
* not a real ref: we carefully arranged the first 16 bits of
* a ref and of a packed array element so they could be distinguished
* from each other. (See ghost.h and packed.h for more detail.)
if ( gs_debug
['I'] || gs_debug
['i'] &&
(*(ushort
*)iref
<= packed_max_full_ref
? r_type(iref
) == t_name
:
{ void debug_print_ref(P1(ref
*));
int edepth
= iesp
- esbot
;
sprintf(depth
, "%2d", edepth
);
do { dputc('.'); } while ( --edepth
> 0 ); /* indent */
dprintf3("%lx(%2d)<%2d>: ",
(ulong
)iref
, icount
, (uint
)(iosp
- osbot
+ 1));
/* Object that have attributes (arrays, dictionaries, files, and strings) */
/* use lit and exec; other objects use plain and plain_exec. */
#define lit(t) type_xe_value(t, a_execute)
#define exec(t) type_xe_value(t, a_execute + a_executable)
#define nox(t) type_xe_value(t, 0)
#define nox_exec(t) type_xe_value(t, a_executable)
#define plain(t) type_xe_value(t, 0)
#define plain_exec(t) type_xe_value(t, a_executable)
* We have to populate enough cases of the switch statement to force
* some compilers to use a dispatch rather than a testing loop.
switch ( r_type_xe(iref
) )
case nox_exec(t_array): case nox_exec(t_dictionary):\
case nox_exec(t_file): case nox_exec(t_string):\
case nox_exec(t_mixedarray): case nox_exec(t_shortarray)
return_with_error (e_invalidaccess
, iref
);
* Literal objects. We have to enumerate all the types.
* In fact, we have to include some extra plain_exec entries
* just to populate the switch. We break them up into groups
* to avoid overflowing some preprocessors.
case lit(t_array): case nox(t_array):\
case plain(t_boolean): case plain_exec(t_boolean):\
case plain(t_condition): case plain_exec(t_condition):\
case lit(t_dictionary): case nox(t_dictionary)
case lit(t_file): case nox(t_file):\
case plain(t_fontID): case plain_exec(t_fontID):\
case plain(t_gstate): case plain_exec(t_gstate):\
case plain(t_integer): case plain_exec(t_integer)
case plain(t_lock): case plain_exec(t_lock):\
case plain(t_mark): case plain_exec(t_mark):\
case plain(t_real): case plain_exec(t_real):\
case plain(t_save): case plain_exec(t_save):\
case lit(t_string): case nox(t_string)
case lit(t_mixedarray): case nox(t_mixedarray):\
case lit(t_shortarray): case nox(t_shortarray):\
case plain(t_color): case plain_exec(t_color):\
case plain(t_device): case plain_exec(t_device)
case plain_exec(tx_op_add
):
x_add
: if ( (code
= zop_add(iosp
)) < 0 )
return_with_error (code
, iref
);
case plain_exec(tx_op_def
):
x_def
: if ( (code
= zop_def(iosp
)) < 0 )
return_with_error (code
, iref
);
case plain_exec(tx_op_dup
):
x_dup
: if ( iosp
< op_nargs_check(1) )
return_with_error (e_stackunderflow
, iref
);
ref_assign(iosp
, iosp
- 1);
case plain_exec(tx_op_exch
):
x_exch
: if ( iosp
< op_nargs_check(2) )
return_with_error (e_stackunderflow
, iref
);
ref_assign(&token
, iosp
);
ref_assign(iosp
, iosp
- 1);
ref_assign(iosp
- 1, &token
);
case plain_exec(tx_op_if
):
x_if
: if ( !r_has_type(iosp
- 1, t_boolean
) )
return_with_error (e_typecheck
, iref
);
if ( !iosp
[-1].value
.index
)
return_with_error (e_execstackoverflow
, iref
);
case plain_exec(tx_op_ifelse
):
x_ifelse
: if ( !r_has_type(iosp
- 2, t_boolean
) )
return_with_error (e_typecheck
, iref
);
return_with_error (e_execstackoverflow
, iref
);
whichp
= (iosp
[-2].value
.index
? iosp
- 1 : iosp
);
/* Open code "up" for the array case(s) */
ifup
: switch( r_type_xe(whichp
) )
esfile
= 0; /* clear currentfile cache */
ref_assign(iesp
+ 1, whichp
);
case exec(t_shortarray
): ;
if ( (icount
= r_size(whichp
) - 1) <= 0 )
{ if ( icount
< 0 ) goto up
; /* 0-element proc */
iref
= whichp
->value
.refs
; /* 1-element proc */
/* Do a ref_assign, but also set iref. */
iref
= iesp
->value
.refs
= whichp
->value
.refs
;
case plain_exec(tx_op_le
):
x_le
: code
= obj_le(iosp
- 1, iosp
);
return_with_error (code
, iref
);
case plain_exec(tx_op_pop
):
x_pop
: if ( iosp
< op_nargs_check(1) )
return_with_error (e_stackunderflow
, iref
);
case plain_exec(tx_op_roll
):
x_roll
: if ( (code
= zroll(iosp
)) < 0 )
return_with_error (code
, iref
);
case plain_exec(tx_op_sub
):
x_sub
: if ( (code
= zop_sub(iosp
)) < 0 )
return_with_error (code
, iref
);
case plain_exec(t_oparray
):
/* Replace with the definition and go again. */
&op_array_table
.value
.refs
[op_index(iref
) - op_def_count
];
prst
: /* Prepare to call the procedure (array) in *pvalue. */
pr
: /* Call the array in *pvalue. State has been stored. */
if ( (icount
= r_size(pvalue
) - 1) <= 0 )
{ if ( icount
< 0 ) goto up
; /* 0-element proc */
iref
= pvalue
->value
.refs
; /* 1-element proc */
return_with_error (e_execstackoverflow
, pvalue
);
/* Do a ref_assign, but also set iref. */
iref
= iesp
->value
.refs
= pvalue
->value
.refs
;
case plain_exec(t_operator
):
{ esp
= iesp
; /* save for operator */
/* Operator routines take osp as an argument. */
/* This is just a convenience, since they adjust */
/* osp themselves to reflect the results. */
/* Operators that (net) push information on the */
/* operand stack must check for overflow: */
/* this normally happens automatically through */
/* the push macro (in oper.h). */
/* Operators that do not typecheck their operands */
/* must check explicitly for stack underflow. */
/* Note that each case must set iosp = osp: */
/* this is so we can switch on code without having to */
/* store it and reload it (for dumb compilers). */
switch ( code
= (*real_opproc(iref
))(iosp
) )
case 0: /* normal case */
case o_push_estack
: /* store the state and go to up */
case o_pop_estack
: /* just go to up */
if ( esp
== iesp
) goto bot
;
/* This might be an operand stack */
/* underflow: check the required # of */
if ( osp
< osbot
- 1 + op_num_args(iref
) )
return_with_error (code
, iref
);
pvalue
= iref
->value
.pname
->pvalue
;
if ( (pdvalue
= dict_find_name(iref
)) == 0 )
return_with_error (e_undefined
, iref
);
/* Dispatch on the type of the value. */
/* Again, we have to over-populate the switch. */
switch ( r_type_xe(pvalue
) )
cases_nox(): /* access errors */
return_with_error (e_invalidaccess
, iref
);
/* Just push the value */
return_with_error (e_stackoverflow
, pvalue
);
ref_assign(iosp
, pvalue
);
/* This is an executable procedure, execute it. */
case plain_exec(tx_op_add
): goto x_add
;
case plain_exec(tx_op_def
): goto x_def
;
case plain_exec(tx_op_dup
): goto x_dup
;
case plain_exec(tx_op_exch
): goto x_exch
;
case plain_exec(tx_op_if
): goto x_if
;
case plain_exec(tx_op_ifelse
): goto x_ifelse
;
case plain_exec(tx_op_le
): goto x_le
;
case plain_exec(tx_op_pop
): goto x_pop
;
case plain_exec(tx_op_roll
): goto x_roll
;
case plain_exec(tx_op_sub
): goto x_sub
;
case plain_exec(t_oparray
):
&op_array_table
.value
.refs
[op_index(pvalue
) -
case plain_exec(t_operator
):
{ /* Shortcut for operators. */
/* See above for the logic. */
switch ( code
= (*real_opproc(pvalue
))(iosp
) )
case 0: /* normal case */
case o_push_estack
: /* store the state and go to up */
case o_pop_estack
: /* just go to up */
if ( esp
== iesp
) goto bot
;
if ( osp
< osbot
- 1 + op_num_args(pvalue
) )
return_with_error (code
, pvalue
);
/* Not a procedure, reinterpret it. */
{ /* Executable file. Read the next token and interpret it. */
code
= file_check_read(iref
, &s
);
if ( code
< 0 ) return_with_error (code
, iref
);
rt
: if ( iosp
>= ostop
) /* check early */
return_with_error (e_stackoverflow
, iref
);
osp
= iosp
; /* scan_token uses ostack */
switch ( code
= scan_token(s
, 0, (ref
*)(iosp
+ 1)) )
case 0: /* read a token */
/* It's worth checking for literals, which make up */
/* the majority of input tokens, before storing the */
/* state on the e-stack. Note that because of //, */
/* the token may have *any* type and attributes. */
switch ( r_type(iosp
+ 1) )
case t_name
: case t_string
:
if ( r_has_attr(iosp
+ 1, a_executable
) )
/* Executable arrays aren't executed at the */
/* top level -- they're treated as literals. */
case t_array
: case t_mixedarray
: case t_shortarray
:
case t_integer
: case t_real
:
/* Push the file on the e-stack */
return_with_error (e_execstackoverflow
, iref
);
case 1: /* end of file */
code
= file_close(iref
, s
);
if ( code
< 0 ) return_with_error (code
, iref
);
return_with_error (code
, iref
);
{ /* Executable string. Read a token and interpret it. */
sread_string(&ss
, iref
->value
.bytes
, r_size(iref
));
osp
= iosp
; /* scan_token uses ostack */
switch ( code
= scan_token(&ss
, 1, &token
) )
case 0: /* read a token */
/* Push the updated string back on the e-stack */
return_with_error (e_execstackoverflow
, iref
);
iesp
->tas
.type_attrs
= iref
->tas
.type_attrs
;
iesp
->value
.bytes
= ss
.cptr
+ 1;
r_set_size(iesp
, ss
.cbuf
+ ss
.bsize
- ss
.cptr
- 1);
case 1: /* end of string */
return_with_error (code
, iref
);
/* Handle packed arrays here by re-dispatching. */
/* This also picks up some anomalous cases of non-packed arrays. */
switch ( *(ushort
*)iref
>> packed_type_shift
)
return_with_error (e_stackoverflow
, iref
);
/* We know that refs are properly aligned: */
/* see packed.h for details. */
case pt_executable_operator
:
{ uint index
= *(ushort
*)iref
& packed_int_mask
;
op_index_ref(index
, &token
);
return_with_error (e_stackoverflow
, iref
);
make_int(iosp
, (*(short *)iref
& packed_int_mask
) +
return_with_error (e_stackoverflow
, iref
);
name_index_ref((uint
)*(ushort
*)iref
&
case pt_executable_name
+1:
name_index_ref((uint
)*(ushort
*)iref
&
pvalue
= nref
.value
.pname
->pvalue
;
if ( (pdvalue
= dict_find_name(&nref
)) == 0 )
return_with_error (e_undefined
, &nref
);
switch ( r_type_xe(pvalue
) )
/* This is an executable procedure, */
default: /* handles other literals */
/* Not a procedure, reinterpret it. */
/* default can't happen here */
/* Literal type, just push it. */
if ( iosp
>= ostop
) return_with_error (e_stackoverflow
, iref
);
out
: /* At most 1 more token in the current procedure. */
/* (We already decremented icount.) */
{ /* Pop the execution stack for tail recursion. */
up
: /* See if there is anything left on the execution stack. */
switch ( r_type_xe(iesp
) )
case exec(t_shortarray
): ;
iref
= iesp
->value
.refs
; /* next element of array */
icount
= r_size(iesp
) - 1;
if ( icount
<= 0 ) /* <= 1 more elements */
{ iesp
--; /* pop, or tail recursion */
if ( icount
< 0 ) goto up
;
res
: /* Some operator has asked for context rescheduling. */
code
= (*gs_interp_reschedule_proc
)();
if ( code
< 0 ) return_with_error (code
, iref
);
/* Reload state information from memory. */
/* ------ Initialization procedure ------ */
op_def interp_op_defs
[] = {
{"0%interp_exit", interp_exit
, &i_interp_exit
},