From d339338a40aa9c311fef049e5d0ab1c7661f960a Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Fri, 2 Feb 2024 14:57:46 +0900 Subject: [PATCH] added some pascal wrapper files --- Makefile.am | 2 +- Makefile.in | 2 +- bin/main.c | 3 +- configure | 3 +- configure.ac | 1 + lang.txt | 2 + lib/comp.c | 19 +- lib/fmt.c | 12 + lib/hcl-prv.h | 16 +- lib/hcl.h | 5 +- lib/print.c | 2 + lib/read.c | 65 +++-- lib/std.c | 8 +- pas/Makefile.am | 14 ++ pas/Makefile.in | 631 ++++++++++++++++++++++++++++++++++++++++++++++++ pas/hcl.pas | 204 ++++++++++++++++ pas/main.pas | 81 +++++++ 17 files changed, 1022 insertions(+), 48 deletions(-) create mode 100644 pas/Makefile.am create mode 100644 pas/Makefile.in create mode 100644 pas/hcl.pas create mode 100644 pas/main.pas diff --git a/Makefile.am b/Makefile.am index 841b9aa..e47ee97 100644 --- a/Makefile.am +++ b/Makefile.am @@ -11,7 +11,7 @@ else SUBDIRS += lib mod bin t endif -DIST_SUBDIRS = $(SUBDIRS) +DIST_SUBDIRS = $(SUBDIRS) pas distclean-local: @rm -rf $(top_srcdir)/autom4te.cache diff --git a/Makefile.in b/Makefile.in index 6367f34..764d11e 100644 --- a/Makefile.in +++ b/Makefile.in @@ -362,7 +362,7 @@ AUTOMAKE_OPTION = foreign ACLOCAL_AMFLAGS = -I m4 EXTRA_DIST = t t/test-bi.hcl SUBDIRS = $(am__append_1) $(am__append_2) -DIST_SUBDIRS = $(SUBDIRS) +DIST_SUBDIRS = $(SUBDIRS) pas @ENABLE_HCLGO_TRUE@hclgo_SOURCES = \ @ENABLE_HCLGO_TRUE@ go/hcl.go \ @ENABLE_HCLGO_TRUE@ go/cb.go \ diff --git a/bin/main.c b/bin/main.c index cc07e0e..79b05cc 100644 --- a/bin/main.c +++ b/bin/main.c @@ -99,6 +99,7 @@ typedef struct xtn_t xtn_t; struct xtn_t { const char* cci_path; /* main source file */ + /*const char* udi_path; */ /* not implemented as of snow */ const char* udo_path; int vm_running; @@ -503,7 +504,7 @@ static int feed_loop (hcl_t* hcl, xtn_t* xtn, int verbose) int is_tty; #if defined(_WIN32) && defined(__STDC_WANT_SECURE_LIB__) - errno_t err = fopen_s(&fp, xtn->cci_path, FOPEN_R_FLAGS); + errno_t err = fopen_s(&fp, xtn->cci_path, FOPEN_R_FLAGS); if (err != 0) { hcl_logbfmt(hcl, HCL_LOG_STDERR, "ERROR: failed to open - %hs - %hs\n", xtn->cci_path, strerror(err)); diff --git a/configure b/configure index 4fe2932..26eab27 100755 --- a/configure +++ b/configure @@ -18740,7 +18740,7 @@ printf "%s\n" "#define HCL_CONFIGURE_ARGS \"$ac_configure_args\"" >>confdefs.h printf "%s\n" "#define HCL_CONFIGURE_CMD \"$hcl_configure_cmd\"" >>confdefs.h -ac_config_files="$ac_config_files Makefile lib/Makefile mod/Makefile bin/Makefile t/Makefile" +ac_config_files="$ac_config_files Makefile lib/Makefile mod/Makefile bin/Makefile pas/Makefile t/Makefile" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure @@ -19792,6 +19792,7 @@ do "lib/Makefile") CONFIG_FILES="$CONFIG_FILES lib/Makefile" ;; "mod/Makefile") CONFIG_FILES="$CONFIG_FILES mod/Makefile" ;; "bin/Makefile") CONFIG_FILES="$CONFIG_FILES bin/Makefile" ;; + "pas/Makefile") CONFIG_FILES="$CONFIG_FILES pas/Makefile" ;; "t/Makefile") CONFIG_FILES="$CONFIG_FILES t/Makefile" ;; *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; diff --git a/configure.ac b/configure.ac index 0db1aa7..f51f7ee 100644 --- a/configure.ac +++ b/configure.ac @@ -690,6 +690,7 @@ AC_CONFIG_FILES([ lib/Makefile mod/Makefile bin/Makefile + pas/Makefile t/Makefile ]) AC_OUTPUT diff --git a/lang.txt b/lang.txt index 8c8961b..afd4782 100644 --- a/lang.txt +++ b/lang.txt @@ -47,6 +47,8 @@ make basic branded types to an object if possible. for example (#[10 20]:at 1) + isn't : for method call confliting with key value spearator in a dictionary? + default return value for some class methods. ::: method -> return what?? ::* method -> return the new instance diff --git a/lib/comp.c b/lib/comp.c index 54a8c6d..875348f 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -3633,7 +3633,7 @@ static int compile_while (hcl_t* hcl, hcl_cnode_t* src, int next_cop) static int compile_cons_array_expression (hcl_t* hcl, hcl_cnode_t* obj) { - /* [ ] */ + /* #[ ] */ hcl_ooi_t nargs; hcl_cframe_t* cf; @@ -3656,9 +3656,10 @@ static int compile_cons_array_expression (hcl_t* hcl, hcl_cnode_t* obj) return 0; } -static int compile_cons_bytearray_expression (hcl_t* hcl, hcl_cnode_t* obj) +static int compile_cons_bytearray_expression (hcl_t* hcl, hcl_cnode_t* obj, int concode) { - /* #[ ] - e.g. #[1, 2, 3] or #[ 1 2 3 ] */ + /* compile the singular-type array such as byte array or char array */ + /* #b[ ] - e.g. #b[1, 2, 3] or #b[ 1 2 3 ] */ hcl_ooi_t nargs; hcl_cframe_t* cf; @@ -3671,11 +3672,13 @@ static int compile_cons_bytearray_expression (hcl_t* hcl, hcl_cnode_t* obj) SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_BYTEARRAY, obj); cf = GET_TOP_CFRAME(hcl); + cf->u.bytearray_list.elem_type = concode; cf->u.bytearray_list.index = nargs; /* redundant cdr check is performed inside compile_object_list() */ PUSH_SUBCFRAME (hcl, COP_COMPILE_BYTEARRAY_LIST, obj); cf = GET_SUBCFRAME(hcl); + cf->u.bytearray_list.elem_type = concode; cf->u.bytearray_list.index = 0; return 0; @@ -4511,7 +4514,8 @@ redo: break; case HCL_CONCODE_BYTEARRAY: - if (compile_cons_bytearray_expression(hcl, oprnd) <= -1) return -1; + case HCL_CONCODE_CHARARRAY: + if (compile_cons_bytearray_expression(hcl, oprnd, HCL_CNODE_CONS_CONCODE(oprnd)) <= -1) return -1; break; case HCL_CONCODE_DIC: @@ -4836,6 +4840,7 @@ static int compile_bytearray_list (hcl_t* hcl) { hcl_cnode_t* car, * cdr; hcl_ooi_t oldidx; + int elem_type; if (!HCL_CNODE_IS_CONS(oprnd)) { @@ -4847,17 +4852,23 @@ static int compile_bytearray_list (hcl_t* hcl) cdr = HCL_CNODE_CONS_CDR(oprnd); oldidx = cf->u.bytearray_list.index; + elem_type = cf->u.bytearray_list.index; + +/* TODO: compile type check if the data element is literal... + runtime check if the data is a variable or something... */ SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car); if (cdr) { PUSH_SUBCFRAME (hcl, COP_COMPILE_BYTEARRAY_LIST, cdr); cf = GET_SUBCFRAME(hcl); + cf->u.bytearray_list.elem_type = elem_type; cf->u.bytearray_list.index = oldidx + 1; } PUSH_SUBCFRAME (hcl, COP_EMIT_POP_INTO_BYTEARRAY, car); cf = GET_SUBCFRAME(hcl); + cf->u.bytearray_list.elem_type = elem_type; cf->u.bytearray_list.index = oldidx; } diff --git a/lib/fmt.c b/lib/fmt.c index a2dd704..f67ff8c 100644 --- a/lib/fmt.c +++ b/lib/fmt.c @@ -1865,6 +1865,12 @@ static int print_bcs (hcl_fmtout_t* fmtout, const hcl_bch_t* ptr, hcl_oow_t len) #else hcl_bch_t* optr; + if (HCL_UNLIKELY(!hcl->io.udo_wrtr)) + { + hcl_seterrmsg (hcl, HCL_EINVAL, "no user-defined output handler"); + return -1; + } + optr = (hcl_bch_t*)ptr; while (len > 0) { @@ -1887,6 +1893,12 @@ static int print_ucs (hcl_fmtout_t* fmtout, const hcl_uch_t* ptr, hcl_oow_t len) { hcl_t* hcl = (hcl_t*)fmtout->ctx; + if (HCL_UNLIKELY(!hcl->io.udo_wrtr)) + { + hcl_seterrmsg (hcl, HCL_EINVAL, "no user-defined output handler"); + return -1; + } + #if defined(HCL_OOCH_IS_UCH) hcl_uch_t* optr; diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index 5b9dc5a..4cacbf9 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -201,10 +201,10 @@ enum hcl_tok_type_t HCL_TOK_APAREN, /* #[ - array parenthesis */ HCL_TOK_BAPAREN, /* #b[ - byte array parenthesis */ -#if 0 HCL_TOK_CAPAREN, /* #c[ - character array parenthesis */ +#if 0 HCL_TOK_WAPAREN, /* #w[ - word array parenthesis */ - HCL_TOK_WAPAREN, /* #hw[ - half-word array parenthesis */ + HCL_TOK_HWAPAREN, /* #hw[ - half-word array parenthesis */ #endif HCL_TOK_QLPAREN, /* #( - quoted-list parenthesis */ HCL_TOK_DLPAREN, /* #{ - dictionary parenthese */ @@ -454,6 +454,7 @@ struct hcl_cframe_t /* COP_COMPILE_BYTEARRAY_LIST, COP_POP_INTO_BYTEARRAY, COP_EMIT_MAKE_BYTEARRAY */ struct { + int elem_type; hcl_ooi_t index; } bytearray_list; @@ -591,10 +592,9 @@ typedef struct hcl_flx_hb_t hcl_flx_hb_t; /* intermediate state for #b */ struct hcl_flx_hb_t { /* state data */ - hcl_oow_t not_unused; /* for now */ + hcl_ooch_t start_c; }; - typedef struct hcl_flx_hn_t hcl_flx_hn_t; /* hash-marked number - radixed number */ struct hcl_flx_hn_t { @@ -659,8 +659,8 @@ struct hcl_flx_st_t }; -typedef struct hcl_flx_bu_t hcl_flx_bu_t; -struct hcl_flx_bu_t +typedef struct hcl_flx_bcp_t hcl_flx_bcp_t; +struct hcl_flx_bcp_t { hcl_ooch_t start_c; }; @@ -680,7 +680,7 @@ enum hcl_flx_state_t HCL_FLX_PLAIN_NUMBER, /* plain number */ HCL_FLX_QUOTED_TOKEN, /* string, character */ HCL_FLX_SIGNED_TOKEN, /* prefixed with + or - */ - HCL_FLX_BU /* beginning with B or U */ + HCL_FLX_BC_PREFIX /* b or C prefix before " or ' */ }; typedef enum hcl_flx_state_t hcl_flx_state_t; @@ -771,7 +771,7 @@ struct hcl_compiler_t hcl_flx_pn_t pn; /* plain number */ hcl_flx_qt_t qt; /* quoted token */ hcl_flx_st_t st; /* signed token */ - hcl_flx_bu_t bu; /* b or u prefix */ + hcl_flx_bcp_t bcp; /* b or c prefix */ } u; } lx; diff --git a/lib/hcl.h b/lib/hcl.h index 19b1e5d..26b2cad 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -1923,8 +1923,9 @@ enum hcl_concode_t HCL_CONCODE_MLIST, /* (obj:message) - message send list */ HCL_CONCODE_ALIST, /* (a := 20) assignment list */ HCL_CONCODE_BLOCK, /* { } */ - HCL_CONCODE_ARRAY, /* [ ] */ - HCL_CONCODE_BYTEARRAY, /* #[ ] */ + HCL_CONCODE_ARRAY, /* #[ ] */ + HCL_CONCODE_BYTEARRAY, /* #b[ ] */ + HCL_CONCODE_CHARARRAY, /* #c[ ] */ HCL_CONCODE_DIC, /* #{ } */ HCL_CONCODE_QLIST, /* #( ) - data list */ HCL_CONCODE_VLIST /* | | - symbol list */ diff --git a/lib/print.c b/lib/print.c index 8f48f2e..e33bff0 100644 --- a/lib/print.c +++ b/lib/print.c @@ -221,6 +221,7 @@ int hcl_fmt_object_ (hcl_fmtout_t* fmtout, hcl_oop_t obj) { "{", "{" }, /*HCL_CONCODE_BLOCK */ { "#[", "[" }, /*HCL_CONCODE_ARRAY */ { "#b[", "[" }, /*HCL_CONCODE_BYTEARRAY */ + { "#c[", "[" }, /*HCL_CONCODE_CHARARRAY */ { "#{", "{" }, /*HCL_CONCODE_DIC */ { "#(", "[" } /*HCL_CONCODE_QLIST */ }; @@ -233,6 +234,7 @@ int hcl_fmt_object_ (hcl_fmtout_t* fmtout, hcl_oop_t obj) { "}", "}" }, /*HCL_CONCODE_BLOCK */ { "]", "]" }, /*HCL_CONCODE_ARRAY */ { "]", "]" }, /*HCL_CONCODE_BYTEARRAY */ + { "]", "]" }, /*HCL_CONCODE_CHARARRAY */ { "}", "}" }, /*HCL_CONCODE_DIC */ { ")", "]" }, /*HCL_CONCODE_QLIST */ }; diff --git a/lib/read.c b/lib/read.c index 9667006..6430ba9 100644 --- a/lib/read.c +++ b/lib/read.c @@ -64,6 +64,7 @@ static struct voca_t { 3, { '{',' ','}' /* BLOCK */ } }, { 4, { '#','[',' ',']' /* ARRAY */ } }, { 5, { '#','b','[',' ',']' /* BYTE ARRAY */ } }, + { 5, { '#','c','[',' ',']' /* CHAR ARRAY */ } }, { 4, { '#','{',' ','}' } }, { 4, { '#','(',' ',')' } }, { 3, { '|',' ','|' } }, @@ -103,6 +104,7 @@ enum voca_id_t VOCA_BLOCK, VOCA_ARRAY, VOCA_BYTEARRAY, + VOCA_CHARARRAY, VOCA_DIC, VOCA_QLIST, VOCA_VLIST, @@ -143,8 +145,9 @@ static struct /*[HCL_CONCODE_MLIST] =*/ { HCL_TOK_RPAREN, HCL_SYNERR_RPAREN, VOCA_MLIST }, /* MLIST (obj:message) */ /*[HCL_CONCODE_ALIST] =*/ { HCL_TOK_RPAREN, HCL_SYNERR_RPAREN, VOCA_ALIST }, /* ALIST (var:=value) */ /*[HCL_CONCODE_BLOCK] =*/ { HCL_TOK_RBRACE, HCL_SYNERR_RBRACE, VOCA_BLOCK }, /* BLOCK { } */ - /*[HCL_CONCODE_ARRAY] =*/ { HCL_TOK_RBRACK, HCL_SYNERR_RBRACK, VOCA_ARRAY }, /* ARRAY [ ] */ - /*[HCL_CONCODE_BYTEARRAY] =*/ { HCL_TOK_RBRACK, HCL_SYNERR_RBRACK, VOCA_BYTEARRAY }, /* BYTEARRAY #[ ] */ + /*[HCL_CONCODE_ARRAY] =*/ { HCL_TOK_RBRACK, HCL_SYNERR_RBRACK, VOCA_ARRAY }, /* ARRAY #[ ] */ + /*[HCL_CONCODE_BYTEARRAY] =*/ { HCL_TOK_RBRACK, HCL_SYNERR_RBRACK, VOCA_BYTEARRAY }, /* BYTEARRAY #b[ ] */ + /*[HCL_CONCODE_CHARARRAY] =*/ { HCL_TOK_RBRACK, HCL_SYNERR_RBRACK, VOCA_CHARARRAY }, /* CHARARRAY #c[ ] */ /*[HCL_CONCODE_DIC] =*/ { HCL_TOK_RBRACE, HCL_SYNERR_RBRACE, VOCA_DIC }, /* DIC #{ } */ /*[HCL_CONCODE_QLIST] =*/ { HCL_TOK_RPAREN, HCL_SYNERR_RPAREN, VOCA_QLIST }, /* QLIST #( ) */ @@ -1179,18 +1182,22 @@ static int feed_process_token (hcl_t* hcl) * expressions(e.g. 1, "abc"). when it's placed at the block beginning, * create the outer XLIST. */ if (auto_forge_xlist_if_at_block_beginning(hcl, frd) <= -1) goto oops; - frd->flagv = DATA_LIST; LIST_FLAG_SET_CONCODE (frd->flagv, HCL_CONCODE_ARRAY); goto start_list; case HCL_TOK_BAPAREN: /* #b[ */ if (auto_forge_xlist_if_at_block_beginning(hcl, frd) <= -1) goto oops; - frd->flagv = DATA_LIST; LIST_FLAG_SET_CONCODE (frd->flagv, HCL_CONCODE_BYTEARRAY); goto start_list; + case HCL_TOK_CAPAREN: /* #c[ */ + if (auto_forge_xlist_if_at_block_beginning(hcl, frd) <= -1) goto oops; + frd->flagv = DATA_LIST; + LIST_FLAG_SET_CONCODE (frd->flagv, HCL_CONCODE_CHARARRAY); + goto start_list; + case HCL_TOK_LBRACE: /* { */ /* this is a block opener itself. auto xlist forge at the block beginning */ frd->flagv = 0; @@ -1729,7 +1736,7 @@ static int feed_continue_with_char (hcl_t* hcl, hcl_ooci_t c, hcl_flx_state_t st #define FLX_PN(hcl) (&((hcl)->c->feed.lx.u.pn)) #define FLX_QT(hcl) (&((hcl)->c->feed.lx.u.qt)) #define FLX_ST(hcl) (&((hcl)->c->feed.lx.u.st)) -#define FLX_BU(hcl) (&((hcl)->c->feed.lx.u.bu)) +#define FLX_BCP(hcl) (&((hcl)->c->feed.lx.u.bcp)) static HCL_INLINE void init_flx_hc (hcl_flx_hc_t* hc) { @@ -1741,9 +1748,10 @@ static HCL_INLINE void init_flx_hi (hcl_flx_hi_t* hi) HCL_MEMSET (hi, 0, HCL_SIZEOF(*hi)); } -static HCL_INLINE void init_flx_hb (hcl_flx_hb_t* hb) +static HCL_INLINE void init_flx_hb (hcl_flx_hb_t* hb, hcl_ooch_t start_c) { HCL_MEMSET (hb, 0, HCL_SIZEOF(*hb)); + hb->start_c = start_c; } static HCL_INLINE void init_flx_hn (hcl_flx_hn_t* hn, hcl_tok_type_t tok_type, hcl_synerrnum_t synerr_code, int radix) @@ -1782,10 +1790,10 @@ static HCL_INLINE void init_flx_st (hcl_flx_st_t* st, hcl_ooch_t sign_c) st->sign_c = sign_c; } -static HCL_INLINE void init_flx_bu (hcl_flx_bu_t* bu, hcl_ooch_t start_c) +static HCL_INLINE void init_flx_bcp (hcl_flx_bcp_t* bcp, hcl_ooch_t start_c) { - HCL_MEMSET (bu, 0, HCL_SIZEOF(*bu)); - bu->start_c = start_c; + HCL_MEMSET (bcp, 0, HCL_SIZEOF(*bcp)); + bcp->start_c = start_c; } static void reset_flx_token (hcl_t* hcl) @@ -1877,10 +1885,10 @@ static int flx_start (hcl_t* hcl, hcl_ooci_t c) case 'B': case 'b': - case 'U': - case 'u': - init_flx_bu(FLX_BU(hcl), c); - FEED_CONTINUE_WITH_CHAR(hcl, c, HCL_FLX_BU); + case 'C': + case 'c': + init_flx_bcp(FLX_BCP(hcl), c); + FEED_CONTINUE_WITH_CHAR(hcl, c, HCL_FLX_BC_PREFIX); goto consumed; default: @@ -1994,16 +2002,18 @@ static int flx_hmarked_token (hcl_t* hcl, hcl_ooci_t c) goto radixed_number; case 'b': + case 'c': #if 0 init_flx_hn (FLX_HN(hcl), HCL_TOK_RADNUMLIT, HCL_SYNERR_NUMLIT, 2); goto radixed_number; #else /* if #b is followed by [, it is a starter for a byte array */ - init_flx_hb (FLX_HB(hcl)); + init_flx_hb (FLX_HB(hcl), c); FEED_CONTINUE_WITH_CHAR (hcl, c, HCL_FLX_HMARKED_B); break; #endif + case 'e': init_flx_hn (FLX_HN(hcl), HCL_TOK_ERRLIT, HCL_SYNERR_ERRLIT, 10); goto radixed_number; @@ -2188,12 +2198,15 @@ not_consumed: static int flx_hmarked_b (hcl_t* hcl, hcl_ooci_t c) { - /*hcl_flx_hb_t* hb = FLX_HB(hcl);*/ + hcl_flx_hb_t* hb = FLX_HB(hcl); if (c == '[') { /* #b[ - byte array starter */ - FEED_WRAP_UP_WITH_CHAR (hcl, c, HCL_TOK_BAPAREN); + /* TODO: more types.. #w[ .. #u32[ ... etc */ + hcl_tok_type_t tt; + tt = (hb->start_c == 'b' || hb->start_c == 'B')? HCL_TOK_BAPAREN: HCL_TOK_CAPAREN; + FEED_WRAP_UP_WITH_CHAR (hcl, c, tt); goto consumed; } else @@ -2465,7 +2478,7 @@ static int flx_quoted_token (hcl_t* hcl, hcl_ooci_t c) /* string, character */ { hcl_ooch_t rc; rc = (qt->escaped == 2)? 'x': - (qt->escaped == 4)? 'u': 'U'; + (qt->escaped == 4)? 'u': 'U'; if (qt->digit_count == 0) ADD_TOKEN_CHAR (hcl, rc); else ADD_TOKEN_CHAR (hcl, qt->c_acc); @@ -2644,21 +2657,21 @@ not_consumed: return 0; } -static int flx_bu (hcl_t* hcl, hcl_ooci_t c) +static int flx_bc_prefix (hcl_t* hcl, hcl_ooci_t c) { - hcl_flx_bu_t* bu = FLX_BU(hcl); + hcl_flx_bcp_t* bcp = FLX_BCP(hcl); - if (c == '\"') + if (c == '\"') /* b" B" c" C" */ { - int is_byte = (bu->start_c == 'b' || bu->start_c == 'B'); + int is_byte = (bcp->start_c == 'b' || bcp->start_c == 'B'); reset_flx_token (hcl); init_flx_qt (FLX_QT(hcl), HCL_TOK_STRLIT, HCL_SYNERR_STRLIT, c, '\\', 0, HCL_TYPE_MAX(hcl_oow_t), is_byte); FEED_CONTINUE (hcl, HCL_FLX_QUOTED_TOKEN); /* discard prefix, quote and move on */ goto consumed; } - else if (c == '\'') + else if (c == '\'') /* b' B' c' C' */ { - int is_byte = (bu->start_c == 'b' || bu->start_c == 'B'); + int is_byte = (bcp->start_c == 'b' || bcp->start_c == 'B'); reset_flx_token (hcl); init_flx_qt (FLX_QT(hcl), HCL_TOK_CHARLIT, HCL_SYNERR_CHARLIT, c, '\\', 1, 1, is_byte); FEED_CONTINUE (hcl, HCL_FLX_QUOTED_TOKEN); /* dicard prefix, quote, and move on */ @@ -2705,7 +2718,7 @@ static int feed_char (hcl_t* hcl, hcl_ooci_t c) case HCL_FLX_PLAIN_NUMBER: return flx_plain_number(hcl, c); case HCL_FLX_QUOTED_TOKEN: return flx_quoted_token(hcl, c); case HCL_FLX_SIGNED_TOKEN: return flx_signed_token(hcl, c); - case HCL_FLX_BU: return flx_bu(hcl, c); + case HCL_FLX_BC_PREFIX: return flx_bc_prefix(hcl, c); default: /* unknown state */ @@ -2782,7 +2795,9 @@ static int feed_from_includee (hcl_t* hcl) int hcl_beginfeed (hcl_t* hcl, hcl_on_cnode_t on_cnode) { - HCL_ASSERT (hcl, hcl->c != HCL_NULL); /* call hcl_attachccio() or hcl_attachcciostd() first */ + /* if the fed data contains @include, you must call hcl_attachccio() first */ + + if (!hcl->c && init_compiler(hcl) <= -1) return -1; init_feed (hcl); if (on_cnode) hcl->c->feed.on_cnode = on_cnode; diff --git a/lib/std.c b/lib/std.c index 08aa720..b710b1a 100644 --- a/lib/std.c +++ b/lib/std.c @@ -3483,15 +3483,15 @@ static HCL_INLINE int open_udi_stream (hcl_t* hcl, hcl_io_udiarg_t* arg) hcl_oow_t pathlen; - pathlen = xtn->cci_path? hcl_count_bcstr(xtn->cci_path): 0; + pathlen = xtn->udi_path? hcl_count_bcstr(xtn->udi_path): 0; bb = (bb_t*)hcl_callocmem(hcl, HCL_SIZEOF(*bb) + (HCL_SIZEOF(hcl_bch_t) * (pathlen + 1))); if (!bb) goto oops; bb->fn = (hcl_bch_t*)(bb + 1); - if (pathlen > 0 && xtn->cci_path) + if (pathlen > 0 && xtn->udi_path) { - hcl_copy_bcstr (bb->fn, pathlen + 1, xtn->cci_path); + hcl_copy_bcstr (bb->fn, pathlen + 1, xtn->udi_path); bb->fp = fopen(bb->fn, FOPEN_R_FLAGS); } else @@ -3824,13 +3824,11 @@ int hcl_attachudiostdwithbcstr (hcl_t* hcl, const hcl_bch_t* udi_file, const hcl HCL_ASSERT (hcl, xtn->udi_path == HCL_NULL); HCL_ASSERT (hcl, xtn->udo_path == HCL_NULL); - xtn->udi_path = udi_file; xtn->udo_path = udo_file; n = hcl_attachudio(hcl, udi_handler, udo_handler); - xtn->udi_path = HCL_NULL; xtn->udo_path = HCL_NULL; diff --git a/pas/Makefile.am b/pas/Makefile.am new file mode 100644 index 0000000..d95e27d --- /dev/null +++ b/pas/Makefile.am @@ -0,0 +1,14 @@ +AUTOMAKE_OPTIONS = nostdinc + +bin_PROGRAMS = hcl +hcl_SOURCES = hcl.pas main.pas +hcl_CPPFLAGS = +hcl_DEPENDENCIES = hcl.bin + +hcl_LINK = cp -pf hcl.bin $(builddir)/hcl$(EXEEXT) || echo + +hcl.bin: $(hcl_SOURCES) ../lib/libhcl.la $(hcl_OBJECTS) + fpc -o$(builddir)/$@ -FcUTF-8 -Fl../lib -Fl../lib/.libs -Fl/usr/lib/gcc/x86_64-linux-gnu/11 $(srcdir)/main.pas + +clean-local: + rm -f *.ppu *.res hcl.bin diff --git a/pas/Makefile.in b/pas/Makefile.in new file mode 100644 index 0000000..5708d1b --- /dev/null +++ b/pas/Makefile.in @@ -0,0 +1,631 @@ +# Makefile.in generated by automake 1.16.5 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994-2021 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +VPATH = @srcdir@ +am__is_gnu_make = { \ + if test -z '$(MAKELEVEL)'; then \ + false; \ + elif test -n '$(MAKE_HOST)'; then \ + true; \ + elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ + true; \ + else \ + false; \ + fi; \ +} +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +bin_PROGRAMS = hcl$(EXEEXT) +subdir = pas +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/m4/ax_check_sign.m4 \ + $(top_srcdir)/m4/ax_numval.m4 $(top_srcdir)/m4/ax_pthread.m4 \ + $(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \ + $(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \ + $(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +DIST_COMMON = $(srcdir)/Makefile.am $(am__DIST_COMMON) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/lib/hcl-cfg.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +am__installdirs = "$(DESTDIR)$(bindir)" +PROGRAMS = $(bin_PROGRAMS) +am_hcl_OBJECTS = +hcl_OBJECTS = $(am_hcl_OBJECTS) +hcl_LDADD = $(LDADD) +AM_V_P = $(am__v_P_@AM_V@) +am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = +DEFAULT_INCLUDES = +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +AM_V_lt = $(am__v_lt_@AM_V@) +am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@) +am__v_lt_0 = --silent +am__v_lt_1 = +LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \ + $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \ + $(AM_CFLAGS) $(CFLAGS) +AM_V_CC = $(am__v_CC_@AM_V@) +am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@) +am__v_CC_0 = @echo " CC " $@; +am__v_CC_1 = +CCLD = $(CC) +LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \ + $(AM_LDFLAGS) $(LDFLAGS) -o $@ +AM_V_CCLD = $(am__v_CCLD_@AM_V@) +am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@) +am__v_CCLD_0 = @echo " CCLD " $@; +am__v_CCLD_1 = +SOURCES = $(hcl_SOURCES) +DIST_SOURCES = $(hcl_SOURCES) +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +am__DIST_COMMON = $(srcdir)/Makefile.in +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ +AR = @AR@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +BUILD_MODE = @BUILD_MODE@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CSCOPE = @CSCOPE@ +CTAGS = @CTAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DLLTOOL = @DLLTOOL@ +DL_LIBS = @DL_LIBS@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +ETAGS = @ETAGS@ +EXEEXT = @EXEEXT@ +FGREP = @FGREP@ +FILECMD = @FILECMD@ +GREP = @GREP@ +HCL_PROJECT_AUTHOR = @HCL_PROJECT_AUTHOR@ +HCL_PROJECT_URL = @HCL_PROJECT_URL@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBM = @LIBM@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIBTOOL_DEPS = @LIBTOOL_DEPS@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTDL_LIBS = @LTDL_LIBS@ +LTLIBOBJS = @LTLIBOBJS@ +LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ +MAKEINFO = @MAKEINFO@ +MANIFEST_TOOL = @MANIFEST_TOOL@ +MKDIR_P = @MKDIR_P@ +NM = @NM@ +NMEDIT = @NMEDIT@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PACKAGE_VERSION_MAJOR = @PACKAGE_VERSION_MAJOR@ +PACKAGE_VERSION_MINOR = @PACKAGE_VERSION_MINOR@ +PACKAGE_VERSION_PATCH = @PACKAGE_VERSION_PATCH@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PTHREAD_CC = @PTHREAD_CC@ +PTHREAD_CFLAGS = @PTHREAD_CFLAGS@ +PTHREAD_CXX = @PTHREAD_CXX@ +PTHREAD_LIBS = @PTHREAD_LIBS@ +QUADMATH_LIBS = @QUADMATH_LIBS@ +RANLIB = @RANLIB@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +UNICOWS_LIBS = @UNICOWS_LIBS@ +UNWIND_LIBS = @UNWIND_LIBS@ +VERSION = @VERSION@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_AR = @ac_ct_AR@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +ax_pthread_config = @ax_pthread_config@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +runstatedir = @runstatedir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +AUTOMAKE_OPTIONS = nostdinc +hcl_SOURCES = hcl.pas main.pas +hcl_CPPFLAGS = +hcl_DEPENDENCIES = hcl.bin +hcl_LINK = cp -pf hcl.bin $(builddir)/hcl$(EXEEXT) || echo +all: all-am + +.SUFFIXES: +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign pas/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --foreign pas/Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__maybe_remake_depfiles)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__maybe_remake_depfiles);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): +install-binPROGRAMS: $(bin_PROGRAMS) + @$(NORMAL_INSTALL) + @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \ + if test -n "$$list"; then \ + echo " $(MKDIR_P) '$(DESTDIR)$(bindir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(bindir)" || exit 1; \ + fi; \ + for p in $$list; do echo "$$p $$p"; done | \ + sed 's/$(EXEEXT)$$//' | \ + while read p p1; do if test -f $$p \ + || test -f $$p1 \ + ; then echo "$$p"; echo "$$p"; else :; fi; \ + done | \ + sed -e 'p;s,.*/,,;n;h' \ + -e 's|.*|.|' \ + -e 'p;x;s,.*/,,;s/$(EXEEXT)$$//;$(transform);s/$$/$(EXEEXT)/' | \ + sed 'N;N;N;s,\n, ,g' | \ + $(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1 } \ + { d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \ + if ($$2 == $$4) files[d] = files[d] " " $$1; \ + else { print "f", $$3 "/" $$4, $$1; } } \ + END { for (d in files) print "f", d, files[d] }' | \ + while read type dir files; do \ + if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \ + test -z "$$files" || { \ + echo " $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files '$(DESTDIR)$(bindir)$$dir'"; \ + $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files "$(DESTDIR)$(bindir)$$dir" || exit $$?; \ + } \ + ; done + +uninstall-binPROGRAMS: + @$(NORMAL_UNINSTALL) + @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \ + files=`for p in $$list; do echo "$$p"; done | \ + sed -e 'h;s,^.*/,,;s/$(EXEEXT)$$//;$(transform)' \ + -e 's/$$/$(EXEEXT)/' \ + `; \ + test -n "$$list" || exit 0; \ + echo " ( cd '$(DESTDIR)$(bindir)' && rm -f" $$files ")"; \ + cd "$(DESTDIR)$(bindir)" && rm -f $$files + +clean-binPROGRAMS: + @list='$(bin_PROGRAMS)'; test -n "$$list" || exit 0; \ + echo " rm -f" $$list; \ + rm -f $$list || exit $$?; \ + test -n "$(EXEEXT)" || exit 0; \ + list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \ + echo " rm -f" $$list; \ + rm -f $$list + +hcl$(EXEEXT): $(hcl_OBJECTS) $(hcl_DEPENDENCIES) $(EXTRA_hcl_DEPENDENCIES) + @rm -f hcl$(EXEEXT) + $(AM_V_GEN)$(hcl_LINK) $(hcl_OBJECTS) $(hcl_LDADD) $(LIBS) + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-am +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-am + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscopelist: cscopelist-am + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags +distdir: $(BUILT_SOURCES) + $(MAKE) $(AM_MAKEFLAGS) distdir-am + +distdir-am: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(PROGRAMS) +installdirs: + for dir in "$(DESTDIR)$(bindir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-binPROGRAMS clean-generic clean-libtool clean-local \ + mostlyclean-am + +distclean: distclean-am + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: install-binPROGRAMS + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic \ + mostlyclean-libtool + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: uninstall-binPROGRAMS + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean \ + clean-binPROGRAMS clean-generic clean-libtool clean-local \ + cscopelist-am ctags ctags-am distclean distclean-compile \ + distclean-generic distclean-libtool distclean-tags distdir dvi \ + dvi-am html html-am info info-am install install-am \ + install-binPROGRAMS install-data install-data-am install-dvi \ + install-dvi-am install-exec install-exec-am install-html \ + install-html-am install-info install-info-am install-man \ + install-pdf install-pdf-am install-ps install-ps-am \ + install-strip installcheck installcheck-am installdirs \ + maintainer-clean maintainer-clean-generic mostlyclean \ + mostlyclean-compile mostlyclean-generic mostlyclean-libtool \ + pdf pdf-am ps ps-am tags tags-am uninstall uninstall-am \ + uninstall-binPROGRAMS + +.PRECIOUS: Makefile + + +hcl.bin: $(hcl_SOURCES) ../lib/libhcl.la $(hcl_OBJECTS) + fpc -o$(builddir)/$@ -FcUTF-8 -Fl../lib -Fl../lib/.libs -Fl/usr/lib/gcc/x86_64-linux-gnu/11 $(srcdir)/main.pas + +clean-local: + rm -f *.ppu *.res hcl.bin + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/pas/hcl.pas b/pas/hcl.pas new file mode 100644 index 0000000..48d3887 --- /dev/null +++ b/pas/hcl.pas @@ -0,0 +1,204 @@ +unit HCL; + +{$mode objfpc}{$H+} +{$linklib hcl} +{$linklib c} +{$linklib gcc} +{$linklib quadmath} + +interface + +type + Interp = class + public + handle: pointer; + private + handle1: integer; + handle2: integer; + handle3: integer; + handle4: integer; + handle5: integer; + handle6: integer; + public + constructor Create (x: integer); + destructor Destroy; override; + procedure Ignite(heapsize: sizeint); + procedure AddBuiltinPrims(); + procedure Compile(text: pansichar); + procedure Compile(text: pansichar; len: sizeint); + procedure Compile(text: pwidechar); + procedure Compile(text: pwidechar; len: sizeint); + procedure Execute(); + + protected + function FetchErrorMsg(): string; + end; + + InterpPtr = ^Interp; + +(*----- external hcl function -----*) +function hcl_errnum_to_errbcstr(errnum: integer; errbuf: pointer; errbufsz: sizeint): pointer; cdecl; external; +function hcl_openstd(xtnsize: sizeint; errnum: pointer): pointer; cdecl; external; +procedure hcl_close(handle: pointer); cdecl; external; +function hcl_geterrbmsg(handle: pointer): pansichar; cdecl; external; +function hcl_ignite(handle: pointer; heapsize: sizeint): integer; cdecl; external; +function hcl_addbuiltinprims(handle: pointer): integer; cdecl; external; +function hcl_beginfeed(handle: pointer; on_cnode: pointer): integer; cdecl; external; +function hcl_feedbchars(handle: pointer; data: pansichar; len: sizeint): integer; cdecl; external; +function hcl_feeduchars(handle: pointer; data: pwidechar; len: sizeint): integer; cdecl; external; (* this is wrong in deed *) +function hcl_endfeed(handle: pointer): integer; cdecl; external; + +function hcl_attachcciostdwithbcstr(handle: pointer; cci: pansichar): integer; cdecl; external; +procedure hcl_detachccio(handle: pointer); cdecl; external; +function hcl_attachudiostdwithbcstr(handle: pointer; udi: pansichar; udo: pansichar): integer; cdecl; external; +procedure hcl_detachudio(handle: pointer); cdecl; external; +function hcl_compile(handle: pointer; cnode: pointer; flags: integer): integer; cdecl; external; +function hcl_execute(handle: pointer): integer; cdecl; external; +procedure hcl_abort(handle: pointer) cdecl; external; + +function hcl_count_ucstr(ptr: pwidechar): sizeint; cdecl; external; +(*----- end external hcl function -----*) + +implementation + +uses sysutils; + +constructor Interp.Create (x: integer); +var + h: pointer; + errnum: integer; + errmsg: array[0..255] of AnsiChar; +begin + h := hcl_openstd(0, @errnum); + if h = nil then begin + hcl_errnum_to_errbcstr (errnum, @errmsg, length(errmsg)); + raise Exception.Create(errmsg); + end; + self.handle := h; +end; + +destructor Interp.Destroy; +begin + if self.handle <> nil then + begin + hcl_close(self.handle); + self.handle := nil; + end; + inherited; +end; + +function Interp.FetchErrorMsg(): string; +var + bmsg: PAnsiChar; +begin + (* TODO: if the errocode is syntax error. use the systax error message and locations info *) + bmsg := hcl_geterrbmsg(self.handle); + exit(string(bmsg)) +end; + +procedure Interp.Ignite(heapsize: sizeint); +begin + if hcl_ignite(self.handle, heapsize) <= -1 then + begin + (* TODO: proper error message *) + raise Exception.Create('failed to ignite - ' + self.FetchErrorMsg()) + end; +end; + +procedure Interp.AddBuiltinPrims(); +begin + (* TODO: proper error message *) + if hcl_addbuiltinprims(self.handle) <= -1 then + begin + raise Exception.Create('failed to add builtin primitives - ' + self.FetchErrorMsg()) + end; +end; + +procedure Interp.Compile(text: pansichar); +begin + self.Compile(text, sysutils.strlen(text)); +end; + +procedure Interp.Compile(text: pansichar; len: sizeint); +var + errmsg: string; +begin + if hcl_attachcciostdwithbcstr(self.handle, nil) <= -1 then begin + raise Exception.Create('failed to attach ccio handlers - ' + self.FetchErrorMsg()) + end; + + if hcl_beginfeed(self.handle, nil) <= -1 then begin + errmsg := self.FetchErrorMsg(); + hcl_detachccio(self.handle); + raise Exception.Create('failed to begin feeding - ' + errmsg) + end; + + if hcl_feedbchars(self.handle, text, len) <= -1 then begin + errmsg := self.FetchErrorMsg(); + hcl_endfeed(self.handle); + hcl_detachccio(self.handle); + raise Exception.Create('failed to feed text - ' + errmsg) + end; + + if hcl_endfeed(self.handle) <= -1 then begin + errmsg := self.FetchErrorMsg(); + hcl_detachccio(self.handle); + raise Exception.Create('failed to end feeding - ' + errmsg) + end; + + hcl_detachccio(self.handle); +end; + +procedure Interp.Compile(text: pwidechar); +begin + self.Compile(text, sysutils.strlen(text)); +end; + +procedure Interp.Compile(text: pwidechar; len: sizeint); +var + errmsg: string; +begin + if hcl_attachcciostdwithbcstr(self.handle, nil) <= -1 then begin + raise Exception.Create('failed to attach ccio handlers - ' + self.FetchErrorMsg()) + end; + + if hcl_beginfeed(self.handle, nil) <= -1 then begin + errmsg := self.FetchErrorMsg(); + hcl_detachccio(self.handle); + raise Exception.Create('failed to begin feeding - ' + errmsg) + end; + + if hcl_feeduchars(self.handle, text, len) <= -1 then begin + errmsg := self.FetchErrorMsg(); + hcl_endfeed(self.handle); + hcl_detachccio(self.handle); + raise Exception.Create('failed to feed text - ' + errmsg) + end; + + if hcl_endfeed(self.handle) <= -1 then begin + errmsg := self.FetchErrorMsg(); + hcl_detachccio(self.handle); + raise Exception.Create('failed to end feeding - ' + errmsg) + end; + + hcl_detachccio(self.handle); +end; + + +procedure Interp.Execute(); +var + n: integer; +begin + if hcl_attachudiostdwithbcstr(self.handle, nil, nil) <= -1 then begin + raise Exception.Create('failed to attach udio handlers - ' + self.FetchErrorMsg()) + end; + n := hcl_execute(self.handle); + hcl_detachudio(self.handle); + if n <= -1 then + begin + raise Exception.Create('failed to execute - ' + self.FetchErrorMsg()) + end; +end; + +end. (* unit *) + diff --git a/pas/main.pas b/pas/main.pas new file mode 100644 index 0000000..2839e4a --- /dev/null +++ b/pas/main.pas @@ -0,0 +1,81 @@ +program main; + +{$mode objfpc}{$H+} + +uses HCL, sysutils; + +(* +function Make(): HCL.InterpPtr; +var + x: HCL.Interp; +begin + x := HCL.Interp.Create(20); + Make := @x; +end; + +function Make2(): HCL.Interp; +begin + Make2 := HCL.Interp.Create(20); +end; + + +var + x: HCL.Interp; + x2: ^HCL.Interp; +begin + Write ('sizeof X=>'); + Writeln (SizeOf(x)); + x := HCL.Interp.Make(20); + Write ('instance sizeof X=>'); + Writeln (x.InstanceSize()); +// x.Open(); +// x.Close(); + x.Destroy(); + //x.Free(); + + Write ('sizeof X2=>'); + Writeln (SizeOf(x2)); + +// New(x2); +// x2^.Open(); +// //x2^.Destroy(); +// //x2^.Free(); +// Dispose (x2); + + x := Make2(); + //Writeln (x.handle); + x.Destroy(); + x := nil; + +// x2 := Make(); +// Writeln (x2^.handle); +// x2^.Destroy(); +end. +*) + +var + x: HCL.Interp = nil; +begin + try + x := HCL.Interp.Create(100); + x.Ignite(0); + + x.AddBuiltinPrims(); + //x.AttachCCIO(); + //x.AttachUDIO(); + + x.Compile(pwidechar('(printf "hello 동키콩\n")')); + x.Compile('(printf "hello 동키콩월드\n")'); + x.Compile('(a := 20)'); + x.Compile('(printf "%d\n" a)'); + + x.Execute(); + except + on e: Exception do + writeln ('exception:', e.Message); + else + writeln ('unknonw exception'); + end; + + if x <> nil then x.Destroy(); +end. \ No newline at end of file