*/ static void Collect_Words_Inner_Loop(REBINT *binds, REBVAL value[], REBCNT modes) /* ** Used for Collect_Words() after the binds table has ** been set up. ** ***********************************************************************/ { for (; NOT_END(value); value++) { if (ANY_WORD(value) && !binds[VAL_WORD_CANON(value)] && (modes & BIND_ALL || IS_SET_WORD(value)) ) { REBVAL *word; binds[VAL_WORD_CANON(value)] = 1; word = Alloc_Tail_Array(BUF_WORDS); Val_Init_Word_Unbound(word, REB_WORD, VAL_WORD_SYM(value)); } else if (ANY_EVAL_BLOCK(value) && (modes & BIND_DEEP)) Collect_Words_Inner_Loop(binds, VAL_BLK_DATA(value), modes); } }
x*/ REBRXT Do_Callback(REBSER *obj, u32 name, RXIARG *rxis, RXIARG *result) /* ** Given an object and a word id, call a REBOL function. ** The arguments are converted from extension format directly ** to the data stack. The result is passed back in ext format, ** with the datatype returned or zero if there was a problem. ** ***********************************************************************/ { REBVAL *val; struct Reb_Call *call; REBCNT len; REBCNT n; REBVAL label; REBVAL out; // Find word in object, verify it is a function. if (!(val = Find_Word_Value(obj, name))) { SET_EXT_ERROR(result, RXE_NO_WORD); return 0; } if (!ANY_FUNC(val)) { SET_EXT_ERROR(result, RXE_NOT_FUNC); return 0; } // Create stack frame (use prior stack frame for location info): SET_TRASH_SAFE(&out); // OUT slot for function eval result Val_Init_Word_Unbound(&label, REB_WORD, name); call = Make_Call( &out, VAL_SERIES(DSF_WHERE(PRIOR_DSF(DSF))), VAL_INDEX(DSF_WHERE(PRIOR_DSF(DSF))), &label, val ); obj = VAL_FUNC_PARAMLIST(val); // func words len = SERIES_TAIL(obj)-1; // number of args (may include locals) // Push args. Too short or too long arg frames are handled W/O error. // Note that refinements args can be set to anything. for (n = 1; n <= len; n++) { REBVAL *arg = DSF_ARG(call, n); if (n <= RXI_COUNT(rxis)) RXI_To_Value(arg, rxis[n], RXI_TYPE(rxis, n)); else SET_NONE(arg); // Check type for word at the given offset: if (!TYPE_CHECK(BLK_SKIP(obj, n), VAL_TYPE(arg))) { result->i2.int32b = n; SET_EXT_ERROR(result, RXE_BAD_ARGS); Free_Call(call); return 0; } } // Evaluate the function: if (Dispatch_Call_Throws(call)) { // !!! Does this need handling such that there is a way for the thrown // value to "bubble up" out of the callback, or is an error sufficient? fail (Error_No_Catch_For_Throw(DSF_OUT(call))); } // Return resulting value from output *result = Value_To_RXI(&out); return Reb_To_RXT[VAL_TYPE(&out)]; }
*/ REBSER *Struct_To_Block(const REBSTU *stu) /* ** Used by MOLD to create a block. ** ***********************************************************************/ { REBSER *ser = Make_Array(10); struct Struct_Field *field = (struct Struct_Field*) SERIES_DATA(stu->fields); REBCNT i; // We are building a recursive structure. So if we did not hand each // sub-series over to the GC then a single Free_Series() would not know // how to free them all. There would have to be a specialized walk to // free the resulting structure. Hence, don't invoke the GC until the // root series being returned is done being used or is safe from GC! MANAGE_SERIES(ser); for(i = 0; i < SERIES_TAIL(stu->fields); i ++, field ++) { REBVAL *val = NULL; REBVAL *type_blk = NULL; /* required field name */ val = Alloc_Tail_Array(ser); Val_Init_Word_Unbound(val, REB_SET_WORD, field->sym); /* required type */ type_blk = Alloc_Tail_Array(ser); Val_Init_Block(type_blk, Make_Array(1)); val = Alloc_Tail_Array(VAL_SERIES(type_blk)); if (field->type == STRUCT_TYPE_STRUCT) { REBVAL *nested = NULL; DS_PUSH_NONE; nested = DS_TOP; Val_Init_Word_Unbound(val, REB_WORD, SYM_STRUCT_TYPE); get_scalar(stu, field, 0, nested); val = Alloc_Tail_Array(VAL_SERIES(type_blk)); Val_Init_Block(val, Struct_To_Block(&VAL_STRUCT(nested))); DS_DROP; } else Val_Init_Word_Unbound(val, REB_WORD, type_to_sym[field->type]); /* optional dimension */ if (field->dimension > 1) { REBSER *dim = Make_Array(1); REBVAL *dv = NULL; val = Alloc_Tail_Array(VAL_SERIES(type_blk)); Val_Init_Block(val, dim); dv = Alloc_Tail_Array(dim); SET_INTEGER(dv, field->dimension); } /* optional initialization */ if (field->dimension > 1) { REBSER *dim = Make_Array(1); REBCNT n = 0; val = Alloc_Tail_Array(ser); Val_Init_Block(val, dim); for (n = 0; n < field->dimension; n ++) { REBVAL *dv = Alloc_Tail_Array(dim); get_scalar(stu, field, n, dv); } } else { val = Alloc_Tail_Array(ser); get_scalar(stu, field, 0, val); } } return ser; }