From 7504ec1a4c6d5ca495c42bb48f276f4d6ee8bf0c Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Wed, 8 Oct 2025 23:38:24 +0900 Subject: [PATCH] added hak_makesymbolwithuchars()/hak_makesymbolwithbchars()/hak_makestringwithuchars()/hak_makestirngwithbchars() fixed some fpc code related to character type configured --- Makefile.in | 2 +- configure | 38 ++++++++- configure.ac | 12 ++- go/cb.go | 16 ++-- go/hak.go | 72 +++++++++--------- go/inst.go | 4 +- lib/err.c | 10 +-- lib/exec.c | 10 ++- lib/hak-prv.h | 12 +++ lib/hak.h | 21 +++-- lib/obj.c | 60 +++++++++++++++ lib/print.c | 2 +- lib/std.c | 4 + lib/sym.c | 36 ++++++++- lib/xchg.c | 31 ++++---- main.go | 2 +- pas/Makefile.am | 3 + pas/Makefile.in | 3 +- pas/hak.pas | 199 +++++++++++++++++++++++++++++++++++++----------- t/t-001.c | 1 - 20 files changed, 406 insertions(+), 132 deletions(-) diff --git a/Makefile.in b/Makefile.in index 30e6f2b..faac7a2 100644 --- a/Makefile.in +++ b/Makefile.in @@ -176,7 +176,7 @@ am__DIST_COMMON = $(srcdir)/Makefile.in $(top_srcdir)/ac/ar-lib \ $(top_srcdir)/ac/compile $(top_srcdir)/ac/config.guess \ $(top_srcdir)/ac/config.sub $(top_srcdir)/ac/install-sh \ $(top_srcdir)/ac/ltmain.sh $(top_srcdir)/ac/missing README.md \ - ac/ar-lib ac/compile ac/config.guess ac/config.sub \ + ac/ar-lib ac/compile ac/config.guess ac/config.sub ac/depcomp \ ac/install-sh ac/ltmain.sh ac/missing DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) distdir = $(PACKAGE)-$(VERSION) diff --git a/configure b/configure index 0ac112b..bd2e952 100755 --- a/configure +++ b/configure @@ -657,6 +657,10 @@ LTLIBOBJS LIBOBJS HAK_LIB_QUADMATH_REQUIRED_FALSE HAK_LIB_QUADMATH_REQUIRED_TRUE +HAK_WIDE_CHAR_SIZE_IS_2_FALSE +HAK_WIDE_CHAR_SIZE_IS_2_TRUE +HAK_WIDE_CHAR_SIZE_IS_4_FALSE +HAK_WIDE_CHAR_SIZE_IS_4_TRUE HAK_SYS_LIB_SEARCH_PATH_SPEC HAK_PROJECT_URL HAK_PROJECT_AUTHOR @@ -19917,6 +19921,7 @@ printf "%s\n" "#define HAK_WIDE_CHAR_SIZE 4" >>confdefs.h printf "%s\n" "#define HAK_ENABLE_WIDE_CHAR 1" >>confdefs.h + wide_char_size=4 elif test "${enable_wide_char}" = "yes:2" then @@ -19925,28 +19930,33 @@ printf "%s\n" "#define HAK_WIDE_CHAR_SIZE 2" >>confdefs.h printf "%s\n" "#define HAK_ENABLE_WIDE_CHAR 1" >>confdefs.h + wide_char_size=2 elif test "${enable_wide_char}" = "yes" then -printf "%s\n" "#define HAK_WIDE_CHAR_SIZE 1" >>confdefs.h +printf "%s\n" "#define HAK_WIDE_CHAR_SIZE 2" >>confdefs.h printf "%s\n" "#define HAK_ENABLE_WIDE_CHAR 1" >>confdefs.h + wide_char_size=2 elif test "${enable_wide_char}" = "no:4" then printf "%s\n" "#define HAK_WIDE_CHAR_SIZE 4" >>confdefs.h + wide_char_size=4 elif test "${enable_wide_char}" = "no:2" then printf "%s\n" "#define HAK_WIDE_CHAR_SIZE 2" >>confdefs.h + wide_char_size=2 else -printf "%s\n" "#define HAK_WIDE_CHAR_SIZE 1" >>confdefs.h +printf "%s\n" "#define HAK_WIDE_CHAR_SIZE 2" >>confdefs.h + wide_char_size=2 fi # Check whether --enable-full-liw was given. @@ -20184,6 +20194,22 @@ HAK_PROJECT_URL="${PACKAGE_URL}" HAK_SYS_LIB_SEARCH_PATH_SPEC="${sys_lib_search_path_spec}" + if test "x${wide_char_size}" = "x4"; then + HAK_WIDE_CHAR_SIZE_IS_4_TRUE= + HAK_WIDE_CHAR_SIZE_IS_4_FALSE='#' +else + HAK_WIDE_CHAR_SIZE_IS_4_TRUE='#' + HAK_WIDE_CHAR_SIZE_IS_4_FALSE= +fi + + if test "x${wide_char_size}" = "x2"; then + HAK_WIDE_CHAR_SIZE_IS_2_TRUE= + HAK_WIDE_CHAR_SIZE_IS_2_FALSE='#' +else + HAK_WIDE_CHAR_SIZE_IS_2_TRUE='#' + HAK_WIDE_CHAR_SIZE_IS_2_FALSE= +fi + if test "x${hak_lib_quadmath_required}" = "xyes"; then HAK_LIB_QUADMATH_REQUIRED_TRUE= HAK_LIB_QUADMATH_REQUIRED_FALSE='#' @@ -20402,6 +20428,14 @@ if test -z "${ENABLE_HAKGO_TRUE}" && test -z "${ENABLE_HAKGO_FALSE}"; then as_fn_error $? "conditional \"ENABLE_HAKGO\" was never defined. Usually this means the macro was only invoked conditionally." "$LINENO" 5 fi +if test -z "${HAK_WIDE_CHAR_SIZE_IS_4_TRUE}" && test -z "${HAK_WIDE_CHAR_SIZE_IS_4_FALSE}"; then + as_fn_error $? "conditional \"HAK_WIDE_CHAR_SIZE_IS_4\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${HAK_WIDE_CHAR_SIZE_IS_2_TRUE}" && test -z "${HAK_WIDE_CHAR_SIZE_IS_2_FALSE}"; then + as_fn_error $? "conditional \"HAK_WIDE_CHAR_SIZE_IS_2\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi if test -z "${HAK_LIB_QUADMATH_REQUIRED_TRUE}" && test -z "${HAK_LIB_QUADMATH_REQUIRED_FALSE}"; then as_fn_error $? "conditional \"HAK_LIB_QUADMATH_REQUIRED\" was never defined. Usually this means the macro was only invoked conditionally." "$LINENO" 5 diff --git a/configure.ac b/configure.ac index aa0dbe3..3b1ca69 100644 --- a/configure.ac +++ b/configure.ac @@ -554,22 +554,28 @@ if test "${enable_wide_char}" = "yes:4" then AC_DEFINE([HAK_WIDE_CHAR_SIZE],[4],[Wide-character type size]) AC_DEFINE([HAK_ENABLE_WIDE_CHAR],[1],[Use the wide-character type as the default character type]) + wide_char_size=4 elif test "${enable_wide_char}" = "yes:2" then AC_DEFINE([HAK_WIDE_CHAR_SIZE],[2],[Wide-character type size]) AC_DEFINE([HAK_ENABLE_WIDE_CHAR],[1],[Use the wide-character type as the default character type]) + wide_char_size=2 elif test "${enable_wide_char}" = "yes" then - AC_DEFINE([HAK_WIDE_CHAR_SIZE],[1],[Wide-character type size]) + AC_DEFINE([HAK_WIDE_CHAR_SIZE],[2],[Wide-character type size]) AC_DEFINE([HAK_ENABLE_WIDE_CHAR],[1],[Use the wide-character type as the default character type]) + wide_char_size=2 elif test "${enable_wide_char}" = "no:4" then AC_DEFINE([HAK_WIDE_CHAR_SIZE],[4],[Wide-character type size]) + wide_char_size=4 elif test "${enable_wide_char}" = "no:2" then AC_DEFINE([HAK_WIDE_CHAR_SIZE],[2],[Wide-character type size]) + wide_char_size=2 else - AC_DEFINE([HAK_WIDE_CHAR_SIZE],[1],[Wide-character type size]) + AC_DEFINE([HAK_WIDE_CHAR_SIZE],[2],[Wide-character type size]) + wide_char_size=2 fi AC_ARG_ENABLE([full-liw], @@ -696,6 +702,8 @@ dnl ==== subsititution of some key items ==== AC_SUBST(HAK_PROJECT_AUTHOR, "${PACKAGE_BUGREPORT}") AC_SUBST(HAK_PROJECT_URL, "${PACKAGE_URL}") AC_SUBST(HAK_SYS_LIB_SEARCH_PATH_SPEC, ["${sys_lib_search_path_spec}"]) +AM_CONDITIONAL(HAK_WIDE_CHAR_SIZE_IS_4, test "x${wide_char_size}" = "x4") +AM_CONDITIONAL(HAK_WIDE_CHAR_SIZE_IS_2, test "x${wide_char_size}" = "x2") AM_CONDITIONAL(HAK_LIB_QUADMATH_REQUIRED, test "x${hak_lib_quadmath_required}" = "xyes") dnl === configure arguments diff --git a/go/cb.go b/go/cb.go index e49dc71..565e94d 100644 --- a/go/cb.go +++ b/go/cb.go @@ -85,7 +85,7 @@ var io_tab IOHandleTable = IOHandleTable{} //export hak_go_cci_handler func hak_go_cci_handler(c *C.hak_t, cmd C.hak_io_cmd_t, arg unsafe.Pointer) C.int { var ( - g *HAK + g *Hak err error ) @@ -216,7 +216,7 @@ func hak_go_cci_handler(c *C.hak_t, cmd C.hak_io_cmd_t, arg unsafe.Pointer) C.in //export hak_go_udi_handler func hak_go_udi_handler(c *C.hak_t, cmd C.hak_io_cmd_t, arg unsafe.Pointer) C.int { var ( - g *HAK + g *Hak err error ) @@ -264,7 +264,7 @@ func hak_go_udi_handler(c *C.hak_t, cmd C.hak_io_cmd_t, arg unsafe.Pointer) C.in //export hak_go_udo_handler func hak_go_udo_handler(c *C.hak_t, cmd C.hak_io_cmd_t, arg unsafe.Pointer) C.int { var ( - g *HAK + g *Hak err error ) @@ -333,10 +333,10 @@ func hak_go_udo_handler(c *C.hak_t, cmd C.hak_io_cmd_t, arg unsafe.Pointer) C.in // ------------------------------------------------------ type CciFileHandler struct { - g *HAK + g *Hak } -func (p *CciFileHandler) Open(g *HAK, name string) (int, error) { +func (p *CciFileHandler) Open(g *Hak, name string) (int, error) { var ( f *os.File r *bufio.Reader @@ -398,12 +398,12 @@ func (p *CciFileHandler) Read(fd int, buf []rune) (int, error) { // ------------------------------------------------------ type UdiFileHandler struct { - g *HAK + g *Hak f *os.File r *bufio.Reader } -func (p *UdiFileHandler) Open(g *HAK) error { +func (p *UdiFileHandler) Open(g *Hak) error { var ( f *os.File // err error @@ -463,7 +463,7 @@ type UdoFileHandler struct { w *bufio.Writer } -func (p *UdoFileHandler) Open(g *HAK) error { +func (p *UdoFileHandler) Open(g *Hak) error { var ( f *os.File // err error diff --git a/go/hak.go b/go/hak.go index 73191c9..64a8776 100644 --- a/go/hak.go +++ b/go/hak.go @@ -31,26 +31,26 @@ import ( ) type CciImpl interface { - Open(g *HAK, name string) (int, error) + Open(g *Hak, name string) (int, error) Close(fd int) Read(fd int, buf []rune) (int, error) } type UdiImpl interface { - Open(g *HAK) error + Open(g *Hak) error Close() Read(buf []rune) (int, error) } type UdoImpl interface { - Open(g *HAK) error + Open(g *Hak) error Close() Write(data []rune) error WriteBytes(data []byte) error Flush() error } -type HAK struct { +type Hak struct { c *C.hak_t inst_no int io struct { @@ -79,33 +79,29 @@ const TRAIT_LANG_ENABLE_EOL BitMask = C.HAK_TRAIT_LANG_ENABLE_EOL var inst_table InstanceTable -func deregister_instance(g *HAK) { +func deregister_instance(g *Hak) { if g.inst_no >= 0 { inst_table.delete_instance(g.inst_no) g.inst_no = -1 } } -func New() (*HAK, error) { +func New() (*Hak, error) { var c *C.hak_t - var g *HAK + var g *Hak var ext *Ext - var errnum C.hak_errnum_t + var errinf C.hak_errinf_t - c = C.hak_openstd(C.hak_oow_t(unsafe.Sizeof(*ext)), &errnum) + c = C.hak_openstd(C.hak_oow_t(unsafe.Sizeof(*ext)), &errinf) if c == nil { - var buf [64]C.hak_uch_t - var ptr *C.hak_uch_t var err error - - ptr = C.hak_errnum_to_errucstr(errnum, &buf[0], C.hak_oow_t(cap(buf))) - err = fmt.Errorf("%s", string(ucstr_to_rune_slice(ptr))) + err = fmt.Errorf("%s", string(ucstr_to_rune_slice(&errinf.msg[0]))) return nil, err } ext = (*Ext)(unsafe.Pointer(C.hak_getxtn(c))) - g = &HAK{c: c, inst_no: -1} + g = &Hak{c: c, inst_no: -1} runtime.SetFinalizer(g, deregister_instance) g.inst_no = inst_table.add_instance(c, g) @@ -114,12 +110,12 @@ func New() (*HAK, error) { return g, nil } -func (hak *HAK) Close() { +func (hak *Hak) Close() { C.hak_close(hak.c) deregister_instance(hak) } -func (hak *HAK) make_errinfo() *Err { +func (hak *Hak) make_errinfo() *Err { var loc C.hak_loc_t var err Err var errnum C.hak_errnum_t @@ -147,7 +143,7 @@ func (hak *HAK) make_errinfo() *Err { return &err } -func (hak *HAK) GetTrait() BitMask { +func (hak *Hak) GetTrait() BitMask { var x C.int var log_mask BitMask = 0 @@ -160,7 +156,7 @@ func (hak *HAK) GetTrait() BitMask { return log_mask } -func (hak *HAK) SetTrait(log_mask BitMask) { +func (hak *Hak) SetTrait(log_mask BitMask) { var x C.int x = C.hak_setoption(hak.c, C.HAK_TRAIT, unsafe.Pointer(&log_mask)) @@ -170,7 +166,7 @@ func (hak *HAK) SetTrait(log_mask BitMask) { } } -func (hak *HAK) GetLogMask() BitMask { +func (hak *Hak) GetLogMask() BitMask { var x C.int var log_mask BitMask = 0 @@ -183,7 +179,7 @@ func (hak *HAK) GetLogMask() BitMask { return log_mask } -func (hak *HAK) SetLogMask(log_mask BitMask) { +func (hak *Hak) SetLogMask(log_mask BitMask) { var x C.int x = C.hak_setoption(hak.c, C.HAK_LOG_MASK, unsafe.Pointer(&log_mask)) @@ -193,7 +189,7 @@ func (hak *HAK) SetLogMask(log_mask BitMask) { } } -func (hak *HAK) GetLogTarget() string { +func (hak *Hak) GetLogTarget() string { var x C.int var tgt *C.char @@ -206,7 +202,7 @@ func (hak *HAK) GetLogTarget() string { return C.GoString(tgt) } -func (hak *HAK) SetLogTarget(target string) { +func (hak *Hak) SetLogTarget(target string) { var x C.int var tgt *C.char @@ -220,7 +216,7 @@ func (hak *HAK) SetLogTarget(target string) { } } -func (hak *HAK) Ignite(memsize uintptr) error { +func (hak *Hak) Ignite(memsize uintptr) error { var x C.int x = C.hak_ignite(hak.c, C.hak_oow_t(memsize)) @@ -232,7 +228,7 @@ func (hak *HAK) Ignite(memsize uintptr) error { return nil } -func (hak *HAK) AddBuiltinPrims() error { +func (hak *Hak) AddBuiltinPrims() error { var x C.int x = C.hak_addbuiltinprims(hak.c) @@ -247,7 +243,7 @@ func (hak *HAK) AddBuiltinPrims() error { // - the main stream is not handled by this IO handler // - the feeder must read the main stream and pass data. // - the inclusion of another file from the main stream requires the path information of the main strea. -func (hak *HAK) AttachCCIO(cci CciImpl, main_cci_name string) error { +func (hak *Hak) AttachCCIO(cci CciImpl, main_cci_name string) error { var x C.int var old_cci CciImpl var old_cci_name string @@ -269,7 +265,7 @@ func (hak *HAK) AttachCCIO(cci CciImpl, main_cci_name string) error { return nil } -func (hak *HAK) AttachUDIO(udi UdiImpl, udo UdoImpl) error { +func (hak *Hak) AttachUDIO(udi UdiImpl, udo UdoImpl) error { var x C.int var os UdiImpl var op UdoImpl @@ -293,7 +289,7 @@ func (hak *HAK) AttachUDIO(udi UdiImpl, udo UdoImpl) error { return nil } -func (hak *HAK) BeginFeed() error { +func (hak *Hak) BeginFeed() error { var x C.int x = C.hak_beginfeed(hak.c, nil) @@ -305,7 +301,7 @@ func (hak *HAK) BeginFeed() error { return nil } -func (hak *HAK) EndFeed() error { +func (hak *Hak) EndFeed() error { var x C.int x = C.hak_endfeed(hak.c) @@ -317,7 +313,7 @@ func (hak *HAK) EndFeed() error { return nil } -func (hak *HAK) FeedString(str string) error { +func (hak *Hak) FeedString(str string) error { var x C.int var q []C.hak_uch_t @@ -330,7 +326,7 @@ func (hak *HAK) FeedString(str string) error { return nil } -func (hak *HAK) FeedRunes(str []rune) error { +func (hak *Hak) FeedRunes(str []rune) error { var x C.int var q []C.hak_uch_t @@ -343,7 +339,7 @@ func (hak *HAK) FeedRunes(str []rune) error { return nil } -func (hak *HAK) FeedFromReader(rdr io.Reader) error { +func (hak *Hak) FeedFromReader(rdr io.Reader) error { var err error var n int var x C.int @@ -368,7 +364,7 @@ func (hak *HAK) FeedFromReader(rdr io.Reader) error { return nil } -func (hak *HAK) FeedFromFile(file string) error { +func (hak *Hak) FeedFromFile(file string) error { var f *os.File var err error @@ -382,7 +378,7 @@ func (hak *HAK) FeedFromFile(file string) error { return hak.FeedFromReader(bufio.NewReader(f)) } -func (hak *HAK) Execute() error { +func (hak *Hak) Execute() error { var x C.hak_oop_t x = C.hak_execute(hak.c) @@ -396,7 +392,7 @@ func (hak *HAK) Execute() error { return nil } -func (hak *HAK) Decode() error { +func (hak *Hak) Decode() error { var x C.int x = C.hak_decode(hak.c, C.hak_getcode(hak.c), 0, C.hak_getbclen(hak.c)) @@ -408,11 +404,11 @@ func (hak *HAK) Decode() error { return nil } -func (hak *HAK) get_errmsg() string { +func (hak *Hak) get_errmsg() string { return C.GoString(C.hak_geterrbmsg(hak.c)) } -func (hak *HAK) set_errmsg(num C.hak_errnum_t, msg string) { +func (hak *Hak) set_errmsg(num C.hak_errnum_t, msg string) { var ptr *C.char ptr = C.CString(msg) defer C.free(unsafe.Pointer(ptr)) @@ -467,7 +463,7 @@ func rune_slice_to_uchars(r []rune) []C.hak_uch_t { return c } -func c_to_go(c *C.hak_t) *HAK { +func c_to_go(c *C.hak_t) *Hak { var ext *Ext var inst Instance diff --git a/go/inst.go b/go/inst.go index 1d683e9..61c0e0b 100644 --- a/go/inst.go +++ b/go/inst.go @@ -10,7 +10,7 @@ import ( type Instance struct { c *C.hak_t // c object - g *HAK // go object + g *Hak // go object } type InstanceTable struct { @@ -19,7 +19,7 @@ type InstanceTable struct { free_slots []int } -func (itab *InstanceTable) add_instance(c *C.hak_t, g *HAK) int { +func (itab *InstanceTable) add_instance(c *C.hak_t, g *Hak) int { itab.mtx.Lock() defer itab.mtx.Unlock() diff --git a/lib/err.c b/lib/err.c index 8e8c287..8c5ba0b 100644 --- a/lib/err.c +++ b/lib/err.c @@ -279,7 +279,7 @@ void hak_geterrbinf (hak_t* hak, hak_errbinf_t* errinf) #if defined(HAK_OOCH_IS_BCH) errinf->num = hak->errnum; errinf->loc = hak->errloc; - hak_copy_oocstr(errinf->msg, HAK_COUNTOF(errinf->msg), (hak->errmsg[0] == '\0'? hak_errnum_to_errstr(hak->errnum): hak->errmsg)); + hak_copy_oocstr(errinf->msg, HAK_COUNTOF(errinf->msg), (hak->errmsg.buf[0] == '\0'? hak_errnum_to_errstr(hak->errnum): hak->errmsg.buf)); #else const hak_ooch_t* msg; hak_oow_t wcslen, mbslen; @@ -313,12 +313,12 @@ void hak_geterruinf (hak_t* hak, hak_erruinf_t* errinf) if (!hak->errloc.file) errinf->loc.file = HAK_NULL; else { - wcslen = HAK_COUNTOF(hak->xerrlocfile); - hak_conv_bcstr_to_ucstr_with_cmgr(hak->errloc.file, &mbslen, hak->xerrlocfile, &wcslen, hak->_cmgr, 1); - errinf->loc.file = hak->xerrlocfile; /* this can be truncated and is transient */ + wcslen = HAK_COUNTOF(hak->errmsg.xerrlocfile); + hak_conv_bcstr_to_ucstr_with_cmgr(hak->errloc.file, &mbslen, hak->errmsg.xerrlocfile, &wcslen, hak->_cmgr, 1); + errinf->loc.file = hak->errmsg.xerrlocfile; /* this can be truncated and is transient */ } - msg = (hak->errmsg[0] == '\0')? hak_errnum_to_errstr(hak->errnum): hak->errmsg; + msg = (hak->errmsg.buf[0] == '\0')? hak_errnum_to_errstr(hak->errnum): hak->errmsg.buf; wcslen = HAK_COUNTOF(errinf->msg); hak_conv_bcstr_to_ucstr_with_cmgr(msg, &mbslen, errinf->msg, &wcslen, hak->_cmgr, 1); #else diff --git a/lib/exec.c b/lib/exec.c index 95db03d..3ace96b 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -2660,7 +2660,7 @@ static HAK_INLINE int exec_syscmd (hak_t* hak, hak_ooi_t nargs) if (HAK_LIKELY(argv)) { argv[0] = cmd; -HAK_DEBUG1 (hak, "NARG %d\n", (int)nargs); +//HAK_DEBUG1 (hak, "NARG %d\n", (int)nargs); for (i = 0; i < nargs;) { hak_oop_t ta = HAK_STACK_GETARG(hak, nargs, i); @@ -2669,17 +2669,21 @@ HAK_DEBUG1 (hak, "NARG %d\n", (int)nargs); { /* TODO: rewrite this part */ hak_bch_t tmp[64]; - snprintf (tmp, sizeof(tmp), "%ld", (long int)HAK_OOP_TO_SMOOI(ta)); + snprintf(tmp, sizeof(tmp), "%ld", (long int)HAK_OOP_TO_SMOOI(ta)); argv[++i] = hak_dupbchars(hak, tmp, strlen(tmp)); } else { + #if defined(HAK_OOCH_IS_UCH) argv[++i] = hak_dupootobchars(hak, HAK_OBJ_GET_CHAR_SLOT(ta), HAK_OBJ_GET_SIZE(ta), HAK_NULL); + #else + argv[++i] = hak_dupoochars(hak, HAK_OBJ_GET_CHAR_SLOT(ta), HAK_OBJ_GET_SIZE(ta)); + #endif } /*HAK_DEBUG2 (hak, "ARG %d -> %hs\n", (int)i - 1, argv[i]);*/ } argv[nargs + 1] = HAK_NULL; - execvp (xcmd, argv); + execvp(xcmd, argv); } if (cmd) hak_freemem(hak, cmd); diff --git a/lib/hak-prv.h b/lib/hak-prv.h index 0752e59..a587918 100644 --- a/lib/hak-prv.h +++ b/lib/hak-prv.h @@ -1599,11 +1599,23 @@ hak_oop_t hak_makesymbolwithbcstr ( const hak_bch_t* ptr ); +hak_oop_t hak_makesymbolwithbchars ( + hak_t* hak, + const hak_bch_t* ptr, + hak_oow_t len +); + hak_oop_t hak_makesymbolwithucstr ( hak_t* hak, const hak_uch_t* ptr ); +hak_oop_t hak_makesymbolwithuchars ( + hak_t* hak, + const hak_uch_t* ptr, + hak_oow_t len +); + hak_oop_t hak_findsymbol ( hak_t* hak, const hak_ooch_t* ptr, diff --git a/lib/hak.h b/lib/hak.h index b97ec02..5426d77 100644 --- a/lib/hak.h +++ b/lib/hak.h @@ -213,7 +213,6 @@ typedef enum hak_synerrnum_t hak_synerrnum_t; */ struct hak_errbinf_t { - hak_oow_t _instsize; hak_errnum_t num; /**< error number */ hak_bch_t msg[HAK_ERRMSG_CAPA]; /**< error message */ hak_bloc_t loc; /**< error location */ @@ -222,7 +221,6 @@ typedef struct hak_errbinf_t hak_errbinf_t; struct hak_erruinf_t { - hak_oow_t _instsize; hak_errnum_t num; /**< error number */ hak_uch_t msg[HAK_ERRMSG_CAPA]; /**< error message */ hak_uloc_t loc; /**< error location */ @@ -2972,6 +2970,18 @@ HAK_EXPORT hak_oop_t hak_makestring ( hak_oow_t len ); +HAK_EXPORT hak_oop_t hak_makestringwithuchars ( + hak_t* hak, + const hak_uch_t* ptr, + hak_oow_t len +); + +HAK_EXPORT hak_oop_t hak_makestringwithbchars ( + hak_t* hak, + const hak_bch_t* ptr, + hak_oow_t len +); + HAK_EXPORT hak_oop_t hak_makefpdec ( hak_t* hak, hak_oop_t value, @@ -3312,8 +3322,9 @@ HAK_EXPORT int hak_convutobcstr ( # define hak_dupootobcstr(hak,oocs,bcslen) hak_duputobcstr(hak,oocs,bcslen) # define hak_dupbtooocstr(hak,bcs,oocslen) hak_dupbtoucstr(hak,bcs,oocslen) -# define hak_dupootoucstr(hak,oocs,ucslen) hak_dupucstr(hak,oocs,ucslen) -# define hak_duputooocstr(hak,ucs,oocslen) hak_dupucstr(hak,ucs,oocslen) +# define hak_dupootoucstr(hak,oocs,ucslen) hak_dupucstr(hak,oocs,ucslen) +# define hak_duputooocstr(hak,ucs,oocslen) hak_dupucstr(hak,ucs,oocslen) + #else # define hak_dupootoucharswithheadroom(hak,hrb,oocs,oocslen,ucslen) hak_dupbtoucharswithheadroom(hak,hrb,oocs,oocslen,ucslen) # define hak_duputooocharswithheadroom(hak,hrb,ucs,ucslen,oocslen) hak_duputobcharswithheadroom(hak,hrb,ucs,ucslen,oocslen) @@ -3393,7 +3404,7 @@ HAK_EXPORT hak_bch_t* hak_duputobcstr ( # define hak_dupoocstr(hak,oocs,oocslen) hak_dupucstr(hak,oocs,oocslen) #else # define hak_dupoochars(hak,oocs,oocslen) hak_dupbchars(hak,oocs,oocslen) -# define hak_dupoocstr(hak,oocs,oocslen) hak_dupbcstr(hak,oocs,oocslen) +# define hak_dupoocstr(hak,oocs,oocslen) hak_dupbcstr(hak,oocs,oocslen) #endif HAK_EXPORT hak_uch_t* hak_dupuchars ( diff --git a/lib/obj.c b/lib/obj.c index 3604577..3df0fd5 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -438,6 +438,66 @@ hak_oop_t hak_makestring (hak_t* hak, const hak_ooch_t* ptr, hak_oow_t len) return v; } +hak_oop_t hak_makestringwithuchars (hak_t* hak, const hak_uch_t* ptr, hak_oow_t len) +{ + /* you must provide the payload when calling this variant. it can't figure out + * the actual number of hak_ooch_t characters */ + if (!ptr) + { + hak_seterrbfmt(hak, HAK_EINVAL, + "unable to instantiate %O - null payload", hak->c_string->name); + return HAK_NULL; + } + +#if defined(HAK_OOCH_IS_UCH) + return hak_makestring(hak, ptr, len); +#else + hak_oow_t xlen; + hak_ooch_t* xptr; + + xptr = hak_duputooochars(hak, ptr, len, &xlen); + if (HAK_UNLIKELY(!xptr)) + { + const hak_ooch_t* orgmsg = hak_backuperrmsg(hak); + hak_seterrbfmt(hak, HAK_ERRNUM(hak), + "unable to instantiate %O - %js", hak->c_string->name, orgmsg); + return HAK_NULL; + } + + return hak_makestring(hak, xptr, xlen); +#endif +} + +hak_oop_t hak_makestringwithbchars (hak_t* hak, const hak_bch_t* ptr, hak_oow_t len) +{ + /* you must provide the payload when calling this variant. it can't figure out + * the actual number of hak_ooch_t characters */ + if (!ptr) + { + hak_seterrbfmt(hak, HAK_EINVAL, + "unable to instantiate %O - null payload", hak->c_string->name); + return HAK_NULL; + } + +#if defined(HAK_OOCH_IS_UCH) + hak_oow_t xlen; + hak_ooch_t* xptr; + + xptr = hak_dupbtooochars(hak, ptr, len, &xlen); + if (HAK_UNLIKELY(!xptr)) + { + const hak_ooch_t* orgmsg = hak_backuperrmsg(hak); + hak_seterrbfmt(hak, HAK_ERRNUM(hak), + "unable to instantiate %O - %js", hak->c_string->name, orgmsg); + return HAK_NULL; + } + + return hak_makestring(hak, xptr, xlen); +#else + return hak_makestring(hak, ptr, len); +#endif +} + hak_oop_t hak_makefpdec (hak_t* hak, hak_oop_t value, hak_ooi_t scale) { hak_oop_fpdec_t f; diff --git a/lib/print.c b/lib/print.c index d3e6fc2..ae0c3ae 100644 --- a/lib/print.c +++ b/lib/print.c @@ -173,7 +173,7 @@ static HAK_INLINE int print_single_char (hak_t* hak, hak_fmtout_t* fmtout, hak_o #if (HAK_SIZEOF_OOCH_T >= 4) if (chu >= 0x10000u) { - if (hak_bfmt_out(fmtout, "\\U%08X", chu) <= -1) return -1; + if (hak_bfmt_out(hak, fmtout, "\\U%08X", chu) <= -1) return -1; } else #endif diff --git a/lib/std.c b/lib/std.c index 9a8cca4..3b47028 100644 --- a/lib/std.c +++ b/lib/std.c @@ -3248,7 +3248,11 @@ static void* dlopen_pfmod (hak_t* hak, const hak_ooch_t* name, const hak_ooch_t* { xlen = dirlen; dlen = bufcapa; + #if defined(HAK_OOCH_IS_UCH) if (hak_convootobchars(hak, dirptr, &xlen, bufptr, &dlen) <= -1) return HAK_NULL; + #else + dlen = hak_copy_bchars_to_bcstr(bufptr, bufcapa, dirptr, dirlen); + #endif if (dlen > 0 && bufptr[dlen - 1] != HAK_DFL_PATH_SEP) { diff --git a/lib/sym.c b/lib/sym.c index a8e0bb6..21b7401 100644 --- a/lib/sym.c +++ b/lib/sym.c @@ -202,12 +202,29 @@ hak_oop_t hak_makesymbolwithbcstr (hak_t* hak, const hak_bch_t* ptr) #endif } +hak_oop_t hak_makesymbolwithbchars (hak_t* hak, const hak_bch_t* ptr, hak_oow_t len) +{ +#if defined(HAK_OOCH_IS_UCH) + hak_uch_t* ucsptr; + hak_oow_t ucslen; + hak_oop_t v; +/* TODO: no duplication? */ + ucsptr = hak_dupbtouchars(hak, ptr, len, &ucslen); + if (HAK_UNLIKELY(!ucsptr)) return HAK_NULL; + v = hak_makesymbol(hak, ucsptr, ucslen); + hak_freemem(hak, ucsptr); + return v; +#else + return hak_makesymbol(hak, ptr, len); +#endif +} + hak_oop_t hak_makesymbolwithucstr (hak_t* hak, const hak_uch_t* ptr) { #if defined(HAK_OOCH_IS_UCH) return hak_makesymbol(hak, ptr, hak_count_ucstr(ptr)); #else - hak_uch_t* bcsptr; + hak_bch_t* bcsptr; hak_oow_t bcslen; hak_oop_t v; /* TODO: no duplication? */ @@ -218,3 +235,20 @@ hak_oop_t hak_makesymbolwithucstr (hak_t* hak, const hak_uch_t* ptr) return v; #endif } + +hak_oop_t hak_makesymbolwithuchars (hak_t* hak, const hak_uch_t* ptr, hak_oow_t len) +{ +#if defined(HAK_OOCH_IS_UCH) + return hak_makesymbol(hak, ptr, len); +#else + hak_bch_t* bcsptr; + hak_oow_t bcslen; + hak_oop_t v; +/* TODO: no duplication? */ + bcsptr = hak_duputobchars(hak, ptr, len, &bcslen); + if (HAK_UNLIKELY(!bcsptr)) return HAK_NULL; + v = hak_makesymbol(hak, bcsptr, bcslen); + hak_freemem(hak, bcsptr); + return v; +#endif +} diff --git a/lib/xchg.c b/lib/xchg.c index 752b6eb..283621c 100644 --- a/lib/xchg.c +++ b/lib/xchg.c @@ -375,22 +375,13 @@ int hak_unmarshalcode (hak_t* hak, hak_code_t* code, hak_xchg_reader_t rdr, void } nbytes = hak_leoowtoh(w); - if (b == HAK_XCHG_STRING_U) + if (nchars > usym_buf_capa) { - ns = hak_makestring(hak, HAK_NULL, nchars); - if (HAK_UNLIKELY(!ns)) goto oops; - ucsptr = HAK_OBJ_GET_CHAR_PTR(ns, 0); - } - else - { - if (nchars > usym_buf_capa) - { - usym_buf_capa = nchars * HAK_SIZEOF(usym_buf[0]); - usym_buf = (hak_uch_t*)hak_allocmem(hak, usym_buf_capa); - if (HAK_UNLIKELY(!usym_buf)) goto oops; - } - ucsptr = usym_buf; + usym_buf_capa = nchars * HAK_SIZEOF(usym_buf[0]); + usym_buf = (hak_uch_t*)hak_allocmem(hak, usym_buf_capa); + if (HAK_UNLIKELY(!usym_buf)) goto oops; } + ucsptr = usym_buf; ucspos = 0; bcsres = 0; @@ -420,14 +411,20 @@ int hak_unmarshalcode (hak_t* hak, hak_code_t* code, hak_xchg_reader_t rdr, void HAK_ASSERT(hak, ucspos == nchars); - if (b != HAK_XCHG_STRING_U) + if (b == HAK_XCHG_STRING_U) { - ns = hak_makesymbol(hak, usym_buf, nchars); + ns = hak_makestringwithuchars(hak, usym_buf, nchars); + if (HAK_UNLIKELY(!ns)) goto oops; + } + else + { + /* symlit or symbol */ + ns = hak_makesymbolwithuchars(hak, usym_buf, nchars); if (HAK_UNLIKELY(!ns)) goto oops; if (b == HAK_XCHG_SYMBOL_U) { - /* form a cons cell */ + /* form a cons cell */ hak_oop_t nc; hak_pushvolat(hak, &ns); nc = hak_makecons(hak, ns, hak->_nil); diff --git a/main.go b/main.go index adf6f8b..d62e760 100644 --- a/main.go +++ b/main.go @@ -96,7 +96,7 @@ func handle_arguments(param *Param) error { func main() { - var x *hak.HAK = nil + var x *hak.Hak = nil var err error = nil var param Param diff --git a/pas/Makefile.am b/pas/Makefile.am index 7e6444f..beeb786 100644 --- a/pas/Makefile.am +++ b/pas/Makefile.am @@ -9,6 +9,9 @@ PASFLAGS = -Mobjfpc -FcUTF8 -Sm -g if HAK_LIB_QUADMATH_REQUIRED PASFLAGS += -dHAK_LIB_QUADMATH_REQUIRED endif +if HAK_WIDE_CHAR_SIZE_IS_4 +PASFLAGS += -dHAK_WIDE_CHAR_SIZE_IS_4 +endif hakpas_LINK = cp -pf hakpas.bin $(builddir)/hakpas$(EXEEXT) || echo diff --git a/pas/Makefile.in b/pas/Makefile.in index 75652e9..f4b2a98 100644 --- a/pas/Makefile.in +++ b/pas/Makefile.in @@ -92,6 +92,7 @@ build_triplet = @build@ host_triplet = @host@ bin_PROGRAMS = hakpas$(EXEEXT) @HAK_LIB_QUADMATH_REQUIRED_TRUE@am__append_1 = -dHAK_LIB_QUADMATH_REQUIRED +@HAK_WIDE_CHAR_SIZE_IS_4_TRUE@am__append_2 = -dHAK_WIDE_CHAR_SIZE_IS_4 subdir = pas ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/m4/ax_check_sign.m4 \ @@ -317,7 +318,7 @@ AUTOMAKE_OPTIONS = nostdinc hakpas_SOURCES = hak.pas main.pas hakpas_CPPFLAGS = hakpas_DEPENDENCIES = hakpas.bin -PASFLAGS = -Mobjfpc -FcUTF8 -Sm -g $(am__append_1) +PASFLAGS = -Mobjfpc -FcUTF8 -Sm -g $(am__append_1) $(am__append_2) hakpas_LINK = cp -pf hakpas.bin $(builddir)/hakpas$(EXEEXT) || echo all: all-am diff --git a/pas/hak.pas b/pas/hak.pas index ae13b1e..2386e0e 100644 --- a/pas/hak.pas +++ b/pas/hak.pas @@ -20,6 +20,17 @@ type TRAIT_LANG_ENABLE_EOL = (BitMask(1) shl 14); *) type + Bchar = System.AnsiChar; + PBchar = System.PAnsiChar; + +{$if defined(HAK_WIDE_CHAR_SIZE_IS_4)} + Uchar = System.UCS4Char; + PUchar = System.PUCS4Char; +{$else} + Uchar = System.WideChar; + PUchar = System.PWideChar; +{$endif} + TraitBit = ( (* this enum must follow hak_trait_t in hak.h *) LANG_ENABLE_EOL = (BitMask(1) shl 14) ); @@ -47,10 +58,10 @@ type //{$packrecords c} CciArgPtr = ^CciArg; CciArg = record (* this record must follow the public part of hak_io_cciarg_t in hak.h *) - name: pwidechar; + name: PUchar; handle: pointer; byte_oriented: integer; - buf: array[0..(HAK_CCI_BUF_LEN - 1)] of widechar; + buf: array[0..(HAK_CCI_BUF_LEN - 1)] of Uchar; xlen: System.SizeUint; includer: CciArgPtr; end; @@ -66,11 +77,15 @@ type destructor Destroy(); override; procedure Ignite(heapsize: System.SizeUint); procedure AddBuiltinPrims(); - procedure CompileFile(filename: pansichar); - procedure CompileText(text: pansichar); - procedure CompileText(text: pansichar; len: System.SizeUint); - procedure CompileText(text: pwidechar); - procedure CompileText(text: pwidechar; len: System.SizeUint); + procedure CompileFile(filename: PBchar); + procedure CompileText(text: PBchar); + procedure CompileText(text: PBchar; len: System.SizeUint); + procedure CompileText(text: PUchar); + procedure CompileText(text: PUchar; len: System.SizeUint); +{$if defined(HAK_WIDE_CHAR_SIZE_IS_4)} + procedure CompileText(text: PWideChar); + procedure CompileText(text: PWideChar; len: System.SizeUint); +{$endif} procedure Execute(); protected @@ -93,55 +108,75 @@ type Location = record line: System.SizeUint; colm: System.SizeUint; - filp: pwidechar; + filp: PUchar; end; + + SynerrPtr = ^Synerr; Synerr = record num: integer; loc: Location; tgt: record - val: array[0..255] of widechar; + val: array[0..255] of Uchar; len: System.SizeUint; end; end; - SynerrPtr = ^Synerr; + ErrbinfPtr = ^Errbinf; + Errbinf = record + num: integer; + msg: array[0..2047] of Bchar; + loc: Location; + end; + + ErruinfPtr = ^Errbinf; + Erruinf = record + num: integer; + msg: array[0..2047] of Uchar; + loc: Location; + end; + + Errinf = Erruinf; + ErrinfPtr = ErruinfPtr; (*----- external hak function -----*) function hak_errnum_to_errbcstr(errnum: integer; errbuf: pointer; errbufsz: System.SizeUint): pointer; cdecl; external; function hak_errnum_is_synerr(errnum: integer): boolean; cdecl; external; -function hak_openstd(xtnsize: System.SizeUint; errnum: pointer): pointer; cdecl; external; +function hak_openstd(xtnsize: System.SizeUint; errinf: pointer): pointer; cdecl; external; procedure hak_close(handle: pointer); cdecl; external; function hak_getxtn(handle: pointer): InterpExtPtr; cdecl; external; function hak_setoption(handle: pointer; option: Option; value: pointer): integer; cdecl; external; function hak_getoption(handle: pointer; option: Option; value: pointer): integer; cdecl; external; -procedure hak_seterrnum (handle: pointer; errnum: integer); cdecl; external; +procedure hak_seterrnum(handle: pointer; errnum: integer); cdecl; external; function hak_geterrnum(handle: pointer): integer; cdecl; external; -procedure hak_seterrbmsg (handle: pointer; errnum: integer; errmsg: pansichar); cdecl; external; -function hak_geterrbmsg(handle: pointer): pansichar; cdecl; external; +procedure hak_seterrbmsg(handle: pointer; errnum: integer; errmsg: PBchar); cdecl; external; +function hak_geterrbmsg(handle: pointer): PBchar; cdecl; external; + +procedure hak_geterrbinf(handle: pointer; errinf: pointer); cdecl; external; +procedure hak_geterruinf(handle: pointer; errinf: pointer); cdecl; external; function hak_ignite(handle: pointer; heapsize: System.SizeUint): integer; cdecl; external; function hak_addbuiltinprims(handle: pointer): integer; cdecl; external; function hak_beginfeed(handle: pointer; on_cnode: pointer): integer; cdecl; external; -function hak_feedbchars(handle: pointer; data: pansichar; len: System.SizeUint): integer; cdecl; external; -function hak_feeduchars(handle: pointer; data: pwidechar; len: System.SizeUint): integer; cdecl; external; (* this is wrong in deed - hak_uchar_t may not been widechar ..*) +function hak_feedbchars(handle: pointer; data: PBchar; len: System.SizeUint): integer; cdecl; external; +function hak_feeduchars(handle: pointer; data: PUchar; len: System.SizeUint): integer; cdecl; external; (* this is wrong in deed - hak_uchar_t may not been Uchar ..*) function hak_endfeed(handle: pointer): integer; cdecl; external; function hak_attachccio(handle: pointer; cci: pointer): integer; cdecl; external; -function hak_attachcciostdwithbcstr(handle: pointer; cci: pansichar): integer; cdecl; external; +function hak_attachcciostdwithbcstr(handle: pointer; cci: PBchar): integer; cdecl; external; procedure hak_detachccio(handle: pointer); cdecl; external; -function hak_attachudiostdwithbcstr(handle: pointer; udi: pansichar; udo: pansichar): integer; cdecl; external; +function hak_attachudiostdwithbcstr(handle: pointer; udi: PBchar; udo: PBchar): integer; cdecl; external; procedure hak_detachudio(handle: pointer); cdecl; external; function hak_compile(handle: pointer; cnode: pointer; flags: integer): integer; cdecl; external; function hak_execute(handle: pointer): pointer; cdecl; external; procedure hak_abort(handle: pointer) cdecl; external; procedure hak_getsynerr(handle: pointer; synerr: SynerrPtr) cdecl; external; -function hak_syserrstrb(handle: pointer; syserr_type: integer; syserr_code: integer; buf: pansichar; len: System.SizeUint): integer; cdecl; external; -function hak_count_ucstr(ptr: pwidechar): System.SizeUint; cdecl; external; +function hak_syserrstrb(handle: pointer; syserr_type: integer; syserr_code: integer; buf: PBchar; len: System.SizeUint): integer; cdecl; external; +function hak_count_ucstr(ptr: PUchar): System.SizeUint; cdecl; external; (*----- end external hak function -----*) implementation @@ -156,27 +191,68 @@ type NamedHandlePtr = ^NamedHandle; + +function PUCS4CharLength(p: PUCS4Char): System.SizeUint; +var + len: System.SizeUint; +begin + len := 0; + while p[len] <> 0 do Inc(len); + exit(len); +end; + +function PUCS4CharToWideString(p: PUCS4Char): System.WideString; +var + len: System.SizeUint; + arr: System.UCS4String; +begin + len := PUCS4CharLength(p); + + (* len + 1 for SetLength because UCS4StringToWideString() skips the last character in RTL. + https://gitlab.com/freepascal.org/fpc/source/-/blob/main/rtl/inc/ustrings.inc + function UCS4StringToUnicodeString(const s : UCS4String) : UnicodeString; + var + i : SizeInt; + reslen : SizeInt; + begin + reslen:=0; + for i:=0 to length(s)-2 do + Inc(reslen,1+ord((s[i]>$ffff) and (cardinal(s[i])<=$10ffff))); + SetLength(result,reslen); + UCS4Decode(s,pointer(result)); + end; + *) + + SetLength(arr, len + 1); + Move(p^, arr[0], len * SizeOf(UCS4Char)); + + exit(UCS4StringToWideString(arr)); +end; + constructor Interp.Create (x: integer); var h: pointer; - errnum: integer; - errmsg: array[0..255] of AnsiChar; + ei: Errinf; + ebi: Errbinf; tb: BitMask; ext: InterpExtPtr; begin - h := hak_openstd(System.SizeOf(Interp), @errnum); + h := hak_openstd(System.SizeOf(Interp), @ei); if h = nil then begin - hak_errnum_to_errbcstr(errnum, @errmsg, length(errmsg)); - raise Exception.Create(errmsg); +{$if defined(HAK_WIDE_CHAR_SIZE_IS_4)} + raise Exception.Create(System.UTF8Encode(PUCS4CharToWideString(ei.msg))); +{$else} + raise Exception.Create(System.UTF8Encode(ei.msg)); +{$endif} end; if hak_getoption(h, Option.TRAIT, @tb) <= -1 then tb := 0; tb := tb or BitMask(TraitBit.LANG_ENABLE_EOL); if hak_setoption(h, Option.TRAIT, @tb) <= -1 then begin - hak_errnum_to_errbcstr(errnum, @errmsg, length(errmsg)); + hak_geterrbinf(h, @ebi); hak_close(h); - raise Exception.Create(errmsg); + raise Exception.Create(ebi.msg); end; self.handle := h; @@ -198,20 +274,27 @@ end; function Interp.FetchErrorMsg(): string; var num: integer; - bmsg: pansichar; + bmsg: PBchar; serr: Synerr; - filp: pwidechar; - tgt: array[0..255] of widechar; + filp: PUchar; + (*tgt: array[0..255] of Uchar;*) + tgt: string; begin num := hak_geterrnum(self.handle); if hak_errnum_is_synerr(num) then begin hak_getsynerr(self.handle, @serr); bmsg := hak_geterrbmsg(self.handle); - filp := pwidechar(widestring('')); + filp := PUchar(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(SysUtils.Format('%s at %s[%u:%u] - %s', [string(bmsg), string(filp), serr.loc.line, serr.loc.colm, string(tgt)])); +{$if defined(HAK_WIDE_CHAR_SIZE_IS_4)} + tgt := System.UTF8Encode(PUCS4CharToWideString(serr.tgt.val)); +{$elseif defined(HAK_WIDE_CHAR_SIZE_IS_2)} + tgt := System.UTF8Encode(serr.tgt.val); +{$else} + tgt := string(serr.tgt.val); +{$endif} + exit(SysUtils.Format('%s at %s[%u:%u] - %s', [string(bmsg), string(filp), serr.loc.line, serr.loc.colm, tgt])); end else begin exit(SysUtils.Format('%s at %s[%u:%u]', [string(bmsg), string(filp), serr.loc.line, serr.loc.colm])); @@ -276,7 +359,7 @@ begin System.New(nf); if nf = nil then begin err := SysUtils.GetLastOSError(); - hak_seterrbmsg(handle, hak_syserrstrb(handle, 0, err, nil, 0), pansichar(SysUtils.SysErrorMessage(err))); + hak_seterrbmsg(handle, hak_syserrstrb(handle, 0, err, nil, 0), PBchar(SysUtils.SysErrorMessage(err))); exit(-1); end; @@ -285,7 +368,7 @@ begin nf^.handle := SysUtils.FileOpen(name, SysUtils.fmOpenRead); if nf^.handle = System.THandle(-1) then begin err := SysUtils.GetLastOSError(); - hak_seterrbmsg(handle, hak_syserrstrb(handle, 0, err, nil, 0), pansichar(SysUtils.SysErrorMessage(err))); + hak_seterrbmsg(handle, hak_syserrstrb(handle, 0, err, nil, 0), PBchar(SysUtils.SysErrorMessage(err))); System.Dispose(nf); exit(-1); end; @@ -307,9 +390,9 @@ begin IO_READ_BYTES: begin nf := NamedHandlePtr(arg^.handle); - len := SysUtils.FileRead(nf^.handle, arg^.buf, System.SizeOf(arg^.buf)); (* use SizeOf a widechar buffer as it needs to fill it with bytes *) + len := SysUtils.FileRead(nf^.handle, arg^.buf, System.SizeOf(arg^.buf)); (* use SizeOf a Uchar buffer as it needs to fill it with bytes *) if len <= -1 then begin - hak_seterrbmsg(handle, hak_syserrstrb(handle, 0, err, nil, 0), pansichar(SysUtils.SysErrorMessage(err))); + hak_seterrbmsg(handle, hak_syserrstrb(handle, 0, err, nil, 0), PBchar(SysUtils.SysErrorMessage(err))); exit(-1); end; arg^.xlen := len; @@ -333,14 +416,14 @@ begin exit(0); end; -procedure Interp.CompileFile(filename: pansichar); +procedure Interp.CompileFile(filename: PBchar); var f: System.THandle = -1; attached: boolean = false; feed_ongoing: boolean = false; errnum: System.Integer; errmsg: string; - buf: array[0..1023] of ansichar; + buf: array[0..1023] of Bchar; len: System.LongInt; label oops; @@ -399,12 +482,12 @@ oops: raise Exception.Create(errmsg); end; -procedure Interp.CompileText(text: pansichar); +procedure Interp.CompileText(text: PBchar); begin self.CompileText(text, SysUtils.Strlen(text)); end; -procedure Interp.CompileText(text: pansichar; len: System.SizeUint); +procedure Interp.CompileText(text: PBchar; len: System.SizeUint); var errnum: integer; errmsg: string; @@ -438,12 +521,40 @@ begin hak_detachccio(self.handle); end; -procedure Interp.CompileText(text: pwidechar); +{$if defined(HAK_WIDE_CHAR_SIZE_IS_4)} +procedure Interp.CompileText(text: PWideChar); +var + x: UCS4String; begin - self.CompileText(text, SysUtils.Strlen(text)); + x := WideStringToUcs4String(text); + self.CompileText(PUchar(x)); end; -procedure Interp.CompileText(text: pwidechar; len: System.SizeUint); +procedure Interp.CompileText(text: PWideChar; len: System.SizeUint); +var + + x_text: PBchar; + x_capa: System.SizeUint; + x_len: System.SizeUint; +begin + x_capa := len * 4 + 1; (* allocation sizing for the worst case *) + System.GetMem(x_text, x_capa); + try + x_len := System.UnicodeToUtf8(x_text, x_capa, text, len); + self.CompileText(x_text, x_len); + finally + FreeMem(x_text); + end; +end; +{$endif} + +procedure Interp.CompileText(text: PUchar); +begin + (*self.CompileText(text, SysUtils.Strlen(text));*) + self.CompileText(text, hak_count_ucstr(text)); +end; + +procedure Interp.CompileText(text: PUchar; len: System.SizeUint); var errnum: integer; errmsg: string; diff --git a/t/t-001.c b/t/t-001.c index abcfee2..b48b8e9 100644 --- a/t/t-001.c +++ b/t/t-001.c @@ -5,7 +5,6 @@ int main(int argc, char* argv[]) { hak_t* hak; hak_oop_t v; - hak_liw_t liw; hak_ooi_t i, j; int n;