pointer seld_notes() {
amc_found=tst_alive_amc();
if (!amc_found && !find_amc())
return Error_0("STOP! amc not running");
BMessage mes(STORE_SEL),
reply;
StoredNote *notes;
Settings *settings;
ssize_t bytes=0;
int n,
items=0;
amc_application.SendMessage(&mes,&reply);
puts("amc did reply");
switch (reply.what) {
case CONTENTS_SEL:
reply.FindData(SELD_NOTES,B_OBJECT_TYPE,(const void**)(¬es),&bytes);
items=bytes/sizeof(StoredNote);
reply.FindData(SETTINGS,B_OBJECT_TYPE,(const void**)(&settings),&bytes);
break;
default: return Error_0("seld notes: unknown reply");
}
pointer ptr,
out=nil_pointer();
for (n=0;n<items;++n) {
ptr=cons(mk_integer(notes[n].lnr),
cons(mk_integer(notes[n].snr),
cons(mk_integer(notes[n].sign),
cons(mk_integer(notes[n].dur),nil_pointer()))));
out=cons(ptr,out);
}
ptr=cons(mk_integer(settings->meter),nil_pointer());
ptr=cons(mk_symbol("meter"),ptr);
ptr=cons(ptr,nil_pointer());
return cons(ptr,out);
}
*/ void Panic_Series_Debug(const REBSER *series, const char *file, int line)
/*
** This could be done in the PANIC_SERIES macro, but having it
** as an actual function gives you a place to set breakpoints.
**
***********************************************************************/
{
Debug_Fmt("Panic_Series() in %s at line %d", file, line);
if (*series->guard == 1020) // should make valgrind or asan alert
panic Error_0(RE_MISC);
panic Error_0(RE_MISC); // just in case it didn't crash
}
*/ static void Prin_OS_String(const void *p, REBCNT len, REBOOL uni)
/*
** Print a string, but no line terminator or space.
**
** The width of the input is specified by UNI.
**
***********************************************************************/
{
#define BUF_SIZE 1024
REBYTE buffer[BUF_SIZE]; // on stack
REBYTE *buf = &buffer[0];
REBINT n;
REBCNT len2;
const REBYTE *bp = uni ? NULL : cast(const REBYTE *, p);
const REBUNI *up = uni ? cast(const REBUNI *, p) : NULL;
if (!p) panic Error_0(RE_NO_PRINT_PTR);
// Determine length if not provided:
if (len == UNKNOWN) len = uni ? Strlen_Uni(up) : LEN_BYTES(bp);
SET_FLAG(Req_SIO->flags, RRF_FLUSH);
Req_SIO->actual = 0;
Req_SIO->common.data = buf;
buffer[0] = 0; // for debug tracing
while ((len2 = len) > 0) {
Do_Signals();
// returns # of chars, size returns buf bytes output
n = Encode_UTF8(
buf,
BUF_SIZE-4,
uni ? cast(const void *, up) : cast(const void *, bp),
&len2,
uni,
OS_CRLF
);
if (n == 0) break;
Req_SIO->length = len2; // byte size of buffer
if (uni) up += n; else bp += n;
len -= n;
OS_DO_DEVICE(Req_SIO, RDC_WRITE);
if (Req_SIO->error) panic Error_0(RE_IO_ERROR);
}
}
*/ RL_API void RL_Protect_GC(REBSER *series, u32 flags)
/*
** Protect memory from garbage collection.
**
** Returns:
** nothing
** Arguments:
** series - a series to protect (block, string, image, ...)
** flags - set to 1 to protect, 0 to unprotect
** Notes:
** You should only use this function when absolutely necessary,
** because it bypasses garbage collection for the specified series.
** Meaning: if you protect a series, it will never be freed.
** Also, you only need this function if you allocate several series
** such as strings, blocks, images, etc. within the same command
** and you don't store those references somewhere where the GC can
** find them, such as in an existing block or object (variable).
**
***********************************************************************/
{
// !!! With series flags in short supply, this undesirable routine
// was removed along with SER_KEEP. (Note that it is not possible
// to simply flip off the SER_MANAGED bit, because there is more
// involved in tracking the managed state than just that bit.)
//
// For the purpose intended by this routine, use the GC_Mark_Hook (or
// its hopeful improved successors.)
panic Error_0(RE_MISC);
}
*/ REBSER *Collect_Words(REBVAL value[], REBVAL prior_value[], REBCNT modes)
/*
** Collect words from a prior block and new block.
**
***********************************************************************/
{
REBSER *series;
REBCNT start;
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
CHECK_BIND_TABLE;
if (SERIES_TAIL(BUF_WORDS)) panic Error_0(RE_WORD_LIST); // still in use
if (prior_value)
Collect_Words_Inner_Loop(binds, &prior_value[0], BIND_ALL);
start = SERIES_TAIL(BUF_WORDS);
Collect_Words_Inner_Loop(binds, &value[0], modes);
// Reset word markers:
for (value = BLK_HEAD(BUF_WORDS); NOT_END(value); value++)
binds[VAL_WORD_CANON(value)] = 0;
series = Copy_Array_At_Max_Shallow(
BUF_WORDS, start, SERIES_TAIL(BUF_WORDS) - start
);
RESET_TAIL(BUF_WORDS); // allow reuse
CHECK_BIND_TABLE;
return series;
}
*/ void Set_Var(const REBVAL *word, const REBVAL *value)
/*
** Set the word (variable) value. (Use macro when possible).
**
***********************************************************************/
{
REBINT index = VAL_WORD_INDEX(word);
struct Reb_Call *call;
REBSER *frm;
assert(!THROWN(value));
if (!HAS_FRAME(word)) raise Error_1(RE_NOT_DEFINED, word);
assert(VAL_WORD_FRAME(word));
// Print("Set %s to %s [frame: %x idx: %d]", Get_Word_Name(word), Get_Type_Name(value), VAL_WORD_FRAME(word), VAL_WORD_INDEX(word));
if (index > 0) {
frm = VAL_WORD_FRAME(word);
if (VAL_GET_EXT(FRM_WORDS(frm) + index, EXT_WORD_LOCK))
raise Error_1(RE_LOCKED_WORD, word);
FRM_VALUES(frm)[index] = *value;
return;
}
if (index == 0) raise Error_0(RE_SELF_PROTECTED);
// Find relative value:
call = DSF;
while (VAL_WORD_FRAME(word) != VAL_WORD_FRAME(DSF_LABEL(call))) {
call = PRIOR_DSF(call);
if (!call) raise Error_1(RE_NOT_DEFINED, word); // change error !!!
}
*DSF_ARG(call, -index) = *value;
}
*/ void Assert_Public_Object(const REBVAL *value)
/*
***********************************************************************/
{
REBVAL *word = BLK_HEAD(VAL_OBJ_WORDS(value));
for (; NOT_END(word); word++)
if (VAL_GET_EXT(word, EXT_WORD_HIDE)) raise Error_0(RE_HIDDEN);
}
*/ void Init_StdIO(void)
/*
***********************************************************************/
{
//OS_CALL_DEVICE(RDI_STDIO, RDC_INIT);
Req_SIO = OS_MAKE_DEVREQ(RDI_STDIO);
if (!Req_SIO) panic Error_0(RE_IO_ERROR);
// The device is already open, so this call will just setup
// the request fields properly.
OS_DO_DEVICE(Req_SIO, RDC_OPEN);
}
pointer send_notes(pointer a) {
amc_found=tst_alive_amc();
if (!amc_found && !find_amc())
return Error_0("STOP! amc not running");
static StoredNote buffer[stored_notes_max];
int n,
lst_note=0,
list_len=list_length(a);
pointer p;
if (list_len>=stored_notes_max) return Error_0("send_notes: list too long");
for (n=0,p=a;n<list_len;++n,p=cdr(p)) {
buffer[n].lnr=int_value(list_ref(car(p),0));
buffer[n].snr=int_value(list_ref(car(p),1));
buffer[n].sign=int_value(list_ref(car(p),2));
buffer[n].dur=int_value(list_ref(car(p),3));
//printf("n=%d lnr=%d\n",n,buffer[n].lnr);
}
BMessage mes(SEND_NOTES);
mes.AddData(SENT_NOTES,B_OBJECT_TYPE,buffer,n*sizeof(StoredNote));
amc_application.SendMessage(&mes);
return mk_extra();
}
*/ void Change_Case(REBVAL *out, REBVAL *val, REBVAL *part, REBOOL upper)
/*
** Common code for string case handling.
**
***********************************************************************/
{
REBCNT len;
REBCNT n;
*out = *val;
if (IS_CHAR(val)) {
REBUNI c = VAL_CHAR(val);
if (c < UNICODE_CASES) {
c = upper ? UP_CASE(c) : LO_CASE(c);
}
VAL_CHAR(out) = c;
return;
}
// String series:
if (IS_PROTECT_SERIES(VAL_SERIES(val))) raise Error_0(RE_PROTECTED);
len = Partial(val, 0, part, 0);
n = VAL_INDEX(val);
len += n;
if (VAL_BYTE_SIZE(val)) {
REBYTE *bp = VAL_BIN(val);
if (upper)
for (; n < len; n++) bp[n] = (REBYTE)UP_CASE(bp[n]);
else {
for (; n < len; n++) bp[n] = (REBYTE)LO_CASE(bp[n]);
}
} else {
REBUNI *up = VAL_UNI(val);
if (upper) {
for (; n < len; n++) {
if (up[n] < UNICODE_CASES) up[n] = UP_CASE(up[n]);
}
}
else {
for (; n < len; n++) {
if (up[n] < UNICODE_CASES) up[n] = LO_CASE(up[n]);
}
}
}
}
*/ REBYTE *Reset_Buffer(REBSER *buf, REBCNT len)
/*
** Setup to reuse a shared buffer. Expand it if needed.
**
** NOTE:The tail is set to the length position.
**
***********************************************************************/
{
if (!buf) panic Error_0(RE_NO_BUFFER);
RESET_TAIL(buf);
if (SERIES_BIAS(buf)) Reset_Bias(buf);
Expand_Series(buf, 0, len); // sets new tail
return BIN_DATA(buf);
}
*/ void Validate_Port(REBSER *port, REBCNT action)
/*
** Because port actors are exposed to the user level, we must
** prevent them from being called with invalid values.
**
***********************************************************************/
{
if (
action >= A_MAX_ACTION
|| port->tail > 50
|| SERIES_WIDE(port) != sizeof(REBVAL)
|| !IS_FRAME(BLK_HEAD(port))
|| !IS_OBJECT(BLK_SKIP(port, STD_PORT_SPEC))
) {
raise Error_0(RE_INVALID_PORT);
}
}
*/ static void Print_OS_Line(void)
/*
** Print a new line.
**
***********************************************************************/
{
// !!! Don't put const literal directly into mutable Req_SIO->data
static REBYTE newline[] = "\n";
Req_SIO->common.data = newline;
Req_SIO->length = 1;
Req_SIO->actual = 0;
OS_DO_DEVICE(Req_SIO, RDC_WRITE);
if (Req_SIO->error) panic Error_0(RE_IO_ERROR);
}
/* set storage memory to external addr: raw_addr */
static void set_ext_storage (REBVAL *out, REBINT raw_size, REBUPT raw_addr)
{
REBSER *data_ser = VAL_STRUCT_DATA_BIN(out);
REBSER *ser = NULL;
if (raw_size >= 0 && raw_size != cast(REBINT, VAL_STRUCT_LEN(out)))
raise Error_0(RE_INVALID_DATA);
ser = Make_Series(
SERIES_LEN(data_ser) + 1, // include term.
SERIES_WIDE(data_ser),
Is_Array_Series(data_ser) ? (MKS_ARRAY | MKS_EXTERNAL) : MKS_EXTERNAL
);
ser->data = (REBYTE*)raw_addr;
VAL_STRUCT_DATA_BIN(out) = ser;
MANAGE_SERIES(ser);
}
*/ static void Loop_Integer(REBVAL *out, REBVAL *var, REBSER* body, REBI64 start, REBI64 end, REBI64 incr)
/*
***********************************************************************/
{
VAL_SET(var, REB_INTEGER);
SET_NONE(out); // Default result to NONE if the loop does not run
while ((incr > 0) ? start <= end : start >= end) {
VAL_INT64(var) = start;
if (Do_Block_Throws(out, body, 0)) {
if (Loop_Throw_Should_Return(out)) break;
}
if (!IS_INTEGER(var)) raise Error_Has_Bad_Type(var);
start = VAL_INT64(var);
if (REB_I64_ADD_OF(start, incr, &start))
raise Error_0(RE_OVERFLOW);
}
}
*/ void Collect_Start(REBCNT modes)
/*
** Use the Bind_Table to start collecting new words for
** a frame. Use Collect_End() when done.
**
** WARNING: Do not call code that might call BIND or otherwise
** make use of the Bind_Table or the Word cache array (BUF_WORDS).
**
***********************************************************************/
{
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
CHECK_BIND_TABLE;
// Reuse a global word list block because length of block cannot
// be known until all words are scanned. Then copy this block.
if (SERIES_TAIL(BUF_WORDS)) panic Error_0(RE_WORD_LIST); // still in use
// Add the SELF word to slot zero.
if ((modes = (modes & BIND_NO_SELF)?0:SYM_SELF))
binds[modes] = -1; // (cannot use zero here)
Val_Init_Word_Typed(BLK_HEAD(BUF_WORDS), REB_WORD, modes, ALL_64);
SERIES_TAIL(BUF_WORDS) = 1;
}
*/ REBVAL *Get_Var_Core(const REBVAL *word, REBOOL trap, REBOOL writable)
/*
** Get the word--variable--value. (Generally, use the macros like
** GET_VAR or GET_MUTABLE_VAR instead of this). This routine is
** called quite a lot and so attention to performance is important.
**
** Coded assuming most common case is trap=TRUE and writable=FALSE
**
***********************************************************************/
{
REBSER *context = VAL_WORD_FRAME(word);
if (context) {
REBINT index = VAL_WORD_INDEX(word);
// POSITIVE INDEX: The word is bound directly to a value inside
// a frame, and represents the zero-based offset into that series.
// This is how values would be picked out of object-like things...
// (Including looking up 'append' in the user context.)
if (index > 0) {
REBVAL *value;
if (
writable &&
VAL_GET_EXT(FRM_WORDS(context) + index, EXT_WORD_LOCK)
) {
if (trap) raise Error_1(RE_LOCKED_WORD, word);
return NULL;
}
value = FRM_VALUES(context) + index;
assert(!THROWN(value));
return value;
}
// NEGATIVE INDEX: Word is stack-relative bound to a function with
// no persistent frame held by the GC. The value *might* be found
// on the stack (or not, if all instances of the function on the
// call stack have finished executing). We walk backward in the call
// stack to see if we can find the function's "identifying series"
// in a call frame...and take the first instance we see (even if
// multiple invocations are on the stack, most recent wins)
if (index < 0) {
struct Reb_Call *call = DSF;
// Get_Var could theoretically be called with no evaluation on
// the stack, so check for no DSF first...
while (call) {
if (
call->args_ready
&& context == VAL_FUNC_WORDS(DSF_FUNC(call))
) {
REBVAL *value;
assert(!IS_CLOSURE(DSF_FUNC(call)));
if (
writable &&
VAL_GET_EXT(
VAL_FUNC_PARAM(DSF_FUNC(call), -index),
EXT_WORD_LOCK
)
) {
if (trap) raise Error_1(RE_LOCKED_WORD, word);
return NULL;
}
value = DSF_ARG(call, -index);
assert(!THROWN(value));
return value;
}
call = PRIOR_DSF(call);
}
if (trap) raise Error_1(RE_NO_RELATIVE, word);
return NULL;
}
// ZERO INDEX: The word is SELF. Although the information needed
// to produce an OBJECT!-style REBVAL lives in the zero offset
// of the frame, it's not a value that we can return a direct
// pointer to. Use GET_VAR_INTO instead for that.
assert(!IS_SELFLESS(context));
if (trap) raise Error_0(RE_SELF_PROTECTED);
return NULL; // is this a case where we should *always* trap?
}
if (trap) raise Error_1(RE_NOT_DEFINED, word);
return NULL;
}
*/ static void Check_Overflow(REBDEC dval)
/*
***********************************************************************/
{
if (!FINITE(dval)) raise Error_0(RE_OVERFLOW);
}
*/ void Resolve_Context(REBSER *target, REBSER *source, REBVAL *only_words, REBFLG all, REBFLG expand)
/*
** Only_words can be a block of words or an index in the target
** (for new words).
**
***********************************************************************/
{
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
REBVAL *words;
REBVAL *vals;
REBINT n;
REBINT m;
REBCNT i = 0;
CHECK_BIND_TABLE;
if (IS_PROTECT_SERIES(target)) raise Error_0(RE_PROTECTED);
if (IS_INTEGER(only_words)) { // Must be: 0 < i <= tail
i = VAL_INT32(only_words); // never <= 0
if (i == 0) i = 1;
if (i >= target->tail) return;
}
Collect_Start(BIND_NO_SELF); // DO NOT TRAP IN THIS SECTION
n = 0;
// If limited resolve, tag the word ids that need to be copied:
if (i) {
// Only the new words of the target:
for (words = FRM_WORD(target, i); NOT_END(words); words++)
binds[VAL_BIND_CANON(words)] = -1;
n = SERIES_TAIL(target) - 1;
}
else if (IS_BLOCK(only_words)) {
// Limit exports to only these words:
for (words = VAL_BLK_DATA(only_words); NOT_END(words); words++) {
if (IS_WORD(words) || IS_SET_WORD(words)) {
binds[VAL_WORD_CANON(words)] = -1;
n++;
}
}
}
// Expand target as needed:
if (expand && n > 0) {
// Determine how many new words to add:
for (words = FRM_WORD(target, 1); NOT_END(words); words++)
if (binds[VAL_BIND_CANON(words)]) n--;
// Expand frame by the amount required:
if (n > 0) Expand_Frame(target, n, 0);
else expand = 0;
}
// Maps a word to its value index in the source context.
// Done by marking all source words (in bind table):
words = FRM_WORDS(source)+1;
for (n = 1; NOT_END(words); n++, words++) {
if (IS_NONE(only_words) || binds[VAL_BIND_CANON(words)])
binds[VAL_WORD_CANON(words)] = n;
}
// Foreach word in target, copy the correct value from source:
n = i ? i : 1;
vals = FRM_VALUE(target, n);
for (words = FRM_WORD(target, n); NOT_END(words); words++, vals++) {
if ((m = binds[VAL_BIND_CANON(words)])) {
binds[VAL_BIND_CANON(words)] = 0; // mark it as set
if (
!VAL_GET_EXT(words, EXT_WORD_LOCK)
&& (all || IS_UNSET(vals))
) {
if (m < 0) SET_UNSET(vals); // no value in source context
else *vals = *FRM_VALUE(source, m);
//Debug_Num("type:", VAL_TYPE(vals));
//Debug_Str(Get_Word_Name(words));
}
}
}
// Add any new words and values:
if (expand) {
REBVAL *val;
words = FRM_WORDS(source)+1;
for (n = 1; NOT_END(words); n++, words++) {
if (binds[VAL_BIND_CANON(words)]) {
// Note: no protect check is needed here
binds[VAL_BIND_CANON(words)] = 0;
val = Append_Frame(target, 0, VAL_BIND_SYM(words));
*val = *FRM_VALUE(source, n);
}
}
}
else {
// Reset bind table (do not use Collect_End):
if (i) {
for (words = FRM_WORD(target, i); NOT_END(words); words++)
binds[VAL_BIND_CANON(words)] = 0;
}
else if (IS_BLOCK(only_words)) {
for (words = VAL_BLK_DATA(only_words); NOT_END(words); words++) {
if (IS_WORD(words) || IS_SET_WORD(words)) binds[VAL_WORD_CANON(words)] = 0;
}
}
else {
for (words = FRM_WORDS(source)+1; NOT_END(words); words++)
binds[VAL_BIND_CANON(words)] = 0;
}
}
CHECK_BIND_TABLE;
RESET_TAIL(BUF_WORDS); // allow reuse, trapping ok now
}
*/ int Do_Port_Action(struct Reb_Call *call_, REBSER *port, REBCNT action)
/*
** Call a PORT actor (action) value. Search PORT actor
** first. If not found, search the PORT scheme actor.
**
** NOTE: stack must already be setup correctly for action, and
** the caller must cleanup the stack.
**
***********************************************************************/
{
REBVAL *actor;
REBCNT n = 0;
assert(action < A_MAX_ACTION);
// Verify valid port (all of these must be false):
if (
// Must be = or larger than std port:
(SERIES_TAIL(port) < STD_PORT_MAX) ||
// Must be an object series:
!IS_FRAME(BLK_HEAD(port)) ||
// Must have a spec object:
!IS_OBJECT(BLK_SKIP(port, STD_PORT_SPEC))
) {
raise Error_0(RE_INVALID_PORT);
}
// Get actor for port, if it has one:
actor = BLK_SKIP(port, STD_PORT_ACTOR);
if (IS_NONE(actor)) return R_NONE;
// If actor is a native function:
if (IS_NATIVE(actor))
return cast(REBPAF, VAL_FUNC_CODE(actor))(call_, port, action);
// actor must be an object:
if (!IS_OBJECT(actor)) raise Error_0(RE_INVALID_ACTOR);
// Dispatch object function:
n = Find_Action(actor, action);
actor = Obj_Value(actor, n);
if (!n || !actor || !ANY_FUNC(actor))
raise Error_1(RE_NO_PORT_ACTION, Get_Action_Word(action));
if (Redo_Func_Throws(actor)) {
// No special handling needed, as we are just going to return
// the output value in D_OUT anyway.
}
return R_OUT;
// If not in PORT actor, use the SCHEME actor:
#ifdef no_longer_used
if (n == 0) {
actor = Obj_Value(scheme, STD_SCHEME_actor);
if (!actor) goto err;
if (IS_NATIVE(actor)) goto fun;
if (!IS_OBJECT(actor)) goto err; //vTrap_Expect(value, STD_PORT_actor, REB_OBJECT);
n = Find_Action(actor, action);
if (n == 0) goto err;
}
#endif
}
*/ void Remove_Series(REBSER *series, REBCNT index, REBINT len)
/*
** Remove a series of values (bytes, longs, reb-vals) from the
** series at the given index.
**
***********************************************************************/
{
REBCNT start;
REBCNT length;
REBYTE *data;
if (len <= 0) return;
// Optimized case of head removal:
if (index == 0) {
if ((REBCNT)len > series->tail) len = series->tail;
SERIES_TAIL(series) -= len;
if (SERIES_TAIL(series) == 0) {
// Reset bias to zero:
len = SERIES_BIAS(series);
SERIES_SET_BIAS(series, 0);
SERIES_REST(series) += len;
series->data -= SERIES_WIDE(series) * len;
CLEAR(series->data, SERIES_WIDE(series)); // terminate
} else {
// Add bias to head:
REBCNT bias = SERIES_BIAS(series);
if (REB_U32_ADD_OF(bias, len, &bias))
raise Error_0(RE_OVERFLOW);
if (bias > 0xffff) { //bias is 16-bit, so a simple SERIES_ADD_BIAS could overflow it
REBYTE *data = series->data;
data += SERIES_WIDE(series) * len;
series->data -= SERIES_WIDE(series) * SERIES_BIAS(series);
SERIES_REST(series) += SERIES_BIAS(series);
SERIES_SET_BIAS(series, 0);
memmove(series->data, data, SERIES_USED(series));
} else {
SERIES_SET_BIAS(series, bias);
SERIES_REST(series) -= len;
series->data += SERIES_WIDE(series) * len;
if ((start = SERIES_BIAS(series))) {
// If more than half biased:
if (start >= MAX_SERIES_BIAS || start > SERIES_REST(series))
Reset_Bias(series);
}
}
}
return;
}
if (index >= series->tail) return;
start = index * SERIES_WIDE(series);
// Clip if past end and optimize the remove operation:
if (len + index >= series->tail) {
series->tail = index;
CLEAR(series->data + start, SERIES_WIDE(series));
return;
}
length = (SERIES_LEN(series) + 1) * SERIES_WIDE(series); // include term.
series->tail -= (REBCNT)len;
len *= SERIES_WIDE(series);
data = series->data + start;
memmove(data, data + len, length - (start + len));
CHECK_MEMORY(5);
}
*/ REBYTE *Temp_Byte_Chars_May_Fail(const REBVAL *val, REBINT max_len, REBCNT *length, REBINT opts)
/*
** NOTE: This function returns a temporary result, and uses an internal
** buffer. Do not use it recursively. Also, it will Trap on errors.
**
** Prequalifies a string before using it with a function that
** expects it to be 8-bits. It would be used for instance to convert
** a string that is potentially REBUNI-wide into a form that can be used
** with a Scan_XXX routine, that is expecting ASCII or UTF-8 source.
** (Many TO-XXX conversions from STRING re-use that scanner logic.)
**
** Returns a temporary string and sets the length field.
**
** Opts can be:
** 0 - no special options
** 1 - allow UTF8 (val is converted to UTF8 during qualification)
** 2 - allow binary
**
** Checks or converts it:
**
** 1. it is byte string (not unicode)
** 2. if unicode, copy and return as temp byte string
** 3. it's actual content (less space, newlines) <= max len
** 4. it does not contain other values ("123 456")
** 5. it's not empty or only whitespace
**
***********************************************************************/
{
REBCNT tail = VAL_TAIL(val);
REBCNT index = VAL_INDEX(val);
REBCNT len;
REBUNI c;
REBYTE *bp;
REBSER *src = VAL_SERIES(val);
if (index > tail) raise Error_0(RE_PAST_END);
Resize_Series(BUF_FORM, max_len+1);
bp = BIN_HEAD(BUF_FORM);
// Skip leading whitespace:
for (; index < tail; index++) {
c = GET_ANY_CHAR(src, index);
if (!IS_SPACE(c)) break;
}
// Copy chars that are valid:
for (; index < tail; index++) {
c = GET_ANY_CHAR(src, index);
if (opts < 2 && c >= 0x80) {
if (opts == 0) raise Error_0(RE_INVALID_CHARS);
len = Encode_UTF8_Char(bp, c);
max_len -= len;
bp += len;
}
else if (!IS_SPACE(c)) {
*bp++ = (REBYTE)c;
max_len--;
}
else break;
if (max_len < 0)
raise Error_0(RE_TOO_LONG);
}
// Rest better be just spaces:
for (; index < tail; index++) {
c = GET_ANY_CHAR(src, index);
if (!IS_SPACE(c)) raise Error_0(RE_INVALID_CHARS);
}
*bp= 0;
len = bp - BIN_HEAD(BUF_FORM);
if (len == 0) raise Error_0(RE_TOO_SHORT);
if (length) *length = len;
return BIN_HEAD(BUF_FORM);
}
/* parse struct attribute */
static void parse_attr (REBVAL *blk, REBINT *raw_size, REBUPT *raw_addr)
{
REBVAL *attr = VAL_BLK_DATA(blk);
*raw_size = -1;
*raw_addr = 0;
while (NOT_END(attr)) {
if (IS_SET_WORD(attr)) {
switch (VAL_WORD_CANON(attr)) {
case SYM_RAW_SIZE:
++ attr;
if (IS_INTEGER(attr)) {
if (*raw_size > 0) /* duplicate raw-size */
raise Error_Invalid_Arg(attr);
*raw_size = VAL_INT64(attr);
if (*raw_size <= 0)
raise Error_Invalid_Arg(attr);
}
else
raise Error_Invalid_Arg(attr);
break;
case SYM_RAW_MEMORY:
++ attr;
if (IS_INTEGER(attr)) {
if (*raw_addr != 0) /* duplicate raw-memory */
raise Error_Invalid_Arg(attr);
*raw_addr = VAL_UNT64(attr);
if (*raw_addr == 0)
raise Error_Invalid_Arg(attr);
}
else
raise Error_Invalid_Arg(attr);
break;
case SYM_EXTERN:
++ attr;
if (*raw_addr != 0) /* raw-memory is exclusive with extern */
raise Error_Invalid_Arg(attr);
if (!IS_BLOCK(attr)
|| VAL_LEN(attr) != 2) {
raise Error_Invalid_Arg(attr);
}
else {
REBVAL *lib;
REBVAL *sym;
CFUNC *addr;
lib = VAL_BLK_SKIP(attr, 0);
sym = VAL_BLK_SKIP(attr, 1);
if (!IS_LIBRARY(lib))
raise Error_Invalid_Arg(attr);
if (IS_CLOSED_LIB(VAL_LIB_HANDLE(lib)))
raise Error_0(RE_BAD_LIBRARY);
if (!ANY_BINSTR(sym))
raise Error_Invalid_Arg(sym);
addr = OS_FIND_FUNCTION(
LIB_FD(VAL_LIB_HANDLE(lib)), s_cast(VAL_DATA(sym))
);
if (!addr)
raise Error_1(RE_SYMBOL_NOT_FOUND, sym);
*raw_addr = cast(REBUPT, addr);
}
break;
/*
case SYM_ALIGNMENT:
++ attr;
if (IS_INTEGER(attr)) {
alignment = VAL_INT64(attr);
} else {
raise Error_Invalid_Arg(attr);
}
break;
*/
default:
raise Error_Invalid_Arg(attr);
}
}
else
raise Error_Invalid_Arg(attr);
++ attr;
}
}
