static Code
chainMetaPredicateSupervisor(Definition def, Code post)
{ if ( true(def, P_META) && true(def, P_TRANSPARENT) )
{ tmp_buffer buf;
unsigned int i;
int count = 0;
Code codes;
initBuffer(&buf);
for(i=0; i < def->functor->arity; i++)
{ int ma = def->impl.any.args[i].meta;
if ( MA_NEEDS_TRANSPARENT(ma) )
{ addBuffer(&buf, encode(S_MQUAL), code);
addBuffer(&buf, VAROFFSET(i), code);
count++;
}
}
if ( count > 0 )
{ baseBuffer(&buf, code)[(count-1)*2] = encode(S_LMQUAL);
copySuperVisorCode((Buffer)&buf, post);
freeCodes(post);
codes = allocCodes(entriesBuffer(&buf, code));
copyCodes(codes, baseBuffer(&buf, code), entriesBuffer(&buf, code));
return codes;
} else
{ discardBuffer(&buf);
}
}
return post;
}
void
PL_register_blob_type(PL_blob_t *type)
{ PL_LOCK(L_MISC); /* cannot use L_ATOM */
if ( !type->registered )
{ if ( !GD->atoms.types )
{ GD->atoms.types = type;
} else
{ PL_blob_t *t = GD->atoms.types;
while(t->next)
t = t->next;
t->next = type;
type->rank = t->rank+1;
}
type->registered = TRUE;
if ( !type->atom_name )
type->atom_name = PL_new_atom(type->name);
if ( true(type, PL_BLOB_TEXT) )
{ if ( true(type, PL_BLOB_WCHAR) )
type->padding = sizeof(pl_wchar_t);
else
type->padding = sizeof(char);
}
}
PL_UNLOCK(L_MISC);
}
static Code
chainMetaPredicateSupervisor(Definition def, Code post)
{ if ( true(def, P_META) && true(def, P_TRANSPARENT) )
{ tmp_buffer buf;
unsigned int i;
int count = 0;
Code codes;
initBuffer(&buf);
for(i=0; i < def->functor->arity; i++)
{ int ma = MA_INFO(def, i);
if ( ma <= 9 || ma == MA_META || ma == MA_HAT || ma == MA_DCG ) /* 0..9, :, ^ or // */
{ addBuffer(&buf, encode(S_MQUAL), code);
addBuffer(&buf, VAROFFSET(i), code);
count++;
}
}
if ( count > 0 )
{ baseBuffer(&buf, code)[(count-1)*2] = encode(S_LMQUAL);
copySuperVisorCode((Buffer)&buf, post);
freeCodes(post);
codes = allocCodes(entriesBuffer(&buf, code));
copyCodes(codes, baseBuffer(&buf, code), entriesBuffer(&buf, code));
return codes;
} else
{ discardBuffer(&buf);
}
}
return post;
}
static size_t
paddingBlob(PL_blob_t *type)
{ if ( true(type, PL_BLOB_TEXT) )
{ return true(type, PL_BLOB_WCHAR) ? sizeof(pl_wchar_t) : sizeof(char);
} else
{ return 0;
}
}
static Code
multifileSupervisor(Definition def)
{ if ( true(def, (P_DYNAMIC|P_MULTIFILE)) )
{ if ( true(def, P_DYNAMIC) )
return SUPERVISOR(dynamic);
else
return SUPERVISOR(multifile);
}
return NULL;
}
int
createForeignSupervisor(Definition def, Func f)
{ assert(true(def, P_FOREIGN));
if ( false(def, P_VARARG) )
{ if ( def->functor->arity > MAX_FLI_ARGS )
sysError("Too many arguments to foreign function %s (>%d)", \
predicateName(def), MAX_FLI_ARGS); \
}
if ( false(def, P_NONDET) )
{ Code codes = allocCodes(4);
codes[0] = encode(I_FOPEN);
if ( true(def, P_VARARG) )
codes[1] = encode(I_FCALLDETVA);
else
codes[1] = encode(I_FCALLDET0+def->functor->arity);
codes[2] = (code)f;
codes[3] = encode(I_FEXITDET);
def->codes = codes;
} else
{ Code codes = allocCodes(5);
codes[0] = encode(I_FOPENNDET);
if ( true(def, P_VARARG) )
codes[1] = encode(I_FCALLNDETVA);
else
codes[1] = encode(I_FCALLNDET0+def->functor->arity);
codes[2] = (code)f;
codes[3] = encode(I_FEXITNDET);
codes[4] = encode(I_FREDO);
def->codes = codes;
}
#ifdef O_PROF_PENTIUM
assert(prof_foreign_index < MAXPROF);
def->prof_index = prof_foreign_index++;
def->prof_name = strdup(predicateName(def));
#endif
succeed;
}
static int
release_clause(atom_t aref)
{ clref *ref = PL_blob_data(aref, NULL, NULL);
clear(ref->clause, DBREF_CLAUSE);
if ( true(ref->clause, DBREF_ERASED_CLAUSE) )
unallocClause(ref->clause);
return TRUE;
}
int
hasProcedureSourceFile(SourceFile sf, Procedure proc)
{ ListCell cell;
if ( true(proc->definition, FILE_ASSIGNED) )
{ for(cell=sf->procedures; cell; cell = cell->next)
{ if ( cell->value == proc )
succeed;
}
}
fail;
}
int
PL_get_clref(term_t t, Clause *cl)
{ struct clref *ref;
PL_blob_t *type;
if ( !PL_get_blob(t, (void**)&ref, NULL, &type) ||
type != &clause_blob )
return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_db_reference, t);
*cl = ref->clause;
if ( true(ref->clause, CL_ERASED) )
return -1;
return TRUE;
}
int demo_test_pass()
{
tf_assert(true(), "This demo_test should pass silently");
tf_passed();
}