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

added some pascal wrapper files
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-02-02 14:57:46 +09:00
parent a1f304bdef
commit d339338a40
17 changed files with 1022 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile.am
View File

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

2
Makefile.in
View File

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

3
bin/main.c
View File

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

3
configure vendored
View File

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

1
configure.ac
View File

@ -690,6 +690,7 @@ AC_CONFIG_FILES([
lib/Makefile
mod/Makefile
bin/Makefile
pas/Makefile
t/Makefile
])
AC_OUTPUT

2
lang.txt
View File

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

19
lib/comp.c
View File

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

12
lib/fmt.c
View File

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

16
lib/hcl-prv.h
View File

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

5
lib/hcl.h
View File

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

2
lib/print.c
View File

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

65
lib/read.c
View File

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

8
lib/std.c
View File

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

14
pas/Makefile.am Normal file
View File

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

631
pas/Makefile.in Normal file
View File

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

204
pas/hcl.pas Normal file
View File

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

81
pas/main.pas Normal file
View File

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