| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | #include "master.hpp"
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-05-04 02:46:13 -04:00
										 |  |  | namespace factor | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | context::context(cell datastack_size, cell retainstack_size, cell callstack_size) : | 
					
						
							| 
									
										
										
										
											2009-11-08 20:44:18 -05:00
										 |  |  | 	callstack_top(NULL), | 
					
						
							|  |  |  | 	callstack_bottom(NULL), | 
					
						
							|  |  |  | 	datastack(0), | 
					
						
							|  |  |  | 	retainstack(0), | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | 	callstack_save(0), | 
					
						
							|  |  |  | 	datastack_seg(new segment(datastack_size,false)), | 
					
						
							|  |  |  | 	retainstack_seg(new segment(retainstack_size,false)), | 
					
						
							|  |  |  | 	callstack_seg(new segment(callstack_size,false)) | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | { | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | 	reset(); | 
					
						
							| 
									
										
										
										
											2010-03-18 05:06:00 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | void context::reset_datastack() | 
					
						
							|  |  |  | { | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | 	datastack = datastack_seg->start - sizeof(cell); | 
					
						
							| 
									
										
										
										
											2010-03-18 05:06:00 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | void context::reset_retainstack() | 
					
						
							|  |  |  | { | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | 	retainstack = retainstack_seg->start - sizeof(cell); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | void context::reset_callstack() | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	callstack_top = callstack_bottom = CALLSTACK_BOTTOM(this); | 
					
						
							| 
									
										
										
										
											2010-03-18 05:06:00 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | void context::reset_context_objects() | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	memset_cell(context_objects,false_object,context_object_count * sizeof(cell)); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | void context::reset() | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	reset_datastack(); | 
					
						
							|  |  |  | 	reset_retainstack(); | 
					
						
							|  |  |  | 	reset_callstack(); | 
					
						
							|  |  |  | 	reset_context_objects(); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-27 07:33:28 -04:00
										 |  |  | void context::fix_stacks() | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	if(datastack + sizeof(cell) < datastack_seg->start | 
					
						
							|  |  |  | 		|| datastack + stack_reserved >= datastack_seg->end) | 
					
						
							|  |  |  | 		reset_datastack(); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 	if(retainstack + sizeof(cell) < retainstack_seg->start | 
					
						
							|  |  |  | 		|| retainstack + stack_reserved >= retainstack_seg->end) | 
					
						
							|  |  |  | 		reset_retainstack(); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-06-11 20:06:00 -04:00
										 |  |  | void context::scrub_stacks(gc_info *info, cell index) | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	u8 *bitmap = info->gc_info_bitmap(); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 	{ | 
					
						
							| 
									
										
										
										
											2010-09-27 01:20:50 -04:00
										 |  |  | 		cell base = info->callsite_scrub_d(index); | 
					
						
							| 
									
										
										
										
											2010-06-11 20:06:00 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-09-27 01:20:50 -04:00
										 |  |  | 		for(cell loc = 0; loc < info->scrub_d_count; loc++) | 
					
						
							| 
									
										
										
										
											2010-06-11 20:06:00 -04:00
										 |  |  | 		{ | 
					
						
							|  |  |  | 			if(bitmap_p(bitmap,base + loc)) | 
					
						
							| 
									
										
										
										
											2010-06-13 17:36:08 -04:00
										 |  |  | 			{ | 
					
						
							|  |  |  | #ifdef DEBUG_GC_MAPS
 | 
					
						
							|  |  |  | 				std::cout << "scrubbing datastack location " << loc << std::endl; | 
					
						
							|  |  |  | #endif
 | 
					
						
							| 
									
										
										
										
											2010-06-17 01:48:39 -04:00
										 |  |  | 				*((cell *)datastack - loc) = 0; | 
					
						
							| 
									
										
										
										
											2010-06-13 17:36:08 -04:00
										 |  |  | 			} | 
					
						
							| 
									
										
										
										
											2010-06-11 20:06:00 -04:00
										 |  |  | 		} | 
					
						
							|  |  |  | 	} | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 	{ | 
					
						
							| 
									
										
										
										
											2010-09-27 01:20:50 -04:00
										 |  |  | 		cell base = info->callsite_scrub_r(index); | 
					
						
							| 
									
										
										
										
											2010-06-11 20:06:00 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-09-27 23:37:37 -04:00
										 |  |  | 		for(cell loc = 0; loc < info->scrub_r_count; loc++) | 
					
						
							| 
									
										
										
										
											2010-06-11 20:06:00 -04:00
										 |  |  | 		{ | 
					
						
							|  |  |  | 			if(bitmap_p(bitmap,base + loc)) | 
					
						
							| 
									
										
										
										
											2010-06-13 17:36:08 -04:00
										 |  |  | 			{ | 
					
						
							|  |  |  | #ifdef DEBUG_GC_MAPS
 | 
					
						
							|  |  |  | 				std::cout << "scrubbing retainstack location " << loc << std::endl; | 
					
						
							|  |  |  | #endif
 | 
					
						
							| 
									
										
										
										
											2010-06-17 01:48:39 -04:00
										 |  |  | 				*((cell *)retainstack - loc) = 0; | 
					
						
							| 
									
										
										
										
											2010-06-13 17:36:08 -04:00
										 |  |  | 			} | 
					
						
							| 
									
										
										
										
											2010-06-11 20:06:00 -04:00
										 |  |  | 		} | 
					
						
							|  |  |  | 	} | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | context::~context() | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	delete datastack_seg; | 
					
						
							|  |  |  | 	delete retainstack_seg; | 
					
						
							|  |  |  | 	delete callstack_seg; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | /* called on startup */ | 
					
						
							|  |  |  | void factor_vm::init_contexts(cell datastack_size_, cell retainstack_size_, cell callstack_size_) | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	datastack_size = datastack_size_; | 
					
						
							|  |  |  | 	retainstack_size = retainstack_size_; | 
					
						
							|  |  |  | 	callstack_size = callstack_size_; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 	ctx = NULL; | 
					
						
							|  |  |  | 	spare_ctx = new_context(); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | void factor_vm::delete_contexts() | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	assert(!ctx); | 
					
						
							| 
									
										
										
										
											2010-09-17 23:52:27 -04:00
										 |  |  | 	std::list<context *>::const_iterator iter = unused_contexts.begin(); | 
					
						
							|  |  |  | 	std::list<context *>::const_iterator end = unused_contexts.end(); | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | 	while(iter != end) | 
					
						
							|  |  |  | 	{ | 
					
						
							|  |  |  | 		delete *iter; | 
					
						
							|  |  |  | 		iter++; | 
					
						
							|  |  |  | 	} | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | context *factor_vm::new_context() | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | { | 
					
						
							| 
									
										
										
										
											2009-05-04 05:50:24 -04:00
										 |  |  | 	context *new_context; | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | 	if(unused_contexts.empty()) | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | 	{ | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | 		new_context = new context(datastack_size, | 
					
						
							|  |  |  | 			retainstack_size, | 
					
						
							|  |  |  | 			callstack_size); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | 	} | 
					
						
							|  |  |  | 	else | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | 	{ | 
					
						
							|  |  |  | 		new_context = unused_contexts.back(); | 
					
						
							|  |  |  | 		unused_contexts.pop_back(); | 
					
						
							|  |  |  | 	} | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 	new_context->reset(); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 	active_contexts.insert(new_context); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-05-04 05:50:24 -04:00
										 |  |  | 	return new_context; | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-04-01 22:12:45 -04:00
										 |  |  | void factor_vm::init_context(context *ctx) | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	ctx->context_objects[OBJ_CONTEXT] = allot_alien(ctx); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-27 02:55:49 -04:00
										 |  |  | context *new_context(factor_vm *parent) | 
					
						
							|  |  |  | { | 
					
						
							| 
									
										
										
										
											2010-04-01 22:12:45 -04:00
										 |  |  | 	context *new_context = parent->new_context(); | 
					
						
							|  |  |  | 	parent->init_context(new_context); | 
					
						
							|  |  |  | 	return new_context; | 
					
						
							| 
									
										
										
										
											2010-03-27 02:55:49 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | void factor_vm::delete_context(context *old_context) | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | { | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | 	unused_contexts.push_back(old_context); | 
					
						
							|  |  |  | 	active_contexts.erase(old_context); | 
					
						
							| 
									
										
										
										
											2010-09-17 23:52:27 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | 	while(unused_contexts.size() > 10) | 
					
						
							|  |  |  | 	{ | 
					
						
							|  |  |  | 		context *stale_context = unused_contexts.front(); | 
					
						
							|  |  |  | 		unused_contexts.pop_front(); | 
					
						
							|  |  |  | 		delete stale_context; | 
					
						
							|  |  |  | 	} | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-30 21:47:48 -04:00
										 |  |  | VM_C_API void delete_context(factor_vm *parent, context *old_context) | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	parent->delete_context(old_context); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-08-02 20:28:23 -04:00
										 |  |  | VM_C_API void reset_context(factor_vm *parent, context *ctx) | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	ctx->reset(); | 
					
						
							|  |  |  | 	parent->init_context(ctx); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-04-01 22:12:45 -04:00
										 |  |  | cell factor_vm::begin_callback(cell quot_) | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | { | 
					
						
							| 
									
										
										
										
											2010-04-01 22:12:45 -04:00
										 |  |  | 	data_root<object> quot(quot_,this); | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | 	ctx->reset(); | 
					
						
							|  |  |  | 	spare_ctx = new_context(); | 
					
						
							|  |  |  | 	callback_ids.push_back(callback_id++); | 
					
						
							| 
									
										
										
										
											2010-04-01 22:12:45 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | 	init_context(ctx); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 	return quot.value(); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-04-01 22:12:45 -04:00
										 |  |  | cell begin_callback(factor_vm *parent, cell quot) | 
					
						
							| 
									
										
										
										
											2009-08-17 16:37:04 -04:00
										 |  |  | { | 
					
						
							| 
									
										
										
										
											2010-04-01 22:12:45 -04:00
										 |  |  | 	return parent->begin_callback(quot); | 
					
						
							| 
									
										
										
										
											2009-08-17 16:37:04 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | void factor_vm::end_callback() | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | { | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | 	callback_ids.pop_back(); | 
					
						
							|  |  |  | 	delete_context(ctx); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | void end_callback(factor_vm *parent) | 
					
						
							| 
									
										
										
										
											2009-08-17 16:37:04 -04:00
										 |  |  | { | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | 	parent->end_callback(); | 
					
						
							| 
									
										
										
										
											2009-08-17 16:37:04 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | void factor_vm::primitive_current_callback() | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | { | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | 	ctx->push(tag_fixnum(callback_ids.back())); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-18 05:06:00 -04:00
										 |  |  | void factor_vm::primitive_context_object() | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	fixnum n = untag_fixnum(ctx->peek()); | 
					
						
							|  |  |  | 	ctx->replace(ctx->context_objects[n]); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | void factor_vm::primitive_set_context_object() | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	fixnum n = untag_fixnum(ctx->pop()); | 
					
						
							|  |  |  | 	cell value = ctx->pop(); | 
					
						
							|  |  |  | 	ctx->context_objects[n] = value; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-29 20:40:17 -04:00
										 |  |  | void factor_vm::primitive_context_object_for() | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	context *other_ctx = (context *)pinned_alien_offset(ctx->pop()); | 
					
						
							|  |  |  | 	fixnum n = untag_fixnum(ctx->pop()); | 
					
						
							|  |  |  | 	ctx->push(other_ctx->context_objects[n]); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | cell factor_vm::stack_to_array(cell bottom, cell top) | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | { | 
					
						
							| 
									
										
										
										
											2009-05-04 05:50:24 -04:00
										 |  |  | 	fixnum depth = (fixnum)(top - bottom + sizeof(cell)); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | 	if(depth < 0) | 
					
						
							| 
									
										
										
										
											2010-03-29 20:40:17 -04:00
										 |  |  | 		return false_object; | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | 	else | 
					
						
							|  |  |  | 	{ | 
					
						
							| 
									
										
										
										
											2009-10-20 13:45:00 -04:00
										 |  |  | 		array *a = allot_uninitialized_array<array>(depth / sizeof(cell)); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | 		memcpy(a + 1,(void*)bottom,depth); | 
					
						
							| 
									
										
										
										
											2010-03-29 20:40:17 -04:00
										 |  |  | 		return tag<array>(a); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | 	} | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-29 20:40:17 -04:00
										 |  |  | cell factor_vm::datastack_to_array(context *ctx) | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | { | 
					
						
							| 
									
										
										
										
											2010-03-29 20:40:17 -04:00
										 |  |  | 	cell array = stack_to_array(ctx->datastack_seg->start,ctx->datastack); | 
					
						
							|  |  |  | 	if(array == false_object) | 
					
						
							| 
									
										
										
										
											2010-03-30 21:47:48 -04:00
										 |  |  | 	{ | 
					
						
							| 
									
										
										
										
											2010-03-27 07:33:28 -04:00
										 |  |  | 		general_error(ERROR_DATASTACK_UNDERFLOW,false_object,false_object); | 
					
						
							| 
									
										
										
										
											2010-03-30 21:47:48 -04:00
										 |  |  | 		return false_object; | 
					
						
							|  |  |  | 	} | 
					
						
							| 
									
										
										
										
											2010-03-29 20:40:17 -04:00
										 |  |  | 	else | 
					
						
							|  |  |  | 		return array; | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-29 20:40:17 -04:00
										 |  |  | void factor_vm::primitive_datastack() | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | { | 
					
						
							| 
									
										
										
										
											2010-03-29 20:40:17 -04:00
										 |  |  | 	ctx->push(datastack_to_array(ctx)); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | void factor_vm::primitive_datastack_for() | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	context *other_ctx = (context *)pinned_alien_offset(ctx->pop()); | 
					
						
							|  |  |  | 	ctx->push(datastack_to_array(other_ctx)); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | cell factor_vm::retainstack_to_array(context *ctx) | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	cell array = stack_to_array(ctx->retainstack_seg->start,ctx->retainstack); | 
					
						
							|  |  |  | 	if(array == false_object) | 
					
						
							|  |  |  | 	{ | 
					
						
							| 
									
										
										
										
											2010-03-27 07:33:28 -04:00
										 |  |  | 		general_error(ERROR_RETAINSTACK_UNDERFLOW,false_object,false_object); | 
					
						
							| 
									
										
										
										
											2010-03-29 20:40:17 -04:00
										 |  |  | 		return false_object; | 
					
						
							|  |  |  | 	} | 
					
						
							|  |  |  | 	else | 
					
						
							|  |  |  | 		return array; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | void factor_vm::primitive_retainstack() | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	ctx->push(retainstack_to_array(ctx)); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | void factor_vm::primitive_retainstack_for() | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	context *other_ctx = (context *)pinned_alien_offset(ctx->pop()); | 
					
						
							|  |  |  | 	ctx->push(retainstack_to_array(other_ctx)); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | /* returns pointer to top of stack */ | 
					
						
							| 
									
										
										
										
											2009-09-23 14:05:46 -04:00
										 |  |  | cell factor_vm::array_to_stack(array *array, cell bottom) | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | { | 
					
						
							| 
									
										
										
										
											2009-05-04 05:50:24 -04:00
										 |  |  | 	cell depth = array_capacity(array) * sizeof(cell); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | 	memcpy((void*)bottom,array + 1,depth); | 
					
						
							| 
									
										
										
										
											2009-05-04 05:50:24 -04:00
										 |  |  | 	return bottom + depth - sizeof(cell); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-29 20:40:17 -04:00
										 |  |  | void factor_vm::set_datastack(context *ctx, array *array) | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	ctx->datastack = array_to_stack(array,ctx->datastack_seg->start); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-09-27 14:42:18 -04:00
										 |  |  | void factor_vm::primitive_set_datastack() | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | { | 
					
						
							| 
									
										
										
										
											2010-03-29 20:40:17 -04:00
										 |  |  | 	set_datastack(ctx,untag_check<array>(ctx->pop())); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | void factor_vm::set_retainstack(context *ctx, array *array) | 
					
						
							|  |  |  | { | 
					
						
							|  |  |  | 	ctx->retainstack = array_to_stack(array,ctx->retainstack_seg->start); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-09-27 14:42:18 -04:00
										 |  |  | void factor_vm::primitive_set_retainstack() | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | { | 
					
						
							| 
									
										
										
										
											2010-03-29 20:40:17 -04:00
										 |  |  | 	set_retainstack(ctx,untag_check<array>(ctx->pop())); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | /* Used to implement call( */ | 
					
						
							| 
									
										
										
										
											2009-09-27 14:42:18 -04:00
										 |  |  | void factor_vm::primitive_check_datastack() | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | { | 
					
						
							| 
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 |  |  | 	fixnum out = to_fixnum(ctx->pop()); | 
					
						
							|  |  |  | 	fixnum in = to_fixnum(ctx->pop()); | 
					
						
							| 
									
										
										
										
											2009-05-04 05:50:24 -04:00
										 |  |  | 	fixnum height = out - in; | 
					
						
							| 
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 |  |  | 	array *saved_datastack = untag_check<array>(ctx->pop()); | 
					
						
							| 
									
										
										
										
											2009-05-04 05:50:24 -04:00
										 |  |  | 	fixnum saved_height = array_capacity(saved_datastack); | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | 	fixnum current_height = (ctx->datastack - ctx->datastack_seg->start + sizeof(cell)) / sizeof(cell); | 
					
						
							| 
									
										
										
										
											2009-05-04 05:50:24 -04:00
										 |  |  | 	if(current_height - height != saved_height) | 
					
						
							| 
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 |  |  | 		ctx->push(false_object); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | 	else | 
					
						
							|  |  |  | 	{ | 
					
						
							| 
									
										
										
										
											2010-03-26 22:44:43 -04:00
										 |  |  | 		cell *ds_bot = (cell *)ctx->datastack_seg->start; | 
					
						
							| 
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 |  |  | 		for(fixnum i = 0; i < saved_height - in; i++) | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | 		{ | 
					
						
							| 
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 |  |  | 			if(ds_bot[i] != array_nth(saved_datastack,i)) | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | 			{ | 
					
						
							| 
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 |  |  | 				ctx->push(false_object); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | 				return; | 
					
						
							|  |  |  | 			} | 
					
						
							|  |  |  | 		} | 
					
						
							| 
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 |  |  | 		ctx->push(true_object); | 
					
						
							| 
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 |  |  | 	} | 
					
						
							|  |  |  | } | 
					
						
							| 
									
										
										
										
											2009-05-04 02:46:13 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-11-05 20:03:51 -05:00
										 |  |  | void factor_vm::primitive_load_locals() | 
					
						
							|  |  |  | { | 
					
						
							| 
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 |  |  | 	fixnum count = untag_fixnum(ctx->pop()); | 
					
						
							|  |  |  | 	memcpy((cell *)(ctx->retainstack + sizeof(cell)), | 
					
						
							|  |  |  | 		(cell *)(ctx->datastack - sizeof(cell) * (count - 1)), | 
					
						
							|  |  |  | 		sizeof(cell) * count); | 
					
						
							|  |  |  | 	ctx->datastack -= sizeof(cell) * count; | 
					
						
							|  |  |  | 	ctx->retainstack += sizeof(cell) * count; | 
					
						
							| 
									
										
										
										
											2009-11-05 20:03:51 -05:00
										 |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-05-04 02:46:13 -04:00
										 |  |  | } |