static void relocate_prolog_memory(prolog_engine *pe, long stack_max_offset, long stack_heap_offset, long trail_offset)
{
register_set *s;
PCell *p, *t;
choice_point *b;
/* fix register stack */
for (s = pe->reg_stack_base; s < pe->reg_stack_top; s++) {
s->SP.ptr += stack_heap_offset;
s->E.ptr += stack_heap_offset;
s->SPB.ptr += stack_heap_offset;
s->HB.ptr += stack_heap_offset;
s->H.ptr += stack_heap_offset;
s->TR.ptr += trail_offset;
if (s->B.ptr) s->B.ptr += trail_offset;
}
/* scan stack */
/* Brute force approach! */
{
for (p = pe->reg.E.ptr; p < pe->stack_base; p++) {
if (p->ptr > pe->stack_max - stack_max_offset && p->ptr < pe->trail_base - trail_offset)
{
do_offset(p, stack_heap_offset);
}
}
}
/* fix heap */
for (p = pe->heap_base; p < pe->reg.H.ptr; ) {
p += do_offset(p, stack_heap_offset);
}
/* scan trail */
for (b = pe->reg.B.cp, t = pe->reg.TR.ptr; b; t = (PCell *)(b + 1), b = b->B.cp) {
if (b->B.ptr) b->B.ptr += trail_offset;
b->SPB.ptr += stack_heap_offset;
b->HB.ptr += stack_heap_offset;
for (p = t ; (void *)p < (void *)b; p++) p->ptr += stack_heap_offset;
}
/* globals */
if (pe->globals_free_list.uint != MMK_INT(-1)) {
/* First adjust the free lists by trail_offset */
for (p = pe->globals_free_list.ptr; p->uint != MMK_INT(-1); p = p->ptr) {
p->ptr += trail_offset;
}
/* Then adjust the rest, skiping over free list items */
for (p = pe->trail_base; p < pe->globals_base; p++) {
if (MTP_TAG(p->sint) != MTP_CONST && !(p->ptr >= pe->trail_base && p->ptr < pe->globals_base)) {
do_offset(p, stack_heap_offset);
}
}
}
}
ERL_NIF_TERM date_roll(ErlNifEnv* env, int argc,
const ERL_NIF_TERM argv[])
{
UErrorCode status = U_ZERO_ERROR;
UCalendar* cal;
cloner* ptr;
double date;
if(!((argc == 3)
&& enif_get_resource(env, argv[0], calendar_type, (void**) &ptr)
&& enif_get_double(env, argv[1], &date))) {
return enif_make_badarg(env);
}
cal = (UCalendar*) cloner_get(ptr);
CHECK_RES(env, cal);
ucal_setMillis(cal, (UDate) date, &status);
CHECK(env, status);
return do_offset(env, cal, ucal_roll, argv[2]);
}
static void relocate_heap(long offset)
{
PWord *p, *e, *b, *t;
int i;
PWord *old_wm_stackbot = wm_stackbot;
PWord *old_wm_trailbase = wm_trailbase;
/* fix pointers! */
wm_stackbot += offset;
wm_stackbot_safety += offset;
wm_heapbase += offset;
wm_trailbase += offset;
wm_gvbase += offset;
wm_gvfreelist += offset;
/* registers */
for (i = 0; i <= wm_regidx; i++) {
wm_regs[i][wm_B_idx] += offset;
wm_regs[i][wm_HB_idx] += offset;
wm_regs[i][wm_SPB_idx] += offset;
wm_regs[i][wm_E_idx] += offset;
wm_regs[i][wm_TR_idx] += offset;
wm_regs[i][wm_H_idx] += offset;
wm_regs[i][wm_SP_idx] += offset;
}
/* scan heap */
for (p = wm_heapbase; p < wm_H; ) {
p += do_offset(p, offset);
}
/* scan trail*/
for (b = wm_B, t = wm_TR; b; t = b+4 , b = chpt_B(b)) {
if (chpt_B(b)) chpt_B(b) += offset;
for (p = t ; p < b; p++) *p += offset*4;
chpt_SPB(b) += offset;
chpt_HB(b) += offset;
}
/* scan stack */
#if 0
// first fix e chain
for (e = wm_E; e < wm_heapbase; e = env_E(e)) {
env_E(e) += offset;
}
for (b = wm_B, e = wm_E; b; b = chpt_B(b)) {
long *spb, *next_e;
spb = (long *) (((long) chpt_SPB(b)) & ~1);
next_e = env_E(e);
if (spb <= next_e) {
for (p = e+2; p < spb; p++) {
do_offset(p, offset);
}
} else {
for (; e < spb; e = next_e, next_e = env_E(e)) {
if (spb < next_e) {
for (p = e+2; p < spb; p++)
do_offset(p, offset);
} else {
for (p = e+2; p < next_e; p++)
do_offset(p, offset);
}
}
}
}
#endif
#if 0
{
PWord *next_e;
for (e = wm_E, b = wm_B; e < wm_heapbase ; e = next_e) {
*e += offset*4;
if (b && ((PWord)chpt_SPB(b) & ~1) <= *e) {
next_e = (long *) ((long) chpt_SPB(b) & ~1);
b = chpt_B(b);
if (b == 0) break;
} else
{
next_e = (PWord *)*e;
}
for (p = e+2; p < next_e; p++) do_offset(p, offset);
}
}
#endif
#if 0
for (f = wm_E, b = wm_B; chpt_B(b) ; ) {
if (chpt_SPB(b) <= *f) {
next_f =
}
#endif
/* Brute force approach! */
{
for (p = wm_E; p < wm_heapbase; p++) {
if ((long *)*p > old_wm_stackbot && (long *)*p < old_wm_trailbase) {
do_offset(p, offset);
}
}
}
//globals
for (p = wm_trailbase; p < wm_gvbase; p++) {
do_offset(p, offset);
}
}
void *heap_ring[4] = {0,0,0,0};
int heap_ring_index = 0;
void newheap(void);
void newheap(void)
{
PWord *new_wm_stackbot, *old_wm_stackbot, *p;
size_t heapsize, stacksize, size;
long offset;
prolog_control_invariant();
heapsize = wm_gvbase - wm_heapbase + 1;
stacksize = wm_heapbase - wm_stackbot;
size = heapsize+stacksize;
old_wm_stackbot = wm_stackbot;
/* Allocate the new prolog memory */
if (heap_ring[heap_ring_index]) new_wm_stackbot = heap_ring[heap_ring_index];
else {
new_wm_stackbot = reallocate_prolog_heap_and_stack(size);
heap_ring[heap_ring_index] = new_wm_stackbot;
}
//new parse area
memcpy(new_wm_stackbot, old_wm_stackbot, size * sizeof(PWord));
// zero old area and free
for (p = old_wm_stackbot+size-1; p >= old_wm_stackbot; p--) *p = 0xFFFFFF00;
//free(old_wm_stackbot);
offset = new_wm_stackbot - old_wm_stackbot;
relocate_heap(offset);
/* test - recopy to original positions and relocate */
#if 0
memcpy(old_wm_stackbot, new_wm_stackbot, size * sizeof(PWord));
relocate_heap(-offset);
free(new_wm_stackbot);
#endif
prolog_control_invariant();
heap_ring_index = (heap_ring_index + 1) % 4;
}