Ejemplo n.º 1
0
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);
			}
		}
	}
}
Ejemplo n.º 2
0
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]);
}
Ejemplo n.º 3
0
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;
}