From a4d8d8e2a59e55af20316ba15a93b9a25a563ab2 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Tue, 13 Feb 2024 00:57:30 +0900 Subject: [PATCH] WIP - updating pascal wrapper with its own cci handler --- Makefile.in | 2 +- bin/Makefile.in | 2 +- configure | 24 ++++- configure.ac | 7 +- lib/Makefile.in | 2 +- lib/hcl.h | 8 -- lib/read.c | 57 ++++++---- lib/std.c | 4 +- mod/Makefile.in | 2 +- pas/Makefile.am | 11 +- pas/Makefile.in | 10 +- pas/hcl.pas | 280 ++++++++++++++++++++++++++++++++++++++++++------ pas/main.pas | 13 ++- t/Makefile.in | 2 +- 14 files changed, 339 insertions(+), 85 deletions(-) diff --git a/Makefile.in b/Makefile.in index 79a2bd1..d4fdd16 100644 --- a/Makefile.in +++ b/Makefile.in @@ -252,9 +252,9 @@ EXEEXT = @EXEEXT@ FGREP = @FGREP@ FILECMD = @FILECMD@ GREP = @GREP@ -HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC = @HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC@ HCL_PROJECT_AUTHOR = @HCL_PROJECT_AUTHOR@ HCL_PROJECT_URL = @HCL_PROJECT_URL@ +HCL_SYS_LIB_SEARCH_PATH_SPEC = @HCL_SYS_LIB_SEARCH_PATH_SPEC@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ diff --git a/bin/Makefile.in b/bin/Makefile.in index 3c663ce..3e9dbe6 100644 --- a/bin/Makefile.in +++ b/bin/Makefile.in @@ -249,9 +249,9 @@ EXEEXT = @EXEEXT@ FGREP = @FGREP@ FILECMD = @FILECMD@ GREP = @GREP@ -HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC = @HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC@ HCL_PROJECT_AUTHOR = @HCL_PROJECT_AUTHOR@ HCL_PROJECT_URL = @HCL_PROJECT_URL@ +HCL_SYS_LIB_SEARCH_PATH_SPEC = @HCL_SYS_LIB_SEARCH_PATH_SPEC@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ diff --git a/configure b/configure index a86eb7e..1781449 100755 --- a/configure +++ b/configure @@ -662,7 +662,9 @@ ac_subst_vars='am__EXEEXT_FALSE am__EXEEXT_TRUE LTLIBOBJS LIBOBJS -HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC +HCL_LIB_QUADMATH_REQUIRED_FALSE +HCL_LIB_QUADMATH_REQUIRED_TRUE +HCL_SYS_LIB_SEARCH_PATH_SPEC HCL_PROJECT_URL HCL_PROJECT_AUTHOR ENABLE_HCLGO_FALSE @@ -17881,6 +17883,7 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext fi +hcl_lib_quadmath_required="" if test ${ac_cv_sizeof___float128} -gt 0 then ac_fn_c_check_func "$LINENO" "quadmath_snprintf" "ac_cv_func_quadmath_snprintf" @@ -17946,6 +17949,7 @@ then : QUADMATH_LIBS="-lquadmath" LIBM="$LIBM -lquadmath" + hcl_lib_quadmath_required="yes" printf "%s\n" "#define HAVE_QUADMATH_SNPRINTF 1" >>confdefs.h @@ -17954,10 +17958,8 @@ fi if test "$ac_cv_lib_quadmath_quadmath_snprintf" = "no" then - - ac_cv_sizeof___float128=0 + ac_cv_sizeof___float128=0 fi - else QUADMATH_LIBS="$LIBM" fi @@ -18727,7 +18729,15 @@ HCL_PROJECT_AUTHOR="${PACKAGE_BUGREPORT}" HCL_PROJECT_URL="${PACKAGE_URL}" -HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC="$sys_lib_search_path_spec" +HCL_SYS_LIB_SEARCH_PATH_SPEC="${sys_lib_search_path_spec}" + + if test "x${hcl_lib_quadmath_required}" = "xyes"; then + HCL_LIB_QUADMATH_REQUIRED_TRUE= + HCL_LIB_QUADMATH_REQUIRED_FALSE='#' +else + HCL_LIB_QUADMATH_REQUIRED_TRUE='#' + HCL_LIB_QUADMATH_REQUIRED_FALSE= +fi if test `expr " $0" : " '.*"` = 0; then @@ -18915,6 +18925,10 @@ if test -z "${ENABLE_HCLGO_TRUE}" && test -z "${ENABLE_HCLGO_FALSE}"; then as_fn_error $? "conditional \"ENABLE_HCLGO\" was never defined. Usually this means the macro was only invoked conditionally." "$LINENO" 5 fi +if test -z "${HCL_LIB_QUADMATH_REQUIRED_TRUE}" && test -z "${HCL_LIB_QUADMATH_REQUIRED_FALSE}"; then + as_fn_error $? "conditional \"HCL_LIB_QUADMATH_REQUIRED\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi : "${CONFIG_STATUS=./config.status}" ac_write_fail=0 diff --git a/configure.ac b/configure.ac index fd858fe..d3c8992 100644 --- a/configure.ac +++ b/configure.ac @@ -415,6 +415,7 @@ fi dnl Quadmath functions may not be in the default c library. dnl Find a library containing them. Disable the float128 type dnl if they are not available. +hcl_lib_quadmath_required="" if test ${ac_cv_sizeof___float128} -gt 0 then AC_CHECK_FUNCS([quadmath_snprintf]) @@ -433,6 +434,7 @@ then AC_CHECK_LIB([quadmath], [quadmath_snprintf], [ QUADMATH_LIBS="-lquadmath" LIBM="$LIBM -lquadmath" + hcl_lib_quadmath_required="yes" AC_DEFINE(HAVE_QUADMATH_SNPRINTF, 1) ]) @@ -440,10 +442,8 @@ then then dnl quadmath_snprintf not avalable in the dnl quadmath lib. - ac_cv_sizeof___float128=0 fi - else QUADMATH_LIBS="$LIBM" fi @@ -674,7 +674,8 @@ AM_CONDITIONAL(ENABLE_HCLGO, test "x${enable_hclgo_is}" = "xyes") dnl ==== subsititution of some key items ==== AC_SUBST(HCL_PROJECT_AUTHOR, "${PACKAGE_BUGREPORT}") AC_SUBST(HCL_PROJECT_URL, "${PACKAGE_URL}") -AC_SUBST(HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC, ["$sys_lib_search_path_spec"]) +AC_SUBST(HCL_SYS_LIB_SEARCH_PATH_SPEC, ["${sys_lib_search_path_spec}"]) +AM_CONDITIONAL(HCL_LIB_QUADMATH_REQUIRED, test "x${hcl_lib_quadmath_required}" = "xyes") dnl === configure arguments if test `expr " [$]0" : " '.*"` = 0; then diff --git a/lib/Makefile.in b/lib/Makefile.in index 68653e6..7640a89 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -301,9 +301,9 @@ EXEEXT = @EXEEXT@ FGREP = @FGREP@ FILECMD = @FILECMD@ GREP = @GREP@ -HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC = @HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC@ HCL_PROJECT_AUTHOR = @HCL_PROJECT_AUTHOR@ HCL_PROJECT_URL = @HCL_PROJECT_URL@ +HCL_SYS_LIB_SEARCH_PATH_SPEC = @HCL_SYS_LIB_SEARCH_PATH_SPEC@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ diff --git a/lib/hcl.h b/lib/hcl.h index 0472b54..a0b763b 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -2266,14 +2266,6 @@ HCL_EXPORT hcl_lxc_t* hcl_readbasesrchar ( hcl_t* hcl ); -/* TODO: don't expose hcl_readbasesrraw() - * find a better way not to use them */ -HCL_EXPORT hcl_ooch_t* hcl_readbasesrraw ( - hcl_t* hcl, - hcl_oow_t* xlen -); - - HCL_EXPORT int hcl_attachccio ( hcl_t* hcl, hcl_io_impl_t cci_rdr diff --git a/lib/read.c b/lib/read.c index fc6cd52..4dbda45 100644 --- a/lib/read.c +++ b/lib/read.c @@ -270,6 +270,7 @@ static int copy_string_to (hcl_t* hcl, const hcl_oocs_t* src, hcl_oocs_t* dst, h return 0; } +/* TODO: remove GET_CHAR(), GET_CHAR_TO(), get_char(), _get_char() */ #define GET_CHAR(hcl) \ do { if (get_char(hcl) <= -1) return -1; } while (0) @@ -2913,6 +2914,41 @@ static void feed_update_lx_loc (hcl_t* hcl, hcl_ooci_t ch) } } +#if 0 +TODO: support the byte cci stream + +static int read_cci_stream (hcl_t* hcl) +{ + int x; + hcl_io_cciarg_t* arg; + + arg = hcl->c->curinp; + + /*x = hcl->c->cci_rdr(hcl, HCL_IO_READ, hcl->c->curinp);*/ + x = hcl->c->cci_rdr(hcl, arg->read_cmd, hcl->c->curinp); + if (x <= -1) return -1; + +#if defined(HCL_OOCH_IS_UCH) + if (arg->read_cmd == HCL_IO_READ_BYTES) + { + hcl_oow_t bcslen, ucslen; + bcslen = arg->bytes.len; + ucslen = HCL_COUNTOF(arg->buf); + x = hcl_convbtooochars(hcl, arg->bytes.buf, &bcslen, arg->buf, &ucslen); + if (x <= -1 && ucslen <= 0) return -1; + + remlen = bb->len - bcslen; + if (remlen > 0) HCL_MEMMOVE (bb->buf, &bb->buf[bcslen], remlen); + bb->len = remlen; + + arg->xlen = ucslen; + } +#endif + + return 0; +} +#endif + static int feed_from_includee (hcl_t* hcl) { int x; @@ -2923,10 +2959,8 @@ static int feed_from_includee (hcl_t* hcl) { if (hcl->c->curinp->b.pos >= hcl->c->curinp->b.len) { - if (hcl->c->cci_rdr(hcl, HCL_IO_READ, hcl->c->curinp) <= -1) - { - return -1; - } + x = hcl->c->cci_rdr(hcl, HCL_IO_READ, hcl->c->curinp); + if (x <= -1) return -1; if (hcl->c->curinp->xlen <= 0) { @@ -3511,7 +3545,7 @@ void hcl_flushudio (hcl_t* hcl) -/* TODO: discard the fwollowing three functions - hcl_setbasesrloc, hcl_readbasesrchar, hcl_readbasesrraw */ +/* TODO: discard the fwollowing three functions - hcl_setbasesrloc, hcl_readbasesrchar */ void hcl_setbasesrloc (hcl_t* hcl, hcl_oow_t line, hcl_oow_t colm) { hcl->c->cci_arg.line = line; @@ -3527,16 +3561,3 @@ hcl_lxc_t* hcl_readbasesrchar (hcl_t* hcl) if (n <= -1) return HCL_NULL; return &hcl->c->cci_arg.lxc; } - -hcl_ooch_t* hcl_readbasesrraw (hcl_t* hcl, hcl_oow_t* xlen) -{ - /* this function provides the raw input interface to the attached source - * input handler. it doesn't increment line/column number, nor does it - * care about ungot characters. it must be used with extra care */ - - HCL_ASSERT (hcl, hcl->c != HCL_NULL); /* call hio_attachio() or hio_attachiostd() with proper arguments first */ - - if (hcl->c->cci_rdr(hcl, HCL_IO_READ, &hcl->c->cci_arg) <= -1) return HCL_NULL; - *xlen = hcl->c->cci_arg.xlen; - return hcl->c->cci_arg.buf; -} diff --git a/lib/std.c b/lib/std.c index c11e4ed..70c4a70 100644 --- a/lib/std.c +++ b/lib/std.c @@ -3467,8 +3467,8 @@ static int cci_handler (hcl_t* hcl, hcl_io_cmd_t cmd, void* arg) return 0; case HCL_IO_READ_BYTES: /* byte input prohibited */ - case HCL_IO_WRITE: /* character output prohibit */ - case HCL_IO_WRITE_BYTES: /* byte output prohibit */ + case HCL_IO_WRITE: /* character output prohibited */ + case HCL_IO_WRITE_BYTES: /* byte output prohibited */ default: hcl_seterrnum (hcl, HCL_EINTERN); return -1; diff --git a/mod/Makefile.in b/mod/Makefile.in index 2f19a8e..4fd7ded 100644 --- a/mod/Makefile.in +++ b/mod/Makefile.in @@ -270,9 +270,9 @@ EXEEXT = @EXEEXT@ FGREP = @FGREP@ FILECMD = @FILECMD@ GREP = @GREP@ -HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC = @HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC@ HCL_PROJECT_AUTHOR = @HCL_PROJECT_AUTHOR@ HCL_PROJECT_URL = @HCL_PROJECT_URL@ +HCL_SYS_LIB_SEARCH_PATH_SPEC = @HCL_SYS_LIB_SEARCH_PATH_SPEC@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ diff --git a/pas/Makefile.am b/pas/Makefile.am index 967226e..07e535e 100644 --- a/pas/Makefile.am +++ b/pas/Makefile.am @@ -5,15 +5,20 @@ hcl_SOURCES = hcl.pas main.pas hcl_CPPFLAGS = hcl_DEPENDENCIES = hcl.bin +PASFLAGS = -Mobjfpc -FcUTF8 -g +if HCL_LIB_QUADMATH_REQUIRED +PASFLAGS += -dHCL_LIB_QUADMATH_REQUIRED +endif + hcl_LINK = cp -pf hcl.bin $(builddir)/hcl$(EXEEXT) || echo hcl.bin: $(hcl_SOURCES) ../lib/libhcl.la $(hcl_OBJECTS) FL='-Fl../lib:../lib/.libs'; \ - for i in @HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC@; do \ + for i in @HCL_SYS_LIB_SEARCH_PATH_SPEC@; do \ FL="$${FL}:$${i}"; \ done; \ - echo fpc -o$(builddir)/$@ -g -Mobjfpc -FcUTF8 "$${FL}" $(srcdir)/main.pas; \ - fpc -o$(builddir)/$@ -g -Mobjfpc -FcUTF8 "$${FL}" $(srcdir)/main.pas + echo fpc -o$(builddir)/$@ $(PASFLAGS) "$${FL}" $(srcdir)/main.pas; \ + fpc -o$(builddir)/$@ $(PASFLAGS) $(PASFLAGS) "$${FL}" $(srcdir)/main.pas clean-local: rm -f *.ppu *.res hcl.bin diff --git a/pas/Makefile.in b/pas/Makefile.in index 31a74d4..a36a8e6 100644 --- a/pas/Makefile.in +++ b/pas/Makefile.in @@ -89,6 +89,7 @@ POST_UNINSTALL = : build_triplet = @build@ host_triplet = @host@ bin_PROGRAMS = hcl$(EXEEXT) +@HCL_LIB_QUADMATH_REQUIRED_TRUE@am__append_1 = -dHCL_LIB_QUADMATH_REQUIRED subdir = pas ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/m4/ax_check_sign.m4 \ @@ -201,9 +202,9 @@ EXEEXT = @EXEEXT@ FGREP = @FGREP@ FILECMD = @FILECMD@ GREP = @GREP@ -HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC = @HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC@ HCL_PROJECT_AUTHOR = @HCL_PROJECT_AUTHOR@ HCL_PROJECT_URL = @HCL_PROJECT_URL@ +HCL_SYS_LIB_SEARCH_PATH_SPEC = @HCL_SYS_LIB_SEARCH_PATH_SPEC@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ @@ -312,6 +313,7 @@ AUTOMAKE_OPTIONS = nostdinc hcl_SOURCES = hcl.pas main.pas hcl_CPPFLAGS = hcl_DEPENDENCIES = hcl.bin +PASFLAGS = -Mobjfpc -FcUTF8 -g $(am__append_1) hcl_LINK = cp -pf hcl.bin $(builddir)/hcl$(EXEEXT) || echo all: all-am @@ -623,11 +625,11 @@ uninstall-am: uninstall-binPROGRAMS hcl.bin: $(hcl_SOURCES) ../lib/libhcl.la $(hcl_OBJECTS) FL='-Fl../lib:../lib/.libs'; \ - for i in @HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC@; do \ + for i in @HCL_SYS_LIB_SEARCH_PATH_SPEC@; do \ FL="$${FL}:$${i}"; \ done; \ - echo fpc -o$(builddir)/$@ -g -Mobjfpc -FcUTF8 "$${FL}" $(srcdir)/main.pas; \ - fpc -o$(builddir)/$@ -g -Mobjfpc -FcUTF8 "$${FL}" $(srcdir)/main.pas + echo fpc -o$(builddir)/$@ $(PASFLAGS) "$${FL}" $(srcdir)/main.pas; \ + fpc -o$(builddir)/$@ $(PASFLAGS) $(PASFLAGS) "$${FL}" $(srcdir)/main.pas clean-local: rm -f *.ppu *.res hcl.bin diff --git a/pas/hcl.pas b/pas/hcl.pas index 291e325..3002d98 100644 --- a/pas/hcl.pas +++ b/pas/hcl.pas @@ -3,8 +3,11 @@ unit HCL; {$mode objfpc}{$H+} {$linklib hcl} {$linklib c} + +{$if defined(HCL_LIB_QUADMATH_REQUIRED)} {$linklib gcc} {$linklib quadmath} +{$endif} interface @@ -16,39 +19,66 @@ type TRAIT_LANG_ENABLE_BLOCK = (BitMask(1) shl 15);*) type - TraitBit = ( + TraitBit = ( (* this enum must follow hcl_trait_t in hcl.h *) LANG_ENABLE_EOF = (BitMask(1) shl 14), LANG_ENABLE_BLOCK = (BitMask(1) shl 15) ); - Option = ( + Option = ( (* this enum must follow hcl_option_t in hcl.h *) TRAIT, LOG_MASK, LOG_MAXCAPA ); + IoCmd = ( (* this enum must follow hcl_io_cmd_t in hcl.h *) + IO_OPEN, + IO_CLOSE, + IO_READ, + IO_READ_BYTES, + IO_WRITE, + IO_WRITE_BYTES, + IO_FLUSH + ); + + CciArgPtr = ^CciArg; + CciArg = record (* this record must follow the public part of hcl_io_cciarg_t in hcl.h *) + name: pwidechar; + handle: pointer; + buf: array[0..2047] of widechar; + xlen: System.SizeUint; + includer: CciArgPtr; + end; + Interp = class protected handle: pointer; public - constructor Create (x: integer); - destructor Destroy; override; - procedure Ignite(heapsize: sizeint); + constructor Create(x: integer); + destructor Destroy(); override; + procedure Ignite(heapsize: System.SizeUint); procedure AddBuiltinPrims(); + procedure CompileFile(filename: pansichar); procedure Compile(text: pansichar); - procedure Compile(text: pansichar; len: sizeint); + procedure Compile(text: pansichar; len: System.SizeUint); procedure Compile(text: pwidechar); - procedure Compile(text: pwidechar; len: sizeint); + procedure Compile(text: pwidechar; len: System.SizeUint); procedure Execute(); protected function FetchErrorMsg(): string; end; + IO = class + public + procedure Open(); virtual; abstract; + procedure Close(); virtual; abstract; + function Read(): System.SizeUint; virtual; abstract; + end; + Location = record - line: sizeint; - colm: sizeint; + line: System.SizeUint; + colm: System.SizeUint; filp: pwidechar; end; Synerr = record @@ -56,31 +86,33 @@ type loc: Location; tgt: record val: array[0..255] of widechar; - len: sizeint; + len: System.SizeUint; end; end; SynerrPtr = ^Synerr; (*----- external hcl function -----*) -function hcl_errnum_to_errbcstr(errnum: integer; errbuf: pointer; errbufsz: sizeint): pointer; cdecl; external; +function hcl_errnum_to_errbcstr(errnum: integer; errbuf: pointer; errbufsz: System.SizeUint): pointer; cdecl; external; function hcl_errnum_is_synerr(errnum: integer): boolean; cdecl; external; -function hcl_openstd(xtnsize: sizeint; errnum: pointer): pointer; cdecl; external; +function hcl_openstd(xtnsize: System.SizeUint; errnum: pointer): pointer; cdecl; external; procedure hcl_close(handle: pointer); cdecl; external; function hcl_setoption(handle: pointer; option: Option; value: pointer): integer; cdecl; external; function hcl_getoption(handle: pointer; option: Option; value: pointer): integer; cdecl; external; +procedure hcl_seterrnum (handle: pointer; errnum: integer); cdecl; external; function hcl_geterrnum(handle: pointer): integer; cdecl; external; function hcl_geterrbmsg(handle: pointer): pansichar; cdecl; external; -function hcl_ignite(handle: pointer; heapsize: sizeint): integer; cdecl; external; +function hcl_ignite(handle: pointer; heapsize: System.SizeUint): 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 - hcl_uchar_t may not been widechar ..*) +function hcl_feedbchars(handle: pointer; data: pansichar; len: System.SizeUint): integer; cdecl; external; +function hcl_feeduchars(handle: pointer; data: pwidechar; len: System.SizeUint): integer; cdecl; external; (* this is wrong in deed - hcl_uchar_t may not been widechar ..*) function hcl_endfeed(handle: pointer): integer; cdecl; external; +function hcl_attachccio(handle: pointer; cci: 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; @@ -90,12 +122,12 @@ function hcl_execute(handle: pointer): pointer; cdecl; external; procedure hcl_abort(handle: pointer) cdecl; external; procedure hcl_getsynerr(handle: pointer; synerr: SynerrPtr) cdecl; external; -function hcl_count_ucstr(ptr: pwidechar): sizeint; cdecl; external; +function hcl_count_ucstr(ptr: pwidechar): System.SizeUint; cdecl; external; (*----- end external hcl function -----*) implementation -uses sysutils, math; +uses SysUtils, Math, Classes; constructor Interp.Create (x: integer); var @@ -145,11 +177,11 @@ begin filp := pwidechar(widestring('')); if serr.loc.filp <> nil then filp := serr.loc.filp; if serr.tgt.len > 0 then begin - sysutils.strlcopy(@tgt, serr.tgt.val, math.min(serr.tgt.len, length(tgt) - 1)); - exit(format('%s at %s[%u:%u] - %s', [string(bmsg), string(filp), serr.loc.line, serr.loc.colm, string(tgt)])); + SysUtils.Strlcopy(@tgt, serr.tgt.val, Math.Min(serr.tgt.len, length(tgt) - 1)); + exit(SysUtils.Format('%s at %s[%u:%u] - %s', [string(bmsg), string(filp), serr.loc.line, serr.loc.colm, string(tgt)])); end else begin - exit(format('%s at %s[%u:%u]', [string(bmsg), string(filp), serr.loc.line, serr.loc.colm])); + exit(SysUtils.Format('%s at %s[%u:%u]', [string(bmsg), string(filp), serr.loc.line, serr.loc.colm])); end; end else begin @@ -158,7 +190,7 @@ begin end; end; -procedure Interp.Ignite(heapsize: sizeint); +procedure Interp.Ignite(heapsize: System.SizeUint); begin if hcl_ignite(self.handle, heapsize) <= -1 then begin @@ -176,24 +208,203 @@ begin end; end; -procedure Interp.Compile(text: pansichar); +{$if 1} +function cci_handler(handle: pointer; cmd: IoCmd; arg: CciArgPtr): integer; cdecl; +var + f: System.THandle; + len: System.LongInt; begin - self.Compile(text, sysutils.strlen(text)); + (* check if the main stream is requested. + * it doesn't have to be handled because the main stream must be handled via feeding *) + if arg^.includer = nil then exit(0); + + case cmd of + IO_OPEN: begin + f := SysUtils.FileOpen(arg^.name, SysUtils.fmOpenRead); + if f <= -1 then begin + // TODO: set error info.... + exit(-1); + end; + arg^.handle := pointer(f); + end; + + IO_CLOSE: begin + f := System.THandle(arg^.handle); + SysUtils.FileClose(f); + end; + + IO_READ: begin + hcl_seterrnum(handle, 999); (* TODO: change error code to ENOIMPL *) + exit(-1); + end; + + IO_READ_BYTES: begin + f := System.THandle(arg^.handle); + len := SysUtils.FileRead(f, arg^.buf, System.SizeOf(arg^.buf)); + if len <= -1 then begin + // TODO: set error info + exit(-1); + end; + arg^.xlen := len; + end; + + IO_FLUSH: + (* no effect on an input stream *) + ; + + (* the following operations are prohibited on the code input stream: + IO_READ: + IO_WRITE: + IO_WRITE_BYTES: + *) + else begin + hcl_seterrnum(handle, 999); (* TODO: change error code *) + exit(-1); + end; + end; + + exit(0); +end; +{$else} +function cci_handler(handle: pointer; cmd: IoCmd; arg: CciArgPtr): integer; cdecl; +var + f: Classes.TFileStream; + len: System.LongInt; +begin + (* check if the main stream is requested. + * it doesn't have to be handled because the main stream must be handled via feeding *) + if arg^.includer = nil then exit(0); + + try + case cmd of + IO_OPEN: begin + f := Classes.TFileStream.Create(arg^.name, SysUtils.fmOpenRead); + arg^.handle := pointer(f); + end; + + IO_CLOSE: begin + f := Classes.TFileStream(arg^.handle); + f.Destroy(); + end; + + IO_READ: begin + f := Classes.TFileStream(arg^.handle); + f.ReadBuffer(arg^.buf, System.SizeOf(arg^.buf)); + if len <= -1 then begin + // TODO: set error info + exit(-1); + end; + arg^.xlen := len; + end; + + IO_FLUSH: + (* no effect on an input stream *) + ; + + (* the following operations are prohibited on the code input stream: + IO_READ_BYTES: + IO_WRITE: + IO_WRITE_BYTES: + *) + else begin + hcl_seterrnum(handle, 999); (* TODO: change error code *) + exit(-1); + end; + end; + + except + on e: Exception do + writeln ('exception:', e.Message); + else + writeln ('unknonw exception'); + + exit(-1); + end; + + exit(0); +end; +{$endif} + +procedure Interp.CompileFile(filename: pansichar); +var + f: System.THandle = -1; + attached: boolean = false; + feed_ongoing: boolean = false; + errnum: System.Integer; + errmsg: string; + buf: array[0..1023] of ansichar; + len: System.LongInt; +label + oops; +begin + f := SysUtils.FileOpen(filename, SysUtils.fmOpenRead); + if f <= -1 then begin + errmsg := 'failed to open file - ' + filename; + goto oops; + end; + + if hcl_attachccio(self.handle, @cci_handler) <= -1 then begin + errmsg := 'failed to attach ccio handler - ' + self.FetchErrorMsg(); + goto oops; + end; + attached := true; + + if hcl_beginfeed(self.handle, nil) <= -1 then begin + errmsg := 'failed to begin feeding - ' + self.FetchErrorMsg(); + goto oops; + end; + feed_ongoing := true; + + while true do begin + len := SysUtils.FileRead(f, buf, System.SizeOf(buf)); + if len <= -1 then begin + errmsg := 'failed to read file - ' + filename; + goto oops; + end; + if len = 0 then break; + + if hcl_feedbchars(self.handle, buf, len) <= -1 then begin + errnum := hcl_geterrnum(self.handle); + errmsg := self.FetchErrorMsg(); + if not hcl_errnum_is_synerr(errnum) then errmsg := 'failed to feed text - ' + errmsg; + goto oops; + end; + end; + + if hcl_endfeed(self.handle) <= -1 then begin + errmsg := 'failed to end feeding - ' + self.FetchErrorMsg(); + goto oops; + end; + feed_ongoing := false; + + hcl_detachccio(self.handle); + SysUtils.FileClose(f); + exit(); + +oops: + if feed_ongoing then hcl_endfeed(self.handle); + if attached then hcl_detachccio(self.handle); + if f >= -1 then SysUtils.FileClose(f); + raise Exception.Create(errmsg); end; -procedure Interp.Compile(text: pansichar; len: sizeint); +procedure Interp.Compile(text: pansichar); +begin + self.Compile(text, SysUtils.Strlen(text)); +end; + +procedure Interp.Compile(text: pansichar; len: System.SizeUint); var errnum: integer; 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_attachcciostdwithbcstr(self.handle, nil) <= -1 then + raise Exception.Create('failed to attach ccio handler - ' + self.FetchErrorMsg()); if hcl_beginfeed(self.handle, nil) <= -1 then begin errmsg := self.FetchErrorMsg(); hcl_detachccio(self.handle); - raise Exception.Create('failed to begin feeding - ' + errmsg) + raise Exception.Create('failed to begin feeding - ' + errmsg); end; if hcl_feedbchars(self.handle, text, len) <= -1 then begin @@ -218,22 +429,21 @@ end; procedure Interp.Compile(text: pwidechar); begin - self.Compile(text, sysutils.strlen(text)); + self.Compile(text, SysUtils.Strlen(text)); end; -procedure Interp.Compile(text: pwidechar; len: sizeint); +procedure Interp.Compile(text: pwidechar; len: System.SizeUint); var errnum: integer; 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_attachcciostdwithbcstr(self.handle, nil) <= -1 then + raise Exception.Create('failed to attach ccio handler - ' + self.FetchErrorMsg()); if hcl_beginfeed(self.handle, nil) <= -1 then begin errmsg := self.FetchErrorMsg(); hcl_detachccio(self.handle); - raise Exception.Create('failed to begin feeding - ' + errmsg) + raise Exception.Create('failed to begin feeding - ' + errmsg); end; if hcl_feeduchars(self.handle, text, len) <= -1 then begin @@ -243,7 +453,7 @@ begin hcl_detachccio(self.handle); if hcl_errnum_is_synerr(errnum) then raise Exception.Create(errmsg) - else + else raise Exception.Create('failed to feed text - ' + errmsg); end; diff --git a/pas/main.pas b/pas/main.pas index ff1a731..3bdc564 100644 --- a/pas/main.pas +++ b/pas/main.pas @@ -2,11 +2,17 @@ program main; {$mode objfpc}{$H+} -uses HCL, sysutils; +uses HCL, SysUtils; var x: HCL.Interp = nil; begin + (* System.ParamCount() returns only the number of argumetns except System.ParamStr(0). It is the upper bound to System.ParamStr(). *) + if System.ParamCount() <> 1 then begin + writeln (System.Stderr, SysUtils.Format('Usage: %s ', [SysUtils.ExtractFileName(System.ParamStr(0))])); + System.Halt(-1); + end; + try x := HCL.Interp.Create(100); x.Ignite(0); @@ -15,17 +21,20 @@ begin //x.AttachCCIO(); //x.AttachUDIO(); + (* x.Compile(pwidechar('(printf "hello 동키콩\n")')); x.Compile('(printf "hello 동키콩월드\n") '); x.Compile('(동가리오 := 20)'); x.Compile('(printf "%d %d\n" 동가리오 (+ 동가리오 동가리오))'); x.Compile(pwidechar('(printf "%d %d\n" 동가리오 (동가리오 * 동가리오))'#10'printf "hello, world\n";;;'#10)); + *) + x.CompileFile(pansichar(ansistring(System.ParamStr(1)))); x.Execute(); // check if exception... except on e: Exception do - writeln ('exception:', e.Message); + writeln ('exception: ', e.Message); else writeln ('unknonw exception'); end; diff --git a/t/Makefile.in b/t/Makefile.in index efa4d19..e95b562 100644 --- a/t/Makefile.in +++ b/t/Makefile.in @@ -364,9 +364,9 @@ EXEEXT = @EXEEXT@ FGREP = @FGREP@ FILECMD = @FILECMD@ GREP = @GREP@ -HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC = @HCL_CONFIGURE_SYS_LIB_SEARCH_PATH_SPEC@ HCL_PROJECT_AUTHOR = @HCL_PROJECT_AUTHOR@ HCL_PROJECT_URL = @HCL_PROJECT_URL@ +HCL_SYS_LIB_SEARCH_PATH_SPEC = @HCL_SYS_LIB_SEARCH_PATH_SPEC@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@