hyung-hwan/hak
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

writing code for return variables support

Browse Source
This commit is contained in:
hyung-hwan
2021-05-11 15:04:53 +00:00
parent 5f7dc95f40
commit a67da34260
6 changed files with 81 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
hcl/README.md
View File

@ -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

5
hcl/lib/decode.c
View File

@ -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);

7
hcl/lib/err.c
View File

@ -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
};

55
hcl/lib/exec.c
View File

@ -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;

33
hcl/lib/hcl-prv.h
View File

@ -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 */

1
hcl/lib/hcl.h
View File

@ -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 */
};