diff --git a/lib/comp.c b/lib/comp.c index 753c306..3313db6 100644 --- a/lib/comp.c +++ b/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 */ - cf = GET_SUBCFRAME (hcl); /* modify the EMIT_LAMBDA frame */ - cf->u.lambda.jip = jump_inst_pos; - cf->u.lambda.nargs = nargs; - cf->u.lambda.ntmprs = ntmprs; + HCL_ASSERT (jump_inst_pos < HCL_SMOOI_MAX); /* guaranteed in emit_byte_instruction() */ + PUSH_SUBCFRAME (hcl, COP_EMIT_LAMBDA, HCL_SMOOI_TO_OOP(jump_inst_pos)); 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, cf->u.lambda.jip + 2, jump_offset & 0xFF); + patch_instruction (hcl, jip + 1, jump_offset >> 8); + 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 } diff --git a/lib/exec.c b/lib/exec.c index c4b644a..461efe5 100644 --- a/lib/exec.c +++ b/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 reason */ - //blkctx = (hcl_oop_context_t)hcl_instantiate (hcl, hcl->_block_context, HCL_NULL, 0); + * this base block context is created with no temporaries + * for this reason */ blkctx = (hcl_oop_context_t)make_context (hcl, 0); if (!blkctx) return -1; diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index b91f891..c365b99 100644 --- a/lib/hcl-prv.h +++ b/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; diff --git a/lib/main.c b/lib/main.c index 378e1a0..93cffc0 100644 --- a/lib/main.c +++ b/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) diff --git a/lib/print.c b/lib/print.c index c75f4bd..eb963ca 100644 --- a/lib/print.c +++ b/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, "#"); - break; - - case HCL_BRAND_CLOSURE: - OUTPUT_STR (pr, "#"); - break; -#endif - - case HCL_BRAND_CFRAME: OUTPUT_STRX (pr, word[WORD_CFRAME].ptr, word[WORD_CFRAME].len); break;