Skip to content

Commit

Permalink
GET-ENV/SET-ENV => process extension, RL_XXX callable from Core
Browse files Browse the repository at this point in the history
This takes a step toward moving the RL_API forward and eliminating
REBCHR from the API, by removing the split between the environment
reading and writing functions and the "host".  Instead of needing to
go through an intermediate representation, the conditional code on
Windows vs. POSIX handles REBVAL* directly...extracting wide characters
from the REBVAL via the RL_API or UTF8, as appropriate based on the
platform.

Because the model being pursued in the new RL_API is actually likely
to be useful to the core at times, this sorts out some of the #include
problems which hampered calling the RL_XXX functions when one was
including %sys-core.h
  • Loading branch information
hostilefork committed Nov 3, 2017
1 parent c3a9c6d commit feec4ac
Show file tree
Hide file tree
Showing 15 changed files with 613 additions and 407 deletions.
202 changes: 189 additions & 13 deletions src/core/a-lib.c
Expand Up @@ -30,16 +30,6 @@

#include "sys-core.h"

// !!! Most of the Rebol source does not include %reb-ext.h. As a result
// REBRXT and RXIARG and RXIFRM are not defined when %tmp-funcs.h is being
// compiled, so the MAKE PREP process doesn't auto-generate prototypes for
// these functions.
//
// Rather than try and define RX* for all of the core to include, assume that
// the burden of keeping these in sync manually is for the best.
//
#include "reb-ext.h"

// Linkage back to HOST functions. Needed when we compile as a DLL
// in order to use the OS_* macro functions.
#ifdef REB_API // Included by C command line
Expand All @@ -51,9 +41,6 @@ static REBRXT Reb_To_RXT[REB_MAX];
static enum Reb_Kind RXT_To_Reb[RXT_MAX];


#include "reb-lib.h" // forward definitions needed for "extern C" linkage


//
// RL_Version: C
//
Expand Down Expand Up @@ -657,6 +644,195 @@ RL_API void RL_Init_Date(
}


//
// RL_Val_UTF8: C
//
// Extract UTF-8 data from an ANY-STRING! or ANY-WORD!.
//
RL_API REBCNT RL_Val_UTF8(
REBYTE *buf,
REBCNT buf_chars,
const REBVAL *v
){
REBCNT index;
REBCNT len;
const REBYTE *utf8;
if (ANY_STRING(v)) {
index = VAL_INDEX(v);
len = VAL_LEN_AT(v);
REBSER *temp = Temp_Bin_Str_Managed(v, &index, &len);
utf8 = BIN_AT(temp, index);
}
else {
assert(ANY_WORD(v));
index = 0;
utf8 = VAL_WORD_HEAD(v);
len = LEN_BYTES(utf8);
}

if (buf == NULL) {
assert(buf_chars == 0);
return len; // caller must allocate a buffer of size len + 1
}

REBCNT limit = MIN(buf_chars, len);
memcpy(s_cast(buf), cs_cast(utf8), limit);
buf[limit] = '\0';
return len;
}


//
// RL_Val_UTF8_Alloc: C
//
RL_API REBYTE *RL_Val_UTF8_Alloc(REBCNT *out_len, const REBVAL *v)
{
REBCNT len = RL_Val_UTF8(NULL, 0, v);
REBYTE *result = OS_ALLOC_N(REBYTE, len + 1);
RL_Val_UTF8(result, len, v);
if (out_len != NULL)
*out_len = len;
return result;
}


//
// RL_Val_Wstring: C
//
// Extract wchar_t data from an ANY-STRING! or ANY-WORD!. Note that while
// the size of a wchar_t varies on Linux, it is part of the windows platform
// standard to be two bytes.
//
RL_API wchar_t RL_Val_Wstring(
wchar_t *buf,
REBCNT buf_chars, // characters buffer can hold (not including terminator)
const REBVAL *v
){
/*
if (VAL_BYTE_SIZE(val)) {
// On windows, we need to convert byte to wide:
REBINT n = VAL_LEN_AT(val);
REBSER *up = Make_Unicode(n);
// !!!"Leaks" in the sense that the GC has to take care of this
MANAGE_SERIES(up);
n = Decode_UTF8_Negative_If_Latin1(
UNI_HEAD(up),
VAL_BIN_AT(val),
n,
FALSE
);
TERM_UNI_LEN(up, abs(n));
if (out) *out = up;
return cast(REBCHR*, UNI_HEAD(up));
}
else {
// Already wide, we can use it as-is:
// !Assumes the OS uses same wide format!
if (out) *out = VAL_SERIES(val);
return cast(REBCHR*, VAL_UNI_AT(val));
}
*/

REBCNT index;
REBCNT len;
if (ANY_STRING(v)) {
index = VAL_INDEX(v);
len = VAL_LEN_AT(v);
}
else {
assert(ANY_WORD(v));
panic ("extracting wide characters from WORD! not yet supported");
}

if (buf == NULL) { // querying for size
assert(buf_chars == 0);
return len; // caller must now allocate buffer of len + 1
}

REBSER *s = VAL_SERIES(v);

REBCNT limit = MIN(buf_chars, len);
REBCNT n = 0;
for (; index < limit; ++n, ++index)
buf[n] = GET_ANY_CHAR(s, index);

buf[limit] = 0;
return len;
}


//
// RL_Val_Wstring_Alloc: C
//
RL_API wchar_t *RL_Val_Wstring_Alloc(REBCNT *out_len, const REBVAL *v)
{
REBCNT len = RL_Val_Wstring(NULL, 0, v);
wchar_t *result = OS_ALLOC_N(wchar_t, len + 1);
RL_Val_Wstring(result, len, v);
if (out_len != NULL)
*out_len = len;
return result;
}


//
// RL_String: C
//
RL_API REBVAL *RL_String(const char *utf8)
{
// Default the returned handle's lifetime to the currently running FRAME!.
// The user can unmanage it if they want it to live longer.
//
assert(FS_TOP != NULL);
REBVAL *pairing = Alloc_Pairing(FS_TOP);
Init_String(pairing, Make_UTF8_May_Fail(utf8));
Manage_Pairing(pairing);
return pairing;
}


//
// RL_Unmanage: C
//
RL_API REBVAL *RL_Unmanage(REBVAL *v)
{
REBVAL *key = PAIRING_KEY(v);
assert(key->header.bits & NODE_FLAG_MANAGED);
UNUSED(key);

Unmanage_Pairing(v);
return v;
}


//
// RL_Free: C
//
RL_API void RL_Free(REBVAL *v)
{
REBVAL *key = PAIRING_KEY(v);
assert(NOT(key->header.bits & NODE_FLAG_MANAGED));
UNUSED(key);

Free_Pairing(v);
}


//
// RL_Panic: C
//
RL_API void RL_Panic(const void *p)
{
Panic_Core(p, __FILE__, __LINE__);
}


#include "reb-lib-lib.h"

//
Expand Down
13 changes: 7 additions & 6 deletions src/core/f-extension.c
Expand Up @@ -27,19 +27,20 @@
//
//=////////////////////////////////////////////////////////////////////////=//
//
// NOTE: The R3-Alpha extension mechanism and API are deprecated in Ren-C.
// !!! Extensions in Ren-C are a redesign from extensions in R3-Alpha. They
// are a work in progress (and need documentation and cleanup), but have
// been a proof-of-concept for the core idea to be able to write code that
// looks similar to Rebol natives, but can be loaded from a DLL making calls
// back into the executable...or alternately, built directly into the Rebol
// interpreter itself based on a configuration switch.
//
// See %reb-ext.h for a general overview of R3-Alpha extensions. Also:
//
// http://www.rebol.com/r3/docs/concepts/extensions-embedded.html
// See the %extensions/ directory for some current (evolving) examples.
//

#include "sys-core.h"

#include "reb-ext.h"
#include "reb-evtypes.h"

#include "reb-lib.h"
#include "sys-ext.h"

//(*call)(int cmd, RXIFRM *args);
Expand Down
42 changes: 32 additions & 10 deletions src/core/m-pools.c
Expand Up @@ -1007,15 +1007,26 @@ REBSER *Make_Series_Core(REBCNT capacity, REBYTE wide, REBUPT flags)
// This provides an alternate mechanism for plain C code to do cleanup besides
// handlers based on PUSH_TRAP().
//
REBVAL *Alloc_Pairing(REBCTX *opt_owning_frame) {
REBVAL *Alloc_Pairing(REBFRM *opt_owning_frame) {
REBSER *s = cast(REBSER*, Make_Node(SER_POOL)); // 2x REBVAL size

REBVAL *key = cast(REBVAL*, s);
REBVAL *paired = key + 1;

Prep_Non_Stack_Cell(key);
if (opt_owning_frame) {
Init_Any_Context(key, REB_FRAME, opt_owning_frame);
if (opt_owning_frame != NULL) {
//
// !!! Currently this reifies the frame... but it would not have to do
// so if FRAME! could hold a non-reified REBFRM* and if Move_Value()
// and Derelativize() were sensitive to reifying those frames on
// demand. This general concept could be used for transient contexts
// as well--consider it
//
Init_Any_Context(
key,
REB_FRAME,
Context_For_Frame_May_Reify_Managed(opt_owning_frame)
);
SET_VAL_FLAGS(
key, ANY_CONTEXT_FLAG_OWNS_PAIRED | NODE_FLAG_ROOT
);
Expand Down Expand Up @@ -1046,20 +1057,31 @@ REBVAL *Alloc_Pairing(REBCTX *opt_owning_frame) {
//
// Manage_Pairing: C
//
// GC management is a one-way street in Ren-C, and the paired management
// status is handled by bits directly in the first (or key's) REBVAL header.
// Switching to managed mode means the key can no longer be changed--only
// the value.
//
// !!! a const_Pairing_Key() accessor should help enforce the rule, only
// allowing const access if managed.
// The paired management status is handled by bits directly in the first (or
// key's) REBVAL header.
//
void Manage_Pairing(REBVAL *paired) {
REBVAL *key = PAIRING_KEY(paired);
SET_VAL_FLAG(key, NODE_FLAG_MANAGED);
}


//
// Unmanage_Pairing: C
//
// A pairing may become unmanaged. This is not a good idea for things like
// the pairing used by a PAIR! value. But pairings are used for API handles
// which default to tying their lifetime to the currently executing frame.
// It may be desirable to extend, shorten, or otherwise explicitly control
// their lifetime.
//
void Unmanage_Pairing(REBVAL *paired) {
REBVAL *key = PAIRING_KEY(paired);
assert(GET_VAL_FLAG(key, NODE_FLAG_MANAGED));
CLEAR_VAL_FLAG(key, NODE_FLAG_MANAGED);
}


//
// Free_Pairing: C
//
Expand Down

0 comments on commit feec4ac

Please sign in to comment.