From faea7b60df23c92ae29f56b62f210fd42be8c5c8 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Tue, 11 May 2021 15:04:53 +0000 Subject: [PATCH] writing code for return variables support --- README.md | 10 ++++++++++ lib/decode.c | 5 +++++ lib/err.c | 7 ++++--- lib/exec.c | 55 ++++++++++++++++++++++++++++++++++++++++----------- lib/hcl-prv.h | 33 ++++++++++++++++--------------- lib/hcl.h | 1 + 6 files changed, 81 insertions(+), 30 deletions(-) diff --git a/README.md b/README.md index accccb9..bd35101 100644 --- a/README.md +++ b/README.md @@ -78,6 +78,16 @@ A HCL program is composed of expressions. ) ``` +## Redefining a primitive function + +``` +(set prim-plus +) +(defun + (a b ...) + (prim-plus a b 9999) +) + +(printf "%d\n" (+ 10 20)) +``` ## HCL Exchange Protocol diff --git a/lib/decode.c b/lib/decode.c index de6fc84..ea3e850 100644 --- a/lib/decode.c +++ b/lib/decode.c @@ -335,6 +335,11 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end) break; /* -------------------------------------------------------- */ + case HCL_CODE_CALL_R: + FETCH_PARAM_CODE_TO (hcl, b1); /* nargs */ + FETCH_PARAM_CODE_TO (hcl, b2); /* nrvars */ + LOG_INST_2 (hcl, "call %zu %zu", b1, b2); + break; case HCL_CODE_CALL_X: FETCH_PARAM_CODE_TO (hcl, b1); diff --git a/lib/err.c b/lib/err.c index 794f071..9f49e8c 100644 --- a/lib/err.c +++ b/lib/err.c @@ -74,8 +74,9 @@ static hcl_ooch_t errstr_33[] = {'s','y','n','t','a','x',' ','e','r','r','o','r' static hcl_ooch_t errstr_34[] = {'c','a','l','l',' ','e','r','r','o','r','\0'}; static hcl_ooch_t errstr_35[] = {'a','r','g','u','m','e','n','t',' ','n','u','m','b','e','r',' ','e','r','r','o','r','\0'}; -static hcl_ooch_t errstr_36[] = {'t','o','o',' ','m','a','n','y',' ','s','e','m','a','p','h','o','r','e','s','\0'}; -static hcl_ooch_t errstr_37[] = {'e','x','c','e','p','a','i','o','n',' ','n','o','t',' ','h','a','n','d','l','e','d','\0'}; +static hcl_ooch_t errstr_36[] = {'r','e','t','u','r','n',' ','c','o','u','n','t',' ','e','r','r','o','r','\0'}; +static hcl_ooch_t errstr_37[] = {'t','o','o',' ','m','a','n','y',' ','s','e','m','a','p','h','o','r','e','s','\0'}; +static hcl_ooch_t errstr_38[] = {'e','x','c','e','p','a','i','o','n',' ','n','o','t',' ','h','a','n','d','l','e','d','\0'}; static hcl_ooch_t* errstr[] = { @@ -83,7 +84,7 @@ static hcl_ooch_t* errstr[] = errstr_8, errstr_9, errstr_10, errstr_11, errstr_12, errstr_13, errstr_14, errstr_15, errstr_16, errstr_17, errstr_18, errstr_19, errstr_20, errstr_21, errstr_22, errstr_23, errstr_24, errstr_25, errstr_26, errstr_27, errstr_28, errstr_29, errstr_30, errstr_31, - errstr_32, errstr_33, errstr_34, errstr_35, errstr_36, errstr_37 + errstr_32, errstr_33, errstr_34, errstr_35, errstr_36, errstr_37, errstr_38 }; diff --git a/lib/exec.c b/lib/exec.c index 8cd810d..0fb6819 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -1806,14 +1806,14 @@ void hcl_releaseiohandle (hcl_t* hcl, hcl_ooi_t io_handle) /* ------------------------------------------------------------------------- */ -static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t nargs, int nargs_offset, hcl_ooi_t extra_slots, int copy_args, hcl_oop_context_t* pnewctx) +static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t nargs, int nargs_offset, hcl_ooi_t req_nrvars, int copy_args, hcl_oop_context_t* pnewctx) { /* prepare a new block context for activation. the receiver must be a block * context which becomes the base for a new block context. */ hcl_oop_context_t blkctx; hcl_ooi_t tmpr_mask; - hcl_ooi_t nrvars, nlvars, flags; + hcl_ooi_t fblk_nrvars, fblk_nlvars, flags; hcl_ooi_t fixed_nargs, actual_nargs, excess_nargs; /* the receiver must be a block context */ @@ -1822,8 +1822,8 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t n flags = HCL_OOP_TO_SMOOI(rcv_blk->flags); tmpr_mask = HCL_OOP_TO_SMOOI(rcv_blk->tmpr_mask); - nrvars = GET_BLKTMPR_MASK_NRVARS(tmpr_mask); - nlvars = GET_BLKTMPR_MASK_NLVARS(tmpr_mask); + fblk_nrvars = GET_BLKTMPR_MASK_NRVARS(tmpr_mask); + fblk_nlvars = GET_BLKTMPR_MASK_NLVARS(tmpr_mask); fixed_nargs = GET_BLKTMPR_MASK_NARGS(tmpr_mask); actual_nargs = nargs - nargs_offset; excess_nargs = actual_nargs - fixed_nargs; @@ -1833,13 +1833,22 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t n HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, "Error - wrong number of arguments to a block %O - expecting %zd, got %zd\n", rcv_blk, fixed_nargs, actual_nargs); - hcl_seterrnum (hcl, HCL_ECALLARG); + hcl_seterrbfmt (hcl, HCL_ECALLARG, "wrong number of argument passed to function block - %zd expected, %zd passed", fixed_nargs, actual_nargs); + return -1; + } + + if (fblk_nrvars != req_nrvars) + { + HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, + "Error - wrong number of returns specified of a block %O - expected %zd, requested %zd\n", + rcv_blk, fblk_nrvars, req_nrvars); + hcl_seterrbfmt (hcl, HCL_ECALLRET, "wrong number of returns requested of function block - %zd expected, %zd requested", fblk_nrvars, req_nrvars); return -1; } /* create a new block context to clone rcv_blk */ hcl_pushvolat (hcl, (hcl_oop_t*)&rcv_blk); - blkctx = make_context(hcl, fixed_nargs + nrvars + nlvars + excess_nargs + extra_slots); + blkctx = make_context(hcl, fixed_nargs + fblk_nrvars + fblk_nlvars + excess_nargs); hcl_popvolat (hcl); if (HCL_UNLIKELY(!blkctx)) return -1; @@ -1870,7 +1879,7 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t n } /* variable arguments. place them behind after local variables. */ - for (i = fixed_nargs + nrvars + nlvars ; j < nargs; i++, j++) + for (i = fixed_nargs + fblk_nrvars + fblk_nlvars ; j < nargs; i++, j++) { blkctx->slot[i] = HCL_STACK_GETARG(hcl, nargs, j); } @@ -1883,7 +1892,7 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t n return 0; } -static HCL_INLINE int activate_block (hcl_t* hcl, hcl_ooi_t nargs) +static HCL_INLINE int activate_block (hcl_t* hcl, hcl_ooi_t nargs, hcl_ooi_t nrvars) { int x; hcl_oop_block_t rcv; @@ -1897,7 +1906,7 @@ static HCL_INLINE int activate_block (hcl_t* hcl, hcl_ooi_t nargs) rcv, nargs, /* nargs */ 0, /* nargs_offset */ - 0, /* extra_slots */ + nrvars, 1, /* copy_args */ &newctx); if (HCL_UNLIKELY(x <= -1)) return -1; @@ -3108,6 +3117,30 @@ static int execute (hcl_t* hcl) /* -------------------------------------------------------- */ + case HCL_CODE_CALL_R: + { + hcl_oop_t rcv; + FETCH_PARAM_CODE_TO (hcl, b1); /* nargs */ + FETCH_PARAM_CODE_TO (hcl, b2); /* nrvars */ + LOG_INST_2 (hcl, "call %zu %zu", b1, b2); + + rcv = HCL_STACK_GETRCV(hcl, b1); + if (HCL_IS_BLOCK(hcl, rcv)) + { + if (activate_block(hcl, b1, b2) <= -1) goto call2_failed; + break; + } + else + { + hcl_seterrbfmt (hcl, HCL_ECALL, "cannot call %O", rcv); + call2_failed: + supplement_errmsg (hcl, fetched_instruction_pointer); + goto oops; + } + + break; + } + case HCL_CODE_CALL_X: FETCH_PARAM_CODE_TO (hcl, b1); goto handle_call; @@ -3132,7 +3165,7 @@ static int execute (hcl_t* hcl) break; case HCL_BRAND_BLOCK: - if (activate_block(hcl, b1) <= -1) goto call_failed; + if (activate_block(hcl, b1, 0) <= -1) goto call_failed; break; case HCL_BRAND_PRIM: @@ -3951,7 +3984,7 @@ hcl_pfrc_t hcl_pf_process_fork (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) blk, nargs, /* nargs */ 1, /* nargs_offset */ - 0, /* extra_slots */ + 0, /* number of return variables expected */ 1, /* copy_args */ &newctx); if (HCL_UNLIKELY(x <= -1)) return HCL_PF_FAILURE; diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index adaac4d..a57334d 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -505,17 +505,20 @@ struct hcl_compiler_t * | SIGN | VA | NARGS | NRVARS | NLVARS | TAG | * 1 1 8 8 12 2 <= 32 * ----------------------------------------------------------- - * Parameters to MAKE_BLOCK or MAKE_FUNCTION. + * Parameters to the MAKE_BLOCK or MAKE_FUNCTION instructions * | VA | NARGS | NRVARS | NLVARS * 1 4 4 7 <= 16 (HCL_CODE_LONG_PARAM_SIZE 1, two params) * 1 8 8 12 <= 32 (HCL_CODE_LONG_PARAM_SIZE 2, two params, use 29 bits to avoid collection when converted to a smooi) + * + * + * NARGS and NRVARS are also used for the CALL and CALL2 instructions. + * CALL encodes NARGS in one parameter. + * CALLR encodes NARGS in one parameter and NRVARS in another parameter. + * NARGS and NRVARS must not exceed a single parameter size. */ #if defined(HCL_CODE_LONG_PARAM_SIZE) && (HCL_CODE_LONG_PARAM_SIZE == 1) -/* -# define MAX_CODE_NBLKARGS (0xFFu) -# define MAX_CODE_NBLKTMPRS (0xFFu) -*/ + # define MAX_CODE_NBLKARGS (0xFu) /* 15 */ # define MAX_CODE_NBLKRVARS (0xFu) /* 15 */ # define MAX_CODE_NBLKLVARS (0x7Fu) /* 127 */ @@ -531,10 +534,7 @@ struct hcl_compiler_t # define MAX_CODE_PARAM (0xFFu) # define MAX_CODE_PARAM2 (0xFFFFu) #elif defined(HCL_CODE_LONG_PARAM_SIZE) && (HCL_CODE_LONG_PARAM_SIZE == 2) -/* -# define MAX_CODE_NBLKARGS (0xFFFFu) -# define MAX_CODE_NBLKTMPRS (0xFFFFu) -*/ + # define MAX_CODE_NBLKARGS (0xFFu) /* 255 */ # define MAX_CODE_NBLKRVARS (0xFFu) /* 255 */ # define MAX_CODE_NBLKLVARS (0xFFFu) /* 4095 */ @@ -829,14 +829,15 @@ enum hcl_bcode_t HCL_CODE_JUMP_BACKWARD_IF_FALSE = 0xD2, /* 210 ## */ HCL_CODE_JUMP2_BACKWARD_IF_FALSE = 0xD3, /* 211 */ - HCL_CODE_CALL_X = 0xD4, /* 212 */ - HCL_CODE_TRY_ENTER = 0xD5, /* 213 ## */ - HCL_CODE_TRY_ENTER2 = 0xD6, /* 214 */ - HCL_CODE_TRY_EXIT = 0xD7, /* 215 */ - + HCL_CODE_CALL_X = 0xD4, /* 212 ## */ + HCL_CODE_CALL_R = 0xD5, /* 213 ## ##*/ + HCL_CODE_TRY_ENTER = 0xD6, /* 214 ## */ + HCL_CODE_TRY_ENTER2 = 0xD7, /* 215 ## */ + HCL_CODE_STORE_INTO_CTXTEMPVAR_X = 0xD8, /* 216 ## */ - HCL_CODE_THROW = 0xD9, /* 217 */ - /* UNUSED - 0xDA - 0xDB */ + HCL_CODE_TRY_EXIT = 0xD9, /* 217 */ + HCL_CODE_THROW = 0xDA, /* 218 */ + /* UNUSED - 0xDB - 0xDB */ HCL_CODE_POP_INTO_CTXTEMPVAR_X = 0xDC, /* 220 ## */ /* UNUSED - 0xDD - 0xDF */ diff --git a/lib/hcl.h b/lib/hcl.h index 8e43977..ce91621 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -88,6 +88,7 @@ enum hcl_errnum_t HCL_ESYNERR, /**< syntax error */ HCL_ECALL, /**< runtime error - cannot call */ HCL_ECALLARG, /**< runtime error - wrong number of arguments to call */ + HCL_ECALLRET, /**< runtime error - wrong number of return variables to call */ HCL_ESEMFLOOD, /**< runtime error - too many semaphores */ HCL_EEXCEPT /**< runtime error - exception not handled */ };