Compare commits

..
25 Commits
Author SHA1 Message Date
hyung-hwan 1d17f1e708 fixed the mssing stack finalization is multiple process manipulation primitive functions 2026-09-15 20:29:09 +09:00
hyung-hwan f99a8c87f0 updated the Semaphore methods to relay the return value of primitive calls 2026-09-12 11:49:10 +09:00
hyung-hwan 7be5d0fe61 code simplification by using MUXEVT_FD in more places 2026-09-12 11:33:51 +09:00
hyung-hwan baa01b22e3 relocated signal primitives to the sys module 2026-09-11 23:12:40 +09:00
hyung-hwan 58d1234020 added ticker to bin/main.go 2026-09-11 16:01:36 +09:00
hyung-hwan bcdc7d8d36 ported the same command line options to the go code 2026-09-11 14:36:51 +09:00
hyung-hwan 1a8cc6ef43 split HAK_OPT_MODLIBDIRS and HAK_OPT_INCDIRS to BCSTR/UCSTR 2026-09-11 12:33:30 +09:00
hyung-hwan 15b42bc269 make the style of option enumerators more uniform 2026-09-11 12:02:12 +09:00
hyung-hwan 992b1344a8 update hak.go with modlibdirs and incdirs... still not complete 2026-09-11 10:58:28 +09:00
hyung-hwan 27115ca792 added HAK_OPT_INCDIRS 2026-09-11 10:44:58 +09:00
hyung-hwan 05b7e3f728 added the option.incdirs field 2026-09-10 06:00:04 +00:00
hyung-hwan e63dc2c2a0 relocated some primitive functions(process,semaphore,etc) to the core module 2026-09-10 14:30:51 +09:00
hyung-hwan 92caa7e8db creating Seamphore and SemaphoreGroup classes 2026-09-10 13:53:25 +09:00
hyung-hwan 4b4238dc50 fixed the return in the catch block bug. the try_exist instruction should not have been emitted for return when directly in a catch block 2026-09-05 00:59:19 +09:00
hyung-hwan 175e666954 fixed the return in try bug. when compiling return, it was emitting the try_exit instruction too early before instructions for return value evaluation 2026-09-05 00:00:28 +09:00
hyung-hwan 586094ae8f added HAK_CLSTK_SIZE and EXSTK_SIZE 2026-09-03 20:35:32 +09:00
hyung-hwan de8c567a87 updated the poll/select branch to fix the delayed waked up of io signaling thread 2026-09-02 18:58:31 +09:00
hyung-hwan 10051c7851 updated the poll path to handle stale events in std.c 2026-09-02 15:11:20 +09:00
hyung-hwan df07bd7eb2 updated start_ticker and stop_ticker to use atomic operations if available
defined a few atomic operation macros
2026-09-02 13:11:18 +09:00
hyung-hwan e5ce0304f8 fixed a c89 violation in test code 2026-09-01 23:52:10 +09:00
hyung-hwan 58d3eaa562 more update to kqueue/kevent handling in std.c 2026-09-01 23:20:34 +09:00
hyung-hwan fdda6998f2 updated muxmod to purge the buffered events from the modified io handle 2026-09-01 23:07:20 +09:00
hyung-hwan 2cb4ddf0b3 changed the HAVE_ESCAPE_U check as the previous check didn't work well 2026-09-01 22:14:14 +09:00
hyung-hwan f77ec1049d added HAVE_ESCAPE_U check 2026-09-01 20:11:02 +09:00
hyung-hwan 897e7477bc minor fixes to cater for old compilers 2026-09-01 05:36:58 +00:00
48 changed files with 2323 additions and 703 deletions
+39 -33
View File
@@ -249,8 +249,8 @@ static int handle_logopt (hak_t* hak, const hak_bch_t* logstr)
}
fname.ptr = (hak_bch_t*)logstr;
hak_setoption (hak, HAK_LOG_TARGET_BCS, &fname);
hak_setoption (hak, HAK_LOG_MASK, &logmask);
hak_setoption (hak, HAK_OPT_LOG_TARGET_BCS, &fname);
hak_setoption (hak, HAK_OPT_LOG_MASK, &logmask);
return 0;
}
@@ -280,9 +280,9 @@ static int handle_dbgopt (hak_t* hak, const hak_bch_t* str)
}
while (cm);
hak_getoption(hak, HAK_TRAIT, &trait);
hak_getoption(hak, HAK_OPT_TRAIT, &trait);
trait |= dbgopt;
hak_setoption(hak, HAK_TRAIT, &trait);
hak_setoption(hak, HAK_OPT_TRAIT, &trait);
return 0;
}
#endif
@@ -865,6 +865,7 @@ int main (int argc, char* argv[])
{ ":debug", '\0' },
#endif
{ ":heapsize", '\0' },
{ ":incdirs", 'I' },
{ ":log", 'l' },
{ "info", '\0' },
{ ":modlibdirs", '\0' },
@@ -873,7 +874,7 @@ int main (int argc, char* argv[])
};
static hak_bopt_t opt =
{
"l:v",
"I:l:v",
lopt
};
@@ -882,6 +883,7 @@ int main (int argc, char* argv[])
int verbose = 0;
int show_info = 0;
const char* modlibdirs = HAK_NULL;
const char* incdirs = HAK_NULL;
#if defined(HAK_BUILD_DEBUG)
const char* dbgopt = HAK_NULL;
@@ -896,6 +898,7 @@ int main (int argc, char* argv[])
fprintf(stderr, "Usage: %s [options] script-filename [output-filename]\n", argv[0]);
fprintf(stderr, "Options are:\n");
fprintf(stderr, " --info show build information\n");
fprintf(stderr, " -I, --incdirs string specify the list of include directories\n");
fprintf(stderr, " -l, --log string specify the log file path and options\n");
fprintf(stderr, " --modlibdirs string specify directories to load modules from\n");
fprintf(stderr, " -v show verbose messages\n");
@@ -907,6 +910,10 @@ int main (int argc, char* argv[])
{
switch (c)
{
case 'I':
incdirs = opt.arg;
break;
case 'l':
logopt = opt.arg;
break;
@@ -979,12 +986,16 @@ int main (int argc, char* argv[])
{
hak_oow_t tab_size;
tab_size = 5000;
hak_setoption (hak, HAK_SYMTAB_SIZE, &tab_size);
tab_size = 5000;
hak_setoption (hak, HAK_SYSDIC_SIZE, &tab_size);
tab_size = 600; /* TODO: choose a better stack size or make this user specifiable */
hak_setoption (hak, HAK_PROCSTK_SIZE, &tab_size);
tab_size = HAK_DFL_SYMTAB_SIZE;
hak_setoption (hak, HAK_OPT_SYMTAB_SIZE, &tab_size);
tab_size = HAK_DFL_SYSDIC_SIZE;
hak_setoption (hak, HAK_OPT_SYSDIC_SIZE, &tab_size);
tab_size = HAK_DFL_PROCSTK_SIZE; /* TODO: choose a better stack size or make this user specifiable */
hak_setoption (hak, HAK_OPT_PROCSTK_SIZE, &tab_size);
tab_size = HAK_DFL_EXSTK_SIZE; /* TODO: choose a better stack size or make this user specifiable */
hak_setoption (hak, HAK_OPT_EXSTK_SIZE, &tab_size);
tab_size = HAK_DFL_CLSTK_SIZE; /* TODO: choose a better stack size or make this user specifiable */
hak_setoption (hak, HAK_OPT_CLSTK_SIZE, &tab_size);
}
{
@@ -993,34 +1004,29 @@ int main (int argc, char* argv[])
/*trait |= HAK_TRAIT_NOGC;*/
trait |= HAK_TRAIT_AWAIT_PROCS;
trait |= HAK_TRAIT_LANG_ENABLE_EOL;
hak_setoption (hak, HAK_TRAIT, &trait);
hak_setoption (hak, HAK_OPT_TRAIT, &trait);
}
if (incdirs)
{
/* the option is stored in both encodings, so the byte form from
* the command line goes in as is - no conversion needed here. */
if (hak_setoption(hak, HAK_OPT_INCDIRS_BCSTR, incdirs) <= -1)
{
hak_logbfmt(hak, HAK_LOG_STDERR,"ERROR: cannot set incdirs - [%d] %js\n", hak_geterrnum(hak), hak_geterrmsg(hak));
goto oops;
}
}
if (modlibdirs)
{
#if defined(HAK_OOCH_IS_UCH)
hak_ooch_t* tmp;
tmp = hak_dupbtoucstr(hak, modlibdirs, HAK_NULL);
if (HAK_UNLIKELY(!tmp))
{
hak_logbfmt(hak, HAK_LOG_STDERR,"ERROR: cannot duplicate modlibdirs - [%d] %js\n", hak_geterrnum(hak), hak_geterrmsg(hak));
goto oops;
}
if (hak_setoption(hak, HAK_MOD_LIBDIRS, tmp) <= -1)
{
hak_logbfmt(hak, HAK_LOG_STDERR,"ERROR: cannot set modlibdirs - [%d] %js\n", hak_geterrnum(hak), hak_geterrmsg(hak));
hak_freemem(hak, tmp);
goto oops;
}
hak_freemem(hak, tmp);
#else
if (hak_setoption(hak, HAK_MOD_LIBDIRS, modlibdirs) <= -1)
/* the option is stored in both encodings, so the byte form from
* the command line goes in as is - no conversion needed here. */
if (hak_setoption(hak, HAK_OPT_MODLIBDIRS_BCSTR, modlibdirs) <= -1)
{
hak_logbfmt(hak, HAK_LOG_STDERR,"ERROR: cannot set modlibdirs - [%d] %js\n", hak_geterrnum(hak), hak_geterrmsg(hak));
goto oops;
}
#endif
}
memset (&hakcb, 0, HAK_SIZEOF(hakcb));
@@ -1091,9 +1097,9 @@ int main (int argc, char* argv[])
// in the non-INTERACTIVE mode, the compiler generates MAKE_BLOCK for lambda functions.
{
hak_bitmask_t trait;
hak_getoption(hak, HAK_TRAIT, &trait);
hak_getoption(hak, HAK_OPT_TRAIT, &trait);
trait |= HAK_TRAIT_INTERACTIVE;
hak_setoption(hak, HAK_TRAIT, &trait);
hak_setoption(hak, HAK_OPT_TRAIT, &trait);
}
#endif
+216 -15
View File
@@ -4,8 +4,10 @@ import (
"flag"
"fmt"
"hak"
"io"
"os"
//"strings"
"strings"
"time"
)
/*
@@ -18,6 +20,9 @@ import (
`))
*/
/* 0 means no pre-allocated heap, as in bin/hak.c */
const DEFAULT_HEAPSIZE uint = 0
/* to be set in build time */
var BINDIR = "."
var SBINDIR = "."
@@ -25,10 +30,14 @@ var LIBDIR = "."
var SYSCONFDIR = "."
type Param struct {
log_file string
log_target string
log_mask hak.BitMask
input_file string
heapsize uint
modlibdirs string
incdirs string
verbose bool
show_info bool
fs_usage func()
}
@@ -36,6 +45,93 @@ func empty_usage() {
}
/* the filter names accepted after the comma in --log, mirroring the xtab
* table in handle_logopt() of bin/hak.c. 'and' marks the entries that clear
* bits instead of setting them. */
type log_filter struct {
name string
and bool
mask hak.BitMask
}
var log_filters = []log_filter{
{"", false, 0},
{"app", false, hak.LOG_APP},
{"compiler", false, hak.LOG_COMPILER},
{"vm", false, hak.LOG_VM},
{"mnemonic", false, hak.LOG_MNEMONIC},
{"gc", false, hak.LOG_GC},
{"ic", false, hak.LOG_IC},
{"primitive", false, hak.LOG_PRIMITIVE},
/* a specific level */
{"fatal", false, hak.LOG_FATAL},
{"error", false, hak.LOG_ERROR},
{"warn", false, hak.LOG_WARN},
{"info", false, hak.LOG_INFO},
{"debug", false, hak.LOG_DEBUG},
/* a specific level or higher */
{"fatal+", false, hak.LOG_FATAL},
{"error+", false, hak.LOG_FATAL | hak.LOG_ERROR},
{"warn+", false, hak.LOG_FATAL | hak.LOG_ERROR | hak.LOG_WARN},
{"info+", false, hak.LOG_FATAL | hak.LOG_ERROR | hak.LOG_WARN | hak.LOG_INFO},
{"debug+", false, hak.LOG_FATAL | hak.LOG_ERROR | hak.LOG_WARN | hak.LOG_INFO | hak.LOG_DEBUG},
/* a specific level or lower */
{"fatal-", false, hak.LOG_FATAL | hak.LOG_ERROR | hak.LOG_WARN | hak.LOG_INFO | hak.LOG_DEBUG},
{"error-", false, hak.LOG_ERROR | hak.LOG_WARN | hak.LOG_INFO | hak.LOG_DEBUG},
{"warn-", false, hak.LOG_WARN | hak.LOG_INFO | hak.LOG_DEBUG},
{"info-", false, hak.LOG_INFO | hak.LOG_DEBUG},
{"debug-", false, hak.LOG_DEBUG},
/* exclude a specific level */
{"-fatal", true, ^hak.LOG_FATAL},
{"-error", true, ^hak.LOG_ERROR},
{"-warn", true, ^hak.LOG_WARN},
{"-info", true, ^hak.LOG_INFO},
{"-debug", true, ^hak.LOG_DEBUG},
}
/* split "path,filter,filter" into a target and a log mask. with no comma the
* whole string is the target and every level and type is enabled. */
func parse_logopt(logstr string) (string, hak.BitMask, error) {
var comma int = strings.Index(logstr, ",")
var mask hak.BitMask
if comma < 0 {
return logstr, hak.LOG_ALL_LEVELS | hak.LOG_ALL_TYPES, nil
}
for _, f := range strings.Split(logstr[comma+1:], ",") {
var i int
for i = 0; i < len(log_filters); i++ {
if log_filters[i].name == f {
if log_filters[i].and {
mask &= log_filters[i].mask
} else {
mask |= log_filters[i].mask
}
break
}
}
if i >= len(log_filters) {
return "", 0, fmt.Errorf("unrecognized log filter - %s - in %s", f, logstr)
}
}
/* nothing selected in a category means everything in that category */
if (mask & hak.LOG_ALL_TYPES) == 0 {
mask |= hak.LOG_ALL_TYPES
}
if (mask & hak.LOG_ALL_LEVELS) == 0 {
mask |= hak.LOG_ALL_LEVELS
}
return logstr[0:comma], mask, nil
}
func handle_arguments(param *Param) error {
/*
var nargs int = len(os.Args)
@@ -64,34 +160,110 @@ func handle_arguments(param *Param) error {
var fs *flag.FlagSet
var heapsize *uint
var modlibdirs *string
var incdirs *string
var log *string
var verbose *bool
var show_info *bool
var err error
fs = flag.NewFlagSet(os.Args[0], flag.ContinueOnError)
heapsize = fs.Uint("heapsize", 0, "specify heap size")
modlibdirs = fs.String("modlibdirs", "", "specify module library directories")
log = fs.String("log", "", "specify log file")
/* the same set bin/hak.c accepts. the flag package treats -x and --x
* alike, so registering both spellings of a short option is enough to
* give -I and --incdirs the same destination. */
heapsize = fs.Uint("heapsize", DEFAULT_HEAPSIZE, "specify the heap size in bytes")
incdirs = fs.String("incdirs", "", "specify the list of include directories")
fs.StringVar(incdirs, "I", "", "specify the list of include directories")
log = fs.String("log", "", "specify the log file path and options")
fs.StringVar(log, "l", "", "specify the log file path and options")
modlibdirs = fs.String("modlibdirs", "", "specify directories to load modules from")
verbose = fs.Bool("v", false, "show verbose messages")
show_info = fs.Bool("info", false, "show build information")
param.fs_usage = fs.Usage
fs.Usage = empty_usage // i don't want fs.Parse() print the usage
fs.SetOutput(io.Discard) // nor its own copy of the error, which we report ourselves
err = fs.Parse(os.Args[1:])
fs.Usage = param.fs_usage // restore it
fs.SetOutput(os.Stderr) // so the restored usage still prints
if err != nil {
return fmt.Errorf("command line error - %s", err.Error())
}
param.heapsize = *heapsize
param.incdirs = *incdirs
param.modlibdirs = *modlibdirs
param.verbose = *verbose
param.show_info = *show_info
if *log != "" {
param.log_target, param.log_mask, err = parse_logopt(*log)
if err != nil {
return err
}
}
/* --info answers on its own and needs no script */
if param.show_info {
return nil
}
if fs.NArg() < 1 {
return fmt.Errorf("no input file specified")
} else if fs.NArg() > 1 {
/* bin/hak.c also takes an optional output file as the second
* argument, but the go binding attaches the user data streams
* through handler objects rather than a path, so there is nothing
* to pass it to yet. */
return fmt.Errorf("too many input files specified")
}
param.input_file = fs.Arg(0);
param.log_file = *log // TODO: parse the option part (e.g. --log /dev/stderr,debug+)
param.heapsize = *heapsize // TODO: set this to hak
param.modlibdirs = *modlibdirs // TODO: set this to hak
return nil;
param.input_file = fs.Arg(0)
return nil
}
func start_ticker(x *hak.Hak) func() {
var ticker *time.Ticker
var ticker_stop chan bool
var ticker_done chan bool
var stopper func()
ticker = time.NewTicker(20 * time.Millisecond)
ticker_done = make(chan bool)
ticker_stop = make(chan bool)
go func() {
for {
select {
case <- ticker_stop:
goto done
case <- ticker.C:
x.RaiseTick()
}
}
done:
ticker.Stop()
ticker_done <- true
}()
x.RcvTick(true)
stopper = func() {
x.RcvTick(false)
ticker_stop <- true
<- ticker_done // wait for the ticker to stop
// if i don't close the the two channels below, the multiple calls to the
// returned stopper function wouldn't cause immediate panic for writing
// on a closed channel. but i would still close them as i don't want to
// cater for generic use of this function and this function wasn't
// written to be generic. i don't care to use any other more advanced
// mechanisms. the caller must ensure to call this stopper only once.
close(ticker_stop)
close(ticker_done)
}
return stopper
}
func main() {
@@ -99,6 +271,7 @@ func main() {
var x *hak.Hak = nil
var err error = nil
var param Param
var stop_ticker func()
var rfh hak.CciFileHandler
var sfh hak.UdiFileHandler
@@ -111,20 +284,39 @@ func main() {
os.Exit(1)
}
if param.show_info {
fmt.Println(hak.BuildInfo())
os.Exit(0)
}
x, err = hak.New()
if err != nil {
fmt.Printf("ERROR: failed to instantiate hak - %s\n", err.Error())
os.Exit(1)
}
if param.log_file != "" {
x.SetLogMask(^hak.BitMask(0))
x.SetLogTarget("/dev/stderr")
if param.log_target != "" {
/* honour both halves of --log. the previous code discarded the path
* and always logged everything to /dev/stderr. */
x.SetLogMask(param.log_mask)
err = x.SetLogTarget(param.log_target)
if err != nil {
fmt.Printf("ERROR: failed to set log target - %s\n", err.Error())
os.Exit(1)
}
}
if param.incdirs != "" {
x.SetIncDirs(param.incdirs)
}
if param.modlibdirs != "" {
x.SetModLibDirs(param.modlibdirs)
}
x.SetTrait(x.GetTrait() | hak.TRAIT_LANG_ENABLE_EOL)
err = x.Ignite(1000000)
err = x.Ignite(uintptr(param.heapsize))
if err != nil {
fmt.Printf("ERROR: failed to ignite - %s\n", err.Error())
goto oops
@@ -169,16 +361,25 @@ func main() {
goto oops
}
/* Decode() writes the bytecode mnemonics through the log, so it only
* produces anything when --log selects the mnemonic type. the log mask
* is no longer cleared afterwards - doing that silenced --log for the
* whole of Execute(). */
x.Decode()
x.SetLogMask(0)
stop_ticker = start_ticker(x)
err = x.Execute()
stop_ticker()
if err != nil {
//fmt.Printf("ERROR: %s[%d:%d] - %s\n", herr.File, herr.Line, herr.Colm, herr.Msg)
fmt.Printf("ERROR: %s\n", err.Error())
goto oops
}
if param.verbose {
fmt.Printf("EXECUTION OK - %s\n", param.input_file)
}
x.Close()
os.Exit(0)
Vendored
+40
View File
@@ -16590,6 +16590,45 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether compiler supports \u escape sequences" >&5
printf %s "checking whether compiler supports \u escape sequences... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* define a macro that forces a compilation error if condition is false */
#define STATIC_ASSERT(expr) char assert_array[(expr) ? 1 : -1]
int
main (void)
{
/* true UTF-8 "\u00e9" is 3 bytes including the null terminator.
* GCC 2.95's "u00e9" is 6 bytes. */
STATIC_ASSERT(sizeof("\u00e9") == 3);
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "yes" >&6; }
printf "%s\n" "#define HAVE_ESCAPE_U 1" >>confdefs.h
else case e in #(
e)
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for __builtin_memset" >&5
printf %s "checking for __builtin_memset... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
@@ -17157,6 +17196,7 @@ then :
fi
ac_fn_c_check_func "$LINENO" "posix_spawn" "ac_cv_func_posix_spawn"
if test "x$ac_cv_func_posix_spawn" = xyes
then :
+19
View File
@@ -70,6 +70,24 @@ AC_SUBST(LIBM, $LIBM)
AX_PTHREAD()
dnl check some compiler features
AC_MSG_CHECKING([whether compiler supports \u escape sequences])
AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM([
/* define a macro that forces a compilation error if condition is false */
#define STATIC_ASSERT(expr) char assert_array[(expr) ? 1 : -1]
], [
/* true UTF-8 "\u00e9" is 3 bytes including the null terminator.
* GCC 2.95's "u00e9" is 6 bytes. */
STATIC_ASSERT(sizeof("\u00e9") == 3);
])], [
AC_MSG_RESULT([yes])
AC_DEFINE([HAVE_ESCAPE_U], [1], [Define to 1 if \u encodes properly])
], [
AC_MSG_RESULT([no])
]
)
dnl check some compiler builtins
AC_MSG_CHECKING([for __builtin_memset])
AC_LINK_IFELSE(
@@ -132,6 +150,7 @@ AC_CHECK_FUNCS([sigaction signal])
AC_CHECK_FUNCS([snprintf _vsnprintf _vsnwprintf strerror_r])
AC_CHECK_FUNCS([accept4 pipe2 epoll_create epoll_create1 kqueue kqueue1])
AC_CHECK_FUNCS([isatty mmap munmap])
AC_CHECK_FUNCS([posix_spawn getrlimit sysconf dirfd])
dnl dirfd may be provided as a macro rather than a function
AC_CHECK_DECLS([dirfd],[],[],[[#include <dirent.h>]])
+47 -13
View File
@@ -12,6 +12,7 @@ import (
"io"
"os"
"path"
"strings"
"path/filepath"
"reflect"
"sync"
@@ -96,6 +97,8 @@ func hak_go_cci_handler(c *C.hak_t, cmd C.hak_io_cmd_t, arg unsafe.Pointer) C.in
var (
ioarg *C.hak_io_cciarg_t
name string
raw string
try_incdirs bool
fd int
tptr unsafe.Pointer
tlen C.size_t
@@ -110,33 +113,64 @@ func hak_go_cci_handler(c *C.hak_t, cmd C.hak_io_cmd_t, arg unsafe.Pointer) C.in
// actual included stream
var includer_name string
name = string(ucstr_to_rune_slice(ioarg.name))
raw = string(ucstr_to_rune_slice(ioarg.name))
tptr = ioarg.includer.handle
tlen = *(*C.size_t)(unsafe.Pointer(uintptr(tptr) + unsafe.Sizeof(fd)))
includer_name = C.GoStringN((*C.char)(unsafe.Pointer(uintptr(tptr)+unsafe.Sizeof(fd)+unsafe.Sizeof(tlen))), C.int(tlen))
name = filepath.Join(path.Dir(includer_name), name)
name = filepath.Join(path.Dir(includer_name), raw)
// a name anchored by the author - absolute, or explicitly ./ or
// ../ - is meant to resolve against the includer alone. anything
// else may fall back to the include directories. this mirrors
// what open_cci_stream() does in lib/std.c.
try_incdirs = !filepath.IsAbs(raw) &&
!strings.HasPrefix(raw, "./") && !strings.HasPrefix(raw, "../")
}
// [NOTE] the open has to happen before the allocation below, because
// the include-directory search can settle on a different (and
// longer) path than the one first tried, and the block is
// sized from the name it ends up storing.
if ioarg.includer == nil {
fd = -1
} else {
fd, err = g.io.cci.Open(g, name)
if err != nil && try_incdirs {
// walk the colon-separated include directories, as the C
// reader does. an empty entry means the current directory.
for _, dir := range strings.Split(g.GetIncDirs(), ":") {
var cand string = filepath.Join(dir, raw)
var fd2 int
var err2 error
fd2, err2 = g.io.cci.Open(g, cand)
if err2 == nil {
// the stored name becomes the includer path for
// anything this file includes in turn, so it has to
// be the path that actually opened
fd, err, name = fd2, nil, cand
break
}
}
}
if err != nil {
g.set_errmsg(C.HAK_EIOERR, err.Error())
return -1
}
}
tlen = C.size_t(len(name)) // number of bytes in the string
tptr = C.hak_allocmem(c, C.size_t(unsafe.Sizeof(fd)) + C.size_t(unsafe.Sizeof(tlen)) + tlen)
if tptr == nil {
if ioarg.includer != nil {
g.io.cci.Close(fd)
}
g.set_errmsg(C.HAK_ESYSMEM, "cci name allocation failure")
return -1
}
if ioarg.includer == nil {
fd = -1
} else {
fd, err = g.io.cci.Open(g, name)
if err != nil {
g.set_errmsg(C.HAK_EIOERR, err.Error())
C.hak_freemem(c, tptr)
return -1
}
}
// | fd | length | name bytes of the length |
*(*int)(tptr) = fd;
*(*C.size_t)(unsafe.Pointer(uintptr(tptr)+unsafe.Sizeof(fd))) = tlen;
+102 -9
View File
@@ -76,6 +76,38 @@ type BitMask C.hak_bitmask_t
const TRAIT_LANG_ENABLE_EOL BitMask = C.HAK_TRAIT_LANG_ENABLE_EOL
/* log levels */
const (
LOG_DEBUG BitMask = C.HAK_LOG_DEBUG
LOG_INFO BitMask = C.HAK_LOG_INFO
LOG_WARN BitMask = C.HAK_LOG_WARN
LOG_ERROR BitMask = C.HAK_LOG_ERROR
LOG_FATAL BitMask = C.HAK_LOG_FATAL
)
/* log types */
const (
LOG_UNTYPED BitMask = C.HAK_LOG_UNTYPED
LOG_COMPILER BitMask = C.HAK_LOG_COMPILER
LOG_VM BitMask = C.HAK_LOG_VM
LOG_MNEMONIC BitMask = C.HAK_LOG_MNEMONIC
LOG_GC BitMask = C.HAK_LOG_GC
LOG_IC BitMask = C.HAK_LOG_IC
LOG_PRIMITIVE BitMask = C.HAK_LOG_PRIMITIVE
LOG_APP BitMask = C.HAK_LOG_APP
)
const (
LOG_ALL_LEVELS BitMask = C.HAK_LOG_ALL_LEVELS
LOG_ALL_TYPES BitMask = C.HAK_LOG_ALL_TYPES
)
/* BuildInfo answers how the underlying C library was configured. it mirrors
* what bin/hak.c prints for --info. */
func BuildInfo() string {
return fmt.Sprintf("Configured with: %s %s", C.HAK_CONFIGURE_CMD, C.HAK_CONFIGURE_ARGS)
}
func deregister_instance(g *Hak) {
if g.inst_no >= 0 {
inst_table.delete_instance(g.inst_no)
@@ -142,7 +174,7 @@ func (hak *Hak) GetTrait() BitMask {
var x C.int
var log_mask BitMask = 0
x = C.hak_getoption(hak.c, C.HAK_TRAIT, unsafe.Pointer(&log_mask))
x = C.hak_getoption(hak.c, C.HAK_OPT_TRAIT, unsafe.Pointer(&log_mask))
if x <= -1 {
// this must not happen
panic(fmt.Errorf("unable to get log mask - %s", hak.get_errmsg()))
@@ -154,7 +186,7 @@ func (hak *Hak) GetTrait() 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))
x = C.hak_setoption(hak.c, C.HAK_OPT_TRAIT, unsafe.Pointer(&log_mask))
if x <= -1 {
// this must not happen
panic(fmt.Errorf("unable to set log mask - %s", hak.get_errmsg()))
@@ -165,7 +197,7 @@ func (hak *Hak) GetLogMask() BitMask {
var x C.int
var log_mask BitMask = 0
x = C.hak_getoption(hak.c, C.HAK_LOG_MASK, unsafe.Pointer(&log_mask))
x = C.hak_getoption(hak.c, C.HAK_OPT_LOG_MASK, unsafe.Pointer(&log_mask))
if x <= -1 {
// this must not happen
panic(fmt.Errorf("unable to get log mask - %s", hak.get_errmsg()))
@@ -177,7 +209,7 @@ func (hak *Hak) GetLogMask() 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))
x = C.hak_setoption(hak.c, C.HAK_OPT_LOG_MASK, unsafe.Pointer(&log_mask))
if x <= -1 {
// this must not happen
panic(fmt.Errorf("unable to set log mask - %s", hak.get_errmsg()))
@@ -188,27 +220,78 @@ func (hak *Hak) GetLogTarget() string {
var x C.int
var tgt *C.char
x = C.hak_getoption(hak.c, C.HAK_LOG_TARGET_BCSTR, unsafe.Pointer(&tgt))
x = C.hak_getoption(hak.c, C.HAK_OPT_LOG_TARGET_BCSTR, unsafe.Pointer(&tgt))
if x <= -1 {
// this must not happen
panic(fmt.Errorf("unable to set log target - %s", hak.get_errmsg()))
panic(fmt.Errorf("unable to get log target - %s", hak.get_errmsg()))
}
return C.GoString(tgt)
}
func (hak *Hak) SetLogTarget(target string) {
func (hak *Hak) SetLogTarget(target string) error {
var x C.int
var tgt *C.char
tgt = C.CString(target) // TODO: need error check?
defer C.free(unsafe.Pointer(tgt))
x = C.hak_setoption(hak.c, C.HAK_LOG_TARGET_BCSTR, unsafe.Pointer(tgt))
x = C.hak_setoption(hak.c, C.HAK_OPT_LOG_TARGET_BCSTR, unsafe.Pointer(tgt))
if x <= -1 { return hak.make_errinfo() }
return nil
}
func (hak *Hak) GetIncDirs() string {
var x C.int
var tgt *C.char
x = C.hak_getoption(hak.c, C.HAK_OPT_INCDIRS_BCSTR, unsafe.Pointer(&tgt))
if x <= -1 {
// this must not happen
panic(fmt.Errorf("unable to set log target - %s", hak.get_errmsg()))
panic(fmt.Errorf("unable to get include directories - %s", hak.get_errmsg()))
}
return C.GoString(tgt)
}
func (hak *Hak) SetIncDirs(target string) error {
var x C.int
var tgt *C.char
tgt = C.CString(target) // TODO: need error check?
defer C.free(unsafe.Pointer(tgt))
x = C.hak_setoption(hak.c, C.HAK_OPT_INCDIRS_BCSTR, unsafe.Pointer(tgt))
if x <= -1 { return hak.make_errinfo() }
return nil
}
func (hak *Hak) GetModLibDirs() string {
var x C.int
var tgt *C.char
x = C.hak_getoption(hak.c, C.HAK_OPT_MODLIBDIRS_BCSTR, unsafe.Pointer(&tgt))
if x <= -1 {
// this must not happen
panic(fmt.Errorf("unable to get module library directories - %s", hak.get_errmsg()))
}
return C.GoString(tgt)
}
func (hak *Hak) SetModLibDirs(target string) error {
var x C.int
var tgt *C.char
tgt = C.CString(target) // TODO: need error check?
defer C.free(unsafe.Pointer(tgt))
x = C.hak_setoption(hak.c, C.HAK_OPT_MODLIBDIRS_BCSTR, unsafe.Pointer(tgt))
if x <= -1 { return hak.make_errinfo() }
return nil
}
func (hak *Hak) Ignite(memsize uintptr) error {
@@ -399,6 +482,16 @@ func (hak *Hak) Decode() error {
return nil
}
func (hak *Hak) RcvTick(enabled bool) {
var i C.int
if enabled { i = 1 } else { i = 0 }
C.hak_rcvtick(hak.c, i)
}
func (hak *Hak) RaiseTick() {
C.hak_raisetick(hak.c)
}
func (hak *Hak) get_errmsg() string {
return C.GoString(C.hak_geterrbmsg(hak.c))
}
+67 -58
View File
@@ -1134,6 +1134,7 @@ static int push_ctlblk (hak_t* hak, const hak_loc_t* errloc, hak_ctlblk_type_t t
HAK_MEMSET(&hak->c->ctlblk.info[new_depth], 0, HAK_SIZEOF(hak->c->ctlblk.info[new_depth]));
hak->c->ctlblk.info[new_depth]._type = type;
/*hak->c->ctlblk.info[new_depth].in_catch = 0; not needed for memset above */
hak->c->ctlblk.depth = new_depth;
return 0;
}
@@ -2090,12 +2091,60 @@ static HAK_INLINE int emit_plus (hak_t* hak)
#endif
/* ========================================================================= */
static int emit_ctlblk_unwind (hak_t* hak, hak_cnode_t* src, int stop_at_loop)
{
hak_ooi_t i;
for (i = hak->c->ctlblk.depth; i > hak->c->funblk.info[hak->c->funblk.depth].ctlblk_base; --i)
{
switch (hak->c->ctlblk.info[i]._type)
{
case HAK_CTLBLK_TYPE_LOOP:
/* a loop block needs no unwinding instruction */
if (stop_at_loop) return 1; /* for break/continue inside loop */
break;
case HAK_CTLBLK_TYPE_TRY:
/* emit an instruction to exit from the try loop. when it is in the catch side. don't emit anything */
if (!hak->c->ctlblk.info[i].in_catch &&
emit_byte_instruction(hak, HAK_CODE_TRY_EXIT, HAK_CNODE_GET_LOC(src)) <= -1) return -1;
break;
case HAK_CTLBLK_TYPE_CLASS:
/* emit an instruction to exit from the class definition scope being defined */
if (emit_byte_instruction(hak, HAK_CODE_CLASS_EXIT, HAK_CNODE_GET_LOC(src)) <= -1) return -1;
break;
}
}
return 0;
}
static void update_try_ctlblk_for_catch (hak_t* hak)
{
hak_ooi_t i;
/* find the innermost try block info and mark that it's now in the catch block side */
for (i = hak->c->ctlblk.depth; i > hak->c->funblk.info[hak->c->funblk.depth].ctlblk_base; --i)
{
if (hak->c->ctlblk.info[i]._type == HAK_CTLBLK_TYPE_TRY)
{
hak->c->ctlblk.info[i].in_catch = 1;
return;
}
}
/* this must not happend. compile_catch() must not be invoked without
* going through the enclosing TRY block first. */
HAK_ASSERT(hak, !"internal error - this must never happen");
}
static int compile_break (hak_t* hak, hak_cnode_t* src)
{
/* (break) */
hak_cnode_t* cmd, * obj;
hak_ooi_t i;
int n;
HAK_ASSERT(hak, HAK_CNODE_IS_CONS(src));
HAK_ASSERT(hak, HAK_CNODE_IS_TYPED(HAK_CNODE_CONS_CAR(src), HAK_CNODE_BREAK));
@@ -2123,30 +2172,15 @@ static int compile_break (hak_t* hak, hak_cnode_t* src)
return -1;
}
for (i = hak->c->ctlblk.depth; i > hak->c->funblk.info[hak->c->funblk.depth].ctlblk_base; --i)
n = emit_ctlblk_unwind(hak, cmd, 1);
if (n <= -1) return -1;
if (n == 0)
{
switch (hak->c->ctlblk.info[i]._type)
{
case HAK_CTLBLK_TYPE_LOOP:
goto inside_loop;
case HAK_CTLBLK_TYPE_TRY:
/* emit an instruction to exit from the try loop. */
if (emit_byte_instruction(hak, HAK_CODE_TRY_EXIT, HAK_CNODE_GET_LOC(src)) <= -1) return -1;
break;
case HAK_CTLBLK_TYPE_CLASS:
/* emit an instruction to exit from the class definition scope being defined */
if (emit_byte_instruction(hak, HAK_CODE_CLASS_EXIT, HAK_CNODE_GET_LOC(src)) <= -1) return -1;
break;
}
}
hak_setsynerrbfmt(hak, HAK_SYNERR_BREAK, HAK_CNODE_GET_LOC(src),
hak_setsynerrbfmt(hak, HAK_SYNERR_BREAK, HAK_CNODE_GET_LOC(cmd),
"%.*js outside loop", HAK_CNODE_GET_TOKLEN(cmd), HAK_CNODE_GET_TOKPTR(cmd));
return -1;
}
inside_loop:
for (i = hak->c->cfs.top; i >= 0; --i)
{
const hak_cframe_t* tcf;
@@ -2217,6 +2251,7 @@ static int compile_continue (hak_t* hak, hak_cnode_t* src)
/* (continue) */
hak_cnode_t* cmd, * obj;
hak_ooi_t i;
int n;
HAK_ASSERT(hak, HAK_CNODE_IS_CONS(src));
HAK_ASSERT(hak, HAK_CNODE_IS_TYPED(HAK_CNODE_CONS_CAR(src), HAK_CNODE_CONTINUE));
@@ -2244,29 +2279,15 @@ static int compile_continue (hak_t* hak, hak_cnode_t* src)
return -1;
}
for (i = hak->c->ctlblk.depth; i > hak->c->funblk.info[hak->c->funblk.depth].ctlblk_base; --i)
n = emit_ctlblk_unwind(hak, cmd, 1);
if (n <= -1) return -1;
if (n == 0)
{
switch (hak->c->ctlblk.info[i]._type)
{
case HAK_CTLBLK_TYPE_LOOP:
goto inside_loop;
case HAK_CTLBLK_TYPE_TRY:
/*must emit an instruction to exit from the try loop.*/
if (emit_byte_instruction(hak, HAK_CODE_TRY_EXIT, HAK_CNODE_GET_LOC(src)) <= -1) return -1;
break;
case HAK_CTLBLK_TYPE_CLASS:
if (emit_byte_instruction(hak, HAK_CODE_CLASS_EXIT, HAK_CNODE_GET_LOC(src)) <= -1) return -1;
break;
}
}
hak_setsynerrbfmt(hak, HAK_SYNERR_BREAK, HAK_CNODE_GET_LOC(src),
hak_setsynerrbfmt(hak, HAK_SYNERR_BREAK, HAK_CNODE_GET_LOC(cmd),
"%.*js outside loop", HAK_CNODE_GET_TOKLEN(cmd), HAK_CNODE_GET_TOKPTR(cmd));
return -1;
}
inside_loop:
for (i = hak->c->cfs.top; i >= 0; --i)
{
const hak_cframe_t* tcf;
@@ -3968,7 +3989,6 @@ static int compile_return (hak_t* hak, hak_cnode_t* src, int ret_from_home)
hak_cnode_t* obj, * val;
hak_cframe_t* cf;
hak_funblk_info_t* fbi;
hak_ooi_t i;
HAK_ASSERT(hak, HAK_CNODE_IS_CONS(src));
HAK_ASSERT(hak, HAK_CNODE_IS_TYPED(HAK_CNODE_CONS_CAR(src), HAK_CNODE_RETURN) ||
@@ -3977,24 +3997,6 @@ static int compile_return (hak_t* hak, hak_cnode_t* src, int ret_from_home)
fbi = &hak->c->funblk.info[hak->c->funblk.depth];
obj = HAK_CNODE_CONS_CDR(src);
for (i = hak->c->ctlblk.depth; i > hak->c->funblk.info[hak->c->funblk.depth].ctlblk_base; --i)
{
switch (hak->c->ctlblk.info[i]._type)
{
case HAK_CTLBLK_TYPE_LOOP:
/* do nothing */
break;
case HAK_CTLBLK_TYPE_TRY:
if (emit_byte_instruction(hak, HAK_CODE_TRY_EXIT, HAK_CNODE_GET_LOC(src)) <= -1) return -1;
break;
case HAK_CTLBLK_TYPE_CLASS:
if (emit_byte_instruction(hak, HAK_CODE_CLASS_EXIT, HAK_CNODE_GET_LOC(src)) <= -1) return -1;
break;
}
}
if (fbi->tmpr_nrvars > 0)
{
hak_cnode_t* tmp = HAK_CNODE_CONS_CAR(src);
@@ -4016,6 +4018,9 @@ static int compile_return (hak_t* hak, hak_cnode_t* src, int ret_from_home)
return -1;
}
/* emit unwinding expression just before emitting the actual return instruction */
if (emit_ctlblk_unwind(hak, src, 0) <= -1) return -1;
/* TODO: pop stack if this is not the first statement... */
if (emit_byte_instruction(hak, HAK_CODE_PUSH_RETURN_R, HAK_CNODE_GET_LOC(tmp)) <= -1) return -1;
POP_CFRAME(hak);
@@ -4502,6 +4507,7 @@ static HAK_INLINE int compile_catch (hak_t* hak)
/* produce an instruction to store the exception value to an exception variable pushed by the 'throw' instruction */
if (emit_variable_access(hak, VAR_ACCESS_POP, &vi, HAK_CNODE_GET_LOC(src)) <= -1) return -1;
update_try_ctlblk_for_catch(hak);
SWITCH_TOP_CFRAME(hak, COP_COMPILE_OBJECT_LIST, obj);
PUSH_SUBCFRAME(hak, COP_POST_CATCH, cmd);
@@ -7001,6 +7007,9 @@ static HAK_INLINE int emit_return (hak_t* hak)
HAK_ASSERT(hak, cf->opcode == COP_EMIT_RETURN);
HAK_ASSERT(hak, cf->operand != HAK_NULL);
/* emit unwinding expression just before emitting the actual return instruction */
if (emit_ctlblk_unwind(hak, cf->operand, 0) <= -1) return -1;
n = emit_byte_instruction(hak, (cf->u._return.from_home? HAK_CODE_RETURN_STACKTOP: HAK_CODE_RETURN_FROM_BLOCK), HAK_CNODE_GET_LOC(cf->operand));
POP_CFRAME(hak);
+67 -8
View File
@@ -180,6 +180,8 @@ static void terminate_all_processes (hak_t* hak);
ap->exsp = HAK_SMOOI_TO_OOP(exsp); \
} while (0)
/* normal stack top is the base of exstack */
#define HAK_EXSTACK_GET_BASE(hak) HAK_OOP_TO_SMOOI(((hak)->processor->active)->st)
#define HAK_EXSTACK_GET_ST(hak) HAK_OOP_TO_SMOOI(((hak)->processor->active)->exst)
#define HAK_EXSTACK_GET_SP(hak) HAK_OOP_TO_SMOOI(((hak)->processor->active)->exsp)
@@ -235,6 +237,8 @@ static void terminate_all_processes (hak_t* hak);
#define HAK_CLSTACK_CHOP(hak, clsp_) ((hak)->processor->active->clsp = HAK_SMOOI_TO_OOP(clsp_))
/* exstack top is the base of clstack */
#define HAK_CLSTACK_GET_BASE(hak) HAK_OOP_TO_SMOOI(((hak)->processor->active)->exst)
#define HAK_CLSTACK_GET_ST(hak) HAK_OOP_TO_SMOOI(((hak)->processor->active)->clst)
#define HAK_CLSTACK_GET_SP(hak) HAK_OOP_TO_SMOOI(((hak)->processor->active)->clsp)
@@ -715,23 +719,23 @@ static hak_oop_process_t make_process (hak_t* hak, hak_oop_context_t c)
if (hak->proc_map_free_first <= -1 && prepare_to_alloc_pid(hak) <= -1) return HAK_NULL;
stksize = hak->option.dfl_procstk_size; /* stack */
exstksize = 128; /* exception stack size */ /* TODO: make it configurable */
clstksize = 64; /* class stack size */ /* TODO: make it configurable too */
exstksize = hak->option.dfl_exstk_size; /* exception stack size */
clstksize = hak->option.dfl_clstk_size; /* class stack size */
fstksize = stksize; /* frame stack size */
maxsize = (HAK_TYPE_MAX(hak_ooi_t) - HAK_PROCESS_NAMED_INSTVARS) / 4;
if (stksize > maxsize) stksize = maxsize;
else if (stksize < 192) stksize = 192;
else if (stksize < HAK_MIN_PROCSTK_SIZE) stksize = HAK_MIN_PROCSTK_SIZE;
if (exstksize > maxsize) exstksize = maxsize;
else if (exstksize < 128) exstksize = 128;
else if (exstksize < HAK_MIN_EXSTK_SIZE) exstksize = HAK_MIN_EXSTK_SIZE;
if (clstksize > maxsize) clstksize = maxsize;
else if (clstksize < 32) clstksize = 32;
else if (clstksize < HAK_MIN_CLSTK_SIZE) clstksize = HAK_MIN_CLSTK_SIZE;
if (fstksize > maxsize) fstksize = maxsize;
else if (fstksize < 1024) fstksize = 1024;
else if (fstksize < HAK_MIN_FSTK_SIZE) fstksize = HAK_MIN_FSTK_SIZE;
hak_pushvolat(hak, (hak_oop_t*)&c);
proc = (hak_oop_process_t)hak_instantiate(hak, hak->c_process, HAK_NULL, stksize + exstksize + clstksize + fstksize);
@@ -1337,7 +1341,6 @@ static void yield_process (hak_t* hak, hak_oop_process_t proc)
}
}
static int async_signal_semaphore (hak_t* hak, hak_oop_semaphore_t sem)
{
#if 0
@@ -3323,13 +3326,21 @@ void hak_rcvtick (hak_t* hak, int enabled)
void hak_raisetick (hak_t* hak)
{
#if defined(HAK_ATOMIC_ADD_FETCH)
HAK_ATOMIC_ADD_FETCH(&hak->tick, 1, HAK_ATOMIC_RELAXED);
#else
hak->tick++;
#endif
}
void hak_raise_gtick (int unused)
{
/* this function is global and not bound to a specific instance. */
#if defined(HAK_ATOMIC_ADD_FETCH)
HAK_ATOMIC_ADD_FETCH(&gtick, 1, HAK_ATOMIC_RELAXED);
#else
gtick++;
#endif
}
/* ------------------------------------------------------------------------- */
@@ -4356,7 +4367,15 @@ static int execute (hak_t* hak)
case HAK_CODE_TRY_EXIT:
LOG_INST_0(hak, "try_exit");
/* TODO: stack underflow check? */
/* writing the condition this way would be more explicit.
* if (HAK_EXSTACK_GET_SP(hak) - HAK_EXSTACK_GET_BASE(hak) < 4)
* it's simpler to use HAK_EXSTACK_IS_EMPTY() base PUSH, POP, POP_TO all move
* exsp by exactly 4. */
if (HAK_EXSTACK_IS_EMPTY(hak))
{
hak_seterrbfmt(hak, HAK_ESTKUNDFLW, "exception stack underflow");
goto oops_with_errmsg_supplement;
}
HAK_EXSTACK_POP(hak);
break;
@@ -5620,6 +5639,11 @@ hak_pfrc_t hak_pf_process_resume (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
return HAK_PF_FAILURE;
}
/* [SPECIAL CASE]
* resume_process changes the the active process.
* calling this after resume_process() pollutes a wrong stack. place it here */
HAK_STACK_SETRET(hak, nargs, prc);
resume_process(hak, prc);
return HAK_PF_SUCCESS;
}
@@ -5642,6 +5666,11 @@ hak_pfrc_t hak_pf_process_suspend (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
prc = hak->processor->active;
}
/* [SPECIAL CASE]
* suspend_process changes the the active process.
* calling this after suspend_process() pollutes a wrong stack. place it here */
HAK_STACK_SETRET(hak, nargs, prc);
suspend_process(hak, prc);
return HAK_PF_SUCCESS;
}
@@ -5664,18 +5693,33 @@ hak_pfrc_t hak_pf_process_terminate (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs
prc = hak->processor->active;
}
/* [SPECIAL CASE]
* terminate_process changes the the active process.
* calling this after terminate_process() pollutes a wrong stack. place it here */
HAK_STACK_SETRET(hak, nargs, prc);
terminate_process(hak, prc);
return HAK_PF_SUCCESS;
}
hak_pfrc_t hak_pf_process_terminate_all (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
{
/* [SPECIAL CASE]
* terminate_all_processes changes the the active process.
* calling this after terminate_all_processes() pollutes a wrong stack. place it here */
HAK_STACK_SETRET(hak, nargs, hak->_nil);
terminate_all_processes(hak);
return HAK_PF_SUCCESS;
}
hak_pfrc_t hak_pf_process_yield (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
{
/* [SPECIAL CASE]
* yield_process changes the the active process.
* calling this after yield_process() pollutes a wrong stack. place it here */
HAK_STACK_SETRET(hak, nargs, hak->_nil);
yield_process(hak, hak->processor->active);
return HAK_PF_SUCCESS;
}
@@ -5695,7 +5739,22 @@ hak_pfrc_t hak_pf_semaphore_new (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
return HAK_PF_FAILURE;
}
if (nargs >= 1)
{
hak_oop_t tmp;
tmp = (hak_oop_semaphore_t)HAK_STACK_GETARG(hak, nargs, 0);
if (!HAK_OOP_IS_SMOOI(tmp))
{
hak_seterrbfmt(hak, HAK_EINVAL, "invalid semaphore count - %O", tmp);
return HAK_PF_FAILURE;
}
sem->count = tmp;
}
else
{
sem->count = HAK_SMOOI_TO_OOP(0);
}
/* TODO: sem->signal_action? */
/* other fields are all set to nil */
+3
View File
@@ -226,6 +226,9 @@
/* Define to 1 if you have the <errno.h> header file. */
#undef HAVE_ERRNO_H
/* Define to 1 if \u encodes properly */
#undef HAVE_ESCAPE_U
/* Define to 1 if you have the <execinfo.h> header file. */
#undef HAVE_EXECINFO_H
+186 -2
View File
@@ -1084,6 +1084,52 @@ typedef struct hak_t hak_t;
#define HAK_HAVE_BUILTIN_CLZLL
#endif
#if __has_builtin(__atomic_compare_exchange_n)
#define HAK_HAVE_ATOMIC_COMPARE_EXCHANGE_N
#endif
#if __has_builtin(__atomic_exchange_n)
#define HAK_HAVE_ATOMIC_EXCHANGE_N
#endif
#if __has_builtin(__atomic_fetch_add)
#define HAK_HAVE_ATOMIC_FETCH_ADD
#endif
#if __has_builtin(__atomic_add_fetch)
#define HAK_HAVE_ATOMIC_ADD_FETCH
#endif
#if __has_builtin(__atomic_fetch_and)
#define HAK_HAVE_ATOMIC_FETCH_AND
#endif
#if __has_builtin(__atomic_and_fetch)
#define HAK_HAVE_ATOMIC_AND_FETCH
#endif
#if __has_builtin(__atomic_fetch_or)
#define HAK_HAVE_ATOMIC_FETCH_OR
#endif
#if __has_builtin(__atomic_or_fetch)
#define HAK_HAVE_ATOMIC_OR_FETCH
#endif
#if __has_builtin(__atomic_fetch_sub)
#define HAK_HAVE_ATOMIC_FETCH_SUB
#endif
#if __has_builtin(__atomic_sub_fetch)
#define HAK_HAVE_ATOMIC_SUB_FETCH
#endif
#if __has_builtin(__atomic_fetch_xor)
#define HAK_HAVE_ATOMIC_FETCH_XOR
#endif
#if __has_builtin(__atomic_xor_fetch)
#define HAK_HAVE_ATOMIC_XOR_FETCH
#endif
#if __has_builtin(__atomic_load_n)
#define HAK_HAVE_ATOMIC_LOAD_N
#endif
#if __has_builtin(__atomic_store_n)
#define HAK_HAVE_ATOMIC_STORE_N
#endif
#if __has_builtin(__builtin_uadd_overflow)
#define HAK_HAVE_BUILTIN_UADD_OVERFLOW
#endif
@@ -1158,11 +1204,19 @@ typedef struct hak_t hak_t;
#endif
#elif defined(__GNUC__) && defined(__GNUC_MINOR__)
#if (__GNUC__ >= 4)
#define HAK_HAVE_SYNC_FETCH_AND_ADD
#define HAK_HAVE_SYNC_ADD_AND_FETCH
#define HAK_HAVE_SYNC_FETCH_AND_AND
#define HAK_HAVE_SYNC_AND_AND_FETCH
#define HAK_HAVE_SYNC_FETCH_AND_OR
#define HAK_HAVE_SYNC_OR_AND_FETCH
#define HAK_HAVE_SYNC_FETCH_AND_SUB
#define HAK_HAVE_SYNC_SUB_AND_FETCH
#define HAK_HAVE_SYNC_FETCH_AND_XOR
#define HAK_HAVE_SYNC_XOR_AND_FETCH
#define HAK_HAVE_SYNC_LOCK_TEST_AND_SET
#define HAK_HAVE_SYNC_LOCK_RELEASE
#define HAK_HAVE_SYNC_SYNCHRONIZE
#define HAK_HAVE_SYNC_BOOL_COMPARE_AND_SWAP
#define HAK_HAVE_SYNC_VAL_COMPARE_AND_SWAP
@@ -1194,6 +1248,19 @@ typedef struct hak_t hak_t;
#define HAK_HAVE_BUILTIN_SMULLL_OVERFLOW
#endif
#if (__GNUC__ >= 5) || (__GNUC__ == 4 && __GNUC_MINOR__ >= 7)
#define HAK_HAVE_ATOMIC_FETCH_ADD
#define HAK_HAVE_ATOMIC_ADD_FETCH
#define HAK_HAVE_ATOMIC_FETCH_AND
#define HAK_HAVE_ATOMIC_AND_FETCH
#define HAK_HAVE_ATOMIC_FETCH_OR
#define HAK_HAVE_ATOMIC_OR_FETCH
#define HAK_HAVE_ATOMIC_FETCH_SUB
#define HAK_HAVE_ATOMIC_SUB_FETCH
#define HAK_HAVE_ATOMIC_FETCH_XOR
#define HAK_HAVE_ATOMIC_XOR_FETCH
#endif
#if (__GNUC__ >= 5) || (__GNUC__ == 4 && __GNUC_MINOR__ >= 8)
/* 4.8.0 or later */
#define HAK_HAVE_BUILTIN_BSWAP16
@@ -1207,6 +1274,12 @@ typedef struct hak_t hak_t;
#endif
#if defined(__has_builtin)
# define HAK_HAS_BUILTIN(v) __has_builtin(v)
#else
# define HAK_HAS_BUILTIN(v) 0
#endif
#if defined(HAK_HAVE_BUILTIN_EXPECT)
# define HAK_LIKELY(x) (__builtin_expect(!!(x),1))
# define HAK_UNLIKELY(x) (__builtin_expect(!!(x),0))
@@ -1215,6 +1288,117 @@ typedef struct hak_t hak_t;
# define HAK_UNLIKELY(x) (x)
#endif
#if defined(HAK_HAVE_ATOMIC_EXCHANGE_N)
# define HAK_ATOMIC_EXCHANGE(ptr,val,mo) __atomic_exchange_n((ptr),(val),(mo))
#elif defined(HAK_HAVE_SYNC_LOCK_TEST_AND_SET)
# define HAK_ATOMIC_EXCHANGE(ptr,val,mo) __sync_lock_test_and_set((ptr),(val))
#endif
#if defined(HAK_HAVE_ATOMIC_FETCH_ADD)
# define HAK_ATOMIC_FETCH_ADD(ptr,val,mo) __atomic_fetch_add((ptr),(val),(mo))
#elif defined(HAK_HAVE_SYNC_FETCH_AND_ADD)
# define HAK_ATOMIC_FETCH_ADD(ptr,val,mo) __sync_fetch_and_add((ptr),(val))
#endif
#if defined(HAK_HAVE_ATOMIC_ADD_FETCH)
# define HAK_ATOMIC_ADD_FETCH(ptr,val,mo) __atomic_add_fetch((ptr),(val),(mo))
#elif defined(HAK_HAVE_SYNC_ADD_AND_FETCH)
# define HAK_ATOMIC_ADD_FETCH(ptr,val,mo) __sync_add_and_fetch((ptr),(val))
#endif
#if defined(HAK_HAVE_ATOMIC_FETCH_AND)
# define HAK_ATOMIC_FETCH_AND(ptr,val,mo) __atomic_fetch_and((ptr),(val),(mo))
#elif defined(HAK_HAVE_SYNC_FETCH_AND_AND)
# define HAK_ATOMIC_FETCH_AND(ptr,val,mo) __sync_fetch_and_and((ptr),(val))
#endif
#if defined(HAK_HAVE_ATOMIC_AND_FETCH)
# define HAK_ATOMIC_AND_FETCH(ptr,val,mo) __atomic_and_fetch((ptr),(val),(mo))
#elif defined(HAK_HAVE_SYNC_AND_AND_FETCH)
# define HAK_ATOMIC_AND_FETCH(ptr,val,mo) __sync_and_and_fetch((ptr),(val))
#endif
#if defined(HAK_HAVE_ATOMIC_FETCH_OR)
# define HAK_ATOMIC_FETCH_OR(ptr,val,mo) __atomic_fetch_or((ptr),(val),(mo))
#elif defined(HAK_HAVE_SYNC_FETCH_AND_OR)
# define HAK_ATOMIC_FETCH_OR(ptr,val,mo) __sync_fetch_and_or((ptr),(val))
#endif
#if defined(HAK_HAVE_ATOMIC_OR_FETCH)
# define HAK_ATOMIC_OR_FETCH(ptr,val,mo) __atomic_or_fetch((ptr),(val),(mo))
#elif defined(HAK_HAVE_SYNC_OR_AND_FETCH)
# define HAK_ATOMIC_OR_FETCH(ptr,val,mo) __sync_or_and_fetch((ptr),(val))
#endif
#if defined(HAK_HAVE_ATOMIC_FETCH_SUB)
# define HAK_ATOMIC_FETCH_SUB(ptr,val,mo) __atomic_fetch_sub((ptr),(val),(mo))
#elif defined(HAK_HAVE_SYNC_FETCH_AND_SUB)
# define HAK_ATOMIC_FETCH_SUB(ptr,val,mo) __sync_fetch_and_sub((ptr),(val))
#endif
#if defined(HAK_HAVE_ATOMIC_SUB_FETCH)
# define HAK_ATOMIC_SUB_FETCH(ptr,val,mo) __atomic_sub_fetch((ptr),(val),(mo))
#elif defined(HAK_HAVE_SYNC_SUB_AND_FETCH)
# define HAK_ATOMIC_SUB_FETCH(ptr,val,mo) __sync_sub_and_fetch((ptr),(val))
#endif
#if defined(HAK_HAVE_ATOMIC_FETCH_XOR)
# define HAK_ATOMIC_FETCH_XOR(ptr,val,mo) __atomic_fetch_xor((ptr),(val),(mo))
#elif defined(HAK_HAVE_SYNC_FETCH_AND_XOR)
# define HAK_ATOMIC_FETCH_XOR(ptr,val,mo) __sync_fetch_and_xor((ptr),(val))
#endif
#if defined(HAK_HAVE_ATOMIC_XOR_FETCH)
# define HAK_ATOMIC_XOR_FETCH(ptr,val,mo) __atomic_xor_fetch((ptr),(val),(mo))
#elif defined(HAK_HAVE_SYNC_XOR_AND_FETCH)
# define HAK_ATOMIC_XOR_FETCH(ptr,val,mo) __sync_xor_and_fetch((ptr),(val))
#endif
#if defined(HAK_HAVE_ATOMIC_LOAD_N)
# define HAK_ATOMIC_LOAD(ptr,mo) __atomic_load_n((ptr),(mo))
#elif defined(HAK_HAVE_SYNC_FETCH_AND_OR)
# define HAK_ATOMIC_LOAD(ptr,mo) __sync_fetch_and_or((ptr),0)
#endif
#if defined(HAK_HAVE_ATOMIC_STORE_N)
# define HAK_ATOMIC_STORE(ptr,val,mo) __atomic_store_n((ptr),(val),(mo))
#elif defined(HAK_HAVE_SYNC_LOCK_TEST_AND_SET) && defined(HAK_HAVE_SYNC_SYNCHRONIZE)
# define HAK_ATOMIC_STORE(ptr,val,mo) do { __sync_lock_test_and_set((ptr),(val)); __sync_synchronize(); } while(0)
#endif
#if defined(HAK_HAVE_ATOMIC_COMPARE_EXCHANGE_N)
# define HAK_ATOMIC_CAS_BOOL(ptr, expected_ptr, desired, memmod_succ, memmod_fail) \
__atomic_compare_exchange_n((ptr), (expected_ptr), (desired), 0, (memmod_succ), (memmod_fail))
# define HAK_ATOMIC_CAS_BOOL_YIELD_OLDVAL
#elif defined(HAK_HAVE_SYNC_BOOL_COMPARE_AND_SWAP)
# define HAK_ATOMIC_CAS_BOOL(ptr, expected_ptr, desired, memmod_succ, memmod_fail) \
__sync_bool_compare_and_swap((ptr), *(expected_ptr), (desired))
#endif
#if defined(__ATOMIC_RELAXED)
# define HAK_ATOMIC_RELAXED __ATOMIC_RELAXED
#else
# define HAK_ATOMIC_RELAXED 0
#endif
#if defined(__ATOMIC_ACQUIRE)
# define HAK_ATOMIC_ACQUIRE __ATOMIC_ACQUIRE
#else
# define HAK_ATOMIC_ACQUIRE 2
#endif
#if defined(__ATOMIC_RELEASE)
# define HAK_ATOMIC_RELEASE __ATOMIC_RELEASE
#else
# define HAK_ATOMIC_RELEASE 3
#endif
#if defined(__ATOMIC_ACQ_REL)
# define HAK_ATOMIC_ACQ_REL __ATOMIC_ACQ_REL
#else
# define HAK_ATOMIC_ACQ_REL 4
#endif
/* =========================================================================
* STATIC ASSERTION
* =========================================================================*/
-2
View File
@@ -157,8 +157,6 @@ struct hak_hnd_t
hak_hnd_t* next;
};
typedef struct hak_hndtab_t hak_hndtab_t;
/* ========================================================================= */
/* THE UNIFORM I/O CONTRACT */
/* ========================================================================= */
+12
View File
@@ -855,6 +855,7 @@ typedef enum hak_ctlblk_type_t hak_ctlblk_type_t;
struct hak_ctlblk_info_t
{
hak_ctlblk_type_t _type;
int in_catch; /* used for HAK_CTLBLK_TYPE_TRY only */
};
typedef struct hak_ctlblk_info_t hak_ctlblk_info_t;
@@ -2247,6 +2248,8 @@ hak_pfrc_t hak_pf_nqv (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
hak_pfrc_t hak_pf_nql (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
hak_pfrc_t hak_pf_nqk (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
hak_pfrc_t hak_pf_object_new (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
hak_pfrc_t hak_pf_process_current (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
hak_pfrc_t hak_pf_process_fork (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
hak_pfrc_t hak_pf_process_resume (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
@@ -2269,6 +2272,15 @@ hak_pfrc_t hak_pf_semaphore_group_add_semaphore (hak_t* hak, hak_mod_t* mod, hak
hak_pfrc_t hak_pf_semaphore_group_remove_semaphore (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
hak_pfrc_t hak_pf_semaphore_group_wait (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
/* the signal primitives live in prim.c but are registered by the sys module,
* which reaches them as sys.sig-getfd, sys.sig-get, sys.sig-set, sys.sig-catch
* and sys.sig-uncatch */
hak_pfrc_t hak_pf_system_get_sigfd (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
hak_pfrc_t hak_pf_system_get_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
hak_pfrc_t hak_pf_system_set_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
hak_pfrc_t hak_pf_system_catch_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
hak_pfrc_t hak_pf_system_uncatch_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
/* ========================================================================= */
/* std.c */
/* ========================================================================= */
+169 -31
View File
@@ -150,6 +150,8 @@ int hak_init (hak_t* hak, hak_mmgr_t* mmgr, const hak_vmprim_t* vmprim)
hak->option.dfl_symtab_size = HAK_DFL_SYMTAB_SIZE;
hak->option.dfl_sysdic_size = HAK_DFL_SYSDIC_SIZE;
hak->option.dfl_procstk_size = HAK_DFL_PROCSTK_SIZE;
hak->option.dfl_exstk_size = HAK_DFL_EXSTK_SIZE;
hak->option.dfl_clstk_size = HAK_DFL_CLSTK_SIZE;
#if defined(HAK_BUILD_DEBUG)
hak->option.karatsuba_cutoff = HAK_KARATSUBA_CUTOFF; /* this won't be used when NDEBUG is set */
#endif
@@ -367,9 +369,39 @@ void hak_fini (hak_t* hak)
hak->option.log_target_b = HAK_NULL;
}
/* destroy dynamically allocated options */
for (i = 0; i < HAK_COUNTOF(hak->option.mod); i++)
{
if (hak->option.mod[i].ptr) hak_freemem(hak, hak->option.mod[i].ptr);
if (hak->option.mod[i].ptr)
{
hak_freemem(hak, hak->option.mod[i].ptr);
hak->option.mod[i].ptr = HAK_NULL;
hak->option.mod[i].len = 0;
}
}
if (hak->option.modlibdirs_b)
{
hak_freemem(hak, hak->option.modlibdirs_b);
hak->option.modlibdirs_b = HAK_NULL;
}
if (hak->option.modlibdirs_u)
{
hak_freemem(hak, hak->option.modlibdirs_u);
hak->option.modlibdirs_u = HAK_NULL;
}
if (hak->option.incdirs_b)
{
hak_freemem(hak, hak->option.incdirs_b);
hak->option.incdirs_b = HAK_NULL;
}
if (hak->option.incdirs_u)
{
hak_freemem(hak, hak->option.incdirs_u);
hak->option.incdirs_u = HAK_NULL;
}
if (hak->inttostr.xbuf.ptr)
@@ -447,28 +479,74 @@ static int dup_str_opt (hak_t* hak, const hak_ooch_t* value, hak_oocs_t* tmp)
return 0;
}
/* Store a string option in both representations at once.
*
* The consumers of these options are byte oriented - dlopen() and fopen() -
* so the bch form is what gets used, and converting once here saves a
* conversion on every module load and every include attempt. The uch form is
* kept so getoption can answer in either encoding without allocating.
*
* Both conversions are done before either slot is replaced, so a failure
* leaves the previous value in place rather than half-updating it. */
static int set_dual_str_opt (hak_t* hak, const void* value, int value_is_bch, hak_bch_t** bp, hak_uch_t** up)
{
hak_bch_t* v_b;
hak_uch_t* v_u;
if (value_is_bch)
{
v_b = hak_dupbcstr(hak, (const hak_bch_t*)value, HAK_NULL);
if (HAK_UNLIKELY(!v_b)) return -1;
v_u = hak_dupbtoucstr(hak, (const hak_bch_t*)value, HAK_NULL);
if (HAK_UNLIKELY(!v_u))
{
hak_freemem(hak, v_b);
return -1;
}
}
else
{
v_u = hak_dupucstr(hak, (const hak_uch_t*)value, HAK_NULL);
if (HAK_UNLIKELY(!v_u)) return -1;
v_b = hak_duputobcstr(hak, (const hak_uch_t*)value, HAK_NULL);
if (HAK_UNLIKELY(!v_b))
{
hak_freemem(hak, v_u);
return -1;
}
}
if (*bp) hak_freemem(hak, *bp);
if (*up) hak_freemem(hak, *up);
*bp = v_b;
*up = v_u;
return 0;
}
int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
{
hak_cb_t* cb;
switch (id)
{
case HAK_TRAIT:
case HAK_OPT_TRAIT:
hak->option.trait = *(const hak_bitmask_t*)value;
#if defined(HAK_BUILD_DEBUG)
hak->option.karatsuba_cutoff = ((hak->option.trait & HAK_TRAIT_DEBUG_BIGINT)? HAK_KARATSUBA_CUTOFF_DEBUG: HAK_KARATSUBA_CUTOFF);
#endif
break;
case HAK_LOG_MASK:
case HAK_OPT_LOG_MASK:
hak->option.log_mask = *(const hak_bitmask_t*)value;
break;
case HAK_LOG_MAXCAPA:
case HAK_OPT_LOG_MAXCAPA:
hak->option.log_maxcapa = *(hak_oow_t*)value;
break;
case HAK_LOG_TARGET_BCSTR:
case HAK_OPT_LOG_TARGET_BCSTR:
{
hak_bch_t* v1;
hak_uch_t* v2;
@@ -488,7 +566,7 @@ int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
break;
}
case HAK_LOG_TARGET_UCSTR:
case HAK_OPT_LOG_TARGET_UCSTR:
{
hak_uch_t* v1;
hak_bch_t* v2;
@@ -508,7 +586,7 @@ int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
break;
}
case HAK_LOG_TARGET_BCS:
case HAK_OPT_LOG_TARGET_BCS:
{
hak_bch_t* v1;
hak_uch_t* v2;
@@ -529,7 +607,7 @@ int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
break;
}
case HAK_LOG_TARGET_UCS:
case HAK_OPT_LOG_TARGET_UCS:
{
hak_uch_t* v1;
hak_bch_t* v2;
@@ -550,7 +628,7 @@ int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
break;
}
case HAK_SYMTAB_SIZE:
case HAK_OPT_SYMTAB_SIZE:
{
hak_oow_t w;
@@ -561,7 +639,7 @@ int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
break;
}
case HAK_SYSDIC_SIZE:
case HAK_OPT_SYSDIC_SIZE:
{
hak_oow_t w;
@@ -572,7 +650,7 @@ int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
break;
}
case HAK_PROCSTK_SIZE:
case HAK_OPT_PROCSTK_SIZE:
{
hak_oow_t w;
@@ -583,26 +661,63 @@ int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
break;
}
case HAK_MOD_LIBDIRS:
case HAK_MOD_PREFIX:
case HAK_MOD_POSTFIX:
case HAK_OPT_EXSTK_SIZE:
{
hak_oow_t w;
w = *(hak_oow_t*)value;
if (w <= 0 || w > HAK_SMOOI_MAX) goto einval;
hak->option.dfl_exstk_size = *(hak_oow_t*)value;
break;
}
case HAK_OPT_CLSTK_SIZE:
{
hak_oow_t w;
w = *(hak_oow_t*)value;
if (w <= 0 || w > HAK_SMOOI_MAX) goto einval;
hak->option.dfl_clstk_size = *(hak_oow_t*)value;
break;
}
case HAK_OPT_MODLIBDIRS_BCSTR:
if (set_dual_str_opt(hak, value, 1, &hak->option.modlibdirs_b, &hak->option.modlibdirs_u) <= -1) return -1;
break;
case HAK_OPT_MODLIBDIRS_UCSTR:
if (set_dual_str_opt(hak, value, 0, &hak->option.modlibdirs_b, &hak->option.modlibdirs_u) <= -1) return -1;
break;
case HAK_OPT_MODPREFIX:
case HAK_OPT_MODPOSTFIX:
{
hak_oocs_t tmp;
int idx;
if (dup_str_opt(hak, (const hak_ooch_t*)value, &tmp) <= -1) return -1;
idx = id - HAK_MOD_LIBDIRS;
idx = id - HAK_OPT_MODPREFIX;
if (hak->option.mod[idx].ptr) hak_freemem(hak, hak->option.mod[idx].ptr);
hak->option.mod[idx] = tmp;
return 0;
}
case HAK_MOD_INCTX:
case HAK_OPT_MODINCTX:
hak->option.mod_inctx = *(void**)value;
break;
case HAK_OPT_INCDIRS_BCSTR:
if (set_dual_str_opt(hak, value, 1, &hak->option.incdirs_b, &hak->option.incdirs_u) <= -1) return -1;
break;
case HAK_OPT_INCDIRS_UCSTR:
if (set_dual_str_opt(hak, value, 0, &hak->option.incdirs_b, &hak->option.incdirs_u) <= -1) return -1;
break;
default:
goto einval;
}
@@ -623,57 +738,80 @@ int hak_getoption (hak_t* hak, hak_option_t id, void* value)
{
switch (id)
{
case HAK_TRAIT:
case HAK_OPT_TRAIT:
*(hak_bitmask_t*)value = hak->option.trait;
return 0;
case HAK_LOG_MASK:
case HAK_OPT_LOG_MASK:
*(hak_bitmask_t*)value = hak->option.log_mask;
return 0;
case HAK_LOG_MAXCAPA:
case HAK_OPT_LOG_MAXCAPA:
*(hak_oow_t*)value = hak->option.log_maxcapa;
return 0;
case HAK_LOG_TARGET_BCSTR:
case HAK_OPT_LOG_TARGET_BCSTR:
*(hak_bch_t**)value = hak->option.log_target_b;
return 0;
case HAK_LOG_TARGET_UCSTR:
case HAK_OPT_LOG_TARGET_UCSTR:
*(hak_uch_t**)value = hak->option.log_target_u;
return 0;
case HAK_LOG_TARGET_BCS:
case HAK_OPT_LOG_TARGET_BCS:
((hak_bcs_t*)value)->ptr = hak->option.log_target_b;
((hak_bcs_t*)value)->len = hak_count_bcstr(hak->option.log_target_b);
return 0;
case HAK_LOG_TARGET_UCS:
case HAK_OPT_LOG_TARGET_UCS:
((hak_ucs_t*)value)->ptr = hak->option.log_target_u;
((hak_ucs_t*)value)->len = hak_count_ucstr(hak->option.log_target_u);
return 0;
case HAK_SYMTAB_SIZE:
case HAK_OPT_SYMTAB_SIZE:
*(hak_oow_t*)value = hak->option.dfl_symtab_size;
return 0;
case HAK_SYSDIC_SIZE:
case HAK_OPT_SYSDIC_SIZE:
*(hak_oow_t*)value = hak->option.dfl_sysdic_size;
return 0;
case HAK_PROCSTK_SIZE:
case HAK_OPT_PROCSTK_SIZE:
*(hak_oow_t*)value = hak->option.dfl_procstk_size;
return 0;
case HAK_MOD_LIBDIRS:
case HAK_MOD_PREFIX:
case HAK_MOD_POSTFIX:
*(const hak_ooch_t**)value = hak->option.mod[id - HAK_MOD_LIBDIRS].ptr;
case HAK_OPT_EXSTK_SIZE:
*(hak_oow_t*)value = hak->option.dfl_exstk_size;
return 0;
case HAK_MOD_INCTX:
case HAK_OPT_CLSTK_SIZE:
*(hak_oow_t*)value = hak->option.dfl_clstk_size;
return 0;
case HAK_OPT_MODLIBDIRS_BCSTR:
*(const hak_bch_t**)value = hak->option.modlibdirs_b;
return 0;
case HAK_OPT_MODLIBDIRS_UCSTR:
*(const hak_uch_t**)value = hak->option.modlibdirs_u;
return 0;
case HAK_OPT_MODPREFIX:
case HAK_OPT_MODPOSTFIX:
*(const hak_ooch_t**)value = hak->option.mod[id - HAK_OPT_MODPREFIX].ptr;
return 0;
case HAK_OPT_MODINCTX:
*(void**)value = hak->option.mod_inctx;
return 0;
case HAK_OPT_INCDIRS_BCSTR:
*(const hak_bch_t**)value = hak->option.incdirs_b;
return 0;
case HAK_OPT_INCDIRS_UCSTR:
*(const hak_uch_t**)value = hak->option.incdirs_u;
return 0;
};
hak_seterrnum(hak, HAK_EINVAL);
+77 -27
View File
@@ -241,33 +241,50 @@ typedef hak_errbinf_t hak_errinf_t;
enum hak_option_t
{
HAK_TRAIT,
HAK_LOG_MASK,
HAK_LOG_MAXCAPA,
HAK_OPT_TRAIT,
HAK_OPT_LOG_MASK,
HAK_OPT_LOG_MAXCAPA,
HAK_LOG_TARGET_BCSTR,
HAK_LOG_TARGET_UCSTR,
HAK_LOG_TARGET_BCS,
HAK_LOG_TARGET_UCS,
HAK_OPT_LOG_TARGET_BCSTR,
HAK_OPT_LOG_TARGET_UCSTR,
HAK_OPT_LOG_TARGET_BCS,
HAK_OPT_LOG_TARGET_UCS,
#if defined(HAK_OOCH_IS_UCH)
# define HAK_LOG_TARGET HAK_LOG_TARGET_UCSTR
# define HAK_LOG_TARGET_OOCSTR HAK_LOG_TARGET_UCSTR
# define HAK_LOG_TARGET_OOCS HAK_LOG_TARGET_UCS
# define HAK_OPT_LOG_TARGET HAK_OPT_LOG_TARGET_UCSTR
# define HAK_OPT_LOG_TARGET_OOCSTR HAK_OPT_LOG_TARGET_UCSTR
# define HAK_OPT_LOG_TARGET_OOCS HAK_OPT_LOG_TARGET_UCS
#else
# define HAK_LOG_TARGET HAK_LOG_TARGET_BCSTR
# define HAK_LOG_TARGET_OOCSTR HAK_LOG_TARGET_BCSTR
# define HAK_LOG_TARGET_OOCS HAK_LOG_TARGET_BCS
# define HAK_OPT_LOG_TARGET HAK_OPT_LOG_TARGET_BCSTR
# define HAK_OPT_LOG_TARGET_OOCSTR HAK_OPT_LOG_TARGET_BCSTR
# define HAK_OPT_LOG_TARGET_OOCS HAK_OPT_LOG_TARGET_BCS
#endif
HAK_SYMTAB_SIZE, /* default system table size */
HAK_SYSDIC_SIZE, /* default system dictionary size */
HAK_PROCSTK_SIZE, /* default process stack size */
HAK_OPT_SYMTAB_SIZE, /* default system table size */
HAK_OPT_SYSDIC_SIZE, /* default system dictionary size */
HAK_OPT_PROCSTK_SIZE, /* default process stack size */
HAK_OPT_EXSTK_SIZE, /* default exception stack size */
HAK_OPT_CLSTK_SIZE, /* default class stack size */
HAK_MOD_LIBDIRS,
HAK_MOD_PREFIX,
HAK_MOD_POSTFIX,
HAK_OPT_MODLIBDIRS_BCSTR,
HAK_OPT_MODLIBDIRS_UCSTR,
#if defined(HAK_OOCH_IS_UCH)
# define HAK_OPT_MODLIBDIRS HAK_OPT_MODLIBDIRS_UCSTR
#else
# define HAK_OPT_MODLIBDIRS HAK_OPT_MODLIBDIRS_BCSTR
#endif
HAK_MOD_INCTX
HAK_OPT_MODPREFIX,
HAK_OPT_MODPOSTFIX,
HAK_OPT_MODINCTX,
HAK_OPT_INCDIRS_BCSTR,
HAK_OPT_INCDIRS_UCSTR
#if defined(HAK_OOCH_IS_UCH)
# define HAK_OPT_INCDIRS HAK_OPT_INCDIRS_UCSTR
#else
# define HAK_OPT_INCDIRS HAK_OPT_INCDIRS_BCSTR
#endif
};
typedef enum hak_option_t hak_option_t;
@@ -277,12 +294,28 @@ typedef enum hak_option_t hak_option_t;
enum hak_option_dflval_t
{
HAK_DFL_LOG_MAXCAPA = HAK_LOG_CAPA_ALIGN * 16,
HAK_DFL_SYMTAB_SIZE = 5000,
HAK_DFL_SYSDIC_SIZE = 5000,
HAK_DFL_PROCSTK_SIZE = 5000
#if defined(HAK_SMALL_MEMORY_FOOTPRINT)
HAK_DFL_SYMTAB_SIZE = 1024,
HAK_DFL_SYSDIC_SIZE = 1024
HAK_DFL_PROCSTK_SIZE = 1024, /* -> fstk 1024, the FSTK floor */
HAK_DFL_EXSTK_SIZE = 256, /* 4 slots/level x 59 levels = 236 */
HAK_DFL_CLSTK_SIZE = 16, /* = HAK_MIN_CLSTK_SIZE */
#else
HAK_DFL_SYMTAB_SIZE = 8192,
HAK_DFL_SYSDIC_SIZE = 8192,
HAK_DFL_PROCSTK_SIZE = 8192,
HAK_DFL_EXSTK_SIZE = 2048,
HAK_DFL_CLSTK_SIZE = 64
#endif
};
typedef enum hak_option_dflval_t hak_option_dflval_t;
#define HAK_MIN_PROCSTK_SIZE (192)
#define HAK_MIN_EXSTK_SIZE (32) /* 4 slots/try -> 8 nested trys */
#define HAK_MIN_CLSTK_SIZE (16) /* 1 slot/class -> 16 nested classes */
#define HAK_MIN_FSTK_SIZE (1024)
enum hak_trait_t
{
#if defined(HAK_BUILD_DEBUG)
@@ -1764,9 +1797,22 @@ struct hak_t
hak_oow_t dfl_symtab_size;
hak_oow_t dfl_sysdic_size;
hak_oow_t dfl_procstk_size;
hak_oow_t dfl_exstk_size;
hak_oow_t dfl_clstk_size;
void* mod_inctx;
hak_oocs_t mod[3];
/* both representations are kept for the two options whose consumers
* are byte oriented: dl_open() feeds dlopen() and open_cci_stream()
* feeds fopen(), so the bch form is what actually gets used, while the
* uch form serves getoption and %js. converting once at set time beats
* converting on every module load and every include attempt. */
hak_bch_t* modlibdirs_b;
hak_uch_t* modlibdirs_u;
hak_bch_t* incdirs_b;
hak_uch_t* incdirs_u;
/* prefix and postfix only - indexed by (id - HAK_OPT_MODPREFIX) */
hak_oocs_t mod[2];
#if defined(HAK_BUILD_DEBUG)
/* set automatically when trait is set */
@@ -1921,11 +1967,11 @@ struct hak_t
hak_oob_t* active_code;
hak_ooi_t sp;
hak_ooi_t ip;
hak_uint8_t abort_req;
volatile hak_int8_t abort_req;
hak_uint8_t no_proc_switch; /* process switching disabled */
hak_uint8_t proc_switched; /* TODO: this is temporary. implement something else to skip immediate context switching */
hak_uint8_t rcv_tick; /* whether to receive tick or not */
hak_uint32_t tick; /* instance specific tick */
volatile hak_uint32_t tick; /* instance specific tick */
hak_uint32_t last_tick; /* last instance specific tick this instance acted on */
hak_uint32_t last_gtick; /* last global tick this instance acted on */
@@ -3549,7 +3595,11 @@ HAK_EXPORT void hak_assertfailed (
/* =========================================================================
* HELPERS
* ========================================================================= */
HAK_EXPORT void hak_start_ticker (
/**
* The hak_start_ticker() starts the ticker for process switching.
* It returns 1 on success, 0 if already started, -1 upon failure.
*/
HAK_EXPORT int hak_start_ticker (
void
);
+2 -2
View File
@@ -952,7 +952,7 @@ hak_json_t* hak_json_open (hak_mmgr_t* mmgr, hak_oow_t xtnsize, hak_json_prim_t*
/* the dummy hak is used for this json to perform primitive operations
* such as getting system time or logging. so the heap size doesn't
* need to be changed from the tiny value set above. */
hak_setoption(json->dummy_hak, HAK_LOG_MASK, &json->cfg.logmask);
hak_setoption(json->dummy_hak, HAK_OPT_LOG_MASK, &json->cfg.logmask);
hak_setcmgr(json->dummy_hak, json->cmgr);
@@ -987,7 +987,7 @@ int hak_json_setoption (hak_json_t* json, hak_json_option_t id, const void* valu
* existing hak instances inside worker threads won't get
* affected. new hak instances to be created later
* is supposed to use the new value */
hak_setoption(json->dummy_hak, HAK_LOG_MASK, value);
hak_setoption(json->dummy_hak, HAK_OPT_LOG_MASK, value);
}
return 0;
}
+4 -3
View File
@@ -470,6 +470,10 @@ hak_oop_t hak_makestringwithuchars (hak_t* hak, const hak_uch_t* ptr, hak_oow_t
hak_oop_t hak_makestringwithbchars (hak_t* hak, const hak_bch_t* ptr, hak_oow_t len)
{
#if defined(HAK_OOCH_IS_UCH)
hak_oow_t xlen;
hak_ooch_t* xptr;
#endif
/* you must provide the payload when calling this variant. it can't figure out
* the actual number of hak_ooch_t characters */
if (!ptr)
@@ -480,9 +484,6 @@ hak_oop_t hak_makestringwithbchars (hak_t* hak, const hak_bch_t* ptr, hak_oow_t
}
#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))
{
+17 -41
View File
@@ -1220,7 +1220,7 @@ static hak_pfrc_t pf_va_get (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
}
static hak_pfrc_t pf_object_new (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
hak_pfrc_t hak_pf_object_new (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
{
hak_oop_t obj;
hak_oop_t _class;
@@ -1256,7 +1256,7 @@ static hak_pfrc_t pf_object_new (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
/* ------------------------------------------------------------------------- */
static hak_pfrc_t pf_system_get_sigfd (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
hak_pfrc_t hak_pf_system_get_sigfd (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
{
hak_ooi_t fd;
hak_hnd_t* hnd;
@@ -1264,7 +1264,7 @@ static hak_pfrc_t pf_system_get_sigfd (hak_t* hak, hak_mod_t* mod, hak_ooi_t nar
fd = hak->vmprim.vm_getsigfd(hak);
/* hand back a system handle id rather than the descriptor itself, so that
* the result can be given to sem-signal-on-input - which resolves handle
* the result can be given to core.sem-signal-on-input - which resolves handle
* ids, not descriptors. wrapped HAK_HND_OPEN_KEEPOPEN because the VM owns
* this descriptor and manages its blocking mode; the table must never
* close it. wrapfd_once() keeps the id stable across calls. */
@@ -1275,7 +1275,7 @@ static hak_pfrc_t pf_system_get_sigfd (hak_t* hak, hak_mod_t* mod, hak_ooi_t nar
return HAK_PF_SUCCESS;
}
static hak_pfrc_t pf_system_get_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
hak_pfrc_t hak_pf_system_get_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
{
hak_uint8_t sig;
int n;
@@ -1289,12 +1289,12 @@ static hak_pfrc_t pf_system_get_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs
return HAK_PF_SUCCESS;
}
/* (system-catch-sig signo) - route an operating system signal into the
* signal descriptor, where hak code can wait for
* it with sem-signal-on-input
* (system-uncatch-sig signo) - release it again
/* (sys.sig-catch signo) - route an operating system signal into the signal
* descriptor, where hak code can wait for it with
* core.sem-signal-on-input
* (sys.sig-uncatch signo) - release it again
*
* Note the difference from system-set-sig, which does not touch the operating
* Note the difference from sys.sig-set, which does not touch the operating
* system at all: that one injects a number into the descriptor directly, as a
* way for hak code to post a synthetic signal to itself.
*/
@@ -1323,17 +1323,17 @@ static hak_pfrc_t __system_catch_sig (hak_t* hak, hak_ooi_t nargs, int enable)
return HAK_PF_SUCCESS;
}
static hak_pfrc_t pf_system_catch_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
hak_pfrc_t hak_pf_system_catch_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
{
return __system_catch_sig(hak, nargs, 1);
}
static hak_pfrc_t pf_system_uncatch_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
hak_pfrc_t hak_pf_system_uncatch_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
{
return __system_catch_sig(hak, nargs, 0);
}
static hak_pfrc_t pf_system_set_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
hak_pfrc_t hak_pf_system_set_sig (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
{
hak_oop_t tmp;
hak_uint8_t sig;
@@ -1366,11 +1366,10 @@ static pf_t builtin_prims[] =
{ 1, HAK_TYPE_MAX(hak_oow_t), pf_scanf, 5, { 's','c','a','n','f' } },
{ 1, HAK_TYPE_MAX(hak_oow_t), pf_sprintf, 7, { 's','p','r','i','n','t','f' } },
{ 0, 0, pf_system_get_sigfd, 16, { 's','y','s','t','e','m','-','g','e','t','-','s','i','g','f','d' } },
{ 0, 0, pf_system_get_sig, 14, { 's','y','s','t','e','m','-','g','e','t','-','s','i','g' } },
{ 1, 1, pf_system_set_sig, 14, { 's','y','s','t','e','m','-','s','e','t','-','s','i','g' } },
{ 1, 1, pf_system_catch_sig, 16, { 's','y','s','t','e','m','-','c','a','t','c','h','-','s','i','g' } },
{ 1, 1, pf_system_uncatch_sig, 18, { 's','y','s','t','e','m','-','u','n','c','a','t','c','h','-','s','i','g' } },
/* the signal primitives are registered by the sys module instead - see
* pfinfos[] in mod/sys.c. they are reached as sys.sig-getfd, sys.sig-get,
* sys.sig-set, sys.sig-catch and sys.sig-uncatch. the implementations stay
* here and are declared in lib/hak-prv.h. */
{ 0, 0, pf_gc, 2, { 'g','c' } },
@@ -1435,30 +1434,7 @@ static pf_t builtin_prims[] =
{ 0, 0, pf_va_context, 10, { 'v','a','-','c','o','n','t','e','x','t' } },
{ 0, 1, pf_va_count, 8, { 'v','a','-','c','o','u','n','t' } },
{ 1, 2, pf_va_get, 6, { 'v','a','-','g','e','t' } },
{ 1, 2, pf_object_new, 10, { 'o','b','j','e','c','t','-','n','e','w' } },
{ 0, 0, hak_pf_process_current, 15, { 'c','u','r','r','e','n','t','-','p','r','o','c','e','s','s'} },
{ 1, HAK_TYPE_MAX(hak_oow_t), hak_pf_process_fork, 4, { 'f','o','r','k'} },
{ 1, 1, hak_pf_process_resume, 6, { 'r','e','s','u','m','e' } },
{ 0, 1, hak_pf_process_suspend, 7, { 's','u','s','p','e','n','d' } },
{ 0, 1, hak_pf_process_terminate, 9, { 't','e','r','m','i','n','a','t','e' } },
{ 0, 0, hak_pf_process_terminate_all, 13, { 't','e','r','m','i','n','a','t','e','-','a','l','l' } },
{ 0, 0, hak_pf_process_yield, 5, { 'y','i','e','l','d'} },
{ 0, 0, hak_pf_semaphore_new, 7, { 's','e','m','-','n','e','w'} },
{ 1, 1, hak_pf_semaphore_wait, 8, { 's','e','m','-','w','a','i','t'} },
{ 1, 3, hak_pf_semaphore_signal, 10, { 's','e','m','-','s','i','g','n','a','l'} },
{ 2, 2, hak_pf_semaphore_signal_on_input, 19, { 's','e','m','-','s','i','g','n','a','l','-','o','n','-','i','n','p','u','t'} },
{ 2, 2, hak_pf_semaphore_signal_on_output, 20, { 's','e','m','-','s','i','g','n','a','l','-','o','n','-','o','u','t','p','u','t'} },
{ 1, 1, hak_pf_semaphore_unsignal, 12, { 's','e','m','-','u','n','s','i','g','n','a','l'} },
{ 0, 0, hak_pf_semaphore_group_new, 9, { 's','e','m','g','r','-','n','e','w'} },
{ 1, 2, hak_pf_semaphore_group_add_semaphore, 9, { 's','e','m','g','r','-','a','d','d'} },
{ 1, 2, hak_pf_semaphore_group_remove_semaphore, 12, { 's','e','m','g','r','-','r','e','m','o','v','e'} },
{ 1, 1, hak_pf_semaphore_group_wait, 10, { 's','e','m','g','r','-','w','a','i','t'} }
{ 1, 2, pf_va_get, 6, { 'v','a','-','g','e','t' } }
};
int hak_addbuiltinprims (hak_t* hak)
+2 -2
View File
@@ -300,7 +300,7 @@ static HAK_INLINE int is_delim_char (hak_ooci_t c)
return c == '(' || c == ')' || c == '[' || c == ']' || c == '{' || c == '}' ||
c == '|' || c == ',' || c == '.' || c == ':' || c == ';' ||
/* the first characters of tokens in delim_token_tab up to this point */
#if defined(HAK_OOCH_IS_UCH) && defined(HAK_LANG_ENABLE_WIDE_DELIM)
#if defined(HAK_OOCH_IS_UCH) && defined(HAK_LANG_ENABLE_WIDE_DELIM) && defined(HAVE_ESCAPE_U)
c == L'\u201C' || c == L'\u201D' || /* “ ” */
c == L'\u2018' || c == L'\u2019' || /* */
#endif
@@ -2665,7 +2665,7 @@ static int flx_start (hak_t* hak, hak_ooci_t c)
FEED_CONTINUE(hak, HAK_FLX_QUOTED_TOKEN); /* discard the quote itself. move on the the QUOTED_TOKEN state */
goto consumed;
#if defined(HAK_OOCH_IS_UCH) && defined(HAK_LANG_ENABLE_WIDE_DELIM)
#if defined(HAK_OOCH_IS_UCH) && defined(HAK_LANG_ENABLE_WIDE_DELIM) && defined(HAVE_ESCAPE_U)
case L'\u201C': /* “ ” */
init_flx_qt(FLX_QT(hak), HAK_TOK_STRLIT, HAK_SYNERR_STRLIT, L'\u201D', '\\', 0, HAK_TYPE_MAX(hak_oow_t), 0);
FEED_CONTINUE(hak, HAK_FLX_QUOTED_TOKEN); /* discard the quote itself. move on the the QUOTED_TOKEN state */
+346 -106
View File
@@ -38,6 +38,15 @@
# define USE_THREAD
#endif
/* BeOS and Haiku accept ITIMER_VIRTUAL, count it down, and never raise
* SIGVTALRM. setitimer() reports success, so the -1 fallback in start_ticker()
* cannot catch it and the wall-clock timer has to be chosen up front. Stated
* in the negative so an unknown platform keeps preferring the cpu-time timer,
* which is what every other system here implements correctly. */
#if defined(__BEOS__) || defined(__HAIKU__)
# define ITIMER_VIRTUAL_NOT_WORKING
#endif
#if defined(__BORLANDC__) && defined(__DOS__) && defined(_WIN32) && defined(__DPMI32__)
/* bcc32 with powerpack seems to define _WIN32 in DPMI32 mode */
# undef _WIN32
@@ -212,7 +221,26 @@
# include <sched.h>
# endif
# if defined(HAVE_SYS_DEVPOLL_H)
/* define FORCE_USE_SELECT or FORCE_USE_POLL to test those backends on a
* platform that would otherwise pick a better multiplexer. they must come
* first in this chain so the auto-detection below is skipped entirely -
* otherwise USE_EPOLL and USE_SELECT both end up defined and the XPOLLXXX
* values get redefined. */
# if defined(FORCE_USE_POLL)
# include <poll.h>
# define USE_POLL
# define XPOLLIN POLLIN
# define XPOLLOUT POLLOUT
# define XPOLLERR POLLERR
# define XPOLLHUP POLLHUP
# elif defined(FORCE_USE_SELECT)
# define USE_SELECT
/* fake XPOLLXXX values */
# define XPOLLIN (1 << 0)
# define XPOLLOUT (1 << 1)
# define XPOLLERR (1 << 2)
# define XPOLLHUP (1 << 3)
# elif defined(HAVE_SYS_DEVPOLL_H)
/* solaris */
# include <sys/devpoll.h>
# define USE_DEVPOLL
@@ -328,7 +356,7 @@
* about async-signal-safety - the spinlock is built out of atomics and is safe
* by that measure - but about reentrancy: a signal delivered to the thread
* that already holds the lock would spin, or block, on a lock that thread can
* no longer reach the end of. post_sig_to_all_haks() therefore walk the chain without it.
* no longer reach the end of. post_sig_to_all_haks() therefore walks the chain without it.
* -------------------------------------------------------------------------- */
#if defined(USE_THREAD)
@@ -448,6 +476,11 @@ struct xtn_t
struct pollfd* ptr;
hak_oow_t capa;
hak_oow_t len;
/* bumped on every add and delete. poll() works on a copy of ptr[]
* taken before it blocks, so a descriptor unregistered during the
* call cannot be withdrawn from it. this lets the io thread notice
* that the set changed underneath a wait and discard its results. */
hak_oow_t epoch;
#if defined(USE_THREAD)
pthread_mutex_t pmtx;
#endif
@@ -460,6 +493,10 @@ struct xtn_t
fd_set rfds;
fd_set wfds;
int maxfd;
/* see the epoch field in the USE_POLL registry above - select()
* works on a copy of rfds/wfds in the same way and needs the
* same protection against a descriptor unregistered mid-call. */
hak_oow_t epoch;
#if defined(USE_THREAD)
pthread_mutex_t smtx;
#endif
@@ -1510,6 +1547,32 @@ static void vm_gettime (hak_t* hak, hak_ntime_t* now)
* IO MULTIPLEXING
* ----------------------------------------------------------------- */
#if defined(USE_THREAD) && (defined(USE_POLL) || defined(USE_SELECT))
/* Kick the io thread out of poll()/select().
*
* these two backends wait on a snapshot of the registry, so a descriptor
* registered or unregistered by the vm while the thread is blocked does not
* take effect until the current wait expires - up to the 10 second timeout in
* iothr_main(). The vm would sit there waiting for input on a descriptor the
* multiplexer is not even watching yet. The kernel-object backends (devpoll,
* kqueue, epoll) need none of this because the registration itself lands in
* the object the thread is blocked on.
*
* iothr.p[0] is registered for input, so one byte here makes the wait return
* at once and the next round re-snapshots. Anything other than 'Q' is drained
* and ignored by the dispatch loop in vm_muxwait().
*
* called from the vm thread with no registry lock held: the pipe is
* non-blocking, and a full pipe (EAGAIN) already means a wake is pending. */
static void wake_iothr (hak_t* hak)
{
xtn_t* xtn = GET_XTN(hak);
if (xtn->iothr.up && !xtn->iothr.abort) write(xtn->iothr.p[1], "W", 1);
}
#else
# define wake_iothr(hak) ((void)0)
#endif
static int _add_poll_fd (hak_t* hak, int fd, int event_mask)
{
#if defined(USE_DEVPOLL)
@@ -1666,8 +1729,10 @@ static int _add_poll_fd (hak_t* hak, int fd, int event_mask)
xtn->ev.reg.ptr[xtn->ev.reg.len].events = event_mask;
xtn->ev.reg.ptr[xtn->ev.reg.len].revents = 0;
xtn->ev.reg.len++;
xtn->ev.reg.epoch++;
MUTEX_UNLOCK(&xtn->ev.reg.pmtx);
wake_iothr(hak);
return 0;
#elif defined(USE_SELECT)
@@ -1684,8 +1749,10 @@ static int _add_poll_fd (hak_t* hak, int fd, int event_mask)
FD_SET (fd, &xtn->ev.reg.wfds);
if (fd > xtn->ev.reg.maxfd) xtn->ev.reg.maxfd = fd;
}
xtn->ev.reg.epoch++;
MUTEX_UNLOCK(&xtn->ev.reg.smtx);
wake_iothr(hak);
return 0;
#else
@@ -1785,7 +1852,15 @@ static int _del_poll_fd (hak_t* hak, int fd)
{
xtn->ev.reg.len--;
HAK_MEMMOVE(&xtn->ev.reg.ptr[i], &xtn->ev.reg.ptr[i+1], (xtn->ev.reg.len - i) * HAK_SIZEOF(*xtn->ev.reg.ptr));
xtn->ev.reg.epoch++;
MUTEX_UNLOCK(&xtn->ev.reg.pmtx);
/* wake on delete too, not just on add. the epoch bump above
* already stops a stale result from being dispatched, but until
* the thread re-snapshots it keeps waiting on a descriptor the vm
* has dropped - and the pending epoch mismatch discards the next
* batch whole, however genuine the rest of it is. */
wake_iothr(hak);
return 0;
}
}
@@ -1811,8 +1886,10 @@ static int _del_poll_fd (hak_t* hak, int fd)
}
xtn->ev.reg.maxfd = i;
}
xtn->ev.reg.epoch++;
MUTEX_UNLOCK(&xtn->ev.reg.smtx);
wake_iothr(hak);
return 0;
#else
@@ -1839,7 +1916,7 @@ static int _mod_poll_fd (hak_t* hak, int fd, int event_mask)
#elif defined(USE_KQUEUE)
xtn_t* xtn = GET_XTN(hak);
hak_oow_t rindex, roffset;
int rv, newrv = 0;
int rv, newrv;
struct kevent ev;
rindex = (hak_oow_t)fd / (HAK_BITSOF(hak_oow_t) >> 1);
@@ -1853,6 +1930,7 @@ static int _mod_poll_fd (hak_t* hak, int fd, int event_mask)
};
rv = HAK_GETBITS(hak_oow_t, xtn->ev.reg.ptr[rindex], roffset, 2);
newrv = rv; /* start from what is registered; each branch below applies its own diff */
if (rv & 1)
{
@@ -1960,12 +2038,18 @@ kqueue_syserr:
{
if (xtn->ev.reg.ptr[i].fd == fd)
{
HAK_MEMMOVE(&xtn->ev.reg.ptr[i], &xtn->ev.reg.ptr[i+1], (xtn->ev.reg.len - i - 1) * HAK_SIZEOF(*xtn->ev.reg.ptr));
xtn->ev.reg.ptr[i].fd = fd;
/* modify in place. shifting the tail down the way a delete does
* would drop the entry at i+1 - it lands on i and is overwritten
* right after - and leave a stale duplicate in the last slot,
* since len does not change. */
xtn->ev.reg.ptr[i].events = event_mask;
xtn->ev.reg.ptr[i].revents = 0;
/* the direction changed, so a result computed from the old mask
* must not be dispatched. see the epoch check in iothr_main(). */
xtn->ev.reg.epoch++;
MUTEX_UNLOCK(&xtn->ev.reg.pmtx);
wake_iothr(hak);
return 0;
}
}
@@ -1992,7 +2076,10 @@ kqueue_syserr:
else
FD_CLR(fd, &xtn->ev.reg.wfds);
xtn->ev.reg.epoch++;
MUTEX_UNLOCK(&xtn->ev.reg.smtx);
wake_iothr(hak);
return 0;
#else
@@ -2003,6 +2090,24 @@ kqueue_syserr:
}
#if defined(USE_THREAD)
#if defined(USE_KQUEUE)
/* kqueue reports one filter per event rather than a mask, so it has no
* MUXEVT_MASK - the entry is kept or dropped whole. */
# define MUXEVT_FD(e) ((int)(e).ident)
#elif defined(USE_DEVPOLL) || defined(USE_POLL)
# define MUXEVT_FD(e) ((e).fd)
# define MUXEVT_MASK(e) ((e).revents)
#elif defined(USE_EPOLL)
# define MUXEVT_FD(e) ((e).data.fd)
# define MUXEVT_MASK(e) ((e).events)
#elif defined(USE_SELECT)
# define MUXEVT_FD(e) ((e).fd)
# define MUXEVT_MASK(e) ((e).events)
#else
# error UNSUPPORTED
#endif
/* Drop multiplexer events already sitting in the buffer for this descriptor.
*
* iothr_main() reads events straight into xtn->ev.buf and publishes ev.len;
@@ -2018,22 +2123,36 @@ kqueue_syserr:
* caches ev.len and would walk entries this function compacts away. Nothing
* does today - signalling a semaphore only makes a process runnable, it does
* not run hak code - but the loop has no defence if that ever changes. */
static void purge_muxevts (hak_t* hak, int fd)
static void purge_muxevts (hak_t* hak, int fd, int keep_mask)
{
xtn_t* xtn = GET_XTN(hak);
hak_oow_t i, j;
#if defined(USE_KQUEUE)
int dir_mask;
#else
int drop = (XPOLLIN | XPOLLOUT) & ~keep_mask;
#endif
MUTEX_LOCK(&xtn->ev.mtx);
for (i = 0, j = 0; i < xtn->ev.len; i++)
{
#if defined(USE_DEVPOLL) || defined(USE_POLL) || defined(USE_SELECT)
if (xtn->ev.buf[i].fd == fd) continue;
#elif defined(USE_KQUEUE)
if ((int)xtn->ev.buf[i].ident == fd) continue;
#elif defined(USE_EPOLL)
if (xtn->ev.buf[i].data.fd == fd) continue;
if (MUXEVT_FD(xtn->ev.buf[i]) == fd)
{
if (!keep_mask) continue; /* nothing registered survives */
#if defined(USE_KQUEUE)
dir_mask = 0;
/* it's "if .. else if" because kqueue filter is either READ or WRITE.
* the flags field which can set with EV_EOF or EV_ERROR is not used here */
if (xtn->ev.buf[i].filter == EVFILT_READ) dir_mask |= XPOLLIN;
else if (xtn->ev.buf[i].filter == EVFILT_WRITE) dir_mask |= XPOLLOUT;
if (!(dir_mask & keep_mask)) continue;
#else
MUXEVT_MASK(xtn->ev.buf[i]) &= ~drop;
if (!(MUXEVT_MASK(xtn->ev.buf[i]) & (XPOLLIN | XPOLLOUT | XPOLLERR | XPOLLHUP))) continue;
#endif
}
if (j != i) xtn->ev.buf[j] = xtn->ev.buf[i];
j++;
}
@@ -2069,6 +2188,7 @@ static int vm_muxadd (hak_t* hak, hak_ooi_t io_handle, hak_ooi_t mask)
static int vm_muxmod (hak_t* hak, hak_ooi_t io_handle, hak_ooi_t mask)
{
int event_mask;
int n;
event_mask = 0;
if (mask & HAK_SEMAPHORE_IO_MASK_INPUT) event_mask |= XPOLLIN;
@@ -2081,16 +2201,13 @@ static int vm_muxmod (hak_t* hak, hak_ooi_t io_handle, hak_ooi_t mask)
return -1;
}
return _mod_poll_fd(hak, io_handle, event_mask);
n = _mod_poll_fd(hak, io_handle, event_mask);
/* [NOTE]
* this may need the same mux event purge as vm_muxdel() for accuracy.
* if a file descriptor is removed for one direction while another direction
* is still watched, this function is invoked. in that case, xtn->evt.buf
* may have some stale events and they can raise spurious signals.
*
* TODO: per-direction event purge
*/
#if defined(USE_THREAD)
purge_muxevts(hak, (int)io_handle, event_mask);
#endif
return n;
}
static int vm_muxdel (hak_t* hak, hak_ooi_t io_handle)
@@ -2105,7 +2222,7 @@ static int vm_muxdel (hak_t* hak, hak_ooi_t io_handle)
* delete does not make a buffered event any less stale.
* delete_sem_from_sem_io_tuple() carries on regardless when force is set.
*/
purge_muxevts(hak, (int)io_handle);
purge_muxevts(hak, (int)io_handle, 0);
#endif
return n;
}
@@ -2128,11 +2245,13 @@ static void* iothr_main (void* arg)
struct timespec ts;
#elif defined(USE_POLL)
hak_oow_t nfds;
hak_oow_t epoch;
#elif defined(USE_SELECT)
struct timeval tv;
fd_set rfds;
fd_set wfds;
int maxfd;
hak_oow_t epoch;
#endif
poll_for_event:
@@ -2154,8 +2273,23 @@ static void* iothr_main (void* arg)
MUTEX_LOCK(&xtn->ev.reg.pmtx);
HAK_MEMCPY(xtn->ev.buf, xtn->ev.reg.ptr, xtn->ev.reg.len * HAK_SIZEOF(*xtn->ev.buf));
nfds = xtn->ev.reg.len;
epoch = xtn->ev.reg.epoch;
MUTEX_UNLOCK(&xtn->ev.reg.pmtx);
n = poll(xtn->ev.buf, nfds, 10000);
/* poll() worked on the copy taken above, so unregistering a
* descriptor while it was blocked could not withdraw it from the
* call. If the registry changed meanwhile, a returned descriptor
* may no longer be the one that was registered - the number can
* have been closed and handed to a different pipe already - and
* dispatching it would signal a semaphore for something that was
* never ready. Drop the whole batch instead: poll() is level
* triggered, so whatever is genuinely ready is reported again by
* the next call and nothing is lost. */
MUTEX_LOCK(&xtn->ev.reg.pmtx);
if (epoch != xtn->ev.reg.epoch) n = 0; /* to report nothing */
MUTEX_UNLOCK(&xtn->ev.reg.pmtx);
if (n > 0)
{
/* compact the return buffer as poll() doesn't */
@@ -2177,8 +2311,17 @@ static void* iothr_main (void* arg)
maxfd = xtn->ev.reg.maxfd;
HAK_MEMCPY(&rfds, &xtn->ev.reg.rfds, HAK_SIZEOF(rfds));
HAK_MEMCPY(&wfds, &xtn->ev.reg.wfds, HAK_SIZEOF(wfds));
epoch = xtn->ev.reg.epoch;
MUTEX_UNLOCK(&xtn->ev.reg.smtx);
n = select(maxfd + 1, &rfds, &wfds, HAK_NULL, &tv);
/* the registry changed while select() held a copy of it - the
* result may name a descriptor that is no longer the one that was
* registered. drop the batch; select() is level triggered, so
* anything genuinely ready comes back on the next call. */
MUTEX_LOCK(&xtn->ev.reg.smtx);
if (epoch != xtn->ev.reg.epoch) n = 0; /* to report nothing */
MUTEX_UNLOCK(&xtn->ev.reg.smtx);
if (n > 0)
{
int fd, count = 0;
@@ -2312,20 +2455,7 @@ static void vm_muxwait (hak_t* hak, const hak_ntime_t* dur, hak_vmprim_muxwait_c
{
--n;
#if defined(USE_DEVPOLL)
if (xtn->ev.buf[n].fd == xtn->iothr.p[0])
#elif defined(USE_KQUEUE)
if (xtn->ev.buf[n].ident == xtn->iothr.p[0])
#elif defined(USE_EPOLL)
/*if (xtn->ev.buf[n].data.ptr == (void*)HAK_TYPE_MAX(hak_oow_t))*/
if (xtn->ev.buf[n].data.fd == xtn->iothr.p[0])
#elif defined(USE_POLL)
if (xtn->ev.buf[n].fd == xtn->iothr.p[0])
#elif defined(USE_SELECT)
if (xtn->ev.buf[n].fd == xtn->iothr.p[0])
#else
# error UNSUPPORTED
#endif
if (MUXEVT_FD(xtn->ev.buf[n]) == xtn->iothr.p[0])
{
hak_uint8_t u8;
while (read(xtn->iothr.p[0], &u8, HAK_SIZEOF(u8)) > 0)
@@ -2339,20 +2469,15 @@ static void vm_muxwait (hak_t* hak, const hak_ntime_t* dur, hak_vmprim_muxwait_c
int revents;
hak_ooi_t mask;
#if defined(USE_DEVPOLL)
revents = xtn->ev.buf[n].revents;
#elif defined(USE_KQUEUE)
#if defined(USE_KQUEUE)
revents = 0;
/* it's "if .. else if" because kqueue filter is either READ or WRITE. */
if (xtn->ev.buf[n].filter == EVFILT_READ) revents |= XPOLLIN;
else if (xtn->ev.buf[n].filter == EVFILT_WRITE) revents |= XPOLLOUT;
if (xtn->ev.buf[n].flags & EV_EOF) revents |= XPOLLHUP;
if (xtn->ev.buf[n].flags & EV_ERROR) revents |= XPOLLERR;
#elif defined(USE_EPOLL)
revents = xtn->ev.buf[n].events;
#elif defined(USE_POLL)
revents = xtn->ev.buf[n].revents;
#elif defined(USE_SELECT)
revents = xtn->ev.buf[n].events;
#else
revents = MUXEVT_MASK(xtn->ev.buf[n]);
#endif
mask = 0;
@@ -2361,19 +2486,7 @@ static void vm_muxwait (hak_t* hak, const hak_ntime_t* dur, hak_vmprim_muxwait_c
if (revents & XPOLLERR) mask |= HAK_SEMAPHORE_IO_MASK_ERROR;
if (revents & XPOLLHUP) mask |= HAK_SEMAPHORE_IO_MASK_HANGUP;
#if defined(USE_DEVPOLL)
muxwcb(hak, xtn->ev.buf[n].fd, mask);
#elif defined(USE_KQUEUE)
muxwcb(hak, xtn->ev.buf[n].ident, mask);
#elif defined(USE_EPOLL)
muxwcb(hak, xtn->ev.buf[n].data.fd, mask);
#elif defined(USE_POLL)
muxwcb(hak, xtn->ev.buf[n].fd, mask);
#elif defined(USE_SELECT)
muxwcb(hak, xtn->ev.buf[n].fd, mask);
#else
# error UNSUPPORTED
#endif
muxwcb(hak, MUXEVT_FD(xtn->ev.buf[n]), mask);
}
}
while (n > 0);
@@ -2515,6 +2628,7 @@ static void vm_muxwait (hak_t* hak, const hak_ntime_t* dur, hak_vmprim_muxwait_c
revents = xtn->ev.buf[n].revents;
#elif defined(USE_KQUEUE)
revents = 0;
/* it's "if .. else if" because kqueue filter is either READ or WRITE. */
if (xtn->ev.buf[n].filter == EVFILT_READ) revents |= XPOLLIN;
else if (xtn->ev.buf[n].filter == EVFILT_WRITE) revents |= XPOLLOUT;
if (xtn->ev.buf[n].flags & EV_EOF) revents |= XPOLLHUP;
@@ -2721,6 +2835,7 @@ static void dispatch_siginfo (int sig, siginfo_t* si, void* ctx)
if (g_sig_state[sig].handler != (hak_uintptr_t)SIG_IGN &&
g_sig_state[sig].handler != (hak_uintptr_t)SIG_DFL)
{
/* execute the current handler */
((sig_handler_t)g_sig_state[sig].handler)(sig);
}
@@ -2728,6 +2843,9 @@ static void dispatch_siginfo (int sig, siginfo_t* si, void* ctx)
g_sig_state[sig].old_handler != (hak_uintptr_t)SIG_IGN &&
g_sig_state[sig].old_handler != (hak_uintptr_t)SIG_DFL)
{
/* execute the original remembered handler */
/* TODO: if the runtime has installed its own signal handler, proably this one must not be called.
* when the runtime registers a single handler, it may optionally request that the previous one should also be invoked? */
((void(*)(int, siginfo_t*, void*))g_sig_state[sig].old_handler)(sig, si, ctx);
}
}
@@ -2994,8 +3112,10 @@ static HAK_INLINE void post_sig_to_all_haks (int signo)
{
xtn_t* xtn = GET_XTN(hak);
hak_uint8_t u8;
/*hak_abortstd(hak);*/
u8 = signo & 0xFF;
/* write a byte of signal number. vm_getsig() reads this when
* it's invoked by the vm */
write(xtn->sigfd.p[1], &u8, HAK_SIZEOF(u8));
hak = xtn->next;
}
@@ -3137,7 +3257,7 @@ static DWORD WINAPI msw_wait_for_timer_event (LPVOID ctx)
return 0;
}
static HAK_INLINE void start_ticker (void)
static HAK_INLINE int start_ticker (void)
{
HANDLE thr;
@@ -3152,7 +3272,10 @@ static HAK_INLINE void start_ticker (void)
* and all handles to it have been closed through a call to CloseHandle.
* it is safe to close the handle here */
CloseHandle(thr);
return 0;
}
return -1;
}
static HAK_INLINE void stop_ticker (void)
@@ -3207,12 +3330,13 @@ done:
DosExit(EXIT_THREAD, 0);
}
static HAK_INLINE void start_ticker (void)
static HAK_INLINE int start_ticker (void)
{
static TID tid;
os2_tick_done = 0;
DosCreateThread(&tid, os2_wait_for_timer_event, 0, 0, 4096);
/* TODO: Error check */
return 0;
}
static HAK_INLINE void stop_ticker (void)
@@ -3245,10 +3369,11 @@ static void interrupt dos_timer_intr_handler (void)
_chain_intr(dos_prev_timer_intr_handler);
}
static HAK_INLINE void start_ticker (void)
static HAK_INLINE int start_ticker (void)
{
dos_prev_timer_intr_handler = _dos_getvect(0x1C);
_dos_setvect(0x1C, dos_timer_intr_handler);
return 0;
}
static HAK_INLINE void stop_ticker (void)
@@ -3271,13 +3396,14 @@ static pascal void timer_intr_handler (TMTask* task)
PrimeTime((QElem*)&mac_tmtask, TMTASK_DELAY);
}
static HAK_INLINE void start_ticker (void)
static HAK_INLINE int start_ticker (void)
{
GetCurrentProcess(&mac_psn);
HAK_MEMSET(&mac_tmtask, 0, HAK_SIZEOF(mac_tmtask));
mac_tmtask.tmAddr = NewTimerProc (timer_intr_handler);
InsXTime((QElem*)&mac_tmtask);
PrimeTime((QElem*)&mac_tmtask, TMTASK_DELAY);
return 0;
}
static HAK_INLINE void stop_ticker (void)
@@ -3288,24 +3414,33 @@ static HAK_INLINE void stop_ticker (void)
#elif defined(HAVE_SETITIMER) && defined(SIGVTALRM) && defined(ITIMER_VIRTUAL)
static HAK_INLINE void start_ticker (void)
static HAK_INLINE int start_ticker (void)
{
#if !defined(ITIMER_VIRTUAL_NOT_WORKING)
/* a cpu-time timer only fires while the vm is actually computing, which is
* exactly when a process needs preempting, so prefer it where it works. */
if (set_signal_handler(SIGVTALRM, SH_HOW_UPSERT, hak_raise_gtick, SA_RESTART) >= 0)
{
struct itimerval itv;
itv.it_interval.tv_sec = 0;
itv.it_interval.tv_usec = HAK_TICKER_INTERVAL_USECS;
itv.it_value.tv_sec = 0;
itv.it_value.tv_usec = HAK_TICKER_INTERVAL_USECS;
if (setitimer(ITIMER_VIRTUAL, &itv, HAK_NULL) == -1)
{
/* WSL supports ITIMER_VIRTUAL only as of windows 10.0.18362.413.
the following is a fallback which will get */
if (setitimer(ITIMER_VIRTUAL, &itv, HAK_NULL) == 0) return 0;
/* WSL before windows 10.0.18362.413 rejects ITIMER_VIRTUAL outright. */
unset_signal_handler(SIGVTALRM);
}
#endif
#if defined(SIGALRM) && defined(ITIMER_REAL)
/* The wall-clock timer. Reached when ITIMER_VIRTUAL is absent, refused at
* runtime, or known not to deliver on this platform. */
if (set_signal_handler(SIGALRM, SH_HOW_UPSERT, hak_raise_gtick, SA_RESTART) >= 0)
{
struct itimerval itv;
/* i double the interval as ITIMER_REAL is against the wall clock.
* if the underlying system is under heavy load, some signals
* will get lost */
@@ -3313,11 +3448,14 @@ static HAK_INLINE void start_ticker (void)
itv.it_interval.tv_usec = HAK_TICKER_INTERVAL_USECS * 2;
itv.it_value.tv_sec = 0;
itv.it_value.tv_usec = HAK_TICKER_INTERVAL_USECS * 2;
setitimer(ITIMER_REAL, &itv, HAK_NULL);
if (setitimer(ITIMER_REAL, &itv, HAK_NULL) == 0) return 0;
unset_signal_handler(SIGALRM);
}
#endif
}
}
/* [NOTE] there is no ticker installed if the code reach here */
return -1;
}
static HAK_INLINE void stop_ticker (void)
@@ -3351,7 +3489,7 @@ static HAK_INLINE void stop_ticker (void)
static pid_t ticker_pid = -1;
static HAK_INLINE void start_ticker (void)
static HAK_INLINE int start_ticker (void)
{
#if defined(SIGALRM)
if (set_signal_handler(SIGALRM, SH_HOW_UPSERT, hak_raise_gtick, SA_RESTART) >= 0)
@@ -3374,7 +3512,6 @@ static HAK_INLINE void start_ticker (void)
nanosleep(&ts, HAK_NULL);
#elif defined(HAVE_USLEEP)
usleep(HAK_TICKER_INTERVAL_USECS * 2);
#else
# error UNDEFINED SLEEP
#endif
@@ -3386,8 +3523,11 @@ static HAK_INLINE void start_ticker (void)
}
/* parent just carries on. */
return 0; /* success */
}
#endif
return -1;
}
static HAK_INLINE void stop_ticker (void)
@@ -3548,11 +3688,17 @@ static void dl_cleanup (hak_t* hak)
#endif
}
static void* dlopen_pfmod (hak_t* hak, const hak_ooch_t* name, const hak_ooch_t* dirptr, const hak_oow_t dirlen, hak_bch_t* bufptr, hak_oow_t bufcapa)
/* [NOTE] dirptr/dirlen is a byte string - it is a segment of the modlibdirs
* option, which is stored in the byte form precisely because it ends up
* here and in dlopen(). only 'name' still needs converting. */
static void* dlopen_pfmod (hak_t* hak, const hak_ooch_t* name, const hak_bch_t* dirptr, const hak_oow_t dirlen, hak_bch_t* bufptr, hak_oow_t bufcapa)
{
void* handle;
hak_oow_t len, i, xlen, dlen;
hak_oow_t ucslen, bcslen;
hak_oow_t bcslen;
#if defined(HAK_OOCH_IS_UCH)
hak_oow_t ucslen;
#endif
/* opening a primitive function module - mostly libhak-xxxx.
* if PFMODPREFIX is absolute, never use PFMODDIR */
@@ -3563,13 +3709,7 @@ static void* dlopen_pfmod (hak_t* hak, const hak_ooch_t* name, const hak_ooch_t*
}
else if (dirptr)
{
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)
{
@@ -3705,25 +3845,28 @@ static void* dl_open (hak_t* hak, const hak_ooch_t* name, int flags)
{
#if defined(USE_LTDL) || defined(USE_DLFCN) || defined(USE_MACH_O_DYLD)
hak_bch_t stabuf[128], * bufptr;
hak_oow_t ucslen, bcslen, bufcapa;
void* handle = HAK_NULL;
hak_oow_t bufcapa;
const hak_bch_t* modlibdirs;
#if defined(HAK_OOCH_IS_UCH)
hak_oow_t ucslen;
#endif
modlibdirs = hak->option.modlibdirs_b;
#if defined(HAK_OOCH_IS_UCH)
if (hak_convootobcstr(hak, name, &ucslen, HAK_NULL, &bufcapa) <= -1) return HAK_NULL;
if (hak->option.mod[0].len > 0)
{
/* multiple directories separated by a colon can be specified for HAK_MOD_LIBDIRS
* however, use the total length to secure space just for simplicity */
ucslen = hak->option.mod[0].len;
if (hak_convootobchars(hak, hak->option.mod[0].ptr, &ucslen, HAK_NULL, &bcslen) <= -1) return HAK_NULL;
bufcapa += bcslen;
}
#else
bufcapa = hak_count_bcstr(name);
bufcapa += (hak->option.mod[0].len > 0)? hak->option.mod[0].len: HAK_COUNTOF(HAK_DEFAULT_PFMODDIR);
#endif
/* modlibdirs is stored in the byte form too, so no conversion is needed
* here. multiple directories separated by a colon can be specified for
* HAK_OPT_MODLIBDIRS - use the total length to secure space, for
* simplicity. */
bufcapa += (modlibdirs && modlibdirs[0] != '\0')?
hak_count_bcstr(modlibdirs): HAK_COUNTOF(HAK_DEFAULT_PFMODDIR);
/* HAK_COUNTOF(HAK_DEFAULT_PFMODPREFIX) and HAK_COUNTOF(HAK_DEFAULT_PFMODPOSTIFX)
* include the terminating nulls. Never mind about the extra 2 characters. */
bufcapa += HAK_COUNTOF(HAK_DEFAULT_PFMODPREFIX) + HAK_COUNTOF(HAK_DEFAULT_PFMODPOSTFIX) + 1;
@@ -3737,12 +3880,12 @@ static void* dl_open (hak_t* hak, const hak_ooch_t* name, int flags)
if (flags & HAK_VMPRIM_DLOPEN_PFMOD)
{
if (hak->option.mod[0].len > 0)
if (modlibdirs && modlibdirs[0] != '\0')
{
const hak_ooch_t* ptr, * end, * seg;
const hak_bch_t* ptr, * end, * seg;
ptr = hak->option.mod[0].ptr;
end = hak->option.mod[0].ptr + hak->option.mod[0].len;
ptr = modlibdirs;
end = modlibdirs + hak_count_bcstr(modlibdirs);
seg = ptr;
while (ptr <= end)
@@ -3945,8 +4088,8 @@ static void cb_on_option (hak_t* hak, hak_option_t id, const void* value)
xtn_t* xtn = GET_XTN(hak);
int fd;
if (id != HAK_LOG_TARGET_BCSTR && id != HAK_LOG_TARGET_UCSTR &&
id != HAK_LOG_TARGET_BCS && id != HAK_LOG_TARGET_UCS) return; /* return success. not interested */
if (id != HAK_OPT_LOG_TARGET_BCSTR && id != HAK_OPT_LOG_TARGET_UCSTR &&
id != HAK_OPT_LOG_TARGET_BCS && id != HAK_OPT_LOG_TARGET_UCS) return; /* return success. not interested */
#if defined(_WIN32)
#if defined(HAK_OOCH_IS_UCH) && (HAK_SIZEOF_UCH_T == HAK_SIZEOF_WCHAR_T)
@@ -4193,6 +4336,7 @@ static int cb_vm_startup (hak_t* hak)
FD_ZERO(&xtn->ev.reg.rfds);
FD_ZERO(&xtn->ev.reg.wfds);
xtn->ev.reg.maxfd = -1;
xtn->ev.reg.epoch = 0;
MUTEX_INIT(&xtn->ev.reg.smtx);
#endif /* USE_DEVPOLL */
@@ -4498,12 +4642,13 @@ static HAK_INLINE int open_cci_stream (hak_t* hak, hak_io_cciarg_t* arg)
xtn_t* xtn = GET_XTN(hak);
bb_t* bb = HAK_NULL;
/* TOOD: support predefined include directory as well */
if (arg->includer)
{
/* includee */
hak_oow_t ucslen, bcslen, parlen;
const hak_bch_t* fn, * fb;
int attempt_incdirs;
const hak_bch_t* incdirs_ptr;
#if defined(HAK_OOCH_IS_UCH)
if (hak_convootobcstr(hak, arg->name, &ucslen, HAK_NULL, &bcslen) <= -1) goto oops;
@@ -4517,15 +4662,17 @@ static HAK_INLINE int open_cci_stream (hak_t* hak, hak_io_cciarg_t* arg)
{
fb = "";
parlen = 0;
attempt_incdirs = 0;
}
else
{
fb = hak_get_base_name_from_bcstr_path(fn);
parlen = fb - fn;
attempt_incdirs = !((arg->name[0] == '.' && arg->name[1] == '/') || (arg->name[0] == '.' && arg->name[1] == '.' && arg->name[2] == '/'));
}
bb = (bb_t*)hak_callocmem(hak, HAK_SIZEOF(*bb) + (HAK_SIZEOF(hak_bch_t) * (parlen + bcslen + 1)));
if (!bb) goto oops;
if (HAK_UNLIKELY(!bb)) goto oops;
bb->fn = (hak_bch_t*)(bb + 1);
hak_copy_bchars(bb->fn, fn, parlen);
@@ -4535,9 +4682,43 @@ static HAK_INLINE int open_cci_stream (hak_t* hak, hak_io_cciarg_t* arg)
hak_copy_bcstr(&bb->fn[parlen], bcslen + 1, arg->name);
#endif
incdirs_ptr = hak->option.incdirs_b;
retry:
bb->fp = fopen(bb->fn, FOPEN_R_FLAGS);
if (!bb->fp)
{
if ((errno == ENOENT || errno == ENOTDIR) && attempt_incdirs && incdirs_ptr && incdirs_ptr[0] != '\0')
{
hak_oow_t incdir_bcslen;
const hak_bch_t* colon;
hak_freemem(hak, bb); bb = HAK_NULL;
/* incdirs is kept in the byte form as well, so the directory part
* needs no conversion here - only the include name does. */
colon = hak_find_bchar_in_bcstr(incdirs_ptr, ':');
incdir_bcslen = colon? (hak_oow_t)(colon - incdirs_ptr): hak_count_bcstr(incdirs_ptr);
bb = (bb_t*)hak_callocmem(hak, HAK_SIZEOF(*bb) + (HAK_SIZEOF(hak_bch_t) * (incdir_bcslen + bcslen + 2)));
if (HAK_UNLIKELY(!bb)) goto oops;
bb->fn = (hak_bch_t*)(bb + 1);
/* TODO: i need to support different directory separator */
hak_copy_bchars(bb->fn, incdirs_ptr, incdir_bcslen);
if (incdir_bcslen > 0 && bb->fn[incdir_bcslen - 1] != '/') bb->fn[incdir_bcslen++] = '/';
#if defined(HAK_OOCH_IS_UCH)
hak_convootobcstr(hak, arg->name, &ucslen, &bb->fn[incdir_bcslen], &bcslen);
#else
hak_copy_bcstr(&bb->fn[incdir_bcslen], bcslen + 1, arg->name);
#endif
incdirs_ptr = colon? colon + 1: HAK_NULL;
/*printf("RETRYING bb->fn [%s]\n", bb->fn);*/
goto retry;
}
hak_seterrbfmt(hak, HAK_EIOERR, "unable to open %hs", bb->fn);
goto oops;
}
@@ -4545,6 +4726,15 @@ static HAK_INLINE int open_cci_stream (hak_t* hak, hak_io_cciarg_t* arg)
else
{
/* main stream */
/* [NOTE]
* in the current implementation, the main stream is rarely used read
* because the input the the reader/compiler is fed via hak_feed() and its relatives.
* this part doesn't really open the specified file.
*/
/* TODO: make if hak_feed() is going to be used or not.
* if it's not used, it can open it as usual as xtn->cci_path point to the file name anyways */
hak_oow_t pathlen;
pathlen = xtn->cci_path? hak_count_bcstr(xtn->cci_path): 0;
@@ -5114,24 +5304,74 @@ int hak_attachudiostdwithucstr (hak_t* hak, const hak_uch_t* udi_file, const hak
/* ========================================================================= */
#if defined(HAK_ATOMIC_LOAD) && defined(HAK_ATOMIC_ADD_FETCH) && \
defined(HAK_ATOMIC_SUB_FETCH) && defined(HAK_ATOMIC_CAS_BOOL)
# define USE_TICKER_ATOMICS
#endif
static hak_uint32_t ticker_started = 0;
void hak_start_ticker (void)
int hak_start_ticker (void)
{
/* TODO: use atomic op */
#if defined(USE_TICKER_ATOMICS)
hak_uint32_t x;
/* ACQ_REL rather than RELAXED - this counter gates the one-time
* start_ticker() call, so it must carry ordering and not merely be
* indivisible. The __sync_* fallbacks ignore the memory order argument
* and are already sequentially consistent. */
x = HAK_ATOMIC_ADD_FETCH(&ticker_started, 1, HAK_ATOMIC_ACQ_REL);
if (x == 1)
#else
if (++ticker_started == 1)
#endif
{
start_ticker();
int n;
n = start_ticker();
if (n <= -1)
{
/* roll the claim back, so a retry can take it again and an
* unbalanced hak_stop_ticker() cannot tear down a ticker that was
* never installed. */
#if defined(USE_TICKER_ATOMICS)
HAK_ATOMIC_SUB_FETCH(&ticker_started, 1, HAK_ATOMIC_ACQ_REL);
#else
ticker_started--;
#endif
return -1;
}
return 1;
}
/* [NOTE] potentially this answer of 0 could be misleading if hak_start_ticker()
* is called in parallel without a guard/mutex and start_ticker() fails mid-loop. */
return 0; /* ok. already started */
}
void hak_stop_ticker (void)
{
/* TODO: use atomic op */
if (ticker_started > 0 && --ticker_started == 0)
#if defined(USE_TICKER_ATOMICS)
hak_uint32_t old;
/* decrement only if non-zero - ticker_started is unsigned, so an
* unbalanced stop would otherwise wrap it round to its maximum. no single
* atomic operation expresses "decrement if greater than zero". */
old = HAK_ATOMIC_LOAD(&ticker_started, HAK_ATOMIC_ACQUIRE);
while (old > 0)
{
stop_ticker();
if (HAK_ATOMIC_CAS_BOOL(&ticker_started, &old, old - 1, HAK_ATOMIC_ACQ_REL, HAK_ATOMIC_ACQUIRE)) break;
#if !defined(HAK_ATOMIC_CAS_BOOL_YIELD_OLDVAL)
/* __sync_bool_compare_and_swap() does not write the observed value
* back into old on failure, so reload it before retrying. */
old = HAK_ATOMIC_LOAD(&ticker_started, HAK_ATOMIC_ACQUIRE);
#endif
}
if (old == 1) stop_ticker();
#else
if (ticker_started > 0 && --ticker_started == 0) stop_ticker();
#endif
}
/* ========================================================================== */
+2 -2
View File
@@ -212,7 +212,7 @@ hak_client_t* hak_client_open (hak_mmgr_t* mmgr, hak_oow_t xtnsize, hak_client_p
/* the dummy hak is used for this client to perform primitive operations
* such as getting system time or logging. so the heap size doesn't
* need to be changed from the tiny value set above. */
hak_setoption (client->dummy_hak, HAK_LOG_MASK, &client->cfg.logmask);
hak_setoption (client->dummy_hak, HAK_OPT_LOG_MASK, &client->cfg.logmask);
hak_setcmgr (client->dummy_hak, client->_cmgr);
return client;
@@ -258,7 +258,7 @@ int hak_client_setoption (hak_client_t* client, hak_client_option_t id, const vo
* existing hak instances inside worker threads won't get
* affected. new hak instances to be created later
* is supposed to use the new value */
hak_setoption (client->dummy_hak, HAK_LOG_MASK, value);
hak_setoption (client->dummy_hak, HAK_OPT_LOG_MASK, value);
}
return 0;
}
+10 -10
View File
@@ -1177,14 +1177,14 @@ hak_server_t* hak_server_open (hak_mmgr_t* mmgr, hak_oow_t xtnsize, hak_server_p
/* the dummy hak is used for this server to perform primitive operations
* such as getting system time or logging. so the heap size doesn't
* need to be changed from the tiny value set above. */
hak_setoption (server->dummy_hak, HAK_LOG_MASK, &server->cfg.logmask);
hak_setoption (server->dummy_hak, HAK_OPT_LOG_MASK, &server->cfg.logmask);
hak_setcmgr (server->dummy_hak, hak_server_getcmgr(server));
hak_getoption (server->dummy_hak, HAK_TRAIT, &trait);
hak_getoption (server->dummy_hak, HAK_OPT_TRAIT, &trait);
#if defined(HAK_BUILD_DEBUG)
if (server->cfg.trait & HAK_SERVER_TRAIT_DEBUG_GC) trait |= HAK_TRAIT_DEBUG_GC;
if (server->cfg.trait & HAK_SERVER_TRAIT_DEBUG_BIGINT) trait |= HAK_TRAIT_DEBUG_BIGINT;
#endif
hak_setoption (server->dummy_hak, HAK_TRAIT, &trait);
hak_setoption (server->dummy_hak, HAK_OPT_TRAIT, &trait);
return server;
@@ -1517,17 +1517,17 @@ static int init_worker_hak (hak_server_worker_t* worker)
xtn = (worker_hak_xtn_t*)hak_getxtn(hak);
xtn->worker = worker;
hak_setoption(hak, HAK_MOD_INCTX, &server->cfg.module_inctx);
hak_setoption(hak, HAK_LOG_MASK, &server->cfg.logmask);
hak_setoption(hak, HAK_OPT_MODINCTX, &server->cfg.module_inctx);
hak_setoption(hak, HAK_OPT_LOG_MASK, &server->cfg.logmask);
hak_setcmgr(hak, hak_server_getcmgr(server));
hak_getoption(hak, HAK_TRAIT, &trait);
hak_getoption(hak, HAK_OPT_TRAIT, &trait);
#if defined(HAK_BUILD_DEBUG)
if (server->cfg.trait & HAK_SERVER_TRAIT_DEBUG_GC) trait |= HAK_TRAIT_DEBUG_GC;
if (server->cfg.trait & HAK_SERVER_TRAIT_DEBUG_BIGINT) trait |= HAK_TRAIT_DEBUG_BIGINT;
#endif
trait |= HAK_TRAIT_LANG_ENABLE_EOL;
hak_setoption(hak, HAK_TRAIT, &trait);
hak_setoption(hak, HAK_OPT_TRAIT, &trait);
HAK_MEMSET(&hakcb, 0, HAK_SIZEOF(hakcb));
/*hakcb.fini = fini_hak;
@@ -2050,12 +2050,12 @@ int hak_server_setoption (hak_server_t* server, hak_server_option_t id, const vo
* is supposed to use the new value */
hak_bitmask_t trait;
hak_getoption (server->dummy_hak, HAK_TRAIT, &trait);
hak_getoption (server->dummy_hak, HAK_OPT_TRAIT, &trait);
#if defined(HAK_BUILD_DEBUG)
if (server->cfg.trait & HAK_SERVER_TRAIT_DEBUG_GC) trait |= HAK_TRAIT_DEBUG_GC;
if (server->cfg.trait & HAK_SERVER_TRAIT_DEBUG_BIGINT) trait |= HAK_TRAIT_DEBUG_BIGINT;
#endif
hak_setoption (server->dummy_hak, HAK_TRAIT, &trait);
hak_setoption (server->dummy_hak, HAK_OPT_TRAIT, &trait);
}
return 0;
@@ -2067,7 +2067,7 @@ int hak_server_setoption (hak_server_t* server, hak_server_option_t id, const vo
* existing hak instances inside worker threads won't get
* affected. new hak instances to be created later
* is supposed to use the new value */
hak_setoption (server->dummy_hak, HAK_LOG_MASK, value);
hak_setoption (server->dummy_hak, HAK_OPT_LOG_MASK, value);
}
return 0;
+25
View File
@@ -605,21 +605,46 @@ static hak_pfinfo_t pfinfos[] =
{ "classRespondsTo", { HAK_PFBASE_FUNC, pf_core_class_responds_to, 2, 2 } },
{ "cons", { HAK_PFBASE_FUNC, pf_core_cons, 2, 2 } },
{ "current-process", { HAK_PFBASE_FUNC, hak_pf_process_current, 0, 0 } },
{ "eqk?", { HAK_PFBASE_FUNC, hak_pf_eqk, 2, 2 } },
{ "eql?", { HAK_PFBASE_FUNC, hak_pf_eql, 2, 2 } },
{ "eqv?", { HAK_PFBASE_FUNC, hak_pf_eqv, 2, 2 } },
{ "fork", { HAK_PFBASE_FUNC, hak_pf_process_fork, 1, HAK_TYPE_MAX(hak_oow_t) } },
{ "instRespondsTo", { HAK_PFBASE_FUNC, pf_core_inst_responds_to, 2, 2 } },
{ "nqk?", { HAK_PFBASE_FUNC, hak_pf_nqk, 2, 2 } },
{ "nql?", { HAK_PFBASE_FUNC, hak_pf_nql, 2, 2 } },
{ "nqv?", { HAK_PFBASE_FUNC, hak_pf_nqv, 2, 2 } },
{ "object-new", { HAK_PFBASE_FUNC, hak_pf_object_new, 1, 2 } },
{ "primAt", { HAK_PFBASE_FUNC, pf_core_prim_at, 2, 2 } },
{ "primAtPut", { HAK_PFBASE_FUNC, pf_core_prim_at_put, 3, 3 } },
{ "resume", { HAK_PFBASE_FUNC, hak_pf_process_resume, 1, 1 } },
{ "sem-new", { HAK_PFBASE_FUNC, hak_pf_semaphore_new, 0, 1 } },
{ "sem-signal", { HAK_PFBASE_FUNC, hak_pf_semaphore_signal, 1, 3 } },
{ "sem-signal-on-input", { HAK_PFBASE_FUNC, hak_pf_semaphore_signal_on_input, 2, 2 } },
{ "sem-signal-on-output", { HAK_PFBASE_FUNC, hak_pf_semaphore_signal_on_output, 2, 2 } },
{ "sem-unsignal", { HAK_PFBASE_FUNC, hak_pf_semaphore_unsignal, 1, 1 } },
{ "sem-wait", { HAK_PFBASE_FUNC, hak_pf_semaphore_wait, 1, 1 } },
{ "semgr-add", { HAK_PFBASE_FUNC, hak_pf_semaphore_group_add_semaphore, 1, 2 } },
{ "semgr-new", { HAK_PFBASE_FUNC, hak_pf_semaphore_group_new, 0, 0 } },
{ "semgr-remove", { HAK_PFBASE_FUNC, hak_pf_semaphore_group_remove_semaphore, 1, 2 } },
{ "semgr-wait", { HAK_PFBASE_FUNC, hak_pf_semaphore_group_wait, 1, 1 } },
{ "slice", { HAK_PFBASE_FUNC, pf_core_slice, 3, 3 } },
{ "smooiToChar", { HAK_PFBASE_FUNC, pf_core_smooi_to_char, 1, 1 } },
{ "sqrt", { HAK_PFBASE_FUNC, hak_pf_number_sqrt, 1, 1 } },
{ "suspend", { HAK_PFBASE_FUNC, hak_pf_process_suspend, 0, 1 } },
{ "terminate", { HAK_PFBASE_FUNC, hak_pf_process_terminate, 0, 1 } },
{ "terminate-all", { HAK_PFBASE_FUNC, hak_pf_process_terminate_all, 0, 0 } },
{ "yield", { HAK_PFBASE_FUNC, hak_pf_process_yield, 0, 0 } },
{ "~=", { HAK_PFBASE_FUNC, hak_pf_number_ne, 2, 2 } },
};
+9 -4
View File
@@ -31,9 +31,8 @@
#endif
#include "_sys.h"
#include <hak-hnd.h>
#include "../lib/hak-prv.h"
#include <hak-pio.h>
#include <hak-str.h>
#include <stdlib.h>
#include <signal.h>
@@ -43,7 +42,6 @@
# include <unistd.h>
# include <fcntl.h>
# include <errno.h>
# include <sys/syscall.h>
#endif
#if defined(HAVE_SYS_TIME_H)
@@ -175,7 +173,7 @@ static hak_pfrc_t pf_sys_random (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
* sys.read and sys.write follow the non-blocking contract: they return the
* byte count, 0 at end of file, or -1 when the handle would have blocked.
* -1 is an ordinary outcome - the caller is expected to wait on a semaphore
* bound with sem-signal-on-input/-output and try again. Only a genuine
* bound with core.sem-signal-on-input/-output and try again. Only a genuine
* failure raises.
* ------------------------------------------------------------------------ */
@@ -814,6 +812,13 @@ static hak_pfinfo_t pfinfos[] =
{ "pwait", { HAK_PFBASE_FUNC, pf_sys_pwait, 1, 1 } },
{ "random", { HAK_PFBASE_FUNC, pf_sys_random, 0, 0 } },
{ "read", { HAK_PFBASE_FUNC, pf_sys_read, 2, 4 } },
{ "sig-catch", { HAK_PFBASE_FUNC, hak_pf_system_catch_sig, 1, 1 } },
{ "sig-get", { HAK_PFBASE_FUNC, hak_pf_system_get_sig, 0, 0 } },
{ "sig-getfd", { HAK_PFBASE_FUNC, hak_pf_system_get_sigfd, 0, 0 } },
{ "sig-set", { HAK_PFBASE_FUNC, hak_pf_system_set_sig, 1, 1 } },
{ "sig-uncatch", { HAK_PFBASE_FUNC, hak_pf_system_uncatch_sig, 1, 1 } },
{ "srandom", { HAK_PFBASE_FUNC, pf_sys_srandom, 1, 1 } },
{ "stime", { HAK_PFBASE_FUNC, pf_sys_stime, 1, 1 } },
{ "time", { HAK_PFBASE_FUNC, pf_sys_time, 0, 0 } },
+3
View File
@@ -42,6 +42,9 @@ class FixedSizedCollection: IndexedCollection {
class[#varying] Array: FixedSizedCollection {
}
class[#byte #varying] ByteArray: FixedSizedCollection {
}
class[#char #varying] String: FixedSizedCollection {
fun[#class] initValue() {
##return '\0'
+76
View File
@@ -0,0 +1,76 @@
class Apex {
fun isNil?() { return false }
fun notNil?() { return true }
fun[#class] basicNew(size) {
return (core.basicNew self size)
}
fun[#class] respondsTo(mthname) {
return (core.classRespondsTo self mthname)
}
fun respondsTo(mthname) {
return (core.instRespondsTo self mthname)
}
fun primAt(pos) {
return (core.primAt self pos)
}
fun primtAtPut(pos value) {
return (core.primAtPut self pos value)
}
fun basicAt(pos) {
return (core.basicAt self pos)
}
fun basicAtPut(pos value) {
return (core.basicAtPut self pos value)
}
fun basicSize() {
return (core.basicSize self)
}
## TODO: ...
fun == (oprnd) { return (== self oprnd) }
fun != (oprnd) { return (!= self oprnd) }
## TODO: fun perform(name ...) {}
}
class[#uncopyable #varying #limited #final] Class: Apex (
_name
_mdic
_spec
_selfspec
_superclass
_nivars_super
_ibrand
_ivarnames
_cvarnames
) {
fun name() {
##return (core.className self)
return _class
}
fun instanceVariableNames() {
## TODO: this still returns nil as the acutal manipulation of the field has not been implemented
return _ivarnames
}
fun classVariableNames() {
## TODO: this still returns nil as the acutal manipulation of the field has not been implemented
return _cvarnames
}
}
class UndefinedObject: Apex {
fun isNil?() { return true }
fun notNil?() { return false }
}
class Object: Apex {
}
+73
View File
@@ -0,0 +1,73 @@
class[#uncopyable] Semaphore: Object(
_waiting_first
_wait_last
_count
_subtype
_index
_ftime_sec_or_handle
_ftime_nsec_or_type
_signal_action
_group
_grm_prev
_grm_next
) {
fun[#class] new() {
return (core.sem-new 0)
}
fun[#class] forMutex() {
return (core.sem-new 1)
}
fun signal() {
return (core.sem-signal self 0 0)
}
fun signalAfter(secs nsecs) {
return (core.sem-signal self secs nsecs)
}
fun signalOnInput(handle) {
return (core.sem-signal-on-input self handle)
}
fun signalOnOutput(handle) {
return (core.sem-signal-on-output self handle)
}
fun unsignal() {
return (core.sem-unsignal self)
}
fun wait() {
return (core.sem-wait self)
}
}
class[#uncopyable] SemaphoreGroup: Object(
_waiting_first
_waiting_last
_sem_unsig_first
_sem_unsig_last
_sem_sig_first
_sem_sig_last
_sem_io_count
_sem_count
) {
fun[#class] new() {
return (core.semgr-new)
}
fun add(sem) {
return (core.semgr-add self sem)
}
fun remove(sem) {
return (core.semgr-remove self sem)
}
fun wait() {
return (core.semgr-wait self)
}
}
+3 -79
View File
@@ -1,84 +1,8 @@
class Apex {
fun isNil?() { return false }
fun notNil?() { return true }
fun[#class] basicNew(size) {
return (core.basicNew self size)
}
fun[#class] respondsTo(mthname) {
return (core.classRespondsTo self mthname)
}
fun respondsTo(mthname) {
return (core.instRespondsTo self mthname)
}
fun primAt(pos) {
return (core.primAt self pos)
}
fun primtAtPut(pos value) {
return (core.primAtPut self pos value)
}
fun basicAt(pos) {
return (core.basicAt self pos)
}
fun basicAtPut(pos value) {
return (core.basicAtPut self pos value)
}
fun basicSize() {
return (core.basicSize self)
}
## TODO: ...
fun == (oprnd) { return (== self oprnd) }
fun != (oprnd) { return (!= self oprnd) }
## TODO: fun perform(name ...) {}
}
class[#uncopyable #varying #limited #final] Class: Apex (
_name
_mdic
_spec
_selfspec
_superclass
_nivars_super
_ibrand
_ivarnames
_cvarnames
) {
fun name() {
##return (core.className self)
return _class
}
fun instanceVariableNames() {
## TODO: this still returns nil as the acutal manipulation of the field has not been implemented
return _ivarnames
}
fun classVariableNames() {
## TODO: this still returns nil as the acutal manipulation of the field has not been implemented
return _cvarnames
}
}
class UndefinedObject: Apex {
fun isNil?() { return true }
fun notNil?() { return false }
}
class Object: Apex {
}
## ---------------------------------------------------------------------------------
$include "Object.hak"
$include "Magnitude.hak"
$include "Collection.hak"
$include "Semaphore.hak"
##$include "System.hak"
## ---------------------------------------------------------------------------------
+19 -19
View File
@@ -37,9 +37,9 @@ class ChildGroup(
sigsem ## the shared semaphore; only in shared mode
) {
fun[#ci] new() {
set sg (semgr-new)
set tmo (sem-new)
semgr-add sg tmo
set sg (core.semgr-new)
set tmo (core.sem-new)
core.semgr-add sg tmo
set capa 8
set kids (core.basicNew Array 8)
set nkids 0
@@ -107,16 +107,16 @@ class ChildGroup(
## semaphore on the signal descriptor for the whole group, once.
if (not self.shared) {
set shared true
system-catch-sig sys.SIGCHLD
set sigsem (sem-new)
semgr-add self.sg self.sigsem
sem-signal-on-input self.sigsem (system-get-sigfd)
sys.sig-catch sys.SIGCHLD
set sigsem (core.sem-new)
core.semgr-add self.sg self.sigsem
core.sem-signal-on-input self.sigsem (sys.sig-getfd)
}
} else {
## A handle of its own, so a wakeup identifies this child directly.
sem := (sem-new)
semgr-add self.sg sem
sem-signal-on-input sem xh
sem := (core.sem-new)
core.semgr-add self.sg sem
core.sem-signal-on-input sem xh
}
kid := (core.basicNew Array 6)
@@ -171,16 +171,16 @@ class ChildGroup(
if (not (nil? kid)) { return kid }
while true {
sem-signal self.tmo secs 0
w := (semgr-wait self.sg)
sem-unsignal self.tmo
core.sem-signal self.tmo secs 0
w := (core.semgr-wait self.sg)
core.sem-unsignal self.tmo
if (eqv? w self.tmo) { return nil }
if self.shared {
## the signal descriptor spoke: take the byte, then look at
## everyone, since one SIGCHLD may stand for several exits
system-get-sig
sys.sig-get
kid := (self:finished)
if (not (nil? kid)) { return kid }
## otherwise it was a SIGCHLD for a child of the host
@@ -188,7 +188,7 @@ class ChildGroup(
} else {
kid := (self:kid-of-sem w)
if (not (nil? kid)) {
sem-unsignal w
core.sem-unsignal w
return kid
}
}
@@ -210,8 +210,8 @@ class ChildGroup(
| sem |
sem := (core.basicAt kid 5)
if (not (nil? sem)) {
sem-unsignal sem
semgr-remove self.sg sem
core.sem-unsignal sem
core.semgr-remove self.sg sem
}
self:forget kid
sys.pclose (core.basicAt kid 0)
@@ -227,8 +227,8 @@ class ChildGroup(
i := (+ i 1)
}
if self.shared {
sem-unsignal self.sigsem
system-uncatch-sig sys.SIGCHLD
core.sem-unsignal self.sigsem
sys.sig-uncatch sys.SIGCHLD
set shared false
}
}
+7 -2
View File
@@ -5,7 +5,8 @@ AM_CPPFLAGS = \
-I$(abs_builddir)/../lib \
-I$(abs_srcdir) \
-I$(abs_srcdir)/../lib \
-I$(includedir)
-I$(includedir) \
-DHAK_TEST_MODLIBDIRS='"@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs"'
LDADD = ../lib/libhak.la
check_SCRIPTS = \
@@ -21,6 +22,7 @@ check_SCRIPTS = \
insta-02.hak \
mux-01.hak \
mux-02.hak \
mux-03.hak \
prim-01.hak \
proc-01.hak \
proclib-01.hak \
@@ -31,6 +33,7 @@ check_SCRIPTS = \
sysproc-01.hak \
sysproc-02.hak \
tick-01.hak \
try-01.hak \
va-01.hak \
var-01.hak \
var-02.hak \
@@ -50,11 +53,13 @@ check_ERRORS = \
check_PROGRAMS = \
t-001 \
t-002 \
t-003
t-003 \
t-004
t_001_SOURCES = t-001.c tap.h
t_002_SOURCES = t-002.c tap.h
t_003_SOURCES = t-003.c tap.h
t_004_SOURCES = t-004.c tap.h
##noinst_SCRIPTS = $(check_SCRIPTS)
EXTRA_DIST = $(check_SCRIPTS) $(check_ERRORS)
+30 -5
View File
@@ -89,7 +89,8 @@ PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
check_PROGRAMS = t-001$(EXEEXT) t-002$(EXEEXT) t-003$(EXEEXT)
check_PROGRAMS = t-001$(EXEEXT) t-002$(EXEEXT) t-003$(EXEEXT) \
t-004$(EXEEXT)
subdir = t
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_check_sign.m4 \
@@ -120,6 +121,10 @@ am_t_003_OBJECTS = t-003.$(OBJEXT)
t_003_OBJECTS = $(am_t_003_OBJECTS)
t_003_LDADD = $(LDADD)
t_003_DEPENDENCIES = ../lib/libhak.la
am_t_004_OBJECTS = t-004.$(OBJEXT)
t_004_OBJECTS = $(am_t_004_OBJECTS)
t_004_LDADD = $(LDADD)
t_004_DEPENDENCIES = ../lib/libhak.la
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
@@ -136,7 +141,7 @@ DEFAULT_INCLUDES =
depcomp = $(SHELL) $(top_srcdir)/ac/depcomp
am__maybe_remake_depfiles = depfiles
am__depfiles_remade = ./$(DEPDIR)/t-001.Po ./$(DEPDIR)/t-002.Po \
./$(DEPDIR)/t-003.Po
./$(DEPDIR)/t-003.Po ./$(DEPDIR)/t-004.Po
am__mv = mv -f
COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
@@ -156,8 +161,10 @@ AM_V_CCLD = $(am__v_CCLD_@AM_V@)
am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
am__v_CCLD_0 = @echo " CCLD " $@;
am__v_CCLD_1 =
SOURCES = $(t_001_SOURCES) $(t_002_SOURCES) $(t_003_SOURCES)
DIST_SOURCES = $(t_001_SOURCES) $(t_002_SOURCES) $(t_003_SOURCES)
SOURCES = $(t_001_SOURCES) $(t_002_SOURCES) $(t_003_SOURCES) \
$(t_004_SOURCES)
DIST_SOURCES = $(t_001_SOURCES) $(t_002_SOURCES) $(t_003_SOURCES) \
$(t_004_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
@@ -543,7 +550,8 @@ AM_CPPFLAGS = \
-I$(abs_builddir)/../lib \
-I$(abs_srcdir) \
-I$(abs_srcdir)/../lib \
-I$(includedir)
-I$(includedir) \
-DHAK_TEST_MODLIBDIRS='"@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs"'
LDADD = ../lib/libhak.la
check_SCRIPTS = \
@@ -559,6 +567,7 @@ check_SCRIPTS = \
insta-02.hak \
mux-01.hak \
mux-02.hak \
mux-03.hak \
prim-01.hak \
proc-01.hak \
proclib-01.hak \
@@ -569,6 +578,7 @@ check_SCRIPTS = \
sysproc-01.hak \
sysproc-02.hak \
tick-01.hak \
try-01.hak \
va-01.hak \
var-01.hak \
var-02.hak \
@@ -588,6 +598,7 @@ check_ERRORS = \
t_001_SOURCES = t-001.c tap.h
t_002_SOURCES = t-002.c tap.h
t_003_SOURCES = t-003.c tap.h
t_004_SOURCES = t-004.c tap.h
EXTRA_DIST = $(check_SCRIPTS) $(check_ERRORS)
TESTS = $(check_PROGRAMS) $(check_SCRIPTS) $(check_ERRORS)
TEST_EXTENSIONS = .hak .err
@@ -646,6 +657,10 @@ t-003$(EXEEXT): $(t_003_OBJECTS) $(t_003_DEPENDENCIES) $(EXTRA_t_003_DEPENDENCIE
@rm -f t-003$(EXEEXT)
$(AM_V_CCLD)$(LINK) $(t_003_OBJECTS) $(t_003_LDADD) $(LIBS)
t-004$(EXEEXT): $(t_004_OBJECTS) $(t_004_DEPENDENCIES) $(EXTRA_t_004_DEPENDENCIES)
@rm -f t-004$(EXEEXT)
$(AM_V_CCLD)$(LINK) $(t_004_OBJECTS) $(t_004_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
@@ -655,6 +670,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/t-001.Po@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/t-002.Po@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/t-003.Po@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/t-004.Po@am__quote@ # am--include-marker
$(am__depfiles_remade):
@$(MKDIR_P) $(@D)
@@ -931,6 +947,13 @@ t-003.log: t-003$(EXEEXT)
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
t-004.log: t-004$(EXEEXT)
@p='t-004$(EXEEXT)'; \
b='t-004'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
.hak.log:
@p='$<'; \
$(am__set_b); \
@@ -1041,6 +1064,7 @@ distclean: distclean-am
-rm -f ./$(DEPDIR)/t-001.Po
-rm -f ./$(DEPDIR)/t-002.Po
-rm -f ./$(DEPDIR)/t-003.Po
-rm -f ./$(DEPDIR)/t-004.Po
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
@@ -1089,6 +1113,7 @@ maintainer-clean: maintainer-clean-am
-rm -f ./$(DEPDIR)/t-001.Po
-rm -f ./$(DEPDIR)/t-002.Po
-rm -f ./$(DEPDIR)/t-003.Po
-rm -f ./$(DEPDIR)/t-004.Po
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
+17 -17
View File
@@ -7,21 +7,21 @@ fun chk(ok msg) {
else { printf "ERROR: %s\n" msg }
}
iosem := (sem-new)
tmo := (sem-new)
sg := (semgr-new)
semgr-add sg iosem
semgr-add sg tmo
fin := (sem-new)
iosem := (core.sem-new)
tmo := (core.sem-new)
sg := (core.semgr-new)
core.semgr-add sg iosem
core.semgr-add sg tmo
fin := (core.sem-new)
## returns 1 when the handle became readable, 0 when the timeout won
fun waitin(h secs) {
| s |
sem-signal tmo secs 0
sem-signal-on-input iosem h
s := (semgr-wait sg)
sem-unsignal iosem
sem-unsignal tmo
core.sem-signal tmo secs 0
core.sem-signal-on-input iosem h
s := (core.semgr-wait sg)
core.sem-unsignal iosem
core.sem-unsignal tmo
if (eqv? s tmo) { return 0 } \
else { return 1 }
}
@@ -46,12 +46,12 @@ fun reader() {
n := (sys.read r buf)
if (>= n 0) {
got := n
sem-signal fin
core.sem-signal fin
return 0
}
if (= (waitin r 5) 0) {
got := -1
sem-signal fin
core.sem-signal fin
return 0
}
}
@@ -63,7 +63,7 @@ fun writer() {
## so these ticks only happen if the VM is still scheduling
while (< ticks 4) {
ticks := (+ ticks 1)
yield
core.yield
}
wb := (core.basicNew ByteArray 2)
core.basicAtPut wb 0 120
@@ -71,9 +71,9 @@ fun writer() {
sys.write w wb
}
fork reader
fork writer
sem-wait fin
core.fork reader
core.fork writer
core.sem-wait fin
chk (= ticks 4) "other coprocesses ran while the reader was blocked"
chk (= got 2) "the reader woke and read the data"
+6 -6
View File
@@ -2,13 +2,13 @@
## stops hak code naming a descriptor it never opened - including hak's own
## multiplexer, signal and io-thread descriptors, and anything the host
## application that embeds hak holds open.
s := (sem-new)
sem-signal-on-input s 0 ##ERROR: system handle 0
s := (core.sem-new)
core.sem-signal-on-input s 0 ##ERROR: system handle 0
---
s := (sem-new)
sem-signal-on-input s 4 ##ERROR: system handle 4
s := (core.sem-new)
core.sem-signal-on-input s 4 ##ERROR: system handle 4
---
@@ -24,8 +24,8 @@ sys.read r (core.basicNew ByteArray 4) ##ERROR: system handle 0
## a regular file is never accepted by the multiplexer: epoll refuses one
## outright, and poll() would report it permanently ready
f := (sys.open "/etc/passwd" "r")
s := (sem-new)
sem-signal-on-input s f ##ERROR: not of an acceptable kind
s := (core.sem-new)
core.sem-signal-on-input s f ##ERROR: not of an acceptable kind
---
+1 -1
View File
@@ -56,7 +56,7 @@ a := (b:get-a)
if (a != 4) {printf "ERROR: a must be 4\n" } \
else { printf "OK %d\n" a }
c := (object-new A)
c := (core.object-new A)
a := (c:get-a)
if (a != nil) {printf "ERROR: a must be nil\n" } \
else { printf "OK %O\n" a }
+10 -10
View File
@@ -16,20 +16,20 @@ fun chk(ok msg) {
else { printf "ERROR: %s\n" msg }
}
iosem := (sem-new)
tmo := (sem-new)
sg := (semgr-new)
semgr-add sg iosem
semgr-add sg tmo
iosem := (core.sem-new)
tmo := (core.sem-new)
sg := (core.semgr-new)
core.semgr-add sg iosem
core.semgr-add sg tmo
## 1 when the handle became readable, 0 when the timer won instead
fun waitin(h secs) {
| s |
sem-signal tmo secs 0
sem-signal-on-input iosem h
s := (semgr-wait sg)
sem-unsignal iosem
sem-unsignal tmo
core.sem-signal tmo secs 0
core.sem-signal-on-input iosem h
s := (core.semgr-wait sg)
core.sem-unsignal iosem
core.sem-unsignal tmo
if (eqv? s tmo) { return 0 } else { return 1 }
}
+18 -18
View File
@@ -15,15 +15,15 @@ fun chk(ok msg) {
else { printf "ERROR: %s\n" msg }
}
sg := (semgr-new)
sa := (sem-new)
sb := (sem-new)
sc := (sem-new)
tmo := (sem-new)
semgr-add sg sa
semgr-add sg sb
semgr-add sg sc
semgr-add sg tmo
sg := (core.semgr-new)
sa := (core.sem-new)
sb := (core.sem-new)
sc := (core.sem-new)
tmo := (core.sem-new)
core.semgr-add sg sa
core.semgr-add sg sb
core.semgr-add sg sc
core.semgr-add sg tmo
## staggered so the completion order is a, then b, then c
pa := (sys.popen "sleep 0.2; echo aaa" "r")
@@ -35,14 +35,14 @@ hb := (core.basicAt pb 2)
hc := (core.basicAt pc 2)
## all three bound at the same time - three live tuple entries
sem-signal-on-input sa ha
sem-signal-on-input sb hb
sem-signal-on-input sc hc
sem-signal tmo 9 0
core.sem-signal-on-input sa ha
core.sem-signal-on-input sb hb
core.sem-signal-on-input sc hc
core.sem-signal tmo 9 0
fun expect(want h name) {
| s buf got |
s := (semgr-wait sg)
s := (core.semgr-wait sg)
chk (eqv? s want) name
buf := (core.basicNew ByteArray 8)
got := (sys.read h buf)
@@ -52,15 +52,15 @@ fun expect(want h name) {
## unbinding sa frees the first slot, so the last entry migrates into it and
## sb/sc must still resolve to their own handles afterwards
expect sa ha "the first child woke its own semaphore"
sem-unsignal sa
core.sem-unsignal sa
expect sb hb "the second child woke its own semaphore after compaction"
sem-unsignal sb
core.sem-unsignal sb
expect sc hc "the third child woke its own semaphore after compaction"
sem-unsignal sc
core.sem-unsignal sc
sem-unsignal tmo
core.sem-unsignal tmo
sys.pclose (core.basicAt pa 0)
sys.pclose (core.basicAt pb 0)
sys.pclose (core.basicAt pc 0)
+67
View File
@@ -0,0 +1,67 @@
## both directions bound to one descriptor, then one of them dropped
##
## Binding an input and an output semaphore to the same handle gives the VM a
## tuple with two directions. Unbinding one of them leaves the other in place,
## so delete_sem_from_sem_io_tuple() modifies the registration rather than
## removing it - vm_muxmod() instead of vm_muxdel(). Nothing else in the suite
## takes that path, so the per-direction event purge behind it is otherwise
## never executed.
##
## A pipe's write end is used because it is always writable, so the output
## semaphore has something to report; the input side is registered but never
## fires, which is fine - what matters is that both directions are registered.
fun chk(ok msg) {
if ok { printf "OK: %s\n" msg } \
else { printf "ERROR: %s\n" msg }
}
sg := (core.semgr-new)
isem := (core.sem-new)
osem := (core.sem-new)
tmo := (core.sem-new)
core.semgr-add sg isem
core.semgr-add sg osem
core.semgr-add sg tmo
p := (sys.pipe)
r := (core.basicAt p 0)
w := (core.basicAt p 1)
## one descriptor, two directions - the tuple now carries both
core.sem-signal-on-input isem w
core.sem-signal-on-output osem w
## drop only the input direction. the output registration must survive, and so
## must any event already reported for it
core.sem-unsignal isem
core.sem-signal tmo 5 0
s := (core.semgr-wait sg)
chk (eqv? s osem) "the surviving direction still reports after a partial unbind"
core.sem-unsignal tmo
## put the input direction back while the output one is still registered. this
## is the add branch of the modify path - the mirror of the drop above - and it
## has to leave the output registration alone.
core.sem-signal-on-input isem w
## now drop the output direction instead, keeping input. a write end is never
## readable, so with input alone nothing can report and the timer must win. if
## the modify path had left the output registration behind, its writability
## would be reported here and the timer would lose.
core.sem-unsignal osem
core.sem-signal tmo 0 300000000
s := (core.semgr-wait sg)
chk (eqv? s tmo) "the dropped direction stops reporting after a partial unbind"
core.sem-unsignal tmo
## and the full unbind from that state really removes the registration
core.sem-unsignal isem
core.sem-signal tmo 0 300000000
s := (core.semgr-wait sg)
chk (eqv? s tmo) "nothing reports once both directions are unbound"
core.sem-unsignal tmo
sys.close r
sys.close w
+14 -14
View File
@@ -8,11 +8,11 @@ fun loop1() {
while (< k 100) {
printf "loop1 => %d\n" k
k := (+ k 2)
yield
core.yield
}
z1 := k
sem-signal s1
core.sem-signal s1
}
fun loop2() {
@@ -22,26 +22,26 @@ fun loop2() {
while (< k 100) {
printf "loop2 => %d\n" k
k := (+ k 2)
yield
core.yield
}
z2 := k
sem-signal s2
core.sem-signal s2
}
s1 := (sem-new)
s2 := (sem-new)
s1 := (core.sem-new)
s2 := (core.sem-new)
p1 := (fork loop1)
p2 := (fork loop2)
p1 := (core.fork loop1)
p2 := (core.fork loop2)
##suspend p1
##suspend p2
##resume p1
##resume p2
##core.suspend p1
##core.suspend p2
##core.resume p1
##core.resume p2
sem-wait s1
sem-wait s2
core.sem-wait s1
core.sem-wait s2
if (== z1 101) { printf "OK: z1 is %d\n" z1 } \
else { printf "ERROR: z1 is not 101 - %d\n" z1 }
+2 -2
View File
@@ -22,10 +22,10 @@ ticks := 0
fun ticker() {
while (< ticks 5) {
ticks := (+ ticks 1)
yield
core.yield
}
}
fork ticker
core.fork ticker
order := (core.basicNew Array 3)
n := 0
+24 -24
View File
@@ -27,23 +27,23 @@ sys.close (core.basicAt q 0)
sys.close (core.basicAt q 1)
## --- catch and uncatch are idempotent ---
chk (= (system-catch-sig sys.SIGUSR1) sys.SIGUSR1) "system-catch-sig returns the signal number"
chk (= (system-catch-sig sys.SIGUSR1) sys.SIGUSR1) "catching an already caught signal is fine"
chk (= (system-uncatch-sig sys.SIGUSR1) sys.SIGUSR1) "system-uncatch-sig returns the signal number"
chk (= (system-uncatch-sig sys.SIGUSR1) sys.SIGUSR1) "uncatching an uncaught signal is fine"
chk (= (sys.sig-catch sys.SIGUSR1) sys.SIGUSR1) "sys.sig-catch returns the signal number"
chk (= (sys.sig-catch sys.SIGUSR1) sys.SIGUSR1) "catching an already caught signal is fine"
chk (= (sys.sig-uncatch sys.SIGUSR1) sys.SIGUSR1) "sys.sig-uncatch returns the signal number"
chk (= (sys.sig-uncatch sys.SIGUSR1) sys.SIGUSR1) "uncatching an uncaught signal is fine"
## --- a real signal reaches hak code, without stalling the coprocesses ---
## SIGCHLD is used because a child exiting is something this test can arrange
## on its own, with no outside help.
system-catch-sig sys.SIGCHLD
sys.sig-catch sys.SIGCHLD
h := (system-get-sigfd)
s := (sem-new)
tmo := (sem-new)
sg := (semgr-new)
semgr-add sg s
semgr-add sg tmo
fin := (sem-new)
h := (sys.sig-getfd)
s := (core.sem-new)
tmo := (core.sem-new)
sg := (core.semgr-new)
core.semgr-add sg s
core.semgr-add sg tmo
fin := (core.sem-new)
ticks := 0
signo := -1
@@ -52,14 +52,14 @@ proc := (core.basicAt pr 0)
fun waiter() {
| w |
sem-signal tmo 20 0
sem-signal-on-input s h
w := (semgr-wait sg)
sem-unsignal s
sem-unsignal tmo
core.sem-signal tmo 20 0
core.sem-signal-on-input s h
w := (core.semgr-wait sg)
core.sem-unsignal s
core.sem-unsignal tmo
if (eqv? w tmo) { signo := -2 } \
else { signo := (system-get-sig) }
sem-signal fin
else { signo := (sys.sig-get) }
core.sem-signal fin
return 0
}
@@ -67,16 +67,16 @@ fun ticker() {
## the waiter is parked on the signal descriptor by now
while (< ticks 4) {
ticks := (+ ticks 1)
yield
core.yield
}
}
fork waiter
fork ticker
sem-wait fin
core.fork waiter
core.fork ticker
core.sem-wait fin
chk (= ticks 4) "coprocesses ran while a coprocess waited on a signal"
chk (= signo sys.SIGCHLD) "the signal number came through the signal descriptor"
chk (= (sys.pwait proc) 4) "and the child's exit status is readable"
sys.pclose proc
system-uncatch-sig sys.SIGCHLD
sys.sig-uncatch sys.SIGCHLD
+3 -3
View File
@@ -54,8 +54,8 @@ chk (== sys.SIGTERM 15) "SIGTERM is 15"
## and the constants behave: a routable one can be caught, an unroutable one
## cannot, whatever the numbers happen to be here
chk (== (system-catch-sig sys.SIGUSR1) sys.SIGUSR1) "SIGUSR1 is catchable"
chk (== (system-uncatch-sig sys.SIGUSR1) sys.SIGUSR1) "SIGUSR1 is uncatchable again"
chk (== (sys.sig-catch sys.SIGUSR1) sys.SIGUSR1) "SIGUSR1 is catchable"
chk (== (sys.sig-uncatch sys.SIGUSR1) sys.SIGUSR1) "SIGUSR1 is uncatchable again"
raised := false
try { system-catch-sig sys.SIGKILL } catch (e) { raised := true }
try { sys.sig-catch sys.SIGKILL } catch (e) { raised := true }
chk raised "SIGKILL is refused"
+10 -10
View File
@@ -1,41 +1,41 @@
## signals that cannot be caught
system-catch-sig sys.SIGKILL ##ERROR: not routable
sys.sig-catch sys.SIGKILL ##ERROR: not routable
---
system-catch-sig sys.SIGSTOP ##ERROR: not routable
sys.sig-catch sys.SIGSTOP ##ERROR: not routable
---
## signals that indicate a crash: turning one into a byte on a pipe and
## carrying on would hide the fault rather than report it
system-catch-sig sys.SIGSEGV ##ERROR: not routable
sys.sig-catch sys.SIGSEGV ##ERROR: not routable
---
system-catch-sig sys.SIGBUS ##ERROR: not routable
sys.sig-catch sys.SIGBUS ##ERROR: not routable
---
system-catch-sig sys.SIGFPE ##ERROR: not routable
sys.sig-catch sys.SIGFPE ##ERROR: not routable
---
system-catch-sig sys.SIGILL ##ERROR: not routable
sys.sig-catch sys.SIGILL ##ERROR: not routable
---
## the timer signal hak itself uses to switch processes
system-catch-sig sys.SIGVTALRM ##ERROR: not routable
sys.sig-catch sys.SIGVTALRM ##ERROR: not routable
---
system-catch-sig 0 ##ERROR: 0 not routable
sys.sig-catch 0 ##ERROR: 0 not routable
---
system-catch-sig 9999 ##ERROR: 9999 not routable
sys.sig-catch 9999 ##ERROR: 9999 not routable
---
system-catch-sig "two" ##ERROR: number not a small integer
sys.sig-catch "two" ##ERROR: number not a small integer
+13 -13
View File
@@ -5,19 +5,19 @@ fun chk(ok msg) {
else { printf "ERROR: %s\n" msg }
}
iosem := (sem-new)
tmo := (sem-new)
sg := (semgr-new)
semgr-add sg iosem
semgr-add sg tmo
iosem := (core.sem-new)
tmo := (core.sem-new)
sg := (core.semgr-new)
core.semgr-add sg iosem
core.semgr-add sg tmo
fun waitin(h secs) {
| s |
sem-signal tmo secs 0
sem-signal-on-input iosem h
s := (semgr-wait sg)
sem-unsignal iosem
sem-unsignal tmo
core.sem-signal tmo secs 0
core.sem-signal-on-input iosem h
s := (core.semgr-wait sg)
core.sem-unsignal iosem
core.sem-unsignal tmo
if (eqv? s tmo) { return 0 } else { return 1 }
}
@@ -38,9 +38,9 @@ fun reap(proc) {
while (< k 300) {
n := (sys.pwait proc)
if (not (= n 256)) { return n }
sem-signal tmo 0 20000000
semgr-wait sg
sem-unsignal tmo
core.sem-signal tmo 0 20000000
core.semgr-wait sg
core.sem-unsignal tmo
k := (+ k 1)
}
return 256
+16 -16
View File
@@ -9,12 +9,12 @@ fun chk(ok msg) {
else { printf "ERROR: %s\n" msg }
}
iosem := (sem-new)
tmo := (sem-new)
sg := (semgr-new)
semgr-add sg iosem
semgr-add sg tmo
fin := (sem-new)
iosem := (core.sem-new)
tmo := (core.sem-new)
sg := (core.semgr-new)
core.semgr-add sg iosem
core.semgr-add sg tmo
fin := (core.sem-new)
p := (sys.popen "sleep 1; exit 5" "r")
proc := (core.basicAt p 0)
@@ -30,14 +30,14 @@ else {
fun waiter() {
| s |
sem-signal tmo 20 0
sem-signal-on-input iosem xh
s := (semgr-wait sg)
sem-unsignal iosem
sem-unsignal tmo
core.sem-signal tmo 20 0
core.sem-signal-on-input iosem xh
s := (core.semgr-wait sg)
core.sem-unsignal iosem
core.sem-unsignal tmo
if (eqv? s tmo) { status := -1 } \
else { status := (sys.pwait proc) }
sem-signal fin
core.sem-signal fin
return 0
}
@@ -46,14 +46,14 @@ else {
## happen if the VM went on scheduling instead of blocking
while (< ticks 4) {
ticks := (+ ticks 1)
yield
core.yield
}
}
chk (integer? xh) "sys.popen hands back an exit handle"
fork waiter
fork ticker
sem-wait fin
core.fork waiter
core.fork ticker
core.sem-wait fin
chk (= ticks 4) "other coprocesses ran while the child was alive"
chk (= status 5) "the exit handle woke the waiter and the status was read"
+10 -7
View File
@@ -199,12 +199,6 @@ static void termreq_round_trips (void)
void* during[NTERMREQ];
void* after[NTERMREQ];
int i;
for (i = 0; i < NTERMREQ; i++)
{
if (disposition_of(TERMREQ[i], &before[i]) <= -1) return; /* no sigaction */
}
#if defined(SIGPIPE)
/* SIGPIPE is deliberately NOT in the set above. It is not a termination
* request - it is the opposite, a measure against being terminated - and
@@ -213,7 +207,16 @@ static void termreq_round_trips (void)
* So termreq must leave it exactly alone. */
void* pipe_before;
void* pipe_during;
int pipe_probed = (disposition_of(SIGPIPE, &pipe_before) >= 0);
int pipe_probed;
#endif
for (i = 0; i < NTERMREQ; i++)
{
if (disposition_of(TERMREQ[i], &before[i]) <= -1) return; /* no sigaction */
}
#if defined(SIGPIPE)
pipe_probed = (disposition_of(SIGPIPE, &pipe_before) >= 0);
#endif
hak_catch_termreq();
+24 -6
View File
@@ -80,12 +80,12 @@ static void state_contract (void)
static const char SRC[] =
"flag := 0\n"
"s := (sem-new)\n"
"fun setter() { flag := 1 ; sem-signal s }\n"
"p := (fork setter)\n"
"s := (core.sem-new)\n"
"fun setter() { flag := 1 ; core.sem-signal s }\n"
"p := (core.fork setter)\n"
"i := 0\n"
"while (< i 300000) { if (== flag 1) { break } ; i := (+ i 1) }\n"
"sem-wait s\n"
"core.sem-wait s\n"
"r := i\n";
static hak_oow_t bc_seen = 0;
@@ -105,6 +105,22 @@ static int on_cnode (hak_t* hak, hak_cnode_t* obj)
return hak_compile(hak, obj, 0);
}
/* The script below reaches the process and semaphore primitives through the
* core module, which is where they are registered. A build configured with
* --enable-static-module links that module in and resolves it unaided, but one
* without it has to load the module from the build tree, and a bare
* hak_openstd() has nowhere to look. HAK_TEST_MODLIBDIRS comes from
* t/Makefile.am and names the same directories run.sh passes to the script
* tests via --modlibdirs. */
static int set_modlibdirs (hak_t* hak)
{
#if defined(HAK_TEST_MODLIBDIRS)
return hak_setoption(hak, HAK_OPT_MODLIBDIRS_BCSTR, HAK_TEST_MODLIBDIRS);
#else
return 0;
#endif
}
static void preempts_a_spinner (void)
{
hak_t* hak;
@@ -117,9 +133,11 @@ static void preempts_a_spinner (void)
OK (hak != HAK_NULL, "instantiation");
if (!hak) return;
hak_getoption(hak, HAK_TRAIT, &trait);
hak_getoption(hak, HAK_OPT_TRAIT, &trait);
trait |= HAK_TRAIT_AWAIT_PROCS | HAK_TRAIT_LANG_ENABLE_EOL;
hak_setoption(hak, HAK_TRAIT, &trait);
hak_setoption(hak, HAK_OPT_TRAIT, &trait);
OK (set_modlibdirs(hak) == 0, "module search path");
memset (&cb, 0, sizeof(cb));
cb.vm_checkbc = cb_checkbc;
+131
View File
@@ -0,0 +1,131 @@
/* process stack overflow must be reported, not swallowed.
*
* HAK_STACK_PUSH() detects the overflow, sets HAK_ESTKOVRFLW and stores -1 in
* hak->abort_req; the interpreter loop then takes "goto oops" and answers a
* failure. That path is only reachable while abort_req is a signed type - when
* it was hak_uint8_t the -1 became 255, the "abort_req < 0" test could never
* be true, and the overflow fell through to the ordinary "abort_req > 0" break
* instead. hak_execute() then answered success and the script simply stopped
* running with nothing reported.
*
* This is checked here rather than in t/ as a script because neither script
* harness can express it: run.sh fails a test as soon as the output contains
* an ERROR: line, and err.sh insists the error be reported at the line its
* ##ERROR: marker sits on, whereas a stack overflow carries no source
* location and is reported at [0,0]. Only a C test can assert on the value
* hak_execute() answers, which is the part that regressed.
*
* The nesting depth is what drives the operand stack: evaluating
* (+ 1 (+ 1 ... 0)) has to hold every pending left operand at once. The
* process stack size is set explicitly here because there is no single
* default to rely on - HAK_DFL_PROCSTK_SIZE is 5000, bin/hak asks for 600,
* and exec.c clamps whatever it is given up to a floor of 192. */
#include <hak.h>
#include "tap.h"
#include <string.h>
#include <stdlib.h>
/* slots per nesting level are an implementation detail, so keep a wide margin
* on both sides of the limit rather than probing for the exact threshold */
#define STK_SLOTS 192
#define DEEP_DEPTH 2000
#define SHALLOW_DEPTH 10
static int on_cnode (hak_t* hak, hak_cnode_t* obj)
{
return hak_compile(hak, obj, 0);
}
/* build "x := (+ 1 (+ 1 ... 0))" nested to the given depth */
static char* make_src (int depth)
{
hak_oow_t capa;
char* buf;
char* p;
int i;
capa = (hak_oow_t)depth * 8 + 64;
buf = (char*)malloc(capa);
if (!buf) return HAK_NULL;
p = buf;
memcpy(p, "x := ", 5); p += 5;
for (i = 0; i < depth; i++) { memcpy(p, "(+ 1 ", 5); p += 5; }
*p++ = '0';
for (i = 0; i < depth; i++) *p++ = ')';
*p++ = '\n';
*p = '\0';
return buf;
}
/* returns 0 if the run completed, -1 if the fixture itself could not be built */
static int run_at_depth (int depth, int expect_overflow)
{
hak_t* hak;
hak_bitmask_t trait;
hak_oow_t stksize;
hak_oop_t retv;
char* src;
int errnum;
int rc = -1;
src = make_src(depth);
OK (src != HAK_NULL, "source built");
if (!src) return -1;
hak = hak_openstd(0, HAK_NULL);
OK (hak != HAK_NULL, "instantiation");
if (!hak) goto done;
hak_getoption(hak, HAK_OPT_TRAIT, &trait);
trait |= HAK_TRAIT_LANG_ENABLE_EOL;
hak_setoption(hak, HAK_OPT_TRAIT, &trait);
stksize = STK_SLOTS;
OK (hak_setoption(hak, HAK_OPT_PROCSTK_SIZE, &stksize) == 0, "process stack size");
OK (hak_ignite(hak, 0) == 0, "ignition");
OK (hak_addbuiltinprims(hak) == 0, "builtin primitives");
OK (hak_attachcciostdwithbcstr(hak, HAK_NULL) == 0, "source input stream");
OK (hak_attachudiostdwithbcstr(hak, "", "") == 0, "user data streams");
OK (hak_beginfeed(hak, on_cnode) == 0, "begin feed");
OK (hak_feedbchars(hak, src, strlen(src)) == 0, "feed the script");
OK (hak_endfeed(hak) == 0, "end feed");
retv = hak_execute(hak);
errnum = (int)hak_geterrnum(hak);
if (expect_overflow)
{
printf("# depth=%d retv=%s errnum=%d (%s)\n", depth,
retv? "value": "HAK_NULL", errnum,
retv? "-": hak_geterrbmsg(hak));
/* the assertion that regressed: a swallowed overflow answers a value */
OK (retv == HAK_NULL, "an overflowing script fails rather than answering a value");
OK (errnum == HAK_ESTKOVRFLW, "the failure is reported as HAK_ESTKOVRFLW");
}
else
{
if (!retv) printf("# depth=%d unexpected failure: [%d] %s\n", depth, errnum, hak_geterrbmsg(hak));
OK (retv != HAK_NULL, "a script within the stack limit still runs");
}
rc = 0;
hak_close(hak);
done:
free(src);
return rc;
}
int main (int argc, char* argv[])
{
no_plan();
/* the control comes first: if this one failed the deep case would pass
* for the wrong reason, since any failure at all answers HAK_NULL */
run_at_depth(SHALLOW_DEPTH, 0);
run_at_depth(DEEP_DEPTH, 1);
return exit_status();
}
+2 -2
View File
@@ -21,7 +21,7 @@ fun setter() { flag := 1 }
## setter is runnable from here on, but it cannot run while this process holds
## the CPU - and this process never calls yield.
p := (fork setter)
p := (core.fork setter)
i := 0
while (< i 3000000) {
@@ -38,7 +38,7 @@ chk (== flag 1) "a process that never yields is preempted so another can run"
## process immediately: then setter would have run before the loop started and
## i would be ~0, proving nothing about preemption. One tick is 20ms, which is
## a great many iterations.
chk (> i 1000) "the switch came from the ticker, not from an eager fork"
chk (> i 1000) "the switch came from the ticker, not from an eager core.fork"
## The preempted process must be resumed, not abandoned - reaching here at all
## means the scheduler came back to it.
+202
View File
@@ -0,0 +1,202 @@
## Two related defects in how 'return' interacts with try/catch. Both are
## fixed; this checks both, because each hid the other while writing the test.
##
## 1. compile_return() emitted TRY_EXIT/CLASS_EXIT before the return value was
## compiled, so the value expression ran with every enclosing handler in the
## function already popped - not just the innermost one. The unwinding now
## comes from emit_return(), after the value is on the operand stack.
## Only the syntactic form used to matter: try { x := (f) } caught what f
## threw while try { return (f) } did not, so both forms appear below.
##
## 2. A 'return', 'break' or 'continue' inside a catch body emitted a TRY_EXIT
## for the very try whose handler it sat in - but 'throw' has already
## unwound that frame, so the second pop drove the exception stack below its
## base. HAK_EXSTACK_IS_EMPTY tests 'exsp <= st', so an underflowed stack
## reads as empty from then on and EVERY later try in the process reported
## 'exception not handled'. The catch body is now compiled with its try
## block marked in_catch, which suppresses the instruction.
##
## That corruption was never visible in the function that caused it, so the
## assertions that actually guard it are the ones exercising a try AFTER a
## catch that returned, broke or continued.
fun chk(ok msg) {
if ok { printf "OK: %s\n" msg } \
else { printf "ERROR: %s\n" msg }
}
fun boom() { throw 99 }
## ------------------------------------------------------------------
## 1. a throw inside a return value
## ------------------------------------------------------------------
fun c1() {
try { return (boom) } catch (e) { return (+ e 1) }
}
chk (= (c1) 100) "a throw in a return value is caught by the enclosing try"
## the catch need not return for the handler to run
seen := 0
fun c2() {
try { return (boom) } catch (e) { seen := e }
return 7
}
chk (= (c2) 7) "execution resumes after the try when the catch falls through"
chk (= seen 99) "the catch body ran"
fun c3() {
try { return (boom) } catch (e) { }
return 8
}
chk (= (c3) 8) "an empty catch body still handles the throw"
## nesting: the innermost handler wins and the outer one stays out of it.
## the old code unwound every enclosing try, so neither fired.
inner := 0
outer := 0
fun c4() {
try {
try { return (boom) } catch (e) { inner := (+ inner 1) }
} catch (e2) { outer := (+ outer 1) }
return 9
}
chk (= (c4) 9) "a nested try returns normally after handling"
chk (= inner 1) "the innermost try catches"
chk (= outer 0) "the outer try is left out of it"
## across a call boundary the callee's own handler wins; the old code let the
## throw escape to the caller's handler instead
g_seen := 0
h_seen := 0
fun g() { try { return (boom) } catch (e) { g_seen := 1 ; return -1 } }
fun h() { try { return (g) } catch (e) { h_seen := 1 ; return -2 } }
chk (= (h) -1) "the callee handles its own throw"
chk (= g_seen 1) "the callee's catch ran"
chk (= h_seen 0) "the caller's catch did not"
## the form that always worked must keep working
fun c5() {
| v |
v := 0
try { v := (boom) } catch (e) { v := e }
return v
}
chk (= (c5) 99) "a throw in an assignment is still caught"
## ------------------------------------------------------------------
## 2. leaving a catch body by return, break or continue
##
## each case is followed by a fresh try: that is where an underflowed
## exception stack shows up, never in the function that caused it.
## ------------------------------------------------------------------
## a try that must still work after the cases above, which all returned from
## inside a catch
fun still1() {
| v |
v := 0
try { v := (boom) } catch (e) { v := 21 }
return v
}
chk (= (still1) 21) "a try still works after earlier catch bodies returned"
## break out of a loop from inside a catch
bj := 0
while (< bj 9) {
bj := (+ bj 1)
try { y := (boom) } catch (e) { break }
}
chk (= bj 1) "break inside a catch leaves the loop"
fun still2() {
| v |
v := 0
try { v := (boom) } catch (e) { v := 22 }
return v
}
chk (= (still2) 22) "a try still works after a break from inside a catch"
## continue to the next iteration from inside a catch
ci := 0
ch := 0
while (< ci 3) {
ci := (+ ci 1)
try { z := (boom) } catch (e) { ch := (+ ch 1) ; continue }
ch := 100
}
chk (= ci 3) "continue inside a catch keeps iterating"
chk (= ch 3) "continue inside a catch skips the rest of the loop body"
fun still3() {
| v |
v := 0
try { v := (boom) } catch (e) { v := 23 }
return v
}
chk (= (still3) 23) "a try still works after a continue from inside a catch"
## the in_catch mark must suppress only the block whose handler we are in. the
## return below sits in the inner catch, so the inner frame is already gone,
## but the outer try is still live and has to be unwound on the way out. a
## frame left behind there would misdirect the next throw instead.
fun nest2() {
try {
try { w := (boom) } catch (e) { return 11 }
} catch (e2) { }
return 12
}
chk (= (nest2) 11) "a return from an inner catch still unwinds the outer try"
fun still4() {
| v |
v := 0
try { v := (boom) } catch (e) { v := 24 }
return v
}
chk (= (still4) 24) "a try still works after returning from a nested catch"
## ------------------------------------------------------------------
## 3. break and continue in a try BODY still unwind
##
## these share emit_ctlblk_unwind with return, and here the frame is live and
## must be popped. a leaked frame per iteration would exhaust the exception
## stack long before these loops finish.
## ------------------------------------------------------------------
i := 0
n := 0
while (< i 2000) {
i := (+ i 1)
try { if (= (mod i 2) 0) { continue } ; n := (+ n 1) } catch (e) { n := -1 }
}
chk (= n 1000) "continue inside a try body unwinds without leaking a handler"
i := 0
while (< i 2000) {
i := (+ i 1)
try { if (= i 7) { break } } catch (e) { }
}
chk (= i 7) "break inside a try body unwinds and leaves the loop"
## ------------------------------------------------------------------
## 4. a handler stays live across a whole call chain
## ------------------------------------------------------------------
hits := 0
caught := 0
fun rec(k) {
if (<= k 0) { throw 55 }
try { return (rec (- k 1)) } catch (e) { hits := (+ hits 1) ; caught := e ; return e }
}
chk (= (rec 20) 55) "recursion with a try per frame propagates the thrown value"
chk (= caught 55) "the thrown value arrives intact"
chk (= hits 1) "only the frame nearest the throw handles it"
fun still5() {
| v |
v := 0
try { v := (boom) } catch (e) { v := 25 }
return v
}
chk (= (still5) 25) "a try still works after deep try-per-frame recursion"