Compare commits
27
Commits
95246943e6
..
main
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
8c2f034082 | ||
|
|
fe7d4c9da1 | ||
|
|
1d17f1e708 | ||
|
|
f99a8c87f0 | ||
|
|
7be5d0fe61 | ||
|
|
baa01b22e3 | ||
|
|
58d1234020 | ||
|
|
bcdc7d8d36 | ||
|
|
1a8cc6ef43 | ||
|
|
15b42bc269 | ||
|
|
992b1344a8 | ||
|
|
27115ca792 | ||
|
|
05b7e3f728 | ||
|
|
e63dc2c2a0 | ||
|
|
92caa7e8db | ||
|
|
4b4238dc50 | ||
|
|
175e666954 | ||
|
|
586094ae8f | ||
|
|
de8c567a87 | ||
|
|
10051c7851 | ||
|
|
df07bd7eb2 | ||
|
|
e5ce0304f8 | ||
|
|
58d3eaa562 | ||
|
|
fdda6998f2 | ||
|
|
2cb4ddf0b3 | ||
|
|
f77ec1049d | ||
|
|
897e7477bc |
@@ -249,8 +249,8 @@ static int handle_logopt (hak_t* hak, const hak_bch_t* logstr)
|
|||||||
}
|
}
|
||||||
|
|
||||||
fname.ptr = (hak_bch_t*)logstr;
|
fname.ptr = (hak_bch_t*)logstr;
|
||||||
hak_setoption (hak, HAK_LOG_TARGET_BCS, &fname);
|
hak_setoption (hak, HAK_OPT_LOG_TARGET_BCS, &fname);
|
||||||
hak_setoption (hak, HAK_LOG_MASK, &logmask);
|
hak_setoption (hak, HAK_OPT_LOG_MASK, &logmask);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -280,9 +280,9 @@ static int handle_dbgopt (hak_t* hak, const hak_bch_t* str)
|
|||||||
}
|
}
|
||||||
while (cm);
|
while (cm);
|
||||||
|
|
||||||
hak_getoption(hak, HAK_TRAIT, &trait);
|
hak_getoption(hak, HAK_OPT_TRAIT, &trait);
|
||||||
trait |= dbgopt;
|
trait |= dbgopt;
|
||||||
hak_setoption(hak, HAK_TRAIT, &trait);
|
hak_setoption(hak, HAK_OPT_TRAIT, &trait);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
@@ -865,6 +865,7 @@ int main (int argc, char* argv[])
|
|||||||
{ ":debug", '\0' },
|
{ ":debug", '\0' },
|
||||||
#endif
|
#endif
|
||||||
{ ":heapsize", '\0' },
|
{ ":heapsize", '\0' },
|
||||||
|
{ ":incdirs", 'I' },
|
||||||
{ ":log", 'l' },
|
{ ":log", 'l' },
|
||||||
{ "info", '\0' },
|
{ "info", '\0' },
|
||||||
{ ":modlibdirs", '\0' },
|
{ ":modlibdirs", '\0' },
|
||||||
@@ -873,7 +874,7 @@ int main (int argc, char* argv[])
|
|||||||
};
|
};
|
||||||
static hak_bopt_t opt =
|
static hak_bopt_t opt =
|
||||||
{
|
{
|
||||||
"l:v",
|
"I:l:v",
|
||||||
lopt
|
lopt
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -882,6 +883,7 @@ int main (int argc, char* argv[])
|
|||||||
int verbose = 0;
|
int verbose = 0;
|
||||||
int show_info = 0;
|
int show_info = 0;
|
||||||
const char* modlibdirs = HAK_NULL;
|
const char* modlibdirs = HAK_NULL;
|
||||||
|
const char* incdirs = HAK_NULL;
|
||||||
|
|
||||||
#if defined(HAK_BUILD_DEBUG)
|
#if defined(HAK_BUILD_DEBUG)
|
||||||
const char* dbgopt = HAK_NULL;
|
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, "Usage: %s [options] script-filename [output-filename]\n", argv[0]);
|
||||||
fprintf(stderr, "Options are:\n");
|
fprintf(stderr, "Options are:\n");
|
||||||
fprintf(stderr, " --info show build information\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, " -l, --log string specify the log file path and options\n");
|
||||||
fprintf(stderr, " --modlibdirs string specify directories to load modules from\n");
|
fprintf(stderr, " --modlibdirs string specify directories to load modules from\n");
|
||||||
fprintf(stderr, " -v show verbose messages\n");
|
fprintf(stderr, " -v show verbose messages\n");
|
||||||
@@ -907,6 +910,10 @@ int main (int argc, char* argv[])
|
|||||||
{
|
{
|
||||||
switch (c)
|
switch (c)
|
||||||
{
|
{
|
||||||
|
case 'I':
|
||||||
|
incdirs = opt.arg;
|
||||||
|
break;
|
||||||
|
|
||||||
case 'l':
|
case 'l':
|
||||||
logopt = opt.arg;
|
logopt = opt.arg;
|
||||||
break;
|
break;
|
||||||
@@ -979,12 +986,16 @@ int main (int argc, char* argv[])
|
|||||||
|
|
||||||
{
|
{
|
||||||
hak_oow_t tab_size;
|
hak_oow_t tab_size;
|
||||||
tab_size = 5000;
|
tab_size = HAK_DFL_SYMTAB_SIZE;
|
||||||
hak_setoption (hak, HAK_SYMTAB_SIZE, &tab_size);
|
hak_setoption (hak, HAK_OPT_SYMTAB_SIZE, &tab_size);
|
||||||
tab_size = 5000;
|
tab_size = HAK_DFL_SYSDIC_SIZE;
|
||||||
hak_setoption (hak, HAK_SYSDIC_SIZE, &tab_size);
|
hak_setoption (hak, HAK_OPT_SYSDIC_SIZE, &tab_size);
|
||||||
tab_size = 600; /* TODO: choose a better stack size or make this user specifiable */
|
tab_size = HAK_DFL_PROCSTK_SIZE; /* TODO: choose a better stack size or make this user specifiable */
|
||||||
hak_setoption (hak, HAK_PROCSTK_SIZE, &tab_size);
|
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_NOGC;*/
|
||||||
trait |= HAK_TRAIT_AWAIT_PROCS;
|
trait |= HAK_TRAIT_AWAIT_PROCS;
|
||||||
trait |= HAK_TRAIT_LANG_ENABLE_EOL;
|
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 (modlibdirs)
|
||||||
{
|
{
|
||||||
#if defined(HAK_OOCH_IS_UCH)
|
/* the option is stored in both encodings, so the byte form from
|
||||||
hak_ooch_t* tmp;
|
* the command line goes in as is - no conversion needed here. */
|
||||||
tmp = hak_dupbtoucstr(hak, modlibdirs, HAK_NULL);
|
if (hak_setoption(hak, HAK_OPT_MODLIBDIRS_BCSTR, modlibdirs) <= -1)
|
||||||
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)
|
|
||||||
{
|
{
|
||||||
hak_logbfmt(hak, HAK_LOG_STDERR,"ERROR: cannot set modlibdirs - [%d] %js\n", hak_geterrnum(hak), hak_geterrmsg(hak));
|
hak_logbfmt(hak, HAK_LOG_STDERR,"ERROR: cannot set modlibdirs - [%d] %js\n", hak_geterrnum(hak), hak_geterrmsg(hak));
|
||||||
goto oops;
|
goto oops;
|
||||||
}
|
}
|
||||||
#endif
|
|
||||||
}
|
}
|
||||||
|
|
||||||
memset (&hakcb, 0, HAK_SIZEOF(hakcb));
|
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.
|
// in the non-INTERACTIVE mode, the compiler generates MAKE_BLOCK for lambda functions.
|
||||||
{
|
{
|
||||||
hak_bitmask_t trait;
|
hak_bitmask_t trait;
|
||||||
hak_getoption(hak, HAK_TRAIT, &trait);
|
hak_getoption(hak, HAK_OPT_TRAIT, &trait);
|
||||||
trait |= HAK_TRAIT_INTERACTIVE;
|
trait |= HAK_TRAIT_INTERACTIVE;
|
||||||
hak_setoption(hak, HAK_TRAIT, &trait);
|
hak_setoption(hak, HAK_OPT_TRAIT, &trait);
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
|||||||
+216
-15
@@ -4,8 +4,10 @@ import (
|
|||||||
"flag"
|
"flag"
|
||||||
"fmt"
|
"fmt"
|
||||||
"hak"
|
"hak"
|
||||||
|
"io"
|
||||||
"os"
|
"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 */
|
/* to be set in build time */
|
||||||
var BINDIR = "."
|
var BINDIR = "."
|
||||||
var SBINDIR = "."
|
var SBINDIR = "."
|
||||||
@@ -25,10 +30,14 @@ var LIBDIR = "."
|
|||||||
var SYSCONFDIR = "."
|
var SYSCONFDIR = "."
|
||||||
|
|
||||||
type Param struct {
|
type Param struct {
|
||||||
log_file string
|
log_target string
|
||||||
|
log_mask hak.BitMask
|
||||||
input_file string
|
input_file string
|
||||||
heapsize uint
|
heapsize uint
|
||||||
modlibdirs string
|
modlibdirs string
|
||||||
|
incdirs string
|
||||||
|
verbose bool
|
||||||
|
show_info bool
|
||||||
fs_usage func()
|
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 {
|
func handle_arguments(param *Param) error {
|
||||||
/*
|
/*
|
||||||
var nargs int = len(os.Args)
|
var nargs int = len(os.Args)
|
||||||
@@ -64,34 +160,110 @@ func handle_arguments(param *Param) error {
|
|||||||
var fs *flag.FlagSet
|
var fs *flag.FlagSet
|
||||||
var heapsize *uint
|
var heapsize *uint
|
||||||
var modlibdirs *string
|
var modlibdirs *string
|
||||||
|
var incdirs *string
|
||||||
var log *string
|
var log *string
|
||||||
|
var verbose *bool
|
||||||
|
var show_info *bool
|
||||||
var err error
|
var err error
|
||||||
|
|
||||||
fs = flag.NewFlagSet(os.Args[0], flag.ContinueOnError)
|
fs = flag.NewFlagSet(os.Args[0], flag.ContinueOnError)
|
||||||
|
|
||||||
heapsize = fs.Uint("heapsize", 0, "specify heap size")
|
/* the same set bin/hak.c accepts. the flag package treats -x and --x
|
||||||
modlibdirs = fs.String("modlibdirs", "", "specify module library directories")
|
* alike, so registering both spellings of a short option is enough to
|
||||||
log = fs.String("log", "", "specify log file")
|
* 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
|
param.fs_usage = fs.Usage
|
||||||
fs.Usage = empty_usage // i don't want fs.Parse() print the 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:])
|
err = fs.Parse(os.Args[1:])
|
||||||
fs.Usage = param.fs_usage // restore it
|
fs.Usage = param.fs_usage // restore it
|
||||||
|
fs.SetOutput(os.Stderr) // so the restored usage still prints
|
||||||
if err != nil {
|
if err != nil {
|
||||||
return fmt.Errorf("command line error - %s", err.Error())
|
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 {
|
if fs.NArg() < 1 {
|
||||||
return fmt.Errorf("no input file specified")
|
return fmt.Errorf("no input file specified")
|
||||||
} else if fs.NArg() > 1 {
|
} 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")
|
return fmt.Errorf("too many input files specified")
|
||||||
}
|
}
|
||||||
|
|
||||||
param.input_file = fs.Arg(0);
|
param.input_file = fs.Arg(0)
|
||||||
param.log_file = *log // TODO: parse the option part (e.g. --log /dev/stderr,debug+)
|
return nil
|
||||||
param.heapsize = *heapsize // TODO: set this to hak
|
}
|
||||||
param.modlibdirs = *modlibdirs // TODO: set this to hak
|
|
||||||
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() {
|
func main() {
|
||||||
@@ -99,6 +271,7 @@ func main() {
|
|||||||
var x *hak.Hak = nil
|
var x *hak.Hak = nil
|
||||||
var err error = nil
|
var err error = nil
|
||||||
var param Param
|
var param Param
|
||||||
|
var stop_ticker func()
|
||||||
|
|
||||||
var rfh hak.CciFileHandler
|
var rfh hak.CciFileHandler
|
||||||
var sfh hak.UdiFileHandler
|
var sfh hak.UdiFileHandler
|
||||||
@@ -111,20 +284,39 @@ func main() {
|
|||||||
os.Exit(1)
|
os.Exit(1)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if param.show_info {
|
||||||
|
fmt.Println(hak.BuildInfo())
|
||||||
|
os.Exit(0)
|
||||||
|
}
|
||||||
|
|
||||||
x, err = hak.New()
|
x, err = hak.New()
|
||||||
if err != nil {
|
if err != nil {
|
||||||
fmt.Printf("ERROR: failed to instantiate hak - %s\n", err.Error())
|
fmt.Printf("ERROR: failed to instantiate hak - %s\n", err.Error())
|
||||||
os.Exit(1)
|
os.Exit(1)
|
||||||
}
|
}
|
||||||
|
|
||||||
if param.log_file != "" {
|
if param.log_target != "" {
|
||||||
x.SetLogMask(^hak.BitMask(0))
|
/* honour both halves of --log. the previous code discarded the path
|
||||||
x.SetLogTarget("/dev/stderr")
|
* 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)
|
x.SetTrait(x.GetTrait() | hak.TRAIT_LANG_ENABLE_EOL)
|
||||||
|
|
||||||
err = x.Ignite(1000000)
|
err = x.Ignite(uintptr(param.heapsize))
|
||||||
if err != nil {
|
if err != nil {
|
||||||
fmt.Printf("ERROR: failed to ignite - %s\n", err.Error())
|
fmt.Printf("ERROR: failed to ignite - %s\n", err.Error())
|
||||||
goto oops
|
goto oops
|
||||||
@@ -169,16 +361,25 @@ func main() {
|
|||||||
goto oops
|
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.Decode()
|
||||||
x.SetLogMask(0)
|
|
||||||
|
|
||||||
|
stop_ticker = start_ticker(x)
|
||||||
err = x.Execute()
|
err = x.Execute()
|
||||||
|
stop_ticker()
|
||||||
if err != nil {
|
if err != nil {
|
||||||
//fmt.Printf("ERROR: %s[%d:%d] - %s\n", herr.File, herr.Line, herr.Colm, herr.Msg)
|
//fmt.Printf("ERROR: %s[%d:%d] - %s\n", herr.File, herr.Line, herr.Colm, herr.Msg)
|
||||||
fmt.Printf("ERROR: %s\n", err.Error())
|
fmt.Printf("ERROR: %s\n", err.Error())
|
||||||
goto oops
|
goto oops
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if param.verbose {
|
||||||
|
fmt.Printf("EXECUTION OK - %s\n", param.input_file)
|
||||||
|
}
|
||||||
|
|
||||||
x.Close()
|
x.Close()
|
||||||
os.Exit(0)
|
os.Exit(0)
|
||||||
|
|
||||||
|
|||||||
@@ -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\n" "$as_me:${as_lineno-$LINENO}: checking for __builtin_memset" >&5
|
||||||
printf %s "checking for __builtin_memset... " >&6; }
|
printf %s "checking for __builtin_memset... " >&6; }
|
||||||
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
|
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
|
||||||
@@ -17157,6 +17196,7 @@ then :
|
|||||||
|
|
||||||
fi
|
fi
|
||||||
|
|
||||||
|
|
||||||
ac_fn_c_check_func "$LINENO" "posix_spawn" "ac_cv_func_posix_spawn"
|
ac_fn_c_check_func "$LINENO" "posix_spawn" "ac_cv_func_posix_spawn"
|
||||||
if test "x$ac_cv_func_posix_spawn" = xyes
|
if test "x$ac_cv_func_posix_spawn" = xyes
|
||||||
then :
|
then :
|
||||||
|
|||||||
@@ -70,6 +70,24 @@ AC_SUBST(LIBM, $LIBM)
|
|||||||
|
|
||||||
AX_PTHREAD()
|
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
|
dnl check some compiler builtins
|
||||||
AC_MSG_CHECKING([for __builtin_memset])
|
AC_MSG_CHECKING([for __builtin_memset])
|
||||||
AC_LINK_IFELSE(
|
AC_LINK_IFELSE(
|
||||||
@@ -132,6 +150,7 @@ AC_CHECK_FUNCS([sigaction signal])
|
|||||||
AC_CHECK_FUNCS([snprintf _vsnprintf _vsnwprintf strerror_r])
|
AC_CHECK_FUNCS([snprintf _vsnprintf _vsnwprintf strerror_r])
|
||||||
AC_CHECK_FUNCS([accept4 pipe2 epoll_create epoll_create1 kqueue kqueue1])
|
AC_CHECK_FUNCS([accept4 pipe2 epoll_create epoll_create1 kqueue kqueue1])
|
||||||
AC_CHECK_FUNCS([isatty mmap munmap])
|
AC_CHECK_FUNCS([isatty mmap munmap])
|
||||||
|
|
||||||
AC_CHECK_FUNCS([posix_spawn getrlimit sysconf dirfd])
|
AC_CHECK_FUNCS([posix_spawn getrlimit sysconf dirfd])
|
||||||
dnl dirfd may be provided as a macro rather than a function
|
dnl dirfd may be provided as a macro rather than a function
|
||||||
AC_CHECK_DECLS([dirfd],[],[],[[#include <dirent.h>]])
|
AC_CHECK_DECLS([dirfd],[],[],[[#include <dirent.h>]])
|
||||||
|
|||||||
@@ -12,6 +12,7 @@ import (
|
|||||||
"io"
|
"io"
|
||||||
"os"
|
"os"
|
||||||
"path"
|
"path"
|
||||||
|
"strings"
|
||||||
"path/filepath"
|
"path/filepath"
|
||||||
"reflect"
|
"reflect"
|
||||||
"sync"
|
"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 (
|
var (
|
||||||
ioarg *C.hak_io_cciarg_t
|
ioarg *C.hak_io_cciarg_t
|
||||||
name string
|
name string
|
||||||
|
raw string
|
||||||
|
try_incdirs bool
|
||||||
fd int
|
fd int
|
||||||
tptr unsafe.Pointer
|
tptr unsafe.Pointer
|
||||||
tlen C.size_t
|
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
|
// actual included stream
|
||||||
var includer_name string
|
var includer_name string
|
||||||
|
|
||||||
name = string(ucstr_to_rune_slice(ioarg.name))
|
raw = string(ucstr_to_rune_slice(ioarg.name))
|
||||||
|
|
||||||
tptr = ioarg.includer.handle
|
tptr = ioarg.includer.handle
|
||||||
tlen = *(*C.size_t)(unsafe.Pointer(uintptr(tptr) + unsafe.Sizeof(fd)))
|
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))
|
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
|
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)
|
tptr = C.hak_allocmem(c, C.size_t(unsafe.Sizeof(fd)) + C.size_t(unsafe.Sizeof(tlen)) + tlen)
|
||||||
if tptr == nil {
|
if tptr == nil {
|
||||||
|
if ioarg.includer != nil {
|
||||||
|
g.io.cci.Close(fd)
|
||||||
|
}
|
||||||
g.set_errmsg(C.HAK_ESYSMEM, "cci name allocation failure")
|
g.set_errmsg(C.HAK_ESYSMEM, "cci name allocation failure")
|
||||||
return -1
|
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 |
|
// | fd | length | name bytes of the length |
|
||||||
*(*int)(tptr) = fd;
|
*(*int)(tptr) = fd;
|
||||||
*(*C.size_t)(unsafe.Pointer(uintptr(tptr)+unsafe.Sizeof(fd))) = tlen;
|
*(*C.size_t)(unsafe.Pointer(uintptr(tptr)+unsafe.Sizeof(fd))) = tlen;
|
||||||
|
|||||||
@@ -76,6 +76,38 @@ type BitMask C.hak_bitmask_t
|
|||||||
|
|
||||||
const TRAIT_LANG_ENABLE_EOL BitMask = C.HAK_TRAIT_LANG_ENABLE_EOL
|
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) {
|
func deregister_instance(g *Hak) {
|
||||||
if g.inst_no >= 0 {
|
if g.inst_no >= 0 {
|
||||||
inst_table.delete_instance(g.inst_no)
|
inst_table.delete_instance(g.inst_no)
|
||||||
@@ -142,7 +174,7 @@ func (hak *Hak) GetTrait() BitMask {
|
|||||||
var x C.int
|
var x C.int
|
||||||
var log_mask BitMask = 0
|
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 {
|
if x <= -1 {
|
||||||
// this must not happen
|
// this must not happen
|
||||||
panic(fmt.Errorf("unable to get log mask - %s", hak.get_errmsg()))
|
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) {
|
func (hak *Hak) SetTrait(log_mask BitMask) {
|
||||||
var x C.int
|
var x C.int
|
||||||
|
|
||||||
x = C.hak_setoption(hak.c, C.HAK_TRAIT, unsafe.Pointer(&log_mask))
|
x = C.hak_setoption(hak.c, C.HAK_OPT_TRAIT, unsafe.Pointer(&log_mask))
|
||||||
if x <= -1 {
|
if x <= -1 {
|
||||||
// this must not happen
|
// this must not happen
|
||||||
panic(fmt.Errorf("unable to set log mask - %s", hak.get_errmsg()))
|
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 x C.int
|
||||||
var log_mask BitMask = 0
|
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 {
|
if x <= -1 {
|
||||||
// this must not happen
|
// this must not happen
|
||||||
panic(fmt.Errorf("unable to get log mask - %s", hak.get_errmsg()))
|
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) {
|
func (hak *Hak) SetLogMask(log_mask BitMask) {
|
||||||
var x C.int
|
var x C.int
|
||||||
|
|
||||||
x = C.hak_setoption(hak.c, C.HAK_LOG_MASK, unsafe.Pointer(&log_mask))
|
x = C.hak_setoption(hak.c, C.HAK_OPT_LOG_MASK, unsafe.Pointer(&log_mask))
|
||||||
if x <= -1 {
|
if x <= -1 {
|
||||||
// this must not happen
|
// this must not happen
|
||||||
panic(fmt.Errorf("unable to set log mask - %s", hak.get_errmsg()))
|
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 x C.int
|
||||||
var tgt *C.char
|
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 {
|
if x <= -1 {
|
||||||
// this must not happen
|
// 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)
|
return C.GoString(tgt)
|
||||||
}
|
}
|
||||||
|
|
||||||
func (hak *Hak) SetLogTarget(target string) {
|
func (hak *Hak) SetLogTarget(target string) error {
|
||||||
var x C.int
|
var x C.int
|
||||||
var tgt *C.char
|
var tgt *C.char
|
||||||
|
|
||||||
tgt = C.CString(target) // TODO: need error check?
|
tgt = C.CString(target) // TODO: need error check?
|
||||||
defer C.free(unsafe.Pointer(tgt))
|
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 {
|
if x <= -1 {
|
||||||
// this must not happen
|
// 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 {
|
func (hak *Hak) Ignite(memsize uintptr) error {
|
||||||
@@ -399,6 +482,16 @@ func (hak *Hak) Decode() error {
|
|||||||
return nil
|
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 {
|
func (hak *Hak) get_errmsg() string {
|
||||||
return C.GoString(C.hak_geterrbmsg(hak.c))
|
return C.GoString(C.hak_geterrbmsg(hak.c))
|
||||||
}
|
}
|
||||||
|
|||||||
+67
-58
@@ -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_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]._type = type;
|
||||||
|
/*hak->c->ctlblk.info[new_depth].in_catch = 0; not needed for memset above */
|
||||||
hak->c->ctlblk.depth = new_depth;
|
hak->c->ctlblk.depth = new_depth;
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@@ -2090,12 +2091,60 @@ static HAK_INLINE int emit_plus (hak_t* hak)
|
|||||||
#endif
|
#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)
|
static int compile_break (hak_t* hak, hak_cnode_t* src)
|
||||||
{
|
{
|
||||||
/* (break) */
|
/* (break) */
|
||||||
hak_cnode_t* cmd, * obj;
|
hak_cnode_t* cmd, * obj;
|
||||||
hak_ooi_t i;
|
hak_ooi_t i;
|
||||||
|
int n;
|
||||||
|
|
||||||
HAK_ASSERT(hak, HAK_CNODE_IS_CONS(src));
|
HAK_ASSERT(hak, HAK_CNODE_IS_CONS(src));
|
||||||
HAK_ASSERT(hak, HAK_CNODE_IS_TYPED(HAK_CNODE_CONS_CAR(src), HAK_CNODE_BREAK));
|
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;
|
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)
|
hak_setsynerrbfmt(hak, HAK_SYNERR_BREAK, HAK_CNODE_GET_LOC(cmd),
|
||||||
{
|
|
||||||
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),
|
|
||||||
"%.*js outside loop", HAK_CNODE_GET_TOKLEN(cmd), HAK_CNODE_GET_TOKPTR(cmd));
|
"%.*js outside loop", HAK_CNODE_GET_TOKLEN(cmd), HAK_CNODE_GET_TOKPTR(cmd));
|
||||||
return -1;
|
return -1;
|
||||||
|
}
|
||||||
|
|
||||||
inside_loop:
|
|
||||||
for (i = hak->c->cfs.top; i >= 0; --i)
|
for (i = hak->c->cfs.top; i >= 0; --i)
|
||||||
{
|
{
|
||||||
const hak_cframe_t* tcf;
|
const hak_cframe_t* tcf;
|
||||||
@@ -2217,6 +2251,7 @@ static int compile_continue (hak_t* hak, hak_cnode_t* src)
|
|||||||
/* (continue) */
|
/* (continue) */
|
||||||
hak_cnode_t* cmd, * obj;
|
hak_cnode_t* cmd, * obj;
|
||||||
hak_ooi_t i;
|
hak_ooi_t i;
|
||||||
|
int n;
|
||||||
|
|
||||||
HAK_ASSERT(hak, HAK_CNODE_IS_CONS(src));
|
HAK_ASSERT(hak, HAK_CNODE_IS_CONS(src));
|
||||||
HAK_ASSERT(hak, HAK_CNODE_IS_TYPED(HAK_CNODE_CONS_CAR(src), HAK_CNODE_CONTINUE));
|
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;
|
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)
|
hak_setsynerrbfmt(hak, HAK_SYNERR_BREAK, HAK_CNODE_GET_LOC(cmd),
|
||||||
{
|
|
||||||
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),
|
|
||||||
"%.*js outside loop", HAK_CNODE_GET_TOKLEN(cmd), HAK_CNODE_GET_TOKPTR(cmd));
|
"%.*js outside loop", HAK_CNODE_GET_TOKLEN(cmd), HAK_CNODE_GET_TOKPTR(cmd));
|
||||||
return -1;
|
return -1;
|
||||||
|
}
|
||||||
|
|
||||||
inside_loop:
|
|
||||||
for (i = hak->c->cfs.top; i >= 0; --i)
|
for (i = hak->c->cfs.top; i >= 0; --i)
|
||||||
{
|
{
|
||||||
const hak_cframe_t* tcf;
|
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_cnode_t* obj, * val;
|
||||||
hak_cframe_t* cf;
|
hak_cframe_t* cf;
|
||||||
hak_funblk_info_t* fbi;
|
hak_funblk_info_t* fbi;
|
||||||
hak_ooi_t i;
|
|
||||||
|
|
||||||
HAK_ASSERT(hak, HAK_CNODE_IS_CONS(src));
|
HAK_ASSERT(hak, HAK_CNODE_IS_CONS(src));
|
||||||
HAK_ASSERT(hak, HAK_CNODE_IS_TYPED(HAK_CNODE_CONS_CAR(src), HAK_CNODE_RETURN) ||
|
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];
|
fbi = &hak->c->funblk.info[hak->c->funblk.depth];
|
||||||
obj = HAK_CNODE_CONS_CDR(src);
|
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)
|
if (fbi->tmpr_nrvars > 0)
|
||||||
{
|
{
|
||||||
hak_cnode_t* tmp = HAK_CNODE_CONS_CAR(src);
|
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;
|
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... */
|
/* 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;
|
if (emit_byte_instruction(hak, HAK_CODE_PUSH_RETURN_R, HAK_CNODE_GET_LOC(tmp)) <= -1) return -1;
|
||||||
POP_CFRAME(hak);
|
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 */
|
/* 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;
|
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);
|
SWITCH_TOP_CFRAME(hak, COP_COMPILE_OBJECT_LIST, obj);
|
||||||
|
|
||||||
PUSH_SUBCFRAME(hak, COP_POST_CATCH, cmd);
|
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->opcode == COP_EMIT_RETURN);
|
||||||
HAK_ASSERT(hak, cf->operand != HAK_NULL);
|
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));
|
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);
|
POP_CFRAME(hak);
|
||||||
|
|||||||
+169
-64
@@ -180,6 +180,8 @@ static void terminate_all_processes (hak_t* hak);
|
|||||||
ap->exsp = HAK_SMOOI_TO_OOP(exsp); \
|
ap->exsp = HAK_SMOOI_TO_OOP(exsp); \
|
||||||
} while (0)
|
} 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_ST(hak) HAK_OOP_TO_SMOOI(((hak)->processor->active)->exst)
|
||||||
#define HAK_EXSTACK_GET_SP(hak) HAK_OOP_TO_SMOOI(((hak)->processor->active)->exsp)
|
#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_))
|
#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_ST(hak) HAK_OOP_TO_SMOOI(((hak)->processor->active)->clst)
|
||||||
#define HAK_CLSTACK_GET_SP(hak) HAK_OOP_TO_SMOOI(((hak)->processor->active)->clsp)
|
#define HAK_CLSTACK_GET_SP(hak) HAK_OOP_TO_SMOOI(((hak)->processor->active)->clsp)
|
||||||
|
|
||||||
@@ -385,6 +389,7 @@ static HAK_INLINE hak_oop_context_t make_context (hak_t* hak, hak_ooi_t ntmprs)
|
|||||||
hak_oop_context_t ctx;
|
hak_oop_context_t ctx;
|
||||||
|
|
||||||
HAK_ASSERT(hak, ntmprs >= 0);
|
HAK_ASSERT(hak, ntmprs >= 0);
|
||||||
|
|
||||||
/*return (hak_oop_context_t)hak_allocoopobj(hak, HAK_BRAND_CONTEXT, HAK_CONTEXT_NAMED_INSTVARS + (hak_oow_t)ntmprs);*/
|
/*return (hak_oop_context_t)hak_allocoopobj(hak, HAK_BRAND_CONTEXT, HAK_CONTEXT_NAMED_INSTVARS + (hak_oow_t)ntmprs);*/
|
||||||
ctx = (hak_oop_context_t)hak_instantiate(hak, hak->c_block_context, HAK_NULL, ntmprs);
|
ctx = (hak_oop_context_t)hak_instantiate(hak, hak->c_block_context, HAK_NULL, ntmprs);
|
||||||
|
|
||||||
@@ -397,15 +402,11 @@ static HAK_INLINE hak_oop_context_t make_context (hak_t* hak, hak_ooi_t ntmprs)
|
|||||||
}
|
}
|
||||||
|
|
||||||
#if defined(HAK_ENABLE_STACK_CONTEXT)
|
#if defined(HAK_ENABLE_STACK_CONTEXT)
|
||||||
#define HAK_USE_STACK_CONTEXT_FOR_FUNCTION 1
|
|
||||||
#define HAK_USE_STACK_CONTEXT_FOR_BLOCK 1
|
|
||||||
|
|
||||||
static HAK_INLINE hak_oop_t* alloc_frame_slots (hak_t* hak, hak_oow_t nslots)
|
static HAK_INLINE hak_oop_t* alloc_frame_slots (hak_t* hak, hak_oop_process_t proc, hak_oow_t nslots)
|
||||||
{
|
{
|
||||||
hak_oop_process_t proc;
|
|
||||||
hak_ooi_t sp, st;
|
hak_ooi_t sp, st;
|
||||||
|
|
||||||
proc = hak->processor->active;
|
|
||||||
HAK_ASSERT(hak, proc != hak->nil_process);
|
HAK_ASSERT(hak, proc != hak->nil_process);
|
||||||
|
|
||||||
sp = HAK_OOP_TO_SMOOI(proc->fsp);
|
sp = HAK_OOP_TO_SMOOI(proc->fsp);
|
||||||
@@ -420,7 +421,7 @@ static HAK_INLINE hak_oop_t* alloc_frame_slots (hak_t* hak, hak_oow_t nslots)
|
|||||||
return &proc->slot[sp + 1];
|
return &proc->slot[sp + 1];
|
||||||
}
|
}
|
||||||
|
|
||||||
static HAK_INLINE hak_oop_context_t make_stack_context (hak_t* hak, hak_ooi_t ntmprs)
|
static HAK_INLINE hak_oop_context_t make_stack_context (hak_t* hak, hak_oop_process_t proc, hak_ooi_t ntmprs)
|
||||||
{
|
{
|
||||||
hak_oop_t* base;
|
hak_oop_t* base;
|
||||||
hak_stack_context_t* sctx;
|
hak_stack_context_t* sctx;
|
||||||
@@ -429,8 +430,8 @@ static HAK_INLINE hak_oop_context_t make_stack_context (hak_t* hak, hak_ooi_t nt
|
|||||||
|
|
||||||
HAK_ASSERT(hak, ntmprs >= 0);
|
HAK_ASSERT(hak, ntmprs >= 0);
|
||||||
|
|
||||||
frame_base = HAK_OOP_TO_SMOOI(hak->processor->active->fsp);
|
frame_base = HAK_OOP_TO_SMOOI(proc->fsp);
|
||||||
base = alloc_frame_slots(hak, HAK_STACK_CONTEXT_NAMED_SLOTS + (hak_oow_t)ntmprs);
|
base = alloc_frame_slots(hak, proc, HAK_STACK_CONTEXT_NAMED_SLOTS + (hak_oow_t)ntmprs);
|
||||||
if (HAK_UNLIKELY(!base)) return HAK_NULL;
|
if (HAK_UNLIKELY(!base)) return HAK_NULL;
|
||||||
|
|
||||||
sctx = (hak_stack_context_t*)base;
|
sctx = (hak_stack_context_t*)base;
|
||||||
@@ -453,30 +454,18 @@ static HAK_INLINE hak_oop_context_t make_stack_context (hak_t* hak, hak_ooi_t nt
|
|||||||
sctx->slot_count = HAK_SMOOI_TO_OOP(ntmprs);
|
sctx->slot_count = HAK_SMOOI_TO_OOP(ntmprs);
|
||||||
sctx->stack_base = HAK_SMOOI_TO_OOP(hak->sp);
|
sctx->stack_base = HAK_SMOOI_TO_OOP(hak->sp);
|
||||||
sctx->frame_base = HAK_SMOOI_TO_OOP(frame_base);
|
sctx->frame_base = HAK_SMOOI_TO_OOP(frame_base);
|
||||||
sctx->heap_ctx = hak->_nil;
|
sctx->heap_ctx = hak->_nil; /* not reified yet. set to nil */
|
||||||
for (i = 0; i < ntmprs; i++) sctx->slot_base[i] = hak->_nil;
|
for (i = 0; i < ntmprs; i++) sctx->slot[i] = hak->_nil;
|
||||||
/* end of extra fields */
|
/* end of extra fields */
|
||||||
|
|
||||||
return (hak_oop_context_t)HAK_SMPTR_TO_OOP(sctx);
|
return (hak_oop_context_t)HAK_SMPTR_TO_OOP(sctx);
|
||||||
}
|
}
|
||||||
|
|
||||||
static HAK_INLINE hak_oop_context_t make_context_for_activation (hak_t* hak, hak_ooi_t ntmprs, int use_stack)
|
|
||||||
{
|
|
||||||
if (use_stack)
|
|
||||||
{
|
|
||||||
hak_oop_context_t ctx = make_stack_context(hak, ntmprs);
|
|
||||||
if (HAK_UNLIKELY(!ctx)) return HAK_NULL;
|
|
||||||
return ctx;
|
|
||||||
}
|
|
||||||
|
|
||||||
return make_context(hak, ntmprs);
|
|
||||||
}
|
|
||||||
|
|
||||||
static HAK_INLINE hak_oop_context_t reify_context_ref (hak_t* hak, hak_oop_t ctx)
|
static HAK_INLINE hak_oop_context_t reify_context_ref (hak_t* hak, hak_oop_t ctx)
|
||||||
{
|
{
|
||||||
if ((hak_oop_t)ctx == hak->_nil) return (hak_oop_context_t)ctx;
|
if ((hak_oop_t)ctx == hak->_nil) return (hak_oop_context_t)ctx;
|
||||||
if (!HAK_CTX_IS_STACK(ctx)) return (hak_oop_context_t)ctx;
|
if (!HAK_CTX_IS_STACK(ctx)) return (hak_oop_context_t)ctx;
|
||||||
return hak_reify_stack_context(hak, HAK_CTX_TO_STACK(ctx));
|
return hak_reifystackcontext(hak, HAK_CTX_TO_STACK(ctx));
|
||||||
}
|
}
|
||||||
|
|
||||||
static HAK_INLINE void release_stack_context (hak_t* hak, hak_oop_t ctx)
|
static HAK_INLINE void release_stack_context (hak_t* hak, hak_oop_t ctx)
|
||||||
@@ -488,13 +477,14 @@ static HAK_INLINE void release_stack_context (hak_t* hak, hak_oop_t ctx)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
hak_oop_context_t hak_reify_stack_context (hak_t* hak, hak_stack_context_t* sctx)
|
hak_oop_context_t hak_reifystackcontext (hak_t* hak, hak_stack_context_t* sctx)
|
||||||
{
|
{
|
||||||
hak_oop_context_t ctx;
|
hak_oop_context_t ctx;
|
||||||
hak_oop_t heap_ctx;
|
hak_oop_t heap_ctx;
|
||||||
hak_ooi_t slot_count;
|
hak_ooi_t slot_count;
|
||||||
hak_ooi_t i;
|
hak_ooi_t i;
|
||||||
|
|
||||||
|
/* check if already reified */
|
||||||
heap_ctx = sctx->heap_ctx;
|
heap_ctx = sctx->heap_ctx;
|
||||||
if ((hak_oop_t)heap_ctx != hak->_nil) return (hak_oop_context_t)heap_ctx;
|
if ((hak_oop_t)heap_ctx != hak->_nil) return (hak_oop_context_t)heap_ctx;
|
||||||
|
|
||||||
@@ -502,6 +492,7 @@ hak_oop_context_t hak_reify_stack_context (hak_t* hak, hak_stack_context_t* sctx
|
|||||||
ctx = make_context(hak, slot_count);
|
ctx = make_context(hak, slot_count);
|
||||||
if (HAK_UNLIKELY(!ctx)) return HAK_NULL;
|
if (HAK_UNLIKELY(!ctx)) return HAK_NULL;
|
||||||
|
|
||||||
|
/* cache it */
|
||||||
sctx->heap_ctx = (hak_oop_t)ctx;
|
sctx->heap_ctx = (hak_oop_t)ctx;
|
||||||
|
|
||||||
/* main fields */
|
/* main fields */
|
||||||
@@ -524,26 +515,10 @@ hak_oop_context_t hak_reify_stack_context (hak_t* hak, hak_stack_context_t* sctx
|
|||||||
if (HAK_UNLIKELY(!ctx->mthhome)) return HAK_NULL;
|
if (HAK_UNLIKELY(!ctx->mthhome)) return HAK_NULL;
|
||||||
/* end of main fields */
|
/* end of main fields */
|
||||||
|
|
||||||
for (i = 0; i < slot_count; i++) ctx->slot[i] = sctx->slot_base[i];
|
for (i = 0; i < slot_count; i++) ctx->slot[i] = sctx->slot[i];
|
||||||
|
|
||||||
return ctx;
|
return ctx;
|
||||||
}
|
}
|
||||||
#else
|
|
||||||
|
|
||||||
#define HAK_USE_STACK_CONTEXT_FOR_FUNCTION 0
|
|
||||||
#define HAK_USE_STACK_CONTEXT_FOR_BLOCK 0
|
|
||||||
|
|
||||||
static HAK_INLINE hak_oop_context_t make_context_for_activation (hak_t* hak, hak_ooi_t ntmprs, int use_stack)
|
|
||||||
{
|
|
||||||
(void)use_stack;
|
|
||||||
return make_context(hak, ntmprs);
|
|
||||||
}
|
|
||||||
|
|
||||||
static HAK_INLINE void release_stack_context (hak_t* hak, hak_oop_t ctx)
|
|
||||||
{
|
|
||||||
(void)hak;
|
|
||||||
(void)ctx;
|
|
||||||
}
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
static HAK_INLINE hak_oop_function_t make_function (hak_t* hak, hak_oow_t lfsize, const hak_oob_t* bptr, hak_oow_t blen, hak_dbgi_t* dbgi)
|
static HAK_INLINE hak_oop_function_t make_function (hak_t* hak, hak_oow_t lfsize, const hak_oob_t* bptr, hak_oow_t blen, hak_dbgi_t* dbgi)
|
||||||
@@ -695,7 +670,7 @@ static HAK_INLINE void free_pid (hak_t* hak, hak_oop_process_t proc)
|
|||||||
hak->proc_map_used--;
|
hak->proc_map_used--;
|
||||||
}
|
}
|
||||||
|
|
||||||
static hak_oop_process_t make_process (hak_t* hak, hak_oop_context_t c)
|
static hak_oop_process_t make_process (hak_t* hak, hak_oop_context_t ctx)
|
||||||
{
|
{
|
||||||
hak_oop_process_t proc;
|
hak_oop_process_t proc;
|
||||||
hak_oow_t stksize, exstksize, clstksize, fstksize, maxsize;
|
hak_oow_t stksize, exstksize, clstksize, fstksize, maxsize;
|
||||||
@@ -715,32 +690,35 @@ 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;
|
if (hak->proc_map_free_first <= -1 && prepare_to_alloc_pid(hak) <= -1) return HAK_NULL;
|
||||||
|
|
||||||
stksize = hak->option.dfl_procstk_size; /* stack */
|
stksize = hak->option.dfl_procstk_size; /* stack */
|
||||||
exstksize = 128; /* exception stack size */ /* TODO: make it configurable */
|
exstksize = hak->option.dfl_exstk_size; /* exception stack size */
|
||||||
clstksize = 64; /* class stack size */ /* TODO: make it configurable too */
|
clstksize = hak->option.dfl_clstk_size; /* class stack size */
|
||||||
fstksize = stksize; /* frame stack size */
|
fstksize = stksize; /* frame stack size */
|
||||||
|
|
||||||
maxsize = (HAK_TYPE_MAX(hak_ooi_t) - HAK_PROCESS_NAMED_INSTVARS) / 4;
|
maxsize = (HAK_TYPE_MAX(hak_ooi_t) - HAK_PROCESS_NAMED_INSTVARS) / 4;
|
||||||
|
|
||||||
if (stksize > maxsize) stksize = maxsize;
|
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;
|
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;
|
if (clstksize > maxsize) clstksize = maxsize;
|
||||||
else if (clstksize < 32) clstksize = 32;
|
else if (clstksize < HAK_MIN_CLSTK_SIZE) clstksize = HAK_MIN_CLSTK_SIZE;
|
||||||
|
|
||||||
|
#if defined(HAK_ENABLE_STACK_CONTEXT)
|
||||||
if (fstksize > maxsize) fstksize = maxsize;
|
if (fstksize > maxsize) fstksize = maxsize;
|
||||||
else if (fstksize < 1024) fstksize = 1024;
|
else if (fstksize < HAK_MIN_FSTK_SIZE) fstksize = HAK_MIN_FSTK_SIZE;
|
||||||
|
#else
|
||||||
|
fstksize = 0;
|
||||||
|
#endif
|
||||||
|
|
||||||
hak_pushvolat(hak, (hak_oop_t*)&c);
|
hak_pushvolat(hak, (hak_oop_t*)&ctx);
|
||||||
proc = (hak_oop_process_t)hak_instantiate(hak, hak->c_process, HAK_NULL, stksize + exstksize + clstksize + fstksize);
|
proc = (hak_oop_process_t)hak_instantiate(hak, hak->c_process, HAK_NULL, stksize + exstksize + clstksize + fstksize);
|
||||||
hak_popvolat(hak);
|
hak_popvolat(hak);
|
||||||
if (HAK_UNLIKELY(!proc))
|
if (HAK_UNLIKELY(!proc))
|
||||||
{
|
{
|
||||||
const hak_ooch_t* oldmsg = hak_backuperrmsg(hak);
|
const hak_ooch_t* oldmsg = hak_backuperrmsg(hak);
|
||||||
hak_seterrbfmt(hak, hak->errnum,
|
hak_seterrbfmt(hak, hak->errnum, "unable to instantiate %O - %js", hak->c_process->name, oldmsg);
|
||||||
"unable to instantiate %O - %js", hak->c_process->name, oldmsg);
|
|
||||||
return HAK_NULL;
|
return HAK_NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -750,8 +728,11 @@ static hak_oop_process_t make_process (hak_t* hak, hak_oop_context_t c)
|
|||||||
/* assign a process id to the process */
|
/* assign a process id to the process */
|
||||||
alloc_pid(hak, proc);
|
alloc_pid(hak, proc);
|
||||||
|
|
||||||
proc->initial_context = c;
|
/* [NIL CONTEXT]
|
||||||
proc->current_context = c;
|
* if you pass hak->_nil for ctx since you don't have the context ready,
|
||||||
|
* you must patch it after this function is over */
|
||||||
|
proc->initial_context = ctx;
|
||||||
|
proc->current_context = proc->initial_context;
|
||||||
|
|
||||||
/* stack */
|
/* stack */
|
||||||
proc->sp = HAK_SMOOI_TO_OOP(-1); /* no item */
|
proc->sp = HAK_SMOOI_TO_OOP(-1); /* no item */
|
||||||
@@ -768,8 +749,14 @@ static hak_oop_process_t make_process (hak_t* hak, hak_oop_context_t c)
|
|||||||
/* frame stack */
|
/* frame stack */
|
||||||
proc->fsp = proc->clst; /* no item pushed yet */
|
proc->fsp = proc->clst; /* no item pushed yet */
|
||||||
proc->fst = HAK_SMOOI_TO_OOP(stksize + exstksize + clstksize + fstksize - 1);
|
proc->fst = HAK_SMOOI_TO_OOP(stksize + exstksize + clstksize + fstksize - 1);
|
||||||
|
/* the frame stack is not used when HAK_ENABLE_STACK_CONTEXT not defined.
|
||||||
|
* but initialize it without the guard. fstksize is 0 anyways. */
|
||||||
|
|
||||||
HAK_ASSERT(hak, (hak_oop_t)HAK_CTX_GET_SENDER(hak, c) == hak->_nil);
|
/* [NIL CONTEXT]
|
||||||
|
* this function allows hak->_nil for ctx but it puts the process object
|
||||||
|
* in inconsistent state. the caller must patch the initial_context and
|
||||||
|
* current_context fields as soon as possible */
|
||||||
|
HAK_ASSERT(hak, (hak_oop_t)ctx == hak->_nil || (hak_oop_t)HAK_CTX_GET_SENDER(hak, ctx) == hak->_nil);
|
||||||
|
|
||||||
#if defined(HAK_DEBUG_VM_PROCESSOR)
|
#if defined(HAK_DEBUG_VM_PROCESSOR)
|
||||||
HAK_LOG2(hak, HAK_LOG_IC | HAK_LOG_DEBUG, "Processor - process[%zd] **CREATED**->%hs\n", HAK_OOP_TO_SMOOI(proc->id), proc_state_to_string(HAK_OOP_TO_SMOOI(proc->state)));
|
HAK_LOG2(hak, HAK_LOG_IC | HAK_LOG_DEBUG, "Processor - process[%zd] **CREATED**->%hs\n", HAK_OOP_TO_SMOOI(proc->id), proc_state_to_string(HAK_OOP_TO_SMOOI(proc->state)));
|
||||||
@@ -1102,7 +1089,8 @@ static HAK_INLINE void reset_process_stack_pointers (hak_t* hak, hak_oop_process
|
|||||||
|
|
||||||
proc->sp = HAK_SMOOI_TO_OOP(-1); /* invalidate the process stack */
|
proc->sp = HAK_SMOOI_TO_OOP(-1); /* invalidate the process stack */
|
||||||
proc->exsp = proc->st;
|
proc->exsp = proc->st;
|
||||||
proc->clsp = proc->clst;
|
proc->clsp = proc->exst;
|
||||||
|
proc->fsp = proc->clst;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void terminate_process (hak_t* hak, hak_oop_process_t proc)
|
static void terminate_process (hak_t* hak, hak_oop_process_t proc)
|
||||||
@@ -1337,7 +1325,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)
|
static int async_signal_semaphore (hak_t* hak, hak_oop_semaphore_t sem)
|
||||||
{
|
{
|
||||||
#if 0
|
#if 0
|
||||||
@@ -2150,7 +2137,7 @@ void hak_releaseiohandle (hak_t* hak, hak_ooi_t io_handle)
|
|||||||
|
|
||||||
/* ------------------------------------------------------------------------- */
|
/* ------------------------------------------------------------------------- */
|
||||||
|
|
||||||
static int prepare_new_context (hak_t* hak, hak_oop_block_t op_blk, hak_ooi_t nargs, int nargs_offset, hak_ooi_t req_nrvars, int copy_args, int is_msgsend, hak_ooi_t msg_ivaroff, hak_oop_context_t* pnewctx)
|
static int prepare_new_context (hak_t* hak, hak_oop_process_t proc, hak_oop_block_t op_blk, hak_ooi_t nargs, int nargs_offset, hak_ooi_t req_nrvars, int copy_args, int is_msgsend, hak_ooi_t msg_ivaroff, hak_oop_context_t* pnewctx)
|
||||||
{
|
{
|
||||||
/* prepare a new block context for activation.
|
/* prepare a new block context for activation.
|
||||||
* the passed block context becomes the base for a new block context. */
|
* the passed block context becomes the base for a new block context. */
|
||||||
@@ -2191,7 +2178,11 @@ static int prepare_new_context (hak_t* hak, hak_oop_block_t op_blk, hak_ooi_t na
|
|||||||
|
|
||||||
/* create a new block context to clone op_blk */
|
/* create a new block context to clone op_blk */
|
||||||
hak_pushvolat(hak, (hak_oop_t*)&op_blk);
|
hak_pushvolat(hak, (hak_oop_t*)&op_blk);
|
||||||
blkctx = make_context_for_activation(hak, fixed_nargs + fblk_nrvars + fblk_nlvars + excess_nargs, HAK_USE_STACK_CONTEXT_FOR_BLOCK);
|
#if defined(HAK_ENABLE_STACK_CONTEXT)
|
||||||
|
blkctx = make_stack_context(hak, proc, fixed_nargs + fblk_nrvars + fblk_nlvars + excess_nargs);
|
||||||
|
#else
|
||||||
|
blkctx = make_context(hak, fixed_nargs + fblk_nrvars + fblk_nlvars + excess_nargs);
|
||||||
|
#endif
|
||||||
hak_popvolat(hak);
|
hak_popvolat(hak);
|
||||||
if (HAK_UNLIKELY(!blkctx)) return -1;
|
if (HAK_UNLIKELY(!blkctx)) return -1;
|
||||||
|
|
||||||
@@ -2259,6 +2250,7 @@ static HAK_INLINE int __activate_block (hak_t* hak, hak_oop_block_t op_blk, hak_
|
|||||||
|
|
||||||
x = prepare_new_context(
|
x = prepare_new_context(
|
||||||
hak,
|
hak,
|
||||||
|
hak->processor->active,
|
||||||
op_blk,
|
op_blk,
|
||||||
nargs, /* nargs */
|
nargs, /* nargs */
|
||||||
0, /* nargs_offset */
|
0, /* nargs_offset */
|
||||||
@@ -2330,7 +2322,11 @@ static int __activate_function (hak_t* hak, hak_oop_function_t op_func, hak_ooi_
|
|||||||
|
|
||||||
/* create a new block context to clone op_func */
|
/* create a new block context to clone op_func */
|
||||||
hak_pushvolat(hak, (hak_oop_t*)&op_func);
|
hak_pushvolat(hak, (hak_oop_t*)&op_func);
|
||||||
functx = make_context_for_activation(hak, fixed_nargs + nrvars + nlvars + excess_nargs, HAK_USE_STACK_CONTEXT_FOR_FUNCTION);
|
#if defined(HAK_ENABLE_STACK_CONTEXT)
|
||||||
|
functx = make_stack_context(hak, hak->processor->active, fixed_nargs + nrvars + nlvars + excess_nargs);
|
||||||
|
#else
|
||||||
|
functx = make_context(hak, fixed_nargs + nrvars + nlvars + excess_nargs);
|
||||||
|
#endif
|
||||||
hak_popvolat(hak);
|
hak_popvolat(hak);
|
||||||
if (HAK_UNLIKELY(!functx)) return -1;
|
if (HAK_UNLIKELY(!functx)) return -1;
|
||||||
|
|
||||||
@@ -2718,9 +2714,11 @@ static HAK_INLINE int do_throw (hak_t* hak, hak_oop_t val, hak_ooi_t ip)
|
|||||||
|
|
||||||
/* the below code is similar to do_return_from_block() */
|
/* the below code is similar to do_return_from_block() */
|
||||||
hak->ip = -1; /* mark context dead. saved into hak->active_context->ip in SWITCH_ACTIVE_CONTEXT */
|
hak->ip = -1; /* mark context dead. saved into hak->active_context->ip in SWITCH_ACTIVE_CONTEXT */
|
||||||
|
|
||||||
|
#if defined(HAK_ENABLE_STACK_CONTEXT)
|
||||||
|
/* rewind the context stack */
|
||||||
{
|
{
|
||||||
hak_oop_context_t xctx;
|
hak_oop_context_t xctx;
|
||||||
|
|
||||||
xctx = hak->active_context;
|
xctx = hak->active_context;
|
||||||
while ((hak_oop_t)xctx != (hak_oop_t)catch_ctx && (hak_oop_t)xctx != hak->_nil)
|
while ((hak_oop_t)xctx != (hak_oop_t)catch_ctx && (hak_oop_t)xctx != hak->_nil)
|
||||||
{
|
{
|
||||||
@@ -2728,6 +2726,8 @@ static HAK_INLINE int do_throw (hak_t* hak, hak_oop_t val, hak_ooi_t ip)
|
|||||||
xctx = (hak_oop_context_t)HAK_CTX_GET_SENDER(hak, xctx);
|
xctx = (hak_oop_context_t)HAK_CTX_GET_SENDER(hak, xctx);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
SWITCH_ACTIVE_CONTEXT(hak, catch_ctx);
|
SWITCH_ACTIVE_CONTEXT(hak, catch_ctx);
|
||||||
hak->ip = catch_ip; /* override the instruction pointer */
|
hak->ip = catch_ip; /* override the instruction pointer */
|
||||||
|
|
||||||
@@ -3323,13 +3323,21 @@ void hak_rcvtick (hak_t* hak, int enabled)
|
|||||||
|
|
||||||
void hak_raisetick (hak_t* hak)
|
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++;
|
hak->tick++;
|
||||||
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
void hak_raise_gtick (int unused)
|
void hak_raise_gtick (int unused)
|
||||||
{
|
{
|
||||||
/* this function is global and not bound to a specific instance. */
|
/* this function is global and not bound to a specific instance. */
|
||||||
|
#if defined(HAK_ATOMIC_ADD_FETCH)
|
||||||
|
HAK_ATOMIC_ADD_FETCH(>ick, 1, HAK_ATOMIC_RELAXED);
|
||||||
|
#else
|
||||||
gtick++;
|
gtick++;
|
||||||
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
/* ------------------------------------------------------------------------- */
|
/* ------------------------------------------------------------------------- */
|
||||||
@@ -3425,7 +3433,9 @@ static HAK_INLINE int do_return_from_block (hak_t* hak)
|
|||||||
/* it is a normal block return as the active block context
|
/* it is a normal block return as the active block context
|
||||||
* is not the initial context of a process */
|
* is not the initial context of a process */
|
||||||
hak->ip = -1; /* mark context dead. saved into hak->active_context->ip in SWITCH_ACTIVE_CONTEXT */
|
hak->ip = -1; /* mark context dead. saved into hak->active_context->ip in SWITCH_ACTIVE_CONTEXT */
|
||||||
|
#if defined(HAK_ENABLE_STACK_CONTEXT)
|
||||||
release_stack_context(hak, (hak_oop_t)hak->active_context);
|
release_stack_context(hak, (hak_oop_t)hak->active_context);
|
||||||
|
#endif
|
||||||
SWITCH_ACTIVE_CONTEXT(hak, (hak_oop_context_t)HAK_CTX_GET_SENDER(hak, hak->active_context));
|
SWITCH_ACTIVE_CONTEXT(hak, (hak_oop_context_t)HAK_CTX_GET_SENDER(hak, hak->active_context));
|
||||||
return 0; /* normal return */
|
return 0; /* normal return */
|
||||||
}
|
}
|
||||||
@@ -3591,7 +3601,9 @@ static HAK_INLINE int do_return_from_home (hak_t* hak, hak_oop_t return_value, h
|
|||||||
while ((hak_oop_t)hak->active_context != (hak_oop_t)home)
|
while ((hak_oop_t)hak->active_context != (hak_oop_t)home)
|
||||||
{
|
{
|
||||||
hak->ip = -1; /* mark context dead. saved into hak->active_context->ip in SWITCH_ACTIVE_CONTEXT */
|
hak->ip = -1; /* mark context dead. saved into hak->active_context->ip in SWITCH_ACTIVE_CONTEXT */
|
||||||
|
#if defined(HAK_ENABLE_STACK_CONTEXT)
|
||||||
release_stack_context(hak, (hak_oop_t)hak->active_context);
|
release_stack_context(hak, (hak_oop_t)hak->active_context);
|
||||||
|
#endif
|
||||||
SWITCH_ACTIVE_CONTEXT(hak, (hak_oop_context_t)HAK_CTX_GET_SENDER(hak, hak->active_context));
|
SWITCH_ACTIVE_CONTEXT(hak, (hak_oop_context_t)HAK_CTX_GET_SENDER(hak, hak->active_context));
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -3620,7 +3632,9 @@ static HAK_INLINE int do_return_from_home (hak_t* hak, hak_oop_t return_value, h
|
|||||||
|
|
||||||
HAK_ASSERT(hak, (hak_oop_t)HAK_CTX_GET_SENDER(hak, hak->active_context) == (hak_oop_t)sender);
|
HAK_ASSERT(hak, (hak_oop_t)HAK_CTX_GET_SENDER(hak, hak->active_context) == (hak_oop_t)sender);
|
||||||
hak->ip = -1; /* mark context dead. saved into hak->active_context->ip in SWITCH_ACTIVE_CONTEXT */
|
hak->ip = -1; /* mark context dead. saved into hak->active_context->ip in SWITCH_ACTIVE_CONTEXT */
|
||||||
|
#if defined(HAK_ENABLE_STACK_CONTEXT)
|
||||||
release_stack_context(hak, (hak_oop_t)hak->active_context);
|
release_stack_context(hak, (hak_oop_t)hak->active_context);
|
||||||
|
#endif
|
||||||
SWITCH_ACTIVE_CONTEXT(hak, (hak_oop_context_t)HAK_CTX_GET_SENDER(hak, hak->active_context));
|
SWITCH_ACTIVE_CONTEXT(hak, (hak_oop_context_t)HAK_CTX_GET_SENDER(hak, hak->active_context));
|
||||||
HAK_STACK_PUSH(hak, return_value);
|
HAK_STACK_PUSH(hak, return_value);
|
||||||
}
|
}
|
||||||
@@ -4356,7 +4370,15 @@ static int execute (hak_t* hak)
|
|||||||
|
|
||||||
case HAK_CODE_TRY_EXIT:
|
case HAK_CODE_TRY_EXIT:
|
||||||
LOG_INST_0(hak, "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);
|
HAK_EXSTACK_POP(hak);
|
||||||
break;
|
break;
|
||||||
|
|
||||||
@@ -4925,6 +4947,7 @@ hak_logbfmt(hak, HAK_LOG_STDERR, ">>>%O c->sc=%O sc=%O b2=%d b3=%d nivars=%d ncv
|
|||||||
|
|
||||||
case HAK_CODE_PUSH_CONTEXT:
|
case HAK_CODE_PUSH_CONTEXT:
|
||||||
LOG_INST_0(hak, "push_context");
|
LOG_INST_0(hak, "push_context");
|
||||||
|
/* TODO: error check? on HAK_CTX_TO_OOP? */
|
||||||
HAK_STACK_PUSH(hak, (hak_oop_t)HAK_CTX_TO_OOP(hak, hak->active_context));
|
HAK_STACK_PUSH(hak, (hak_oop_t)HAK_CTX_TO_OOP(hak, hak->active_context));
|
||||||
break;
|
break;
|
||||||
|
|
||||||
@@ -5345,7 +5368,7 @@ hak_logbfmt(hak, HAK_LOG_STDERR, ">>>%O c->sc=%O sc=%O b2=%d b3=%d nivars=%d ncv
|
|||||||
if (HAK_CTX_IS_STACK(homectx))
|
if (HAK_CTX_IS_STACK(homectx))
|
||||||
{
|
{
|
||||||
hak_pushvolat(hak, (hak_oop_t*)&funcobj);
|
hak_pushvolat(hak, (hak_oop_t*)&funcobj);
|
||||||
homectx = hak_reify_stack_context(hak, HAK_CTX_TO_STACK(homectx));
|
homectx = hak_reifystackcontext(hak, HAK_CTX_TO_STACK(homectx));
|
||||||
hak_popvolat(hak);
|
hak_popvolat(hak);
|
||||||
if (HAK_UNLIKELY(!homectx)) goto oops;
|
if (HAK_UNLIKELY(!homectx)) goto oops;
|
||||||
hak->active_context = homectx; /* because homectx is reified of hak->active_context */
|
hak->active_context = homectx; /* because homectx is reified of hak->active_context */
|
||||||
@@ -5398,10 +5421,10 @@ hak_logbfmt(hak, HAK_LOG_STDERR, ">>>%O c->sc=%O sc=%O b2=%d b3=%d nivars=%d ncv
|
|||||||
if (HAK_CTX_IS_STACK(homectx))
|
if (HAK_CTX_IS_STACK(homectx))
|
||||||
{
|
{
|
||||||
hak_pushvolat(hak, (hak_oop_t*)&blkobj);
|
hak_pushvolat(hak, (hak_oop_t*)&blkobj);
|
||||||
homectx = hak_reify_stack_context(hak, HAK_CTX_TO_STACK(homectx));
|
homectx = hak_reifystackcontext(hak, HAK_CTX_TO_STACK(homectx));
|
||||||
hak_popvolat(hak);
|
hak_popvolat(hak);
|
||||||
if (HAK_UNLIKELY(!homectx)) goto oops;
|
if (HAK_UNLIKELY(!homectx)) goto oops;
|
||||||
hak->active_context = homectx; /* because homectx is reified of hak->active_context) */
|
hak->active_context = homectx; /* because homectx is reified of hak->active_context */
|
||||||
hak->processor->active->current_context = homectx;
|
hak->processor->active->current_context = homectx;
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
@@ -5577,6 +5600,46 @@ hak_pfrc_t hak_pf_process_fork (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
|
|||||||
return HAK_PF_FAILURE;
|
return HAK_PF_FAILURE;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#if defined(HAK_ENABLE_STACK_CONTEXT)
|
||||||
|
/* a process requires a context to start with but create a new process first
|
||||||
|
* to have a new context on the frame stack of the new process */
|
||||||
|
newprc = make_process(hak, (hak_oop_context_t)hak->_nil);
|
||||||
|
if (HAK_UNLIKELY(!newprc)) return HAK_PF_FAILURE;
|
||||||
|
|
||||||
|
hak_pushvolat(hak, (hak_oop_t*)&newprc);
|
||||||
|
x = prepare_new_context(
|
||||||
|
hak,
|
||||||
|
newprc,
|
||||||
|
blk,
|
||||||
|
nargs, /* nargs */
|
||||||
|
1, /* nargs_offset */
|
||||||
|
0, /* number of return variables expected */
|
||||||
|
1, /* copy_args */
|
||||||
|
0, /* is_msgsend */
|
||||||
|
0, /* msg_ivaroff */
|
||||||
|
&newctx);
|
||||||
|
hak_popvolat(hak);
|
||||||
|
if (HAK_UNLIKELY(x <= -1))
|
||||||
|
{
|
||||||
|
/* is it safe to terminate the process which doesn't have a proper context value
|
||||||
|
* in initial_context and current_context? */
|
||||||
|
terminate_process(hak, newprc);
|
||||||
|
return HAK_PF_FAILURE;
|
||||||
|
}
|
||||||
|
|
||||||
|
HAK_ASSERT(hak, (hak_oop_t)HAK_CTX_GET_SENDER(hak, newctx) == hak->_nil);
|
||||||
|
HAK_CTX_SET_HOME(hak, newctx, (hak_oop_t)hak->_nil); /* the new context is the initial context in the new process. so reset it to nil */
|
||||||
|
|
||||||
|
HAK_ASSERT(hak, newprc->initial_context == (hak_oop_t)hak->_nil);
|
||||||
|
HAK_ASSERT(hak, newprc->initial_context == newprc->current_context);
|
||||||
|
newprc->initial_context = newctx;
|
||||||
|
newprc->current_context = newctx;
|
||||||
|
#else
|
||||||
|
/* when stack context is disabled, create the context before
|
||||||
|
* the process. so we put the process in consitent state
|
||||||
|
* upon creation and also avoid the chance of making the process
|
||||||
|
* stuck in some suspended state. */
|
||||||
|
|
||||||
/* (defun x(a b) ...)
|
/* (defun x(a b) ...)
|
||||||
* (fork x 1 2)
|
* (fork x 1 2)
|
||||||
* among three arguments to fork, the first is the function block.
|
* among three arguments to fork, the first is the function block.
|
||||||
@@ -5585,6 +5648,7 @@ hak_pfrc_t hak_pf_process_fork (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
|
|||||||
*/
|
*/
|
||||||
x = prepare_new_context(
|
x = prepare_new_context(
|
||||||
hak,
|
hak,
|
||||||
|
hak->processor->active,
|
||||||
blk,
|
blk,
|
||||||
nargs, /* nargs */
|
nargs, /* nargs */
|
||||||
1, /* nargs_offset */
|
1, /* nargs_offset */
|
||||||
@@ -5602,6 +5666,7 @@ hak_pfrc_t hak_pf_process_fork (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
|
|||||||
newprc = make_process(hak, newctx);
|
newprc = make_process(hak, newctx);
|
||||||
hak_popvolat(hak);
|
hak_popvolat(hak);
|
||||||
if (HAK_UNLIKELY(!newprc)) return HAK_PF_FAILURE;
|
if (HAK_UNLIKELY(!newprc)) return HAK_PF_FAILURE;
|
||||||
|
#endif
|
||||||
|
|
||||||
chain_into_processor(hak, newprc, HAK_PROCESS_STATE_RUNNABLE);
|
chain_into_processor(hak, newprc, HAK_PROCESS_STATE_RUNNABLE);
|
||||||
|
|
||||||
@@ -5620,6 +5685,11 @@ hak_pfrc_t hak_pf_process_resume (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
|
|||||||
return HAK_PF_FAILURE;
|
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, (hak_oop_t)prc);
|
||||||
|
|
||||||
resume_process(hak, prc);
|
resume_process(hak, prc);
|
||||||
return HAK_PF_SUCCESS;
|
return HAK_PF_SUCCESS;
|
||||||
}
|
}
|
||||||
@@ -5642,6 +5712,11 @@ hak_pfrc_t hak_pf_process_suspend (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
|
|||||||
prc = hak->processor->active;
|
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, (hak_oop_t)prc);
|
||||||
|
|
||||||
suspend_process(hak, prc);
|
suspend_process(hak, prc);
|
||||||
return HAK_PF_SUCCESS;
|
return HAK_PF_SUCCESS;
|
||||||
}
|
}
|
||||||
@@ -5664,18 +5739,33 @@ hak_pfrc_t hak_pf_process_terminate (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs
|
|||||||
prc = hak->processor->active;
|
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, (hak_oop_t)prc);
|
||||||
|
|
||||||
terminate_process(hak, prc);
|
terminate_process(hak, prc);
|
||||||
return HAK_PF_SUCCESS;
|
return HAK_PF_SUCCESS;
|
||||||
}
|
}
|
||||||
|
|
||||||
hak_pfrc_t hak_pf_process_terminate_all (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
|
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);
|
terminate_all_processes(hak);
|
||||||
return HAK_PF_SUCCESS;
|
return HAK_PF_SUCCESS;
|
||||||
}
|
}
|
||||||
|
|
||||||
hak_pfrc_t hak_pf_process_yield (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
|
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);
|
yield_process(hak, hak->processor->active);
|
||||||
return HAK_PF_SUCCESS;
|
return HAK_PF_SUCCESS;
|
||||||
}
|
}
|
||||||
@@ -5695,7 +5785,22 @@ hak_pfrc_t hak_pf_semaphore_new (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
|
|||||||
return HAK_PF_FAILURE;
|
return HAK_PF_FAILURE;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if (nargs >= 1)
|
||||||
|
{
|
||||||
|
hak_oop_t tmp;
|
||||||
|
tmp = 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);
|
sem->count = HAK_SMOOI_TO_OOP(0);
|
||||||
|
}
|
||||||
|
|
||||||
/* TODO: sem->signal_action? */
|
/* TODO: sem->signal_action? */
|
||||||
/* other fields are all set to nil */
|
/* other fields are all set to nil */
|
||||||
|
|
||||||
|
|||||||
@@ -880,10 +880,12 @@ static HAK_INLINE void gc_ms_scan_stack (hak_t* hak)
|
|||||||
HAK_ASSERT(hak, ll < (hak_ooi_t)(HAK_OBJ_GET_SIZE(oop) - HAK_PROCESS_NAMED_INSTVARS));
|
HAK_ASSERT(hak, ll < (hak_ooi_t)(HAK_OBJ_GET_SIZE(oop) - HAK_PROCESS_NAMED_INSTVARS));
|
||||||
for (i = HAK_OOP_TO_SMOOI(proc->exst) + 1; i <= ll; i++) gc_ms_mark_object(hak, proc->slot[i]);
|
for (i = HAK_OOP_TO_SMOOI(proc->exst) + 1; i <= ll; i++) gc_ms_mark_object(hak, proc->slot[i]);
|
||||||
|
|
||||||
|
#if defined(HAK_ENABLE_STACK_CONTEXT)
|
||||||
/* frame stack */
|
/* frame stack */
|
||||||
ll = HAK_OOP_TO_SMOOI(proc->fsp);
|
ll = HAK_OOP_TO_SMOOI(proc->fsp);
|
||||||
HAK_ASSERT(hak, ll < (hak_ooi_t)(HAK_OBJ_GET_SIZE(oop) - HAK_PROCESS_NAMED_INSTVARS));
|
HAK_ASSERT(hak, ll < (hak_ooi_t)(HAK_OBJ_GET_SIZE(oop) - HAK_PROCESS_NAMED_INSTVARS));
|
||||||
for (i = HAK_OOP_TO_SMOOI(proc->clst) + 1; i <= ll; i++) gc_ms_mark_object(hak, proc->slot[i]);
|
for (i = HAK_OOP_TO_SMOOI(proc->clst) + 1; i <= ll; i++) gc_ms_mark_object(hak, proc->slot[i]);
|
||||||
|
#endif
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
|
|||||||
@@ -226,6 +226,9 @@
|
|||||||
/* Define to 1 if you have the <errno.h> header file. */
|
/* Define to 1 if you have the <errno.h> header file. */
|
||||||
#undef HAVE_ERRNO_H
|
#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. */
|
/* Define to 1 if you have the <execinfo.h> header file. */
|
||||||
#undef HAVE_EXECINFO_H
|
#undef HAVE_EXECINFO_H
|
||||||
|
|
||||||
|
|||||||
+186
-2
@@ -1084,6 +1084,52 @@ typedef struct hak_t hak_t;
|
|||||||
#define HAK_HAVE_BUILTIN_CLZLL
|
#define HAK_HAVE_BUILTIN_CLZLL
|
||||||
#endif
|
#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)
|
#if __has_builtin(__builtin_uadd_overflow)
|
||||||
#define HAK_HAVE_BUILTIN_UADD_OVERFLOW
|
#define HAK_HAVE_BUILTIN_UADD_OVERFLOW
|
||||||
#endif
|
#endif
|
||||||
@@ -1158,11 +1204,19 @@ typedef struct hak_t hak_t;
|
|||||||
#endif
|
#endif
|
||||||
|
|
||||||
#elif defined(__GNUC__) && defined(__GNUC_MINOR__)
|
#elif defined(__GNUC__) && defined(__GNUC_MINOR__)
|
||||||
|
|
||||||
#if (__GNUC__ >= 4)
|
#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_TEST_AND_SET
|
||||||
#define HAK_HAVE_SYNC_LOCK_RELEASE
|
#define HAK_HAVE_SYNC_LOCK_RELEASE
|
||||||
|
|
||||||
#define HAK_HAVE_SYNC_SYNCHRONIZE
|
#define HAK_HAVE_SYNC_SYNCHRONIZE
|
||||||
#define HAK_HAVE_SYNC_BOOL_COMPARE_AND_SWAP
|
#define HAK_HAVE_SYNC_BOOL_COMPARE_AND_SWAP
|
||||||
#define HAK_HAVE_SYNC_VAL_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
|
#define HAK_HAVE_BUILTIN_SMULLL_OVERFLOW
|
||||||
#endif
|
#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)
|
#if (__GNUC__ >= 5) || (__GNUC__ == 4 && __GNUC_MINOR__ >= 8)
|
||||||
/* 4.8.0 or later */
|
/* 4.8.0 or later */
|
||||||
#define HAK_HAVE_BUILTIN_BSWAP16
|
#define HAK_HAVE_BUILTIN_BSWAP16
|
||||||
@@ -1207,6 +1274,12 @@ typedef struct hak_t hak_t;
|
|||||||
|
|
||||||
#endif
|
#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)
|
#if defined(HAK_HAVE_BUILTIN_EXPECT)
|
||||||
# define HAK_LIKELY(x) (__builtin_expect(!!(x),1))
|
# define HAK_LIKELY(x) (__builtin_expect(!!(x),1))
|
||||||
# define HAK_UNLIKELY(x) (__builtin_expect(!!(x),0))
|
# define HAK_UNLIKELY(x) (__builtin_expect(!!(x),0))
|
||||||
@@ -1215,6 +1288,117 @@ typedef struct hak_t hak_t;
|
|||||||
# define HAK_UNLIKELY(x) (x)
|
# define HAK_UNLIKELY(x) (x)
|
||||||
#endif
|
#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
|
* STATIC ASSERTION
|
||||||
* =========================================================================*/
|
* =========================================================================*/
|
||||||
|
|||||||
@@ -157,8 +157,6 @@ struct hak_hnd_t
|
|||||||
hak_hnd_t* next;
|
hak_hnd_t* next;
|
||||||
};
|
};
|
||||||
|
|
||||||
typedef struct hak_hndtab_t hak_hndtab_t;
|
|
||||||
|
|
||||||
/* ========================================================================= */
|
/* ========================================================================= */
|
||||||
/* THE UNIFORM I/O CONTRACT */
|
/* THE UNIFORM I/O CONTRACT */
|
||||||
/* ========================================================================= */
|
/* ========================================================================= */
|
||||||
|
|||||||
+26
-21
@@ -48,7 +48,9 @@
|
|||||||
/* enable floating-pointer number support in the basic formatting functions */
|
/* enable floating-pointer number support in the basic formatting functions */
|
||||||
#define HAK_ENABLE_FLTFMT
|
#define HAK_ENABLE_FLTFMT
|
||||||
|
|
||||||
|
#if !defined(HAK_DISABLE_STACK_CONTEXT)
|
||||||
#define HAK_ENABLE_STACK_CONTEXT
|
#define HAK_ENABLE_STACK_CONTEXT
|
||||||
|
#endif
|
||||||
|
|
||||||
#if defined(HAK_ENABLE_STACK_CONTEXT)
|
#if defined(HAK_ENABLE_STACK_CONTEXT)
|
||||||
|
|
||||||
@@ -57,6 +59,7 @@
|
|||||||
typedef struct hak_stack_context_t hak_stack_context_t;
|
typedef struct hak_stack_context_t hak_stack_context_t;
|
||||||
struct hak_stack_context_t
|
struct hak_stack_context_t
|
||||||
{
|
{
|
||||||
|
/* mirrored fields of hak_context_t defined in hak.h */
|
||||||
hak_oop_t req_nrets;
|
hak_oop_t req_nrets;
|
||||||
hak_oop_t attr_mask;
|
hak_oop_t attr_mask;
|
||||||
hak_oop_t name;
|
hak_oop_t name;
|
||||||
@@ -69,22 +72,24 @@ struct hak_stack_context_t
|
|||||||
hak_oop_t ivaroff;
|
hak_oop_t ivaroff;
|
||||||
hak_oop_t owner;
|
hak_oop_t owner;
|
||||||
|
|
||||||
|
/* extra fields for house-keeping */
|
||||||
hak_oop_t slot_count;
|
hak_oop_t slot_count;
|
||||||
hak_oop_t stack_base;
|
hak_oop_t stack_base;
|
||||||
hak_oop_t frame_base;
|
hak_oop_t frame_base;
|
||||||
hak_oop_t heap_ctx;
|
hak_oop_t heap_ctx; /* set to non-nil if reified */
|
||||||
|
|
||||||
hak_oop_t slot_base[1];
|
/* space for arguments, local variables, return variables, etc after the fixed fields like in hak_context_t */
|
||||||
|
hak_oop_t slot[1];
|
||||||
};
|
};
|
||||||
|
|
||||||
/*#define HAK_STACK_CONTEXT_NAMED_SLOTS (HAK_SIZEOF(hak_stack_context_t) / HAK_SIZEOF(hak_oop_t))*/
|
/*#define HAK_STACK_CONTEXT_NAMED_SLOTS (HAK_SIZEOF(hak_stack_context_t) / HAK_SIZEOF(hak_oop_t))*/
|
||||||
#define HAK_STACK_CONTEXT_NAMED_SLOTS (15) /* excludes slot_base */
|
#define HAK_STACK_CONTEXT_NAMED_SLOTS (15) /* excludes slot */
|
||||||
|
|
||||||
#if defined(__cplusplus)
|
#if defined(__cplusplus)
|
||||||
extern "C" {
|
extern "C" {
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
hak_oop_context_t hak_reify_stack_context (hak_t* hak, hak_stack_context_t* sctx);
|
hak_oop_context_t hak_reifystackcontext (hak_t* hak, hak_stack_context_t* sctx);
|
||||||
|
|
||||||
#if defined(__cplusplus)
|
#if defined(__cplusplus)
|
||||||
}
|
}
|
||||||
@@ -92,33 +97,20 @@ hak_oop_context_t hak_reify_stack_context (hak_t* hak, hak_stack_context_t* sctx
|
|||||||
|
|
||||||
#define HAK_CTX_IS_STACK(ctx) (HAK_OOP_IS_SMPTR(ctx))
|
#define HAK_CTX_IS_STACK(ctx) (HAK_OOP_IS_SMPTR(ctx))
|
||||||
#define HAK_CTX_TO_STACK(ctx) ((hak_stack_context_t*)HAK_OOP_TO_SMPTR(ctx))
|
#define HAK_CTX_TO_STACK(ctx) ((hak_stack_context_t*)HAK_OOP_TO_SMPTR(ctx))
|
||||||
#define HAK_CTX_TO_OOP(hak, ctx) (HAK_CTX_IS_STACK(ctx)? hak_reify_stack_context((hak), HAK_CTX_TO_STACK(ctx)): (hak_oop_context_t)(ctx))
|
#define HAK_CTX_TO_OOP(hak, ctx) (HAK_CTX_IS_STACK(ctx)? hak_reifystackcontext((hak), HAK_CTX_TO_STACK(ctx)): (hak_oop_context_t)(ctx))
|
||||||
|
|
||||||
#if 0
|
#define HAK_CTX_SLOT(hak, ctx) (HAK_CTX_IS_STACK(ctx)? HAK_CTX_TO_STACK(ctx)->slot: ((hak_oop_context_t)(ctx))->slot)
|
||||||
#define HAK_CTX_SLOT(hak, ctx) (HAK_CTX_IS_STACK(ctx)? (hak_oop_t*)HAK_OOP_TO_SMPTR(HAK_CTX_TO_STACK(ctx)->slot_base) : ((hak_oop_context_t)(ctx))->slot)
|
|
||||||
#define HAK_CTX_SLOT_AT(hak, ctx, idx) (HAK_CTX_IS_STACK(ctx)? ((hak_oop_t*)HAK_OOP_TO_SMPTR(HAK_CTX_TO_STACK(ctx)->slot_base))[idx] : ((hak_oop_context_t)(ctx))->slot[idx])
|
|
||||||
#define HAK_CTX_SLOT_AT_PUT(hak, ctx, idx, val) \
|
|
||||||
do { \
|
|
||||||
if (HAK_CTX_IS_STACK(ctx)) \
|
|
||||||
((hak_oop_t*)HAK_OOP_TO_SMPTR(HAK_CTX_TO_STACK(ctx)->slot_base))[idx] = (val); \
|
|
||||||
else \
|
|
||||||
((hak_oop_context_t)(ctx))->slot[idx] = (val); \
|
|
||||||
} while(0)
|
|
||||||
#else
|
|
||||||
|
|
||||||
#define HAK_CTX_SLOT(hak, ctx) (HAK_CTX_IS_STACK(ctx)? HAK_CTX_TO_STACK(ctx)->slot_base : ((hak_oop_context_t)(ctx))->slot)
|
|
||||||
|
|
||||||
#define HAK_CTX_SLOT_AT(hak, ctx, idx) \
|
#define HAK_CTX_SLOT_AT(hak, ctx, idx) \
|
||||||
(HAK_CTX_IS_STACK(ctx)? HAK_CTX_TO_STACK(ctx)->slot_base[idx]: ((hak_oop_context_t)(ctx))->slot[idx])
|
(HAK_CTX_IS_STACK(ctx)? HAK_CTX_TO_STACK(ctx)->slot[idx]: ((hak_oop_context_t)(ctx))->slot[idx])
|
||||||
|
|
||||||
#define HAK_CTX_SLOT_AT_PUT(hak, ctx, idx, val) \
|
#define HAK_CTX_SLOT_AT_PUT(hak, ctx, idx, val) \
|
||||||
do { \
|
do { \
|
||||||
if (HAK_CTX_IS_STACK(ctx)) \
|
if (HAK_CTX_IS_STACK(ctx)) \
|
||||||
HAK_CTX_TO_STACK(ctx)->slot_base[idx] = (val); \
|
HAK_CTX_TO_STACK(ctx)->slot[idx] = (val); \
|
||||||
else \
|
else \
|
||||||
((hak_oop_context_t)(ctx))->slot[idx] = (val); \
|
((hak_oop_context_t)(ctx))->slot[idx] = (val); \
|
||||||
} while(0)
|
} while(0)
|
||||||
#endif
|
|
||||||
|
|
||||||
#define HAK_CTX_GET_REQNRETS(hak, ctx) (HAK_CTX_IS_STACK(ctx)? HAK_CTX_TO_STACK(ctx)->req_nrets : ((hak_oop_context_t)(ctx))->req_nrets)
|
#define HAK_CTX_GET_REQNRETS(hak, ctx) (HAK_CTX_IS_STACK(ctx)? HAK_CTX_TO_STACK(ctx)->req_nrets : ((hak_oop_context_t)(ctx))->req_nrets)
|
||||||
#define HAK_CTX_SET_REQNRETS(hak, ctx, v) do { if (HAK_CTX_IS_STACK(ctx)) HAK_CTX_TO_STACK(ctx)->req_nrets = (v); else ((hak_oop_context_t)(ctx))->req_nrets = (v); } while (0)
|
#define HAK_CTX_SET_REQNRETS(hak, ctx, v) do { if (HAK_CTX_IS_STACK(ctx)) HAK_CTX_TO_STACK(ctx)->req_nrets = (v); else ((hak_oop_context_t)(ctx))->req_nrets = (v); } while (0)
|
||||||
@@ -517,6 +509,7 @@ enum hak_tok_type_t
|
|||||||
HAK_TOK_EOL, /* end of line */
|
HAK_TOK_EOL, /* end of line */
|
||||||
|
|
||||||
HAK_TOK_INCLUDE,
|
HAK_TOK_INCLUDE,
|
||||||
|
HAK_TOK_INCLUDE_ONCE,
|
||||||
HAK_TOK_PRAGMA
|
HAK_TOK_PRAGMA
|
||||||
};
|
};
|
||||||
typedef enum hak_tok_type_t hak_tok_type_t;
|
typedef enum hak_tok_type_t hak_tok_type_t;
|
||||||
@@ -855,6 +848,7 @@ typedef enum hak_ctlblk_type_t hak_ctlblk_type_t;
|
|||||||
struct hak_ctlblk_info_t
|
struct hak_ctlblk_info_t
|
||||||
{
|
{
|
||||||
hak_ctlblk_type_t _type;
|
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;
|
typedef struct hak_ctlblk_info_t hak_ctlblk_info_t;
|
||||||
|
|
||||||
@@ -2247,6 +2241,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_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_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_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_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);
|
hak_pfrc_t hak_pf_process_resume (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs);
|
||||||
@@ -2269,6 +2265,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_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);
|
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 */
|
/* std.c */
|
||||||
/* ========================================================================= */
|
/* ========================================================================= */
|
||||||
|
|||||||
@@ -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_symtab_size = HAK_DFL_SYMTAB_SIZE;
|
||||||
hak->option.dfl_sysdic_size = HAK_DFL_SYSDIC_SIZE;
|
hak->option.dfl_sysdic_size = HAK_DFL_SYSDIC_SIZE;
|
||||||
hak->option.dfl_procstk_size = HAK_DFL_PROCSTK_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)
|
#if defined(HAK_BUILD_DEBUG)
|
||||||
hak->option.karatsuba_cutoff = HAK_KARATSUBA_CUTOFF; /* this won't be used when NDEBUG is set */
|
hak->option.karatsuba_cutoff = HAK_KARATSUBA_CUTOFF; /* this won't be used when NDEBUG is set */
|
||||||
#endif
|
#endif
|
||||||
@@ -367,9 +369,39 @@ void hak_fini (hak_t* hak)
|
|||||||
hak->option.log_target_b = HAK_NULL;
|
hak->option.log_target_b = HAK_NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* destroy dynamically allocated options */
|
||||||
for (i = 0; i < HAK_COUNTOF(hak->option.mod); i++)
|
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)
|
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;
|
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)
|
int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
|
||||||
{
|
{
|
||||||
hak_cb_t* cb;
|
hak_cb_t* cb;
|
||||||
|
|
||||||
switch (id)
|
switch (id)
|
||||||
{
|
{
|
||||||
case HAK_TRAIT:
|
case HAK_OPT_TRAIT:
|
||||||
hak->option.trait = *(const hak_bitmask_t*)value;
|
hak->option.trait = *(const hak_bitmask_t*)value;
|
||||||
#if defined(HAK_BUILD_DEBUG)
|
#if defined(HAK_BUILD_DEBUG)
|
||||||
hak->option.karatsuba_cutoff = ((hak->option.trait & HAK_TRAIT_DEBUG_BIGINT)? HAK_KARATSUBA_CUTOFF_DEBUG: HAK_KARATSUBA_CUTOFF);
|
hak->option.karatsuba_cutoff = ((hak->option.trait & HAK_TRAIT_DEBUG_BIGINT)? HAK_KARATSUBA_CUTOFF_DEBUG: HAK_KARATSUBA_CUTOFF);
|
||||||
#endif
|
#endif
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case HAK_LOG_MASK:
|
case HAK_OPT_LOG_MASK:
|
||||||
hak->option.log_mask = *(const hak_bitmask_t*)value;
|
hak->option.log_mask = *(const hak_bitmask_t*)value;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case HAK_LOG_MAXCAPA:
|
case HAK_OPT_LOG_MAXCAPA:
|
||||||
hak->option.log_maxcapa = *(hak_oow_t*)value;
|
hak->option.log_maxcapa = *(hak_oow_t*)value;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case HAK_LOG_TARGET_BCSTR:
|
case HAK_OPT_LOG_TARGET_BCSTR:
|
||||||
{
|
{
|
||||||
hak_bch_t* v1;
|
hak_bch_t* v1;
|
||||||
hak_uch_t* v2;
|
hak_uch_t* v2;
|
||||||
@@ -488,7 +566,7 @@ int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
||||||
case HAK_LOG_TARGET_UCSTR:
|
case HAK_OPT_LOG_TARGET_UCSTR:
|
||||||
{
|
{
|
||||||
hak_uch_t* v1;
|
hak_uch_t* v1;
|
||||||
hak_bch_t* v2;
|
hak_bch_t* v2;
|
||||||
@@ -508,7 +586,7 @@ int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
||||||
case HAK_LOG_TARGET_BCS:
|
case HAK_OPT_LOG_TARGET_BCS:
|
||||||
{
|
{
|
||||||
hak_bch_t* v1;
|
hak_bch_t* v1;
|
||||||
hak_uch_t* v2;
|
hak_uch_t* v2;
|
||||||
@@ -529,7 +607,7 @@ int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
||||||
case HAK_LOG_TARGET_UCS:
|
case HAK_OPT_LOG_TARGET_UCS:
|
||||||
{
|
{
|
||||||
hak_uch_t* v1;
|
hak_uch_t* v1;
|
||||||
hak_bch_t* v2;
|
hak_bch_t* v2;
|
||||||
@@ -550,7 +628,7 @@ int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
||||||
case HAK_SYMTAB_SIZE:
|
case HAK_OPT_SYMTAB_SIZE:
|
||||||
{
|
{
|
||||||
hak_oow_t w;
|
hak_oow_t w;
|
||||||
|
|
||||||
@@ -561,7 +639,7 @@ int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
||||||
case HAK_SYSDIC_SIZE:
|
case HAK_OPT_SYSDIC_SIZE:
|
||||||
{
|
{
|
||||||
hak_oow_t w;
|
hak_oow_t w;
|
||||||
|
|
||||||
@@ -572,7 +650,7 @@ int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
||||||
case HAK_PROCSTK_SIZE:
|
case HAK_OPT_PROCSTK_SIZE:
|
||||||
{
|
{
|
||||||
hak_oow_t w;
|
hak_oow_t w;
|
||||||
|
|
||||||
@@ -583,26 +661,63 @@ int hak_setoption (hak_t* hak, hak_option_t id, const void* value)
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
||||||
case HAK_MOD_LIBDIRS:
|
case HAK_OPT_EXSTK_SIZE:
|
||||||
case HAK_MOD_PREFIX:
|
{
|
||||||
case HAK_MOD_POSTFIX:
|
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;
|
hak_oocs_t tmp;
|
||||||
int idx;
|
int idx;
|
||||||
|
|
||||||
if (dup_str_opt(hak, (const hak_ooch_t*)value, &tmp) <= -1) return -1;
|
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);
|
if (hak->option.mod[idx].ptr) hak_freemem(hak, hak->option.mod[idx].ptr);
|
||||||
|
|
||||||
hak->option.mod[idx] = tmp;
|
hak->option.mod[idx] = tmp;
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
case HAK_MOD_INCTX:
|
case HAK_OPT_MODINCTX:
|
||||||
hak->option.mod_inctx = *(void**)value;
|
hak->option.mod_inctx = *(void**)value;
|
||||||
break;
|
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:
|
default:
|
||||||
goto einval;
|
goto einval;
|
||||||
}
|
}
|
||||||
@@ -623,57 +738,80 @@ int hak_getoption (hak_t* hak, hak_option_t id, void* value)
|
|||||||
{
|
{
|
||||||
switch (id)
|
switch (id)
|
||||||
{
|
{
|
||||||
case HAK_TRAIT:
|
case HAK_OPT_TRAIT:
|
||||||
*(hak_bitmask_t*)value = hak->option.trait;
|
*(hak_bitmask_t*)value = hak->option.trait;
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
case HAK_LOG_MASK:
|
case HAK_OPT_LOG_MASK:
|
||||||
*(hak_bitmask_t*)value = hak->option.log_mask;
|
*(hak_bitmask_t*)value = hak->option.log_mask;
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
case HAK_LOG_MAXCAPA:
|
case HAK_OPT_LOG_MAXCAPA:
|
||||||
*(hak_oow_t*)value = hak->option.log_maxcapa;
|
*(hak_oow_t*)value = hak->option.log_maxcapa;
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
case HAK_LOG_TARGET_BCSTR:
|
case HAK_OPT_LOG_TARGET_BCSTR:
|
||||||
*(hak_bch_t**)value = hak->option.log_target_b;
|
*(hak_bch_t**)value = hak->option.log_target_b;
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
case HAK_LOG_TARGET_UCSTR:
|
case HAK_OPT_LOG_TARGET_UCSTR:
|
||||||
*(hak_uch_t**)value = hak->option.log_target_u;
|
*(hak_uch_t**)value = hak->option.log_target_u;
|
||||||
return 0;
|
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)->ptr = hak->option.log_target_b;
|
||||||
((hak_bcs_t*)value)->len = hak_count_bcstr(hak->option.log_target_b);
|
((hak_bcs_t*)value)->len = hak_count_bcstr(hak->option.log_target_b);
|
||||||
return 0;
|
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)->ptr = hak->option.log_target_u;
|
||||||
((hak_ucs_t*)value)->len = hak_count_ucstr(hak->option.log_target_u);
|
((hak_ucs_t*)value)->len = hak_count_ucstr(hak->option.log_target_u);
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
case HAK_SYMTAB_SIZE:
|
case HAK_OPT_SYMTAB_SIZE:
|
||||||
*(hak_oow_t*)value = hak->option.dfl_symtab_size;
|
*(hak_oow_t*)value = hak->option.dfl_symtab_size;
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
case HAK_SYSDIC_SIZE:
|
case HAK_OPT_SYSDIC_SIZE:
|
||||||
*(hak_oow_t*)value = hak->option.dfl_sysdic_size;
|
*(hak_oow_t*)value = hak->option.dfl_sysdic_size;
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
case HAK_PROCSTK_SIZE:
|
case HAK_OPT_PROCSTK_SIZE:
|
||||||
*(hak_oow_t*)value = hak->option.dfl_procstk_size;
|
*(hak_oow_t*)value = hak->option.dfl_procstk_size;
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
case HAK_MOD_LIBDIRS:
|
case HAK_OPT_EXSTK_SIZE:
|
||||||
case HAK_MOD_PREFIX:
|
*(hak_oow_t*)value = hak->option.dfl_exstk_size;
|
||||||
case HAK_MOD_POSTFIX:
|
|
||||||
*(const hak_ooch_t**)value = hak->option.mod[id - HAK_MOD_LIBDIRS].ptr;
|
|
||||||
return 0;
|
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;
|
*(void**)value = hak->option.mod_inctx;
|
||||||
return 0;
|
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);
|
hak_seterrnum(hak, HAK_EINVAL);
|
||||||
|
|||||||
@@ -241,33 +241,50 @@ typedef hak_errbinf_t hak_errinf_t;
|
|||||||
|
|
||||||
enum hak_option_t
|
enum hak_option_t
|
||||||
{
|
{
|
||||||
HAK_TRAIT,
|
HAK_OPT_TRAIT,
|
||||||
HAK_LOG_MASK,
|
HAK_OPT_LOG_MASK,
|
||||||
HAK_LOG_MAXCAPA,
|
HAK_OPT_LOG_MAXCAPA,
|
||||||
|
|
||||||
HAK_LOG_TARGET_BCSTR,
|
HAK_OPT_LOG_TARGET_BCSTR,
|
||||||
HAK_LOG_TARGET_UCSTR,
|
HAK_OPT_LOG_TARGET_UCSTR,
|
||||||
HAK_LOG_TARGET_BCS,
|
HAK_OPT_LOG_TARGET_BCS,
|
||||||
HAK_LOG_TARGET_UCS,
|
HAK_OPT_LOG_TARGET_UCS,
|
||||||
#if defined(HAK_OOCH_IS_UCH)
|
#if defined(HAK_OOCH_IS_UCH)
|
||||||
# define HAK_LOG_TARGET HAK_LOG_TARGET_UCSTR
|
# define HAK_OPT_LOG_TARGET HAK_OPT_LOG_TARGET_UCSTR
|
||||||
# define HAK_LOG_TARGET_OOCSTR HAK_LOG_TARGET_UCSTR
|
# define HAK_OPT_LOG_TARGET_OOCSTR HAK_OPT_LOG_TARGET_UCSTR
|
||||||
# define HAK_LOG_TARGET_OOCS HAK_LOG_TARGET_UCS
|
# define HAK_OPT_LOG_TARGET_OOCS HAK_OPT_LOG_TARGET_UCS
|
||||||
#else
|
#else
|
||||||
# define HAK_LOG_TARGET HAK_LOG_TARGET_BCSTR
|
# define HAK_OPT_LOG_TARGET HAK_OPT_LOG_TARGET_BCSTR
|
||||||
# define HAK_LOG_TARGET_OOCSTR HAK_LOG_TARGET_BCSTR
|
# define HAK_OPT_LOG_TARGET_OOCSTR HAK_OPT_LOG_TARGET_BCSTR
|
||||||
# define HAK_LOG_TARGET_OOCS HAK_LOG_TARGET_BCS
|
# define HAK_OPT_LOG_TARGET_OOCS HAK_OPT_LOG_TARGET_BCS
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
HAK_SYMTAB_SIZE, /* default system table size */
|
HAK_OPT_SYMTAB_SIZE, /* default system table size */
|
||||||
HAK_SYSDIC_SIZE, /* default system dictionary size */
|
HAK_OPT_SYSDIC_SIZE, /* default system dictionary size */
|
||||||
HAK_PROCSTK_SIZE, /* default process stack 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_OPT_MODLIBDIRS_BCSTR,
|
||||||
HAK_MOD_PREFIX,
|
HAK_OPT_MODLIBDIRS_UCSTR,
|
||||||
HAK_MOD_POSTFIX,
|
#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;
|
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
|
enum hak_option_dflval_t
|
||||||
{
|
{
|
||||||
HAK_DFL_LOG_MAXCAPA = HAK_LOG_CAPA_ALIGN * 16,
|
HAK_DFL_LOG_MAXCAPA = HAK_LOG_CAPA_ALIGN * 16,
|
||||||
HAK_DFL_SYMTAB_SIZE = 5000,
|
|
||||||
HAK_DFL_SYSDIC_SIZE = 5000,
|
#if defined(HAK_SMALL_MEMORY_FOOTPRINT)
|
||||||
HAK_DFL_PROCSTK_SIZE = 5000
|
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;
|
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
|
enum hak_trait_t
|
||||||
{
|
{
|
||||||
#if defined(HAK_BUILD_DEBUG)
|
#if defined(HAK_BUILD_DEBUG)
|
||||||
@@ -690,7 +723,7 @@ struct hak_block_t
|
|||||||
/* the fields of hak_context_t must be mirroed to hak_stack_context_t
|
/* the fields of hak_context_t must be mirroed to hak_stack_context_t
|
||||||
* in hak-prv.h. there are functions affected by the layout change
|
* in hak-prv.h. there are functions affected by the layout change
|
||||||
* of these structures:
|
* of these structures:
|
||||||
* - hak_reify_stack_context() in lib/exec.
|
* - hak_reifystackcontext() in lib/exec.
|
||||||
* - make_stack_context() in lib/exec.c
|
* - make_stack_context() in lib/exec.c
|
||||||
*/
|
*/
|
||||||
struct hak_context_t
|
struct hak_context_t
|
||||||
@@ -793,6 +826,8 @@ struct hak_process_t
|
|||||||
hak_oop_t clsp; /* class stack pointer */
|
hak_oop_t clsp; /* class stack pointer */
|
||||||
hak_oop_t clst; /* class stack top */
|
hak_oop_t clst; /* class stack top */
|
||||||
|
|
||||||
|
/* frame stack store the context objects when the stack context feature is enabled.
|
||||||
|
* if both fsp and fst are to clst, the stack context feature is disabled */
|
||||||
hak_oop_t fsp; /* frame stack pointer */
|
hak_oop_t fsp; /* frame stack pointer */
|
||||||
hak_oop_t fst; /* frame stack top */
|
hak_oop_t fst; /* frame stack top */
|
||||||
|
|
||||||
@@ -1764,9 +1799,22 @@ struct hak_t
|
|||||||
hak_oow_t dfl_symtab_size;
|
hak_oow_t dfl_symtab_size;
|
||||||
hak_oow_t dfl_sysdic_size;
|
hak_oow_t dfl_sysdic_size;
|
||||||
hak_oow_t dfl_procstk_size;
|
hak_oow_t dfl_procstk_size;
|
||||||
|
hak_oow_t dfl_exstk_size;
|
||||||
|
hak_oow_t dfl_clstk_size;
|
||||||
void* mod_inctx;
|
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)
|
#if defined(HAK_BUILD_DEBUG)
|
||||||
/* set automatically when trait is set */
|
/* set automatically when trait is set */
|
||||||
@@ -1921,11 +1969,11 @@ struct hak_t
|
|||||||
hak_oob_t* active_code;
|
hak_oob_t* active_code;
|
||||||
hak_ooi_t sp;
|
hak_ooi_t sp;
|
||||||
hak_ooi_t ip;
|
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 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 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_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_tick; /* last instance specific tick this instance acted on */
|
||||||
hak_uint32_t last_gtick; /* last global tick this instance acted on */
|
hak_uint32_t last_gtick; /* last global tick this instance acted on */
|
||||||
|
|
||||||
@@ -3549,7 +3597,11 @@ HAK_EXPORT void hak_assertfailed (
|
|||||||
/* =========================================================================
|
/* =========================================================================
|
||||||
* HELPERS
|
* 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
|
void
|
||||||
);
|
);
|
||||||
|
|
||||||
|
|||||||
+2
-2
@@ -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
|
/* 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
|
* such as getting system time or logging. so the heap size doesn't
|
||||||
* need to be changed from the tiny value set above. */
|
* 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);
|
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
|
* existing hak instances inside worker threads won't get
|
||||||
* affected. new hak instances to be created later
|
* affected. new hak instances to be created later
|
||||||
* is supposed to use the new value */
|
* 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;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -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)
|
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
|
/* you must provide the payload when calling this variant. it can't figure out
|
||||||
* the actual number of hak_ooch_t characters */
|
* the actual number of hak_ooch_t characters */
|
||||||
if (!ptr)
|
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)
|
#if defined(HAK_OOCH_IS_UCH)
|
||||||
hak_oow_t xlen;
|
|
||||||
hak_ooch_t* xptr;
|
|
||||||
|
|
||||||
xptr = hak_dupbtooochars(hak, ptr, len, &xlen);
|
xptr = hak_dupbtooochars(hak, ptr, len, &xlen);
|
||||||
if (HAK_UNLIKELY(!xptr))
|
if (HAK_UNLIKELY(!xptr))
|
||||||
{
|
{
|
||||||
|
|||||||
+17
-41
@@ -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 obj;
|
||||||
hak_oop_t _class;
|
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_ooi_t fd;
|
||||||
hak_hnd_t* hnd;
|
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);
|
fd = hak->vmprim.vm_getsigfd(hak);
|
||||||
|
|
||||||
/* hand back a system handle id rather than the descriptor itself, so that
|
/* 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
|
* ids, not descriptors. wrapped HAK_HND_OPEN_KEEPOPEN because the VM owns
|
||||||
* this descriptor and manages its blocking mode; the table must never
|
* this descriptor and manages its blocking mode; the table must never
|
||||||
* close it. wrapfd_once() keeps the id stable across calls. */
|
* 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;
|
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;
|
hak_uint8_t sig;
|
||||||
int n;
|
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;
|
return HAK_PF_SUCCESS;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* (system-catch-sig signo) - route an operating system signal into the
|
/* (sys.sig-catch signo) - route an operating system signal into the signal
|
||||||
* signal descriptor, where hak code can wait for
|
* descriptor, where hak code can wait for it with
|
||||||
* it with sem-signal-on-input
|
* core.sem-signal-on-input
|
||||||
* (system-uncatch-sig signo) - release it again
|
* (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
|
* 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.
|
* 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;
|
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);
|
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);
|
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_oop_t tmp;
|
||||||
hak_uint8_t sig;
|
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_scanf, 5, { 's','c','a','n','f' } },
|
||||||
{ 1, HAK_TYPE_MAX(hak_oow_t), pf_sprintf, 7, { 's','p','r','i','n','t','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' } },
|
/* the signal primitives are registered by the sys module instead - see
|
||||||
{ 0, 0, pf_system_get_sig, 14, { 's','y','s','t','e','m','-','g','e','t','-','s','i','g' } },
|
* pfinfos[] in mod/sys.c. they are reached as sys.sig-getfd, sys.sig-get,
|
||||||
{ 1, 1, pf_system_set_sig, 14, { 's','y','s','t','e','m','-','s','e','t','-','s','i','g' } },
|
* sys.sig-set, sys.sig-catch and sys.sig-uncatch. the implementations stay
|
||||||
{ 1, 1, pf_system_catch_sig, 16, { 's','y','s','t','e','m','-','c','a','t','c','h','-','s','i','g' } },
|
* here and are declared in lib/hak-prv.h. */
|
||||||
{ 1, 1, pf_system_uncatch_sig, 18, { 's','y','s','t','e','m','-','u','n','c','a','t','c','h','-','s','i','g' } },
|
|
||||||
|
|
||||||
{ 0, 0, pf_gc, 2, { 'g','c' } },
|
{ 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, 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' } },
|
{ 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_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'} }
|
|
||||||
};
|
};
|
||||||
|
|
||||||
int hak_addbuiltinprims (hak_t* hak)
|
int hak_addbuiltinprims (hak_t* hak)
|
||||||
|
|||||||
+22
-8
@@ -35,12 +35,13 @@
|
|||||||
static struct voca_t
|
static struct voca_t
|
||||||
{
|
{
|
||||||
hak_oow_t len;
|
hak_oow_t len;
|
||||||
hak_ooch_t str[11];
|
hak_ooch_t str[15];
|
||||||
} vocas[] =
|
} vocas[] =
|
||||||
{
|
{
|
||||||
/* TODO: change $include and $pragma to #\include or #\pragma or use some other prefix like #^ -> $ to use really for variable reference or something...
|
/* TODO: change $include and $pragma to #\include or #\pragma or use some other prefix like #^ -> $ to use really for variable reference or something...
|
||||||
* TODO: change #\ to something else... */
|
* TODO: change #\ to something else... */
|
||||||
{ 8, { '$','i','n','c','l','u','d','e' } },
|
{ 8, { '$','i','n','c','l','u','d','e' } },
|
||||||
|
{ 13, { '$','i','n','c','l','u','d','e','-','o','n','c','e' } },
|
||||||
{ 7, { '$','p','r','a','g','m','a' } },
|
{ 7, { '$','p','r','a','g','m','a' } },
|
||||||
|
|
||||||
{ 11, { '#','\\','b','a','c','k','s','p','a','c','e' } },
|
{ 11, { '#','\\','b','a','c','k','s','p','a','c','e' } },
|
||||||
@@ -110,6 +111,7 @@ static struct voca_t
|
|||||||
enum voca_id_t
|
enum voca_id_t
|
||||||
{
|
{
|
||||||
VOCA_INCLUDE,
|
VOCA_INCLUDE,
|
||||||
|
VOCA_INCLUDE_ONCE,
|
||||||
VOCA_PRAGMA,
|
VOCA_PRAGMA,
|
||||||
|
|
||||||
VOCA_CHAR_BACKSPACE,
|
VOCA_CHAR_BACKSPACE,
|
||||||
@@ -300,7 +302,7 @@ static HAK_INLINE int is_delim_char (hak_ooci_t c)
|
|||||||
return c == '(' || c == ')' || c == '[' || c == ']' || c == '{' || c == '}' ||
|
return c == '(' || c == ')' || c == '[' || c == ']' || c == '{' || c == '}' ||
|
||||||
c == '|' || c == ',' || c == '.' || c == ':' || c == ';' ||
|
c == '|' || c == ',' || c == '.' || c == ':' || c == ';' ||
|
||||||
/* the first characters of tokens in delim_token_tab up to this point */
|
/* 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'\u201C' || c == L'\u201D' || /* “ ” */
|
||||||
c == L'\u2018' || c == L'\u2019' || /* ‘ ’ */
|
c == L'\u2018' || c == L'\u2019' || /* ‘ ’ */
|
||||||
#endif
|
#endif
|
||||||
@@ -400,6 +402,11 @@ static int get_directive_token_type (hak_t* hak, hak_tok_type_t* tok_type)
|
|||||||
*tok_type = HAK_TOK_INCLUDE;
|
*tok_type = HAK_TOK_INCLUDE;
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
else if (does_token_name_match(hak, VOCA_INCLUDE_ONCE))
|
||||||
|
{
|
||||||
|
*tok_type = HAK_TOK_INCLUDE_ONCE;
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
else if (does_token_name_match(hak, VOCA_PRAGMA))
|
else if (does_token_name_match(hak, VOCA_PRAGMA))
|
||||||
{
|
{
|
||||||
*tok_type = HAK_TOK_PRAGMA;
|
*tok_type = HAK_TOK_PRAGMA;
|
||||||
@@ -1440,11 +1447,12 @@ static void init_feed (hak_t* hak)
|
|||||||
|
|
||||||
/* ------------------------------------------------------------------------ */
|
/* ------------------------------------------------------------------------ */
|
||||||
|
|
||||||
static int feed_begin_include (hak_t* hak)
|
static int feed_begin_include (hak_t* hak, int once)
|
||||||
{
|
{
|
||||||
hak_io_cciarg_t* arg;
|
hak_io_cciarg_t* arg;
|
||||||
const hak_ooch_t* io_name;
|
const hak_ooch_t* io_name;
|
||||||
|
|
||||||
|
/* TODO: handle once... */
|
||||||
io_name = add_sr_name(hak, TOKEN_NAME(hak));
|
io_name = add_sr_name(hak, TOKEN_NAME(hak));
|
||||||
if (HAK_UNLIKELY(!io_name))
|
if (HAK_UNLIKELY(!io_name))
|
||||||
{
|
{
|
||||||
@@ -1761,12 +1769,12 @@ static int feed_process_token (hak_t* hak)
|
|||||||
goto oops;
|
goto oops;
|
||||||
}
|
}
|
||||||
|
|
||||||
frd->expect_include_file = 0;
|
|
||||||
|
|
||||||
/* indicate that the file inclusion should be performed soon.
|
/* indicate that the file inclusion should be performed soon.
|
||||||
* don't perform actual inclusion here so that the return value of
|
* don't perform actual inclusion here so that the return value of
|
||||||
* feed_char() advances the input pointers properly. */
|
* feed_char() advances the input pointers properly. */
|
||||||
frd->do_include_file = 1;
|
frd->do_include_file = frd->expect_include_file;
|
||||||
|
frd->expect_include_file = 0;
|
||||||
|
|
||||||
goto ok;
|
goto ok;
|
||||||
}
|
}
|
||||||
@@ -1807,6 +1815,10 @@ static int feed_process_token (hak_t* hak)
|
|||||||
frd->expect_include_file = 1;
|
frd->expect_include_file = 1;
|
||||||
goto ok;
|
goto ok;
|
||||||
|
|
||||||
|
case HAK_TOK_INCLUDE_ONCE:
|
||||||
|
frd->expect_include_file = 2;
|
||||||
|
goto ok;
|
||||||
|
|
||||||
case HAK_TOK_PRAGMA:
|
case HAK_TOK_PRAGMA:
|
||||||
/* TODO: check if pragma is the first word in the line */
|
/* TODO: check if pragma is the first word in the line */
|
||||||
frd->expect_pragma_item = 1;
|
frd->expect_pragma_item = 1;
|
||||||
@@ -2665,7 +2677,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 */
|
FEED_CONTINUE(hak, HAK_FLX_QUOTED_TOKEN); /* discard the quote itself. move on the the QUOTED_TOKEN state */
|
||||||
goto consumed;
|
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': /* “ ” */
|
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);
|
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 */
|
FEED_CONTINUE(hak, HAK_FLX_QUOTED_TOKEN); /* discard the quote itself. move on the the QUOTED_TOKEN state */
|
||||||
@@ -3916,8 +3928,9 @@ static int feed_from_includee (hak_t* hak)
|
|||||||
* directive, sets hak->c->feed.rd.do_include_file to 1 instead of attepmting
|
* directive, sets hak->c->feed.rd.do_include_file to 1 instead of attepmting
|
||||||
* to include the file. the file inclusion is attempted here after the return
|
* to include the file. the file inclusion is attempted here after the return
|
||||||
* value of feed_char() is used to advance the hak->c->curinp->b.pos pointer. */
|
* value of feed_char() is used to advance the hak->c->curinp->b.pos pointer. */
|
||||||
|
int incmod = hak->c->feed.rd.do_include_file;
|
||||||
hak->c->feed.rd.do_include_file = 0; /* clear this regardless of inclusion result */
|
hak->c->feed.rd.do_include_file = 0; /* clear this regardless of inclusion result */
|
||||||
if (feed_begin_include(hak) <= -1) goto oops;
|
if (feed_begin_include(hak, incmod == 2) <= -1) goto oops;
|
||||||
curinp = hak->c->curinp;
|
curinp = hak->c->curinp;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -4012,8 +4025,9 @@ int hak_feed (hak_t* hak, const hak_ooch_t* data, hak_oow_t len)
|
|||||||
|
|
||||||
if (hak->c->feed.rd.do_include_file)
|
if (hak->c->feed.rd.do_include_file)
|
||||||
{
|
{
|
||||||
|
int incmod = hak->c->feed.rd.do_include_file;
|
||||||
hak->c->feed.rd.do_include_file = 0; /* done regardless of inclusion result */
|
hak->c->feed.rd.do_include_file = 0; /* done regardless of inclusion result */
|
||||||
if (feed_begin_include(hak) <= -1) goto oops;
|
if (feed_begin_include(hak, incmod == 2) <= -1) goto oops;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (hak->c->curinp && hak->c->curinp != &hak->c->cci_arg && feed_from_includee(hak) <= -1)
|
if (hak->c->curinp && hak->c->curinp != &hak->c->cci_arg && feed_from_includee(hak) <= -1)
|
||||||
|
|||||||
@@ -38,6 +38,15 @@
|
|||||||
# define USE_THREAD
|
# define USE_THREAD
|
||||||
#endif
|
#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__)
|
#if defined(__BORLANDC__) && defined(__DOS__) && defined(_WIN32) && defined(__DPMI32__)
|
||||||
/* bcc32 with powerpack seems to define _WIN32 in DPMI32 mode */
|
/* bcc32 with powerpack seems to define _WIN32 in DPMI32 mode */
|
||||||
# undef _WIN32
|
# undef _WIN32
|
||||||
@@ -212,7 +221,26 @@
|
|||||||
# include <sched.h>
|
# include <sched.h>
|
||||||
# endif
|
# 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 */
|
/* solaris */
|
||||||
# include <sys/devpoll.h>
|
# include <sys/devpoll.h>
|
||||||
# define USE_DEVPOLL
|
# define USE_DEVPOLL
|
||||||
@@ -328,7 +356,7 @@
|
|||||||
* about async-signal-safety - the spinlock is built out of atomics and is safe
|
* 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
|
* 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
|
* 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)
|
#if defined(USE_THREAD)
|
||||||
@@ -448,6 +476,11 @@ struct xtn_t
|
|||||||
struct pollfd* ptr;
|
struct pollfd* ptr;
|
||||||
hak_oow_t capa;
|
hak_oow_t capa;
|
||||||
hak_oow_t len;
|
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)
|
#if defined(USE_THREAD)
|
||||||
pthread_mutex_t pmtx;
|
pthread_mutex_t pmtx;
|
||||||
#endif
|
#endif
|
||||||
@@ -460,6 +493,10 @@ struct xtn_t
|
|||||||
fd_set rfds;
|
fd_set rfds;
|
||||||
fd_set wfds;
|
fd_set wfds;
|
||||||
int maxfd;
|
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)
|
#if defined(USE_THREAD)
|
||||||
pthread_mutex_t smtx;
|
pthread_mutex_t smtx;
|
||||||
#endif
|
#endif
|
||||||
@@ -1510,6 +1547,32 @@ static void vm_gettime (hak_t* hak, hak_ntime_t* now)
|
|||||||
* IO MULTIPLEXING
|
* 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)
|
static int _add_poll_fd (hak_t* hak, int fd, int event_mask)
|
||||||
{
|
{
|
||||||
#if defined(USE_DEVPOLL)
|
#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].events = event_mask;
|
||||||
xtn->ev.reg.ptr[xtn->ev.reg.len].revents = 0;
|
xtn->ev.reg.ptr[xtn->ev.reg.len].revents = 0;
|
||||||
xtn->ev.reg.len++;
|
xtn->ev.reg.len++;
|
||||||
|
xtn->ev.reg.epoch++;
|
||||||
MUTEX_UNLOCK(&xtn->ev.reg.pmtx);
|
MUTEX_UNLOCK(&xtn->ev.reg.pmtx);
|
||||||
|
|
||||||
|
wake_iothr(hak);
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
#elif defined(USE_SELECT)
|
#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);
|
FD_SET (fd, &xtn->ev.reg.wfds);
|
||||||
if (fd > xtn->ev.reg.maxfd) xtn->ev.reg.maxfd = fd;
|
if (fd > xtn->ev.reg.maxfd) xtn->ev.reg.maxfd = fd;
|
||||||
}
|
}
|
||||||
|
xtn->ev.reg.epoch++;
|
||||||
MUTEX_UNLOCK(&xtn->ev.reg.smtx);
|
MUTEX_UNLOCK(&xtn->ev.reg.smtx);
|
||||||
|
|
||||||
|
wake_iothr(hak);
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
#else
|
#else
|
||||||
@@ -1785,7 +1852,15 @@ static int _del_poll_fd (hak_t* hak, int fd)
|
|||||||
{
|
{
|
||||||
xtn->ev.reg.len--;
|
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));
|
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);
|
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;
|
return 0;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -1811,8 +1886,10 @@ static int _del_poll_fd (hak_t* hak, int fd)
|
|||||||
}
|
}
|
||||||
xtn->ev.reg.maxfd = i;
|
xtn->ev.reg.maxfd = i;
|
||||||
}
|
}
|
||||||
|
xtn->ev.reg.epoch++;
|
||||||
MUTEX_UNLOCK(&xtn->ev.reg.smtx);
|
MUTEX_UNLOCK(&xtn->ev.reg.smtx);
|
||||||
|
|
||||||
|
wake_iothr(hak);
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
#else
|
#else
|
||||||
@@ -1839,7 +1916,7 @@ static int _mod_poll_fd (hak_t* hak, int fd, int event_mask)
|
|||||||
#elif defined(USE_KQUEUE)
|
#elif defined(USE_KQUEUE)
|
||||||
xtn_t* xtn = GET_XTN(hak);
|
xtn_t* xtn = GET_XTN(hak);
|
||||||
hak_oow_t rindex, roffset;
|
hak_oow_t rindex, roffset;
|
||||||
int rv, newrv = 0;
|
int rv, newrv;
|
||||||
struct kevent ev;
|
struct kevent ev;
|
||||||
|
|
||||||
rindex = (hak_oow_t)fd / (HAK_BITSOF(hak_oow_t) >> 1);
|
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);
|
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)
|
if (rv & 1)
|
||||||
{
|
{
|
||||||
@@ -1960,12 +2038,18 @@ kqueue_syserr:
|
|||||||
{
|
{
|
||||||
if (xtn->ev.reg.ptr[i].fd == fd)
|
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));
|
/* modify in place. shifting the tail down the way a delete does
|
||||||
xtn->ev.reg.ptr[i].fd = fd;
|
* 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].events = event_mask;
|
||||||
xtn->ev.reg.ptr[i].revents = 0;
|
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);
|
MUTEX_UNLOCK(&xtn->ev.reg.pmtx);
|
||||||
|
|
||||||
|
wake_iothr(hak);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -1992,7 +2076,10 @@ kqueue_syserr:
|
|||||||
else
|
else
|
||||||
FD_CLR(fd, &xtn->ev.reg.wfds);
|
FD_CLR(fd, &xtn->ev.reg.wfds);
|
||||||
|
|
||||||
|
xtn->ev.reg.epoch++;
|
||||||
MUTEX_UNLOCK(&xtn->ev.reg.smtx);
|
MUTEX_UNLOCK(&xtn->ev.reg.smtx);
|
||||||
|
|
||||||
|
wake_iothr(hak);
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
#else
|
#else
|
||||||
@@ -2003,6 +2090,24 @@ kqueue_syserr:
|
|||||||
}
|
}
|
||||||
|
|
||||||
#if defined(USE_THREAD)
|
#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.
|
/* Drop multiplexer events already sitting in the buffer for this descriptor.
|
||||||
*
|
*
|
||||||
* iothr_main() reads events straight into xtn->ev.buf and publishes ev.len;
|
* 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
|
* caches ev.len and would walk entries this function compacts away. Nothing
|
||||||
* does today - signalling a semaphore only makes a process runnable, it does
|
* 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. */
|
* 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);
|
xtn_t* xtn = GET_XTN(hak);
|
||||||
hak_oow_t i, j;
|
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);
|
MUTEX_LOCK(&xtn->ev.mtx);
|
||||||
|
|
||||||
for (i = 0, j = 0; i < xtn->ev.len; i++)
|
for (i = 0, j = 0; i < xtn->ev.len; i++)
|
||||||
{
|
{
|
||||||
#if defined(USE_DEVPOLL) || defined(USE_POLL) || defined(USE_SELECT)
|
if (MUXEVT_FD(xtn->ev.buf[i]) == fd)
|
||||||
if (xtn->ev.buf[i].fd == fd) continue;
|
{
|
||||||
#elif defined(USE_KQUEUE)
|
if (!keep_mask) continue; /* nothing registered survives */
|
||||||
if ((int)xtn->ev.buf[i].ident == fd) continue;
|
#if defined(USE_KQUEUE)
|
||||||
#elif defined(USE_EPOLL)
|
dir_mask = 0;
|
||||||
if (xtn->ev.buf[i].data.fd == fd) continue;
|
/* 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
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
if (j != i) xtn->ev.buf[j] = xtn->ev.buf[i];
|
if (j != i) xtn->ev.buf[j] = xtn->ev.buf[i];
|
||||||
j++;
|
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)
|
static int vm_muxmod (hak_t* hak, hak_ooi_t io_handle, hak_ooi_t mask)
|
||||||
{
|
{
|
||||||
int event_mask;
|
int event_mask;
|
||||||
|
int n;
|
||||||
|
|
||||||
event_mask = 0;
|
event_mask = 0;
|
||||||
if (mask & HAK_SEMAPHORE_IO_MASK_INPUT) event_mask |= XPOLLIN;
|
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 -1;
|
||||||
}
|
}
|
||||||
|
|
||||||
return _mod_poll_fd(hak, io_handle, event_mask);
|
n = _mod_poll_fd(hak, io_handle, event_mask);
|
||||||
|
|
||||||
/* [NOTE]
|
#if defined(USE_THREAD)
|
||||||
* this may need the same mux event purge as vm_muxdel() for accuracy.
|
purge_muxevts(hak, (int)io_handle, event_mask);
|
||||||
* if a file descriptor is removed for one direction while another direction
|
#endif
|
||||||
* is still watched, this function is invoked. in that case, xtn->evt.buf
|
|
||||||
* may have some stale events and they can raise spurious signals.
|
return n;
|
||||||
*
|
|
||||||
* TODO: per-direction event purge
|
|
||||||
*/
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static int vm_muxdel (hak_t* hak, hak_ooi_t io_handle)
|
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 does not make a buffered event any less stale.
|
||||||
* delete_sem_from_sem_io_tuple() carries on regardless when force is set.
|
* 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
|
#endif
|
||||||
return n;
|
return n;
|
||||||
}
|
}
|
||||||
@@ -2128,11 +2245,13 @@ static void* iothr_main (void* arg)
|
|||||||
struct timespec ts;
|
struct timespec ts;
|
||||||
#elif defined(USE_POLL)
|
#elif defined(USE_POLL)
|
||||||
hak_oow_t nfds;
|
hak_oow_t nfds;
|
||||||
|
hak_oow_t epoch;
|
||||||
#elif defined(USE_SELECT)
|
#elif defined(USE_SELECT)
|
||||||
struct timeval tv;
|
struct timeval tv;
|
||||||
fd_set rfds;
|
fd_set rfds;
|
||||||
fd_set wfds;
|
fd_set wfds;
|
||||||
int maxfd;
|
int maxfd;
|
||||||
|
hak_oow_t epoch;
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
poll_for_event:
|
poll_for_event:
|
||||||
@@ -2154,8 +2273,23 @@ static void* iothr_main (void* arg)
|
|||||||
MUTEX_LOCK(&xtn->ev.reg.pmtx);
|
MUTEX_LOCK(&xtn->ev.reg.pmtx);
|
||||||
HAK_MEMCPY(xtn->ev.buf, xtn->ev.reg.ptr, xtn->ev.reg.len * HAK_SIZEOF(*xtn->ev.buf));
|
HAK_MEMCPY(xtn->ev.buf, xtn->ev.reg.ptr, xtn->ev.reg.len * HAK_SIZEOF(*xtn->ev.buf));
|
||||||
nfds = xtn->ev.reg.len;
|
nfds = xtn->ev.reg.len;
|
||||||
|
epoch = xtn->ev.reg.epoch;
|
||||||
MUTEX_UNLOCK(&xtn->ev.reg.pmtx);
|
MUTEX_UNLOCK(&xtn->ev.reg.pmtx);
|
||||||
|
|
||||||
n = poll(xtn->ev.buf, nfds, 10000);
|
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)
|
if (n > 0)
|
||||||
{
|
{
|
||||||
/* compact the return buffer as poll() doesn't */
|
/* compact the return buffer as poll() doesn't */
|
||||||
@@ -2177,8 +2311,17 @@ static void* iothr_main (void* arg)
|
|||||||
maxfd = xtn->ev.reg.maxfd;
|
maxfd = xtn->ev.reg.maxfd;
|
||||||
HAK_MEMCPY(&rfds, &xtn->ev.reg.rfds, HAK_SIZEOF(rfds));
|
HAK_MEMCPY(&rfds, &xtn->ev.reg.rfds, HAK_SIZEOF(rfds));
|
||||||
HAK_MEMCPY(&wfds, &xtn->ev.reg.wfds, HAK_SIZEOF(wfds));
|
HAK_MEMCPY(&wfds, &xtn->ev.reg.wfds, HAK_SIZEOF(wfds));
|
||||||
|
epoch = xtn->ev.reg.epoch;
|
||||||
MUTEX_UNLOCK(&xtn->ev.reg.smtx);
|
MUTEX_UNLOCK(&xtn->ev.reg.smtx);
|
||||||
n = select(maxfd + 1, &rfds, &wfds, HAK_NULL, &tv);
|
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)
|
if (n > 0)
|
||||||
{
|
{
|
||||||
int fd, count = 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;
|
--n;
|
||||||
|
|
||||||
#if defined(USE_DEVPOLL)
|
if (MUXEVT_FD(xtn->ev.buf[n]) == xtn->iothr.p[0])
|
||||||
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
|
|
||||||
{
|
{
|
||||||
hak_uint8_t u8;
|
hak_uint8_t u8;
|
||||||
while (read(xtn->iothr.p[0], &u8, HAK_SIZEOF(u8)) > 0)
|
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;
|
int revents;
|
||||||
hak_ooi_t mask;
|
hak_ooi_t mask;
|
||||||
|
|
||||||
#if defined(USE_DEVPOLL)
|
#if defined(USE_KQUEUE)
|
||||||
revents = xtn->ev.buf[n].revents;
|
|
||||||
#elif defined(USE_KQUEUE)
|
|
||||||
revents = 0;
|
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;
|
if (xtn->ev.buf[n].filter == EVFILT_READ) revents |= XPOLLIN;
|
||||||
else if (xtn->ev.buf[n].filter == EVFILT_WRITE) revents |= XPOLLOUT;
|
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_EOF) revents |= XPOLLHUP;
|
||||||
if (xtn->ev.buf[n].flags & EV_ERROR) revents |= XPOLLERR;
|
if (xtn->ev.buf[n].flags & EV_ERROR) revents |= XPOLLERR;
|
||||||
#elif defined(USE_EPOLL)
|
#else
|
||||||
revents = xtn->ev.buf[n].events;
|
revents = MUXEVT_MASK(xtn->ev.buf[n]);
|
||||||
#elif defined(USE_POLL)
|
|
||||||
revents = xtn->ev.buf[n].revents;
|
|
||||||
#elif defined(USE_SELECT)
|
|
||||||
revents = xtn->ev.buf[n].events;
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
mask = 0;
|
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 & XPOLLERR) mask |= HAK_SEMAPHORE_IO_MASK_ERROR;
|
||||||
if (revents & XPOLLHUP) mask |= HAK_SEMAPHORE_IO_MASK_HANGUP;
|
if (revents & XPOLLHUP) mask |= HAK_SEMAPHORE_IO_MASK_HANGUP;
|
||||||
|
|
||||||
#if defined(USE_DEVPOLL)
|
muxwcb(hak, MUXEVT_FD(xtn->ev.buf[n]), mask);
|
||||||
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
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
while (n > 0);
|
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;
|
revents = xtn->ev.buf[n].revents;
|
||||||
#elif defined(USE_KQUEUE)
|
#elif defined(USE_KQUEUE)
|
||||||
revents = 0;
|
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;
|
if (xtn->ev.buf[n].filter == EVFILT_READ) revents |= XPOLLIN;
|
||||||
else if (xtn->ev.buf[n].filter == EVFILT_WRITE) revents |= XPOLLOUT;
|
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_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 &&
|
if (g_sig_state[sig].handler != (hak_uintptr_t)SIG_IGN &&
|
||||||
g_sig_state[sig].handler != (hak_uintptr_t)SIG_DFL)
|
g_sig_state[sig].handler != (hak_uintptr_t)SIG_DFL)
|
||||||
{
|
{
|
||||||
|
/* execute the current handler */
|
||||||
((sig_handler_t)g_sig_state[sig].handler)(sig);
|
((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_IGN &&
|
||||||
g_sig_state[sig].old_handler != (hak_uintptr_t)SIG_DFL)
|
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);
|
((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);
|
xtn_t* xtn = GET_XTN(hak);
|
||||||
hak_uint8_t u8;
|
hak_uint8_t u8;
|
||||||
/*hak_abortstd(hak);*/
|
|
||||||
u8 = signo & 0xFF;
|
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));
|
write(xtn->sigfd.p[1], &u8, HAK_SIZEOF(u8));
|
||||||
hak = xtn->next;
|
hak = xtn->next;
|
||||||
}
|
}
|
||||||
@@ -3137,7 +3257,7 @@ static DWORD WINAPI msw_wait_for_timer_event (LPVOID ctx)
|
|||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static HAK_INLINE void start_ticker (void)
|
static HAK_INLINE int start_ticker (void)
|
||||||
{
|
{
|
||||||
HANDLE thr;
|
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.
|
* and all handles to it have been closed through a call to CloseHandle.
|
||||||
* it is safe to close the handle here */
|
* it is safe to close the handle here */
|
||||||
CloseHandle(thr);
|
CloseHandle(thr);
|
||||||
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
return -1;
|
||||||
}
|
}
|
||||||
|
|
||||||
static HAK_INLINE void stop_ticker (void)
|
static HAK_INLINE void stop_ticker (void)
|
||||||
@@ -3207,12 +3330,13 @@ done:
|
|||||||
DosExit(EXIT_THREAD, 0);
|
DosExit(EXIT_THREAD, 0);
|
||||||
}
|
}
|
||||||
|
|
||||||
static HAK_INLINE void start_ticker (void)
|
static HAK_INLINE int start_ticker (void)
|
||||||
{
|
{
|
||||||
static TID tid;
|
static TID tid;
|
||||||
os2_tick_done = 0;
|
os2_tick_done = 0;
|
||||||
DosCreateThread(&tid, os2_wait_for_timer_event, 0, 0, 4096);
|
DosCreateThread(&tid, os2_wait_for_timer_event, 0, 0, 4096);
|
||||||
/* TODO: Error check */
|
/* TODO: Error check */
|
||||||
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static HAK_INLINE void stop_ticker (void)
|
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);
|
_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_prev_timer_intr_handler = _dos_getvect(0x1C);
|
||||||
_dos_setvect(0x1C, dos_timer_intr_handler);
|
_dos_setvect(0x1C, dos_timer_intr_handler);
|
||||||
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static HAK_INLINE void stop_ticker (void)
|
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);
|
PrimeTime((QElem*)&mac_tmtask, TMTASK_DELAY);
|
||||||
}
|
}
|
||||||
|
|
||||||
static HAK_INLINE void start_ticker (void)
|
static HAK_INLINE int start_ticker (void)
|
||||||
{
|
{
|
||||||
GetCurrentProcess(&mac_psn);
|
GetCurrentProcess(&mac_psn);
|
||||||
HAK_MEMSET(&mac_tmtask, 0, HAK_SIZEOF(mac_tmtask));
|
HAK_MEMSET(&mac_tmtask, 0, HAK_SIZEOF(mac_tmtask));
|
||||||
mac_tmtask.tmAddr = NewTimerProc (timer_intr_handler);
|
mac_tmtask.tmAddr = NewTimerProc (timer_intr_handler);
|
||||||
InsXTime((QElem*)&mac_tmtask);
|
InsXTime((QElem*)&mac_tmtask);
|
||||||
PrimeTime((QElem*)&mac_tmtask, TMTASK_DELAY);
|
PrimeTime((QElem*)&mac_tmtask, TMTASK_DELAY);
|
||||||
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static HAK_INLINE void stop_ticker (void)
|
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)
|
#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)
|
if (set_signal_handler(SIGVTALRM, SH_HOW_UPSERT, hak_raise_gtick, SA_RESTART) >= 0)
|
||||||
{
|
{
|
||||||
struct itimerval itv;
|
struct itimerval itv;
|
||||||
|
|
||||||
itv.it_interval.tv_sec = 0;
|
itv.it_interval.tv_sec = 0;
|
||||||
itv.it_interval.tv_usec = HAK_TICKER_INTERVAL_USECS;
|
itv.it_interval.tv_usec = HAK_TICKER_INTERVAL_USECS;
|
||||||
itv.it_value.tv_sec = 0;
|
itv.it_value.tv_sec = 0;
|
||||||
itv.it_value.tv_usec = HAK_TICKER_INTERVAL_USECS;
|
itv.it_value.tv_usec = HAK_TICKER_INTERVAL_USECS;
|
||||||
if (setitimer(ITIMER_VIRTUAL, &itv, HAK_NULL) == -1)
|
if (setitimer(ITIMER_VIRTUAL, &itv, HAK_NULL) == 0) return 0;
|
||||||
{
|
|
||||||
/* WSL supports ITIMER_VIRTUAL only as of windows 10.0.18362.413.
|
/* WSL before windows 10.0.18362.413 rejects ITIMER_VIRTUAL outright. */
|
||||||
the following is a fallback which will get */
|
|
||||||
unset_signal_handler(SIGVTALRM);
|
unset_signal_handler(SIGVTALRM);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
#if defined(SIGALRM) && defined(ITIMER_REAL)
|
#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)
|
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.
|
/* i double the interval as ITIMER_REAL is against the wall clock.
|
||||||
* if the underlying system is under heavy load, some signals
|
* if the underlying system is under heavy load, some signals
|
||||||
* will get lost */
|
* 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_interval.tv_usec = HAK_TICKER_INTERVAL_USECS * 2;
|
||||||
itv.it_value.tv_sec = 0;
|
itv.it_value.tv_sec = 0;
|
||||||
itv.it_value.tv_usec = HAK_TICKER_INTERVAL_USECS * 2;
|
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
|
#endif
|
||||||
}
|
|
||||||
}
|
/* [NOTE] there is no ticker installed if the code reach here */
|
||||||
|
return -1;
|
||||||
}
|
}
|
||||||
|
|
||||||
static HAK_INLINE void stop_ticker (void)
|
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 pid_t ticker_pid = -1;
|
||||||
|
|
||||||
static HAK_INLINE void start_ticker (void)
|
static HAK_INLINE int start_ticker (void)
|
||||||
{
|
{
|
||||||
#if defined(SIGALRM)
|
#if defined(SIGALRM)
|
||||||
if (set_signal_handler(SIGALRM, SH_HOW_UPSERT, hak_raise_gtick, SA_RESTART) >= 0)
|
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);
|
nanosleep(&ts, HAK_NULL);
|
||||||
#elif defined(HAVE_USLEEP)
|
#elif defined(HAVE_USLEEP)
|
||||||
usleep(HAK_TICKER_INTERVAL_USECS * 2);
|
usleep(HAK_TICKER_INTERVAL_USECS * 2);
|
||||||
|
|
||||||
#else
|
#else
|
||||||
# error UNDEFINED SLEEP
|
# error UNDEFINED SLEEP
|
||||||
#endif
|
#endif
|
||||||
@@ -3386,8 +3523,11 @@ static HAK_INLINE void start_ticker (void)
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* parent just carries on. */
|
/* parent just carries on. */
|
||||||
|
return 0; /* success */
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
return -1;
|
||||||
}
|
}
|
||||||
|
|
||||||
static HAK_INLINE void stop_ticker (void)
|
static HAK_INLINE void stop_ticker (void)
|
||||||
@@ -3548,11 +3688,17 @@ static void dl_cleanup (hak_t* hak)
|
|||||||
#endif
|
#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;
|
void* handle;
|
||||||
hak_oow_t len, i, xlen, dlen;
|
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.
|
/* opening a primitive function module - mostly libhak-xxxx.
|
||||||
* if PFMODPREFIX is absolute, never use PFMODDIR */
|
* 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)
|
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);
|
dlen = hak_copy_bchars_to_bcstr(bufptr, bufcapa, dirptr, dirlen);
|
||||||
#endif
|
|
||||||
|
|
||||||
if (dlen > 0 && bufptr[dlen - 1] != HAK_DFL_PATH_SEP)
|
if (dlen > 0 && bufptr[dlen - 1] != HAK_DFL_PATH_SEP)
|
||||||
{
|
{
|
||||||
@@ -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)
|
#if defined(USE_LTDL) || defined(USE_DLFCN) || defined(USE_MACH_O_DYLD)
|
||||||
hak_bch_t stabuf[128], * bufptr;
|
hak_bch_t stabuf[128], * bufptr;
|
||||||
hak_oow_t ucslen, bcslen, bufcapa;
|
|
||||||
void* handle = HAK_NULL;
|
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 defined(HAK_OOCH_IS_UCH)
|
||||||
if (hak_convootobcstr(hak, name, &ucslen, HAK_NULL, &bufcapa) <= -1) return HAK_NULL;
|
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
|
#else
|
||||||
bufcapa = hak_count_bcstr(name);
|
bufcapa = hak_count_bcstr(name);
|
||||||
bufcapa += (hak->option.mod[0].len > 0)? hak->option.mod[0].len: HAK_COUNTOF(HAK_DEFAULT_PFMODDIR);
|
|
||||||
#endif
|
#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)
|
/* HAK_COUNTOF(HAK_DEFAULT_PFMODPREFIX) and HAK_COUNTOF(HAK_DEFAULT_PFMODPOSTIFX)
|
||||||
* include the terminating nulls. Never mind about the extra 2 characters. */
|
* include the terminating nulls. Never mind about the extra 2 characters. */
|
||||||
bufcapa += HAK_COUNTOF(HAK_DEFAULT_PFMODPREFIX) + HAK_COUNTOF(HAK_DEFAULT_PFMODPOSTFIX) + 1;
|
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 (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;
|
ptr = modlibdirs;
|
||||||
end = hak->option.mod[0].ptr + hak->option.mod[0].len;
|
end = modlibdirs + hak_count_bcstr(modlibdirs);
|
||||||
seg = ptr;
|
seg = ptr;
|
||||||
|
|
||||||
while (ptr <= end)
|
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);
|
xtn_t* xtn = GET_XTN(hak);
|
||||||
int fd;
|
int fd;
|
||||||
|
|
||||||
if (id != HAK_LOG_TARGET_BCSTR && id != HAK_LOG_TARGET_UCSTR &&
|
if (id != HAK_OPT_LOG_TARGET_BCSTR && id != HAK_OPT_LOG_TARGET_UCSTR &&
|
||||||
id != HAK_LOG_TARGET_BCS && id != HAK_LOG_TARGET_UCS) return; /* return success. not interested */
|
id != HAK_OPT_LOG_TARGET_BCS && id != HAK_OPT_LOG_TARGET_UCS) return; /* return success. not interested */
|
||||||
|
|
||||||
#if defined(_WIN32)
|
#if defined(_WIN32)
|
||||||
#if defined(HAK_OOCH_IS_UCH) && (HAK_SIZEOF_UCH_T == HAK_SIZEOF_WCHAR_T)
|
#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.rfds);
|
||||||
FD_ZERO(&xtn->ev.reg.wfds);
|
FD_ZERO(&xtn->ev.reg.wfds);
|
||||||
xtn->ev.reg.maxfd = -1;
|
xtn->ev.reg.maxfd = -1;
|
||||||
|
xtn->ev.reg.epoch = 0;
|
||||||
MUTEX_INIT(&xtn->ev.reg.smtx);
|
MUTEX_INIT(&xtn->ev.reg.smtx);
|
||||||
#endif /* USE_DEVPOLL */
|
#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);
|
xtn_t* xtn = GET_XTN(hak);
|
||||||
bb_t* bb = HAK_NULL;
|
bb_t* bb = HAK_NULL;
|
||||||
|
|
||||||
/* TOOD: support predefined include directory as well */
|
|
||||||
if (arg->includer)
|
if (arg->includer)
|
||||||
{
|
{
|
||||||
/* includee */
|
/* includee */
|
||||||
hak_oow_t ucslen, bcslen, parlen;
|
hak_oow_t ucslen, bcslen, parlen;
|
||||||
const hak_bch_t* fn, * fb;
|
const hak_bch_t* fn, * fb;
|
||||||
|
int attempt_incdirs;
|
||||||
|
const hak_bch_t* incdirs_ptr;
|
||||||
|
|
||||||
#if defined(HAK_OOCH_IS_UCH)
|
#if defined(HAK_OOCH_IS_UCH)
|
||||||
if (hak_convootobcstr(hak, arg->name, &ucslen, HAK_NULL, &bcslen) <= -1) goto oops;
|
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 = "";
|
fb = "";
|
||||||
parlen = 0;
|
parlen = 0;
|
||||||
|
attempt_incdirs = 0;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
fb = hak_get_base_name_from_bcstr_path(fn);
|
fb = hak_get_base_name_from_bcstr_path(fn);
|
||||||
parlen = fb - 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)));
|
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);
|
bb->fn = (hak_bch_t*)(bb + 1);
|
||||||
hak_copy_bchars(bb->fn, fn, parlen);
|
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);
|
hak_copy_bcstr(&bb->fn[parlen], bcslen + 1, arg->name);
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
incdirs_ptr = hak->option.incdirs_b;
|
||||||
|
retry:
|
||||||
bb->fp = fopen(bb->fn, FOPEN_R_FLAGS);
|
bb->fp = fopen(bb->fn, FOPEN_R_FLAGS);
|
||||||
if (!bb->fp)
|
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);
|
hak_seterrbfmt(hak, HAK_EIOERR, "unable to open %hs", bb->fn);
|
||||||
goto oops;
|
goto oops;
|
||||||
}
|
}
|
||||||
@@ -4545,6 +4726,15 @@ static HAK_INLINE int open_cci_stream (hak_t* hak, hak_io_cciarg_t* arg)
|
|||||||
else
|
else
|
||||||
{
|
{
|
||||||
/* main stream */
|
/* 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;
|
hak_oow_t pathlen;
|
||||||
|
|
||||||
pathlen = xtn->cci_path? hak_count_bcstr(xtn->cci_path): 0;
|
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;
|
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)
|
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)
|
void hak_stop_ticker (void)
|
||||||
{
|
{
|
||||||
/* TODO: use atomic op */
|
#if defined(USE_TICKER_ATOMICS)
|
||||||
if (ticker_started > 0 && --ticker_started == 0)
|
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
@@ -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
|
/* 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
|
* such as getting system time or logging. so the heap size doesn't
|
||||||
* need to be changed from the tiny value set above. */
|
* 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);
|
hak_setcmgr (client->dummy_hak, client->_cmgr);
|
||||||
|
|
||||||
return client;
|
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
|
* existing hak instances inside worker threads won't get
|
||||||
* affected. new hak instances to be created later
|
* affected. new hak instances to be created later
|
||||||
* is supposed to use the new value */
|
* 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;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|||||||
+10
-10
@@ -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
|
/* 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
|
* such as getting system time or logging. so the heap size doesn't
|
||||||
* need to be changed from the tiny value set above. */
|
* 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_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 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_GC) trait |= HAK_TRAIT_DEBUG_GC;
|
||||||
if (server->cfg.trait & HAK_SERVER_TRAIT_DEBUG_BIGINT) trait |= HAK_TRAIT_DEBUG_BIGINT;
|
if (server->cfg.trait & HAK_SERVER_TRAIT_DEBUG_BIGINT) trait |= HAK_TRAIT_DEBUG_BIGINT;
|
||||||
#endif
|
#endif
|
||||||
hak_setoption (server->dummy_hak, HAK_TRAIT, &trait);
|
hak_setoption (server->dummy_hak, HAK_OPT_TRAIT, &trait);
|
||||||
|
|
||||||
return server;
|
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_hak_xtn_t*)hak_getxtn(hak);
|
||||||
xtn->worker = worker;
|
xtn->worker = worker;
|
||||||
|
|
||||||
hak_setoption(hak, HAK_MOD_INCTX, &server->cfg.module_inctx);
|
hak_setoption(hak, HAK_OPT_MODINCTX, &server->cfg.module_inctx);
|
||||||
hak_setoption(hak, HAK_LOG_MASK, &server->cfg.logmask);
|
hak_setoption(hak, HAK_OPT_LOG_MASK, &server->cfg.logmask);
|
||||||
hak_setcmgr(hak, hak_server_getcmgr(server));
|
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 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_GC) trait |= HAK_TRAIT_DEBUG_GC;
|
||||||
if (server->cfg.trait & HAK_SERVER_TRAIT_DEBUG_BIGINT) trait |= HAK_TRAIT_DEBUG_BIGINT;
|
if (server->cfg.trait & HAK_SERVER_TRAIT_DEBUG_BIGINT) trait |= HAK_TRAIT_DEBUG_BIGINT;
|
||||||
#endif
|
#endif
|
||||||
trait |= HAK_TRAIT_LANG_ENABLE_EOL;
|
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));
|
HAK_MEMSET(&hakcb, 0, HAK_SIZEOF(hakcb));
|
||||||
/*hakcb.fini = fini_hak;
|
/*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 */
|
* is supposed to use the new value */
|
||||||
hak_bitmask_t trait;
|
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 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_GC) trait |= HAK_TRAIT_DEBUG_GC;
|
||||||
if (server->cfg.trait & HAK_SERVER_TRAIT_DEBUG_BIGINT) trait |= HAK_TRAIT_DEBUG_BIGINT;
|
if (server->cfg.trait & HAK_SERVER_TRAIT_DEBUG_BIGINT) trait |= HAK_TRAIT_DEBUG_BIGINT;
|
||||||
#endif
|
#endif
|
||||||
hak_setoption (server->dummy_hak, HAK_TRAIT, &trait);
|
hak_setoption (server->dummy_hak, HAK_OPT_TRAIT, &trait);
|
||||||
}
|
}
|
||||||
return 0;
|
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
|
* existing hak instances inside worker threads won't get
|
||||||
* affected. new hak instances to be created later
|
* affected. new hak instances to be created later
|
||||||
* is supposed to use the new value */
|
* 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;
|
return 0;
|
||||||
|
|
||||||
|
|||||||
+26
@@ -584,6 +584,9 @@ static hak_pfinfo_t pfinfos[] =
|
|||||||
|
|
||||||
/* TODO: add more builtin primitives here... */
|
/* TODO: add more builtin primitives here... */
|
||||||
{ "abs", { HAK_PFBASE_FUNC, hak_pf_number_abs, 1, 1 } },
|
{ "abs", { HAK_PFBASE_FUNC, hak_pf_number_abs, 1, 1 } },
|
||||||
|
|
||||||
|
{ "active-process", { HAK_PFBASE_FUNC, hak_pf_process_current, 0, 0 } },
|
||||||
|
|
||||||
{ "basicAt", { HAK_PFBASE_FUNC, pf_core_basic_at, 2, 2 } },
|
{ "basicAt", { HAK_PFBASE_FUNC, pf_core_basic_at, 2, 2 } },
|
||||||
{ "basicAtPut", { HAK_PFBASE_FUNC, pf_core_basic_at_put, 3, 3 } },
|
{ "basicAtPut", { HAK_PFBASE_FUNC, pf_core_basic_at_put, 3, 3 } },
|
||||||
{ "basicNew", { HAK_PFBASE_FUNC, pf_core_basic_new, 1, 2 } },
|
{ "basicNew", { HAK_PFBASE_FUNC, pf_core_basic_new, 1, 2 } },
|
||||||
@@ -609,17 +612,40 @@ static hak_pfinfo_t pfinfos[] =
|
|||||||
{ "eql?", { HAK_PFBASE_FUNC, hak_pf_eql, 2, 2 } },
|
{ "eql?", { HAK_PFBASE_FUNC, hak_pf_eql, 2, 2 } },
|
||||||
{ "eqv?", { HAK_PFBASE_FUNC, hak_pf_eqv, 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 } },
|
{ "instRespondsTo", { HAK_PFBASE_FUNC, pf_core_inst_responds_to, 2, 2 } },
|
||||||
|
|
||||||
{ "nqk?", { HAK_PFBASE_FUNC, hak_pf_nqk, 2, 2 } },
|
{ "nqk?", { HAK_PFBASE_FUNC, hak_pf_nqk, 2, 2 } },
|
||||||
{ "nql?", { HAK_PFBASE_FUNC, hak_pf_nql, 2, 2 } },
|
{ "nql?", { HAK_PFBASE_FUNC, hak_pf_nql, 2, 2 } },
|
||||||
{ "nqv?", { HAK_PFBASE_FUNC, hak_pf_nqv, 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 } },
|
{ "primAt", { HAK_PFBASE_FUNC, pf_core_prim_at, 2, 2 } },
|
||||||
{ "primAtPut", { HAK_PFBASE_FUNC, pf_core_prim_at_put, 3, 3 } },
|
{ "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 } },
|
{ "slice", { HAK_PFBASE_FUNC, pf_core_slice, 3, 3 } },
|
||||||
{ "smooiToChar", { HAK_PFBASE_FUNC, pf_core_smooi_to_char, 1, 1 } },
|
{ "smooiToChar", { HAK_PFBASE_FUNC, pf_core_smooi_to_char, 1, 1 } },
|
||||||
{ "sqrt", { HAK_PFBASE_FUNC, hak_pf_number_sqrt, 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 } },
|
{ "~=", { HAK_PFBASE_FUNC, hak_pf_number_ne, 2, 2 } },
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|||||||
@@ -31,9 +31,8 @@
|
|||||||
#endif
|
#endif
|
||||||
|
|
||||||
#include "_sys.h"
|
#include "_sys.h"
|
||||||
#include <hak-hnd.h>
|
#include "../lib/hak-prv.h"
|
||||||
#include <hak-pio.h>
|
#include <hak-pio.h>
|
||||||
#include <hak-str.h>
|
|
||||||
#include <stdlib.h>
|
#include <stdlib.h>
|
||||||
#include <signal.h>
|
#include <signal.h>
|
||||||
|
|
||||||
@@ -43,7 +42,6 @@
|
|||||||
# include <unistd.h>
|
# include <unistd.h>
|
||||||
# include <fcntl.h>
|
# include <fcntl.h>
|
||||||
# include <errno.h>
|
# include <errno.h>
|
||||||
# include <sys/syscall.h>
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#if defined(HAVE_SYS_TIME_H)
|
#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
|
* 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.
|
* 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
|
* -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.
|
* failure raises.
|
||||||
* ------------------------------------------------------------------------ */
|
* ------------------------------------------------------------------------ */
|
||||||
|
|
||||||
@@ -814,6 +812,13 @@ static hak_pfinfo_t pfinfos[] =
|
|||||||
{ "pwait", { HAK_PFBASE_FUNC, pf_sys_pwait, 1, 1 } },
|
{ "pwait", { HAK_PFBASE_FUNC, pf_sys_pwait, 1, 1 } },
|
||||||
{ "random", { HAK_PFBASE_FUNC, pf_sys_random, 0, 0 } },
|
{ "random", { HAK_PFBASE_FUNC, pf_sys_random, 0, 0 } },
|
||||||
{ "read", { HAK_PFBASE_FUNC, pf_sys_read, 2, 4 } },
|
{ "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 } },
|
{ "srandom", { HAK_PFBASE_FUNC, pf_sys_srandom, 1, 1 } },
|
||||||
{ "stime", { HAK_PFBASE_FUNC, pf_sys_stime, 1, 1 } },
|
{ "stime", { HAK_PFBASE_FUNC, pf_sys_stime, 1, 1 } },
|
||||||
{ "time", { HAK_PFBASE_FUNC, pf_sys_time, 0, 0 } },
|
{ "time", { HAK_PFBASE_FUNC, pf_sys_time, 0, 0 } },
|
||||||
|
|||||||
@@ -42,6 +42,9 @@ class FixedSizedCollection: IndexedCollection {
|
|||||||
class[#varying] Array: FixedSizedCollection {
|
class[#varying] Array: FixedSizedCollection {
|
||||||
}
|
}
|
||||||
|
|
||||||
|
class[#byte #varying] ByteArray: FixedSizedCollection {
|
||||||
|
}
|
||||||
|
|
||||||
class[#char #varying] String: FixedSizedCollection {
|
class[#char #varying] String: FixedSizedCollection {
|
||||||
fun[#class] initValue() {
|
fun[#class] initValue() {
|
||||||
##return '\0'
|
##return '\0'
|
||||||
|
|||||||
@@ -0,0 +1,36 @@
|
|||||||
|
##$include-once "Semaphore.hak"
|
||||||
|
|
||||||
|
class[#uncopyable] Mutex: Object(
|
||||||
|
_sem
|
||||||
|
_owner
|
||||||
|
) {
|
||||||
|
fun[#ci] new() {
|
||||||
|
self._sem := (Semaphore:forMutex)
|
||||||
|
self._owner := nil
|
||||||
|
return self
|
||||||
|
}
|
||||||
|
|
||||||
|
## TODO: support relay of variable arguments to (fnc args...)
|
||||||
|
##fun critical(fnc args...) {
|
||||||
|
fun critical(fnc) {
|
||||||
|
| p ex r |
|
||||||
|
|
||||||
|
p := (core.active-process)
|
||||||
|
|
||||||
|
## already the owner: just run the body. the outermost critical
|
||||||
|
## is the one that releases, so nesting needs no bookkeeping.
|
||||||
|
if (eqv? p self._owner) { return (fnc) }
|
||||||
|
|
||||||
|
self._sem:wait
|
||||||
|
self._owner := p
|
||||||
|
|
||||||
|
## TODO: update code to use 'finally' if 'finally' is implemented...
|
||||||
|
try { r := (fnc) } catch (e) { ex := e }
|
||||||
|
|
||||||
|
self._owner := nil
|
||||||
|
self._sem:signal
|
||||||
|
|
||||||
|
if (nqv? ex nil) { throw ex }
|
||||||
|
return r
|
||||||
|
}
|
||||||
|
}
|
||||||
@@ -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 {
|
||||||
|
}
|
||||||
@@ -0,0 +1,31 @@
|
|||||||
|
##$include-once "Object.hak"
|
||||||
|
|
||||||
|
class[#uncopyable #final #limited #varying] Process: Object(
|
||||||
|
_initial_context
|
||||||
|
_current_context
|
||||||
|
_id
|
||||||
|
_state
|
||||||
|
_sp
|
||||||
|
_st
|
||||||
|
_exsp
|
||||||
|
_exst
|
||||||
|
_clsp
|
||||||
|
_clst
|
||||||
|
_fsp
|
||||||
|
_fst
|
||||||
|
_sched_prev
|
||||||
|
_sched_next
|
||||||
|
_sem_wawit_prev
|
||||||
|
_sem_wait_next
|
||||||
|
_sem
|
||||||
|
) {
|
||||||
|
|
||||||
|
## TODO: add many read-only methods
|
||||||
|
fun id() {
|
||||||
|
return self._id
|
||||||
|
}
|
||||||
|
|
||||||
|
fun state() {
|
||||||
|
return self._state
|
||||||
|
}
|
||||||
|
}
|
||||||
@@ -0,0 +1,74 @@
|
|||||||
|
##$include-once "Object.hak"
|
||||||
|
|
||||||
|
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)
|
||||||
|
}
|
||||||
|
}
|
||||||
+6
-79
@@ -1,84 +1,11 @@
|
|||||||
class Apex {
|
$include "Object.hak"
|
||||||
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 "Magnitude.hak"
|
$include "Magnitude.hak"
|
||||||
$include "Collection.hak"
|
$include "Collection.hak"
|
||||||
|
|
||||||
|
$include "Semaphore.hak"
|
||||||
|
$include "Mutex.hak"
|
||||||
|
|
||||||
|
$include "Process.hak"
|
||||||
##$include "System.hak"
|
##$include "System.hak"
|
||||||
|
|
||||||
## ---------------------------------------------------------------------------------
|
## ---------------------------------------------------------------------------------
|
||||||
|
|||||||
+19
-19
@@ -37,9 +37,9 @@ class ChildGroup(
|
|||||||
sigsem ## the shared semaphore; only in shared mode
|
sigsem ## the shared semaphore; only in shared mode
|
||||||
) {
|
) {
|
||||||
fun[#ci] new() {
|
fun[#ci] new() {
|
||||||
set sg (semgr-new)
|
set sg (core.semgr-new)
|
||||||
set tmo (sem-new)
|
set tmo (core.sem-new)
|
||||||
semgr-add sg tmo
|
core.semgr-add sg tmo
|
||||||
set capa 8
|
set capa 8
|
||||||
set kids (core.basicNew Array 8)
|
set kids (core.basicNew Array 8)
|
||||||
set nkids 0
|
set nkids 0
|
||||||
@@ -107,16 +107,16 @@ class ChildGroup(
|
|||||||
## semaphore on the signal descriptor for the whole group, once.
|
## semaphore on the signal descriptor for the whole group, once.
|
||||||
if (not self.shared) {
|
if (not self.shared) {
|
||||||
set shared true
|
set shared true
|
||||||
system-catch-sig sys.SIGCHLD
|
sys.sig-catch sys.SIGCHLD
|
||||||
set sigsem (sem-new)
|
set sigsem (core.sem-new)
|
||||||
semgr-add self.sg self.sigsem
|
core.semgr-add self.sg self.sigsem
|
||||||
sem-signal-on-input self.sigsem (system-get-sigfd)
|
core.sem-signal-on-input self.sigsem (sys.sig-getfd)
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
## A handle of its own, so a wakeup identifies this child directly.
|
## A handle of its own, so a wakeup identifies this child directly.
|
||||||
sem := (sem-new)
|
sem := (core.sem-new)
|
||||||
semgr-add self.sg sem
|
core.semgr-add self.sg sem
|
||||||
sem-signal-on-input sem xh
|
core.sem-signal-on-input sem xh
|
||||||
}
|
}
|
||||||
|
|
||||||
kid := (core.basicNew Array 6)
|
kid := (core.basicNew Array 6)
|
||||||
@@ -171,16 +171,16 @@ class ChildGroup(
|
|||||||
if (not (nil? kid)) { return kid }
|
if (not (nil? kid)) { return kid }
|
||||||
|
|
||||||
while true {
|
while true {
|
||||||
sem-signal self.tmo secs 0
|
core.sem-signal self.tmo secs 0
|
||||||
w := (semgr-wait self.sg)
|
w := (core.semgr-wait self.sg)
|
||||||
sem-unsignal self.tmo
|
core.sem-unsignal self.tmo
|
||||||
|
|
||||||
if (eqv? w self.tmo) { return nil }
|
if (eqv? w self.tmo) { return nil }
|
||||||
|
|
||||||
if self.shared {
|
if self.shared {
|
||||||
## the signal descriptor spoke: take the byte, then look at
|
## the signal descriptor spoke: take the byte, then look at
|
||||||
## everyone, since one SIGCHLD may stand for several exits
|
## everyone, since one SIGCHLD may stand for several exits
|
||||||
system-get-sig
|
sys.sig-get
|
||||||
kid := (self:finished)
|
kid := (self:finished)
|
||||||
if (not (nil? kid)) { return kid }
|
if (not (nil? kid)) { return kid }
|
||||||
## otherwise it was a SIGCHLD for a child of the host
|
## otherwise it was a SIGCHLD for a child of the host
|
||||||
@@ -188,7 +188,7 @@ class ChildGroup(
|
|||||||
} else {
|
} else {
|
||||||
kid := (self:kid-of-sem w)
|
kid := (self:kid-of-sem w)
|
||||||
if (not (nil? kid)) {
|
if (not (nil? kid)) {
|
||||||
sem-unsignal w
|
core.sem-unsignal w
|
||||||
return kid
|
return kid
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -210,8 +210,8 @@ class ChildGroup(
|
|||||||
| sem |
|
| sem |
|
||||||
sem := (core.basicAt kid 5)
|
sem := (core.basicAt kid 5)
|
||||||
if (not (nil? sem)) {
|
if (not (nil? sem)) {
|
||||||
sem-unsignal sem
|
core.sem-unsignal sem
|
||||||
semgr-remove self.sg sem
|
core.semgr-remove self.sg sem
|
||||||
}
|
}
|
||||||
self:forget kid
|
self:forget kid
|
||||||
sys.pclose (core.basicAt kid 0)
|
sys.pclose (core.basicAt kid 0)
|
||||||
@@ -227,8 +227,8 @@ class ChildGroup(
|
|||||||
i := (+ i 1)
|
i := (+ i 1)
|
||||||
}
|
}
|
||||||
if self.shared {
|
if self.shared {
|
||||||
sem-unsignal self.sigsem
|
core.sem-unsignal self.sigsem
|
||||||
system-uncatch-sig sys.SIGCHLD
|
sys.sig-uncatch sys.SIGCHLD
|
||||||
set shared false
|
set shared false
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|||||||
+11
-2
@@ -5,7 +5,8 @@ AM_CPPFLAGS = \
|
|||||||
-I$(abs_builddir)/../lib \
|
-I$(abs_builddir)/../lib \
|
||||||
-I$(abs_srcdir) \
|
-I$(abs_srcdir) \
|
||||||
-I$(abs_srcdir)/../lib \
|
-I$(abs_srcdir)/../lib \
|
||||||
-I$(includedir)
|
-I$(includedir) \
|
||||||
|
-DHAK_TEST_MODLIBDIRS='"@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs"'
|
||||||
LDADD = ../lib/libhak.la
|
LDADD = ../lib/libhak.la
|
||||||
|
|
||||||
check_SCRIPTS = \
|
check_SCRIPTS = \
|
||||||
@@ -13,14 +14,19 @@ check_SCRIPTS = \
|
|||||||
cons-01.hak \
|
cons-01.hak \
|
||||||
dic-01.hak \
|
dic-01.hak \
|
||||||
feed-01.hak \
|
feed-01.hak \
|
||||||
|
fork-01.hak \
|
||||||
|
fork-02.hak \
|
||||||
fun-01.hak \
|
fun-01.hak \
|
||||||
hnd-01.hak \
|
hnd-01.hak \
|
||||||
hnd-02.hak \
|
hnd-02.hak \
|
||||||
hnd-03.hak \
|
hnd-03.hak \
|
||||||
insta-01.hak \
|
insta-01.hak \
|
||||||
insta-02.hak \
|
insta-02.hak \
|
||||||
|
mutex-01.hak \
|
||||||
|
mutex-02.hak \
|
||||||
mux-01.hak \
|
mux-01.hak \
|
||||||
mux-02.hak \
|
mux-02.hak \
|
||||||
|
mux-03.hak \
|
||||||
prim-01.hak \
|
prim-01.hak \
|
||||||
proc-01.hak \
|
proc-01.hak \
|
||||||
proclib-01.hak \
|
proclib-01.hak \
|
||||||
@@ -31,6 +37,7 @@ check_SCRIPTS = \
|
|||||||
sysproc-01.hak \
|
sysproc-01.hak \
|
||||||
sysproc-02.hak \
|
sysproc-02.hak \
|
||||||
tick-01.hak \
|
tick-01.hak \
|
||||||
|
try-01.hak \
|
||||||
va-01.hak \
|
va-01.hak \
|
||||||
var-01.hak \
|
var-01.hak \
|
||||||
var-02.hak \
|
var-02.hak \
|
||||||
@@ -50,11 +57,13 @@ check_ERRORS = \
|
|||||||
check_PROGRAMS = \
|
check_PROGRAMS = \
|
||||||
t-001 \
|
t-001 \
|
||||||
t-002 \
|
t-002 \
|
||||||
t-003
|
t-003 \
|
||||||
|
t-004
|
||||||
|
|
||||||
t_001_SOURCES = t-001.c tap.h
|
t_001_SOURCES = t-001.c tap.h
|
||||||
t_002_SOURCES = t-002.c tap.h
|
t_002_SOURCES = t-002.c tap.h
|
||||||
t_003_SOURCES = t-003.c tap.h
|
t_003_SOURCES = t-003.c tap.h
|
||||||
|
t_004_SOURCES = t-004.c tap.h
|
||||||
|
|
||||||
##noinst_SCRIPTS = $(check_SCRIPTS)
|
##noinst_SCRIPTS = $(check_SCRIPTS)
|
||||||
EXTRA_DIST = $(check_SCRIPTS) $(check_ERRORS)
|
EXTRA_DIST = $(check_SCRIPTS) $(check_ERRORS)
|
||||||
|
|||||||
+34
-5
@@ -89,7 +89,8 @@ PRE_UNINSTALL = :
|
|||||||
POST_UNINSTALL = :
|
POST_UNINSTALL = :
|
||||||
build_triplet = @build@
|
build_triplet = @build@
|
||||||
host_triplet = @host@
|
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
|
subdir = t
|
||||||
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
|
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
|
||||||
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_check_sign.m4 \
|
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_check_sign.m4 \
|
||||||
@@ -120,6 +121,10 @@ am_t_003_OBJECTS = t-003.$(OBJEXT)
|
|||||||
t_003_OBJECTS = $(am_t_003_OBJECTS)
|
t_003_OBJECTS = $(am_t_003_OBJECTS)
|
||||||
t_003_LDADD = $(LDADD)
|
t_003_LDADD = $(LDADD)
|
||||||
t_003_DEPENDENCIES = ../lib/libhak.la
|
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_V@)
|
||||||
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
|
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
|
||||||
am__v_P_0 = false
|
am__v_P_0 = false
|
||||||
@@ -136,7 +141,7 @@ DEFAULT_INCLUDES =
|
|||||||
depcomp = $(SHELL) $(top_srcdir)/ac/depcomp
|
depcomp = $(SHELL) $(top_srcdir)/ac/depcomp
|
||||||
am__maybe_remake_depfiles = depfiles
|
am__maybe_remake_depfiles = depfiles
|
||||||
am__depfiles_remade = ./$(DEPDIR)/t-001.Po ./$(DEPDIR)/t-002.Po \
|
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
|
am__mv = mv -f
|
||||||
COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
|
COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
|
||||||
$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
|
$(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_ = $(am__v_CCLD_@AM_DEFAULT_V@)
|
||||||
am__v_CCLD_0 = @echo " CCLD " $@;
|
am__v_CCLD_0 = @echo " CCLD " $@;
|
||||||
am__v_CCLD_1 =
|
am__v_CCLD_1 =
|
||||||
SOURCES = $(t_001_SOURCES) $(t_002_SOURCES) $(t_003_SOURCES)
|
SOURCES = $(t_001_SOURCES) $(t_002_SOURCES) $(t_003_SOURCES) \
|
||||||
DIST_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 = \
|
am__can_run_installinfo = \
|
||||||
case $$AM_UPDATE_INFO_DIR in \
|
case $$AM_UPDATE_INFO_DIR in \
|
||||||
n|no|NO) false;; \
|
n|no|NO) false;; \
|
||||||
@@ -543,7 +550,8 @@ AM_CPPFLAGS = \
|
|||||||
-I$(abs_builddir)/../lib \
|
-I$(abs_builddir)/../lib \
|
||||||
-I$(abs_srcdir) \
|
-I$(abs_srcdir) \
|
||||||
-I$(abs_srcdir)/../lib \
|
-I$(abs_srcdir)/../lib \
|
||||||
-I$(includedir)
|
-I$(includedir) \
|
||||||
|
-DHAK_TEST_MODLIBDIRS='"@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs"'
|
||||||
|
|
||||||
LDADD = ../lib/libhak.la
|
LDADD = ../lib/libhak.la
|
||||||
check_SCRIPTS = \
|
check_SCRIPTS = \
|
||||||
@@ -551,14 +559,19 @@ check_SCRIPTS = \
|
|||||||
cons-01.hak \
|
cons-01.hak \
|
||||||
dic-01.hak \
|
dic-01.hak \
|
||||||
feed-01.hak \
|
feed-01.hak \
|
||||||
|
fork-01.hak \
|
||||||
|
fork-02.hak \
|
||||||
fun-01.hak \
|
fun-01.hak \
|
||||||
hnd-01.hak \
|
hnd-01.hak \
|
||||||
hnd-02.hak \
|
hnd-02.hak \
|
||||||
hnd-03.hak \
|
hnd-03.hak \
|
||||||
insta-01.hak \
|
insta-01.hak \
|
||||||
insta-02.hak \
|
insta-02.hak \
|
||||||
|
mutex-01.hak \
|
||||||
|
mutex-02.hak \
|
||||||
mux-01.hak \
|
mux-01.hak \
|
||||||
mux-02.hak \
|
mux-02.hak \
|
||||||
|
mux-03.hak \
|
||||||
prim-01.hak \
|
prim-01.hak \
|
||||||
proc-01.hak \
|
proc-01.hak \
|
||||||
proclib-01.hak \
|
proclib-01.hak \
|
||||||
@@ -569,6 +582,7 @@ check_SCRIPTS = \
|
|||||||
sysproc-01.hak \
|
sysproc-01.hak \
|
||||||
sysproc-02.hak \
|
sysproc-02.hak \
|
||||||
tick-01.hak \
|
tick-01.hak \
|
||||||
|
try-01.hak \
|
||||||
va-01.hak \
|
va-01.hak \
|
||||||
var-01.hak \
|
var-01.hak \
|
||||||
var-02.hak \
|
var-02.hak \
|
||||||
@@ -588,6 +602,7 @@ check_ERRORS = \
|
|||||||
t_001_SOURCES = t-001.c tap.h
|
t_001_SOURCES = t-001.c tap.h
|
||||||
t_002_SOURCES = t-002.c tap.h
|
t_002_SOURCES = t-002.c tap.h
|
||||||
t_003_SOURCES = t-003.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)
|
EXTRA_DIST = $(check_SCRIPTS) $(check_ERRORS)
|
||||||
TESTS = $(check_PROGRAMS) $(check_SCRIPTS) $(check_ERRORS)
|
TESTS = $(check_PROGRAMS) $(check_SCRIPTS) $(check_ERRORS)
|
||||||
TEST_EXTENSIONS = .hak .err
|
TEST_EXTENSIONS = .hak .err
|
||||||
@@ -646,6 +661,10 @@ t-003$(EXEEXT): $(t_003_OBJECTS) $(t_003_DEPENDENCIES) $(EXTRA_t_003_DEPENDENCIE
|
|||||||
@rm -f t-003$(EXEEXT)
|
@rm -f t-003$(EXEEXT)
|
||||||
$(AM_V_CCLD)$(LINK) $(t_003_OBJECTS) $(t_003_LDADD) $(LIBS)
|
$(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:
|
mostlyclean-compile:
|
||||||
-rm -f *.$(OBJEXT)
|
-rm -f *.$(OBJEXT)
|
||||||
|
|
||||||
@@ -655,6 +674,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-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-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-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):
|
$(am__depfiles_remade):
|
||||||
@$(MKDIR_P) $(@D)
|
@$(MKDIR_P) $(@D)
|
||||||
@@ -931,6 +951,13 @@ t-003.log: t-003$(EXEEXT)
|
|||||||
--log-file $$b.log --trs-file $$b.trs \
|
--log-file $$b.log --trs-file $$b.trs \
|
||||||
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
|
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
|
||||||
"$$tst" $(AM_TESTS_FD_REDIRECT)
|
"$$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:
|
.hak.log:
|
||||||
@p='$<'; \
|
@p='$<'; \
|
||||||
$(am__set_b); \
|
$(am__set_b); \
|
||||||
@@ -1041,6 +1068,7 @@ distclean: distclean-am
|
|||||||
-rm -f ./$(DEPDIR)/t-001.Po
|
-rm -f ./$(DEPDIR)/t-001.Po
|
||||||
-rm -f ./$(DEPDIR)/t-002.Po
|
-rm -f ./$(DEPDIR)/t-002.Po
|
||||||
-rm -f ./$(DEPDIR)/t-003.Po
|
-rm -f ./$(DEPDIR)/t-003.Po
|
||||||
|
-rm -f ./$(DEPDIR)/t-004.Po
|
||||||
-rm -f Makefile
|
-rm -f Makefile
|
||||||
distclean-am: clean-am distclean-compile distclean-generic \
|
distclean-am: clean-am distclean-compile distclean-generic \
|
||||||
distclean-tags
|
distclean-tags
|
||||||
@@ -1089,6 +1117,7 @@ maintainer-clean: maintainer-clean-am
|
|||||||
-rm -f ./$(DEPDIR)/t-001.Po
|
-rm -f ./$(DEPDIR)/t-001.Po
|
||||||
-rm -f ./$(DEPDIR)/t-002.Po
|
-rm -f ./$(DEPDIR)/t-002.Po
|
||||||
-rm -f ./$(DEPDIR)/t-003.Po
|
-rm -f ./$(DEPDIR)/t-003.Po
|
||||||
|
-rm -f ./$(DEPDIR)/t-004.Po
|
||||||
-rm -f Makefile
|
-rm -f Makefile
|
||||||
maintainer-clean-am: distclean-am maintainer-clean-generic
|
maintainer-clean-am: distclean-am maintainer-clean-generic
|
||||||
|
|
||||||
|
|||||||
@@ -0,0 +1,73 @@
|
|||||||
|
## fork must build the new process's initial context in the NEW process.
|
||||||
|
##
|
||||||
|
## A context normally lives on the frame stack of the process that owns it.
|
||||||
|
## fork has to create one before the new process runs, and it used to carve it
|
||||||
|
## out of the CALLER's frame stack instead of the callee's. Nothing goes wrong
|
||||||
|
## while the caller is alive, so this is only observable once the caller has
|
||||||
|
## terminated and its process object has been collected: the child is then left
|
||||||
|
## with initial_context/current_context pointing into freed memory.
|
||||||
|
##
|
||||||
|
## Two things below are what make that observable, and neither is incidental:
|
||||||
|
##
|
||||||
|
## - the main process forks and then simply ENDS. It does not wait for the
|
||||||
|
## workers. HAK_TRAIT_AWAIT_PROCS keeps the vm running the children after
|
||||||
|
## the main process is gone, so the creator really is dead and collected
|
||||||
|
## while its children are still running.
|
||||||
|
##
|
||||||
|
## - each worker builds a block literal INSIDE itself and runs it. MAKE_BLOCK
|
||||||
|
## reifies the home context, which is the dereference that reads the freed
|
||||||
|
## stack context. Without a block literal the dangling pointer is merely
|
||||||
|
## held, not followed.
|
||||||
|
##
|
||||||
|
## So the test is the run itself: reaching the OK lines means the children
|
||||||
|
## outlived their creator and still found their own contexts. Against the old
|
||||||
|
## behaviour this segfaults instead, and run.sh reports the non-zero exit.
|
||||||
|
##
|
||||||
|
## [NOTE] keep this file free of anything that is not part of the above. Extra
|
||||||
|
## phases beforehand change the heap enough that the freed memory is no longer
|
||||||
|
## recycled under the child, and the crash stops reproducing - which is exactly
|
||||||
|
## why this does not live at the end of t/mutex-02.hak. When HAK_ENABLE_STACK_
|
||||||
|
## CONTEXT is undefined there are no stack contexts and no bug to trip over;
|
||||||
|
## the file still runs clean, it just is not testing anything.
|
||||||
|
|
||||||
|
$include "../src/kernel.hak"
|
||||||
|
|
||||||
|
fun chk(ok msg) {
|
||||||
|
if ok { printf "OK: %s\n" msg } \
|
||||||
|
else { printf "ERROR: %s\n" msg }
|
||||||
|
}
|
||||||
|
|
||||||
|
WORKERS := 5
|
||||||
|
SPINS := 100
|
||||||
|
|
||||||
|
mux := (Mutex:new)
|
||||||
|
|
||||||
|
fun orphan() {
|
||||||
|
| body |
|
||||||
|
|
||||||
|
## built here, in the forked process, so MAKE_BLOCK runs against the
|
||||||
|
## context fork created for this process
|
||||||
|
body := (fun() {
|
||||||
|
| i |
|
||||||
|
i := 0
|
||||||
|
while (< i SPINS) {
|
||||||
|
i := (+ i 1)
|
||||||
|
core.yield ## give the other workers a turn while holding it
|
||||||
|
}
|
||||||
|
})
|
||||||
|
|
||||||
|
mux:critical body
|
||||||
|
chk true "a forked process still runs after its creator is gone"
|
||||||
|
}
|
||||||
|
|
||||||
|
fun spawn() {
|
||||||
|
| i |
|
||||||
|
i := 0
|
||||||
|
while (< i WORKERS) {
|
||||||
|
core.fork orphan
|
||||||
|
i := (+ i 1)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
## no wait, on purpose - see the header
|
||||||
|
spawn
|
||||||
@@ -0,0 +1,74 @@
|
|||||||
|
## fork must not leak a frame in the CALLER's frame stack.
|
||||||
|
##
|
||||||
|
## A stack context is carved out of a process's frame stack by alloc_frame_slots
|
||||||
|
## bumping that process's fsp, and it is popped again by release_stack_context
|
||||||
|
## when the owning process returns through it. fork has to build a context for
|
||||||
|
## the process it is creating, and it used to allocate that context out of the
|
||||||
|
## CALLER's frame stack. The caller never returns through it, so nothing ever
|
||||||
|
## popped it: every fork permanently consumed a frame of the forking process.
|
||||||
|
##
|
||||||
|
## That is the same one-line defect t/fork-01.hak covers, but it shows up as a
|
||||||
|
## completely different symptom, so it is worth pinning separately. fork-01
|
||||||
|
## catches the dangling context (a segfault once the parent is collected); this
|
||||||
|
## one catches the slow exhaustion, which is what a long-lived process that
|
||||||
|
## forks in a loop - a server accepting connections, say - would actually hit.
|
||||||
|
## Neither symptom implies the other on inspection.
|
||||||
|
##
|
||||||
|
## Sizing: one leaked context is HAK_STACK_CONTEXT_NAMED_SLOTS (15) slots plus
|
||||||
|
## the block's temporaries, and the frame stack is HAK_DFL_PROCSTK_SIZE slots
|
||||||
|
## (8192 by default, or the HAK_MIN_FSTK_SIZE floor of 1024 under HAK_SMALL_
|
||||||
|
## MEMORY_FOOTPRINT). So the old behaviour ran out after roughly 546 forks on a
|
||||||
|
## default build and far sooner on a small one. 600 clears both. The count only
|
||||||
|
## has to sit above the threshold and never needs retuning, because a correct
|
||||||
|
## fork does not grow the caller's frame stack at all - measured flat at 5000.
|
||||||
|
##
|
||||||
|
## [NOTE] the loop is inside a function on purpose. The leak is charged to the
|
||||||
|
## process running it, so that process has to stay alive across all 600 forks
|
||||||
|
## for the frames to pile up.
|
||||||
|
|
||||||
|
$include "../src/kernel.hak"
|
||||||
|
|
||||||
|
fun chk(ok msg) {
|
||||||
|
if ok { printf "OK: %s\n" msg } \
|
||||||
|
else { printf "ERROR: %s\n" msg }
|
||||||
|
}
|
||||||
|
|
||||||
|
FORKS := 600
|
||||||
|
|
||||||
|
forked := 0
|
||||||
|
failed := 0
|
||||||
|
ran := 0
|
||||||
|
done := (Semaphore:new)
|
||||||
|
|
||||||
|
fun noop() {
|
||||||
|
ran := (+ ran 1)
|
||||||
|
done:signal
|
||||||
|
}
|
||||||
|
|
||||||
|
## catch rather than let the overflow abort the script, so a regression is
|
||||||
|
## reported as a failed assertion instead of an unhandled exception
|
||||||
|
fun spawner() {
|
||||||
|
| i |
|
||||||
|
i := 0
|
||||||
|
while (< i FORKS) {
|
||||||
|
try { core.fork noop ; forked := (+ forked 1) } catch (e) { failed := (+ failed 1) }
|
||||||
|
i := (+ i 1)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
fun waitall(n) {
|
||||||
|
| i |
|
||||||
|
i := 0
|
||||||
|
while (< i n) {
|
||||||
|
done:wait
|
||||||
|
i := (+ i 1)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
spawner
|
||||||
|
|
||||||
|
chk (= failed 0) "600 forks from one function all succeed"
|
||||||
|
chk (= forked FORKS) "every fork answered a process"
|
||||||
|
|
||||||
|
waitall forked
|
||||||
|
chk (= ran FORKS) "all 600 forked processes actually ran"
|
||||||
+17
-17
@@ -7,21 +7,21 @@ fun chk(ok msg) {
|
|||||||
else { printf "ERROR: %s\n" msg }
|
else { printf "ERROR: %s\n" msg }
|
||||||
}
|
}
|
||||||
|
|
||||||
iosem := (sem-new)
|
iosem := (core.sem-new)
|
||||||
tmo := (sem-new)
|
tmo := (core.sem-new)
|
||||||
sg := (semgr-new)
|
sg := (core.semgr-new)
|
||||||
semgr-add sg iosem
|
core.semgr-add sg iosem
|
||||||
semgr-add sg tmo
|
core.semgr-add sg tmo
|
||||||
fin := (sem-new)
|
fin := (core.sem-new)
|
||||||
|
|
||||||
## returns 1 when the handle became readable, 0 when the timeout won
|
## returns 1 when the handle became readable, 0 when the timeout won
|
||||||
fun waitin(h secs) {
|
fun waitin(h secs) {
|
||||||
| s |
|
| s |
|
||||||
sem-signal tmo secs 0
|
core.sem-signal tmo secs 0
|
||||||
sem-signal-on-input iosem h
|
core.sem-signal-on-input iosem h
|
||||||
s := (semgr-wait sg)
|
s := (core.semgr-wait sg)
|
||||||
sem-unsignal iosem
|
core.sem-unsignal iosem
|
||||||
sem-unsignal tmo
|
core.sem-unsignal tmo
|
||||||
if (eqv? s tmo) { return 0 } \
|
if (eqv? s tmo) { return 0 } \
|
||||||
else { return 1 }
|
else { return 1 }
|
||||||
}
|
}
|
||||||
@@ -46,12 +46,12 @@ fun reader() {
|
|||||||
n := (sys.read r buf)
|
n := (sys.read r buf)
|
||||||
if (>= n 0) {
|
if (>= n 0) {
|
||||||
got := n
|
got := n
|
||||||
sem-signal fin
|
core.sem-signal fin
|
||||||
return 0
|
return 0
|
||||||
}
|
}
|
||||||
if (= (waitin r 5) 0) {
|
if (= (waitin r 5) 0) {
|
||||||
got := -1
|
got := -1
|
||||||
sem-signal fin
|
core.sem-signal fin
|
||||||
return 0
|
return 0
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -63,7 +63,7 @@ fun writer() {
|
|||||||
## so these ticks only happen if the VM is still scheduling
|
## so these ticks only happen if the VM is still scheduling
|
||||||
while (< ticks 4) {
|
while (< ticks 4) {
|
||||||
ticks := (+ ticks 1)
|
ticks := (+ ticks 1)
|
||||||
yield
|
core.yield
|
||||||
}
|
}
|
||||||
wb := (core.basicNew ByteArray 2)
|
wb := (core.basicNew ByteArray 2)
|
||||||
core.basicAtPut wb 0 120
|
core.basicAtPut wb 0 120
|
||||||
@@ -71,9 +71,9 @@ fun writer() {
|
|||||||
sys.write w wb
|
sys.write w wb
|
||||||
}
|
}
|
||||||
|
|
||||||
fork reader
|
core.fork reader
|
||||||
fork writer
|
core.fork writer
|
||||||
sem-wait fin
|
core.sem-wait fin
|
||||||
|
|
||||||
chk (= ticks 4) "other coprocesses ran while the reader was blocked"
|
chk (= ticks 4) "other coprocesses ran while the reader was blocked"
|
||||||
chk (= got 2) "the reader woke and read the data"
|
chk (= got 2) "the reader woke and read the data"
|
||||||
|
|||||||
+6
-6
@@ -2,13 +2,13 @@
|
|||||||
## stops hak code naming a descriptor it never opened - including hak's own
|
## stops hak code naming a descriptor it never opened - including hak's own
|
||||||
## multiplexer, signal and io-thread descriptors, and anything the host
|
## multiplexer, signal and io-thread descriptors, and anything the host
|
||||||
## application that embeds hak holds open.
|
## application that embeds hak holds open.
|
||||||
s := (sem-new)
|
s := (core.sem-new)
|
||||||
sem-signal-on-input s 0 ##ERROR: system handle 0
|
core.sem-signal-on-input s 0 ##ERROR: system handle 0
|
||||||
|
|
||||||
---
|
---
|
||||||
|
|
||||||
s := (sem-new)
|
s := (core.sem-new)
|
||||||
sem-signal-on-input s 4 ##ERROR: system handle 4
|
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
|
## a regular file is never accepted by the multiplexer: epoll refuses one
|
||||||
## outright, and poll() would report it permanently ready
|
## outright, and poll() would report it permanently ready
|
||||||
f := (sys.open "/etc/passwd" "r")
|
f := (sys.open "/etc/passwd" "r")
|
||||||
s := (sem-new)
|
s := (core.sem-new)
|
||||||
sem-signal-on-input s f ##ERROR: not of an acceptable kind
|
core.sem-signal-on-input s f ##ERROR: not of an acceptable kind
|
||||||
|
|
||||||
---
|
---
|
||||||
|
|
||||||
|
|||||||
+1
-1
@@ -56,7 +56,7 @@ a := (b:get-a)
|
|||||||
if (a != 4) {printf "ERROR: a must be 4\n" } \
|
if (a != 4) {printf "ERROR: a must be 4\n" } \
|
||||||
else { printf "OK %d\n" a }
|
else { printf "OK %d\n" a }
|
||||||
|
|
||||||
c := (object-new A)
|
c := (core.object-new A)
|
||||||
a := (c:get-a)
|
a := (c:get-a)
|
||||||
if (a != nil) {printf "ERROR: a must be nil\n" } \
|
if (a != nil) {printf "ERROR: a must be nil\n" } \
|
||||||
else { printf "OK %O\n" a }
|
else { printf "OK %O\n" a }
|
||||||
|
|||||||
@@ -0,0 +1,95 @@
|
|||||||
|
## a semaphore used as a mutex must give mutual exclusion across coprocesses.
|
||||||
|
##
|
||||||
|
## Semaphore:forMutex is (core.sem-new 1) - a counting semaphore that starts at
|
||||||
|
## one, so the first waiter takes it and every other one blocks until the
|
||||||
|
## holder signals. What makes this worth a test is that the holder gives up the
|
||||||
|
## CPU inside the critical section: core.yield lets the other processes run
|
||||||
|
## while the lock is held, which is exactly the window a broken mutex would
|
||||||
|
## leak through.
|
||||||
|
##
|
||||||
|
## Both phases run the same worker. The only difference is the semaphore's
|
||||||
|
## initial count, so a failure cannot be blamed on the two paths differing:
|
||||||
|
##
|
||||||
|
## count 4 -> four processes may hold it at once, so the overlap counter
|
||||||
|
## must actually see them overlapping. this is the control: if it
|
||||||
|
## reported 1, the workers would not be interleaving at all and
|
||||||
|
## the mutex phase below would pass for the wrong reason.
|
||||||
|
## count 1 -> a mutex. the overlap counter must never exceed one.
|
||||||
|
##
|
||||||
|
## [NOTE] the spin counts are deliberately small - enough interleaving to
|
||||||
|
## expose an overlap, without making the test slow. What matters is that the
|
||||||
|
## holder yields at all, not how often.
|
||||||
|
|
||||||
|
$include "../src/kernel.hak"
|
||||||
|
|
||||||
|
fun chk(ok msg) {
|
||||||
|
if ok { printf "OK: %s\n" msg } \
|
||||||
|
else { printf "ERROR: %s\n" msg }
|
||||||
|
}
|
||||||
|
|
||||||
|
WORKERS := 4
|
||||||
|
SPINS := 20
|
||||||
|
|
||||||
|
inside := 0 ## processes inside the critical section right now
|
||||||
|
maxin := 0 ## high-water mark of the above
|
||||||
|
rounds := 0 ## completed critical sections
|
||||||
|
done := (Semaphore:new)
|
||||||
|
|
||||||
|
fun worker(lock n) {
|
||||||
|
| i |
|
||||||
|
lock:wait ## lock
|
||||||
|
|
||||||
|
inside := (+ inside 1)
|
||||||
|
if (> inside maxin) { maxin := inside }
|
||||||
|
|
||||||
|
## hold the lock while yielding, so any other process that can enter will
|
||||||
|
i := 0
|
||||||
|
while (< i n) {
|
||||||
|
i := (+ i 1)
|
||||||
|
core.yield
|
||||||
|
}
|
||||||
|
|
||||||
|
inside := (- inside 1)
|
||||||
|
rounds := (+ rounds 1)
|
||||||
|
lock:signal ## unlock
|
||||||
|
done:signal
|
||||||
|
}
|
||||||
|
|
||||||
|
fun waitall(n) {
|
||||||
|
| i |
|
||||||
|
i := 0
|
||||||
|
while (< i n) {
|
||||||
|
done:wait
|
||||||
|
i := (+ i 1)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
fun spawn(lock) {
|
||||||
|
| i |
|
||||||
|
i := 0
|
||||||
|
while (< i WORKERS) {
|
||||||
|
core.fork worker lock SPINS
|
||||||
|
i := (+ i 1)
|
||||||
|
}
|
||||||
|
waitall WORKERS
|
||||||
|
}
|
||||||
|
|
||||||
|
## --- control: a count of WORKERS lets everyone in at once ---
|
||||||
|
inside := 0
|
||||||
|
maxin := 0
|
||||||
|
rounds := 0
|
||||||
|
spawn (core.sem-new WORKERS)
|
||||||
|
|
||||||
|
chk (= rounds WORKERS) "every process finishes when the semaphore admits them all"
|
||||||
|
chk (= inside 0) "the occupancy counter is balanced afterwards"
|
||||||
|
chk (> maxin 1) "the processes really do interleave, so an overlap is detectable"
|
||||||
|
|
||||||
|
## --- the mutex proper ---
|
||||||
|
inside := 0
|
||||||
|
maxin := 0
|
||||||
|
rounds := 0
|
||||||
|
spawn (Semaphore:forMutex)
|
||||||
|
|
||||||
|
chk (= rounds WORKERS) "every process finishes through the mutex too"
|
||||||
|
chk (= inside 0) "the occupancy counter is balanced afterwards"
|
||||||
|
chk (= maxin 1) "only one process is ever inside the critical section"
|
||||||
+124
@@ -0,0 +1,124 @@
|
|||||||
|
## the Mutex class.
|
||||||
|
##
|
||||||
|
## t/mutex-01.hak covers mutual exclusion over a raw counting semaphore, with
|
||||||
|
## the lock taken and released by hand. This one goes through Mutex:critical,
|
||||||
|
## which adds:
|
||||||
|
##
|
||||||
|
## - the critical section is a block literal built INSIDE a forked process,
|
||||||
|
## so each worker runs MAKE_BLOCK against its own context rather than
|
||||||
|
## sharing one made by the parent.
|
||||||
|
##
|
||||||
|
## - a throw out of the critical section must still release the lock, since
|
||||||
|
## Mutex:critical catches, unlocks, and rethrows.
|
||||||
|
##
|
||||||
|
## Every phase here waits for its workers, so the parent outlives them all.
|
||||||
|
## That deliberately keeps this file away from the fork stack-context lifetime
|
||||||
|
## question, which needs the parent to die first and is tested on its own in
|
||||||
|
## t/fork-01.hak.
|
||||||
|
##
|
||||||
|
## [NOTE] reentrancy (the same process calling critical again while holding it)
|
||||||
|
## is deliberately not exercised here - see the comment at the bottom.
|
||||||
|
|
||||||
|
$include "../src/kernel.hak"
|
||||||
|
|
||||||
|
fun chk(ok msg) {
|
||||||
|
if ok { printf "OK: %s\n" msg } \
|
||||||
|
else { printf "ERROR: %s\n" msg }
|
||||||
|
}
|
||||||
|
|
||||||
|
WORKERS := 5
|
||||||
|
SPINS := 20
|
||||||
|
|
||||||
|
inside := 0 ## processes inside the critical section right now
|
||||||
|
maxin := 0 ## high-water mark of the above
|
||||||
|
rounds := 0 ## completed critical sections
|
||||||
|
done := (Semaphore:new)
|
||||||
|
|
||||||
|
## the body is built inside the forked process, so every worker runs MAKE_BLOCK
|
||||||
|
## against its own context - the path that used to reference the parent's.
|
||||||
|
fun worker(m locked) {
|
||||||
|
| body |
|
||||||
|
|
||||||
|
body := (fun() {
|
||||||
|
| i |
|
||||||
|
inside := (+ inside 1)
|
||||||
|
if (> inside maxin) { maxin := inside }
|
||||||
|
i := 0
|
||||||
|
while (< i SPINS) {
|
||||||
|
i := (+ i 1)
|
||||||
|
core.yield
|
||||||
|
}
|
||||||
|
inside := (- inside 1)
|
||||||
|
rounds := (+ rounds 1)
|
||||||
|
})
|
||||||
|
|
||||||
|
if locked { m:critical body } else { body }
|
||||||
|
done:signal
|
||||||
|
}
|
||||||
|
|
||||||
|
fun waitall(n) {
|
||||||
|
| i |
|
||||||
|
i := 0
|
||||||
|
while (< i n) {
|
||||||
|
done:wait
|
||||||
|
i := (+ i 1)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
fun spawn(m locked) {
|
||||||
|
| i |
|
||||||
|
i := 0
|
||||||
|
while (< i WORKERS) {
|
||||||
|
core.fork worker m locked
|
||||||
|
i := (+ i 1)
|
||||||
|
}
|
||||||
|
waitall WORKERS
|
||||||
|
}
|
||||||
|
|
||||||
|
mux := (Mutex:new)
|
||||||
|
|
||||||
|
## --- control: same workers, same block, no locking ---
|
||||||
|
inside := 0
|
||||||
|
maxin := 0
|
||||||
|
rounds := 0
|
||||||
|
spawn mux false
|
||||||
|
|
||||||
|
chk (= rounds WORKERS) "every unlocked process finishes"
|
||||||
|
chk (= inside 0) "the occupancy counter is balanced afterwards"
|
||||||
|
chk (> maxin 1) "the processes really do interleave, so an overlap is detectable"
|
||||||
|
|
||||||
|
## --- the same thing through Mutex:critical ---
|
||||||
|
inside := 0
|
||||||
|
maxin := 0
|
||||||
|
rounds := 0
|
||||||
|
spawn mux true
|
||||||
|
|
||||||
|
chk (= rounds WORKERS) "every process finishes through Mutex:critical too"
|
||||||
|
chk (= inside 0) "the occupancy counter is balanced afterwards"
|
||||||
|
chk (= maxin 1) "only one process is ever inside the critical section"
|
||||||
|
|
||||||
|
## --- a throw out of the critical section unlocks and propagates ---
|
||||||
|
caught := 0
|
||||||
|
try { mux:critical (fun() { throw 5 }) } catch (e) { caught := e }
|
||||||
|
chk (= caught 5) "an exception raised inside a critical section propagates"
|
||||||
|
|
||||||
|
reused := 0
|
||||||
|
mux:critical (fun() { reused := 1 })
|
||||||
|
chk (= reused 1) "the mutex is still usable after an exception unwound it"
|
||||||
|
|
||||||
|
## --- each process has its own identity ---
|
||||||
|
main_id := ((core.active-process):id)
|
||||||
|
other_id := 0
|
||||||
|
fun idjob() { other_id := ((core.active-process):id) ; done:signal }
|
||||||
|
core.fork idjob
|
||||||
|
waitall 1
|
||||||
|
chk (>= main_id 0) "the main process has an id"
|
||||||
|
chk (> other_id main_id) "a forked process gets a later id"
|
||||||
|
chk (nqv? main_id other_id) "a forked process has an id of its own"
|
||||||
|
|
||||||
|
## [NOTE] Mutex:critical is reentrant by design - it tracks _owner and
|
||||||
|
## _nest_count so the holder may re-enter - but the nested path returns from
|
||||||
|
## inside the 'if' without undoing its own increment, so _nest_count never
|
||||||
|
## falls back to 0 and the semaphore is never signalled. A process that nests
|
||||||
|
## once holds the mutex forever. No case below exercises nesting for that
|
||||||
|
## reason; add one when the counting is fixed.
|
||||||
+10
-10
@@ -16,20 +16,20 @@ fun chk(ok msg) {
|
|||||||
else { printf "ERROR: %s\n" msg }
|
else { printf "ERROR: %s\n" msg }
|
||||||
}
|
}
|
||||||
|
|
||||||
iosem := (sem-new)
|
iosem := (core.sem-new)
|
||||||
tmo := (sem-new)
|
tmo := (core.sem-new)
|
||||||
sg := (semgr-new)
|
sg := (core.semgr-new)
|
||||||
semgr-add sg iosem
|
core.semgr-add sg iosem
|
||||||
semgr-add sg tmo
|
core.semgr-add sg tmo
|
||||||
|
|
||||||
## 1 when the handle became readable, 0 when the timer won instead
|
## 1 when the handle became readable, 0 when the timer won instead
|
||||||
fun waitin(h secs) {
|
fun waitin(h secs) {
|
||||||
| s |
|
| s |
|
||||||
sem-signal tmo secs 0
|
core.sem-signal tmo secs 0
|
||||||
sem-signal-on-input iosem h
|
core.sem-signal-on-input iosem h
|
||||||
s := (semgr-wait sg)
|
s := (core.semgr-wait sg)
|
||||||
sem-unsignal iosem
|
core.sem-unsignal iosem
|
||||||
sem-unsignal tmo
|
core.sem-unsignal tmo
|
||||||
if (eqv? s tmo) { return 0 } else { return 1 }
|
if (eqv? s tmo) { return 0 } else { return 1 }
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
+18
-18
@@ -15,15 +15,15 @@ fun chk(ok msg) {
|
|||||||
else { printf "ERROR: %s\n" msg }
|
else { printf "ERROR: %s\n" msg }
|
||||||
}
|
}
|
||||||
|
|
||||||
sg := (semgr-new)
|
sg := (core.semgr-new)
|
||||||
sa := (sem-new)
|
sa := (core.sem-new)
|
||||||
sb := (sem-new)
|
sb := (core.sem-new)
|
||||||
sc := (sem-new)
|
sc := (core.sem-new)
|
||||||
tmo := (sem-new)
|
tmo := (core.sem-new)
|
||||||
semgr-add sg sa
|
core.semgr-add sg sa
|
||||||
semgr-add sg sb
|
core.semgr-add sg sb
|
||||||
semgr-add sg sc
|
core.semgr-add sg sc
|
||||||
semgr-add sg tmo
|
core.semgr-add sg tmo
|
||||||
|
|
||||||
## staggered so the completion order is a, then b, then c
|
## staggered so the completion order is a, then b, then c
|
||||||
pa := (sys.popen "sleep 0.2; echo aaa" "r")
|
pa := (sys.popen "sleep 0.2; echo aaa" "r")
|
||||||
@@ -35,14 +35,14 @@ hb := (core.basicAt pb 2)
|
|||||||
hc := (core.basicAt pc 2)
|
hc := (core.basicAt pc 2)
|
||||||
|
|
||||||
## all three bound at the same time - three live tuple entries
|
## all three bound at the same time - three live tuple entries
|
||||||
sem-signal-on-input sa ha
|
core.sem-signal-on-input sa ha
|
||||||
sem-signal-on-input sb hb
|
core.sem-signal-on-input sb hb
|
||||||
sem-signal-on-input sc hc
|
core.sem-signal-on-input sc hc
|
||||||
sem-signal tmo 9 0
|
core.sem-signal tmo 9 0
|
||||||
|
|
||||||
fun expect(want h name) {
|
fun expect(want h name) {
|
||||||
| s buf got |
|
| s buf got |
|
||||||
s := (semgr-wait sg)
|
s := (core.semgr-wait sg)
|
||||||
chk (eqv? s want) name
|
chk (eqv? s want) name
|
||||||
buf := (core.basicNew ByteArray 8)
|
buf := (core.basicNew ByteArray 8)
|
||||||
got := (sys.read h buf)
|
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
|
## unbinding sa frees the first slot, so the last entry migrates into it and
|
||||||
## sb/sc must still resolve to their own handles afterwards
|
## sb/sc must still resolve to their own handles afterwards
|
||||||
expect sa ha "the first child woke its own semaphore"
|
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"
|
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"
|
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 pa 0)
|
||||||
sys.pclose (core.basicAt pb 0)
|
sys.pclose (core.basicAt pb 0)
|
||||||
sys.pclose (core.basicAt pc 0)
|
sys.pclose (core.basicAt pc 0)
|
||||||
|
|||||||
@@ -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
@@ -8,11 +8,11 @@ fun loop1() {
|
|||||||
while (< k 100) {
|
while (< k 100) {
|
||||||
printf "loop1 => %d\n" k
|
printf "loop1 => %d\n" k
|
||||||
k := (+ k 2)
|
k := (+ k 2)
|
||||||
yield
|
core.yield
|
||||||
}
|
}
|
||||||
|
|
||||||
z1 := k
|
z1 := k
|
||||||
sem-signal s1
|
core.sem-signal s1
|
||||||
}
|
}
|
||||||
|
|
||||||
fun loop2() {
|
fun loop2() {
|
||||||
@@ -22,26 +22,26 @@ fun loop2() {
|
|||||||
while (< k 100) {
|
while (< k 100) {
|
||||||
printf "loop2 => %d\n" k
|
printf "loop2 => %d\n" k
|
||||||
k := (+ k 2)
|
k := (+ k 2)
|
||||||
yield
|
core.yield
|
||||||
}
|
}
|
||||||
|
|
||||||
z2 := k
|
z2 := k
|
||||||
sem-signal s2
|
core.sem-signal s2
|
||||||
}
|
}
|
||||||
|
|
||||||
s1 := (sem-new)
|
s1 := (core.sem-new)
|
||||||
s2 := (sem-new)
|
s2 := (core.sem-new)
|
||||||
|
|
||||||
p1 := (fork loop1)
|
p1 := (core.fork loop1)
|
||||||
p2 := (fork loop2)
|
p2 := (core.fork loop2)
|
||||||
|
|
||||||
##suspend p1
|
##core.suspend p1
|
||||||
##suspend p2
|
##core.suspend p2
|
||||||
##resume p1
|
##core.resume p1
|
||||||
##resume p2
|
##core.resume p2
|
||||||
|
|
||||||
sem-wait s1
|
core.sem-wait s1
|
||||||
sem-wait s2
|
core.sem-wait s2
|
||||||
|
|
||||||
if (== z1 101) { printf "OK: z1 is %d\n" z1 } \
|
if (== z1 101) { printf "OK: z1 is %d\n" z1 } \
|
||||||
else { printf "ERROR: z1 is not 101 - %d\n" z1 }
|
else { printf "ERROR: z1 is not 101 - %d\n" z1 }
|
||||||
|
|||||||
+2
-2
@@ -22,10 +22,10 @@ ticks := 0
|
|||||||
fun ticker() {
|
fun ticker() {
|
||||||
while (< ticks 5) {
|
while (< ticks 5) {
|
||||||
ticks := (+ ticks 1)
|
ticks := (+ ticks 1)
|
||||||
yield
|
core.yield
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
fork ticker
|
core.fork ticker
|
||||||
|
|
||||||
order := (core.basicNew Array 3)
|
order := (core.basicNew Array 3)
|
||||||
n := 0
|
n := 0
|
||||||
|
|||||||
+24
-24
@@ -27,23 +27,23 @@ sys.close (core.basicAt q 0)
|
|||||||
sys.close (core.basicAt q 1)
|
sys.close (core.basicAt q 1)
|
||||||
|
|
||||||
## --- catch and uncatch are idempotent ---
|
## --- catch and uncatch are idempotent ---
|
||||||
chk (= (system-catch-sig sys.SIGUSR1) sys.SIGUSR1) "system-catch-sig returns the signal number"
|
chk (= (sys.sig-catch sys.SIGUSR1) sys.SIGUSR1) "sys.sig-catch returns the signal number"
|
||||||
chk (= (system-catch-sig sys.SIGUSR1) sys.SIGUSR1) "catching an already caught signal is fine"
|
chk (= (sys.sig-catch 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 (= (sys.sig-uncatch sys.SIGUSR1) sys.SIGUSR1) "sys.sig-uncatch returns the signal number"
|
||||||
chk (= (system-uncatch-sig sys.SIGUSR1) sys.SIGUSR1) "uncatching an uncaught signal is fine"
|
chk (= (sys.sig-uncatch sys.SIGUSR1) sys.SIGUSR1) "uncatching an uncaught signal is fine"
|
||||||
|
|
||||||
## --- a real signal reaches hak code, without stalling the coprocesses ---
|
## --- a real signal reaches hak code, without stalling the coprocesses ---
|
||||||
## SIGCHLD is used because a child exiting is something this test can arrange
|
## SIGCHLD is used because a child exiting is something this test can arrange
|
||||||
## on its own, with no outside help.
|
## on its own, with no outside help.
|
||||||
system-catch-sig sys.SIGCHLD
|
sys.sig-catch sys.SIGCHLD
|
||||||
|
|
||||||
h := (system-get-sigfd)
|
h := (sys.sig-getfd)
|
||||||
s := (sem-new)
|
s := (core.sem-new)
|
||||||
tmo := (sem-new)
|
tmo := (core.sem-new)
|
||||||
sg := (semgr-new)
|
sg := (core.semgr-new)
|
||||||
semgr-add sg s
|
core.semgr-add sg s
|
||||||
semgr-add sg tmo
|
core.semgr-add sg tmo
|
||||||
fin := (sem-new)
|
fin := (core.sem-new)
|
||||||
ticks := 0
|
ticks := 0
|
||||||
signo := -1
|
signo := -1
|
||||||
|
|
||||||
@@ -52,14 +52,14 @@ proc := (core.basicAt pr 0)
|
|||||||
|
|
||||||
fun waiter() {
|
fun waiter() {
|
||||||
| w |
|
| w |
|
||||||
sem-signal tmo 20 0
|
core.sem-signal tmo 20 0
|
||||||
sem-signal-on-input s h
|
core.sem-signal-on-input s h
|
||||||
w := (semgr-wait sg)
|
w := (core.semgr-wait sg)
|
||||||
sem-unsignal s
|
core.sem-unsignal s
|
||||||
sem-unsignal tmo
|
core.sem-unsignal tmo
|
||||||
if (eqv? w tmo) { signo := -2 } \
|
if (eqv? w tmo) { signo := -2 } \
|
||||||
else { signo := (system-get-sig) }
|
else { signo := (sys.sig-get) }
|
||||||
sem-signal fin
|
core.sem-signal fin
|
||||||
return 0
|
return 0
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -67,16 +67,16 @@ fun ticker() {
|
|||||||
## the waiter is parked on the signal descriptor by now
|
## the waiter is parked on the signal descriptor by now
|
||||||
while (< ticks 4) {
|
while (< ticks 4) {
|
||||||
ticks := (+ ticks 1)
|
ticks := (+ ticks 1)
|
||||||
yield
|
core.yield
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
fork waiter
|
core.fork waiter
|
||||||
fork ticker
|
core.fork ticker
|
||||||
sem-wait fin
|
core.sem-wait fin
|
||||||
|
|
||||||
chk (= ticks 4) "coprocesses ran while a coprocess waited on a signal"
|
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 (= signo sys.SIGCHLD) "the signal number came through the signal descriptor"
|
||||||
chk (= (sys.pwait proc) 4) "and the child's exit status is readable"
|
chk (= (sys.pwait proc) 4) "and the child's exit status is readable"
|
||||||
sys.pclose proc
|
sys.pclose proc
|
||||||
system-uncatch-sig sys.SIGCHLD
|
sys.sig-uncatch sys.SIGCHLD
|
||||||
|
|||||||
+3
-3
@@ -54,8 +54,8 @@ chk (== sys.SIGTERM 15) "SIGTERM is 15"
|
|||||||
|
|
||||||
## and the constants behave: a routable one can be caught, an unroutable one
|
## and the constants behave: a routable one can be caught, an unroutable one
|
||||||
## cannot, whatever the numbers happen to be here
|
## cannot, whatever the numbers happen to be here
|
||||||
chk (== (system-catch-sig sys.SIGUSR1) sys.SIGUSR1) "SIGUSR1 is catchable"
|
chk (== (sys.sig-catch sys.SIGUSR1) sys.SIGUSR1) "SIGUSR1 is catchable"
|
||||||
chk (== (system-uncatch-sig sys.SIGUSR1) sys.SIGUSR1) "SIGUSR1 is uncatchable again"
|
chk (== (sys.sig-uncatch sys.SIGUSR1) sys.SIGUSR1) "SIGUSR1 is uncatchable again"
|
||||||
raised := false
|
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"
|
chk raised "SIGKILL is refused"
|
||||||
|
|||||||
+10
-10
@@ -1,41 +1,41 @@
|
|||||||
## signals that cannot be caught
|
## 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
|
## signals that indicate a crash: turning one into a byte on a pipe and
|
||||||
## carrying on would hide the fault rather than report it
|
## 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
|
## 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
@@ -5,19 +5,19 @@ fun chk(ok msg) {
|
|||||||
else { printf "ERROR: %s\n" msg }
|
else { printf "ERROR: %s\n" msg }
|
||||||
}
|
}
|
||||||
|
|
||||||
iosem := (sem-new)
|
iosem := (core.sem-new)
|
||||||
tmo := (sem-new)
|
tmo := (core.sem-new)
|
||||||
sg := (semgr-new)
|
sg := (core.semgr-new)
|
||||||
semgr-add sg iosem
|
core.semgr-add sg iosem
|
||||||
semgr-add sg tmo
|
core.semgr-add sg tmo
|
||||||
|
|
||||||
fun waitin(h secs) {
|
fun waitin(h secs) {
|
||||||
| s |
|
| s |
|
||||||
sem-signal tmo secs 0
|
core.sem-signal tmo secs 0
|
||||||
sem-signal-on-input iosem h
|
core.sem-signal-on-input iosem h
|
||||||
s := (semgr-wait sg)
|
s := (core.semgr-wait sg)
|
||||||
sem-unsignal iosem
|
core.sem-unsignal iosem
|
||||||
sem-unsignal tmo
|
core.sem-unsignal tmo
|
||||||
if (eqv? s tmo) { return 0 } else { return 1 }
|
if (eqv? s tmo) { return 0 } else { return 1 }
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -38,9 +38,9 @@ fun reap(proc) {
|
|||||||
while (< k 300) {
|
while (< k 300) {
|
||||||
n := (sys.pwait proc)
|
n := (sys.pwait proc)
|
||||||
if (not (= n 256)) { return n }
|
if (not (= n 256)) { return n }
|
||||||
sem-signal tmo 0 20000000
|
core.sem-signal tmo 0 20000000
|
||||||
semgr-wait sg
|
core.semgr-wait sg
|
||||||
sem-unsignal tmo
|
core.sem-unsignal tmo
|
||||||
k := (+ k 1)
|
k := (+ k 1)
|
||||||
}
|
}
|
||||||
return 256
|
return 256
|
||||||
|
|||||||
+16
-16
@@ -9,12 +9,12 @@ fun chk(ok msg) {
|
|||||||
else { printf "ERROR: %s\n" msg }
|
else { printf "ERROR: %s\n" msg }
|
||||||
}
|
}
|
||||||
|
|
||||||
iosem := (sem-new)
|
iosem := (core.sem-new)
|
||||||
tmo := (sem-new)
|
tmo := (core.sem-new)
|
||||||
sg := (semgr-new)
|
sg := (core.semgr-new)
|
||||||
semgr-add sg iosem
|
core.semgr-add sg iosem
|
||||||
semgr-add sg tmo
|
core.semgr-add sg tmo
|
||||||
fin := (sem-new)
|
fin := (core.sem-new)
|
||||||
|
|
||||||
p := (sys.popen "sleep 1; exit 5" "r")
|
p := (sys.popen "sleep 1; exit 5" "r")
|
||||||
proc := (core.basicAt p 0)
|
proc := (core.basicAt p 0)
|
||||||
@@ -30,14 +30,14 @@ else {
|
|||||||
|
|
||||||
fun waiter() {
|
fun waiter() {
|
||||||
| s |
|
| s |
|
||||||
sem-signal tmo 20 0
|
core.sem-signal tmo 20 0
|
||||||
sem-signal-on-input iosem xh
|
core.sem-signal-on-input iosem xh
|
||||||
s := (semgr-wait sg)
|
s := (core.semgr-wait sg)
|
||||||
sem-unsignal iosem
|
core.sem-unsignal iosem
|
||||||
sem-unsignal tmo
|
core.sem-unsignal tmo
|
||||||
if (eqv? s tmo) { status := -1 } \
|
if (eqv? s tmo) { status := -1 } \
|
||||||
else { status := (sys.pwait proc) }
|
else { status := (sys.pwait proc) }
|
||||||
sem-signal fin
|
core.sem-signal fin
|
||||||
return 0
|
return 0
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -46,14 +46,14 @@ else {
|
|||||||
## happen if the VM went on scheduling instead of blocking
|
## happen if the VM went on scheduling instead of blocking
|
||||||
while (< ticks 4) {
|
while (< ticks 4) {
|
||||||
ticks := (+ ticks 1)
|
ticks := (+ ticks 1)
|
||||||
yield
|
core.yield
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
chk (integer? xh) "sys.popen hands back an exit handle"
|
chk (integer? xh) "sys.popen hands back an exit handle"
|
||||||
fork waiter
|
core.fork waiter
|
||||||
fork ticker
|
core.fork ticker
|
||||||
sem-wait fin
|
core.sem-wait fin
|
||||||
|
|
||||||
chk (= ticks 4) "other coprocesses ran while the child was alive"
|
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"
|
chk (= status 5) "the exit handle woke the waiter and the status was read"
|
||||||
|
|||||||
@@ -199,12 +199,6 @@ static void termreq_round_trips (void)
|
|||||||
void* during[NTERMREQ];
|
void* during[NTERMREQ];
|
||||||
void* after[NTERMREQ];
|
void* after[NTERMREQ];
|
||||||
int i;
|
int i;
|
||||||
|
|
||||||
for (i = 0; i < NTERMREQ; i++)
|
|
||||||
{
|
|
||||||
if (disposition_of(TERMREQ[i], &before[i]) <= -1) return; /* no sigaction */
|
|
||||||
}
|
|
||||||
|
|
||||||
#if defined(SIGPIPE)
|
#if defined(SIGPIPE)
|
||||||
/* SIGPIPE is deliberately NOT in the set above. It is not a termination
|
/* SIGPIPE is deliberately NOT in the set above. It is not a termination
|
||||||
* request - it is the opposite, a measure against being terminated - and
|
* 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. */
|
* So termreq must leave it exactly alone. */
|
||||||
void* pipe_before;
|
void* pipe_before;
|
||||||
void* pipe_during;
|
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
|
#endif
|
||||||
|
|
||||||
hak_catch_termreq();
|
hak_catch_termreq();
|
||||||
|
|||||||
@@ -80,12 +80,12 @@ static void state_contract (void)
|
|||||||
|
|
||||||
static const char SRC[] =
|
static const char SRC[] =
|
||||||
"flag := 0\n"
|
"flag := 0\n"
|
||||||
"s := (sem-new)\n"
|
"s := (core.sem-new)\n"
|
||||||
"fun setter() { flag := 1 ; sem-signal s }\n"
|
"fun setter() { flag := 1 ; core.sem-signal s }\n"
|
||||||
"p := (fork setter)\n"
|
"p := (core.fork setter)\n"
|
||||||
"i := 0\n"
|
"i := 0\n"
|
||||||
"while (< i 300000) { if (== flag 1) { break } ; i := (+ i 1) }\n"
|
"while (< i 300000) { if (== flag 1) { break } ; i := (+ i 1) }\n"
|
||||||
"sem-wait s\n"
|
"core.sem-wait s\n"
|
||||||
"r := i\n";
|
"r := i\n";
|
||||||
|
|
||||||
static hak_oow_t bc_seen = 0;
|
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);
|
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)
|
static void preempts_a_spinner (void)
|
||||||
{
|
{
|
||||||
hak_t* hak;
|
hak_t* hak;
|
||||||
@@ -117,9 +133,11 @@ static void preempts_a_spinner (void)
|
|||||||
OK (hak != HAK_NULL, "instantiation");
|
OK (hak != HAK_NULL, "instantiation");
|
||||||
if (!hak) return;
|
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;
|
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));
|
memset (&cb, 0, sizeof(cb));
|
||||||
cb.vm_checkbc = cb_checkbc;
|
cb.vm_checkbc = cb_checkbc;
|
||||||
|
|||||||
@@ -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
@@ -21,7 +21,7 @@ fun setter() { flag := 1 }
|
|||||||
|
|
||||||
## setter is runnable from here on, but it cannot run while this process holds
|
## setter is runnable from here on, but it cannot run while this process holds
|
||||||
## the CPU - and this process never calls yield.
|
## the CPU - and this process never calls yield.
|
||||||
p := (fork setter)
|
p := (core.fork setter)
|
||||||
|
|
||||||
i := 0
|
i := 0
|
||||||
while (< i 3000000) {
|
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
|
## 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
|
## i would be ~0, proving nothing about preemption. One tick is 20ms, which is
|
||||||
## a great many iterations.
|
## 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
|
## The preempted process must be resumed, not abandoned - reaching here at all
|
||||||
## means the scheduler came back to it.
|
## means the scheduler came back to it.
|
||||||
|
|||||||
+202
@@ -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"
|
||||||
Reference in New Issue
Block a user