added string, character, symbol literals with c style escape sequences
This commit is contained in:
parent
dea9944270
commit
54aa947bab
423
stix/lib/comp.c
423
stix/lib/comp.c
@ -417,7 +417,7 @@ static int string_to_smint (stix_t* stix, stix_ucs_t* str, int radixed, stix_ooi
|
|||||||
|
|
||||||
if (negsign)
|
if (negsign)
|
||||||
{
|
{
|
||||||
/*if (value > STIX_SMINT_MIN) return -1;*/
|
/*if (value > -STIX_SMINT_MIN) */
|
||||||
if (value > ((stix_oow_t)STIX_SMINT_MAX + 1))
|
if (value > ((stix_oow_t)STIX_SMINT_MAX + 1))
|
||||||
{
|
{
|
||||||
stix->errnum = STIX_ERANGE;
|
stix->errnum = STIX_ERANGE;
|
||||||
@ -658,7 +658,7 @@ static int skip_comment (stix_t* stix)
|
|||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static int get_ident (stix_t* stix)
|
static int get_ident (stix_t* stix, stix_uci_t char_read_ahead)
|
||||||
{
|
{
|
||||||
/*
|
/*
|
||||||
* identifier := alpha-char (alpha-char | digit-char)*
|
* identifier := alpha-char (alpha-char | digit-char)*
|
||||||
@ -670,6 +670,11 @@ static int get_ident (stix_t* stix)
|
|||||||
c = stix->c->lxc.c;
|
c = stix->c->lxc.c;
|
||||||
stix->c->tok.type = STIX_IOTOK_IDENT;
|
stix->c->tok.type = STIX_IOTOK_IDENT;
|
||||||
|
|
||||||
|
if (char_read_ahead != STIX_UCI_EOF)
|
||||||
|
{
|
||||||
|
ADD_TOKEN_CHAR(stix, char_read_ahead);
|
||||||
|
}
|
||||||
|
|
||||||
get_more:
|
get_more:
|
||||||
do
|
do
|
||||||
{
|
{
|
||||||
@ -819,8 +824,7 @@ static int get_charlit (stix_t* stix)
|
|||||||
return -1;
|
return -1;
|
||||||
}
|
}
|
||||||
|
|
||||||
stix->c->tok.type = STIX_IOTOK_CHRLIT;
|
stix->c->tok.type = STIX_IOTOK_CHARLIT;
|
||||||
ADD_TOKEN_CHAR(stix, '$');
|
|
||||||
ADD_TOKEN_CHAR(stix, c);
|
ADD_TOKEN_CHAR(stix, c);
|
||||||
GET_CHAR (stix);
|
GET_CHAR (stix);
|
||||||
return 0;
|
return 0;
|
||||||
@ -835,8 +839,6 @@ static int get_strlit (stix_t* stix)
|
|||||||
* normal-character := character-except-single-quote
|
* normal-character := character-except-single-quote
|
||||||
*/
|
*/
|
||||||
|
|
||||||
/* TODO: C-like string */
|
|
||||||
|
|
||||||
stix_uci_t c = stix->c->lxc.c;
|
stix_uci_t c = stix->c->lxc.c;
|
||||||
stix->c->tok.type = STIX_IOTOK_STRLIT;
|
stix->c->tok.type = STIX_IOTOK_STRLIT;
|
||||||
|
|
||||||
@ -863,6 +865,168 @@ static int get_strlit (stix_t* stix)
|
|||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static int get_string (stix_t* stix, stix_uch_t end_char, stix_uch_t esc_char, int regex, stix_size_t preescaped)
|
||||||
|
{
|
||||||
|
stix_uci_t c;
|
||||||
|
stix_size_t escaped = preescaped;
|
||||||
|
stix_size_t digit_count = 0;
|
||||||
|
stix_uci_t c_acc = 0;
|
||||||
|
|
||||||
|
stix->c->tok.type = STIX_IOTOK_STRLIT;
|
||||||
|
|
||||||
|
while (1)
|
||||||
|
{
|
||||||
|
GET_CHAR_TO (stix, c);
|
||||||
|
|
||||||
|
if (c == STIX_UCI_EOF)
|
||||||
|
{
|
||||||
|
set_syntax_error (stix, STIX_SYNERR_STRNC, &stix->c->tok.loc /*&stix->c->lxc.l*/, STIX_NULL);
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (escaped == 3)
|
||||||
|
{
|
||||||
|
if (c >= '0' && c <= '7')
|
||||||
|
{
|
||||||
|
c_acc = c_acc * 8 + c - '0';
|
||||||
|
digit_count++;
|
||||||
|
if (digit_count >= escaped)
|
||||||
|
{
|
||||||
|
/* should i limit the max to 0xFF/0377?
|
||||||
|
* if (c_acc > 0377) c_acc = 0377;*/
|
||||||
|
ADD_TOKEN_CHAR (stix, c_acc);
|
||||||
|
escaped = 0;
|
||||||
|
}
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
ADD_TOKEN_CHAR (stix, c_acc);
|
||||||
|
escaped = 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else if (escaped == 2 || escaped == 4 || escaped == 8)
|
||||||
|
{
|
||||||
|
if (c >= '0' && c <= '9')
|
||||||
|
{
|
||||||
|
c_acc = c_acc * 16 + c - '0';
|
||||||
|
digit_count++;
|
||||||
|
if (digit_count >= escaped)
|
||||||
|
{
|
||||||
|
ADD_TOKEN_CHAR (stix, c_acc);
|
||||||
|
escaped = 0;
|
||||||
|
}
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
else if (c >= 'A' && c <= 'F')
|
||||||
|
{
|
||||||
|
c_acc = c_acc * 16 + c - 'A' + 10;
|
||||||
|
digit_count++;
|
||||||
|
if (digit_count >= escaped)
|
||||||
|
{
|
||||||
|
ADD_TOKEN_CHAR (stix, c_acc);
|
||||||
|
escaped = 0;
|
||||||
|
}
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
else if (c >= 'a' && c <= 'f')
|
||||||
|
{
|
||||||
|
c_acc = c_acc * 16 + c - 'a' + 10;
|
||||||
|
digit_count++;
|
||||||
|
if (digit_count >= escaped)
|
||||||
|
{
|
||||||
|
ADD_TOKEN_CHAR (stix, c_acc);
|
||||||
|
escaped = 0;
|
||||||
|
}
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
stix_uch_t rc;
|
||||||
|
|
||||||
|
rc = (escaped == 2)? 'x':
|
||||||
|
(escaped == 4)? 'u': 'U';
|
||||||
|
if (digit_count == 0)
|
||||||
|
ADD_TOKEN_CHAR (stix, rc);
|
||||||
|
else ADD_TOKEN_CHAR (stix, c_acc);
|
||||||
|
|
||||||
|
escaped = 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (escaped == 0 && c == end_char)
|
||||||
|
{
|
||||||
|
/* terminating quote */
|
||||||
|
/*GET_CHAR_TO (stix, c);*/
|
||||||
|
GET_CHAR (stix);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (escaped == 0 && c == esc_char)
|
||||||
|
{
|
||||||
|
escaped = 1;
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (escaped == 1)
|
||||||
|
{
|
||||||
|
if (c == 'n') c = '\n';
|
||||||
|
else if (c == 'r') c = '\r';
|
||||||
|
else if (c == 't') c = '\t';
|
||||||
|
else if (c == 'f') c = '\f';
|
||||||
|
else if (c == 'b') c = '\b';
|
||||||
|
else if (c == 'v') c = '\v';
|
||||||
|
else if (c == 'a') c = '\a';
|
||||||
|
else if (c >= '0' && c <= '7' && !regex)
|
||||||
|
{
|
||||||
|
/* i don't support the octal notation for a regular expression.
|
||||||
|
* it conflicts with the backreference notation between \1 and \7 inclusive. */
|
||||||
|
escaped = 3;
|
||||||
|
digit_count = 1;
|
||||||
|
c_acc = c - '0';
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
else if (c == 'x')
|
||||||
|
{
|
||||||
|
escaped = 2;
|
||||||
|
digit_count = 0;
|
||||||
|
c_acc = 0;
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
else if (c == 'u' && STIX_SIZEOF(stix_uch_t) >= 2)
|
||||||
|
{
|
||||||
|
escaped = 4;
|
||||||
|
digit_count = 0;
|
||||||
|
c_acc = 0;
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
else if (c == 'U' && STIX_SIZEOF(stix_uch_t) >= 4)
|
||||||
|
{
|
||||||
|
escaped = 8;
|
||||||
|
digit_count = 0;
|
||||||
|
c_acc = 0;
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
else if (regex)
|
||||||
|
{
|
||||||
|
/* if the following character doesn't compose a proper
|
||||||
|
* escape sequence, keep the escape character.
|
||||||
|
* an unhandled escape sequence can be handled
|
||||||
|
* outside this function since the escape character
|
||||||
|
* is preserved.*/
|
||||||
|
ADD_TOKEN_CHAR (stix, esc_char);
|
||||||
|
}
|
||||||
|
|
||||||
|
escaped = 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
ADD_TOKEN_CHAR (stix, c);
|
||||||
|
}
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
static int get_binsel (stix_t* stix)
|
static int get_binsel (stix_t* stix)
|
||||||
{
|
{
|
||||||
/*
|
/*
|
||||||
@ -944,21 +1108,31 @@ retry:
|
|||||||
|
|
||||||
case ':':
|
case ':':
|
||||||
stix->c->tok.type = STIX_IOTOK_COLON;
|
stix->c->tok.type = STIX_IOTOK_COLON;
|
||||||
ADD_TOKEN_CHAR(stix, c);
|
ADD_TOKEN_CHAR (stix, c);
|
||||||
GET_CHAR (stix);
|
GET_CHAR_TO (stix, c);
|
||||||
|
|
||||||
c = stix->c->lxc.c;
|
|
||||||
if (c == '=')
|
if (c == '=')
|
||||||
{
|
{
|
||||||
stix->c->tok.type = STIX_IOTOK_ASSIGN;
|
stix->c->tok.type = STIX_IOTOK_ASSIGN;
|
||||||
ADD_TOKEN_CHAR(stix, c);
|
ADD_TOKEN_CHAR (stix, c);
|
||||||
GET_CHAR (stix);
|
GET_CHAR (stix);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case '^':
|
case '^':
|
||||||
stix->c->tok.type = STIX_IOTOK_RETURN;
|
stix->c->tok.type = STIX_IOTOK_RETURN;
|
||||||
goto single_char_token;
|
ADD_TOKEN_CHAR(stix, c);
|
||||||
|
GET_CHAR_TO (stix, c);
|
||||||
|
#if 0
|
||||||
|
/* TODO: support explicit block return */
|
||||||
|
if (c == '^')
|
||||||
|
{
|
||||||
|
/* ^^ */
|
||||||
|
stix->c->tok.type == STIX_IOTOK_BLKRET;
|
||||||
|
ADD_TOKEN_CHAR (stix, c);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
break;
|
||||||
|
|
||||||
case '{': /* extension */
|
case '{': /* extension */
|
||||||
stix->c->tok.type = STIX_IOTOK_LBRACE;
|
stix->c->tok.type = STIX_IOTOK_LBRACE;
|
||||||
goto single_char_token;
|
goto single_char_token;
|
||||||
@ -1050,13 +1224,16 @@ retry:
|
|||||||
|
|
||||||
if (is_alphachar(c))
|
if (is_alphachar(c))
|
||||||
{
|
{
|
||||||
|
/* if a colon is found in the middle of a symbol,
|
||||||
|
* the last charater is expected to be a colon as well */
|
||||||
colon_required =1;
|
colon_required =1;
|
||||||
goto nextword;
|
goto nextword;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
else if (colon_required)
|
else if (colon_required)
|
||||||
{
|
{
|
||||||
set_syntax_error (stix, STIX_SYNERR_CLNMS, &stix->c->lxc.l, STIX_NULL);
|
/* the last character is not a colon */
|
||||||
|
set_syntax_error (stix, STIX_SYNERR_COLON, &stix->c->lxc.l, STIX_NULL);
|
||||||
return -1;
|
return -1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -1072,19 +1249,70 @@ retry:
|
|||||||
|
|
||||||
break;
|
break;
|
||||||
|
|
||||||
|
case 'C': /* a character with a C-style escape sequence */
|
||||||
|
case 'S': /* a string with a C-style escape sequences */
|
||||||
|
case 'M': /* a symbol with a C-style escape sequences */
|
||||||
|
{
|
||||||
|
stix_uci_t saved_c = c;
|
||||||
|
|
||||||
|
GET_CHAR_TO (stix, c);
|
||||||
|
if (c == '\'')
|
||||||
|
{
|
||||||
|
/*GET_CHAR (stix);*/
|
||||||
|
if (get_string(stix, '\'', '\\', 0, 0) <= -1) return -1;
|
||||||
|
|
||||||
|
if (saved_c == 'C')
|
||||||
|
{
|
||||||
|
if (stix->c->tok.name.len != 1)
|
||||||
|
{
|
||||||
|
set_syntax_error (stix, STIX_SYNERR_CHARLIT, &stix->c->tok.loc, &stix->c->tok.name);
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
stix->c->tok.type = STIX_IOTOK_CHARLIT;
|
||||||
|
}
|
||||||
|
else if (saved_c == 'M')
|
||||||
|
{
|
||||||
|
stix->c->tok.type = STIX_IOTOK_SYMLIT;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
if (get_ident(stix, saved_c) <= -1) return -1;
|
||||||
|
}
|
||||||
|
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* case 'B': TODO: byte string with a c-style escape sequence? */
|
||||||
|
|
||||||
|
/* case 'R':
|
||||||
|
TODO: regular expression?
|
||||||
|
GET_CHAR_TO (stix, c);
|
||||||
|
if (c == '\'')
|
||||||
|
{
|
||||||
|
GET_CHAR (stix);
|
||||||
|
if (get_rexlit(stix) <= -1) return -1;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
if (get_ident(stix, 'R') <= -1) return -1;
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
*/
|
||||||
|
|
||||||
default:
|
default:
|
||||||
if (is_alphachar(c))
|
if (is_alphachar(c))
|
||||||
{
|
{
|
||||||
if (get_ident (stix) <= -1) return -1;
|
if (get_ident(stix, STIX_UCI_EOF) <= -1) return -1;
|
||||||
}
|
}
|
||||||
else if (is_digitchar(c))
|
else if (is_digitchar(c))
|
||||||
{
|
{
|
||||||
if (get_numlit (stix, 0) <= -1) return -1;
|
if (get_numlit(stix, 0) <= -1) return -1;
|
||||||
}
|
}
|
||||||
else if (is_binselchar(c))
|
else if (is_binselchar(c))
|
||||||
{
|
{
|
||||||
/* binary selector */
|
/* binary selector */
|
||||||
if (get_binsel (stix) <= -1) return -1;
|
if (get_binsel(stix) <= -1) return -1;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
@ -2193,6 +2421,7 @@ printf ("\tjump\n");
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
printf ("\treturn_from_block\n");
|
||||||
if (emit_byte_instruction(stix,CODE_RETURN_FROM_BLOCK) <= -1) return -1;
|
if (emit_byte_instruction(stix,CODE_RETURN_FROM_BLOCK) <= -1) return -1;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -2347,9 +2576,9 @@ printf ("LARGE NOT IMPLEMENTED IN COMPILE_ARRAY_LITERAL\n");
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
||||||
case STIX_IOTOK_CHRLIT:
|
case STIX_IOTOK_CHARLIT:
|
||||||
STIX_ASSERT (stix->c->tok.name.len == 2);
|
STIX_ASSERT (stix->c->tok.name.len == 1);
|
||||||
lit = STIX_OOP_FROM_CHAR(stix->c->tok.name.ptr[1]);
|
lit = STIX_OOP_FROM_CHAR(stix->c->tok.name.ptr[0]);
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case STIX_IOTOK_STRLIT:
|
case STIX_IOTOK_STRLIT:
|
||||||
@ -2558,9 +2787,9 @@ printf ("\tpush context...\n");
|
|||||||
GET_TOKEN (stix);
|
GET_TOKEN (stix);
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case STIX_IOTOK_CHRLIT:
|
case STIX_IOTOK_CHARLIT:
|
||||||
STIX_ASSERT (stix->c->tok.name.len == 2); /* the token includes $ */
|
STIX_ASSERT (stix->c->tok.name.len == 1);
|
||||||
if (add_character_literal(stix, stix->c->tok.name.ptr[1], &index) <= -1 ||
|
if (add_character_literal(stix, stix->c->tok.name.ptr[0], &index) <= -1 ||
|
||||||
emit_positional_instruction(stix, CMD_PUSH_LITERAL, index) <= -1) return -1;
|
emit_positional_instruction(stix, CMD_PUSH_LITERAL, index) <= -1) return -1;
|
||||||
printf ("\tpush character literal %d\n", (int)index);
|
printf ("\tpush character literal %d\n", (int)index);
|
||||||
GET_TOKEN (stix);
|
GET_TOKEN (stix);
|
||||||
@ -2650,143 +2879,6 @@ static stix_byte_t send_message_cmd[] =
|
|||||||
CMD_SEND_MESSAGE_TO_SUPER
|
CMD_SEND_MESSAGE_TO_SUPER
|
||||||
};
|
};
|
||||||
|
|
||||||
#if 0
|
|
||||||
static int compile_unary_message (stix_t* stix, int to_super)
|
|
||||||
{
|
|
||||||
stix_size_t index;
|
|
||||||
|
|
||||||
while (stix->c->tok.type == STIX_IOTOK_IDENT)
|
|
||||||
{
|
|
||||||
if (add_symbol_literal(stix, &stix->c->tok.name, &index) <= -1) return -1;
|
|
||||||
|
|
||||||
printf ("adding binary symbol...");
|
|
||||||
print_ucs (&stix->c->tok.name);
|
|
||||||
printf ("\n");
|
|
||||||
GET_TOKEN (stix);
|
|
||||||
|
|
||||||
if (stix->c->tok.type == STIX_IOTOK_SEMICOLON) printf ("\tdup_stack for cascading\n");
|
|
||||||
/* check adhead if it will be followed by a cascaded message */
|
|
||||||
if (stix->c->tok.type == STIX_IOTOK_SEMICOLON &&
|
|
||||||
emit_byte_instruction(stix, CODE_DUP_STACKTOP) <= -1) return -1;
|
|
||||||
|
|
||||||
if (emit_double_positional_instruction(stix, send_message_cmd[to_super], 0, index) <= -1) return -1;
|
|
||||||
printf ("\tsend message %d with 0 arguments to %s\n", (int)index, (to_super? "super": "self"));
|
|
||||||
}
|
|
||||||
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
static int compile_binary_message (stix_t* stix, int to_super)
|
|
||||||
{
|
|
||||||
/*
|
|
||||||
* binary-message := binary-selector binary-argument
|
|
||||||
* binary-argument := expression-primary unary-message*
|
|
||||||
*/
|
|
||||||
stix_size_t index;
|
|
||||||
int to_super2;
|
|
||||||
stix_ucs_t binsel;
|
|
||||||
stix_size_t saved_binsels_len;
|
|
||||||
|
|
||||||
if (compile_unary_message(stix, to_super) <= -1) return -1;
|
|
||||||
|
|
||||||
while (stix->c->tok.type == STIX_IOTOK_BINSEL)
|
|
||||||
{
|
|
||||||
binsel = stix->c->tok.name;
|
|
||||||
saved_binsels_len = stix->c->mth.binsels.len;
|
|
||||||
|
|
||||||
if (clone_binary_selector(stix, &binsel) <= -1) goto oops;
|
|
||||||
|
|
||||||
GET_TOKEN (stix);
|
|
||||||
if (compile_expression_primary(stix, STIX_NULL, STIX_NULL, &to_super2) <= -1 ||
|
|
||||||
compile_unary_message(stix, to_super2) <= -1 ||
|
|
||||||
add_symbol_literal(stix, &binsel, &index) <= -1) goto oops;
|
|
||||||
|
|
||||||
if (stix->c->tok.type == STIX_IOTOK_SEMICOLON) printf ("\tdup_stack for cascading\n");
|
|
||||||
/* check ahead message cascading */
|
|
||||||
if (stix->c->tok.type == STIX_IOTOK_SEMICOLON &&
|
|
||||||
emit_byte_instruction(stix, CODE_DUP_STACKTOP) <= -1) goto oops;
|
|
||||||
|
|
||||||
if (emit_double_positional_instruction(stix, send_message_cmd[to_super], 1, index) <= -1) goto oops;
|
|
||||||
printf ("\tsend message %d with 1 arguments%s\n", (int)index, (to_super? " to super": ""));
|
|
||||||
|
|
||||||
/*stix->c->mth.binsels.len -= binsel.len;*/
|
|
||||||
stix->c->mth.binsels.len = saved_binsels_len;
|
|
||||||
}
|
|
||||||
|
|
||||||
return 0;
|
|
||||||
|
|
||||||
oops:
|
|
||||||
/*stix->c->mth.binsels.len -= binsel.len;*/
|
|
||||||
stix->c->mth.binsels.len -= saved_binsels_len;
|
|
||||||
return -1;
|
|
||||||
}
|
|
||||||
|
|
||||||
static int compile_keyword_message (stix_t* stix, int to_super)
|
|
||||||
{
|
|
||||||
/*
|
|
||||||
* keyword-message := (keyword keyword-argument)+
|
|
||||||
* keyword-argument := expression-primary unary-message* binary-message*
|
|
||||||
*/
|
|
||||||
|
|
||||||
stix_size_t index;
|
|
||||||
int to_super2;
|
|
||||||
stix_ucs_t kw, kwsel;
|
|
||||||
stix_ioloc_t kwsel_loc;
|
|
||||||
stix_size_t kwsel_len;
|
|
||||||
stix_size_t nargs = 0;
|
|
||||||
|
|
||||||
if (compile_binary_message(stix, to_super) <= -1) return -1;
|
|
||||||
if (stix->c->tok.type != STIX_IOTOK_KEYWORD) return 0;
|
|
||||||
|
|
||||||
kwsel_loc = stix->c->tok.loc;
|
|
||||||
kwsel_len = stix->c->mth.kwsels.len;
|
|
||||||
|
|
||||||
do
|
|
||||||
{
|
|
||||||
kw = stix->c->tok.name;
|
|
||||||
if (clone_keyword(stix, &kw) <= -1) goto oops;
|
|
||||||
|
|
||||||
GET_TOKEN (stix);
|
|
||||||
if (compile_expression_primary(stix, STIX_NULL, STIX_NULL, &to_super2) <= -1 ||
|
|
||||||
compile_binary_message(stix, to_super2) <= -1) goto oops;
|
|
||||||
|
|
||||||
if (nargs >= MAX_CODE_NARGS)
|
|
||||||
{
|
|
||||||
/* 'kw' points to only one segment of the full keyword message.
|
|
||||||
* if it parses an expression like 'aBlock value: 10 with: 20',
|
|
||||||
* 'kw' may point to 'value:' or 'with:'.
|
|
||||||
*/
|
|
||||||
set_syntax_error (stix, STIX_SYNERR_ARGFLOOD, &kwsel_loc, &kw);
|
|
||||||
goto oops;
|
|
||||||
}
|
|
||||||
|
|
||||||
nargs++;
|
|
||||||
}
|
|
||||||
while (stix->c->tok.type == STIX_IOTOK_KEYWORD);
|
|
||||||
|
|
||||||
kwsel.ptr = &stix->c->mth.kwsels.ptr[kwsel_len];
|
|
||||||
kwsel.len = stix->c->mth.kwsels.len - kwsel_len;
|
|
||||||
|
|
||||||
if (add_symbol_literal(stix, &kwsel, &index) <= -1) goto oops;
|
|
||||||
|
|
||||||
if (stix->c->tok.type == STIX_IOTOK_SEMICOLON) printf ("\tdup_stack for cascading\n");
|
|
||||||
|
|
||||||
if (stix->c->tok.type == STIX_IOTOK_SEMICOLON &&
|
|
||||||
emit_byte_instruction(stix, CODE_DUP_STACKTOP) <= -1) goto oops;
|
|
||||||
|
|
||||||
if (emit_double_positional_instruction(stix, send_message_cmd[to_super], nargs, index) <= -1) goto oops;
|
|
||||||
printf ("\tsend message %d [", (int)index);
|
|
||||||
print_ucs (&kwsel);
|
|
||||||
printf ("] with %d arguments to %s\n", (int)nargs, (to_super? "super": "self"));
|
|
||||||
stix->c->mth.kwsels.len = kwsel_len;
|
|
||||||
return 0;
|
|
||||||
|
|
||||||
oops:
|
|
||||||
stix->c->mth.kwsels.len = kwsel_len;
|
|
||||||
return -1;
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
|
|
||||||
static int compile_unary_message (stix_t* stix, int to_super)
|
static int compile_unary_message (stix_t* stix, int to_super)
|
||||||
{
|
{
|
||||||
stix_size_t index;
|
stix_size_t index;
|
||||||
@ -2795,12 +2887,11 @@ static int compile_unary_message (stix_t* stix, int to_super)
|
|||||||
|
|
||||||
do
|
do
|
||||||
{
|
{
|
||||||
printf ("adding binary symbol...");
|
|
||||||
print_ucs (&stix->c->tok.name);
|
|
||||||
printf ("\n");
|
|
||||||
if (add_symbol_literal(stix, &stix->c->tok.name, &index) <= -1 ||
|
if (add_symbol_literal(stix, &stix->c->tok.name, &index) <= -1 ||
|
||||||
emit_double_positional_instruction(stix, send_message_cmd[to_super], 0, index) <= -1) return -1;
|
emit_double_positional_instruction(stix, send_message_cmd[to_super], 0, index) <= -1) return -1;
|
||||||
printf ("\tsend message %d with 0 arguments to %s\n", (int)index, (to_super? "super": "self"));
|
printf ("\tsend unary message %d [", (int)index);
|
||||||
|
print_ucs (&stix->c->tok.name);
|
||||||
|
printf ("] with 0 arguments %s\n", (to_super? " to super": ""));
|
||||||
|
|
||||||
GET_TOKEN (stix);
|
GET_TOKEN (stix);
|
||||||
}
|
}
|
||||||
@ -2837,7 +2928,9 @@ static int compile_binary_message (stix_t* stix, int to_super)
|
|||||||
|
|
||||||
if (add_symbol_literal(stix, &binsel, &index) <= -1 ||
|
if (add_symbol_literal(stix, &binsel, &index) <= -1 ||
|
||||||
emit_double_positional_instruction(stix, send_message_cmd[to_super], 1, index) <= -1) goto oops;
|
emit_double_positional_instruction(stix, send_message_cmd[to_super], 1, index) <= -1) goto oops;
|
||||||
printf ("\tsend message %d with 1 arguments%s\n", (int)index, (to_super? " to super": ""));
|
printf ("\tsend binary message %d [", (int)index);
|
||||||
|
print_ucs (&binsel);
|
||||||
|
printf ("] with 1 arguments %s\n", (to_super? " to super": ""));
|
||||||
|
|
||||||
stix->c->mth.binsels.len = saved_binsels_len;
|
stix->c->mth.binsels.len = saved_binsels_len;
|
||||||
}
|
}
|
||||||
@ -2898,7 +2991,7 @@ static int compile_keyword_message (stix_t* stix, int to_super)
|
|||||||
if (add_symbol_literal(stix, &kwsel, &index) <= -1 ||
|
if (add_symbol_literal(stix, &kwsel, &index) <= -1 ||
|
||||||
emit_double_positional_instruction(stix, send_message_cmd[to_super], nargs, index) <= -1) goto oops;
|
emit_double_positional_instruction(stix, send_message_cmd[to_super], nargs, index) <= -1) goto oops;
|
||||||
|
|
||||||
printf ("\tsend message %d [", (int)index);
|
printf ("\tsend keyword message %d [", (int)index);
|
||||||
print_ucs (&kwsel);
|
print_ucs (&kwsel);
|
||||||
printf ("] with %d arguments to %s\n", (int)nargs, (to_super? "super": "self"));
|
printf ("] with %d arguments to %s\n", (int)nargs, (to_super? "super": "self"));
|
||||||
stix->c->mth.kwsels.len = saved_kwsel_len;
|
stix->c->mth.kwsels.len = saved_kwsel_len;
|
||||||
|
@ -66,7 +66,7 @@
|
|||||||
LOAD_ACTIVE_SP (stix); \
|
LOAD_ACTIVE_SP (stix); \
|
||||||
} while (0) \
|
} while (0) \
|
||||||
|
|
||||||
static int activate_new_method (stix_t* stix, stix_oop_method_t mth)
|
static STIX_INLINE int activate_new_method (stix_t* stix, stix_oop_method_t mth, stix_uint16_t next_inst)
|
||||||
{
|
{
|
||||||
stix_oow_t stack_size;
|
stix_oow_t stack_size;
|
||||||
stix_oop_context_t ctx;
|
stix_oop_context_t ctx;
|
||||||
@ -110,7 +110,28 @@ static int activate_new_method (stix_t* stix, stix_oop_method_t mth)
|
|||||||
STIX_ASSERT (stix->sp >= 0);
|
STIX_ASSERT (stix->sp >= 0);
|
||||||
STIX_ASSERT (stix->sp >= nargs);
|
STIX_ASSERT (stix->sp >= nargs);
|
||||||
|
|
||||||
|
switch (next_inst)
|
||||||
|
{
|
||||||
|
case (CODE_POP_STACKTOP << 8) | CODE_RETURN_STACKTOP:
|
||||||
|
case (CODE_POP_STACKTOP << 8) | CODE_RETURN_RECEIVER:
|
||||||
|
case CODE_RETURN_STACKTOP:
|
||||||
|
case CODE_RETURN_RECEIVER:
|
||||||
|
/* tail-call optimization */
|
||||||
|
/* TODO: is this correct? */
|
||||||
|
ctx->sender = stix->active_context->sender;
|
||||||
|
break;
|
||||||
|
|
||||||
|
/* RETURN_FROM_BLOCK is never preceeded by POP_STACKPOP */
|
||||||
|
case CODE_RETURN_FROM_BLOCK:
|
||||||
|
/* tail-call optimization */
|
||||||
|
ctx->sender = stix->active_context->sender;
|
||||||
|
break;
|
||||||
|
|
||||||
|
default:
|
||||||
ctx->sender = (stix_oop_t)stix->active_context;
|
ctx->sender = (stix_oop_t)stix->active_context;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
|
||||||
ctx->ip = 0;
|
ctx->ip = 0;
|
||||||
|
|
||||||
/* the stack front has temporary variables including arguments.
|
/* the stack front has temporary variables including arguments.
|
||||||
@ -228,7 +249,7 @@ printf ("\n");
|
|||||||
STIX_ASSERT ((stix_oop_t)mthdic != stix->_nil);
|
STIX_ASSERT ((stix_oop_t)mthdic != stix->_nil);
|
||||||
STIX_ASSERT (STIX_CLASSOF(stix, mthdic) == stix->_method_dictionary);
|
STIX_ASSERT (STIX_CLASSOF(stix, mthdic) == stix->_method_dictionary);
|
||||||
|
|
||||||
dump_dictionary (stix, mthdic, "Method dictionary");
|
/*dump_dictionary (stix, mthdic, "Method dictionary");*/
|
||||||
ass = (stix_oop_association_t)stix_lookupdic (stix, mthdic, message);
|
ass = (stix_oop_association_t)stix_lookupdic (stix, mthdic, message);
|
||||||
if (ass)
|
if (ass)
|
||||||
{
|
{
|
||||||
@ -300,7 +321,7 @@ TODO: overcome this problem
|
|||||||
STORE_ACTIVE_IP (stix);
|
STORE_ACTIVE_IP (stix);
|
||||||
STORE_ACTIVE_SP (stix);
|
STORE_ACTIVE_SP (stix);
|
||||||
|
|
||||||
return activate_new_method (stix, mth);
|
return activate_new_method (stix, mth, CODE_NOOP);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@ -772,13 +793,16 @@ int stix_execute (stix_t* stix)
|
|||||||
stix_byte_t bc, cmd;
|
stix_byte_t bc, cmd;
|
||||||
stix_ooi_t b1, b2;
|
stix_ooi_t b1, b2;
|
||||||
|
|
||||||
|
stix_size_t inst_counter;
|
||||||
|
|
||||||
STIX_ASSERT (stix->active_context != STIX_NULL);
|
STIX_ASSERT (stix->active_context != STIX_NULL);
|
||||||
|
|
||||||
|
inst_counter = 0;
|
||||||
|
|
||||||
while (1)
|
while (1)
|
||||||
{
|
{
|
||||||
mth = stix->active_context->origin->method;
|
mth = stix->active_context->origin->method;
|
||||||
code = mth->code;
|
code = mth->code;
|
||||||
|
|
||||||
#if 0
|
#if 0
|
||||||
printf ("IP => %d ", (int)stix->ip);
|
printf ("IP => %d ", (int)stix->ip);
|
||||||
#endif
|
#endif
|
||||||
@ -833,6 +857,7 @@ printf ("IP => %d ", (int)stix->ip);
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
inst_counter++;
|
||||||
#if 0
|
#if 0
|
||||||
printf ("CMD => %d, B1 = %d, SP = %d, IP AFTER INC %d\n", (int)cmd, (int)b1, (int)stix->sp, (int)stix->ip);
|
printf ("CMD => %d, B1 = %d, SP = %d, IP AFTER INC %d\n", (int)cmd, (int)b1, (int)stix->sp, (int)stix->ip);
|
||||||
#endif
|
#endif
|
||||||
@ -1002,9 +1027,12 @@ printf ("\n");
|
|||||||
stix_oop_method_t newmth;
|
stix_oop_method_t newmth;
|
||||||
stix_oop_char_t selector;
|
stix_oop_char_t selector;
|
||||||
stix_ooi_t preamble;
|
stix_ooi_t preamble;
|
||||||
|
stix_uint16_t next_inst;
|
||||||
|
|
||||||
/* the next byte is the message selector index to the
|
/* read ahead the next instruction for tail-call optimization */
|
||||||
* literal frame. */
|
next_inst = ((stix_oop_byte_t)stix->active_context->origin->method->code)->slot[stix->ip];
|
||||||
|
if (next_inst == CODE_POP_STACKTOP)
|
||||||
|
next_inst |= (next_inst << 8) + ((stix_oop_byte_t)stix->active_context->origin->method->code)->slot[stix->ip + 1];
|
||||||
|
|
||||||
/* get the selector from the literal frame */
|
/* get the selector from the literal frame */
|
||||||
selector = (stix_oop_char_t)stix->active_context->origin->method->slot[b2];
|
selector = (stix_oop_char_t)stix->active_context->origin->method->slot[b2];
|
||||||
@ -1075,7 +1103,7 @@ printf ("RETURN INSTVAR AT PREAMBLE\n");
|
|||||||
}
|
}
|
||||||
|
|
||||||
default:
|
default:
|
||||||
if (activate_new_method (stix, newmth) <= -1) goto oops;
|
if (activate_new_method (stix, newmth, next_inst) <= -1) goto oops;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -1168,7 +1196,6 @@ printf ("RETURN_RECEIVER\n");
|
|||||||
{
|
{
|
||||||
stix_oop_block_context_t blkctx;
|
stix_oop_block_context_t blkctx;
|
||||||
|
|
||||||
|
|
||||||
STIX_ASSERT(STIX_CLASSOF(stix, stix->active_context) == stix->_block_context);
|
STIX_ASSERT(STIX_CLASSOF(stix, stix->active_context) == stix->_block_context);
|
||||||
|
|
||||||
return_value = ACTIVE_STACK_GETTOP(stix);
|
return_value = ACTIVE_STACK_GETTOP(stix);
|
||||||
@ -1251,8 +1278,16 @@ printf ("SEND_BLOCK_COPY\n");
|
|||||||
|
|
||||||
|
|
||||||
handle_return:
|
handle_return:
|
||||||
/* TODO: consider block context.. jump to origin if in a block context */
|
if (stix->active_context->home == stix->_nil)
|
||||||
|
{
|
||||||
|
/* a method context is active. */
|
||||||
SWITCH_ACTIVE_CONTEXT (stix, (stix_oop_context_t)stix->active_context->sender);
|
SWITCH_ACTIVE_CONTEXT (stix, (stix_oop_context_t)stix->active_context->sender);
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
/* a block context is active */
|
||||||
|
SWITCH_ACTIVE_CONTEXT (stix, (stix_oop_context_t)stix->active_context->origin->sender);
|
||||||
|
}
|
||||||
|
|
||||||
/* push the return value to the stack of the new active context */
|
/* push the return value to the stack of the new active context */
|
||||||
ACTIVE_STACK_PUSH (stix, return_value);
|
ACTIVE_STACK_PUSH (stix, return_value);
|
||||||
@ -1276,6 +1311,7 @@ printf ("<<<RETURNIGN TO THE INITIAL CONTEXT>>>\n");
|
|||||||
}
|
}
|
||||||
|
|
||||||
done:
|
done:
|
||||||
|
printf ("TOTAL_INST_COUTNER = %lu\n", (unsigned long int)inst_counter);
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
|
|
||||||
|
@ -173,7 +173,8 @@ static char* syntax_error_msg[] =
|
|||||||
"string not closed",
|
"string not closed",
|
||||||
"no character after $",
|
"no character after $",
|
||||||
"no valid character after #",
|
"no valid character after #",
|
||||||
"missing colon",
|
"wrong character literal",
|
||||||
|
"colon expected",
|
||||||
"string expected",
|
"string expected",
|
||||||
"invalid radix",
|
"invalid radix",
|
||||||
"invalid numeric literal",
|
"invalid numeric literal",
|
||||||
|
@ -231,7 +231,7 @@ struct stix_iotok_t
|
|||||||
enum
|
enum
|
||||||
{
|
{
|
||||||
STIX_IOTOK_EOF,
|
STIX_IOTOK_EOF,
|
||||||
STIX_IOTOK_CHRLIT,
|
STIX_IOTOK_CHARLIT,
|
||||||
STIX_IOTOK_STRLIT,
|
STIX_IOTOK_STRLIT,
|
||||||
STIX_IOTOK_SYMLIT,
|
STIX_IOTOK_SYMLIT,
|
||||||
STIX_IOTOK_NUMLIT,
|
STIX_IOTOK_NUMLIT,
|
||||||
@ -276,7 +276,8 @@ enum stix_synerrnum_t
|
|||||||
STIX_SYNERR_STRNC, /* string not closed */
|
STIX_SYNERR_STRNC, /* string not closed */
|
||||||
STIX_SYNERR_CLTNT, /* character literal not terminated */
|
STIX_SYNERR_CLTNT, /* character literal not terminated */
|
||||||
STIX_SYNERR_HLTNT, /* hased literal not terminated */
|
STIX_SYNERR_HLTNT, /* hased literal not terminated */
|
||||||
STIX_SYNERR_CLNMS, /* colon missing */
|
STIX_SYNERR_CHARLIT, /* wrong character literal */
|
||||||
|
STIX_SYNERR_COLON, /* : expected */
|
||||||
STIX_SYNERR_STRING, /* string expected */
|
STIX_SYNERR_STRING, /* string expected */
|
||||||
STIX_SYNERR_RADIX, /* invalid radix */
|
STIX_SYNERR_RADIX, /* invalid radix */
|
||||||
STIX_SYNERR_RADNUMLIT, /* invalid numeric literal with radix */
|
STIX_SYNERR_RADNUMLIT, /* invalid numeric literal with radix */
|
||||||
|
Loading…
Reference in New Issue
Block a user