/*-------------------------------------------------------------------------*
* PL_FD_MATH_UNIFY_X_Y *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Fd_Math_Unify_X_Y(WamWord x, WamWord y)
{
WamWord x_word, x_tag;
WamWord y_word, y_tag;
DEREF(x, x_word, x_tag);
DEREF(y, y_word, y_tag);
if (x_tag == TAG_FDV_MASK && y_tag == TAG_FDV_MASK)
{
MATH_CSTR_2(pl_x_eq_y, x, y);
return TRUE;
}
#ifdef DEBUG
DBGPRINTF("Prolog Unif: ");
Pl_Write_1(x_word);
DBGPRINTF(" = ");
Pl_Write_1(y_word);
DBGPRINTF("\n");
#endif
return Pl_Unify(x_word, y_word);
}
void layout_deep_copy(MessageLayout* layout, void* to, void* from) {
upb_msg_field_iter it;
for (upb_msg_field_begin(&it, layout->msgdef);
!upb_msg_field_done(&it);
upb_msg_field_next(&it)) {
const upb_fielddef* field = upb_msg_iter_field(&it);
void* to_memory = slot_memory(layout, to, field);
uint32_t* to_oneof_case = slot_oneof_case(layout, to, field);
void* from_memory = slot_memory(layout, from, field);
uint32_t* from_oneof_case = slot_oneof_case(layout, from, field);
if (upb_fielddef_containingoneof(field)) {
if (*from_oneof_case == upb_fielddef_number(field)) {
*to_oneof_case = *from_oneof_case;
native_slot_deep_copy(upb_fielddef_type(field), to_memory, from_memory);
}
} else if (is_map_field(field)) {
DEREF(to_memory, VALUE) =
Map_deep_copy(DEREF(from_memory, VALUE));
} else if (upb_fielddef_label(field) == UPB_LABEL_REPEATED) {
DEREF(to_memory, VALUE) =
RepeatedField_deep_copy(DEREF(from_memory, VALUE));
} else {
if (field_contains_hasbit(layout, field)) {
if (!slot_is_hasbit_set(layout, from, field)) continue;
slot_set_hasbit(layout, to, field);
}
native_slot_deep_copy(upb_fielddef_type(field), to_memory, from_memory);
}
}
}
// Handler for a submessage field in a oneof.
static void *oneofsubmsg_handler(void *closure,
const void *hd) {
MessageHeader* msg = closure;
const oneof_handlerdata_t *oneofdata = hd;
uint32_t oldcase = DEREF(msg, oneofdata->case_ofs, uint32_t);
VALUE subdesc =
get_def_obj((void*)oneofdata->md);
VALUE subklass = Descriptor_msgclass(subdesc);
VALUE submsg_rb;
MessageHeader* submsg;
if (oldcase != oneofdata->oneof_case_num ||
DEREF(msg, oneofdata->ofs, VALUE) == Qnil) {
DEREF(msg, oneofdata->ofs, VALUE) =
rb_class_new_instance(0, NULL, subklass);
}
// Set the oneof case *after* allocating the new class instance -- otherwise,
// if the Ruby GC is invoked as part of a call into the VM, it might invoke
// our mark routines, and our mark routines might see the case value
// indicating a VALUE is present and expect a valid VALUE. See comment in
// layout_set() for more detail: basically, the change to the value and the
// case must be atomic w.r.t. the Ruby VM.
DEREF(msg, oneofdata->case_ofs, uint32_t) =
oneofdata->oneof_case_num;
submsg_rb = DEREF(msg, oneofdata->ofs, VALUE);
TypedData_Get_Struct(submsg_rb, MessageHeader, &Message_type, submsg);
return submsg;
}
void insertIntoComplexRe(char ** complexRe, int where, int * len, char * toInsert) {
char * buf;
int insertLen = strlen(toInsert);
int i = where;
/* enough space for complexRe+the new range */
*len = *len+(insertLen+1);
*complexRe = (char*)realloc(*complexRe, *len);
/* buffer the rest */
buf = (char*)malloc(*len);
int k;
for (k = i+2; k < *len-(insertLen+1); k++) {
buf[k-(i+2)] = DEREF(complexRe,k);
}
/* insert the string */
for (k = 0; k < insertLen; k++) {
DEREF(complexRe, i++) = toInsert[k];
}
/* put the buffer back in */
for (k = i; k < *len; k++) {
DEREF(complexRe,k) = buf[k-i];
}
free(buf);
}
/*-------------------------------------------------------------------------*
* READ_ARG *
* *
*-------------------------------------------------------------------------*/
static WamWord
Read_Arg(WamWord **lst_adr)
{
WamWord word, tag_mask;
WamWord *adr;
WamWord car_word;
DEREF(**lst_adr, word, tag_mask);
if (tag_mask != TAG_LST_MASK)
{
if (tag_mask == TAG_REF_MASK)
Pl_Err_Instantiation();
if (word == NIL_WORD)
Pl_Err_Domain(pl_domain_non_empty_list, word);
Pl_Err_Type(pl_type_list, word);
}
adr = UnTag_LST(word);
car_word = Car(adr);
*lst_adr = &Cdr(adr);
DEREF(car_word, word, tag_mask);
return word;
}
NODE *
do_ext(int nargs)
{
NODE *obj, *init = NULL, *fini = NULL, *ret = NULL;
SRCFILE *s;
char *init_func = NULL;
char *fini_func = NULL;
if (nargs == 3) {
fini = POP_STRING();
fini_func = fini->stptr;
}
if (nargs >= 2) {
init = POP_STRING();
init_func = init->stptr;
}
obj = POP_STRING();
s = add_srcfile(SRC_EXTLIB, obj->stptr, srcfiles, NULL, NULL);
if (s != NULL)
ret = load_old_ext(s, init_func, fini_func, obj);
DEREF(obj);
if (fini != NULL)
DEREF(fini);
if (init != NULL)
DEREF(init);
if (ret == NULL)
ret = dupnode(Nnull_string);
return ret;
}
void layout_clear(MessageLayout* layout,
const void* storage,
const upb_fielddef* field) {
void* memory = slot_memory(layout, storage, field);
uint32_t* oneof_case = slot_oneof_case(layout, storage, field);
if (field_contains_hasbit(layout, field)) {
slot_clear_hasbit(layout, storage, field);
}
if (upb_fielddef_containingoneof(field)) {
memset(memory, 0, NATIVE_SLOT_MAX_SIZE);
*oneof_case = ONEOF_CASE_NONE;
} else if (is_map_field(field)) {
VALUE map = Qnil;
const upb_fielddef* key_field = map_field_key(field);
const upb_fielddef* value_field = map_field_value(field);
VALUE type_class = field_type_class(value_field);
if (type_class != Qnil) {
VALUE args[3] = {
fieldtype_to_ruby(upb_fielddef_type(key_field)),
fieldtype_to_ruby(upb_fielddef_type(value_field)),
type_class,
};
map = rb_class_new_instance(3, args, cMap);
} else {
VALUE args[2] = {
fieldtype_to_ruby(upb_fielddef_type(key_field)),
fieldtype_to_ruby(upb_fielddef_type(value_field)),
};
map = rb_class_new_instance(2, args, cMap);
}
DEREF(memory, VALUE) = map;
} else if (upb_fielddef_label(field) == UPB_LABEL_REPEATED) {
VALUE ary = Qnil;
VALUE type_class = field_type_class(field);
if (type_class != Qnil) {
VALUE args[2] = {
fieldtype_to_ruby(upb_fielddef_type(field)),
type_class,
};
ary = rb_class_new_instance(2, args, cRepeatedField);
} else {
VALUE args[1] = { fieldtype_to_ruby(upb_fielddef_type(field)) };
ary = rb_class_new_instance(1, args, cRepeatedField);
}
DEREF(memory, VALUE) = ary;
} else {
native_slot_set(upb_fielddef_name(field),
upb_fielddef_type(field), field_type_class(field),
memory, layout_get_default(field));
}
}
void layout_init(MessageLayout* layout,
void* storage) {
upb_msg_field_iter it;
for (upb_msg_field_begin(&it, layout->msgdef);
!upb_msg_field_done(&it);
upb_msg_field_next(&it)) {
const upb_fielddef* field = upb_msg_iter_field(&it);
void* memory = slot_memory(layout, storage, field);
uint32_t* oneof_case = slot_oneof_case(layout, storage, field);
if (upb_fielddef_containingoneof(field)) {
memset(memory, 0, NATIVE_SLOT_MAX_SIZE);
*oneof_case = ONEOF_CASE_NONE;
} else if (is_map_field(field)) {
VALUE map = Qnil;
const upb_fielddef* key_field = map_field_key(field);
const upb_fielddef* value_field = map_field_value(field);
VALUE type_class = field_type_class(value_field);
if (type_class != Qnil) {
VALUE args[3] = {
fieldtype_to_ruby(upb_fielddef_type(key_field)),
fieldtype_to_ruby(upb_fielddef_type(value_field)),
type_class,
};
map = rb_class_new_instance(3, args, cMap);
} else {
VALUE args[2] = {
fieldtype_to_ruby(upb_fielddef_type(key_field)),
fieldtype_to_ruby(upb_fielddef_type(value_field)),
};
map = rb_class_new_instance(2, args, cMap);
}
DEREF(memory, VALUE) = map;
} else if (upb_fielddef_label(field) == UPB_LABEL_REPEATED) {
VALUE ary = Qnil;
VALUE type_class = field_type_class(field);
if (type_class != Qnil) {
VALUE args[2] = {
fieldtype_to_ruby(upb_fielddef_type(field)),
type_class,
};
ary = rb_class_new_instance(2, args, cRepeatedField);
} else {
VALUE args[1] = { fieldtype_to_ruby(upb_fielddef_type(field)) };
ary = rb_class_new_instance(1, args, cRepeatedField);
}
DEREF(memory, VALUE) = ary;
} else {
native_slot_init(upb_fielddef_type(field), memory);
}
}
}
/*-------------------------------------------------------------------------*
* PL_GET_PRED_INDICATOR *
* *
* returns the functor and initializes the arity of the predicate indicator*
* func= -1 if it is a variable, arity= -1 if it is a variable *
*-------------------------------------------------------------------------*/
int
Pl_Get_Pred_Indicator(WamWord pred_indic_word, Bool must_be_ground, int *arity)
{
WamWord word, tag_mask;
int func;
DEREF(pred_indic_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK && must_be_ground)
Pl_Err_Instantiation();
if (!Pl_Get_Structure(ATOM_CHAR('/'), 2, pred_indic_word))
{
if (!Flag_Value(FLAG_STRICT_ISO) &&
Pl_Rd_Callable(word, &func, arity) != NULL)
return func;
Pl_Err_Type(pl_type_predicate_indicator, pred_indic_word);
}
pl_pi_name_word = Pl_Unify_Variable();
pl_pi_arity_word = Pl_Unify_Variable();
if (must_be_ground)
func = Pl_Rd_Atom_Check(pl_pi_name_word);
else
{
DEREF(pl_pi_name_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
func = -1;
else
func = Pl_Rd_Atom_Check(pl_pi_name_word);
}
if (must_be_ground)
{
*arity = Pl_Rd_Positive_Check(pl_pi_arity_word);
if (*arity > MAX_ARITY)
Pl_Err_Representation(pl_representation_max_arity);
}
else
{
DEREF(pl_pi_arity_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
*arity = -1;
else
{
*arity = Pl_Rd_Positive_Check(pl_pi_arity_word);
if (*arity > MAX_ARITY)
Pl_Err_Representation(pl_representation_max_arity);
}
}
return func;
}
/*-------------------------------------------------------------------------*
* PL_FD_PROLOG_TO_ARRAY_INT *
* *
*-------------------------------------------------------------------------*/
WamWord *
Pl_Fd_Prolog_To_Array_Int(WamWord list_word)
{
WamWord word, tag_mask;
WamWord save_list_word;
WamWord *lst_adr;
WamWord val;
int n = 0;
WamWord *array;
WamWord *save_array;
array = CS;
save_list_word = list_word;
save_array = array;
array++; /* +1 for the nb of elems */
for (;;)
{
DEREF(list_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
Pl_Err_Instantiation();
if (word == NIL_WORD)
break;
if (tag_mask != TAG_LST_MASK)
Pl_Err_Type(pl_type_list, save_list_word);
lst_adr = UnTag_LST(word);
DEREF(Car(lst_adr), word, tag_mask);
if (tag_mask == TAG_REF_MASK)
Pl_Err_Instantiation();
if (tag_mask != TAG_INT_MASK)
Pl_Err_Type(pl_type_integer, word);
val = UnTag_INT(word);
*array++ = val;
n++;
list_word = Cdr(lst_adr);
}
*save_array = n;
CS = array;
return save_array;
}
/*-------------------------------------------------------------------------*
* PL_FD_LIST_INT_TO_RANGE *
* *
*-------------------------------------------------------------------------*/
void
Pl_Fd_List_Int_To_Range(Range *range, WamWord list_word)
{
WamWord word, tag_mask;
WamWord save_list_word;
WamWord *lst_adr;
WamWord val;
int n = 0;
save_list_word = list_word;
range->extra_cstr = FALSE;
Vector_Allocate_If_Necessary(range->vec);
Pl_Vector_Empty(range->vec);
for (;;)
{
DEREF(list_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
Pl_Err_Instantiation();
if (word == NIL_WORD)
break;
if (tag_mask != TAG_LST_MASK)
Pl_Err_Type(pl_type_list, save_list_word);
lst_adr = UnTag_LST(word);
DEREF(Car(lst_adr), word, tag_mask);
if (tag_mask == TAG_REF_MASK)
Pl_Err_Instantiation();
if (tag_mask != TAG_INT_MASK)
Pl_Err_Type(pl_type_integer, word);
val = UnTag_INT(word);
if ((unsigned) val > (unsigned) pl_vec_max_integer)
range->extra_cstr = TRUE;
else
{
Vector_Set_Value(range->vec, val);
n++;
}
list_word = Cdr(lst_adr);
}
if (n == 0)
Set_To_Empty(range);
else
Pl_Range_From_Vector(range);
}
SimpleReBuilder * simplifyRe(char ** complexRe, SimpleReBuilder * builder) {
int len = strlen(*complexRe);
simpleReBuilder(&builder, len);
int i,j;
for (i = 0, j = 0; i < len; i++, j++) {
switch(DEREF(complexRe, i)) {
case '\\':
handle_escape(builder, complexRe, &len, &j, &i);
break;
case '.':
builder->re[j] = ANY; //nak is ANY
break;
case '+':
builder->re[j] = PLUS; //0x01 is +
break;
case '?':
builder->re[j] = QUESTION; //0x02 is ?
break;
case '*':
builder->re[j] = STAR; //0x03 is *
break;
case '|':
builder->re[j] = ALTERNATE; //0x04 is |
break;
case '(':
builder->re[j] = PAREN_OPEN; //0x05 is (
break;
case ')':
builder->re[j] = PAREN_CLOSE; //0x06 is )
break;
case '[':
handle_range(builder, *complexRe, len, &j, &i);
break;
default:
builder->re[j] = DEREF(complexRe,i);
break;
}
}
builder->re[j] = '\0';
return builder;
}
static void *oneofbytes_handler(void *closure,
const void *hd,
size_t size_hint) {
MessageHeader* msg = closure;
const oneof_handlerdata_t *oneofdata = hd;
VALUE str = rb_str_new2("");
rb_enc_associate(str, kRubyString8bitEncoding);
DEREF(msg, oneofdata->case_ofs, uint32_t) =
oneofdata->oneof_case_num;
DEREF(msg, oneofdata->ofs, VALUE) = str;
return (void*)str;
}
PVector_ptr Vector_mul(PVector_ptr a, PVector_ptr b)
{
REF((heap_object *)a.vector);
REF((heap_object *)b.vector);
int i;
if ( a.vector==NULL || b.vector==NULL || a.vector->length!=b.vector->length ) vector_operation_error();
size_t n = a.vector->length;
PVector_ptr c = PVector_init(0, n);
for (i=0; i<n; i++) c.vector->nodes[i].data = ith(a, i) * ith(b, i);
DEREF((heap_object *)a.vector);
DEREF((heap_object *)b.vector);
return c;
}
bool Vector_eq(PVector_ptr a, PVector_ptr b) {
REF((heap_object *)a.vector);
REF((heap_object *)b.vector);
if (a.vector == NULL || b.vector == NULL) return false;
if (a.vector->length != b.vector->length) return false;
int i = (int)a.vector->length;
for (int j = 0; j < i; j++) {
if(a.vector->nodes[j].data != b.vector->nodes[j].data) return false;
}
DEREF((heap_object *)a.vector);
DEREF((heap_object *)b.vector);
return true;
}
String *String_add(String *s, String *t)
{
if ( s==NULL ) return t; // don't REF/DEREF as we might free our return value
if ( t==NULL ) return s;
REF((heap_object *)s);
REF((heap_object *)t);
size_t n = strlen(s->str) + strlen(t->str);
String *u = String_alloc(n);
strcpy(u->str, s->str);
strcat(u->str, t->str);
DEREF((heap_object *)s);
DEREF((heap_object *)t);
return u;
}
PVector_ptr Vector_add(PVector_ptr a, PVector_ptr b)
{
REF((heap_object *)a.vector);
REF((heap_object *)b.vector);
int i;
if ( a.vector==NULL || b.vector==NULL || a.vector->length!=b.vector->length ) vector_operation_error();
size_t n = a.vector->length;
PVector_ptr c = PVector_init(0, n);
for (i=0; i<n; i++) c.vector->nodes[i].data = ith(a, i) + ith(b, i); // safe because we have sole ptr to c for now
DEREF((heap_object *)a.vector);
DEREF((heap_object *)b.vector);
return c;
}
bool native_slot_eq(upb_fieldtype_t type, void* mem1, void* mem2) {
switch (type) {
case UPB_TYPE_STRING:
case UPB_TYPE_BYTES:
case UPB_TYPE_MESSAGE: {
VALUE val1 = DEREF(mem1, VALUE);
VALUE val2 = DEREF(mem2, VALUE);
VALUE ret = rb_funcall(val1, rb_intern("=="), 1, val2);
return ret == Qtrue;
}
default:
return !memcmp(mem1, mem2, native_slot_size(type));
}
}
/*-------------------------------------------------------------------------*
* PL_FD_BOOL_META_3 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Fd_Bool_Meta_3(WamWord le_word, WamWord re_word, WamWord op_word)
{
WamWord word, tag_mask;
WamWord *adr, *fdv_adr;
WamWord *exp;
int op;
static WamWord h[3]; /* static to avoid high address */
DEREF(op_word, word, tag_mask);
op = UnTag_INT(op_word);
h[0] = bool_tbl[op]; /* also works for NOT/1 */
h[1] = le_word;
h[2] = re_word;
sp = stack;
vars_sp = vars_tbl;
exp = Simplify(1, Tag_STC(h));
#ifdef DEBUG
Display_Stack(exp);
DBGPRINTF("\n");
#endif
if (!Load_Bool_Into_Word(exp, 1, NULL))
return FALSE;
while (--vars_sp >= vars_tbl)
if (*vars_sp-- == 0) /* bool var */
{
if (!Pl_Fd_Check_For_Bool_Var(*vars_sp))
return FALSE;
}
else /* FD var */
{
DEREF(*vars_sp, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
{
adr = UnTag_REF(word);
fdv_adr = Pl_Fd_New_Variable();
Bind_UV(adr, Tag_REF(fdv_adr));
}
}
return TRUE;
}
/*-------------------------------------------------------------------------*
* PL_NUMBER_CODES_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Number_Codes_2(WamWord number_word, WamWord codes_word)
{
WamWord word, tag_mask;
WamWord *lst_adr, list_word;
char *str = pl_glob_buff;
PlLong c;
list_word = codes_word;
for (;;)
{
DEREF(list_word, word, tag_mask);
if (word == NIL_WORD)
break;
if (tag_mask != TAG_LST_MASK)
goto from_nb;
lst_adr = UnTag_LST(word);
DEREF(Car(lst_adr), word, tag_mask);
c = UnTag_INT(word);
if (tag_mask != TAG_INT_MASK || !Is_Valid_Code(c))
goto from_nb;
*str++ = (char) c;
list_word = Cdr(lst_adr);
}
*str = '\0';
return String_To_Number(pl_glob_buff, number_word);
from_nb:
DEREF(number_word, word, tag_mask);
if (tag_mask == TAG_INT_MASK)
{
sprintf(pl_glob_buff, "%" PL_FMT_d, UnTag_INT(word));
return Pl_Un_Codes_Check(pl_glob_buff, codes_word);
}
if (tag_mask != TAG_REF_MASK)
{
str = Pl_Float_To_String(Pl_Rd_Number_Check(word));
return Pl_Un_Codes_Check(str, codes_word);
}
Pl_Rd_Codes_Check(codes_word); /* only to raise the correct error */
return FALSE;
}
/*-------------------------------------------------------------------------*
* PL_NUMBER_CHARS_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Number_Chars_2(WamWord number_word, WamWord chars_word)
{
WamWord word, tag_mask;
WamWord *lst_adr, list_word;
char *str = pl_glob_buff;
int atom;
list_word = chars_word;
for (;;)
{
DEREF(list_word, word, tag_mask);
if (word == NIL_WORD)
break;
if (tag_mask != TAG_LST_MASK)
goto from_nb;
lst_adr = UnTag_LST(word);
DEREF(Car(lst_adr), word, tag_mask);
atom = UnTag_ATM(word);
if (tag_mask != TAG_ATM_MASK || pl_atom_tbl[atom].prop.length != 1)
goto from_nb;
*str++ = pl_atom_tbl[atom].name[0];
list_word = Cdr(lst_adr);
}
*str = '\0';
return String_To_Number(pl_glob_buff, number_word);
from_nb:
DEREF(number_word, word, tag_mask);
if (tag_mask == TAG_INT_MASK)
{
sprintf(pl_glob_buff, "%" PL_FMT_d, UnTag_INT(word));
return Pl_Un_Chars_Check(pl_glob_buff, chars_word);
}
if (tag_mask != TAG_REF_MASK)
{
str = Pl_Float_To_String(Pl_Rd_Number_Check(word));
return Pl_Un_Chars_Check(str, chars_word);
}
Pl_Rd_Chars_Check(chars_word); /* only to raise the correct error */
return FALSE;
}
void layout_set(MessageLayout* layout,
void* storage,
const upb_fielddef* field,
VALUE val) {
void* memory = slot_memory(layout, storage, field);
uint32_t* oneof_case = slot_oneof_case(layout, storage, field);
if (upb_fielddef_containingoneof(field)) {
if (val == Qnil) {
// Assigning nil to a oneof field clears the oneof completely.
*oneof_case = ONEOF_CASE_NONE;
memset(memory, 0, NATIVE_SLOT_MAX_SIZE);
} else {
// The transition between field types for a single oneof (union) slot is
// somewhat complex because we need to ensure that a GC triggered at any
// point by a call into the Ruby VM sees a valid state for this field and
// does not either go off into the weeds (following what it thinks is a
// VALUE but is actually a different field type) or miss an object (seeing
// what it thinks is a primitive field but is actually a VALUE for the new
// field type).
//
// In order for the transition to be safe, the oneof case slot must be in
// sync with the value slot whenever the Ruby VM has been called. Thus, we
// use native_slot_set_value_and_case(), which ensures that both the value
// and case number are altered atomically (w.r.t. the Ruby VM).
native_slot_set_value_and_case(
upb_fielddef_name(field),
upb_fielddef_type(field), field_type_class(field),
memory, val,
oneof_case, upb_fielddef_number(field));
}
} else if (is_map_field(field)) {
check_map_field_type(val, field);
DEREF(memory, VALUE) = val;
} else if (upb_fielddef_label(field) == UPB_LABEL_REPEATED) {
check_repeated_field_type(val, field);
DEREF(memory, VALUE) = val;
} else {
native_slot_set(upb_fielddef_name(field),
upb_fielddef_type(field), field_type_class(field),
memory, val);
}
if (layout->fields[upb_fielddef_index(field)].hasbit !=
MESSAGE_FIELD_NO_HASBIT) {
slot_set_hasbit(layout, storage, field);
}
}
static PyObject *PY_pdbdata_tp_str(PY_pdbdata *self)
{intb bpi;
char *str;
Py_ssize_t size;
PyObject *rv;
if (_PD_indirection(self->type))
{str = DEREF(self->data);
size = SC_arrlen(str);}
else
{str = self->data;
bpi = _PD_lookup_size(self->type, self->fileinfo->file->host_chart);
size = bpi * self->nitems;};
#if PY_MAJOR_VERSION >= 3
PyObject *io;
io = PyBytes_FromStringAndSize(str, size);
rv = PyObject_Str(io);
#else
rv = PY_STRING_STRING_SIZE(str, size);
#endif
return(rv);}
/*-------------------------------------------------------------------------*
* PL_CURRENT_STREAM_1 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Current_Stream_1(WamWord stm_word)
{
WamWord word, tag_mask;
int stm = 0;
DEREF(stm_word, word, tag_mask); /* either an INT or a REF */
if (tag_mask == TAG_INT_MASK)
{
stm = UnTag_INT(word);
return (stm >= 0 && stm <= pl_stm_last_used && pl_stm_tbl[stm] != NULL);
}
for (; stm <= pl_stm_last_used; stm++)
if (pl_stm_tbl[stm])
break;
if (stm >= pl_stm_last_used)
{
if (stm > pl_stm_last_used)
return FALSE;
}
else /* non deterministic case */
{
A(0) = stm_word;
A(1) = stm + 1;
Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_STREAM_ALT, 0),
2);
}
return Pl_Get_Integer(stm, stm_word);
}
/*-------------------------------------------------------------------------*
* PL_NAME_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Name_2(WamWord atomic_word, WamWord codes_word)
{
WamWord word, tag_mask;
int syn_flag;
Bool is_number;
char *str;
DEREF(atomic_word, word, tag_mask);
if (tag_mask == TAG_ATM_MASK)
return Pl_Atom_Codes_2(word, codes_word);
if (tag_mask == TAG_INT_MASK || tag_mask == TAG_FLT_MASK)
return Pl_Number_Codes_2(word, codes_word);
if (tag_mask != TAG_REF_MASK)
Pl_Err_Type(pl_type_atomic, word);
str = Pl_Rd_Codes_Check(codes_word);
syn_flag = Flag_Value(syntax_error);
Flag_Value(syntax_error) = PF_ERR_FAIL;
is_number = String_To_Number(str, word); /* only fails on syn err */
Flag_Value(syntax_error) = syn_flag;
if (is_number)
return TRUE;
return Pl_Un_String(str, word);
}
/*-------------------------------------------------------------------------*
* PL_BETWEEN_3 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Between_3(WamWord l_word, WamWord u_word, WamWord i_word)
{
WamWord word, tag_mask;
PlLong l, u, i;
l = Pl_Rd_Integer_Check(l_word);
u = Pl_Rd_Integer_Check(u_word);
DEREF(i_word, word, tag_mask);
if (tag_mask != TAG_REF_MASK)
{
i = Pl_Rd_Integer_Check(word);
return i >= l && i <= u;
}
i_word = word;
if (l > u)
return FALSE;
/* here i_word is a variable */
if (l < u) /* non deterministic case */
{
A(0) = l + 1;
A(1) = u;
A(2) = i_word;
Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(BETWEEN_ALT, 0), 3);
}
return Pl_Get_Integer(l, i_word); /* always TRUE */
}
CFUN__PROTO(current_instance, instance_t *)
{
int_info_t *root;
BlockingType block;
#if defined(PROFILE)
tagged_t *junk;
w->node->functor=find_definition(predicates_location,X(0),&junk,FALSE);
#endif
PredTrace("I",w->node->functor);
root = TagToRoot(X(2));
if (root->behavior_on_failure == DYNAMIC)
return current_instance_noconc(Arg);
else {
DEREF(X(4), X(4)); /* Blocking? (MCL) */
#if defined(DEBUG)
if (X(4) == atom_block)
block = BLOCK;
else if (X(4) == atom_no_block)
block = NO_BLOCK;
else {
failc("$current_instance called with unkown 5th argument");
return NULL;
}
#else
block = X(4) == atom_block ? BLOCK : NO_BLOCK;
#endif
return current_instance_conc(Arg, block);
}
}
/*-------------------------------------------------------------------------*
* PL_CURRENT_ATOM_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Current_Atom_2(WamWord atom_word, WamWord hide_word)
{
WamWord word, tag_mask;
Bool hide;
int atom;
hide = Pl_Rd_Integer_Check(hide_word);
DEREF(atom_word, word, tag_mask);
if (tag_mask != TAG_REF_MASK)
return *Pl_Rd_String_Check(word) != '$' || !hide;
atom = -1;
for (;;)
{
atom = Pl_Find_Next_Atom(atom);
if (atom == -1)
return FALSE;
if (!hide || pl_atom_tbl[atom].name[0] != '$')
break;
}
/* non deterministic case */
A(0) = atom_word;
A(1) = hide;
A(2) = atom;
Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_ATOM_ALT, 0), 3);
return Pl_Get_Atom(atom, atom_word);
}
/*-------------------------------------------------------------------------*
* PL_THROW_2 *
* *
*-------------------------------------------------------------------------*/
void
Pl_Throw_2(WamWord ball_word, WamWord b_word)
{
WamWord word, tag_mask;
WamWord *b;
StmInf *pstm;
DEREF(b_word, word, tag_mask);
b = From_WamWord_To_B(word);
if (b <= pl_query_top_b && pl_query_top_b != NULL)
{
Assign_B(pl_query_top_b);
pl_query_exception = ball_word;
Pl_Exit_With_Exception();
}
if (b == LSSA)
{
pstm = pl_stm_tbl[pl_stm_top_level_output];
Pl_Stream_Printf(pstm, "\nsystem_error(cannot_catch_throw(");
Pl_Write_Term(pstm, -1, MAX_PREC,
WRITE_NUMBER_VARS | WRITE_NAME_VARS | WRITE_QUOTED, NULL,
ball_word);
Pl_Stream_Printf(pstm, "))\n");
return;
}
Pl_Cut(b_word);
}
/*-------------------------------------------------------------------------*
* PL_SETARG_4 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Setarg_4(WamWord arg_no_word, WamWord term_word, WamWord new_value_word,
WamWord undo_word)
{
WamWord word, tag_mask;
int func, arity;
int undo;
WamWord *arg_adr;
int arg_no;
arg_adr = Pl_Rd_Compound_Check(term_word, &func, &arity);
arg_no = Pl_Rd_Positive_Check(arg_no_word) - 1;
undo = Pl_Rd_Boolean_Check(undo_word);
DEREF(new_value_word, word, tag_mask);
if (!undo && tag_mask != TAG_ATM_MASK && tag_mask != TAG_INT_MASK)
Pl_Err_Type(pl_type_atomic, word); /* pl_type_atomic but float not allowed */
if ((unsigned) arg_no >= (unsigned) arity)
return FALSE;
if (undo)
Bind_OV((arg_adr + arg_no), word);
else
arg_adr[arg_no] = word;
return TRUE;
}
