int prolog_code_call(CTXTdeclc Cell term, int value)
{
Psc psc;
if (isconstr(term)) {
int disp;
char *addr;
psc = get_str_psc(term);
addr = (char *)(clref_val(term));
for (disp = 1; disp <= (int)get_arity(psc); ++disp) {
bld_copy(reg+disp, cell((CPtr)(addr)+disp));
}
bld_int(reg+get_arity(psc)+1, value);
} else bld_int(reg+1, value);
return TRUE;
}
void add_interrupt(CTXTdeclc Cell op1, Cell op2) {
Cell head, tail, temp;
CPtr addr_head, addr_tail;
addr_head = (CPtr)glstack.low;
head = cell(addr_head); // addr of interrupt list
addr_tail = (CPtr)glstack.low+1;
tail = cell(addr_tail); // addr of last cons cell of interrupt list
// Build the new list cons pair and the new op-pair cons
// This record is 4 words long and so INT_REC_SIZE=4
bld_list(&temp,hreg); // temp -> new cons pair 1
bld_list(hreg,hreg+2); // 1.car -> 2nd new cons pair 2
hreg++;
bld_free(hreg); // 1.cdr is free var
hreg++;
bld_copy(hreg,op1); // 2.car is op1
hreg++;
bld_copy(hreg,op2); // 2.cdr is op2
hreg++;
if (isnonvar(head)) { // nonempty
CPtr addr_cdr;
addr_cdr = clref_val(tail)+1;
bind_copy(addr_cdr,temp);
push_pre_image_trail(addr_tail,temp);
bld_copy(addr_tail,temp);
} else { // first
bind_copy(addr_head,temp);
bind_copy(addr_tail,temp);
}
}
int prolog_call0(CTXTdeclc Cell term)
{
Psc psc;
if (isconstr(term)) {
int disp;
char *addr;
psc = get_str_psc(term);
addr = (char *)(clref_val(term));
for (disp = 1; disp <= (int)get_arity(psc); ++disp) {
bld_copy(reg+disp, cell((CPtr)(addr)+disp));
}
} else if (isstring(term)) {
int value;
Pair sym;
if (string_val(term) == true_string) return TRUE; /* short-circuit if calling "true" */
sym = insert(string_val(term),0,(Psc)flags[CURRENT_MODULE],&value);
psc = pair_psc(sym);
} else {
if (isnonvar(term))
xsb_type_error(CTXTc "callable",term,"call/1",1);
else xsb_instantiation_error(CTXTc "call/1",1);
return FALSE;
}
#ifdef CP_DEBUG
pscreg = psc;
#endif
pcreg = get_ep(psc);
if (asynint_val) intercept(CTXTc psc);
return TRUE;
}
Psc synint_proc(CTXTdeclc Psc psc, int intcode)
{
if (pflags[intcode+INT_HANDLERS_FLAGS_START]==(Cell)0) {
/* default hard handler */
default_inthandler(CTXTc intcode);
psc = 0;
} else { /* call Prolog handler */
switch (intcode) {
case MYSIG_UNDEF: /* 0 */
SYS_MUTEX_LOCK( MUTEX_LOAD_UNDEF ) ;
case MYSIG_KEYB: /* 1 */
case MYSIG_SPY: /* 3 */
case MYSIG_TRACE: /* 4 */
case THREADSIG_CANCEL: /* f */
case MYSIG_CLAUSE: /* 16 */
if (psc) bld_cs(reg+1, build_call(CTXTc psc));
psc = (Psc)pflags[intcode+INT_HANDLERS_FLAGS_START];
bld_int(reg+2, asynint_code);
pcreg = get_ep(psc);
break;
case MYSIG_ATTV: /* 8 */
/* the old call must be built first */
if (psc)
bld_cs(reg+2, build_call(CTXTc psc));
psc = (Psc)pflags[intcode+INT_HANDLERS_FLAGS_START];
/*
* Pass the interrupt chain to reg 1. The interrupt chain
* will be reset to 0 in build_interrupt_chain()).
*/
bld_copy(reg + 1, build_interrupt_chain(CTXT));
/* bld_int(reg + 3, intcode); */ /* Not really needed */
pcreg = get_ep(psc);
break;
default:
xsb_abort("Unknown intcode in synint_proc()");
} /* switch */
}
return psc;
}
