diff --git a/C/absmi.c b/C/absmi.c index f6c6c7f82..a4bdb7456 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -989,7 +989,7 @@ Yap_absmi(int inp) CACHE_Y(YREG); { struct index_t *i = (struct index_t *)(PREG->u.lp.l); - S_YREG[-1] = i->links[(CELL)(SREG-i->cls)/i->arity]; + S_YREG[-1] = (CELL)EXO_OFFSET_TO_ADDRESS(i,i->links[(CELL)(SREG-i->cls)/i->arity]); } S_YREG--; /* store arguments for procedure */ @@ -1011,6 +1011,41 @@ Yap_absmi(int inp) GONext(); ENDOp(); + /* check if enough space between trail and codespace */ + /* try_exo Pred,Label */ + Op(try_all_exo, lp); + /* check if enough space between trail and codespace */ + check_trail(TR); + /* I use YREG =to go through the choicepoint. Usually YREG =is in a + * register, but sometimes (X86) not. In this case, have a + * new register to point at YREG =*/ + CACHE_Y(YREG); + { + struct index_t *i = (struct index_t *)(PREG->u.lp.l); + SREG = i->cls; + S_YREG[-2] = (CELL)(SREG+i->arity); + S_YREG[-1] = (CELL)(SREG+i->arity*i->nels); + } + S_YREG-=2; + /* store arguments for procedure */ + store_at_least_one_arg(PREG->u.lp.p->ArityOfPE); + /* store abstract machine registers */ + store_yaam_regs(NEXTOP(PREG,lp), 0); + /* On a try_me, set cut to point at previous choicepoint, + * that is, to the B before the cut. + */ + set_cut(S_YREG, B); + /* now, install the new YREG =*/ + B = B_YREG; +#ifdef YAPOR + SCH_set_load(B_YREG); +#endif /* YAPOR */ + PREG = NEXTOP(NEXTOP(PREG, lp),lp); + SET_BB(B_YREG); + ENDCACHE_Y(); + GONext(); + ENDOp(); + /* retry_exo Pred */ Op(retry_exo, lp); BEGD(d0); @@ -1061,6 +1096,57 @@ Yap_absmi(int inp) GONext(); ENDOp(); + /* retry_exo Pred */ + Op(retry_all_exo, lp); + BEGD(d0); + CACHE_Y(B); + { + UInt arity = ((struct index_t *)PREG->u.lp.l)->arity; + CELL *extras = (CELL *)(B+1); + SREG = (CELL *)extras[arity]; + d0 = (SREG+arity != (CELL *)extras[arity+1]); + if (d0) { + extras[arity] = (CELL)(SREG+arity); + /* After retry, cut should be pointing at the parent + * choicepoint for the current B */ + restore_yaam_regs(PREG); + restore_at_least_one_arg(arity); +#ifdef FROZEN_STACKS + S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + set_cut(S_YREG, B->cp_b); +#else + set_cut(S_YREG, B_YREG->cp_b); +#endif /* FROZEN_STACKS */ + SET_BB(B_YREG); + } else { +#ifdef YAPOR + if (SCH_top_shared_cp(B)) { + SCH_last_alternative(PREG, B_YREG); + restore_at_least_one_arg(arity); +#ifdef FROZEN_STACKS + S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); +#endif /* FROZEN_STACKS */ + set_cut(S_YREG, B->cp_b); + } else +#endif /* YAPOR */ + { + pop_yaam_regs(); + pop_at_least_one_arg(arity); + /* After trust, cut should be pointing at the new top + * choicepoint */ +#ifdef FROZEN_STACKS + S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); +#endif /* FROZEN_STACKS */ + set_cut(S_YREG, B); + } + } + } + PREG = NEXTOP(PREG, lp); + ENDCACHE_Y(); + ENDD(D0); + GONext(); + ENDOp(); + /***************************************************************** * Profiled try - retry - trust instructions * *****************************************************************/ diff --git a/C/exo.c b/C/exo.c index f6bf4ae01..e83ab5fd0 100644 --- a/C/exo.c +++ b/C/exo.c @@ -213,21 +213,23 @@ fill_hash(UInt bmap, UInt bnds[], struct index_t *it) } static struct index_t * -add_index(struct index_t **ip, UInt bmap, UInt bndsf[], PredEntry *ap) +add_index(struct index_t **ip, UInt bmap, UInt bndsf[], PredEntry *ap, UInt count) { UInt ncls = ap->cs.p_code.NOfClauses, j; - CELL *base; + CELL *base = NULL; struct index_t *i; size_t sz; yamop *ptr; - if (!(base = (CELL *)Yap_AllocCodeSpace(3*sizeof(CELL)*ncls))) { - CACHE_REGS - save_machine_regs(); - LOCAL_Error_Size = 3*ncls*sizeof(CELL); - LOCAL_ErrorMessage = "not enough space to index"; - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); - return NULL; + if (count) { + if (!(base = (CELL *)Yap_AllocCodeSpace(3*sizeof(CELL)*ncls))) { + CACHE_REGS + save_machine_regs(); + LOCAL_Error_Size = 3*ncls*sizeof(CELL); + LOCAL_ErrorMessage = "not enough space to index"; + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); + return NULL; + } } sz = (CELL)NEXTOP(NEXTOP((yamop*)NULL,lp),lp)+ap->ArityOfPE*(CELL)NEXTOP((yamop *)NULL,x) +(CELL)NEXTOP(NEXTOP((yamop *)NULL,p),l); if (!(i = (struct index_t *)Yap_AllocCodeSpace(sizeof(struct index_t)+sz))) { @@ -238,7 +240,8 @@ add_index(struct index_t **ip, UInt bmap, UInt bndsf[], PredEntry *ap) Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return NULL; } - bzero(base, 3*sizeof(CELL)*ncls); + if (count) + bzero(base, 3*sizeof(CELL)*ncls); i->next = *ip; i->prev = NULL; i->nels = ncls; @@ -251,14 +254,22 @@ add_index(struct index_t **ip, UInt bmap, UInt bndsf[], PredEntry *ap) i->links = (CELL *)(base+2*ncls); i->cls = (CELL *)((ADDR)ap->cs.p_code.FirstClause+2*sizeof(struct index_t *)); *ip = i; - fill_hash(bmap, bndsf, i); + if (count) { + fill_hash(bmap, bndsf, i); + } ptr = (yamop *)(i+1); i->code = ptr; - ptr->opc = Yap_opcode(_try_exo); + if (count) + ptr->opc = Yap_opcode(_try_exo); + else + ptr->opc = Yap_opcode(_try_all_exo); ptr->u.lp.l = (yamop *)i; ptr->u.lp.p = ap; ptr = NEXTOP(ptr, lp); - ptr->opc = Yap_opcode(_retry_exo); + if (count) + ptr->opc = Yap_opcode(_retry_exo); + else + ptr->opc = Yap_opcode(_retry_all_exo); ptr->u.lp.p = ap; ptr->u.lp.l = (yamop *)i; ptr = NEXTOP(ptr, lp); @@ -314,17 +325,20 @@ Yap_ExoLookup(PredEntry *ap) i = i->next; } if (!i) { - i = add_index(ip, bmap, bnds, ap); + i = add_index(ip, bmap, bnds, ap, count); } - return LOOKUP(i, arity, bnds); + if (count) + return LOOKUP(i, arity, bnds); + else + return i->code; } CELL Yap_NextExo(choiceptr cptr, struct index_t *it) { - CELL offset = ((CELL *)(B+1))[it->arity]; + CELL offset = EXO_ADDRESS_TO_OFFSET(it,(CELL *)((CELL *)(B+1))[it->arity]); CELL next = it->links[offset]; - ((CELL *)(B+1))[it->arity] = next; + ((CELL *)(B+1))[it->arity] = (CELL)EXO_OFFSET_TO_ADDRESS(it, next); S = it->cls+it->arity*offset; return next; } diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index dedc4937f..5b22fb537 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -9,7 +9,9 @@ OPCODE(trust_me ,Otapl), OPCODE(enter_exo ,e), OPCODE(try_exo ,lp), + OPCODE(try_all_exo ,lp), OPCODE(retry_exo ,lp), + OPCODE(retry_all_exo ,lp), OPCODE(enter_profiling ,p), OPCODE(retry_profiled ,p), OPCODE(profiled_retry_me ,Otapl), diff --git a/H/clause.h b/H/clause.h index 2e10131de..6e2eacb32 100644 --- a/H/clause.h +++ b/H/clause.h @@ -173,6 +173,22 @@ typedef struct index_t { yamop *code; } Index_t; +INLINE_ONLY EXTERN inline UInt EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL *ptr); + +INLINE_ONLY EXTERN inline UInt +EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL* ptr) +{ + return ptr-it->links; +} + +INLINE_ONLY EXTERN inline CELL *EXO_OFFSET_TO_ADDRESS(struct index_t *it, UInt off); + +INLINE_ONLY EXTERN inline CELL * +EXO_OFFSET_TO_ADDRESS(struct index_t *it, UInt off) +{ + return it->links+off; +} + typedef struct dbterm_list { /* a list of dbterms associated with a clause */ diff --git a/H/rclause.h b/H/rclause.h index 453961d14..daa64fbe3 100644 --- a/H/rclause.h +++ b/H/rclause.h @@ -286,7 +286,9 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS) pc = NEXTOP(pc,llll); break; /* instructions type lp */ + case _retry_all_exo: case _retry_exo: + case _try_all_exo: case _try_exo: case _user_switch: pc->u.lp.l = PtoOpAdjust(pc->u.lp.l); diff --git a/H/saveclause.h b/H/saveclause.h index 8cd818c19..05020703a 100644 --- a/H/saveclause.h +++ b/H/saveclause.h @@ -303,7 +303,9 @@ pc = NEXTOP(pc,llll); break; /* instructions type lp */ + case _retry_all_exo: case _retry_exo: + case _try_all_exo: case _try_exo: case _user_switch: CHECK(save_PtoOp(stream, pc->u.lp.l)); diff --git a/H/walkclause.h b/H/walkclause.h index 20fc82edb..6bc7a8a41 100644 --- a/H/walkclause.h +++ b/H/walkclause.h @@ -216,7 +216,9 @@ pc = NEXTOP(pc,llll); break; /* instructions type lp */ + case _retry_all_exo: case _retry_exo: + case _try_all_exo: case _try_exo: case _user_switch: pc = NEXTOP(pc,lp);