From 98a18b797c63ea9baab31768ed720ad32c0004e8 Mon Sep 17 00:00:00 2001 From: Guillaume Cottenceau Date: Mon, 14 May 2001 21:47:42 +0000 Subject: i can compile slang and newt with dietlibc now --- mdk-stage1/slang/slparse.c | 1970 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1970 insertions(+) create mode 100644 mdk-stage1/slang/slparse.c (limited to 'mdk-stage1/slang/slparse.c') diff --git a/mdk-stage1/slang/slparse.c b/mdk-stage1/slang/slparse.c new file mode 100644 index 000000000..bc709d1fb --- /dev/null +++ b/mdk-stage1/slang/slparse.c @@ -0,0 +1,1970 @@ +/* Copyright (c) 1998, 1999, 2001 John E. Davis + * This file is part of the S-Lang library. + * + * You may distribute under the terms of either the GNU General Public + * License or the Perl Artistic License. + */ + +#include "slinclud.h" + +#include "slang.h" +#include "_slang.h" + +static SLang_Load_Type *LLT; +int _SLang_Compile_Line_Num_Info; + +static void free_token (_SLang_Token_Type *t) +{ + register unsigned int nrefs = t->num_refs; + + if (nrefs == 0) + return; + + if (nrefs == 1) + { + if (t->free_sval_flag) + { + if (t->type == BSTRING_TOKEN) + SLbstring_free (t->v.b_val); + else + _SLfree_hashed_string (t->v.s_val, strlen (t->v.s_val), t->hash); + t->v.s_val = NULL; + } + } + + t->num_refs = nrefs - 1; +} + +static void init_token (_SLang_Token_Type *t) +{ + memset ((char *) t, 0, sizeof (_SLang_Token_Type)); +#if _SLANG_HAS_DEBUG_CODE + t->line_number = -1; +#endif +} + +/* Allow room for one push back of a token. This is necessary for + * multiple assignment. + */ +static unsigned int Use_Next_Token; +static _SLang_Token_Type Next_Token; +#if _SLANG_HAS_DEBUG_CODE +static int Last_Line_Number = -1; +#endif + +static int unget_token (_SLang_Token_Type *ctok) +{ + if (SLang_Error) + return -1; + if (Use_Next_Token != 0) + { + _SLparse_error ("unget_token failed", ctok, 0); + return -1; + } + + Use_Next_Token++; + Next_Token = *ctok; + init_token (ctok); + return 0; +} + +static int get_token (_SLang_Token_Type *ctok) +{ + if (ctok->num_refs) + free_token (ctok); + + if (Use_Next_Token) + { + Use_Next_Token--; + *ctok = Next_Token; + return ctok->type; + } + + return _SLget_token (ctok); +} + +static int compile_token (_SLang_Token_Type *t) +{ +#if _SLANG_HAS_DEBUG_CODE + if (_SLang_Compile_Line_Num_Info + && (t->line_number != Last_Line_Number) + && (t->line_number != -1)) + { + _SLang_Token_Type tok; + tok.type = LINE_NUM_TOKEN; + tok.v.long_val = Last_Line_Number = t->line_number; + (*_SLcompile_ptr) (&tok); + } +#endif + (*_SLcompile_ptr) (t); + return 0; +} + +typedef struct +{ +#define USE_PARANOID_MAGIC 0 +#if USE_PARANOID_MAGIC + unsigned long magic; +#endif + _SLang_Token_Type *stack; + unsigned int len; + unsigned int size; +} +Token_List_Type; + +#define MAX_TOKEN_LISTS 16 +static Token_List_Type Token_List_Stack [MAX_TOKEN_LISTS]; +static unsigned int Token_List_Stack_Depth = 0; +static Token_List_Type *Token_List = NULL; + +static void init_token_list (Token_List_Type *t) +{ + t->size = 0; + t->len = 0; + t->stack = NULL; +#if USE_PARANOID_MAGIC + t->magic = 0xABCDEF12; +#endif +} + +static void free_token_list (Token_List_Type *t) +{ + _SLang_Token_Type *s; + + if (t == NULL) + return; +#if USE_PARANOID_MAGIC + if (t->magic != 0xABCDEF12) + { + SLang_doerror ("Magic error."); + return; + } +#endif + s = t->stack; + if (s != NULL) + { + _SLang_Token_Type *smax = s + t->len; + while (s != smax) + { + if (s->num_refs) free_token (s); + s++; + } + + SLfree ((char *) t->stack); + } + + memset ((char *) t, 0, sizeof (Token_List_Type)); +} + +static Token_List_Type *push_token_list (void) +{ + if (Token_List_Stack_Depth == MAX_TOKEN_LISTS) + { + _SLparse_error ("Token list stack size exceeded", NULL, 0); + return NULL; + } + + Token_List = Token_List_Stack + Token_List_Stack_Depth; + Token_List_Stack_Depth++; + init_token_list (Token_List); + return Token_List; +} + +static int pop_token_list (int do_free) +{ + if (Token_List_Stack_Depth == 0) + { + if (SLang_Error == 0) + _SLparse_error ("Token list stack underflow", NULL, 0); + return -1; + } + Token_List_Stack_Depth--; + + if (do_free) free_token_list (Token_List); + + if (Token_List_Stack_Depth != 0) + Token_List = Token_List_Stack + (Token_List_Stack_Depth - 1); + else + Token_List = NULL; + + return 0; +} + +static int check_token_list_space (Token_List_Type *t, unsigned int delta_size) +{ + _SLang_Token_Type *st; + unsigned int len; +#if USE_PARANOID_MAGIC + if (t->magic != 0xABCDEF12) + { + SLang_doerror ("Magic error."); + return -1; + } +#endif + len = t->len + delta_size; + if (len <= t->size) return 0; + + if (delta_size < 4) + { + delta_size = 4; + len = t->len + delta_size; + } + + st = (_SLang_Token_Type *) SLrealloc((char *) t->stack, + len * sizeof(_SLang_Token_Type)); + if (st == NULL) + { + _SLparse_error ("Malloc error", NULL, 0); + return -1; + } + + memset ((char *) (st + t->len), 0, delta_size); + + t->stack = st; + t->size = len; + return 0; +} + +static int append_token (_SLang_Token_Type *t) +{ + if (-1 == check_token_list_space (Token_List, 1)) + return -1; + + Token_List->stack [Token_List->len] = *t; + Token_List->len += 1; + t->num_refs = 0; /* stealing it */ + return 0; +} + +static int append_token_of_type (unsigned char t) +{ + _SLang_Token_Type *tok; + + if (-1 == check_token_list_space (Token_List, 1)) + return -1; + + /* The memset when the list was created ensures that the other fields + * are properly initialized. + */ + tok = Token_List->stack + Token_List->len; + init_token (tok); + tok->type = t; + Token_List->len += 1; + return 0; +} + +static _SLang_Token_Type *get_last_token (void) +{ + unsigned int len; + + if ((Token_List == NULL) + || (0 == (len = Token_List->len))) + return NULL; + + len--; + return Token_List->stack + len; +} + +/* This function does NOT free the list. */ +static int compile_token_list_with_fun (int dir, Token_List_Type *list, + int (*f)(_SLang_Token_Type *)) +{ + _SLang_Token_Type *t0, *t1; + + if (list == NULL) + return -1; + + if (f == NULL) + f = compile_token; + + t0 = list->stack; + t1 = t0 + list->len; + + if (dir < 0) + { + /* backwards */ + + while ((SLang_Error == 0) && (t1 > t0)) + { + t1--; + (*f) (t1); + } + return 0; + } + + /* forward */ + while ((SLang_Error == 0) && (t0 < t1)) + { + (*f) (t0); + t0++; + } + return 0; +} + +static int compile_token_list (void) +{ + if (Token_List == NULL) + return -1; + + compile_token_list_with_fun (1, Token_List, NULL); + pop_token_list (1); + return 0; +} + +/* Take all elements in the list from pos2 to the end and exchange them + * with the elements at pos1, e.g., + * ...ABCDEabc ==> ...abcABCDE + * where pos1 denotes A and pos2 denotes a. + */ +static int token_list_element_exchange (unsigned int pos1, unsigned int pos2) +{ + _SLang_Token_Type *s, *s1, *s2; + unsigned int len, nloops; + + if (Token_List == NULL) + return -1; + + s = Token_List->stack; + len = Token_List->len; + + if ((s == NULL) || (len == 0) + || (pos2 >= len)) + return -1; + + /* This may not be the most efficient algorithm but the number to swap + * is most-likely going to be small, e.g, 3 + * The algorithm is to rotate the list. The particular rotation + * direction was chosen to make insert_token fast. + * It works like: + * @ ABCabcde --> BCabcdeA --> CabcdeAB --> abcdefAB + * which is optimal for Abcdef sequence produced by function calls. + * + * Profiling indicates that nloops is almost always 1, whereas the inner + * loop can loop many times (e.g., 9 times). + */ + + s2 = s + (len - 1); + s1 = s + pos1; + nloops = pos2 - pos1; + + while (nloops) + { + _SLang_Token_Type save; + + s = s1; + save = *s; + + while (s < s2) + { + *s = *(s + 1); + s++; + } + *s = save; + + nloops--; + } + return 0; +} + +#if 0 +static int insert_token (_SLang_Token_Type *t, unsigned int pos) +{ + if (-1 == append_token (t)) + return -1; + + return token_list_element_exchange (pos, Token_List->len - 1); +} +#endif +static void compile_token_of_type (unsigned char t) +{ + _SLang_Token_Type tok; + +#if _SLANG_HAS_DEBUG_CODE + tok.line_number = -1; +#endif + tok.type = t; + compile_token(&tok); +} + +static void statement (_SLang_Token_Type *); +static void compound_statement (_SLang_Token_Type *); +static void expression_with_parenthesis (_SLang_Token_Type *); +static void handle_semicolon (_SLang_Token_Type *); +static void statement_list (_SLang_Token_Type *); +static void variable_list (_SLang_Token_Type *, unsigned char); +static void struct_declaration (_SLang_Token_Type *); +static void define_function_args (_SLang_Token_Type *); +static void typedef_definition (_SLang_Token_Type *); +static void function_args_expression (_SLang_Token_Type *, int); +static void expression (_SLang_Token_Type *); +static void expression_with_commas (_SLang_Token_Type *, int); +static void simple_expression (_SLang_Token_Type *); +static void unary_expression (_SLang_Token_Type *); +static void postfix_expression (_SLang_Token_Type *); +static int check_for_lvalue (unsigned char, _SLang_Token_Type *); +/* static void primary_expression (_SLang_Token_Type *); */ +static void block (_SLang_Token_Type *); +static void inline_array_expression (_SLang_Token_Type *); +static void array_index_expression (_SLang_Token_Type *); +static void do_multiple_assignment (_SLang_Token_Type *); +static void try_multiple_assignment (_SLang_Token_Type *); +#if 0 +static void not_implemented (char *what) +{ + char err [256]; + sprintf (err, "Expression not implemented: %s", what); + _SLparse_error (err, NULL, 0); +} +#endif +static void rpn_parse_line (_SLang_Token_Type *tok) +{ + do + { + /* multiple RPN tokens possible when the file looks like: + * . + * . + */ + if (tok->type != RPN_TOKEN) + compile_token (tok); + free_token (tok); + } + while (EOF_TOKEN != _SLget_rpn_token (tok)); +} + +static int get_identifier_token (_SLang_Token_Type *tok) +{ + if (IDENT_TOKEN == get_token (tok)) + return IDENT_TOKEN; + + _SLparse_error ("Expecting identifier", tok, 0); + return tok->type; +} + +static void define_function (_SLang_Token_Type *ctok, unsigned char type) +{ + _SLang_Token_Type fname; + + switch (type) + { + case STATIC_TOKEN: + type = DEFINE_STATIC_TOKEN; + break; + + case PUBLIC_TOKEN: + type = DEFINE_PUBLIC_TOKEN; + break; + + case PRIVATE_TOKEN: + type = DEFINE_PRIVATE_TOKEN; + } + + init_token (&fname); + if (IDENT_TOKEN != get_identifier_token (&fname)) + { + free_token (&fname); + return; + } + + compile_token_of_type(OPAREN_TOKEN); + get_token (ctok); + define_function_args (ctok); + compile_token_of_type(FARG_TOKEN); + + if (ctok->type == OBRACE_TOKEN) + compound_statement(ctok); + + else if (ctok->type != SEMICOLON_TOKEN) + { + _SLparse_error("Expecting {", ctok, 0); + free_token (&fname); + return; + } + + fname.type = type; + compile_token (&fname); + free_token (&fname); +} + +/* statement: + * compound-statement + * if ( expression ) statement + * if ( expression ) statement else statement + * !if ( expression ) statement + * loop ( expression ) statement + * _for ( expression ) statement + * foreach ( expression ) statement + * foreach (expression ) using (expression-list) statement + * while ( expression ) statement + * do statement while (expression) ; + * for ( expressionopt ; expressionopt ; expressionopt ) statement + * ERROR_BLOCK statement + * EXIT_BLOCK statement + * USER_BLOCK0 statement + * USER_BLOCK1 statement + * USER_BLOCK2 statement + * USER_BLOCK3 statement + * USER_BLOCK4 statement + * forever statement + * break ; + * continue ; + * return expressionopt ; + * variable variable-list ; + * struct struct-decl ; + * define identifier function-args ; + * define identifier function-args compound-statement + * switch ( expression ) statement + * rpn-line + * at-line + * push ( expression ) + * ( expression ) = expression ; + * expression ; + * expression : + */ + +/* Note: This function does not return with a new token. It is up to the + * calling routine to handle that. + */ +static void statement (_SLang_Token_Type *ctok) +{ + unsigned char type; + + if (SLang_Error) + return; + + LLT->parse_level += 1; + + switch (ctok->type) + { + case OBRACE_TOKEN: + compound_statement (ctok); + break; + + case IF_TOKEN: + case IFNOT_TOKEN: + type = ctok->type; + get_token (ctok); + expression_with_parenthesis (ctok); + block (ctok); + + if (ELSE_TOKEN != get_token (ctok)) + { + compile_token_of_type (type); + unget_token (ctok); + break; + } + get_token (ctok); + block (ctok); + if (type == IF_TOKEN) type = ELSE_TOKEN; else type = NOTELSE_TOKEN; + compile_token_of_type (type); + break; + + /* case IFNOT_TOKEN: */ + case LOOP_TOKEN: + case _FOR_TOKEN: + type = ctok->type; + get_token (ctok); + expression_with_parenthesis (ctok); + block (ctok); + compile_token_of_type (type); + break; + + case FOREACH_TOKEN: + get_token (ctok); + expression_with_parenthesis (ctok); + + if (NULL == push_token_list ()) + break; + + append_token_of_type (ARG_TOKEN); + if (ctok->type == USING_TOKEN) + { + if (OPAREN_TOKEN != get_token (ctok)) + { + _SLparse_error ("Expected 'using ('", ctok, 0); + break; + } + get_token (ctok); + function_args_expression (ctok, 0); + } + append_token_of_type (EARG_TOKEN); + + compile_token_list (); + + block (ctok); + compile_token_of_type (FOREACH_TOKEN); + break; + + case WHILE_TOKEN: + get_token (ctok); + compile_token_of_type (OBRACE_TOKEN); + expression_with_parenthesis (ctok); + compile_token_of_type (CBRACE_TOKEN); + block (ctok); + compile_token_of_type (WHILE_TOKEN); + break; + + case DO_TOKEN: + get_token (ctok); + block (ctok); + + if (WHILE_TOKEN != get_token (ctok)) + { + _SLparse_error("Expecting while", ctok, 0); + break; + } + + get_token (ctok); + + compile_token_of_type (OBRACE_TOKEN); + expression_with_parenthesis (ctok); + compile_token_of_type (CBRACE_TOKEN); + compile_token_of_type (DOWHILE_TOKEN); + handle_semicolon (ctok); + break; + + case FOR_TOKEN: + + /* Look for (exp_opt ; exp_opt ; exp_opt ) */ + + if (OPAREN_TOKEN != get_token (ctok)) + { + _SLparse_error("Expecting (.", ctok, 0); + break; + } + + if (NULL == push_token_list ()) + break; + + append_token_of_type (OBRACE_TOKEN); + if (SEMICOLON_TOKEN != get_token (ctok)) + { + expression (ctok); + if (ctok->type != SEMICOLON_TOKEN) + { + _SLparse_error("Expecting ;", ctok, 0); + break; + } + } + append_token_of_type (CBRACE_TOKEN); + + append_token_of_type (OBRACE_TOKEN); + if (SEMICOLON_TOKEN != get_token (ctok)) + { + expression (ctok); + if (ctok->type != SEMICOLON_TOKEN) + { + _SLparse_error("Expecting ;", ctok, 0); + break; + } + } + append_token_of_type (CBRACE_TOKEN); + + append_token_of_type (OBRACE_TOKEN); + if (CPAREN_TOKEN != get_token (ctok)) + { + expression (ctok); + if (ctok->type != CPAREN_TOKEN) + { + _SLparse_error("Expecting ).", ctok, 0); + break; + } + } + append_token_of_type (CBRACE_TOKEN); + + compile_token_list (); + + get_token (ctok); + block (ctok); + compile_token_of_type (FOR_TOKEN); + break; + + case ERRBLK_TOKEN: + case EXITBLK_TOKEN: + case USRBLK0_TOKEN: + case USRBLK1_TOKEN: + case USRBLK2_TOKEN: + case USRBLK3_TOKEN: + case USRBLK4_TOKEN: + case FOREVER_TOKEN: + type = ctok->type; + get_token (ctok); + block (ctok); + compile_token_of_type (type); + break; + + case BREAK_TOKEN: + case CONT_TOKEN: + compile_token_of_type (ctok->type); + get_token (ctok); + handle_semicolon (ctok); + break; + + case RETURN_TOKEN: + if (SEMICOLON_TOKEN != get_token (ctok)) + { + if (NULL == push_token_list ()) + break; + + expression (ctok); + + if (ctok->type != SEMICOLON_TOKEN) + { + _SLparse_error ("Expecting ;", ctok, 0); + break; + } + compile_token_list (); + } + compile_token_of_type (RETURN_TOKEN); + handle_semicolon (ctok); + break; + + case STATIC_TOKEN: + case PRIVATE_TOKEN: + case PUBLIC_TOKEN: + type = ctok->type; + get_token (ctok); + if (ctok->type == VARIABLE_TOKEN) + { + get_token (ctok); + variable_list (ctok, type); + handle_semicolon (ctok); + break; + } + if (ctok->type == DEFINE_TOKEN) + { + define_function (ctok, type); + break; + } + _SLparse_error ("Expecting 'variable' or 'define'", ctok, 0); + break; + + case VARIABLE_TOKEN: + get_token (ctok); + variable_list (ctok, OBRACKET_TOKEN); + handle_semicolon (ctok); + break; + + case TYPEDEF_TOKEN: + get_token (ctok); + if (NULL == push_token_list ()) + break; + typedef_definition (ctok); + compile_token_list (); + + handle_semicolon (ctok); + break; + + case DEFINE_TOKEN: + define_function (ctok, DEFINE_TOKEN); + break; + + case SWITCH_TOKEN: + get_token (ctok); + expression_with_parenthesis (ctok); + + while ((SLang_Error == 0) + && (OBRACE_TOKEN == ctok->type)) + { + compile_token_of_type (OBRACE_TOKEN); + compound_statement (ctok); + compile_token_of_type (CBRACE_TOKEN); + get_token (ctok); + } + compile_token_of_type (SWITCH_TOKEN); + unget_token (ctok); + break; + + case EOF_TOKEN: + break; +#if 0 + case PUSH_TOKEN: + get_token (ctok); + expression_list_with_parenthesis (ctok); + handle_semicolon (ctok); + break; +#endif + + case SEMICOLON_TOKEN: + handle_semicolon (ctok); + break; + + case RPN_TOKEN: + if (POUND_TOKEN == get_token (ctok)) + _SLcompile_byte_compiled (); + else if (ctok->type != EOF_TOKEN) + rpn_parse_line (ctok); + break; + + case OPAREN_TOKEN: /* multiple assignment */ + try_multiple_assignment (ctok); + if (ctok->type == COLON_TOKEN) + compile_token_of_type (COLON_TOKEN); + else handle_semicolon (ctok); + break; + + default: + + if (NULL == push_token_list ()) + break; + + expression (ctok); + compile_token_list (); + + if (ctok->type == COLON_TOKEN) + compile_token_of_type (COLON_TOKEN); + else handle_semicolon (ctok); + break; + } + + LLT->parse_level -= 1; +} + +static void block (_SLang_Token_Type *ctok) +{ + compile_token_of_type (OBRACE_TOKEN); + statement (ctok); + compile_token_of_type (CBRACE_TOKEN); +} + +/* + * statement-list: + * statement + * statement-list statement + */ +static void statement_list (_SLang_Token_Type *ctok) +{ + while ((SLang_Error == 0) + && (ctok->type != CBRACE_TOKEN) + && (ctok->type != EOF_TOKEN)) + { + statement(ctok); + get_token (ctok); + } +} + +/* compound-statement: + * { statement-list } + */ +static void compound_statement (_SLang_Token_Type *ctok) +{ + /* ctok->type is OBRACE_TOKEN here */ + get_token (ctok); + statement_list(ctok); + if (CBRACE_TOKEN != ctok->type) + { + _SLparse_error ("Expecting '}'", ctok, 0); + return; + } +} + +/* This function is only called from statement. */ +static void expression_with_parenthesis (_SLang_Token_Type *ctok) +{ + if (ctok->type != OPAREN_TOKEN) + { + _SLparse_error("Expecting (", ctok, 0); + return; + } + + if (NULL == push_token_list ()) + return; + + get_token (ctok); + expression (ctok); + + if (ctok->type != CPAREN_TOKEN) + _SLparse_error("Expecting )", ctok, 0); + + compile_token_list (); + + get_token (ctok); +} + +static void handle_semicolon (_SLang_Token_Type *ctok) +{ + if ((ctok->type == SEMICOLON_TOKEN) + || (ctok->type == EOF_TOKEN)) + return; + + _SLparse_error ("Expecting ;", ctok, 0); +} + +void _SLparse_start (SLang_Load_Type *llt) +{ + _SLang_Token_Type ctok; + SLang_Load_Type *save_llt; + unsigned int save_use_next_token; + _SLang_Token_Type save_next_token; + Token_List_Type *save_list; +#if _SLANG_HAS_DEBUG_CODE + int save_last_line_number = Last_Line_Number; + + Last_Line_Number = -1; +#endif + save_use_next_token = Use_Next_Token; + save_next_token = Next_Token; + save_list = Token_List; + save_llt = LLT; + LLT = llt; + + init_token (&Next_Token); + Use_Next_Token = 0; + init_token (&ctok); + get_token (&ctok); + + llt->parse_level = 0; + statement_list (&ctok); + + if ((SLang_Error == 0) + && (ctok.type != EOF_TOKEN)) + _SLparse_error ("Parse ended prematurely", &ctok, 0); + + + if (SLang_Error) + { + if (SLang_Error < 0) /* severe error */ + save_list = NULL; + + while (Token_List != save_list) + { + if (-1 == pop_token_list (1)) + break; /* ??? when would this happen? */ + } + } + + free_token (&ctok); + LLT = save_llt; + if (Use_Next_Token) + free_token (&Next_Token); + Use_Next_Token = save_use_next_token; + Next_Token = save_next_token; +#if _SLANG_HAS_DEBUG_CODE + Last_Line_Number = save_last_line_number; +#endif +} + +/* variable-list: + * variable-decl + * variable-decl variable-list + * + * variable-decl: + * identifier + * identifier = simple-expression + */ +static void variable_list (_SLang_Token_Type *name_token, unsigned char variable_type) +{ + int declaring; + _SLang_Token_Type tok; + + if (name_token->type != IDENT_TOKEN) + { + _SLparse_error ("Expecting a variable name", name_token, 0); + return; + } + + declaring = 0; + do + { + if (declaring == 0) + { + declaring = 1; + compile_token_of_type (variable_type); + } + + compile_token (name_token); + + init_token (&tok); + if (ASSIGN_TOKEN == get_token (&tok)) + { + compile_token_of_type (CBRACKET_TOKEN); + declaring = 0; + + get_token (&tok); + + push_token_list (); + simple_expression (&tok); + compile_token_list (); + + name_token->type = _SCALAR_ASSIGN_TOKEN; + compile_token (name_token); + } + + free_token (name_token); + *name_token = tok; + } + while ((name_token->type == COMMA_TOKEN) + && (IDENT_TOKEN == get_token (name_token))); + + if (declaring) compile_token_of_type (CBRACKET_TOKEN); +} + +/* struct-declaration: + * struct { struct-field-list }; + * + * struct-field-list: + * struct-field-name , struct-field-list + * struct-field-name + * + * Generates code: "field-name-1" ... "field-name-N" N STRUCT_TOKEN + */ +static void struct_declaration (_SLang_Token_Type *ctok) +{ + int n; + _SLang_Token_Type num_tok; + + if (ctok->type != OBRACE_TOKEN) + { + _SLparse_error ("Expecting {", ctok, 0); + return; + } + + n = 0; + while (IDENT_TOKEN == get_token (ctok)) + { + n++; + ctok->type = STRING_TOKEN; + append_token (ctok); + if (COMMA_TOKEN != get_token (ctok)) + break; + } + + if (ctok->type != CBRACE_TOKEN) + { + _SLparse_error ("Expecting }", ctok, 0); + return; + } + if (n == 0) + { + _SLparse_error ("struct requires at least 1 field", ctok, 0); + return; + } + + init_token (&num_tok); + num_tok.type = INT_TOKEN; + num_tok.v.long_val = n; + append_token (&num_tok); + append_token_of_type (STRUCT_TOKEN); + + get_token (ctok); +} + +/* struct-declaration: + * typedef struct { struct-field-list } Type_Name; + * + * struct-field-list: + * struct-field-name , struct-field-list + * struct-field-name + * + * Generates code: "field-name-1" ... "field-name-N" N STRUCT_TOKEN typedef + */ +static void typedef_definition (_SLang_Token_Type *t) +{ + + if (t->type != STRUCT_TOKEN) + { + _SLparse_error ("Expecting `struct'", t, 0); + return; + } + get_token (t); + + struct_declaration (t); + if (t->type != IDENT_TOKEN) + { + _SLparse_error ("Expecting identifier", t, 0); + return; + } + + t->type = STRING_TOKEN; + append_token (t); + append_token_of_type (TYPEDEF_TOKEN); + + get_token (t); +} + +/* function-args: + * ( args-dec-opt ) + * + * args-decl-opt: + * identifier + * args-decl , identifier + */ +static void define_function_args (_SLang_Token_Type *ctok) +{ + if (CPAREN_TOKEN == get_token (ctok)) + { + get_token (ctok); + return; + } + + compile_token_of_type(OBRACKET_TOKEN); + + while ((SLang_Error == 0) + && (ctok->type == IDENT_TOKEN)) + { + compile_token (ctok); + if (COMMA_TOKEN != get_token (ctok)) + break; + + get_token (ctok); + } + + if (CPAREN_TOKEN != ctok->type) + { + _SLparse_error("Expecting )", ctok, 0); + return; + } + compile_token_of_type(CBRACKET_TOKEN); + + get_token (ctok); +} + +void try_multiple_assignment (_SLang_Token_Type *ctok) +{ + /* This is called with ctok->type == OPAREN_TOKEN. We have no idea + * what follows this. There are various possibilities such as: + * @ () = x; + * @ ( expression ) = x; + * @ ( expression ) ; + * @ ( expression ) OP expression; + * @ ( expression ) [expression] = expression; + * and only the first two constitute a multiple assignment. The last + * two forms create the difficulty. + * + * Here is the plan. First parse (expression) and then check next token. + * If it is an equal operator, then it will be parsed as a multiple + * assignment. In fact, that is the easy part. + * + * The hard part stems from the fact that by parsing (expression), we + * have effectly truncated the parse if (expression) is part of a binary + * or unary expression. Somehow, the parsing must be resumed. The trick + * here is to use a dummy literal that generates no code: NO_OP_LITERAL + * Using it, we just call 'expression' and proceed. + */ + + if (NULL == push_token_list ()) + return; + + get_token (ctok); + + if (ctok->type != CPAREN_TOKEN) + { + expression_with_commas (ctok, 1); + if (ctok->type != CPAREN_TOKEN) + { + _SLparse_error ("Expecting )", ctok, 0); + return; + } + } + + switch (get_token (ctok)) + { + case ASSIGN_TOKEN: + case PLUSEQS_TOKEN: + case MINUSEQS_TOKEN: + case TIMESEQS_TOKEN: + case DIVEQS_TOKEN: + case BOREQS_TOKEN: + case BANDEQS_TOKEN: + do_multiple_assignment (ctok); + pop_token_list (1); + break; + + default: + unget_token (ctok); + ctok->type = NO_OP_LITERAL; + expression (ctok); + compile_token_list (); + break; + } +} + +/* Note: expression never gets compiled directly. Rather, it gets + * appended to the token list and then compiled by a calling + * routine. + */ + +/* expression: + * simple_expression + * simple-expression , expression + * + */ +static void expression_with_commas (_SLang_Token_Type *ctok, int save_comma) +{ + while (SLang_Error == 0) + { + if (ctok->type != COMMA_TOKEN) + { + if (ctok->type == CPAREN_TOKEN) + return; + + simple_expression (ctok); + + if (ctok->type != COMMA_TOKEN) + break; + } + if (save_comma) append_token (ctok); + get_token (ctok); + } +} + +static void expression (_SLang_Token_Type *ctok) +{ + expression_with_commas (ctok, 0); +} + +/* priority levels of binary operations */ +static unsigned char Binop_Level[] = +{ +/* ADD_TOKEN */ 2, +/* SUB_TOKEN */ 2, +/* MUL_TOKEN */ 1, +/* DIV_TOKEN */ 1, +/* LT_TOKEN */ 4, +/* LE_TOKEN */ 4, +/* GT_TOKEN */ 4, +/* GE_TOKEN */ 4, +/* EQ_TOKEN */ 5, +/* NE_TOKEN */ 5, +/* AND_TOKEN */ 9, +/* OR_TOKEN */ 10, +/* MOD_TOKEN */ 1, +/* BAND_TOKEN */ 6, +/* SHL_TOKEN */ 3, +/* SHR_TOKEN */ 3, +/* BXOR_TOKEN */ 7, +/* BOR_TOKEN */ 8, +/* POUND_TOKEN */ 1 /* Matrix Multiplication */ +}; + +/* % Note: simple-expression groups operators OP1 at same level. The + * % actual implementation will not do this. + * simple-expression: + * unary-expression + * binary-expression BINARY-OP unary-expression + * andelse xxelse-expression-list + * orelse xxelse-expression-list + * + * xxelse-expression-list: + * { expression } + * xxelse-expression-list { expression } + * binary-expression: + * unary-expression + * unary-expression BINARY-OP binary-expression + */ +static void simple_expression (_SLang_Token_Type *ctok) +{ + unsigned char type; + unsigned char op_stack [64]; + unsigned char level_stack [64]; + unsigned char level; + unsigned int op_num; + + switch (ctok->type) + { + case ANDELSE_TOKEN: + case ORELSE_TOKEN: + type = ctok->type; + if (OBRACE_TOKEN != get_token (ctok)) + { + _SLparse_error ("Expecting '{'", ctok, 0); + return; + } + + while (ctok->type == OBRACE_TOKEN) + { + append_token (ctok); + get_token (ctok); + expression (ctok); + if (CBRACE_TOKEN != ctok->type) + { + _SLparse_error("Expecting }", ctok, 0); + return; + } + append_token (ctok); + get_token (ctok); + } + append_token_of_type (type); + return; + + /* avoid unary-expression if possible */ + case STRING_TOKEN: + append_token (ctok); + get_token (ctok); + break; + + default: + unary_expression (ctok); + break; + } + + if (SEMICOLON_TOKEN == (type = ctok->type)) + return; + + op_num = 0; + + while ((SLang_Error == 0) + && (IS_BINARY_OP(type))) + { + level = Binop_Level[type - FIRST_BINARY_OP]; + + while ((op_num > 0) && (level_stack [op_num - 1] <= level)) + append_token_of_type (op_stack [--op_num]); + + if (op_num >= sizeof (op_stack) - 1) + { + _SLparse_error ("Binary op stack overflow", ctok, 0); + return; + } + + op_stack [op_num] = type; + level_stack [op_num] = level; + op_num++; + + get_token (ctok); + unary_expression (ctok); + type = ctok->type; + } + + while (op_num > 0) + append_token_of_type(op_stack[--op_num]); +} + +/* unary-expression: + * postfix-expression + * ++ postfix-expression + * -- postfix-expression + * case unary-expression + * OP3 unary-expression + * (OP3: + - ~ & not @) + * + * Note: This grammar permits: case case case WHATEVER + */ +static void unary_expression (_SLang_Token_Type *ctok) +{ + unsigned char save_unary_ops [16]; + unsigned int num_unary_ops; + unsigned char type; + _SLang_Token_Type *last_token; + + num_unary_ops = 0; + while (SLang_Error == 0) + { + type = ctok->type; + + switch (type) + { + case PLUSPLUS_TOKEN: + case MINUSMINUS_TOKEN: + get_token (ctok); + postfix_expression (ctok); + check_for_lvalue (type, NULL); + goto out_of_switch; + + case ADD_TOKEN: + get_token (ctok); /* skip it-- it's unary here */ + break; + + case SUB_TOKEN: + (void) get_token (ctok); + if (IS_INTEGER_TOKEN (ctok->type)) + { + ctok->v.long_val = -ctok->v.long_val; + break; + } + + if (num_unary_ops == 16) + goto stack_overflow_error; + save_unary_ops [num_unary_ops++] = CHS_TOKEN; + break; + + case DEREF_TOKEN: + case BNOT_TOKEN: + case NOT_TOKEN: + case CASE_TOKEN: + if (num_unary_ops == 16) + goto stack_overflow_error; + + save_unary_ops [num_unary_ops++] = type; + get_token (ctok); + break; + + /* Try to avoid ->postfix_expression->primary_expression + * subroutine calls. + */ + case STRING_TOKEN: + append_token (ctok); + get_token (ctok); + goto out_of_switch; + + default: + postfix_expression (ctok); + goto out_of_switch; + } + } + + out_of_switch: + if (num_unary_ops == 0) + return; + + if ((DEREF_TOKEN == save_unary_ops[num_unary_ops - 1]) + && (NULL != (last_token = get_last_token ())) + && (IS_ASSIGN_TOKEN(last_token->type))) + { + /* FIXME: Priority=medium + * This needs generalized so that things like @a.y = 1 will work properly. + */ + if ((num_unary_ops != 1) + || (last_token->type != _SCALAR_ASSIGN_TOKEN)) + { + SLang_verror (SL_NOT_IMPLEMENTED, + "Only derefence assignments to simple variables are possible"); + return; + } + + last_token->type += (_DEREF_ASSIGN_TOKEN - _SCALAR_ASSIGN_TOKEN); + return; + } + + while (num_unary_ops) + { + num_unary_ops--; + append_token_of_type (save_unary_ops [num_unary_ops]); + } + return; + + stack_overflow_error: + _SLparse_error ("Too many unary operators.", ctok, 0); +} + +static int combine_namespace_tokens (_SLang_Token_Type *a, _SLang_Token_Type *b) +{ + char *sa, *sb, *sc; + unsigned int lena, lenb; + unsigned long hash; + + /* This is somewhat of a hack. Combine the TWO identifier names + * (NAMESPACE) and (name) into the form NAMESPACE->name. Then when the + * byte compiler compiles the object it will not be found. It will then + * check for this hack and make the appropriate namespace lookup. + */ + + sa = a->v.s_val; + sb = b->v.s_val; + + lena = strlen (sa); + lenb = strlen (sb); + + sc = SLmalloc (lena + lenb + 3); + if (sc == NULL) + return -1; + + strcpy (sc, sa); + strcpy (sc + lena, "->"); + strcpy (sc + lena + 2, sb); + + sb = _SLstring_make_hashed_string (sc, lena + lenb + 2, &hash); + SLfree (sc); + if (sb == NULL) + return -1; + + /* I can free this string because no other token should be referencing it. + * (num_refs == 1). + */ + _SLfree_hashed_string (sa, lena, a->hash); + a->v.s_val = sb; + a->hash = hash; + + return 0; +} + +static void append_identifier_token (_SLang_Token_Type *ctok) +{ + _SLang_Token_Type *last_token; + + append_token (ctok); + + if (NAMESPACE_TOKEN != get_token (ctok)) + return; + + if (IDENT_TOKEN != get_token (ctok)) + { + _SLparse_error ("Expecting name-space identifier", ctok, 0); + return; + } + + last_token = get_last_token (); + if (-1 == combine_namespace_tokens (last_token, ctok)) + return; + + (void) get_token (ctok); +} + +static int get_identifier_expr_token (_SLang_Token_Type *ctok) +{ + _SLang_Token_Type next_token; + + if (IDENT_TOKEN != get_identifier_token (ctok)) + return -1; + + init_token (&next_token); + if (NAMESPACE_TOKEN != get_token (&next_token)) + { + unget_token (&next_token); + return IDENT_TOKEN; + } + + if (IDENT_TOKEN != get_identifier_token (&next_token)) + { + free_token (&next_token); + return -1; + } + + if (-1 == combine_namespace_tokens (ctok, &next_token)) + { + free_token (&next_token); + return -1; + } + free_token (&next_token); + return IDENT_TOKEN; +} + +/* postfix-expression: + * primary-expression + * postfix-expression [ expression ] + * postfix-expression ( function-args-expression ) + * postfix-expression . identifier + * postfix-expression ^ unary-expression + * postfix-expression ++ + * postfix-expression -- + * postfix-expression = simple-expression + * postfix-expression += simple-expression + * postfix-expression -= simple-expression + * + * primary-expression: + * literal + * identifier-expr + * ( expression_opt ) + * [ inline-array-expression ] + * &identifier-expr + * struct-definition + * __tmp(identifier-expr) + * + * identifier-expr: + * identifier + * identifier->identifier + */ +static void postfix_expression (_SLang_Token_Type *ctok) +{ + unsigned int start_pos, end_pos; + unsigned char type; + + if (Token_List == NULL) + return; + + start_pos = Token_List->len; + + switch (ctok->type) + { + case IDENT_TOKEN: + append_identifier_token (ctok); + break; + + case CHAR_TOKEN: + case SHORT_TOKEN: + case INT_TOKEN: + case LONG_TOKEN: + case UCHAR_TOKEN: + case USHORT_TOKEN: + case UINT_TOKEN: + case ULONG_TOKEN: + case STRING_TOKEN: + case BSTRING_TOKEN: +#ifdef SLANG_HAS_FLOAT + case DOUBLE_TOKEN: + case FLOAT_TOKEN: +#endif +#ifdef SLANG_HAS_COMPLEX + case COMPLEX_TOKEN: +#endif + append_token (ctok); + get_token (ctok); + break; + + case OPAREN_TOKEN: + if (CPAREN_TOKEN != get_token (ctok)) + { + expression (ctok); + if (ctok->type != CPAREN_TOKEN) + _SLparse_error("Expecting )", ctok, 0); + } + get_token (ctok); + break; + + case BAND_TOKEN: + if (IDENT_TOKEN != get_identifier_expr_token (ctok)) + break; + + ctok->type = _REF_TOKEN; + append_token (ctok); + get_token (ctok); + break; + + case OBRACKET_TOKEN: + get_token (ctok); + inline_array_expression (ctok); + break; + + case NO_OP_LITERAL: + /* This token was introduced by try_multiple_assignment. There, + * a new token_list was pushed and (expression) was evaluated. + * NO_OP_LITERAL represents the result of expression. However, + * we need to tweak the start_pos variable to point to the beginning + * of the token list to complete the equivalence. + */ + start_pos = 0; + get_token (ctok); + break; + + case STRUCT_TOKEN: + get_token (ctok); + struct_declaration (ctok); + break; + + case TMP_TOKEN: + get_token (ctok); + if (ctok->type == OPAREN_TOKEN) + { + if (IDENT_TOKEN == get_identifier_expr_token (ctok)) + { + ctok->type = TMP_TOKEN; + append_token (ctok); + get_token (ctok); + if (ctok->type == CPAREN_TOKEN) + { + get_token (ctok); + break; + } + } + } + _SLparse_error ("Expecting form __tmp(NAME)", ctok, 0); + break; + + default: + if (IS_INTERNAL_FUNC(ctok->type)) + { + append_token (ctok); + get_token (ctok); + } + else + _SLparse_error("Expecting a PRIMARY", ctok, 0); + } + + while (SLang_Error == 0) + { + end_pos = Token_List->len; + type = ctok->type; + switch (type) + { + case OBRACKET_TOKEN: /* X[args] ==> [args] X ARRAY */ + get_token (ctok); + append_token_of_type (ARG_TOKEN); + if (ctok->type != CBRACKET_TOKEN) + array_index_expression (ctok); + + if (ctok->type != CBRACKET_TOKEN) + { + _SLparse_error ("Expecting ']'", ctok, 0); + return; + } + get_token (ctok); + /* append_token_of_type (EARG_TOKEN); -- ARRAY_TOKEN implicitely does this */ + token_list_element_exchange (start_pos, end_pos); + append_token_of_type (ARRAY_TOKEN); + break; + + case OPAREN_TOKEN: + /* f(args) ==> args f */ + if (CPAREN_TOKEN != get_token (ctok)) + { + function_args_expression (ctok, 1); + token_list_element_exchange (start_pos, end_pos); + } + else get_token (ctok); + break; + + case DOT_TOKEN: + /* S.a ==> "a" S DOT + * This means that if S is X[b], then X[b].a ==> a b X ARRAY DOT + * and f(a).X[b].c ==> "c" b "X" a f . ARRAY . + * Also, f(a).X[b] = g(x); ==> x g b "X" a f . + */ + if (IDENT_TOKEN != get_identifier_token (ctok)) + return; + + ctok->type = DOT_TOKEN; + append_token (ctok); + get_token (ctok); + break; + + case PLUSPLUS_TOKEN: + case MINUSMINUS_TOKEN: + check_for_lvalue (type, NULL); + get_token (ctok); + break; + + case ASSIGN_TOKEN: + case PLUSEQS_TOKEN: + case MINUSEQS_TOKEN: + case TIMESEQS_TOKEN: + case DIVEQS_TOKEN: + case BOREQS_TOKEN: + case BANDEQS_TOKEN: + check_for_lvalue (type, NULL); + get_token (ctok); + simple_expression (ctok); + token_list_element_exchange (start_pos, end_pos); + break; + + case POW_TOKEN: + get_token (ctok); + unary_expression (ctok); + append_token_of_type (POW_TOKEN); + break; + + default: + return; + } + } +} + +static void function_args_expression (_SLang_Token_Type *ctok, int handle_num_args) +{ + unsigned char last_type, this_type; + + if (handle_num_args) append_token_of_type (ARG_TOKEN); + + last_type = COMMA_TOKEN; + + while (SLang_Error == 0) + { + this_type = ctok->type; + + switch (this_type) + { + case COMMA_TOKEN: + if (last_type == COMMA_TOKEN) + append_token_of_type (_NULL_TOKEN); + get_token (ctok); + break; + + case CPAREN_TOKEN: + if (last_type == COMMA_TOKEN) + append_token_of_type (_NULL_TOKEN); + if (handle_num_args) append_token_of_type (EARG_TOKEN); + get_token (ctok); + return; + + default: + simple_expression (ctok); + if ((ctok->type != COMMA_TOKEN) + && (ctok->type != CPAREN_TOKEN)) + { + _SLparse_error ("Expecting ')'", ctok, 0); + break; + } + } + last_type = this_type; + } +} + +static int check_for_lvalue (unsigned char eqs_type, _SLang_Token_Type *ctok) +{ + unsigned char type; + + if ((ctok == NULL) + && (NULL == (ctok = get_last_token ()))) + return -1; + + type = ctok->type; + + eqs_type -= ASSIGN_TOKEN; + + if (type == IDENT_TOKEN) + eqs_type += _SCALAR_ASSIGN_TOKEN; + else if (type == ARRAY_TOKEN) + eqs_type += _ARRAY_ASSIGN_TOKEN; + else if (type == DOT_TOKEN) + eqs_type += _STRUCT_ASSIGN_TOKEN; + else + { + _SLparse_error ("Expecting LVALUE", ctok, 0); + return -1; + } + + ctok->type = eqs_type; + return 0; +} + +static void array_index_expression (_SLang_Token_Type *ctok) +{ + unsigned int num_commas; + + num_commas = 0; + while (1) + { + switch (ctok->type) + { + case COLON_TOKEN: + if (num_commas) + _SLparse_error ("Misplaced ':'", ctok, 0); + return; + + case TIMES_TOKEN: + append_token_of_type (_INLINE_WILDCARD_ARRAY_TOKEN); + get_token (ctok); + break; + + case COMMA_TOKEN: + _SLparse_error ("Misplaced ','", ctok, 0); + return; + + default: + simple_expression (ctok); + } + + if (ctok->type != COMMA_TOKEN) + return; + num_commas++; + get_token (ctok); + } +} + +/* inline-array-expression: + * array_index_expression + * simple_expression : simple_expression + * simple_expression : simple_expression : simple_expression + */ +static void inline_array_expression (_SLang_Token_Type *ctok) +{ + int num_colons = 0; + + append_token_of_type (ARG_TOKEN); + + if (ctok->type == COLON_TOKEN) /* [:...] */ + append_token_of_type (_NULL_TOKEN); + else if (ctok->type != CBRACKET_TOKEN) + array_index_expression (ctok); + + if (ctok->type == COLON_TOKEN) + { + num_colons++; + if ((COLON_TOKEN == get_token (ctok)) + || (ctok->type == CBRACKET_TOKEN)) + append_token_of_type (_NULL_TOKEN); + else + simple_expression (ctok); + + if (ctok->type == COLON_TOKEN) + { + num_colons++; + get_token (ctok); + simple_expression (ctok); + } + } + + if (ctok->type != CBRACKET_TOKEN) + { + _SLparse_error ("Expecting ']'", ctok, 0); + return; + } + + /* append_token_of_type (EARG_TOKEN); */ + if (num_colons) + append_token_of_type (_INLINE_IMPLICIT_ARRAY_TOKEN); + else + append_token_of_type (_INLINE_ARRAY_TOKEN); + get_token (ctok); +} + +static void do_multiple_assignment (_SLang_Token_Type *ctok) +{ + _SLang_Token_Type *s; + unsigned int i, k, len; + unsigned char assign_type; + + assign_type = ctok->type; + + /* The LHS token list has already been pushed. Here we do the RHS + * so push to another token list, process it, then come back to + * LHS for assignment. + */ + if (NULL == push_token_list ()) + return; + + get_token (ctok); + expression (ctok); + compile_token_list (); + + if (SLang_Error) + return; + + /* Finally compile the LHS of the assignment expression + * that has been saved. + */ + s = Token_List->stack; + len = Token_List->len; + + if (len == 0) + { + compile_token_of_type (POP_TOKEN); + return; + } + + while (len > 0) + { + /* List is of form: + * a , b, c d e, f , g , , , h , + * The missing expressions will be replaced by a POP + * ,,a + */ + + /* Start from back looking for a COMMA */ + k = len - 1; + if (s[k].type == COMMA_TOKEN) + { + compile_token_of_type (POP_TOKEN); + len = k; + continue; + } + + if (-1 == check_for_lvalue (assign_type, s + k)) + return; + + i = 0; + while (1) + { + if (s[k].type == COMMA_TOKEN) + { + i = k + 1; + break; + } + + if (k == 0) + break; + + k--; + } + + while (i < len) + { + compile_token (s + i); + i++; + } + + len = k; + } + + if (s[0].type == COMMA_TOKEN) + compile_token_of_type (POP_TOKEN); +} + -- cgit v1.2.1