/* <file> read -false- */
static int
zread(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
stream *s;
int ch;
check_read_file(s, op);
/* We 'push' first in case of ostack block overflow and the */
/* usual case is we will need to push anyway. If we get EOF */
/* we will need to 'pop' and decrement the 'op' pointer. */
/* This is required since the 'push' macro might return with*/
/* stackoverflow which will result in another stack block */
/* added on, then the operator being retried. We can't read */
/* (sgetc) prior to having a place on the ostack to return */
/* the character. */
push(1);
ch = sgetc(s);
if (ch >= 0) {
make_int(op - 1, ch);
make_bool(op, 1);
} else {
pop(1); /* Adjust ostack back from preparatory 'pop' */
op--;
if (ch == EOFC)
make_bool(op, 0);
else
return handle_read_status(i_ctx_p, ch, op, NULL, zread);
}
return 0;
}
/* search */
int
zsearch(register os_ptr op)
{ os_ptr op1 = op - 1;
uint size = r_size(op);
uint count;
byte *ptr;
check_read_type(*op1, t_string);
check_read_type(*op, t_string);
if ( size > r_size(op1) ) /* can't match */
{ make_bool(op, 0);
return 0;
}
count = r_size(op1) - size;
ptr = op1->value.bytes;
do
{ if ( !memcmp(ptr, op->value.bytes, size) )
{ op->tas.type_attrs = op1->tas.type_attrs;
op->value.bytes = ptr;
r_set_size(op, size);
push(1);
*op = *op1;
r_set_size(op, ptr - op->value.bytes);
op1->value.bytes = ptr + size;
r_set_size(op1, count);
push(1);
make_bool(op, 1);
return 0;
}
ptr++;
}
while ( count-- );
/* No match */
make_bool(op, 0);
return 0;
}
/* token */
int
ztoken(register os_ptr op)
{ stream st;
stream *s = &st;
int code;
ref token;
switch ( r_type(op) )
{
default: return e_typecheck;
case t_file: return ztoken_file(op);
case t_string: ;
}
check_read(*op);
sread_string(s, op->value.bytes, r_size(op));
switch ( code = scan_token(s, 1, &token) )
{
case 0: /* read a token */
{ uint pos = stell(s);
op->value.bytes += pos;
r_inc_size(op, -pos);
}
push(2);
op[-1] = token;
make_bool(op, 1);
return 0;
case 1: /* no tokens */
make_bool(op, 0);
return 0;
default: /* error */
return code;
}
}
parse_result parse_bool(char const * str) {
bool * r=NULL;
if (!str)
return make_parse_result(NULL, str);
if (!strcmp(str, "true") ) r=make_bool(true);
if (!strcmp(str, "false")) r=make_bool(false);
// although it is doubtful ...
if (!strcmp(str, "1")) r=make_bool(true);
if (!strcmp(str, "0")) r=make_bool(false);
return make_parse_result(r, last_char(str));
}
/* <obj> <pattern> .stringmatch <bool> */
static int
zstringmatch(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
os_ptr op1 = op - 1;
bool result;
check_read_type(*op, t_string);
switch (r_type(op1)) {
case t_string:
check_read(*op1);
goto cmp;
case t_name:
name_string_ref(imemory, op1, op1); /* can't fail */
cmp:
result = string_match(op1->value.const_bytes, r_size(op1),
op->value.const_bytes, r_size(op),
NULL);
break;
default:
result = (r_size(op) == 1 && *op->value.bytes == '*');
}
make_bool(op1, result);
pop(1);
return 0;
}
Expr Parameter::get_scalar_expr() const {
check_is_scalar();
const Type t = type();
if (t.is_float()) {
switch (t.bits()) {
case 32: return Expr(get_scalar<float>());
case 64: return Expr(get_scalar<double>());
}
} else if (t.is_int()) {
switch (t.bits()) {
case 8: return Expr(get_scalar<int8_t>());
case 16: return Expr(get_scalar<int16_t>());
case 32: return Expr(get_scalar<int32_t>());
case 64: return Expr(get_scalar<int64_t>());
}
} else if (t.is_uint()) {
switch (t.bits()) {
case 1: return make_bool(get_scalar<bool>());
case 8: return Expr(get_scalar<uint8_t>());
case 16: return Expr(get_scalar<uint16_t>());
case 32: return Expr(get_scalar<uint32_t>());
case 64: return Expr(get_scalar<uint64_t>());
}
}
return Expr();
}
static int
zreadstring_at(i_ctx_t *i_ctx_p, os_ptr op, uint start)
{
stream *s;
uint len, rlen;
int status;
check_write_type(*op, t_string);
check_read_file(s, op - 1);
len = r_size(op);
status = sgets(s, op->value.bytes + start, len - start, &rlen);
rlen += start;
switch (status) {
case EOFC:
case 0:
break;
default:
return handle_read_status(i_ctx_p, status, op - 1, &rlen,
zreadstring_continue);
}
/*
* The most recent Adobe specification says that readstring
* must signal a rangecheck if the string length is zero.
* I can't imagine the motivation for this, but we emulate it.
* It's safe to check it here, rather than earlier, because if
* len is zero, sgets will return 0 immediately with rlen = 0.
*/
if (len == 0)
return_error(e_rangecheck);
r_set_size(op, rlen);
op[-1] = *op;
make_bool(op, (rlen == len ? 1 : 0));
return 0;
}
/* Note that .setdevice clears the current pagedevice. */
int
zsetdevice(i_ctx_t *i_ctx_p)
{
gx_device *dev = gs_currentdevice(igs);
os_ptr op = osp;
int code = 0;
check_write_type(*op, t_device);
if (dev->LockSafetyParams) { /* do additional checking if locked */
if(op->value.pdevice != dev) /* don't allow a different device */
return_error(e_invalidaccess);
}
#ifndef PSI_INCLUDED
/* the language switching build shouldn't install a new device
here. The language switching machinery installs a shared
device. */
code = gs_setdevice_no_erase(igs, op->value.pdevice);
#endif
if (code < 0)
return code;
make_bool(op, code != 0); /* erase page if 1 */
clear_pagedevice(istate);
return code;
}
static obj_t string_predicate_fn(obj_t args, Reporter rep)
{
obj_t obj;
if (!args_match(rep, args, 1, is_obj))
return unspecific;
obj = list_ref(args, 0);
return make_bool(is_string(obj));
}
/* <any> .systemvmcheck <bool> */
static int
zsystemvmcheck(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
make_bool(op, (r_space(op) == avm_system ? true : false));
return 0;
}
/* - .currenttexturetransparent <bool> */
static int
zcurrenttexturetransparent(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
push(1);
make_bool(op, gs_currenttexturetransparent(igs));
return 0;
}
static int
zcurrent_bool(i_ctx_t *i_ctx_p, bool (*current_proc)(const gs_state *))
{
os_ptr op = osp;
push(1);
make_bool(op, current_proc(igs));
return 0;
}
/* - currentstrokeadjust <bool> */
static int
zcurrentstrokeadjust(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
push(1);
make_bool(op, gs_currentstrokeadjust(igs));
return 0;
}
/* <obj> xcheck <bool> */
static int
zxcheck(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
check_op(1);
make_bool(op, (r_has_attr(ACCESS_REF(op), a_executable) ? 1 : 0));
return 0;
}
/* anchorsearch */
int
zanchorsearch(register os_ptr op)
{ os_ptr op1 = op - 1;
uint size = r_size(op);
check_read_type(*op1, t_string);
check_read_type(*op, t_string);
if ( size <= r_size(op1) && !memcmp(op1->value.bytes, op->value.bytes, size) )
{ *op = *op1;
r_set_size(op, size);
op1->value.bytes += size;
r_inc_size(op1, -size);
push(1);
make_bool(op, 1);
}
else
make_bool(op, 0);
return 0;
}
/* - .getCPSImode <bool> */
static int
zgetCPSImode(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
push(1);
make_bool(op, gs_currentcpsimode(imemory));
return 0;
}
/* - currentoverprint <bool> */
static int
zcurrentoverprint(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
push(1);
make_bool(op, gs_currentoverprint(igs));
return 0;
}
/* - .incachedevice <bool> */
static int
zincachedevice(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
push(1);
make_bool(op, !!igs->in_cachedevice);
return 0;
}
/* - .currentdotlength <num> <bool> */
static int
zcurrentdotlength(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
push(2);
make_real(op - 1, gs_currentdotlength(igs));
make_bool(op, gs_currentdotlength_absolute(igs));
return 0;
}
/*
* - .useralternate <bool>
*
* Push true if the current color space contains a base or alternate
* color space and makes use of that color space (e.g.: a Separation
* color space for a component not supported by the process color model.
*/
static int
zusealternate(i_ctx_t * i_ctx_p)
{
os_ptr op = osp;
const gs_color_space * pcs = gs_currentcolorspace(igs);
push(1);
make_bool(op, pcs->base_space != 0);
return 0;
}
/* <array|packedarray|dict|file|string> wcheck <bool> */
static int
zwcheck(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
int code = access_check(i_ctx_p, a_write, false);
if (code >= 0)
make_bool(op, code), code = 0;
return code;
}
/* <obj1> <obj2> eq <bool> */
int
zeq(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
EQ_CHECK_READ(op - 1, check_op(2));
EQ_CHECK_READ(op, DO_NOTHING);
make_bool(op - 1, (obj_eq(imemory, op - 1, op) ? 1 : 0));
pop(1);
return 0;
}
/*
* <proc> .isencapfunction <bool>
*
* This routine checks if a given Postscript procedure is an "encapsulated"
* function of the type made by .buildfunction. These functions can then
* be executed without executing the interpreter. These functions can be
* executed directly from within C code inside the graphics library.
*/
static int
zisencapfunction(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
gs_function_t *pfn;
check_proc(*op);
pfn = ref_function(op);
make_bool(op, pfn != NULL);
return 0;
}
void *make_thread(void *arg)
{
//Make sure names map is up to date.
dsb_names_rebuild();
//Build volatile system graph
make_system();
//Build boolean structure.
make_bool();
return 0;
}
Env *get_init_env()
{
Env *env = NULL;
/* Builtin functions */
env = extend_func(env, "+", b_plus);
env = extend_func(env, "-", b_minus);
env = extend_func(env, "*", b_multiply);
env = extend_func(env, "cons", b_cons);
env = extend_func(env, "car", b_car);
env = extend_func(env, "cdr", b_cdr);
env = extend_func(env, "set", b_set);
env = extend_func(env, "def", b_def);
/* Boolean values */
env = extend(env, make_symbol_cpy("t"), make_bool(1));
env = extend(env, make_symbol_cpy("f"), make_bool(0));
return env;
}
/* <str1> <str2> gt <bool> */
int
zgt(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
int code = obj_le(op - 1, op);
if (code < 0)
return code;
make_bool(op - 1, code ^ 1);
pop(1);
return 0;
}
/* <file> .isprocfilter <bool> */
static int
zisprocfilter(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
stream *s;
check_file(s, op);
while (s->strm != 0)
s = s->strm;
make_bool(op, s_is_proc(s));
return 0;
}
static obj_t string_ci_ge_fn(obj_t args, Reporter rep)
{
obj_t s1, s2;
int rv;
if (!args_match(rep, args, 2, is_string, is_string))
return unspecific;
s1 = list_ref(args, 0);
s2 = list_ref(args, 1);
rv = string_ci_cmp(fetch_string(s1), fetch_string(s2));
return make_bool(rv >= 0);
}
/* <dict> <key> .knownundef <bool> */
static int
zknownundef(i_ctx_t *i_ctx_p)
{
os_ptr op = osp;
os_ptr op1 = op - 1;
int code;
check_type(*op1, t_dictionary);
check_dict_write(*op1);
code = idict_undef(op1, op);
make_bool(op1, code == 0);
pop(1);
return 0;
}
static int
dcompare(i_ctx_t *i_ctx_p, int mask)
{
os_ptr op = osp;
double num[2];
int code = double_params(op, 2, num);
if (code < 0)
return code;
make_bool(op - 1,
(mask & (num[0] < num[1] ? 1 : num[0] > num[1] ? 4 : 2))
!= 0);
pop(1);
return 0;
}