Compare commits

..
27 Commits
Author SHA1 Message Date
hyung-hwan 8c2f034082 a little code clean-up 2026-09-19 02:29:50 +09:00
hyung-hwan fe7d4c9da1 fixed the segfault for the ownership issue of the stack context with core.fork 2026-09-18 20:44:22 +09:00
hyung-hwan 1d17f1e708 fixed the mssing stack finalization is multiple process manipulation primitive functions 2026-09-15 20:29:09 +09:00
hyung-hwan f99a8c87f0 updated the Semaphore methods to relay the return value of primitive calls 2026-09-12 11:49:10 +09:00
hyung-hwan 7be5d0fe61 code simplification by using MUXEVT_FD in more places 2026-09-12 11:33:51 +09:00
hyung-hwan baa01b22e3 relocated signal primitives to the sys module 2026-09-11 23:12:40 +09:00
hyung-hwan 58d1234020 added ticker to bin/main.go 2026-09-11 16:01:36 +09:00
hyung-hwan bcdc7d8d36 ported the same command line options to the go code 2026-09-11 14:36:51 +09:00
hyung-hwan 1a8cc6ef43 split HAK_OPT_MODLIBDIRS and HAK_OPT_INCDIRS to BCSTR/UCSTR 2026-09-11 12:33:30 +09:00
hyung-hwan 15b42bc269 make the style of option enumerators more uniform 2026-09-11 12:02:12 +09:00
hyung-hwan 992b1344a8 update hak.go with modlibdirs and incdirs... still not complete 2026-09-11 10:58:28 +09:00
hyung-hwan 27115ca792 added HAK_OPT_INCDIRS 2026-09-11 10:44:58 +09:00
hyung-hwan 05b7e3f728 added the option.incdirs field 2026-09-10 06:00:04 +00:00
hyung-hwan e63dc2c2a0 relocated some primitive functions(process,semaphore,etc) to the core module 2026-09-10 14:30:51 +09:00
hyung-hwan 92caa7e8db creating Seamphore and SemaphoreGroup classes 2026-09-10 13:53:25 +09:00
hyung-hwan 4b4238dc50 fixed the return in the catch block bug. the try_exist instruction should not have been emitted for return when directly in a catch block 2026-09-05 00:59:19 +09:00
hyung-hwan 175e666954 fixed the return in try bug. when compiling return, it was emitting the try_exit instruction too early before instructions for return value evaluation 2026-09-05 00:00:28 +09:00
hyung-hwan 586094ae8f added HAK_CLSTK_SIZE and EXSTK_SIZE 2026-09-03 20:35:32 +09:00
hyung-hwan de8c567a87 updated the poll/select branch to fix the delayed waked up of io signaling thread 2026-09-02 18:58:31 +09:00
hyung-hwan 10051c7851 updated the poll path to handle stale events in std.c 2026-09-02 15:11:20 +09:00
hyung-hwan df07bd7eb2 updated start_ticker and stop_ticker to use atomic operations if available
defined a few atomic operation macros
2026-09-02 13:11:18 +09:00
hyung-hwan e5ce0304f8 fixed a c89 violation in test code 2026-09-01 23:52:10 +09:00
hyung-hwan 58d3eaa562 more update to kqueue/kevent handling in std.c 2026-09-01 23:20:34 +09:00
hyung-hwan fdda6998f2 updated muxmod to purge the buffered events from the modified io handle 2026-09-01 23:07:20 +09:00
hyung-hwan 2cb4ddf0b3 changed the HAVE_ESCAPE_U check as the previous check didn't work well 2026-09-01 22:14:14 +09:00
hyung-hwan f77ec1049d added HAVE_ESCAPE_U check 2026-09-01 20:11:02 +09:00
hyung-hwan 897e7477bc minor fixes to cater for old compilers 2026-09-01 05:36:58 +00:00
55 changed files with 2910 additions and 787 deletions
+39 -33
View File
@@ -249,8 +249,8 @@ static int handle_logopt (hak_t* hak, const hak_bch_t* logstr)
} }
fname.ptr = (hak_bch_t*)logstr; 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
View File
@@ -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)
Vendored
+40
View File
@@ -16590,6 +16590,45 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether compiler supports \u escape sequences" >&5
printf %s "checking whether compiler supports \u escape sequences... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* define a macro that forces a compilation error if condition is false */
#define STATIC_ASSERT(expr) char assert_array[(expr) ? 1 : -1]
int
main (void)
{
/* true UTF-8 "\u00e9" is 3 bytes including the null terminator.
* GCC 2.95's "u00e9" is 6 bytes. */
STATIC_ASSERT(sizeof("\u00e9") == 3);
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"
then :
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "yes" >&6; }
printf "%s\n" "#define HAVE_ESCAPE_U 1" >>confdefs.h
else case e in #(
e)
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5
printf "%s\n" "no" >&6; }
;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for __builtin_memset" >&5 { printf "%s\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 :
+19
View File
@@ -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>]])
+47 -13
View File
@@ -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;
+102 -9
View File
@@ -76,6 +76,38 @@ type BitMask C.hak_bitmask_t
const TRAIT_LANG_ENABLE_EOL BitMask = C.HAK_TRAIT_LANG_ENABLE_EOL 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
View File
@@ -1134,6 +1134,7 @@ static int push_ctlblk (hak_t* hak, const hak_loc_t* errloc, hak_ctlblk_type_t t
HAK_MEMSET(&hak->c->ctlblk.info[new_depth], 0, HAK_SIZEOF(hak->c->ctlblk.info[new_depth])); HAK_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
View File
@@ -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(&gtick, 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 */
+2
View File
@@ -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
{ {
+3
View File
@@ -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
View File
@@ -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
* =========================================================================*/ * =========================================================================*/
-2
View File
@@ -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
View File
@@ -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 */
/* ========================================================================= */ /* ========================================================================= */
+169 -31
View File
@@ -150,6 +150,8 @@ int hak_init (hak_t* hak, hak_mmgr_t* mmgr, const hak_vmprim_t* vmprim)
hak->option.dfl_symtab_size = HAK_DFL_SYMTAB_SIZE; hak->option.dfl_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);
+80 -28
View File
@@ -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
View File
@@ -952,7 +952,7 @@ hak_json_t* hak_json_open (hak_mmgr_t* mmgr, hak_oow_t xtnsize, hak_json_prim_t*
/* the dummy hak is used for this json to perform primitive operations /* 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;
} }
+4 -3
View File
@@ -470,6 +470,10 @@ hak_oop_t hak_makestringwithuchars (hak_t* hak, const hak_uch_t* ptr, hak_oow_t
hak_oop_t hak_makestringwithbchars (hak_t* hak, const hak_bch_t* ptr, hak_oow_t len) 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
View File
@@ -1220,7 +1220,7 @@ static hak_pfrc_t pf_va_get (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
} }
static hak_pfrc_t pf_object_new (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs) hak_pfrc_t hak_pf_object_new (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
{ {
hak_oop_t obj; hak_oop_t 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
View File
@@ -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)
+346 -106
View File
@@ -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
View File
@@ -212,7 +212,7 @@ hak_client_t* hak_client_open (hak_mmgr_t* mmgr, hak_oow_t xtnsize, hak_client_p
/* the dummy hak is used for this client to perform primitive operations /* 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
View File
@@ -1177,14 +1177,14 @@ hak_server_t* hak_server_open (hak_mmgr_t* mmgr, hak_oow_t xtnsize, hak_server_p
/* the dummy hak is used for this server to perform primitive operations /* 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
View File
@@ -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 } },
}; };
+9 -4
View File
@@ -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 } },
+3
View File
@@ -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'
+36
View File
@@ -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
}
}
+76
View File
@@ -0,0 +1,76 @@
class Apex {
fun isNil?() { return false }
fun notNil?() { return true }
fun[#class] basicNew(size) {
return (core.basicNew self size)
}
fun[#class] respondsTo(mthname) {
return (core.classRespondsTo self mthname)
}
fun respondsTo(mthname) {
return (core.instRespondsTo self mthname)
}
fun primAt(pos) {
return (core.primAt self pos)
}
fun primtAtPut(pos value) {
return (core.primAtPut self pos value)
}
fun basicAt(pos) {
return (core.basicAt self pos)
}
fun basicAtPut(pos value) {
return (core.basicAtPut self pos value)
}
fun basicSize() {
return (core.basicSize self)
}
## TODO: ...
fun == (oprnd) { return (== self oprnd) }
fun != (oprnd) { return (!= self oprnd) }
## TODO: fun perform(name ...) {}
}
class[#uncopyable #varying #limited #final] Class: Apex (
_name
_mdic
_spec
_selfspec
_superclass
_nivars_super
_ibrand
_ivarnames
_cvarnames
) {
fun name() {
##return (core.className self)
return _class
}
fun instanceVariableNames() {
## TODO: this still returns nil as the acutal manipulation of the field has not been implemented
return _ivarnames
}
fun classVariableNames() {
## TODO: this still returns nil as the acutal manipulation of the field has not been implemented
return _cvarnames
}
}
class UndefinedObject: Apex {
fun isNil?() { return true }
fun notNil?() { return false }
}
class Object: Apex {
}
+31
View File
@@ -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
}
}
+74
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
+73
View File
@@ -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
+74
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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 }
+95
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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)
+67
View File
@@ -0,0 +1,67 @@
## both directions bound to one descriptor, then one of them dropped
##
## Binding an input and an output semaphore to the same handle gives the VM a
## tuple with two directions. Unbinding one of them leaves the other in place,
## so delete_sem_from_sem_io_tuple() modifies the registration rather than
## removing it - vm_muxmod() instead of vm_muxdel(). Nothing else in the suite
## takes that path, so the per-direction event purge behind it is otherwise
## never executed.
##
## A pipe's write end is used because it is always writable, so the output
## semaphore has something to report; the input side is registered but never
## fires, which is fine - what matters is that both directions are registered.
fun chk(ok msg) {
if ok { printf "OK: %s\n" msg } \
else { printf "ERROR: %s\n" msg }
}
sg := (core.semgr-new)
isem := (core.sem-new)
osem := (core.sem-new)
tmo := (core.sem-new)
core.semgr-add sg isem
core.semgr-add sg osem
core.semgr-add sg tmo
p := (sys.pipe)
r := (core.basicAt p 0)
w := (core.basicAt p 1)
## one descriptor, two directions - the tuple now carries both
core.sem-signal-on-input isem w
core.sem-signal-on-output osem w
## drop only the input direction. the output registration must survive, and so
## must any event already reported for it
core.sem-unsignal isem
core.sem-signal tmo 5 0
s := (core.semgr-wait sg)
chk (eqv? s osem) "the surviving direction still reports after a partial unbind"
core.sem-unsignal tmo
## put the input direction back while the output one is still registered. this
## is the add branch of the modify path - the mirror of the drop above - and it
## has to leave the output registration alone.
core.sem-signal-on-input isem w
## now drop the output direction instead, keeping input. a write end is never
## readable, so with input alone nothing can report and the timer must win. if
## the modify path had left the output registration behind, its writability
## would be reported here and the timer would lose.
core.sem-unsignal osem
core.sem-signal tmo 0 300000000
s := (core.semgr-wait sg)
chk (eqv? s tmo) "the dropped direction stops reporting after a partial unbind"
core.sem-unsignal tmo
## and the full unbind from that state really removes the registration
core.sem-unsignal isem
core.sem-signal tmo 0 300000000
s := (core.semgr-wait sg)
chk (eqv? s tmo) "nothing reports once both directions are unbound"
core.sem-unsignal tmo
sys.close r
sys.close w
+14 -14
View File
@@ -8,11 +8,11 @@ fun loop1() {
while (< k 100) { 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
View File
@@ -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
View File
@@ -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
View File
@@ -54,8 +54,8 @@ chk (== sys.SIGTERM 15) "SIGTERM is 15"
## and the constants behave: a routable one can be caught, an unroutable one ## 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
View File
@@ -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
View File
@@ -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
View File
@@ -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"
+10 -7
View File
@@ -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();
+24 -6
View File
@@ -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;
+131
View File
@@ -0,0 +1,131 @@
/* process stack overflow must be reported, not swallowed.
*
* HAK_STACK_PUSH() detects the overflow, sets HAK_ESTKOVRFLW and stores -1 in
* hak->abort_req; the interpreter loop then takes "goto oops" and answers a
* failure. That path is only reachable while abort_req is a signed type - when
* it was hak_uint8_t the -1 became 255, the "abort_req < 0" test could never
* be true, and the overflow fell through to the ordinary "abort_req > 0" break
* instead. hak_execute() then answered success and the script simply stopped
* running with nothing reported.
*
* This is checked here rather than in t/ as a script because neither script
* harness can express it: run.sh fails a test as soon as the output contains
* an ERROR: line, and err.sh insists the error be reported at the line its
* ##ERROR: marker sits on, whereas a stack overflow carries no source
* location and is reported at [0,0]. Only a C test can assert on the value
* hak_execute() answers, which is the part that regressed.
*
* The nesting depth is what drives the operand stack: evaluating
* (+ 1 (+ 1 ... 0)) has to hold every pending left operand at once. The
* process stack size is set explicitly here because there is no single
* default to rely on - HAK_DFL_PROCSTK_SIZE is 5000, bin/hak asks for 600,
* and exec.c clamps whatever it is given up to a floor of 192. */
#include <hak.h>
#include "tap.h"
#include <string.h>
#include <stdlib.h>
/* slots per nesting level are an implementation detail, so keep a wide margin
* on both sides of the limit rather than probing for the exact threshold */
#define STK_SLOTS 192
#define DEEP_DEPTH 2000
#define SHALLOW_DEPTH 10
static int on_cnode (hak_t* hak, hak_cnode_t* obj)
{
return hak_compile(hak, obj, 0);
}
/* build "x := (+ 1 (+ 1 ... 0))" nested to the given depth */
static char* make_src (int depth)
{
hak_oow_t capa;
char* buf;
char* p;
int i;
capa = (hak_oow_t)depth * 8 + 64;
buf = (char*)malloc(capa);
if (!buf) return HAK_NULL;
p = buf;
memcpy(p, "x := ", 5); p += 5;
for (i = 0; i < depth; i++) { memcpy(p, "(+ 1 ", 5); p += 5; }
*p++ = '0';
for (i = 0; i < depth; i++) *p++ = ')';
*p++ = '\n';
*p = '\0';
return buf;
}
/* returns 0 if the run completed, -1 if the fixture itself could not be built */
static int run_at_depth (int depth, int expect_overflow)
{
hak_t* hak;
hak_bitmask_t trait;
hak_oow_t stksize;
hak_oop_t retv;
char* src;
int errnum;
int rc = -1;
src = make_src(depth);
OK (src != HAK_NULL, "source built");
if (!src) return -1;
hak = hak_openstd(0, HAK_NULL);
OK (hak != HAK_NULL, "instantiation");
if (!hak) goto done;
hak_getoption(hak, HAK_OPT_TRAIT, &trait);
trait |= HAK_TRAIT_LANG_ENABLE_EOL;
hak_setoption(hak, HAK_OPT_TRAIT, &trait);
stksize = STK_SLOTS;
OK (hak_setoption(hak, HAK_OPT_PROCSTK_SIZE, &stksize) == 0, "process stack size");
OK (hak_ignite(hak, 0) == 0, "ignition");
OK (hak_addbuiltinprims(hak) == 0, "builtin primitives");
OK (hak_attachcciostdwithbcstr(hak, HAK_NULL) == 0, "source input stream");
OK (hak_attachudiostdwithbcstr(hak, "", "") == 0, "user data streams");
OK (hak_beginfeed(hak, on_cnode) == 0, "begin feed");
OK (hak_feedbchars(hak, src, strlen(src)) == 0, "feed the script");
OK (hak_endfeed(hak) == 0, "end feed");
retv = hak_execute(hak);
errnum = (int)hak_geterrnum(hak);
if (expect_overflow)
{
printf("# depth=%d retv=%s errnum=%d (%s)\n", depth,
retv? "value": "HAK_NULL", errnum,
retv? "-": hak_geterrbmsg(hak));
/* the assertion that regressed: a swallowed overflow answers a value */
OK (retv == HAK_NULL, "an overflowing script fails rather than answering a value");
OK (errnum == HAK_ESTKOVRFLW, "the failure is reported as HAK_ESTKOVRFLW");
}
else
{
if (!retv) printf("# depth=%d unexpected failure: [%d] %s\n", depth, errnum, hak_geterrbmsg(hak));
OK (retv != HAK_NULL, "a script within the stack limit still runs");
}
rc = 0;
hak_close(hak);
done:
free(src);
return rc;
}
int main (int argc, char* argv[])
{
no_plan();
/* the control comes first: if this one failed the deep case would pass
* for the wrong reason, since any failure at all answers HAK_NULL */
run_at_depth(SHALLOW_DEPTH, 0);
run_at_depth(DEEP_DEPTH, 1);
return exit_status();
}
+2 -2
View File
@@ -21,7 +21,7 @@ fun setter() { flag := 1 }
## setter is runnable from here on, but it cannot run while this process holds ## 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
View File
@@ -0,0 +1,202 @@
## Two related defects in how 'return' interacts with try/catch. Both are
## fixed; this checks both, because each hid the other while writing the test.
##
## 1. compile_return() emitted TRY_EXIT/CLASS_EXIT before the return value was
## compiled, so the value expression ran with every enclosing handler in the
## function already popped - not just the innermost one. The unwinding now
## comes from emit_return(), after the value is on the operand stack.
## Only the syntactic form used to matter: try { x := (f) } caught what f
## threw while try { return (f) } did not, so both forms appear below.
##
## 2. A 'return', 'break' or 'continue' inside a catch body emitted a TRY_EXIT
## for the very try whose handler it sat in - but 'throw' has already
## unwound that frame, so the second pop drove the exception stack below its
## base. HAK_EXSTACK_IS_EMPTY tests 'exsp <= st', so an underflowed stack
## reads as empty from then on and EVERY later try in the process reported
## 'exception not handled'. The catch body is now compiled with its try
## block marked in_catch, which suppresses the instruction.
##
## That corruption was never visible in the function that caused it, so the
## assertions that actually guard it are the ones exercising a try AFTER a
## catch that returned, broke or continued.
fun chk(ok msg) {
if ok { printf "OK: %s\n" msg } \
else { printf "ERROR: %s\n" msg }
}
fun boom() { throw 99 }
## ------------------------------------------------------------------
## 1. a throw inside a return value
## ------------------------------------------------------------------
fun c1() {
try { return (boom) } catch (e) { return (+ e 1) }
}
chk (= (c1) 100) "a throw in a return value is caught by the enclosing try"
## the catch need not return for the handler to run
seen := 0
fun c2() {
try { return (boom) } catch (e) { seen := e }
return 7
}
chk (= (c2) 7) "execution resumes after the try when the catch falls through"
chk (= seen 99) "the catch body ran"
fun c3() {
try { return (boom) } catch (e) { }
return 8
}
chk (= (c3) 8) "an empty catch body still handles the throw"
## nesting: the innermost handler wins and the outer one stays out of it.
## the old code unwound every enclosing try, so neither fired.
inner := 0
outer := 0
fun c4() {
try {
try { return (boom) } catch (e) { inner := (+ inner 1) }
} catch (e2) { outer := (+ outer 1) }
return 9
}
chk (= (c4) 9) "a nested try returns normally after handling"
chk (= inner 1) "the innermost try catches"
chk (= outer 0) "the outer try is left out of it"
## across a call boundary the callee's own handler wins; the old code let the
## throw escape to the caller's handler instead
g_seen := 0
h_seen := 0
fun g() { try { return (boom) } catch (e) { g_seen := 1 ; return -1 } }
fun h() { try { return (g) } catch (e) { h_seen := 1 ; return -2 } }
chk (= (h) -1) "the callee handles its own throw"
chk (= g_seen 1) "the callee's catch ran"
chk (= h_seen 0) "the caller's catch did not"
## the form that always worked must keep working
fun c5() {
| v |
v := 0
try { v := (boom) } catch (e) { v := e }
return v
}
chk (= (c5) 99) "a throw in an assignment is still caught"
## ------------------------------------------------------------------
## 2. leaving a catch body by return, break or continue
##
## each case is followed by a fresh try: that is where an underflowed
## exception stack shows up, never in the function that caused it.
## ------------------------------------------------------------------
## a try that must still work after the cases above, which all returned from
## inside a catch
fun still1() {
| v |
v := 0
try { v := (boom) } catch (e) { v := 21 }
return v
}
chk (= (still1) 21) "a try still works after earlier catch bodies returned"
## break out of a loop from inside a catch
bj := 0
while (< bj 9) {
bj := (+ bj 1)
try { y := (boom) } catch (e) { break }
}
chk (= bj 1) "break inside a catch leaves the loop"
fun still2() {
| v |
v := 0
try { v := (boom) } catch (e) { v := 22 }
return v
}
chk (= (still2) 22) "a try still works after a break from inside a catch"
## continue to the next iteration from inside a catch
ci := 0
ch := 0
while (< ci 3) {
ci := (+ ci 1)
try { z := (boom) } catch (e) { ch := (+ ch 1) ; continue }
ch := 100
}
chk (= ci 3) "continue inside a catch keeps iterating"
chk (= ch 3) "continue inside a catch skips the rest of the loop body"
fun still3() {
| v |
v := 0
try { v := (boom) } catch (e) { v := 23 }
return v
}
chk (= (still3) 23) "a try still works after a continue from inside a catch"
## the in_catch mark must suppress only the block whose handler we are in. the
## return below sits in the inner catch, so the inner frame is already gone,
## but the outer try is still live and has to be unwound on the way out. a
## frame left behind there would misdirect the next throw instead.
fun nest2() {
try {
try { w := (boom) } catch (e) { return 11 }
} catch (e2) { }
return 12
}
chk (= (nest2) 11) "a return from an inner catch still unwinds the outer try"
fun still4() {
| v |
v := 0
try { v := (boom) } catch (e) { v := 24 }
return v
}
chk (= (still4) 24) "a try still works after returning from a nested catch"
## ------------------------------------------------------------------
## 3. break and continue in a try BODY still unwind
##
## these share emit_ctlblk_unwind with return, and here the frame is live and
## must be popped. a leaked frame per iteration would exhaust the exception
## stack long before these loops finish.
## ------------------------------------------------------------------
i := 0
n := 0
while (< i 2000) {
i := (+ i 1)
try { if (= (mod i 2) 0) { continue } ; n := (+ n 1) } catch (e) { n := -1 }
}
chk (= n 1000) "continue inside a try body unwinds without leaking a handler"
i := 0
while (< i 2000) {
i := (+ i 1)
try { if (= i 7) { break } } catch (e) { }
}
chk (= i 7) "break inside a try body unwinds and leaves the loop"
## ------------------------------------------------------------------
## 4. a handler stays live across a whole call chain
## ------------------------------------------------------------------
hits := 0
caught := 0
fun rec(k) {
if (<= k 0) { throw 55 }
try { return (rec (- k 1)) } catch (e) { hits := (+ hits 1) ; caught := e ; return e }
}
chk (= (rec 20) 55) "recursion with a try per frame propagates the thrown value"
chk (= caught 55) "the thrown value arrives intact"
chk (= hits 1) "only the frame nearest the throw handles it"
fun still5() {
| v |
v := 0
try { v := (boom) } catch (e) { v := 25 }
return v
}
chk (= (still5) 25) "a try still works after deep try-per-frame recursion"