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

added hcl_instantiatewithtrailer()
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-05-15 22:59:34 +09:00
parent 47e0604b03
commit c795b28cb8
21 changed files with 236 additions and 216 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
bin/hcl.c
View File

@ -656,6 +656,8 @@ static int feed_loop (hcl_t* hcl, xtn_t* xtn, int verbose)
}
}
}
hcl_logbfmt (hcl, HCL_LOG_STDOUT, "\n");
}
else
{
@ -678,7 +680,6 @@ static int feed_loop (hcl_t* hcl, xtn_t* xtn, int verbose)
}
}
hcl_logbfmt (hcl, HCL_LOG_STDOUT, "\n");
if (hcl_endfeed(hcl) <= -1)
{
feed_error:

8
lib/exec.c
View File

@ -372,7 +372,8 @@ static void vm_checkbc (hcl_t* hcl, hcl_oob_t bcode)
static HCL_INLINE hcl_oop_context_t make_context (hcl_t* hcl, hcl_ooi_t ntmprs)
{
HCL_ASSERT (hcl, ntmprs >= 0);
return (hcl_oop_context_t)hcl_allocoopobj(hcl, HCL_BRAND_CONTEXT, HCL_CONTEXT_NAMED_INSTVARS + (hcl_oow_t)ntmprs);
//return (hcl_oop_context_t)hcl_allocoopobj(hcl, HCL_BRAND_CONTEXT, HCL_CONTEXT_NAMED_INSTVARS + (hcl_oow_t)ntmprs);
return (hcl_oop_context_t)hcl_instantiatewithtrailer(hcl, hcl->c_block_context, ntmprs, HCL_NULL, 0);
}
static HCL_INLINE hcl_oop_function_t make_function (hcl_t* hcl, hcl_oow_t lfsize, const hcl_oob_t* bptr, hcl_oow_t blen, hcl_dbgi_t* dbgi)
@ -381,7 +382,8 @@ static HCL_INLINE hcl_oop_function_t make_function (hcl_t* hcl, hcl_oow_t lfsize
/* the literal frame is placed in the variable part.
* the byte code is placed in the trailer space */
func = (hcl_oop_function_t)hcl_allocoopobjwithtrailer(hcl, HCL_BRAND_FUNCTION, HCL_FUNCTION_NAMED_INSTVARS + lfsize, bptr, blen);
/*func = (hcl_oop_function_t)hcl_allocoopobjwithtrailer(hcl, HCL_BRAND_FUNCTION, HCL_FUNCTION_NAMED_INSTVARS + lfsize, bptr, blen);*/
func = (hcl_oop_function_t)hcl_instantiatewithtrailer(hcl, hcl->c_function, lfsize, bptr, blen);
if (HCL_UNLIKELY(!func)) return HCL_NULL;
if (dbgi)
@ -390,7 +392,7 @@ static HCL_INLINE hcl_oop_function_t make_function (hcl_t* hcl, hcl_oow_t lfsize
hcl_pushvolat (hcl, (hcl_oop_t*)&func);
tmp = hcl_makebytearray(hcl, (hcl_oob_t*)dbgi, HCL_SIZEOF(*dbgi) * blen);
hcl_popvolat (hcl);
if (tmp) func->dbgi = tmp;
if (HCL_LIKELY(tmp)) func->dbgi = tmp;
}
return func;

94
lib/fmt.c
View File

@ -1810,52 +1810,6 @@ hcl_ooi_t hcl_logufmt (hcl_t* hcl, hcl_bitmask_t mask, const hcl_uch_t* fmt, ...
static int print_bcs (hcl_t* hcl, hcl_fmtout_t* fmtout, const hcl_bch_t* ptr, hcl_oow_t len)
{
#if 0
#if defined(HCL_OOCH_IS_UCH)
hcl_oow_t ucslen, bcslen;
hcl_ooch_t ucsbuf[64], * ucsptr;
while (len > 0)
{
bcslen = len;
ucslen = HCL_COUNTOF(ucsbuf);
hcl_conv_bchars_to_uchars_with_cmgr(ptr, &bcslen, ucsbuf, &ucslen, HCL_CMGR(hcl), 1);
ucsptr = ucsbuf;
while (ucslen > 0)
{
hcl->io.udo_arg.ptr = ucsptr;
hcl->io.udo_arg.len = ucslen;
if (hcl->io.udo_wrtr(hcl, HCL_IO_WRITE, &hcl->io.udo_arg) <= -1) return -1;
if (hcl->io.udo_arg.xlen <= 0) return 0; /* end of stream. but not failure */
HCL_ASSERT (hcl, hcl->io.udo_arg.xlen <= len);
ucsptr += hcl->io.udo_arg.xlen;
ucslen -= hcl->io.udo_arg.xlen;
}
ptr += bcslen;
len -= bcslen;
}
#else
hcl_bch_t* optr;
optr = (hcl_bch_t*)ptr;
while (len > 0)
{
hcl->io.udo_arg.ptr = optr;
hcl->io.udo_arg.len = len;
if (hcl->io.udo_wrtr(hcl, HCL_IO_WRITE, &hcl->io.udo_arg) <= -1) return -1;
if (hcl->io.udo_arg.xlen <= 0) return 0; /* end of stream. but not failure */
HCL_ASSERT (hcl, hcl->io.udo_arg.xlen <= len);
optr += hcl->io.udo_arg.xlen;
len -= hcl->io.udo_arg.xlen;
}
#endif
#else
hcl_bch_t* optr;
if (HCL_UNLIKELY(!hcl->io.udo_wrtr))
@ -1877,7 +1831,6 @@ static int print_bcs (hcl_t* hcl, hcl_fmtout_t* fmtout, const hcl_bch_t* ptr, hc
optr += hcl->io.udo_arg.xlen;
len -= hcl->io.udo_arg.xlen;
}
#endif
return 1; /* success */
}
@ -2880,6 +2833,53 @@ int hcl_logfmtcallstack (hcl_t* hcl, hcl_ooi_t nargs)
return format_stack_args(hcl, &fo, nargs, 0);
}
/* --------------------------------------------------------------------------
* FORMATTED INPUT
* -------------------------------------------------------------------------- */
static int read_bcs (hcl_t* hcl, hcl_fmtin_t* fmtout, hcl_bch_t* buf, hcl_oow_t len)
{
if (HCL_UNLIKELY(!hcl->io.udo_wrtr))
{
hcl_seterrbmsg (hcl, HCL_EINVAL, "no user-defined output handler");
return -1;
}
return 0;
}
static int read_ucs (hcl_t* hcl, hcl_fmtin_t* fmtin, hcl_uch_t* buf, hcl_oow_t len)
{
if (HCL_UNLIKELY(!hcl->io.udo_wrtr))
{
hcl_seterrbmsg (hcl, HCL_EINVAL, "no user-defined output handler");
return -1;
}
return 0;
}
static HCL_INLINE int fmtin_stack_args (hcl_t* hcl, hcl_fmtin_t* fmtin, hcl_ooi_t nargs, int rcv_is_fmtstr)
{
/* TODO: */
return 0;
}
int hcl_scfmtcallstack (hcl_t* hcl, hcl_ooi_t nargs)
{
hcl_fmtin_t fi;
HCL_MEMSET (&fi, 0, HCL_SIZEOF(fi));
/*
* TODO:
fi.getbchars =
fi.getuchars =
*/
return fmtin_stack_args(hcl, &fi, nargs, 0);
}
/* --------------------------------------------------------------------------
* DYNAMIC STRING FORMATTING
* -------------------------------------------------------------------------- */

22
lib/gc.c
View File

@ -284,6 +284,26 @@ static kernel_class_info_t kernel_classes[] =
HCL_OFFSETOF(hcl_t, c_methsig) },
#endif
/* special function created with MAKE_FUNCTION in interactive mode
* for execution of code fed and compiled. */
{ "Function", HCL_BRAND_FUNCTION,
0,
0,
HCL_FUNCTION_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_function) },
#if 0
{ "Primitive", HCL_BRAND_PRIM,
0,
0,
HCL_PRIM_NAMED_INSTVARS,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_prim) },
#endif
{ "CompiledBlock", 0,
0,
0,
@ -300,7 +320,7 @@ static kernel_class_info_t kernel_classes[] =
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_method_context) },
{ "BlockContext", 0,
{ "BlockContext", HCL_BRAND_CONTEXT,
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_CONTEXT_NAMED_INSTVARS,

15
lib/hcl-fmt.h
View File

@ -187,6 +187,21 @@ struct hcl_fmtout_t
const void* fmt_str;
};
/* =========================================================================
* FORMATTED INPUT
* ========================================================================= */
typedef struct hcl_fmtin_t hcl_fmtin_t;
struct hcl_fmtin_t
{
#if 0
hcl_fmtin_getbchars_t getbchars; /* in */
hcl_fmtin_getuchars_t getuchars; /* in */
#endif
void* ctx; /* in */
};
#if defined(__cplusplus)
extern "C" {
#endif

2
lib/hcl-opt.h
View File

@ -25,7 +25,7 @@
#ifndef _HCL_OPT_H_
#define _HCL_OPT_H_
#include "hcl-cmn.h"
#include <hcl-cmn.h>
/** \file
* This file defines functions and data structures to process

13
lib/hcl-prv.h
View File

@ -1506,6 +1506,14 @@ hcl_oop_t hcl_instantiate (
hcl_oow_t vlen
);
hcl_oop_t hcl_instantiatewithtrailer (
hcl_t* hcl,
hcl_oop_class_t _class,
hcl_oow_t vlen,
const hcl_oob_t* trptr,
hcl_oow_t trlen
);
/* ========================================================================= */
/* sym.c */
/* ========================================================================= */
@ -1912,6 +1920,11 @@ int hcl_strfmtcallstack (
hcl_ooi_t nargs
);
int hcl_scfmtcallstack (
hcl_t* hcl,
hcl_ooi_t nargs
);
/* ========================================================================= */
/* comp.c */
/* ========================================================================= */

2
lib/hcl-rbt.h
View File

@ -25,7 +25,7 @@
#ifndef _HCL_RBT_H_
#define _HCL_RBT_H_
#include "hcl-cmn.h"
#include <hcl-cmn.h>
/** \file
* This file provides a red-black tree encapsulated in the #hcl_rbt_t type that

2
lib/hcl-tmr.h
View File

@ -25,7 +25,7 @@
#ifndef _HCL_TMR_H_
#define _HCL_TMR_H_
#include "hcl-cmn.h"
#include <hcl-cmn.h>
typedef struct hcl_tmr_t hcl_tmr_t;
typedef struct hcl_tmr_event_t hcl_tmr_event_t;

2
lib/hcl-utl.h
View File

@ -25,7 +25,7 @@
#ifndef _HCL_UTL_H_
#define _HCL_UTL_H_
#include "hcl-cmn.h"
#include <hcl-cmn.h>
#include <stdarg.h>
/* =========================================================================

2
lib/hcl-x.h
View File

@ -42,6 +42,8 @@ enum hcl_xpkt_type_t
HCL_XPKT_STDOUT, /* [S]->[C] output to stdout */
HCL_XPKT_STDERR, /* [S]->[C] output to stderr or output data related to error */
HCL_XPKT_INFORM, /* [S]->[C], [C]->[S] */
/*TODO: define HCL_XPKT_CONTROL and make LIST_WORKS AND KILL_WORKER sub-commands of CONTORL */
HCL_XPKT_LIST_WORKERS, /* [C]->[S] */
HCL_XPKT_KILL_WORKER, /* [C]->[S] */

148
lib/hcl-xutl.h
View File

@ -1,148 +0,0 @@
/*
Copyright (c) 2016-2018 Chung, Hyung-Hwan. All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#ifndef _HCL_XUTL_H_
#define _HCL_XUTL_H_
#include "hcl-cmn.h"
#if (HCL_SIZEOF_SOCKLEN_T == 1)
#if defined(HCL_SOCKLEN_T_IS_SIGNED)
typedef hcl_int8_t hcl_scklen_t;
#else
typedef hcl_uint8_t hcl_scklen_t;
#endif
#elif (HCL_SIZEOF_SOCKLEN_T == 2)
#if defined(HCL_SOCKLEN_T_IS_SIGNED)
typedef hcl_int16_t hcl_scklen_t;
#else
typedef hcl_uint16_t hcl_scklen_t;
#endif
#elif (HCL_SIZEOF_SOCKLEN_T == 4)
#if defined(HCL_SOCKLEN_T_IS_SIGNED)
typedef hcl_int32_t hcl_scklen_t;
#else
typedef hcl_uint32_t hcl_scklen_t;
#endif
#elif (HCL_SIZEOF_SOCKLEN_T == 8)
#if defined(HCL_SOCKLEN_T_IS_SIGNED)
typedef hcl_int64_t hcl_scklen_t;
#else
typedef hcl_uint64_t hcl_scklen_t;
#endif
#else
#undef HCL_SIZEOF_SOCKLEN_T
#define HCL_SIZEOF_SOCKLEN_T HCL_SIZEOF_INT
#define HCL_SOCKLEN_T_IS_SIGNED
typedef int hcl_scklen_t;
#endif
struct hcl_sckaddr_t
{
#define HCL_SCKADDR_DATA_SIZE 0
#if (HCL_SIZEOF_STRUCT_SOCKADDR_IN > HCL_SCKADDR_DATA_SIZE)
#undef HCL_SCKADDR_DATA_SIZE
#define HCL_SCKADDR_DATA_SIZE HCL_SIZEOF_STRUCT_SOCKADDR_IN
#endif
#if (HCL_SIZEOF_STRUCT_SOCKADDR_IN6 > HCL_SCKADDR_DATA_SIZE)
#undef HCL_SCKADDR_DATA_SIZE
#define HCL_SCKADDR_DATA_SIZE HCL_SIZEOF_STRUCT_SOCKADDR_IN6
#endif
#if (HCL_SIZEOF_STRUCT_SOCKADDR_UN > HCL_SCKADDR_DATA_SIZE)
#undef HCL_SCKADDR_DATA_SIZE
#define HCL_SCKADDR_DATA_SIZE HCL_SIZEOF_STRUCT_SOCKADDR_UN
#endif
#if (HCL_SIZEOF_STRUCT_SOCKADDR_LL > HCL_SCKADDR_DATA_SIZE)
#undef HCL_SCKADDR_DATA_SIZE
#define HCL_SCKADDR_DATA_SIZE HCL_SIZEOF_STRUCT_SOCKADDR_LL
#endif
#if (HCL_SCKADDR_DATA_SIZE == 0)
#undef HCL_SCKADDR_DATA_SIZE
#define HCL_SCKADDR_DATA_SIZE 64
#endif
hcl_uint8_t storage[HCL_SCKADDR_DATA_SIZE];
};
typedef struct hcl_sckaddr_t hcl_sckaddr_t;
#if defined(__cplusplus)
extern "C" {
#endif
HCL_EXPORT int hcl_ucharstosckaddr (
hcl_t* hcl,
const hcl_uch_t* str,
hcl_oow_t len,
hcl_sckaddr_t* sckaddr,
hcl_scklen_t* scklen
);
HCL_EXPORT int hcl_bcharstosckaddr (
hcl_t* hcl,
const hcl_bch_t* str,
hcl_oow_t len,
hcl_sckaddr_t* sckaddr,
hcl_scklen_t* scklen
);
#if defined(HCL_HAVE_INLINE)
static HCL_INLINE int hcl_uchars_to_sckaddr (const hcl_uch_t* str, hcl_oow_t len, hcl_sckaddr_t* sckaddr, hcl_scklen_t* scklen)
{
return hcl_ucharstosckaddr(HCL_NULL, str, len, sckaddr, scklen);
}
static HCL_INLINE int hcl_bchars_to_sckaddr (const hcl_bch_t* str, hcl_oow_t len, hcl_sckaddr_t* sckaddr, hcl_scklen_t* scklen)
{
return hcl_bcharstosckaddr(HCL_NULL, str, len, sckaddr, scklen);
}
#else
#define hcl_uchars_to_sckaddr(str,len,sckaddr,scklen) hcl_ucharstosckaddr(HCL_NULL,str,len,sckaddr,scklen)
#define hcl_bchars_to_sckaddr(str,len,sckaddr,scklen) hcl_bcharstosckaddr(HCL_NULL,str,len,sckaddr,scklen)
#endif
#if defined(HCL_OOCH_IS_UCH)
# define hcl_oocharstosckaddr hcl_ucharstosckaddr
# define hcl_oochars_to_sckaddr hcl_uchars_to_sckaddr
#else
# define hcl_oocharstosckaddr hcl_bcharstosckaddr
# define hcl_oochars_to_sckaddr hcl_bchars_to_sckaddr
#endif
/**
* The hcl_get_sckaddr_info() function returns the socket family.
* if \a scklen is not #HCL_NULL, it also sets the actual address length
* in the memory pointed to by it.
*/
HCL_EXPORT int hcl_get_sckaddr_info (
const hcl_sckaddr_t* sckaddr,
hcl_scklen_t* scklen
);
#if defined(__cplusplus)
}
#endif
#endif

2
lib/hcl.h
View File

@ -1695,6 +1695,8 @@ struct hcl_t
hcl_oop_class_t c_method; /* CompiledMethod */
hcl_oop_class_t c_methsig; /* MethodSignature */
#endif
hcl_oop_class_t c_function; /* Function */
hcl_oop_class_t c_primitive; /* Primitive */
hcl_oop_class_t c_block; /* CompiledBlock */
hcl_oop_class_t c_method_context; /* MethodContext */

2
lib/json.c
View File

@ -22,7 +22,7 @@
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#include "hcl-json.h"
#include <hcl-json.h>
#include "hcl-prv.h"
#include <string.h>

75
lib/obj.c
View File

@ -635,7 +635,7 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr,
hcl_ooi_t spec;
#endif
HCL_OBJ_SET_CLASS (oop, (hcl_oop_t)_class);
#if 0
#if 0 /* TODO: revive this part */
spec = HCL_OOP_TO_SMOOI(_class->spec);
if (HCL_CLASS_SPEC_IS_IMMUTABLE(spec)) HCL_OBJ_SET_FLAGS_RDONLY (oop, 1);
if (HCL_CLASS_SPEC_IS_UNCOPYABLE(spec)) HCL_OBJ_SET_FLAGS_UNCOPYABLE (oop, 1);
@ -646,6 +646,79 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr,
return oop;
}
hcl_oop_t hcl_instantiatewithtrailer (hcl_t* hcl, hcl_oop_class_t _class, hcl_oow_t vlen, const hcl_oob_t* trptr, hcl_oow_t trlen)
{
hcl_oop_t oop;
hcl_obj_type_t type;
hcl_oow_t alloclen;
hcl_oow_t tmp_count = 0;
HCL_ASSERT (hcl, hcl->_nil != HCL_NULL);
if (decode_spec(hcl, _class, vlen, &type, &alloclen) <= -1) return HCL_NULL;
hcl_pushvolat (hcl, (hcl_oop_t*)&_class); tmp_count++;
switch (type)
{
case HCL_OBJ_TYPE_OOP:
oop = hcl_allocoopobjwithtrailer(hcl, HCL_BRAND_INSTANCE, alloclen, trptr, trlen);
if (HCL_LIKELY(oop))
{
/* initialize named instance variables with default values */
#if 0 /* TODO: revive this part */
if (_class->initv[0] != hcl->_nil)
{
hcl_oow_t i = HCL_OBJ_GET_SIZE(_class->initv[0]);
/* [NOTE] i don't deep-copy initial values.
* if you change the contents of compound values like arrays,
* it affects subsequent instantiation of the class.
* it's important that the compiler should mark compound initial
* values read-only. */
while (i > 0)
{
--i;
HCL_STORE_OOP (hcl, HCL_OBJ_GET_OOP_PTR(oop, i), HCL_OBJ_GET_OOP_VAL(_class->initv[0], i));
}
}
#endif
}
break;
default:
#if 0
HCL_DEBUG3 (hcl, "Not allowed to instantiate a non-pointer object of the %.*js class with trailer %zu\n",
HCL_OBJ_GET_SIZE(_class->name),
HCL_OBJ_GET_CHAR_SLOT(_class->name),
trlen);
#endif
hcl_seterrnum (hcl, HCL_EPERM);
oop = HCL_NULL;
break;
}
if (oop)
{
#if 0
hcl_ooi_t spec;
#endif
HCL_OBJ_SET_CLASS (oop, (hcl_oop_t)_class);
#if 0 /* TODO: revive this part */
spec = HCL_OOP_TO_SMOOI(_class->spec);
if (HCL_CLASS_SPEC_IS_IMMUTABLE(spec)) HCL_OBJ_SET_FLAGS_RDONLY (oop, 1);
/* the object with trailer is to to uncopyable in hcl_allocoopobjwithtrailer() so no need to check/set it again here
if (HCL_CLASS_SPEC_IS_UNCOPYABLE(spec)) HCL_OBJ_SET_FLAGS_UNCOPYABLE (oop, 1);
*/
#endif
HCL_OBJ_SET_FLAGS_BRAND(oop, HCL_OOP_TO_SMOOI(_class->ibrand));
}
hcl_popvolats (hcl, tmp_count);
return oop;
}
/* ------------------------------------------------------------------------ *
* NGC HANDLING
* ------------------------------------------------------------------------ */

4
lib/opt-impl.h
View File

@ -26,8 +26,8 @@
/* this file is supposed to be included by opt.c multiple times */
#include "hcl-opt.h"
#include "hcl-utl.h"
#include <hcl-opt.h>
#include <hcl-utl.h>
/*
* hcl_getopt is based on BSD getopt.

4
lib/opt.c
View File

@ -22,8 +22,8 @@
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#include "hcl-opt.h"
#include "hcl-utl.h"
#include <hcl-opt.h>
#include <hcl-utl.h>
#define BADCH '?'
#define BADARG ':'

35
lib/prim.c
View File

@ -42,7 +42,7 @@ hcl_oop_t hcl_makeprim (hcl_t* hcl, hcl_pfimpl_t primimpl, hcl_oow_t minargs, hc
hcl_oop_prim_t obj; /* in principle, hcl_oop_word_t with HCL_PRIM_NUM_WORDS elements */
obj = (hcl_oop_prim_t)hcl_allocwordobj(hcl, HCL_BRAND_PRIM, HCL_NULL, HCL_PRIM_NUM_WORDS);
if (obj)
if (HCL_LIKELY(obj))
{
obj->impl = (hcl_oow_t)primimpl;
obj->min_nargs = minargs;
@ -213,7 +213,36 @@ static hcl_pfrc_t pf_sprintf (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
return HCL_PF_SUCCESS;
}
/* ------------------------------------------------------------------------- */
static hcl_pfrc_t pf_getbyte (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t pf_getch (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
/*getchar(;)
HCL_STACK_SETRET (hcl, nars, v);*/
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t pf_scanf (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
if (hcl_scfmtcallstack(hcl, nargs) <= -1)
{
HCL_STACK_SETRETTOERRNUM (hcl, nargs);
}
else
{
/* TODO: better return code? */
HCL_STACK_SETRET (hcl, nargs, hcl->_nil);
}
return HCL_PF_SUCCESS;
}
/* ------------------------------------------------------------------------- */
static hcl_pfrc_t pf_gc (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
@ -403,7 +432,7 @@ static hcl_pfrc_t pf_is_lambda (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
{
hcl_oop_t rv, x;
x = HCL_STACK_GETARG(hcl, nargs, 0);
rv = (HCL_IS_CONTEXT(hcl, x))? hcl->_true: hcl->_false;
rv = (HCL_IS_LAMBDA(hcl, x))? hcl->_true: hcl->_false;
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
}
@ -904,9 +933,11 @@ static hcl_pfrc_t pf_object_new (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
static pf_t builtin_prims[] =
{
{ 0, 0, pf_getch, 5, { 'g','e','t','c','h' } },
{ 0, HCL_TYPE_MAX(hcl_oow_t), pf_log, 3, { 'l','o','g' } },
{ 1, HCL_TYPE_MAX(hcl_oow_t), pf_logf, 4, { 'l','o','g','f' } },
{ 1, HCL_TYPE_MAX(hcl_oow_t), pf_printf, 6, { 'p','r','i','n','t','f' } },
{ 1, HCL_TYPE_MAX(hcl_oow_t), pf_scanf, 5, { 's','c','a','n','f' } },
{ 1, HCL_TYPE_MAX(hcl_oow_t), pf_sprintf, 7, { 's','p','r','i','n','t','f' } },
{ 0, 0, pf_gc, 2, { 'g','c' } },

2
lib/rbt.c
View File

@ -22,7 +22,7 @@
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#include "hcl-rbt.h"
#include <hcl-rbt.h>
#include "hcl-prv.h"
#define copier_t hcl_rbt_copier_t

3
lib/read.c
View File

@ -3222,7 +3222,8 @@ static int feed_from_includee (hcl_t* hcl)
int hcl_beginfeed (hcl_t* hcl, hcl_on_cnode_t on_cnode)
{
/* if the fed data contains @include, you must call hcl_attachccio() first */
/* if the fed data contains #include, you must call hcl_attachccio() first.
* file includsion requires the ccio handler to be implemented. */
if (!hcl->c && init_compiler(hcl) <= -1) return -1;

12
lib/std.c
View File

@ -3317,8 +3317,16 @@ static HCL_INLINE int open_cci_stream (hcl_t* hcl, hcl_io_cciarg_t* arg)
fn = ((bb_t*)arg->includer->handle)->fn;
fb = hcl_get_base_name_from_bcstr_path(fn);
parlen = fb - fn;
if (arg->name[0] == '/') /* TODO: change the code to check if it's an absolute path */
{
fb = "";
parlen = 0;
}
else
{
fb = hcl_get_base_name_from_bcstr_path(fn);
parlen = fb - fn;
}
bb = (bb_t*)hcl_callocmem(hcl, HCL_SIZEOF(*bb) + (HCL_SIZEOF(hcl_bch_t) * (parlen + bcslen + 1)));
if (!bb) goto oops;