Skip to content

Commit

Permalink
Use function args as frame reference of function variables instead of…
Browse files Browse the repository at this point in the history 
… function body.

Function body was unsuitable (unsafe) for the purpose since in R3 it is possible to define distinct functions sharing the same body.
Corrects bug#2025
  • Loading branch information
@ladislav
ladislav committed Aug 20, 2013
1 parent 4d9840f commit 3561c16
Show file tree
Hide file tree
Showing 3 changed files with 23 additions and 71 deletions.
6 changes: 3 additions & 3 deletions src/core/c-do.c
View file
Expand Up @@ -342,7 +342,7 @@ void Trace_Arg(REBINT num, REBVAL *arg, REBVAL *path)
VAL_WORD_SYM(tos) = word ? word : SYM__APPLY_;
VAL_WORD_INDEX(tos) = -1; // avoid GC access to invalid FRAME above
if (func) {
VAL_WORD_FRAME(tos) = VAL_FUNC_BODY(func);
VAL_WORD_FRAME(tos) = VAL_FUNC_ARGS(func);
// Save FUNC value for safety (spec, args, code):
tos++;
*tos = *func; // the DSF_FUNC
Expand Down Expand Up @@ -1737,7 +1737,7 @@ x*/ static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN
REBINT n;

// Caller must: Prep_Func + Args above
VAL_WORD_FRAME(DSF_WORD(DSF)) = VAL_FUNC_BODY(func_val);
VAL_WORD_FRAME(DSF_WORD(DSF)) = VAL_FUNC_ARGS(func_val);
n = DS_ARGC - (SERIES_TAIL(VAL_FUNC_WORDS(func_val)) - 1);
for (; n > 0; n--) DS_PUSH_NONE;
Func_Dispatch[VAL_TYPE(func_val)-REB_NATIVE](func_val);
Expand Down Expand Up @@ -1818,7 +1818,7 @@ x*/ static REBINT Do_Args_Light(REBVAL *func, REBVAL *path, REBSER *block, REBCN
memmove(DS_ARG(1), DS_TOP-(inew-1), inew * sizeof(REBVAL));
DSP = DS_ARG_BASE + inew; // new TOS
//Dump_Block(DS_ARG(1), inew);
VAL_WORD_FRAME(DSF_WORD(DSF)) = VAL_FUNC_BODY(func_val);
VAL_WORD_FRAME(DSF_WORD(DSF)) = VAL_FUNC_ARGS(func_val);
*DSF_FUNC(DSF) = *func_val;
Func_Dispatch[VAL_TYPE(func_val)-REB_NATIVE](func_val);
}
Expand Down
30 changes: 15 additions & 15 deletions src/core/c-frame.c
View file
Expand Up @@ -471,7 +471,7 @@
// Rebind functions:
for (val = BLK_SKIP(obj, 1); NOT_END(val); val++) {
if (IS_FUNCTION(val)) {
Bind_Relative(VAL_FUNC_ARGS(val), VAL_FUNC_BODY(val), VAL_FUNC_BODY(val));
Bind_Relative(VAL_FUNC_ARGS(val), VAL_FUNC_ARGS(val), VAL_FUNC_BODY(val));
}
else if (IS_CLOSURE(val)) {
}
Expand Down Expand Up @@ -935,7 +935,7 @@
/*
** Recursive function for relative function word binding.
**
** Note: body arg points to an identifying series of the function,
** Note: frame arg points to an identifying series of the function,
** not a normal frame. This will be used to verify the word fetch.
**
***********************************************************************/
Expand All @@ -960,14 +960,14 @@

/***********************************************************************
**
*/ void Bind_Relative(REBSER *words, REBSER *body, REBSER *block)
*/ void Bind_Relative(REBSER *words, REBSER *frame, REBSER *block)
/*
** Bind the words of a function block to a stack frame.
** To indicate the relative nature of the index, it is set to
** a negative offset.
**
** words: VAL_FUNC_ARGS(func)
** body: VAL_FUNC_BODY(func) - used as frame
** frame: VAL_FUNC_ARGS(func)
** block: block to bind
**
***********************************************************************/
Expand All @@ -986,7 +986,7 @@
for (index = 1; NOT_END(args); args++, index++)
binds[VAL_BIND_CANON(args)] = -index;

Bind_Relative_Words(body, block);
Bind_Relative_Words(frame, block);

// Reset binding table:
for (args = BLK_SKIP(words, 1); NOT_END(args); args++)
Expand All @@ -996,43 +996,43 @@

/***********************************************************************
**
*/ void Bind_Stack_Block(REBSER *body, REBSER *block)
*/ void Bind_Stack_Block(REBSER *frame, REBSER *block)
/*
***********************************************************************/
{
REBINT dsf = DSF;

// Find body (frame) on stack:
while (body != VAL_WORD_FRAME(DSF_WORD(dsf))) {
// Find frame on stack:
while (frame != VAL_WORD_FRAME(DSF_WORD(dsf))) {
dsf = PRIOR_DSF(dsf);
if (dsf <= 0) Trap0(RE_NOT_DEFINED); // better message !!!!
}

if (IS_FUNCTION(DSF_FUNC(dsf))) {
Bind_Relative(VAL_FUNC_ARGS(DSF_FUNC(dsf)), body, block);
Bind_Relative(VAL_FUNC_ARGS(DSF_FUNC(dsf)), frame, block);
}
}


/***********************************************************************
**
*/ void Bind_Stack_Word(REBSER *body, REBVAL *word)
*/ void Bind_Stack_Word(REBSER *frame, REBVAL *word)
/*
***********************************************************************/
{
REBINT dsf = DSF;
REBINT index;

// Find body (frame) on stack:
while (body != VAL_WORD_FRAME(DSF_WORD(dsf))) {
dsf = PRIOR_DSF(dsf);
if (dsf <= 0) Trap1(RE_NOT_IN_CONTEXT, word);
// Find frame on stack:
while (frame != VAL_WORD_FRAME(DSF_WORD(dsf))) {
dsf = PRIOR_DSF(dsf);
if (dsf <= 0) Trap1(RE_NOT_IN_CONTEXT, word);
}

if (IS_FUNCTION(DSF_FUNC(dsf))) {
index = Find_Arg_Index(VAL_FUNC_ARGS(DSF_FUNC(dsf)), VAL_WORD_SYM(word));
if (!index) Trap1(RE_NOT_IN_CONTEXT, word);
VAL_WORD_FRAME(word) = body;
VAL_WORD_FRAME(word) = frame;
VAL_WORD_INDEX(word) = -index;
} else
Crash(9100); // !!! function is not there!
Expand Down
58 changes: 5 additions & 53 deletions src/core/c-function.c
View file
Expand Up @@ -38,65 +38,18 @@
word - word, 'word, :word, /word
value - typeset! or none (valid datatypes)
Arg list provides:
Args list provides:
1. specifies arg order, arg kind (e.g. 'word)
2. specifies valid datatypes (typesets)
3. used for word and type in error output
4. used for debugging tools (stack dumps)
5. not used for MOLD (spec is used)
6. used as a (pseudo) frame of function variables
*/

#include "sys-core.h"

#ifdef not_used
void Dump_Func_Words(REBSER *words)
{
REBINT n;

for (n = 0; n < (REBINT)SERIES_TAIL(words); n++) {
Debug_Fmt("%d: %d", n, WORDS_HEAD(words)[n]);
}
}
#endif

#ifdef obsolete
/***********************************************************************
**
xx*/ REBSER *Make_Func_Words(REBSER *spec)
/*
** Make a word list part of a context block for a function spec.
** This series is stored in the ARGS field of the function value.
**
***********************************************************************/
{
REBVAL *word = BLK_HEAD(spec);
REBSER *words;
REBCNT n;
REBCNT len = 0;

// Count the number of words within the spec:
for (n = 0; n < SERIES_TAIL(spec); n++) {
if (ANY_WORD(word+n)) len++;
}

// Make the words table:
words = Make_Words(len+1);

// Skip 0th entry (because 0 is not valid for bind index).
len = 1;
WORDS_HEAD(words)[0] = 0;

// Initialize the words in the new table.
for (n = 0; n < SERIES_TAIL(spec); n++) {
if (ANY_WORD(word+n)) WORDS_HEAD(words)[len++] = n;
}
SERIES_TAIL(words) = len;
return words;
}
#endif

/***********************************************************************
**
*/ REBSER *List_Func_Words(REBVAL *func)
Expand Down Expand Up @@ -232,7 +185,6 @@ xx*/ REBSER *Make_Func_Words(REBSER *spec)

if (
!IS_BLOCK(def)
//// || type < REB_CLOSURE // for now
|| (len = VAL_LEN(def)) < 2
|| !IS_BLOCK(spec = VAL_BLK(def))
) return FALSE;
Expand All @@ -253,7 +205,7 @@ xx*/ REBSER *Make_Func_Words(REBSER *spec)
VAL_SET(value, type);

if (type == REB_FUNCTION)
Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value), VAL_FUNC_BODY(value));
Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value));

return TRUE;
}
Expand Down Expand Up @@ -290,7 +242,7 @@ xx*/ REBSER *Make_Func_Words(REBSER *spec)

// Rebind function words:
if (IS_FUNCTION(value))
Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value), VAL_FUNC_BODY(value));
Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value));

return TRUE;
}
Expand All @@ -303,7 +255,7 @@ xx*/ REBSER *Make_Func_Words(REBSER *spec)
***********************************************************************/
{
VAL_FUNC_SPEC(value) = VAL_FUNC_SPEC(func);
VAL_FUNC_ARGS(value) = VAL_FUNC_ARGS(func);
VAL_FUNC_ARGS(value) = Copy_Block(VAL_FUNC_ARGS(func), 0);
VAL_FUNC_BODY(value) = Clone_Block(VAL_FUNC_BODY(func));
}

Expand Down

0 comments on commit 3561c16

Please sign in to comment.