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/library/dialect/swi/fli/blobs.c
2015-06-19 01:29:16 +01:00

188 lines
3.6 KiB
C

/*************************************************************************
* *
* YAP Prolog *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright V.Santos Costa and Universidade do Porto 1985-- *
* *
**************************************************************************
* *
* File: blobs.c *
* comments: support blobs in YAP definition *
* *
* Last rev: $Date: $,$Author: vsc $ *
* *
* *
*************************************************************************/
/**
*
* @{
* @file blobs.c
*
* @addtogroup swi-c-interface
*
*/
#include <stdio.h>
#include <Yap.h>
#include <Yatom.h>
#include <iopreds.h>
#include <string.h>
/* for freeBSD9.1 */
#define _WITH_DPRINTF
#include <stdio.h>
//#include <SWI-Stream.h>
//#include <pl-shared.h>
#include "swi.h"
static PL_blob_t unregistered_blob_atom =
{ PL_BLOB_MAGIC,
PL_BLOB_NOCOPY|PL_BLOB_TEXT,
"unregistered"
};
int
PL_is_blob(term_t t, PL_blob_t **type)
{
CACHE_REGS
Term yt = Yap_GetFromSlot(t);
Atom a;
BlobPropEntry *b;
if (IsVarTerm(yt))
return FALSE;
if (!IsAtomTerm(yt))
return FALSE;
a = AtomOfTerm(yt);
if (!IsBlob(a))
return FALSE;
b = RepBlobProp(a->PropsOfAE);
*type = (struct PL_blob_t *)b->blob_type;
return TRUE;
}
/* void check_chain(void); */
PL_EXPORT(int)
PL_unify_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
{
CACHE_REGS
AtomEntry *ae;
if (!blob)
return FALSE;
ae = Yap_lookupBlob(blob, len, type, NULL);
if (!ae) {
return FALSE;
}
if (type->acquire) {
type->acquire(AtomToSWIAtom(AbsAtom(ae)));
}
return Yap_unify(Yap_GetFromSlot(t), MkAtomTerm(AbsAtom(ae)));
}
PL_EXPORT(int)
PL_put_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
{
CACHE_REGS
AtomEntry *ae;
int ret;
if (!blob)
return FALSE;
ae = Yap_lookupBlob(blob, len, type, & ret);
if (!ae) {
return FALSE;
}
if (type->acquire) {
type->acquire(AtomToSWIAtom(AbsAtom(ae)));
}
Yap_PutInSlot(t, MkAtomTerm(AbsAtom(ae)) PASS_REGS);
return ret;
}
PL_EXPORT(int)
PL_get_blob(term_t t, void **blob, size_t *len, PL_blob_t **type)
{
CACHE_REGS
Atom a;
Term tt;
AtomEntry *ae;
tt = Yap_GetFromSlot(t);
if (IsVarTerm(tt))
return FALSE;
if (!IsAtomTerm(tt))
return FALSE;
a = AtomOfTerm(tt);
if (!IsBlob(a))
return FALSE;
ae = RepAtom(a);
if (type)
*type = (struct PL_blob_t *)RepBlobProp(ae->PropsOfAE)->blob_type;
if (len)
*len = ae->rep.blob[0].length;
if (blob)
*blob = ae->rep.blob[0].data;
return TRUE;
}
PL_EXPORT(void*)
PL_blob_data(atom_t a, size_t *len, struct PL_blob_t **type)
{
Atom x = SWIAtomToAtom(a);
if (!IsBlob(x)) {
if (IsWideAtom(x)) {
if ( len )
*len = wcslen(x->WStrOfAE);
if ( type )
*type = &unregistered_blob_atom;
return x->WStrOfAE;
}
if ( len )
*len = strlen(x->StrOfAE);
if ( type )
*type = &unregistered_blob_atom;
return x->StrOfAE;
}
if ( len )
*len = x->rep.blob[0].length;
if ( type )
*type = (struct PL_blob_t *)RepBlobProp(x->PropsOfAE)->blob_type;
return x->rep.blob[0].data;
}
PL_EXPORT(void)
PL_register_blob_type(PL_blob_t *type)
{
type->next = (PL_blob_t *)BlobTypes;
BlobTypes = (struct YAP_blob_t *)type;
}
PL_EXPORT(PL_blob_t*)
PL_find_blob_type(const char* name)
{
Atom at = Yap_LookupAtom((char *)name);
return YAP_find_blob_type((YAP_Atom)at);
}
PL_EXPORT(int)
PL_unregister_blob_type(PL_blob_t *type)
{
fprintf(stderr,"PL_unregister_blob_type not implemented yet\n");
return FALSE;
}
/**
* @}
*/