writing code for function activation using function-local literal frame

bin/main.c

@@ -1167,6 +1167,13 @@ hcl_logufmt (hcl, HCL_LOG_WARN, fmt, ustr, 0x6789);
 		trait |= HCL_TRAIT_INTERACTIVE;
 		hcl_setoption (hcl, HCL_TRAIT, &trait);
 	}
+else
+{
+	hcl_bitmask_t trait;
+	hcl_getoption (hcl, HCL_TRAIT, &trait);
+	trait |= HCL_TRAIT_INTERACTIVE;
+	hcl_setoption (hcl, HCL_TRAIT, &trait);
+}
 
 	while (1)
 	{

lib/comp.c

@@ -102,7 +102,7 @@ static int add_literal (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t* index)
 	}
 
 	*index = hcl->code.lit.len;
-	if (hcl->option.trait & HCL_TRAIT_INTERACTIVE) *index -= hcl->c->blk.info[hcl->c->blk.depth].litbase;
+	if (hcl->option.trait & HCL_TRAIT_INTERACTIVE) *index -= hcl->c->blk.info[hcl->c->blk.depth].lfbase;
 
 	((hcl_oop_oop_t)hcl->code.lit.arr)->slot[hcl->code.lit.len++] = obj;
 	return 0;
@@ -161,7 +161,7 @@ static int find_temporary_variable_backward (hcl_t* hcl, hcl_oop_t name, hcl_oow
 	return -1;
 }
 
-static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_count, hcl_oow_t lit_base)
+static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_count, hcl_oow_t lfbase)
 {
 	HCL_ASSERT (hcl, hcl->c->blk.depth >= 0);
 
@@ -179,7 +179,7 @@ static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_
 	}
 
 	hcl->c->blk.info[hcl->c->blk.depth].tmprcnt = tmpr_count;
-	hcl->c->blk.info[hcl->c->blk.depth].litbase = lit_base;
+	hcl->c->blk.info[hcl->c->blk.depth].lfbase = lfbase;
 	return 0;
 }
 
@@ -376,6 +376,7 @@ static int emit_double_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
 			}
 
 
+		case HCL_CODE_MAKE_FUNCTION: /* this is quad-param instruction. you should emit two more parameters after the call to this function */
 		case HCL_CODE_MAKE_BLOCK:
 			bc = cmd;
 			goto write_long;
@@ -407,33 +408,22 @@ write_long:
 	    emit_byte_instruction(hcl, param_2) <= -1) return -1;
 #endif
 	return 0;
+}
 
-/*
+static HCL_INLINE int emit_long_param (hcl_t* hcl, hcl_oow_t param)
-write_long2:
+{
-	if (param_1 > MAX_CODE_PARAM || param_2 > MAX_CODE_PARAM)
+	if (param > MAX_CODE_PARAM)
 	{
 		hcl_seterrnum (hcl, HCL_ERANGE);
 		return -1;
 	}
+
 #if (HCL_HCL_CODE_LONG_PARAM_SIZE == 2)
-	if (emit_byte_instruction(hcl, bc) <= -1 ||
+	return (emit_byte_instruction(hcl, param >> 8) <= -1 ||
-	    emit_byte_instruction(hcl, (param_1 >> 24) & 0xFF) <= -1 ||
+	        emit_byte_instruction(hcl, param & 0xFF) <= -1)? -1: 0;
-	    emit_byte_instruction(hcl, (param_1 >> 16) & 0xFF) <= -1 ||
-	    emit_byte_instruction(hcl, (param_1 >>  8) & 0xFF) <= -1 ||
-	    emit_byte_instruction(hcl, param_1 & 0xFF) <= -1  ||
-	    emit_byte_instruction(hcl, (param_2 >> 24) & 0xFF) <= -1 ||
-	    emit_byte_instruction(hcl, (param_2 >> 16) & 0xFF) <= -1 ||
-	    emit_byte_instruction(hcl, (param_2 >>  8) & 0xFF) <= -1 ||
-	    emit_byte_instruction(hcl, param_2 & 0xFF) <= -1) return -1;
 #else
-	if (emit_byte_instruction(hcl, bc) <= -1 ||
+	return emit_byte_instruction(hcl, param_1);
-	    emit_byte_instruction(hcl, param_1 >> 8) <= -1 ||
-	    emit_byte_instruction(hcl, param_1 & 0xFF) <= -1 ||
-	    emit_byte_instruction(hcl, param_2 >> 8) <= -1 ||
-	    emit_byte_instruction(hcl, param_2 & 0xFF) <= -1) return -1;
 #endif
-*/
-	return 0;
 }
 
 static int emit_push_literal (hcl_t* hcl, hcl_oop_t obj)
@@ -512,6 +502,16 @@ static HCL_INLINE void patch_long_jump (hcl_t* hcl, hcl_ooi_t jip, hcl_ooi_t jum
 #endif
 }
 
+static HCL_INLINE void patch_long_param (hcl_t* hcl, hcl_ooi_t ip, hcl_oow_t param)
+{
+#if (HCL_HCL_CODE_LONG_PARAM_SIZE == 2)
+	patch_instruction (hcl, ip, param >> 8);
+	patch_instruction (hcl, ip + 1, param & 0xFF);
+#else
+	patch_instruction (hcl, ip, param);
+#endif
+}
+
 /* ========================================================================= */
 static HCL_INLINE int _insert_cframe (hcl_t* hcl, hcl_ooi_t index, int opcode, hcl_oop_t operand)
 {
@@ -868,7 +868,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src, int defun)
 {
 	hcl_oop_t obj, args;
 	hcl_oow_t nargs, ntmprs;
-	hcl_ooi_t jump_inst_pos;
+	hcl_ooi_t jump_inst_pos, lfbase_pos, lfsize_pos;
 	hcl_oow_t saved_tv_count, tv_dup_start;
 	hcl_oop_t defun_name;
 
@@ -1062,7 +1062,20 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src, int defun)
 	hcl->c->blk.depth++;
 	if (store_temporary_variable_count_for_block(hcl, hcl->c->tv.size, hcl->code.lit.len) <= -1) return -1;
 
+
+	if (hcl->option.trait & HCL_TRAIT_INTERACTIVE)
+	{
+		/* make_function nargs ntmprs lfbase lfsize */
+		if (emit_double_param_instruction(hcl, HCL_CODE_MAKE_FUNCTION, nargs, ntmprs) <= -1) return -1;
+		lfbase_pos = hcl->code.bc.len;
+		if (emit_long_param(hcl, hcl->code.lit.len) <= -1) return -1; /* lfbase */
+		lfsize_pos = hcl->code.bc.len;
+		if (emit_long_param(hcl, 0) <= -1) return -1;
+	}
+	else
+	{
 		if (emit_double_param_instruction(hcl, HCL_CODE_MAKE_BLOCK, nargs, ntmprs) <= -1) return -1;
+	}
 
 	HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);  /* guaranteed in emit_byte_instruction() */
 	jump_inst_pos = hcl->code.bc.len;
@@ -1096,6 +1109,14 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src, int defun)
 
 	PUSH_SUBCFRAME (hcl, COP_EMIT_LAMBDA, HCL_SMOOI_TO_OOP(jump_inst_pos));
 
+	if (hcl->option.trait & HCL_TRAIT_INTERACTIVE)
+	{
+		hcl_cframe_t* cf;
+		cf = GET_SUBCFRAME (hcl);
+		cf->u.lambda.lfbase_pos = lfbase_pos;
+		cf->u.lambda.lfsize_pos= lfsize_pos;
+	}
+
 	return 0;
 }
 
@@ -2485,7 +2506,7 @@ static HCL_INLINE int emit_pop_into_dic (hcl_t* hcl)
 static HCL_INLINE int emit_lambda (hcl_t* hcl)
 {
 	hcl_cframe_t* cf;
-	hcl_oow_t block_code_size;
+	hcl_oow_t block_code_size, lfsize;
 	hcl_ooi_t jip;
 
 	cf = GET_TOP_CFRAME(hcl);
@@ -2494,6 +2515,9 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl)
 
 	jip = HCL_OOP_TO_SMOOI(cf->operand);
 
+	if (hcl->option.trait & HCL_TRAIT_INTERACTIVE) 
+		lfsize = hcl->code.lit.len - hcl->c->blk.info[hcl->c->blk.depth].lfbase;
+
 	hcl->c->blk.depth--;
 	hcl->c->tv.size = hcl->c->blk.info[hcl->c->blk.depth].tmprcnt;
 
@@ -2519,6 +2543,9 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl)
 	}
 	patch_long_jump (hcl, jip, block_code_size);
 
+	if (hcl->option.trait & HCL_TRAIT_INTERACTIVE) 
+		patch_long_param (hcl, cf->u.lambda.lfsize_pos, lfsize);
+
 	POP_CFRAME (hcl);
 	return 0;
 }

lib/exec.c

@@ -81,7 +81,7 @@ static HCL_INLINE const char* proc_state_to_string (int state)
 	{ \
 		STORE_ACTIVE_IP (hcl); \
 		(hcl)->active_context = (v_ctx); \
-		(hcl)->active_function = (hcl_oop_function_t)(hcl)->active_context->origin; \
+		(hcl)->active_function = (hcl)->active_context->origin->receiver_or_base; \
 		(hcl)->active_code = HCL_FUNCTION_GET_CODE_BYTE((hcl)->active_function); \
 		LOAD_ACTIVE_IP (hcl); \
 		(hcl)->processor->active->current_context = (hcl)->active_context; \
@@ -1017,7 +1017,7 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi
 	 * (printf ">>>> %d\n" (sum 10))
 	 */
 
-	/* the receiver must be a block context */
+	/* the receiver must be a function */
 	HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, rcv_func));
 
 	if (HCL_OOP_TO_SMOOI(rcv_func->nargs) != nargs)
@@ -1043,7 +1043,7 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi
 	blkctx->nargs = rcv_func->nargs;
 	blkctx->receiver_or_base = (hcl_oop_t)rcv_func;
 	blkctx->home = rcv_func->home;
-	blkctx->origin = rcv_func;
+	blkctx->origin = blkctx; /* the origin of the context over a function should be itself */
 
 /* TODO: check the stack size of a block context to see if it's large enough to hold arguments */
 	/* copy the arguments to the stack */
@@ -1319,7 +1319,7 @@ static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip)
 	ctx->sp = HCL_SMOOI_TO_OOP(-1); /* pointer to -1 below the bottom */
 	ctx->nargs = HCL_SMOOI_TO_OOP(0);
 	ctx->ntmprs = HCL_SMOOI_TO_OOP(0);
-	ctx->origin = hcl->initial_function;
+	ctx->origin = ctx; /* the origin of the initial context should be itself */
 	ctx->home = hcl->initial_function->home; /* this should be nil */
 	ctx->sender = (hcl_oop_context_t)hcl->_nil;
 	ctx->receiver_or_base = hcl->initial_function;
@@ -2255,7 +2255,7 @@ static int execute (hcl_t* hcl)
 					}
 
 /*
-//					HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context->origin) == hcl->_method_context);
+//					HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, hcl->active_context->origin) == hcl->_method_context);
 */
 					/* restore the stack pointer */
 					hcl->sp = HCL_OOP_TO_SMOOI(hcl->active_context->origin->sp);
@@ -2268,10 +2268,9 @@ static int execute (hcl_t* hcl)
 					{
 						/* the new active context is the fake initial context.
 						 * this context can't get executed further. */
+						HCL_ASSERT (hcl, HCL_IS_CONTEXT(hcl, hcl->active_context));
 						HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->sender == hcl->_nil);
-/*
+
-//							HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context) == hcl->_method_context);
-*/
 						HCL_ASSERT (hcl, hcl->active_context->receiver_or_base == hcl->_nil);
 						HCL_ASSERT (hcl, hcl->active_context == hcl->processor->active->initial_context);
 						HCL_ASSERT (hcl, hcl->active_context->origin == hcl->processor->active->initial_context->origin);
@@ -2304,9 +2303,9 @@ static int execute (hcl_t* hcl)
 				if (hcl->active_context == hcl->processor->active->initial_context)
 				{
 					/* the active context to return from is an initial context of
-					 * the active process. this process must have been created 
+					 * the active process. let's terminate the process. 
-					 * over a block using the newProcess method. let's terminate
+					 * the initial context has been forged over the initial function
-					 * the process. */
+					 * in start_initial_process_and_context() */
 					HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->sender == hcl->_nil);
 					terminate_process (hcl, hcl->processor->active);
 				}
@@ -2314,21 +2313,8 @@ static int execute (hcl_t* hcl)
 				{
 					/* it is a normal block return as the active block context 
 					 * is not the initial context of a process */
-
-					/* the process stack is shared. the return value 
-					 * doesn't need to get moved. */
-/*
-					//XXX SWITCH_ACTIVE_CONTEXT (hcl, (hcl_oop_context_t)hcl->active_context->sender);
-*/
-					if (hcl->active_context->sender == hcl->processor->active->initial_context)
-					{
-						terminate_process (hcl, hcl->processor->active);
-					}
-					else
-					{
 					SWITCH_ACTIVE_CONTEXT (hcl, (hcl_oop_context_t)hcl->active_context->sender);
 				}
-				}
 
 				break;
 

lib/hcl-prv.h

@@ -209,6 +209,12 @@ struct hcl_cframe_t
 		{
 			hcl_ooi_t index;
 		} bytearray_list;
+
+		struct
+		{
+			hcl_ooi_t lfbase_pos;
+			hcl_ooi_t lfsize_pos;
+		} lambda;
 	} u;
 };
 
@@ -217,7 +223,7 @@ typedef struct hcl_cframe_t hcl_cframe_t;
 struct hcl_blk_info_t
 {
 	hcl_oow_t tmprcnt;
-	hcl_oow_t litbase;
+	hcl_oow_t lfbase;
 };
 typedef struct hcl_blk_info_t hcl_blk_info_t;
 

lib/print.c

@@ -87,6 +87,7 @@ enum
 	WORD_CFRAME,
 	WORD_PRIM,
 
+	WORD_FUNCTION,
 	WORD_CONTEXT,
 	WORD_PROCESS,
 	WORD_PROCESS_SCHEDULER,
@@ -107,6 +108,7 @@ static struct
 	{  9,  { '#','<','C','F','R','A','M','E','>' } },
 	{  7,  { '#','<','P','R','I','M','>' } },
 
+	{  11, { '#','<','F','U','N','C','T','I','O','N','>' } },
 	{  10, { '#','<','C','O','N','T','E','X','T','>' } },
 	{  10, { '#','<','P','R','O','C','E','S','S','>' } },
 	{  20, { '#','<','P','R','O','C','E','S','S','-','S','C','H','E','D','U','L','E','R','>' } },
@@ -657,6 +659,10 @@ next:
 			word_index = WORD_PRIM;
 			goto print_word;
 
+		case HCL_BRAND_FUNCTION:
+			word_index = WORD_FUNCTION;
+			goto print_word;
+
 		case HCL_BRAND_CONTEXT:
 			word_index = WORD_CONTEXT;
 			goto print_word;