clib package
This commit is contained in:
Vítor Santos Costa
515
packages/clib/memfile.c
Normal file
515
packages/clib/memfile.c
Normal file
@@ -0,0 +1,515 @@
|
||||
/* $Id$
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
Author: Jan Wielemaker
|
||||
E-mail: J.Wielemaker@uva.nl
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 1985-2009, University of Amsterdam
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU Lesser General Public
|
||||
License as published by the Free Software Foundation; either
|
||||
version 2.1 of the License, or (at your option) any later version.
|
||||
|
||||
This library is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
Lesser General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with this library; if not, write to the Free Software
|
||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
*/
|
||||
|
||||
#include <SWI-Stream.h>
|
||||
#include <SWI-Prolog.h>
|
||||
#include <string.h>
|
||||
#include <stdlib.h>
|
||||
#include <assert.h>
|
||||
#include <errno.h>
|
||||
#include "error.h"
|
||||
|
||||
#define streq(s,q) (strcmp((s), (q)) == 0)
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Memory-files
|
||||
|
||||
make_memory_file(-Handle)
|
||||
free_memory_file(+Handle)
|
||||
open_memory_file(+Handle, +Mode, -Stream)
|
||||
size_memory_file(+Handle, -Size)
|
||||
memory_file_to_codes(+Handle, -Codes)
|
||||
memory_file_to_atom(+Handle, -Atom)
|
||||
atom_to_memory_file(+Atom, -Handle)
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
static functor_t FUNCTOR_memory_file1;
|
||||
static atom_t ATOM_encoding;
|
||||
static atom_t ATOM_unknown;
|
||||
static atom_t ATOM_octet;
|
||||
static atom_t ATOM_ascii;
|
||||
static atom_t ATOM_iso_latin_1;
|
||||
static atom_t ATOM_text;
|
||||
static atom_t ATOM_utf8;
|
||||
static atom_t ATOM_unicode_be;
|
||||
static atom_t ATOM_unicode_le;
|
||||
static atom_t ATOM_wchar_t;
|
||||
static atom_t ATOM_read;
|
||||
static atom_t ATOM_write;
|
||||
static atom_t ATOM_free_on_close;
|
||||
|
||||
#define MEMFILE_MAGIC 0x5624a6b3L
|
||||
#define NOSIZE ((size_t)-1)
|
||||
|
||||
typedef struct
|
||||
{ long magic; /* MEMFILE_MAGIC */
|
||||
IOENC encoding; /* encoding of the data */
|
||||
int free_on_close; /* free if it is closed */
|
||||
char *data; /* data of the file */
|
||||
size_t data_size; /* byte-size of data */
|
||||
size_t size; /* size in characters */
|
||||
IOSTREAM *stream; /* Stream hanging onto it */
|
||||
atom_t atom; /* Created from atom */
|
||||
} memfile;
|
||||
|
||||
|
||||
static int
|
||||
unify_memfile(term_t handle, memfile *f)
|
||||
{ return PL_unify_term(handle,
|
||||
PL_FUNCTOR, FUNCTOR_memory_file1,
|
||||
PL_POINTER, f);
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
get_memfile(term_t handle, memfile **f)
|
||||
{ if ( PL_is_functor(handle, FUNCTOR_memory_file1) )
|
||||
{ term_t a = PL_new_term_ref();
|
||||
void *ptr;
|
||||
|
||||
_PL_get_arg(1, handle, a);
|
||||
if ( PL_get_pointer(a, &ptr) )
|
||||
{ memfile *m = ptr;
|
||||
|
||||
if ( m->magic == MEMFILE_MAGIC )
|
||||
{ *f = ptr;
|
||||
return TRUE;
|
||||
}
|
||||
return pl_error(NULL, 0, NULL, ERR_EXISTENCE,
|
||||
"memory_file", handle);
|
||||
}
|
||||
}
|
||||
|
||||
return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 1,
|
||||
handle, "memory_file");
|
||||
}
|
||||
|
||||
|
||||
static foreign_t
|
||||
new_memory_file(term_t handle)
|
||||
{ memfile *m = calloc(1, sizeof(*m));
|
||||
|
||||
if ( !m )
|
||||
return pl_error(NULL, 0, NULL, ERR_ERRNO, errno,
|
||||
"create", "memory_file", handle);
|
||||
|
||||
m->magic = MEMFILE_MAGIC;
|
||||
m->encoding = ENC_UTF8;
|
||||
m->data = 0;
|
||||
m->size = 0;
|
||||
|
||||
if ( unify_memfile(handle, m) )
|
||||
return TRUE;
|
||||
|
||||
m->magic = 0;
|
||||
free(m);
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
destroy_memory_file(memfile *m)
|
||||
{ if ( m->stream )
|
||||
Sclose(m->stream);
|
||||
if ( m->atom )
|
||||
PL_unregister_atom(m->atom);
|
||||
else if ( m->data )
|
||||
Sfree(m->data); /* MS-Windows: malloc by other DLL! */
|
||||
m->magic = 0;
|
||||
free(m);
|
||||
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
|
||||
static foreign_t
|
||||
free_memory_file(term_t handle)
|
||||
{ memfile *m;
|
||||
|
||||
if ( get_memfile(handle, &m) )
|
||||
return destroy_memory_file(m);
|
||||
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
closehook(void *closure)
|
||||
{ memfile *m = closure;
|
||||
|
||||
m->stream = NULL;
|
||||
if ( m->free_on_close )
|
||||
destroy_memory_file(m);
|
||||
}
|
||||
|
||||
|
||||
static foreign_t
|
||||
alreadyOpen(term_t handle, const char *op)
|
||||
{ return pl_error(NULL, 0, "already open",
|
||||
ERR_PERMISSION, handle, op, "memory_file");
|
||||
}
|
||||
|
||||
|
||||
static struct encname
|
||||
{ IOENC code;
|
||||
atom_t *name;
|
||||
} encoding_names[] =
|
||||
{ { ENC_UNKNOWN, &ATOM_unknown },
|
||||
{ ENC_OCTET, &ATOM_octet },
|
||||
{ ENC_ASCII, &ATOM_ascii },
|
||||
{ ENC_ISO_LATIN_1, &ATOM_iso_latin_1 },
|
||||
{ ENC_ANSI, &ATOM_text },
|
||||
{ ENC_UTF8, &ATOM_utf8 },
|
||||
{ ENC_UNICODE_BE, &ATOM_unicode_be },
|
||||
{ ENC_UNICODE_LE, &ATOM_unicode_le },
|
||||
{ ENC_WCHAR, &ATOM_wchar_t },
|
||||
{ ENC_UNKNOWN, NULL },
|
||||
};
|
||||
|
||||
|
||||
IOENC
|
||||
atom_to_encoding(atom_t a)
|
||||
{ struct encname *en;
|
||||
|
||||
for(en=encoding_names; en->name; en++)
|
||||
{ if ( *en->name == a )
|
||||
return en->code;
|
||||
}
|
||||
|
||||
return ENC_UNKNOWN;
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
get_encoding(term_t t, IOENC *enc)
|
||||
{ atom_t en;
|
||||
|
||||
if ( PL_get_atom(t, &en) )
|
||||
{ IOENC encoding;
|
||||
|
||||
if ( (encoding = atom_to_encoding(en)) == ENC_UNKNOWN )
|
||||
return pl_error(NULL, 0, NULL, ERR_DOMAIN, t, "encoding");
|
||||
|
||||
*enc = encoding;
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
return pl_error(NULL, 0, NULL, ERR_TYPE, t, "encoding");
|
||||
}
|
||||
|
||||
|
||||
static foreign_t
|
||||
open_memory_file4(term_t handle, term_t mode, term_t stream, term_t options)
|
||||
{ memfile *m;
|
||||
char *x;
|
||||
atom_t iom;
|
||||
IOSTREAM *fd;
|
||||
IOENC encoding;
|
||||
int free_on_close = FALSE;
|
||||
|
||||
if ( !get_memfile(handle, &m) )
|
||||
return FALSE;
|
||||
if ( m->stream )
|
||||
return alreadyOpen(handle, "open");
|
||||
if ( !PL_get_atom(mode, &iom) )
|
||||
return pl_error("open_memory_file", 3, NULL, ERR_ARGTYPE, 2,
|
||||
mode, "io_mode");
|
||||
encoding = m->encoding;
|
||||
|
||||
if ( options )
|
||||
{ term_t tail = PL_copy_term_ref(options);
|
||||
term_t head = PL_new_term_ref();
|
||||
|
||||
while(PL_get_list(tail, head, tail))
|
||||
{ int arity;
|
||||
atom_t name;
|
||||
|
||||
if ( PL_get_name_arity(head, &name, &arity) && arity == 1 )
|
||||
{ term_t arg = PL_new_term_ref();
|
||||
|
||||
_PL_get_arg(1, head, arg);
|
||||
if ( name == ATOM_encoding )
|
||||
{ if ( !get_encoding(arg, &encoding) )
|
||||
return FALSE;
|
||||
} else if ( name == ATOM_free_on_close )
|
||||
{ if ( !PL_get_bool(arg, &free_on_close) )
|
||||
return pl_error("open_memory_file", 4, NULL, ERR_TYPE,
|
||||
arg, "boolean");
|
||||
}
|
||||
} else
|
||||
return pl_error("open_memory_file", 4, NULL, ERR_TYPE, head, "option");
|
||||
}
|
||||
if ( !PL_get_nil(tail) )
|
||||
return pl_error("open_memory_file", 4, NULL, ERR_TYPE, tail, "list");
|
||||
}
|
||||
|
||||
if ( iom == ATOM_write )
|
||||
{ x = "w";
|
||||
if ( m->atom )
|
||||
return pl_error("open_memory_file", 3, NULL, ERR_PERMISSION,
|
||||
handle, "write", "memory_file");
|
||||
if ( m->data )
|
||||
{ Sfree(m->data);
|
||||
m->data = NULL;
|
||||
}
|
||||
m->data_size = 0;
|
||||
m->size = NOSIZE; /* don't know */
|
||||
m->encoding = encoding;
|
||||
} else if ( iom == ATOM_read )
|
||||
{ x = "r";
|
||||
m->free_on_close = free_on_close;
|
||||
} else
|
||||
{ return pl_error("open_memory_file", 3, NULL, ERR_DOMAIN,
|
||||
mode, "io_mode");
|
||||
}
|
||||
|
||||
if ( !(fd = Sopenmem(&m->data, &m->data_size, x)) )
|
||||
return pl_error("open_memory_file", 3, NULL, ERR_ERRNO, errno,
|
||||
"create", "memory_file", handle);
|
||||
|
||||
fd->close_hook = closehook;
|
||||
fd->closure = m;
|
||||
fd->encoding = encoding;
|
||||
m->stream = fd;
|
||||
|
||||
return PL_unify_stream(stream, fd);
|
||||
}
|
||||
|
||||
|
||||
static foreign_t
|
||||
open_memory_file(term_t handle, term_t mode, term_t stream)
|
||||
{ return open_memory_file4(handle, mode, stream, 0);
|
||||
}
|
||||
|
||||
|
||||
|
||||
static foreign_t
|
||||
size_memory_file(term_t handle, term_t size)
|
||||
{ memfile *m;
|
||||
|
||||
if ( get_memfile(handle, &m) )
|
||||
{ if ( m->stream && !m->atom )
|
||||
return alreadyOpen(handle, "size");
|
||||
if ( m->data )
|
||||
{ if ( m->size == NOSIZE )
|
||||
{ switch( m->encoding )
|
||||
{ case ENC_ISO_LATIN_1:
|
||||
case ENC_OCTET:
|
||||
m->size = m->data_size;
|
||||
break;
|
||||
case ENC_WCHAR:
|
||||
m->size = m->data_size / sizeof(wchar_t);
|
||||
break;
|
||||
case ENC_UTF8:
|
||||
m->size = PL_utf8_strlen(m->data, m->data_size);
|
||||
break;
|
||||
default:
|
||||
assert(0);
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
return PL_unify_integer(size, m->size);
|
||||
} else
|
||||
return PL_unify_integer(size, 0);
|
||||
}
|
||||
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
utf8_position_memory_file(+MF, -Here, -Size)
|
||||
|
||||
Given MF is a UTF-8 encoded memory file, unify here with the
|
||||
byte-position of the read-pointer and Size with the total size of the
|
||||
memory file in bytes. This is a bit hacky predicate, but the information
|
||||
is easily available at low cost, while it is very valuable for producing
|
||||
answers in content-length computation of the HTTP server. See
|
||||
http_wrapper.pl
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
static foreign_t
|
||||
utf8_position(term_t handle, term_t here, term_t size)
|
||||
{ memfile *m;
|
||||
|
||||
if ( !get_memfile(handle, &m) )
|
||||
return FALSE;
|
||||
if ( m->encoding != ENC_UTF8 )
|
||||
return pl_error(NULL, 0, "no UTF-8 encoding",
|
||||
ERR_PERMISSION, handle, "utf8_position", "memory_file");
|
||||
if ( !PL_unify_integer(size, m->data_size) )
|
||||
return FALSE;
|
||||
if ( m->stream )
|
||||
{ IOPOS *op = m->stream->position;
|
||||
long p;
|
||||
|
||||
m->stream->position = NULL;
|
||||
p = Stell(m->stream);
|
||||
m->stream->position = op;
|
||||
|
||||
return PL_unify_integer(here, p);
|
||||
} else
|
||||
return PL_unify_integer(here, 0);
|
||||
}
|
||||
|
||||
|
||||
static foreign_t
|
||||
atom_to_memory_file(term_t atom, term_t handle)
|
||||
{ atom_t a;
|
||||
|
||||
if ( PL_get_atom(atom, &a) )
|
||||
{ memfile *m = calloc(1, sizeof(*m));
|
||||
|
||||
if ( !m )
|
||||
return pl_error(NULL, 0, NULL, ERR_ERRNO, errno, "create", "memory_file", handle);
|
||||
|
||||
m->atom = a;
|
||||
PL_register_atom(m->atom);
|
||||
m->magic = MEMFILE_MAGIC;
|
||||
|
||||
if ( (m->data = (char *)PL_atom_nchars(a, &m->size)) )
|
||||
{ m->encoding = ENC_ISO_LATIN_1;
|
||||
m->data_size = m->size;
|
||||
} else if ( (m->data = (char *)PL_atom_wchars(a, &m->size)) )
|
||||
{ m->encoding = ENC_WCHAR;
|
||||
m->data_size = m->size * sizeof(wchar_t);
|
||||
} else if ( PL_blob_data(a, &m->size, NULL) )
|
||||
{ m->data = PL_blob_data(a, &m->data_size, NULL);
|
||||
m->encoding = ENC_OCTET;
|
||||
m->size = m->data_size;
|
||||
}
|
||||
|
||||
if ( unify_memfile(handle, m) )
|
||||
return TRUE;
|
||||
else
|
||||
{ PL_unregister_atom(m->atom);
|
||||
m->magic = 0;
|
||||
free(m);
|
||||
return FALSE;
|
||||
}
|
||||
} else
|
||||
{ return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 1,
|
||||
atom, "atom");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static foreign_t
|
||||
memory_file_to_text(term_t handle, term_t atom, term_t encoding, int flags)
|
||||
{ memfile *m;
|
||||
|
||||
if ( get_memfile(handle, &m) )
|
||||
{ IOENC enc;
|
||||
|
||||
if ( encoding )
|
||||
{ if ( !get_encoding(encoding, &enc) )
|
||||
return FALSE;
|
||||
} else
|
||||
enc = m->encoding;
|
||||
|
||||
if ( m->stream )
|
||||
return alreadyOpen(handle, "to_atom");
|
||||
if ( m->data )
|
||||
{ switch(enc)
|
||||
{ case ENC_ISO_LATIN_1:
|
||||
case ENC_OCTET:
|
||||
return PL_unify_chars(atom, flags, m->data_size, m->data);
|
||||
case ENC_WCHAR:
|
||||
return PL_unify_wchars(atom, flags, m->data_size/sizeof(wchar_t), (pl_wchar_t*)m->data);
|
||||
case ENC_UTF8:
|
||||
return PL_unify_chars(atom, flags|REP_UTF8, m->data_size, m->data);
|
||||
default:
|
||||
assert(0);
|
||||
}
|
||||
} else
|
||||
return PL_unify_chars(atom, flags, 0, "");
|
||||
}
|
||||
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
|
||||
static foreign_t
|
||||
memory_file_to_atom2(term_t handle, term_t atom)
|
||||
{ return memory_file_to_text(handle, atom, 0, PL_ATOM);
|
||||
}
|
||||
|
||||
|
||||
static foreign_t
|
||||
memory_file_to_atom3(term_t handle, term_t atom, term_t encoding)
|
||||
{ return memory_file_to_text(handle, atom, encoding, PL_ATOM);
|
||||
}
|
||||
|
||||
|
||||
static foreign_t
|
||||
memory_file_to_codes2(term_t handle, term_t atom)
|
||||
{ return memory_file_to_text(handle, atom, 0, PL_CODE_LIST);
|
||||
}
|
||||
|
||||
|
||||
static foreign_t
|
||||
memory_file_to_codes3(term_t handle, term_t atom, term_t encoding)
|
||||
{ return memory_file_to_text(handle, atom, encoding, PL_CODE_LIST);
|
||||
}
|
||||
|
||||
|
||||
#define MKATOM(n) ATOM_ ## n = PL_new_atom(#n);
|
||||
|
||||
install_t
|
||||
install_memfile()
|
||||
{
|
||||
#if !_YAP_NOT_INSTALLED_
|
||||
if ( PL_query(PL_QUERY_VERSION) <= 50505 )
|
||||
{ PL_warning("Requires SWI-Prolog version 5.5.6 or later");
|
||||
return;
|
||||
}
|
||||
#endif
|
||||
|
||||
FUNCTOR_memory_file1 = PL_new_functor(PL_new_atom("$memory_file"), 1);
|
||||
MKATOM(encoding);
|
||||
MKATOM(unknown);
|
||||
MKATOM(octet);
|
||||
MKATOM(ascii);
|
||||
MKATOM(iso_latin_1);
|
||||
MKATOM(text);
|
||||
MKATOM(utf8);
|
||||
MKATOM(unicode_be);
|
||||
MKATOM(unicode_le);
|
||||
MKATOM(wchar_t);
|
||||
MKATOM(read);
|
||||
MKATOM(write);
|
||||
MKATOM(free_on_close);
|
||||
|
||||
PL_register_foreign("new_memory_file", 1, new_memory_file, 0);
|
||||
PL_register_foreign("free_memory_file", 1, free_memory_file, 0);
|
||||
PL_register_foreign("size_memory_file", 2, size_memory_file, 0);
|
||||
PL_register_foreign("open_memory_file", 3, open_memory_file, 0);
|
||||
PL_register_foreign("open_memory_file", 4, open_memory_file4, 0);
|
||||
PL_register_foreign("atom_to_memory_file", 2, atom_to_memory_file, 0);
|
||||
PL_register_foreign("memory_file_to_atom", 2, memory_file_to_atom2, 0);
|
||||
PL_register_foreign("memory_file_to_codes", 2, memory_file_to_codes2,0);
|
||||
PL_register_foreign("memory_file_to_atom", 3, memory_file_to_atom3, 0);
|
||||
PL_register_foreign("memory_file_to_codes", 3, memory_file_to_codes3,0);
|
||||
PL_register_foreign("utf8_position_memory_file", 3, utf8_position, 0);
|
||||
}
|
||||
Reference in New Issue
Block a user