indirect_table *
new_indirect_table(void)
{ indirect_table *tab = PL_malloc(sizeof(*tab));
indirect_array *arr = &tab->array;
indirect_buckets *newtab = PL_malloc(sizeof(*newtab));
int i;
memset(tab, 0, sizeof(*tab));
#ifdef O_PLMT
simpleMutexInit(&tab->mutex);
#endif
for(i=0; i<MSB(PREALLOCATED_INDIRECT_BLOCKS); i++)
{ arr->blocks[i] = arr->preallocated;
}
newtab->size = 8;
newtab->buckets = PL_malloc(newtab->size*sizeof(*newtab->buckets));
memset(newtab->buckets, 0, newtab->size*sizeof(*newtab->buckets));
newtab->prev = NULL;
tab->table = newtab;
tab->no_hole_before = 1;
tab->highest = 1;
return tab;
}
ptr_hash *
new_ptr_hash(int entries, int shift)
{ ptr_hash *hash = PL_malloc(sizeof(*hash));
size_t size = sizeof(*hash->chains)*entries;
memset(hash, 0, sizeof(*hash));
hash->entries = entries;
hash->shift = shift;
hash->chains = PL_malloc(size);
memset(hash->chains, 0, size);
return hash;
}
static void
registerConsole(rlc_console c)
{ rlc_console *p;
int n;
LOCK();
for(;;)
{ for(p=consoles, n=0; n++<consoles_length; p++)
{ if ( !*p )
{ *p = c;
rlc_set(c, RLC_REGISTER, (uintptr_t)c, unregisterConsole);
UNLOCK();
return;
}
}
if ( consoles_length )
{ int bytes = consoles_length*sizeof(rlc_console);
consoles = PL_realloc(consoles, bytes*2);
memset(consoles+consoles_length, 0, bytes);
consoles_length *= 2;
} else
{ consoles_length = 10;
consoles = PL_malloc(consoles_length*sizeof(rlc_console));
memset(consoles, 0, consoles_length*sizeof(rlc_console));
}
}
}
atom_t
codeToAtom(int chrcode)
{ atom_t a;
if ( chrcode == EOF )
return ATOM_end_of_file;
assert(chrcode >= 0);
if ( chrcode < (1<<15) )
{ int page = chrcode / 256;
int entry = chrcode % 256;
atom_t *pv;
if ( !(pv=GD->atoms.for_code[page]) )
{ pv = PL_malloc(256*sizeof(atom_t));
memset(pv, 0, 256*sizeof(atom_t));
GD->atoms.for_code[page] = pv;
}
if ( !(a=pv[entry]) )
{ a = pv[entry] = uncachedCodeToAtom(chrcode);
}
} else
{ a = uncachedCodeToAtom(chrcode);
}
return a;
}
static int
int_mbscoll(const char *s1, const char *s2, int icase)
{ size_t l1 = strlen(s1);
size_t l2 = strlen(s2);
wchar_t *w1;
wchar_t *w2;
int ml1, ml2;
mbstate_t mbs;
int rc;
if ( l1 < 1024 && (w1 = alloca(sizeof(wchar_t)*(l1+1))) )
{ ml1 = FALSE;
} else
{ w1 = PL_malloc(sizeof(wchar_t)*(l1+1));
ml1 = TRUE;
}
if ( l2 < 1024 && (w2 = alloca(sizeof(wchar_t)*(l2+1))) )
{ ml2 = FALSE;
} else
{ w2 = PL_malloc(sizeof(wchar_t)*(l2+1));
ml2 = TRUE;
}
memset(&mbs, 0, sizeof(mbs));
if ( mbsrtowcs(w1, &s1, l1+1, &mbs) == (size_t)-1 )
{ rc = -2;
goto out;
}
if ( mbsrtowcs(w2, &s2, l2+1, &mbs) == (size_t)-1 )
{ rc = 2;
goto out;
}
if ( icase )
{ wstolower(w1, l1);
wstolower(w2, l2);
}
rc = wcscoll(w1, w2);
out:
if ( ml1 ) PL_free(w1);
if ( ml2 ) PL_free(w2);
return rc;
}
static range_context*
alloc_range_context(IOSTREAM *s)
{ range_context *ctx = PL_malloc(sizeof(*ctx));
memset(ctx, 0, sizeof(*ctx));
ctx->stream = s;
return ctx;
}
static chunked_context*
alloc_chunked_context(IOSTREAM *s)
{ chunked_context *ctx = PL_malloc(sizeof(*ctx));
memset(ctx, 0, sizeof(*ctx));
ctx->stream = s;
ctx->close_parent = FALSE;
return ctx;
}
static foreign_t pl_clingo_new(term_t ccontrol, term_t options) {
(void)options;
clingo_control_t *ctl;
char const *argv[] = {"-n", "0"};
clingo_wrapper *ar;
// TODO: no error checking here?
// TODO: might take a logger for handling info messages
clingo_control_new(argv, 2, NULL, NULL, 20, &ctl);
ar = PL_malloc(sizeof(*ar));
memset(ar, 0, sizeof(*ar));
ar->clingo = PL_malloc(sizeof(*ar->clingo));
memset(ar->clingo, 0, sizeof(*ar->clingo));
ar->magic = CLINGO_MAGIC;
ar->clingo->control = ctl;
return PL_unify_blob(ccontrol, ar, sizeof(*ar), &clingo_blob);
}
void
PL_save_text(PL_chars_t *text, int flags)
{ if ( (flags & BUF_MALLOC) && text->storage != PL_CHARS_MALLOC )
{ size_t bl = bufsize_text(text, text->length+1);
void *new = PL_malloc(bl);
memcpy(new, text->text.t, bl);
text->text.t = new;
text->storage = PL_CHARS_MALLOC;
} else if ( text->storage == PL_CHARS_LOCAL )
static char *
dupStr(const char *str)
{ if (str)
{ size_t len = strlen(str)+1;
char *m = PL_malloc(len);
memcpy(m, str, len);
return m;
}
return NULL;
}
static cgi_context*
alloc_cgi_context(IOSTREAM *s)
{ cgi_context *ctx = PL_malloc(sizeof(*ctx));
memset(ctx, 0, sizeof(*ctx));
ctx->magic = CGI_MAGIC;
ctx->stream = s;
return ctx;
}
static void
register_process(DWORD pid, HANDLE h)
{ win_process *wp = PL_malloc(sizeof(*wp));
wp->pid = pid;
wp->handle = h;
LOCK();
wp->next = processes;
processes = wp;
UNLOCK();
}
static int
init_charbuf_at_size(charbuf *cb, size_t size)
{ size++;
if ( size < sizeof(cb->tmp)/sizeof(pl_wchar_t) )
cb->base = cb->here = cb->tmp;
else
cb->base = cb->here = PL_malloc(size*sizeof(pl_wchar_t));
return TRUE;
}
static int
parse_environment(term_t t, p_options *info)
{ term_t tail = PL_copy_term_ref(t);
term_t head = PL_new_term_ref();
term_t tmp = PL_new_term_ref();
ecbuf *eb = &info->envbuf;
int count = 0;
#ifndef __WINDOWS__
echar *q;
char **ep;
int c = 0;
#endif
assert(eb->size == 0);
assert(eb->allocated == 0);
assert(eb->buffer == NULL);
while( PL_get_list(tail, head, tail) )
{ echar *s;
size_t len;
if ( !PL_is_functor(head, FUNCTOR_eq2) )
return type_error(head, "environment_variable");
if ( !get_echars_arg_ex(1, head, tmp, &s, &len) )
return FALSE;
add_ecbuf(eb, s, len);
add_ecbuf(eb, ECHARS("="), 1);
if ( !get_echars_arg_ex(2, head, tmp, &s, &len) )
return FALSE;
add_ecbuf(eb, s, len);
add_ecbuf(eb, ECHARS("\0"), 1);
count++;
}
if ( !PL_get_nil(tail) )
return type_error(tail, "list");
#ifdef __WINDOWS__
add_ecbuf(eb, ECHARS("\0"), 1);
#else
info->envp = PL_malloc((count+1)*sizeof(char*));
for(ep=info->envp, c=0, q=eb->buffer; c<count; c++, ep++)
{ *ep = q;
q += strlen(q)+1;
}
assert((size_t)(q-eb->buffer) == eb->size);
*ep = NULL;
#endif
return TRUE;
}
static int
get_exe(term_t exe, p_options *info)
{ int arity;
term_t arg = PL_new_term_ref();
if ( !PL_get_name_arity(exe, &info->exe_name, &arity) )
return type_error(exe, "callable");
PL_put_atom(arg, info->exe_name);
#ifdef __WINDOWS__
if ( !PL_get_wchars(arg, NULL, &info->exe, CVT_ATOM|CVT_EXCEPTION|BUF_MALLOC) )
return FALSE;
if ( !win_command_line(exe, arity, info->exe, &info->cmdline) )
return FALSE;
#else /*__WINDOWS__*/
if ( !PL_get_chars(arg, &info->exe, CVT_ATOM|CVT_EXCEPTION|BUF_MALLOC|REP_FN) )
return FALSE;
if ( !(info->argv = PL_malloc((arity+2)*sizeof(char*))) )
return PL_resource_error("memory");
memset(info->argv, 0, (arity+2)*sizeof(char*));
if ( !(info->argv[0] = PL_malloc(strlen(info->exe)+1)) )
return PL_resource_error("memory");
strcpy(info->argv[0], info->exe);
{ int i;
for(i=1; i<=arity; i++)
{ _PL_get_arg(i, exe, arg);
if ( !PL_get_chars(arg, &info->argv[i],
CVT_ATOMIC|CVT_EXCEPTION|BUF_MALLOC|REP_FN) )
return FALSE;
}
info->argv[i] = NULL;
}
#endif /*__WINDOWS__*/
return TRUE;
}
static void
rehash_indirect_table(indirect_table *tab)
{ if ( TIGHT(tab->table, tab) )
{ indirect_buckets *oldtab = tab->table;
indirect_buckets *newtab = PL_malloc(sizeof(*newtab));
unsigned int mask;
size_t index;
int i, last=FALSE;
newtab->size = oldtab->size * 2;
newtab->buckets = PL_malloc(newtab->size*sizeof(*newtab->buckets));
memset(newtab->buckets, 0, newtab->size*sizeof(*newtab->buckets));
newtab->prev = oldtab;
mask = newtab->size - 1;
for(index=1, i=0; !last; i++)
{ size_t upto = (size_t)2<<i;
indirect *b = tab->array.blocks[i];
if ( upto >= tab->highest )
{ upto = tab->highest;
last = TRUE;
}
for(; index<upto; index++)
{ indirect *a = b+index;
if ( INDIRECT_IS_VALID(a->references) )
{ size_t sz = wsizeofInd(a->header);
unsigned int v;
v = MurmurHashAligned2(a->data, sz*sizeof(word), MURMUR_SEED) & mask;
a->next = newtab->buckets[v];
newtab->buckets[v] = a;
}
}
}
tab->table = newtab;
}
}
static base_cache *
myBase()
{ base_cache *base;
if ( (base=pthread_getspecific(base_key)) )
return base;
base = PL_malloc(sizeof(*base));
memset(base, 0, sizeof(*base));
pthread_setspecific(base_key, base);
return base;
}
static indirect *
create_indirect(indirect *h, size_t index, word val ARG_LD)
{ Word idata = addressIndirect(val); /* points at header */
size_t isize = wsizeofInd(*idata); /* include header */
h->handle = (index<<LMASK_BITS)|tag(val)|STG_GLOBAL; /* (*) */
h->header = idata[0];
h->data = PL_malloc(isize*sizeof(word));
memcpy(h->data, &idata[1], isize*sizeof(word));
return h;
}
int
System(char *command) /* command is a UTF-8 string */
{ STARTUPINFOW sinfo;
PROCESS_INFORMATION pinfo;
int shell_rval;
size_t len;
wchar_t *wcmd;
memset(&sinfo, 0, sizeof(sinfo));
sinfo.cb = sizeof(sinfo);
len = utf8_strlen(command, strlen(command));
wcmd = PL_malloc((len+1)*sizeof(wchar_t));
utf8towcs(wcmd, command);
if ( CreateProcessW(NULL, /* module */
wcmd, /* command line */
NULL, /* Security stuff */
NULL, /* Thread security stuff */
FALSE, /* Inherit handles */
CREATE_NO_WINDOW, /* flags */
NULL, /* environment */
NULL, /* CWD */
&sinfo, /* startup info */
&pinfo) ) /* process into */
{ BOOL rval;
DWORD code;
CloseHandle(pinfo.hThread); /* don't need this */
PL_free(wcmd);
do
{ MSG msg;
if ( PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) )
{ TranslateMessage(&msg);
DispatchMessage(&msg);
} else
Sleep(50);
rval = GetExitCodeProcess(pinfo.hProcess, &code);
} while(rval == TRUE && code == STILL_ACTIVE);
shell_rval = (rval == TRUE ? code : -1);
CloseHandle(pinfo.hProcess);
} else
{ PL_free(wcmd);
return shell_rval = -1;
}
return shell_rval;
}
void
rememberExtensions(const char *module, const PL_extension *e)
{ ExtensionCell cell = PL_malloc(sizeof *cell);
cell->extensions = dupExtensions(e);
cell->next = NULL;
cell->module = dupStr(module);
if ( ext_tail )
{ ext_tail->next = cell;
ext_tail = cell;
} else
{ ext_head = ext_tail = cell;
}
}
static void
allocate_indirect_block(indirect_table *tab, int idx)
{ simpleMutexLock(&tab->mutex);
if ( !tab->array.blocks[idx] )
{ size_t bs = (size_t)1<<idx;
indirect *newblock;
if ( !(newblock=PL_malloc(bs*sizeof(*newblock))) )
outOfCore();
memset(newblock, 0, bs*sizeof(*newblock));
tab->array.blocks[idx] = newblock-bs;
}
simpleMutexUnlock(&tab->mutex);
}
int
add_ptr_hash(ptr_hash *hash, void *value)
{ int key = HASHKEY(hash, value);
ptr_hash_node *node;
for(node = hash->chains[key]; node; node = node->next)
{ if ( node->value == value )
return FALSE; /* already in hash */
}
node = PL_malloc(sizeof(*node));
node->value = value;
node->next = hash->chains[key];
hash->chains[key] = node;
return TRUE;
}
static stem_cache *
get_cache(void)
{ stem_cache *cache;
#ifndef __WINDOWS__
pthread_once(&stem_key_once, stem_key_alloc);
#endif
if ( (cache=(stem_cache*)pthread_getspecific(stem_key)) )
return cache;
if ( (cache = PL_malloc(sizeof(stem_cache))) )
memset(cache, 0, sizeof(*cache));
pthread_setspecific(stem_key, cache);
return cache;
}
static int
wrap_console(HANDLE h, IOSTREAM *s, IOFUNCTIONS *funcs)
{ ansi_stream *as;
as = PL_malloc(sizeof(*as));
memset(as, 0, sizeof(*as));
as->hConsole = h;
as->pStream = s;
as->saved_handle = s->handle;
s->handle = as;
s->encoding = ENC_WCHAR;
s->functions = funcs;
return TRUE;
}
static PL_extension *
dupExtensions(const PL_extension *e)
{ int i;
PL_extension *dup, *o;
int len = 0;
while(e[len++].predicate_name)
;
o = dup = PL_malloc(len*sizeof(*e));
for ( i=0; i<len; i++, o++, e++)
{ o->predicate_name = dupStr(e->predicate_name);
o->arity = e->arity;
o->function = e->function;
o->flags = e->flags;
}
return dup;
}
static ssize_t
do_write(void *handle, char *buffer, size_t size)
{ struct recall *rc = &recall_buffer;
switch(use_console)
{ case C_ATTACHED:
return write_console(handle, buffer, size);
case C_NONE:
if ( handle == Serror->handle )
{ if ( ask_attach(FALSE) )
{ if ( attach_console() )
return write_console(handle, buffer, size);
}
}
break;
case C_READ:
break;
case C_NEVER:
return size;
}
if ( !rc->data )
{ rc->allocated = 512;
rc->data = PL_malloc(rc->allocated);
rc->size = 0;
}
if ( size + rc->size <= rc->allocated )
{ memcpy(&rc->data[rc->size], buffer, size);
rc->size += size;
} else if ( size >= rc->allocated )
{ memcpy(rc->data, &buffer[size-rc->allocated], rc->allocated);
rc->size = rc->allocated;
} else
{ int leave = rc->allocated - size;
memmove(rc->data, &rc->data[rc->size-leave], leave);
memcpy(&rc->data+leave, buffer, size);
rc->size = rc->allocated;
}
return size;
}
static int
win_exec(size_t len, const wchar_t *cmd, UINT show)
{ GET_LD
STARTUPINFOW startup;
PROCESS_INFORMATION info;
int rval;
wchar_t *wcmd;
memset(&startup, 0, sizeof(startup));
startup.cb = sizeof(startup);
startup.wShowWindow = show;
/* ensure 0-terminated */
wcmd = PL_malloc((len+1)*sizeof(wchar_t));
memcpy(wcmd, cmd, len*sizeof(wchar_t));
wcmd[len] = 0;
rval = CreateProcessW(NULL, /* app */
wcmd,
NULL, NULL, /* security */
FALSE, /* inherit handles */
0, /* flags */
NULL, /* environment */
NULL, /* Directory */
&startup,
&info); /* process info */
PL_free(wcmd);
if ( rval )
{ CloseHandle(info.hProcess);
CloseHandle(info.hThread);
succeed;
} else
{ term_t tmp = PL_new_term_ref();
return ( PL_unify_wchars(tmp, PL_ATOM, len, cmd) &&
PL_error(NULL, 0, WinError(), ERR_SHELL_FAILED, tmp)
);
}
}
static int
add_charbuf(charbuf *cb, int c)
{ if ( cb->here < cb->end )
{ *cb->here++ = c;
} else
{ size_t len = (cb->end-cb->base);
if ( cb->base == cb->tmp )
{ pl_wchar_t *n = PL_malloc(len*2*sizeof(pl_wchar_t));
memcpy(n, cb->base, sizeof(cb->tmp));
cb->base = n;
} else
{ cb->base = PL_realloc(cb->base, len*2*sizeof(pl_wchar_t));
}
cb->here = &cb->base[len];
cb->end = &cb->base[len*2];
*cb->here++ = c;
}
return TRUE;
}
static int
add_ecbuf(ecbuf *b, echar *data, size_t len)
{ if ( b->size + len > b->allocated )
{ size_t newsize = (b->allocated ? b->allocated * 2 : 2048);
while( b->size + len > newsize )
newsize *= 2;
if ( b->buffer )
{ b->buffer = PL_realloc(b->buffer, newsize*sizeof(echar));
} else
{ b->buffer = PL_malloc(newsize*sizeof(echar));
}
b->allocated = newsize;
}
memcpy(b->buffer+b->size, data, len*sizeof(echar));
b->size += len;
return TRUE;
}
int
pushSegStack(segstack *stack, void *data)
{ if ( stack->top + stack->unit_size <= stack->max )
{ memcpy(stack->top, data, stack->unit_size);
stack->top += stack->unit_size;
stack->count++;
return TRUE;
} else
{ segchunk *chunk = PL_malloc(SEGSTACK_CHUNKSIZE);
if ( !chunk )
return FALSE; /* out of memory */
chunk->allocated = TRUE;
chunk->size = SEGSTACK_CHUNKSIZE;
chunk->next = NULL;
chunk->previous = stack->last;
chunk->top = chunk->data; /* async scanning */
if ( stack->last )
{ stack->last->next = chunk;
stack->last->top = stack->top;
stack->top = chunk->top; /* async scanning */
stack->last = chunk;
} else
{ stack->top = chunk->top; /* async scanning */
stack->last = stack->first = chunk;
}
stack->base = chunk->data;
stack->max = addPointer(chunk, chunk->size);
memcpy(chunk->data, data, stack->unit_size);
stack->top = chunk->data + stack->unit_size;
stack->count++;
return TRUE;
}
}
