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

added hak_makesymbolwithuchars()/hak_makesymbolwithbchars()/hak_makestringwithuchars()/hak_makestirngwithbchars()

Browse Source 
fixed some fpc code related to character type configured
This commit is contained in:
hyung-hwan
2025-10-08 23:38:24 +09:00
parent 56dfb3630e
commit 7504ec1a4c
20 changed files with 406 additions and 132 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile.in
View File

@ -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/compile $(top_srcdir)/ac/config.guess \
$(top_srcdir)/ac/config.sub $(top_srcdir)/ac/install-sh \ $(top_srcdir)/ac/config.sub $(top_srcdir)/ac/install-sh \
$(top_srcdir)/ac/ltmain.sh $(top_srcdir)/ac/missing README.md \ $(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 ac/install-sh ac/ltmain.sh ac/missing
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
distdir = $(PACKAGE)-$(VERSION) distdir = $(PACKAGE)-$(VERSION)

38
configure vendored
View File

@ -657,6 +657,10 @@ LTLIBOBJS
LIBOBJS LIBOBJS
HAK_LIB_QUADMATH_REQUIRED_FALSE HAK_LIB_QUADMATH_REQUIRED_FALSE
HAK_LIB_QUADMATH_REQUIRED_TRUE 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_SYS_LIB_SEARCH_PATH_SPEC
HAK_PROJECT_URL HAK_PROJECT_URL
HAK_PROJECT_AUTHOR 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 printf "%s\n" "#define HAK_ENABLE_WIDE_CHAR 1" >>confdefs.h
wide_char_size=4
elif test "${enable_wide_char}" = "yes:2" elif test "${enable_wide_char}" = "yes:2"
then 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 printf "%s\n" "#define HAK_ENABLE_WIDE_CHAR 1" >>confdefs.h
wide_char_size=2
elif test "${enable_wide_char}" = "yes" elif test "${enable_wide_char}" = "yes"
then 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 printf "%s\n" "#define HAK_ENABLE_WIDE_CHAR 1" >>confdefs.h
wide_char_size=2
elif test "${enable_wide_char}" = "no:4" elif test "${enable_wide_char}" = "no:4"
then then
printf "%s\n" "#define HAK_WIDE_CHAR_SIZE 4" >>confdefs.h printf "%s\n" "#define HAK_WIDE_CHAR_SIZE 4" >>confdefs.h
wide_char_size=4
elif test "${enable_wide_char}" = "no:2" elif test "${enable_wide_char}" = "no:2"
then then
printf "%s\n" "#define HAK_WIDE_CHAR_SIZE 2" >>confdefs.h printf "%s\n" "#define HAK_WIDE_CHAR_SIZE 2" >>confdefs.h
wide_char_size=2
else 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 fi
# Check whether --enable-full-liw was given. # 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}" 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 if test "x${hak_lib_quadmath_required}" = "xyes"; then
HAK_LIB_QUADMATH_REQUIRED_TRUE= HAK_LIB_QUADMATH_REQUIRED_TRUE=
HAK_LIB_QUADMATH_REQUIRED_FALSE='#' 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. as_fn_error $? "conditional \"ENABLE_HAKGO\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5 Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi 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 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. as_fn_error $? "conditional \"HAK_LIB_QUADMATH_REQUIRED\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5 Usually this means the macro was only invoked conditionally." "$LINENO" 5

12
configure.ac
View File

@ -554,22 +554,28 @@ if test "${enable_wide_char}" = "yes:4"
then then
AC_DEFINE([HAK_WIDE_CHAR_SIZE],[4],[Wide-character type size]) 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]) 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" elif test "${enable_wide_char}" = "yes:2"
then then
AC_DEFINE([HAK_WIDE_CHAR_SIZE],[2],[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]) 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" elif test "${enable_wide_char}" = "yes"
then 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]) 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" elif test "${enable_wide_char}" = "no:4"
then then
AC_DEFINE([HAK_WIDE_CHAR_SIZE],[4],[Wide-character type size]) AC_DEFINE([HAK_WIDE_CHAR_SIZE],[4],[Wide-character type size])
wide_char_size=4
elif test "${enable_wide_char}" = "no:2" elif test "${enable_wide_char}" = "no:2"
then then
AC_DEFINE([HAK_WIDE_CHAR_SIZE],[2],[Wide-character type size]) AC_DEFINE([HAK_WIDE_CHAR_SIZE],[2],[Wide-character type size])
wide_char_size=2
else 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 fi
AC_ARG_ENABLE([full-liw], 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_AUTHOR, "${PACKAGE_BUGREPORT}")
AC_SUBST(HAK_PROJECT_URL, "${PACKAGE_URL}") AC_SUBST(HAK_PROJECT_URL, "${PACKAGE_URL}")
AC_SUBST(HAK_SYS_LIB_SEARCH_PATH_SPEC, ["${sys_lib_search_path_spec}"]) 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") AM_CONDITIONAL(HAK_LIB_QUADMATH_REQUIRED, test "x${hak_lib_quadmath_required}" = "xyes")
dnl === configure arguments dnl === configure arguments

16
go/cb.go
View File

@ -85,7 +85,7 @@ var io_tab IOHandleTable = IOHandleTable{}
//export hak_go_cci_handler //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 { func hak_go_cci_handler(c *C.hak_t, cmd C.hak_io_cmd_t, arg unsafe.Pointer) C.int {
var ( var (
g *HAK g *Hak
err error 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 //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 { func hak_go_udi_handler(c *C.hak_t, cmd C.hak_io_cmd_t, arg unsafe.Pointer) C.int {
var ( var (
g *HAK g *Hak
err error 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 //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 { func hak_go_udo_handler(c *C.hak_t, cmd C.hak_io_cmd_t, arg unsafe.Pointer) C.int {
var ( var (
g *HAK g *Hak
err error 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 { 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 ( var (
f *os.File f *os.File
r *bufio.Reader r *bufio.Reader
@ -398,12 +398,12 @@ func (p *CciFileHandler) Read(fd int, buf []rune) (int, error) {
// ------------------------------------------------------ // ------------------------------------------------------
type UdiFileHandler struct { type UdiFileHandler struct {
g *HAK g *Hak
f *os.File f *os.File
r *bufio.Reader r *bufio.Reader
} }
func (p *UdiFileHandler) Open(g *HAK) error { func (p *UdiFileHandler) Open(g *Hak) error {
var ( var (
f *os.File f *os.File
// err error // err error
@ -463,7 +463,7 @@ type UdoFileHandler struct {
w *bufio.Writer w *bufio.Writer
} }
func (p *UdoFileHandler) Open(g *HAK) error { func (p *UdoFileHandler) Open(g *Hak) error {
var ( var (
f *os.File f *os.File
// err error // err error

72
go/hak.go
View File

@ -31,26 +31,26 @@ import (
) )
type CciImpl interface { type CciImpl interface {
Open(g *HAK, name string) (int, error) Open(g *Hak, name string) (int, error)
Close(fd int) Close(fd int)
Read(fd int, buf []rune) (int, error) Read(fd int, buf []rune) (int, error)
} }
type UdiImpl interface { type UdiImpl interface {
Open(g *HAK) error Open(g *Hak) error
Close() Close()
Read(buf []rune) (int, error) Read(buf []rune) (int, error)
} }
type UdoImpl interface { type UdoImpl interface {
Open(g *HAK) error Open(g *Hak) error
Close() Close()
Write(data []rune) error Write(data []rune) error
WriteBytes(data []byte) error WriteBytes(data []byte) error
Flush() error Flush() error
} }
type HAK struct { type Hak struct {
c *C.hak_t c *C.hak_t
inst_no int inst_no int
io struct { io struct {
@ -79,33 +79,29 @@ const TRAIT_LANG_ENABLE_EOL BitMask = C.HAK_TRAIT_LANG_ENABLE_EOL
var inst_table InstanceTable var inst_table InstanceTable
func deregister_instance(g *HAK) { func deregister_instance(g *Hak) {
if g.inst_no >= 0 { if g.inst_no >= 0 {
inst_table.delete_instance(g.inst_no) inst_table.delete_instance(g.inst_no)
g.inst_no = -1 g.inst_no = -1
} }
} }
func New() (*HAK, error) { func New() (*Hak, error) {
var c *C.hak_t var c *C.hak_t
var g *HAK var g *Hak
var ext *Ext 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 { if c == nil {
var buf [64]C.hak_uch_t
var ptr *C.hak_uch_t
var err error var err error
err = fmt.Errorf("%s", string(ucstr_to_rune_slice(&errinf.msg[0])))
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)))
return nil, err return nil, err
} }
ext = (*Ext)(unsafe.Pointer(C.hak_getxtn(c))) 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) runtime.SetFinalizer(g, deregister_instance)
g.inst_no = inst_table.add_instance(c, g) g.inst_no = inst_table.add_instance(c, g)
@ -114,12 +110,12 @@ func New() (*HAK, error) {
return g, nil return g, nil
} }
func (hak *HAK) Close() { func (hak *Hak) Close() {
C.hak_close(hak.c) C.hak_close(hak.c)
deregister_instance(hak) deregister_instance(hak)
} }
func (hak *HAK) make_errinfo() *Err { func (hak *Hak) make_errinfo() *Err {
var loc C.hak_loc_t var loc C.hak_loc_t
var err Err var err Err
var errnum C.hak_errnum_t var errnum C.hak_errnum_t
@ -147,7 +143,7 @@ func (hak *HAK) make_errinfo() *Err {
return &err return &err
} }
func (hak *HAK) GetTrait() BitMask { func (hak *Hak) GetTrait() BitMask {
var x C.int var x C.int
var log_mask BitMask = 0 var log_mask BitMask = 0
@ -160,7 +156,7 @@ func (hak *HAK) GetTrait() BitMask {
return log_mask return log_mask
} }
func (hak *HAK) SetTrait(log_mask BitMask) { func (hak *Hak) SetTrait(log_mask BitMask) {
var x C.int var x C.int
x = C.hak_setoption(hak.c, C.HAK_TRAIT, unsafe.Pointer(&log_mask)) 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 x C.int
var log_mask BitMask = 0 var log_mask BitMask = 0
@ -183,7 +179,7 @@ func (hak *HAK) GetLogMask() BitMask {
return log_mask return log_mask
} }
func (hak *HAK) SetLogMask(log_mask BitMask) { func (hak *Hak) SetLogMask(log_mask BitMask) {
var x C.int var x C.int
x = C.hak_setoption(hak.c, C.HAK_LOG_MASK, unsafe.Pointer(&log_mask)) 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 x C.int
var tgt *C.char var tgt *C.char
@ -206,7 +202,7 @@ func (hak *HAK) GetLogTarget() string {
return C.GoString(tgt) return C.GoString(tgt)
} }
func (hak *HAK) SetLogTarget(target string) { func (hak *Hak) SetLogTarget(target string) {
var x C.int var x C.int
var tgt *C.char 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 var x C.int
x = C.hak_ignite(hak.c, C.hak_oow_t(memsize)) x = C.hak_ignite(hak.c, C.hak_oow_t(memsize))
@ -232,7 +228,7 @@ func (hak *HAK) Ignite(memsize uintptr) error {
return nil return nil
} }
func (hak *HAK) AddBuiltinPrims() error { func (hak *Hak) AddBuiltinPrims() error {
var x C.int var x C.int
x = C.hak_addbuiltinprims(hak.c) 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 main stream is not handled by this IO handler
// - the feeder must read the main stream and pass data. // - 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. // - 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 x C.int
var old_cci CciImpl var old_cci CciImpl
var old_cci_name string var old_cci_name string
@ -269,7 +265,7 @@ func (hak *HAK) AttachCCIO(cci CciImpl, main_cci_name string) error {
return nil 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 x C.int
var os UdiImpl var os UdiImpl
var op UdoImpl var op UdoImpl
@ -293,7 +289,7 @@ func (hak *HAK) AttachUDIO(udi UdiImpl, udo UdoImpl) error {
return nil return nil
} }
func (hak *HAK) BeginFeed() error { func (hak *Hak) BeginFeed() error {
var x C.int var x C.int
x = C.hak_beginfeed(hak.c, nil) x = C.hak_beginfeed(hak.c, nil)
@ -305,7 +301,7 @@ func (hak *HAK) BeginFeed() error {
return nil return nil
} }
func (hak *HAK) EndFeed() error { func (hak *Hak) EndFeed() error {
var x C.int var x C.int
x = C.hak_endfeed(hak.c) x = C.hak_endfeed(hak.c)
@ -317,7 +313,7 @@ func (hak *HAK) EndFeed() error {
return nil return nil
} }
func (hak *HAK) FeedString(str string) error { func (hak *Hak) FeedString(str string) error {
var x C.int var x C.int
var q []C.hak_uch_t var q []C.hak_uch_t
@ -330,7 +326,7 @@ func (hak *HAK) FeedString(str string) error {
return nil return nil
} }
func (hak *HAK) FeedRunes(str []rune) error { func (hak *Hak) FeedRunes(str []rune) error {
var x C.int var x C.int
var q []C.hak_uch_t var q []C.hak_uch_t
@ -343,7 +339,7 @@ func (hak *HAK) FeedRunes(str []rune) error {
return nil return nil
} }
func (hak *HAK) FeedFromReader(rdr io.Reader) error { func (hak *Hak) FeedFromReader(rdr io.Reader) error {
var err error var err error
var n int var n int
var x C.int var x C.int
@ -368,7 +364,7 @@ func (hak *HAK) FeedFromReader(rdr io.Reader) error {
return nil return nil
} }
func (hak *HAK) FeedFromFile(file string) error { func (hak *Hak) FeedFromFile(file string) error {
var f *os.File var f *os.File
var err error var err error
@ -382,7 +378,7 @@ func (hak *HAK) FeedFromFile(file string) error {
return hak.FeedFromReader(bufio.NewReader(f)) return hak.FeedFromReader(bufio.NewReader(f))
} }
func (hak *HAK) Execute() error { func (hak *Hak) Execute() error {
var x C.hak_oop_t var x C.hak_oop_t
x = C.hak_execute(hak.c) x = C.hak_execute(hak.c)
@ -396,7 +392,7 @@ func (hak *HAK) Execute() error {
return nil return nil
} }
func (hak *HAK) Decode() error { func (hak *Hak) Decode() error {
var x C.int var x C.int
x = C.hak_decode(hak.c, C.hak_getcode(hak.c), 0, C.hak_getbclen(hak.c)) 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 return nil
} }
func (hak *HAK) get_errmsg() string { func (hak *Hak) get_errmsg() string {
return C.GoString(C.hak_geterrbmsg(hak.c)) 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 var ptr *C.char
ptr = C.CString(msg) ptr = C.CString(msg)
defer C.free(unsafe.Pointer(ptr)) defer C.free(unsafe.Pointer(ptr))
@ -467,7 +463,7 @@ func rune_slice_to_uchars(r []rune) []C.hak_uch_t {
return c return c
} }
func c_to_go(c *C.hak_t) *HAK { func c_to_go(c *C.hak_t) *Hak {
var ext *Ext var ext *Ext
var inst Instance var inst Instance

4
go/inst.go
View File

@ -10,7 +10,7 @@ import (
type Instance struct { type Instance struct {
c *C.hak_t // c object c *C.hak_t // c object
g *HAK // go object g *Hak // go object
} }
type InstanceTable struct { type InstanceTable struct {
@ -19,7 +19,7 @@ type InstanceTable struct {
free_slots []int 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() itab.mtx.Lock()
defer itab.mtx.Unlock() defer itab.mtx.Unlock()

10
lib/err.c
View File

@ -279,7 +279,7 @@ void hak_geterrbinf (hak_t* hak, hak_errbinf_t* errinf)
#if defined(HAK_OOCH_IS_BCH) #if defined(HAK_OOCH_IS_BCH)
errinf->num = hak->errnum; errinf->num = hak->errnum;
errinf->loc = hak->errloc; 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 #else
const hak_ooch_t* msg; const hak_ooch_t* msg;
hak_oow_t wcslen, mbslen; 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; if (!hak->errloc.file) errinf->loc.file = HAK_NULL;
else else
{ {
wcslen = HAK_COUNTOF(hak->xerrlocfile); wcslen = HAK_COUNTOF(hak->errmsg.xerrlocfile);
hak_conv_bcstr_to_ucstr_with_cmgr(hak->errloc.file, &mbslen, hak->xerrlocfile, &wcslen, hak->_cmgr, 1); hak_conv_bcstr_to_ucstr_with_cmgr(hak->errloc.file, &mbslen, hak->errmsg.xerrlocfile, &wcslen, hak->_cmgr, 1);
errinf->loc.file = hak->xerrlocfile; /* this can be truncated and is transient */ 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); wcslen = HAK_COUNTOF(errinf->msg);
hak_conv_bcstr_to_ucstr_with_cmgr(msg, &mbslen, errinf->msg, &wcslen, hak->_cmgr, 1); hak_conv_bcstr_to_ucstr_with_cmgr(msg, &mbslen, errinf->msg, &wcslen, hak->_cmgr, 1);
#else #else

10
lib/exec.c
View File

@ -2660,7 +2660,7 @@ static HAK_INLINE int exec_syscmd (hak_t* hak, hak_ooi_t nargs)
if (HAK_LIKELY(argv)) if (HAK_LIKELY(argv))
{ {
argv[0] = cmd; argv[0] = cmd;
HAK_DEBUG1 (hak, "NARG %d\n", (int)nargs); //HAK_DEBUG1 (hak, "NARG %d\n", (int)nargs);
for (i = 0; i < nargs;) for (i = 0; i < nargs;)
{ {
hak_oop_t ta = HAK_STACK_GETARG(hak, nargs, i); 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 */ /* TODO: rewrite this part */
hak_bch_t tmp[64]; 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)); argv[++i] = hak_dupbchars(hak, tmp, strlen(tmp));
} }
else 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); 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]);*/ /*HAK_DEBUG2 (hak, "ARG %d -> %hs\n", (int)i - 1, argv[i]);*/
} }
argv[nargs + 1] = HAK_NULL; argv[nargs + 1] = HAK_NULL;
execvp (xcmd, argv); execvp(xcmd, argv);
} }
if (cmd) hak_freemem(hak, cmd); if (cmd) hak_freemem(hak, cmd);

12
lib/hak-prv.h
View File

@ -1599,11 +1599,23 @@ hak_oop_t hak_makesymbolwithbcstr (
const hak_bch_t* ptr 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_oop_t hak_makesymbolwithucstr (
hak_t* hak, hak_t* hak,
const hak_uch_t* ptr 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_oop_t hak_findsymbol (
hak_t* hak, hak_t* hak,
const hak_ooch_t* ptr, const hak_ooch_t* ptr,

21
lib/hak.h
View File

@ -213,7 +213,6 @@ typedef enum hak_synerrnum_t hak_synerrnum_t;
*/ */
struct hak_errbinf_t struct hak_errbinf_t
{ {
hak_oow_t _instsize;
hak_errnum_t num; /**< error number */ hak_errnum_t num; /**< error number */
hak_bch_t msg[HAK_ERRMSG_CAPA]; /**< error message */ hak_bch_t msg[HAK_ERRMSG_CAPA]; /**< error message */
hak_bloc_t loc; /**< error location */ hak_bloc_t loc; /**< error location */
@ -222,7 +221,6 @@ typedef struct hak_errbinf_t hak_errbinf_t;
struct hak_erruinf_t struct hak_erruinf_t
{ {
hak_oow_t _instsize;
hak_errnum_t num; /**< error number */ hak_errnum_t num; /**< error number */
hak_uch_t msg[HAK_ERRMSG_CAPA]; /**< error message */ hak_uch_t msg[HAK_ERRMSG_CAPA]; /**< error message */
hak_uloc_t loc; /**< error location */ hak_uloc_t loc; /**< error location */
@ -2972,6 +2970,18 @@ HAK_EXPORT hak_oop_t hak_makestring (
hak_oow_t len 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_EXPORT hak_oop_t hak_makefpdec (
hak_t* hak, hak_t* hak,
hak_oop_t value, 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_dupootobcstr(hak,oocs,bcslen) hak_duputobcstr(hak,oocs,bcslen)
# define hak_dupbtooocstr(hak,bcs,oocslen) hak_dupbtoucstr(hak,bcs,oocslen) # define hak_dupbtooocstr(hak,bcs,oocslen) hak_dupbtoucstr(hak,bcs,oocslen)
# define hak_dupootoucstr(hak,oocs,ucslen) hak_dupucstr(hak,oocs,ucslen) # define hak_dupootoucstr(hak,oocs,ucslen) hak_dupucstr(hak,oocs,ucslen)
# define hak_duputooocstr(hak,ucs,oocslen) hak_dupucstr(hak,ucs,oocslen) # define hak_duputooocstr(hak,ucs,oocslen) hak_dupucstr(hak,ucs,oocslen)
#else #else
# define hak_dupootoucharswithheadroom(hak,hrb,oocs,oocslen,ucslen) hak_dupbtoucharswithheadroom(hak,hrb,oocs,oocslen,ucslen) # 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) # 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) # define hak_dupoocstr(hak,oocs,oocslen) hak_dupucstr(hak,oocs,oocslen)
#else #else
# define hak_dupoochars(hak,oocs,oocslen) hak_dupbchars(hak,oocs,oocslen) # 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 #endif
HAK_EXPORT hak_uch_t* hak_dupuchars ( HAK_EXPORT hak_uch_t* hak_dupuchars (

60
lib/obj.c
View File

@ -438,6 +438,66 @@ hak_oop_t hak_makestring (hak_t* hak, const hak_ooch_t* ptr, hak_oow_t len)
return v; 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_t hak_makefpdec (hak_t* hak, hak_oop_t value, hak_ooi_t scale)
{ {
hak_oop_fpdec_t f; hak_oop_fpdec_t f;

2
lib/print.c
View File

@ -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 (HAK_SIZEOF_OOCH_T >= 4)
if (chu >= 0x10000u) 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 else
#endif #endif

4
lib/std.c
View File

@ -3248,7 +3248,11 @@ static void* dlopen_pfmod (hak_t* hak, const hak_ooch_t* name, const hak_ooch_t*
{ {
xlen = dirlen; xlen = dirlen;
dlen = bufcapa; dlen = bufcapa;
#if defined(HAK_OOCH_IS_UCH)
if (hak_convootobchars(hak, dirptr, &xlen, bufptr, &dlen) <= -1) return HAK_NULL; 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) if (dlen > 0 && bufptr[dlen - 1] != HAK_DFL_PATH_SEP)
{ {

36
lib/sym.c
View File

@ -202,12 +202,29 @@ hak_oop_t hak_makesymbolwithbcstr (hak_t* hak, const hak_bch_t* ptr)
#endif #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) hak_oop_t hak_makesymbolwithucstr (hak_t* hak, const hak_uch_t* ptr)
{ {
#if defined(HAK_OOCH_IS_UCH) #if defined(HAK_OOCH_IS_UCH)
return hak_makesymbol(hak, ptr, hak_count_ucstr(ptr)); return hak_makesymbol(hak, ptr, hak_count_ucstr(ptr));
#else #else
hak_uch_t* bcsptr; hak_bch_t* bcsptr;
hak_oow_t bcslen; hak_oow_t bcslen;
hak_oop_t v; hak_oop_t v;
/* TODO: no duplication? */ /* TODO: no duplication? */
@ -218,3 +235,20 @@ hak_oop_t hak_makesymbolwithucstr (hak_t* hak, const hak_uch_t* ptr)
return v; return v;
#endif #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
}

31
lib/xchg.c
View File

@ -375,22 +375,13 @@ int hak_unmarshalcode (hak_t* hak, hak_code_t* code, hak_xchg_reader_t rdr, void
} }
nbytes = hak_leoowtoh(w); nbytes = hak_leoowtoh(w);
if (b == HAK_XCHG_STRING_U) if (nchars > usym_buf_capa)
{ {
ns = hak_makestring(hak, HAK_NULL, nchars); usym_buf_capa = nchars * HAK_SIZEOF(usym_buf[0]);
if (HAK_UNLIKELY(!ns)) goto oops; usym_buf = (hak_uch_t*)hak_allocmem(hak, usym_buf_capa);
ucsptr = HAK_OBJ_GET_CHAR_PTR(ns, 0); if (HAK_UNLIKELY(!usym_buf)) goto oops;
}
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;
} }
ucsptr = usym_buf;
ucspos = 0; ucspos = 0;
bcsres = 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); 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 (HAK_UNLIKELY(!ns)) goto oops;
if (b == HAK_XCHG_SYMBOL_U) if (b == HAK_XCHG_SYMBOL_U)
{ {
/* form a cons cell */ /* form a cons cell */
hak_oop_t nc; hak_oop_t nc;
hak_pushvolat(hak, &ns); hak_pushvolat(hak, &ns);
nc = hak_makecons(hak, ns, hak->_nil); nc = hak_makecons(hak, ns, hak->_nil);

2
main.go
View File

@ -96,7 +96,7 @@ func handle_arguments(param *Param) error {
func main() { func main() {
var x *hak.HAK = nil var x *hak.Hak = nil
var err error = nil var err error = nil
var param Param var param Param

3
pas/Makefile.am
View File

@ -9,6 +9,9 @@ PASFLAGS = -Mobjfpc -FcUTF8 -Sm -g
if HAK_LIB_QUADMATH_REQUIRED if HAK_LIB_QUADMATH_REQUIRED
PASFLAGS += -dHAK_LIB_QUADMATH_REQUIRED PASFLAGS += -dHAK_LIB_QUADMATH_REQUIRED
endif 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 hakpas_LINK = cp -pf hakpas.bin $(builddir)/hakpas$(EXEEXT) || echo

3
pas/Makefile.in
View File

@ -92,6 +92,7 @@ build_triplet = @build@
host_triplet = @host@ host_triplet = @host@
bin_PROGRAMS = hakpas$(EXEEXT) bin_PROGRAMS = hakpas$(EXEEXT)
@HAK_LIB_QUADMATH_REQUIRED_TRUE@am__append_1 = -dHAK_LIB_QUADMATH_REQUIRED @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 subdir = pas
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_check_sign.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_SOURCES = hak.pas main.pas
hakpas_CPPFLAGS = hakpas_CPPFLAGS =
hakpas_DEPENDENCIES = hakpas.bin 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 hakpas_LINK = cp -pf hakpas.bin $(builddir)/hakpas$(EXEEXT) || echo
all: all-am all: all-am

199
pas/hak.pas
View File

@ -20,6 +20,17 @@ type
TRAIT_LANG_ENABLE_EOL = (BitMask(1) shl 14); *) TRAIT_LANG_ENABLE_EOL = (BitMask(1) shl 14); *)
type 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 *) TraitBit = ( (* this enum must follow hak_trait_t in hak.h *)
LANG_ENABLE_EOL = (BitMask(1) shl 14) LANG_ENABLE_EOL = (BitMask(1) shl 14)
); );
@ -47,10 +58,10 @@ type
//{$packrecords c} //{$packrecords c}
CciArgPtr = ^CciArg; CciArgPtr = ^CciArg;
CciArg = record (* this record must follow the public part of hak_io_cciarg_t in hak.h *) CciArg = record (* this record must follow the public part of hak_io_cciarg_t in hak.h *)
name: pwidechar; name: PUchar;
handle: pointer; handle: pointer;
byte_oriented: integer; 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; xlen: System.SizeUint;
includer: CciArgPtr; includer: CciArgPtr;
end; end;
@ -66,11 +77,15 @@ type
destructor Destroy(); override; destructor Destroy(); override;
procedure Ignite(heapsize: System.SizeUint); procedure Ignite(heapsize: System.SizeUint);
procedure AddBuiltinPrims(); procedure AddBuiltinPrims();
procedure CompileFile(filename: pansichar); procedure CompileFile(filename: PBchar);
procedure CompileText(text: pansichar); procedure CompileText(text: PBchar);
procedure CompileText(text: pansichar; len: System.SizeUint); procedure CompileText(text: PBchar; len: System.SizeUint);
procedure CompileText(text: pwidechar); procedure CompileText(text: PUchar);
procedure CompileText(text: pwidechar; len: System.SizeUint); 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(); procedure Execute();
protected protected
@ -93,55 +108,75 @@ type
Location = record Location = record
line: System.SizeUint; line: System.SizeUint;
colm: System.SizeUint; colm: System.SizeUint;
filp: pwidechar; filp: PUchar;
end; end;
SynerrPtr = ^Synerr;
Synerr = record Synerr = record
num: integer; num: integer;
loc: Location; loc: Location;
tgt: record tgt: record
val: array[0..255] of widechar; val: array[0..255] of Uchar;
len: System.SizeUint; len: System.SizeUint;
end; end;
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 -----*) (*----- external hak function -----*)
function hak_errnum_to_errbcstr(errnum: integer; errbuf: pointer; errbufsz: System.SizeUint): pointer; cdecl; external; 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_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; procedure hak_close(handle: pointer); cdecl; external;
function hak_getxtn(handle: pointer): InterpExtPtr; cdecl; external; function hak_getxtn(handle: pointer): InterpExtPtr; cdecl; external;
function hak_setoption(handle: pointer; option: Option; value: pointer): integer; 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; 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; function hak_geterrnum(handle: pointer): integer; cdecl; external;
procedure hak_seterrbmsg (handle: pointer; errnum: integer; errmsg: pansichar); cdecl; external; procedure hak_seterrbmsg(handle: pointer; errnum: integer; errmsg: PBchar); cdecl; external;
function hak_geterrbmsg(handle: pointer): pansichar; 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_ignite(handle: pointer; heapsize: System.SizeUint): integer; cdecl; external;
function hak_addbuiltinprims(handle: pointer): integer; cdecl; external; function hak_addbuiltinprims(handle: pointer): integer; cdecl; external;
function hak_beginfeed(handle: pointer; on_cnode: 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_feedbchars(handle: pointer; data: PBchar; 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_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_endfeed(handle: pointer): integer; cdecl; external;
function hak_attachccio(handle: pointer; cci: 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; 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; procedure hak_detachudio(handle: pointer); cdecl; external;
function hak_compile(handle: pointer; cnode: pointer; flags: integer): integer; cdecl; external; function hak_compile(handle: pointer; cnode: pointer; flags: integer): integer; cdecl; external;
function hak_execute(handle: pointer): pointer; cdecl; external; function hak_execute(handle: pointer): pointer; cdecl; external;
procedure hak_abort(handle: pointer) cdecl; external; procedure hak_abort(handle: pointer) cdecl; external;
procedure hak_getsynerr(handle: pointer; synerr: SynerrPtr) 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_syserrstrb(handle: pointer; syserr_type: integer; syserr_code: integer; buf: PBchar; len: System.SizeUint): integer; cdecl; external;
function hak_count_ucstr(ptr: pwidechar): System.SizeUint; cdecl; external; function hak_count_ucstr(ptr: PUchar): System.SizeUint; cdecl; external;
(*----- end external hak function -----*) (*----- end external hak function -----*)
implementation implementation
@ -156,27 +191,68 @@ type
NamedHandlePtr = ^NamedHandle; 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); constructor Interp.Create (x: integer);
var var
h: pointer; h: pointer;
errnum: integer; ei: Errinf;
errmsg: array[0..255] of AnsiChar; ebi: Errbinf;
tb: BitMask; tb: BitMask;
ext: InterpExtPtr; ext: InterpExtPtr;
begin begin
h := hak_openstd(System.SizeOf(Interp), @errnum); h := hak_openstd(System.SizeOf(Interp), @ei);
if h = nil then begin if h = nil then begin
hak_errnum_to_errbcstr(errnum, @errmsg, length(errmsg)); {$if defined(HAK_WIDE_CHAR_SIZE_IS_4)}
raise Exception.Create(errmsg); raise Exception.Create(System.UTF8Encode(PUCS4CharToWideString(ei.msg)));
{$else}
raise Exception.Create(System.UTF8Encode(ei.msg));
{$endif}
end; end;
if hak_getoption(h, Option.TRAIT, @tb) <= -1 then tb := 0; if hak_getoption(h, Option.TRAIT, @tb) <= -1 then tb := 0;
tb := tb or BitMask(TraitBit.LANG_ENABLE_EOL); tb := tb or BitMask(TraitBit.LANG_ENABLE_EOL);
if hak_setoption(h, Option.TRAIT, @tb) <= -1 then begin 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); hak_close(h);
raise Exception.Create(errmsg); raise Exception.Create(ebi.msg);
end; end;
self.handle := h; self.handle := h;
@ -198,20 +274,27 @@ end;
function Interp.FetchErrorMsg(): string; function Interp.FetchErrorMsg(): string;
var var
num: integer; num: integer;
bmsg: pansichar; bmsg: PBchar;
serr: Synerr; serr: Synerr;
filp: pwidechar; filp: PUchar;
tgt: array[0..255] of widechar; (*tgt: array[0..255] of Uchar;*)
tgt: string;
begin begin
num := hak_geterrnum(self.handle); num := hak_geterrnum(self.handle);
if hak_errnum_is_synerr(num) then begin if hak_errnum_is_synerr(num) then begin
hak_getsynerr(self.handle, @serr); hak_getsynerr(self.handle, @serr);
bmsg := hak_geterrbmsg(self.handle); bmsg := hak_geterrbmsg(self.handle);
filp := pwidechar(widestring('')); filp := PUchar(WideString(''));
if serr.loc.filp <> nil then filp := serr.loc.filp; if serr.loc.filp <> nil then filp := serr.loc.filp;
if serr.tgt.len > 0 then begin if serr.tgt.len > 0 then begin
SysUtils.Strlcopy(@tgt, serr.tgt.val, Math.Min(serr.tgt.len, length(tgt) - 1)); {$if defined(HAK_WIDE_CHAR_SIZE_IS_4)}
exit(SysUtils.Format('%s at %s[%u:%u] - %s', [string(bmsg), string(filp), serr.loc.line, serr.loc.colm, string(tgt)])); 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 end
else begin else begin
exit(SysUtils.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]));
@ -276,7 +359,7 @@ begin
System.New(nf); System.New(nf);
if nf = nil then begin if nf = nil then begin
err := SysUtils.GetLastOSError(); 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); exit(-1);
end; end;
@ -285,7 +368,7 @@ begin
nf^.handle := SysUtils.FileOpen(name, SysUtils.fmOpenRead); nf^.handle := SysUtils.FileOpen(name, SysUtils.fmOpenRead);
if nf^.handle = System.THandle(-1) then begin if nf^.handle = System.THandle(-1) then begin
err := SysUtils.GetLastOSError(); 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); System.Dispose(nf);
exit(-1); exit(-1);
end; end;
@ -307,9 +390,9 @@ begin
IO_READ_BYTES: begin IO_READ_BYTES: begin
nf := NamedHandlePtr(arg^.handle); 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 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); exit(-1);
end; end;
arg^.xlen := len; arg^.xlen := len;
@ -333,14 +416,14 @@ begin
exit(0); exit(0);
end; end;
procedure Interp.CompileFile(filename: pansichar); procedure Interp.CompileFile(filename: PBchar);
var var
f: System.THandle = -1; f: System.THandle = -1;
attached: boolean = false; attached: boolean = false;
feed_ongoing: boolean = false; feed_ongoing: boolean = false;
errnum: System.Integer; errnum: System.Integer;
errmsg: string; errmsg: string;
buf: array[0..1023] of ansichar; buf: array[0..1023] of Bchar;
len: System.LongInt; len: System.LongInt;
label label
oops; oops;
@ -399,12 +482,12 @@ oops:
raise Exception.Create(errmsg); raise Exception.Create(errmsg);
end; end;
procedure Interp.CompileText(text: pansichar); procedure Interp.CompileText(text: PBchar);
begin begin
self.CompileText(text, SysUtils.Strlen(text)); self.CompileText(text, SysUtils.Strlen(text));
end; end;
procedure Interp.CompileText(text: pansichar; len: System.SizeUint); procedure Interp.CompileText(text: PBchar; len: System.SizeUint);
var var
errnum: integer; errnum: integer;
errmsg: string; errmsg: string;
@ -438,12 +521,40 @@ begin
hak_detachccio(self.handle); hak_detachccio(self.handle);
end; end;
procedure Interp.CompileText(text: pwidechar); {$if defined(HAK_WIDE_CHAR_SIZE_IS_4)}
procedure Interp.CompileText(text: PWideChar);
var
x: UCS4String;
begin begin
self.CompileText(text, SysUtils.Strlen(text)); x := WideStringToUcs4String(text);
self.CompileText(PUchar(x));
end; 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 var
errnum: integer; errnum: integer;
errmsg: string; errmsg: string;

1
t/t-001.c
View File

@ -5,7 +5,6 @@ int main(int argc, char* argv[])
{ {
hak_t* hak; hak_t* hak;
hak_oop_t v; hak_oop_t v;
hak_liw_t liw;
hak_ooi_t i, j; hak_ooi_t i, j;
int n; int n;