diff --git a/C/amasm.c b/C/amasm.c index 61a7d82dd..01bbf1b88 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -11,8 +11,12 @@ * File: amasm.c * * comments: abstract machine assembler * * * -* Last rev: $Date: 2005-06-01 14:02:47 $ * +* Last rev: $Date: 2005-06-01 16:42:30 $ * * $Log: not supported by cvs2svn $ +* Revision 1.78 2005/06/01 14:02:47 vsc +* get_rid of try_me?, retry_me? and trust_me? instructions: they are not +* significantly used nowadays. +* * Revision 1.77 2005/05/31 19:42:27 vsc * insert some more slack for indices in LU * Use doubly linked list for LU indices so that updating is less cumbersome. @@ -1226,31 +1230,75 @@ a_xigl(op_numbers opcode, yamop *code_p, int pass_no, struct PSEUDO *cpc) return code_p; } +/* enable peephole optimisation for switch_on_term to switch_on_list */ +static int +is_switch_on_list(op_numbers opcode, struct intermediates *cip) +{ + struct PSEUDO *cpc = cip->cpc, *ncpc, *n2cpc; + CELL *if_table; + + /* only do this is indexing code is stable */ + if (cip->CurrentPred->PredFlags & LogUpdatePredFlag) + return FALSE; + /* check if we are transforming a switch_on_type */ + if (opcode != _switch_on_type) + return FALSE; + /* should have two instructions next */ + if ((ncpc = cpc->nextInst) == NULL || + (n2cpc = ncpc->nextInst) == NULL) + return FALSE; + /* one a label, the other an if_constant */ + if (ncpc->op != label_op || + n2cpc->op != if_c_op) + return FALSE; + /* the label for the constant case should be the if_c label + (this should always hold) */ + if (cpc->arnds[1] != ncpc->rnd1) + return FALSE; + if_table = (CELL *)(n2cpc->rnd2); + /* the constant switch should only have the empty list */ + if (n2cpc->rnd1 != 1 || + if_table[0] !=TermNil) + return FALSE; + /* + should be pointing to a clause so that we can push the clause opcode, + this should be fixable; + also, we need to go what's in there, so it cannot be suspend code! + */ + if (cpc->arnds[0] & 1 || + (yamop *)(cpc->arnds[0]) == (yamop *)(&(cip->CurrentPred->cs.p_code.ExpandCode))) + return FALSE; + /* Appl alternative should be pointing to same point as [] alternative, + usually FAILCODE */ + if (if_table[3] != cpc->arnds[2]) + return FALSE; + /* yesss!! */ + return TRUE; +} + static yamop * a_4sw(op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip) { CELL *seq_ptr; - if (opcode == _switch_on_type && - cip->cpc->nextInst != NULL && - cip->cpc->nextInst->op == label_op && - cip->cpc->arnds[1] == cip->cpc->nextInst->rnd1 && - !(cip->cpc->arnds[0] & 1) && - cip->cpc->nextInst->nextInst != NULL && - cip->cpc->nextInst->nextInst->op == if_c_op && - cip->cpc->nextInst->nextInst->rnd1 == 1 && - cip->cpc->nextInst->nextInst->arnds[1] == TermNil && - cip->cpc->nextInst->nextInst->arnds[0] == cip->cpc->arnds[2]) { + if (is_switch_on_list(opcode, cip)) { if (pass_no) { + CELL *ars = (CELL *)(cip->cpc->nextInst->nextInst->rnd2); code_p->opc = emit_op(_switch_list_nl); seq_ptr = cip->cpc->arnds; code_p->u.ollll.pop = ((yamop *)(seq_ptr[0]))->opc; code_p->u.ollll.l1 = emit_ilabel(seq_ptr[0], cip); - code_p->u.ollll.l2 = emit_ilabel(cip->cpc->nextInst->nextInst->arnds[2], cip); + code_p->u.ollll.l2 = emit_ilabel(ars[1], cip); code_p->u.ollll.l3 = emit_ilabel(seq_ptr[2], cip); code_p->u.ollll.l4 = emit_ilabel(seq_ptr[3], cip); + if (cip->CurrentPred->PredFlags & LogUpdatePredFlag) { + Yap_FreeCodeSpace((char *)ClauseCodeToLogUpdIndex(ars)); + } else { + Yap_FreeCodeSpace((char *)ClauseCodeToStaticIndex(ars)); + } } GONEXT(ollll); + /* skip if_cons */ cip->cpc = cip->cpc->nextInst->nextInst; } else { if (pass_no) { diff --git a/C/index.c b/C/index.c index fd8f79b32..780d02f2d 100644 --- a/C/index.c +++ b/C/index.c @@ -11,8 +11,12 @@ * File: index.c * * comments: Indexing a Prolog predicate * * * -* Last rev: $Date: 2005-06-01 14:02:50 $,$Author: vsc $ * +* Last rev: $Date: 2005-06-01 16:42:30 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.133 2005/06/01 14:02:50 vsc +* get_rid of try_me?, retry_me? and trust_me? instructions: they are not +* significantly used nowadays. +* * Revision 1.132 2005/05/31 20:04:17 vsc * fix cleanup of expand_clauses: make sure we have everything with NULL afterwards. * @@ -4851,12 +4855,19 @@ expand_index(struct intermediates *cint) { labp = &(ipc->u.ollll.l1); sp = push_stack(sp, 1, AbsPair(NULL), TermNil, cint); ipc = ipc->u.ollll.l1; - } else if (IsApplTerm(t)) { - sp = push_stack(sp, 1, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil, cint); - ipc = ipc->u.ollll.l3; - } else { - sp = push_stack(sp, argno, t, TermNil, cint); + } else if (t == TermNil) { + sp = push_stack(sp, 1, t, TermNil, cint); ipc = ipc->u.ollll.l2; + } else { + Term tn; + + if (IsApplTerm(t)) { + tn = AbsAppl((CELL *)FunctorOfTerm(t)); + } else { + tn = t; + } + sp = push_stack(sp, argno, tn, TermNil, cint); + ipc = ipc->u.ollll.l3; } break; case _switch_on_arg_type: @@ -6780,54 +6791,8 @@ add_to_index(struct intermediates *cint, int first, path_stack_entry *sp, Clause } break; case _switch_list_nl: - sp = push_path(sp, &(ipc->u.ollll.l4), cls, cint); - if (ap->PredFlags & LogUpdatePredFlag) { - add_head_info(cls, 1); - } else { - add_info(cls, 1); - } - if (IsPairTerm(cls->Tag)) { - yamop *nipc = ipc->u.ollll.l1; - - current_arity = 2; - move_next(cls, 1); - if (nipc == FAILCODE) { - /* jump straight to clause */ - ipc->u.ollll.l1 = cls->CurrentCode; - ipc = pop_path(&sp, cls, ap); - } else { - /* go on */ - sp = cross_block(sp, &ipc->u.ollll.l1, ap); - ipc = nipc; - } - } else if (IsAtomOrIntTerm(cls->Tag)) { - yamop *nipc = ipc->u.ollll.l2; - move_next(cls, 1); - if (nipc == FAILCODE) { - /* need to expand the block */ - sp = kill_block(sp, ap); - ipc = pop_path(&sp, cls, ap); - } else { - /* I do not have to worry about crossing a block here */ - ipc = nipc; - } - } else if (IsApplTerm(cls->Tag)) { - yamop *nipc = ipc->u.ollll.l3; - if (nipc == FAILCODE) { - /* need to expand the block */ - sp = kill_block(sp, ap); - ipc = pop_path(&sp, cls, ap); - } else { - /* I do not have to worry about crossing a block here */ - ipc = nipc; - } - } else { - /* we can't separate into four groups, - need to restart. - */ - sp = kill_block(sp, ap); - ipc = pop_path(&sp, cls, ap); - } + sp = kill_block(sp, ap); + ipc = pop_path(&sp, cls, ap); break; case _switch_on_arg_type: sp = push_path(sp, &(ipc->u.xllll.l4), cls, cint); @@ -7322,51 +7287,8 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg } break; case _switch_list_nl: - sp = push_path(sp, &(ipc->u.ollll.l4), cls, cint); - if (ap->PredFlags & LogUpdatePredFlag) { - add_head_info(cls, 1); - } else { - add_info(cls, 1); - } - if (IsPairTerm(cls->Tag)) { - yamop *nipc = ipc->u.ollll.l1; - current_arity = 2; - if (IN_BETWEEN(bg,nipc,lt)) { - /* jump straight to clause */ - ipc->u.ollll.l1 = FAILCODE; - ipc = pop_path(&sp, cls, ap); - } else { - /* go on */ - sp = cross_block(sp, &ipc->u.ollll.l1, ap); - ipc = nipc; - } - } else if (IsAtomOrIntTerm(cls->Tag)) { - yamop *nipc = ipc->u.ollll.l2; - if (IN_BETWEEN(bg,nipc,lt)) { - /* jump straight to clause */ - ipc->u.ollll.l2 = FAILCODE; - ipc = pop_path(&sp, cls, ap); - } else { - /* I do not have to worry about crossing a block here */ - ipc = nipc; - } - } else if (IsApplTerm(cls->Tag)) { - yamop *nipc = ipc->u.ollll.l3; - if (IN_BETWEEN(bg,nipc,lt)) { - /* jump straight to clause */ - ipc->u.ollll.l3 = FAILCODE; - ipc = pop_path(&sp, cls, ap); - } else { - /* I do not have to worry about crossing a block here */ - ipc = nipc; - } - } else { - /* we can't separate into four groups, - need to restart. - */ - sp = kill_block(sp, ap); - ipc = pop_path(&sp, cls, ap); - } + sp = kill_block(sp, ap); + ipc = pop_path(&sp, cls, ap); break; case _switch_on_arg_type: sp = push_path(sp, &(ipc->u.xllll.l4), cls, cint); @@ -7973,7 +7895,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y jlbl = &(ipc->u.ollll.l1); ipc = ipc->u.ollll.l1; s_reg = RepPair(t); - } else if (IsAtomOrIntTerm(t)) { + } else if (t == TermNil) { jlbl = &(ipc->u.ollll.l2); ipc = ipc->u.ollll.l2; } else { @@ -8468,12 +8390,16 @@ find_caller(PredEntry *ap, yamop *code, struct intermediates *cint) { if (ipc->u.ollll.l1 == code) return &(ipc->u.ollll.l1); ipc = ipc->u.ollll.l1; - } else if (IsApplTerm(t)) { - sp = push_stack(sp, 1, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil, cint); - ipc = ipc->u.ollll.l3; - } else { + } else if (t == TermNil) { sp = push_stack(sp, 1, t, TermNil, cint); ipc = ipc->u.ollll.l2; + } else { + if (IsApplTerm(t)) { + sp = push_stack(sp, 1, t, AbsAppl((CELL *)FunctorOfTerm(t)), cint); + } else { + sp = push_stack(sp, 1, t, TermNil, cint); + } + ipc = ipc->u.ollll.l3; } break; case _switch_on_arg_type: