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

263 lines
5.1 KiB
C
Raw Normal View History

2010-11-30 21:59:45 +00:00
/*************************************************************************
* *
* 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 $ *
* *
* *
*************************************************************************/
2014-05-14 10:01:11 +01:00
/**
*
* @file blobs.c
*
* @addtogroup swi-c-interface
*
* @{
*/
2010-11-30 21:59:45 +00:00
#include <Yap.h>
#include <Yatom.h>
#include <string.h>
2013-01-17 12:59:52 +00:00
/* for freeBSD9.1 */
#define _WITH_DPRINTF
#include <stdio.h>
#include <pl-shared.h>
2010-11-30 21:59:45 +00:00
#include "swi.h"
2011-02-11 01:22:07 +00:00
static PL_blob_t unregistered_blob_atom =
{ PL_BLOB_MAGIC,
PL_BLOB_NOCOPY|PL_BLOB_TEXT,
"unregistered"
};
2010-11-30 21:59:45 +00:00
PL_EXPORT(int)
PL_is_blob(term_t t, PL_blob_t **type)
{
CACHE_REGS
Term yt = Yap_GetFromSlot(t PASS_REGS);
2010-11-30 21:59:45 +00:00
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 = b->blob_t;
return TRUE;
}
2011-12-22 10:27:56 +00:00
2012-01-09 23:27:22 +00:00
/* void check_chain(void); */
/* void check_chain(void) { */
/* AtomEntry *ae, *old; */
/* ae = SWI_Blobs; */
/* old = NULL; */
/* while (ae) { */
/* old = ae; */
/* ae = RepAtom(ae->NextOfAE); */
/* } */
/* } */
2011-12-22 10:27:56 +00:00
2011-02-12 14:14:12 +00:00
static AtomEntry *
2013-11-22 15:16:54 +00:00
lookupBlob(void *blob, size_t len, PL_blob_t *type, int *new)
2011-02-12 14:14:12 +00:00
{
BlobPropEntry *b;
AtomEntry *ae;
2013-11-22 15:16:54 +00:00
if (new)
*new = FALSE;
2011-12-22 10:27:56 +00:00
LOCK(SWI_Blobs_Lock);
2011-02-12 14:14:12 +00:00
if (type->flags & PL_BLOB_UNIQUE) {
/* just keep a linked chain for now */
ae = SWI_Blobs;
while (ae) {
2011-03-16 00:15:15 +00:00
if (ae->PropsOfAE &&
RepBlobProp(ae->PropsOfAE)->blob_t == type &&
2011-02-12 14:14:12 +00:00
ae->rep.blob->length == len &&
2011-12-22 10:27:56 +00:00
!memcmp(ae->rep.blob->data, blob, len)) {
UNLOCK(SWI_Blobs_Lock);
2011-02-12 14:14:12 +00:00
return ae;
2011-12-22 10:27:56 +00:00
}
2011-02-12 14:14:12 +00:00
ae = RepAtom(ae->NextOfAE);
}
}
2013-11-22 15:16:54 +00:00
if (new)
*new = TRUE;
2011-02-12 14:14:12 +00:00
b = (BlobPropEntry *)Yap_AllocCodeSpace(sizeof(BlobPropEntry));
2011-12-22 10:27:56 +00:00
if (!b) {
UNLOCK(SWI_Blobs_Lock);
2011-02-12 14:14:12 +00:00
return NULL;
2011-12-22 10:27:56 +00:00
}
2011-02-12 14:14:12 +00:00
b->NextOfPE = NIL;
b->KindOfPE = BlobProperty;
b->blob_t = type;
2011-02-13 01:03:08 +00:00
ae = (AtomEntry *)Yap_AllocCodeSpace(sizeof(AtomEntry)+len+sizeof(size_t));
2011-12-22 10:27:56 +00:00
if (!ae) {
UNLOCK(SWI_Blobs_Lock);
2011-02-12 14:14:12 +00:00
return NULL;
2011-12-22 10:27:56 +00:00
}
NOfBlobs++;
2011-02-12 14:14:12 +00:00
INIT_RWLOCK(ae->ARWLock);
ae->PropsOfAE = AbsBlobProp(b);
ae->NextOfAE = AbsAtom(SWI_Blobs);
ae->rep.blob->length = len;
memcpy(ae->rep.blob->data, blob, len);
SWI_Blobs = ae;
2011-12-22 10:27:56 +00:00
if (NOfBlobs > NOfBlobsMax) {
Yap_signal(YAP_CDOVF_SIGNAL);
}
UNLOCK(SWI_Blobs_Lock);
2011-02-12 14:14:12 +00:00
return ae;
}
2010-11-30 21:59:45 +00:00
PL_EXPORT(int)
PL_unify_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
{
CACHE_REGS
2011-02-12 14:14:12 +00:00
AtomEntry *ae;
if (!blob)
return FALSE;
2013-11-22 15:16:54 +00:00
ae = lookupBlob(blob, len, type, NULL);
2011-02-12 14:14:12 +00:00
if (!ae) {
return FALSE;
}
2011-03-11 19:49:32 +00:00
if (type->acquire) {
type->acquire(AtomToSWIAtom(AbsAtom(ae)));
}
return Yap_unify(Yap_GetFromSlot(t PASS_REGS), MkAtomTerm(AbsAtom(ae)));
2010-11-30 21:59:45 +00:00
}
PL_EXPORT(int)
PL_put_blob(term_t t, void *blob, size_t len, PL_blob_t *type)
{
2013-11-22 15:16:54 +00:00
CACHE_REGS
AtomEntry *ae;
int ret;
if (!blob)
return FALSE;
ae = 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;
2010-11-30 21:59:45 +00:00
}
PL_EXPORT(int)
PL_get_blob(term_t t, void **blob, size_t *len, PL_blob_t **type)
{
2013-11-22 15:16:54 +00:00
CACHE_REGS
Atom a;
Term tt;
AtomEntry *ae;
tt = Yap_GetFromSlot(t PASS_REGS);
if (IsVarTerm(tt))
return FALSE;
if (!IsAtomTerm(tt))
return FALSE;
a = AtomOfTerm(tt);
if (!IsBlob(a))
return FALSE;
ae = RepAtom(a);
if (type)
*type = RepBlobProp(ae->PropsOfAE)->blob_t;
if (len)
*len = ae->rep.blob[0].length;
if (blob)
*blob = ae->rep.blob[0].data;
return TRUE;
2010-11-30 21:59:45 +00:00
}
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 )
2011-02-11 01:22:07 +00:00
*type = &unregistered_blob_atom;
2010-11-30 21:59:45 +00:00
return x->WStrOfAE;
}
if ( len )
*len = strlen(x->StrOfAE);
if ( type )
2011-02-11 01:22:07 +00:00
*type = &unregistered_blob_atom;
2010-11-30 21:59:45 +00:00
return x->StrOfAE;
}
if ( len )
*len = x->rep.blob[0].length;
2010-11-30 21:59:45 +00:00
if ( type )
*type = RepBlobProp(x->PropsOfAE)->blob_t;
return x->rep.blob[0].data;
2010-11-30 21:59:45 +00:00
}
PL_EXPORT(void)
PL_register_blob_type(PL_blob_t *type)
{
2011-02-12 14:14:12 +00:00
type->next = SWI_BlobTypes;
SWI_BlobTypes = type;
2010-11-30 21:59:45 +00:00
}
PL_EXPORT(PL_blob_t*)
PL_find_blob_type(const char* name)
{
2011-02-10 00:01:19 +00:00
Atom at = Yap_LookupAtom((char *)name);
return YAP_find_blob_type((YAP_Atom)at);
}
PL_EXPORT(PL_blob_t*)
YAP_find_blob_type(YAP_Atom at)
{
AtomEntry *a = RepAtom((Atom)at);
if (!IsBlob(a)) {
2011-02-11 01:22:07 +00:00
return &unregistered_blob_atom;
2011-02-10 00:01:19 +00:00
}
return RepBlobProp(a->PropsOfAE)->blob_t;
2010-11-30 21:59:45 +00:00
}
PL_EXPORT(int)
PL_unregister_blob_type(PL_blob_t *type)
{
fprintf(stderr,"PL_unregister_blob_type not implemented yet\n");
return FALSE;
}
void
Yap_install_blobs(void)
{
}
2014-05-14 10:01:11 +01:00
/**
* @}
*/