示例#1
0
文件: c-path.c 项目: rgchris/ren-c
//
//  Resolve_Path: C
//
// Given a path, determine if it is ultimately specifying a selection out
// of a context...and if it is, return that context.  So `a/obj/key` would
// return the object assocated with obj, while `a/str/1` would return
// NULL if `str` were a string as it's not an object selection.
//
// !!! This routine overlaps the logic of Do_Path, and should potentially
// be a mode of that instead.  It is not very complete, considering that it
// does not execute GROUP! (and perhaps shouldn't?) and only supports a
// path that picks contexts out of other contexts, via word selection.
//
REBCTX *Resolve_Path(const REBVAL *path, REBCNT *index_out)
{
    RELVAL *selector;
    const REBVAL *var;
    REBARR *array;
    REBCNT i;

    array = VAL_ARRAY(path);
    selector = ARR_HEAD(array);

    if (IS_END(selector) || !ANY_WORD(selector))
        return NULL; // !!! only handles heads of paths that are ANY-WORD!

    var = GET_OPT_VAR_MAY_FAIL(selector, VAL_SPECIFIER(path));

    ++selector;
    if (IS_END(selector))
        return NULL; // !!! does not handle single-element paths

    while (ANY_CONTEXT(var) && IS_WORD(selector)) {
        i = Find_Canon_In_Context(
            VAL_CONTEXT(var), VAL_WORD_CANON(selector), FALSE
        );
        ++selector;
        if (IS_END(selector)) {
            *index_out = i;
            return VAL_CONTEXT(var);
        }

        var = CTX_VAR(VAL_CONTEXT(var), i);
    }

    DEAD_END;
}
示例#2
0
文件: f-stubs.c 项目: kjanz1899/ren-c
//
//  Get_Object: C
// 
// Get an instance variable from an ANY-CONTEXT! value.
//
REBVAL *Get_Object(const REBVAL *any_context, REBCNT index)
{
    REBCTX *context = VAL_CONTEXT(any_context);

    assert(GET_ARR_FLAG(CTX_VARLIST(context), ARRAY_FLAG_CONTEXT_VARLIST));
    assert(index <= CTX_LEN(context));
    return CTX_VAR(context, index);
}
示例#3
0
文件: f-stubs.c 项目: kjanz1899/ren-c
//
//  Get_System: C
// 
// Return a second level object field of the system object.
//
REBVAL *Get_System(REBCNT i1, REBCNT i2)
{
    REBVAL *obj;

    obj = CTX_VAR(VAL_CONTEXT(ROOT_SYSTEM), i1);
    if (i2 == 0) return obj;
    assert(IS_OBJECT(obj));
    return Get_Field(VAL_CONTEXT(obj), i2);
}
示例#4
0
文件: a-lib.c 项目: kjanz1899/ren-c
//
//  RL_Get_Field: C
// 
// Get a field value (context variable) of an object.
// 
// Returns:
//     Datatype of value or zero if word is not found in the object.
// Arguments:
//     obj  - object pointer (e.g. from RXA_OBJECT)
//     word - global word identifier (integer)
//     result - gets set to the value of the field
//
RL_API int RL_Get_Field(REBSER *obj, u32 word, RXIARG *result)
{
    REBCTX *context = AS_CONTEXT(obj);
    REBVAL *value;
    if (!(word = Find_Word_In_Context(context, word, FALSE))) return 0;
    value = CTX_VAR(context, word);
    Value_To_RXI(result, value);
    return Reb_To_RXT[VAL_TYPE_0(value)];
}
示例#5
0
文件: a-lib.c 项目: kjanz1899/ren-c
//
//  RL_Set_Field: C
// 
// Set a field (context variable) of an object.
// 
// Returns:
//     The type arg, or zero if word not found in object or if field is protected.
// Arguments:
//     obj  - object pointer (e.g. from RXA_OBJECT)
//     word_id - global word identifier (integer)
//     val  - new value for field
//     type - datatype of value
//
RL_API int RL_Set_Field(REBSER *obj, u32 word_id, RXIARG val, int type)
{
    REBCTX *context = AS_CONTEXT(obj);

    word_id = Find_Word_In_Context(context, word_id, FALSE);
    if (word_id == 0) return 0;

    if (GET_VAL_FLAG(CTX_KEY(context, word_id), TYPESET_FLAG_LOCKED))
        return 0;

    RXI_To_Value(CTX_VAR(context, word_id), &val, type);

    return type;
}
示例#6
0
文件: a-lib.c 项目: kjanz1899/ren-c
//
//  RL_Extend: C
// 
// Appends embedded extension to system/catalog/boot-exts.
// 
// Returns:
//     A pointer to the REBOL library (see reb-lib.h).
// Arguments:
//     source - A pointer to a UTF-8 (or ASCII) string that provides
//         extension module header, function definitions, and other
//         related functions and data.
//     call - A pointer to the extension's command dispatcher.
// Notes:
//     This function simply adds the embedded extension to the
//     boot-exts list. All other processing and initialization
//     happens later during startup. Each embedded extension is
//     queried and init using LOAD-EXTENSION system native.
//     See c:extensions-embedded
//
RL_API void *RL_Extend(const REBYTE *source, RXICAL call)
{
    REBVAL *value;
    REBARR *array;

    value = CTX_VAR(Sys_Context, SYS_CTX_BOOT_EXTS);
    if (IS_BLOCK(value))
        array = VAL_ARRAY(value);
    else {
        array = Make_Array(2);
        Val_Init_Block(value, array);
    }
    value = Alloc_Tail_Array(array);
    Val_Init_Binary(value, Copy_Bytes(source, -1)); // UTF-8
    value = Alloc_Tail_Array(array);
    SET_HANDLE_CODE(value, cast(CFUNC*, call));

    return Extension_Lib();
}
示例#7
0
文件: f-stubs.c 项目: kjanz1899/ren-c
//
//  In_Object: C
// 
// Get value from nested list of objects. List is null terminated.
// Returns object value, else returns 0 if not found.
//
REBVAL *In_Object(REBCTX *base, ...)
{
    REBVAL *context = NULL;
    REBCNT n;
    va_list va;

    va_start(va, base);
    while ((n = va_arg(va, REBCNT))) {
        if (n > CTX_LEN(base)) {
            va_end(va);
            return NULL;
        }
        context = CTX_VAR(base, n);
        if (!ANY_CONTEXT(context)) {
            va_end(va);
            return NULL;
        }
        base = VAL_CONTEXT(context);
    }
    va_end(va);

    return context;
}
示例#8
0
文件: f-stubs.c 项目: kjanz1899/ren-c
//
//  Get_Field: C
// 
// Get an instance variable from an object series.
//
REBVAL *Get_Field(REBCTX *context, REBCNT index)
{
    assert(index <= CTX_LEN(context));
    return CTX_VAR(context, index);
}
示例#9
0
文件: f-stubs.c 项目: kjanz1899/ren-c
//
//  Type_Of: C
// 
// Returns the datatype value for the given value.
// The datatypes are all at the head of the context.
//
REBVAL *Type_Of(const REBVAL *value)
{
    return CTX_VAR(Lib_Context, SYM_FROM_KIND(VAL_TYPE(value)));
}
示例#10
0
文件: f-stubs.c 项目: kjanz1899/ren-c
//
//  Get_Type: C
// 
// Returns the specified datatype value from the system context.
// The datatypes are all at the head of the context.
//
REBVAL *Get_Type(enum Reb_Kind kind)
{
    return CTX_VAR(Lib_Context, SYM_FROM_KIND(kind));
}
示例#11
0
文件: f-stubs.c 项目: kjanz1899/ren-c
//
//  Val_Init_Datatype: C
//
void Val_Init_Datatype(REBVAL *value, enum Reb_Kind kind)
{
    *value = *CTX_VAR(Lib_Context, SYM_FROM_KIND(kind));
}
示例#12
0
文件: a-lib.c 项目: kjanz1899/ren-c
//
//  RL_Start: C
// 
// Evaluate the default boot function.
// 
// Returns:
//     Zero on success, otherwise indicates an error occurred.
// Arguments:
//     bin - optional startup code (compressed), can be null
//     len - length of above bin
//     flags - special flags
// Notes:
//     This function completes the startup sequence by calling
//     the sys/start function.
//
RL_API int RL_Start(REBYTE *bin, REBINT len, REBYTE *script, REBINT script_len, REBCNT flags)
{
    REBVAL *val;
    REBSER *ser;

    struct Reb_State state;
    REBCTX *error;
    int error_num;

    REBVAL result;
    VAL_INIT_WRITABLE_DEBUG(&result);

    if (bin) {
        ser = Decompress(bin, len, -1, FALSE, FALSE);
        if (!ser) return 1;

        val = CTX_VAR(Sys_Context, SYS_CTX_BOOT_HOST);
        Val_Init_Binary(val, ser);
    }

    if (script && script_len > 4) {
        /* a 4-byte long payload type at the beginning */
        i32 ptype = 0;
        REBYTE *data = script + sizeof(ptype);
        script_len -= sizeof(ptype);

        memcpy(&ptype, script, sizeof(ptype));

        if (ptype == 1) {/* COMPRESSed data */
            ser = Decompress(data, script_len, -1, FALSE, FALSE);
        } else {
            ser = Make_Binary(script_len);
            if (ser == NULL) {
                OS_FREE(script);
                return 1;
            }
            memcpy(BIN_HEAD(ser), data, script_len);
        }
        OS_FREE(script);

        val = CTX_VAR(Sys_Context, SYS_CTX_BOOT_EMBEDDED);
        Val_Init_Binary(val, ser);
    }

    PUSH_UNHALTABLE_TRAP(&error, &state);

// The first time through the following code 'error' will be NULL, but...
// `fail` can longjmp here, so 'error' won't be NULL *if* that happens!

    if (error) {
        //
        // !!! We are not allowed to ask for a print operation that can take
        // arbitrarily long without allowing for cancellation via Ctrl-C,
        // but here we are wanting to print an error.  If you're printing
        // out an error and get a halt, it won't print the halt.
        //
        REBCTX *halt_error;

        // Save error for WHY?
        //
        REBVAL *last = Get_System(SYS_STATE, STATE_LAST_ERROR);
        Val_Init_Error(last, error);

        PUSH_UNHALTABLE_TRAP(&halt_error, &state);

// The first time through the following code 'error' will be NULL, but...
// `fail` can longjmp here, so 'error' won't be NULL *if* that happens!

        if (halt_error) {
            assert(ERR_NUM(halt_error) == RE_HALT);
            return ERR_NUM(halt_error);
        }

        Print_Value(last, 1024, FALSE);

        DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);

        // !!! When running in a script, whether or not the Rebol interpreter
        // just exits in an error case with a bad error code or breaks you
        // into the console to debug the environment should be controlled by
        // a command line option.  Defaulting to returning an error code
        // seems better, because kicking into an interactive session can
        // cause logging systems to hang.

        // For RE_HALT and all other errors we return the error
        // number.  Error numbers are not set in stone (currently), but
        // are never zero...which is why we can use 0 for success.
        //
        return ERR_NUM(error);
    }

    if (Apply_Only_Throws(
        &result, Sys_Func(SYS_CTX_FINISH_RL_START), END_VALUE
    )) {
        #if !defined(NDEBUG)
            if (LEGACY(OPTIONS_EXIT_FUNCTIONS_ONLY))
                fail (Error_No_Catch_For_Throw(&result));
        #endif

        if (
            IS_FUNCTION_AND(&result, FUNC_CLASS_NATIVE) && (
                VAL_FUNC_CODE(&result) == &N_quit
                || VAL_FUNC_CODE(&result) == &N_exit
            )
        ) {
            int status;

            CATCH_THROWN(&result, &result);
            status = Exit_Status_From_Value(&result);

            DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);

            Shutdown_Core();
            OS_EXIT(status);
            DEAD_END;
        }

        fail (Error_No_Catch_For_Throw(&result));
    }

    DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);

    // The convention in the API was to return 0 for success.  We use the
    // convention (as for FINISH_INIT_CORE) that any non-UNSET! result from
    // FINISH_RL_START indicates something went wrong.

    if (IS_UNSET(&result))
        error_num = 0; // no error
    else {
        assert(FALSE); // should not happen (raise an error instead)
        Debug_Fmt("** finish-rl-start returned non-NONE!:");
        Debug_Fmt("%r", &result);
        error_num = RE_MISC;
    }

    return error_num;
}
示例#13
0
//
//  Specialize_Action_Throws: C
//
// Create a new ACTION! value that uses the same implementation as another,
// but just takes fewer arguments or refinements.  It does this by storing a
// heap-based "exemplar" FRAME! in the specialized action; this stores the
// values to preload in the stack frame cells when it is invoked.
//
// The caller may provide information on the order in which refinements are
// to be specialized, using the data stack.  These refinements should be
// pushed in the *reverse* order of their invocation, so append/dup/part
// has /DUP at DS_TOP, and /PART under it.  List stops at lowest_ordered_dsp.
//
bool Specialize_Action_Throws(
    REBVAL *out,
    REBVAL *specializee,
    REBSTR *opt_specializee_name,
    REBVAL *opt_def, // !!! REVIEW: binding modified directly (not copied)
    REBDSP lowest_ordered_dsp
){
    assert(out != specializee);

    struct Reb_Binder binder;
    if (opt_def)
        INIT_BINDER(&binder);

    REBACT *unspecialized = VAL_ACTION(specializee);

    // This produces a context where partially specialized refinement slots
    // will be on the stack (including any we are adding "virtually", from
    // the current DSP down to the lowest_ordered_dsp).
    //
    REBCTX *exemplar = Make_Context_For_Action_Push_Partials(
        specializee,
        lowest_ordered_dsp,
        opt_def ? &binder : nullptr,
        CELL_MASK_NON_STACK
    );
    Manage_Array(CTX_VARLIST(exemplar)); // destined to be managed, guarded

    if (opt_def) { // code that fills the frame...fully or partially
        //
        // Bind all the SET-WORD! in the body that match params in the frame
        // into the frame.  This means `value: value` can very likely have
        // `value:` bound for assignments into the frame while `value` refers
        // to whatever value was in the context the specialization is running
        // in, but this is likely the more useful behavior.
        //
        // !!! This binds the actual arg data, not a copy of it--following
        // OBJECT!'s lead.  However, ordinary functions make a copy of the
        // body they are passed before rebinding.  Rethink.

        // See Bind_Values_Core() for explanations of how the binding works.

        Bind_Values_Inner_Loop(
            &binder,
            VAL_ARRAY_AT(opt_def),
            exemplar,
            FLAGIT_KIND(REB_SET_WORD), // types to bind (just set-word!)
            0, // types to "add midstream" to binding as we go (nothing)
            BIND_DEEP
        );

        // !!! Only one binder can be in effect, and we're calling arbitrary
        // code.  Must clean up now vs. in loop we do at the end.  :-(
        //
        RELVAL *key = CTX_KEYS_HEAD(exemplar);
        REBVAL *var = CTX_VARS_HEAD(exemplar);
        for (; NOT_END(key); ++key, ++var) {
            if (Is_Param_Unbindable(key))
                continue; // !!! is this flag still relevant?
            if (Is_Param_Hidden(key)) {
                assert(GET_CELL_FLAG(var, ARG_MARKED_CHECKED));
                continue;
            }
            if (GET_CELL_FLAG(var, ARG_MARKED_CHECKED))
                continue; // may be refinement from stack, now specialized out
            Remove_Binder_Index(&binder, VAL_KEY_CANON(key));
        }
        SHUTDOWN_BINDER(&binder);

        // Run block and ignore result (unless it is thrown)
        //
        PUSH_GC_GUARD(exemplar);
        bool threw = Do_Any_Array_At_Throws(out, opt_def, SPECIFIED);
        DROP_GC_GUARD(exemplar);

        if (threw) {
            DS_DROP_TO(lowest_ordered_dsp);
            return true;
        }
    }

    REBVAL *rootkey = CTX_ROOTKEY(exemplar);

    // Build up the paramlist for the specialized function on the stack.
    // The same walk used for that is used to link and process REB_X_PARTIAL
    // arguments for whether they become fully specialized or not.

    REBDSP dsp_paramlist = DSP;
    Move_Value(DS_PUSH(), ACT_ARCHETYPE(unspecialized));

    REBVAL *param = rootkey + 1;
    REBVAL *arg = CTX_VARS_HEAD(exemplar);

    REBDSP ordered_dsp = lowest_ordered_dsp;

    for (; NOT_END(param); ++param, ++arg) {
        if (TYPE_CHECK(param, REB_TS_REFINEMENT)) {
            if (IS_NULLED(arg)) {
                //
                // A refinement that is nulled is a candidate for usage at the
                // callsite.  Hence it must be pre-empted by our ordered
                // overrides.  -but- the overrides only apply if their slot
                // wasn't filled by the user code.  Yet these values we are
                // putting in disrupt that detection (!), so use another
                // flag (PUSH_PARTIAL) to reflect this state.
                //
                while (ordered_dsp != dsp_paramlist) {
                    ++ordered_dsp;
                    REBVAL *ordered = DS_AT(ordered_dsp);

                    if (not IS_WORD_BOUND(ordered))  // specialize 'print/asdf
                        fail (Error_Bad_Refine_Raw(ordered));

                    REBVAL *slot = CTX_VAR(exemplar, VAL_WORD_INDEX(ordered));
                    if (
                        IS_NULLED(slot) or GET_CELL_FLAG(slot, PUSH_PARTIAL)
                    ){
                        // It's still partial, so set up the pre-empt.
                        //
                        Init_Any_Word_Bound(
                            arg,
                            REB_SYM_WORD,
                            VAL_STORED_CANON(ordered),
                            exemplar,
                            VAL_WORD_INDEX(ordered)
                        );
                        SET_CELL_FLAG(arg, PUSH_PARTIAL);
                        goto unspecialized_arg;
                    }
                    // Otherwise the user filled it in, so skip to next...
                }

                goto unspecialized_arg;  // ran out...no pre-empt needed
            }

            if (GET_CELL_FLAG(arg, ARG_MARKED_CHECKED)) {
                assert(
                    IS_BLANK(arg)
                    or (
                        IS_REFINEMENT(arg)
                        and (
                            VAL_REFINEMENT_SPELLING(arg)
                            == VAL_PARAM_SPELLING(param)
                        )
                    )
                );
            }
            else
                Typecheck_Refinement_And_Canonize(param, arg);

            goto specialized_arg_no_typecheck;
        }

        switch (VAL_PARAM_CLASS(param)) {
          case REB_P_RETURN:
          case REB_P_LOCAL:
            assert(IS_NULLED(arg)); // no bindings, you can't set these
            goto unspecialized_arg;

          default:
            break;
        }

        // It's an argument, either a normal one or a refinement arg.

        if (not IS_NULLED(arg))
            goto specialized_arg_with_check;

    unspecialized_arg:

        assert(NOT_CELL_FLAG(arg, ARG_MARKED_CHECKED));
        assert(
            IS_NULLED(arg)
            or (IS_SYM_WORD(arg) and TYPE_CHECK(param, REB_TS_REFINEMENT))
        );
        Move_Value(DS_PUSH(), param);
        continue;

    specialized_arg_with_check:

        // !!! If argument was previously specialized, should have been type
        // checked already... don't type check again (?)
        //
        if (Is_Param_Variadic(param))
            fail ("Cannot currently SPECIALIZE variadic arguments.");

        if (TYPE_CHECK(param, REB_TS_DEQUOTE_REQUOTE) and IS_QUOTED(arg)) {
            //
            // Have to leave the quotes on, but still want to type check.

            if (not TYPE_CHECK(param, CELL_KIND(VAL_UNESCAPED(arg))))
                fail (arg); // !!! merge w/Error_Invalid_Arg()
        }
        else if (not TYPE_CHECK(param, VAL_TYPE(arg)))
            fail (arg); // !!! merge w/Error_Invalid_Arg()

       SET_CELL_FLAG(arg, ARG_MARKED_CHECKED);

    specialized_arg_no_typecheck:

        // Specialized-out arguments must still be in the parameter list,
        // for enumeration in the evaluator to line up with the frame values
        // of the underlying function.

        assert(GET_CELL_FLAG(arg, ARG_MARKED_CHECKED));
        Move_Value(DS_PUSH(), param);
        TYPE_SET(DS_TOP, REB_TS_HIDDEN);
        continue;
    }

    REBARR *paramlist = Pop_Stack_Values_Core(
        dsp_paramlist,
        SERIES_MASK_PARAMLIST
            | (SER(unspecialized)->header.bits & PARAMLIST_MASK_INHERIT)
    );
    Manage_Array(paramlist);
    RELVAL *rootparam = ARR_HEAD(paramlist);
    VAL_ACT_PARAMLIST_NODE(rootparam) = NOD(paramlist);

    // Everything should have balanced out for a valid specialization
    //
    while (ordered_dsp != DSP) {
        ++ordered_dsp;
        REBVAL *ordered = DS_AT(ordered_dsp);
        if (not IS_WORD_BOUND(ordered))  // specialize 'print/asdf
            fail (Error_Bad_Refine_Raw(ordered));

        REBVAL *slot = CTX_VAR(exemplar, VAL_WORD_INDEX(ordered));
        assert(not IS_NULLED(slot) and NOT_CELL_FLAG(slot, PUSH_PARTIAL));
        UNUSED(slot);
    }
    DS_DROP_TO(lowest_ordered_dsp);

    // See %sysobj.r for `specialized-meta:` object template

    REBVAL *example = Get_System(SYS_STANDARD, STD_SPECIALIZED_META);

    REBCTX *meta = Copy_Context_Shallow_Managed(VAL_CONTEXT(example));

    Init_Nulled(CTX_VAR(meta, STD_SPECIALIZED_META_DESCRIPTION)); // default
    Move_Value(
        CTX_VAR(meta, STD_SPECIALIZED_META_SPECIALIZEE),
        specializee
    );
    if (not opt_specializee_name)
        Init_Nulled(CTX_VAR(meta, STD_SPECIALIZED_META_SPECIALIZEE_NAME));
    else
        Init_Word(
            CTX_VAR(meta, STD_SPECIALIZED_META_SPECIALIZEE_NAME),
            opt_specializee_name
        );

    MISC_META_NODE(paramlist) = NOD(meta);

    REBACT *specialized = Make_Action(
        paramlist,
        &Specializer_Dispatcher,
        ACT_UNDERLYING(unspecialized), // same underlying action as this
        exemplar, // also provide a context of specialization values
        1 // details array capacity
    );
    assert(CTX_KEYLIST(exemplar) == ACT_PARAMLIST(unspecialized));

    assert(
        GET_ACTION_FLAG(specialized, IS_INVISIBLE)
        == GET_ACTION_FLAG(unspecialized, IS_INVISIBLE)
    );

    // The "body" is the FRAME! value of the specialization.  It takes on the
    // binding we want to use (which we can't put in the exemplar archetype,
    // that binding has to be UNBOUND).  It also remembers the original
    // action in the phase, so Specializer_Dispatcher() knows what to call.
    //
    RELVAL *body = ARR_HEAD(ACT_DETAILS(specialized));
    Move_Value(body, CTX_ARCHETYPE(exemplar));
    INIT_BINDING(body, VAL_BINDING(specializee));
    INIT_VAL_CONTEXT_PHASE(body, unspecialized);

    Init_Action_Unbound(out, specialized);
    return false; // code block did not throw
}
示例#14
0
文件: p-serial.c 项目: rhencke/rebol
//
//  Serial_Actor: C
//
static REB_R Serial_Actor(REBFRM *frame_, REBCTX *port, REBSYM action)
{
    REBREQ *req;    // IO request
    REBVAL *spec;   // port spec
    REBVAL *arg;    // action argument value
    REBVAL *val;    // e.g. port number value
    REBINT result;  // IO result
    REBCNT refs;    // refinement argument flags
    REBCNT len;     // generic length
    REBSER *ser;    // simplifier
    REBVAL *path;

    Validate_Port(port, action);

    *D_OUT = *D_ARG(1);

    // Validate PORT fields:
    spec = CTX_VAR(port, STD_PORT_SPEC);
    if (!IS_OBJECT(spec)) fail (Error(RE_INVALID_PORT));
    path = Obj_Value(spec, STD_PORT_SPEC_HEAD_REF);
    if (!path) fail (Error(RE_INVALID_SPEC, spec));

    //if (!IS_FILE(path)) fail (Error(RE_INVALID_SPEC, path));

    req = cast(REBREQ*, Use_Port_State(port, RDI_SERIAL, sizeof(*req)));

    // Actions for an unopened serial port:
    if (!IS_OPEN(req)) {

        switch (action) {

        case SYM_OPEN:
            arg = Obj_Value(spec, STD_PORT_SPEC_SERIAL_PATH);
            if (! (IS_FILE(arg) || IS_STRING(arg) || IS_BINARY(arg)))
                fail (Error(RE_INVALID_PORT_ARG, arg));

            req->special.serial.path = ALLOC_N(REBCHR, MAX_SERIAL_DEV_PATH);
            OS_STRNCPY(
                req->special.serial.path,
                //
                // !!! This is assuming VAL_DATA contains native chars.
                // Should it? (2 bytes on windows, 1 byte on linux/mac)
                //
                SER_AT(REBCHR, VAL_SERIES(arg), VAL_INDEX(arg)),
                MAX_SERIAL_DEV_PATH
            );
            arg = Obj_Value(spec, STD_PORT_SPEC_SERIAL_SPEED);
            if (! IS_INTEGER(arg))
                fail (Error(RE_INVALID_PORT_ARG, arg));

            req->special.serial.baud = VAL_INT32(arg);
            //Secure_Port(SYM_SERIAL, ???, path, ser);
            arg = Obj_Value(spec, STD_PORT_SPEC_SERIAL_DATA_SIZE);
            if (!IS_INTEGER(arg)
                || VAL_INT64(arg) < 5
                || VAL_INT64(arg) > 8
            ) {
                fail (Error(RE_INVALID_PORT_ARG, arg));
            }
            req->special.serial.data_bits = VAL_INT32(arg);

            arg = Obj_Value(spec, STD_PORT_SPEC_SERIAL_STOP_BITS);
            if (!IS_INTEGER(arg)
                || VAL_INT64(arg) < 1
                || VAL_INT64(arg) > 2
            ) {
                fail (Error(RE_INVALID_PORT_ARG, arg));
            }
            req->special.serial.stop_bits = VAL_INT32(arg);

            arg = Obj_Value(spec, STD_PORT_SPEC_SERIAL_PARITY);
            if (IS_BLANK(arg)) {
                req->special.serial.parity = SERIAL_PARITY_NONE;
            } else {
                if (!IS_WORD(arg))
                    fail (Error(RE_INVALID_PORT_ARG, arg));

                switch (VAL_WORD_SYM(arg)) {
                    case SYM_ODD:
                        req->special.serial.parity = SERIAL_PARITY_ODD;
                        break;
                    case SYM_EVEN:
                        req->special.serial.parity = SERIAL_PARITY_EVEN;
                        break;
                    default:
                        fail (Error(RE_INVALID_PORT_ARG, arg));
                }
            }

            arg = Obj_Value(spec, STD_PORT_SPEC_SERIAL_FLOW_CONTROL);
            if (IS_BLANK(arg)) {
                req->special.serial.flow_control = SERIAL_FLOW_CONTROL_NONE;
            } else {
                if (!IS_WORD(arg))
                    fail (Error(RE_INVALID_PORT_ARG, arg));

                switch (VAL_WORD_SYM(arg)) {
                    case SYM_HARDWARE:
                        req->special.serial.flow_control = SERIAL_FLOW_CONTROL_HARDWARE;
                        break;
                    case SYM_SOFTWARE:
                        req->special.serial.flow_control = SERIAL_FLOW_CONTROL_SOFTWARE;
                        break;
                    default:
                        fail (Error(RE_INVALID_PORT_ARG, arg));
                }
            }

            if (OS_DO_DEVICE(req, RDC_OPEN))
                fail (Error_On_Port(RE_CANNOT_OPEN, port, -12));
            SET_OPEN(req);
            return R_OUT;

        case SYM_CLOSE:
            return R_OUT;

        case SYM_OPEN_Q:
            return R_FALSE;

        default:
            fail (Error_On_Port(RE_NOT_OPEN, port, -12));
        }
    }

    // Actions for an open socket:
    switch (action) {

    case SYM_READ:
        refs = Find_Refines(frame_, ALL_READ_REFS);

        // Setup the read buffer (allocate a buffer if needed):
        arg = CTX_VAR(port, STD_PORT_DATA);
        if (!IS_STRING(arg) && !IS_BINARY(arg)) {
            Val_Init_Binary(arg, Make_Binary(32000));
        }
        ser = VAL_SERIES(arg);
        req->length = SER_AVAIL(ser); // space available
        if (req->length < 32000/2) Extend_Series(ser, 32000);
        req->length = SER_AVAIL(ser);

        // This used STR_TAIL (obsolete, equivalent to BIN_TAIL) but was it
        // sure the series was byte sized?  Added in a check.
        assert(BYTE_SIZE(ser));
        req->common.data = BIN_TAIL(ser); // write at tail

        //if (SER_LEN(ser) == 0)
        req->actual = 0;  // Actual for THIS read, not for total.
#ifdef DEBUG_SERIAL
        printf("(max read length %d)", req->length);
#endif
        result = OS_DO_DEVICE(req, RDC_READ); // recv can happen immediately
        if (result < 0) fail (Error_On_Port(RE_READ_ERROR, port, req->error));
#ifdef DEBUG_SERIAL
        for (len = 0; len < req->actual; len++) {
            if (len % 16 == 0) printf("\n");
            printf("%02x ", req->common.data[len]);
        }
        printf("\n");
#endif
        *D_OUT = *arg;
        return R_OUT;

    case SYM_WRITE:
        refs = Find_Refines(frame_, ALL_WRITE_REFS);

        // Determine length. Clip /PART to size of string if needed.
        spec = D_ARG(2);
        len = VAL_LEN_AT(spec);
        if (refs & AM_WRITE_PART) {
            REBCNT n = Int32s(D_ARG(ARG_WRITE_LIMIT), 0);
            if (n <= len) len = n;
        }

        // Setup the write:
        *CTX_VAR(port, STD_PORT_DATA) = *spec;  // keep it GC safe
        req->length = len;
        req->common.data = VAL_BIN_AT(spec);
        req->actual = 0;

        //Print("(write length %d)", len);
        result = OS_DO_DEVICE(req, RDC_WRITE); // send can happen immediately
        if (result < 0) fail (Error_On_Port(RE_WRITE_ERROR, port, req->error));
        break;

    case SYM_UPDATE:
        // Update the port object after a READ or WRITE operation.
        // This is normally called by the WAKE-UP function.
        arg = CTX_VAR(port, STD_PORT_DATA);
        if (req->command == RDC_READ) {
            if (ANY_BINSTR(arg)) {
                SET_SERIES_LEN(
                    VAL_SERIES(arg),
                    VAL_LEN_HEAD(arg) + req->actual
                );
            }
        }
        else if (req->command == RDC_WRITE) {
            SET_BLANK(arg);  // Write is done.
        }
        return R_BLANK;

    case SYM_OPEN_Q:
        return R_TRUE;

    case SYM_CLOSE:
        if (IS_OPEN(req)) {
            OS_DO_DEVICE(req, RDC_CLOSE);
            SET_CLOSED(req);
        }
        break;

    default:
        fail (Error_Illegal_Action(REB_PORT, action));
    }

    return R_OUT;
}