/************************************************************************ * * * The SB-Prolog System * * Copyright SUNY at Stony Brook, 1986 * * * ************************************************************************/ /*----------------------------------------------------------------- SB-Prolog is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY. No author or distributor accepts responsibility to anyone for the consequences of using it or for whether it serves any particular purpose or works at all, unless he says so in writing. Refer to the SB-Prolog General Public License for full details. Everyone is granted permission to copy, modify and redistribute SB-Prolog, but only under the conditions described in the SB-Prolog General Public License. A copy of this license is supposed to have been given to you along with SB-Prolog so you can know your rights and responsibilities. It should be in a file named COPYING. Among other things, the copyright notice and this notice must be preserved on all copies. ------------------------------------------------------------------ */ /* These are the basic routines that support assert and retract in our system. The system supports a concept of a Prref, a predicate reference. A Prref is a database reference to a sequence of asserted clauses. Normally a Prref is associated with a psc-entry (in the e.p. field), the psc entry of the main functor symbol of all the clauses. But that need not be the case. A Prref can be created, asserted to, and called explicitly. The system also supports a concept of Clref, a clause reference. These are quite similar to the db references in CProlog. A Clref is a reference to a single clause. A Clref can also be called. Normally a Clref is chained into a Prref. */ $db_export([$db_new_prref/1,$db_assert_fact/5,$db_assert_fact/6, $db_assert_fact/7, $db_assert_fact/8, $db_add_clref/6, $db_call_prref/2,$db_call_prref_s/2,$db_call_prref_s/3, $db_call_clref/2,$db_get_clauses/3,$db_kill_clause/1]). $db_use($dbcmpl,[$db_cmpl/5,$db_cmpl/6,$db_putbuffop/4,$db_putbuffbyte/4, $db_putbuffnum/4]). $db_use($buff, [$alloc_perm/2,$alloc_heap/2,$trimbuff/3,$buff_code/4,$symtype/2, $substring/6,$subnumber/6,$subdelim/6,$conlength/2, $pred_undefined/1, $hashval/3]). $db_use($bmeta,[$atom/1,$atomic/1,$integer/1,$number/1,$structure/1, $functor0/2,$bldstr/3,$arg/3,$arity/2,$real/1,$floor/2]). $db_use($bio,[$writename/1,$writeqname/1,$put/1,$nl/0,$tab/1, $tell/1,$tell/2,$telling/1,$told/0,$get/1,$get0/1,$see/1,$seeing/1, $seen/0]). /* $db_new_prref(Prref): creates an empty Prref, i.e. one with no clauses in it. If called, it will simply fail. Prref must be a variable at the time of call. */ $db_new_prref(Prref) :- $db_new_prref(Prref,0,0). $db_new_prref(Prref,Where,Supbuff) :- $alloc_buff(16,Prref,Where,Supbuff,0), /* disp 12 for pointer to last clause */ $buff_code(Prref,0,14 /*ptv*/ ,Prref), /*set back pointer*/ $buff_code(Prref,4,3 /*pb*/ ,248 /* fail*/ ), $buff_code(Prref,5,3 /*pb*/ ,0), $buff_code(Prref,10,3 /*pb*/ ,248 /* fail*/ ), $buff_code(Prref,11,3 /*pb*/ ,0). /* $db_assert_fact(Fact,Prref,AZ,Index,Clref): where Fact is a fact to be asserted; Prref is a predicate reference to which to add the asserted fact; AZ is either 0 indicating the fact should be inserted as the first clause in Prref, or 1 indicating it should be inserted as the last; Index is 0 if no index is to be built, or n if an index on the nth argument of the fact is to be used; Clref is returned and it is the clause reference of the asserted fact. */ $db_assert_fact(Fact,Prref,AZ,Index,Clref) :- $db_assert_fact(Fact,Prref,AZ,Index,Clref,1,0,0). $db_assert_fact(Fact,Prref,AZ,Index,Clref,Where,Supbuff) :- $db_assert_fact(Fact,Prref,AZ,Index,Clref,1,Where,Supbuff). $db_assert_fact(Fact,Prref,AZ,Index,Clref,Flatten) :- $db_assert_fact(Fact,Prref,AZ,Index,Clref,Flatten,0,0). $db_assert_fact(Clause,Prref,AZ,Index,Clref,Flatten,Where,Supbuff) :- $db_cmpl(Clause,Clref,Index,Where,Supbuff,Flatten), (var(Prref) -> $db_new_prref(Prref,Where,Supbuff) ; true), (Clause = (Head:-_) -> $arity(Head,Arity); (Clause=Head,$arity(Head,Ar1),Arity is Ar1+1) ), $db_add_clref(Head,Arity,Prref,AZ,Index,Clref,Where,Supbuff). /* $db_add_clref(Fact,Arity,Prref,AZ,Index,Clref) adds a clause buffer to a prref. So Prref and Clref must be bound. Arity is the number of registers to save in a choice point (if Fact is a fact, it is Arity(Fact)+1, for cut) The other parameters are as above. */ $db_add_clref(Fact,Arity,Prref,AZ,Index,Clref) :- $db_add_clref(Fact,Arity,Prref,AZ,Index,Clref,0,0). $db_add_clref(Fact,Arity,Prref,AZ,Index,Clref,Where,Supbuff) :- Index =< 0 -> (AZ =:= 0 -> $db_addbuffa(Arity,Clref,Prref); $db_addbuffz(Arity,Clref,Prref)); (AZ =:= 0 -> $writename('Indexed add to beginning not supported'),$nl,fail ; $arg(Index, Fact, Arg), (var(Arg) -> $db_addbuffz(Arity,Clref,Prref) ; $db_addbuffz_i(Arity,Clref,Prref,Index,Arg,Where,Supbuff) ) ). /* Add Clref to empty Prref */ $db_addbuffonly(Arity,Clref,Prref) :- $buff_code(Prref,4,3 /*pb*/ ,170 /*jump and save breg */ ), $buff_code(Prref,5,3 /*pb*/ ,Arity), $buff_code(Prref,6,10 /*pbr*/ ,Clref), $buff_code(Prref,12,10 /*pbr*/ ,Clref), /* ptr to last clause */ $buff_code(Clref,4,3 /*pb*/ ,249 /*noop*/ ), $buff_code(Clref,5,3 /*pb*/ ,2). /* add Clref to end of Prref */ $db_addbuffz(Arity,Clref,Prref) :- /* Prref must be dummy header */ $buff_code(Prref,4,6 /*gb*/ ,Op), (Op =:= 248, /*fail*/ $db_addbuffonly(Arity,Clref,Prref) ; Op =\= 248, (Op =:= 170, /* must be a jump-and-save-breg to next clause */ $buff_code(Prref,12,8 /*gpb*/ ,Lbuff), /* last buff */ $buff_code(Lbuff,4,6 /*gb*/ ,Sop), (Sop =:= 249, /* noop, change to try */ $buff_code(Lbuff,4,3 /*pb*/ ,160 /*trymeelse*/) ; Sop =\= 249, Sop =:= 162, /* must be a trustmeelsefail */ $buff_code(Lbuff,4,3 /*pb*/ ,161 /*retrymeelse*/) ), $buff_code(Lbuff,5,3 /*pb*/ ,Arity), $buff_code(Lbuff,6,10 /*pbr*/ ,Clref), $buff_code(Clref,4,3 /*pb*/ ,162 /*trustmeelsefail*/ ), $buff_code(Clref,5,3 /*pb*/ ,Arity), $buff_code(Clref,6,3 /*pb*/ ,249 /*noop*/ ), $buff_code(Clref,7,3 /*pb*/ ,1), $buff_code(Prref,12,10 /*pbr*/ ,Clref) /* point to new last */ ) ). /* add a buffer to the beginning of the chain */ $db_addbuffa(Arity,Clref,Prref) :- $buff_code(Prref,4,6 /*gb*/ ,Op), (Op =:= 248, /* fail */ /* only dummy clause there */ $db_addbuffonly(Arity,Clref,Prref) ; Op =\= 248, (Op =:= 170, /* must be a jump-and-save-breg, otw fail */ $buff_code(Prref,6,8 /*gpb*/ ,Sbuff), /* next buff */ $buff_code(Sbuff,4,6 /*gb*/ ,Sop), (Sop =:= 249, /* noop, change to trust */ $buff_code(Sbuff,4,3 /*pb*/ ,162), $buff_code(Sbuff,5,3 /*pb*/ ,Arity), $buff_code(Sbuff,6,3 /*pb*/ ,249 /*noop*/ ), $buff_code(Sbuff,7,3 /*pb*/ ,1) ; Sop =\= 249, /* not noop */ Sop =:= 160, /* must be try, else fail */ $buff_code(Sbuff,4,3 /*pb*/ ,161) /* make retry */ ), $buff_code(Prref,6,10 /*pbr*/ , Clref), /* point first to new */ $buff_code(Clref,4,3 /*pb*/ ,160 /*trymeelse*/), $buff_code(Clref,5,3 /*pb*/ ,Arity), $buff_code(Clref,6,10 /*pbr*/ , Sbuff) /* point new to old 2nd*/ ) ). /* adds a buffer to an index chain */ $db_addbuffz_i(Arity,Clref,Prref,Index,Arg,_,_) :- $buff_code(Prref,4,6 /*gb*/ ,Op),Op =\= 248, /* fail if no clrefs */ $buff_code(Prref, 12,8 /*gpb*/ ,Lbuff), /* last buff */ $buff_code(Lbuff,10,6 /*gb*/ ,249), /* noop if SOB */ $buff_code(Lbuff,16,6 /*gb*/ ,179), /* op code must be sob */ $buff_code(Lbuff,17,6,Index), /* must be same arg */ !, $buff_code(Lbuff,22,5 /*gn*/, N), /* tabsize */ $db_proc_all_chain(Arity,Lbuff,Clref), $db_proc_hash_chain(Arg,Arity,Lbuff,Clref,N). $db_addbuffz_i(Arity,Clref,Prref,Index,Arg,Where,Supbuff) :- /* must add new sop buffer */ $db_create_sob(Sbuff,N,Where,Supbuff), /* get sob buffer */ $db_gen_sobcode(Index, Sbuff, Clref, N), $db_proc_hash_chain(Arg, Arity, Sbuff, Clref, N), $db_addbuffz(Arity,Sbuff,Prref). $db_create_sob(Sbuff,N,Where,Supbuff) :- '_$tab_size'(N), Size is 10 + 6 + 10 + 6 + 4 * N + 4, $alloc_buff(Size,Sbuff,Where,Supbuff,0), $buff_code(Sbuff, 0, 14 /*ptv*/, Sbuff). /* backptr */ $db_gen_sobcode(Narg, Sbuff, Clref, N) :- $buff_code(Sbuff, 10, 3, 249 /*noop*/), $buff_code(Sbuff, 11, 3, 2), $buff_code(Sbuff, 12, 10 /*pbr*/ ,Clref), $buff_code(Sbuff, 16, 3, 179 /*switchonbound*/), $buff_code(Sbuff, 17, 3, Narg), $buff_code(Sbuff, 32, 4, AddrTab), /* get addr of tab */ $buff_code(Sbuff, 18, 2, AddrTab), /* store addr of tab */ $buff_code(Sbuff, 22, 2, N /* size of hashtab */), $buff_code(Sbuff, 26, 3, 240 /* jump */), $buff_code(Sbuff, 27, 3, 0), $buff_code(Sbuff, 28, 10, Clref), $buff_code(Clref, 4, 3 /*pb*/, 249 /*noop*/), $buff_code(Clref, 5, 3 /*pb*/, 2), $db_init_tab(Sbuff, N). $db_init_tab(Clref, N) :- Disp is 32 + 4 * N, $buff_code(Clref, Disp, 3, 248 /*fail*/), Disp1 is Disp + 1, $buff_code(Clref, Disp1, 3, 0), $buff_code(Clref, Disp, 4, FailAddr), $db_init_hashtab(0, 32, N, Clref, FailAddr). $db_init_hashtab(N, Lin, Size, Clref, FailAddr) :- N >= Size; N < Size, $buff_code(Clref, Lin, 2 /* word num */, FailAddr), Lout is Lin + 4, N1 is N + 1, $db_init_hashtab(N1, Lout, Size, Clref, FailAddr). $db_proc_all_chain(Arity, Sbuff, Clref) :- $buff_code(Sbuff, 12, 8, Lbuff), /* last buff on all chain */ $buff_code(Lbuff,4,6 /*gb*/ ,Sop), (Sop =:= 249, /* noop, change to try */ $buff_code(Lbuff,4,3 /*pb*/ ,160 /*trymeelse*/) ; Sop =\= 249, Sop =:= 162, /* must be a trustmeelsefail */ $buff_code(Lbuff,4,3 /*pb*/ ,161 /*retrymeelse*/) ), $buff_code(Lbuff,5,3 /*pb*/ ,Arity), $buff_code(Lbuff,6,10 /*pbr*/ ,Clref), $buff_code(Clref,4,3 /*pb*/ ,162 /*trustmeelsefail*/ ), $buff_code(Clref,5,3 /*pb*/ ,Arity), $buff_code(Clref,6,3 /*pb*/ ,249 /*noop*/ ), $buff_code(Clref,7,3 /*pb*/ ,1), $buff_code(Sbuff,12,10 /*pbr*/ ,Clref). /* point to new last */ $db_proc_hash_chain(Arg, Arity, Tbuff, Buff, N) :- nonvar(Arg), $hashval(Arg, N, Hashval), Bucket is 32 + 4 * Hashval, $buff_code(Tbuff, Bucket, 5, Addr), Faild is 32 + 4 * N, $buff_code(Tbuff, Faild, 4, Faddr), ((Addr = Faddr, $db_link_first(Bucket, Tbuff, Buff), !); ($db_get_hash_next(Bucket, Tbuff, NextBuff, Disp, B), $db_link_all(Arity, NextBuff, Disp, Buff, B)) ). $db_link_first(Bucket, Tbuff, Buff) :- $db_get_addr(Buff, _, Hash_addr), $buff_code(Tbuff, Bucket, 2, Hash_addr). $db_get_addr(Buff, Disp, Hash_addr) :- $conlength(Buff, Len), Disp is Len - 12, $buff_code(Buff, Disp, 4, Hash_addr). $db_get_hash_next(Bucket, Tbuff, NextBuff, Disp, B) :- /* get buffer pointed to by the bucket */ $buff_code(Tbuff, Bucket, 21 /* gnb */, NextBuff), $conlength(NextBuff, Len), Disp is Len - 12, $buff_code(NextBuff, Disp, 6, B). $db_link_all(Arity, NextBuff, Disp, Buff, B) :- ((B =:= 249, /* noop */ $db_putbuffop(160 /* trymeelse */, NextBuff, Disp, L1), $db_putbuffbyte(Arity, NextBuff, L1, L2), $db_get_addr(Buff, BuffDisp, Hash_addr), $db_putbuffnum(Hash_addr, NextBuff, L2, _), $db_set_index_trust(Arity, Buff, BuffDisp)); (B =\= 249, B =:= 160, /* trymeelse */ Loc is Disp + 2, $db_get_hash_next(Loc, NextBuff, Clref, NewDisp, NewB), $db_link_rest(Arity, Clref, NewDisp, Buff, NewB)) ). $db_link_rest(Arity, NextBuff, Disp, Buff, B) :- ((B =:= 161, /* retrymeelse */ Loc is Disp + 2, $db_get_hash_next(Loc, NextBuff, Clref, NewDisp, NewB), $db_link_rest(Arity, Clref, NewDisp, Buff, NewB)); (B =\= 161, B =:= 162, /* trustmeelsefail */ $db_get_addr(Buff, BDisp, Hash_addr), $db_set_index_retry(Arity, NextBuff, Disp, Hash_addr), $db_set_index_trust(Arity, Buff, BDisp)) ). $db_set_index_trust(Arity, Buff, Disp) :- $db_putbuffop(162, Buff, Disp, L1), $db_putbuffbyte(Arity, Buff, L1, L2), $db_putbuffop(249, Buff, L2, L3), $db_putbuffbyte(1, Buff, L3, _). $db_set_index_retry(Arity, Buff, Disp, Addr) :- $db_putbuffop(161, Buff, Disp, L1), $db_putbuffbyte(Arity, Buff, L1, L2), $db_putbuffnum(Addr, Buff, L2, _). /* $db_call_prref(Call,Prref): where Call is a literal and Prref is a predicate reference. This calls the Prref using Call as the call. The call is done by simply branching to the first clause. Thus the trust optimization is used, and so new facts added to the Prref after the last fact is retrieved but before the call is failed through will NOT be used. */ $db_call_prref(Call,Prref) :- $buff_code(Prref,4,13 /*execb*/ ,Call). /* $db_call_prref_s(Call,Prref): with the same arguments as the previous and also calling the clauses. The difference from $db_call_prref is that it does not use the trust optimization so that any new fact addd before final failure will be used. */ $db_call_prref_s(Goal,Prref) :- $db_call_prref_s(Goal,Prref,_). /* same as above, but also returns cl_ref of successful clause */ $db_call_prref_s(Goal,Prref,Cur_clref) :- $db_get_first_clref(Prref,Clref),$db_get_clrefs(Clref,Cur_clref,0), $db_call_clref(Goal,Cur_clref). /* $db_call_clref(Call,Clref): will call the clause referenced by Clref using the literal Call as the call. */ $db_call_clref(Call,Clref) :- $buff_code(Clref,10,13 /*execb*/ ,Call). /* $db_get_clauses(Prref,Clref,Dir): This returns nondeterministically all the clause references for clauses asserted to Prref. If Dir is 0, then the first on the list is returned first; if Dir is 1, then they are returned in reverse order. */ $db_get_clauses(Prref,Clref,Dir) :- $db_get_first_clref(Prref,Fclref), $db_get_clrefs(Fclref,Clref,Dir). /* given a pr_ref, get the cl_ref for the first clause. */ $db_get_first_clref(Prref,Clref) :- $buff_code(Prref,4,6 /*gb*/ ,170), /* must be jump-and-save-breg */ $buff_code(Prref,6,8 /*gpb*/ ,Clref). /* return, through backtracking, the sequence of cl_refs chained from the given one, returning given one first */ $db_get_clrefs(Clref,N_clref,1) :- $db_get_next_clref(Clref,Nxt_clref), $db_get_clrefs(Nxt_clref,N_clref,1). $db_get_clrefs(Clref,N_clref,Dir) :- $buff_code(Clref,10,6,Nop), /* if sob, is noop */ (Nop =:= 249 -> $buff_code(Clref,16,6 /*gb*/ ,Sop), /* op code must be sob */ (Sop =:= 179 -> /* sob buffer */ $buff_code(Clref,28,8 /*gpb*/ ,Tclref), /* first of all */ $db_get_clrefs(Tclref,N_clref,Dir) /* and recurse */ ; N_clref=Clref /* not a sob buffer */ ) ; N_clref=Clref ). $db_get_clrefs(Clref,N_clref,0) :- $db_get_next_clref(Clref,Nxt_clref), $db_get_clrefs(Nxt_clref,N_clref,0). /* get the next cl_ref following the given one. */ $db_get_next_clref(Clref,Nxt_clref) :- $buff_code(Clref,4,6 /*gb*/ ,B), (B =:= 161, /* retrymeelse, so there is another clause */ $buff_code(Clref,6,8 /*gpb*/ ,Nxt_clref) ; B =\= 161, B =:= 160, /* trymeelse, so ditto */ $buff_code(Clref,6,8 /*gpb*/ ,Nxt_clref) ). /* $db_kill_clause(Clref): retracts the fact referenced by Clref. It does this by simply making the first instruction of the clause a fail instruction. */ $db_kill_clause(Clref) :- $buff_code(Clref,10,3 /*pb*/ ,248 /*fail*/ ). /* ---------------------------------------------------------------------- */