From de0f8a82363ae7f94daa9e297d6d79cc6e53eb38 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sat, 30 Apr 2011 01:16:40 +0100 Subject: [PATCH] dbload --- C/cdmgr.c | 231 ++++++++++++++++++++++++++++++++++++++++++++++++ C/modules.c | 1 + H/dhstruct.h | 1 + H/hstruct.h | 1 + H/iatoms.h | 1 + H/ihstruct.h | 1 + H/ratoms.h | 1 + H/rhstruct.h | 1 + H/tatoms.h | 2 + Makefile.in | 1 + misc/ATOMS | 1 + misc/HEAPFIELDS | 1 + pl/dbload.yap | 119 +++++++++++++++++++++++++ pl/init.yap | 1 + 14 files changed, 363 insertions(+) create mode 100644 pl/dbload.yap diff --git a/C/cdmgr.c b/C/cdmgr.c index 2f48990af..cef1ea4ea 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -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); diff --git a/C/modules.c b/C/modules.c index c37358910..d588b5914 100644 --- a/C/modules.c +++ b/C/modules.c @@ -327,5 +327,6 @@ Yap_InitModules(void) LookupModule(HACKS_MODULE); LookupModule(ARG_MODULE); LookupModule(GLOBALS_MODULE); + LookupModule(DBLOAD_MODULE); CurrentModule = PROLOG_MODULE; } diff --git a/H/dhstruct.h b/H/dhstruct.h index e08629dbc..0c5191033 100644 --- a/H/dhstruct.h +++ b/H/dhstruct.h @@ -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 diff --git a/H/hstruct.h b/H/hstruct.h index 996038297..b9ea11621 100644 --- a/H/hstruct.h +++ b/H/hstruct.h @@ -96,6 +96,7 @@ Term arg_module; Term globals_module; Term swi_module; + Term dbload_module; diff --git a/H/iatoms.h b/H/iatoms.h index 6c3c51689..7d0f51791 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -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"); diff --git a/H/ihstruct.h b/H/ihstruct.h index 27ff0acf1..45ab202c3 100644 --- a/H/ihstruct.h +++ b/H/ihstruct.h @@ -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); diff --git a/H/ratoms.h b/H/ratoms.h index fa0f4f692..9350f03a8 100644 --- a/H/ratoms.h +++ b/H/ratoms.h @@ -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); diff --git a/H/rhstruct.h b/H/rhstruct.h index b6b268ef3..71e37aad3 100644 --- a/H/rhstruct.h +++ b/H/rhstruct.h @@ -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); diff --git a/H/tatoms.h b/H/tatoms.h index 040401a00..f63e9e481 100644 --- a/H/tatoms.h +++ b/H/tatoms.h @@ -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_; diff --git a/Makefile.in b/Makefile.in index e2a4d3ecb..96a97432d 100755 --- a/Makefile.in +++ b/Makefile.in @@ -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 \ diff --git a/misc/ATOMS b/misc/ATOMS index 517458039..2bb81f846 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -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" diff --git a/misc/HEAPFIELDS b/misc/HEAPFIELDS index 75985d9dd..5f9681e9e 100755 --- a/misc/HEAPFIELDS +++ b/misc/HEAPFIELDS @@ -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 diff --git a/pl/dbload.yap b/pl/dbload.yap new file mode 100644 index 000000000..92361cde8 --- /dev/null +++ b/pl/dbload.yap @@ -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. + diff --git a/pl/init.yap b/pl/init.yap index 489634d0a..d42b7c371 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -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').