1 /*
2 Copyright (C) 2004-2017,2018 John E. Davis
3 
4 This file is part of the S-Lang Library.
5 
6 The S-Lang Library is free software; you can redistribute it and/or
7 modify it under the terms of the GNU General Public License as
8 published by the Free Software Foundation; either version 2 of the
9 License, or (at your option) any later version.
10 
11 The S-Lang Library is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14 General Public License for more details.
15 
16 You should have received a copy of the GNU General Public License
17 along with this library; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
19 USA.
20 */
21 
22 #include "slinclud.h"
23 
24 #include "slang.h"
25 #include "_slang.h"
26 
27 static SLang_Load_Type *LLT;
28 
free_token(_pSLang_Token_Type * t)29 static void free_token (_pSLang_Token_Type *t)
30 {
31    register unsigned int nrefs = t->num_refs;
32 
33    if (nrefs == 0)
34      return;
35 
36    if (nrefs == 1)
37      {
38 	if (t->free_val_func != NULL)
39 	  {
40 	     (*t->free_val_func)(t);
41 	     t->free_val_func = NULL;
42 	     t->v.s_val = NULL;
43 	  }
44      }
45 
46    t->num_refs = nrefs - 1;
47 }
48 
init_token(_pSLang_Token_Type * t)49 static void init_token (_pSLang_Token_Type *t)
50 {
51    memset ((char *) t, 0, sizeof (_pSLang_Token_Type));
52 #if SLANG_HAS_DEBUG_CODE
53    t->line_number = -1;
54 #endif
55 }
56 
57 /* Allow room for one push back of a token.  This is necessary for
58  * multiple assignment.
59  */
60 static unsigned int Use_Next_Token;
61 static _pSLang_Token_Type Next_Token;
62 #if SLANG_HAS_DEBUG_CODE
63 static int Last_Line_Number = -1;
64 #endif
65 
66 static int In_Looping_Context = 0;
67 
unget_token(_pSLang_Token_Type * ctok)68 static int unget_token (_pSLang_Token_Type *ctok)
69 {
70    if (_pSLang_Error)
71      return -1;
72    if (Use_Next_Token != 0)
73      {
74 	_pSLparse_error (SL_INTERNAL_ERROR, "unget_token failed", ctok, 0);
75 	return -1;
76      }
77 
78    Use_Next_Token++;
79    Next_Token = *ctok;
80    init_token (ctok);
81    return 0;
82 }
83 
get_token(_pSLang_Token_Type * ctok)84 static int get_token (_pSLang_Token_Type *ctok)
85 {
86    if (ctok->num_refs)
87      free_token (ctok);
88 
89    if (Use_Next_Token)
90      {
91 	Use_Next_Token--;
92 	*ctok = Next_Token;
93 	return ctok->type;
94      }
95 
96    return _pSLget_token (ctok);
97 }
98 
check_int_token_overflow(_pSLang_Token_Type * ctok,int sign)99 static int check_int_token_overflow (_pSLang_Token_Type *ctok, int sign)
100 {
101    long ival, lval;
102    SLtype stype;
103 
104    ctok->v.long_val = lval = sign * ctok->v.long_val;
105 
106    if (ctok->flags & (SLTOKEN_IS_HEX|SLTOKEN_IS_BINARY))
107      return 0;
108 
109    switch (ctok->type)
110      {
111       case CHAR_TOKEN:
112 	stype = SLANG_CHAR_TYPE;
113 	ival = (long)(char) lval;
114 	break;
115       case SHORT_TOKEN:
116 	stype = SLANG_SHORT_TYPE;
117 	ival = (long)(short) lval;
118 	break;
119       case INT_TOKEN:
120 	stype = SLANG_INT_TYPE;
121 	ival = (long)(int) lval;
122 	break;
123       case LONG_TOKEN:
124 	stype = LONG_TOKEN;
125         ival = lval;
126 	break;
127 
128       default:
129 	return 0;
130      }
131 
132    if (ival == lval)
133      {
134 	if (((lval >= 0) && (sign > 0))
135 	    || ((lval <= 0) && (sign < 0)))
136 	  return 0;
137      }
138    SLang_verror (SL_SYNTAX_ERROR, "Literal integer constant is too large for %s", SLclass_get_datatype_name(stype));
139    return -1;
140 }
141 
check_uint_token_overflow(_pSLang_Token_Type * ctok,int sign)142 static int check_uint_token_overflow (_pSLang_Token_Type *ctok, int sign)
143 {
144    unsigned long ival, lval;
145    SLtype stype;
146 
147    ctok->v.long_val = sign * ctok->v.long_val;
148    lval = (unsigned long) ctok->v.long_val;
149 
150    switch (ctok->type)
151      {
152       case UCHAR_TOKEN:
153 	ival = (unsigned long)(unsigned char) lval;
154 	stype = SLANG_UCHAR_TYPE;
155 	break;
156       case USHORT_TOKEN:
157 	stype = SLANG_USHORT_TYPE;
158 	ival = (unsigned long)(unsigned short) lval;
159 	break;
160       case UINT_TOKEN:
161 	stype = SLANG_UINT_TYPE;
162 	ival = (unsigned long)(unsigned int) lval;
163 	break;
164       case ULONG_TOKEN:
165 	stype = SLANG_ULONG_TYPE;
166 	ival = lval;
167 	break;
168       default:
169 	return 0;
170      }
171 
172    if (ival == lval)
173      return 0;
174 
175    SLang_verror (SL_SYNTAX_ERROR, "Literal integer constant is too large for %s", SLclass_get_datatype_name(stype));
176    return -1;
177 }
178 
179 #ifdef HAVE_LONG_LONG
check_llong_token_overflow(_pSLang_Token_Type * ctok,int sign)180 static int check_llong_token_overflow (_pSLang_Token_Type *ctok, int sign)
181 {
182    long long lval = sign * ctok->v.llong_val;
183    ctok->v.llong_val = lval;
184 
185    if ((ctok->flags & (SLTOKEN_IS_HEX|SLTOKEN_IS_BINARY))
186        || ((lval >= 0) && (sign > 0))
187        || ((lval <= 0) && (sign < 0)))
188      return 0;
189 
190    SLang_verror (SL_SYNTAX_ERROR, "Literal integer constant is too large for %s", SLclass_get_datatype_name(SLANG_LLONG_TYPE));
191    return -1;
192 }
193 
check_ullong_token_overflow(_pSLang_Token_Type * ctok,int sign)194 static int check_ullong_token_overflow (_pSLang_Token_Type *ctok, int sign)
195 {
196    ctok->v.ullong_val *= sign;
197    return 0;
198 }
199 #endif
200 
check_number_token_overflow(_pSLang_Token_Type * tok,int sign)201 static int check_number_token_overflow (_pSLang_Token_Type *tok, int sign)
202 {
203    tok->flags |= SLTOKEN_OVERFLOW_CHECKED;
204 
205    switch (tok->type)
206      {
207       case CHAR_TOKEN:
208       case SHORT_TOKEN:
209       case INT_TOKEN:
210       case LONG_TOKEN:
211 	return check_int_token_overflow (tok, sign);
212 
213       case UCHAR_TOKEN:
214       case USHORT_TOKEN:
215       case UINT_TOKEN:
216       case ULONG_TOKEN:
217 	return check_uint_token_overflow (tok, sign);
218 
219 #ifdef HAVE_LONG_LONG
220       case LLONG_TOKEN:
221 	return check_llong_token_overflow (tok, sign);
222 
223       case ULLONG_TOKEN:
224 	return check_ullong_token_overflow (tok, sign);
225 #endif
226      }
227    return 0;
228 }
229 
compile_token(_pSLang_Token_Type * t)230 static int compile_token (_pSLang_Token_Type *t)
231 {
232 #if SLANG_HAS_DEBUG_CODE
233    if ((t->line_number != Last_Line_Number)
234        && (t->line_number != -1))
235      {
236 	_pSLang_Token_Type tok;
237 	tok.type = LINE_NUM_TOKEN;
238 	tok.v.long_val = Last_Line_Number = t->line_number;
239 	(*_pSLcompile_ptr) (&tok);
240      }
241 #endif
242    if ((t->flags & (SLTOKEN_TYPE_INTEGER|SLTOKEN_OVERFLOW_CHECKED)) == SLTOKEN_TYPE_INTEGER)
243      {
244 	if (-1 == check_number_token_overflow (t, 1))
245 	  return -1;
246      }
247    (*_pSLcompile_ptr) (t);
248    return 0;
249 }
250 
251 typedef struct
252 {
253 #define USE_PARANOID_MAGIC	0
254 #if USE_PARANOID_MAGIC
255    unsigned long magic;
256 #endif
257    _pSLang_Token_Type *stack;
258    unsigned int len;
259    unsigned int size;
260 }
261 Token_List_Type;
262 
263 #define MAX_TOKEN_LISTS 256
264 static Token_List_Type Token_List_Stack [MAX_TOKEN_LISTS];
265 static unsigned int Token_List_Stack_Depth = 0;
266 static Token_List_Type *Token_List = NULL;
267 
init_token_list(Token_List_Type * t)268 static void init_token_list (Token_List_Type *t)
269 {
270    t->size = 0;
271    t->len = 0;
272    t->stack = NULL;
273 #if USE_PARANOID_MAGIC
274    t->magic = 0xABCDEF12;
275 #endif
276 }
277 
free_token_list(Token_List_Type * t)278 static void free_token_list (Token_List_Type *t)
279 {
280    _pSLang_Token_Type *s;
281 
282    if (t == NULL)
283      return;
284 #if USE_PARANOID_MAGIC
285    if (t->magic != 0xABCDEF12)
286      {
287 	_pSLang_verror (SL_INTERNAL_ERROR, "Token Magic number error.");
288 	return;
289      }
290 #endif
291    s = t->stack;
292    if (s != NULL)
293      {
294 	_pSLang_Token_Type *smax = s + t->len;
295 	while (s != smax)
296 	  {
297 	     if (s->num_refs) free_token (s);
298 	     s++;
299 	  }
300 
301 	SLfree ((char *) t->stack);
302      }
303 
304    memset ((char *) t, 0, sizeof (Token_List_Type));
305 }
306 
push_token_list(void)307 static Token_List_Type *push_token_list (void)
308 {
309    if (Token_List_Stack_Depth == MAX_TOKEN_LISTS)
310      {
311 	_pSLparse_error (SL_BUILTIN_LIMIT_EXCEEDED,
312 			"Token list stack size exceeded", NULL, 0);
313 	return NULL;
314      }
315 
316    Token_List = Token_List_Stack + Token_List_Stack_Depth;
317    Token_List_Stack_Depth++;
318    init_token_list (Token_List);
319    return Token_List;
320 }
321 
pop_token_list(int do_free)322 static int pop_token_list (int do_free)
323 {
324    if (Token_List_Stack_Depth == 0)
325      {
326 	if (_pSLang_Error == 0)
327 	  _pSLparse_error (SL_INTERNAL_ERROR, "Token list stack underflow", NULL, 0);
328 	return -1;
329      }
330    Token_List_Stack_Depth--;
331 
332    if (do_free) free_token_list (Token_List);
333 
334    if (Token_List_Stack_Depth != 0)
335      Token_List = Token_List_Stack + (Token_List_Stack_Depth - 1);
336    else
337      Token_List = NULL;
338 
339    return 0;
340 }
341 
check_token_list_space(Token_List_Type * t,unsigned int delta_size)342 static int check_token_list_space (Token_List_Type *t, unsigned int delta_size)
343 {
344    _pSLang_Token_Type *st;
345    unsigned int len;
346 #if USE_PARANOID_MAGIC
347    if (t->magic != 0xABCDEF12)
348      {
349 	_pSLang_verror (SL_INTERNAL_ERROR, "Token Magic number error.");
350 	return -1;
351      }
352 #endif
353    len = t->len + delta_size;
354    if (len <= t->size) return 0;
355 
356    if (delta_size < 4)
357      {
358 	delta_size = 4;
359 	len = t->len + delta_size;
360      }
361 
362    st = (_pSLang_Token_Type *) SLrealloc((char *) t->stack,
363 					len * sizeof(_pSLang_Token_Type));
364    if (st == NULL)
365      {
366 	_pSLparse_error (SL_MALLOC_ERROR, "Malloc error", NULL, 0);
367 	return -1;
368      }
369 
370    memset ((char *) (st + t->len), 0, delta_size);
371 
372    t->stack = st;
373    t->size = len;
374    return 0;
375 }
376 
append_token(_pSLang_Token_Type * t)377 static int append_token (_pSLang_Token_Type *t)
378 {
379    if (-1 == check_token_list_space (Token_List, 1))
380      return -1;
381 
382    Token_List->stack [Token_List->len] = *t;
383    Token_List->len += 1;
384    t->num_refs = 0;		       /* stealing it */
385    return 0;
386 }
387 
append_copy_of_string_token(_pSLang_Token_Type * t)388 static int append_copy_of_string_token (_pSLang_Token_Type *t)
389 {
390    _pSLang_Token_Type *t1;
391 
392    if (-1 == check_token_list_space (Token_List, 1))
393      return -1;
394 
395    t1 = Token_List->stack + Token_List->len;
396    *t1 = *t;
397 
398    if (t->v.s_val == NULL)
399      return -1;
400 
401    if (EOF_TOKEN == _pSLtoken_init_slstring_token (t1, t->type, t->v.s_val, strlen (t->v.s_val)))
402      return -1;
403 
404    t1->num_refs = 1;
405 
406    Token_List->len += 1;
407    return 0;
408 }
409 
append_int_as_token(int n)410 static int append_int_as_token (int n)
411 {
412    _pSLang_Token_Type num_tok;
413 
414    init_token (&num_tok);
415    num_tok.type = INT_TOKEN;
416    num_tok.flags |= SLTOKEN_TYPE_INTEGER|SLTOKEN_OVERFLOW_CHECKED;
417    num_tok.v.long_val = n;
418    return append_token (&num_tok);
419 }
420 
421 #if 0
422 static int append_string_as_token (char *str)
423 {
424    _pSLang_Token_Type *t;
425 
426    if (-1 == check_token_list_space (Token_List, 1))
427      return -1;
428 
429    t = Token_List->stack + Token_List->len;
430    init_token (t);
431 
432    if (EOF_TOKEN == _pSLtoken_init_slstring_token (t, STRING_TOKEN, str, strlen (str)))
433      return -1;
434 
435    t->num_refs = 1;
436 
437    Token_List->len += 1;
438    return 0;
439 }
440 #endif
441 
append_token_of_type(unsigned char t)442 static int append_token_of_type (unsigned char t)
443 {
444    _pSLang_Token_Type *tok;
445 
446    if (-1 == check_token_list_space (Token_List, 1))
447      return -1;
448 
449    /* The memset when the list was created ensures that the other fields
450     * are properly initialized.
451     */
452 #if 0
453    if ((t == CHS_TOKEN) && Token_List->len)
454      {
455 	tok = Token_List->stack + (Token_List->len-1);
456 	if (IS_INTEGER_TOKEN(tok->type))
457 	  {
458 	     tok->v.long_val = -tok->v.long_val;
459 	     return 0;
460 	  }
461 #ifdef HAVE_LONG_LONG
462 	if ((tok->type == LLONG_TOKEN) || (tok->type == ULLONG_TOKEN))
463 	  {
464 	     tok->v.llong_val = -tok->v.llong_val;
465 	     return 0;
466 	  }
467 #endif
468      }
469 #endif
470 
471    tok = Token_List->stack + Token_List->len;
472    init_token (tok);
473    tok->type = t;
474    Token_List->len += 1;
475    return 0;
476 }
477 
get_last_token(void)478 static _pSLang_Token_Type *get_last_token (void)
479 {
480    unsigned int len;
481 
482    if ((Token_List == NULL)
483        || (0 == (len = Token_List->len)))
484      return NULL;
485 
486    len--;
487    return Token_List->stack + len;
488 }
489 
490 /* This function does NOT free the list. */
compile_token_list_with_fun(int dir,Token_List_Type * list,int (* f)(_pSLang_Token_Type *))491 static int compile_token_list_with_fun (int dir, Token_List_Type *list,
492 					int (*f)(_pSLang_Token_Type *))
493 {
494    _pSLang_Token_Type *t0, *t1;
495 
496    if (list == NULL)
497      return -1;
498 
499    if (f == NULL)
500      f = compile_token;
501 
502    t0 = list->stack;
503    t1 = t0 + list->len;
504 
505    if (dir < 0)
506      {
507 	/* backwards */
508 
509 	while ((_pSLang_Error == 0) && (t1 > t0))
510 	  {
511 	     t1--;
512 	     (*f) (t1);
513 	  }
514 	return 0;
515      }
516 
517    /* forward */
518    while ((_pSLang_Error == 0) && (t0 < t1))
519      {
520 	(*f) (t0);
521 	t0++;
522      }
523    return 0;
524 }
525 
compile_token_list(void)526 static int compile_token_list (void)
527 {
528    if (Token_List == NULL)
529      return -1;
530 
531    compile_token_list_with_fun (1, Token_List, NULL);
532    pop_token_list (1);
533    return 0;
534 }
535 
536 /* Take all elements in the list from pos2 to the end and exchange them
537  * with the elements at pos1, e.g.,
538  * ...ABCDEabc ==> ...abcABCDE
539  * where pos1 denotes A and pos2 denotes a.
540  *
541  * NOTE: The caller must make special provisions for NO_OP_LITERAL tokens.
542  */
token_list_element_exchange(unsigned int pos1,unsigned int pos2)543 static int token_list_element_exchange (unsigned int pos1, unsigned int pos2)
544 {
545    _pSLang_Token_Type *s, *s1, *s2;
546    unsigned int len, nloops;
547 
548    if (Token_List == NULL)
549      return -1;
550 
551    s = Token_List->stack;
552    len = Token_List->len;
553 
554    if ((s == NULL) || (len == 0)
555        || (pos2 >= len))
556      return -1;
557 
558    if (pos1 > pos2)
559      {
560 	SLang_verror (SL_INTERNAL_ERROR, "pos1<pos2 in token_list_element_exchange");
561 	return -1;
562      }
563 
564    /* This may not be the most efficient algorithm but the number to swap
565     * is most-likely going to be small, e.g, 3
566     * The algorithm is to rotate the list.  The particular rotation
567     * direction was chosen to make insert_token fast.
568     * It works like:
569     * @ ABCabcde --> BCabcdeA --> CabcdeAB -->  abcdefAB
570     * which is optimal for Abcdef sequence produced by function calls.
571     *
572     * Profiling indicates that nloops is almost always 1, whereas the inner
573     * loop can loop many times (e.g., 9 times).
574     */
575 
576    s2 = s + (len - 1);
577    s1 = s + pos1;
578    nloops = pos2 - pos1;
579 
580    while (nloops)
581      {
582 	_pSLang_Token_Type save;
583 
584 	s = s1;
585 	save = *s;
586 
587 	while (s < s2)
588 	  {
589 	     *s = *(s + 1);
590 	     s++;
591 	  }
592 	*s = save;
593 
594 	nloops--;
595      }
596    return 0;
597 }
598 
599 #if 0
600 static int insert_token (_pSLang_Token_Type *t, unsigned int pos)
601 {
602    if (-1 == append_token (t))
603      return -1;
604 
605    return token_list_element_exchange (pos, Token_List->len - 1);
606 }
607 #endif
compile_token_of_type(unsigned char t)608 static void compile_token_of_type (unsigned char t)
609 {
610    _pSLang_Token_Type tok;
611 
612 #if SLANG_HAS_DEBUG_CODE
613    tok.line_number = -1;
614 #endif
615    tok.flags = 0;
616    tok.type = t;
617    compile_token(&tok);
618 }
619 
620 #if SLANG_HAS_BOSEOS
compile_eos(void)621 static void compile_eos (void)
622 {
623    /* This is commented out to ensure that if bos was compiled, the eos will be.
624     *
625     * if (0 == (_pSLang_Compile_Line_Num_Info & SLANG_BOSEOS_MASK))
626     * return;
627     */
628    compile_token_of_type (EOS_TOKEN);
629 }
630 
compile_bos(_pSLang_Token_Type * t,int level)631 static int compile_bos (_pSLang_Token_Type *t, int level)
632 {
633    _pSLang_Token_Type tok;
634 
635    if (level > (_pSLang_Compile_BOSEOS & SLANG_BOSEOS_VALUE_BITS))
636      return 0;
637 
638    tok.type = BOS_TOKEN;
639    tok.v.long_val = t->line_number;
640    (*_pSLcompile_ptr) (&tok);
641    return 1;
642 }
append_eos(void)643 static void append_eos (void)
644 {
645    /* This is commented out to ensure that if bos was compiled, the eos will be.
646     *
647     * if (0 == (_pSLang_Compile_Line_Num_Info & SLANG_BOSEOS_MASK))
648     * return;
649     */
650    append_token_of_type (EOS_TOKEN);
651 }
652 
append_bos(_pSLang_Token_Type * t,int level)653 static int append_bos (_pSLang_Token_Type *t, int level)
654 {
655    _pSLang_Token_Type tok;
656 
657    if (level > (_pSLang_Compile_BOSEOS & SLANG_BOSEOS_VALUE_BITS))
658      return 0;
659 
660    init_token (&tok);
661    tok.type = BOS_TOKEN;
662    tok.v.long_val = t->line_number;
663 
664    append_token (&tok);
665    free_token (&tok);
666    return 1;
667 }
668 #endif
669 
670 static void statement (_pSLang_Token_Type *);
671 static void loop_statement (_pSLang_Token_Type *);
672 static void compound_statement (_pSLang_Token_Type *);
673 static void expression_with_parenthesis (_pSLang_Token_Type *);
674 static void handle_semicolon (_pSLang_Token_Type *);
675 static void handle_for_statement (_pSLang_Token_Type *);
676 static void handle_foreach_statement (_pSLang_Token_Type *);
677 static void statement_list (_pSLang_Token_Type *);
678 static void variable_list (_pSLang_Token_Type *, unsigned char);
679 static void struct_declaration (_pSLang_Token_Type *, int);
680 static void define_function_args (_pSLang_Token_Type *);
681 static void typedef_definition (_pSLang_Token_Type *);
682 static void function_args_expression (_pSLang_Token_Type *, int, int, int, unsigned int *);
683 static void expression (_pSLang_Token_Type *);
684 static void expression_with_commas (_pSLang_Token_Type *, int);
685 static void simple_expression (_pSLang_Token_Type *);
686 static void unary_expression (_pSLang_Token_Type *);
687 static void postfix_expression (_pSLang_Token_Type *);
688 static int check_for_lvalue (unsigned char, _pSLang_Token_Type *);
689 /* static void primary_expression (_pSLang_Token_Type *); */
690 static void block (_pSLang_Token_Type *);
691 static void loop_block (_pSLang_Token_Type *);
692 static void inline_array_expression (_pSLang_Token_Type *);
693 static void inline_list_expression (_pSLang_Token_Type *);
694 static void array_index_expression (_pSLang_Token_Type *);
695 static void do_multiple_assignment (_pSLang_Token_Type *);
696 static void try_multiple_assignment (_pSLang_Token_Type *);
697 static void handle_try_statement (_pSLang_Token_Type *);
698 static void handle_throw_statement (_pSLang_Token_Type *);
699 
700 #if 0
701 static void not_implemented (char *what)
702 {
703    char err [256];
704    sprintf (err, "Expression not implemented: %s", what);
705    _pSLparse_error (SL_NOT_IMPLEMENTED, err, NULL, 0);
706 }
707 #endif
rpn_parse_line(_pSLang_Token_Type * tok)708 static void rpn_parse_line (_pSLang_Token_Type *tok)
709 {
710    do
711      {
712 	  /* multiple RPN tokens possible when the file looks like:
713 	   * . <end of line>
714 	   * . <end of line>
715 	   */
716 	if (tok->type != RPN_TOKEN)
717 	  compile_token (tok);
718 	free_token (tok);
719      }
720    while (EOF_TOKEN != _pSLget_rpn_token (tok));
721 }
722 
get_identifier_token(_pSLang_Token_Type * tok,int string_ok)723 static int get_identifier_token (_pSLang_Token_Type *tok, int string_ok)
724 {
725    int type = get_token (tok);
726 
727    if ((type == IDENT_TOKEN)
728        || (string_ok && (type == STRING_TOKEN)))
729      return 0;
730 
731    if (string_ok && (tok->flags & SLTOKEN_VALUE_IS_RESERVED))
732      {
733 	if (EOF_TOKEN == _pSLtoken_init_slstring_token (tok, IDENT_TOKEN, tok->v.s_val, strlen(tok->v.s_val)))
734 	  return -1;
735 	return 0;
736      }
737 
738    _pSLparse_error (SL_SYNTAX_ERROR, "Expecting identifier", tok, 0);
739    return -1;
740 }
741 
define_function(_pSLang_Token_Type * ctok,unsigned char type)742 static void define_function (_pSLang_Token_Type *ctok, unsigned char type)
743 {
744    _pSLang_Token_Type fname;
745 
746    switch (type)
747      {
748       case STATIC_TOKEN:
749 	type = DEFINE_STATIC_TOKEN;
750 	break;
751 
752       case PUBLIC_TOKEN:
753 	type = DEFINE_PUBLIC_TOKEN;
754 	break;
755 
756       case PRIVATE_TOKEN:
757 	type = DEFINE_PRIVATE_TOKEN;
758      }
759 
760    init_token (&fname);
761    if (-1 == get_identifier_token (&fname, 0))
762      {
763 	free_token (&fname);
764 	return;
765      }
766 
767    compile_token_of_type(OPAREN_TOKEN);
768    get_token (ctok);
769    define_function_args (ctok);
770    compile_token_of_type(FARG_TOKEN);
771 
772    if (ctok->type == OBRACE_TOKEN)
773      {
774 	int loop_context = In_Looping_Context;
775 	In_Looping_Context = 0;
776 	compound_statement(ctok);
777 	In_Looping_Context = loop_context;
778      }
779 
780    else if (ctok->type != SEMICOLON_TOKEN)
781      {
782 	_pSLparse_error(SL_SYNTAX_ERROR, "Expecting {", ctok, 0);
783 	free_token (&fname);
784 	return;
785      }
786 
787    fname.type = type;
788    compile_token (&fname);
789    free_token (&fname);
790 }
791 
792 /* This is called from "statement", which is expected to return no
793  * new token.
794  */
check_for_loop_then_else(_pSLang_Token_Type * ctok)795 static int check_for_loop_then_else (_pSLang_Token_Type *ctok)
796 {
797    int b = 0;
798 
799    get_token (ctok);
800 
801    while (1)
802      {
803 	_pSLtok_Type type = ctok->type;
804 #ifdef LOOP_ELSE_TOKEN
805 	if ((type == ELSE_TOKEN) && ((b & 1) == 0))
806 	  {
807 	     get_token (ctok);
808 	     block (ctok);
809 	     compile_token_of_type (LOOP_ELSE_TOKEN);
810 	     get_token (ctok);
811 	     b |= 1;
812 	     continue;
813 	  }
814 #endif
815 	if ((type == THEN_TOKEN) && ((b & 2) == 0))
816 	  {
817 	     get_token (ctok);
818 	     block (ctok);
819 	     compile_token_of_type (LOOP_THEN_TOKEN);
820 	     b |= 2;
821 #ifdef LOOP_ELSE_TOKEN
822 	     get_token (ctok);
823 	     continue;
824 #else
825 	     return b;
826 #endif
827 	  }
828 	break;
829      }
830    unget_token (ctok);
831    return b;
832 }
833 
834 /* statement:
835  *	 compound-statement
836  *	 if ( expression ) statement
837  *	 if ( expression ) statement else statement
838  *	 !if ( expression ) statement
839  *	 loop ( expression ) statement
840  *	 _for ( expression ) statement
841  *       foreach ( expression ) statement
842  *       foreach (expression ) using (expression-list) statement
843  *	 while ( expression ) statement
844  *	 do statement while (expression) ;
845  *	 for ( expressionopt ; expressionopt ; expressionopt ) statement
846  *	 ERROR_BLOCK statement
847  *       try statement rest-of-try-statement
848  *       throw exception, object
849  *	 EXIT_BLOCK statement
850  *	 USER_BLOCK0 statement
851  *	 USER_BLOCK1 statement
852  *	 USER_BLOCK2 statement
853  *	 USER_BLOCK3 statement
854  *	 USER_BLOCK4 statement
855  *	 forever statement
856  *	 break ;
857  *	 continue ;
858  *	 return expressionopt ;
859  *	 variable variable-list ;
860  *	 struct struct-decl ;
861  *	 define identifier function-args ;
862  *	 define identifier function-args compound-statement
863  *	 switch ( expression ) statement
864  *	 rpn-line
865  *	 at-line
866  *	 push ( expression )
867  *	 ( expression ) = expression ;
868  *	 expression ;
869  *       expression :
870  */
871 
872 /* Note: This function does not return with a new token.  It is up to the
873  * calling routine to handle that.
874  */
statement(_pSLang_Token_Type * ctok)875 static void statement (_pSLang_Token_Type *ctok)
876 {
877    unsigned char type;
878 #if SLANG_HAS_BOSEOS
879    int eos;
880 #endif
881    if (_pSLang_Error)
882      return;
883 
884    LLT->parse_level += 1;
885 
886    switch (ctok->type)
887      {
888       case OBRACE_TOKEN:
889 	compound_statement (ctok);
890 	break;
891 
892       case IF_TOKEN:
893       case IFNOT_TOKEN:
894 	type = ctok->type;
895 	get_token (ctok);
896 #if SLANG_HAS_BOSEOS
897 	eos = compile_bos (ctok, 2);
898 #endif
899 	expression_with_parenthesis (ctok);
900 #if SLANG_HAS_BOSEOS
901 	if (eos) compile_eos ();
902 #endif
903 	block (ctok);
904 
905 	if (ELSE_TOKEN != get_token (ctok))
906 	  {
907 	     compile_token_of_type (type);
908 	     unget_token (ctok);
909 	     break;
910 	  }
911 	get_token (ctok);
912 	block (ctok);
913 	if (type == IF_TOKEN) type = ELSE_TOKEN; else type = NOTELSE_TOKEN;
914 	compile_token_of_type (type);
915 	break;
916 
917       /* case IFNOT_TOKEN: */
918       case _FOR_TOKEN:
919 	get_token (ctok);
920 	handle_for_statement (ctok);
921 	if (0 == check_for_loop_then_else (ctok))
922 	  compile_token_of_type (NOP_TOKEN);
923 	break;
924 
925       case LOOP_TOKEN:
926 	get_token (ctok);
927 #if SLANG_HAS_BOSEOS
928 	eos = compile_bos (ctok, 2);
929 #endif
930 	expression_with_parenthesis (ctok);
931 #if SLANG_HAS_BOSEOS
932 	if (eos) compile_eos ();
933 #endif
934 	loop_block (ctok);
935 	compile_token_of_type (LOOP_TOKEN);
936 	if (0 == check_for_loop_then_else (ctok))
937 	  compile_token_of_type (NOP_TOKEN);
938 	break;
939 
940       case FOREACH_TOKEN:
941 	get_token (ctok);
942 	handle_foreach_statement (ctok);
943 	if (0 == check_for_loop_then_else (ctok))
944 	  compile_token_of_type (NOP_TOKEN);
945 	break;
946 
947       case WHILE_TOKEN:
948 	get_token (ctok);
949 	compile_token_of_type (OBRACE_TOKEN);
950 #if SLANG_HAS_BOSEOS
951 	eos = compile_bos (ctok, 2);
952 #endif
953 	expression_with_parenthesis (ctok);
954 #if SLANG_HAS_BOSEOS
955 	if (eos) compile_eos ();
956 #endif
957 	compile_token_of_type (CBRACE_TOKEN);
958 	loop_block (ctok);
959 	compile_token_of_type (WHILE_TOKEN);
960 	if (0 == check_for_loop_then_else (ctok))
961 	  compile_token_of_type (NOP_TOKEN);
962 	break;
963 
964       case DO_TOKEN:
965 	get_token (ctok);
966 	loop_block (ctok);
967 
968 	if (WHILE_TOKEN != get_token (ctok))
969 	  {
970 	     _pSLparse_error(SL_SYNTAX_ERROR, "Expecting while", ctok, 0);
971 	     break;
972 	  }
973 
974 	get_token (ctok);
975 
976 	compile_token_of_type (OBRACE_TOKEN);
977 #if SLANG_HAS_BOSEOS
978 	eos = compile_bos (ctok, 2);
979 #endif
980 	expression_with_parenthesis (ctok);
981 #if SLANG_HAS_BOSEOS
982 	if (eos) compile_eos ();
983 #endif
984 	compile_token_of_type (CBRACE_TOKEN);
985 	compile_token_of_type (DOWHILE_TOKEN);
986 	handle_semicolon (ctok);
987 	if (0 == check_for_loop_then_else (ctok))
988 	  compile_token_of_type (NOP_TOKEN);
989 	break;
990 
991       case FOR_TOKEN:
992 	/* Look for (exp_opt ; exp_opt ; exp_opt ) */
993 
994 	if (OPAREN_TOKEN != get_token (ctok))
995 	  {
996 	     _pSLparse_error(SL_SYNTAX_ERROR, "Expecting (.", ctok, 0);
997 	     break;
998 	  }
999 
1000 	if (NULL == push_token_list ())
1001 	  break;
1002 
1003 	append_token_of_type (OBRACE_TOKEN);
1004 	if (SEMICOLON_TOKEN != get_token (ctok))
1005 	  {
1006 #if SLANG_HAS_BOSEOS
1007 	     eos = append_bos (ctok, 2);
1008 #endif
1009 	     expression (ctok);
1010 #if SLANG_HAS_BOSEOS
1011 	     if (eos) append_eos ();
1012 #endif
1013 	     if (ctok->type != SEMICOLON_TOKEN)
1014 	       {
1015 		  _pSLparse_error(SL_SYNTAX_ERROR, "Expecting ;", ctok, 0);
1016 		  break;
1017 	       }
1018 	  }
1019 	append_token_of_type (CBRACE_TOKEN);
1020 
1021 	append_token_of_type (OBRACE_TOKEN);
1022 	if (SEMICOLON_TOKEN == get_token (ctok))
1023 	  {
1024 	     (void) append_int_as_token (1);
1025 	  }
1026 	else
1027 	  {
1028 #if SLANG_HAS_BOSEOS
1029 	     eos = append_bos (ctok, 2);
1030 #endif
1031 	     expression (ctok);
1032 #if SLANG_HAS_BOSEOS
1033 	     if (eos) append_eos ();
1034 #endif
1035 	     if (ctok->type != SEMICOLON_TOKEN)
1036 	       {
1037 		  _pSLparse_error(SL_SYNTAX_ERROR, "Expecting ;", ctok, 0);
1038 		  break;
1039 	       }
1040 	  }
1041 	append_token_of_type (CBRACE_TOKEN);
1042 	append_token_of_type (OBRACE_TOKEN);
1043 	if (CPAREN_TOKEN != get_token (ctok))
1044 	  {
1045 #if SLANG_HAS_BOSEOS
1046 	     eos = append_bos (ctok, 2);
1047 #endif
1048 	     expression (ctok);
1049 #if SLANG_HAS_BOSEOS
1050 	     if (eos) append_eos ();
1051 #endif
1052 	     if (ctok->type != CPAREN_TOKEN)
1053 	       {
1054 		  _pSLparse_error(SL_SYNTAX_ERROR, "Expecting ).", ctok, 0);
1055 		  break;
1056 	       }
1057 	  }
1058 	append_token_of_type (CBRACE_TOKEN);
1059 
1060 	compile_token_list ();
1061 
1062 	get_token (ctok);
1063 	loop_block (ctok);
1064 	compile_token_of_type (FOR_TOKEN);
1065 	if (0 == check_for_loop_then_else (ctok))
1066 	  compile_token_of_type (NOP_TOKEN);
1067 	break;
1068 
1069       case FOREVER_TOKEN:
1070 	get_token (ctok);
1071 	loop_block (ctok);
1072 	compile_token_of_type (FOREVER_TOKEN);
1073 	if (0 == check_for_loop_then_else (ctok))
1074 	  compile_token_of_type (NOP_TOKEN);
1075 	break;
1076 
1077       case ERRBLK_TOKEN:
1078       case EXITBLK_TOKEN:
1079       case USRBLK0_TOKEN:
1080       case USRBLK1_TOKEN:
1081       case USRBLK2_TOKEN:
1082       case USRBLK3_TOKEN:
1083       case USRBLK4_TOKEN:
1084 	type = ctok->type;
1085 	get_token (ctok);
1086 	block (ctok);
1087 	compile_token_of_type (type);
1088 	break;
1089 
1090       case BREAK_TOKEN:
1091       case CONT_TOKEN:
1092 	if (In_Looping_Context == 0)
1093 	  {
1094 	     _pSLparse_error (SL_SYNTAX_ERROR, "`break' or `continue' requires a looping context", ctok, 0);
1095 	     break;
1096 	  }
1097 
1098 	type = ctok->type;
1099 #if SLANG_HAS_BOSEOS
1100 	eos = compile_bos (ctok, 3);
1101 #endif
1102 	if (SEMICOLON_TOKEN != get_token (ctok))
1103 	  {
1104 	     if ((ctok->type != INT_TOKEN)
1105 		 || (ctok->v.long_val <= 0))
1106 	       {
1107 		  _pSLparse_error (SL_SYNTAX_ERROR, "Expecting a positive non-zero integer or a semi-colon.", ctok, 0);
1108 		  break;
1109 	       }
1110 	     ctok->type = (type == BREAK_TOKEN) ? BREAK_N_TOKEN : CONT_N_TOKEN;
1111 	     compile_token (ctok);
1112 	     get_token (ctok);
1113 	     handle_semicolon (ctok);
1114 	  }
1115 	else compile_token_of_type (type);
1116 #if SLANG_HAS_BOSEOS
1117 	if (eos) compile_eos ();
1118 #endif
1119 	break;
1120 
1121       case RETURN_TOKEN:
1122 	if (SEMICOLON_TOKEN != get_token (ctok))
1123 	  {
1124 	     if (NULL == push_token_list ())
1125 	       break;
1126 
1127 #if SLANG_HAS_BOSEOS
1128 	     eos = append_bos (ctok, 3);
1129 #endif
1130 	     expression (ctok);
1131 #if SLANG_HAS_BOSEOS
1132 	     if (eos) append_eos ();
1133 #endif
1134 
1135 	     if (ctok->type != SEMICOLON_TOKEN)
1136 	       {
1137 		  _pSLparse_error (SL_SYNTAX_ERROR, "Expecting ;", ctok, 0);
1138 		  break;
1139 	       }
1140 	     compile_token_list ();
1141 	  }
1142 	compile_token_of_type (RETURN_TOKEN);
1143 	handle_semicolon (ctok);
1144 	break;
1145 
1146       case STATIC_TOKEN:
1147       case PRIVATE_TOKEN:
1148       case PUBLIC_TOKEN:
1149 	type = ctok->type;
1150 	get_token (ctok);
1151 	if (ctok->type == VARIABLE_TOKEN)
1152 	  {
1153 	     get_token (ctok);
1154 	     variable_list (ctok, type);
1155 	     handle_semicolon (ctok);
1156 	     break;
1157 	  }
1158 	if (ctok->type == DEFINE_TOKEN)
1159 	  {
1160 	     define_function (ctok, type);
1161 	     break;
1162 	  }
1163 	_pSLparse_error (SL_SYNTAX_ERROR, "Expecting 'variable' or 'define'", ctok, 0);
1164 	break;
1165 
1166       case VARIABLE_TOKEN:
1167 	get_token (ctok);
1168 	variable_list (ctok, OBRACKET_TOKEN);
1169 	handle_semicolon (ctok);
1170 	break;
1171 
1172       case TYPEDEF_TOKEN:
1173 	get_token (ctok);
1174 	if (NULL == push_token_list ())
1175 	  break;
1176 	typedef_definition (ctok);
1177 	compile_token_list ();
1178 
1179 	handle_semicolon (ctok);
1180 	break;
1181 
1182       case DEFINE_TOKEN:
1183 	define_function (ctok, DEFINE_TOKEN);
1184 	break;
1185 
1186       case TRY_TOKEN:
1187 	get_token (ctok);
1188 	handle_try_statement (ctok);
1189 	break;
1190 
1191       case THROW_TOKEN:
1192 	get_token (ctok);
1193 	handle_throw_statement (ctok);
1194 	break;
1195 
1196       case SWITCH_TOKEN:
1197 	get_token (ctok);
1198 #if SLANG_HAS_BOSEOS
1199 	eos = compile_bos (ctok, 2);
1200 #endif
1201 	expression_with_parenthesis (ctok);
1202 #if SLANG_HAS_BOSEOS
1203 	if (eos) compile_eos ();
1204 #endif
1205 
1206 	while ((_pSLang_Error == 0)
1207 	       && (OBRACE_TOKEN == ctok->type))
1208 	  {
1209 	     compile_token_of_type (OBRACE_TOKEN);
1210 	     compound_statement (ctok);
1211 	     compile_token_of_type (CBRACE_TOKEN);
1212 	     get_token (ctok);
1213 	  }
1214 	compile_token_of_type (SWITCH_TOKEN);
1215 	unget_token (ctok);
1216 	break;
1217 
1218       case EOF_TOKEN:
1219 	break;
1220 #if 0
1221       case PUSH_TOKEN:
1222 	get_token (ctok);
1223 	expression_list_with_parenthesis (ctok);
1224 	handle_semicolon (ctok);
1225 	break;
1226 #endif
1227 
1228       case SEMICOLON_TOKEN:
1229 #if SLANG_HAS_BOSEOS
1230 	eos = compile_bos (ctok, 3);
1231 	if (eos) compile_eos ();
1232 #endif
1233 	handle_semicolon (ctok);
1234 	break;
1235 
1236       case RPN_TOKEN:
1237 	if (POUND_TOKEN == get_token (ctok))
1238 	  _pSLcompile_byte_compiled ();
1239 	else if (ctok->type != EOF_TOKEN)
1240 	  rpn_parse_line (ctok);
1241 	break;
1242 
1243       case OPAREN_TOKEN:	       /* multiple assignment */
1244 #if SLANG_HAS_BOSEOS
1245 	eos = compile_bos(ctok, 1);
1246 #endif
1247 	try_multiple_assignment (ctok);
1248 	if (ctok->type == COLON_TOKEN)
1249 	  compile_token_of_type (COLON_TOKEN);
1250 	else handle_semicolon (ctok);
1251 #if SLANG_HAS_BOSEOS
1252 	if (eos) compile_eos();
1253 #endif
1254 	break;
1255 
1256       default:
1257 
1258 #if SLANG_HAS_BOSEOS
1259 	eos = compile_bos(ctok, ctok->type != CASE_TOKEN ? 1 : 2);
1260 #endif
1261 	if (NULL == push_token_list ())
1262 	  break;
1263 
1264 	expression (ctok);
1265 	compile_token_list ();
1266 
1267 #if SLANG_HAS_BOSEOS
1268 	if (eos) compile_eos ();
1269 #endif
1270 
1271 	if (ctok->type == COLON_TOKEN)
1272 	  compile_token_of_type (COLON_TOKEN);
1273 	else handle_semicolon (ctok);
1274 	break;
1275      }
1276 
1277    LLT->parse_level -= 1;
1278 }
1279 
loop_statement(_pSLang_Token_Type * ctok)1280 static void loop_statement (_pSLang_Token_Type *ctok)
1281 {
1282    In_Looping_Context++;
1283    statement (ctok);
1284    In_Looping_Context--;
1285 }
1286 
1287 /* This function does not return a new token.  Calling routine must do that */
block(_pSLang_Token_Type * ctok)1288 static void block (_pSLang_Token_Type *ctok)
1289 {
1290    compile_token_of_type (OBRACE_TOKEN);
1291    statement (ctok);
1292    compile_token_of_type (CBRACE_TOKEN);
1293 }
1294 
loop_block(_pSLang_Token_Type * ctok)1295 static void loop_block (_pSLang_Token_Type *ctok)
1296 {
1297    compile_token_of_type (OBRACE_TOKEN);
1298    loop_statement (ctok);
1299    compile_token_of_type (CBRACE_TOKEN);
1300 }
1301 
1302 /* It is important that the caller wrap this with push_token_list/compile_token_list */
simple_expressions_with_paren(_pSLang_Token_Type * ctok)1303 static int simple_expressions_with_paren (_pSLang_Token_Type *ctok)
1304 {
1305    int n = 0;
1306 
1307    if (ctok->type != OPAREN_TOKEN)
1308      {
1309 	_pSLparse_error(SL_SYNTAX_ERROR, "Expecting (", ctok, 0);
1310 	return -1;
1311      }
1312 
1313    (void) get_token (ctok);
1314    while (_pSLang_Error == 0)
1315      {
1316 	if (ctok->type == COMMA_TOKEN)
1317 	  {
1318 	     _pSLparse_error (SL_SYNTAX_ERROR, "Misplaced ','", ctok, 0);
1319 	     return -1;
1320 	  }
1321 
1322 	simple_expression (ctok);
1323 	n++;
1324 
1325 	if (ctok->type == CPAREN_TOKEN)
1326 	  {
1327 	     if (-1 == get_token (ctok))
1328 	       return -1;
1329 
1330 	     return n;
1331 	  }
1332 	if (ctok->type != COMMA_TOKEN)
1333 	  {
1334 	     _pSLparse_error (SL_SYNTAX_ERROR, "Expecting a ',' or ')'", ctok, 0);
1335 	     return -1;
1336 	  }
1337 	(void) get_token (ctok);
1338      }
1339 
1340    return -1;
1341 }
1342 
handle_for_statement(_pSLang_Token_Type * ctok)1343 static void handle_for_statement (_pSLang_Token_Type *ctok)
1344 {
1345    _pSLang_Token_Type tok_buf;
1346    _pSLang_Token_Type *ident_token = NULL;
1347    int n;
1348 #if SLANG_HAS_BOSEOS
1349    int eos;
1350 #endif
1351 
1352    if (ctok->type == IDENT_TOKEN)
1353      {
1354 	tok_buf = *ctok;
1355 	ident_token = &tok_buf;
1356 	init_token (ctok);
1357 	get_token (ctok);
1358      }
1359 #if SLANG_HAS_BOSEOS
1360    eos = compile_bos(ctok, 2);
1361 #endif
1362 
1363    if (NULL == push_token_list ())
1364      return;
1365 
1366    if (-1 == (n = simple_expressions_with_paren (ctok)))
1367      return;
1368 
1369    if (n == 2)			       /* _for (a, b) */
1370      {
1371 	n++;
1372 	append_int_as_token (1);
1373      }
1374    if (n != 3)
1375      {
1376 	_pSLparse_error (SL_SYNTAX_ERROR, "Invalid number of control variables in _for statement", ctok, 1);
1377 	return;
1378      }
1379    (void) compile_token_list ();
1380 
1381 #if SLANG_HAS_BOSEOS
1382    if (eos) compile_eos ();
1383 #endif
1384 
1385    compile_token_of_type (OBRACE_TOKEN);
1386    if (ident_token != NULL)
1387      {
1388 	ident_token->type = _SCALAR_ASSIGN_TOKEN;
1389 	compile_token (ident_token);
1390 	free_token (ident_token);
1391      }
1392    loop_statement (ctok);
1393    compile_token_of_type (CBRACE_TOKEN);
1394 
1395    compile_token_of_type (_FOR_TOKEN);
1396 }
1397 
init_identifier_token(_pSLang_Token_Type * t,SLFUTURE_CONST char * name)1398 static int init_identifier_token (_pSLang_Token_Type *t, SLFUTURE_CONST char *name)
1399 {
1400    init_token (t);
1401 
1402    if (EOF_TOKEN == _pSLtoken_init_slstring_token (t, IDENT_TOKEN, name, strlen(name)))
1403      return -1;
1404 
1405    return 0;
1406 }
1407 
1408 /* The try-statement looks like:
1409  *
1410  *    TRY ev_optional catch_blocks_opt finally_block_opt
1411  *
1412  *    ev_optional:
1413  *       nil
1414  *       ( e , v)
1415  *
1416  *    catch_blocks_opt:
1417  *       catch_blocks_opt catch_block
1418  *    catch_block:
1419  *       CATCH exception-list : block
1420  *       CATCH exception-list ;
1421  *    exception-list:
1422  *       expression
1423  *       exception-list , exception
1424  *
1425  *    finally_block_opt:
1426  *       FINALLY[:] block
1427  *
1428  * The above gets compiled into the form:
1429  *
1430  *    {ev_block} {try-statements}
1431  *       {exception-list}{catch-block}
1432  *               .
1433  *               .
1434  *       {exception-list}{catch-block}
1435  *    {finally_block} try
1436  */
1437 
handle_try_statement(_pSLang_Token_Type * ctok)1438 static void handle_try_statement (_pSLang_Token_Type *ctok)
1439 {
1440    int num_catches;
1441 
1442    /* start ev_block */
1443    if (NULL == push_token_list ())
1444      return;
1445 
1446    append_token_of_type (OBRACE_TOKEN);
1447    if (ctok->type == OPAREN_TOKEN)
1448      {
1449 	_pSLang_Token_Type e;
1450 	if (-1 == init_identifier_token (&e, "__get_exception_info"))
1451 	  return;
1452 
1453 	append_token (&e);
1454 	free_token (&e);
1455 
1456 	get_token (ctok);
1457 	postfix_expression (ctok);
1458 	check_for_lvalue (ASSIGN_TOKEN, NULL);
1459 
1460 	if (ctok->type != CPAREN_TOKEN)
1461 	  {
1462 	     _pSLparse_error (SL_SYNTAX_ERROR, "Expecting )", ctok, 0);
1463 	     return;
1464 	  }
1465 	get_token (ctok);
1466      }
1467    append_token_of_type (CBRACE_TOKEN);
1468    compile_token_list ();
1469 
1470    /* Now the try block itself */
1471    block (ctok);
1472 
1473    /* Now the various catch blocks */
1474    num_catches = 0;
1475    while (CATCH_TOKEN == get_token (ctok))
1476      {
1477 	/* Expecting catch expression-list: */
1478 	compile_token_of_type (OBRACE_TOKEN);
1479 	get_token (ctok);
1480 
1481 	push_token_list ();
1482 
1483 	while (_pSLang_Error == 0)
1484 	  {
1485 	     if (ctok->type == COLON_TOKEN)
1486 	       break;
1487 
1488 	     simple_expression (ctok);
1489 	     if (ctok->type != COMMA_TOKEN)
1490 	       break;
1491 	     get_token (ctok);
1492 	  }
1493 
1494 	if (ctok->type == COLON_TOKEN)
1495 	  get_token (ctok);
1496 	else if (ctok->type != SEMICOLON_TOKEN)
1497 	  {
1498 	     _pSLparse_error (SL_SYNTAX_ERROR, "Expecting a colon to end the exception list", ctok, 0);
1499 	     return;
1500 	  }
1501 	compile_token_list ();
1502 
1503 	compile_token_of_type (CBRACE_TOKEN);
1504 
1505 	/* catch block */
1506 	block (ctok);
1507 	num_catches++;
1508      }
1509 
1510    if ((num_catches == 0)
1511        && (ctok->type != FINALLY_TOKEN))
1512      {
1513 	_pSLparse_error (SL_SYNTAX_ERROR, "Expecting \"catch\" or \"finally\"", ctok, 0);
1514 	return;
1515      }
1516 
1517    /* finally */
1518    if (ctok->type == FINALLY_TOKEN)
1519      {
1520 	get_token (ctok);
1521 	if (ctok->type == COLON_TOKEN)
1522 	  get_token (ctok);
1523 	block (ctok);
1524      }
1525    else
1526      {
1527 	/* since this is called directly from statement, we need to get only
1528 	 * tokens that were used.  So, since we are not using this, put it back.
1529 	 */
1530 	unget_token (ctok);
1531 	compile_token_of_type (OBRACE_TOKEN);
1532 	compile_token_of_type (CBRACE_TOKEN);
1533      }
1534    compile_token_of_type (TRY_TOKEN);
1535 }
1536 
1537 /*
1538  * throw-statement:
1539  *   throw ;
1540  *   throw exception_expr ;
1541  *   throw exception_expr , simple_expression
1542  *   throw exception_expr , simple_expression ;
1543  *   throw exception_expr , simple_expression, simple_expression ;
1544  */
handle_throw_statement(_pSLang_Token_Type * ctok)1545 static void handle_throw_statement (_pSLang_Token_Type *ctok)
1546 {
1547    push_token_list ();
1548 
1549    if (ctok->type == SEMICOLON_TOKEN)
1550      append_token_of_type (ARG_TOKEN);
1551    else
1552      {
1553 #if SLANG_HAS_BOSEOS
1554 	int eos = append_bos (ctok, 2);
1555 #endif
1556 	append_token_of_type (ARG_TOKEN);
1557 	simple_expression (ctok);
1558 	if (ctok->type == COMMA_TOKEN)
1559 	  {
1560 	     get_token (ctok);
1561 	     simple_expression (ctok);
1562 	  }
1563 	if (ctok->type == COMMA_TOKEN)
1564 	  {
1565 	     get_token (ctok);
1566 	     simple_expression (ctok);
1567 	  }
1568 	handle_semicolon (ctok);
1569    /* not-necessary -- append_token_of_type (EARG_TOKEN); */
1570 #if SLANG_HAS_BOSEOS
1571 	if (eos) append_eos ();
1572 #endif
1573      }
1574    compile_token_list ();
1575    compile_token_of_type (THROW_TOKEN);
1576 }
1577 
allocate_token(void)1578 static _pSLang_Token_Type *allocate_token (void)
1579 {
1580    _pSLang_Token_Type *v;
1581 
1582    v = (_pSLang_Token_Type *)SLmalloc (sizeof (_pSLang_Token_Type));
1583    if (v == NULL)
1584      return NULL;
1585 
1586    init_token (v);
1587    return v;
1588 }
1589 
handle_foreach_statement(_pSLang_Token_Type * ctok)1590 static void handle_foreach_statement (_pSLang_Token_Type *ctok)
1591 {
1592    _pSLang_Token_Type *var_tokens = NULL;
1593    _pSLang_Token_Type *v;
1594 #if SLANG_HAS_BOSEOS
1595    int eos;
1596 #endif
1597 
1598 #if SLANG_HAS_BOSEOS
1599    eos = compile_bos (ctok, 2);
1600 #endif
1601    /* I may want to make this a separate routine */
1602    while (ctok->type == IDENT_TOKEN)
1603      {
1604 	v = (_pSLang_Token_Type *)SLmalloc (sizeof (_pSLang_Token_Type));
1605 	if (v == NULL)
1606 	  goto free_return;
1607 	init_token (v);
1608 	*v = *ctok;
1609 	init_token (ctok);
1610 	v->next = var_tokens;
1611 	var_tokens = v;
1612 	get_token (ctok);
1613 	if (ctok->type != COMMA_TOKEN)
1614 	  break;
1615 	get_token (ctok);
1616      }
1617 
1618    expression_with_parenthesis (ctok);
1619 #if SLANG_HAS_BOSEOS
1620    if (eos) compile_eos ();
1621 #endif
1622 
1623    if (NULL == push_token_list ())
1624      goto free_return;
1625 
1626    append_token_of_type (ARG_TOKEN);
1627    if (ctok->type == USING_TOKEN)
1628      {
1629 	if (OPAREN_TOKEN != get_token (ctok))
1630 	  {
1631 	     _pSLparse_error (SL_SYNTAX_ERROR, "Expected 'using ('", ctok, 0);
1632 	     goto free_return;
1633 	  }
1634 	get_token (ctok);
1635 	function_args_expression (ctok, 0, 0, 0, NULL);
1636      }
1637    /* append_token_of_type (EARG_TOKEN); // This is now handled by the
1638     * FOREACH_TOKEN itself.  Doing it presents a problem if a hook gets
1639     * called when the loop_statements are being parsed.  This can and will
1640     * happen when slsh calls its massage_input hook.  The would result in
1641     * bytecode such as:
1642     *  __args <using-expression> __eargs __args <hookargs> __eargs hook
1643     * As a result, the first __args/__eargs info will be lost.  By allowing
1644     * __foreach__ to handle it, we effectively get the proper nested
1645     * __args/__eargs form:
1646     *  __args <using-expression> __args <hookargs> __eargs hook __eargs __foreach
1647     *
1648     * Yes, this is subtle.  Always follow the rule:  Avoid __args/__eargs
1649     * outside a token list and make sure the code that uses it is either also
1650     * in the same token list, or implicitely calls __eargs.
1651     */
1652 
1653    compile_token_list ();
1654 
1655    compile_token_of_type (OBRACE_TOKEN);
1656 
1657    v = var_tokens;
1658    while (v != NULL)
1659      {
1660 	v->type = _SCALAR_ASSIGN_TOKEN;
1661 	compile_token (v);
1662 	v = v->next;
1663      }
1664 
1665    loop_statement (ctok);
1666 
1667    compile_token_of_type (CBRACE_TOKEN);
1668    compile_token_of_type (FOREACH_EARGS_TOKEN);
1669 
1670    free_return:
1671    while (var_tokens != NULL)
1672      {
1673 	v = var_tokens->next;
1674 	free_token (var_tokens);
1675 	SLfree ((char *) var_tokens);
1676 	var_tokens = v;
1677      }
1678 }
1679 
1680 /*
1681  * statement-list:
1682  *	 statement
1683  *	 statement-list statement
1684  */
statement_list(_pSLang_Token_Type * ctok)1685 static void statement_list (_pSLang_Token_Type *ctok)
1686 {
1687    while ((_pSLang_Error == 0)
1688 	  && (ctok->type != CBRACE_TOKEN)
1689 	  && (ctok->type != EOF_TOKEN))
1690      {
1691 	statement(ctok);
1692 	get_token (ctok);
1693      }
1694 }
1695 
1696 /* compound-statement:
1697  *	 { statement-list }
1698  */
compound_statement(_pSLang_Token_Type * ctok)1699 static void compound_statement (_pSLang_Token_Type *ctok)
1700 {
1701    /* ctok->type is OBRACE_TOKEN here */
1702    get_token (ctok);
1703    statement_list(ctok);
1704    if (CBRACE_TOKEN != ctok->type)
1705      {
1706 	_pSLparse_error (SL_SYNTAX_ERROR, "Expecting '}'", ctok, 0);
1707 	return;
1708      }
1709 }
1710 
1711 /* This function is only called from statement. */
expression_with_parenthesis(_pSLang_Token_Type * ctok)1712 static void expression_with_parenthesis (_pSLang_Token_Type *ctok)
1713 {
1714    if (ctok->type != OPAREN_TOKEN)
1715      {
1716 	_pSLparse_error(SL_SYNTAX_ERROR, "Expecting (", ctok, 0);
1717 	return;
1718      }
1719 
1720    if (NULL == push_token_list ())
1721      return;
1722 
1723    get_token (ctok);
1724    expression (ctok);
1725 
1726    if (ctok->type != CPAREN_TOKEN)
1727      _pSLparse_error(SL_SYNTAX_ERROR, "Expecting )", ctok, 0);
1728 
1729    compile_token_list ();
1730 
1731    get_token (ctok);
1732 }
1733 
handle_semicolon(_pSLang_Token_Type * ctok)1734 static void handle_semicolon (_pSLang_Token_Type *ctok)
1735 {
1736    if ((ctok->type == SEMICOLON_TOKEN)
1737        || (ctok->type == EOF_TOKEN))
1738      return;
1739 
1740    _pSLparse_error (SL_SYNTAX_ERROR, "Expecting ;", ctok, 0);
1741 }
1742 
_pSLparse_start(SLang_Load_Type * llt)1743 void _pSLparse_start (SLang_Load_Type *llt)
1744 {
1745    _pSLang_Token_Type ctok;
1746    SLang_Load_Type *save_llt;
1747    unsigned int save_use_next_token;
1748    _pSLang_Token_Type save_next_token;
1749    Token_List_Type *save_list;
1750    int save_looping_context = In_Looping_Context;
1751 #if SLANG_HAS_DEBUG_CODE
1752    int save_last_line_number = Last_Line_Number;
1753 
1754    Last_Line_Number = -1;
1755 #endif
1756    save_use_next_token = Use_Next_Token;
1757    save_next_token = Next_Token;
1758    save_list = Token_List;
1759    save_llt = LLT;
1760    LLT = llt;
1761 
1762    init_token (&Next_Token);
1763    Use_Next_Token = 0;
1764    In_Looping_Context = 0;
1765    init_token (&ctok);
1766    get_token (&ctok);
1767 
1768    llt->parse_level = 0;
1769    statement_list (&ctok);
1770 
1771    if (_pSLang_Error == 0)
1772      {
1773 	if (ctok.type != EOF_TOKEN)
1774 	  _pSLparse_error (SL_SYNTAX_ERROR, "Parse ended prematurely", &ctok, 0);
1775 	else
1776 	  compile_token_of_type (EOF_TOKEN);
1777      }
1778 
1779    if (_pSLang_Error)
1780      {
1781 	if (_pSLang_Error < 0)	       /* severe error */
1782 	  save_list = NULL;
1783 
1784 	while (Token_List != save_list)
1785 	  {
1786 	     if (-1 == pop_token_list (1))
1787 	       break;		       /* ??? when would this happen? */
1788 	  }
1789      }
1790 
1791    free_token (&ctok);
1792    LLT = save_llt;
1793    if (Use_Next_Token)
1794      free_token (&Next_Token);
1795    Use_Next_Token = save_use_next_token;
1796    Next_Token = save_next_token;
1797    In_Looping_Context = save_looping_context;
1798 
1799 #if SLANG_HAS_DEBUG_CODE
1800    Last_Line_Number = save_last_line_number;
1801 #endif
1802 }
1803 
1804 /* variable-list:
1805  * 	variable-decl
1806  * 	variable-decl variable-list
1807  *
1808  * variable-decl:
1809  * 	identifier
1810  * 	identifier = simple-expression
1811  */
variable_list(_pSLang_Token_Type * name_token,unsigned char variable_type)1812 static void variable_list (_pSLang_Token_Type *name_token, unsigned char variable_type)
1813 {
1814    int declaring;
1815    _pSLang_Token_Type tok;
1816 
1817    if (name_token->type != IDENT_TOKEN)
1818      {
1819 	_pSLparse_error (SL_SYNTAX_ERROR, "Expecting a variable name", name_token, 0);
1820 	return;
1821      }
1822 
1823    declaring = 0;
1824    do
1825      {
1826 	if (declaring == 0)
1827 	  {
1828 	     declaring = 1;
1829 	     compile_token_of_type (variable_type);
1830 	  }
1831 
1832 	compile_token (name_token);
1833 
1834 	init_token (&tok);
1835 	if (ASSIGN_TOKEN == get_token (&tok))
1836 	  {
1837 #if SLANG_HAS_BOSEOS
1838 	     int eos;
1839 #endif
1840 	     compile_token_of_type (CBRACKET_TOKEN);
1841 	     declaring = 0;
1842 
1843 	     get_token (&tok);
1844 #if SLANG_HAS_BOSEOS
1845 	     eos = compile_bos (&tok, 1);
1846 #endif
1847 	     push_token_list ();
1848 	     simple_expression (&tok);
1849 	     compile_token_list ();
1850 
1851 	     name_token->type = _SCALAR_ASSIGN_TOKEN;
1852 	     compile_token (name_token);
1853 #if SLANG_HAS_BOSEOS
1854 	     if (eos) compile_eos ();
1855 #endif
1856 	  }
1857 
1858 	free_token (name_token);
1859 	*name_token = tok;
1860      }
1861    while ((name_token->type == COMMA_TOKEN)
1862 	  && (IDENT_TOKEN == get_token (name_token)));
1863 
1864    if (declaring) compile_token_of_type (CBRACKET_TOKEN);
1865 }
1866 
free_token_linked_list(_pSLang_Token_Type * tok)1867 static void free_token_linked_list (_pSLang_Token_Type *tok)
1868 {
1869    while (tok != NULL)
1870      {
1871 	_pSLang_Token_Type *next = tok->next;
1872 	free_token (tok);
1873 	if (tok->num_refs != 0)
1874 	  {
1875 	     _pSLang_verror (SL_INTERNAL_ERROR, "Cannot free token in linked list");
1876 	  }
1877 	else
1878 	  SLfree ((char *) tok);
1879 
1880 	tok = next;
1881      }
1882 }
1883 
1884 /* This works with any string-like token */
prefix_token_sval_field(_pSLang_Token_Type * tok,SLFUTURE_CONST char * prefix)1885 static int prefix_token_sval_field (_pSLang_Token_Type *tok, SLFUTURE_CONST char *prefix)
1886 {
1887    char buf[2*SL_MAX_TOKEN_LEN];
1888    size_t len, prefix_len;
1889 
1890    prefix_len = strlen (prefix);
1891    len = _pSLstring_bytelen (tok->v.s_val);   /* sign */
1892    if (len + prefix_len >= sizeof(buf))
1893      {
1894 	_pSLparse_error (SL_BUILTIN_LIMIT_EXCEEDED, "Number too long for buffer", tok, 1);
1895 	return -1;
1896      }
1897    memcpy (buf, prefix, prefix_len);
1898    memcpy (buf+prefix_len, tok->v.s_val, len);  /* copys \0 */
1899    (*tok->free_val_func)(tok);
1900    if (EOF_TOKEN == _pSLtoken_init_slstring_token (tok, tok->type, buf, len+prefix_len))
1901      return -1;
1902 
1903    return 0;
1904 }
1905 
1906 /*
1907  * This function parses a structure definition block.  It returns the names
1908  * of the structure fields in the form of a linked list of tokens.
1909  *
1910  * If the structure contains assignments, the function parses the expressions and returns the
1911  * number of such assignments.  So:
1912  *
1913  *  foo = foo_expr, bar = bar_expr, ...
1914  *
1915  * generates:  foo_expr_tokens "foo" bar_expr_tokens "bar" ...
1916  */
1917 static _pSLang_Token_Type *
handle_struct_assign_list(_pSLang_Token_Type * ctok,int assign_ok,unsigned int * nassignp)1918   handle_struct_assign_list (_pSLang_Token_Type *ctok, int assign_ok, unsigned int *nassignp)
1919 {
1920    _pSLang_Token_Type *name_list_root = NULL;
1921    _pSLang_Token_Type *name_list_tail = NULL;
1922    unsigned int n, m;
1923    char buf[64];
1924 
1925    n = m = 0;
1926    while (_pSLang_Error == 0)
1927      {
1928 	_pSLang_Token_Type *new_tok;
1929 	int is_deref = 0;
1930 
1931 	if (assign_ok && (ctok->type == DEREF_TOKEN))
1932 	  {
1933 	     /* struct { @ expr, ... } */
1934 
1935 	     (void) SLsnprintf (buf, sizeof(buf), "@%d", n);
1936 	     free_token (ctok);
1937 	     if (EOF_TOKEN == _pSLtoken_init_slstring_token (ctok, STRING_TOKEN, buf, strlen (buf)))
1938 	       break;
1939 
1940 	     is_deref = 1;
1941 	  }
1942 	else
1943 	  {
1944 	     if ((IDENT_TOKEN != ctok->type) && (ctok->type != STRING_TOKEN))
1945 	       {
1946 		  if (0 == (ctok->flags & SLTOKEN_VALUE_IS_RESERVED))
1947 		    break;
1948 		  /* Allow field names such as "public", ... */
1949 		  if (EOF_TOKEN == _pSLtoken_init_slstring_token (ctok, STRING_TOKEN, ctok->v.s_val, strlen(ctok->v.s_val)))
1950 		    break;
1951 	       }
1952 	  }
1953 
1954 	new_tok = allocate_token ();
1955 	if (new_tok == NULL)
1956 	  break;
1957 
1958 	*new_tok = *ctok;
1959 	new_tok->type = STRING_TOKEN;
1960 
1961 	init_token (ctok);
1962 
1963 	if (name_list_root == NULL)
1964 	  name_list_tail = name_list_root = new_tok;
1965 	else
1966 	  name_list_tail->next = new_tok;
1967 	name_list_tail = new_tok;
1968 
1969 	n++;
1970 
1971 	if ((COMMA_TOKEN == get_token (ctok))
1972 	    && (is_deref == 0))
1973 	  {
1974 	     get_token (ctok);
1975 	     continue;
1976 	  }
1977 
1978 	if (assign_ok == 0)
1979 	  break;
1980 
1981 	if ((ASSIGN_TOKEN == ctok->type) || is_deref)
1982 	  {
1983 	     /* name = ... */
1984 #if SLANG_HAS_BOSEOS
1985 	     int eos = append_bos (ctok, 2);
1986 #endif
1987 	     if (is_deref == 0)
1988 	       get_token (ctok);
1989 
1990 	     simple_expression (ctok);
1991 #if SLANG_HAS_BOSEOS
1992 	     if (eos) append_eos ();
1993 #endif
1994 
1995 	     if (-1 == append_copy_of_string_token (new_tok))
1996 	       break;
1997 
1998 	     m++;
1999 
2000 	     if (ctok->type != COMMA_TOKEN)
2001 	       break;
2002 
2003 	     get_token (ctok);
2004 	     continue;
2005 	  }
2006 
2007 	break;
2008      }
2009 
2010    if (_pSLang_Error)
2011      {
2012 	free_token_linked_list (name_list_root);
2013 	return NULL;
2014      }
2015 
2016    if (n == 0)
2017      {
2018 	_pSLparse_error (SL_SYNTAX_ERROR, "Expecting a qualifier", ctok, 0);
2019 	return NULL;
2020      }
2021 
2022    *nassignp = m;
2023    return name_list_root;
2024 }
2025 
handle_struct_fields(_pSLang_Token_Type * ctok,int assign_ok)2026 static int handle_struct_fields (_pSLang_Token_Type *ctok, int assign_ok)
2027 {
2028    _pSLang_Token_Type *name_list, *next;
2029    unsigned int n, m;
2030 
2031    if (NULL == (name_list = handle_struct_assign_list (ctok, assign_ok, &m)))
2032      return -1;
2033 
2034    n = 0;
2035    next = name_list;
2036    while (next != NULL)
2037      {
2038 	if (-1 == append_token (next))
2039 	  break;
2040 	next = next->next;
2041 	n++;
2042      }
2043    free_token_linked_list (name_list);
2044 
2045    if (_pSLang_Error)
2046      return -1;
2047 
2048    append_int_as_token (n);
2049    if (m == 0)
2050      append_token_of_type (STRUCT_TOKEN);
2051    else
2052      {
2053 	append_int_as_token (m);
2054 	append_token_of_type (STRUCT_WITH_ASSIGN_TOKEN);
2055      }
2056 
2057    if (_pSLang_Error)
2058      return -1;
2059 
2060    return 0;
2061 }
2062 
2063 /* struct-declaration:
2064  * 	struct { struct-field-list };
2065  *
2066  * struct-field-list:
2067  * 	struct-field-name [= simple_expr], struct-field-list
2068  * 	struct-field-name [= simple_expr]
2069  *
2070  * Generates code:
2071  *    "field-name-1" ... "field-name-N" N STRUCT_TOKEN
2072  * - OR -
2073  *    expr-k1 "field-name-k1" ... expr-kM "field-name-kM"
2074  *        "name-1" ... "field-name-N" N M STRUCT_DEF_ASSIGN_TOKEN
2075  */
struct_declaration(_pSLang_Token_Type * ctok,int assign_ok)2076 static void struct_declaration (_pSLang_Token_Type *ctok, int assign_ok)
2077 {
2078    if (ctok->type != OBRACE_TOKEN)
2079      {
2080 	_pSLparse_error (SL_SYNTAX_ERROR, "Expecting {", ctok, 0);
2081 	return;
2082      }
2083    get_token (ctok);
2084 
2085    if (-1 == handle_struct_fields (ctok, assign_ok))
2086      return;
2087 
2088    if (ctok->type != CBRACE_TOKEN)
2089      {
2090 	_pSLparse_error (SL_SYNTAX_ERROR, "Expecting }", ctok, 0);
2091 	return;
2092      }
2093    get_token (ctok);
2094 }
2095 
2096 /* struct-declaration:
2097  * 	typedef struct { struct-field-list } Type_Name;
2098  *
2099  * struct-field-list:
2100  * 	struct-field-name , struct-field-list
2101  * 	struct-field-name
2102  *
2103  * Generates code: "field-name-1" ... "field-name-N" N STRUCT_TOKEN typedef
2104  */
typedef_definition(_pSLang_Token_Type * t)2105 static void typedef_definition (_pSLang_Token_Type *t)
2106 {
2107 
2108    if (t->type != STRUCT_TOKEN)
2109      {
2110 	_pSLparse_error (SL_SYNTAX_ERROR, "Expecting `struct'", t, 0);
2111 	return;
2112      }
2113    get_token (t);
2114 
2115    struct_declaration (t, 0);
2116    if (t->type != IDENT_TOKEN)
2117      {
2118 	_pSLparse_error (SL_SYNTAX_ERROR, "Expecting identifier", t, 0);
2119 	return;
2120      }
2121 
2122    t->type = STRING_TOKEN;
2123    append_token (t);
2124    append_token_of_type (TYPEDEF_TOKEN);
2125 
2126    get_token (t);
2127 }
2128 
2129 /* function-args:
2130  * 	( args-dec-opt )
2131  *
2132  * args-decl-opt:
2133  * 	identifier
2134  * 	args-decl , identifier
2135  */
define_function_args(_pSLang_Token_Type * ctok)2136 static void define_function_args (_pSLang_Token_Type *ctok)
2137 {
2138    if (CPAREN_TOKEN == get_token (ctok))
2139      {
2140 	get_token (ctok);
2141 	return;
2142      }
2143 
2144    compile_token_of_type(OBRACKET_TOKEN);
2145 
2146    while ((_pSLang_Error == 0)
2147 	  && (ctok->type == IDENT_TOKEN))
2148      {
2149 	compile_token (ctok);
2150 	if (COMMA_TOKEN != get_token (ctok))
2151 	  break;
2152 
2153 	get_token (ctok);
2154      }
2155 
2156    if (CPAREN_TOKEN != ctok->type)
2157      {
2158 	_pSLparse_error(SL_SYNTAX_ERROR, "Expecting )", ctok, 0);
2159 	return;
2160      }
2161    compile_token_of_type(CBRACKET_TOKEN);
2162 
2163    get_token (ctok);
2164 }
2165 
try_multiple_assignment(_pSLang_Token_Type * ctok)2166 void try_multiple_assignment (_pSLang_Token_Type *ctok)
2167 {
2168    /* This is called with ctok->type == OPAREN_TOKEN.  We have no idea
2169     * what follows this.  There are various possibilities such as:
2170     * @  () = x;
2171     * @  ( expression ) = x;
2172     * @  ( expression ) ;
2173     * @  ( expression ) OP expression;
2174     * @  ( expression ) [expression] = expression;
2175     * and only the first two constitute a multiple assignment.  The last
2176     * two forms create the difficulty.
2177     *
2178     * Here is the plan.  First parse (expression) and then check next token.
2179     * If it is an equal operator, then it will be parsed as a multiple
2180     * assignment.  In fact, that is the easy part.
2181     *
2182     * The hard part stems from the fact that by parsing (expression), we
2183     * have effectly truncated the parse if (expression) is part of a binary
2184     * or unary expression.  Somehow, the parsing must be resumed.  The trick
2185     * here is to use a dummy literal that generates no code: NO_OP_LITERAL
2186     * Using it, we just call 'expression' and proceed.
2187     */
2188 
2189    if (NULL == push_token_list ())
2190      return;
2191 
2192    get_token (ctok);
2193 
2194    if (ctok->type != CPAREN_TOKEN)
2195      {
2196 	expression_with_commas (ctok, 1);
2197 	if (ctok->type != CPAREN_TOKEN)
2198 	  {
2199 	     _pSLparse_error (SL_SYNTAX_ERROR, "Expecting )", ctok, 0);
2200 	     return;
2201 	  }
2202      }
2203 
2204    switch (get_token (ctok))
2205      {
2206       case ASSIGN_TOKEN:
2207       case PLUSEQS_TOKEN:
2208       case MINUSEQS_TOKEN:
2209       case TIMESEQS_TOKEN:
2210       case DIVEQS_TOKEN:
2211       case BOREQS_TOKEN:
2212       case BANDEQS_TOKEN:
2213 	do_multiple_assignment (ctok);
2214 	pop_token_list (1);
2215 	break;
2216 
2217       default:
2218 	unget_token (ctok);
2219 	ctok->type = NO_OP_LITERAL;
2220 	expression (ctok);
2221 	compile_token_list ();
2222 	break;
2223      }
2224 }
2225 
2226 /* assignment-expression:
2227  *   simple_expression
2228  *   simple_expression assign-op simple_expression
2229  *   simple_expression ++
2230  *   simple_expression --
2231  *   ++ simple_expression
2232  *   -- simple_expression
2233  */
assignment_expression(_pSLang_Token_Type * ctok)2234 static void assignment_expression (_pSLang_Token_Type *ctok)
2235 {
2236    unsigned int start_pos, end_pos;
2237    unsigned char type;
2238 
2239    if (Token_List == NULL)
2240      return;
2241 
2242    type = ctok->type;
2243    if ((type == PLUSPLUS_TOKEN) || (type == MINUSMINUS_TOKEN))
2244      {
2245 	get_token (ctok);
2246 	simple_expression (ctok);
2247 	check_for_lvalue (type, NULL);
2248 	return;
2249      }
2250    start_pos = Token_List->len;
2251 
2252    if (ctok->type == NO_OP_LITERAL)
2253      {
2254 	/* This is called from try_multiple_assignment with a new token list.
2255 	 * The tokens added to that list collectively make up a object that
2256 	 * is treated as a literal.  Reset the list start position to
2257 	 * those start of those elements.
2258 	 */
2259 	start_pos = 0;
2260      }
2261    simple_expression (ctok);
2262    switch (ctok->type)
2263      {
2264       case PLUSPLUS_TOKEN:
2265       case MINUSMINUS_TOKEN:
2266 	check_for_lvalue (ctok->type, NULL);
2267 	get_token (ctok);
2268 	break;
2269 
2270       case ASSIGN_TOKEN:
2271       case PLUSEQS_TOKEN:
2272       case MINUSEQS_TOKEN:
2273       case TIMESEQS_TOKEN:
2274       case DIVEQS_TOKEN:
2275       case BOREQS_TOKEN:
2276       case BANDEQS_TOKEN:
2277 	end_pos = Token_List->len;
2278 	check_for_lvalue (ctok->type, NULL);
2279 	get_token (ctok);
2280 	simple_expression (ctok);
2281 	token_list_element_exchange (start_pos, end_pos);
2282 	break;
2283      }
2284 }
2285 
2286 /* Note:  expression never gets compiled directly.  Rather, it gets
2287  *        appended to the token list and then compiled by a calling
2288  *        routine.
2289  */
2290 
2291 /* expression:
2292  *	 assignment_expression
2293  *	 assignment_expression, expression
2294  *       <none>
2295  */
expression_with_commas(_pSLang_Token_Type * ctok,int save_comma)2296 static void expression_with_commas (_pSLang_Token_Type *ctok, int save_comma)
2297 {
2298    while (_pSLang_Error == 0)
2299      {
2300 	if (ctok->type != COMMA_TOKEN)
2301 	  {
2302 	     if (ctok->type == CPAREN_TOKEN)
2303 	       return;
2304 
2305 	     assignment_expression (ctok);
2306 
2307 	     if (ctok->type != COMMA_TOKEN)
2308 	       break;
2309 	  }
2310 	if (save_comma) append_token (ctok);
2311 	get_token (ctok);
2312      }
2313 }
2314 
expression(_pSLang_Token_Type * ctok)2315 static void expression (_pSLang_Token_Type *ctok)
2316 {
2317    expression_with_commas (ctok, 0);
2318 }
2319 
2320 /* priority levels of binary operations */
2321 static unsigned char Binop_Level[] =
2322 {
2323 /* SC_AND_TOKEN */	10,
2324 /* SC_OR_TOKEN */	12,
2325 /* POW_TOKEN */		0,  /* This case is handled in unary expression so that -x^2 == -(x^2) */
2326 /* ADD_TOKEN */		2,
2327 /* SUB_TOKEN */		2,
2328 /* MUL_TOKEN */		1,
2329 /* DIV_TOKEN */		1,
2330 /* LT_TOKEN */		4,
2331 /* LE_TOKEN */		4,
2332 /* GT_TOKEN */		4,
2333 /* GE_TOKEN */		4,
2334 /* EQ_TOKEN */		4,
2335 /* NE_TOKEN */		4,
2336 /* AND_TOKEN */		9,
2337 /* OR_TOKEN */		11,
2338 /* MOD_TOKEN */		1,
2339 /* BAND_TOKEN */	6,
2340 /* SHL_TOKEN */		3,
2341 /* SHR_TOKEN */		3,
2342 /* BXOR_TOKEN */	7,
2343 /* BOR_TOKEN */		8,
2344 /* POUND_TOKEN */	1  /* Matrix Multiplication */
2345 };
2346 
2347 static void handle_binary_sequence (_pSLang_Token_Type *, unsigned char);
handle_sc_sequence(_pSLang_Token_Type * ctok,unsigned char level)2348 static void handle_sc_sequence (_pSLang_Token_Type *ctok, unsigned char level)
2349 {
2350    unsigned char type = ctok->type;
2351 
2352    while ((ctok->type == type) && (_pSLang_Error == 0))
2353      {
2354 	append_token_of_type (OBRACE_TOKEN);
2355 	get_token (ctok);
2356 	unary_expression (ctok);
2357 	handle_binary_sequence (ctok, level);
2358 	append_token_of_type (CBRACE_TOKEN);
2359      }
2360    append_token_of_type (type);
2361 }
2362 
2363 /* unary0 OP1 unary1 OP2 unary2 ... OPN unaryN
2364  * ==> unary0 unary1 ... unaryN {OP1 OP2 ... OPN} COMPARE_BLOCK
2365  */
handle_compare_sequence(_pSLang_Token_Type * ctok,unsigned char level)2366 static void handle_compare_sequence (_pSLang_Token_Type *ctok, unsigned char level)
2367 {
2368    unsigned char op_stack [64];
2369    unsigned int op_num = 0;
2370    unsigned int i;
2371 
2372    do
2373      {
2374 	if (op_num >= sizeof(op_stack))
2375 	  {
2376 	     _pSLparse_error (SL_BUILTIN_LIMIT_EXCEEDED, "Too many comparison operators", ctok, 0);
2377 	     return;
2378 	  }
2379 	op_stack[op_num++] = ctok->type;
2380 	get_token (ctok);
2381 	unary_expression (ctok);
2382 	handle_binary_sequence (ctok, level);
2383      }
2384    while (IS_COMPARE_OP(ctok->type) && (_pSLang_Error == 0));
2385 
2386    if (op_num == 1)
2387      {
2388 	append_token_of_type (op_stack[0]);
2389 	return;
2390      }
2391 
2392    append_token_of_type (OBRACE_TOKEN);
2393    for (i = 0; i < op_num; i++)
2394      append_token_of_type (op_stack[i]);
2395    append_token_of_type (CBRACE_TOKEN);
2396    append_token_of_type (_COMPARE_TOKEN);
2397 }
2398 
handle_binary_sequence(_pSLang_Token_Type * ctok,unsigned char max_level)2399 static void handle_binary_sequence (_pSLang_Token_Type *ctok, unsigned char max_level)
2400 {
2401    unsigned char op_stack [64];
2402    unsigned char level_stack [64];
2403    unsigned int op_num;
2404    unsigned char type;
2405 
2406    op_num = 0;
2407    type = ctok->type;
2408 
2409    while ((_pSLang_Error == 0)
2410 	  && (IS_BINARY_OP(type)))
2411      {
2412 	unsigned char level = Binop_Level[type - FIRST_BINARY_OP];
2413 	if (level >= max_level)
2414 	  break;
2415 
2416 	while ((op_num > 0) && (level_stack [op_num - 1] <= level))
2417 	  append_token_of_type (op_stack [--op_num]);
2418 
2419 	if ((type == SC_AND_TOKEN) || (type == SC_OR_TOKEN))
2420 	  {
2421 	     handle_sc_sequence (ctok, level);
2422 	     type = ctok->type;
2423 	     continue;
2424 	  }
2425 
2426 	if (IS_COMPARE_OP(type))
2427 	  {
2428 	     handle_compare_sequence (ctok, level);
2429 	     type = ctok->type;
2430 	     continue;
2431 	  }
2432 	if (op_num >= sizeof (op_stack) - 1)
2433 	  {
2434 	     _pSLparse_error (SL_BUILTIN_LIMIT_EXCEEDED, "Binary op stack overflow", ctok, 0);
2435 	     return;
2436 	  }
2437 
2438 	op_stack [op_num] = type;
2439 	level_stack [op_num] = level;
2440 	op_num++;
2441 
2442 	get_token (ctok);
2443 	unary_expression (ctok);
2444 	type = ctok->type;
2445      }
2446 
2447    while (op_num > 0)
2448      append_token_of_type(op_stack[--op_num]);
2449 }
2450 
2451 /* % Note: simple-expression groups operators OP1 at same level.  The
2452  * % actual implementation will not do this.
2453  * simple-expression:
2454  *       simple-expression ? simple-expression : simple-expression
2455  *	 unary-expression
2456  *	 binary-expression BINARY-OP unary-expression
2457  *       andelse xxelse-expression-list
2458  *       orelse xxelse-expression-list
2459  *
2460  * xxelse-expression-list:
2461  * 	{ expression }
2462  * 	xxelse-expression-list { expression }
2463  * binary-expression:
2464  *      unary-expression
2465  *      unary-expression BINARY-OP binary-expression
2466  */
simple_expression(_pSLang_Token_Type * ctok)2467 static void simple_expression (_pSLang_Token_Type *ctok)
2468 {
2469    unsigned char type;
2470 
2471    switch (ctok->type)
2472      {
2473       case ANDELSE_TOKEN:
2474       case ORELSE_TOKEN:
2475 	type = ctok->type;
2476 	if (OBRACE_TOKEN != get_token (ctok))
2477 	  {
2478 	     _pSLparse_error (SL_SYNTAX_ERROR, "Expecting '{'", ctok, 0);
2479 	     return;
2480 	  }
2481 
2482 	while (ctok->type == OBRACE_TOKEN)
2483 	  {
2484 	     append_token (ctok);
2485 	     get_token (ctok);
2486 	     expression (ctok);
2487 	     if (CBRACE_TOKEN != ctok->type)
2488 	       {
2489 		  _pSLparse_error(SL_SYNTAX_ERROR, "Expecting }", ctok, 0);
2490 		  return;
2491 	       }
2492 	     append_token (ctok);
2493 	     get_token (ctok);
2494 	  }
2495 	append_token_of_type (type);
2496 	return;
2497 
2498 	/* avoid unary-expression if possible */
2499       case STRING_TOKEN:
2500 	append_token (ctok);
2501 	get_token (ctok);
2502 	break;
2503 
2504       default:
2505 	unary_expression (ctok);
2506 	break;
2507      }
2508 
2509    if (SEMICOLON_TOKEN == (type = ctok->type))
2510      return;
2511 
2512    handle_binary_sequence (ctok, 0xFF);
2513 
2514    if (ctok->type == QUESTION_TOKEN)
2515      {
2516 	append_token_of_type (OBRACE_TOKEN);
2517 	get_token (ctok);
2518 	simple_expression (ctok);
2519 	if (ctok->type != COLON_TOKEN)
2520 	  {
2521 	     _pSLparse_error (SL_SYNTAX_ERROR, "Expecting a colon in the ternary expression", ctok, 0);
2522 	     return;
2523 	  }
2524 	append_token_of_type (CBRACE_TOKEN);
2525 	get_token (ctok);
2526 	append_token_of_type (OBRACE_TOKEN);
2527 	simple_expression (ctok);
2528 	append_token_of_type (CBRACE_TOKEN);
2529 	append_token_of_type (ELSE_TOKEN);
2530      }
2531 }
2532 
negate_float_type_token(_pSLang_Token_Type * tok)2533 static int negate_float_type_token (_pSLang_Token_Type *tok)
2534 {
2535    return prefix_token_sval_field (tok, "-");
2536 }
2537 
2538 /* unary-expression:
2539  *	 postfix-expression
2540  *	 case unary-expression
2541  *	 OP3 unary-expression
2542  *	 (OP3: + - ~ & not)
2543  *
2544  * Note:  This grammar permits: case case case WHATEVER
2545  */
unary_expression(_pSLang_Token_Type * ctok)2546 static void unary_expression (_pSLang_Token_Type *ctok)
2547 {
2548    unsigned char save_unary_ops [16];
2549    unsigned int num_unary_ops;
2550    unsigned char type;
2551 #if 0
2552    _pSLang_Token_Type *last_token;
2553 #endif
2554    num_unary_ops = 0;
2555    while (_pSLang_Error == 0)
2556      {
2557 	type = ctok->type;
2558 
2559 	switch (type)
2560 	  {
2561 #if 0
2562 	   case PLUSPLUS_TOKEN:
2563 	   case MINUSMINUS_TOKEN:
2564 	     get_token (ctok);
2565 	     postfix_expression (ctok);
2566 	     check_for_lvalue (type, NULL);
2567 	     goto out_of_switch;
2568 #endif
2569 	   case ADD_TOKEN:
2570 	     get_token (ctok);	       /* skip it-- it's unary here */
2571 	     break;
2572 
2573 	   case SUB_TOKEN:
2574 	     (void) get_token (ctok);
2575 	     if (ctok->flags & SLTOKEN_TYPE_NUMBER)
2576 	       {
2577 		  _pSLang_Token_Type *last_token;
2578 		  postfix_expression (ctok);
2579 		  if ((NULL != (last_token = get_last_token ()))
2580 		      && (last_token->flags & SLTOKEN_TYPE_NUMBER))
2581 		    {
2582 		       if (last_token->flags & SLTOKEN_TYPE_FLOAT)
2583 			 {
2584 			    if (-1 == negate_float_type_token (last_token))
2585 			      return;
2586 			 }
2587 		       else if (-1 == check_number_token_overflow (last_token, -1))
2588 			 return;
2589 		    }
2590 		  else
2591 		    {
2592 		       if (num_unary_ops == 16)
2593 			 goto stack_overflow_error;
2594 		       save_unary_ops [num_unary_ops++] = CHS_TOKEN;
2595 		    }
2596 		  goto out_of_switch;
2597 	       }
2598 	     if (num_unary_ops == 16)
2599 	       goto stack_overflow_error;
2600 	     save_unary_ops [num_unary_ops++] = CHS_TOKEN;
2601 	     break;
2602 #if 0
2603 	   case DEREF_TOKEN:
2604 #endif
2605 	   case BNOT_TOKEN:
2606 	   case NOT_TOKEN:
2607 	   case CASE_TOKEN:
2608 	     if (num_unary_ops == 16)
2609 	       goto stack_overflow_error;
2610 
2611 	     save_unary_ops [num_unary_ops++] = type;
2612 	     get_token (ctok);
2613 	     break;
2614 
2615 	     /* Try to avoid ->postfix_expression->primary_expression
2616 	      * subroutine calls.
2617 	      */
2618 	   case STRING_TOKEN:
2619 	     append_token (ctok);
2620 	     get_token (ctok);
2621 	     goto out_of_switch;
2622 
2623 	   default:
2624 	     postfix_expression (ctok);
2625 	     goto out_of_switch;
2626 	  }
2627      }
2628 
2629    out_of_switch:
2630    while (num_unary_ops)
2631      {
2632 	num_unary_ops--;
2633 	append_token_of_type (save_unary_ops [num_unary_ops]);
2634      }
2635    return;
2636 
2637    stack_overflow_error:
2638    _pSLparse_error (SL_BUILTIN_LIMIT_EXCEEDED, "Too many unary operators.", ctok, 0);
2639 }
2640 
combine_namespace_tokens(_pSLang_Token_Type * a,_pSLang_Token_Type * b)2641 static int combine_namespace_tokens (_pSLang_Token_Type *a, _pSLang_Token_Type *b)
2642 {
2643    SLFUTURE_CONST char *sa, *sb;
2644    char *sc;
2645    size_t lena, lenb;
2646    unsigned long hash;
2647 
2648    /* This is somewhat of a hack.  Combine the TWO identifier names
2649     * (NAMESPACE) and (name) into the form NAMESPACE->name.  Then when the
2650     * byte compiler compiles the object it will not be found.  It will then
2651     * check for this hack and make the appropriate namespace lookup.
2652     */
2653 
2654    sa = a->v.s_val;
2655    sb = b->v.s_val;
2656 
2657    lena = strlen (sa);
2658    lenb = strlen (sb);
2659 
2660    sc = (char *)SLmalloc (lena + lenb + 3);
2661    if (sc == NULL)
2662      return -1;
2663 
2664    strcpy (sc, sa);
2665    strcpy (sc + lena, "->");
2666    strcpy (sc + lena + 2, sb);
2667 
2668    sb = _pSLstring_make_hashed_string (sc, lena + lenb + 2, &hash);
2669    SLfree (sc);
2670    if (sb == NULL)
2671      return -1;
2672 
2673    /* I can free this string because no other token should be referencing it.
2674     * (num_refs == 1).
2675     */
2676    _pSLfree_hashed_string ((char *) sa, lena, a->hash);
2677    a->v.s_val = sb;
2678    a->hash = hash;
2679 
2680    return 0;
2681 }
2682 
append_identifier_token(_pSLang_Token_Type * ctok)2683 static void append_identifier_token (_pSLang_Token_Type *ctok)
2684 {
2685    _pSLang_Token_Type *last_token;
2686 
2687    append_token (ctok);
2688 
2689    if (NAMESPACE_TOKEN != get_token (ctok))
2690      return;
2691 
2692    if (IDENT_TOKEN != get_token (ctok))
2693      {
2694 	_pSLparse_error (SL_SYNTAX_ERROR, "Expecting name-space identifier", ctok, 0);
2695 	return;
2696      }
2697 
2698    if (NULL == (last_token = get_last_token ()))
2699      {
2700 	if (_pSLang_Error == 0)
2701 	  _pSLang_verror (SL_INTERNAL_ERROR, "get_last_token returned NULL in append_identifier_token");
2702 	return;
2703      }
2704    if (-1 == combine_namespace_tokens (last_token, ctok))
2705      return;
2706 
2707    (void) get_token (ctok);
2708 }
2709 
get_identifier_expr_token(_pSLang_Token_Type * ctok)2710 static int get_identifier_expr_token (_pSLang_Token_Type *ctok)
2711 {
2712    _pSLang_Token_Type next_token;
2713 
2714    if (-1 == get_identifier_token (ctok, 0))
2715      return -1;
2716 
2717    init_token (&next_token);
2718    if (NAMESPACE_TOKEN != get_token (&next_token))
2719      {
2720 	unget_token (&next_token);
2721 	return IDENT_TOKEN;
2722      }
2723 
2724    if (-1 == get_identifier_token (&next_token, 0))
2725      {
2726 	free_token (&next_token);
2727 	return -1;
2728      }
2729 
2730    if (-1 == combine_namespace_tokens (ctok, &next_token))
2731      {
2732 	free_token (&next_token);
2733 	return -1;
2734      }
2735    free_token (&next_token);
2736    return 0;
2737 }
2738 
2739 /* postfix-expression:
2740  *       @ postfix-expression
2741  *	 primary-expression
2742  *	 postfix-expression [ expression ]
2743  *	 postfix-expression ( function-args-expression )
2744  *	 postfix-expression . identifier
2745  *       postfix-expression ^ unary-expression
2746  *
2747  * Not yet supported:
2748  *	 postfix-expression ++
2749  *	 postfix-expression --
2750  *	 postfix-expression = simple-expression
2751  *	 postfix-expression += simple-expression
2752  *	 postfix-expression -= simple-expression
2753  *
2754  * primary-expression:
2755  *	literal
2756  *	identifier-expr
2757  *	( expression_opt )
2758  * 	[ inline-array-expression ]
2759  *      { inline-list-expression }
2760  * 	&identifier-expr
2761  *      struct-definition
2762  *      __tmp(identifier-expr)
2763  *
2764  * identifier-expr:
2765  *      identifier
2766  *      identifier->identifier
2767  */
postfix_expression(_pSLang_Token_Type * ctok)2768 static void postfix_expression (_pSLang_Token_Type *ctok)
2769 {
2770    unsigned int start_pos;
2771    _pSLang_Token_Type *last_token;
2772 
2773    if (Token_List == NULL)
2774      return;
2775 
2776    start_pos = Token_List->len;
2777 
2778    switch (ctok->type)
2779      {
2780 #if 1
2781       case DEREF_TOKEN:
2782 	get_token (ctok);
2783 	postfix_expression (ctok);
2784 	append_token_of_type (DEREF_TOKEN);
2785 	break;
2786 #endif
2787       case IDENT_TOKEN:
2788 	append_identifier_token (ctok);
2789 	break;
2790 
2791       case CHAR_TOKEN:
2792       case SHORT_TOKEN:
2793       case INT_TOKEN:
2794       case LONG_TOKEN:
2795       case UCHAR_TOKEN:
2796       case USHORT_TOKEN:
2797       case UINT_TOKEN:
2798       case ULONG_TOKEN:
2799 #ifdef HAVE_LONG_LONG
2800       case LLONG_TOKEN:
2801       case ULLONG_TOKEN:
2802 #endif
2803       case STRING_TOKEN:
2804       case BSTRING_TOKEN:
2805 #ifdef SLANG_HAS_FLOAT
2806       case DOUBLE_TOKEN:
2807       case FLOAT_TOKEN:
2808       case LDOUBLE_TOKEN:
2809 #endif
2810 #ifdef SLANG_HAS_COMPLEX
2811       case COMPLEX_TOKEN:
2812 #endif
2813       case STRING_DOLLAR_TOKEN:
2814       case MULTI_STRING_TOKEN:
2815 	append_token (ctok);
2816 	get_token (ctok);
2817 	if (ctok->type == OPAREN_TOKEN)
2818 	  _pSLparse_error(SL_SYNTAX_ERROR, "Literal constant is not callable", ctok, 1);
2819 	break;
2820 
2821       case OPAREN_TOKEN:
2822 	if (CPAREN_TOKEN != get_token (ctok))
2823 	  {
2824 	     expression (ctok);
2825 	     if (ctok->type != CPAREN_TOKEN)
2826 	       _pSLparse_error(SL_SYNTAX_ERROR, "Expecting )", ctok, 0);
2827 	  }
2828 	get_token (ctok);
2829 	break;
2830 
2831       case BAND_TOKEN:
2832 #if 0
2833 	if (-1 == get_identifier_expr_token (ctok))
2834 	  break;
2835 
2836 	ctok->type = _REF_TOKEN;
2837 	append_token (ctok);
2838 	get_token (ctok);
2839 	if ((ctok->type == OBRACKET_TOKEN) || (ctok->type == DOT_TOKEN))
2840 	  _pSLparse_error (SL_NOT_IMPLEMENTED, "& of an array or structure element is not currently supported", ctok, 0);
2841 #else
2842 	get_token (ctok);
2843 	postfix_expression (ctok);
2844 	last_token = get_last_token ();
2845 	if (last_token == NULL)
2846 	  {
2847 	     if (_pSLang_Error == 0)
2848 	       _pSLang_verror (SL_SYNTAX_ERROR, "Misplaced &");
2849 	     return;
2850 	  }
2851 	switch (last_token->type)
2852 	  {
2853 	   case IDENT_TOKEN:
2854 	     last_token->type = _REF_TOKEN;
2855 	     break;
2856 	   case ARRAY_TOKEN:
2857 	     last_token->type = _ARRAY_ELEM_REF_TOKEN;
2858 	     break;
2859 	   case DOT_TOKEN:
2860 	     last_token->type = _STRUCT_FIELD_REF_TOKEN;
2861 	     break;
2862 	   default:
2863 	     _pSLparse_error (SL_NOT_IMPLEMENTED, "& not supported in this context", last_token, 0);
2864 	  }
2865 #endif
2866 	break;
2867 
2868       case OBRACKET_TOKEN:
2869 	get_token (ctok);
2870 	inline_array_expression (ctok);
2871 	break;
2872 
2873       case OBRACE_TOKEN:
2874 	get_token (ctok);
2875 	inline_list_expression (ctok);
2876 	break;
2877 
2878       case NO_OP_LITERAL:
2879 	/* This token was introduced by try_multiple_assignment.  There,
2880 	 * a new token_list was pushed and (expression) was evaluated.
2881 	 * NO_OP_LITERAL represents the result of expression.  However,
2882 	 * we need to tweak the start_pos variable to point to the beginning
2883 	 * of the token list to complete the equivalence.
2884 	 */
2885 	start_pos = 0;
2886 	get_token (ctok);
2887 	break;
2888 
2889       case STRUCT_TOKEN:
2890 	get_token (ctok);
2891 	struct_declaration (ctok, 1);
2892 	break;
2893 
2894       case TMP_TOKEN:
2895 	get_token (ctok);
2896 	if (ctok->type == OPAREN_TOKEN)
2897 	  {
2898 	     if (-1 != get_identifier_expr_token (ctok))
2899 	       {
2900 		  ctok->type = TMP_TOKEN;
2901 		  append_token (ctok);
2902 		  get_token (ctok);
2903 		  if (ctok->type == CPAREN_TOKEN)
2904 		    {
2905 		       get_token (ctok);
2906 		       break;
2907 		    }
2908 	       }
2909 	  }
2910 	_pSLparse_error (SL_SYNTAX_ERROR, "Expecting form __tmp(NAME)", ctok, 0);
2911 	break;
2912 
2913       default:
2914 #ifdef IS_INTERNAL_FUNC
2915 	if (IS_INTERNAL_FUNC(ctok->type))
2916 	  {
2917 	     append_token (ctok);
2918 	     get_token (ctok);
2919 	  }
2920 	else
2921 #endif
2922 	  _pSLparse_error(SL_SYNTAX_ERROR, "Expecting a PRIMARY", ctok, 0);
2923      }
2924 
2925    while (_pSLang_Error == 0)
2926      {
2927 	unsigned int end_pos = Token_List->len;
2928 	unsigned char type = ctok->type;
2929 	switch (type)
2930 	  {
2931 	   case OBRACKET_TOKEN:	       /* X[args] ==> [args] X ARRAY */
2932 	     get_token (ctok);
2933 	     append_token_of_type (ARG_TOKEN);
2934 	     if (ctok->type != CBRACKET_TOKEN)
2935 	       array_index_expression (ctok);
2936 
2937 	     if (ctok->type != CBRACKET_TOKEN)
2938 	       {
2939 		  _pSLparse_error (SL_SYNTAX_ERROR, "Expecting ']'", ctok, 0);
2940 		  return;
2941 	       }
2942 	     get_token (ctok);
2943 	     /* append_token_of_type (EARG_TOKEN); -- ARRAY_TOKEN implicitely does this */
2944 	     token_list_element_exchange (start_pos, end_pos);
2945 	     append_token_of_type (ARRAY_TOKEN);
2946 	     break;
2947 
2948 	   case OPAREN_TOKEN:
2949 	     /* f(args) ==> args f */
2950 	     if ((NULL != (last_token = get_last_token ()))
2951 		 && (last_token->type == DEREF_TOKEN))
2952 	       {
2953 		  /* Expressions such as (@A[i])(args...) */
2954 		  last_token->type = _DEREF_FUNCALL_TOKEN;
2955 		  append_token_of_type (ARG_TOKEN);
2956 		  (void) get_token (ctok);
2957 		  function_args_expression (ctok, 0, 1, 1, NULL);
2958 		  /* Now we have: ... @ __args ...
2959 		   * and we want: ... __args ... @
2960 		   */
2961 		  /* token_list_element_exchange (start_pos, end_pos); */
2962 		  token_list_element_exchange (end_pos-1, end_pos);
2963 		  break;
2964 	       }
2965 
2966 	     if (CPAREN_TOKEN != get_token (ctok))
2967 	       {
2968 		  function_args_expression (ctok, 1, 1, 1, NULL);
2969 		  token_list_element_exchange (start_pos, end_pos);
2970 	       }
2971 	     else get_token (ctok);
2972 	     break;
2973 
2974 	   case DOT_TOKEN:
2975 	     /* S.a ==> "a" S DOT
2976 	      * This means that if S is X[b], then X[b].a ==> a b X ARRAY DOT
2977 	      * and f(a).X[b].c ==> "c" b "X" a f . ARRAY .
2978 	      * Also, f(a).X[b] = g(x); ==> x g b "X" a f .
2979 	      */
2980 	     if (-1 == get_identifier_token (ctok, 1))
2981 	       return;
2982 
2983 	     ctok->type = DOT_TOKEN;
2984 	     append_token (ctok);
2985 	     get_token (ctok);
2986 #ifdef DOT_METHOD_CALL_TOKEN
2987 	     if (ctok->type == OPAREN_TOKEN)
2988 	       {
2989 		  unsigned int qual_pos, meth_pos, x_pos, y_pos;
2990 		  /* This case is a bit tricky for expressions such as:
2991 		   *   foo(x;q1).bar(y;q2)
2992 		   *                ^
2993 		   * Here, '^' denotes the parse point.  The token list looks
2994 		   * roughly like:
2995 		   *    __arg x q1 __earg foo bar .
2996 		   */
2997 		  if (NULL == (last_token = get_last_token ()))
2998 		    return;
2999 		  last_token->type = DOT_METHOD_CALL_TOKEN;
3000 		  x_pos = start_pos;
3001 		  y_pos = Token_List->len;
3002 		  meth_pos = y_pos-1;
3003 		  append_token_of_type (ARG_TOKEN);
3004 		  get_token (ctok);
3005 		  function_args_expression (ctok, 0, 1, 1, &qual_pos);
3006 		  if (_pSLang_Error)
3007 		    break;
3008 		  end_pos = Token_List->len;
3009 		  /* At this point, the token list looks like:
3010 		   *   __arg x q1 __earg foo methcall(bar) __arg y q2
3011 		   * x^                    m^            y^      q^
3012 		   * where ^ denotes the meth, x, y, and qual positions.
3013 		   * We want to rearrange this to be:
3014 		   *   __arg y __arg x q1 __earg foo q2 methcall(bar)
3015 		   * Do it in 3 stages:
3016 		   */
3017 		  token_list_element_exchange (x_pos, y_pos);
3018 		  /*   __arg y q2 __arg x q1 __earg foo methcall(bar)
3019 		   * y^      q^ x^                    m^
3020 		   */
3021 		  qual_pos = start_pos + (qual_pos-y_pos);
3022 		  meth_pos = meth_pos + (end_pos-y_pos);
3023 		  x_pos = start_pos + (end_pos-y_pos);
3024 		  token_list_element_exchange (qual_pos, x_pos);
3025 		  /*   __arg y __arg x q1 __earg foo methcall(bar) q2
3026 		   * y^      x^                    m^            q^
3027 		   */
3028 		  meth_pos = meth_pos - (x_pos - qual_pos);
3029 		  qual_pos = qual_pos + (end_pos-x_pos);
3030 		  token_list_element_exchange (meth_pos, qual_pos);
3031 	       }
3032 #endif
3033 	     break;
3034 
3035 #if 0
3036 	   case PLUSPLUS_TOKEN:
3037 	   case MINUSMINUS_TOKEN:
3038 	     check_for_lvalue (type, NULL);
3039 	     get_token (ctok);
3040 	     break;
3041 	   case ASSIGN_TOKEN:
3042 	   case PLUSEQS_TOKEN:
3043 	   case MINUSEQS_TOKEN:
3044 	   case TIMESEQS_TOKEN:
3045 	   case DIVEQS_TOKEN:
3046 	   case BOREQS_TOKEN:
3047 	   case BANDEQS_TOKEN:
3048 	     check_for_lvalue (type, NULL);
3049 	     get_token (ctok);
3050 	     simple_expression (ctok);
3051 	     token_list_element_exchange (start_pos, end_pos);
3052 	     break;
3053 #endif
3054 #if 1
3055 	   case POW_TOKEN:
3056 	     get_token (ctok);
3057 	     unary_expression (ctok);
3058 	     append_token_of_type (POW_TOKEN);
3059 	     break;
3060 #endif
3061 	   default:
3062 	     return;
3063 	  }
3064      }
3065 }
3066 
3067 /* This function is used for more than function arguments */
function_args_expression(_pSLang_Token_Type * ctok,int handle_num_args,int handle_qualifiers,int is_function,unsigned int * qual_posp)3068 static void function_args_expression (_pSLang_Token_Type *ctok, int handle_num_args, int handle_qualifiers,
3069 				      int is_function,
3070 				      unsigned int *qual_posp)
3071 {
3072    unsigned char last_type, this_type;
3073    int has_qualifiers = 0;
3074 
3075    if (handle_num_args) append_token_of_type (ARG_TOKEN);
3076 
3077    last_type = (ctok->type == COMMA_TOKEN) ? COMMA_TOKEN : 0;
3078 
3079    while (_pSLang_Error == 0)
3080      {
3081 	this_type = ctok->type;
3082 
3083 	switch (this_type)
3084 	  {
3085 	   case COMMA_TOKEN:
3086 	     if (last_type == COMMA_TOKEN)
3087 	       append_token_of_type (_NULL_TOKEN);
3088 	     get_token (ctok);
3089 	     break;
3090 
3091 	   case CPAREN_TOKEN:
3092 	     if (last_type == COMMA_TOKEN)
3093 	       append_token_of_type (_NULL_TOKEN);
3094 
3095 	     if (handle_num_args) append_token_of_type (EARG_TOKEN);
3096 
3097 	     if ((qual_posp != NULL) && (has_qualifiers == 0))
3098 	       *qual_posp = Token_List->len;
3099 
3100 	     get_token (ctok);
3101 	     if (is_function && (ctok->type == OPAREN_TOKEN))
3102 	       _pSLparse_error (SL_SYNTAX_ERROR, "A '(' is not permitted here", ctok, 0);
3103 	     return;
3104 
3105 	   case SEMICOLON_TOKEN:
3106 	     if (handle_qualifiers)
3107 	       {
3108 		  if (last_type == COMMA_TOKEN)
3109 		    append_token_of_type (_NULL_TOKEN);
3110 
3111 		  if (qual_posp != NULL)
3112 		    *qual_posp = Token_List->len;
3113 
3114 		  has_qualifiers = 1;
3115 
3116 		  if (SEMICOLON_TOKEN == get_token (ctok))
3117 		    {
3118 		       /* foo (args... ;; q) form */
3119 		       if (CPAREN_TOKEN == get_token (ctok))
3120 			 break;  /* foo (args ;;) */
3121 		       simple_expression (ctok);
3122 		    }
3123 		  else if (ctok->type == CPAREN_TOKEN)
3124 		    break;	       /* foo (args;) */
3125 		  else if (-1 == handle_struct_fields (ctok, 1))
3126 		    return;
3127 
3128 		  append_token_of_type (QUALIFIER_TOKEN);
3129 		  if (ctok->type != CPAREN_TOKEN)
3130 		    _pSLparse_error (SL_SYNTAX_ERROR, "Expecting ')'", ctok, 0);
3131 		  break;
3132 	       }
3133 	     /* drop */
3134 
3135 	   default:
3136 	     simple_expression (ctok);
3137 	     if ((ctok->type != COMMA_TOKEN)
3138 		 && (ctok->type != CPAREN_TOKEN)
3139 		 && ((handle_qualifiers == 0)
3140 		     || (ctok->type != SEMICOLON_TOKEN)))
3141 	       {
3142 		  _pSLparse_error (SL_SYNTAX_ERROR, "Expecting ')'", ctok, 0);
3143 		  break;
3144 	       }
3145 	  }
3146 	last_type = this_type;
3147      }
3148 }
3149 
check_for_lvalue(unsigned char eqs_type,_pSLang_Token_Type * ctok)3150 static int check_for_lvalue (unsigned char eqs_type, _pSLang_Token_Type *ctok)
3151 {
3152    unsigned char type;
3153 
3154    if ((ctok == NULL)
3155        && (NULL == (ctok = get_last_token ())))
3156      type = ILLEGAL_TOKEN;
3157    else
3158      type = ctok->type;
3159 
3160    eqs_type -= ASSIGN_TOKEN;
3161    switch (type)
3162      {
3163       case IDENT_TOKEN:
3164 	eqs_type += _SCALAR_ASSIGN_TOKEN;
3165 	break;
3166       case ARRAY_TOKEN:
3167 	eqs_type += _ARRAY_ASSIGN_TOKEN;
3168 	break;
3169       case DOT_TOKEN:
3170 	eqs_type += _STRUCT_ASSIGN_TOKEN;
3171 	break;
3172       case DEREF_TOKEN:
3173 	eqs_type += _DEREF_ASSIGN_TOKEN;
3174 	break;
3175       default:
3176 	_pSLparse_error (SL_SYNTAX_ERROR, "Expecting LVALUE", ctok, 0);
3177 	return -1;
3178      }
3179 
3180    ctok->type = eqs_type;
3181    return 0;
3182 }
3183 
3184 /* inline_list_expression:
3185  *     (nil)
3186  *     simple_expression
3187  *     inline_list_expression, simple_expression
3188  */
inline_list_expression(_pSLang_Token_Type * ctok)3189 static void inline_list_expression (_pSLang_Token_Type *ctok)
3190 {
3191    append_token_of_type (ARG_TOKEN);
3192 
3193    if (ctok->type != CBRACE_TOKEN)
3194      {
3195 	while (1)
3196 	  {
3197 	     simple_expression (ctok);
3198 	     if (ctok->type != COMMA_TOKEN)
3199 	       break;
3200 	     get_token (ctok);
3201 	     if (ctok->type == CBRACE_TOKEN)   /* trailing comma: {a,b,} */
3202 	       break;
3203 	  }
3204 	if (ctok->type != CBRACE_TOKEN)
3205 	  {
3206 	     _pSLparse_error (SL_SYNTAX_ERROR, "Expecting '}' to denote list end", ctok, 0);
3207 	     return;
3208 	  }
3209      }
3210 
3211    append_token_of_type (_INLINE_LIST_TOKEN);
3212    get_token (ctok);
3213 }
3214 
array_index_expression(_pSLang_Token_Type * ctok)3215 static void array_index_expression (_pSLang_Token_Type *ctok)
3216 {
3217    unsigned int num_commas;
3218 
3219    num_commas = 0;
3220    while (1)
3221      {
3222 	switch (ctok->type)
3223 	  {
3224 	   case COLON_TOKEN:
3225 	     if (num_commas)
3226 	       _pSLparse_error (SL_SYNTAX_ERROR, "Misplaced ':'", ctok, 0);
3227 	     return;
3228 
3229 	   case TIMES_TOKEN:
3230 	     append_token_of_type (_INLINE_WILDCARD_ARRAY_TOKEN);
3231 	     get_token (ctok);
3232 	     break;
3233 
3234 	   case COMMA_TOKEN:
3235 	     _pSLparse_error (SL_SYNTAX_ERROR, "Misplaced ','", ctok, 0);
3236 	     return;
3237 
3238 	   default:
3239 	     simple_expression (ctok);
3240 	  }
3241 
3242 	if (ctok->type != COMMA_TOKEN)
3243 	  return;
3244 	num_commas++;
3245 	get_token (ctok);
3246 	if (ctok->type == CBRACKET_TOKEN)   /* allow trailing comma */
3247 	  return;
3248      }
3249 }
3250 
3251 /* inline-array-expression:
3252  *    array_index_expression
3253  *    simple_expression : simple_expression
3254  *    simple_expression : simple_expression : simple_expression
3255  *    simple_expression : simple_expression : # simple_expression
3256  */
inline_array_expression(_pSLang_Token_Type * ctok)3257 static void inline_array_expression (_pSLang_Token_Type *ctok)
3258 {
3259    int num_colons = 0;
3260    int has_pound = 0;
3261 
3262    append_token_of_type (ARG_TOKEN);
3263 
3264    if (ctok->type == COLON_TOKEN)	       /* [:...] */
3265      append_token_of_type (_NULL_TOKEN);
3266    else if (ctok->type != CBRACKET_TOKEN)
3267      array_index_expression (ctok);
3268 
3269    if (ctok->type == COLON_TOKEN)
3270      {
3271 	num_colons++;
3272 	if ((COLON_TOKEN == get_token (ctok))
3273 	    || (ctok->type == CBRACKET_TOKEN))
3274 	  append_token_of_type (_NULL_TOKEN);
3275 	else
3276 	  simple_expression (ctok);
3277 
3278 	if (ctok->type == COLON_TOKEN)
3279 	  {
3280 	     num_colons++;
3281 	     if (POUND_TOKEN == get_token (ctok))
3282 	       {
3283 		  has_pound = 1;
3284 		  get_token(ctok);
3285 	       }
3286 	     simple_expression (ctok);
3287 	  }
3288      }
3289 
3290    if (ctok->type != CBRACKET_TOKEN)
3291      {
3292 	_pSLparse_error (SL_SYNTAX_ERROR, "Expecting ']'", ctok, 0);
3293 	return;
3294      }
3295 
3296    /* append_token_of_type (EARG_TOKEN); */
3297    if (num_colons)
3298      {
3299 	if (has_pound)
3300 	  append_token_of_type (_INLINE_IMPLICIT_ARRAYN_TOKEN);
3301 	else
3302 	  append_token_of_type (_INLINE_IMPLICIT_ARRAY_TOKEN);
3303      }
3304    else
3305      append_token_of_type (_INLINE_ARRAY_TOKEN);
3306    get_token (ctok);
3307 }
3308 
do_multiple_assignment(_pSLang_Token_Type * ctok)3309 static void do_multiple_assignment (_pSLang_Token_Type *ctok)
3310 {
3311    _pSLang_Token_Type *s;
3312    unsigned int i, k, len;
3313    unsigned char assign_type;
3314 
3315    assign_type = ctok->type;
3316 
3317    /* The LHS token list has already been pushed.  Here we do the RHS
3318     * so push to another token list, process it, then come back to
3319     * LHS for assignment.
3320     */
3321    if (NULL == push_token_list ())
3322      return;
3323 
3324    get_token (ctok);
3325    expression (ctok);
3326    compile_token_list ();
3327 
3328    if (_pSLang_Error)
3329      return;
3330 
3331    /* Finally compile the LHS of the assignment expression
3332     * that has been saved.
3333     */
3334    s = Token_List->stack;
3335    len = Token_List->len;
3336 
3337    if (len == 0)
3338      {
3339 	compile_token_of_type (POP_TOKEN);
3340 	return;
3341      }
3342 
3343    while (len > 0)
3344      {
3345 	/* List is of form:
3346 	 *    a , b, c d e, f , g , , , h ,
3347 	 * The missing expressions will be replaced by a POP
3348 	 * ,,a
3349 	 */
3350 
3351 	/* Start from back looking for a COMMA */
3352 	k = len - 1;
3353 	if (s[k].type == COMMA_TOKEN)
3354 	  {
3355 	     compile_token_of_type (POP_TOKEN);
3356 	     len = k;
3357 	     continue;
3358 	  }
3359 
3360 	if (-1 == check_for_lvalue (assign_type, s + k))
3361 	  return;
3362 
3363 	i = 0;
3364 	while (1)
3365 	  {
3366 	     if (s[k].type == COMMA_TOKEN)
3367 	       {
3368 		  i = k + 1;
3369 		  break;
3370 	       }
3371 
3372 	     if (k == 0)
3373 	       break;
3374 
3375 	     k--;
3376 	  }
3377 
3378 	while (i < len)
3379 	  {
3380 	     compile_token (s + i);
3381 	     i++;
3382 	  }
3383 
3384 	len = k;
3385      }
3386 
3387    if (s[0].type == COMMA_TOKEN)
3388      compile_token_of_type (POP_TOKEN);
3389 }
3390 
3391