enhancing the compiler and hcl_execute() for better interactive use

bin/main.c

@@ -1160,15 +1160,10 @@ hcl_logufmt (hcl, HCL_LOG_WARN, fmt, ustr, 0x6789);
 }
 #endif
 
-#if 1
+#if 0
-	if (xtn->reader_istty)
+// TODO: change the option name
-	{
+// in the INTERACTIVE mode, the compiler generates MAKE_FUNCTION for lambda functions.
-		hcl_bitmask_t trait;
+// in the non-INTERACTIVE mode, the compiler generates MAKE_CONTEXT for lambda functions.
-		hcl_getoption (hcl, HCL_TRAIT, &trait);
-		trait |= HCL_TRAIT_INTERACTIVE;
-		hcl_setoption (hcl, HCL_TRAIT, &trait);
-	}
-else
 {
 	hcl_bitmask_t trait;
 	hcl_getoption (hcl, HCL_TRAIT, &trait);
@@ -1215,11 +1210,15 @@ count++;
 		}
 		else
 		{
-			hcl_oow_t code_offset;
+			if (xtn->reader_istty)
-
+			{
-			code_offset = hcl_getbclen(hcl);
+				/* TODO: create a proper function for this and call it */
+				hcl->code.bc.len = 0;
+				hcl->code.lit.len = 0;
+			}
 
 			if (verbose) hcl_prbfmt (hcl, "\n"); /* flush the output buffer by hcl_print above */
+
 			if (hcl_compile(hcl, obj) <= -1)
 			{
 				if (hcl->errnum == HCL_ESYNERR)
@@ -1239,12 +1238,12 @@ count++;
 				/* interactive mode */
 				hcl_oop_t retv;
 
-				hcl_decode (hcl, code_offset, hcl_getbclen(hcl));
+				hcl_decode (hcl, 0, hcl_getbclen(hcl));
 				HCL_LOG0 (hcl, HCL_LOG_MNEMONIC, "------------------------------------------\n");
 				g_hcl = hcl;
 				//setup_tick ();
 
-				retv = hcl_executefromip(hcl, code_offset);
+				retv = hcl_execute(hcl);
 
 				/* flush pending output data in the interactive mode(e.g. printf without a newline) */
 				hcl_flushio (hcl); 

lib/comp.c

@@ -190,13 +190,11 @@ static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_
 static HCL_INLINE void patch_instruction (hcl_t* hcl, hcl_oow_t index, hcl_oob_t bc)
 {
 	HCL_ASSERT (hcl, index < hcl->code.bc.len);
-	hcl->code.bc.arr->slot[index] = bc;
+	hcl->code.bc.ptr[index] = bc;
 }
 
 static int emit_byte_instruction (hcl_t* hcl, hcl_oob_t bc)
 {
-	hcl_oow_t capa;
-
 	/* the context object has the ip field. it should be representable
 	 * in a small integer. for simplicity, limit the total byte code length
 	 * to fit in a small integer. because 'ip' points to the next instruction
@@ -208,23 +206,27 @@ static int emit_byte_instruction (hcl_t* hcl, hcl_oob_t bc)
 		return -1;
 	}
 
-	capa = HCL_OBJ_GET_SIZE(hcl->code.bc.arr);
+	if (hcl->code.bc.len >= hcl->code.bc.capa)
-	if (hcl->code.bc.len >= capa)
 	{
-		hcl_oop_t tmp;
+		hcl_oob_t* tmp;
 		hcl_oow_t newcapa;
 
-		newcapa = HCL_ALIGN(capa + 1, HCL_BC_BUFFER_ALIGN);
+		newcapa = HCL_ALIGN(hcl->code.bc.capa + 1, HCL_BC_BUFFER_ALIGN);
-		tmp = hcl_remakengcbytearray(hcl, (hcl_oop_t)hcl->code.bc.arr, newcapa);
+		tmp = hcl_reallocmem(hcl, hcl->code.bc.ptr, HCL_SIZEOF(*tmp) * newcapa);
 		if (!tmp) return -1;
 
-		hcl->code.bc.arr = (hcl_oop_byte_t)tmp;
+		hcl->code.bc.ptr = tmp;
+		hcl->code.bc.capa = newcapa;
 	}
 
-	hcl->code.bc.arr->slot[hcl->code.bc.len++] = bc;
+	hcl->code.bc.ptr[hcl->code.bc.len++] = bc;
 	return 0;
 }
 
+int hcl_emitbyteinstruction (hcl_t* hcl, hcl_oob_t bc)
+{
+	return emit_byte_instruction(hcl, bc);
+}
 
 static int emit_single_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1)
 {
@@ -486,13 +488,13 @@ static HCL_INLINE void patch_long_jump (hcl_t* hcl, hcl_ooi_t jip, hcl_ooi_t jum
 		
 		HCL_ASSERT (hcl, jump_offset <= MAX_CODE_JUMP * 2);
 
-		HCL_ASSERT (hcl, hcl->code.bc.arr->slot[jip] == HCL_CODE_JUMP_FORWARD_X ||
+		HCL_ASSERT (hcl, hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_X ||
-		            hcl->code.bc.arr->slot[jip] == HCL_CODE_JUMP_BACKWARD_X ||
+		                 hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_BACKWARD_X ||
-		            hcl->code.bc.arr->slot[jip] == HCL_CODE_JUMP_FORWARD_IF_TRUE ||
+		                 hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_IF_TRUE ||
-		            hcl->code.bc.arr->slot[jip] == HCL_CODE_JUMP_FORWARD_IF_FALSE);
+		                 hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_IF_FALSE);
 
 		/* JUMP2 instructions are chosen to be greater than its JUMP counterpart by 1 */
-		patch_instruction (hcl, jip, hcl->code.bc.arr->slot[jip] + 1); 
+		patch_instruction (hcl, jip, hcl->code.bc.ptr[jip] + 1); 
 		jump_offset -= MAX_CODE_JUMP;
 	}
 

lib/decode.c

@@ -77,7 +77,7 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
 	if (end > hcl->code.bc.len) end = hcl->code.bc.len;
 
 	ip = start;
-	cdptr = ((hcl_oop_byte_t)hcl->code.bc.arr)->slot;
+	cdptr = hcl->code.bc.ptr;
 
 /* TODO: check if ip increases beyond bcode when fetching parameters too */
 	while (ip < end)

lib/exec.c

@@ -1483,9 +1483,9 @@ static int execute (hcl_t* hcl)
 		hcl->proc_switched = 0;
 	#endif
 
-		if (HCL_UNLIKELY(hcl->ip >= hcl->code.bc.len)) 
+		if (HCL_UNLIKELY(hcl->ip >= HCL_FUNCTION_GET_CODE_SIZE(hcl->active_function)))
 		{
-			HCL_DEBUG1 (hcl, "Stopping executeion as IP reached the end of bytecode(%zu)\n", hcl->code.bc.len);
+			HCL_DEBUG1 (hcl, "Stopping execution as IP reached the end of bytecode(%zu)\n", hcl->code.bc.len);
 			return_value = hcl->_nil;
 			goto handle_return;
 		}
@@ -2186,7 +2186,7 @@ static int execute (hcl_t* hcl)
 				HCL_ASSERT (hcl, !HCL_STACK_ISEMPTY(hcl));
 
 				/* at the top level, the value is just popped off the stack
-				 * after evaluation of an expressio. so it's likely the
+				 * after evaluation of an expression. so it's likely the
 				 * return value of the last expression unless explicit
 				 * returning is performed */
 				hcl->last_retv = HCL_STACK_GETTOP(hcl);
@@ -2204,12 +2204,9 @@ static int execute (hcl_t* hcl)
 				return_value = hcl->active_context->origin->receiver_or_base;
 
 			handle_return:
+				hcl->last_retv = return_value;
 				if (hcl->active_context->origin == hcl->processor->active->initial_context->origin)
 				{
-/*
-//					HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context) == hcl->_block_context);
-//					HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->processor->active->initial_context) == hcl->_block_context);
-*/
 					/* decrement the instruction pointer back to the return instruction.
 					 * even if the context is reentered, it will just return.
 					 *hcl->ip--;*/
@@ -2222,7 +2219,6 @@ static int execute (hcl_t* hcl)
 					 * before context switching and marks a dead context */
 					if (hcl->active_context->origin == hcl->active_context)
 					{
-						/* returning from a method */
 /*
 //						HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context) == hcl->_method_context);
 */
@@ -2258,9 +2254,6 @@ static int execute (hcl_t* hcl)
 						hcl->active_context->origin->ip = HCL_SMOOI_TO_OOP(-1);
 					}
 
-/*
-//					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);
 					SWITCH_ACTIVE_CONTEXT (hcl, hcl->active_context->origin->sender);
@@ -2442,17 +2435,14 @@ oops:
 	return -1;
 }
 
-hcl_oop_t hcl_executefromip (hcl_t* hcl, hcl_oow_t initial_ip)
+hcl_oop_t hcl_execute (hcl_t* hcl)
 {
+//////////////////////////////////////////////////////////////////////////////////////////////
+	hcl_oop_function_t func;
 	int n;
 	hcl_bitmask_t log_default_type_mask;
 
 	HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); /* asserted by the compiler */
-	if (initial_ip >= hcl->code.bc.len)
-	{
-		hcl_seterrnum (hcl, HCL_EINVAL);
-		return HCL_NULL;
-	}
 
 	log_default_type_mask = hcl->log.default_type_mask;
 	hcl->log.default_type_mask |= HCL_LOG_VM;
@@ -2460,9 +2450,31 @@ hcl_oop_t hcl_executefromip (hcl_t* hcl, hcl_oow_t initial_ip)
 	HCL_ASSERT (hcl, hcl->initial_context == HCL_NULL);
 	HCL_ASSERT (hcl, hcl->active_context == HCL_NULL);
 
-	hcl->last_retv = hcl->_nil;
 
-	n = start_initial_process_and_context(hcl, initial_ip);
+	/* the code generated doesn't cater for its use as an initial funtion.
+	 * mutate the generated code so that the intiail function can break
+	 * out of the execution loop in execute() smoothly */
+#if 0
+	/* append RETURN_FROM_BLOCK */
+	if (hcl_emitbyteinstruction(hcl, HCL_CODE_RETURN_FROM_BLOCK) <= -1) return -1;
+#else
+	/* substitute RETURN_STACKTOP for POP_STACKTOP) */
+	HCL_ASSERT (hcl, hcl->code.bc.ptr[hcl->code.bc.len - 1] == HCL_CODE_POP_STACKTOP);
+	hcl->code.bc.ptr[hcl->code.bc.len - 1] = HCL_CODE_RETURN_STACKTOP;
+#endif
+
+	func = (hcl_oop_function_t)make_function(hcl, hcl->code.lit.len, hcl->code.bc.ptr, hcl->code.bc.len);
+	if (HCL_UNLIKELY(!func)) return HCL_NULL;
+
+	/* pass nil for the home context of the initial function */
+	fill_function_data (hcl, func, 0, 0, (hcl_oop_context_t)hcl->_nil, hcl->code.lit.arr->slot, hcl->code.lit.len);
+
+	hcl->initial_function = func;
+//////////////////////////////////////////////////////////////////////////////////////////////
+
+
+	hcl->last_retv = hcl->_nil;
+	n = start_initial_process_and_context(hcl, 0);
 	if (n >= 0) 
 	{
 		n = execute(hcl);
@@ -2477,23 +2489,6 @@ hcl_oop_t hcl_executefromip (hcl_t* hcl, hcl_oow_t initial_ip)
 	return (n <= -1)? HCL_NULL: hcl->last_retv;
 }
 
-hcl_oop_t hcl_execute (hcl_t* hcl)
-{
-//////////////////////////////////////////////////////////////////////////////////////////////
-	hcl_oop_function_t func;
-
-	func = (hcl_oop_function_t)make_function(hcl, hcl->code.lit.len, hcl->code.bc.arr->slot, hcl->code.bc.len);
-	if (HCL_UNLIKELY(!func)) return HCL_NULL;
-
-	/* pass nil for the home context of the initial function */
-	fill_function_data (hcl, func, 0, 0, (hcl_oop_context_t)hcl->_nil, hcl->code.lit.arr->slot, hcl->code.lit.len);
-
-	hcl->initial_function = func;
-//////////////////////////////////////////////////////////////////////////////////////////////
-
-	return hcl_executefromip (hcl, 0);
-}
-
 void hcl_abort (hcl_t* hcl)
 {
 	hcl->abort_req = 1;

lib/fmt.c

@@ -2145,7 +2145,7 @@ static HCL_INLINE int format_stack_args (hcl_fmtout_t* fmtout, hcl_ooi_t nargs,
 
 			if (!hcl_inttostr(hcl, arg, 10 | HCL_INTTOSTR_NONEWOBJ)) 
 			{
-				HCL_LOG1 (hcl, HCL_LOG_WARN | HCL_LOG_UNTYPED, "unable to convert %O to string \n", arg);
+				HCL_LOG2 (hcl, HCL_LOG_WARN | HCL_LOG_UNTYPED, "unable to convert %O for float output\n", arg, hcl_geterrmsg(hcl));
 				goto invalid_format;
 			}
 
@@ -2489,7 +2489,6 @@ static HCL_INLINE int format_stack_args (hcl_fmtout_t* fmtout, hcl_ooi_t nargs,
 			break;
 		}
 
-
 		print_integer:
 		{
 			const hcl_ooch_t* nsptr;
@@ -2523,7 +2522,7 @@ static HCL_INLINE int format_stack_args (hcl_fmtout_t* fmtout, hcl_ooi_t nargs,
 			{
 				/*hcl_seterrbfmt (hcl, HCL_EINVAL, "not a valid number - %O", arg);
 				goto oops;*/
-				HCL_LOG1 (hcl, HCL_LOG_WARN | HCL_LOG_UNTYPED, "unable to convert integer %O to string \n", arg);
+				HCL_LOG2 (hcl, HCL_LOG_WARN | HCL_LOG_UNTYPED, "unable to convert %O for integer output - %js\n", arg, hcl_geterrmsg(hcl));
 				goto invalid_format;
 			}
 

lib/gc.c

@@ -451,32 +451,32 @@ int hcl_ignite (hcl_t* hcl)
 
 	if (!hcl->_nil) 
 	{
-		hcl->_nil = hcl_makenil (hcl);
+		hcl->_nil = hcl_makenil(hcl);
-		if (!hcl->_nil) return -1;
+		if (HCL_UNLIKELY(!hcl->_nil)) return -1;
 	}
 
 	if (!hcl->_true) 
 	{
-		hcl->_true = hcl_maketrue (hcl);
+		hcl->_true = hcl_maketrue(hcl);
-		if (!hcl->_true) return -1;
+		if (HCL_UNLIKELY(!hcl->_true)) return -1;
 	}
 	if (!hcl->_false)
 	{
-		hcl->_false = hcl_makefalse (hcl);
+		hcl->_false = hcl_makefalse(hcl);
-		if (!hcl->_false) return -1;
+		if (HCL_UNLIKELY(!hcl->_false)) return -1;
 	}
 
 
 	if (!hcl->symtab) 
 	{
-		hcl->symtab = (hcl_oop_dic_t)hcl_makedic (hcl, hcl->option.dfl_symtab_size);
+		hcl->symtab = (hcl_oop_dic_t)hcl_makedic(hcl, hcl->option.dfl_symtab_size);
-		if (!hcl->symtab) return -1;
+		if (HCL_UNLIKELY(!hcl->symtab)) return -1;
 	}
 
 	if (!hcl->sysdic)
 	{
-		hcl->sysdic = (hcl_oop_dic_t)hcl_makedic (hcl, hcl->option.dfl_sysdic_size);
+		hcl->sysdic = (hcl_oop_dic_t)hcl_makedic(hcl, hcl->option.dfl_sysdic_size);
-		if (!hcl->sysdic) return -1;
+		if (HCL_UNLIKELY(!hcl->sysdic)) return -1;
 	}
 
 	/* symbol table available now. symbols can be created */
@@ -484,8 +484,8 @@ int hcl_ignite (hcl_t* hcl)
 	{
 		hcl_oop_t tmp;
 
-		tmp = hcl_makesymbol (hcl, syminfo[i].ptr, syminfo[i].len);
+		tmp = hcl_makesymbol(hcl, syminfo[i].ptr, syminfo[i].len);
-		if (!tmp) return -1;
+		if (HCL_UNLIKELY(!tmp)) return -1;
 
 		HCL_OBJ_SET_FLAGS_SYNCODE (tmp, syminfo[i].syncode);
 		*(hcl_oop_t*)((hcl_uint8_t*)hcl + syminfo[i].offset) = tmp;
@@ -496,29 +496,32 @@ int hcl_ignite (hcl_t* hcl)
 		/* Create a nil process used to simplify nil check in GC.
 		 * only accessible by VM. not exported via the global dictionary. */
 		hcl->nil_process = (hcl_oop_process_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS);
-		if (!hcl->nil_process) return -1;
+		if (HCL_UNLIKELY(!hcl->nil_process)) return -1;
 		hcl->nil_process->sp = HCL_SMOOI_TO_OOP(-1);
 	}
 
 	if (!hcl->processor)
 	{
 		hcl->processor = (hcl_oop_process_scheduler_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS_SCHEDULER, HCL_PROCESS_SCHEDULER_NAMED_INSTVARS);
-		if (!hcl->processor) return -1;
+		if (HCL_UNLIKELY(!hcl->processor)) return -1;
 		hcl->processor->tally = HCL_SMOOI_TO_OOP(0);
 		hcl->processor->active = hcl->nil_process;
 	}
 
-	if (!hcl->code.bc.arr)
+	/* TODO: move code.bc.ptr creation to hcl_init? */
+	if (!hcl->code.bc.ptr)
 	{
-		hcl->code.bc.arr = (hcl_oop_byte_t)hcl_makengcbytearray(hcl, HCL_NULL, HCL_BC_BUFFER_INIT); /* TODO: set a proper intial size */
+		hcl->code.bc.ptr = (hcl_oop_byte_t)hcl_allocmem(hcl, HCL_SIZEOF(*hcl->code.bc.ptr) * HCL_BC_BUFFER_INIT); /* TODO: set a proper intial size */
-		if (!hcl->code.bc.arr) return -1;
+		if (HCL_UNLIKELY(!hcl->code.bc.ptr)) return -1;
 		HCL_ASSERT (hcl, hcl->code.bc.len == 0);
+		hcl->code.bc.capa = HCL_BC_BUFFER_INIT;
 	}
 
+	/* TODO: move code.lit.arr creation to hcl_init() after swithching to hcl_allocmem? */
 	if (!hcl->code.lit.arr)
 	{
 		hcl->code.lit.arr = (hcl_oop_oop_t)hcl_makengcarray(hcl, HCL_LIT_BUFFER_INIT); /* TOOD: set a proper initial size */
-		if (!hcl->code.lit.arr) return -1;
+		if (HCL_UNLIKELY(!hcl->code.lit.arr)) return -1;
 		HCL_ASSERT (hcl, hcl->code.lit.len == 0);
 	}
 

lib/hcl-prv.h

@@ -1093,7 +1093,7 @@ hcl_pfbase_t* hcl_querymod (
 );
 
 /* ========================================================================= */
-/* fmt.c                                                                  */
+/* fmt.c                                                                     */
 /* ========================================================================= */
 int hcl_fmt_object_ (
 	hcl_fmtout_t* fmtout,
@@ -1115,6 +1115,14 @@ int hcl_strfmtcallstack (
 	hcl_ooi_t nargs
 );
 
+/* ========================================================================= */
+/* comp.c                                                                    */
+/* ========================================================================= */
+int hcl_emitbyteinstruction (
+	hcl_t*     hcl,
+	hcl_oob_t  bc
+);
+
 #if defined(__cplusplus)
 }
 #endif

lib/hcl.c

@@ -241,10 +241,10 @@ void hcl_fini (hcl_t* hcl)
 		hcl->proc_map_free_last = -1;
 	}
 
-	if (hcl->code.bc.arr)
+	if (hcl->code.bc.ptr)
 	{
-		hcl_freengcobj (hcl, (hcl_oop_t)hcl->code.bc.arr);
+		hcl_freemem (hcl, hcl->code.bc.ptr);
-		hcl->code.bc.arr = HCL_NULL;
+		hcl->code.bc.ptr = HCL_NULL;
 		hcl->code.bc.len = 0;
 	}
 

lib/hcl.h

@@ -1285,8 +1285,9 @@ struct hcl_t
 	{
 		struct
 		{
-			hcl_oop_byte_t arr; /* byte code array - not part of object memory */
+			hcl_oob_t* ptr; /* byte code array */
 			hcl_oow_t len;
+			hcl_oow_t capa;
 		} bc;
 
 		struct
@@ -1650,11 +1651,6 @@ HCL_EXPORT hcl_oop_t hcl_execute (
 	hcl_t* hcl
 );
 
-HCL_EXPORT hcl_oop_t hcl_executefromip (
-	hcl_t*    hcl,
-	hcl_oow_t initial_ip
-);
-
 HCL_EXPORT void hcl_abort (
 	hcl_t* hcl
 );