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

WIP - updating pascal wrapper with its own cci handler
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-02-13 00:57:30 +09:00
parent f85dd54040
commit a4d8d8e2a5
14 changed files with 339 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile.in
View File

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

2
bin/Makefile.in
View File

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

22
configure vendored
View File

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

7
configure.ac
View File

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

2
lib/Makefile.in
View File

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

8
lib/hcl.h
View File

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

57
lib/read.c
View File

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

4
lib/std.c
View File

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

2
mod/Makefile.in
View File

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

11
pas/Makefile.am
View File

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

10
pas/Makefile.in
View File

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

276
pas/hcl.pas
View File

@ -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);
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;
procedure Interp.Compile(text: pansichar; len: sizeint);
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);
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

11
pas/main.pas
View File

@ -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 <filename>', [SysUtils.ExtractFileName(System.ParamStr(0))]));
System.Halt(-1);
end;
try
x := HCL.Interp.Create(100);
x.Ignite(0);
@ -15,13 +21,16 @@ 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

2
t/Makefile.in
View File

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