diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

dbload

Browse Source
This commit is contained in:
Vítor Santos Costa 2011-04-30 01:16:40 +01:00
parent 6a3e422c11
commit de0f8a8236
14 changed files with 363 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

231
C/cdmgr.c
View File

@ -5635,6 +5635,233 @@ p_choicepoint_info( USES_REGS1 )
Yap_unify(ARG7,MkIntegerTerm(ClauseId(ncl,pe)));
}
static UInt
compute_dbcl_size(UInt arity)
{
UInt sz;
switch(arity) {
case 2:
sz = (UInt)NEXTOP((yamop *)NULL,cc);
break;
case 3:
sz = (UInt)NEXTOP((yamop *)NULL,ccc);
break;
case 4:
sz = (UInt)NEXTOP((yamop *)NULL,cccc);
break;
case 5:
sz = (UInt)NEXTOP((yamop *)NULL,ccccc);
break;
case 6:
sz = (UInt)NEXTOP((yamop *)NULL,cccccc);
break;
default:
sz = arity*(UInt)NEXTOP((yamop *)NULL,xc);
break;
}
return (UInt)NEXTOP((yamop *)sz,p);
}
#define DerefAndCheck(t, V) \
t = Deref(V); if(IsVarTerm(t) || !(IsAtomOrIntTerm(t))) Yap_Error(TYPE_ERROR_ATOM, t0, "load_db");
static int
store_dbcl_size(yamop *pc, UInt arity, Term t0, PredEntry *pe)
{
Term t;
CELL *tp = RepAppl(t0)+1;
switch(arity) {
case 2:
pc->opc = Yap_opcode(_get_2atoms);
DerefAndCheck(t, tp[0]);
pc->u.cc.c1 = t;
DerefAndCheck(t, tp[1]);
pc->u.cc.c2 = t;
pc = NEXTOP(pc,cc);
break;
case 3:
pc->opc = Yap_opcode(_get_3atoms);
DerefAndCheck(t, tp[0]);
pc->u.ccc.c1 = t;
DerefAndCheck(t, tp[1]);
pc->u.ccc.c2 = t;
DerefAndCheck(t, tp[2]);
pc->u.ccc.c3 = t;
pc = NEXTOP(pc,ccc);
break;
case 4:
pc->opc = Yap_opcode(_get_4atoms);
DerefAndCheck(t, tp[0]);
pc->u.cccc.c1 = t;
DerefAndCheck(t, tp[1]);
pc->u.cccc.c2 = t;
DerefAndCheck(t, tp[2]);
pc->u.cccc.c3 = t;
DerefAndCheck(t, tp[3]);
pc->u.cccc.c4 = t;
pc = NEXTOP(pc,cccc);
break;
case 5:
pc->opc = Yap_opcode(_get_5atoms);
DerefAndCheck(t, tp[0]);
pc->u.ccccc.c1 = t;
DerefAndCheck(t, tp[1]);
pc->u.ccccc.c2 = t;
DerefAndCheck(t, tp[2]);
pc->u.ccccc.c3 = t;
DerefAndCheck(t, tp[3]);
pc->u.ccccc.c4 = t;
DerefAndCheck(t, tp[4]);
pc->u.ccccc.c5 = t;
pc = NEXTOP(pc,ccccc);
break;
case 6:
pc->opc = Yap_opcode(_get_6atoms);
DerefAndCheck(t, tp[0]);
pc->u.cccccc.c1 = t;
DerefAndCheck(t, tp[1]);
pc->u.cccccc.c2 = t;
DerefAndCheck(t, tp[2]);
pc->u.cccccc.c3 = t;
DerefAndCheck(t, tp[3]);
pc->u.cccccc.c4 = t;
DerefAndCheck(t, tp[4]);
pc->u.cccccc.c5 = t;
DerefAndCheck(t, tp[5]);
pc->u.cccccc.c6 = t;
pc = NEXTOP(pc,cccccc);
break;
default:
{
UInt i;
for (i = 0; i< arity; i++) {
pc->opc = Yap_opcode(_get_atom);
#if PRECOMPUTE_REGADDRESS
pc->u.xc.x = (CELL) (XREGS + (i+1));
#else
pc->u.xc.x = i+1;
#endif
DerefAndCheck(t, tp[0]);
pc->u.xc.c = t;
tp++;
pc = NEXTOP(pc,xc);
}
}
break;
}
pc->opc = Yap_opcode(_procceed);
pc->u.p.p = pe;
return TRUE;
}
static Int
p_dbload_get_space( USES_REGS1 )
{ /* '$number_of_clauses'(Predicate,M,N) */
Term t = Deref(ARG1);
Term mod = Deref(ARG2);
Term tn = Deref(ARG3);
UInt arity;
Prop pe;
PredEntry *ap;
UInt sz;
MegaClause *mcl;
yamop *ptr;
UInt ncls;
UInt required;
if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
return(FALSE);
}
if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
arity = 0;
pe = PredPropByAtom(a, mod);
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
arity = ArityOfFunctor(f);
pe = PredPropByFunc(f, mod);
} else {
return FALSE;
}
if (EndOfPAEntr(pe))
return FALSE;
ap = RepPredProp(pe);
if (ap->PredFlags & (DynamicPredFlag|LogUpdatePredFlag
#ifdef TABLING
|TabledPredFlag
#endif /* TABLING */
)) {
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,t,"dbload_get_space/4");
return FALSE;
}
if (IsVarTerm(tn) || !IsIntegerTerm(tn)) {
return FALSE;
}
ncls = IntegerOfTerm(tn);
if (ncls <= 1) {
return FALSE;
}
sz = compute_dbcl_size(arity);
required = sz*ncls+sizeof(MegaClause)+(UInt)NEXTOP((yamop *)NULL,l);
#ifdef DEBUG
total_megaclause += required;
nof_megaclauses++;
#endif
while (!(mcl = (MegaClause *)Yap_AllocCodeSpace(required))) {
if (!Yap_growheap(FALSE, required, NULL)) {
/* just fail, the system will keep on going */
return FALSE;
}
}
Yap_ClauseSpace += required;
/* cool, it's our turn to do the conversion */
mcl->ClFlags = MegaMask;
mcl->ClSize = sz*ncls;
mcl->ClPred = ap;
mcl->ClItemSize = sz;
mcl->ClNext = NULL;
ap->cs.p_code.FirstClause =
ap->cs.p_code.LastClause =
mcl->ClCode;
ap->PredFlags |= MegaClausePredFlag;
ap->cs.p_code.NOfClauses = ncls;
if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred);
} else {
ap->OpcodeOfPred = INDEX_OPCODE;
}
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
ptr = (yamop *)((ADDR)mcl->ClCode+ncls*sz);
ptr->opc = Yap_opcode(_Ystop);
return Yap_unify(ARG4, MkIntegerTerm((Int)mcl));
}
static Int
p_dbassert( USES_REGS1 )
{ /* '$number_of_clauses'(Predicate,M,N) */
Term thandle = Deref(ARG2);
Term tn = Deref(ARG3);
PredEntry *pe;
MegaClause *mcl;
Int n;
if (IsVarTerm(thandle) || !IsIntegerTerm(thandle)) {
return FALSE;
}
mcl = (MegaClause *)IntegerOfTerm(thandle);
if (IsVarTerm(tn) || !IsIntegerTerm(tn)) {
return FALSE;
}
n = IntegerOfTerm(tn);
pe = mcl->ClPred;
return store_dbcl_size((yamop *)((ADDR)mcl->ClCode+n*(mcl->ClItemSize)),pe->ArityOfPE,Deref(ARG1),pe);
}
void
Yap_InitCdMgr(void)
{
@ -5701,6 +5928,10 @@ Yap_InitCdMgr(void)
Yap_InitCPred("continuation", 4, p_env_info, HiddenPredFlag);
Yap_InitCPred("cp_to_predicate", 5, p_cpc_info, HiddenPredFlag);
CurrentModule = cm;
CurrentModule = DBLOAD_MODULE;
Yap_InitCPred("dbload_get_space", 4, p_dbload_get_space, 0L);
Yap_InitCPred("dbassert", 3, p_dbassert, 0L);
CurrentModule = cm;
Yap_InitCPred("$predicate_erased_statistics", 5, p_predicate_erased_statistics, SyncPredFlag);
#ifdef DEBUG
Yap_InitCPred("$predicate_live_cps", 4, p_predicate_lu_cps, 0L);

1
C/modules.c
View File

@ -327,5 +327,6 @@ Yap_InitModules(void)
LookupModule(HACKS_MODULE);
LookupModule(ARG_MODULE);
LookupModule(GLOBALS_MODULE);
LookupModule(DBLOAD_MODULE);
CurrentModule = PROLOG_MODULE;
}

1
H/dhstruct.h
View File

@ -96,6 +96,7 @@
#define ARG_MODULE Yap_heap_regs->arg_module
#define GLOBALS_MODULE Yap_heap_regs->globals_module
#define SWI_MODULE Yap_heap_regs->swi_module
#define DBLOAD_MODULE Yap_heap_regs->dbload_module

1
H/hstruct.h
View File

@ -96,6 +96,7 @@
Term arg_module;
Term globals_module;
Term swi_module;
Term dbload_module;

1
H/iatoms.h
View File

@ -63,6 +63,7 @@
AtomCut = Yap_LookupAtom("!");
AtomCutBy = Yap_FullLookupAtom("$cut_by");
AtomDAbort = Yap_FullLookupAtom("$abort");
AtomDBLoad = Yap_FullLookupAtom("$db_load");
AtomDBREF = Yap_LookupAtom("DBRef");
AtomDBReference = Yap_LookupAtom("db_reference");
AtomDBTerm = Yap_LookupAtom("db_term");

1
H/ihstruct.h
View File

@ -96,6 +96,7 @@
Yap_heap_regs->arg_module = MkAtomTerm(AtomArg);
Yap_heap_regs->globals_module = MkAtomTerm(AtomNb);
Yap_heap_regs->swi_module = MkAtomTerm(AtomSwi);
Yap_heap_regs->dbload_module = MkAtomTerm(AtomDBLoad);

1
H/ratoms.h
View File

@ -63,6 +63,7 @@
AtomCut = AtomAdjust(AtomCut);
AtomCutBy = AtomAdjust(AtomCutBy);
AtomDAbort = AtomAdjust(AtomDAbort);
AtomDBLoad = AtomAdjust(AtomDBLoad);
AtomDBREF = AtomAdjust(AtomDBREF);
AtomDBReference = AtomAdjust(AtomDBReference);
AtomDBTerm = AtomAdjust(AtomDBTerm);

1
H/rhstruct.h
View File

@ -96,6 +96,7 @@
Yap_heap_regs->arg_module = AtomTermAdjust(Yap_heap_regs->arg_module);
Yap_heap_regs->globals_module = AtomTermAdjust(Yap_heap_regs->globals_module);
Yap_heap_regs->swi_module = AtomTermAdjust(Yap_heap_regs->swi_module);
Yap_heap_regs->dbload_module = AtomTermAdjust(Yap_heap_regs->dbload_module);

2
H/tatoms.h
View File

@ -124,6 +124,8 @@
#define AtomCutBy Yap_heap_regs->AtomCutBy_
Atom AtomDAbort_;
#define AtomDAbort Yap_heap_regs->AtomDAbort_
Atom AtomDBLoad_;
#define AtomDBLoad Yap_heap_regs->AtomDBLoad_
Atom AtomDBREF_;
#define AtomDBREF Yap_heap_regs->AtomDBREF_
Atom AtomDBReference_;

1
Makefile.in
View File

@ -296,6 +296,7 @@ PL_SOURCES= \
$(srcdir)/pl/consult.yap \
$(srcdir)/pl/control.yap \
$(srcdir)/pl/corout.yap $(srcdir)/pl/debug.yap \
$(srcdir)/pl/dbload.yap \
$(srcdir)/pl/depth_bound.yap \
$(srcdir)/pl/dialect.yap \
$(srcdir)/pl/directives.yap \

1
misc/ATOMS
View File

@ -68,6 +68,7 @@ A CurrentModule F "$current_module"
A Cut N "!"
A CutBy F "$cut_by"
A DAbort F "$abort"
A DBLoad F "$db_load"
A DBREF N "DBRef"
A DBReference N "db_reference"
A DBTerm N "db_term"

1
misc/HEAPFIELDS
View File

@ -99,6 +99,7 @@ Term hacks_module HACKS_MODULE MkAT AtomYapHacks
Term arg_module ARG_MODULE MkAT AtomArg
Term globals_module GLOBALS_MODULE MkAT AtomNb
Term swi_module SWI_MODULE MkAT AtomSwi
Term dbload_module DBLOAD_MODULE MkAT AtomDBLoad
//
// Module list

119
pl/dbload.yap Normal file
View File

@ -0,0 +1,119 @@
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: dbload.yap *
* Last rev: 8/2/88 *
* mods: *
* comments: Compact Loading of Facts in YAP *
* *
*************************************************************************/
:- module('$db_load',
[]).
:- dynamic dbloading/6, dbprocess/2.
prolog:load_db(Fs) :-
'$current_module'(M0),
prolog_flag(agc_margin,Old,0),
dbload(Fs,M0,load_db(Fs)),
load_facts,
prolog_flag(agc_margin,_,Old),
clean_up.
dbload(Fs, _, G) :-
var(Fs),
'$do_error'(instantiation_error,G).
dbload([], _, _).
dbload([F|Fs], M0, G) :-
dbload(F, M0, G),
dbload(Fs, M0, G).
dbload(M:F, _M0, G) :-
dbload(F, M, G).
dbload(F, M0, G) :-
atom(F), !,
do_dbload(F, M0, G).
dbload(F, _, G) :-
'$do_error'(type_error(atom,F),G).
do_dbload(F0, M0, G) :-
'$find_in_path'(F0,F,G),
assert(dbprocess(F, M0)),
open(F, read, R),
check_dbload_stream(R, M0),
close(R).
check_dbload_stream(R, M0) :-
repeat,
read(R,T),
( T = end_of_file -> !;
dbload_count(T, M0),
fail
).
dbload_count(T0, M0) :-
get_module(T0,M0,T,M),
functor(T,Na,Arity),
% dbload_check_term(T),
(
dbloading(Na,Arity,M,_,NaAr,_) ->
nb_getval(NaAr,I0),
I is I0+1,
nb_setval(NaAr,I)
;
atomic_concat([Na,'__',Arity,'__',M],NaAr),
assert(dbloading(Na,Arity,M,T,NaAr,0)),
nb_setval(NaAr,1)
).
get_module(M1:T0,_,T,M) :- !,
get_module(T0, M1, T , M).
get_module(T,M,T,M).
load_facts :-
retract(dbloading(Na,Arity,M,T,NaAr,_)),
nb_getval(NaAr,Size),
dbload_get_space(T, M, Size, Handle),
assertz(dbloading(Na,Arity,M,T,NaAr,Handle)),
nb_setval(NaAr,0),
fail.
load_facts :-
dbprocess(F, M),
open(F, read, R),
dbload_add_facts(R, M),
close(R),
fail.
load_facts.
dbload_add_facts(R, M) :-
repeat,
read(R,T),
( T = end_of_file -> !;
dbload_add_fact(T, M),
fail
).
dbload_add_fact(T0, M0) :-
get_module(T0,M0,T,M),
functor(T,Na,Arity),
Na \= gene_product,
dbloading(Na,Arity,M,_,NaAr,Handle),
nb_getval(NaAr,I0),
I is I0+1,
nb_setval(NaAr,I),
dbassert(T,Handle,I0).
clean_up :-
retractall(dbloading(_,_,_,_,_,_)),
retractall(dbprocess(_,_)),
fail.
clean_up.

1
pl/init.yap
View File

@ -114,6 +114,7 @@ system_mode(verbose,off) :- set_value('$verbose',off).
:- use_module('corout.yap').
:- use_module('dialect.yap').
:- use_module('history.pl').
:- use_module('dbload.yap').
'$system_module'('$messages').
'$system_module'('$hacks').