This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/BEAM/eamindex.c
Vitor Santos Costa 65ff3ed471 Smaller updates:
constant use of longjmp
conflict with python headers
win32 support
dll support
2017-02-20 15:28:46 +00:00

320 lines
7.9 KiB
C

/*************************************************************************
* *
* BEAM -> Basic Extended Andorra Model *
* BEAM extends the YAP Prolog system to support the EAM *
* *
* Copyright: Ricardo Lopes and NCC - University of Porto, Portugal *
* *
**************************************************************************
* comments: indexing related functions *
*************************************************************************/
#ifdef BEAM
#include "Yap.h"
#include "YapCompile.h"
#include "clause.h"
#include "eam.h"
#include <stdio.h>
#include <stdlib.h>
CInstr *StartCode,*inter_code;
extern void eam_showcode(Cell *code);
extern unsigned int index_of_hash_table_atom(Cell c, int nr);
extern unsigned int index_of_hash_table_appl(Cell c, int nr);
extern CInstr *emit_new(int o, int r1,CELL r4);
Cell *gera_codigo_try(struct Predicates *);
Cell *gera_codigo_try_list(struct Predicates *predi);
Cell *gera_codigo_try_only_vars(struct Predicates *predi);
struct HASH_TABLE **gera_codigo_try_atom(struct Predicates *predi);
struct HASH_TABLE **gera_codigo_try_functor(struct Predicates *predi);
extern Cell *eam_assemble(CInstr *code);
void do_eam_indexing(struct Predicates *p);
void ver_predicados(struct Predicates *p);
int exists_on_table(Cell a,struct HASH_TABLE **table, int i);
int exists_on_table(Cell a,struct HASH_TABLE **table, int i)
{
struct HASH_TABLE *t;
t=table[i];
while(t) {
if (t->value==a) return(1);
t=t->next;
}
return(0);
}
Cell *gera_codigo_try(struct Predicates *predi) /* gerar os try's para o predicado i */
{
struct Clauses *c;
int nr=0;
StartCode=NULL;
inter_code=NULL;
c=predi->first;
emit_new(prepare_tries,predi->nr_alt,predi->arity);
if (predi->nr_alt==1) {
emit_new(only_1_clause_op,0,(unsigned long) c);
} else if (predi->nr_alt>1) {
while(c!=NULL) {
if (nr+1==predi->nr_alt) emit_new(trust_me_op,nr,(unsigned long) c);
else if (nr==0) emit_new(try_me_op,predi->nr_alt,(unsigned long) c);
else emit_new(retry_me_op,nr,(unsigned long) c);
c=c->next;
nr++;
}
} else {
emit_new(fail_op,0,0);
}
return(eam_assemble(StartCode));
}
Cell *gera_codigo_try_list(struct Predicates *predi) /* gerar os try's para o predicado i */
{
struct Clauses *c;
int nr=0,nr_preds;
StartCode=NULL;
inter_code=NULL;
nr_preds=predi->idx_list+predi->idx_var;
c=predi->first;
emit_new(prepare_tries,nr_preds,predi->arity);
if (nr_preds>=1) {
while(c!=NULL) {
if (c->predi==predi && (c->idx==Lista || c->idx==Variavel)) {
if (nr_preds==1) {
emit_new(only_1_clause_op,0,(unsigned long) c);
break;
}
if (nr+1==nr_preds) { emit_new(trust_me_op,nr,(unsigned long) c); break; }
else if (nr==0) emit_new(try_me_op,nr_preds,(unsigned long) c);
else emit_new(retry_me_op,nr,(unsigned long) c);
nr++;
}
c=c->next;
}
} else {
emit_new(fail_op,0,0);
}
return(eam_assemble(StartCode));
}
struct HASH_TABLE **gera_codigo_try_atom(struct Predicates *predi)
{
int j,nr_preds,nr_atoms;
struct HASH_TABLE **table;
struct HASH_TABLE *t;
struct Clauses *cla;
nr_atoms=predi->idx_atom;
nr_preds=nr_atoms+predi->idx_var;
table=malloc(sizeof(struct HASH_TABLE *)*(nr_atoms+1));
for (j=0;j<=nr_atoms;j++) table[j]=NULL;
cla=predi->first;
while(cla) {
if (cla->idx==Constante) {
Cell a;
unsigned int index;
int nr;
a=cla->val;
if (a && nr_atoms) {
index=index_of_hash_table_atom(a,nr_atoms);
} else index=nr_atoms;
/* printf("nr_atoms=%d index=%d -> 0x%X \n",nr_atoms,index,a); */
if (!exists_on_table(a,table,index)) {
CInstr *first,*last=NULL,*prepare;
struct Clauses *cla2;
/* printf("a gerar codigo para atom index=%d value %ld\n",index,cla->val); */
t=malloc(sizeof(struct HASH_TABLE));
t->next=table[index];
table[index]=t;
t->value=a;
StartCode=NULL;
inter_code=NULL;
prepare=emit_new(prepare_tries,0,predi->arity);
cla2=predi->first;
nr=0;
first=NULL;
while(cla2) {
if ((cla2->idx==Constante && cla2->val==a) || cla2->idx==Variavel) {
last=emit_new(retry_me_op,nr,(unsigned long) cla2);
if (first==NULL) first=last;
nr++;
}
cla2=cla2->next;
}
prepare->new1=nr;
if (first==last) {
first->op=only_1_clause_op;
} else {
first->op=try_me_op;
last->op=trust_me_op;
}
t->code=eam_assemble(StartCode);
}
}
cla=cla->next;
}
return(table);
}
struct HASH_TABLE **gera_codigo_try_functor(struct Predicates *predi) /*gerar os try's para o predicado i*/
{
int j,nr_preds,nr_appls;
struct HASH_TABLE **table;
struct HASH_TABLE *t;
struct Clauses *cla;
nr_appls=predi->idx_functor;
nr_preds=nr_appls+predi->idx_var;
table=malloc(sizeof(struct HASH_TABLE *)*(nr_appls+1));
for (j=0;j<=nr_appls;j++) table[j]=NULL;
cla=predi->first;
while(cla) {
if (cla->idx==Estrutura) {
Cell a;
long int index;
int nr;
a=cla->val;
if (a && nr_appls) {
index=index_of_hash_table_appl(a,nr_appls);
} else index=nr_appls;
if (!exists_on_table(a,table,index)) {
CInstr *first,*last=NULL,*prepare;
struct Clauses *cla2;
/* printf("a gerar codigo para appl index=%d value %ld\n",index,cla->val); */
t=malloc(sizeof(struct HASH_TABLE));
t->next=table[index];
table[index]=t;
t->value=a;
StartCode=NULL;
inter_code=NULL;
prepare=emit_new(prepare_tries,0,predi->arity);
cla2=predi->first;
nr=0;
first=NULL;
while(cla2) {
if ((cla2->idx==Estrutura && cla2->val==a) || cla2->idx==Variavel) {
last=emit_new(retry_me_op,nr,(unsigned long) cla2);
if (first==NULL) first=last;
nr++;
}
cla2=cla2->next;
}
prepare->new1=nr;
if (first==last) {
first->op=only_1_clause_op;
} else {
first->op=try_me_op;
last->op=trust_me_op;
}
t->code=eam_assemble(StartCode);
}
}
cla=cla->next;
}
return(table);
}
Cell *gera_codigo_try_only_vars(struct Predicates *predi) /* gerar os try's de Vars para o predicado i */
{
struct Clauses *c;
int nr=0,nr_preds;
StartCode=NULL;
inter_code=NULL;
nr_preds=predi->idx_var;
c=predi->first;
emit_new(prepare_tries,nr_preds,predi->arity);
if (nr_preds>=1) {
while(c!=NULL) {
if (c->predi==predi && c->idx==Variavel) {
if (nr_preds==1) {
emit_new(only_1_clause_op,0,(unsigned long) c);
break;
}
if (nr+1==nr_preds) { emit_new(trust_me_op,nr,(unsigned long) c); break; }
else if (nr==0) emit_new(try_me_op,nr_preds,(unsigned long) c);
else emit_new(retry_me_op,nr,(unsigned long) c);
nr++;
}
c=c->next;
}
} else {
emit_new(fail_op,0,0);
}
return(eam_assemble(StartCode));
}
void do_eam_indexing(struct Predicates *p)
{
p->code=gera_codigo_try(p);
p->idx=-1;
if (p->arity && (p->idx_list || p->idx_atom || p->idx_functor)) {
p->vars=gera_codigo_try_only_vars(p);
p->list=gera_codigo_try_list(p);
p->functor=gera_codigo_try_functor(p);
p->atom=gera_codigo_try_atom(p);
p->idx=1;
}
if((Print_Code & 4) && (Print_Code & 8)) {
printf("General Case :\n");
eam_showcode(p->code);
}
if (Print_Code & 1) ver_predicados(p);
}
void ver_predicados(struct Predicates *p)
{
struct Clauses *c; int i=0;
printf("Predicado %s:%d (ES=%d) tem %d clausulas do tipo V=%d L=%d A=%d F=%d \n",p->name,p->arity,p->eager_split,p->nr_alt,p->idx_var,p->idx_list,p->idx_atom,p->idx_functor);
c=p->first;
while(c!=NULL) {
printf("Clausula %d do tipo %d (%d locals %d args) (val=0x%X)\n",++i,c->idx,c->nr_vars,c->predi->arity, (unsigned )c->val);
c=c->next;
}
}
#endif /* BEAM */