refactored comp.c a bit

hcl/lib/comp.c

@@ -549,7 +549,6 @@ enum
 
 static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
 {
-	hcl_cframe_t* cf;
 	hcl_oop_t obj, args;
 	hcl_oow_t nargs, ntmprs;
 	hcl_oow_t jump_inst_pos;
@@ -697,7 +696,11 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
 	hcl->c->blk.depth++;
 	if (store_temporary_variable_count_for_block (hcl, hcl->c->tv.size) <= -1) return -1;
 
-	if (emit_double_param_instruction (hcl, HCL_CODE_MAKE_BLOCK, nargs, ntmprs) <= -1) return -1;
+	/* use the accumulated number of temporaries so far when generating
+	 * the make_block instruction. at context activation time, the actual 
+	 * count of temporaries for this block is derived by subtracting the 
+	 * count of temporaries in the home context */
+	if (emit_double_param_instruction (hcl, HCL_CODE_MAKE_BLOCK, nargs, hcl->c->tv.size/*ntmprs*/) <= -1) return -1;
 
 	/* specifying MAX_CODE_JUMP causes emit_single_param_instruction() to 
 	 * produce the long jump instruction (BCODE_JUMP_FORWARD_X) */
@@ -706,11 +709,8 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
 
 	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj);
 
-	PUSH_SUBCFRAME (hcl, COP_EMIT_LAMBDA, hcl->_nil); /* operand field is not used for COP_EMIT_LAMBDA */
+	HCL_ASSERT (jump_inst_pos < HCL_SMOOI_MAX); /* guaranteed in emit_byte_instruction() */
-	cf = GET_SUBCFRAME (hcl); /* modify the EMIT_LAMBDA frame */
+	PUSH_SUBCFRAME (hcl, COP_EMIT_LAMBDA, HCL_SMOOI_TO_OOP(jump_inst_pos));
-	cf->u.lambda.jip = jump_inst_pos;
-	cf->u.lambda.nargs = nargs;
-	cf->u.lambda.ntmprs = ntmprs;
 
 	return 0;
 }
@@ -1057,16 +1057,19 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl)
 {
 	hcl_cframe_t* cf;
 	hcl_oow_t block_code_size;
+	hcl_oow_t jip;
 
 	cf = GET_TOP_CFRAME(hcl);
 	HCL_ASSERT (cf->opcode == COP_EMIT_LAMBDA);
-	HCL_ASSERT (HCL_IS_NIL(hcl, cf->operand));
+	HCL_ASSERT (HCL_OOP_IS_SMOOI(cf->operand));
+
+	jip = HCL_OOP_TO_SMOOI(cf->operand);
 
 	hcl->c->blk.depth--;
 	hcl->c->tv.size = hcl->c->blk.tmprcnt[hcl->c->blk.depth];
 
 	/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD instruction */
-	block_code_size = hcl->code.bc.len - cf->u.lambda.jip - (HCL_BCODE_LONG_PARAM_SIZE + 1);
+	block_code_size = hcl->code.bc.len - jip - (HCL_BCODE_LONG_PARAM_SIZE + 1);
 
 	if (block_code_size == 0)
  	{
@@ -1093,7 +1096,7 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl)
 		{
 			/* switch to JUMP2 instruction to allow a bigger jump offset.
 			 * up to twice MAX_CODE_JUMP only */
-			patch_instruction (hcl, cf->u.lambda.jip, HCL_CODE_JUMP2_FORWARD);
+			patch_instruction (hcl, jip, HCL_CODE_JUMP2_FORWARD);
 			jump_offset = block_code_size - MAX_CODE_JUMP;
 		}
 		else
@@ -1102,10 +1105,10 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl)
 		}
 
 	#if (HCL_BCODE_LONG_PARAM_SIZE == 2)
-		patch_instruction (hcl, cf->u.lambda.jip + 1, jump_offset >> 8);
+		patch_instruction (hcl, jip + 1, jump_offset >> 8);
-		patch_instruction (hcl, cf->u.lambda.jip + 2, jump_offset & 0xFF);
+		patch_instruction (hcl, jip + 2, jump_offset & 0xFF);
 	#else
-		patch_instruction (hcl, cf->u.lambda.jip + 1, jump_offset);
+		patch_instruction (hcl, jip + 1, jump_offset);
 	#endif
 	}
 

hcl/lib/exec.c

@@ -921,7 +921,6 @@ static int __activate_context (hcl_t* hcl, hcl_oop_context_t rcv_blkctx, hcl_ooi
 	               HCL_OOP_TO_SMOOI(((hcl_oop_context_t)rcv_blkctx->home)->ntmprs);
 	HCL_ASSERT (local_ntmprs >= nargs);
 
-
 	/* create a new block context to clone rcv_blkctx */
 	hcl_pushtmp (hcl, (hcl_oop_t*)&rcv_blkctx);
 	blkctx = (hcl_oop_context_t) make_context (hcl, local_ntmprs); 
@@ -2022,11 +2021,10 @@ return -1;
 				HCL_ASSERT (b2 >= b1);
 
 				/* the block context object created here is used as a base
-				 * object for block context activation. prim_block_value()
+				 * object for block context activation. activate_context()
 				 * clones a block context and activates the cloned context.
-				 * this base block context is created with no stack for 
+				 * this base block context is created with no temporaries
-				 * this reason */
+				 * for this reason */
-				//blkctx = (hcl_oop_context_t)hcl_instantiate (hcl, hcl->_block_context, HCL_NULL, 0); 
 				blkctx = (hcl_oop_context_t)make_context (hcl, 0);
 				if (!blkctx) return -1;
 

hcl/lib/hcl-prv.h

@@ -284,13 +284,6 @@ struct hcl_cframe_t
 	hcl_oop_t operand;
 	union
 	{
-		struct 
-		{
-			hcl_oow_t nargs;
-			hcl_oow_t ntmprs;
-			hcl_oow_t jip; /* jump instruction position */
-		} lambda;
-
 		struct
 		{
 			int var_type;

hcl/lib/main.c

@@ -399,7 +399,12 @@ if (mask & HCL_LOG_GC) return; /* don't show gc logs */
 		strcpy (ts, "0000-00-00 00:00:00 +0000");
 		tslen = 25; 
 	}
-	if (write_all (1, ts, tslen) <= -1) write (1, "XXXX ", 5);
+	if (write_all (1, ts, tslen) <= -1) 
+	{
+		char ttt[10];
+		snprintf (ttt, sizeof(ttt), "ERR: %d\n", errno);
+		write (1, ttt, strlen(ttt));
+	}
 
 	msgidx = 0;
 	while (len > 0)

hcl/lib/print.c

@@ -457,17 +457,6 @@ next:
 			OUTPUT_STRX (pr, word[WORD_SET].ptr, word[WORD_SET].len);
 			break;
 
-#if 0
-		case HCL_BRAND_PROCEDURE:
-			OUTPUT_STR (pr, "#<PROCEDURE>");
-			break;
-
-		case HCL_BRAND_CLOSURE:
-			OUTPUT_STR (pr, "#<CLOSURE>");
-			break;
-#endif
-
-
 		case HCL_BRAND_CFRAME:
 			OUTPUT_STRX (pr, word[WORD_CFRAME].ptr, word[WORD_CFRAME].len);
 			break;