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

some more code cleanup

Browse Source
This commit is contained in:
hyung-hwan 2021-03-28 03:44:27 +00:00
parent a20587537e
commit 9f89bd7c1b
7 changed files with 329 additions and 287 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
bin/main.c
View File

@ -24,8 +24,9 @@
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#include "hcl-prv.h"
#include "hcl-opt.h"
#include <hcl.h>
#include <hcl-utl.h>
#include <hcl-opt.h>
#include <stdio.h>
#include <stdlib.h>
@ -47,6 +48,7 @@
# define INCL_DOSPROCESS
# define INCL_DOSERRORS
# include <os2.h>
# include <signal.h>
#elif defined(__DOS__)
# include <dos.h>
@ -87,11 +89,11 @@ typedef struct xtn_t xtn_t;
struct xtn_t
{
const char* read_path; /* main source file */
const char* print_path;
const char* print_path;
int vm_running;
int reader_istty;
hcl_oop_t sym_errstr;
/*hcl_oop_t sym_errstr;*/
};
@ -178,7 +180,7 @@ static HCL_INLINE int open_input (hcl_t* hcl, hcl_ioinarg_t* arg)
arg->handle = bb;
/* HACK */
if (!arg->includer)
if (!arg->includer)
{
HCL_ASSERT (hcl, arg->name == HCL_NULL);
arg->name = hcl_dupbtooocstr(hcl, xtn->read_path, HCL_NULL);
@ -191,7 +193,7 @@ static HCL_INLINE int open_input (hcl_t* hcl, hcl_ioinarg_t* arg)
return 0;
oops:
if (bb)
if (bb)
{
if (bb->fp) fclose (bb->fp);
hcl_freemem (hcl, bb);
@ -276,7 +278,7 @@ static int read_handler (hcl_t* hcl, hcl_iocmd_t cmd, void* arg)
{
case HCL_IO_OPEN:
return open_input(hcl, (hcl_ioinarg_t*)arg);
case HCL_IO_CLOSE:
return close_input(hcl, (hcl_ioinarg_t*)arg);
@ -314,7 +316,7 @@ static HCL_INLINE int open_output (hcl_t* hcl, hcl_iooutarg_t* arg)
arg->handle = fp;
return 0;
}
static HCL_INLINE int close_output (hcl_t* hcl, hcl_iooutarg_t* arg)
{
/*xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl);*/
@ -338,7 +340,7 @@ static HCL_INLINE int write_output (hcl_t* hcl, hcl_iooutarg_t* arg)
donelen = 0;
do
do
{
#if defined(HCL_OOCH_IS_UCH)
bcslen = HCL_COUNTOF(bcsbuf);
@ -424,7 +426,7 @@ static void vm_checkbc (hcl_t* hcl, hcl_oob_t bcode)
static void gc_hcl (hcl_t* hcl)
{
xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl);
if (xtn->sym_errstr) xtn->sym_errstr = hcl_moveoop(hcl, xtn->sym_errstr);
/*if (xtn->sym_errstr) xtn->sym_errstr = hcl_moveoop(hcl, xtn->sym_errstr);*/
}
/* ========================================================================= */
@ -435,16 +437,16 @@ static int handle_logopt (hcl_t* hcl, const hcl_bch_t* str)
hcl_bitmask_t logmask;
xstr = hcl_dupbtooochars(hcl, str, hcl_count_bcstr(str), HCL_NULL);
if (!xstr)
if (!xstr)
{
fprintf (stderr, "ERROR: out of memory in duplicating %s\n", str);
return -1;
}
cm = hcl_find_oochar_in_oocstr(xstr, ',');
if (cm)
if (cm)
{
/* i duplicate this string for open() below as open() doesn't
/* i duplicate this string for open() below as open() doesn't
* accept a length-bounded string */
cm = hcl_find_oochar_in_oocstr(xstr, ',');
*cm = '\0';
@ -555,7 +557,7 @@ typedef void(*signal_handler_t)(int);
#endif
#if defined(_WIN32) || defined(__MSDOS__) || defined(__OS2__)
#if defined(_WIN32) || defined(__MSDOS__) || defined(__OS2__)
static void handle_sigint (int sig)
{
if (g_hcl) hcl_abort (g_hcl);
@ -576,7 +578,7 @@ static void handle_sigint (int sig)
static void set_signal (int sig, signal_handler_t handler)
{
#if defined(_WIN32) || defined(__MSDOS__) || defined(__OS2__)
#if defined(_WIN32) || defined(__MSDOS__) || defined(__OS2__)
signal (sig, handler);
#elif defined(macintosh)
/* TODO: implement this */
@ -599,12 +601,12 @@ static void set_signal (int sig, signal_handler_t handler)
static void set_signal_to_default (int sig)
{
#if defined(_WIN32) || defined(__MSDOS__) || defined(__OS2__)
#if defined(_WIN32) || defined(__MSDOS__) || defined(__OS2__)
signal (sig, SIG_DFL);
#elif defined(macintosh)
/* TODO: implement this */
#else
struct sigaction sa;
struct sigaction sa;
memset (&sa, 0, sizeof(sa));
sa.sa_handler = SIG_DFL;
@ -635,7 +637,7 @@ static void print_synerr (hcl_t* hcl)
hcl_logbfmt (hcl, HCL_LOG_STDERR, "%s", xtn->read_path);
}
hcl_logbfmt (hcl, HCL_LOG_STDERR, "[%zu,%zu] %js",
hcl_logbfmt (hcl, HCL_LOG_STDERR, "[%zu,%zu] %js",
synerr.loc.line, synerr.loc.colm,
(hcl_geterrmsg(hcl) != hcl_geterrstr(hcl)? hcl_geterrmsg(hcl): hcl_geterrstr(hcl))
);
@ -649,7 +651,7 @@ static void print_synerr (hcl_t* hcl)
}
#define DEFAULT_HEAPSIZE 512000ul
int main (int argc, char* argv[])
{
hcl_t* hcl = HCL_NULL;
@ -807,6 +809,7 @@ int main (int argc, char* argv[])
goto oops;
}
/*
{
hcl_ooch_t errstr[] = { 'E', 'R', 'R', 'S', 'T', 'R' };
xtn->sym_errstr = hcl_makesymbol(hcl, errstr, 6);
@ -817,8 +820,9 @@ int main (int argc, char* argv[])
}
HCL_OBJ_SET_FLAGS_KERNEL (xtn->sym_errstr, 1);
}
*/
/* -- from this point onward, any failure leads to jumping to the oops label
/* -- from this point onward, any failure leads to jumping to the oops label
* -- instead of returning -1 immediately. --*/
set_signal (SIGINT, handle_sigint);
@ -865,9 +869,9 @@ count++;
else if (hcl->errnum == HCL_ESYNERR)
{
print_synerr (hcl);
if (xtn->reader_istty && hcl_getsynerrnum(hcl) != HCL_SYNERR_EOF)
if (xtn->reader_istty && hcl_getsynerrnum(hcl) != HCL_SYNERR_EOF)
{
/* TODO: drain remaining data in the reader including the actual inputstream and buffered data in hcl */
/* TODO: drain remaining data in the reader including the actual inputstream and buffered data in hcl */
continue;
}
}
@ -913,12 +917,12 @@ count++;
hcl_decode (hcl, 0, hcl_getbclen(hcl));
HCL_LOG0 (hcl, HCL_LOG_MNEMONIC, "------------------------------------------\n");
g_hcl = hcl;
//setup_tick ();
/*setup_tick ();*/
retv = hcl_execute(hcl);
/* flush pending output data in the interactive mode(e.g. printf without a newline) */
hcl_flushio (hcl);
hcl_flushio (hcl);
if (!retv)
{
@ -940,7 +944,7 @@ count++;
}
*/
}
//cancel_tick();
/*cancel_tick();*/
g_hcl = HCL_NULL;
}
}

5
lib/fmt.c
View File

@ -76,6 +76,9 @@
# if !defined(HAVE_SNPRINTF)
# define HAVE_SNPRINTF
# endif
# if defined(__OS2__) && defined(__BORLANDC__)
# undef HAVE_SNPRINTF
# endif
#endif
#if defined(HAVE_QUADMATH_H)
# include <quadmath.h> /* for quadmath_snprintf() */
@ -87,7 +90,7 @@
* hcl_intmax_t in base 2, plus NUL byte. */
#define MAXNBUF (HCL_SIZEOF(hcl_intmax_t) * HCL_BITS_PER_BYTE + 1)
enum
enum fmt_spec_t
{
/* integer */
LF_C = (1 << 0),

94
lib/hcl-cmn.h
View File

@ -27,20 +27,20 @@
#ifndef _HCL_CMN_H_
#define _HCL_CMN_H_
/* WARNING: NEVER CHANGE/DELETE THE FOLLOWING HCL_HAVE_CFG_H DEFINITION.
/* WARNING: NEVER CHANGE/DELETE THE FOLLOWING HCL_HAVE_CFG_H DEFINITION.
* IT IS USED FOR DEPLOYMENT BY MAKEFILE.AM */
/*#define HCL_HAVE_CFG_H*/
#if defined(HCL_HAVE_CFG_H)
# include "hcl-cfg.h"
# include <hcl-cfg.h>
#elif defined(_WIN32)
# include "hcl-msw.h"
# include <hcl-msw.h>
#elif defined(__OS2__)
# include "hcl-os2.h"
# include <hcl-os2.h>
#elif defined(__DOS__)
# include "hcl-dos.h"
# include <hcl-dos.h>
#elif defined(macintosh)
# include "hcl-mac.h" /* class mac os */
# include <hcl-mac.h> /* classic mac os */
#else
# error UNSUPPORTED SYSTEM
#endif
@ -51,7 +51,7 @@
#if defined(EMSCRIPTEN)
# if defined(HCL_SIZEOF___INT128)
# undef HCL_SIZEOF___INT128
# undef HCL_SIZEOF___INT128
# define HCL_SIZEOF___INT128 0
# endif
# if defined(HCL_SIZEOF_LONG) && defined(HCL_SIZEOF_INT) && (HCL_SIZEOF_LONG > HCL_SIZEOF_INT)
@ -292,7 +292,7 @@
typedef hcl_int64_t hcl_intptr_t;
typedef hcl_uint32_t hcl_ushortptr_t;
typedef hcl_int32_t hcl_shortptr_t;
#elif defined(HCL_HAVE_UINT128_T) && (HCL_SIZEOF_VOID_P == 16)
#elif defined(HCL_HAVE_UINT128_T) && (HCL_SIZEOF_VOID_P == 16)
typedef hcl_uint128_t hcl_uintptr_t;
typedef hcl_int128_t hcl_intptr_t;
typedef hcl_uint64_t hcl_ushortptr_t;
@ -407,7 +407,7 @@ typedef unsigned char hcl_bchu_t; /* unsigned version of hcl_bch_t for
# define HCL_SIZEOF_UCH_T 4
#elif defined(__GNUC__) && defined(__CHAR16_TYPE__)
typedef __CHAR16_TYPE__ hcl_uch_t;
typedef __CHAR16_TYPE__ hcl_uch_t;
typedef hcl_uint16_t hcl_uchu_t; /* same as hcl_uch_t as it is already unsigned */
# define HCL_SIZEOF_UCH_T 2
#else
@ -479,7 +479,7 @@ typedef unsigned int hcl_bitmask_t;
typedef struct hcl_obj_t hcl_obj_t;
typedef struct hcl_obj_t* hcl_oop_t;
/*
/*
* An object pointer(OOP) is an ordinary pointer value to an object.
* but some simple numeric values are also encoded into OOP using a simple
* bit-shifting and masking.
@ -487,15 +487,15 @@ typedef struct hcl_obj_t* hcl_oop_t;
* A real OOP is stored without any bit-shifting while a non-pointer value encoded
* in an OOP is bit-shifted to the left by 2 and the 2 least-significant bits
* are set to 1 or 2.
*
*
* This scheme works because the object allocators aligns the object size to
* a multiple of sizeof(hcl_oop_t). This way, the 2 least-significant bits
* of a real OOP are always 0s.
*
* With 2 bits, i can encode only 3 special types except object pointers.
* With 2 bits, i can encode only 3 special types except object pointers.
* Since I need more than 3 special types, I extend the tag bits up to 4 bits
* to represent a special data type that doesn't require a range as wide
* as a small integer. A unicode character, for instance, only requires 21
* as a small integer. A unicode character, for instance, only requires 21
* bits at most. An error doesn't need to be as diverse as a small integer.
*/
@ -537,13 +537,13 @@ typedef struct hcl_obj_t* hcl_oop_t;
#define HCL_OOP_TO_ERROR(oop) (((hcl_oow_t)oop) >> (HCL_OOP_TAG_BITS_LO + HCL_OOP_TAG_BITS_LO))
#define HCL_ERROR_TO_OOP(num) ((hcl_oop_t)((((hcl_oow_t)(num)) << (HCL_OOP_TAG_BITS_LO + HCL_OOP_TAG_BITS_LO)) | HCL_OOP_TAG_ERROR))
/* SMOOI takes up 62 bit on a 64-bit architecture and 30 bits
/* SMOOI takes up 62 bit on a 64-bit architecture and 30 bits
* on a 32-bit architecture. The absolute value takes up 61 bits and 29 bits
* respectively for the 1 sign bit. */
#define HCL_SMOOI_BITS (HCL_OOI_BITS - HCL_OOP_TAG_BITS_LO)
#define HCL_SMOOI_ABS_BITS (HCL_SMOOI_BITS - 1)
#define HCL_SMOOI_MAX ((hcl_ooi_t)(~((hcl_oow_t)0) >> (HCL_OOP_TAG_BITS_LO + 1)))
/* Sacrificing 1 bit pattern for a negative SMOOI makes
/* Sacrificing 1 bit pattern for a negative SMOOI makes
* implementation a lot eaisier in many respect. */
/*#define HCL_SMOOI_MIN (-HCL_SMOOI_MAX - 1)*/
#define HCL_SMOOI_MIN (-HCL_SMOOI_MAX)
@ -552,7 +552,7 @@ typedef struct hcl_obj_t* hcl_oop_t;
/* SMPTR is a special value which has been devised to encode an address value
* whose low HCL_OOP_TAG_BITS_LO bits are 0. its class is SmallPointer. A pointer
* returned by most of system functions would be aligned to the pointer size.
* returned by most of system functions would be aligned to the pointer size.
* you can use the followings macros when converting such a pointer without loss. */
#define HCL_IN_SMPTR_RANGE(ptr) ((((hcl_oow_t)ptr) & HCL_LBMASK(hcl_oow_t, HCL_OOP_TAG_BITS_LO)) == 0)
@ -691,7 +691,7 @@ struct hcl_ntime_t
#endif
/* make a bit mask that can mask off low n bits */
#define HCL_LBMASK(type,n) (~(~((type)0) << (n)))
#define HCL_LBMASK(type,n) (~(~((type)0) << (n)))
#define HCL_LBMASK_SAFE(type,n) (((n) < HCL_BITSOF(type))? HCL_LBMASK(type,n): ~(type)0)
/* make a bit mask that can mask off hig n bits */
@ -715,7 +715,7 @@ struct hcl_ntime_t
(value = (((type)(value)) | (((bits) & HCL_LBMASK(type,length)) << (offset))))
/**
/**
* The HCL_BITS_MAX() macros calculates the maximum value that the 'nbits'
* bits of an unsigned integer of the given 'type' can hold.
* \code
@ -730,12 +730,12 @@ struct hcl_ntime_t
* ========================================================================= */
typedef struct hcl_mmgr_t hcl_mmgr_t;
/**
/**
* allocate a memory chunk of the size \a n.
* \return pointer to a memory chunk on success, #HCL_NULL on failure.
*/
typedef void* (*hcl_mmgr_alloc_t) (hcl_mmgr_t* mmgr, hcl_oow_t n);
/**
/**
* resize a memory chunk pointed to by \a ptr to the size \a n.
* \return pointer to a memory chunk on success, #HCL_NULL on failure.
*/
@ -748,13 +748,13 @@ typedef void (*hcl_mmgr_free_t) (hcl_mmgr_t* mmgr, void* ptr);
/**
* The hcl_mmgr_t type defines the memory management interface.
* As the type is merely a structure, it is just used as a single container
* for memory management functions with a pointer to user-defined data.
* The user-defined data pointer \a ctx is passed to each memory management
* function whenever it is called. You can allocate, reallocate, and free
* for memory management functions with a pointer to user-defined data.
* The user-defined data pointer \a ctx is passed to each memory management
* function whenever it is called. You can allocate, reallocate, and free
* a memory chunk.
*
* For example, a hcl_xxx_open() function accepts a pointer of the hcl_mmgr_t
* type and the xxx object uses it to manage dynamic data within the object.
* type and the xxx object uses it to manage dynamic data within the object.
*/
struct hcl_mmgr_t
{
@ -771,12 +771,12 @@ struct hcl_mmgr_t
#define HCL_MMGR_ALLOC(mmgr,size) ((mmgr)->alloc(mmgr,size))
/**
* The HCL_MMGR_REALLOC() macro resizes a memory block pointed to by \a ptr
* The HCL_MMGR_REALLOC() macro resizes a memory block pointed to by \a ptr
* to the \a size bytes using the \a mmgr memory manager.
*/
#define HCL_MMGR_REALLOC(mmgr,ptr,size) ((mmgr)->realloc(mmgr,ptr,size))
/**
/**
* The HCL_MMGR_FREE() macro deallocates the memory block pointed to by \a ptr.
*/
#define HCL_MMGR_FREE(mmgr,ptr) ((mmgr)->free(mmgr,ptr))
@ -789,7 +789,7 @@ struct hcl_mmgr_t
typedef struct hcl_cmgr_t hcl_cmgr_t;
typedef hcl_oow_t (*hcl_cmgr_bctouc_t) (
const hcl_bch_t* mb,
const hcl_bch_t* mb,
hcl_oow_t size,
hcl_uch_t* wc
);
@ -801,8 +801,8 @@ typedef hcl_oow_t (*hcl_cmgr_uctobc_t) (
);
/**
* The hcl_cmgr_t type defines the character-level interface to
* multibyte/wide-character conversion. This interface doesn't
* The hcl_cmgr_t type defines the character-level interface to
* multibyte/wide-character conversion. This interface doesn't
* provide any facility to store conversion state in a context
* independent manner. This leads to the limitation that it can
* handle a stateless multibyte encoding only.
@ -829,7 +829,7 @@ typedef struct hcl_t hcl_t;
#elif defined(_WIN32) || (defined(__WATCOMC__) && (__WATCOMC__ >= 1000) && !defined(__WINDOWS_386__))
# define HCL_IMPORT __declspec(dllimport)
# define HCL_EXPORT __declspec(dllexport)
# define HCL_PRIVATE
# define HCL_PRIVATE
#elif defined(__GNUC__) && ((__GNUC__>= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 3))
# define HCL_IMPORT __attribute__((visibility("default")))
# define HCL_EXPORT __attribute__((visibility("default")))
@ -846,12 +846,12 @@ typedef struct hcl_t hcl_t;
# define HCL_INLINE inline
# define HCL_HAVE_INLINE
#elif defined(__GNUC__) && defined(__GNUC_GNU_INLINE__)
/* gcc disables inline when -std=c89 or -ansi is used.
/* gcc disables inline when -std=c89 or -ansi is used.
* so use __inline__ supported by gcc regardless of the options */
# define HCL_INLINE /*extern*/ __inline__
# define HCL_HAVE_INLINE
#else
# define HCL_INLINE
# define HCL_INLINE
# undef HCL_HAVE_INLINE
#endif
@ -921,7 +921,7 @@ typedef struct hcl_t hcl_t;
*/
#if defined(__has_builtin)
#if defined(__has_builtin)
#if __has_builtin(__builtin_ctz)
#define HCL_HAVE_BUILTIN_CTZ
#endif
@ -941,43 +941,43 @@ typedef struct hcl_t hcl_t;
#if __has_builtin(__builtin_clzll)
#define HCL_HAVE_BUILTIN_CLZLL
#endif
#if __has_builtin(__builtin_uadd_overflow)
#define HCL_HAVE_BUILTIN_UADD_OVERFLOW
#define HCL_HAVE_BUILTIN_UADD_OVERFLOW
#endif
#if __has_builtin(__builtin_uaddl_overflow)
#define HCL_HAVE_BUILTIN_UADDL_OVERFLOW
#define HCL_HAVE_BUILTIN_UADDL_OVERFLOW
#endif
#if __has_builtin(__builtin_uaddll_overflow)
#define HCL_HAVE_BUILTIN_UADDLL_OVERFLOW
#define HCL_HAVE_BUILTIN_UADDLL_OVERFLOW
#endif
#if __has_builtin(__builtin_umul_overflow)
#define HCL_HAVE_BUILTIN_UMUL_OVERFLOW
#define HCL_HAVE_BUILTIN_UMUL_OVERFLOW
#endif
#if __has_builtin(__builtin_umull_overflow)
#define HCL_HAVE_BUILTIN_UMULL_OVERFLOW
#define HCL_HAVE_BUILTIN_UMULL_OVERFLOW
#endif
#if __has_builtin(__builtin_umulll_overflow)
#define HCL_HAVE_BUILTIN_UMULLL_OVERFLOW
#define HCL_HAVE_BUILTIN_UMULLL_OVERFLOW
#endif
#if __has_builtin(__builtin_sadd_overflow)
#define HCL_HAVE_BUILTIN_SADD_OVERFLOW
#define HCL_HAVE_BUILTIN_SADD_OVERFLOW
#endif
#if __has_builtin(__builtin_saddl_overflow)
#define HCL_HAVE_BUILTIN_SADDL_OVERFLOW
#define HCL_HAVE_BUILTIN_SADDL_OVERFLOW
#endif
#if __has_builtin(__builtin_saddll_overflow)
#define HCL_HAVE_BUILTIN_SADDLL_OVERFLOW
#define HCL_HAVE_BUILTIN_SADDLL_OVERFLOW
#endif
#if __has_builtin(__builtin_smul_overflow)
#define HCL_HAVE_BUILTIN_SMUL_OVERFLOW
#define HCL_HAVE_BUILTIN_SMUL_OVERFLOW
#endif
#if __has_builtin(__builtin_smull_overflow)
#define HCL_HAVE_BUILTIN_SMULL_OVERFLOW
#define HCL_HAVE_BUILTIN_SMULL_OVERFLOW
#endif
#if __has_builtin(__builtin_smulll_overflow)
#define HCL_HAVE_BUILTIN_SMULLL_OVERFLOW
#define HCL_HAVE_BUILTIN_SMULLL_OVERFLOW
#endif
#if __has_builtin(__builtin_expect)
@ -1017,7 +1017,7 @@ typedef struct hcl_t hcl_t;
#elif defined(__GNUC__) && defined(__GNUC_MINOR__)
#if (__GNUC__ >= 4)
#if (__GNUC__ >= 4)
#define HCL_HAVE_SYNC_LOCK_TEST_AND_SET
#define HCL_HAVE_SYNC_LOCK_RELEASE

90
lib/hcl-fmt.h
View File

@ -27,14 +27,14 @@
#ifndef _HCL_FMT_H_
#define _HCL_FMT_H_
#include "hcl-cmn.h"
#include <hcl-cmn.h>
#include <stdarg.h>
/** \file
* This file defines various formatting functions.
*/
/**
/**
* The hcl_fmt_intmax_flag_t type defines enumerators to change the
* behavior of hcl_fmt_intmax() and hcl_fmt_uintmax().
*/
@ -163,7 +163,7 @@ typedef int (*hcl_fmtout_putobj_t) (
hcl_oop_t obj
);
enum hcl_fmtout_fmt_type_t
enum hcl_fmtout_fmt_type_t
{
HCL_FMTOUT_FMT_TYPE_BCH = 0,
HCL_FMTOUT_FMT_TYPE_UCH
@ -193,22 +193,22 @@ extern "C" {
#endif
/**
* The hcl_fmt_intmax_to_bcstr() function formats an integer \a value to a
* multibyte string according to the given base and writes it to a buffer
* pointed to by \a buf. It writes to the buffer at most \a size characters
* including the terminating null. The base must be between 2 and 36 inclusive
* and can be ORed with zero or more #hcl_fmt_intmax_to_bcstr_flag_t enumerators.
* This ORed value is passed to the function via the \a base_and_flags
* The hcl_fmt_intmax_to_bcstr() function formats an integer \a value to a
* multibyte string according to the given base and writes it to a buffer
* pointed to by \a buf. It writes to the buffer at most \a size characters
* including the terminating null. The base must be between 2 and 36 inclusive
* and can be ORed with zero or more #hcl_fmt_intmax_to_bcstr_flag_t enumerators.
* This ORed value is passed to the function via the \a base_and_flags
* parameter. If the formatted string is shorter than \a bufsize, the redundant
* slots are filled with the fill character \a fillchar if it is not a null
* slots are filled with the fill character \a fillchar if it is not a null
* character. The filling behavior is determined by the flags shown below:
*
* - If #HCL_FMT_INTMAX_TO_BCSTR_FILLRIGHT is set in \a base_and_flags, slots
* - If #HCL_FMT_INTMAX_TO_BCSTR_FILLRIGHT is set in \a base_and_flags, slots
* after the formatting string are filled.
* - If #HCL_FMT_INTMAX_TO_BCSTR_FILLCENTER is set in \a base_and_flags, slots
* - If #HCL_FMT_INTMAX_TO_BCSTR_FILLCENTER is set in \a base_and_flags, slots
* before the formatting string are filled. However, if it contains the
* sign character, the slots between the sign character and the digit part
* are filled.
* are filled.
* - If neither #HCL_FMT_INTMAX_TO_BCSTR_FILLRIGHT nor #HCL_FMT_INTMAX_TO_BCSTR_FILLCENTER
* , slots before the formatting string are filled.
*
@ -220,26 +220,26 @@ extern "C" {
*
* The terminating null is not added if #HCL_FMT_INTMAX_TO_BCSTR_NONULL is set;
* The #HCL_FMT_INTMAX_TO_BCSTR_UPPERCASE flag indicates that the function should
* use the uppercase letter for a alphabetic digit;
* use the uppercase letter for a alphabetic digit;
* You can set #HCL_FMT_INTMAX_TO_BCSTR_NOTRUNC if you require lossless formatting.
* The #HCL_FMT_INTMAX_TO_BCSTR_PLUSSIGN flag and #HCL_FMT_INTMAX_TO_BCSTR_EMPTYSIGN
* ensures that the plus sign and a space is added for a positive integer
* The #HCL_FMT_INTMAX_TO_BCSTR_PLUSSIGN flag and #HCL_FMT_INTMAX_TO_BCSTR_EMPTYSIGN
* ensures that the plus sign and a space is added for a positive integer
* including 0 respectively.
* The #HCL_FMT_INTMAX_TO_BCSTR_ZEROLEAD flag ensures that the numeric string
* begins with '0' before applying the prefix.
* You can set the #HCL_FMT_INTMAX_TO_BCSTR_NOZERO flag if you want the value of
* 0 to produce nothing. If both #HCL_FMT_INTMAX_TO_BCSTR_NOZERO and
* 0 to produce nothing. If both #HCL_FMT_INTMAX_TO_BCSTR_NOZERO and
* #HCL_FMT_INTMAX_TO_BCSTR_ZEROLEAD are specified, '0' is still produced.
*
*
* If \a prefix is not #HCL_NULL, it is inserted before the digits.
*
*
* \return
* - -1 if the base is not between 2 and 36 inclusive.
* - negated number of characters required for lossless formatting
* - -1 if the base is not between 2 and 36 inclusive.
* - negated number of characters required for lossless formatting
* - if \a bufsize is 0.
* - if #HCL_FMT_INTMAX_TO_BCSTR_NOTRUNC is set and \a bufsize is less than
* the minimum required for lossless formatting.
* - number of characters written to the buffer excluding a terminating
* - number of characters written to the buffer excluding a terminating
* null in all other cases.
*/
HCL_EXPORT int hcl_fmt_intmax_to_bcstr (
@ -253,25 +253,25 @@ HCL_EXPORT int hcl_fmt_intmax_to_bcstr (
);
/**
* The hcl_fmt_intmax_to_ucstr() function formats an integer \a value to a
* wide-character string according to the given base and writes it to a buffer
* pointed to by \a buf. It writes to the buffer at most \a size characters
* including the terminating null. The base must be between 2 and 36 inclusive
* and can be ORed with zero or more #hcl_fmt_intmax_to_ucstr_flag_t enumerators.
* This ORed value is passed to the function via the \a base_and_flags
* The hcl_fmt_intmax_to_ucstr() function formats an integer \a value to a
* wide-character string according to the given base and writes it to a buffer
* pointed to by \a buf. It writes to the buffer at most \a size characters
* including the terminating null. The base must be between 2 and 36 inclusive
* and can be ORed with zero or more #hcl_fmt_intmax_to_ucstr_flag_t enumerators.
* This ORed value is passed to the function via the \a base_and_flags
* parameter. If the formatted string is shorter than \a bufsize, the redundant
* slots are filled with the fill character \a fillchar if it is not a null
* slots are filled with the fill character \a fillchar if it is not a null
* character. The filling behavior is determined by the flags shown below:
*
* - If #HCL_FMT_INTMAX_TO_UCSTR_FILLRIGHT is set in \a base_and_flags, slots
* - If #HCL_FMT_INTMAX_TO_UCSTR_FILLRIGHT is set in \a base_and_flags, slots
* after the formatting string are filled.
* - If #HCL_FMT_INTMAX_TO_UCSTR_FILLCENTER is set in \a base_and_flags, slots
* - If #HCL_FMT_INTMAX_TO_UCSTR_FILLCENTER is set in \a base_and_flags, slots
* before the formatting string are filled. However, if it contains the
* sign character, the slots between the sign character and the digit part
* are filled.
* are filled.
* - If neither #HCL_FMT_INTMAX_TO_UCSTR_FILLRIGHT nor #HCL_FMT_INTMAX_TO_UCSTR_FILLCENTER
* , slots before the formatting string are filled.
*
*
* The \a precision parameter specified the minimum number of digits to
* produce from the \ value. If \a value produces fewer digits than
* \a precision, the actual digits are padded with '0' to meet the precision
@ -280,26 +280,26 @@ HCL_EXPORT int hcl_fmt_intmax_to_bcstr (
*
* The terminating null is not added if #HCL_FMT_INTMAX_TO_UCSTR_NONULL is set;
* The #HCL_FMT_INTMAX_TO_UCSTR_UPPERCASE flag indicates that the function should
* use the uppercase letter for a alphabetic digit;
* use the uppercase letter for a alphabetic digit;
* You can set #HCL_FMT_INTMAX_TO_UCSTR_NOTRUNC if you require lossless formatting.
* The #HCL_FMT_INTMAX_TO_UCSTR_PLUSSIGN flag and #HCL_FMT_INTMAX_TO_UCSTR_EMPTYSIGN
* ensures that the plus sign and a space is added for a positive integer
* The #HCL_FMT_INTMAX_TO_UCSTR_PLUSSIGN flag and #HCL_FMT_INTMAX_TO_UCSTR_EMPTYSIGN
* ensures that the plus sign and a space is added for a positive integer
* including 0 respectively.
* The #HCL_FMT_INTMAX_TO_UCSTR_ZEROLEAD flag ensures that the numeric string
* begins with 0 before applying the prefix.
* You can set the #HCL_FMT_INTMAX_TO_UCSTR_NOZERO flag if you want the value of
* 0 to produce nothing. If both #HCL_FMT_INTMAX_TO_UCSTR_NOZERO and
* 0 to produce nothing. If both #HCL_FMT_INTMAX_TO_UCSTR_NOZERO and
* #HCL_FMT_INTMAX_TO_UCSTR_ZEROLEAD are specified, '0' is still produced.
*
* If \a prefix is not #HCL_NULL, it is inserted before the digits.
*
*
* \return
* - -1 if the base is not between 2 and 36 inclusive.
* - negated number of characters required for lossless formatting
* - -1 if the base is not between 2 and 36 inclusive.
* - negated number of characters required for lossless formatting
* - if \a bufsize is 0.
* - if #HCL_FMT_INTMAX_TO_UCSTR_NOTRUNC is set and \a bufsize is less than
* the minimum required for lossless formatting.
* - number of characters written to the buffer excluding a terminating
* - number of characters written to the buffer excluding a terminating
* null in all other cases.
*/
HCL_EXPORT int hcl_fmt_intmax_to_ucstr (
@ -313,8 +313,8 @@ HCL_EXPORT int hcl_fmt_intmax_to_ucstr (
);
/**
* The hcl_fmt_uintmax_to_bcstr() function formats an unsigned integer \a value
* to a multibyte string buffer. It behaves the same as hcl_fmt_intmax_to_bcstr()
* The hcl_fmt_uintmax_to_bcstr() function formats an unsigned integer \a value
* to a multibyte string buffer. It behaves the same as hcl_fmt_intmax_to_bcstr()
* except that it handles an unsigned integer.
*/
HCL_EXPORT int hcl_fmt_uintmax_to_bcstr (
@ -328,8 +328,8 @@ HCL_EXPORT int hcl_fmt_uintmax_to_bcstr (
);
/**
* The hcl_fmt_uintmax_to_ucstr() function formats an unsigned integer \a value
* to a multibyte string buffer. It behaves the same as hcl_fmt_intmax_to_ucstr()
* The hcl_fmt_uintmax_to_ucstr() function formats an unsigned integer \a value
* to a multibyte string buffer. It behaves the same as hcl_fmt_intmax_to_ucstr()
* except that it handles an unsigned integer.
*/
HCL_EXPORT int hcl_fmt_uintmax_to_ucstr (

23
lib/hcl-prv.h
View File

@ -34,7 +34,7 @@
/* you can define this to either 1 or 2 */
#define HCL_CODE_LONG_PARAM_SIZE 2
/* this is useful for debugging. hcl_gc() can be called
/* this is useful for debugging. hcl_gc() can be called
* while hcl has not been fully initialized when this is defined*/
#define HCL_SUPPORT_GC_DURING_IGNITION
@ -339,7 +339,7 @@ struct hcl_cframe_t
hcl_ooi_t index;
} dic_list;
/* COP_EMIT_LAMBDA */
struct
{
@ -392,7 +392,7 @@ struct hcl_compiler_t
hcl_ioimpl_t reader;
/* static input data buffer */
hcl_ioinarg_t inarg;
hcl_ioinarg_t inarg;
/* pointer to the current input data. initially, it points to &inarg */
hcl_ioinarg_t* curinp;
@ -481,7 +481,7 @@ struct hcl_compiler_t
SHORT INSTRUCTION CODE LONG INSTRUCTION CODE
----------------------------------------------------------------------------------------------------------------
v v
0-3 0000 00XX STORE_INTO_INSTVAR 128 1000 0000 XXXXXXXX STORE_INTO_INSTVAR_X (bit 4 off, bit 3 off)
0-3 0000 00XX STORE_INTO_INSTVAR 128 1000 0000 XXXXXXXX STORE_INTO_INSTVAR_X (bit 4 off, bit 3 off)
4-7 0000 01XX STORE_INTO_INSTVAR
8-11 0000 10XX POP_INTO_INSTVAR 136 1000 1000 XXXXXXXX POP_INTO_INSTVAR_X (bit 4 off, bit 3 on)
12-15 0000 11XX POP_INTO_INSTVAR
@ -773,7 +773,7 @@ enum hcl_bcode_t
HCL_CODE_MAKE_ARRAY = 0xE9, /* 233 ## */
HCL_CODE_MAKE_BYTEARRAY = 0xEA, /* 234 ## */
HCL_CODE_MAKE_DIC = 0xEB, /* 235 ## */
HCL_CODE_POP_INTO_OBJVAR_X = 0xEC, /* 236 ## */
HCL_CODE_POP_INTO_ARRAY = 0xED, /* 237 ## */
@ -814,7 +814,7 @@ typedef hcl_ooi_t (*hcl_outbfmt_t) (
...
);
/* i don't want an error raised inside the callback to override
/* i don't want an error raised inside the callback to override
* the existing error number and message. */
#define vmprim_log_write(hcl,mask,ptr,len) do { \
int shuterr = (hcl)->shuterr; \
@ -837,7 +837,7 @@ extern "C" {
* \return heap pointer on success and #HCL_NULL on failure.
*/
hcl_heap_t* hcl_makeheap (
hcl_t* hcl,
hcl_t* hcl,
hcl_oow_t size
);
@ -845,11 +845,11 @@ hcl_heap_t* hcl_makeheap (
* The hcl_killheap() function destroys the heap pointed to by \a heap.
*/
void hcl_killheap (
hcl_t* hcl,
hcl_t* hcl,
hcl_heap_t* heap
);
/**
/**
* The hcl_allocheapmem() function allocates \a size bytes from the given heap
* and clears it with zeros.
*/
@ -1019,7 +1019,7 @@ int hcl_ucstoutf8 (
* For a null-terminated string, you can specify ~(hcl_oow_t)0 in
* \a bcslen. The destination buffer \a ucs also must be large enough to
* store a terminating null. Otherwise, -2 is returned.
*
*
* The resulting \a ucslen can still be greater than 0 even if the return
* value is negative. The value indiates the number of characters converted
* before the error has occurred.
@ -1175,7 +1175,7 @@ hcl_oop_t hcl_strtoint (
/**
* The hcl_inttostr() function converts an integer object to a string object
* printed in the given radix. If HCL_INTTOSTR_NONEWOBJ is set in flags_radix,
* it returns hcl->_nil but keeps the result in the buffer pointed to by
* it returns hcl->_nil but keeps the result in the buffer pointed to by
* hcl->inttostr.xbuf.ptr with the length stored in hcl->inttostr.xbuf.len.
* If the function fails, it returns #HCL_NULL.
*/
@ -1347,7 +1347,6 @@ hcl_cnode_t* hcl_makecnodecons (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_cnode_t*
hcl_cnode_t* hcl_makecnodeelist (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_concode_t type);
hcl_cnode_t* hcl_makecnodeshell (hcl_t* hcl, const hcl_ioloc_t* loc, hcl_cnode_t* obj);
void hcl_freesinglecnode (hcl_t* hcl, hcl_cnode_t* c);
void hcl_freecnode (hcl_t* hcl, hcl_cnode_t* c);
hcl_oow_t hcl_countcnodecons (hcl_t* hcl, hcl_cnode_t* cons);

152
lib/hcl.h
View File

@ -51,25 +51,25 @@ enum hcl_errnum_t
HCL_ENOIMPL, /**< not implemented */
HCL_ESYSERR, /**< subsystem error */
HCL_EINTERN, /**< internal error */
HCL_ESYSMEM, /**< insufficient system memory */
HCL_EOOMEM, /**< insufficient object memory */
HCL_ETYPE, /**< invalid class/type */
HCL_EINVAL, /**< invalid parameter or data */
HCL_ENOENT, /**< data not found */
HCL_EEXIST, /**< existing/duplicate data */
HCL_EBUSY,
HCL_EBUSY,
HCL_EACCES,
HCL_EPERM,
HCL_ENOTDIR,
HCL_EINTR,
HCL_EPIPE,
HCL_EAGAIN,
HCL_EBADHND,
HCL_EFRMFLOOD, /**< too many frames */
HCL_EMSGRCV, /**< mesasge receiver error */
HCL_EMSGSND, /**< message sending error. even doesNotUnderstand: is not found */
HCL_ENUMARGS, /**< wrong number of arguments */
@ -192,7 +192,7 @@ enum hcl_trait_t
HCL_TRAIT_INTERACTIVE = (1u << 7),
/* perform no garbage collection when the heap is full.
/* perform no garbage collection when the heap is full.
* you still can use hcl_gc() explicitly. */
HCL_TRAIT_NOGC = (1u << 8),
@ -239,7 +239,7 @@ typedef struct hcl_obj_word_t* hcl_oop_word_t;
# define HCL_SIZEOF_LIW_T HCL_SIZEOF_OOW_T
# define HCL_SIZEOF_LIDW_T HCL_SIZEOF_UINTMAX_T
# define HCL_LIW_BITS HCL_OOW_BITS
# define HCL_LIDW_BITS (HCL_SIZEOF_UINTMAX_T * HCL_BITS_PER_BYTE)
# define HCL_LIDW_BITS (HCL_SIZEOF_UINTMAX_T * HCL_BITS_PER_BYTE)
typedef hcl_oop_word_t hcl_oop_liword_t;
# define HCL_OBJ_TYPE_LIWORD HCL_OBJ_TYPE_WORD
@ -287,7 +287,7 @@ enum hcl_obj_type_t
*/
/* NOTE: you can have HCL_OBJ_SHORT, HCL_OBJ_INT
* HCL_OBJ_LONG, HCL_OBJ_FLOAT, HCL_OBJ_DOUBLE, etc
* HCL_OBJ_LONG, HCL_OBJ_FLOAT, HCL_OBJ_DOUBLE, etc
* type type field being 6 bits long, you can have up to 64 different types.
HCL_OBJ_TYPE_SHORT,
@ -299,20 +299,20 @@ enum hcl_obj_type_t
typedef enum hcl_obj_type_t hcl_obj_type_t;
/* =========================================================================
* Object header structure
*
* Object header structure
*
* _flags:
* type: the type of a payload item.
* one of HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_CHAR,
* type: the type of a payload item.
* one of HCL_OBJ_TYPE_OOP, HCL_OBJ_TYPE_CHAR,
* HCL_OBJ_TYPE_BYTE, HCL_OBJ_TYPE_HALFWORD, HCL_OBJ_TYPE_WORD
* unit: the size of a payload item in bytes.
* unit: the size of a payload item in bytes.
* extra: 0 or 1. 1 indicates that the payload contains 1 more
* item than the value of the size field. used for a
* item than the value of the size field. used for a
* terminating null in a variable-char object. internel
* use only.
* kernel: 0 - ordinary object.
* 1 - kernel object. can survive hcl_reset().
* 2 - kernel object. can survive hcl_reset().
* 2 - kernel object. can survive hcl_reset().
* a symbol object with 2 in the kernel bits cannot be assigned a
* value with the 'set' special form.
* moved: 0 or 1. used by GC. internal use only.
@ -322,27 +322,27 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
*
* _size: the number of payload items in an object.
* it doesn't include the header size.
*
*
* The total number of bytes occupied by an object can be calculated
* with this fomula:
* sizeof(hcl_obj_t) + ALIGN((size + extra) * unit), sizeof(hcl_oop_t))
*
* If the type is known to be not HCL_OBJ_TYPE_CHAR, you can assume that
*
* If the type is known to be not HCL_OBJ_TYPE_CHAR, you can assume that
* 'extra' is 0. So you can simplify the fomula in such a context.
* sizeof(hcl_obj_t) + ALIGN(size * unit), sizeof(hcl_oop_t))
*
* The ALIGN() macro is used above since allocation adjusts the payload
* size to a multiple of sizeof(hcl_oop_t). it assumes that sizeof(hcl_obj_t)
* is a multiple of sizeof(hcl_oop_t). See the HCL_BYTESOF() macro.
*
*
* Due to the header structure, an object can only contain items of
* homogeneous data types in the payload.
* homogeneous data types in the payload.
*
* It's actually possible to split the size field into 2. For example,
* the upper half contains the number of oops and the lower half contains
* the number of bytes/chars. This way, a variable-byte class or a variable-char
* class can have normal instance variables. On the contrary, the actual byte
* size calculation and the access to the payload fields become more complex.
* size calculation and the access to the payload fields become more complex.
* Therefore, i've dropped the idea.
* ========================================================================= */
#define HCL_OBJ_FLAGS_TYPE_BITS 6
@ -403,7 +403,7 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
/* [NOTE] this macro doesn't check the range of the actual value.
* make sure that the value of each bit fields given falls within the
* make sure that the value of each bit fields given falls within the
* possible range of the defined bits */
#define HCL_OBJ_MAKE_FLAGS(t,u,e,k,m,g,r,b) ( \
(((hcl_oow_t)(t)) << HCL_OBJ_FLAGS_TYPE_SHIFT) | \
@ -548,7 +548,7 @@ struct hcl_fpdec_t
typedef struct hcl_function_t hcl_function_t;
typedef struct hcl_function_t* hcl_oop_function_t;
#define HCL_BLOCK_NAMED_INSTVARS 4
#define HCL_BLOCK_NAMED_INSTVARS 4
typedef struct hcl_block_t hcl_block_t;
typedef struct hcl_block_t* hcl_oop_block_t;
@ -573,7 +573,7 @@ struct hcl_function_t
};
/* hcl_function_t copies the byte codes and literal frames into itself
* hlc_block_t contains minimal information(ip) for referening byte codes
* hlc_block_t contains minimal information(ip) for referening byte codes
* and literal frames available in home->origin.
*/
struct hcl_block_t
@ -590,7 +590,7 @@ struct hcl_context_t
HCL_OBJ_HEADER;
/* SmallInteger, context flags */
hcl_oop_t flags;
hcl_oop_t flags;
/* it points to the active context at the moment when
* this context object has been activated. a new method context
@ -614,16 +614,16 @@ struct hcl_context_t
hcl_oop_t receiver_or_base; /* when used as a base, it's either a block or a function */
/* it is set to nil for a method context.
* for a block context, it points to the active context at the
* moment the block context was created. that is, it points to
* a method context where the base block has been defined.
* for a block context, it points to the active context at the
* moment the block context was created. that is, it points to
* a method context where the base block has been defined.
* an activated block context copies this field from the base block context. */
hcl_oop_context_t home; /* context or nil */
/* a function context is created with itself in this field. The function
* context creation is based on a function object(initial or lambda/defun).
*
* a block context is created over a block object. it stores
* a block context is created over a block object. it stores
* a function context points to itself in this field. a block context
* points to the function context where it is created. another block context
* created within the block context also points to the same function context.
@ -631,11 +631,11 @@ struct hcl_context_t
* take note of the following points:
* ctx->origin: function context
* ctx->origin->receiver_or_base: actual function containing byte codes pertaining to ctx.
*
*
* a base of a block context is a block object but ctx->origin is guaranteed to be
* a function context. so its base is also a function object all the time.
*/
hcl_oop_context_t origin;
hcl_oop_context_t origin;
/* variable indexed part */
hcl_oop_t slot[1]; /* stack */
@ -719,13 +719,13 @@ struct hcl_semaphore_t
hcl_oop_t count; /* SmallInteger */
/* nil for normal. SmallInteger if associated with
/* nil for normal. SmallInteger if associated with
* timer(HCL_SEMAPHORE_SUBTYPE_TIMED) or IO(HCL_SEMAPHORE_SUBTYPE_IO). */
hcl_oop_t subtype;
hcl_oop_t subtype;
union
{
struct
struct
{
hcl_oop_t index; /* index to the heap that stores timed semaphores */
hcl_oop_t ftime_sec; /* firing time */
@ -762,7 +762,7 @@ struct hcl_semaphore_group_t
struct
{
hcl_oop_process_t first;
hcl_oop_process_t last;
hcl_oop_process_t last;
} waiting; /* list of processes waiting on this semaphore group */
/* [END IMPORTANT] */
@ -810,7 +810,7 @@ struct hcl_process_scheduler_t
/**
* The HCL_BYTESOF() macro returns the size of the payload of
* an object in bytes. If the pointer given encodes a numeric value,
* an object in bytes. If the pointer given encodes a numeric value,
* it returns the size of #hcl_oow_t in bytes.
*/
#define HCL_BYTESOF(hcl,oop) \
@ -1039,7 +1039,7 @@ struct hcl_vmprim_t
/* If you customize the heap allocator by providing the alloc_heap
* callback, you should implement the heap freer. otherwise the default
* implementation doesn't know how to free the heap allocated by
* implementation doesn't know how to free the heap allocated by
* the allocator callback. */
hcl_free_heap_t free_heap; /* optional */
@ -1096,15 +1096,15 @@ typedef struct hcl_iolxc_t hcl_iolxc_t;
typedef struct hcl_ioinarg_t hcl_ioinarg_t;
struct hcl_ioinarg_t
{
/**
/**
* [IN] I/O object name.
* It is #HCL_NULL for the main stream and points to a non-NULL string
* for an included stream.
*/
const hcl_ooch_t* name;
const hcl_ooch_t* name;
/**
* [OUT] I/O handle set by a handler.
/**
* [OUT] I/O handle set by a handler.
* The source stream handler can set this field when it opens a stream.
* All subsequent operations on the stream see this field as set
* during opening.
@ -1147,8 +1147,8 @@ struct hcl_ioinarg_t
typedef struct hcl_iooutarg_t hcl_iooutarg_t;
struct hcl_iooutarg_t
{
/**
* [OUT] I/O handle set by a handler.
/**
* [OUT] I/O handle set by a handler.
* The source stream handler can set this field when it opens a stream.
* All subsequent operations on the stream see this field as set
* during opening.
@ -1164,7 +1164,7 @@ struct hcl_iooutarg_t
/**
* [IN] total number of characters to write
*/
hcl_oow_t len;
hcl_oow_t len;
/**
* [OUT] place the number of characters written here for HCL_IO_WRITE
@ -1172,14 +1172,14 @@ struct hcl_iooutarg_t
hcl_oow_t xlen;
};
/**
/**
* The hcl_ioimpl_t type defines a callback function prototype
* for I/O operations.
*/
typedef int (*hcl_ioimpl_t) (
hcl_t* hcl,
hcl_iocmd_t cmd,
void* arg /* hcl_ioinarg_t* or hcl_iooutarg_t* */
void* arg /* hcl_ioinarg_t* or hcl_iooutarg_t* */
);
/* =========================================================================
@ -1290,7 +1290,7 @@ struct hcl_mod_t
void* ctx;
};
struct hcl_mod_data_t
struct hcl_mod_data_t
{
void* handle;
hcl_rbt_pair_t* pair; /* internal backreference to hcl->modtab */
@ -1370,7 +1370,7 @@ struct hcl_t
#endif
hcl_oow_t dfl_symtab_size;
hcl_oow_t dfl_sysdic_size;
hcl_oow_t dfl_procstk_size;
hcl_oow_t dfl_procstk_size;
void* mod_inctx;
#if defined(HCL_BUILD_DEBUG)
@ -1433,7 +1433,7 @@ struct hcl_t
hcl_oow_t sem_list_count;
hcl_oow_t sem_list_capa;
/* semaphores sorted according to time-out.
/* semaphores sorted according to time-out.
* organize entries using heap as the earliest entry
* needs to be checked first */
hcl_oop_semaphore_t* sem_heap;
@ -1614,7 +1614,7 @@ struct hcl_t
#define HCL_STACK_GETRCV(hcl,nargs) HCL_STACK_GET(hcl, (hcl)->sp - nargs)
/* you can't access arguments and receiver after this macro.
/* you can't access arguments and receiver after this macro.
* also you must not call this macro more than once */
#define HCL_STACK_SETRET(hcl,nargs,retv) \
@ -1812,7 +1812,7 @@ static HCL_INLINE hcl_errnum_t hcl_geterrnum (hcl_t* hcl) { return hcl->errnum;
#endif
HCL_EXPORT void hcl_seterrnum (
hcl_t* hcl,
hcl_t* hcl,
hcl_errnum_t errnum
);
@ -1823,16 +1823,16 @@ HCL_EXPORT void hcl_seterrwithsyserr (
);
void hcl_seterrbfmtwithsyserr (
hcl_t* hcl,
int syserr_type,
hcl_t* hcl,
int syserr_type,
int syserr_code,
const hcl_bch_t* fmt,
...
);
void hcl_seterrufmtwithsyserr (
hcl_t* hcl,
int syserr_type,
hcl_t* hcl,
int syserr_type,
int syserr_code,
const hcl_uch_t* fmt,
...
@ -1895,7 +1895,7 @@ HCL_EXPORT int hcl_getoption (
);
/**
* The hcl_setoption() function sets the value of an option
* The hcl_setoption() function sets the value of an option
* specified by \a id to the value pointed to by \a value.
*
* \return 0 on success, -1 on failure
@ -1992,6 +1992,10 @@ HCL_EXPORT hcl_cnode_t* hcl_read (
hcl_t* hcl
);
HCL_EXPORT void hcl_freecnode (
hcl_t* hcl,
hcl_cnode_t* cnode
);
HCL_EXPORT int hcl_print (
hcl_t* hcl,
@ -2018,9 +2022,9 @@ HCL_EXPORT int hcl_compile (
);
/**
* The hcl_decode() function decodes instructions from the position
* The hcl_decode() function decodes instructions from the position
* \a start to the position \a end - 1, and prints the decoded instructions
* in the textual form.
* in the textual form.
*/
HCL_EXPORT int hcl_decode (
hcl_t* hcl,
@ -2039,14 +2043,14 @@ HCL_EXPORT int hcl_decode (
#endif
/* if you should read charcters from the input stream before hcl_read(),
/* if you should read charcters from the input stream before hcl_read(),
* you can call hcl_readchar() */
HCL_EXPORT hcl_iolxc_t* hcl_readchar (
hcl_t* hcl
);
/* If you use hcl_readchar() to read the input stream, you may use
* hcl_unreadchar() to put back characters read for hcl_readchar()
/* If you use hcl_readchar() to read the input stream, you may use
* hcl_unreadchar() to put back characters read for hcl_readchar()
* to return before reading the stream again. */
HCL_EXPORT int hcl_unreadchar (
hcl_t* hcl,
@ -2265,12 +2269,12 @@ HCL_EXPORT hcl_oop_t hcl_makefpdec (
);
HCL_EXPORT hcl_oop_t hcl_makedic (
hcl_t* hcl,
hcl_t* hcl,
hcl_oow_t inisize /* initial bucket size */
);
HCL_EXPORT hcl_oop_t hcl_makeprocess (
hcl_t* hcl,
hcl_t* hcl,
hcl_oow_t stksize
);
@ -2318,19 +2322,12 @@ HCL_EXPORT hcl_oop_t hcl_makeprim (
HCL_EXPORT hcl_oop_t hcl_makebigint (
hcl_t* hcl,
hcl_t* hcl,
int brand,
const hcl_liw_t* ptr,
hcl_oow_t len
);
#if (HCL_SIZEOF_UINTMAX_T == HCL_SIZEOF_OOW_T)
# define hcl_inttouintmax hcl_inttooow
# define hcl_inttointmax hcl_inttoooi
# define hcl_uintmaxtoint hcl_oowtoint
# define hcl_intmaxtoint hcl_ooitoint
#else
HCL_EXPORT hcl_oop_t hcl_oowtoint (
hcl_t* hcl,
hcl_oow_t w
@ -2353,6 +2350,13 @@ HCL_EXPORT int hcl_inttoooi (
hcl_ooi_t* i
);
#if (HCL_SIZEOF_UINTMAX_T == HCL_SIZEOF_OOW_T)
# define hcl_inttouintmax hcl_inttooow
# define hcl_inttointmax hcl_inttoooi
# define hcl_uintmaxtoint hcl_oowtoint
# define hcl_intmaxtoint hcl_ooitoint
#else
HCL_EXPORT hcl_oop_t hcl_intmaxtoint (
hcl_t* hcl,
hcl_intmax_t i
@ -2458,8 +2462,8 @@ HCL_EXPORT int hcl_walkdic (
* ========================================================================= */
HCL_EXPORT int hcl_hashobj (
hcl_t* hcl,
hcl_oop_t obj,
hcl_t* hcl,
hcl_oop_t obj,
hcl_oow_t* xhv
);
@ -2504,7 +2508,7 @@ HCL_EXPORT int hcl_convutobchars (
/**
* The hcl_convbtoucstr() function converts a null-terminated byte string
* The hcl_convbtoucstr() function converts a null-terminated byte string
* to a wide string.
*/
HCL_EXPORT int hcl_convbtoucstr (

198
lib/std.c
View File

@ -248,8 +248,8 @@
#else
# define MUTEX_INIT(x)
# define MUTEX_DESTROY(x)
# define MUTEX_LOCK(x)
# define MUTEX_UNLOCK(x)
# define MUTEX_LOCK(x)
# define MUTEX_UNLOCK(x)
#endif
@ -283,6 +283,7 @@ struct xtn_t
DWORD tc_overflow;
#elif defined(__OS2__)
ULONG tc_last;
ULONG tc_overflow;
hcl_ntime_t tc_last_ret;
#elif defined(__DOS__)
clock_t tc_last;
@ -328,8 +329,8 @@ struct xtn_t
hcl_oow_t* ptr;
hcl_oow_t capa;
} reg;
struct kevent buf[64];
#elif defined(USE_EPOLL)
struct kevent buf[64];
#elif defined(USE_EPOLL)
/*TODO: make it dynamically changeable depending on the number of
* file descriptors added */
struct epoll_event buf[64]; /* buffer for reading events */
@ -374,7 +375,7 @@ struct xtn_t
#define GET_XTN(hcl) ((xtn_t*)((hcl_uint8_t*)hcl_getxtn(hcl) - HCL_SIZEOF(xtn_t)))
/* -----------------------------------------------------------------
/* -----------------------------------------------------------------
* BASIC MEMORY MANAGER
* ----------------------------------------------------------------- */
@ -401,7 +402,7 @@ static hcl_mmgr_t sys_mmgr =
HCL_NULL
};
/* -----------------------------------------------------------------
/* -----------------------------------------------------------------
* LOGGING SUPPORT
* ----------------------------------------------------------------- */
@ -536,7 +537,7 @@ static void log_write (hcl_t* hcl, hcl_bitmask_t mask, const hcl_ooch_t* msg, hc
#if defined(_WIN32)
tmp = localtime(&now);
tslen = strftime(ts, sizeof(ts), "%Y-%m-%d %H:%M:%S %z ", tmp);
if (tslen == 0)
if (tslen == 0)
{
tslen = sprintf(ts, "%04d-%02d-%02d %02d:%02d:%02d ", tmp->tm_year + 1900, tmp->tm_mon + 1, tmp->tm_mday, tmp->tm_hour, tmp->tm_min, tmp->tm_sec);
}
@ -553,7 +554,7 @@ static void log_write (hcl_t* hcl, hcl_bitmask_t mask, const hcl_ooch_t* msg, hc
#else
tslen = strftime(ts, sizeof(ts), "%Y-%m-%d %H:%M:%S %z ", tmp);
#endif
if (tslen == 0)
if (tslen == 0)
{
tslen = sprintf(ts, "%04d-%02d-%02d %02d:%02d:%02d ", tmp->tm_year + 1900, tmp->tm_mon + 1, tmp->tm_mday, tmp->tm_hour, tmp->tm_min, tmp->tm_sec);
}
@ -572,9 +573,9 @@ static void log_write (hcl_t* hcl, hcl_bitmask_t mask, const hcl_ooch_t* msg, hc
#if defined(HAVE_STRFTIME_SMALL_Z)
tslen = strftime(ts, sizeof(ts), "%Y-%m-%d %H:%M:%S %z ", tmp);
#else
tslen = strftime(ts, sizeof(ts), "%Y-%m-%d %H:%M:%S %Z ", tmp);
tslen = strftime(ts, sizeof(ts), "%Y-%m-%d %H:%M:%S %Z ", tmp);
#endif
if (tslen == 0)
if (tslen == 0)
{
tslen = sprintf(ts, "%04d-%02d-%02d %02d:%02d:%02d ", tmp->tm_year + 1900, tmp->tm_mon + 1, tmp->tm_mday, tmp->tm_hour, tmp->tm_min, tmp->tm_sec);
}
@ -599,9 +600,9 @@ static void log_write (hcl_t* hcl, hcl_bitmask_t mask, const hcl_ooch_t* msg, hc
n = hcl_convootobchars(hcl, &msg[msgidx], &ucslen, buf, &bcslen);
if (n == 0 || n == -2)
{
/* n = 0:
* converted all successfully
* n == -2:
/* n = 0:
* converted all successfully
* n == -2:
* buffer not sufficient. not all got converted yet.
* write what have been converted this round. */
@ -635,7 +636,7 @@ static void log_write (hcl_t* hcl, hcl_bitmask_t mask, const hcl_ooch_t* msg, hc
flush_log (hcl, logfd);
}
/* -----------------------------------------------------------------
/* -----------------------------------------------------------------
* SYSTEM ERROR CONVERSION
* ----------------------------------------------------------------- */
static hcl_errnum_t errno_to_errnum (int errcode)
@ -668,7 +669,7 @@ static hcl_errnum_t errno_to_errnum (int errcode)
#endif
#if defined(EAGAIN) && defined(EWOULDBLOCK) && (EAGAIN != EWOULDBLOCK)
case EAGAIN:
case EAGAIN:
case EWOULDBLOCK: return HCL_EAGAIN;
#elif defined(EAGAIN)
case EAGAIN: return HCL_EAGAIN;
@ -734,14 +735,14 @@ static hcl_errnum_t os2err_to_errnum (APIRET errcode)
case ERROR_NOT_ENOUGH_MEMORY:
return HCL_ESYSMEM;
case ERROR_INVALID_PARAMETER:
case ERROR_INVALID_PARAMETER:
case ERROR_INVALID_NAME:
return HCL_EINVAL;
case ERROR_INVALID_HANDLE:
case ERROR_INVALID_HANDLE:
return HCL_EBADHND;
case ERROR_ACCESS_DENIED:
case ERROR_ACCESS_DENIED:
case ERROR_SHARING_VIOLATION:
return HCL_EACCES;
@ -778,7 +779,7 @@ static hcl_errnum_t macerr_to_errnum (int errcode)
return HCL_ENOENT;
/*TODO: add more mappings */
default:
default:
return HCL_ESYSERR;
}
}
@ -788,14 +789,14 @@ static hcl_errnum_t _syserrstrb (hcl_t* hcl, int syserr_type, int syserr_code, h
{
switch (syserr_type)
{
case 1:
case 1:
#if defined(_WIN32)
if (buf)
{
DWORD rc;
rc = FormatMessageA (
FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
NULL, syserr_code, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
NULL, syserr_code, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
buf, len, HCL_NULL
);
while (rc > 0 && buf[rc - 1] == '\r' || buf[rc - 1] == '\n') buf[--rc] = '\0';
@ -829,7 +830,7 @@ static hcl_errnum_t _syserrstrb (hcl_t* hcl, int syserr_type, int syserr_code, h
}
/* --------------------------------------------------------------------------
/* --------------------------------------------------------------------------
* ASSERTION SUPPORT
* -------------------------------------------------------------------------- */
@ -842,7 +843,7 @@ static void _assertfail (hcl_t* hcl, const hcl_bch_t* expr, const hcl_bch_t* fil
#else /* defined(HCL_BUILD_RELEASE) */
/* --------------------------------------------------------------------------
/* --------------------------------------------------------------------------
* SYSTEM DEPENDENT HEADERS
* -------------------------------------------------------------------------- */
@ -890,7 +891,7 @@ static void backtrace_stack_frames (hcl_t* hcl)
unw_init_local(&cursor, &context);
hcl_logbfmt (hcl, HCL_LOG_UNTYPED | HCL_LOG_DEBUG, "[BACKTRACE]\n");
for (n = 0; unw_step(&cursor) > 0; n++)
for (n = 0; unw_step(&cursor) > 0; n++)
{
unw_word_t ip, sp, off;
char symbol[256];
@ -898,13 +899,13 @@ static void backtrace_stack_frames (hcl_t* hcl)
unw_get_reg (&cursor, UNW_REG_IP, &ip);
unw_get_reg (&cursor, UNW_REG_SP, &sp);
if (unw_get_proc_name(&cursor, symbol, HCL_COUNTOF(symbol), &off))
if (unw_get_proc_name(&cursor, symbol, HCL_COUNTOF(symbol), &off))
{
hcl_copy_bcstr (symbol, HCL_COUNTOF(symbol), "<unknown>");
}
hcl_logbfmt (hcl, HCL_LOG_UNTYPED | HCL_LOG_DEBUG,
"#%02d ip=0x%*p sp=0x%*p %hs+0x%zu\n",
hcl_logbfmt (hcl, HCL_LOG_UNTYPED | HCL_LOG_DEBUG,
"#%02d ip=0x%*p sp=0x%*p %hs+0x%zu\n",
n, HCL_SIZEOF(void*) * 2, (void*)ip, HCL_SIZEOF(void*) * 2, (void*)sp, symbol, (hcl_oow_t)off);
}
}
@ -972,7 +973,7 @@ static void _assertfail (hcl_t* hcl, const hcl_bch_t* expr, const hcl_bch_t* fil
#endif /* defined(HCL_BUILD_RELEASE) */
/* -----------------------------------------------------------------
/* -----------------------------------------------------------------
* HEAP ALLOCATION
* ----------------------------------------------------------------- */
@ -980,7 +981,7 @@ static int get_huge_page_size (hcl_t* hcl, hcl_oow_t* page_size)
{
FILE* fp;
char buf[256];
fp = fopen("/proc/meminfo", "r");
if (!fp) return -1;
@ -1047,20 +1048,20 @@ static void* alloc_heap (hcl_t* hcl, hcl_oow_t* size)
aligned_size = HCL_ALIGN_POW2(req_size, align);
ptr = (hcl_oow_t*)mmap(NULL, aligned_size, PROT_READ | PROT_WRITE, flags, -1, 0);
#if defined(MAP_HUGETLB)
if (ptr == MAP_FAILED && (flags & MAP_HUGETLB))
if (ptr == MAP_FAILED && (flags & MAP_HUGETLB))
{
flags &= ~MAP_HUGETLB;
align = sysconf(_SC_PAGESIZE);
aligned_size = HCL_ALIGN_POW2(req_size, align);
ptr = (hcl_oow_t*)mmap(NULL, aligned_size, PROT_READ | PROT_WRITE, flags, -1, 0);
if (ptr == MAP_FAILED)
if (ptr == MAP_FAILED)
{
hcl_seterrwithsyserr (hcl, 0, errno);
return HCL_NULL;
}
}
#else
if (ptr == MAP_FAILED)
if (ptr == MAP_FAILED)
{
hcl_seterrwithsyserr (hcl, 0, errno);
return HCL_NULL;
@ -1088,7 +1089,7 @@ static void free_heap (hcl_t* hcl, void* ptr)
#endif
}
/* -----------------------------------------------------------------
/* -----------------------------------------------------------------
* POSSIBLY MONOTONIC TIME
* ----------------------------------------------------------------- */
@ -1122,9 +1123,11 @@ void vm_gettime (hcl_t* hcl, hcl_ntime_t* now)
#elif defined(__OS2__)
xtn_t* xtn = GET_XTN(hcl);
hcl_uint64_t bigsec, bigmsec;
ULONG msec;
#if (HCL_SIZEOF_UINT64_T > 0)
hcl_uint64_t bigsec, bigmsec;
/* TODO: use DosTmrQueryTime() and DosTmrQueryFreq()? */
DosQuerySysInfo (QSV_MS_COUNT, QSV_MS_COUNT, &msec, HCL_SIZEOF(msec)); /* milliseconds */
/* it must return NO_ERROR */
@ -1139,6 +1142,32 @@ void vm_gettime (hcl_t* hcl, hcl_ntime_t* now)
bigsec = HCL_MSEC_TO_SEC(bigmsec);
bigmsec -= HCL_SEC_TO_MSEC(bigsec);
HCL_INIT_NTIME (now, bigsec, HCL_MSEC_TO_NSEC(bigmsec));
#else
hcl_uint32_t bigsec, bigmsec;
DosQuerySysInfo (QSV_MS_COUNT, QSV_MS_COUNT, &msec, HCL_SIZEOF(msec));
bigsec = HCL_MSEC_TO_SEC(msec);
bigmsec = msec - HCL_SEC_TO_MSEC(bigsec);
if (msec < xtn->tc_last)
{
ULONG i;
hcl_uint32_t inc;
xtn->tc_overflow++;
inc = HCL_MSEC_TO_SEC(HCL_TYPE_MAX(hcl_uint32_t));
for (i = 0; i < xtn->tc_overflow; i++)
{
ULONG max = HCL_TYPE_MAX(hcl_uint32_t) - bigsec;
if (max > inc)
{
bigsec = HCL_TYPE_MAX(hcl_uint32_t);
break;
}
bigsec += inc;
}
}
HCL_INIT_NTIME (now, bigsec, HCL_MSEC_TO_NSEC(bigmsec));
#endif
#elif defined(__DOS__) && (defined(_INTELC32_) || defined(__WATCOMC__))
clock_t c;
@ -1235,7 +1264,7 @@ static int _add_poll_fd (hcl_t* hcl, int fd, int event_mask)
xtn->ev.reg.capa = newcapa;
}
if (event_mask & XPOLLIN)
if (event_mask & XPOLLIN)
{
/*EV_SET (&ev, fd, EVFILT_READ, EV_ADD | EV_CLEAR, 0, 0, 0);*/
HCL_MEMSET (&ev, 0, HCL_SIZEOF(ev));
@ -1347,12 +1376,12 @@ static int _add_poll_fd (hcl_t* hcl, int fd, int event_mask)
xtn_t* xtn = GET_XTN(hcl);
MUTEX_LOCK (&xtn->ev.reg.smtx);
if (event_mask & XPOLLIN)
if (event_mask & XPOLLIN)
{
FD_SET (fd, &xtn->ev.reg.rfds);
if (fd > xtn->ev.reg.maxfd) xtn->ev.reg.maxfd = fd;
}
if (event_mask & XPOLLOUT)
if (event_mask & XPOLLOUT)
{
FD_SET (fd, &xtn->ev.reg.wfds);
if (fd > xtn->ev.reg.maxfd) xtn->ev.reg.maxfd = fd;
@ -1505,7 +1534,7 @@ static int _mod_poll_fd (hcl_t* hcl, int fd, int event_mask)
if (_del_poll_fd (hcl, fd) <= -1) return -1;
if (_add_poll_fd (hcl, fd, event_mask) <= -1)
if (_add_poll_fd (hcl, fd, event_mask) <= -1)
{
/* TODO: any good way to rollback successful deletion? */
return -1;
@ -1658,12 +1687,12 @@ kqueue_syserr:
MUTEX_LOCK (&xtn->ev.reg.smtx);
HCL_ASSERT (hcl, fd <= xtn->ev.reg.maxfd);
if (event_mask & XPOLLIN)
if (event_mask & XPOLLIN)
FD_SET (fd, &xtn->ev.reg.rfds);
else
else
FD_CLR (fd, &xtn->ev.reg.rfds);
if (event_mask & XPOLLOUT)
if (event_mask & XPOLLOUT)
FD_SET (fd, &xtn->ev.reg.wfds);
else
FD_CLR (fd, &xtn->ev.reg.wfds);
@ -1683,7 +1712,7 @@ static int vm_muxadd (hcl_t* hcl, hcl_ooi_t io_handle, hcl_ooi_t mask)
int event_mask;
event_mask = 0;
if (mask & HCL_SEMAPHORE_IO_MASK_INPUT) event_mask |= XPOLLIN;
if (mask & HCL_SEMAPHORE_IO_MASK_INPUT) event_mask |= XPOLLIN;
if (mask & HCL_SEMAPHORE_IO_MASK_OUTPUT) event_mask |= XPOLLOUT;
if (event_mask == 0)
@ -1701,7 +1730,7 @@ static int vm_muxmod (hcl_t* hcl, hcl_ooi_t io_handle, hcl_ooi_t mask)
int event_mask;
event_mask = 0;
if (mask & HCL_SEMAPHORE_IO_MASK_INPUT) event_mask |= XPOLLIN;
if (mask & HCL_SEMAPHORE_IO_MASK_INPUT) event_mask |= XPOLLIN;
if (mask & HCL_SEMAPHORE_IO_MASK_OUTPUT) event_mask |= XPOLLOUT;
if (event_mask == 0)
@ -1745,7 +1774,7 @@ static void* iothr_main (void* arg)
#endif
poll_for_event:
#if defined(USE_DEVPOLL)
dvp.dp_timeout = 10000; /* milliseconds */
dvp.dp_fds = xtn->ev.buf;
@ -1765,7 +1794,7 @@ static void* iothr_main (void* arg)
nfds = xtn->ev.reg.len;
MUTEX_UNLOCK (&xtn->ev.reg.pmtx);
n = poll(xtn->ev.buf, nfds, 10000);
if (n > 0)
if (n > 0)
{
/* compact the return buffer as poll() doesn't */
hcl_oow_t i, j;
@ -1868,7 +1897,7 @@ static void vm_muxwait (hcl_t* hcl, const hcl_ntime_t* dur, hcl_vmprim_muxwait_c
int n;
/* create a thread if mux wait is started at least once. */
if (!xtn->iothr.up)
if (!xtn->iothr.up)
{
xtn->iothr.up = 1;
if (pthread_create(&xtn->iothr.thr, HCL_NULL, iothr_main, hcl) != 0)
@ -1881,7 +1910,7 @@ static void vm_muxwait (hcl_t* hcl, const hcl_ntime_t* dur, hcl_vmprim_muxwait_c
if (xtn->iothr.abort) return;
if (xtn->ev.len <= 0)
if (xtn->ev.len <= 0)
{
struct timespec ts;
hcl_ntime_t ns;
@ -1937,7 +1966,7 @@ static void vm_muxwait (hcl_t* hcl, const hcl_ntime_t* dur, hcl_vmprim_muxwait_c
#endif
{
hcl_uint8_t u8;
while (read(xtn->iothr.p[0], &u8, HCL_SIZEOF(u8)) > 0)
while (read(xtn->iothr.p[0], &u8, HCL_SIZEOF(u8)) > 0)
{
/* consume as much as possible */;
if (u8 == 'Q') xtn->iothr.abort = 1;
@ -2020,11 +2049,11 @@ static void vm_muxwait (hcl_t* hcl, const hcl_ntime_t* dur, hcl_vmprim_muxwait_c
n = ioctl(xtn->ep, DP_POLL, &dvp);
#elif defined(USE_KQUEUE)
if (dur)
{
ts.tv_sec = dur->sec;
ts.tv_nsec = dur->nsec;
ts.tv_nsec = dur->nsec;
}
else
{
@ -2044,7 +2073,7 @@ static void vm_muxwait (hcl_t* hcl, const hcl_ntime_t* dur, hcl_vmprim_muxwait_c
tmout = dur? HCL_SECNSEC_TO_MSEC(dur->sec, dur->nsec): 0;
HCL_MEMCPY (xtn->ev.buf, xtn->ev.reg.ptr, xtn->ev.reg.len * HCL_SIZEOF(*xtn->ev.buf));
n = poll(xtn->ev.buf, xtn->ev.reg.len, tmout);
if (n > 0)
if (n > 0)
{
/* compact the return buffer as poll() doesn't */
hcl_oow_t i, j;
@ -2062,7 +2091,7 @@ static void vm_muxwait (hcl_t* hcl, const hcl_ntime_t* dur, hcl_vmprim_muxwait_c
if (dur)
{
tv.tv_sec = dur->sec;
tv.tv_usec = HCL_NSEC_TO_USEC(dur->nsec);
tv.tv_usec = HCL_NSEC_TO_USEC(dur->nsec);
}
else
{
@ -2157,12 +2186,12 @@ static void vm_muxwait (hcl_t* hcl, const hcl_ntime_t* dur, hcl_vmprim_muxwait_c
#endif /* USE_THREAD */
}
/* -----------------------------------------------------------------
/* -----------------------------------------------------------------
* SLEEPING
* ----------------------------------------------------------------- */
#if defined(__DOS__)
# if defined(_INTELC32_)
#if defined(__DOS__)
# if defined(_INTELC32_)
void _halt_cpu (void);
# elif defined(__WATCOMC__)
void _halt_cpu (void);
@ -2189,7 +2218,7 @@ static int vm_sleep (hcl_t* hcl, const hcl_ntime_t* dur)
}
#elif defined(__OS2__)
/* TODO: in gui mode, this is not a desirable method???
/* TODO: in gui mode, this is not a desirable method???
* this must be made event-driven coupled with the main event loop */
DosSleep (HCL_SECNSEC_TO_MSEC(dur->sec,dur->nsec));
@ -2218,7 +2247,7 @@ static int vm_sleep (hcl_t* hcl, const hcl_ntime_t* dur)
/* TODO: handle clock overvlow */
/* TODO: check if there is abortion request or interrupt */
while (c > clock())
while (c > clock())
{
_halt_cpu();
}
@ -2239,10 +2268,10 @@ static int vm_sleep (hcl_t* hcl, const hcl_ntime_t* dur)
return 0;
}
/* -----------------------------------------------------------------
/* -----------------------------------------------------------------
* SHARED LIBRARY HANDLING
* ----------------------------------------------------------------- */
#if defined(USE_LTDL)
# define sys_dl_error() lt_dlerror()
# define sys_dl_open(x) lt_dlopen(x)
@ -2282,10 +2311,10 @@ static const char* win_dlerror (void)
rc = FormatMessageA (
FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
buf, HCL_COUNTOF(buf), HCL_NULL
);
while (rc > 0 && buf[rc - 1] == '\r' || buf[rc - 1] == '\n')
while (rc > 0 && buf[rc - 1] == '\r' || buf[rc - 1] == '\n')
{
buf[--rc] = '\0';
}
@ -2302,7 +2331,7 @@ static void* mach_dlopen (const char* path)
void* handle;
mach_dlerror_str = "";
if ((rc = NSCreateObjectFileImageFromFile(path, &image)) != NSObjectFileImageSuccess)
if ((rc = NSCreateObjectFileImageFromFile(path, &image)) != NSObjectFileImageSuccess)
{
switch (rc)
{
@ -2322,7 +2351,7 @@ static void* mach_dlopen (const char* path)
case NSObjectFileImageAccess:
mach_dlerror_str = "inaccessible file";
break;
default:
mach_dlerror_str = "unknown error";
break;
@ -2388,7 +2417,7 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
#else
bufcapa = hcl_count_bcstr(name);
#endif
bufcapa += HCL_COUNTOF(HCL_DEFAULT_PFMODDIR) + HCL_COUNTOF(HCL_DEFAULT_PFMODPREFIX) + HCL_COUNTOF(HCL_DEFAULT_PFMODPOSTFIX) + 1;
bufcapa += HCL_COUNTOF(HCL_DEFAULT_PFMODDIR) + HCL_COUNTOF(HCL_DEFAULT_PFMODPREFIX) + HCL_COUNTOF(HCL_DEFAULT_PFMODPOSTFIX) + 1;
if (bufcapa <= HCL_COUNTOF(stabuf)) bufptr = stabuf;
else
@ -2403,7 +2432,7 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
/* opening a primitive function module - mostly libhcl-xxxx.
* if PFMODPREFIX is absolute, never use PFMODDIR */
dlen = HCL_IS_PATH_ABSOLUTE(HCL_DEFAULT_PFMODPREFIX)?
dlen = HCL_IS_PATH_ABSOLUTE(HCL_DEFAULT_PFMODPREFIX)?
0: hcl_copy_bcstr(bufptr, bufcapa, HCL_DEFAULT_PFMODDIR);
len = hcl_copy_bcstr(bufptr, bufcapa, HCL_DEFAULT_PFMODPREFIX);
len += dlen;
@ -2416,20 +2445,20 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
#endif
/* length including the directory, the prefix and the name. but excluding the postfix */
xlen = len + bcslen;
xlen = len + bcslen;
for (i = len; i < xlen; i++)
for (i = len; i < xlen; i++)
{
/* convert a period(.) to a dash(-) */
if (bufptr[i] == '.') bufptr[i] = '-';
}
retry:
hcl_copy_bcstr (&bufptr[xlen], bufcapa - xlen, HCL_DEFAULT_PFMODPOSTFIX);
/* both prefix and postfix attached. for instance, libhcl-xxx */
handle = sys_dl_openext(bufptr);
if (!handle)
if (!handle)
{
HCL_DEBUG3 (hcl, "Unable to open(ext) PFMOD %hs[%js] - %hs\n", &bufptr[dlen], name, sys_dl_error());
@ -2443,7 +2472,7 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
/* try without prefix and postfix */
bufptr[xlen] = '\0';
handle = sys_dl_openext(&bufptr[len]);
if (!handle)
if (!handle)
{
hcl_bch_t* dash;
const hcl_bch_t* dl_errstr;
@ -2452,9 +2481,9 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
hcl_seterrbfmt (hcl, HCL_ESYSERR, "unable to open(ext) PFMOD %js - %hs", name, dl_errstr);
dash = hcl_rfind_bchar(bufptr, hcl_count_bcstr(bufptr), '-');
if (dash)
if (dash)
{
/* remove a segment at the back.
/* remove a segment at the back.
* [NOTE] a dash contained in the original name before
* period-to-dash transformation may cause extraneous/wrong
* loading reattempts. */
@ -2462,7 +2491,7 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
goto retry;
}
}
else
else
{
HCL_DEBUG3 (hcl, "Opened(ext) PFMOD %hs[%js] handle %p\n", &bufptr[len], name, handle);
}
@ -2486,7 +2515,7 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
if (hcl_find_bchar(bufptr, bcslen, '.'))
{
handle = sys_dl_open(bufptr);
if (!handle)
if (!handle)
{
const hcl_bch_t* dl_errstr;
dl_errstr = sys_dl_error();
@ -2498,7 +2527,7 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
else
{
handle = sys_dl_openext(bufptr);
if (!handle)
if (!handle)
{
const hcl_bch_t* dl_errstr;
dl_errstr = sys_dl_error();
@ -2580,7 +2609,7 @@ static void* dl_getsym (hcl_t* hcl, void* handle, const hcl_ooch_t* name)
sym = sys_dl_getsym(handle, symname);
if (!sym)
{
bufptr[bcslen + 1] = '_';
bufptr[bcslen + 1] = '_';
bufptr[bcslen + 2] = '\0';
symname = &bufptr[1]; /* try name_ */
@ -2596,7 +2625,7 @@ static void* dl_getsym (hcl_t* hcl, void* handle, const hcl_ooch_t* name)
dl_errstr = sys_dl_error();
HCL_DEBUG3 (hcl, "Failed to get module symbol %js from handle %p - %hs\n", name, handle, dl_errstr);
hcl_seterrbfmt (hcl, HCL_ENOENT, "unable to get module symbol %hs - %hs", symname, dl_errstr);
}
}
}
@ -2614,7 +2643,7 @@ static void* dl_getsym (hcl_t* hcl, void* handle, const hcl_ooch_t* name)
#endif
}
/* -----------------------------------------------------------------
/* -----------------------------------------------------------------
* EVENT CALLBACKS
* ----------------------------------------------------------------- */
@ -2679,6 +2708,8 @@ static int open_pipes (hcl_t* hcl, int p[2])
#if defined(_WIN32)
if (_pipe(p, 256, _O_BINARY | _O_NOINHERIT) == -1)
#elif defined(__OS2__)
if (_pipe(p, 256, 10) == -1)
#elif defined(HAVE_PIPE2) && defined(O_CLOEXEC) && defined(O_NONBLOCK)
if (pipe2(p, O_CLOEXEC | O_NONBLOCK) == -1)
#else
@ -2708,6 +2739,7 @@ static int open_pipes (hcl_t* hcl, int p[2])
return 0;
}
static void close_pipes (hcl_t* hcl, int p[2])
{
#if defined(_WIN32)
@ -2733,7 +2765,7 @@ static int cb_vm_startup (hcl_t* hcl)
#if defined(USE_DEVPOLL)
xtn->ep = open("/dev/poll", O_RDWR);
if (xtn->ep == -1)
if (xtn->ep == -1)
{
hcl_seterrwithsyserr (hcl, 0, errno);
HCL_DEBUG1 (hcl, "Cannot create devpoll - %hs\n", strerror(errno));
@ -2767,11 +2799,11 @@ static int cb_vm_startup (hcl_t* hcl)
#elif defined(USE_EPOLL)
#if defined(HAVE_EPOLL_CREATE1) && defined(EPOLL_CLOEXEC)
xtn->ep = epoll_create1(EPOLL_CLOEXEC);
if (xtn->ep == -1) xtn->ep = epoll_create(1024);
if (xtn->ep == -1) xtn->ep = epoll_create(1024);
#else
xtn->ep = epoll_create(1024);
#endif
if (xtn->ep == -1)
if (xtn->ep == -1)
{
hcl_seterrwithsyserr (hcl, 0, errno);
HCL_DEBUG1 (hcl, "Cannot create epoll - %hs\n", strerror(errno));
@ -2876,7 +2908,7 @@ static void cb_vm_cleanup (hcl_t* hcl)
close_pipes (hcl, xtn->sigfd.p);
#if defined(USE_DEVPOLL)
#if defined(USE_DEVPOLL)
if (xtn->ep >= 0)
{
close (xtn->ep);
@ -2918,7 +2950,7 @@ static void cb_vm_cleanup (hcl_t* hcl)
#endif
}
/* -----------------------------------------------------------------
/* -----------------------------------------------------------------
* STANDARD HCL
* ----------------------------------------------------------------- */