From ccca051c48a9629b7c5030733e5afa111a1167d7 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 14 Apr 2010 23:47:01 +0100 Subject: [PATCH 1/4] avoid using ftell: it can be very slow on NFS. --- C/iopreds.c | 20 ++++++-------------- C/stdpreds.c | 4 ++-- 2 files changed, 8 insertions(+), 16 deletions(-) diff --git a/C/iopreds.c b/C/iopreds.c index cc5fd51c8..b8600ace9 100755 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -3994,11 +3994,7 @@ static Int if (Stream[inp_stream].status & InMemory_Stream_f) { cpos = Stream[inp_stream].u.mem_string.pos; } else { -#if HAVE_FGETPOS - fgetpos(Stream[inp_stream].u.file.file, &rpos); -#else - cpos = ftell(Stream[inp_stream].u.file.file); -#endif + cpos = Stream[inp_stream].charcount; } } /* Scans the term using stack space */ @@ -4356,16 +4352,12 @@ static Term StreamPosition(int sno) { Term sargs[5]; - if (Stream[sno].status & (Tty_Stream_f|Socket_Stream_f|Pipe_Stream_f|InMemory_Stream_f)) - sargs[0] = MkIntTerm (Stream[sno].charcount); - else if (Stream[sno].status & Null_Stream_f) - sargs[0] = MkIntTerm (Stream[sno].charcount); - else { - if (Stream[sno].stream_getc == PlUnGetc) - sargs[0] = MkIntTerm (YP_ftell (Stream[sno].u.file.file) - 1); - else - sargs[0] = MkIntTerm (YP_ftell (Stream[sno].u.file.file)); + Int cpos; + cpos = Stream[sno].charcount; + if (Stream[sno].stream_getc == PlUnGetc) { + cpos--; } + sargs[0] = MkIntegerTerm (cpos); sargs[1] = MkIntegerTerm (StartLine = Stream[sno].linecount); sargs[2] = MkIntegerTerm (Stream[sno].linepos); sargs[3] = sargs[4] = MkIntTerm (0); diff --git a/C/stdpreds.c b/C/stdpreds.c index 715f21e5d..ffd7ce58b 100755 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -3857,8 +3857,8 @@ p_set_yap_flags(void) break; case QUIET_MODE_FLAG: if (value != 0 && value != 1) - return(FALSE); - yap_flags[VARS_CAN_HAVE_QUOTE_FLAG] = value; + return FALSE; + yap_flags[QUIET_MODE_FLAG] = value; break; default: return(FALSE); From e122f2ca8d5cbad921073a6a12fe149aafdc12d5 Mon Sep 17 00:00:00 2001 From: Ricardo Rocha Date: Thu, 15 Apr 2010 01:09:59 +0100 Subject: [PATCH 2/4] Global trie support: atomic terms (vars, integers and atoms) are now stored in the local tries (and not in the global trie). This required major changes to the trie instructions in order to unify the use of the auxiliary stack organization for the terms in the local tries and in the global trie. --- C/absmi.c | 58 +- C/cdmgr.c | 76 +- C/heapgc.c | 138 +-- C/index.c | 76 +- H/YapOpcodes.h | 76 +- H/rclause.h | 68 +- H/walkclause.h | 68 +- OPTYap/opt.proto.h | 2 +- OPTYap/tab.insts.i | 10 +- OPTYap/tab.macros.h | 26 +- OPTYap/tab.tries.c | 753 +++------------- OPTYap/tab.tries.i | 871 ++++++++++++++---- OPTYap/tab.tries.insts.i | 1830 +++++++++++++++++--------------------- 13 files changed, 1921 insertions(+), 2131 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index 47260abb7..404b9d712 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -1894,34 +1894,36 @@ Yap_absmi(int inp) case _table_answer_resolution: low_level_trace(retry_table_consumer, CONS_CP(B)->cp_pred_entry, NULL); break; - case _trie_trust_null: - case _trie_retry_null: - case _trie_trust_null_in_new_pair: - case _trie_retry_null_in_new_pair: - case _trie_trust_var: - case _trie_retry_var: - case _trie_trust_var_in_new_pair: - case _trie_retry_var_in_new_pair: - case _trie_trust_val: - case _trie_retry_val: - case _trie_trust_val_in_new_pair: - case _trie_retry_val_in_new_pair: - case _trie_trust_atom: - case _trie_retry_atom: - case _trie_trust_atom_in_new_pair: - case _trie_retry_atom_in_new_pair: - case _trie_trust_pair: - case _trie_retry_pair: - case _trie_trust_struct: - case _trie_retry_struct: - case _trie_trust_struct_in_new_pair: - case _trie_retry_struct_in_new_pair: - case _trie_trust_extension: - case _trie_retry_extension: - case _trie_trust_float: - case _trie_retry_float: - case _trie_trust_long: - case _trie_retry_long: + case _trie_trust_var: + case _trie_retry_var: + case _trie_trust_var_in_pair: + case _trie_retry_var_in_pair: + case _trie_trust_val: + case _trie_retry_val: + case _trie_trust_val_in_pair: + case _trie_retry_val_in_pair: + case _trie_trust_atom: + case _trie_retry_atom: + case _trie_trust_atom_in_pair: + case _trie_retry_atom_in_pair: + case _trie_trust_null: + case _trie_retry_null: + case _trie_trust_null_in_pair: + case _trie_retry_null_in_pair: + case _trie_trust_pair: + case _trie_retry_pair: + case _trie_trust_appl: + case _trie_retry_appl: + case _trie_trust_appl_in_pair: + case _trie_retry_appl_in_pair: + case _trie_trust_extension: + case _trie_retry_extension: + case _trie_trust_double: + case _trie_retry_double: + case _trie_trust_longint: + case _trie_retry_longint: + case _trie_trust_gterm: + case _trie_retry_gterm: low_level_trace(retry_table_loader, UndefCode, NULL); break; #endif /* TABLING */ diff --git a/C/cdmgr.c b/C/cdmgr.c index e259cd9d2..10a41e19b 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -558,34 +558,36 @@ PredForChoicePt(yamop *p_code) { case _profiled_trust_logical: return p_code->u.OtaLl.d->ClPred; #ifdef TABLING - case _trie_trust_null: - case _trie_retry_null: - case _trie_trust_null_in_new_pair: - case _trie_retry_null_in_new_pair: case _trie_trust_var: case _trie_retry_var: - case _trie_trust_var_in_new_pair: - case _trie_retry_var_in_new_pair: + case _trie_trust_var_in_pair: + case _trie_retry_var_in_pair: case _trie_trust_val: case _trie_retry_val: - case _trie_trust_val_in_new_pair: - case _trie_retry_val_in_new_pair: + case _trie_trust_val_in_pair: + case _trie_retry_val_in_pair: case _trie_trust_atom: case _trie_retry_atom: - case _trie_trust_atom_in_new_pair: - case _trie_retry_atom_in_new_pair: + case _trie_trust_atom_in_pair: + case _trie_retry_atom_in_pair: + case _trie_trust_null: + case _trie_retry_null: + case _trie_trust_null_in_pair: + case _trie_retry_null_in_pair: case _trie_trust_pair: case _trie_retry_pair: - case _trie_trust_struct: - case _trie_retry_struct: - case _trie_trust_struct_in_new_pair: - case _trie_retry_struct_in_new_pair: + case _trie_trust_appl: + case _trie_retry_appl: + case _trie_trust_appl_in_pair: + case _trie_retry_appl_in_pair: case _trie_trust_extension: case _trie_retry_extension: - case _trie_trust_float: - case _trie_retry_float: - case _trie_trust_long: - case _trie_retry_long: + case _trie_trust_double: + case _trie_retry_double: + case _trie_trust_longint: + case _trie_retry_longint: + case _trie_trust_gterm: + case _trie_retry_gterm: return NULL; case _table_load_answer: case _table_try_answer: @@ -5506,34 +5508,36 @@ p_choicepoint_info(void) #endif t = MkVarTerm(); break; - case _trie_trust_null: - case _trie_retry_null: - case _trie_trust_null_in_new_pair: - case _trie_retry_null_in_new_pair: case _trie_trust_var: case _trie_retry_var: - case _trie_trust_var_in_new_pair: - case _trie_retry_var_in_new_pair: + case _trie_trust_var_in_pair: + case _trie_retry_var_in_pair: case _trie_trust_val: case _trie_retry_val: - case _trie_trust_val_in_new_pair: - case _trie_retry_val_in_new_pair: + case _trie_trust_val_in_pair: + case _trie_retry_val_in_pair: case _trie_trust_atom: case _trie_retry_atom: - case _trie_trust_atom_in_new_pair: - case _trie_retry_atom_in_new_pair: + case _trie_trust_atom_in_pair: + case _trie_retry_atom_in_pair: + case _trie_trust_null: + case _trie_retry_null: + case _trie_trust_null_in_pair: + case _trie_retry_null_in_pair: case _trie_trust_pair: case _trie_retry_pair: - case _trie_trust_struct: - case _trie_retry_struct: - case _trie_trust_struct_in_new_pair: - case _trie_retry_struct_in_new_pair: + case _trie_trust_appl: + case _trie_retry_appl: + case _trie_trust_appl_in_pair: + case _trie_retry_appl_in_pair: case _trie_trust_extension: case _trie_retry_extension: - case _trie_trust_float: - case _trie_retry_float: - case _trie_trust_long: - case _trie_retry_long: + case _trie_trust_double: + case _trie_retry_double: + case _trie_trust_longint: + case _trie_retry_longint: + case _trie_trust_gterm: + case _trie_retry_gterm: pe = UndefCode; t = MkVarTerm(); break; diff --git a/C/heapgc.c b/C/heapgc.c index ade299df5..e05ad8717 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -2095,58 +2095,61 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose) } nargs = 0; break; - case _trie_trust_null: - case _trie_retry_null: - case _trie_trust_null_in_new_pair: - case _trie_retry_null_in_new_pair: case _trie_trust_var: case _trie_retry_var: - case _trie_trust_var_in_new_pair: - case _trie_retry_var_in_new_pair: + case _trie_trust_var_in_pair: + case _trie_retry_var_in_pair: case _trie_trust_val: case _trie_retry_val: - case _trie_trust_val_in_new_pair: - case _trie_retry_val_in_new_pair: + case _trie_trust_val_in_pair: + case _trie_retry_val_in_pair: case _trie_trust_atom: case _trie_retry_atom: - case _trie_trust_atom_in_new_pair: - case _trie_retry_atom_in_new_pair: + case _trie_trust_atom_in_pair: + case _trie_retry_atom_in_pair: + case _trie_trust_null: + case _trie_retry_null: + case _trie_trust_null_in_pair: + case _trie_retry_null_in_pair: case _trie_trust_pair: case _trie_retry_pair: - case _trie_trust_struct: - case _trie_retry_struct: - case _trie_trust_struct_in_new_pair: - case _trie_retry_struct_in_new_pair: + case _trie_trust_appl: + case _trie_retry_appl: + case _trie_trust_appl_in_pair: + case _trie_retry_appl_in_pair: case _trie_trust_extension: case _trie_retry_extension: - case _trie_trust_float: - case _trie_retry_float: - case _trie_trust_long: - case _trie_retry_long: + case _trie_trust_double: + case _trie_retry_double: + case _trie_trust_longint: + case _trie_retry_longint: + case _trie_trust_gterm: + case _trie_retry_gterm: { CELL *vars_ptr; int heap_arity, vars_arity, subs_arity; vars_ptr = (CELL *)(gc_B + 1); - heap_arity = *vars_ptr; - vars_arity = *(vars_ptr + heap_arity + 1); - subs_arity = *(vars_ptr + heap_arity + 2); - vars_ptr += heap_arity + subs_arity + vars_arity + 2; - if (vars_arity) { - while (vars_arity--) { - mark_external_reference(vars_ptr); - vars_ptr--; - } - } + heap_arity = vars_ptr[0]; + vars_arity = vars_ptr[1 + heap_arity]; + subs_arity = vars_ptr[2 + heap_arity + vars_arity]; + vars_ptr += 2 + heap_arity + subs_arity + vars_arity; if (subs_arity) { while (subs_arity--) { mark_external_reference(vars_ptr); vars_ptr--; } } - vars_ptr -= 2; + vars_ptr--; /* skip subs_arity entry */ + if (vars_arity) { + while (vars_arity--) { + mark_external_reference(vars_ptr); + vars_ptr--; + } + } + vars_ptr--; /* skip vars_arity entry */ if (heap_arity) { while (heap_arity--) { - if (*vars_ptr == 0) /* float/longint extension mark */ + if (*vars_ptr == 0) /* double/longint extension mark */ break; mark_external_reference(vars_ptr); vars_ptr--; @@ -3006,55 +3009,45 @@ sweep_choicepoints(choiceptr gc_B) } } break; - case _trie_trust_null: - case _trie_retry_null: - case _trie_trust_null_in_new_pair: - case _trie_retry_null_in_new_pair: case _trie_trust_var: case _trie_retry_var: - case _trie_trust_var_in_new_pair: - case _trie_retry_var_in_new_pair: + case _trie_trust_var_in_pair: + case _trie_retry_var_in_pair: case _trie_trust_val: case _trie_retry_val: - case _trie_trust_val_in_new_pair: - case _trie_retry_val_in_new_pair: + case _trie_trust_val_in_pair: + case _trie_retry_val_in_pair: case _trie_trust_atom: case _trie_retry_atom: - case _trie_trust_atom_in_new_pair: - case _trie_retry_atom_in_new_pair: + case _trie_trust_atom_in_pair: + case _trie_retry_atom_in_pair: + case _trie_trust_null: + case _trie_retry_null: + case _trie_trust_null_in_pair: + case _trie_retry_null_in_pair: case _trie_trust_pair: case _trie_retry_pair: - case _trie_trust_struct: - case _trie_retry_struct: - case _trie_trust_struct_in_new_pair: - case _trie_retry_struct_in_new_pair: + case _trie_trust_appl: + case _trie_retry_appl: + case _trie_trust_appl_in_pair: + case _trie_retry_appl_in_pair: case _trie_trust_extension: case _trie_retry_extension: - case _trie_trust_float: - case _trie_retry_float: - case _trie_trust_long: - case _trie_retry_long: + case _trie_trust_double: + case _trie_retry_double: + case _trie_trust_longint: + case _trie_retry_longint: + case _trie_trust_gterm: + case _trie_retry_gterm: { CELL *vars_ptr; int heap_arity, vars_arity, subs_arity; sweep_environments(gc_B->cp_env, EnvSize(gc_B->cp_cp), EnvBMap(gc_B->cp_cp)); vars_ptr = (CELL *)(gc_B + 1); - heap_arity = *vars_ptr; - vars_arity = *(vars_ptr + heap_arity + 1); - subs_arity = *(vars_ptr + heap_arity + 2); - vars_ptr += heap_arity + subs_arity + vars_arity + 2; - if (vars_arity) { - while (vars_arity--) { - CELL cp_cell = *vars_ptr; - if (MARKED_PTR(vars_ptr)) { - UNMARK(vars_ptr); - if (HEAP_PTR(cp_cell)) { - into_relocation_chain(vars_ptr, GET_NEXT(cp_cell)); - } - } - vars_ptr--; - } - } + heap_arity = vars_ptr[0]; + vars_arity = vars_ptr[1 + heap_arity]; + subs_arity = vars_ptr[2 + heap_arity + vars_arity]; + vars_ptr += 2 + heap_arity + subs_arity + vars_arity; if (subs_arity) { while (subs_arity--) { CELL cp_cell = *vars_ptr; @@ -3067,11 +3060,24 @@ sweep_choicepoints(choiceptr gc_B) vars_ptr--; } } - vars_ptr -= 2; + vars_ptr--; /* skip subs_arity entry */ + if (vars_arity) { + while (vars_arity--) { + CELL cp_cell = *vars_ptr; + if (MARKED_PTR(vars_ptr)) { + UNMARK(vars_ptr); + if (HEAP_PTR(cp_cell)) { + into_relocation_chain(vars_ptr, GET_NEXT(cp_cell)); + } + } + vars_ptr--; + } + } + vars_ptr--; /* skip vars_arity entry */ if (heap_arity) { while (heap_arity--) { CELL cp_cell = *vars_ptr; - if (*vars_ptr == 0) /* float/longint extension mark */ + if (*vars_ptr == 0) /* double/longint extension mark */ break; if (MARKED_PTR(vars_ptr)) { UNMARK(vars_ptr); diff --git a/C/index.c b/C/index.c index ab2861f9b..cbec2cb8d 100644 --- a/C/index.c +++ b/C/index.c @@ -1069,62 +1069,66 @@ has_cut(yamop *pc) case _getwork_first_time: #endif /* YAPOR */ #ifdef TABLING - case _trie_do_null: - case _trie_trust_null: - case _trie_try_null: - case _trie_retry_null: - case _trie_do_null_in_new_pair: - case _trie_trust_null_in_new_pair: - case _trie_try_null_in_new_pair: - case _trie_retry_null_in_new_pair: case _trie_do_var: case _trie_trust_var: case _trie_try_var: case _trie_retry_var: - case _trie_do_var_in_new_pair: - case _trie_trust_var_in_new_pair: - case _trie_try_var_in_new_pair: - case _trie_retry_var_in_new_pair: + case _trie_do_var_in_pair: + case _trie_trust_var_in_pair: + case _trie_try_var_in_pair: + case _trie_retry_var_in_pair: case _trie_do_val: case _trie_trust_val: case _trie_try_val: case _trie_retry_val: - case _trie_do_val_in_new_pair: - case _trie_trust_val_in_new_pair: - case _trie_try_val_in_new_pair: - case _trie_retry_val_in_new_pair: + case _trie_do_val_in_pair: + case _trie_trust_val_in_pair: + case _trie_try_val_in_pair: + case _trie_retry_val_in_pair: case _trie_do_atom: case _trie_trust_atom: case _trie_try_atom: case _trie_retry_atom: - case _trie_do_atom_in_new_pair: - case _trie_trust_atom_in_new_pair: - case _trie_try_atom_in_new_pair: - case _trie_retry_atom_in_new_pair: + case _trie_do_atom_in_pair: + case _trie_trust_atom_in_pair: + case _trie_try_atom_in_pair: + case _trie_retry_atom_in_pair: + case _trie_do_null: + case _trie_trust_null: + case _trie_try_null: + case _trie_retry_null: + case _trie_do_null_in_pair: + case _trie_trust_null_in_pair: + case _trie_try_null_in_pair: + case _trie_retry_null_in_pair: case _trie_do_pair: case _trie_trust_pair: case _trie_try_pair: case _trie_retry_pair: - case _trie_do_struct: - case _trie_trust_struct: - case _trie_try_struct: - case _trie_retry_struct: - case _trie_do_struct_in_new_pair: - case _trie_trust_struct_in_new_pair: - case _trie_try_struct_in_new_pair: - case _trie_retry_struct_in_new_pair: + case _trie_do_appl: + case _trie_trust_appl: + case _trie_try_appl: + case _trie_retry_appl: + case _trie_do_appl_in_pair: + case _trie_trust_appl_in_pair: + case _trie_try_appl_in_pair: + case _trie_retry_appl_in_pair: case _trie_do_extension: case _trie_trust_extension: case _trie_try_extension: case _trie_retry_extension: - case _trie_do_float: - case _trie_trust_float: - case _trie_try_float: - case _trie_retry_float: - case _trie_do_long: - case _trie_trust_long: - case _trie_try_long: - case _trie_retry_long: + case _trie_do_double: + case _trie_trust_double: + case _trie_try_double: + case _trie_retry_double: + case _trie_do_longint: + case _trie_trust_longint: + case _trie_try_longint: + case _trie_retry_longint: + case _trie_do_gterm: + case _trie_trust_gterm: + case _trie_try_gterm: + case _trie_retry_gterm: #endif /* TABLING */ pc = NEXTOP(pc,e); break; diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index 679a381a1..9ab8d22db 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -341,62 +341,66 @@ OPCODE(table_new_answer ,s), OPCODE(table_answer_resolution ,Otapl), OPCODE(table_completion ,Otapl), - OPCODE(trie_do_null ,e), - OPCODE(trie_trust_null ,e), - OPCODE(trie_try_null ,e), - OPCODE(trie_retry_null ,e), - OPCODE(trie_do_null_in_new_pair ,e), - OPCODE(trie_trust_null_in_new_pair,e), - OPCODE(trie_try_null_in_new_pair ,e), - OPCODE(trie_retry_null_in_new_pair,e), OPCODE(trie_do_var ,e), OPCODE(trie_trust_var ,e), OPCODE(trie_try_var ,e), OPCODE(trie_retry_var ,e), - OPCODE(trie_do_var_in_new_pair ,e), - OPCODE(trie_trust_var_in_new_pair ,e), - OPCODE(trie_try_var_in_new_pair ,e), - OPCODE(trie_retry_var_in_new_pair ,e), + OPCODE(trie_do_var_in_pair ,e), + OPCODE(trie_trust_var_in_pair ,e), + OPCODE(trie_try_var_in_pair ,e), + OPCODE(trie_retry_var_in_pair ,e), OPCODE(trie_do_val ,e), OPCODE(trie_trust_val ,e), OPCODE(trie_try_val ,e), OPCODE(trie_retry_val ,e), - OPCODE(trie_do_val_in_new_pair ,e), - OPCODE(trie_trust_val_in_new_pair ,e), - OPCODE(trie_try_val_in_new_pair ,e), - OPCODE(trie_retry_val_in_new_pair ,e), + OPCODE(trie_do_val_in_pair ,e), + OPCODE(trie_trust_val_in_pair ,e), + OPCODE(trie_try_val_in_pair ,e), + OPCODE(trie_retry_val_in_pair ,e), OPCODE(trie_do_atom ,e), OPCODE(trie_trust_atom ,e), OPCODE(trie_try_atom ,e), OPCODE(trie_retry_atom ,e), - OPCODE(trie_do_atom_in_new_pair ,e), - OPCODE(trie_trust_atom_in_new_pair,e), - OPCODE(trie_try_atom_in_new_pair ,e), - OPCODE(trie_retry_atom_in_new_pair,e), + OPCODE(trie_do_atom_in_pair ,e), + OPCODE(trie_trust_atom_in_pair ,e), + OPCODE(trie_try_atom_in_pair ,e), + OPCODE(trie_retry_atom_in_pair ,e), + OPCODE(trie_do_null ,e), + OPCODE(trie_trust_null ,e), + OPCODE(trie_try_null ,e), + OPCODE(trie_retry_null ,e), + OPCODE(trie_do_null_in_pair ,e), + OPCODE(trie_trust_null_in_pair ,e), + OPCODE(trie_try_null_in_pair ,e), + OPCODE(trie_retry_null_in_pair ,e), OPCODE(trie_do_pair ,e), OPCODE(trie_trust_pair ,e), OPCODE(trie_try_pair ,e), OPCODE(trie_retry_pair ,e), - OPCODE(trie_do_struct ,e), - OPCODE(trie_trust_struct ,e), - OPCODE(trie_try_struct ,e), - OPCODE(trie_retry_struct ,e), - OPCODE(trie_do_struct_in_new_pair ,e), - OPCODE(trie_trust_struct_in_new_pair,e), - OPCODE(trie_try_struct_in_new_pair,e), - OPCODE(trie_retry_struct_in_new_pair,e), + OPCODE(trie_do_appl ,e), + OPCODE(trie_trust_appl ,e), + OPCODE(trie_try_appl ,e), + OPCODE(trie_retry_appl ,e), + OPCODE(trie_do_appl_in_pair ,e), + OPCODE(trie_trust_appl_in_pair ,e), + OPCODE(trie_try_appl_in_pair ,e), + OPCODE(trie_retry_appl_in_pair ,e), OPCODE(trie_do_extension ,e), OPCODE(trie_trust_extension ,e), OPCODE(trie_try_extension ,e), OPCODE(trie_retry_extension ,e), - OPCODE(trie_do_float ,e), - OPCODE(trie_trust_float ,e), - OPCODE(trie_try_float ,e), - OPCODE(trie_retry_float ,e), - OPCODE(trie_do_long ,e), - OPCODE(trie_trust_long ,e), - OPCODE(trie_try_long ,e), - OPCODE(trie_retry_long ,e), + OPCODE(trie_do_double ,e), + OPCODE(trie_trust_double ,e), + OPCODE(trie_try_double ,e), + OPCODE(trie_retry_double ,e), + OPCODE(trie_do_longint ,e), + OPCODE(trie_trust_longint ,e), + OPCODE(trie_try_longint ,e), + OPCODE(trie_retry_longint ,e), + OPCODE(trie_do_gterm ,e), + OPCODE(trie_trust_gterm ,e), + OPCODE(trie_try_gterm ,e), + OPCODE(trie_retry_gterm ,e), #endif /* this instruction is hardwired */ #ifdef YAPOR diff --git a/H/rclause.h b/H/rclause.h index d94ddd6a9..f7715c73d 100644 --- a/H/rclause.h +++ b/H/rclause.h @@ -802,62 +802,66 @@ restore_opcodes(yamop *pc, yamop *max) pc = NEXTOP(pc,s); break; /* instructions type e */ + case _trie_do_appl: + case _trie_do_appl_in_pair: case _trie_do_atom: - case _trie_do_atom_in_new_pair: + case _trie_do_atom_in_pair: + case _trie_do_double: case _trie_do_extension: - case _trie_do_float: - case _trie_do_long: + case _trie_do_gterm: + case _trie_do_longint: case _trie_do_null: - case _trie_do_null_in_new_pair: + case _trie_do_null_in_pair: case _trie_do_pair: - case _trie_do_struct: - case _trie_do_struct_in_new_pair: case _trie_do_val: - case _trie_do_val_in_new_pair: + case _trie_do_val_in_pair: case _trie_do_var: - case _trie_do_var_in_new_pair: + case _trie_do_var_in_pair: + case _trie_retry_appl: + case _trie_retry_appl_in_pair: case _trie_retry_atom: - case _trie_retry_atom_in_new_pair: + case _trie_retry_atom_in_pair: + case _trie_retry_double: case _trie_retry_extension: - case _trie_retry_float: - case _trie_retry_long: + case _trie_retry_gterm: + case _trie_retry_longint: case _trie_retry_null: - case _trie_retry_null_in_new_pair: + case _trie_retry_null_in_pair: case _trie_retry_pair: - case _trie_retry_struct: - case _trie_retry_struct_in_new_pair: case _trie_retry_val: - case _trie_retry_val_in_new_pair: + case _trie_retry_val_in_pair: case _trie_retry_var: - case _trie_retry_var_in_new_pair: + case _trie_retry_var_in_pair: + case _trie_trust_appl: + case _trie_trust_appl_in_pair: case _trie_trust_atom: - case _trie_trust_atom_in_new_pair: + case _trie_trust_atom_in_pair: + case _trie_trust_double: case _trie_trust_extension: - case _trie_trust_float: - case _trie_trust_long: + case _trie_trust_gterm: + case _trie_trust_longint: case _trie_trust_null: - case _trie_trust_null_in_new_pair: + case _trie_trust_null_in_pair: case _trie_trust_pair: - case _trie_trust_struct: - case _trie_trust_struct_in_new_pair: case _trie_trust_val: - case _trie_trust_val_in_new_pair: + case _trie_trust_val_in_pair: case _trie_trust_var: - case _trie_trust_var_in_new_pair: + case _trie_trust_var_in_pair: + case _trie_try_appl: + case _trie_try_appl_in_pair: case _trie_try_atom: - case _trie_try_atom_in_new_pair: + case _trie_try_atom_in_pair: + case _trie_try_double: case _trie_try_extension: - case _trie_try_float: - case _trie_try_long: + case _trie_try_gterm: + case _trie_try_longint: case _trie_try_null: - case _trie_try_null_in_new_pair: + case _trie_try_null_in_pair: case _trie_try_pair: - case _trie_try_struct: - case _trie_try_struct_in_new_pair: case _trie_try_val: - case _trie_try_val_in_new_pair: + case _trie_try_val_in_pair: case _trie_try_var: - case _trie_try_var_in_new_pair: + case _trie_try_var_in_pair: if (op == _Nstop || op == _copy_idb_term || op == _unify_idb_term) return; pc = NEXTOP(pc,e); break; diff --git a/H/walkclause.h b/H/walkclause.h index 8138ba865..539db02f2 100644 --- a/H/walkclause.h +++ b/H/walkclause.h @@ -614,62 +614,66 @@ pc = NEXTOP(pc,s); break; /* instructions type e */ + case _trie_do_appl: + case _trie_do_appl_in_pair: case _trie_do_atom: - case _trie_do_atom_in_new_pair: + case _trie_do_atom_in_pair: + case _trie_do_double: case _trie_do_extension: - case _trie_do_float: - case _trie_do_long: + case _trie_do_gterm: + case _trie_do_longint: case _trie_do_null: - case _trie_do_null_in_new_pair: + case _trie_do_null_in_pair: case _trie_do_pair: - case _trie_do_struct: - case _trie_do_struct_in_new_pair: case _trie_do_val: - case _trie_do_val_in_new_pair: + case _trie_do_val_in_pair: case _trie_do_var: - case _trie_do_var_in_new_pair: + case _trie_do_var_in_pair: + case _trie_retry_appl: + case _trie_retry_appl_in_pair: case _trie_retry_atom: - case _trie_retry_atom_in_new_pair: + case _trie_retry_atom_in_pair: + case _trie_retry_double: case _trie_retry_extension: - case _trie_retry_float: - case _trie_retry_long: + case _trie_retry_gterm: + case _trie_retry_longint: case _trie_retry_null: - case _trie_retry_null_in_new_pair: + case _trie_retry_null_in_pair: case _trie_retry_pair: - case _trie_retry_struct: - case _trie_retry_struct_in_new_pair: case _trie_retry_val: - case _trie_retry_val_in_new_pair: + case _trie_retry_val_in_pair: case _trie_retry_var: - case _trie_retry_var_in_new_pair: + case _trie_retry_var_in_pair: + case _trie_trust_appl: + case _trie_trust_appl_in_pair: case _trie_trust_atom: - case _trie_trust_atom_in_new_pair: + case _trie_trust_atom_in_pair: + case _trie_trust_double: case _trie_trust_extension: - case _trie_trust_float: - case _trie_trust_long: + case _trie_trust_gterm: + case _trie_trust_longint: case _trie_trust_null: - case _trie_trust_null_in_new_pair: + case _trie_trust_null_in_pair: case _trie_trust_pair: - case _trie_trust_struct: - case _trie_trust_struct_in_new_pair: case _trie_trust_val: - case _trie_trust_val_in_new_pair: + case _trie_trust_val_in_pair: case _trie_trust_var: - case _trie_trust_var_in_new_pair: + case _trie_trust_var_in_pair: + case _trie_try_appl: + case _trie_try_appl_in_pair: case _trie_try_atom: - case _trie_try_atom_in_new_pair: + case _trie_try_atom_in_pair: + case _trie_try_double: case _trie_try_extension: - case _trie_try_float: - case _trie_try_long: + case _trie_try_gterm: + case _trie_try_longint: case _trie_try_null: - case _trie_try_null_in_new_pair: + case _trie_try_null_in_pair: case _trie_try_pair: - case _trie_try_struct: - case _trie_try_struct_in_new_pair: case _trie_try_val: - case _trie_try_val_in_new_pair: + case _trie_try_val_in_pair: case _trie_try_var: - case _trie_try_var_in_new_pair: + case _trie_try_var_in_pair: pc = NEXTOP(pc,e); break; #endif diff --git a/OPTYap/opt.proto.h b/OPTYap/opt.proto.h index 8e844490a..18e4bd665 100644 --- a/OPTYap/opt.proto.h +++ b/OPTYap/opt.proto.h @@ -75,7 +75,7 @@ void load_answer(ans_node_ptr, CELL *); #ifndef GLOBAL_TRIE void free_subgoal_trie_branch(sg_node_ptr, int, int, int); #else /* GLOBAL_TRIE */ -CELL *load_substitution_variable(gt_node_ptr, CELL *); +CELL *exec_substitution(gt_node_ptr, CELL *); void free_subgoal_trie_branch(sg_node_ptr, int, int); #endif /* GLOBAL_TRIE */ void free_answer_trie_branch(ans_node_ptr, int); diff --git a/OPTYap/tab.insts.i b/OPTYap/tab.insts.i index 326ad98f4..232b83a5f 100644 --- a/OPTYap/tab.insts.i +++ b/OPTYap/tab.insts.i @@ -509,9 +509,7 @@ PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr)); PREFETCH_OP(PREG); *--YENV = 0; /* vars_arity */ -#ifndef GLOBAL_TRIE *--YENV = 0; /* heap_arity */ -#endif /* GLOBAL_TRIE */ GONext(); } } @@ -624,9 +622,7 @@ PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr)); PREFETCH_OP(PREG); *--YENV = 0; /* vars_arity */ -#ifndef GLOBAL_TRIE *--YENV = 0; /* heap_arity */ -#endif /* GLOBAL_TRIE */ GONext(); } } @@ -739,9 +735,7 @@ PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr)); PREFETCH_OP(PREG); *--YENV = 0; /* vars_arity */ -#ifndef GLOBAL_TRIE *--YENV = 0; /* heap_arity */ -#endif /* GLOBAL_TRIE */ GONext(); } } @@ -1758,9 +1752,7 @@ PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr)); PREFETCH_OP(PREG); *--YENV = 0; /* vars_arity */ -#ifndef GLOBAL_TRIE - *--YENV = 0; /* heap_arity */ -#endif /* GLOBAL_TRIE */ + *--YENV = 0; /* heap_arity */ GONext(); } } diff --git a/OPTYap/tab.macros.h b/OPTYap/tab.macros.h index f7c1547d0..788cbf0b4 100644 --- a/OPTYap/tab.macros.h +++ b/OPTYap/tab.macros.h @@ -60,20 +60,20 @@ static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int); ** Macros ** *********************/ -#define SHOW_MODE_STRUCTURE 0 -#define SHOW_MODE_STATISTICS 1 -#define TRAVERSE_TYPE_SUBGOAL 0 -#define TRAVERSE_TYPE_ANSWER 1 -#define TRAVERSE_MODE_NORMAL 0 -#define TRAVERSE_MODE_FLOAT 1 -#define TRAVERSE_MODE_FLOAT2 2 -#define TRAVERSE_MODE_FLOAT_END 3 -#define TRAVERSE_MODE_LONG 4 -#define TRAVERSE_MODE_LONG_END 5 +#define SHOW_MODE_STRUCTURE 0 +#define SHOW_MODE_STATISTICS 1 +#define TRAVERSE_TYPE_SUBGOAL 0 +#define TRAVERSE_TYPE_ANSWER 1 +#define TRAVERSE_MODE_NORMAL 0 +#define TRAVERSE_MODE_DOUBLE 1 +#define TRAVERSE_MODE_DOUBLE2 2 +#define TRAVERSE_MODE_DOUBLE_END 3 +#define TRAVERSE_MODE_LONGINT 4 +#define TRAVERSE_MODE_LONGINT_END 5 /* do not change order !!! */ -#define TRAVERSE_POSITION_NEXT 0 -#define TRAVERSE_POSITION_FIRST 1 -#define TRAVERSE_POSITION_LAST 2 +#define TRAVERSE_POSITION_NEXT 0 +#define TRAVERSE_POSITION_FIRST 1 +#define TRAVERSE_POSITION_LAST 2 /* LowTagBits is 3 for 32 bit-machines and 7 for 64 bit-machines */ #define NumberOfLowTagBits (LowTagBits == 3 ? 2 : 3) diff --git a/OPTYap/tab.tries.c b/OPTYap/tab.tries.c index 82b1ea578..4aaba3d9b 100644 --- a/OPTYap/tab.tries.c +++ b/OPTYap/tab.tries.c @@ -26,40 +26,33 @@ #include "yapio.h" #include "tab.macros.h" -#ifndef GLOBAL_TRIE -static inline sg_node_ptr subgoal_trie_check_insert_token(tab_ent_ptr, sg_node_ptr, Term); -static inline ans_node_ptr answer_trie_check_insert_token(sg_fr_ptr, ans_node_ptr, Term, int); -#else /* GLOBAL_TRIE */ -static inline gt_node_ptr global_trie_check_insert_token(gt_node_ptr, Term); -static inline sg_node_ptr subgoal_trie_check_insert_gt_token(tab_ent_ptr, sg_node_ptr, Term); -static inline ans_node_ptr answer_trie_check_insert_gt_token(sg_fr_ptr, ans_node_ptr, Term, int); -#ifdef GLOBAL_TRIE_FOR_SUBTERMS -static inline gt_node_ptr global_trie_check_insert_gt_token(gt_node_ptr, Term); -#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ -#endif /* GLOBAL_TRIE */ - -#ifndef GLOBAL_TRIE +static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr, sg_node_ptr, Term); +static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr, ans_node_ptr, Term, int); static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr, sg_node_ptr, Term, int *, CELL **); static inline ans_node_ptr answer_search_loop(sg_fr_ptr, ans_node_ptr, Term, int *); static inline CELL *load_answer_loop(ans_node_ptr); -#else /* GLOBAL_TRIE */ + +#ifdef GLOBAL_TRIE +static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr, Term); +static inline sg_node_ptr subgoal_trie_check_insert_gt_entry(tab_ent_ptr, sg_node_ptr, Term); +static inline ans_node_ptr answer_trie_check_insert_gt_entry(sg_fr_ptr, ans_node_ptr, Term, int); #ifdef GLOBAL_TRIE_FOR_TERMS -static inline gt_node_ptr subgoal_search_loop_for_terms(Term, int *, CELL **); -static inline gt_node_ptr answer_search_loop_for_terms(Term, int *); +static inline gt_node_ptr subgoal_search_loop_gt_term(Term, int *, CELL **); +static inline gt_node_ptr answer_search_loop_gt_term(Term, int *); #elif GLOBAL_TRIE_FOR_SUBTERMS -static inline gt_node_ptr subgoal_search_loop_for_subterms(Term, int *, CELL **, CELL *); -static inline gt_node_ptr answer_search_loop_for_subterms(Term, int *, CELL *); +static inline gt_node_ptr global_trie_check_insert_gt_entry(gt_node_ptr, Term); +static inline gt_node_ptr subgoal_search_loop_gt_subterm(Term, int *, CELL **, CELL *); +static inline gt_node_ptr answer_search_loop_gt_subterm(Term, int *, CELL *); #endif /* GLOBAL_TRIE_MODE */ -static inline CELL *load_answer_loop(gt_node_ptr, int *, CELL *); -static inline CELL *load_substitution_variable_loop(gt_node_ptr, CELL **, CELL *); +static inline CELL *load_substitution_loop(gt_node_ptr, int *, CELL *); +static inline CELL *exec_substitution_loop(gt_node_ptr, CELL **, CELL *); #ifdef GLOBAL_TRIE_FOR_TERMS static void free_global_trie_branch(gt_node_ptr); #elif GLOBAL_TRIE_FOR_SUBTERMS static void free_global_trie_branch(gt_node_ptr, int); #endif /* GLOBAL_TRIE_MODE */ static void traverse_global_trie(gt_node_ptr, char *, int, int *, int, int); -static void traverse_global_trie_for_subgoal(gt_node_ptr, char *, int *, int *, int *); -static void traverse_global_trie_for_answer(gt_node_ptr, char *, int *, int *, int *); +static void traverse_global_trie_for_term(gt_node_ptr, char *, int *, int *, int *, int); #endif /* GLOBAL_TRIE */ static void traverse_subgoal_trie(sg_node_ptr, char *, int, int *, int, int); @@ -117,38 +110,25 @@ static struct trie_statistics{ fprintf(Yap_stdout, MESG, ##ARGS) #ifndef GLOBAL_TRIE -#define SUBGOAL_CHECK_INSERT_TOKEN(TAB_ENT, NODE, TOKEN) \ - NODE = subgoal_trie_check_insert_token(TAB_ENT, NODE, TOKEN) -#define ANSWER_CHECK_INSERT_TOKEN(SG_FR, NODE, TOKEN, INSTR) \ - NODE = answer_trie_check_insert_token(SG_FR, NODE, TOKEN, INSTR) -#define INCREMENT_GLOBAL_TRIE_REFERENCE(REF) #define DECREMENT_GLOBAL_TRIE_REFERENCE(REF) #else /* GLOBAL_TRIE */ -#define SUBGOAL_CHECK_INSERT_TOKEN(TAB_ENT, NODE, TOKEN) \ - NODE = global_trie_check_insert_token(NODE, TOKEN) -#define ANSWER_CHECK_INSERT_TOKEN(SG_FR, NODE, TOKEN, INSTR) \ - NODE = global_trie_check_insert_token(NODE, TOKEN) -#define INCREMENT_GLOBAL_TRIE_REFERENCE(REF) \ - { register gt_node_ptr gt_node = (gt_node_ptr) (REF); \ - TrNode_child(gt_node) = (gt_node_ptr) ((unsigned long int) TrNode_child(gt_node) + 1); \ - } #define DECREMENT_GLOBAL_TRIE_REFERENCE(REF) \ - { register gt_node_ptr gt_node = (gt_node_ptr) (REF); \ - TrNode_child(gt_node) = (gt_node_ptr) ((unsigned long int) TrNode_child(gt_node) - 1); \ + if (IsVarTerm(REF) && REF > VarIndexOfTableTerm(MAX_TABLE_VARS)) { \ + register gt_node_ptr gt_node = (gt_node_ptr) (REF); \ + TrNode_child(gt_node) = (gt_node_ptr) ((unsigned long int) TrNode_child(gt_node) - 1); \ if (TrNode_child(gt_node) == 0) \ FREE_GLOBAL_TRIE_BRANCH(gt_node,TRAVERSE_MODE_NORMAL); \ - } + } #endif /* GLOBAL_TRIE */ #ifdef GLOBAL_TRIE_FOR_SUBTERMS -#define CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF,MODE) \ - if (MODE == TRAVERSE_MODE_NORMAL && IsVarTerm(REF) && REF > VarIndexOfTableTerm(MAX_TABLE_VARS)) { \ - DECREMENT_GLOBAL_TRIE_REFERENCE(REF); \ - } -#define FREE_GLOBAL_TRIE_BRANCH(NODE,MODE) \ +#define CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF,MODE) \ + if (MODE == TRAVERSE_MODE_NORMAL) \ + DECREMENT_GLOBAL_TRIE_REFERENCE(REF) +#define FREE_GLOBAL_TRIE_BRANCH(NODE,MODE) \ free_global_trie_branch(NODE,MODE) #else #define CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF,MODE) -#define FREE_GLOBAL_TRIE_BRANCH(NODE,MODE) \ +#define FREE_GLOBAL_TRIE_BRANCH(NODE,MODE) \ free_global_trie_branch(NODE) #endif /* GLOBAL_TRIE_FOR_SUBTEMRS */ @@ -158,528 +138,45 @@ static struct trie_statistics{ ** Local functions ** ******************************/ -#ifndef GLOBAL_TRIE -#define INCLUDE_SUBGOAL_TRIE_CHECK_INSERT /* subgoal_trie_check_insert_token() */ -#define INCLUDE_ANSWER_TRIE_CHECK_INSERT /* answer_trie_check_insert_token() */ -#include "tab.tries.i" -#else /* GLOBAL_TRIE */ -#define INCLUDE_GLOBAL_TRIE_CHECK_INSERT /* global_trie_check_insert_token() */ -#include "tab.tries.i" -#define IS_GLOBAL_TRIE_REFERENCE -#define INCLUDE_SUBGOAL_TRIE_CHECK_INSERT /* subgoal_trie_check_insert_gt_token() */ -#define INCLUDE_ANSWER_TRIE_CHECK_INSERT /* answer_trie_check_insert_gt_token() */ -#ifndef GLOBAL_TRIE_FOR_SUBTERMS -#undef INCLUDE_GLOBAL_TRIE_CHECK_INSERT /* global_trie_check_insert_gt_token() */ -#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ -#include "tab.tries.i" +#define INCLUDE_SUBGOAL_TRIE_CHECK_INSERT /* subgoal_trie_check_insert_entry */ +#define INCLUDE_ANSWER_TRIE_CHECK_INSERT /* answer_trie_check_insert_entry */ +#ifdef GLOBAL_TRIE +#define INCLUDE_GLOBAL_TRIE_CHECK_INSERT /* global_trie_check_insert_entry */ #endif /* GLOBAL_TRIE */ +#define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_loop */ +#define INCLUDE_ANSWER_SEARCH_LOOP /* answer_search_loop */ +#define INCLUDE_LOAD_ANSWER_LOOP /* load_answer_loop */ +#include "tab.tries.i" #undef INCLUDE_SUBGOAL_TRIE_CHECK_INSERT #undef INCLUDE_ANSWER_TRIE_CHECK_INSERT #undef INCLUDE_GLOBAL_TRIE_CHECK_INSERT -#undef IS_GLOBAL_TRIE_REFERENCE - - -#ifndef GLOBAL_TRIE -static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr tab_ent, sg_node_ptr current_node, Term t, int *subs_arity_ptr, CELL **stack_vars_ptr) { -#elif GLOBAL_TRIE_FOR_TERMS -static inline gt_node_ptr subgoal_search_loop_for_terms(Term t, int *subs_arity_ptr, CELL **stack_vars_ptr) { -#elif GLOBAL_TRIE_FOR_SUBTERMS -static inline gt_node_ptr subgoal_search_loop_for_subterms(Term t, int *subs_arity_ptr, CELL **stack_vars_ptr, CELL *stack_terms) { -#endif -/************************************************************************ - =========== - | | - | ... | - | | - ----------- - | VAR_N | <-- stack_vars - ----------- * - | ... | /|\ - ----------- | subs_arity (N+1) - | VAR_0 | \|/ - ----------- * - YENV --> | | - ----------- - | | - | ... | - | | - =========== - | | - | ... | - | | - ----------- - TR --> | | <-- stack_terms_limit - ----------- - | | - | ... | - | | - ----------| - | TERM_N | <-- stack_terms - ----------| * - | ... | /|\ - ----------| | - | TERM_1 | | - ----------| | - | NULL | \|/ - =========== * - Yap_TrailTop --> | | - ----------- -************************************************************************/ -#ifdef GLOBAL_TRIE - gt_node_ptr current_node = GLOBAL_root_gt; -#endif /* GLOBAL_TRIE */ - int subs_arity = *subs_arity_ptr; - CELL *stack_vars = *stack_vars_ptr; -#ifndef GLOBAL_TRIE_FOR_SUBTERMS - CELL *stack_terms = (CELL *) Yap_TrailTop; -#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ - CELL *stack_terms_limit = (CELL *) TR; - AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); /* + 1 because initially we stiil haven't done any STACK_POP_DOWN */ - STACK_PUSH_UP(NULL, stack_terms); - - do { - if (IsVarTerm(t)) { - if (IsTableVarTerm(t)) { - t = MakeTableVarTerm(VarIndexOfTerm(t)); - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, t); - } else { - if (subs_arity == MAX_TABLE_VARS) - Yap_Error(INTERNAL_ERROR, TermNil, "MAX_TABLE_VARS exceeded (subgoal_search_loop)"); - STACK_PUSH_UP(t, stack_vars); - *((CELL *)t) = GLOBAL_table_var_enumerator(subs_arity); - t = MakeTableVarTerm(subs_arity); - subs_arity = subs_arity + 1; - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, t); - } - } else if (IsAtomOrIntTerm(t)) { - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, t); -#ifdef TRIE_COMPACT_PAIRS - } else if (IsPairTerm(t)) { - CELL *aux_pair = RepPair(t); - if (aux_pair == PairTermMark) { - t = STACK_POP_DOWN(stack_terms); - if (IsPairTerm(t)) { - aux_pair = RepPair(t); - t = Deref(aux_pair[1]); - if (t == TermNil) { - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, CompactPairEndList); - } else { - /* AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 2); */ - /* AUX_STACK_CHECK_EXPAND is not necessary here because the situation of pushing ** - ** up 3 terms has already initially checked for the CompactPairInit term */ - STACK_PUSH_UP(t, stack_terms); - STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms); - } - STACK_PUSH_UP(Deref(aux_pair[0]), stack_terms); - } else { - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, CompactPairEndTerm); - STACK_PUSH_UP(t, stack_terms); - } -#ifdef GLOBAL_TRIE_FOR_SUBTERMS - } else if (current_node != GLOBAL_root_gt) { - gt_node_ptr subterm_node = subgoal_search_loop_for_subterms(t, &subs_arity, &stack_vars, stack_terms); - current_node = global_trie_check_insert_gt_token(current_node, (Term) subterm_node); -#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ - } else { - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, CompactPairInit); - t = Deref(aux_pair[1]); - if (t == TermNil) { - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, CompactPairEndList); - } else { - AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 2); - STACK_PUSH_UP(t, stack_terms); - STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms); - } - STACK_PUSH_UP(Deref(aux_pair[0]), stack_terms); - } -#ifdef GLOBAL_TRIE_FOR_SUBTERMS - } else if (current_node != GLOBAL_root_gt) { - gt_node_ptr subterm_node = subgoal_search_loop_for_subterms(t, &subs_arity, &stack_vars, stack_terms); - current_node = global_trie_check_insert_gt_token(current_node, (Term) subterm_node); -#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ -#else -#ifdef GLOBAL_TRIE_FOR_SUBTERMS - } else if (current_node != GLOBAL_root_gt) { - gt_node_ptr subterm_node = subgoal_search_loop_for_subterms(t, &subs_arity, &stack_vars, stack_terms); - current_node = global_trie_check_insert_gt_token(current_node, (Term) subterm_node); -#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ - } else if (IsPairTerm(t)) { - CELL *aux_pair = RepPair(t); - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, AbsPair(NULL)); - AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); - STACK_PUSH_UP(Deref(aux_pair[1]), stack_terms); - STACK_PUSH_UP(Deref(aux_pair[0]), stack_terms); -#endif /* TRIE_COMPACT_PAIRS */ - } else if (IsApplTerm(t)) { - Functor f = FunctorOfTerm(t); - if (f == FunctorDouble) { - volatile Float dbl = FloatOfTerm(t); - volatile Term *t_dbl = (Term *)((void *) &dbl); - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, AbsAppl((Term *)f)); -#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, t_dbl[1]); -#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, t_dbl[0]); -#ifdef GLOBAL_TRIE - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, AbsAppl((Term *)f)); -#endif /* GLOBAL_TRIE */ - } else if (f == FunctorLongInt) { - Int li = LongIntOfTerm(t); - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, AbsAppl((Term *)f)); - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, li); -#ifdef GLOBAL_TRIE - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, AbsAppl((Term *)f)); -#endif /* GLOBAL_TRIE */ - } else if (f == FunctorDBRef) { - Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorDBRef in subgoal_search_loop)"); - } else if (f == FunctorBigInt) { - Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorBigInt in subgoal_search_loop)"); - } else { - int i; - CELL *aux_appl = RepAppl(t); - SUBGOAL_CHECK_INSERT_TOKEN(tab_ent, current_node, AbsAppl((Term *)f)); - AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + ArityOfFunctor(f) - 1); - for (i = ArityOfFunctor(f); i >= 1; i--) - STACK_PUSH_UP(Deref(aux_appl[i]), stack_terms); - } - } else { - Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (subgoal_search_loop)"); - } - t = STACK_POP_DOWN(stack_terms); - } while (t); - - *subs_arity_ptr = subs_arity; - *stack_vars_ptr = stack_vars; - return current_node; -} - - -#ifndef GLOBAL_TRIE -static inline ans_node_ptr answer_search_loop(sg_fr_ptr sg_fr, ans_node_ptr current_node, Term t, int *vars_arity_ptr) { -#elif GLOBAL_TRIE_FOR_TERMS -static inline gt_node_ptr answer_search_loop_for_terms(Term t, int *vars_arity_ptr) { -#elif GLOBAL_TRIE_FOR_SUBTERMS -static inline gt_node_ptr answer_search_loop_for_subterms(Term t, int *vars_arity_ptr, CELL *stack_terms) { -#endif -/************************************************************************ - =========== - | | - | ... | - | | - ----------- - TR --> | VAR_0 | <-- stack_vars_base - ----------- * - | ... | /|\ - ----------- | vars_arity (N+1) - | VAR_N | \|/ - ----------- * - | | <-- stack_terms_limit - ----------- - | | - | ... | - | | - ----------| - | TERM_N | <-- stack_terms - ----------| * - | ... | /|\ - ----------| | - | TERM_1 | | - ----------| | - | NULL | \|/ - =========== * - Yap_TrailTop --> | | - ----------- -************************************************************************/ -#ifdef GLOBAL_TRIE - gt_node_ptr current_node = GLOBAL_root_gt; -#endif /* GLOBAL_TRIE */ - int vars_arity = *vars_arity_ptr; -#ifndef GLOBAL_TRIE_FOR_SUBTERMS - CELL *stack_terms = (CELL *) Yap_TrailTop; -#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ - CELL *stack_vars_base = (CELL *) TR; -#define stack_terms_limit (stack_vars_base + vars_arity) -#ifdef TRIE_COMPACT_PAIRS - int in_new_pair = 0; -#else -#define in_new_pair 0 -#endif /* TRIE_COMPACT_PAIRS */ - AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); /* + 1 because initially we stiil haven't done any STACK_POP_DOWN */ - STACK_PUSH_UP(NULL, stack_terms); - - do { - if (IsVarTerm(t)) { - t = Deref(t); - if (IsTableVarTerm(t)) { - t = MakeTableVarTerm(VarIndexOfTerm(t)); - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, t, _trie_retry_val + in_new_pair); - } else { - if (vars_arity == MAX_TABLE_VARS) - Yap_Error(INTERNAL_ERROR, TermNil, "MAX_TABLE_VARS exceeded (answer_search_loop)"); - stack_vars_base[vars_arity] = t; - *((CELL *)t) = GLOBAL_table_var_enumerator(vars_arity); - t = MakeTableVarTerm(vars_arity); - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, t, _trie_retry_var + in_new_pair); - vars_arity = vars_arity + 1; - } -#ifdef TRIE_COMPACT_PAIRS - in_new_pair = 0; -#endif /* TRIE_COMPACT_PAIRS */ - } else if (IsAtomOrIntTerm(t)) { - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, t, _trie_retry_atom + in_new_pair); -#ifdef TRIE_COMPACT_PAIRS - in_new_pair = 0; - } else if (IsPairTerm(t)) { - CELL *aux_pair = RepPair(t); - if (aux_pair == PairTermMark) { - t = STACK_POP_DOWN(stack_terms); - if (IsPairTerm(t)) { - aux_pair = RepPair(t); - t = Deref(aux_pair[1]); - if (t == TermNil) { - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, CompactPairEndList, _trie_retry_pair); - } else { - /* AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 2); */ - /* AUX_STACK_CHECK_EXPAND is not necessary here because the situation of pushing ** - ** up 3 terms has already initially checked for the CompactPairInit term */ - STACK_PUSH_UP(t, stack_terms); - STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms); - in_new_pair = 4; - } - STACK_PUSH_UP(Deref(aux_pair[0]), stack_terms); - } else { - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, CompactPairEndTerm, _trie_retry_null); - STACK_PUSH_UP(t, stack_terms); - } -#ifdef GLOBAL_TRIE_FOR_SUBTERMS - } else if (current_node != GLOBAL_root_gt) { - gt_node_ptr subterm_node = answer_search_loop_for_subterms(t, &vars_arity, stack_terms); - current_node = global_trie_check_insert_gt_token(current_node, (Term) subterm_node); -#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ - } else { - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, CompactPairInit, _trie_retry_null + in_new_pair); - t = Deref(aux_pair[1]); - if (t == TermNil) { - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, CompactPairEndList, _trie_retry_pair); - in_new_pair = 0; - } else { - AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 2); - STACK_PUSH_UP(t, stack_terms); - STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms); - in_new_pair = 4; - } - STACK_PUSH_UP(Deref(aux_pair[0]), stack_terms); - } -#ifdef GLOBAL_TRIE_FOR_SUBTERMS - } else if (current_node != GLOBAL_root_gt) { - gt_node_ptr subterm_node = answer_search_loop_for_subterms(t, &vars_arity, stack_terms); - current_node = global_trie_check_insert_gt_token(current_node, (Term) subterm_node); -#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ -#else -#ifdef GLOBAL_TRIE_FOR_SUBTERMS - } else if (current_node != GLOBAL_root_gt) { - gt_node_ptr subterm_node = answer_search_loop_for_subterms(t, &vars_arity, stack_terms); - current_node = global_trie_check_insert_gt_token(current_node, (Term) subterm_node); -#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ - } else if (IsPairTerm(t)) { - CELL *aux_pair = RepPair(t); - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, AbsPair(NULL), _trie_retry_pair); - AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); - STACK_PUSH_UP(Deref(aux_pair[1]), stack_terms); - STACK_PUSH_UP(Deref(aux_pair[0]), stack_terms); -#endif /* TRIE_COMPACT_PAIRS */ - } else if (IsApplTerm(t)) { - Functor f = FunctorOfTerm(t); - if (f == FunctorDouble) { - volatile Float dbl = FloatOfTerm(t); - volatile Term *t_dbl = (Term *)((void *) &dbl); - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_null + in_new_pair); -#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, t_dbl[1], _trie_retry_extension); -#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, t_dbl[0], _trie_retry_extension); - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_float); - } else if (f == FunctorLongInt) { - Int li = LongIntOfTerm (t); - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_null + in_new_pair); - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, li, _trie_retry_extension); - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_long); - } else if (f == FunctorDBRef) { - Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorDBRef in answer_search_loop)"); - } else if (f == FunctorBigInt) { - Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorBigInt in answer_search_loop)"); - } else { - int i; - CELL *aux_appl = RepAppl(t); - ANSWER_CHECK_INSERT_TOKEN(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_struct + in_new_pair); - AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + ArityOfFunctor(f) - 1); - for (i = ArityOfFunctor(f); i >= 1; i--) - STACK_PUSH_UP(Deref(aux_appl[i]), stack_terms); - } -#ifdef TRIE_COMPACT_PAIRS - in_new_pair = 0; -#endif /* TRIE_COMPACT_PAIRS */ - } else { - Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (answer_search_loop)"); - } - t = STACK_POP_DOWN(stack_terms); - } while (t); - - *vars_arity_ptr = vars_arity; - return current_node; - -#undef stack_terms_limit -#ifndef TRIE_COMPACT_PAIRS -#undef in_new_pair -#endif /* TRIE_COMPACT_PAIRS */ -} - - -#ifndef GLOBAL_TRIE -static inline CELL *load_answer_loop(ans_node_ptr current_node) { -#else /* GLOBAL_TRIE */ -static inline CELL *load_answer_loop(gt_node_ptr current_node, int *vars_arity_ptr, CELL *stack_terms) { -#endif /* GLOBAL_TRIE */ -/************************************************************************ - =========== - | | - | ... | - | | - ----------- - TR --> | VAR_0 | <-- stack_vars_base - ----------- * - | ... | /|\ - ----------- | vars_arity (N+1) - | VAR_N | \|/ - ----------- * - | | <-- stack_terms_limit - ----------- - | | - | ... | - | | - ----------| - | TERM_N | <-- stack_terms - ----------| * - | ... | /|\ - ----------| | stack_terms_pair_offset (TRIE_COMPACT_PAIRS) - | TERM_1 | \|/ - =========== * - Yap_TrailTop --> | | <-- stack_terms_base (TRIE_COMPACT_PAIRS) - ----------- -************************************************************************/ -#ifndef GLOBAL_TRIE - int vars_arity = 0; - CELL *stack_terms = (CELL *) Yap_TrailTop; -#else /* GLOBAL_TRIE */ - int vars_arity = *vars_arity_ptr; -#endif - CELL *stack_vars_base = (CELL *) TR; -#define stack_terms_limit (stack_vars_base + vars_arity) -#ifdef TRIE_COMPACT_PAIRS -#define stack_terms_base ((CELL *) Yap_TrailTop) - int stack_terms_pair_offset = 0; -#endif /* TRIE_COMPACT_PAIRS */ - Term t = TrNode_entry(current_node); -#ifdef GLOBAL_TRIE - current_node = TrNode_parent(current_node); -#else - current_node = UNTAG_ANSWER_LEAF_NODE(TrNode_parent(current_node)); -#endif /* GLOBAL_TRIE */ - - do { - if (IsVarTerm(t)) { -#ifdef GLOBAL_TRIE_FOR_SUBTERMS - if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) { - stack_terms = load_answer_loop((gt_node_ptr) t, &vars_arity, stack_terms); - } else -#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ - { int var_index = VarIndexOfTableTerm(t); - AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit - vars_arity + var_index + 1); - if (var_index >= vars_arity) { - while (vars_arity < var_index) - stack_vars_base[vars_arity++] = 0; - stack_vars_base[vars_arity++] = MkVarTerm(); - } else if (stack_vars_base[var_index] == 0) - stack_vars_base[var_index] = MkVarTerm(); - STACK_PUSH_UP(stack_vars_base[var_index], stack_terms); - } - } else if (IsAtomOrIntTerm(t)) { - AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit); - STACK_PUSH_UP(t, stack_terms); - } else if (IsPairTerm(t)) { -#ifdef TRIE_COMPACT_PAIRS - if (t == CompactPairInit) { - Term *stack_aux = stack_terms_base - stack_terms_pair_offset; - Term head, tail = STACK_POP_UP(stack_aux); - while (STACK_NOT_EMPTY(stack_aux, stack_terms)) { - head = STACK_POP_UP(stack_aux); - tail = MkPairTerm(head, tail); - } - stack_terms = stack_terms_base - stack_terms_pair_offset; - stack_terms_pair_offset = (int) STACK_POP_DOWN(stack_terms); - STACK_PUSH_UP(tail, stack_terms); - } else { /* CompactPairEndList / CompactPairEndTerm */ - Term last; - AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); - last = STACK_POP_DOWN(stack_terms); - STACK_PUSH_UP(stack_terms_pair_offset, stack_terms); - stack_terms_pair_offset = (int) (stack_terms_base - stack_terms); - if (t == CompactPairEndList) - STACK_PUSH_UP(TermNil, stack_terms); - STACK_PUSH_UP(last, stack_terms); - } -#else - Term head = STACK_POP_DOWN(stack_terms); - Term tail = STACK_POP_DOWN(stack_terms); - t = MkPairTerm(head, tail); - STACK_PUSH_UP(t, stack_terms); -#endif /* TRIE_COMPACT_PAIRS */ - } else if (IsApplTerm(t)) { - Functor f = (Functor) RepAppl(t); - if (f == FunctorDouble) { - volatile Float dbl; - volatile Term *t_dbl = (Term *)((void *) &dbl); - t = TrNode_entry(current_node); - current_node = TrNode_parent(current_node); - t_dbl[0] = t; -#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - t = TrNode_entry(current_node); - current_node = TrNode_parent(current_node); - t_dbl[1] = t; -#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ - current_node = TrNode_parent(current_node); - t = MkFloatTerm(dbl); - } else if (f == FunctorLongInt) { - Int li = TrNode_entry(current_node); - current_node = TrNode_parent(current_node); - current_node = TrNode_parent(current_node); - t = MkLongIntTerm(li); - } else { - int f_arity = ArityOfFunctor(f); - t = Yap_MkApplTerm(f, f_arity, stack_terms); - stack_terms += f_arity; - } - AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit); - STACK_PUSH_UP(t, stack_terms); - } - t = TrNode_entry(current_node); - current_node = TrNode_parent(current_node); - } while (current_node); +#undef INCLUDE_SUBGOAL_SEARCH_LOOP +#undef INCLUDE_ANSWER_SEARCH_LOOP +#undef INCLUDE_LOAD_ANSWER_LOOP #ifdef GLOBAL_TRIE - *vars_arity_ptr = vars_arity; -#endif /* GLOBAL_TRIE */ - return stack_terms; - -#undef stack_terms_limit -#ifdef TRIE_COMPACT_PAIRS -#undef stack_terms_base -#endif /* TRIE_COMPACT_PAIRS */ -} +#define MODE_GLOBAL_TRIE_ENTRY +#define MODE_GLOBAL_TRIE_LOOP +#define INCLUDE_SUBGOAL_TRIE_CHECK_INSERT /* subgoal_trie_check_insert_gt_entry */ +#define INCLUDE_ANSWER_TRIE_CHECK_INSERT /* answer_trie_check_insert_gt_entry */ +#ifdef GLOBAL_TRIE_FOR_SUBTERMS +#define INCLUDE_GLOBAL_TRIE_CHECK_INSERT /* global_trie_check_insert_gt_entry */ +#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ +#define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_loop_gt_(sub)terms */ +#define INCLUDE_ANSWER_SEARCH_LOOP /* answer_search_loop_gt_(sub)terms */ +#define INCLUDE_LOAD_ANSWER_LOOP /* load_substitution_loop */ +#include "tab.tries.i" +#undef MODE_GLOBAL_TRIE_ENTRY +#undef MODE_GLOBAL_TRIE_LOOP +#undef INCLUDE_SUBGOAL_TRIE_CHECK_INSERT +#undef INCLUDE_ANSWER_TRIE_CHECK_INSERT +#undef INCLUDE_GLOBAL_TRIE_CHECK_INSERT +#undef INCLUDE_SUBGOAL_SEARCH_LOOP +#undef INCLUDE_ANSWER_SEARCH_LOOP +#undef INCLUDE_LOAD_ANSWER_LOOP -#ifdef GLOBAL_TRIE -static inline CELL *load_substitution_variable_loop(gt_node_ptr current_node, CELL **stack_vars_ptr, CELL *stack_terms) { +static inline CELL *exec_substitution_loop(gt_node_ptr current_node, CELL **stack_vars_ptr, CELL *stack_terms) { /************************************************************************ =========== | | @@ -730,7 +227,7 @@ static inline CELL *load_substitution_variable_loop(gt_node_ptr current_node, CE if (IsVarTerm(t)) { #ifdef GLOBAL_TRIE_FOR_SUBTERMS if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) { - stack_terms = load_substitution_variable_loop((gt_node_ptr) t, &stack_vars, stack_terms); + stack_terms = exec_substitution_loop((gt_node_ptr) t, &stack_vars, stack_terms); } else #endif /* GLOBAL_TRIE_FOR_SUBTERMS */ { @@ -885,21 +382,21 @@ static void free_global_trie_branch(gt_node_ptr current_node, int mode) { if (IsApplTerm(t)) { Functor f = (Functor) RepAppl(t); if (f == FunctorDouble) - FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_FLOAT); + FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_DOUBLE); else if (f == FunctorLongInt) - FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_LONG); + FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_LONGINT); else FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_NORMAL); } else FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_NORMAL); - } else if (mode == TRAVERSE_MODE_LONG) - FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_LONG_END); - else if (mode == TRAVERSE_MODE_FLOAT) + } else if (mode == TRAVERSE_MODE_LONGINT) + FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_LONGINT_END); + else if (mode == TRAVERSE_MODE_DOUBLE) #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_FLOAT2); - else if (mode == TRAVERSE_MODE_FLOAT2) + FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_DOUBLE2); + else if (mode == TRAVERSE_MODE_DOUBLE2) #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ - FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_FLOAT_END); + FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_DOUBLE_END); else #endif /* GLOBAL_TRIE_FOR_SUBTERMS */ FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_NORMAL); @@ -922,21 +419,21 @@ static void free_global_trie_branch(gt_node_ptr current_node, int mode) { if (IsApplTerm(t)) { Functor f = (Functor) RepAppl(t); if (f == FunctorDouble) - FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_FLOAT); + FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_DOUBLE); else if (f == FunctorLongInt) - FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_LONG); + FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_LONGINT); else FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_NORMAL); } else FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_NORMAL); - } else if (mode == TRAVERSE_MODE_LONG) - FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_LONG_END); - else if (mode == TRAVERSE_MODE_FLOAT) + } else if (mode == TRAVERSE_MODE_LONGINT) + FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_LONGINT_END); + else if (mode == TRAVERSE_MODE_DOUBLE) #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_FLOAT2); - else if (mode == TRAVERSE_MODE_FLOAT2) + FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_DOUBLE2); + else if (mode == TRAVERSE_MODE_DOUBLE2) #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ - FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_FLOAT_END); + FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_DOUBLE_END); else #endif /* GLOBAL_TRIE_FOR_SUBTERMS */ FREE_GLOBAL_TRIE_BRANCH(parent_node,TRAVERSE_MODE_NORMAL); @@ -1026,18 +523,10 @@ static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_in } -static void traverse_global_trie_for_subgoal(gt_node_ptr current_node, char *str, int *str_index, int *arity, int *mode) { +static void traverse_global_trie_for_term(gt_node_ptr current_node, char *str, int *str_index, int *arity, int *mode, int type) { if (TrNode_parent(current_node) != GLOBAL_root_gt) - traverse_global_trie_for_subgoal(TrNode_parent(current_node), str, str_index, arity, mode); - traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode, TRAVERSE_TYPE_SUBGOAL); - return; -} - - -static void traverse_global_trie_for_answer(gt_node_ptr current_node, char *str, int *str_index, int *arity, int *mode) { - if (TrNode_parent(current_node) != GLOBAL_root_gt) - traverse_global_trie_for_answer(TrNode_parent(current_node), str, str_index, arity, mode); - traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode, TRAVERSE_TYPE_ANSWER); + traverse_global_trie_for_term(TrNode_parent(current_node), str, str_index, arity, mode, type); + traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode, type); return; } #endif /* GLOBAL_TRIE */ @@ -1082,11 +571,7 @@ static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_i /* process current trie node */ TrStat_sg_nodes++; -#ifdef GLOBAL_TRIE - traverse_global_trie_for_subgoal((gt_node_ptr)TrNode_entry(current_node), str, &str_index, arity, &mode); -#else traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_SUBGOAL); -#endif /* GLOBAL_TRIE */ /* continue with child node ... */ if (arity[0] != 0 || mode != TRAVERSE_MODE_NORMAL) @@ -1189,11 +674,7 @@ static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_i /* process current trie node */ TrStat_ans_nodes++; -#ifdef GLOBAL_TRIE - traverse_global_trie_for_answer((gt_node_ptr)TrNode_entry(current_node), str, &str_index, arity, &mode); -#else traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_ANSWER); -#endif /* GLOBAL_TRIE */ /* show answer .... */ if (IS_ANSWER_LEAF_NODE(current_node)) { @@ -1242,12 +723,12 @@ static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int int str_index = *str_index_ptr; /* test the node type */ - if (mode == TRAVERSE_MODE_FLOAT) { + if (mode == TRAVERSE_MODE_DOUBLE) { #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P arity[0]++; arity[arity[0]] = (int) t; - mode = TRAVERSE_MODE_FLOAT2; - } else if (mode == TRAVERSE_MODE_FLOAT2) { + mode = TRAVERSE_MODE_DOUBLE2; + } else if (mode == TRAVERSE_MODE_DOUBLE2) { volatile Float dbl; volatile Term *t_dbl = (Term *)((void *) &dbl); t_dbl[0] = t; @@ -1289,10 +770,10 @@ static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int mode = TRAVERSE_MODE_NORMAL; else /* type == TRAVERSE_TYPE_ANSWER */ #endif /* GLOBAL_TRIE */ - mode = TRAVERSE_MODE_FLOAT_END; - } else if (mode == TRAVERSE_MODE_FLOAT_END) { + mode = TRAVERSE_MODE_DOUBLE_END; + } else if (mode == TRAVERSE_MODE_DOUBLE_END) { mode = TRAVERSE_MODE_NORMAL; - } else if (mode == TRAVERSE_MODE_LONG) { + } else if (mode == TRAVERSE_MODE_LONGINT) { Int li = (Int) t; #if SHORT_INTS str_index += sprintf(& str[str_index], "%ld", li); @@ -1329,18 +810,15 @@ static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int mode = TRAVERSE_MODE_NORMAL; else /* type == TRAVERSE_TYPE_ANSWER */ #endif /* GLOBAL_TRIE */ - mode = TRAVERSE_MODE_LONG_END; - } else if (mode == TRAVERSE_MODE_LONG_END) { + mode = TRAVERSE_MODE_LONGINT_END; + } else if (mode == TRAVERSE_MODE_LONGINT_END) { mode = TRAVERSE_MODE_NORMAL; } else if (IsVarTerm(t)) { -#ifdef GLOBAL_TRIE_FOR_SUBTERMS +#ifdef GLOBAL_TRIE if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) { - if(type == TRAVERSE_TYPE_SUBGOAL) - traverse_global_trie_for_subgoal((gt_node_ptr) t, str, &str_index, arity, &mode); - else - traverse_global_trie_for_answer((gt_node_ptr) t, str, &str_index, arity, &mode); - } else -#endif /* GLOBAL_TRIE_FOR_SUBTERMS */ + traverse_global_trie_for_term((gt_node_ptr) t, str, &str_index, arity, &mode, type); + } else +#endif /* GLOBAL_TRIE */ { if (type == TRAVERSE_TYPE_SUBGOAL) str_index += sprintf(& str[str_index], "VAR%d", VarIndexOfTableTerm(t)); @@ -1456,9 +934,9 @@ static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int } else if (IsApplTerm(t)) { Functor f = (Functor) RepAppl(t); if (f == FunctorDouble) { - mode = TRAVERSE_MODE_FLOAT; + mode = TRAVERSE_MODE_DOUBLE; } else if (f == FunctorLongInt) { - mode = TRAVERSE_MODE_LONG; + mode = TRAVERSE_MODE_LONGINT; } else { str_index += sprintf(& str[str_index], "%s(", AtomName(NameOfFunctor(f))); arity[0]++; @@ -1576,17 +1054,7 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) { #endif /* TABLE_LOCK_LEVEL */ for (i = 1; i <= pred_arity; i++) { -#ifndef GLOBAL_TRIE current_sg_node = subgoal_search_loop(tab_ent, current_sg_node, Deref(XREGS[i]), &subs_arity, &stack_vars); -#else /* GLOBAL_TRIE */ - gt_node_ptr current_node; -#ifdef GLOBAL_TRIE_FOR_TERMS - current_node = subgoal_search_loop_for_terms(Deref(XREGS[i]), &subs_arity, &stack_vars); -#elif GLOBAL_TRIE_FOR_SUBTERMS - current_node = subgoal_search_loop_for_subterms(Deref(XREGS[i]), &subs_arity, &stack_vars, (CELL *) Yap_TrailTop); -#endif - current_sg_node = subgoal_trie_check_insert_gt_token(tab_ent, current_sg_node, (Term) current_node); -#endif } STACK_PUSH_UP(subs_arity, stack_vars); @@ -1639,17 +1107,7 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) { if (IsNonVarTerm(subs_ptr[i])) TABLING_ERROR_MESSAGE("IsNonVarTem(subs_ptr[i]) (answer_search)"); #endif /* TABLING_ERRORS */ -#ifndef GLOBAL_TRIE current_ans_node = answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity); -#else /* GLOBAL_TRIE */ - gt_node_ptr current_node; -#ifdef GLOBAL_TRIE_FOR_TERMS - current_node = answer_search_loop_for_terms(Deref(subs_ptr[i]), &vars_arity); -#elif GLOBAL_TRIE_FOR_SUBTERMS - current_node = answer_search_loop_for_subterms(Deref(subs_ptr[i]), &vars_arity, (CELL *) Yap_TrailTop); -#endif - current_ans_node = answer_trie_check_insert_gt_token(sg_fr, current_ans_node, (Term) current_node, _trie_retry_atom); -#endif } /* reset variables */ @@ -1668,9 +1126,6 @@ void load_answer(ans_node_ptr current_ans_node, CELL *subs_ptr) { #define subs_arity *subs_ptr CELL *stack_terms; int i; -#ifdef GLOBAL_TRIE - int vars_arity; -#endif /* GLOBAL_TRIE */ #ifdef TABLING_ERRORS if (H < H_FZ) @@ -1679,22 +1134,11 @@ void load_answer(ans_node_ptr current_ans_node, CELL *subs_ptr) { if (subs_arity == 0) return; -#ifndef GLOBAL_TRIE stack_terms = load_answer_loop(current_ans_node); -#else /* GLOBAL_TRIE */ - vars_arity = 0; - stack_terms = (CELL *) Yap_TrailTop; - for (i = subs_arity; i >= 1; i--) { - gt_node_ptr current_node = (gt_node_ptr) TrNode_entry(current_ans_node); - current_ans_node = UNTAG_ANSWER_LEAF_NODE(TrNode_parent(current_ans_node)); - stack_terms = load_answer_loop(current_node, &vars_arity, stack_terms); - } -#endif for (i = subs_arity; i >= 1; i--) { - CELL *subs_var = (CELL *) subs_ptr[i]; Term t = STACK_POP_DOWN(stack_terms); - Bind(subs_var, t); + Bind((CELL *) subs_ptr[i], t); } #ifdef TABLING_ERRORS if (stack_terms != (CELL *)Yap_TrailTop) @@ -1707,24 +1151,25 @@ void load_answer(ans_node_ptr current_ans_node, CELL *subs_ptr) { #ifdef GLOBAL_TRIE -CELL *load_substitution_variable(gt_node_ptr current_node, CELL *stack_vars_subs) { +CELL *exec_substitution(gt_node_ptr current_node, CELL *aux_stack) { #define subs_arity *subs_ptr - CELL *stack_terms, *subs_ptr, *subs_var; + CELL *stack_terms, *subs_ptr; Term t; - stack_terms = load_substitution_variable_loop(current_node, &stack_vars_subs, (CELL *) Yap_TrailTop); + ++aux_stack; /* skip the heap_arity entry */ + stack_terms = exec_substitution_loop(current_node, &aux_stack, (CELL *) Yap_TrailTop); + *--aux_stack = 0; /* restore the heap_arity entry */ - subs_ptr = stack_vars_subs + *stack_vars_subs + 1; - subs_var = (CELL *) subs_ptr[subs_arity]; + subs_ptr = aux_stack + aux_stack[1] + 2; t = STACK_POP_DOWN(stack_terms); - Bind(subs_var, t); + Bind((CELL *) subs_ptr[subs_arity], t); #ifdef TABLING_ERRORS if (stack_terms != (CELL *)Yap_TrailTop) - TABLING_ERROR_MESSAGE("stack_terms != Yap_TrailTop (load_substitution_variable)"); + TABLING_ERROR_MESSAGE("stack_terms != Yap_TrailTop (exec_substitution)"); #endif /* TABLING_ERRORS */ *subs_ptr = subs_arity - 1; - return stack_vars_subs; + return aux_stack; #undef subs_arity } #endif /* GLOBAL_TRIE */ diff --git a/OPTYap/tab.tries.i b/OPTYap/tab.tries.i index 4e21b7455..8bf2a2104 100644 --- a/OPTYap/tab.tries.i +++ b/OPTYap/tab.tries.i @@ -15,13 +15,20 @@ ** Macros ** *********************/ +#undef INCREMENT_GLOBAL_TRIE_REFERENCE #undef NEW_SUBGOAL_TRIE_NODE #undef NEW_ANSWER_TRIE_NODE #undef NEW_GLOBAL_TRIE_NODE +#undef SUBGOAL_CHECK_INSERT_ENTRY +#undef ANSWER_CHECK_INSERT_ENTRY #undef LOCK_NODE #undef UNLOCK_NODE -#ifdef IS_GLOBAL_TRIE_REFERENCE +#ifdef MODE_GLOBAL_TRIE_ENTRY +#define INCREMENT_GLOBAL_TRIE_REFERENCE(ENTRY) \ + { register gt_node_ptr entry_node = (gt_node_ptr) (ENTRY); \ + TrNode_child(entry_node) = (gt_node_ptr) ((unsigned long int) TrNode_child(entry_node) + 1); \ + } #define NEW_SUBGOAL_TRIE_NODE(NODE, ENTRY, CHILD, PARENT, NEXT) \ INCREMENT_GLOBAL_TRIE_REFERENCE(ENTRY); \ new_subgoal_trie_node(NODE, ENTRY, CHILD, PARENT, NEXT) @@ -38,7 +45,21 @@ new_answer_trie_node(NODE, INSTR, ENTRY, CHILD, PARENT, NEXT) #define NEW_GLOBAL_TRIE_NODE(NODE, ENTRY, CHILD, PARENT, NEXT) \ new_global_trie_node(NODE, ENTRY, CHILD, PARENT, NEXT) -#endif /* IS_GLOBAL_TRIE_REFERENCE */ +#endif /* MODE_GLOBAL_TRIE_ENTRY */ + + +#ifdef MODE_GLOBAL_TRIE_LOOP +#define SUBGOAL_CHECK_INSERT_ENTRY(TAB_ENT, NODE, ENTRY) \ + NODE = global_trie_check_insert_entry(NODE, ENTRY) +#define ANSWER_CHECK_INSERT_ENTRY(SG_FR, NODE, ENTRY, INSTR) \ + NODE = global_trie_check_insert_entry(NODE, ENTRY) +#else +#define SUBGOAL_CHECK_INSERT_ENTRY(TAB_ENT, NODE, ENTRY) \ + NODE = subgoal_trie_check_insert_entry(TAB_ENT, NODE, ENTRY) +#define ANSWER_CHECK_INSERT_ENTRY(SG_FR, NODE, ENTRY, INSTR) \ + NODE = answer_trie_check_insert_entry(SG_FR, NODE, ENTRY, INSTR) +#endif /* MODE_GLOBAL_TRIE_LOOP */ + #if defined(TABLE_LOCK_AT_WRITE_LEVEL) #define LOCK_NODE(NODE) LOCK_TABLE(NODE) @@ -46,7 +67,7 @@ #elif defined(TABLE_LOCK_AT_NODE_LEVEL) #define LOCK_NODE(NODE) TRIE_LOCK(TrNode_lock(NODE)) #define UNLOCK_NODE(NODE) UNLOCK(TrNode_lock(NODE)) -#else +#else /* TABLE_LOCK_AT_ENTRY_LEVEL || ! YAPOR */ #define LOCK_NODE(NODE) #define UNLOCK_NODE(NODE) #endif /* TABLE_LOCK_LEVEL */ @@ -54,16 +75,112 @@ /************************************************************************ -** subgoal_trie_check_insert_(gt)_token ** +** subgoal_trie_check_insert_(gt)_entry ** ************************************************************************/ #ifdef INCLUDE_SUBGOAL_TRIE_CHECK_INSERT -#ifdef TABLE_LOCK_AT_WRITE_LEVEL -#ifdef IS_GLOBAL_TRIE_REFERENCE -static inline sg_node_ptr subgoal_trie_check_insert_gt_token(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) { +#ifndef TABLE_LOCK_AT_WRITE_LEVEL /* TABLE_LOCK_AT_ENTRY_LEVEL || TABLE_LOCK_AT_NODE_LEVEL || ! YAPOR */ +#ifdef MODE_GLOBAL_TRIE_ENTRY +static inline sg_node_ptr subgoal_trie_check_insert_gt_entry(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) { #else -static inline sg_node_ptr subgoal_trie_check_insert_token(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) { -#endif /* IS_GLOBAL_TRIE_REFERENCE */ +static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) { +#endif /* MODE_GLOBAL_TRIE_ENTRY */ + sg_node_ptr child_node; + + LOCK_NODE(parent_node); + child_node = TrNode_child(parent_node); + if (child_node == NULL) { + NEW_SUBGOAL_TRIE_NODE(child_node, t, NULL, parent_node, NULL); + TrNode_child(parent_node) = child_node; + UNLOCK_NODE(parent_node); + return child_node; + } + + if (! IS_SUBGOAL_TRIE_HASH(child_node)) { + int count_nodes = 0; + do { + if (TrNode_entry(child_node) == t) { + UNLOCK_NODE(parent_node); + return child_node; + } + count_nodes++; + child_node = TrNode_next(child_node); + } while (child_node); + NEW_SUBGOAL_TRIE_NODE(child_node, t, NULL, parent_node, TrNode_child(parent_node)); + count_nodes++; + if (count_nodes >= MAX_NODES_PER_TRIE_LEVEL) { + /* alloc a new hash */ + sg_hash_ptr hash; + sg_node_ptr chain_node, next_node, *bucket; + new_subgoal_trie_hash(hash, count_nodes, tab_ent); + chain_node = child_node; + do { + bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS - 1)); + next_node = TrNode_next(chain_node); + TrNode_next(chain_node) = *bucket; + *bucket = chain_node; + chain_node = next_node; + } while (chain_node); + TrNode_child(parent_node) = (sg_node_ptr) hash; + } else { + TrNode_child(parent_node) = child_node; + } + UNLOCK_NODE(parent_node); + return child_node; + } + + { /* trie nodes with hashing */ + sg_hash_ptr hash; + sg_node_ptr *bucket; + int count_nodes = 0; + hash = (sg_hash_ptr) child_node; + bucket = Hash_bucket(hash, HASH_ENTRY(t, Hash_seed(hash))); + child_node = *bucket; + while (child_node) { + if (TrNode_entry(child_node) == t) { + UNLOCK_NODE(parent_node); + return child_node; + } + count_nodes++; + child_node = TrNode_next(child_node); + } + NEW_SUBGOAL_TRIE_NODE(child_node, t, NULL, parent_node, *bucket); + *bucket = child_node; + Hash_num_nodes(hash)++; + count_nodes++; + if (count_nodes >= MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) { + /* expand current hash */ + sg_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket; + int seed; + first_old_bucket = Hash_buckets(hash); + old_bucket = first_old_bucket + Hash_num_buckets(hash); + Hash_num_buckets(hash) *= 2; + ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash)); + seed = Hash_seed(hash); + do { + if (*--old_bucket) { + chain_node = *old_bucket; + do { + bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), seed)); + next_node = TrNode_next(chain_node); + TrNode_next(chain_node) = *bucket; + *bucket = chain_node; + chain_node = next_node; + } while (chain_node); + } + } while (old_bucket != first_old_bucket); + FREE_HASH_BUCKETS(first_old_bucket); + } + UNLOCK_NODE(parent_node); + return child_node; + } +} +#else /* TABLE_LOCK_AT_WRITE_LEVEL */ +#ifdef MODE_GLOBAL_TRIE_ENTRY +static inline sg_node_ptr subgoal_trie_check_insert_gt_entry(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) { +#else +static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) { +#endif /* MODE_GLOBAL_TRIE_ENTRY */ sg_node_ptr child_node; sg_hash_ptr hash; @@ -248,24 +365,39 @@ subgoal_trie_hash: return child_node; } } -#else /* TABLE_LOCK_AT_ENTRY_LEVEL || TABLE_LOCK_AT_NODE_LEVEL || ! YAPOR */ -#ifdef IS_GLOBAL_TRIE_REFERENCE -static inline sg_node_ptr subgoal_trie_check_insert_gt_token(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) { +#endif /* TABLE_LOCK_LEVEL */ +#endif /* INCLUDE_SUBGOAL_TRIE_CHECK_INSERT */ + + + +/************************************************************************ +** answer_trie_check_insert_(gt)_entry ** +************************************************************************/ + +#ifdef INCLUDE_ANSWER_TRIE_CHECK_INSERT +#ifndef TABLE_LOCK_AT_WRITE_LEVEL /* TABLE_LOCK_AT_ENTRY_LEVEL || TABLE_LOCK_AT_NODE_LEVEL || ! YAPOR */ +#ifdef MODE_GLOBAL_TRIE_ENTRY +static inline ans_node_ptr answer_trie_check_insert_gt_entry(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) { #else -static inline sg_node_ptr subgoal_trie_check_insert_token(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) { -#endif /* IS_GLOBAL_TRIE_REFERENCE */ - sg_node_ptr child_node; +static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) { +#endif /* MODE_GLOBAL_TRIE_ENTRY */ + ans_node_ptr child_node; + +#ifdef TABLING_ERRORS + if (IS_ANSWER_LEAF_NODE(parent_node)) + TABLING_ERROR_MESSAGE("IS_ANSWER_LEAF_NODE(parent_node) (answer_trie_check_insert_(gt)_entry)"); +#endif /* TABLING_ERRORS */ LOCK_NODE(parent_node); child_node = TrNode_child(parent_node); if (child_node == NULL) { - NEW_SUBGOAL_TRIE_NODE(child_node, t, NULL, parent_node, NULL); + NEW_ANSWER_TRIE_NODE(child_node, instr, t, NULL, parent_node, NULL); TrNode_child(parent_node) = child_node; UNLOCK_NODE(parent_node); return child_node; } - if (! IS_SUBGOAL_TRIE_HASH(child_node)) { + if (! IS_ANSWER_TRIE_HASH(child_node)) { int count_nodes = 0; do { if (TrNode_entry(child_node) == t) { @@ -275,13 +407,13 @@ static inline sg_node_ptr subgoal_trie_check_insert_token(tab_ent_ptr tab_ent, s count_nodes++; child_node = TrNode_next(child_node); } while (child_node); - NEW_SUBGOAL_TRIE_NODE(child_node, t, NULL, parent_node, TrNode_child(parent_node)); + NEW_ANSWER_TRIE_NODE(child_node, instr, t, NULL, parent_node, TrNode_child(parent_node)); count_nodes++; if (count_nodes >= MAX_NODES_PER_TRIE_LEVEL) { /* alloc a new hash */ - sg_hash_ptr hash; - sg_node_ptr chain_node, next_node, *bucket; - new_subgoal_trie_hash(hash, count_nodes, tab_ent); + ans_hash_ptr hash; + ans_node_ptr chain_node, next_node, *bucket; + new_answer_trie_hash(hash, count_nodes, sg_fr); chain_node = child_node; do { bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS - 1)); @@ -290,7 +422,7 @@ static inline sg_node_ptr subgoal_trie_check_insert_token(tab_ent_ptr tab_ent, s *bucket = chain_node; chain_node = next_node; } while (chain_node); - TrNode_child(parent_node) = (sg_node_ptr) hash; + TrNode_child(parent_node) = (ans_node_ptr) hash; } else { TrNode_child(parent_node) = child_node; } @@ -299,10 +431,10 @@ static inline sg_node_ptr subgoal_trie_check_insert_token(tab_ent_ptr tab_ent, s } { /* trie nodes with hashing */ - sg_hash_ptr hash; - sg_node_ptr *bucket; + ans_hash_ptr hash; + ans_node_ptr *bucket; int count_nodes = 0; - hash = (sg_hash_ptr) child_node; + hash = (ans_hash_ptr) child_node; bucket = Hash_bucket(hash, HASH_ENTRY(t, Hash_seed(hash))); child_node = *bucket; while (child_node) { @@ -313,13 +445,13 @@ static inline sg_node_ptr subgoal_trie_check_insert_token(tab_ent_ptr tab_ent, s count_nodes++; child_node = TrNode_next(child_node); } - NEW_SUBGOAL_TRIE_NODE(child_node, t, NULL, parent_node, *bucket); + NEW_ANSWER_TRIE_NODE(child_node, instr, t, NULL, parent_node, *bucket); *bucket = child_node; Hash_num_nodes(hash)++; count_nodes++; if (count_nodes >= MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) { - /* expand current hash */ - sg_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket; + /* expand current hash */ + ans_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket; int seed; first_old_bucket = Hash_buckets(hash); old_bucket = first_old_bucket + Hash_num_buckets(hash); @@ -344,28 +476,18 @@ static inline sg_node_ptr subgoal_trie_check_insert_token(tab_ent_ptr tab_ent, s return child_node; } } -#endif /* TABLE_LOCK_LEVEL */ -#endif /* INCLUDE_SUBGOAL_TRIE_CHECK_INSERT */ - - - -/************************************************************************ -** answer_trie_check_insert_(gt)_token ** -************************************************************************/ - -#ifdef INCLUDE_ANSWER_TRIE_CHECK_INSERT -#ifdef TABLE_LOCK_AT_WRITE_LEVEL -#ifdef IS_GLOBAL_TRIE_REFERENCE -static inline ans_node_ptr answer_trie_check_insert_gt_token(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) { #else -static inline ans_node_ptr answer_trie_check_insert_token(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) { -#endif /* IS_GLOBAL_TRIE_REFERENCE */ +#ifdef MODE_GLOBAL_TRIE_ENTRY +static inline ans_node_ptr answer_trie_check_insert_gt_entry(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) { +#else +static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) { +#endif /* MODE_GLOBAL_TRIE_ENTRY */ ans_node_ptr child_node; ans_hash_ptr hash; #ifdef TABLING_ERRORS if (IS_ANSWER_LEAF_NODE(parent_node)) - TABLING_ERROR_MESSAGE("IS_ANSWER_LEAF_NODE(parent_node) (answer_token_check_insert)"); + TABLING_ERROR_MESSAGE("IS_ANSWER_LEAF_NODE(parent_node) (answer_trie_check_insert_(gt)_entry)"); #endif /* TABLING_ERRORS */ child_node = TrNode_child(parent_node); @@ -549,122 +671,21 @@ answer_trie_hash: return child_node; } } -#else /* TABLE_LOCK_AT_ENTRY_LEVEL || TABLE_LOCK_AT_NODE_LEVEL || ! YAPOR */ -#ifdef IS_GLOBAL_TRIE_REFERENCE -static inline ans_node_ptr answer_trie_check_insert_gt_token(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) { -#else -static inline ans_node_ptr answer_trie_check_insert_token(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) { -#endif /* IS_GLOBAL_TRIE_REFERENCE */ - ans_node_ptr child_node; - -#ifdef TABLING_ERRORS - if (IS_ANSWER_LEAF_NODE(parent_node)) - TABLING_ERROR_MESSAGE("IS_ANSWER_LEAF_NODE(parent_node) (answer_token_check_insert)"); -#endif /* TABLING_ERRORS */ - - LOCK_NODE(parent_node); - child_node = TrNode_child(parent_node); - if (child_node == NULL) { - NEW_ANSWER_TRIE_NODE(child_node, instr, t, NULL, parent_node, NULL); - TrNode_child(parent_node) = child_node; - UNLOCK_NODE(parent_node); - return child_node; - } - - if (! IS_ANSWER_TRIE_HASH(child_node)) { - int count_nodes = 0; - do { - if (TrNode_entry(child_node) == t) { - UNLOCK_NODE(parent_node); - return child_node; - } - count_nodes++; - child_node = TrNode_next(child_node); - } while (child_node); - NEW_ANSWER_TRIE_NODE(child_node, instr, t, NULL, parent_node, TrNode_child(parent_node)); - count_nodes++; - if (count_nodes >= MAX_NODES_PER_TRIE_LEVEL) { - /* alloc a new hash */ - ans_hash_ptr hash; - ans_node_ptr chain_node, next_node, *bucket; - new_answer_trie_hash(hash, count_nodes, sg_fr); - chain_node = child_node; - do { - bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS - 1)); - next_node = TrNode_next(chain_node); - TrNode_next(chain_node) = *bucket; - *bucket = chain_node; - chain_node = next_node; - } while (chain_node); - TrNode_child(parent_node) = (ans_node_ptr) hash; - } else { - TrNode_child(parent_node) = child_node; - } - UNLOCK_NODE(parent_node); - return child_node; - } - - { /* trie nodes with hashing */ - ans_hash_ptr hash; - ans_node_ptr *bucket; - int count_nodes = 0; - hash = (ans_hash_ptr) child_node; - bucket = Hash_bucket(hash, HASH_ENTRY(t, Hash_seed(hash))); - child_node = *bucket; - while (child_node) { - if (TrNode_entry(child_node) == t) { - UNLOCK_NODE(parent_node); - return child_node; - } - count_nodes++; - child_node = TrNode_next(child_node); - } - NEW_ANSWER_TRIE_NODE(child_node, instr, t, NULL, parent_node, *bucket); - *bucket = child_node; - Hash_num_nodes(hash)++; - count_nodes++; - if (count_nodes >= MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) { - /* expand current hash */ - ans_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket; - int seed; - first_old_bucket = Hash_buckets(hash); - old_bucket = first_old_bucket + Hash_num_buckets(hash); - Hash_num_buckets(hash) *= 2; - ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash)); - seed = Hash_seed(hash); - do { - if (*--old_bucket) { - chain_node = *old_bucket; - do { - bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), seed)); - next_node = TrNode_next(chain_node); - TrNode_next(chain_node) = *bucket; - *bucket = chain_node; - chain_node = next_node; - } while (chain_node); - } - } while (old_bucket != first_old_bucket); - FREE_HASH_BUCKETS(first_old_bucket); - } - UNLOCK_NODE(parent_node); - return child_node; - } -} #endif /* TABLE_LOCK_LEVEL */ #endif /* INCLUDE_ANSWER_TRIE_CHECK_INSERT */ /************************************************************************ -** global_trie_check_insert_(gt)_token ** +** global_trie_check_insert_(gt)_entry ** ************************************************************************/ #ifdef INCLUDE_GLOBAL_TRIE_CHECK_INSERT -#ifdef IS_GLOBAL_TRIE_REFERENCE -static inline gt_node_ptr global_trie_check_insert_gt_token(gt_node_ptr parent_node, Term t) { +#ifdef MODE_GLOBAL_TRIE_ENTRY +static inline gt_node_ptr global_trie_check_insert_gt_entry(gt_node_ptr parent_node, Term t) { #else -static inline gt_node_ptr global_trie_check_insert_token(gt_node_ptr parent_node, Term t) { -#endif /* IS_GLOBAL_TRIE_REFERENCE */ +static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr parent_node, Term t) { +#endif /* MODE_GLOBAL_TRIE_ENTRY */ gt_node_ptr child_node; LOCK_NODE(parent_node); @@ -756,3 +777,553 @@ static inline gt_node_ptr global_trie_check_insert_token(gt_node_ptr parent_node } } #endif /* INCLUDE_GLOBAL_TRIE_CHECK_INSERT */ + + + +/************************************************************************ +** subgoal_search_loop(_gt_(sub)term) ** +************************************************************************/ + +#ifdef INCLUDE_SUBGOAL_SEARCH_LOOP +#ifdef MODE_GLOBAL_TRIE_LOOP +#ifdef GLOBAL_TRIE_FOR_TERMS +static inline gt_node_ptr subgoal_search_loop_gt_term(Term t, int *subs_arity_ptr, CELL **stack_vars_ptr) { +#elif GLOBAL_TRIE_FOR_SUBTERMS +static inline gt_node_ptr subgoal_search_loop_gt_subterm(Term t, int *subs_arity_ptr, CELL **stack_vars_ptr, CELL *stack_terms) { +#endif +#else +static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr tab_ent, sg_node_ptr current_node, Term t, int *subs_arity_ptr, CELL **stack_vars_ptr) { +#endif /* MODE_GLOBAL_TRIE_LOOP */ +/************************************************************************ + =========== + | | + | ... | + | | + ----------- + | VAR_N | <-- stack_vars + ----------- * + | ... | /|\ + ----------- | subs_arity (N+1) + | VAR_0 | \|/ + ----------- * + YENV --> | | + ----------- + | | + | ... | + | | + =========== + | | + | ... | + | | + ----------- + TR --> | | <-- stack_terms_limit + ----------- + | | + | ... | + | | + ----------| + | TERM_N | <-- stack_terms + ----------| * + | ... | /|\ + ----------| | + | TERM_1 | | + ----------| | + | NULL | \|/ + =========== * + Yap_TrailTop --> | | + ----------- +************************************************************************/ +#ifdef MODE_GLOBAL_TRIE_LOOP + gt_node_ptr current_node = GLOBAL_root_gt; +#endif /* MODE_GLOBAL_TRIE_LOOP */ + int subs_arity = *subs_arity_ptr; + CELL *stack_vars = *stack_vars_ptr; +#if !defined(MODE_GLOBAL_TRIE_LOOP) || !defined(GLOBAL_TRIE_FOR_SUBTERMS) + CELL *stack_terms = (CELL *) Yap_TrailTop; +#endif /* ! MODE_GLOBAL_TRIE_LOOP || ! GLOBAL_TRIE_FOR_SUBTERMS */ + CELL *stack_terms_limit = (CELL *) TR; + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); /* + 1 because initially we stiil haven't done any STACK_POP_DOWN */ + STACK_PUSH_UP(NULL, stack_terms); + + do { + if (IsVarTerm(t)) { + if (IsTableVarTerm(t)) { + t = MakeTableVarTerm(VarIndexOfTerm(t)); + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, t); + } else { + if (subs_arity == MAX_TABLE_VARS) + Yap_Error(INTERNAL_ERROR, TermNil, "subgoal_search_loop(_gt_(sub)term): MAX_TABLE_VARS exceeded"); + STACK_PUSH_UP(t, stack_vars); + *((CELL *)t) = GLOBAL_table_var_enumerator(subs_arity); + t = MakeTableVarTerm(subs_arity); + subs_arity = subs_arity + 1; + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, t); + } + } else if (IsAtomOrIntTerm(t)) { + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, t); +#if !defined(MODE_GLOBAL_TRIE_LOOP) && defined(GLOBAL_TRIE) + } else { + gt_node_ptr entry_node; +#ifdef GLOBAL_TRIE_FOR_TERMS + entry_node = subgoal_search_loop_gt_term(t, &subs_arity, &stack_vars); +#elif GLOBAL_TRIE_FOR_SUBTERMS + entry_node = subgoal_search_loop_gt_subterm(t, &subs_arity, &stack_vars, stack_terms); +#endif + current_node = subgoal_trie_check_insert_gt_entry(tab_ent, current_node, (Term) entry_node); + } +#else /* MODE_GLOBAL_TRIE_LOOP || ! GLOBAL_TRIE */ +#ifdef TRIE_COMPACT_PAIRS + } else if (IsPairTerm(t)) { + CELL *aux_pair = RepPair(t); + if (aux_pair == PairTermMark) { + t = STACK_POP_DOWN(stack_terms); + if (IsPairTerm(t)) { + aux_pair = RepPair(t); + t = Deref(aux_pair[1]); + if (t == TermNil) { + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, CompactPairEndList); + } else { + /* AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 2); */ + /* AUX_STACK_CHECK_EXPAND is not necessary here because the situation of pushing ** + ** up 3 terms has already initially checked for the CompactPairInit term */ + STACK_PUSH_UP(t, stack_terms); + STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms); + } + STACK_PUSH_UP(Deref(aux_pair[0]), stack_terms); + } else { + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, CompactPairEndTerm); + STACK_PUSH_UP(t, stack_terms); + } +#if defined(MODE_GLOBAL_TRIE_LOOP) && defined(GLOBAL_TRIE_FOR_SUBTERMS) + } else if (current_node != GLOBAL_root_gt) { + gt_node_ptr entry_node = subgoal_search_loop_gt_subterm(t, &subs_arity, &stack_vars, stack_terms); + current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node); +#endif /* MODE_GLOBAL_TRIE_LOOP && GLOBAL_TRIE_FOR_SUBTERMS */ + } else { + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, CompactPairInit); + t = Deref(aux_pair[1]); + if (t == TermNil) { + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, CompactPairEndList); + } else { + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 2); + STACK_PUSH_UP(t, stack_terms); + STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms); + } + STACK_PUSH_UP(Deref(aux_pair[0]), stack_terms); + } +#if defined(MODE_GLOBAL_TRIE_LOOP) && defined(GLOBAL_TRIE_FOR_SUBTERMS) + } else if (current_node != GLOBAL_root_gt) { + gt_node_ptr entry_node = subgoal_search_loop_gt_subterm(t, &subs_arity, &stack_vars, stack_terms); + current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node); +#endif /* MODE_GLOBAL_TRIE_LOOP && GLOBAL_TRIE_FOR_SUBTERMS */ +#else +#if defined(MODE_GLOBAL_TRIE_LOOP) && defined(GLOBAL_TRIE_FOR_SUBTERMS) + } else if (current_node != GLOBAL_root_gt) { + gt_node_ptr entry_node = subgoal_search_loop_gt_subterm(t, &subs_arity, &stack_vars, stack_terms); + current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node); +#endif /* MODE_GLOBAL_TRIE_LOOP && GLOBAL_TRIE_FOR_SUBTERMS */ + } else if (IsPairTerm(t)) { + CELL *aux_pair = RepPair(t); + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, AbsPair(NULL)); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); + STACK_PUSH_UP(Deref(aux_pair[1]), stack_terms); + STACK_PUSH_UP(Deref(aux_pair[0]), stack_terms); +#endif /* TRIE_COMPACT_PAIRS */ + } else if (IsApplTerm(t)) { + Functor f = FunctorOfTerm(t); + if (f == FunctorDouble) { + volatile Float dbl = FloatOfTerm(t); + volatile Term *t_dbl = (Term *)((void *) &dbl); + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, AbsAppl((Term *)f)); +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, t_dbl[1]); +#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, t_dbl[0]); +#ifdef MODE_GLOBAL_TRIE_LOOP + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, AbsAppl((Term *)f)); +#endif /* MODE_GLOBAL_TRIE_LOOP */ + } else if (f == FunctorLongInt) { + Int li = LongIntOfTerm(t); + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, AbsAppl((Term *)f)); + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, li); +#ifdef MODE_GLOBAL_TRIE_LOOP + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, AbsAppl((Term *)f)); +#endif /* MODE_GLOBAL_TRIE_LOOP */ + } else if (f == FunctorDBRef) { + Yap_Error(INTERNAL_ERROR, TermNil, "subgoal_search_loop(_gt_(sub)term): unsupported type tag FunctorDBRef"); + } else if (f == FunctorBigInt) { + Yap_Error(INTERNAL_ERROR, TermNil, "subgoal_search_loop(_gt_(sub)term): unsupported type tag FunctorBigInt"); + } else { + int i; + CELL *aux_appl = RepAppl(t); + SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, AbsAppl((Term *)f)); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + ArityOfFunctor(f) - 1); + for (i = ArityOfFunctor(f); i >= 1; i--) + STACK_PUSH_UP(Deref(aux_appl[i]), stack_terms); + } + } else { + Yap_Error(INTERNAL_ERROR, TermNil, "subgoal_search_loop(_gt_(sub)term): unknown type tag"); + } +#endif /* MODE_GLOBAL_TRIE_LOOP + GLOBAL_TRIE + */ + t = STACK_POP_DOWN(stack_terms); + } while (t); + + *subs_arity_ptr = subs_arity; + *stack_vars_ptr = stack_vars; + return current_node; +} +#endif /* INCLUDE_SUBGOAL_SEARCH_LOOP */ + + + +/************************************************************************ +** answer_search_loop(_gt_(sub)term) ** +************************************************************************/ + +#ifdef INCLUDE_ANSWER_SEARCH_LOOP +#ifdef MODE_GLOBAL_TRIE_LOOP +#ifdef GLOBAL_TRIE_FOR_TERMS +static inline gt_node_ptr answer_search_loop_gt_term(Term t, int *vars_arity_ptr) { +#elif GLOBAL_TRIE_FOR_SUBTERMS +static inline gt_node_ptr answer_search_loop_gt_subterm(Term t, int *vars_arity_ptr, CELL *stack_terms) { +#endif +#else +static inline ans_node_ptr answer_search_loop(sg_fr_ptr sg_fr, ans_node_ptr current_node, Term t, int *vars_arity_ptr) { +#endif /* MODE_GLOBAL_TRIE_LOOP */ +/************************************************************************ + =========== + | | + | ... | + | | + ----------- + TR --> | VAR_0 | <-- stack_vars_base + ----------- * + | ... | /|\ + ----------- | vars_arity (N+1) + | VAR_N | \|/ + ----------- * + | | <-- stack_terms_limit + ----------- + | | + | ... | + | | + ----------| + | TERM_N | <-- stack_terms + ----------| * + | ... | /|\ + ----------| | + | TERM_1 | | + ----------| | + | NULL | \|/ + =========== * + Yap_TrailTop --> | | + ----------- +************************************************************************/ +#ifdef MODE_GLOBAL_TRIE_LOOP + gt_node_ptr current_node = GLOBAL_root_gt; +#endif /* MODE_GLOBAL_TRIE_LOOP */ + int vars_arity = *vars_arity_ptr; +#if !defined(MODE_GLOBAL_TRIE_LOOP) || !defined(GLOBAL_TRIE_FOR_SUBTERMS) + CELL *stack_terms = (CELL *) Yap_TrailTop; +#endif /* ! MODE_GLOBAL_TRIE_LOOP || ! GLOBAL_TRIE_FOR_SUBTERMS */ + CELL *stack_vars_base = (CELL *) TR; +#define stack_terms_limit (stack_vars_base + vars_arity) +#ifdef TRIE_COMPACT_PAIRS + int in_pair = 0; +#else +#define in_pair 0 +#endif /* TRIE_COMPACT_PAIRS */ + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); /* + 1 because initially we stiil haven't done any STACK_POP_DOWN */ + STACK_PUSH_UP(NULL, stack_terms); + + do { + if (IsVarTerm(t)) { + t = Deref(t); + if (IsTableVarTerm(t)) { + t = MakeTableVarTerm(VarIndexOfTerm(t)); + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, t, _trie_retry_val + in_pair); + } else { + if (vars_arity == MAX_TABLE_VARS) + Yap_Error(INTERNAL_ERROR, TermNil, "answer_search_loop(_gt_(sub)term): MAX_TABLE_VARS exceeded"); + stack_vars_base[vars_arity] = t; + *((CELL *)t) = GLOBAL_table_var_enumerator(vars_arity); + t = MakeTableVarTerm(vars_arity); + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, t, _trie_retry_var + in_pair); + vars_arity = vars_arity + 1; + } +#ifdef TRIE_COMPACT_PAIRS + in_pair = 0; +#endif /* TRIE_COMPACT_PAIRS */ + } else if (IsAtomOrIntTerm(t)) { + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, t, _trie_retry_atom + in_pair); +#if !defined(MODE_GLOBAL_TRIE_LOOP) && defined(GLOBAL_TRIE) + } else { + gt_node_ptr entry_node; +#ifdef GLOBAL_TRIE_FOR_TERMS + entry_node = answer_search_loop_gt_term(t, &vars_arity); +#elif GLOBAL_TRIE_FOR_SUBTERMS + entry_node = answer_search_loop_gt_subterm(t, &vars_arity, stack_terms); +#endif + current_node = answer_trie_check_insert_gt_entry(sg_fr, current_node, (Term) entry_node, _trie_retry_gterm + in_pair); + } +#else /* MODE_GLOBAL_TRIE_LOOP || ! GLOBAL_TRIE */ +#ifdef TRIE_COMPACT_PAIRS + in_pair = 0; + } else if (IsPairTerm(t)) { + CELL *aux_pair = RepPair(t); + if (aux_pair == PairTermMark) { + t = STACK_POP_DOWN(stack_terms); + if (IsPairTerm(t)) { + aux_pair = RepPair(t); + t = Deref(aux_pair[1]); + if (t == TermNil) { + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, CompactPairEndList, _trie_retry_pair); + } else { + /* AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 2); */ + /* AUX_STACK_CHECK_EXPAND is not necessary here because the situation of pushing ** + ** up 3 terms has already initially checked for the CompactPairInit term */ + STACK_PUSH_UP(t, stack_terms); + STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms); + in_pair = 4; + } + STACK_PUSH_UP(Deref(aux_pair[0]), stack_terms); + } else { + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, CompactPairEndTerm, _trie_retry_null); + STACK_PUSH_UP(t, stack_terms); + } +#if defined(MODE_GLOBAL_TRIE_LOOP) && defined(GLOBAL_TRIE_FOR_SUBTERMS) + } else if (current_node != GLOBAL_root_gt) { + gt_node_ptr entry_node = answer_search_loop_gt_subterm(t, &vars_arity, stack_terms); + current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node); +#endif /* MODE_GLOBAL_TRIE_LOOP && GLOBAL_TRIE_FOR_SUBTERMS */ + } else { + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, CompactPairInit, _trie_retry_null + in_pair); + t = Deref(aux_pair[1]); + if (t == TermNil) { + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, CompactPairEndList, _trie_retry_pair); + in_pair = 0; + } else { + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 2); + STACK_PUSH_UP(t, stack_terms); + STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms); + in_pair = 4; + } + STACK_PUSH_UP(Deref(aux_pair[0]), stack_terms); + } +#if defined(MODE_GLOBAL_TRIE_LOOP) && defined(GLOBAL_TRIE_FOR_SUBTERMS) + } else if (current_node != GLOBAL_root_gt) { + gt_node_ptr entry_node = answer_search_loop_gt_subterm(t, &vars_arity, stack_terms); + current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node); +#endif /* MODE_GLOBAL_TRIE_LOOP && GLOBAL_TRIE_FOR_SUBTERMS */ +#else +#if defined(MODE_GLOBAL_TRIE_LOOP) && defined(GLOBAL_TRIE_FOR_SUBTERMS) + } else if (current_node != GLOBAL_root_gt) { + gt_node_ptr entry_node = answer_search_loop_gt_subterm(t, &vars_arity, stack_terms); + current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node); +#endif /* MODE_GLOBAL_TRIE_LOOP && GLOBAL_TRIE_FOR_SUBTERMS */ + } else if (IsPairTerm(t)) { + CELL *aux_pair = RepPair(t); + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, AbsPair(NULL), _trie_retry_pair); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); + STACK_PUSH_UP(Deref(aux_pair[1]), stack_terms); + STACK_PUSH_UP(Deref(aux_pair[0]), stack_terms); +#endif /* TRIE_COMPACT_PAIRS */ + } else if (IsApplTerm(t)) { + Functor f = FunctorOfTerm(t); + if (f == FunctorDouble) { + volatile Float dbl = FloatOfTerm(t); + volatile Term *t_dbl = (Term *)((void *) &dbl); + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_null + in_pair); +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, t_dbl[1], _trie_retry_extension); +#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, t_dbl[0], _trie_retry_extension); + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_double); + } else if (f == FunctorLongInt) { + Int li = LongIntOfTerm (t); + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_null + in_pair); + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, li, _trie_retry_extension); + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_longint); + } else if (f == FunctorDBRef) { + Yap_Error(INTERNAL_ERROR, TermNil, "answer_search_loop(_gt_(sub)term): unsupported type tag FunctorDBRef"); + } else if (f == FunctorBigInt) { + Yap_Error(INTERNAL_ERROR, TermNil, "answer_search_loop(_gt_(sub)term): unsupported type tag FunctorBigInt"); + } else { + int i; + CELL *aux_appl = RepAppl(t); + ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, AbsAppl((Term *)f), _trie_retry_appl + in_pair); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + ArityOfFunctor(f) - 1); + for (i = ArityOfFunctor(f); i >= 1; i--) + STACK_PUSH_UP(Deref(aux_appl[i]), stack_terms); + } +#ifdef TRIE_COMPACT_PAIRS + in_pair = 0; +#endif /* TRIE_COMPACT_PAIRS */ + } else { + Yap_Error(INTERNAL_ERROR, TermNil, "answer_search_loop(_gt_(sub)term): unknown type tag"); + } +#endif /* MODE_GLOBAL_TRIE_LOOP + GLOBAL_TRIE */ + t = STACK_POP_DOWN(stack_terms); + } while (t); + + *vars_arity_ptr = vars_arity; + return current_node; + +#undef stack_terms_limit +#ifndef TRIE_COMPACT_PAIRS +#undef in_pair +#endif /* TRIE_COMPACT_PAIRS */ +} +#endif /* INCLUDE_ANSWER_SEARCH_LOOP */ + + + +/************************************************************************ +** load_(answer|substitution)_loop ** +************************************************************************/ + +#ifdef INCLUDE_LOAD_ANSWER_LOOP +#ifdef MODE_GLOBAL_TRIE_LOOP +static inline CELL *load_substitution_loop(gt_node_ptr current_node, int *vars_arity_ptr, CELL *stack_terms) { +#else +static inline CELL *load_answer_loop(ans_node_ptr current_node) { +#endif /* MODE_GLOBAL_TRIE_LOOP */ +/************************************************************************ + =========== + | | + | ... | + | | + ----------- + TR --> | VAR_0 | <-- stack_vars_base + ----------- * + | ... | /|\ + ----------- | vars_arity (N+1) + | VAR_N | \|/ + ----------- * + | | <-- stack_terms_limit + ----------- + | | + | ... | + | | + ----------| + | TERM_N | <-- stack_terms + ----------| * + | ... | /|\ + ----------| | stack_terms_pair_offset (TRIE_COMPACT_PAIRS) + | TERM_1 | \|/ + =========== * + Yap_TrailTop --> | | <-- stack_terms_base (TRIE_COMPACT_PAIRS) + ----------- +************************************************************************/ +#ifdef MODE_GLOBAL_TRIE_LOOP + int vars_arity = *vars_arity_ptr; +#else + int vars_arity = 0; + CELL *stack_terms = (CELL *) Yap_TrailTop; +#endif /* MODE_GLOBAL_TRIE_LOOP */ + CELL *stack_vars_base = (CELL *) TR; +#define stack_terms_limit (stack_vars_base + vars_arity) +#if defined(TRIE_COMPACT_PAIRS) && (defined(MODE_GLOBAL_TRIE_LOOP) || !defined(GLOBAL_TRIE)) +#define stack_terms_base ((CELL *) Yap_TrailTop) + int stack_terms_pair_offset = 0; +#endif /* TRIE_COMPACT_PAIRS && (MODE_GLOBAL_TRIE_LOOP || ! GLOBAL_TRIE) */ + Term t = TrNode_entry(current_node); +#ifdef MODE_GLOBAL_TRIE_LOOP + current_node = TrNode_parent(current_node); +#else + current_node = UNTAG_ANSWER_LEAF_NODE(TrNode_parent(current_node)); +#endif /* MODE_GLOBAL_TRIE_LOOP */ + + do { + if (IsVarTerm(t)) { +#if (!defined(MODE_GLOBAL_TRIE_LOOP) && defined(GLOBAL_TRIE)) || defined(GLOBAL_TRIE_FOR_SUBTERMS) + if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) { + stack_terms = load_substitution_loop((gt_node_ptr) t, &vars_arity, stack_terms); + } else +#endif /* (! MODE_GLOBAL_TRIE_LOOP && GLOBAL_TRIE) || GLOBAL_TRIE_FOR_SUBTERMS */ + { int var_index = VarIndexOfTableTerm(t); + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit - vars_arity + var_index + 1); + if (var_index >= vars_arity) { + while (vars_arity < var_index) + stack_vars_base[vars_arity++] = 0; + stack_vars_base[vars_arity++] = MkVarTerm(); + } else if (stack_vars_base[var_index] == 0) + stack_vars_base[var_index] = MkVarTerm(); + STACK_PUSH_UP(stack_vars_base[var_index], stack_terms); + } + } else if (IsAtomOrIntTerm(t)) { + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit); + STACK_PUSH_UP(t, stack_terms); +#if defined(MODE_GLOBAL_TRIE_LOOP) || !defined(GLOBAL_TRIE) + } else if (IsPairTerm(t)) { +#ifdef TRIE_COMPACT_PAIRS + if (t == CompactPairInit) { + Term *stack_aux = stack_terms_base - stack_terms_pair_offset; + Term head, tail = STACK_POP_UP(stack_aux); + while (STACK_NOT_EMPTY(stack_aux, stack_terms)) { + head = STACK_POP_UP(stack_aux); + tail = MkPairTerm(head, tail); + } + stack_terms = stack_terms_base - stack_terms_pair_offset; + stack_terms_pair_offset = (int) STACK_POP_DOWN(stack_terms); + STACK_PUSH_UP(tail, stack_terms); + } else { /* CompactPairEndList / CompactPairEndTerm */ + Term last; + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1); + last = STACK_POP_DOWN(stack_terms); + STACK_PUSH_UP(stack_terms_pair_offset, stack_terms); + stack_terms_pair_offset = (int) (stack_terms_base - stack_terms); + if (t == CompactPairEndList) + STACK_PUSH_UP(TermNil, stack_terms); + STACK_PUSH_UP(last, stack_terms); + } +#else + Term head = STACK_POP_DOWN(stack_terms); + Term tail = STACK_POP_DOWN(stack_terms); + t = MkPairTerm(head, tail); + STACK_PUSH_UP(t, stack_terms); +#endif /* TRIE_COMPACT_PAIRS */ + } else if (IsApplTerm(t)) { + Functor f = (Functor) RepAppl(t); + if (f == FunctorDouble) { + volatile Float dbl; + volatile Term *t_dbl = (Term *)((void *) &dbl); + t = TrNode_entry(current_node); + current_node = TrNode_parent(current_node); + t_dbl[0] = t; +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + t = TrNode_entry(current_node); + current_node = TrNode_parent(current_node); + t_dbl[1] = t; +#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ + current_node = TrNode_parent(current_node); + t = MkFloatTerm(dbl); + } else if (f == FunctorLongInt) { + Int li = TrNode_entry(current_node); + current_node = TrNode_parent(current_node); + current_node = TrNode_parent(current_node); + t = MkLongIntTerm(li); + } else { + int f_arity = ArityOfFunctor(f); + t = Yap_MkApplTerm(f, f_arity, stack_terms); + stack_terms += f_arity; + } + AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit); + STACK_PUSH_UP(t, stack_terms); +#endif /* MODE_GLOBAL_TRIE_LOOP || ! GLOBAL_TRIE */ + } + t = TrNode_entry(current_node); + current_node = TrNode_parent(current_node); + } while (current_node); + +#ifdef MODE_GLOBAL_TRIE_LOOP + *vars_arity_ptr = vars_arity; +#endif /* MODE_GLOBAL_TRIE_LOOP */ + return stack_terms; + +#undef stack_terms_limit +#ifdef TRIE_COMPACT_PAIRS +#undef stack_terms_base +#endif /* TRIE_COMPACT_PAIRS */ +} +#endif /* INCLUDE_LOAD_ANSWER_LOOP */ diff --git a/OPTYap/tab.tries.insts.i b/OPTYap/tab.tries.insts.i index 504fee213..9434f3b02 100644 --- a/OPTYap/tab.tries.insts.i +++ b/OPTYap/tab.tries.insts.i @@ -14,1447 +14,1201 @@ /************************************************************************ ** Trie instructions: auxiliary stack organization ** ************************************************************************* - - STANDARD_TRIE - ------------------- - | ha = heap_arity | - ------------------- -- - | heap ptr 1 | | - ------------------- | - | ... | -- heap_arity - ------------------- | - | heap ptr ha | | - ------------------- -- - | va = vars_arity | - ------------------- - | sa = subs_arity | - ------------------- -- - | subs ptr sa | | - ------------------- | - | ... | -- subs_arity - ------------------- | - | subs ptr 1 | | - ------------------- -- - | var ptr va | | - ------------------- | - | ... | -- vars_arity - ------------------- | - | var ptr 1 | | - ------------------- -- - - - GLOBAL_TRIE - ------------------- - | va = vars_arity | - ------------------- -- - | var ptr va | | - ------------------- | - | ... | -- vars_arity - ------------------- | - | var ptr 1 | | - ------------------- -- - | sa = subs_arity | - ------------------- -- - | subs ptr sa | | - ------------------- | - | ... | -- subs_arity - ------------------- | - | subs ptr 1 | | - ------------------- -- - + ------------------- + | ha = heap_arity | + ------------------- -- + | heap ptr 1 | | + ------------------- | + | ... | -- heap_arity (0 if GLOBAL_TRIE) + ------------------- | + | heap ptr ha | | + ------------------- -- + | va = vars_arity | + ------------------- -- + | var ptr va | | + ------------------- | + | ... | -- vars_arity + ------------------- | + | var ptr 1 | | + ------------------- -- + | sa = subs_arity | + ------------------- -- + | subs ptr sa | | + ------------------- | + | ... | -- subs_arity + ------------------- | + | subs ptr 1 | | + ------------------- -- ************************************************************************/ /************************************************************************ -** Trie instructions: auxiliary macros ** +** Trie instructions: macros ** ************************************************************************/ -#ifdef GLOBAL_TRIE -#define copy_arity_stack() \ - { int size = subs_arity + vars_arity + 2; \ - YENV -= size; \ - memcpy(YENV, aux_stack_ptr, size * sizeof(CELL *)); \ - aux_stack_ptr = YENV; \ - } -#else -#define copy_arity_stack() \ - { int size = heap_arity + subs_arity + vars_arity + 3; \ - YENV -= size; \ - memcpy(YENV, aux_stack_ptr, size * sizeof(CELL *)); \ - aux_stack_ptr = YENV; \ - } -#endif /* GLOBAL_TRIE */ +#define TOP_STACK YENV -#define next_trie_instruction(NODE) \ - PREG = (yamop *) TrNode_child(NODE); \ - PREFETCH_OP(PREG); \ +#define HEAP_ARITY_ENTRY (0) +#define VARS_ARITY_ENTRY (1 + heap_arity) +#define SUBS_ARITY_ENTRY (1 + heap_arity + 1 + vars_arity) + +/* macros 'HEAP_ENTRY', 'VARS_ENTRY' and 'SUBS_ENTRY' ** +** assume that INDEX starts at 1 (and not at 0 !!!) */ +#define HEAP_ENTRY(INDEX) (HEAP_ARITY_ENTRY + (INDEX)) +#define VARS_ENTRY(INDEX) (VARS_ARITY_ENTRY + 1 + vars_arity - (INDEX)) +#define SUBS_ENTRY(INDEX) (SUBS_ARITY_ENTRY + 1 + subs_arity - (INDEX)) + +#define next_trie_instruction(NODE) \ + PREG = (yamop *) TrNode_child(NODE); \ + PREFETCH_OP(PREG); \ GONext() -#define next_instruction(CONDITION, NODE) \ - if (CONDITION) { \ - PREG = (yamop *) TrNode_child(NODE); \ - } else { \ - /* procceed */ \ - PREG = (yamop *) CPREG; \ - YENV = ENV; \ - } \ - PREFETCH_OP(PREG); \ +#define next_instruction(CONDITION, NODE) \ + if (CONDITION) { \ + PREG = (yamop *) TrNode_child(NODE); \ + } else { /* procceed */ \ + PREG = (yamop *) CPREG; \ + TOP_STACK = ENV; \ + } \ + PREFETCH_OP(PREG); \ GONext() -/* the 'store_trie_node', 'restore_trie_node' and 'pop_trie_node' macros do not ** -** include the 'set_cut' macro because there are no cuts in trie instructions */ +#define copy_aux_stack() \ + { int size = 3 + heap_arity + subs_arity + vars_arity; \ + TOP_STACK -= size; \ + memcpy(TOP_STACK, aux_stack, size * sizeof(CELL *)); \ + aux_stack = TOP_STACK; \ + } -#define store_trie_node(AP) \ - { register choiceptr cp; \ - YENV = (CELL *) (NORM_CP(YENV) - 1); \ - cp = NORM_CP(YENV); \ - HBREG = H; \ - store_yaam_reg_cpdepth(cp); \ - cp->cp_tr = TR; \ - cp->cp_h = H; \ - cp->cp_b = B; \ - cp->cp_cp = CPREG; \ - cp->cp_ap = (yamop *) AP; \ - cp->cp_env= ENV; \ - B = cp; \ - YAPOR_SET_LOAD(B); \ - SET_BB(B); \ - TABLING_ERRORS_check_stack; \ - } \ - copy_arity_stack() +/* macros 'store_trie_node', 'restore_trie_node' and 'pop_trie_node' ** +** do not include 'set_cut' because trie instructions are cut safe */ -#define restore_trie_node(AP) \ - H = HBREG = PROTECT_FROZEN_H(B); \ - restore_yaam_reg_cpdepth(B); \ - CPREG = B->cp_cp; \ - ENV = B->cp_env; \ - YAPOR_update_alternative(PREG, (yamop *) AP) \ - B->cp_ap = (yamop *) AP; \ - YENV = (CELL *) PROTECT_FROZEN_B(B); \ - SET_BB(NORM_CP(YENV)); \ - copy_arity_stack() +#define store_trie_node(AP) \ + { register choiceptr cp; \ + TOP_STACK = (CELL *) (NORM_CP(TOP_STACK) - 1); \ + cp = NORM_CP(TOP_STACK); \ + HBREG = H; \ + store_yaam_reg_cpdepth(cp); \ + cp->cp_tr = TR; \ + cp->cp_h = H; \ + cp->cp_b = B; \ + cp->cp_cp = CPREG; \ + cp->cp_ap = (yamop *) AP; \ + cp->cp_env= ENV; \ + B = cp; \ + YAPOR_SET_LOAD(B); \ + SET_BB(B); \ + TABLING_ERRORS_check_stack; \ + } \ + copy_aux_stack() -#define really_pop_trie_node() \ - YENV = (CELL *) PROTECT_FROZEN_B((B + 1)); \ - H = PROTECT_FROZEN_H(B); \ - pop_yaam_reg_cpdepth(B); \ - CPREG = B->cp_cp; \ - TABLING_close_alt(B); \ - ENV = B->cp_env; \ - B = B->cp_b; \ - HBREG = PROTECT_FROZEN_H(B); \ - SET_BB(PROTECT_FROZEN_B(B)); \ - if ((choiceptr) YENV == B_FZ) { \ - copy_arity_stack(); \ +#define restore_trie_node(AP) \ + H = HBREG = PROTECT_FROZEN_H(B); \ + restore_yaam_reg_cpdepth(B); \ + CPREG = B->cp_cp; \ + ENV = B->cp_env; \ + YAPOR_update_alternative(PREG, (yamop *) AP) \ + B->cp_ap = (yamop *) AP; \ + TOP_STACK = (CELL *) PROTECT_FROZEN_B(B); \ + SET_BB(NORM_CP(TOP_STACK)); \ + copy_aux_stack() + +#define really_pop_trie_node() \ + TOP_STACK = (CELL *) PROTECT_FROZEN_B((B + 1)); \ + H = PROTECT_FROZEN_H(B); \ + pop_yaam_reg_cpdepth(B); \ + CPREG = B->cp_cp; \ + TABLING_close_alt(B); \ + ENV = B->cp_env; \ + B = B->cp_b; \ + HBREG = PROTECT_FROZEN_H(B); \ + SET_BB(PROTECT_FROZEN_B(B)); \ + if ((choiceptr) TOP_STACK == B_FZ) { \ + copy_aux_stack(); \ } #ifdef YAPOR -#define pop_trie_node() \ - if (SCH_top_shared_cp(B)) { \ - restore_trie_node(NULL); \ - } else { \ - really_pop_trie_node(); \ +#define pop_trie_node() \ + if (SCH_top_shared_cp(B)) { \ + restore_trie_node(NULL); \ + } else { \ + really_pop_trie_node(); \ } #else -#define pop_trie_node() really_pop_trie_node() +#define pop_trie_node() \ + really_pop_trie_node() #endif /* YAPOR */ /************************************************************************ -** trie_null ** +** aux_stack_null_instr ** ************************************************************************/ -#define stack_trie_null_instr() \ +#define aux_stack_null_instr() \ next_trie_instruction(node) -#ifdef TRIE_COMPACT_PAIRS -/* trie compiled code for term 'CompactPairInit' */ -#define stack_trie_null_in_new_pair_instr() \ - if (heap_arity) { \ - aux_stack_ptr++; \ - Bind_Global((CELL *) *aux_stack_ptr, AbsPair(H)); \ - *aux_stack_ptr-- = (CELL) (H + 1); \ - *aux_stack_ptr-- = (CELL) H; \ - *aux_stack_ptr = heap_arity - 1 + 2; \ - YENV = aux_stack_ptr; \ - } else { \ - int i; \ - *aux_stack_ptr-- = (CELL) (H + 1); \ - *aux_stack_ptr-- = (CELL) H; \ - *aux_stack_ptr = 2; \ - YENV = aux_stack_ptr; \ - aux_stack_ptr += 2 + 2; \ - *aux_stack_ptr = subs_arity - 1; \ - aux_stack_ptr += subs_arity; \ - Bind((CELL *) *aux_stack_ptr, AbsPair(H)); \ - for (i = 0; i < vars_arity; i++) { \ - *aux_stack_ptr = *(aux_stack_ptr + 1); \ - aux_stack_ptr++; \ - } \ - } \ - H += 2; \ - next_trie_instruction(node) -#endif /* TRIE_COMPACT_PAIRS */ - /************************************************************************ -** trie_var ** +** aux_stack_extension_instr ** ************************************************************************/ -#define stack_trie_var_instr() \ - if (heap_arity) { \ - CELL var; \ - int i; \ - *aux_stack_ptr = heap_arity - 1; \ - var = *++aux_stack_ptr; \ - RESET_VARIABLE(var); \ - for (i = 0; i < heap_arity - 1; i++) { \ - *aux_stack_ptr = *(aux_stack_ptr + 1); \ - aux_stack_ptr++; \ - } \ - *aux_stack_ptr++ = vars_arity + 1; \ - *aux_stack_ptr++ = subs_arity; \ - for (i = 0; i < subs_arity; i++) { \ - *aux_stack_ptr = *(aux_stack_ptr + 1); \ - aux_stack_ptr++; \ - } \ - *aux_stack_ptr = var; \ - next_instruction(heap_arity - 1 || subs_arity, node); \ - } else { \ - *++aux_stack_ptr = vars_arity + 1; \ - *++aux_stack_ptr = subs_arity - 1; \ - next_instruction(subs_arity - 1, node); \ +#define aux_stack_extension_instr() \ + TOP_STACK = &aux_stack[-2]; \ + TOP_STACK[HEAP_ARITY_ENTRY] = heap_arity + 2; \ + TOP_STACK[HEAP_ENTRY(1)] = TrNode_entry(node); \ + TOP_STACK[HEAP_ENTRY(2)] = 0; /* extension mark */ \ + next_trie_instruction(node) + + + +/************************************************************************ +** aux_stack_term_(in_pair_)instr ** +************************************************************************/ + +#define aux_stack_term_instr() \ + if (heap_arity) { \ + Bind_Global((CELL *) aux_stack[HEAP_ENTRY(1)], t); \ + TOP_STACK = &aux_stack[1]; \ + TOP_STACK[HEAP_ARITY_ENTRY] = heap_arity - 1; \ + next_instruction(heap_arity - 1 || subs_arity, node); \ + } else { \ + Bind((CELL *) aux_stack[SUBS_ENTRY(1)], t); \ + aux_stack[SUBS_ARITY_ENTRY] = subs_arity - 1; \ + next_instruction(subs_arity - 1, node); \ } -#ifdef TRIE_COMPACT_PAIRS -#define stack_trie_var_in_new_pair_instr() \ - if (heap_arity) { \ - int i; \ - *aux_stack_ptr-- = (CELL) (H + 1); \ - *aux_stack_ptr = heap_arity - 1 + 1; \ - YENV = aux_stack_ptr; \ - aux_stack_ptr += 2; \ - Bind_Global((CELL *) *aux_stack_ptr, AbsPair(H)); \ - for (i = 0; i < heap_arity - 1; i++) { \ - *aux_stack_ptr = *(aux_stack_ptr + 1); \ - aux_stack_ptr++; \ - } \ - *aux_stack_ptr++ = vars_arity + 1; \ - *aux_stack_ptr++ = subs_arity; \ - for (i = 0; i < subs_arity; i++) { \ - *aux_stack_ptr = *(aux_stack_ptr + 1); \ - aux_stack_ptr++; \ - } \ - *aux_stack_ptr = (CELL) H; \ - } else { \ - *aux_stack_ptr-- = (CELL) (H + 1); \ - *aux_stack_ptr = 1; \ - YENV = aux_stack_ptr; \ - aux_stack_ptr += 2; \ - *aux_stack_ptr++ = vars_arity + 1; \ - *aux_stack_ptr = subs_arity - 1; \ - aux_stack_ptr += subs_arity; \ - Bind((CELL *) *aux_stack_ptr, AbsPair(H)); \ - *aux_stack_ptr = (CELL) H; \ - } \ - RESET_VARIABLE((CELL) H); \ - H += 2; \ +#define aux_stack_term_in_pair_instr() \ + if (heap_arity) { \ + Bind_Global((CELL *) aux_stack[HEAP_ENTRY(1)], AbsPair(H)); \ + } else { \ + Bind((CELL *) aux_stack[SUBS_ENTRY(1)], AbsPair(H)); \ + aux_stack[SUBS_ARITY_ENTRY] = subs_arity - 1; \ + TOP_STACK = &aux_stack[-1]; \ + TOP_STACK[HEAP_ARITY_ENTRY] = 1; \ + } \ + Bind_Global(H, TrNode_entry(node)); \ + TOP_STACK[HEAP_ENTRY(1)] = (CELL) (H + 1); \ + H += 2; \ next_trie_instruction(node) -#endif /* TRIE_COMPACT_PAIRS */ /************************************************************************ -** trie_val ** +** aux_stack_(new_)pair_instr ** ************************************************************************/ -#define stack_trie_val_instr() \ - if (heap_arity) { \ - CELL aux_sub, aux_var, *vars_ptr; \ - YENV = ++aux_stack_ptr; \ - vars_ptr = aux_stack_ptr + heap_arity + 1 + subs_arity + vars_arity - var_index; \ - aux_sub = *aux_stack_ptr; \ - aux_var = *vars_ptr; \ - if (aux_sub > aux_var) { \ - Bind_Global((CELL *) aux_sub, aux_var); \ - } else { \ - RESET_VARIABLE(aux_sub); \ - Bind_Local((CELL *) aux_var, aux_sub); \ - *vars_ptr = aux_sub; \ - } \ - *aux_stack_ptr = heap_arity - 1; \ - next_instruction(heap_arity - 1 || subs_arity, node); \ - } else { \ - CELL aux_sub, aux_var, *vars_ptr; \ - int i; \ - aux_stack_ptr += 2; \ - *aux_stack_ptr = subs_arity - 1; \ - aux_stack_ptr += subs_arity; \ - vars_ptr = aux_stack_ptr + vars_arity - var_index; \ - aux_sub = *aux_stack_ptr; \ - aux_var = *vars_ptr; \ - if (aux_sub > aux_var) { \ - if ((CELL *) aux_sub <= H) { \ - Bind_Global((CELL *) aux_sub, aux_var); \ - } else if ((CELL *) aux_var <= H) { \ - Bind_Local((CELL *) aux_sub, aux_var); \ - } else { \ - Bind_Local((CELL *) aux_var, aux_sub); \ - *vars_ptr = aux_sub; \ - } \ - } else { \ - if ((CELL *) aux_var <= H) { \ - Bind_Global((CELL *) aux_var, aux_sub); \ - *vars_ptr = aux_sub; \ - } else if ((CELL *) aux_sub <= H) { \ - Bind_Local((CELL *) aux_var, aux_sub); \ - *vars_ptr = aux_sub; \ - } else { \ - Bind_Local((CELL *) aux_sub, aux_var); \ - } \ - } \ - for (i = 0; i < vars_arity; i++) { \ - *aux_stack_ptr = *(aux_stack_ptr + 1); \ - aux_stack_ptr++; \ - } \ - next_instruction(subs_arity - 1, node); \ - } - -#ifdef TRIE_COMPACT_PAIRS -#define stack_trie_val_in_new_pair_instr() \ - if (heap_arity) { \ - CELL aux_sub, aux_var, *vars_ptr; \ - aux_stack_ptr++; \ - Bind_Global((CELL *) *aux_stack_ptr, AbsPair(H)); \ - *aux_stack_ptr = (CELL) (H + 1); \ - aux_sub = (CELL) H; \ - vars_ptr = aux_stack_ptr + heap_arity + 1 + subs_arity + vars_arity - var_index; \ - aux_var = *vars_ptr; \ - if (aux_sub > aux_var) { \ - Bind_Global((CELL *) aux_sub, aux_var); \ - } else { \ - RESET_VARIABLE(aux_sub); \ - Bind_Local((CELL *) aux_var, aux_sub); \ - *vars_ptr = aux_sub; \ - } \ - } else { \ - CELL aux_sub, aux_var, *vars_ptr; \ - int i; \ - *aux_stack_ptr-- = (CELL) (H + 1); \ - *aux_stack_ptr = 1; \ - YENV = aux_stack_ptr; \ - aux_stack_ptr += 1 + 2; \ - aux_sub = (CELL) H; \ - vars_ptr = aux_stack_ptr + subs_arity + vars_arity - var_index; \ - aux_var = *vars_ptr; \ - if (aux_sub > aux_var) { \ - Bind_Global((CELL *) aux_sub, aux_var); \ - } else { \ - RESET_VARIABLE(aux_sub); \ - Bind_Local((CELL *) aux_var, aux_sub); \ - *vars_ptr = aux_sub; \ - } \ - *aux_stack_ptr = subs_arity - 1; \ - aux_stack_ptr += subs_arity; \ - Bind((CELL *) *aux_stack_ptr, AbsPair(H)); \ - for (i = 0; i < vars_arity; i++) { \ - *aux_stack_ptr = *(aux_stack_ptr + 1); \ - aux_stack_ptr++; \ - } \ - } \ - H += 2; \ +#define aux_stack_new_pair_instr() /* for term 'CompactPairInit' */ \ + if (heap_arity) { \ + Bind_Global((CELL *) aux_stack[HEAP_ENTRY(1)], AbsPair(H)); \ + TOP_STACK = &aux_stack[-1]; \ + TOP_STACK[HEAP_ARITY_ENTRY] = heap_arity + 1; \ + } else { \ + Bind((CELL *) aux_stack[SUBS_ENTRY(1)], AbsPair(H)); \ + aux_stack[SUBS_ARITY_ENTRY] = subs_arity - 1; \ + TOP_STACK = &aux_stack[-2]; \ + TOP_STACK[HEAP_ARITY_ENTRY] = 2; \ + } \ + TOP_STACK[HEAP_ENTRY(1)] = (CELL) H; \ + TOP_STACK[HEAP_ENTRY(2)] = (CELL) (H + 1); \ + H += 2; \ next_trie_instruction(node) -#endif /* TRIE_COMPACT_PAIRS */ - - - -/************************************************************************ -** trie_atom ** -************************************************************************/ - -#define stack_trie_atom_instr() \ - if (heap_arity) { \ - YENV = ++aux_stack_ptr; \ - Bind_Global((CELL *) *aux_stack_ptr, TrNode_entry(node)); \ - *aux_stack_ptr = heap_arity - 1; \ - next_instruction(heap_arity - 1 || subs_arity, node); \ - } else { \ - int i; \ - aux_stack_ptr += 2; \ - *aux_stack_ptr = subs_arity - 1; \ - aux_stack_ptr += subs_arity; \ - Bind((CELL *) *aux_stack_ptr, TrNode_entry(node)); \ - for (i = 0; i < vars_arity; i++) { \ - *aux_stack_ptr = *(aux_stack_ptr + 1); \ - aux_stack_ptr++; \ - } \ - next_instruction(subs_arity - 1, node); \ - } #ifdef TRIE_COMPACT_PAIRS -#define stack_trie_atom_in_new_pair_instr() \ - if (heap_arity) { \ - aux_stack_ptr++; \ - Bind_Global((CELL *) *aux_stack_ptr, AbsPair(H)); \ - *aux_stack_ptr = (CELL) (H + 1); \ - } else { \ - int i; \ - *aux_stack_ptr-- = (CELL) (H + 1); \ - *aux_stack_ptr = 1; \ - YENV = aux_stack_ptr; \ - aux_stack_ptr += 1 + 2; \ - *aux_stack_ptr = subs_arity - 1; \ - aux_stack_ptr += subs_arity; \ - Bind((CELL *) *aux_stack_ptr, AbsPair(H)); \ - for (i = 0; i < vars_arity; i++) { \ - *aux_stack_ptr = *(aux_stack_ptr + 1); \ - aux_stack_ptr++; \ - } \ - } \ - Bind_Global(H, TrNode_entry(node)); \ - H += 2; \ - next_trie_instruction(node) -#endif /* TRIE_COMPACT_PAIRS */ - - - -/************************************************************************ -** trie_pair ** -************************************************************************/ - -#ifdef TRIE_COMPACT_PAIRS -/* trie compiled code for term 'CompactPairEndList' */ -#define stack_trie_pair_instr() \ - if (heap_arity) { \ - aux_stack_ptr++; \ - Bind_Global((CELL *) *aux_stack_ptr, AbsPair(H)); \ - *aux_stack_ptr = (CELL) H; \ - } else { \ - int i; \ - *aux_stack_ptr-- = (CELL) H; \ - *aux_stack_ptr = 1; \ - YENV = aux_stack_ptr; \ - aux_stack_ptr += 1 + 2; \ - *aux_stack_ptr = subs_arity - 1; \ - aux_stack_ptr += subs_arity; \ - Bind((CELL *) *aux_stack_ptr, AbsPair(H)); \ - for (i = 0; i < vars_arity; i++) { \ - *aux_stack_ptr = *(aux_stack_ptr + 1); \ - aux_stack_ptr++; \ - } \ - } \ - Bind_Global(H + 1, TermNil); \ - H += 2; \ +#define aux_stack_pair_instr() /* for term 'CompactPairEndList' */ \ + if (heap_arity) { \ + Bind_Global((CELL *) aux_stack[HEAP_ENTRY(1)], AbsPair(H)); \ + } else { \ + Bind((CELL *) aux_stack[SUBS_ENTRY(1)], AbsPair(H)); \ + aux_stack[SUBS_ARITY_ENTRY] = subs_arity - 1; \ + TOP_STACK = &aux_stack[-1]; \ + TOP_STACK[HEAP_ARITY_ENTRY] = 1; \ + } \ + TOP_STACK[HEAP_ENTRY(1)] = (CELL) H; \ + Bind_Global(H + 1, TermNil); \ + H += 2; \ next_trie_instruction(node) #else -#define stack_trie_pair_instr() \ - if (heap_arity) { \ - aux_stack_ptr++; \ - Bind_Global((CELL *) *aux_stack_ptr, AbsPair(H)); \ - *aux_stack_ptr-- = (CELL) (H + 1); \ - *aux_stack_ptr-- = (CELL) H; \ - *aux_stack_ptr = heap_arity - 1 + 2; \ - YENV = aux_stack_ptr; \ - } else { \ - int i; \ - *aux_stack_ptr-- = (CELL) (H + 1); \ - *aux_stack_ptr-- = (CELL) H; \ - *aux_stack_ptr = 2; \ - YENV = aux_stack_ptr; \ - aux_stack_ptr += 2 + 2; \ - *aux_stack_ptr = subs_arity - 1; \ - aux_stack_ptr += subs_arity; \ - Bind((CELL *) *aux_stack_ptr, AbsPair(H)); \ - for (i = 0; i < vars_arity; i++) { \ - *aux_stack_ptr = *(aux_stack_ptr + 1); \ - aux_stack_ptr++; \ - } \ - } \ - H += 2; \ - next_trie_instruction(node) +#define aux_stack_pair_instr() \ + aux_stack_new_pair_instr() #endif /* TRIE_COMPACT_PAIRS */ /************************************************************************ -** trie_struct ** +** aux_stack_appl_(in_pair_)instr ** ************************************************************************/ -#define stack_trie_struct_instr() \ - if (heap_arity) { \ - int i; \ - aux_stack_ptr++; \ - Bind_Global((CELL *) *aux_stack_ptr, AbsAppl(H)); \ - for (i = 0; i < func_arity; i++) \ - *aux_stack_ptr-- = (CELL) (H + func_arity - i); \ - *aux_stack_ptr = heap_arity - 1 + func_arity; \ - YENV = aux_stack_ptr; \ - } else { \ - int i; \ - for (i = 0; i < func_arity; i++) \ - *aux_stack_ptr-- = (CELL) (H + func_arity - i); \ - *aux_stack_ptr = func_arity; \ - YENV = aux_stack_ptr; \ - aux_stack_ptr += func_arity + 2; \ - *aux_stack_ptr = subs_arity - 1; \ - aux_stack_ptr += subs_arity; \ - Bind((CELL *) *aux_stack_ptr, AbsAppl(H)); \ - for (i = 0; i < vars_arity; i++) { \ - *aux_stack_ptr = *(aux_stack_ptr + 1); \ - aux_stack_ptr++; \ - } \ - } \ - *H = (CELL) func; \ - H += 1 + func_arity; \ +#define aux_stack_appl_instr() \ + if (heap_arity) { \ + Bind_Global((CELL *) aux_stack[HEAP_ENTRY(1)], AbsAppl(H)); \ + TOP_STACK = &aux_stack[-func_arity + 1]; \ + TOP_STACK[HEAP_ARITY_ENTRY] = heap_arity + func_arity - 1; \ + } else { \ + Bind((CELL *) aux_stack[SUBS_ENTRY(1)], AbsAppl(H)); \ + aux_stack[SUBS_ARITY_ENTRY] = subs_arity - 1; \ + TOP_STACK = &aux_stack[-func_arity]; \ + TOP_STACK[HEAP_ARITY_ENTRY] = func_arity; \ + } \ + *H = (CELL) func; \ + { int i; \ + for (i = 1; i <= func_arity; i++) \ + TOP_STACK[HEAP_ENTRY(i)] = (CELL) (H + i); \ + } \ + H += 1 + func_arity; \ next_trie_instruction(node) -#ifdef TRIE_COMPACT_PAIRS -#define stack_trie_struct_in_new_pair_instr() \ - if (heap_arity) { \ - int i; \ - aux_stack_ptr++; \ - Bind_Global((CELL *) *aux_stack_ptr, AbsPair(H)); \ - *aux_stack_ptr-- = (CELL) (H + 1); \ - for (i = 0; i < func_arity; i++) \ - *aux_stack_ptr-- = (CELL) (H + 2 + func_arity - i); \ - *aux_stack_ptr = heap_arity - 1 + 1 + func_arity; \ - YENV = aux_stack_ptr; \ - } else { \ - int i; \ - *aux_stack_ptr-- = (CELL) (H + 1); \ - for (i = 0; i < func_arity; i++) \ - *aux_stack_ptr-- = (CELL) (H + 2 + func_arity - i); \ - *aux_stack_ptr = 1 + func_arity; \ - YENV = aux_stack_ptr; \ - aux_stack_ptr += 1 + func_arity + 2; \ - *aux_stack_ptr = subs_arity - 1; \ - aux_stack_ptr += subs_arity; \ - Bind((CELL *) *aux_stack_ptr, AbsPair(H)); \ - for (i = 0; i < vars_arity; i++) { \ - *aux_stack_ptr = *(aux_stack_ptr + 1); \ - aux_stack_ptr++; \ - } \ - } \ - Bind_Global(H, AbsAppl(H + 2)); \ - H += 2; \ - *H = (CELL) func; \ - H += 1 + func_arity; \ - next_trie_instruction(node) -#endif /* TRIE_COMPACT_PAIRS */ - - - -/************************************************************************ -** trie_extension ** -************************************************************************/ - -#define stack_trie_extension_instr() \ - *aux_stack_ptr-- = 0; /* float/longint extension mark */ \ - *aux_stack_ptr-- = TrNode_entry(node); \ - *aux_stack_ptr = heap_arity + 2; \ - YENV = aux_stack_ptr; \ +#define aux_stack_appl_in_pair_instr() \ + if (heap_arity) { \ + Bind_Global((CELL *) aux_stack[HEAP_ENTRY(1)], AbsPair(H)); \ + TOP_STACK = &aux_stack[-func_arity]; \ + TOP_STACK[HEAP_ARITY_ENTRY] = heap_arity + func_arity; \ + } else { \ + Bind((CELL *) aux_stack[SUBS_ENTRY(1)], AbsPair(H)); \ + aux_stack[SUBS_ARITY_ENTRY] = subs_arity - 1; \ + TOP_STACK = &aux_stack[-func_arity - 1]; \ + TOP_STACK[HEAP_ARITY_ENTRY] = func_arity + 1; \ + } \ + TOP_STACK[HEAP_ENTRY(func_arity + 1)] = (CELL) (H + 1); \ + Bind_Global(H, AbsAppl(H + 2)); \ + H += 2; \ + *H = (CELL) func; \ + { int i; \ + for (i = 1; i <= func_arity; i++) \ + TOP_STACK[HEAP_ENTRY(i)] = (CELL) (H + i); \ + } \ + H += 1 + func_arity; \ next_trie_instruction(node) /************************************************************************ -** trie_float_longint ** +** aux_stack_var_(in_pair_)instr ** ************************************************************************/ -#define stack_trie_float_longint_instr() \ - if (heap_arity) { \ - YENV = ++aux_stack_ptr; \ - Bind_Global((CELL *) *aux_stack_ptr, t); \ - *aux_stack_ptr = heap_arity - 1; \ - next_instruction(heap_arity - 1 || subs_arity, node); \ - } else { \ - int i; \ - YENV = aux_stack_ptr; \ - *aux_stack_ptr = 0; \ - aux_stack_ptr += 2; \ - *aux_stack_ptr = subs_arity - 1; \ - aux_stack_ptr += subs_arity; \ - Bind((CELL *) *aux_stack_ptr, t); \ - for (i = 0; i < vars_arity; i++) { \ - *aux_stack_ptr = *(aux_stack_ptr + 1); \ - aux_stack_ptr++; \ - } \ - next_instruction(subs_arity - 1, node); \ +#define aux_stack_var_instr() \ + if (heap_arity) { \ + int i; \ + CELL var = aux_stack[HEAP_ENTRY(1)]; \ + RESET_VARIABLE(var); \ + TOP_STACK[HEAP_ARITY_ENTRY] = heap_arity - 1; \ + for (i = 2; i <= heap_arity; i++) \ + TOP_STACK[HEAP_ENTRY(i - 1)] = aux_stack[HEAP_ENTRY(i)]; \ + aux_stack[VARS_ARITY_ENTRY - 1] = vars_arity + 1; \ + aux_stack[VARS_ENTRY(vars_arity + 1)] = var; \ + next_instruction(heap_arity - 1 || subs_arity, node); \ + } else { \ + CELL var = aux_stack[SUBS_ENTRY(1)]; \ + aux_stack[SUBS_ARITY_ENTRY] = subs_arity - 1; \ + TOP_STACK = &aux_stack[-1]; \ + TOP_STACK[HEAP_ARITY_ENTRY] = 0; \ + aux_stack[VARS_ARITY_ENTRY - 1] = vars_arity + 1; \ + aux_stack[VARS_ENTRY(vars_arity + 1)] = var; \ + next_instruction(subs_arity - 1, node); \ + } + +#define aux_stack_var_in_pair_instr() \ + if (heap_arity) { \ + int i; \ + Bind_Global((CELL *) aux_stack[HEAP_ENTRY(1)], AbsPair(H)); \ + TOP_STACK = &aux_stack[-1]; \ + TOP_STACK[HEAP_ARITY_ENTRY] = heap_arity; \ + TOP_STACK[HEAP_ENTRY(1)] = (CELL) (H + 1); \ + for (i = 2; i <= heap_arity; i++) \ + TOP_STACK[HEAP_ENTRY(i)] = aux_stack[HEAP_ENTRY(i)]; \ + } else { \ + Bind((CELL *) aux_stack[SUBS_ENTRY(1)], AbsPair(H)); \ + aux_stack[SUBS_ARITY_ENTRY] = subs_arity - 1; \ + TOP_STACK = &aux_stack[-2]; \ + TOP_STACK[HEAP_ARITY_ENTRY] = 1; \ + TOP_STACK[HEAP_ENTRY(1)] = (CELL) (H + 1); \ + } \ + aux_stack[VARS_ARITY_ENTRY - 1] = vars_arity + 1; \ + aux_stack[VARS_ENTRY(vars_arity + 1)] = (CELL) H; \ + RESET_VARIABLE((CELL) H); \ + H += 2; \ + next_trie_instruction(node) + + + +/************************************************************************ +** aux_stack_val_(in_pair_)instr ** +************************************************************************/ + +#define aux_stack_val_instr() \ + if (heap_arity) { \ + CELL aux_sub, aux_var; \ + aux_sub = aux_stack[HEAP_ENTRY(1)]; \ + aux_var = aux_stack[VARS_ENTRY(var_index + 1)]; \ + if (aux_sub > aux_var) { \ + Bind_Global((CELL *) aux_sub, aux_var); \ + } else { \ + RESET_VARIABLE(aux_sub); \ + Bind_Local((CELL *) aux_var, aux_sub); \ + aux_stack[VARS_ENTRY(var_index + 1)] = aux_sub; \ + } \ + TOP_STACK = &aux_stack[1]; \ + TOP_STACK[HEAP_ARITY_ENTRY] = heap_arity - 1; \ + next_instruction(heap_arity - 1 || subs_arity, node); \ + } else { \ + CELL aux_sub, aux_var; \ + aux_sub = aux_stack[SUBS_ENTRY(1)]; \ + aux_stack[SUBS_ARITY_ENTRY] = subs_arity - 1; \ + aux_var = aux_stack[VARS_ENTRY(var_index + 1)]; \ + if (aux_sub > aux_var) { \ + if ((CELL *) aux_sub <= H) { \ + Bind_Global((CELL *) aux_sub, aux_var); \ + } else if ((CELL *) aux_var <= H) { \ + Bind_Local((CELL *) aux_sub, aux_var); \ + } else { \ + Bind_Local((CELL *) aux_var, aux_sub); \ + aux_stack[VARS_ENTRY(var_index + 1)] = aux_sub; \ + } \ + } else { \ + if ((CELL *) aux_var <= H) { \ + Bind_Global((CELL *) aux_var, aux_sub); \ + aux_stack[VARS_ENTRY(var_index + 1)] = aux_sub; \ + } else if ((CELL *) aux_sub <= H) { \ + Bind_Local((CELL *) aux_var, aux_sub); \ + aux_stack[VARS_ENTRY(var_index + 1)] = aux_sub; \ + } else { \ + Bind_Local((CELL *) aux_sub, aux_var); \ + } \ + } \ + next_instruction(subs_arity - 1, node); \ } +#define aux_stack_val_in_pair_instr() \ + if (heap_arity) { \ + Bind_Global((CELL *) aux_stack[HEAP_ENTRY(1)], AbsPair(H)); \ + } else { \ + Bind((CELL *) aux_stack[SUBS_ENTRY(1)], AbsPair(H)); \ + aux_stack[SUBS_ARITY_ENTRY] = subs_arity - 1; \ + TOP_STACK = &aux_stack[-1]; \ + TOP_STACK[HEAP_ARITY_ENTRY] = 1; \ + } \ + { CELL aux_sub, aux_var; \ + aux_sub = (CELL) H; \ + aux_var = aux_stack[VARS_ENTRY(var_index + 1)]; \ + if (aux_sub > aux_var) { \ + Bind_Global((CELL *) aux_sub, aux_var); \ + } else { \ + RESET_VARIABLE(aux_sub); \ + Bind_Local((CELL *) aux_var, aux_sub); \ + aux_stack[VARS_ENTRY(var_index + 1)] = aux_sub; \ + } \ + } \ + TOP_STACK[HEAP_ENTRY(1)] = (CELL) (H + 1); \ + H += 2; \ + next_trie_instruction(node) + /************************************************************************ ** Trie instructions ** ************************************************************************/ - PBOp(trie_do_null, e) -#ifndef GLOBAL_TRIE - register ans_node_ptr node = (ans_node_ptr) PREG; - - stack_trie_null_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_null)"); -#endif /* GLOBAL_TRIE */ - ENDPBOp(); - - - PBOp(trie_trust_null, e) -#ifndef GLOBAL_TRIE - register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); - - pop_trie_node(); - stack_trie_null_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_null)"); -#endif /* GLOBAL_TRIE */ - ENDPBOp(); - - - PBOp(trie_try_null, e) -#ifndef GLOBAL_TRIE - register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); - - store_trie_node(TrNode_next(node)); - stack_trie_null_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_null)"); -#endif /* GLOBAL_TRIE */ - ENDPBOp(); - - - PBOp(trie_retry_null, e) -#ifndef GLOBAL_TRIE - register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); - - restore_trie_node(TrNode_next(node)); - stack_trie_null_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_null)"); -#endif /* GLOBAL_TRIE */ - ENDPBOp(); - - - PBOp(trie_do_null_in_new_pair, e) -#if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) - register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); - - stack_trie_null_in_new_pair_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_null_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ - ENDPBOp(); - - - PBOp(trie_trust_null_in_new_pair, e) -#if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) - register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); - - pop_trie_node(); - stack_trie_null_in_new_pair_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_null_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ - ENDPBOp(); - - - PBOp(trie_try_null_in_new_pair, e) -#if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) - register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); - - store_trie_node(TrNode_next(node)); - stack_trie_null_in_new_pair_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_null_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ - ENDPBOp(); - - - PBOp(trie_retry_null_in_new_pair, e) -#if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) - register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); - - restore_trie_node(TrNode_next(node)); - stack_trie_null_in_new_pair_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_null_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ - ENDPBOp(); - - PBOp(trie_do_var, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; - stack_trie_var_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_var)"); -#endif /* GLOBAL_TRIE */ + aux_stack_var_instr(); ENDPBOp(); PBOp(trie_trust_var, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; pop_trie_node(); - stack_trie_var_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_var)"); -#endif /* GLOBAL_TRIE */ + aux_stack_var_instr(); ENDPBOp(); PBOp(trie_try_var, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; store_trie_node(TrNode_next(node)); - stack_trie_var_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_var)"); -#endif /* GLOBAL_TRIE */ + aux_stack_var_instr(); ENDPBOp(); PBOp(trie_retry_var, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; restore_trie_node(TrNode_next(node)); - stack_trie_var_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_var)"); -#endif /* GLOBAL_TRIE */ + aux_stack_var_instr(); ENDPBOp(); - PBOp(trie_do_var_in_new_pair, e) + PBOp(trie_do_var_in_pair, e) #if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; - stack_trie_var_in_new_pair_instr(); + aux_stack_var_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_var_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_do_var_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); - PBOp(trie_trust_var_in_new_pair, e) + PBOp(trie_trust_var_in_pair, e) #if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; pop_trie_node(); - stack_trie_var_in_new_pair_instr(); + aux_stack_var_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_var_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_trust_var_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); - PBOp(trie_try_var_in_new_pair, e) + PBOp(trie_try_var_in_pair, e) #if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; store_trie_node(TrNode_next(node)); - stack_trie_var_in_new_pair_instr(); + aux_stack_var_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_var_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_try_var_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); - PBOp(trie_retry_var_in_new_pair, e) + PBOp(trie_retry_var_in_pair, e) #if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; restore_trie_node(TrNode_next(node)); - stack_trie_var_in_new_pair_instr(); + aux_stack_var_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_var_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_retry_var_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); PBOp(trie_do_val, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; int var_index = VarIndexOfTableTerm(TrNode_entry(node)); - stack_trie_val_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_val)"); -#endif /* GLOBAL_TRIE */ + aux_stack_val_instr(); ENDPBOp(); PBOp(trie_trust_val, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; int var_index = VarIndexOfTableTerm(TrNode_entry(node)); pop_trie_node(); - stack_trie_val_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_val)"); -#endif /* GLOBAL_TRIE */ + aux_stack_val_instr(); ENDPBOp(); PBOp(trie_try_val, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; int var_index = VarIndexOfTableTerm(TrNode_entry(node)); store_trie_node(TrNode_next(node)); - stack_trie_val_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_val)"); -#endif /* GLOBAL_TRIE */ + aux_stack_val_instr(); ENDPBOp(); PBOp(trie_retry_val, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; int var_index = VarIndexOfTableTerm(TrNode_entry(node)); restore_trie_node(TrNode_next(node)); - stack_trie_val_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_val)"); -#endif /* GLOBAL_TRIE */ + aux_stack_val_instr(); ENDPBOp(); - PBOp(trie_do_val_in_new_pair, e) + PBOp(trie_do_val_in_pair, e) #if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; int var_index = VarIndexOfTableTerm(TrNode_entry(node)); - stack_trie_val_in_new_pair_instr(); + aux_stack_val_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_val_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_do_val_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); - PBOp(trie_trust_val_in_new_pair, e) + PBOp(trie_trust_val_in_pair, e) #if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; int var_index = VarIndexOfTableTerm(TrNode_entry(node)); pop_trie_node(); - stack_trie_val_in_new_pair_instr(); + aux_stack_val_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_val_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_trust_val_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); - PBOp(trie_try_val_in_new_pair, e) + PBOp(trie_try_val_in_pair, e) #if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; int var_index = VarIndexOfTableTerm(TrNode_entry(node)); store_trie_node(TrNode_next(node)); - stack_trie_val_in_new_pair_instr(); + aux_stack_val_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_val_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_try_val_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); - PBOp(trie_retry_val_in_new_pair, e) + PBOp(trie_retry_val_in_pair, e) #if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; int var_index = VarIndexOfTableTerm(TrNode_entry(node)); restore_trie_node(TrNode_next(node)); - stack_trie_val_in_new_pair_instr(); + aux_stack_val_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_val_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_retry_val_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); PBOp(trie_do_atom, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; -#ifdef GLOBAL_TRIE - int subs_arity = *(aux_stack_ptr + *aux_stack_ptr + 1); - YENV = aux_stack_ptr = load_substitution_variable((gt_node_ptr)TrNode_entry(node), aux_stack_ptr); - next_instruction(subs_arity - 1 , node); -#else - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + Term t = TrNode_entry(node); - stack_trie_atom_instr(); -#endif /* GLOBAL_TRIE */ + aux_stack_term_instr(); ENDPBOp(); PBOp(trie_trust_atom, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); -#ifdef GLOBAL_TRIE - int vars_arity = *(aux_stack_ptr); - int subs_arity = *(aux_stack_ptr + vars_arity + 1); -#else - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); -#endif /* GLOBAL_TRIE */ + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + Term t = TrNode_entry(node); + pop_trie_node(); -#ifdef GLOBAL_TRIE - YENV = aux_stack_ptr = load_substitution_variable((gt_node_ptr)TrNode_entry(node), aux_stack_ptr); - next_instruction(subs_arity - 1 , node); -#else - stack_trie_atom_instr(); -#endif /* GLOBAL_TRIE */ + aux_stack_term_instr(); ENDPBOp(); PBOp(trie_try_atom, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; -#ifdef GLOBAL_TRIE - int vars_arity = *(aux_stack_ptr); - int subs_arity = *(aux_stack_ptr + vars_arity + 1); -#else - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); -#endif /* GLOBAL_TRIE */ + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + Term t = TrNode_entry(node); + store_trie_node(TrNode_next(node)); -#ifdef GLOBAL_TRIE - YENV = aux_stack_ptr = load_substitution_variable((gt_node_ptr)TrNode_entry(node), aux_stack_ptr); - next_instruction(subs_arity - 1, node); -#else - stack_trie_atom_instr(); -#endif /* GLOBAL_TRIE */ + aux_stack_term_instr(); ENDPBOp(); PBOp(trie_retry_atom, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); -#ifdef GLOBAL_TRIE - int vars_arity = *(aux_stack_ptr); - int subs_arity = *(aux_stack_ptr + vars_arity + 1); -#else - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); -#endif /* GLOBAL_TRIE */ + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + Term t = TrNode_entry(node); + restore_trie_node(TrNode_next(node)); -#ifdef GLOBAL_TRIE - YENV = aux_stack_ptr = load_substitution_variable((gt_node_ptr)TrNode_entry(node), aux_stack_ptr); - next_instruction(subs_arity - 1, node); -#else - stack_trie_atom_instr(); -#endif /* GLOBAL_TRIE */ + aux_stack_term_instr(); ENDPBOp(); - PBOp(trie_do_atom_in_new_pair, e) + PBOp(trie_do_atom_in_pair, e) #if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; - stack_trie_atom_in_new_pair_instr(); + aux_stack_term_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_atom_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_do_atom_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); - PBOp(trie_trust_atom_in_new_pair, e) + PBOp(trie_trust_atom_in_pair, e) #if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; pop_trie_node(); - stack_trie_atom_in_new_pair_instr(); + aux_stack_term_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_atom_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_trust_atom_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); - PBOp(trie_try_atom_in_new_pair, e) + PBOp(trie_try_atom_in_pair, e) #if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; store_trie_node(TrNode_next(node)); - stack_trie_atom_in_new_pair_instr(); + aux_stack_term_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_atom_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_try_atom_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); - PBOp(trie_retry_atom_in_new_pair, e) + PBOp(trie_retry_atom_in_pair, e) #if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; restore_trie_node(TrNode_next(node)); - stack_trie_atom_in_new_pair_instr(); + aux_stack_term_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_atom_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_retry_atom_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ + ENDPBOp(); + + + PBOp(trie_do_null, e) + register ans_node_ptr node = (ans_node_ptr) PREG; + + aux_stack_null_instr(); + ENDPBOp(); + + + PBOp(trie_trust_null, e) + register ans_node_ptr node = (ans_node_ptr) PREG; + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + + pop_trie_node(); + aux_stack_null_instr(); + ENDPBOp(); + + + PBOp(trie_try_null, e) + register ans_node_ptr node = (ans_node_ptr) PREG; + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + + store_trie_node(TrNode_next(node)); + aux_stack_null_instr(); + ENDPBOp(); + + + PBOp(trie_retry_null, e) + register ans_node_ptr node = (ans_node_ptr) PREG; + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + + restore_trie_node(TrNode_next(node)); + aux_stack_null_instr(); + ENDPBOp(); + + + PBOp(trie_do_null_in_pair, e) +#ifdef TRIE_COMPACT_PAIRS + register ans_node_ptr node = (ans_node_ptr) PREG; + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + + aux_stack_new_pair_instr(); +#else + Yap_Error(INTERNAL_ERROR, TermNil, "trie_do_null_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ + ENDPBOp(); + + + PBOp(trie_trust_null_in_pair, e) +#ifdef TRIE_COMPACT_PAIRS + register ans_node_ptr node = (ans_node_ptr) PREG; + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + + pop_trie_node(); + aux_stack_new_pair_instr(); +#else + Yap_Error(INTERNAL_ERROR, TermNil, "trie_trust_null_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ + ENDPBOp(); + + + PBOp(trie_try_null_in_pair, e) +#ifdef TRIE_COMPACT_PAIRS + register ans_node_ptr node = (ans_node_ptr) PREG; + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + + store_trie_node(TrNode_next(node)); + aux_stack_new_pair_instr(); +#else + Yap_Error(INTERNAL_ERROR, TermNil, "trie_try_null_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ + ENDPBOp(); + + + PBOp(trie_retry_null_in_pair, e) +#ifdef TRIE_COMPACT_PAIRS + register ans_node_ptr node = (ans_node_ptr) PREG; + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + + restore_trie_node(TrNode_next(node)); + aux_stack_new_pair_instr(); +#else + Yap_Error(INTERNAL_ERROR, TermNil, "trie_retry_null_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); PBOp(trie_do_pair, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; - stack_trie_pair_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_pair)"); -#endif /* GLOBAL_TRIE */ + aux_stack_pair_instr(); ENDPBOp(); PBOp(trie_trust_pair, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; pop_trie_node(); - stack_trie_pair_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_pair)"); -#endif /* GLOBAL_TRIE */ + aux_stack_pair_instr(); ENDPBOp(); PBOp(trie_try_pair, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; store_trie_node(TrNode_next(node)); - stack_trie_pair_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_pair)"); -#endif /* GLOBAL_TRIE */ + aux_stack_pair_instr(); ENDPBOp(); PBOp(trie_retry_pair, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; restore_trie_node(TrNode_next(node)); - stack_trie_pair_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_pair)"); -#endif /* GLOBAL_TRIE */ + aux_stack_pair_instr(); ENDPBOp(); - PBOp(trie_do_struct, e) -#ifndef GLOBAL_TRIE + PBOp(trie_do_appl, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); int func_arity = ArityOfFunctor(func); - stack_trie_struct_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_struct)"); -#endif /* GLOBAL_TRIE */ + aux_stack_appl_instr(); ENDPBOp(); - PBOp(trie_trust_struct, e) -#ifndef GLOBAL_TRIE + PBOp(trie_trust_appl, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); int func_arity = ArityOfFunctor(func); pop_trie_node(); - stack_trie_struct_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_struct)"); -#endif /* GLOBAL_TRIE */ + aux_stack_appl_instr(); ENDPBOp(); - PBOp(trie_try_struct, e) -#ifndef GLOBAL_TRIE + PBOp(trie_try_appl, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); int func_arity = ArityOfFunctor(func); store_trie_node(TrNode_next(node)); - stack_trie_struct_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_struct)"); -#endif /* GLOBAL_TRIE */ + aux_stack_appl_instr(); ENDPBOp(); - PBOp(trie_retry_struct, e) -#ifndef GLOBAL_TRIE + PBOp(trie_retry_appl, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); int func_arity = ArityOfFunctor(func); restore_trie_node(TrNode_next(node)); - stack_trie_struct_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_struct)"); -#endif /* GLOBAL_TRIE */ + aux_stack_appl_instr(); ENDPBOp(); - PBOp(trie_do_struct_in_new_pair, e) -#if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) + PBOp(trie_do_appl_in_pair, e) +#ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); int func_arity = ArityOfFunctor(func); - stack_trie_struct_in_new_pair_instr(); + aux_stack_appl_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_struct_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_do_appl_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); - PBOp(trie_trust_struct_in_new_pair, e) -#if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) + PBOp(trie_trust_appl_in_pair, e) +#ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); int func_arity = ArityOfFunctor(func); pop_trie_node(); - stack_trie_struct_in_new_pair_instr(); + aux_stack_appl_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_struct_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_trust_appl_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); - PBOp(trie_try_struct_in_new_pair, e) -#if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) + PBOp(trie_try_appl_in_pair, e) +#ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); int func_arity = ArityOfFunctor(func); store_trie_node(TrNode_next(node)); - stack_trie_struct_in_new_pair_instr(); + aux_stack_appl_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_struct_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_try_appl_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); - PBOp(trie_retry_struct_in_new_pair, e) -#if defined(TRIE_COMPACT_PAIRS) && !defined(GLOBAL_TRIE) + PBOp(trie_retry_appl_in_pair, e) +#ifdef TRIE_COMPACT_PAIRS register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; Functor func = (Functor) RepAppl(TrNode_entry(node)); int func_arity = ArityOfFunctor(func); restore_trie_node(TrNode_next(node)); - stack_trie_struct_in_new_pair_instr(); + aux_stack_appl_in_pair_instr(); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_struct_in_new_pair)"); -#endif /* TRIE_COMPACT_PAIRS && GLOBAL_TRIE */ + Yap_Error(INTERNAL_ERROR, TermNil, "trie_retry_appl_in_pair: invalid instruction"); +#endif /* TRIE_COMPACT_PAIRS && ! GLOBAL_TRIE */ ENDPBOp(); PBOp(trie_do_extension, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; - stack_trie_extension_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_extension)"); -#endif /* GLOBAL_TRIE */ + aux_stack_extension_instr(); ENDPBOp(); PBOp(trie_trust_extension, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; pop_trie_node(); - stack_trie_extension_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_extension)"); -#endif /* GLOBAL_TRIE */ + aux_stack_extension_instr(); ENDPBOp(); PBOp(trie_try_extension, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; store_trie_node(TrNode_next(node)); - stack_trie_extension_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_extension)"); -#endif /* GLOBAL_TRIE */ + aux_stack_extension_instr(); ENDPBOp(); PBOp(trie_retry_extension, e) -#ifndef GLOBAL_TRIE register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = (CELL *) (B + 1); - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; restore_trie_node(TrNode_next(node)); - stack_trie_extension_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_extension)"); -#endif /* GLOBAL_TRIE */ + aux_stack_extension_instr(); ENDPBOp(); - PBOp(trie_do_float, e) -#ifndef GLOBAL_TRIE + PBOp(trie_do_double, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; volatile Float dbl; volatile Term *t_dbl = (Term *)((void *) &dbl); Term t; #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + t_dbl[0] = aux_stack[HEAP_ENTRY(1)]; + t_dbl[1] = aux_stack[HEAP_ENTRY(3)]; /* jump the first extension mark */ heap_arity -= 4; - t_dbl[0] = *++aux_stack_ptr; - ++aux_stack_ptr; /* jump the float/longint extension mark */ - t_dbl[1] = *++aux_stack_ptr; + TOP_STACK = aux_stack = &aux_stack[4]; /* jump until the second extension mark */ #else /* SIZEOF_DOUBLE == SIZEOF_INT_P */ + t_dbl[0] = aux_stack[HEAP_ENTRY(1)]; heap_arity -= 2; - t_dbl[0] = *++aux_stack_ptr; + TOP_STACK = aux_stack = &aux_stack[2]; /* jump until the extension mark */ #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ - ++aux_stack_ptr; /* jump the float/longint extension mark */ + TOP_STACK[HEAP_ARITY_ENTRY] = heap_arity; t = MkFloatTerm(dbl); - stack_trie_float_longint_instr(); -#else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_float)"); -#endif /* GLOBAL_TRIE */ + aux_stack_term_instr(); ENDPBOp(); - BOp(trie_trust_float, e) - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_float)"); + BOp(trie_trust_double, e) + Yap_Error(INTERNAL_ERROR, TermNil, "trie_trust_double: invalid instruction"); ENDBOp(); - BOp(trie_try_float, e) - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_float)"); + BOp(trie_try_double, e) + Yap_Error(INTERNAL_ERROR, TermNil, "trie_try_double: invalid instruction"); ENDBOp(); - BOp(trie_retry_float, e) - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_float)"); + BOp(trie_retry_double, e) + Yap_Error(INTERNAL_ERROR, TermNil, "trie_retry_double: invalid instruction"); ENDBOp(); - PBOp(trie_do_long, e) -#ifndef GLOBAL_TRIE + PBOp(trie_do_longint, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_stack_ptr = YENV; - int heap_arity = *aux_stack_ptr; - int vars_arity = *(aux_stack_ptr + heap_arity + 1); - int subs_arity = *(aux_stack_ptr + heap_arity + 2); - Term t; + register CELL *aux_stack = TOP_STACK; + int heap_arity = aux_stack[HEAP_ARITY_ENTRY]; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + Term t = MkLongIntTerm(aux_stack[HEAP_ENTRY(1)]); heap_arity -= 2; - t = MkLongIntTerm(*++aux_stack_ptr); - ++aux_stack_ptr; /* jump the float/longint extension mark */ - stack_trie_float_longint_instr(); + TOP_STACK = aux_stack = &aux_stack[2]; /* jump until the extension mark */ + TOP_STACK[HEAP_ARITY_ENTRY] = heap_arity; + aux_stack_term_instr(); + ENDPBOp(); + + + BOp(trie_trust_longint, e) + Yap_Error(INTERNAL_ERROR, TermNil, "trie_trust_longint: invalid instruction"); + ENDBOp(); + + + BOp(trie_try_longint, e) + Yap_Error(INTERNAL_ERROR, TermNil, "trie_try_longint: invalid instruction"); + ENDBOp(); + + + BOp(trie_retry_longint, e) + Yap_Error(INTERNAL_ERROR, TermNil, "trie_retry_longint: invalid instruction"); + ENDBOp(); + + + PBOp(trie_do_gterm, e) +#ifdef GLOBAL_TRIE + register ans_node_ptr node = (ans_node_ptr) PREG; + register CELL *aux_stack = TOP_STACK; + int heap_arity = 0; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + + TOP_STACK = exec_substitution((gt_node_ptr)TrNode_entry(node), aux_stack); + next_instruction(subs_arity - 1 , node); #else - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_long)"); + Yap_Error(INTERNAL_ERROR, TermNil, "trie_do_gterm: invalid instruction"); #endif /* GLOBAL_TRIE */ ENDPBOp(); - BOp(trie_trust_long, e) - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_long)"); - ENDBOp(); + PBOp(trie_trust_gterm, e) +#ifdef GLOBAL_TRIE + register ans_node_ptr node = (ans_node_ptr) PREG; + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = 0; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + + pop_trie_node(); + TOP_STACK = exec_substitution((gt_node_ptr)TrNode_entry(node), aux_stack); + next_instruction(subs_arity - 1 , node); +#else + Yap_Error(INTERNAL_ERROR, TermNil, "trie_trust_gterm: invalid instruction"); +#endif /* GLOBAL_TRIE */ + ENDPBOp(); - BOp(trie_try_long, e) - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_long)"); - ENDBOp(); + PBOp(trie_try_gterm, e) +#ifdef GLOBAL_TRIE + register ans_node_ptr node = (ans_node_ptr) PREG; + register CELL *aux_stack = TOP_STACK; + int heap_arity = 0; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + + store_trie_node(TrNode_next(node)); + TOP_STACK = exec_substitution((gt_node_ptr)TrNode_entry(node), aux_stack); + next_instruction(subs_arity - 1, node); +#else + Yap_Error(INTERNAL_ERROR, TermNil, "trie_try_gterm: invalid instruction"); +#endif /* GLOBAL_TRIE */ + ENDPBOp(); - BOp(trie_retry_long, e) - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_long)"); - ENDBOp(); + PBOp(trie_retry_gterm, e) +#ifdef GLOBAL_TRIE + register ans_node_ptr node = (ans_node_ptr) PREG; + register CELL *aux_stack = (CELL *) (B + 1); + int heap_arity = 0; + int vars_arity = aux_stack[VARS_ARITY_ENTRY]; + int subs_arity = aux_stack[SUBS_ARITY_ENTRY]; + + restore_trie_node(TrNode_next(node)); + TOP_STACK = exec_substitution((gt_node_ptr)TrNode_entry(node), aux_stack); + next_instruction(subs_arity - 1, node); +#else + Yap_Error(INTERNAL_ERROR, TermNil, "trie_retry_gterm: invalid instruction"); +#endif /* GLOBAL_TRIE */ + ENDPBOp(); From 78b3213d5ae9af4d308207a3cd1204e38bfd2788 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Thu, 15 Apr 2010 11:37:15 +0100 Subject: [PATCH 3/4] add debugging info to system_malloc --- C/alloc.c | 60 ++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 37 insertions(+), 23 deletions(-) diff --git a/C/alloc.c b/C/alloc.c index 2ec954ca3..f425c7419 100644 --- a/C/alloc.c +++ b/C/alloc.c @@ -122,16 +122,11 @@ static char * my_realloc(char *ptr, UInt sz, UInt osz, int safe) long long unsigned int mallocs, reallocs, frees; long long unsigned int tmalloc; -#if INSTRUMENT_MALLOC -static void -minfo(char mtype) -{ - struct mallinfo minfo = mallinfo(); - - fprintf(stderr,"%c %lld (%lld), %lld, %lld %d/%d/%d\n", mtype, mallocs, tmalloc, reallocs, frees,minfo.arena,minfo.ordblks,minfo.fordblks); -} +#if DEBUG +#define INSTRUMENT_MALLOC 1 #endif + static inline char * call_malloc(unsigned long int size) { @@ -140,13 +135,16 @@ call_malloc(unsigned long int size) LOCK(DLMallocLock); #endif #if INSTRUMENT_MALLOC - if (mallocs % 1024*4 == 0) - minfo('A'); mallocs++; tmalloc += size; + size += sizeof(CELL); #endif Yap_PrologMode |= MallocMode; out = (char *) my_malloc(size); +#if INSTRUMENT_MALLOC + *(CELL*)out = size-sizeof(CELL); + out += sizeof(CELL); +#endif Yap_PrologMode &= ~MallocMode; #if USE_DL_MALLOC UNLOCK(DLMallocLock); @@ -168,13 +166,18 @@ call_realloc(char *p, unsigned long int size) LOCK(DLMallocLock); #endif #if INSTRUMENT_MALLOC - if (mallocs % 1024*4 == 0) - minfo('A'); - mallocs++; + reallocs++; tmalloc += size; + size += sizeof(CELL); + p -= sizeof(CELL); + tmalloc -= *(CELL*)p; #endif Yap_PrologMode |= MallocMode; out = (char *) my_realloc0(p, size); +#if INSTRUMENT_MALLOC + *(CELL*)out = size-sizeof(CELL); + out += sizeof(CELL); +#endif Yap_PrologMode &= ~MallocMode; #if USE_DL_MALLOC UNLOCK(DLMallocLock); @@ -195,10 +198,9 @@ Yap_FreeCodeSpace(char *p) LOCK(DLMallocLock); #endif Yap_PrologMode |= MallocMode; - #if INSTRUMENT_MALLOC - if (frees % 1024*4 == 0) - minfo('F'); + p -= sizeof(CELL); + tmalloc -= *(CELL*)p; frees++; #endif my_free (p); @@ -222,8 +224,8 @@ Yap_FreeAtomSpace(char *p) #endif Yap_PrologMode |= MallocMode; #if INSTRUMENT_MALLOC - if (frees % 1024*4 == 0) - minfo('F'); + p -= sizeof(CELL); + tmalloc -= *(CELL*)p; frees++; #endif my_free (p); @@ -247,6 +249,11 @@ Yap_InitPreAllocCodeSpace(void) LOCK(DLMallocLock); #endif Yap_PrologMode |= MallocMode; +#if INSTRUMENT_MALLOC + mallocs++; + tmalloc += sz; + sz += sizeof(CELL); +#endif while (!(ptr = my_malloc(sz))) { Yap_PrologMode &= ~MallocMode; #if USE_DL_MALLOC @@ -256,6 +263,12 @@ Yap_InitPreAllocCodeSpace(void) Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); return(NULL); } +#if INSTRUMENT_MALLOC + fprintf(stderr,"vsc ptr=%p\n",ptr); + sz -= sizeof(CELL); + *(CELL*)ptr = sz; + ptr += sizeof(CELL); +#endif #if USE_DL_MALLOC LOCK(DLMallocLock); #endif @@ -289,13 +302,14 @@ Yap_ExpandPreAllocCodeSpace(UInt sz0, void *cip, int safe) #if USE_DL_MALLOC LOCK(DLMallocLock); -#endif -#if INSTRUMENT_MALLOC - if (reallocs % 1024*4 == 0) - minfo('R'); - reallocs++; #endif Yap_PrologMode |= MallocMode; +#if INSTRUMENT_MALLOC + reallocs++; + tmalloc -= ScratchPad.sz; + tmalloc += sz; + fprintf(stderr,"vsc ptr=%p\n",ScratchPad.ptr); +#endif if (!(ptr = my_realloc(ScratchPad.ptr, sz, ScratchPad.sz, safe))) { Yap_PrologMode &= ~MallocMode; #if USE_DL_MALLOC From b737ce447f4c3107f78fbad7ea8580ac1ceb04c7 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Thu, 15 Apr 2010 11:37:39 +0100 Subject: [PATCH 4/4] improve allocation through malloc: avoid allocating labels in the stack. --- C/amasm.c | 29 +++++++++++++++++++++++++++-- C/compiler.c | 2 +- C/index.c | 6 +++--- H/compile.h | 2 +- 4 files changed, 32 insertions(+), 7 deletions(-) diff --git a/C/amasm.c b/C/amasm.c index 43980eb21..5219856f1 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -3516,14 +3516,16 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip); } if (!pass_no) { +#if !USE_SYSTEM_MALLOC if (CellPtr(cip->label_offset+cip->cpc->rnd1) > ASP-256) { Yap_Error_Size = 256+((char *)(cip->label_offset+cip->cpc->rnd1) - (char *)H); save_machine_regs(); longjmp(cip->CompilerBotch, 3); } - if ( (char *)(cip->label_offset+cip->cpc->rnd1) >= cip->freep) cip->freep = (char *)(cip->label_offset+(cip->cpc->rnd1+1)); +#endif + cip->label_offset[cip->cpc->rnd1] = (CELL) code_p; } /* reset dealloc_found in case there was a branch */ @@ -3819,7 +3821,7 @@ init_dbterms_list(yamop *code_p, PredEntry *ap) yamop * -Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates *cip) +Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates *cip, UInt max_label) { /* * the assembly proccess is done in two passes: 1 - a first pass @@ -3832,7 +3834,15 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates int clause_has_blobs = FALSE; int clause_has_dbterm = FALSE; +#if USE_SYSTEM_MALLOC + cip->label_offset = (Int *)Yap_AllocCodeSpace(sizeof(Int)*max_label); + if (!cip->label_offset) { + save_machine_regs(); + longjmp(cip->CompilerBotch, OUT_OF_HEAP_BOTCH); + } +#else cip->label_offset = (Int *)cip->freep; +#endif cip->code_addr = NULL; code_p = do_pass(0, &entry_code, mode, &clause_has_blobs, &clause_has_dbterm, cip, size); if (clause_has_dbterm) { @@ -3852,6 +3862,9 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates UInt osize; if(!(x = fetch_clause_space(&t,size,cip,&osize))){ +#if USE_SYSTEM_MALLOC + Yap_FreeCodeSpace((ADDR)cip->label_offset); +#endif return NULL; } cl = (LogUpdClause *)((CODEADDR)x-(UInt)size); @@ -3866,6 +3879,9 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates StaticClause *cl; UInt osize; if(!(x = fetch_clause_space(&t,size,cip,&osize))) { +#if USE_SYSTEM_MALLOC + Yap_FreeCodeSpace((ADDR)cip->label_offset); +#endif return NULL; } cl = (StaticClause *)((CODEADDR)x-(UInt)size); @@ -3875,6 +3891,9 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates cl->usc.ClSource = x; cl->ClSize = osize; ProfEnd=code_p; +#if USE_SYSTEM_MALLOC + Yap_FreeCodeSpace((ADDR)cip->label_offset); +#endif return entry_code; } else { while ((cip->code_addr = (yamop *) Yap_AllocCodeSpace(size)) == NULL) { @@ -3882,6 +3901,9 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates if (!Yap_growheap(TRUE, size, cip)) { Yap_Error_TYPE = OUT_OF_HEAP_ERROR; Yap_Error_Size = size; +#if USE_SYSTEM_MALLOC + Yap_FreeCodeSpace((ADDR)cip->label_offset); +#endif return NULL; } } @@ -3905,6 +3927,9 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates Yap_inform_profiler_of_clause(entry_code, ProfEnd, ap, mode == ASSEMBLING_INDEX); } #endif /* LOW_PROF */ +#if USE_SYSTEM_MALLOC + Yap_FreeCodeSpace((ADDR)cip->label_offset); +#endif return entry_code; } diff --git a/C/compiler.c b/C/compiler.c index 9d6999ba9..3b97148a8 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -3560,7 +3560,7 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, Term mod, volatile Term src) #endif /* phase 3: assemble code */ - acode = Yap_assemble(ASSEMBLING_CLAUSE, src, cglobs.cint.CurrentPred, (cglobs.is_a_fact && !cglobs.hasdbrefs && !(cglobs.cint.CurrentPred->PredFlags & TabledPredFlag)), &cglobs.cint); + acode = Yap_assemble(ASSEMBLING_CLAUSE, src, cglobs.cint.CurrentPred, (cglobs.is_a_fact && !cglobs.hasdbrefs && !(cglobs.cint.CurrentPred->PredFlags & TabledPredFlag)), &cglobs.cint, cglobs.labelno+1); /* check first if there was space for us */ Yap_ReleaseCMem (&cglobs.cint); if (acode == NULL) { diff --git a/C/index.c b/C/index.c index ab2861f9b..a1330fc94 100644 --- a/C/index.c +++ b/C/index.c @@ -553,7 +553,6 @@ recover_from_failed_susp_on_cls(struct intermediates *cint, UInt sz) OPCODE ecls = Yap_opcode(_expand_clauses); UInt log_upd_pred = cint->CurrentPred->PredFlags & LogUpdatePredFlag; - Yap_ReleaseCMem(cint); while (cpc) { switch(cpc->op) { case enter_lu_op: @@ -635,6 +634,7 @@ recover_from_failed_susp_on_cls(struct intermediates *cint, UInt sz) } cpc = cpc->nextInst; } + Yap_ReleaseCMem(cint); if (cint->code_addr) { Yap_FreeCodeSpace((char *)cint->code_addr); cint->code_addr = NULL; @@ -3420,7 +3420,7 @@ Yap_PredIsIndexable(PredEntry *ap, UInt NSlots, yamop *next_pc) /* globals for assembler */ IPredArity = ap->ArityOfPE; if (cint.CodeStart) { - if ((indx_out = Yap_assemble(ASSEMBLING_INDEX, TermNil, ap, FALSE, &cint)) == NULL) { + if ((indx_out = Yap_assemble(ASSEMBLING_INDEX, TermNil, ap, FALSE, &cint, cint.i_labelno+1)) == NULL) { if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) { Yap_ReleaseCMem(&cint); Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); @@ -4612,7 +4612,7 @@ ExpandIndex(PredEntry *ap, int ExtraArgs, yamop *nextop) { /* globals for assembler */ IPredArity = ap->ArityOfPE; if (cint.CodeStart) { - if ((indx_out = Yap_assemble(ASSEMBLING_EINDEX, TermNil, ap, FALSE, &cint)) == NULL) { + if ((indx_out = Yap_assemble(ASSEMBLING_EINDEX, TermNil, ap, FALSE, &cint, cint.i_labelno+1)) == NULL) { if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) { Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage); Yap_ReleaseCMem(&cint); diff --git a/H/compile.h b/H/compile.h index efc1d5312..0c16089c8 100644 --- a/H/compile.h +++ b/H/compile.h @@ -318,7 +318,7 @@ typedef enum special_label_op_enum { #define Two 2 -yamop *STD_PROTO(Yap_assemble,(int,Term,struct pred_entry *,int, struct intermediates *)); +yamop *STD_PROTO(Yap_assemble,(int,Term,struct pred_entry *,int, struct intermediates *, UInt)); void STD_PROTO(Yap_emit,(compiler_vm_op,Int,CELL, struct intermediates *)); void STD_PROTO(Yap_emit_3ops,(compiler_vm_op,CELL,CELL,CELL, struct intermediates *)); void STD_PROTO(Yap_emit_4ops,(compiler_vm_op,CELL,CELL,CELL,CELL, struct intermediates *));