2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								#include "master.hpp"
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:46:13 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								namespace factor
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-11-08 20:44:18 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								context::context(cell ds_size, cell rs_size) :
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									callstack_top(NULL),
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									callstack_bottom(NULL),
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									datastack(0),
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									retainstack(0),
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									datastack_region(new segment(ds_size,false)),
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									retainstack_region(new segment(rs_size,false)),
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									catchstack_save(0),
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									current_callback_save(0),
							 | 
						
					
						
							
								
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									next(NULL)
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{
							 | 
						
					
						
							
								
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									reset_datastack();
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									reset_retainstack();
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								}
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-23 14:05:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								context *factor_vm::alloc_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
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									if(unused_contexts)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									{
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 05:50:24 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
										new_context = unused_contexts;
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
										unused_contexts = unused_contexts->next;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									}
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									else
							 | 
						
					
						
							
								
									
										
										
										
											2009-11-08 20:44:18 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
										new_context = new context(ds_size,rs_size);
							 | 
						
					
						
							
								
									
										
										
										
											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
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								}
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-23 14:05:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								void factor_vm::dealloc_context(context *old_context)
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 05:50:24 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									old_context->next = unused_contexts;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									unused_contexts = old_context;
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								}
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								/* called on entry into a compiled callback */
							 | 
						
					
						
							
								
									
										
										
										
											2010-01-02 07:03:30 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								void factor_vm::nest_stacks()
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-16 12:39:22 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									context *new_ctx = alloc_context();
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-16 12:39:22 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									new_ctx->callstack_bottom = (stack_frame *)-1;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									new_ctx->callstack_top = (stack_frame *)-1;
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-23 01:33:53 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									/* save per-callback special_objects */
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									new_ctx->current_callback_save = special_objects[OBJ_CURRENT_CALLBACK];
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									new_ctx->catchstack_save = special_objects[OBJ_CATCHSTACK];
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-12-21 21:42:49 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									new_ctx->reset_datastack();
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									new_ctx->reset_retainstack();
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-16 12:39:22 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									new_ctx->next = ctx;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									ctx = new_ctx;
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								}
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2010-01-02 07:03:30 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								void nest_stacks(factor_vm *parent)
							 | 
						
					
						
							
								
									
										
										
										
											2009-08-17 16:37:04 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{
							 | 
						
					
						
							
								
									
										
										
										
											2010-01-02 07:03:30 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									return parent->nest_stacks();
							 | 
						
					
						
							
								
									
										
										
										
											2009-08-17 16:37:04 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								}
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								/* called when leaving a compiled callback */
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-23 14:05:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								void factor_vm::unnest_stacks()
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-23 01:33:53 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									/* restore per-callback special_objects */
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									special_objects[OBJ_CURRENT_CALLBACK] = ctx->current_callback_save;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									special_objects[OBJ_CATCHSTACK] = ctx->catchstack_save;
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-16 12:39:22 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									context *old_ctx = ctx;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									ctx = old_ctx->next;
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-16 05:33:35 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									dealloc_context(old_ctx);
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								}
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-18 21:31:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								void unnest_stacks(factor_vm *parent)
							 | 
						
					
						
							
								
									
										
										
										
											2009-08-17 16:37:04 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-18 21:31:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									return parent->unnest_stacks();
							 | 
						
					
						
							
								
									
										
										
										
											2009-08-17 16:37:04 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								}
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								/* called on startup */
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-23 14:05:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								void factor_vm::init_stacks(cell ds_size_, cell rs_size_)
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									ds_size = ds_size_;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									rs_size = rs_size_;
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-16 12:39:22 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									ctx = NULL;
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
									unused_contexts = NULL;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								}
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-23 14:05:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								bool 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)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
										return false;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									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);
							 | 
						
					
						
							
								
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
										ctx->push(tag<array>(a));
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
										return true;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									}
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								}
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-27 14:42:18 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								void factor_vm::primitive_datastack()
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{
							 | 
						
					
						
							
								
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									if(!stack_to_array(ctx->datastack_region->start,ctx->datastack))
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-18 21:26:21 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
										general_error(ERROR_DS_UNDERFLOW,false_object,false_object,NULL);
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								}
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-27 14:42:18 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								void factor_vm::primitive_retainstack()
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{
							 | 
						
					
						
							
								
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									if(!stack_to_array(ctx->retainstack_region->start,ctx->retainstack))
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-18 21:26:21 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
										general_error(ERROR_RS_UNDERFLOW,false_object,false_object,NULL);
							 | 
						
					
						
							
								
									
										
										
										
											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
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								}
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-27 14:42:18 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								void factor_vm::primitive_set_datastack()
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-04 02:00:30 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{
							 | 
						
					
						
							
								
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									ctx->datastack = array_to_stack(untag_check<array>(ctx->pop()),ctx->datastack_region->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
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{
							 | 
						
					
						
							
								
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									ctx->retainstack = array_to_stack(untag_check<array>(ctx->pop()),ctx->retainstack_region->start);
							 | 
						
					
						
							
								
									
										
										
										
											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);
							 | 
						
					
						
							
								
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
									fixnum current_height = (ctx->datastack - ctx->datastack_region->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
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
									{
							 | 
						
					
						
							
								
									
										
										
										
											2009-12-18 16:59:56 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
										cell *ds_bot = (cell *)ctx->datastack_region->start;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
										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
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								}
							 |