1 : /*
2 : * OpenBIOS - free your system!
3 : * ( FCode tokenizer )
4 : *
5 : * scanner.c - simple scanner for forth files.
6 : *
7 : * This program is part of a free implementation of the IEEE 1275-1994
8 : * Standard for Boot (Initialization Configuration) Firmware.
9 : *
10 : * Copyright (C) 2001-2005 by Stefan Reinauer <stepan@openbios.org>
11 : *
12 : * This program is free software; you can redistribute it and/or modify
13 : * it under the terms of the GNU General Public License as published by
14 : * the Free Software Foundation; version 2 of the License.
15 : *
16 : * This program is distributed in the hope that it will be useful,
17 : * but WITHOUT ANY WARRANTY; without even the implied warranty of
18 : * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 : * GNU General Public License for more details.
20 : *
21 : * You should have received a copy of the GNU General Public License
22 : * along with this program; if not, write to the Free Software
23 : * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA, 02110-1301 USA
24 : *
25 : */
26 :
27 : /* **************************************************************************
28 : * Modifications made in 2005 by IBM Corporation
29 : * (C) Copyright 2005 IBM Corporation. All Rights Reserved.
30 : * Modifications Author: David L. Paktor dlpaktor@us.ibm.com
31 : **************************************************************************** */
32 :
33 : #include <stdio.h>
34 : #include <stdlib.h>
35 : #include <unistd.h>
36 : #ifdef __GLIBC__
37 : #define __USE_XOPEN_EXTENDED
38 : #endif
39 : #include <string.h>
40 : #include <time.h>
41 : #include <ctype.h>
42 :
43 : #include "macros.h"
44 : #include "stack.h"
45 : #include "stream.h"
46 : #include "emit.h"
47 : #include "toke.h"
48 : #include "dictionary.h"
49 : #include "vocabfuncts.h"
50 : #include "scanner.h"
51 : #include "errhandler.h"
52 : #include "tokzesc.h"
53 : #include "conditl.h"
54 : #include "flowcontrol.h"
55 : #include "usersymbols.h"
56 : #include "clflags.h"
57 : #include "devnode.h"
58 : #include "tracesyms.h"
59 : #include "nextfcode.h"
60 :
61 : #include "parselocals.h"
62 :
63 : /* **************************************************************************
64 : *
65 : * Some VERY IMPORTANT global variables follow
66 : *
67 : **************************************************************************** */
68 :
69 : u8 *statbuf=NULL; /* The word just read from the input stream */
70 : u8 base=0x0a; /* The numeric-interpretation base */
71 :
72 : /* pci data */
73 : bool pci_is_last_image=TRUE;
74 : u16 pci_image_rev=0x0001; /* Vendor's Image, NOT PCI Data Structure Rev */
75 : u16 pci_vpd=0x0000;
76 :
77 :
78 : /* Having to do with the state of the tokenization */
79 : bool offs16 = TRUE; /* We are using 16-bit branch- (etc) -offsets */
80 : bool in_tokz_esc = FALSE; /* TRUE if in "Tokenizer Escape" mode */
81 : bool incolon = FALSE; /* TRUE if inside a colon definition */
82 : bool haveend = FALSE; /* TRUE if the "end" code was read. */
83 : int do_loop_depth = 0; /* How deep we are inside DO ... LOOP variants */
84 :
85 : /* Used for error-checking of IBM-style Locals */
86 : int lastcolon; /* Location in output stream of latest colon-definition. */
87 :
88 : /* Used for error reporting */
89 : char *last_colon_defname = NULL; /* Name of last colon-definition */
90 : char *last_colon_filename = NULL; /* File where last colon-def'n made */
91 : unsigned int last_colon_lineno; /* Line number of last colon-def'n */
92 : bool report_multiline = TRUE; /* False to suspend multiline warning */
93 : unsigned int last_colon_abs_token_no;
94 :
95 : /* **************************************************************************
96 : * Local variables
97 : **************************************************************************** */
98 : static u16 last_colon_fcode; /* FCode-number assigned to last colon-def'n */
99 : /* Used for RECURSE */
100 :
101 : static bool do_not_overload = TRUE ; /* False to suspend dup-name-test */
102 : static bool got_until_eof = FALSE ; /* TRUE to signal "unterminated" */
103 :
104 : static unsigned int last_colon_do_depth = 0;
105 :
106 : /* State of headered-ness for name-creation */
107 : typedef enum headeredness_t {
108 : FLAG_HEADERLESS ,
109 : FLAG_EXTERNAL ,
110 : FLAG_HEADERS } headeredness ;
111 : static headeredness hdr_flag = FLAG_HEADERLESS ; /* Init'l default state */
112 :
113 : /* Local variables having to do with: */
114 : /* ... the state of the tokenization */
115 : static bool is_instance = FALSE; /* Is "instance" is in effect? */
116 : static char *instance_filename = NULL; /* File where "instance" invoked */
117 : static unsigned int instance_lineno; /* Line number of "instance" */
118 : static bool fcode_started = FALSE ; /* Only 1 fcode_starter per block. */
119 : static bool first_fc_starter = TRUE; /* Only once per tokenization... */
120 :
121 : /* ... with the state of the input stream, */
122 : static bool need_to_pop_source;
123 :
124 : /* ... with the use of the return stack, */
125 : static int ret_stk_depth = 0; /* Return-Stack-Usage-Depth counter */
126 :
127 : /* ... and with control of error-messaging. */
128 : /* Should a warning about a dangling "instance"
129 : * be issued at the next device-node change?
130 : */
131 : static bool dev_change_instance_warning = TRUE;
132 :
133 : /* Has a gap developed between "instance" and its application? */
134 : static bool instance_definer_gap = FALSE;
135 :
136 : /* Shared phrases */
137 : static char *in_tkz_esc_mode = "in Tokenizer-Escape mode.\n";
138 :
139 :
140 : /* **************************************************************************
141 : *
142 : * Function name: skip_ws
143 : * Synopsis: Advance the PC past all whitespace.
144 : * Protect against pointer over-runs
145 : *
146 : * Inputs:
147 : * Parameters: NONE
148 : * Global Variables:
149 : * pc Input-source Scanning pointer
150 : * end End of input-source buffer
151 : *
152 : * Outputs:
153 : * Returned Value: TRUE if PC reached END before non-blank char
154 : * Global Variables:
155 : * pc Advanced to first non-blank char, or to END
156 : * lineno Incremented if encountered new-line along the way
157 : *
158 : * Error Detection:
159 : * Return a TRUE if End of input-source buffer reached before
160 : * non-blank character. Not necessarily an error; allow
161 : * calling routine to decide...
162 : *
163 : **************************************************************************** */
164 :
165 : static bool skip_ws(void)
166 126801 : {
167 126801 : bool retval = TRUE;
168 : char ch_tmp;
169 :
170 269989 : for ( ; pc < end; pc++ )
171 : {
172 268373 : ch_tmp = *pc;
173 268373 : if ( (ch_tmp != '\t') && (ch_tmp != ' ') && (ch_tmp != '\n' ) )
174 : {
175 125185 : retval = FALSE;
176 125185 : break;
177 : }
178 143188 : if ( ch_tmp == '\n') lineno++;
179 : }
180 126801 : return ( retval );
181 : }
182 :
183 : /* **************************************************************************
184 : *
185 : * Function name: skip_until
186 : * Synopsis: Advance the PC to the given character.
187 : * Do not copy anything into statbuf.
188 : * Protect against pointer over-runs
189 : *
190 : * Inputs:
191 : * Parameters:
192 : * lim_ch Limiting Character
193 : * Global Variables:
194 : * pc Input-source Scanning pointer
195 : * end End of input-source buffer
196 : *
197 : * Outputs:
198 : * Returned Value: TRUE if PC reached END before finding LIM_CH
199 : * Global Variables:
200 : * pc Advanced to first occurrence of LIM_CH, or to END
201 : * lineno Incremented if encountered new-line along the way
202 : *
203 : * Error Detection:
204 : * Return a TRUE if End of input-source buffer reached before
205 : * desired character. Not necessarily an error; allow calling
206 : * routine to decide...
207 : *
208 : **************************************************************************** */
209 :
210 : bool skip_until( char lim_ch)
211 4661 : {
212 4661 : bool retval = TRUE;
213 : char ch_tmp;
214 :
215 205731 : for ( ; pc < end; pc++ )
216 : {
217 205723 : ch_tmp = *pc;
218 205723 : if ( ch_tmp == lim_ch )
219 : {
220 4653 : retval = FALSE;
221 4653 : break;
222 : }
223 201070 : if ( ch_tmp == '\n') lineno++;
224 : }
225 4661 : return ( retval );
226 : }
227 :
228 :
229 : /* **************************************************************************
230 : *
231 : * Function name: get_until
232 : * Synopsis: Return, in statbuf, the string from PC to the first
233 : * occurrence of the given delimiter-character..
234 : *
235 : * Inputs:
236 : * Parameters:
237 : * needle The given delimiter-character
238 : * Global Variables:
239 : * pc Input-source Scanning Pointer
240 : *
241 : * Outputs:
242 : * Returned Value: Length of the string obtained
243 : * Global Variables:
244 : * statbuf The string obtained from the input stream;
245 : * does not include the delimiter-character.
246 : * pc Bumped past the delimiter-character, unless
247 : * it's a new-line, in which case leave it
248 : * to be handled by get_word()
249 : * Local Static Variables:
250 : * got_until_eof Pass this as a signal that the end of the
251 : * buffer was reached before the delimiter;
252 : * Testing whether PC has reached END is
253 : * not a sufficient indication.
254 : *
255 : * Error Detection:
256 : * If string overflows statbuf allocation, ERROR, and
257 : * return "no string" (i.e., length = 0).
258 : * Otherwise, if delimiter not found before eof, keep string.
259 : * Protection against PC pointer-over-run past END is
260 : * provided by skip_until() . Reaching END will be
261 : * handled by calling routine; pass indication along
262 : * via Local Static Variable.
263 : *
264 : * Process Explanation:
265 : * Skip the delimiter-character from further input, unless it's a
266 : * new-line which will be skipped anyway. Let skip_until()
267 : * and get_word() handle incrementing line-number counters.
268 : * If skip_until() indicated reaching end-of-file, don't bump PC
269 : *
270 : * Revision History:
271 : * Updated Thu, 14 Jul 2005 by David L. Paktor
272 : * More robust testing for when PC exceeds END
273 : * Involved replacing firstchar()
274 : *
275 : **************************************************************************** */
276 :
277 : static signed long get_until(char needle)
278 518 : {
279 : u8 *safe;
280 518 : unsigned long len = 0;
281 :
282 518 : safe=pc;
283 :
284 518 : got_until_eof = skip_until(needle);
285 :
286 518 : len = pc - safe;
287 518 : if (len >= GET_BUF_MAX )
288 : {
289 2 : tokenization_error( TKERROR,
290 : "get_until buffer overflow. Max is %d.\n", GET_BUF_MAX-1 );
291 2 : len = GET_BUF_MAX-1;
292 : }
293 :
294 518 : memcpy(statbuf, safe, len);
295 518 : statbuf[len]=0;
296 :
297 518 : if ( INVERSE(got_until_eof) )
298 : {
299 514 : if ( needle != '\n' ) pc++;
300 : }
301 518 : return len;
302 : }
303 :
304 :
305 : /* **************************************************************************
306 : *
307 : * We are going to use a fairly sophisticated mechanism to
308 : * make a smooth transition between processing the body
309 : * of a Macro, a User-defined Symbol or an FLOADed file
310 : * and the resumption of processing the source file, so
311 : * that the end-of-file will only be seen at the end of
312 : * the primary input file (the one from the command-line).
313 : * This mechanism will be tied in with the get_word() routine
314 : *
315 : * We are going to define a private data-structure in which
316 : * we will save the state of the current source file,
317 : * and from which, of course, we will recover it. Its
318 : * fields will be:
319 : * A pointer to the next structure in the list.
320 : * The saved values of START END and PC
321 : * The saved values of INAME and LINENO
322 : * A flag indicating that get-word should "pause"
323 : * before popping the source-stream because
324 : * the input file will be changing.
325 : * A place from which to save and recover the state of
326 : * whether we're testing for "Multi-line" strings;
327 : * to prevent undeserved "Multi-line" warnings
328 : * during Macro processing.
329 : * A pointer to a "resumption" routine, to call
330 : * when resuming processing the source file;
331 : * the routine takes a pointer parameter
332 : * and has no return value. The pointer
333 : * may be NULL if no routine is needed.
334 : * The pointer to pass as the parameter to the
335 : * resumption routine.
336 : *
337 : **************************************************************************** */
338 :
339 : typedef struct source_state
340 : {
341 : struct source_state *next;
342 : u8 *old_start;
343 : u8 *old_pc;
344 : u8 *old_end;
345 : char *old_iname;
346 : unsigned int old_lineno;
347 : bool pause_before_pop;
348 : bool sav_rep_multlin;
349 : void (*resump_func)();
350 : _PTR resump_param;
351 : } source_state_t ;
352 :
353 : static source_state_t *saved_source = NULL;
354 :
355 :
356 : /* **************************************************************************
357 : *
358 : * Function name: push_source
359 : * Synopsis: Save the state of the current source file, in the
360 : * source_state data-structure LIFO linked-list.
361 : *
362 : * Inputs:
363 : * Parameters:
364 : * res_func Pointer to routine to call when resuming
365 : * processing the saved source file.
366 : * res_param Parameter to pass to res_func.
367 : * Either or both pointers may be NULL.
368 : * file_chg TRUE if input file is going to change.
369 : * Global Variables:
370 : * start Points to current input buffer
371 : * end Points to end of current input buffer
372 : * pc Input point in current buffer
373 : * iname Name of current source file
374 : * lineno Line number in current source file
375 : * report_multiline Whether we're testing for "Multi-line"
376 : * Local Static Variables:
377 : * saved_source Pointer to the source_state data-structure
378 : *
379 : * Outputs:
380 : * Returned Value: NONE
381 : * Local Static Variables:
382 : * saved_source Points to new source_state entry
383 : * Memory Allocated
384 : * for the new source_state entry
385 : * When Freed?
386 : * When resuming processing the source file, by drop_source().
387 : *
388 : * Process Explanation:
389 : * The calling routine will establish the new input buffer via
390 : * a call to init_inbuf() or the like.
391 : *
392 : **************************************************************************** */
393 :
394 : void push_source( void (*res_func)(), _PTR res_parm, bool file_chg )
395 1458 : {
396 : source_state_t *new_sav_src;
397 :
398 1458 : new_sav_src = safe_malloc( sizeof(source_state_t), "pushing Source state");
399 :
400 1458 : new_sav_src->next = saved_source;
401 1458 : new_sav_src->old_start = start;
402 1458 : new_sav_src->old_pc = pc;
403 1458 : new_sav_src->old_end = end;
404 1458 : new_sav_src->old_iname = iname;
405 1458 : new_sav_src->old_lineno = lineno;
406 1458 : new_sav_src->pause_before_pop = file_chg;
407 1458 : new_sav_src->sav_rep_multlin = report_multiline;
408 1458 : new_sav_src->resump_func = res_func;
409 1458 : new_sav_src->resump_param = res_parm;
410 :
411 1458 : saved_source = new_sav_src;
412 1458 : }
413 :
414 : /* **************************************************************************
415 : *
416 : * Function name: drop_source
417 : * Synopsis: Remove last saved state of source processing
418 : * from the source_state LIFO linked-list,
419 : * without (or after) restoring.
420 : *
421 : * Inputs:
422 : * Parameters: NONE
423 : * Local Static Variables:
424 : * saved_source Pointer to the source_state data-structure
425 : *
426 : * Outputs:
427 : * Returned Value: NONE
428 : * Local Static Variables:
429 : * saved_source Points to previous source_state entry
430 : * Memory Freed
431 : * Saved source_state entry that was just "dropped"
432 : *
433 : * Error Detection:
434 : * None. Called only when linked-list is known not to be at end.
435 : *
436 : **************************************************************************** */
437 :
438 : static void drop_source( void)
439 1458 : {
440 1458 : source_state_t *former_sav_src = saved_source;
441 :
442 1458 : saved_source = saved_source->next ;
443 1458 : free( former_sav_src);
444 1458 : }
445 :
446 : /* **************************************************************************
447 : *
448 : * Function name: pop_source
449 : * Synopsis: Restore the state of source processing as it was
450 : * last saved in the source_state linked-list.
451 : *
452 : * Inputs:
453 : * Parameters: NONE
454 : * Local Static Variables:
455 : * saved_source Pointer to the source_state data-structure
456 : * need_to_pop_source If TRUE, don't check before popping.
457 : *
458 : * Outputs:
459 : * Returned Value: TRUE if reached end of linked-list
460 : * Global Variables:
461 : * start Points to restored input buffer
462 : * end Points to end of restored input buffer
463 : * pc Input point in restored buffer
464 : * iname Name of restored source file
465 : * lineno Line number in restored source file
466 : * report_multiline Restored to saved value.
467 : * Local Static Variables:
468 : * saved_source Points to previous source_state entry
469 : * need_to_pop_source TRUE if postponed popping till next time
470 : * Memory Freed
471 : * Saved source-state entry that was just "popped"
472 : *
473 : * Process Explanation:
474 : * First check the need_to_pop_source flag.
475 : * If it is set, we will clear it and go ahead and pop.
476 : * If it is not set, we will check the pause_before_pop field
477 : * of the top entry in the source_state linked-list.
478 : * If the pause_before_pop field is set, we will set the
479 : * need_to_pop_source flag and return.
480 : * If it is not, we will go ahead and pop.
481 : * If we are going to go ahead and pop, we will call the
482 : * "Resume-Processing" routine (if it's not NULL) before
483 : * we restore the saved source state.
484 : *
485 : **************************************************************************** */
486 :
487 : static bool pop_source( void )
488 1859 : {
489 1859 : bool retval = TRUE;
490 :
491 1859 : if ( saved_source != NULL )
492 : {
493 1688 : retval = FALSE;
494 1688 : if ( need_to_pop_source )
495 : {
496 244 : need_to_pop_source = FALSE;
497 : }else{
498 1444 : if ( saved_source->pause_before_pop )
499 : {
500 244 : need_to_pop_source = TRUE;
501 244 : return( retval);
502 : }
503 : }
504 :
505 1444 : if ( saved_source->resump_func != NULL )
506 : {
507 610 : saved_source->resump_func( saved_source->resump_param);
508 : }
509 1444 : report_multiline = saved_source->sav_rep_multlin;
510 1444 : lineno = saved_source->old_lineno ;
511 1444 : iname = saved_source->old_iname ;
512 1444 : end = saved_source->old_end ;
513 1444 : pc = saved_source->old_pc ;
514 1444 : start = saved_source->old_start ;
515 :
516 1444 : drop_source();
517 : }
518 1615 : return( retval);
519 : }
520 :
521 :
522 : /* **************************************************************************
523 : *
524 : * Function name: get_word
525 : * Synopsis: Gather the next "word" (aka Forth Token) from the
526 : * input stream.
527 : * A Forth Token is, of course, a string of characters
528 : * delimited by white-space (blank, tab or new-line).
529 : * Do not increment line-number counters here; leave
530 : * the delimiter after the word unconsumed.
531 : *
532 : * Inputs:
533 : * Parameters: NONE
534 : * Global Variables:
535 : * pc Input-stream Scanning Pointer
536 : * Local Static Variables:
537 : * need_to_pop_source If TRUE, pop_source() as first step
538 : *
539 : * Outputs:
540 : * Returned Value: Length of "word" gotten;
541 : * 0 if reached end of file.
542 : * -1 if reached end of primary input
543 : * (I.e., end of all source)
544 : * Global Variables:
545 : * statbuf Copy of "gotten" word
546 : * pc Advanced to end of "gotten" word,
547 : * (i.e., the next word is "consumed")
548 : * unless returning zero.
549 : * abs_token_no Incremented, if valid "word" (token)
550 : * was gotten.
551 : *
552 : * Process Explanation:
553 : * Skip whitespace to the start of the token,
554 : * then skip printable characters to the end of the token.
555 : * That part's easy, but what about when skipping whitespace
556 : * brings you to the end of the input stream?
557 : * First, look at the need_to_pop_source flag. If it's set,
558 : * we came to the end of the input stream the last time
559 : * through. Now we need to pop_source() first.
560 : * Next, we start skipping whitespace; this detects when we've
561 : * reached the end of the input stream. If we have,
562 : * then we need to pop_source() again.
563 : * If pop_source() returned a TRUE, we've reached the end
564 : * of the primary input file. Return -1.
565 : * If pop_source() turned the need_to_pop_source flag
566 : * to TRUE again, then we need to "pause" until the
567 : * next time through; return zero.
568 : * Otherwise, we proceed with collecting the token as described.
569 : *
570 : * Revision History:
571 : * Updated Thu, 23 Feb 2006 by David L. Paktor
572 : * Tied this routine in with a more sophisticated mechanism that
573 : * makes a smooth transition between processing the body of
574 : * a Macro, a User-defined Symbol or an FLOADed file, and
575 : * the resumption of processing the source file, so that the
576 : * end-of-file will only be seen at the end of the primary
577 : * input file (the one that came from the command-line)
578 : * Updated Fri, 24 Feb 2006 by David L. Paktor
579 : * This is trickier than I thought. Added a global indicator
580 : * of whether a file-boundary was crossed while getting
581 : * the word; previously, that was indicated by a return
582 : * value of zero, which now means something else...
583 : * The flag, closed_stream , will be cleared every time this
584 : * routine is entered, and set whenever close_stream() is
585 : * entered.
586 : * Updated Tue, 28 Feb 2006 at 10:13 PST by David L. Paktor
587 : * Trickier still. On crossing a file-boundary, must not
588 : * consume the first word in the resumed file, for one
589 : * call; instead, return zero. Consume it on the next
590 : * call. The closed_stream flag is now irrelevant and
591 : * has gone away.
592 : *
593 : **************************************************************************** */
594 :
595 : signed long get_word( void)
596 125435 : {
597 : size_t len;
598 : u8 *str;
599 : bool keep_skipping;
600 : bool pop_result;
601 :
602 125435 : if ( need_to_pop_source )
603 : {
604 244 : pop_result = pop_source();
605 : }
606 :
607 : do {
608 126635 : keep_skipping = skip_ws();
609 126635 : if ( keep_skipping )
610 : {
611 1615 : pop_result = pop_source();
612 1615 : if ( pop_result || need_to_pop_source )
613 : {
614 415 : statbuf[0] = 0;
615 415 : if ( pop_result )
616 : {
617 171 : return -1;
618 : }
619 244 : return 0;
620 : }
621 : }
622 126220 : } while ( keep_skipping );
623 :
624 125020 : str=pc;
625 733184 : while ( (str < end) && *str && *str!='\n' && *str!='\t' && *str!=' ')
626 483144 : str++;
627 :
628 125020 : len=(size_t)(str-pc);
629 125020 : if (len >= GET_BUF_MAX )
630 : {
631 0 : tokenization_error ( FATAL,
632 : "get_word buffer overflow. Max is %d.", GET_BUF_MAX-1 );
633 : }
634 :
635 125020 : memcpy(statbuf, pc, len);
636 125020 : statbuf[len]=0;
637 :
638 : #ifdef DEBUG_SCANNER
639 : printf("%s:%d: debug: read token '%s', length=%ld\n",
640 : iname, lineno, statbuf, len);
641 : #endif
642 125020 : pc+=len;
643 125020 : abs_token_no++;
644 125020 : return len;
645 : }
646 :
647 :
648 : /* **************************************************************************
649 : *
650 : * Function name: get_word_in_line
651 : * Synopsis: Get the next word on the same line as the current
652 : * line of input. If the end of line was reached
653 : * before a word was found, print an error message
654 : * and return an indication.
655 : *
656 : * Inputs:
657 : * Parameters:
658 : * func_nam Name of the function expecting the same-line
659 : * input; for use in the Error Message.
660 : * If NULL, do not issue Error Message
661 : * Global Variables:
662 : * pc Input character pointer. Saved for comparison
663 : * lineno Current input line number. Saved for comparison
664 : *
665 : * Outputs:
666 : * Returned Value: TRUE = success. Word was acquired on same line.
667 : * Global Variables:
668 : * statbuf Advanced to the next word in the input stream.
669 : * pc Advanced if no error; restored otherwise.
670 : *
671 : * Error Detection:
672 : * If no next word is gotten (i.e., we're at end-of-file), or if
673 : * one is gotten but not on the same line, the routine will
674 : * return FALSE; if func_nam is not NULL, an ERROR Message
675 : * will be issued.
676 : * Also, the values of PC LINENO and ABS_TOKEN_NO will be reset
677 : * to the positions they had when this routine was entered.
678 : *
679 : **************************************************************************** */
680 :
681 : bool get_word_in_line( char *func_nam)
682 1733 : {
683 : signed long wlen;
684 1733 : bool retval = TRUE;
685 1733 : u8 *save_pc = pc;
686 1733 : unsigned int save_lineno = lineno;
687 1733 : unsigned int save_abs_token_no = abs_token_no;
688 :
689 : /* Copy of function name, for error message */
690 : char func_cpy[FUNC_CPY_BUF_SIZE+1];
691 :
692 : /* Do this first, in the likely event that func_nam was statbuf */
693 1733 : if ( func_nam != NULL )
694 : {
695 1620 : strncpy( func_cpy, func_nam, FUNC_CPY_BUF_SIZE);
696 1620 : func_cpy[FUNC_CPY_BUF_SIZE] = 0; /* Guarantee a null terminator */
697 : }
698 :
699 1733 : wlen = get_word();
700 1733 : if ( ( lineno != save_lineno ) || ( wlen <= 0 ) )
701 : {
702 16 : abs_token_no = save_abs_token_no;
703 16 : lineno = save_lineno;
704 16 : pc = save_pc;
705 16 : retval = FALSE;
706 16 : if ( func_nam != NULL )
707 : {
708 15 : tokenization_error ( TKERROR,
709 : "Operator %s expects its target on the same line\n",
710 : strupr(func_cpy));
711 : }
712 : }
713 1733 : return ( retval );
714 : }
715 :
716 :
717 : /* **************************************************************************
718 : *
719 : * Function name: get_rest_of_line
720 : * Synopsis: Get all the remaining text on the same line as
721 : * the current line of input. If there is no text
722 : * (not counting whitespace) before the end of line,
723 : * return an indication.
724 : *
725 : * Inputs:
726 : * Parameters: NONE
727 : * Global Variables:
728 : * pc Input character pointer. Saved for restoration
729 : * lineno Current input line number. Saved for comparison
730 : *
731 : * Outputs:
732 : * Returned Value: TRUE = success. Text was acquired on same line.
733 : * Global Variables:
734 : * statbuf Contains the text found in the input stream.
735 : * pc Advanced to end of line or of whitespace, if
736 : * no error; restored otherwise.
737 : * lineno Preserved if no error; otherwise, restored.
738 : * abs_token_no Restored if error; otherwise, advanced as normal.
739 : *
740 : * Error Detection:
741 : * Routine will return FALSE if no text is gotten on the same line.
742 : *
743 : **************************************************************************** */
744 :
745 : bool get_rest_of_line( void)
746 112 : {
747 112 : bool retval = FALSE;
748 112 : u8 *save_pc = pc;
749 112 : unsigned int save_lineno = lineno;
750 112 : unsigned int save_abs_token_no = abs_token_no;
751 :
752 112 : if ( INVERSE( skip_ws() ) )
753 : {
754 112 : if ( lineno == save_lineno )
755 : {
756 111 : signed long wlen = get_until('\n');
757 111 : if ( wlen > 0 ) retval = TRUE;
758 : }else{
759 1 : abs_token_no = save_abs_token_no;
760 1 : lineno = save_lineno;
761 1 : pc = save_pc;
762 : }
763 : }
764 112 : return( retval);
765 : }
766 :
767 :
768 : /* **************************************************************************
769 : *
770 : * Function name: warn_unterm
771 : * Synopsis: Message for "Unterminated ..." something
772 : * Show saved line-number, where the "something" started,
773 : * and the definition, if any, in which it occurred.
774 : *
775 : * Inputs:
776 : * Parameters:
777 : * severity Type of error/warning message to display
778 : * usually either WARNING or TKERROR
779 : * something String to print after "Unterminated"
780 : * saved_lineno Line-Number where the "something" started
781 : * Global Variables:
782 : * lineno Saved, then restored.
783 : * last_colon_defname Used only if unterm_is_colon is TRUE;
784 : * Local Static Variables:
785 : * unterm_is_colon See 07 Mar 2006 entry under Rev'n History
786 : *
787 : * Outputs:
788 : * Returned Value: NONE
789 : * Global Variables:
790 : * lineno Saved, then restored.
791 : * Local Static Variables:
792 : * unterm_is_colon Reset to FALSE
793 : * Printout:
794 : * Warning or Error message
795 : *
796 : * Revision History:
797 : * Updated Mon, 06 Mar 2006 by David L. Paktor
798 : * Added call to in_last_colon()
799 : * Updated Tue, 07 Mar 2006 by David L. Paktor
800 : * Call to in_last_colon() works okay in most cases except for
801 : * when the "something" is a Colon Definition; there, it
802 : * results in the phrase: ... Definition in definition of ...
803 : * which is awkward. To eliminate that, I am introducing
804 : * a Local Static Variable flag called unterm_is_colon
805 : * which will be set only in the appropriate place and
806 : * re-cleared here. It's a retro-fit, of course; it could
807 : * have been a parameter had the need for it occurred when
808 : * this routine was first constructed...
809 : *
810 : **************************************************************************** */
811 :
812 : static bool unterm_is_colon = FALSE;
813 : void warn_unterm( int severity, char *something, unsigned int saved_lineno)
814 25 : {
815 25 : unsigned int tmp = lineno;
816 25 : lineno = saved_lineno;
817 25 : if ( unterm_is_colon )
818 : {
819 3 : tokenization_error( severity, "Unterminated %s of %s\n",
820 : something, strupr( last_colon_defname) );
821 3 : unterm_is_colon = FALSE;
822 : }else{
823 22 : tokenization_error( severity, "Unterminated %s", something);
824 22 : in_last_colon();
825 : }
826 25 : lineno = tmp;
827 25 : }
828 :
829 : /* **************************************************************************
830 : *
831 : * Function name: warn_if_multiline
832 : * Synopsis: Test for "Multi-line ..." something and issue WARNING
833 : * Show saved line-number, where the "something" started
834 : *
835 : * Inputs:
836 : * Parameters:
837 : * something String to print after "Unterminated"
838 : * start_lineno Line-Number where the "something" started
839 : * Global Variables:
840 : * lineno Line-Number where we are now
841 : * iname Input file name, to satisfy ...where_started()
842 : * (Not crossing any actual file boundary.)
843 : * report_multiline TRUE = go ahead with the message
844 : *
845 : * Outputs:
846 : * Returned Value: NONE
847 : * Global Variables:
848 : * report_multiline Restored to TRUE.
849 : *
850 : * Error Detection:
851 : * Only issue message if the current lineno doesn't equal
852 : * the start_lineno
853 : *
854 : * Process Explanation:
855 : * The directive "multi-line" allows the user to specify that
856 : * the next "Multi-line ..." something is intentional, and
857 : * will cause its warning to be suppressed. It remains in
858 : * effect until it's "used"; afterwards, it's reset.
859 : *
860 : **************************************************************************** */
861 :
862 : void warn_if_multiline( char *something, unsigned int start_lineno )
863 36922 : {
864 36922 : if ( report_multiline && ( start_lineno != lineno ) )
865 : {
866 130 : tokenization_error( WARNING, "Multi-line %s, started", something);
867 130 : where_started( iname, start_lineno);
868 : }
869 36922 : report_multiline = TRUE;
870 36922 : }
871 :
872 :
873 : /* **************************************************************************
874 : *
875 : * Function name: string_remark
876 : * Synopsis: Suspend string parsing past end of line and
877 : * whitespace at start of the new line.
878 : *
879 : * Inputs:
880 : * Parameters:
881 : * errmsg_txt Text to be used for error-message.
882 : * Global Variables:
883 : * pc Input-source Scanning pointer
884 : *
885 : * Outputs:
886 : * Returned Value: NONE
887 : * Global Variables:
888 : * pc Will point to first non-blank in new line
889 : *
890 : * Error Detection:
891 : * The return value of the skip_until() or skip_ws() routine
892 : * will indicate if PC goes past END. Issue a WARNING.
893 : * The calling routine will handle things from there.
894 : *
895 : **************************************************************************** */
896 :
897 : static void string_remark(char *errmsg_txt)
898 54 : {
899 54 : unsigned int sav_lineno = lineno;
900 54 : bool eof = skip_until('\n');
901 54 : if ( ! eof )
902 : {
903 54 : eof = skip_ws();
904 : }
905 54 : if ( eof )
906 : {
907 1 : warn_unterm(WARNING, errmsg_txt, sav_lineno);
908 : }
909 :
910 54 : }
911 :
912 :
913 : /* Convert the given string to a number in the supplied base */
914 : /* Allow -- and ignore -- embedded periods. */
915 : /* The endptr param represents a pointer that will be updated
916 : * with the address of the first non-numeric character encountered,
917 : * (unless it is a NULL, in which case it is ignored).
918 : */
919 : /* There is no test for a completely invalid string;
920 : * the calling routine is responsible for ascertaining
921 : * the validity of the string being passed.
922 : */
923 : static long parse_number(u8 *start, u8 **endptr, int lbase)
924 11827 : {
925 11827 : long val = 0;
926 11827 : bool negative = FALSE ;
927 : int curr;
928 11827 : u8 *nptr=start;
929 :
930 11827 : curr = *nptr;
931 11827 : if (curr == '-')
932 : {
933 0 : negative = TRUE ;
934 0 : nptr++;
935 : }
936 :
937 37570 : for (curr = *nptr; (curr = *nptr); nptr++) {
938 26467 : if ( curr == '.' )
939 8 : continue;
940 26459 : if ( curr >= '0' && curr <= '9')
941 24765 : curr -= '0';
942 1694 : else if (curr >= 'a' && curr <= 'f')
943 1023 : curr += 10 - 'a';
944 671 : else if (curr >= 'A' && curr <= 'F')
945 2 : curr += 10 - 'A';
946 : else
947 669 : break;
948 :
949 25790 : if (curr >= lbase)
950 55 : break;
951 :
952 25735 : val *= lbase;
953 25735 : val += curr;
954 : }
955 :
956 : #ifdef DEBUG_SCANNER
957 : if (curr)
958 : printf( "%s:%d: warning: couldn't parse number '%s' (%d/%d)\n",
959 : iname, lineno, start,curr,lbase);
960 : #endif
961 :
962 11827 : if (endptr)
963 11548 : *endptr=nptr;
964 :
965 11827 : if (negative)
966 : {
967 0 : val = -val;
968 : }
969 11827 : return val;
970 : }
971 :
972 : /* **************************************************************************
973 : *
974 : * Function name: add_byte_to_string
975 : * Synopsis: Add the given byte (or character) to the string
976 : * being accumulated in statbuf, but protect
977 : * against a buffer overflow.
978 : *
979 : * Inputs:
980 : * Parameters:
981 : * nu_byte The given character to be added
982 : * walk Pointer to pointer to the position
983 : * in statbuf where the character
984 : * is to be placed
985 : * Global Variables:
986 : * statbuf Buffer where the string is accumulated
987 : * Macros:
988 : * GET_BUF_MAX Size of the buffer
989 : *
990 : * Outputs:
991 : * Returned Value: NONE
992 : * Supplied Pointers:
993 : * **walk Given character is placed here
994 : * *walk Incremented in any case
995 : *
996 : * Error Detection:
997 : * If walk has reached end of string buffer, do not place
998 : * the character, but continue to increment walk .
999 : * Calling routine will detect overflow.
1000 : *
1001 : **************************************************************************** */
1002 :
1003 : static void add_byte_to_string( u8 nu_byte, u8 **walk )
1004 1478035 : {
1005 1478035 : if ( *walk - statbuf < GET_BUF_MAX )
1006 : {
1007 1475587 : **walk = nu_byte;
1008 : }
1009 1478035 : (*walk)++;
1010 1478035 : }
1011 :
1012 : /* **************************************************************************
1013 : *
1014 : * Function name: c_string_escape
1015 : * Synopsis: Process C-style escape syntax in strings
1016 : *
1017 : * Inputs:
1018 : * Parameters:
1019 : * walk Pointer to pointer to area into
1020 : * which to put acquired values
1021 : * Global Variables:
1022 : * pc Input-source Scanning pointer
1023 : *
1024 : * Outputs:
1025 : * Returned Value: NONE
1026 : * Global Variables:
1027 : * pc Point to last character processed.
1028 : * Supplied Pointers:
1029 : * *walk Advanced by number of bytes acquired
1030 : *
1031 : * Error Detection:
1032 : * WARNING conditions. See under "Process Explanation" below.
1033 : *
1034 : * Process Explanation:
1035 : * Start with PC pointing to the first character to process
1036 : * i.e., after the backslash.
1037 : * We recognize newline, tab and numbers
1038 : * A digit-string in the current base can be converted to a number.
1039 : * The first non-numeric character ends the numeric sequence
1040 : * and gets swallowed up.
1041 : * If the number exceeds the size of a byte, use the truncated
1042 : * value and issue a WARNING.
1043 : * If the first character in the "digit"-string was non-numeric,
1044 : * use the character literally and issue a WARNING.
1045 : * If the character that ended the numeric sequence is a quote,
1046 : * it might be the end of the string, or the start of a
1047 : * special-character or even of an "( ... ) hex-sequence,
1048 : * so don't swallow it up.
1049 : *
1050 : * Still to be done:
1051 : * Better protection against PC pointer-over-run past END.
1052 : * Currently, this works, but it's held together by threads:
1053 : * Because init_stream forces a null-byte at the end of
1054 : * the input buffer, parse_number() exits immediately upon
1055 : * encountering it. This situation could be covered more
1056 : * robustly...
1057 : *
1058 : **************************************************************************** */
1059 :
1060 : static void c_string_escape( u8 **walk)
1061 159 : {
1062 159 : char c = *pc;
1063 : u8 val;
1064 : /* We will come out of this "switch" statement
1065 : * with a value for val and a decision
1066 : * as to whether to write it.
1067 : */
1068 159 : bool write_val = TRUE;
1069 :
1070 159 : switch (c)
1071 : {
1072 : case 'n':
1073 : /* newline */
1074 17 : val = '\n';
1075 17 : break;
1076 : case 't':
1077 : /* tab */
1078 27 : val = '\t';
1079 27 : break;
1080 : default:
1081 :
1082 : /* Digit-string? Convert it to a number, using the current base.
1083 : * The first non-numeric character ends the numeric sequence
1084 : * and gets swallowed up.
1085 : * If the number exceeds the size of a byte, use the truncated
1086 : * value and issue a WARNING.
1087 : * If the first character in the "digit"-string was non-numeric,
1088 : * use the character literally and issue a WARNING.
1089 : */
1090 :
1091 : /*
1092 : * If the sequence ender is a quote, it might be the end of
1093 : * the string, or the start of a special-character or even
1094 : * of an "( ... ) hex-sequence, so don't swallow it up.
1095 : */
1096 : {
1097 : long lval;
1098 115 : u8 *sav_pc = pc;
1099 115 : lval=parse_number(pc, &pc, base);
1100 115 : val = (u8)lval;
1101 : #ifdef DEBUG_SCANNER
1102 : if (verbose)
1103 : printf( "%s:%d: debug: escape code "
1104 : "0x%x\n",iname, lineno, val);
1105 : #endif
1106 115 : if ( lval > 0x0ff )
1107 : {
1108 14 : tokenization_error ( WARNING,
1109 : "Numeric String after \\ overflows byte. "
1110 : "Using 0x%02x.\n", val);
1111 : }
1112 :
1113 115 : if ( pc == sav_pc )
1114 : {
1115 : /* NOTE: Here, PC hasn't been advanced past its
1116 : * saved value, so we can count on C remaining
1117 : * unchanged since the start of the routine.
1118 : */
1119 : /* Don't use the null-byte at the end of the buffer */
1120 40 : if ( ( pc >= end )
1121 : /* or a sequence-ending quote. */
1122 : || ( c == '"' ) )
1123 : {
1124 2 : write_val = FALSE;
1125 : }else{
1126 : /* In the WARNING message, print the character
1127 : * if it's printable or show it in hex
1128 : * if it's not.
1129 : */
1130 38 : if ( (c > 0x20 ) && ( c <= 0x7e) )
1131 : {
1132 20 : tokenization_error ( WARNING,
1133 : "Unrecognized character, %c, "
1134 : "after \\ in string. "
1135 : "Using it literally.\n", c);
1136 : }else{
1137 18 : tokenization_error ( WARNING,
1138 : "Unrecognized character, 0x%02x, "
1139 : "after \\ in string. "
1140 : "Using it literally.\n", c);
1141 : }
1142 38 : val = c;
1143 : }
1144 : }
1145 : /* NOTE: Here, however, PC may have been advanced... */
1146 : /* Don't swallow the sequence-ender if it's a quote. */
1147 115 : if ( *pc == '"' )
1148 : {
1149 16 : pc--;
1150 : }
1151 :
1152 : } /* End of the "default" clause */
1153 : } /* End of the "switch" statement */
1154 :
1155 159 : if ( write_val ) add_byte_to_string( val, walk );
1156 :
1157 159 : }
1158 :
1159 : /* **************************************************************************
1160 : *
1161 : * Function name: get_sequence
1162 : * Synopsis: Process the Hex-Number option in strings
1163 : * Protect against PC pointer-over-run past END.
1164 : *
1165 : * Inputs:
1166 : * Parameters:
1167 : * **walk Pointer to pointer to area into which
1168 : * to put acquired values
1169 : * Global Variables:
1170 : * pc Input-source Scanning pointer
1171 : * end End of input-source buffer
1172 : *
1173 : * Outputs:
1174 : * Returned Value: TRUE = "Normal Completion" (I.e., not EOF)
1175 : * Global Variables:
1176 : * pc Points at terminating close-paren, or END
1177 : * lineno Input File Line-Number Counter, may be incr'd
1178 : * Supplied Pointers:
1179 : * *walk Advanced by number of values acquired
1180 : *
1181 : * Error Detection:
1182 : * End-of-file encountered before end of hex-sequence:
1183 : * Issue a Warning, conclude processing, return FALSE.
1184 : *
1185 : * Process Explanation:
1186 : * SETUP and RULES:
1187 : * Start with PC pointing to the first character
1188 : * after the '(' (Open-Paren)
1189 : * Bytes are gathered from digits in pairs, except
1190 : * when separated they are treated singly.
1191 : * Allow a backslash in the middle of the sequence
1192 : * to skip to the end of the line and past the
1193 : * whitespace at the start of the next line,
1194 : * i.e., it acts as a comment-escape.
1195 : *
1196 : * INITIALIZE:
1197 : * PV_indx = 0
1198 : * Set return-indicator to "Abnormal Completion"
1199 : * Ready_to_Parse = FALSE
1200 : * Stuff NULL into PVAL[2]
1201 : * WHILE PC is less than END
1202 : * Pick up character at PC into Next_Ch
1203 : * IF Next_Ch is close-paren :
1204 : * Set return-indicator to "Normal Completion".
1205 : * Done! Break out of loop.
1206 : * ENDIF
1207 : * IF comment-escape behavior (controlled by means of a
1208 : * command-line switch) is allowed
1209 : * IF Next_Ch is backslash :
1210 : * Skip to end-of line, skip whitespace.
1211 : * If that makes PC reach END : WARNING message.
1212 : * (Don't need to break out of loop;
1213 : * normal test will terminate.)
1214 : * CONTINUE Loop.
1215 : * (Don't increment PC; PC is already at right place).
1216 : * ENDIF
1217 : * ENDIF
1218 : * IF Next_Ch is a valid Hex-Digit character :
1219 : * Stuff it into PVAL[PV_indx]
1220 : * IF (PV_indx is 0) :
1221 : * Increment PV_indx
1222 : * ELSE
1223 : * Set Ready_to_Parse to TRUE
1224 : * ENDIF
1225 : * ELSE
1226 : * IF Next_Ch is a New-Line, increment Line Number counter
1227 : * IF (PV_indx is 1) :
1228 : * Stuff NULL into PVAL[1]
1229 : * Set Ready_to_Parse to TRUE
1230 : * ENDIF
1231 : * ENDIF
1232 : * IF Ready_to_Parse
1233 : * Parse PVAL
1234 : * Stuff into WALK
1235 : * Reset PV_indx to zero
1236 : * Reset Ready_to_Parse to FALSE
1237 : * ENDIF
1238 : * Increment PC
1239 : * REPEAT
1240 : * Return with Normal/Abnormal completion indicator
1241 : *
1242 : **************************************************************************** */
1243 :
1244 : static bool get_sequence(u8 **walk)
1245 33 : {
1246 33 : int pv_indx = 0;
1247 33 : bool retval = FALSE; /* "Abnormal Completion" indicator */
1248 33 : bool ready_to_parse = FALSE;
1249 : char next_ch;
1250 : char pval[3];
1251 :
1252 : #ifdef DEBUG_SCANNER
1253 : printf("%s:%d: debug: hex field:", iname, lineno);
1254 : #endif
1255 33 : pval[2]=0;
1256 :
1257 888 : while ( pc < end )
1258 : {
1259 854 : next_ch = *pc;
1260 854 : if ( next_ch == ')' )
1261 : {
1262 32 : retval = TRUE;
1263 32 : break;
1264 : }
1265 822 : if ( hex_remark_escape )
1266 : {
1267 685 : if ( next_ch == '\\' )
1268 : {
1269 34 : string_remark("string hex-sequence remark");
1270 34 : continue;
1271 : }
1272 : }
1273 788 : if ( isxdigit(next_ch) )
1274 : {
1275 469 : pval[pv_indx] = next_ch;
1276 469 : if ( pv_indx == 0 )
1277 : {
1278 279 : pv_indx++;
1279 : }else{
1280 190 : ready_to_parse = TRUE;
1281 : }
1282 : }else{
1283 319 : if ( next_ch == '\n' ) lineno++ ;
1284 319 : if ( pv_indx != 0 )
1285 : {
1286 89 : pval[1] = 0;
1287 89 : ready_to_parse = TRUE;
1288 : }
1289 : }
1290 788 : if ( ready_to_parse )
1291 : {
1292 279 : u8 val = parse_number(pval, NULL, 16);
1293 279 : *((*walk)++)=val;
1294 : #ifdef DEBUG_SCANNER
1295 : printf(" %02x",val);
1296 : #endif
1297 279 : pv_indx = 0;
1298 279 : ready_to_parse = FALSE;
1299 : }
1300 788 : pc++;
1301 : }
1302 : #ifdef DEBUG_SCANNER
1303 : printf("\n");
1304 : #endif
1305 33 : return ( retval );
1306 : }
1307 :
1308 : /* **************************************************************************
1309 : *
1310 : * Return the length of the string.
1311 : * Pack the string, without the terminating '"' (Quote), into statbuf
1312 : * Protect against PC pointer-over-run past END.
1313 : * Enable Quote-Backslash as a String-Remark Escape.
1314 : * Allowability of Quote-Backslash as a String-Remark is under control
1315 : * of a command-line switch (string_remark_escape ).
1316 : * Allowability of C-style escape characters is under control
1317 : * of a command-line switch ( c_style_string_escape ).
1318 : *
1319 : * Truncate string to size of Forth Packed-String (i.e., uses leading
1320 : * count-byte, so limited to 255, number that one byte can express)
1321 : * unless the string is being gathered for a Message or is being
1322 : * consumed for purposes of ignoring it, in either of which case
1323 : * that limit need not be enforced. Parameter "pack_str" controls
1324 : * this: TRUE if limit needs to be enforced.
1325 : *
1326 : * Issue WARNING if string length gets truncated.
1327 : * Issue WARNING if string crosses line.
1328 : * The issuance of the Multi-line WARNING is under control of a
1329 : * one-shot directive similar to OVERLOAD , called MULTI-LINE
1330 : *
1331 : * Still to be decided:
1332 : * Do we want to bring the allowability of strings crossing
1333 : * lines under control of a command-line switch?
1334 : *
1335 : ************************************************************************** */
1336 :
1337 : static signed long get_string( bool pack_str)
1338 36080 : {
1339 : u8 *walk;
1340 : unsigned long len;
1341 : char c;
1342 36080 : bool run = TRUE;
1343 36080 : unsigned long start_lineno = lineno; /* For warning message */
1344 :
1345 : /*
1346 : * Bump past the single whitespace character that delimits
1347 : * the command -- e.g., ." or " or suchlike -- that
1348 : * starts the string. Allow new-line to be a command-
1349 : * -delimiting whitespace character. Regard any sub-
1350 : * sequent whitespace characters as part of the string
1351 : */
1352 36080 : if (*pc++=='\n') lineno++;
1353 :
1354 36080 : got_until_eof = TRUE ;
1355 :
1356 36080 : walk=statbuf;
1357 1586321 : while (run) {
1358 1514161 : switch ((c=*pc))
1359 : {
1360 : /* Standard use of '"' (Quote) for special-char escape */
1361 : case '\"':
1362 : /* Skip the '"' (Quote) */
1363 36376 : pc++;
1364 : /* End of the buffer also ends the string cleanly */
1365 36376 : if ( pc >= end )
1366 : {
1367 0 : run = FALSE;
1368 0 : got_until_eof = FALSE ;
1369 0 : break;
1370 : }
1371 : /* Pick up the next char after the '"' (Quote) */
1372 36376 : c=*pc;
1373 36376 : switch (c)
1374 : {
1375 : case '(':
1376 33 : pc++; /* skip the '(' */
1377 33 : run = get_sequence(&walk);
1378 33 : break;
1379 :
1380 : case 'n':
1381 41 : add_byte_to_string( '\n', &walk);
1382 41 : break;
1383 : case 'r':
1384 7 : add_byte_to_string( '\r', &walk);
1385 7 : break;
1386 : case 't':
1387 35 : add_byte_to_string( '\t', &walk);
1388 35 : break;
1389 : case 'f':
1390 7 : add_byte_to_string( '\f', &walk);
1391 7 : break;
1392 : case 'l':
1393 6 : add_byte_to_string( '\n', &walk);
1394 6 : break;
1395 : case 'b':
1396 13 : add_byte_to_string( 0x08, &walk);
1397 13 : break;
1398 : case '!':
1399 14 : add_byte_to_string( 0x07, &walk);
1400 14 : break;
1401 : case '^':
1402 20 : pc++; /* Skip the up-arrow (Caret) */
1403 20 : add_byte_to_string( *pc & 0x1f , &walk);
1404 20 : break;
1405 : /* We're done after any of the whitespace
1406 : * characters follows a quote.
1407 : */
1408 : case ' ':
1409 : case '\t':
1410 : /* Advance past the terminating whitespace
1411 : * character, except newline.
1412 : * Let get_word() handle that.
1413 : */
1414 34785 : pc++;
1415 : case '\n':
1416 36071 : run=FALSE;
1417 36071 : got_until_eof = FALSE ;
1418 36071 : break;
1419 : default:
1420 : /* Control allowability of Quote-Backslash
1421 : * as a String-Remark by means of a
1422 : * command-line switch.
1423 : */
1424 129 : if ( string_remark_escape )
1425 : {
1426 121 : if ( c == '\\' )
1427 : {
1428 20 : string_remark("string-escape remark");
1429 : /* The first non-blank in the new line
1430 : * has not been processed yet.
1431 : * Back up to allow it to be.
1432 : */
1433 20 : pc--;
1434 20 : break;
1435 : }
1436 : }
1437 109 : add_byte_to_string( c, &walk);
1438 : }
1439 : break;
1440 : case '\n':
1441 : /* Allow strings to cross lines. Include the
1442 : * newline in the string. Account for it.
1443 : */
1444 218 : lineno++;
1445 : default:
1446 : /* Control allowability of C-style escape-character
1447 : * syntax by means of a command-line switch.
1448 : */
1449 1477785 : if ( c_style_string_escape )
1450 : {
1451 1477446 : if ( c == '\\' )
1452 : {
1453 159 : pc++;
1454 159 : c_string_escape(&walk );
1455 159 : break;
1456 : }
1457 : }
1458 1477626 : add_byte_to_string( c, &walk);
1459 : }
1460 : /* Advance past the char processed, unless we're done. */
1461 1514161 : if ( run ) pc++;
1462 : /* Done if we hit end of file before string was concluded */
1463 1514161 : if ( pc >= end )
1464 : {
1465 9 : run = FALSE;
1466 9 : if ( got_until_eof )
1467 : {
1468 9 : warn_unterm( WARNING, "string", start_lineno);
1469 : /* Prevent multiple messages for one error */
1470 9 : got_until_eof = FALSE;
1471 : }
1472 : }
1473 : }
1474 :
1475 36080 : warn_if_multiline( "string", start_lineno);
1476 :
1477 36080 : len = walk - statbuf;
1478 36080 : if (len >= GET_BUF_MAX )
1479 : {
1480 4 : tokenization_error ( TKERROR,
1481 : "get_string buffer overflow. Max is %d\n.", GET_BUF_MAX-1 );
1482 4 : len = GET_BUF_MAX-1;
1483 : }
1484 : #ifdef DEBUG_SCANNER
1485 : if (verbose)
1486 : printf("%s:%d: debug: scanned string: '%s'\n",
1487 : iname, lineno, statbuf);
1488 : #endif
1489 36080 : if ( pack_str && (len > STRING_LEN_MAX) )
1490 : {
1491 2 : tokenization_error ( WARNING,
1492 : "String length being truncated to %d.\n", STRING_LEN_MAX );
1493 2 : len = STRING_LEN_MAX;
1494 : }
1495 36080 : statbuf[len] = 0;
1496 :
1497 36080 : return len ;
1498 : }
1499 :
1500 :
1501 : /* **************************************************************************
1502 : *
1503 : * Function name: handle_user_message
1504 : * Synopsis: Collect a user-generated tokenization-time message;
1505 : * either print it or discard it. Shared code
1506 : * for user_message() and skip_user_message()
1507 : *
1508 : * Inputs:
1509 : * Parameters:
1510 : * delim End-of-string delimiter character.
1511 : * If it's a double-quote ("), we will use
1512 : * the get-string() routine, with all
1513 : * its options, to collect the message.
1514 : * Otherwise, we'll capture plain text from
1515 : * the input stream.
1516 : * print_it TRUE if we should print the message
1517 : * Local Static Variables:
1518 : * got_until_eof TRUE if reached end of buffer before delim.
1519 : * Global Variables:
1520 : * lineno Save, then restore.
1521 : *
1522 : * Outputs:
1523 : * Returned Value: NONE
1524 : * Global Variables:
1525 : * statbuf The string will be collected in here
1526 : *
1527 : * Printout (if print_it is TRUE):
1528 : * The string, with new-line tacked on, will be printed from
1529 : * the tokenization_error() routine as a MESSAGE.
1530 : * The line-number will be shown as of the origin of the message
1531 : *
1532 : * Error Detection:
1533 : * Error-reports will be printed regardless of print_it param.
1534 : * If delimiter was not found, show "Unterminated" warning message.
1535 : * If delimiter was " (double-quote), the get_string() routine
1536 : * already checked for a multi-line construct; if delimiter is
1537 : * a new-line, then a multi-line construct is impossible.
1538 : * otherwise, we will do the multi-line check here.
1539 : *
1540 : **************************************************************************** */
1541 :
1542 : static void handle_user_message( char delim, bool print_it )
1543 822 : {
1544 : signed long wlen;
1545 822 : unsigned int start_lineno = lineno;
1546 822 : unsigned int multiline_start = lineno; /* For warning message */
1547 822 : bool check_multiline = FALSE;
1548 822 : const char *ug_msg = "user-generated message";
1549 :
1550 822 : if ( delim == '"' )
1551 : {
1552 452 : wlen = get_string( FALSE);
1553 : }else{
1554 : /*
1555 : * When the message-delimiter is a new-line, and the
1556 : * command-delimiter was a new-line, it means the
1557 : * string length is zero; we won't bump the PC.
1558 : * Otherwise, we will honor the convention we extend
1559 : * to .( whereby, if the command is delimited
1560 : * by a new-line, we allow the string to begin
1561 : * on the next line.
1562 : */
1563 370 : if ( delim == '\n' )
1564 : {
1565 324 : if ( *pc != '\n') pc++;
1566 : }else{
1567 46 : if (*pc++=='\n') lineno++;
1568 46 : multiline_start = lineno;
1569 46 : check_multiline = TRUE;
1570 : }
1571 370 : wlen = get_until( delim );
1572 : }
1573 :
1574 822 : if ( print_it )
1575 : {
1576 582 : unsigned int tmp_lineno = lineno;
1577 582 : lineno = start_lineno;
1578 : /* Don't add a new-line to body of the message.
1579 : * Routine already takes care of that.
1580 : * Besides, buffer might be full...
1581 : */
1582 582 : tokenization_error( MESSAGE, statbuf);
1583 582 : lineno = tmp_lineno;
1584 : }
1585 :
1586 822 : if ( got_until_eof ) /* Crude but effective retrofit... */
1587 : {
1588 2 : warn_unterm(WARNING, (char *)ug_msg, start_lineno);
1589 : }else{
1590 820 : if ( check_multiline )
1591 : {
1592 44 : warn_if_multiline( (char *)ug_msg, multiline_start);
1593 : }
1594 : }
1595 822 : }
1596 :
1597 : /* **************************************************************************
1598 : *
1599 : * Function name: user_message
1600 : * Synopsis: Collect a user-generated message and
1601 : * print it at tokenization-time.
1602 : *
1603 : * Tokenizer directive (either mode):
1604 : * Synonyms String Delimiter
1605 : * [MESSAGE] #MESSAGE [#MESSAGE] end-of-line
1606 : * #MESSAGE" "
1607 : * "Tokenizer-Escape" mode directive String Delimiter
1608 : * .( )
1609 : * ." "
1610 : *
1611 : * Inputs:
1612 : * Parameter is the "parameter field" of the TIC entry, which
1613 : * was initialized to the end-of-string delimiter character.
1614 : *
1615 : * Outputs:
1616 : * Returned Value: NONE
1617 : * Printout: User-message, parsed from input.
1618 : *
1619 : * Extraneous Remarks:
1620 : * We would have preferred to simply use the "character value"
1621 : * aspect of the union, but we found portability issues
1622 : * between big- and little- -endian processors, so we still
1623 : * have to recast its type here.
1624 : *
1625 : **************************************************************************** */
1626 :
1627 : void user_message( tic_param_t pfield )
1628 582 : {
1629 582 : char delim = (char)pfield.deflt_elem ;
1630 582 : handle_user_message( delim, TRUE);
1631 582 : }
1632 :
1633 : /* **************************************************************************
1634 : *
1635 : * Function name: skip_user_message
1636 : * Synopsis: Collect a user-generated message and discard it.
1637 : * Used when ignoring a Conditional section.
1638 : *
1639 : * Tokenizer directive (either mode):
1640 : * Synonyms String Delimiter
1641 : * [MESSAGE] #MESSAGE [#MESSAGE] end-of-line
1642 : * #MESSAGE" "
1643 : * "Tokenizer-Escape" mode directive String Delimiter
1644 : * .( )
1645 : * ." "
1646 : *
1647 : * Inputs:
1648 : * Parameters:
1649 : * pfield "Parameter field" of the TIC entry, which
1650 : * was initialized to the delimiter.
1651 : *
1652 : * Outputs:
1653 : * Returned Value: NONE
1654 : * Printout: NONE
1655 : *
1656 : **************************************************************************** */
1657 :
1658 : void skip_user_message( tic_param_t pfield )
1659 240 : {
1660 240 : char delim = (char)pfield.deflt_elem ;
1661 240 : handle_user_message( delim, FALSE);
1662 240 : }
1663 :
1664 :
1665 :
1666 : /* **************************************************************************
1667 : *
1668 : * Function name: get_number
1669 : * Synopsis: If the word retrieved from the input stream is a
1670 : * valid number (under the current base) convert it.
1671 : * Return an indication if it was not.
1672 : *
1673 : * Inputs:
1674 : * Parameters:
1675 : * *result Pointer to place to return the number
1676 : * Global Variables:
1677 : * statbuf The word just read that is to be converted.
1678 : * base The current numeric-interpretation base.
1679 : *
1680 : * Outputs:
1681 : * Returned Value: TRUE = Input was a valid number
1682 : * Supplied Pointers:
1683 : * *result The converted number, if valid
1684 : * otherwise undefined
1685 : *
1686 : * Revision History:
1687 : * Updated Mon, 28 Mar 2005 by David L. Paktor
1688 : * Always use the current base.
1689 : * Reversed sense of return-flag.
1690 : *
1691 : **************************************************************************** */
1692 :
1693 : bool get_number( long *result)
1694 11433 : {
1695 : u8 *until;
1696 : long val;
1697 11433 : bool retval = FALSE ;
1698 :
1699 11433 : val = parse_number(statbuf, &until, base);
1700 :
1701 : #ifdef DEBUG_SCANNER
1702 : printf("%s:%d: debug: parsing number: base 0x%x, val 0x%lx, "
1703 : "processed %ld of %ld bytes\n", iname, lineno,
1704 : base, val,(size_t)(until-statbuf), strlen((char *)statbuf));
1705 : #endif
1706 :
1707 : /* If number-parsing ended before the end of the input word,
1708 : * then the input word was not a valid number.
1709 : */
1710 11433 : if (until==(statbuf+strlen((char *)statbuf)))
1711 : {
1712 10823 : *result=val;
1713 10823 : retval = TRUE;
1714 : }
1715 :
1716 11433 : return ( retval );
1717 : }
1718 :
1719 : /* **************************************************************************
1720 : *
1721 : * Function name: deliver_number
1722 : * Synopsis: Deliver the supplied number according to the
1723 : * state of the tokenizer:
1724 : * In normal tokenization mode, emit it as an
1725 : * FCode literal.
1726 : * In "Tokenizer-Escape" mode, push it onto
1727 : * the Data Stack.
1728 : *
1729 : * Inputs:
1730 : * Parameters:
1731 : * numval The number, verified to be valid.
1732 : * Global Variables:
1733 : * in_tokz_esc TRUE if tokenizer is in "Tokenizer Escape" mode.
1734 : *
1735 : * Outputs:
1736 : * Returned Value: NONE
1737 : * Items Pushed onto Data-Stack:
1738 : * Top: The number, if in_tokz_esc was TRUE
1739 : * FCode Output buffer:
1740 : * If in_tokz_esc was FALSE, a b(lit) token will be written,
1741 : * followed by the number.
1742 : *
1743 : **************************************************************************** */
1744 :
1745 : static void deliver_number( long numval)
1746 10845 : {
1747 10845 : if ( in_tokz_esc )
1748 : {
1749 231 : dpush( numval );
1750 : } else {
1751 10614 : emit_literal(numval);
1752 : }
1753 10845 : }
1754 : /* **************************************************************************
1755 : *
1756 : * Function name: handle_number
1757 : * Synopsis: Convert the word just retrieved from the input stream
1758 : * to a number.
1759 : * Indicate whether the string was a valid number and
1760 : * deliver it, as appropriate.
1761 : *
1762 : * Inputs:
1763 : * Parameters: NONE
1764 : * Global Variables:
1765 : * statbuf The word that was just read, and to be converted.
1766 : *
1767 : * Outputs:
1768 : * Returned Value: TRUE = Input string was a valid number
1769 : * If input string was a valid number, the converted number will
1770 : * be delivered, as appropriate, by deliver_number().
1771 : *
1772 : **************************************************************************** */
1773 :
1774 : static bool handle_number( void )
1775 11128 : {
1776 : bool retval ;
1777 : long numval;
1778 :
1779 11128 : retval = get_number( &numval );
1780 11128 : if ( retval )
1781 : {
1782 10820 : deliver_number( numval );
1783 : }
1784 :
1785 11128 : return ( retval );
1786 : }
1787 :
1788 : /* **************************************************************************
1789 : *
1790 : * Function name: ascii_right_number
1791 : * Synopsis: Convert a character sequence to a number, justified
1792 : * toward the right (i.e., the low-order bytes) and
1793 : * deliver it, as appropriate.
1794 : *
1795 : * Inputs:
1796 : * Parameters:
1797 : * in_str The input string
1798 : *
1799 : * Outputs:
1800 : * Returned Value: NONE
1801 : * The converted number will be delivered by deliver_number().
1802 : *
1803 : * Process Explanation:
1804 : * The last four characters in the sequence will become the number.
1805 : * If there are fewer than four, they will fill the low-order part
1806 : * of the number.
1807 : * Example: PCIR is converted to h# 50434952
1808 : * CPU is converted to h# 00435055
1809 : * and
1810 : * LotsOfStuff is equivalent to a# tuff
1811 : * and is converted to h# 74756666
1812 : *
1813 : **************************************************************************** */
1814 :
1815 : static void ascii_right_number( char *in_str)
1816 13 : {
1817 : u8 nxt_ch;
1818 13 : char *str_ptr = in_str;
1819 13 : long numval = 0;
1820 :
1821 13 : for ( nxt_ch = (u8)*str_ptr ;
1822 98 : ( nxt_ch = (u8)*str_ptr ) != 0 ;
1823 72 : str_ptr++ )
1824 : {
1825 72 : numval = ( numval << 8 ) + nxt_ch ;
1826 : }
1827 13 : deliver_number( numval );
1828 13 : }
1829 :
1830 :
1831 : /* **************************************************************************
1832 : *
1833 : * Function name: ascii_left_number
1834 : * Synopsis: Similar to ascii_right_number() except justified
1835 : * toward the left (i.e., the high-order bytes).
1836 : *
1837 : *
1838 : * Inputs:
1839 : * Parameters:
1840 : * in_str The input string
1841 : *
1842 : * Outputs:
1843 : * Returned Value: NONE
1844 : * The converted number will be delivered by deliver_number().
1845 : *
1846 : * Process Explanation:
1847 : * If there are fewer than four characters in the sequence, they
1848 : * will fill the high-order part of the number.
1849 : * CPU is converted to h# 43505500
1850 : * In all other respects, similar to ascii_right_number()
1851 : *
1852 : **************************************************************************** */
1853 :
1854 : static void ascii_left_number( char *in_str)
1855 12 : {
1856 : u8 nxt_ch;
1857 12 : char *str_ptr = in_str;
1858 12 : long numval = 0;
1859 12 : int shift_amt = 24;
1860 12 : bool shift_over = FALSE ;
1861 :
1862 12 : for ( nxt_ch = (u8)*str_ptr ;
1863 92 : ( nxt_ch = (u8)*str_ptr ) != 0 ;
1864 68 : str_ptr++ )
1865 : {
1866 68 : if ( shift_over ) numval <<= 8;
1867 68 : if ( shift_amt == 0 ) shift_over = TRUE ;
1868 68 : numval += ( nxt_ch << shift_amt );
1869 68 : if ( shift_amt > 0 ) shift_amt -= 8;
1870 : }
1871 12 : deliver_number( numval );
1872 :
1873 12 : }
1874 :
1875 : /* **************************************************************************
1876 : *
1877 : * Function name: init_scanner
1878 : * Synopsis: Allocate memory the Scanner will need.
1879 : * Only need to call once per program run.
1880 : *
1881 : **************************************************************************** */
1882 :
1883 : void init_scanner(void)
1884 154 : {
1885 154 : statbuf=safe_malloc(GET_BUF_MAX, "initting scanner");
1886 154 : }
1887 :
1888 : /* **************************************************************************
1889 : *
1890 : * Function name: exit_scanner
1891 : * Synopsis: Free up memory the Scanner used
1892 : *
1893 : **************************************************************************** */
1894 :
1895 : void exit_scanner(void)
1896 153 : {
1897 153 : free(statbuf);
1898 153 : }
1899 :
1900 : /* **************************************************************************
1901 : *
1902 : * Function name: set_hdr_flag
1903 : * Synopsis: Set the state of the "headered-ness" flag to the
1904 : * value given, unless over-ridden by one or both
1905 : * of the "always-..." Command-Line Flags
1906 : *
1907 : * Inputs:
1908 : * Parameters:
1909 : * new_flag New setting
1910 : * Global Variables:
1911 : * always_headers Override HEADERLESS and make HEADERS
1912 : * always_external Override HEADERLESS and HEADERS;
1913 : * make EXTERNAL
1914 : *
1915 : * Outputs:
1916 : * Returned Value: None
1917 : * Local Static Variables:
1918 : * hdr_flag Adjusted to new setting
1919 : *
1920 : * Process Explanation:
1921 : * If always_headers is TRUE, and new_flag is not FLAG_EXTERNAL
1922 : * then set to FLAG_HEADERS
1923 : * If always_external is TRUE, set to FLAG_EXTERNAL, regardless.
1924 : * (Note: always_external over-rides always_headers).
1925 : * Otherwise, set to new_flag
1926 : *
1927 : **************************************************************************** */
1928 :
1929 : static void set_hdr_flag( headeredness new_flag)
1930 349 : {
1931 349 : headeredness new_state = new_flag;
1932 349 : switch ( new_flag)
1933 : {
1934 : case FLAG_HEADERLESS:
1935 : {
1936 171 : if ( always_headers )
1937 7 : { new_state = FLAG_HEADERS;
1938 : }
1939 : /* No break. Intentional... */
1940 : }
1941 : case FLAG_HEADERS:
1942 : {
1943 337 : if ( always_external )
1944 8 : { new_state = FLAG_EXTERNAL;
1945 : }
1946 : /* No break. Intentional... */
1947 : }
1948 : case FLAG_EXTERNAL:
1949 : break; /* Satisfy compiler's error-checking... */
1950 : /* No default needed here... */
1951 : }
1952 :
1953 349 : hdr_flag = new_state;
1954 :
1955 349 : }
1956 :
1957 :
1958 : /* **************************************************************************
1959 : *
1960 : * Function name: init_scan_state
1961 : * Synopsis: Initialize various state variables for each time
1962 : * a new tokenization scan is started.
1963 : *
1964 : * Inputs:
1965 : * Parameters: NONE
1966 : *
1967 : * Outputs:
1968 : * Returned Value: NONE
1969 : * Global Variables: Initialized to:
1970 : * base 0x0a (I.e., base = "decimal")
1971 : * nextfcode By reset_fcode_ranges()
1972 : * pci_is_last_image TRUE
1973 : * incolon FALSE
1974 : * Local Static Variables:
1975 : * hdr_flag FLAG_HEADERLESS (unless over-ridden)
1976 : * is_instance FALSE
1977 : * last_colon_filename NULL
1978 : * instance_filename NULL
1979 : * dev_change_instance_warning TRUE
1980 : * instance_definer_gap FALSE
1981 : * need_to_pop_source FALSE
1982 : * first_fc_starter TRUE
1983 : * ret_stk_depth 0
1984 : * Memory Freed
1985 : * Copies of input-file name in last_colon_filename and
1986 : * instance_filename , if allocated.
1987 : *
1988 : **************************************************************************** */
1989 :
1990 : void init_scan_state( void)
1991 165 : {
1992 165 : base = 0x0a;
1993 165 : pci_is_last_image = TRUE;
1994 165 : incolon = FALSE;
1995 165 : is_instance = FALSE;
1996 165 : set_hdr_flag( FLAG_HEADERLESS);
1997 165 : reset_fcode_ranges();
1998 165 : first_fc_starter = TRUE;
1999 165 : if ( last_colon_filename != NULL ) free( last_colon_filename);
2000 165 : if ( instance_filename != NULL ) free( instance_filename);
2001 165 : last_colon_filename = NULL;
2002 165 : instance_filename = NULL;
2003 165 : dev_change_instance_warning = TRUE;
2004 165 : instance_definer_gap = FALSE;
2005 165 : need_to_pop_source = FALSE;
2006 165 : ret_stk_depth = 0;
2007 165 : }
2008 :
2009 :
2010 : /* **************************************************************************
2011 : *
2012 : * Function name: collect_input_filename
2013 : * Synopsis: Save a copy of the current input file name in the
2014 : * given variable, for error-reporting purposes
2015 : *
2016 : * Inputs:
2017 : * Parameters:
2018 : * saved_nam Pointer to pointer for copy of name
2019 : * Global Variables:
2020 : * iname Current input file name
2021 : * Local Static Variables:
2022 : *
2023 : * Outputs:
2024 : * Returned Value: NONE
2025 : * Supplied Pointers:
2026 : * *saved_nam Copy of name
2027 : * Memory Allocated
2028 : * For copy of input file name
2029 : * When Freed?
2030 : * Subsequent call to this routine with same pointer
2031 : * (Last copy made will be freed if starting a new tokenization,
2032 : * otherwise, will persist until end of program.)
2033 : * Memory Freed
2034 : * Previous copy in same pointer.
2035 : *
2036 : * Process Explanation:
2037 : * If there is a previous copy, and it still matches the current
2038 : * input-file name, we don't need to free or re-allocate.
2039 : *
2040 : **************************************************************************** */
2041 :
2042 : static void collect_input_filename( char **saved_nam)
2043 805 : {
2044 805 : bool update_lcfn = TRUE; /* Need to re-allocate? */
2045 805 : if ( *saved_nam != NULL )
2046 : {
2047 664 : if ( strcmp( *saved_nam, iname) == 0 )
2048 : {
2049 : /* Last collected filename unchanged from iname */
2050 614 : update_lcfn = FALSE;
2051 : }else{
2052 50 : free( *saved_nam);
2053 : }
2054 : }
2055 805 : if ( update_lcfn )
2056 : {
2057 191 : *saved_nam = strdup(iname);
2058 : }
2059 805 : }
2060 :
2061 : /* **************************************************************************
2062 : *
2063 : * Function name: test_in_colon
2064 : * Synopsis: Error-check whether a word is being used in the
2065 : * correct state, relative to being inside a colon
2066 : * definition; issue a message if it's not.
2067 : *
2068 : * Inputs:
2069 : * Parameters:
2070 : * wname The name of the word in question
2071 : * sb_in_colon TRUE if the name should be used inside
2072 : * a colon-definition only; FALSE if
2073 : * it may only be used outside of a
2074 : * colon-definition.
2075 : * severity Type of error/warning message to call.
2076 : * usually either WARNING or TKERROR
2077 : * use_instead Word the error-message should suggest be
2078 : * used "instead". This may be a NULL,
2079 : * in which case the "suggestion" part
2080 : * of the message will simply be omitted.
2081 : * Global Variables:
2082 : * incolon State of the tokenization; TRUE if inside
2083 : * a colon definition
2084 : *
2085 : * Outputs:
2086 : * Returned Value: TRUE if no error.
2087 : * Printout: Error messages as indicated.
2088 : *
2089 : * Error Detection:
2090 : * If the state, relative to being inside a colon-definition,
2091 : * is not what the parameter says it should be, issue a
2092 : * message of the indicated severity, and return FALSE.
2093 : *
2094 : **************************************************************************** */
2095 :
2096 : static bool test_in_colon ( char *wname,
2097 : bool sb_in_colon, /* "Should Be IN colon" */
2098 : int severity,
2099 : char *use_instead)
2100 11120 : {
2101 : bool is_wrong;
2102 11120 : bool retval = TRUE ;
2103 :
2104 11120 : is_wrong = BOOLVAL(( sb_in_colon != FALSE ) != ( incolon != FALSE )) ;
2105 11120 : if ( is_wrong )
2106 : {
2107 23 : char *ui_pt1 = "";
2108 23 : char *ui_pt2 = "";
2109 23 : char *ui_pt3 = "";
2110 23 : retval = FALSE;
2111 23 : if ( use_instead != NULL )
2112 : {
2113 5 : ui_pt1 = " Use ";
2114 5 : ui_pt2 = use_instead;
2115 5 : ui_pt3 = " instead.";
2116 : }
2117 23 : tokenization_error ( severity, "The word %s should not be used "
2118 : "%sside of a colon definition.%s%s%s\n", strupr(wname),
2119 : sb_in_colon ? "out" : "in", ui_pt1, ui_pt2, ui_pt3 );
2120 : }
2121 11120 : return ( retval );
2122 : }
2123 :
2124 : /* **************************************************************************
2125 : *
2126 : * Function name: must_be_deep_in_do
2127 : * Synopsis: Check that the statement in question is called
2128 : * from inside the given depth of structures
2129 : * of the DO ... LOOP -type (i.e., any combination
2130 : * of DO or ?DO and LOOP or +LOOP ).
2131 : * Show an error if it is not.
2132 : *
2133 : **************************************************************************** */
2134 :
2135 : static void must_be_deep_in_do( int how_deep )
2136 82 : {
2137 82 : int functional_depth = do_loop_depth;
2138 82 : if ( incolon )
2139 : {
2140 69 : functional_depth -= last_colon_do_depth;
2141 : }
2142 82 : if ( functional_depth < how_deep )
2143 : {
2144 14 : char deep_do[64] = "";
2145 : int indx;
2146 14 : bool prefix = FALSE;
2147 :
2148 34 : for ( indx = 0; indx < how_deep ; indx ++ )
2149 : {
2150 20 : strcat( deep_do, "DO ... ");
2151 : }
2152 34 : for ( indx = 0; indx < how_deep ; indx ++ )
2153 : {
2154 20 : if ( prefix )
2155 : {
2156 6 : strcat( deep_do, " ... ");
2157 : }
2158 20 : strcat( deep_do, "LOOP");
2159 20 : prefix = TRUE;
2160 : }
2161 :
2162 14 : tokenization_error( TKERROR,
2163 : "%s outside of %s structure", strupr(statbuf), deep_do);
2164 14 : in_last_colon();
2165 : }
2166 :
2167 82 : }
2168 :
2169 : /* **************************************************************************
2170 : *
2171 : * Function name: bump_ret_stk_depth
2172 : * Synopsis: Increment or decrement the Return-Stack-Usage-Depth
2173 : * counter.
2174 : *
2175 : * Inputs:
2176 : * Parameters:
2177 : * bump Amount by which to increment;
2178 : * negative number to decrement.
2179 : * Local Static Variables:
2180 : * ret_stk_depth The Return-Stack-Usage-Depth counter
2181 : *
2182 : * Outputs:
2183 : * Returned Value: NONE
2184 : * Local Static Variables:
2185 : * ret_stk_depth Incremented or decremented
2186 : *
2187 : * Process Explanation:
2188 : * This simple-seeming function is actually a place-holder
2189 : * for future expansion. Proper error-detection of
2190 : * Return-Stack usage is considerably more complex than
2191 : * what we are implementing here, and is deferred for a
2192 : * later revision.
2193 : *
2194 : * Still to be done:
2195 : * Full detection of whether the Return-Stack has been cleared
2196 : * when required, including analysis of Return-Stack usage
2197 : * within Flow-Control constructs, and before Loop elements...
2198 : *
2199 : * Extraneous Remarks:
2200 : * Some FORTHs use a Loop-Control stack separate from the Return-
2201 : * -Stack, but others use the Return-Stack to keep LOOP-control
2202 : * elements. An FCode program must be portable between different
2203 : * environments, and so must adhere to the restrictions listed
2204 : * in the ANSI Spec:
2205 : *
2206 : * 3.2.3.3 Return stack
2207 : * . . . . . .
2208 : * A program may use the return stack for temporary storage during the
2209 : * execution of a definition subject to the following restrictions:
2210 : * A program shall not access values on the return stack (using R@,
2211 : * R>, 2R@ or 2R>) that it did not place there using >R or 2>R;
2212 : * A program shall not access from within a do-loop values placed
2213 : * on the return stack before the loop was entered;
2214 : * All values placed on the return stack within a do-loop shall
2215 : * be removed before I, J, LOOP, +LOOP, UNLOOP, or LEAVE is
2216 : * executed;
2217 : * All values placed on the return stack within a definition
2218 : * shall be removed before the definition is terminated
2219 : * or before EXIT is executed.
2220 : *
2221 : **************************************************************************** */
2222 :
2223 : static void bump_ret_stk_depth( int bump)
2224 76 : {
2225 76 : ret_stk_depth += bump;
2226 76 : }
2227 :
2228 :
2229 : /* **************************************************************************
2230 : *
2231 : * Function name: ret_stk_balance_rpt
2232 : * Synopsis: Display a Message if usage of the Return-Stack
2233 : * appears to be out of balance.
2234 : *
2235 : * Inputs:
2236 : * Parameters:
2237 : * before_what Phrase to use in Message;
2238 : * if NULL, use statbuf...
2239 : * clear_it TRUE if this call should also clear the
2240 : * Return-Stack-Usage-Depth counter
2241 : * Global Variables:
2242 : * statbuf Word currently being processed
2243 : * Local Static Variables:
2244 : * ret_stk_depth The Return-Stack-Usage-Depth counter
2245 : *
2246 : * Outputs:
2247 : * Returned Value: NONE
2248 : * Local Static Variables:
2249 : * ret_stk_depth May be cleared
2250 : *
2251 : * Error Detection:
2252 : * Based simply on whether the Return-Stack-Usage-Depth counter
2253 : * is zero. This is a weak and uncertain implementation;
2254 : * therefore, the Message will be a WARNING phrased with
2255 : * some equivocation.
2256 : *
2257 : * Process Explanation:
2258 : * Proper detection of Return-Stack usage errors is considerably
2259 : * more complex, and is deferred for a future revision.
2260 : *
2261 : * Still to be done:
2262 : * Correct analysis of Return-Stack usage around Flow-Control
2263 : * constructs. Consider, for instance, the following:
2264 : *
2265 : * blablabla >R yadayada IF R> gubble ELSE flubble R> THEN
2266 : *
2267 : * It is, in fact, correct, but the present scheme would
2268 : * tag it as a possible error. Conversely, something like:
2269 : *
2270 : * blablabla >R yadayada IF R> gubble THEN
2271 : *
2272 : * would not get tagged, even though it is actually an error.
2273 : *
2274 : * The current simple scheme also does not cover Return-Stack
2275 : * usage within Do-Loops or before Loop elements like I and
2276 : * J or UNLOOP or LEAVE. Implementing something like that
2277 : * would probably need to be integrated in with Flow-Control
2278 : * constructs, and will be noted in flowcontrol.c
2279 : *
2280 : **************************************************************************** */
2281 :
2282 : static void ret_stk_balance_rpt( char *before_what, bool clear_it)
2283 764 : {
2284 764 : if ( ret_stk_depth != 0 )
2285 : {
2286 7 : char *what_flow = ret_stk_depth < 0 ? "deficit" : "excess" ;
2287 7 : char *what_phr = before_what != NULL ? before_what : strupr(statbuf);
2288 :
2289 7 : tokenization_error( WARNING,
2290 : "Possible Return-Stack %s before %s", what_flow, what_phr);
2291 7 : in_last_colon();
2292 :
2293 7 : if ( clear_it )
2294 : {
2295 5 : ret_stk_depth = 0;
2296 : }
2297 : }
2298 764 : }
2299 :
2300 :
2301 : /* **************************************************************************
2302 : *
2303 : * Function name: ret_stk_access_rpt
2304 : * Synopsis: Display a Message if an attempt to access a value
2305 : * on the Return-Stack appears to occur before
2306 : * one was placed there.
2307 : *
2308 : * Inputs:
2309 : * Parameters: NONE
2310 : * Global Variables:
2311 : * statbuf Word currently being processed
2312 : * Local Static Variables:
2313 : * ret_stk_depth The Return-Stack-Usage-Depth counter
2314 : *
2315 : * Outputs:
2316 : * Returned Value: NONE
2317 : *
2318 : * Error Detection:
2319 : * Equivocal WARNING, based simply on whether the Return-Stack-
2320 : * -Usage-Depth counter not positive.
2321 : *
2322 : * Process Explanation:
2323 : * Proper detection is deferred...
2324 : *
2325 : * Still to be done:
2326 : * Correct analysis of Return-Stack usage...
2327 : *
2328 : **************************************************************************** */
2329 :
2330 : static void ret_stk_access_rpt( void)
2331 44 : {
2332 44 : if ( ret_stk_depth <= 0 )
2333 : {
2334 9 : tokenization_error( WARNING,
2335 : "Possible Return-Stack access attempt by %s "
2336 : "without value having been placed there",
2337 : strupr(statbuf) );
2338 9 : in_last_colon();
2339 : }
2340 44 : }
2341 :
2342 :
2343 :
2344 : /* **************************************************************************
2345 : *
2346 : * Function name: encode_file
2347 : * Synopsis: Input a (presumably binary) file and encode it
2348 : * as a series of strings which will be accumulated
2349 : * and encoded in a manner appropriate for a property.
2350 : *
2351 : * Associated Tokenizer directive: encode-file
2352 : *
2353 : * Error Detection:
2354 : * Handled by support routines.
2355 : *
2356 : **************************************************************************** */
2357 :
2358 : static void encode_file( const char *filename )
2359 18 : {
2360 : FILE *f;
2361 : size_t s;
2362 18 : int num_encoded=0;
2363 :
2364 18 : tokenization_error( INFO, "ENCODing File %s\n", filename );
2365 :
2366 18 : f = open_expanded_file( filename, "rb", "encoding");
2367 18 : if( f != NULL )
2368 : {
2369 21 : while( (s=fread(statbuf, 1, STRING_LEN_MAX, f)) )
2370 : {
2371 14 : emit_token("b(\")");
2372 14 : emit_string(statbuf, s);
2373 14 : emit_token("encode-bytes");
2374 14 : if( num_encoded )
2375 10 : emit_token("encode+");
2376 14 : num_encoded += s;
2377 : }
2378 7 : fclose( f );
2379 7 : tokenization_error ( INFO, "ENCODed %d bytes.\n", num_encoded);
2380 : }
2381 18 : }
2382 :
2383 : /* **************************************************************************
2384 : *
2385 : * Function name: check_name_length
2386 : * Synopsis: If the length of a user-defined name exceeds the
2387 : * ANSI-specified maximum of 31 characters, issue
2388 : * a message. This is a hard-coded limit.
2389 : * Although our Tokenizer can handle longer names,
2390 : * they will cause big problems when encountered
2391 : * by an FCode interpreter.
2392 : * If the name is going to be included in the binary
2393 : * output, the message severity must be an ERROR.
2394 : * Otherwise, if the name is HEADERLESS, the severity
2395 : * can be reduced to a Warning; if the name is only
2396 : * defined in "Tokenizer Escape" mode the message
2397 : * severity can be further reduced to an Advisory.
2398 : *
2399 : * Inputs:
2400 : * Parameters:
2401 : * wlen Length of the newly-created word
2402 : * Global Variables:
2403 : * in_tokz_esc TRUE if in "Tokenizer Escape" mode.
2404 : * Local Static Variables:
2405 : * hdr_flag State of headered-ness for name-creation
2406 : *
2407 : * Outputs:
2408 : * Returned Value: NONE
2409 : * Global Variables:
2410 : * Printout: ERROR message if applicable.
2411 : *
2412 : * Error Detection:
2413 : * The whole point of this routine.
2414 : *
2415 : * Revision History:
2416 : * Updated Wed, 20 Jul 2005 by David L. Paktor
2417 : * Escalated from merely an informative warning to a TKERROR
2418 : * Updated Fri, 21 Oct 2005 by David L. Paktor
2419 : * Adjust severity if name doesn't go into the FCode anyway...
2420 : *
2421 : **************************************************************************** */
2422 :
2423 : void check_name_length( signed long wlen )
2424 10077 : {
2425 10077 : if ( wlen > 31 )
2426 : {
2427 7 : int severity = TKERROR;
2428 7 : if ( in_tokz_esc )
2429 2 : { severity = INFO;
2430 : }else{
2431 5 : if (hdr_flag == FLAG_HEADERLESS)
2432 1 : { severity = WARNING;
2433 : }
2434 : }
2435 7 : tokenization_error( severity,
2436 : "ANSI Forth does not permit definition of names "
2437 : "longer than 31 characters.\n" );
2438 : }
2439 :
2440 10077 : }
2441 :
2442 :
2443 : /* **************************************************************************
2444 : *
2445 : * Function name: definer_name
2446 : * Synopsis: Given a defining-word internal token, return
2447 : * a printable string for the definer, for use
2448 : * in an error-message.
2449 : *
2450 : * Inputs:
2451 : * Parameters:
2452 : * definer Internal token for the defining-word
2453 : * reslt_ptr Pointer to string-pointer that takes
2454 : * the result, if successful
2455 : *
2456 : * Outputs:
2457 : * Returned Value: TRUE if definer was recognized
2458 : * Supplied Pointers:
2459 : * *reslt_ptr If successful, points to printable string;
2460 : * otherwise, left unchanged.
2461 : *
2462 : *
2463 : **************************************************************************** */
2464 :
2465 : static bool definer_name(fwtoken definer, char **reslt_ptr)
2466 10275 : {
2467 10275 : bool retval = TRUE;
2468 10275 : switch (definer)
2469 : {
2470 : case VARIABLE:
2471 64 : *reslt_ptr = "VARIABLE";
2472 64 : break;
2473 : case DEFER:
2474 5 : *reslt_ptr = "DEFER";
2475 5 : break;
2476 : case VALUE:
2477 72 : *reslt_ptr = "VALUE";
2478 72 : break;
2479 : case BUFFER:
2480 37 : *reslt_ptr = "BUFFER";
2481 37 : break;
2482 : case CONST:
2483 9115 : *reslt_ptr = "CONSTANT";
2484 9115 : break;
2485 : case COLON:
2486 783 : *reslt_ptr = "COLON";
2487 783 : break;
2488 : case CREATE:
2489 32 : *reslt_ptr = "CREATE";
2490 32 : break;
2491 : case FIELD:
2492 6 : *reslt_ptr = "FIELD";
2493 6 : break;
2494 : case MACRO_DEF:
2495 25 : *reslt_ptr = "MACRO";
2496 25 : break;
2497 : case ALIAS:
2498 3 : *reslt_ptr = "ALIAS";
2499 3 : break;
2500 : case LOCAL_VAL:
2501 46 : *reslt_ptr = "Local Value name";
2502 46 : break;
2503 : default:
2504 87 : retval = FALSE;
2505 : }
2506 :
2507 10275 : return ( retval);
2508 : }
2509 :
2510 :
2511 : /* **************************************************************************
2512 : *
2513 : * Function name: as_a_what
2514 : * Synopsis: Add the phrase "as a[n] <DEF'N_TYPE>" for the given
2515 : * definition-type to the given string buffer.
2516 : *
2517 : * Inputs:
2518 : * Parameters:
2519 : * definer Internal token for the defining-word
2520 : * as_what The string buffer to which to add.
2521 : *
2522 : * Outputs:
2523 : * Returned Value: TRUE if an assigned name was found
2524 : * for the given definer and text
2525 : * was added to the buffer.
2526 : * Supplied Pointers:
2527 : * *as_what Text is added to this buffer.
2528 : *
2529 : * Process Explanation:
2530 : * The calling routine is responsible to make sure the size of
2531 : * the buffer is adequate. Allow 25 for this routine.
2532 : * The added text will not have spaces before or after; if any
2533 : * are needed, they, too, are the responsibility of the
2534 : * calling routine. The return value gives a helpful clue.
2535 : *
2536 : **************************************************************************** */
2537 :
2538 : bool as_a_what( fwtoken definer, char *as_what)
2539 245 : {
2540 : char *defn_type_name;
2541 245 : bool retval = definer_name(definer, &defn_type_name);
2542 245 : if ( retval )
2543 : {
2544 171 : strcat( as_what, "as a");
2545 : /* Handle article preceding definer name
2546 : * that starts with a vowel.
2547 : */
2548 : /* HACK: Only one definer name -- ALIAS --
2549 : * begins with a vowel. Take advantage
2550 : * of that...
2551 : * Otherwise, we'd need to do something involving
2552 : * strchr( "AEIOU", defn_type_name[0] )
2553 : */
2554 171 : if ( definer == ALIAS ) strcat( as_what, "n" );
2555 :
2556 171 : strcat( as_what, " ");
2557 171 : strcat( as_what, defn_type_name);
2558 : }
2559 245 : return( retval);
2560 : }
2561 :
2562 :
2563 : /* **************************************************************************
2564 : *
2565 : * Function name: lookup_word
2566 : * Synopsis: Find the TIC-entry for the given word in the Current
2567 : * mode -- relative to "Tokenizer-Escape" -- and
2568 : * Scope into which definitions are being entered.
2569 : * Optionally, prepare text for various Message types.
2570 : *
2571 : * Inputs:
2572 : * Parameters:
2573 : * stat_name Word to look up
2574 : * where_pt1 Pointer to result-display string, part 1
2575 : * NULL if not preparing text
2576 : * where_pt2 Pointer to result-display string, part 2
2577 : * NULL if not preparing text
2578 : * Global Variables:
2579 : * in_tokz_esc TRUE if in "Tokenizer Escape" mode.
2580 : * scope_is_global TRUE if "global" scope is in effect
2581 : * current_device_node Current dev-node data-struct
2582 : * ibm_locals TRUE if IBM-style Locals are enabled
2583 : *
2584 : * Outputs:
2585 : * Returned Value: Pointer to TIC-entry; NULL if not found
2586 : * Supplied Pointers:
2587 : * *where_pt1 Result display string, part 1 of 2
2588 : * *where_pt2 Result display string, part 2 of 2
2589 : *
2590 : * Process Explanation:
2591 : * We will set the two-part result-display string in this routine
2592 : * because only here do we know in which vocabulary the word
2593 : * was found.
2594 : * Pre-load the two parts of the result-display string.
2595 : * If we are in "Tokenizer Escape" mode, look up the word: first,
2596 : * in the "Tokenizer Escape" Vocabulary, or, if not found,
2597 : * among the "Shared" words.
2598 : * Otherwise, we're in Normal" mode. Look it up: first, among the
2599 : * Locals, if IBM-style Locals are enabled (it can possibly be
2600 : * one if "Tokenizer Escape" mode was entered during a colon-
2601 : * -definition); then, if it was not found and if "Device"
2602 : * scope is in effect, look in the current device-node; then,
2603 : * if not found, in the "core" vocabulary.
2604 : * Load the second part of the result-display string with the
2605 : * appropriate phrase for whereever it was found.
2606 : * Then adjust the first part of the result-display string with
2607 : * the definer, if known.
2608 : *
2609 : * The two strings will be formatted to be printed adjacently,
2610 : * without any additional spaces in the printf() format.
2611 : * The first part of the result-display string will not start with
2612 : * a space, but will have an intermediate space if necessary.
2613 : * The second part of the result-display string will not start
2614 : * with a space, and will contain the terminating new-line
2615 : * if appropriate. It might or might not have been built
2616 : * with a call to in_what_node().
2617 : *
2618 : * If the calling routine displays the result-display strings,
2619 : * it should follow-up with a call to show_node_start()
2620 : * This will be harmless if in_what_node() was not used
2621 : * in the construction of the result-display string.
2622 : * If the calling routine is NOT going to display the result strings,
2623 : * it should pass NULLs for the string-pointer pointers.
2624 : *
2625 : * The second part of the string consists of pre-coded phrases;
2626 : * therefore, we can directly assign the pointer.
2627 : * The first part of the string, however, has developed into
2628 : * something constructed "on the fly". Earlier, it, too,
2629 : * had been a directly-assignable pointer; all the callers
2630 : * to this routine expect that. Rather than change all the
2631 : * callers, we will assign a local buffer for it.
2632 : *
2633 : * Extraneous Remarks:
2634 : * We had to add the rule allowing where_pt1 or where_pt2 to be
2635 : * NULL after we introduced the in_what_node() function.
2636 : * We had cases where residue from a lookup for processing
2637 : * showed up later in an unrelated Message. The NULL rule
2638 : * should prevent that.
2639 : *
2640 : **************************************************************************** */
2641 :
2642 : static char lookup_where_pt1_buf[32];
2643 :
2644 : tic_hdr_t *lookup_word( char *stat_name, char **where_pt1, char **where_pt2 )
2645 123068 : {
2646 123068 : tic_hdr_t *found = NULL;
2647 123068 : bool trail_space = TRUE;
2648 123068 : bool doing_lookup = BOOLVAL( ( where_pt1 != NULL )
2649 : && ( where_pt2 != NULL ) );
2650 123068 : char *temp_where_pt2 = "in the core vocabulary.\n";
2651 :
2652 123068 : lookup_where_pt1_buf[0] = 0; /* Init'lz part-1 buffer */
2653 :
2654 : /* "Core vocab" refers both to shared fwords and built-in tokens. */
2655 :
2656 : /* Distinguish between "Normal" and "Tokenizer Escape" mode */
2657 123068 : if ( in_tokz_esc )
2658 : { /* "Tokenizer Escape" mode. */
2659 2539 : found = lookup_tokz_esc( stat_name);
2660 2539 : if ( found != NULL )
2661 : {
2662 1304 : temp_where_pt2 = in_tkz_esc_mode;
2663 : }else{
2664 : /* "Core vocabulary". */
2665 1235 : found = lookup_shared_word( stat_name);
2666 : }
2667 : }else{
2668 : /* "Normal" tokenization mode */
2669 120529 : if ( ibm_locals )
2670 : {
2671 11758 : found = lookup_local( stat_name);
2672 11758 : if ( doing_lookup && ( found != NULL ) )
2673 : {
2674 44 : trail_space = FALSE;
2675 44 : temp_where_pt2 = ".\n";
2676 : }
2677 : }
2678 :
2679 120529 : if ( found == NULL )
2680 : {
2681 119983 : found = lookup_in_dev_node( stat_name);
2682 119983 : if ( found != NULL )
2683 : {
2684 1318 : if ( doing_lookup )
2685 : {
2686 19 : temp_where_pt2 = in_what_node( current_device_node);
2687 : }
2688 : }else{
2689 : /* "Core vocabulary". */
2690 118665 : found = lookup_core_word( stat_name);
2691 : }
2692 : }
2693 : }
2694 :
2695 123068 : if ( ( doing_lookup ) && ( found != NULL ) )
2696 : {
2697 174 : if ( as_a_what( found->fword_defr, lookup_where_pt1_buf) )
2698 : {
2699 109 : if ( trail_space )
2700 : {
2701 65 : strcat(lookup_where_pt1_buf, " ");
2702 : }
2703 : }
2704 174 : *where_pt1 = lookup_where_pt1_buf;
2705 174 : *where_pt2 = temp_where_pt2;
2706 : }
2707 123068 : return( found);
2708 : }
2709 :
2710 : /* **************************************************************************
2711 : *
2712 : * Function name: word_exists
2713 : * Synopsis: Check whether a given word is already defined in the
2714 : * Current mode -- relative to "Tokenizer-Escape" --
2715 : * and Scope into which definitions are being entered.
2716 : * Used for error-reporting.
2717 : *
2718 : * Inputs:
2719 : * Parameters:
2720 : * stat_name Word to look up
2721 : * where_pt1 Pointer to string, part 1 of 2,
2722 : * to display in result
2723 : * where_pt2 Pointer to string, part 2 of 2,
2724 : * to display in result
2725 : *
2726 : * Outputs:
2727 : * Returned Value: TRUE if the name exists.
2728 : * Supplied Pointers:
2729 : * *where_pt1 Result display string, part 1 of 2
2730 : * *where_pt2 Result display string, part 2 of 2
2731 : *
2732 : * Process Explanation:
2733 : * If the calling routine displays the result-display strings,
2734 : * it should follow-up with a call to show_node_start()
2735 : *
2736 : * Extraneous Remarks:
2737 : * This used to be a much heftier routine; now it's just
2738 : * a wrapper around lookup_word() .
2739 : *
2740 : **************************************************************************** */
2741 :
2742 : bool word_exists( char *stat_name, char **where_pt1, char **where_pt2 )
2743 11030 : {
2744 11030 : bool retval = FALSE;
2745 11030 : tic_hdr_t *found = lookup_word( stat_name, where_pt1, where_pt2 );
2746 :
2747 11030 : if ( found != NULL )
2748 : {
2749 174 : retval = TRUE;
2750 : }
2751 :
2752 11030 : return( retval);
2753 : }
2754 :
2755 : /* **************************************************************************
2756 : *
2757 : * Function name: warn_if_duplicate
2758 : * Synopsis: Check whether a given word is already defined in
2759 : * the current mode and issue a warning if it is.
2760 : *
2761 : * Inputs:
2762 : * Parameters:
2763 : * stat_name Word to check
2764 : * Global Variables:
2765 : * verbose_dup_warning Whether to run the check at all.
2766 : * Local Static Variables:
2767 : * do_not_overload FALSE if OVERLOAD is in effect.
2768 : *
2769 : * Outputs:
2770 : * Returned Value: NONE
2771 : * Local Static Variables:
2772 : * do_not_overload Restored to TRUE
2773 : * Printout:
2774 : * Warning message if a duplicate.
2775 : *
2776 : * Error Detection:
2777 : * None. This is merely an informative warning.
2778 : *
2779 : * Process Explanation:
2780 : * "Current mode" -- meaning, whether the tokenizer is operating
2781 : * in "Tokenizer Escape" mode or in normal tokenization mode --
2782 : * will be recognized by the word_exists() function.
2783 : *
2784 : * Extraneous Remarks:
2785 : * The OVERLOAD directive is our best shot at creating a more
2786 : * fine-grained way to temporarily bypass this test when
2787 : * deliberately overloading a name. It would be nice to have
2788 : * a mechanism, comparable to the classic
2789 : * WARNING @ WARNING OFF ..... WARNING !
2790 : * that could be applied to a range of definitions, but:
2791 : * (1) That would require more of a true FORTH infrastructure;
2792 : * hence, more effort than I am willing to invest, at
2793 : * this juncture, for such a small return,
2794 : * and
2795 : * (2) Most intentional-overloading ranges only cover a
2796 : * single definition anyway.
2797 : *
2798 : **************************************************************************** */
2799 :
2800 : void warn_if_duplicate( char *stat_name)
2801 10380 : {
2802 10380 : if ( verbose_dup_warning && do_not_overload )
2803 : {
2804 : char *where_pt1;
2805 : char *where_pt2;
2806 10319 : if ( word_exists( stat_name, &where_pt1, &where_pt2) )
2807 : {
2808 57 : tokenization_error( WARNING,
2809 : "Duplicate definition: %s already exists %s%s",
2810 : stat_name, where_pt1, where_pt2 );
2811 57 : show_node_start();
2812 : }
2813 : }
2814 10380 : do_not_overload = TRUE;
2815 10380 : }
2816 :
2817 :
2818 : /* **************************************************************************
2819 : *
2820 : * Function name: glob_not_allowed
2821 : * Synopsis: Print a Message that "XXX is not allowed."
2822 : * because Global Scope is in effect.
2823 : * Used from several places...
2824 : *
2825 : * Inputs:
2826 : * Parameters:
2827 : * severity Severity of the Message
2828 : * not_ignoring FALSE = "Ignoring", for the part of the
2829 : * message about "How It's being Handled"
2830 : * Global Variables:
2831 : * statbuf Disallowed word currently being processed
2832 : *
2833 : * Outputs:
2834 : * Returned Value: NONE
2835 : * Printout: Message of given severity.
2836 : *
2837 : **************************************************************************** */
2838 :
2839 : static void glob_not_allowed( int severity, bool not_ignoring)
2840 33 : {
2841 33 : tokenization_error( severity, "Global Scope is in effect; "
2842 : "%s not allowed. %s.\n",
2843 : strupr(statbuf),
2844 : not_ignoring ?
2845 : "Attempting to compensate.." :
2846 : "Ignoring" );
2847 33 : }
2848 :
2849 :
2850 : /* **************************************************************************
2851 : *
2852 : * Function name: not_in_dict
2853 : * Synopsis: Print the message "XXX is not in dictionary."
2854 : * Used from several places...
2855 : *
2856 : * Inputs:
2857 : * Parameters:
2858 : * stat_name Word that could not be processed
2859 : *
2860 : * Outputs:
2861 : * Returned Value: NONE
2862 : * Printout: Error message.
2863 : *
2864 : **************************************************************************** */
2865 :
2866 : static void not_in_dict( char *stat_name)
2867 289 : {
2868 289 : tokenization_error ( TKERROR,
2869 : "Word %s is not in dictionary.\n", stat_name);
2870 289 : }
2871 :
2872 : /* **************************************************************************
2873 : *
2874 : * Function name: tokenized_word_error
2875 : * Synopsis: Report an error when a word could not be processed
2876 : * by the tokenizer. Messages will vary...
2877 : *
2878 : * Inputs:
2879 : * Parameters:
2880 : * stat_name Word that could not be processed
2881 : * Global Variables:
2882 : * in_tokz_esc TRUE if tokenizer is in "Tokenizer Escape" mode.
2883 : *
2884 : * Outputs:
2885 : * Returned Value: NONE
2886 : * Printout: Error message. Possible Advisory about
2887 : *
2888 : * Error Detection:
2889 : * Error was detected by the calling routine...
2890 : *
2891 : * Process Explanation:
2892 : * If the tokenizer is in "Tokenizer Escape" mode, the word might
2893 : * be one that can be used in normal tokenization mode;
2894 : * Conversely, if the tokenizer is in normal-tokenization mode,
2895 : * the word might be one that can be used in the "Escape" mode.
2896 : * Or, the word is completely unknown.
2897 : * Recognizing the current mode is handled by word_exists()
2898 : * However, we need to test for the *converse* of the current mode,
2899 : * so before we call word_exists() we are going to save and
2900 : * invert the setting of in_tokz_esc (and afterwards, of
2901 : * course, restore it...)
2902 : *
2903 : **************************************************************************** */
2904 :
2905 : static void tokenized_word_error( char *stat_name)
2906 319 : {
2907 : char *where_pt1;
2908 : char *where_pt2;
2909 : bool found_somewhere;
2910 :
2911 319 : bool sav_in_tokz_esc = in_tokz_esc;
2912 319 : in_tokz_esc = INVERSE(sav_in_tokz_esc);
2913 :
2914 319 : found_somewhere = word_exists( stat_name, &where_pt1, &where_pt2);
2915 319 : if ( found_somewhere )
2916 : {
2917 30 : tokenization_error ( TKERROR, "The word %s is %s recognized "
2918 : "in tokenizer-escape mode.\n",
2919 : stat_name, sav_in_tokz_esc ? "not" : "only" );
2920 : } else {
2921 289 : not_in_dict( stat_name);
2922 : }
2923 :
2924 319 : if ( INVERSE(exists_in_ancestor( stat_name)) )
2925 : {
2926 261 : if ( found_somewhere && sav_in_tokz_esc )
2927 : {
2928 22 : tokenization_error(INFO,
2929 : "%s is defined %s%s", stat_name, where_pt1, where_pt2 );
2930 22 : show_node_start();
2931 : }
2932 : }
2933 :
2934 319 : in_tokz_esc = sav_in_tokz_esc;
2935 319 : }
2936 :
2937 :
2938 : /* **************************************************************************
2939 : *
2940 : * Function name: unresolved_instance
2941 : * Synopsis: Print the "unresolved instance" message
2942 : *
2943 : * Inputs:
2944 : * Parameters:
2945 : * severity Severity of the Message
2946 : * Local Static Variables:
2947 : * instance_filename File where "instance" invoked
2948 : * instance_lineno Line number where "instance" invoked
2949 : *
2950 : * Outputs:
2951 : * Returned Value: NONE
2952 : * Printout: Message.
2953 : *
2954 : * Error Detection:
2955 : * Error was detected by the calling routine...
2956 : *
2957 : **************************************************************************** */
2958 :
2959 : static void unresolved_instance( int severity)
2960 17 : {
2961 17 : tokenization_error( severity, "Unresolved \"INSTANCE\"" );
2962 17 : just_where_started( instance_filename, instance_lineno );
2963 17 : }
2964 :
2965 :
2966 : /* **************************************************************************
2967 : *
2968 : * Function name: modified_by_instance
2969 : * Synopsis: Print the "[not] modified by instance" message
2970 : *
2971 : * Inputs:
2972 : * Parameters:
2973 : * definer Internal token for the defining-word
2974 : * was_modded FALSE if "not modified..."
2975 : * Local Static Variables:
2976 : * instance_filename File where "instance" invoked
2977 : * instance_lineno Line number where "instance" invoked
2978 : *
2979 : * Outputs:
2980 : * Returned Value: NONE
2981 : * Printout: WARNING message.
2982 : *
2983 : * Error Detection:
2984 : * Error was detected by the calling routine...
2985 : *
2986 : **************************************************************************** */
2987 :
2988 : static void modified_by_instance( fwtoken definer, bool was_modded)
2989 19 : {
2990 19 : char *was_not = was_modded ? "was" : "not" ;
2991 : char *defn_type_name;
2992 :
2993 : /* No need to check the return value */
2994 19 : definer_name(definer, &defn_type_name);
2995 :
2996 19 : tokenization_error ( WARNING,
2997 : "%s definition %s modified by \"INSTANCE\"",
2998 : defn_type_name, was_not );
2999 19 : just_where_started( instance_filename, instance_lineno );
3000 19 : }
3001 :
3002 : /* **************************************************************************
3003 : *
3004 : * Function name: validate_instance
3005 : * Synopsis: If "instance" is in effect, check whether it is
3006 : * appropriate to the defining-word being called.
3007 : *
3008 : * Inputs:
3009 : * Parameters:
3010 : * definer Internal token for the defining-word
3011 : * Local Static Variables:
3012 : * is_instance TRUE if "instance" is in effect.
3013 : * instance_definer_gap TRUE if invalid definer(s) invoked
3014 : * since "instance" went into effect.
3015 : *
3016 : * Outputs:
3017 : * Returned Value: NONE
3018 : * Local Static Variables:
3019 : * is_instance Reset to FALSE if definer was valid.
3020 : * instance_definer_gap TRUE if definer was not valid;
3021 : * FALSE if definer was valid.
3022 : *
3023 : * Error Detection:
3024 : * If "instance" is in effect, the only defining-words that are
3025 : * valid are: value variable defer or buffer: Attempts
3026 : * to use any other defining-word will be reported with a
3027 : * WARNING, but "instance" will remain in effect.
3028 : * If an invalid defining-word was invoked since "instance" went
3029 : * into effect, then, when it is finally applied to a valid
3030 : * definer, issue a WARNING.
3031 : *
3032 : * Process Explanation:
3033 : * Implicit in the Standard is the notion that, once INSTANCE has
3034 : * been executed, it remains in effect until a valid defining-
3035 : * word is encountered. We will do the same.
3036 : *
3037 : **************************************************************************** */
3038 :
3039 : static void validate_instance(fwtoken definer)
3040 10193 : {
3041 10193 : if ( is_instance )
3042 : {
3043 90 : bool is_error = TRUE ;
3044 :
3045 90 : switch ( definer)
3046 : {
3047 : case VALUE:
3048 : case VARIABLE:
3049 : case DEFER:
3050 : case BUFFER:
3051 80 : is_error = FALSE;
3052 : /* No default needed, likewise, no breaks; */
3053 : /* but some compilers get upset without 'em... */
3054 : default:
3055 : break;
3056 : }
3057 :
3058 90 : if( is_error )
3059 : {
3060 10 : modified_by_instance(definer, FALSE );
3061 10 : instance_definer_gap = TRUE;
3062 : }else{
3063 80 : if ( instance_definer_gap )
3064 : {
3065 9 : modified_by_instance(definer, TRUE );
3066 : }
3067 80 : is_instance = FALSE;
3068 80 : instance_definer_gap = FALSE;
3069 : }
3070 : }
3071 10193 : }
3072 :
3073 :
3074 : /* **************************************************************************
3075 : *
3076 : * Function name: trace_creation
3077 : * Synopsis: If the word being created is on the Trace List,
3078 : * display the appropriate message
3079 : *
3080 : * Inputs:
3081 : * Parameters:
3082 : * definer Internal token for the defining-word
3083 : * nu_name The word being created
3084 : * Global Variables:
3085 : * verbose No point in doing all this if we're
3086 : * not showing the message anyway...
3087 : * in_tokz_esc TRUE if we are in Tokenizer-Escape mode
3088 : * scope_is_global TRUE if "global" scope is in effect
3089 : * current_device_node Current dev-node data-struct
3090 : *
3091 : * Outputs:
3092 : * Returned Value: NONE
3093 : * Printout:
3094 : * Advisory Message, if the word is on the Trace List.
3095 : *
3096 : * Process Explanation:
3097 : * The order of scope-checking is important:
3098 : * A Local has no scope beyond the definition in which it occurs.
3099 : * Tokenizer-Escape mode supercedes "Normal" mode, and renders
3100 : * moot the differences between Global and Device scope.
3101 : * Global scope is mutually exclusive with Device scope.
3102 : * Device scope needs to identify where the Current device-node
3103 : * began.
3104 : *
3105 : **************************************************************************** */
3106 :
3107 : void trace_creation( fwtoken definer, char *nu_name)
3108 10665 : {
3109 10665 : if ( verbose )
3110 : {
3111 10665 : if ( is_on_trace_list( nu_name) )
3112 : {
3113 13 : char as_what[96] = "";
3114 13 : bool show_last_colon = BOOLVAL( definer == LOCAL_VAL);
3115 :
3116 13 : as_a_what( definer, as_what); /* No need to check return value. */
3117 :
3118 : /* Scope-checking starts here, unless show_last_colon is TRUE.
3119 : * Come out of this with as_what[] filled up and
3120 : * terminated with a new-line, if appropriate,
3121 : */
3122 13 : while ( ! show_last_colon )
3123 : {
3124 12 : strcat( as_what, " ");
3125 :
3126 12 : if ( in_tokz_esc )
3127 : {
3128 1 : strcat( as_what, in_tkz_esc_mode);
3129 1 : break;
3130 : }
3131 :
3132 11 : if ( scope_is_global )
3133 : {
3134 1 : strcat( as_what, "with Global scope.\n");
3135 : }else{
3136 : /* In Device scope. Show the Current node. */
3137 10 : strcat( as_what, in_what_node( current_device_node));
3138 : }
3139 : break;
3140 :
3141 : } /* Destination of BREAKs ... */
3142 :
3143 13 : tokenization_error(INFO, "Creating %s %s", nu_name, as_what);
3144 :
3145 13 : if ( show_last_colon )
3146 : {
3147 1 : in_last_colon();
3148 : }else{
3149 12 : show_node_start();
3150 : }
3151 :
3152 : }
3153 : }
3154 10665 : }
3155 :
3156 : /* **************************************************************************
3157 : *
3158 : * Function name: create_word
3159 : * Synopsis:
3160 : *
3161 : * Inputs:
3162 : * Parameters:
3163 : * definer Internal token for the defining-word
3164 : * Global Variables:
3165 : * control_stack_depth Number of "Control Stack" entries in effect
3166 : * nextfcode FCode-number to be assigned to the new name
3167 : * statbuf Symbol last read from the input stream
3168 : * pc Input-source Scanning pointer
3169 : * hdr_flag State of headered-ness for name-creation
3170 : * force_tokens_case If TRUE, force token-names' case in FCode
3171 : * force_lower_case_tokens
3172 : * If force_tokens_case is TRUE, this
3173 : * determines which case to force
3174 : * iname Input-source file name; for error-reporting
3175 : * lineno Input-source Line number; also for err-rep't
3176 : *
3177 : * Outputs:
3178 : * Returned Value: TRUE if successful
3179 : * Global Variables:
3180 : * nextfcode Incremented (by bump_fcode() )
3181 : * statbuf Advanced to next symbol; must be re-read
3182 : * pc Advanced, then restored to previous value
3183 : * Memory Allocated
3184 : * Copy of the name being defined, by support routine.
3185 : * Copy of input-source file name, for error-reporting
3186 : * When Freed?
3187 : * Copy of name being defined is freed when Current Device Vocab
3188 : * is "finished", or at end of tokenization.
3189 : * Copy of input-source file name is freed at end of this routine.
3190 : *
3191 : * Error Detection:
3192 : * ERROR if already inside a colon-definition. Discontinue
3193 : * processing and return FALSE.
3194 : * ERROR if inside a control-structure. Continue processing,
3195 : * though, to catch other errors, and even return TRUE;
3196 : * except: leave the new token undefined.
3197 : * Warning on duplicate name (subject to command-line control)
3198 : * Message if name is excessively long; Warning if headerless.
3199 : * FATAL if the value of nextfcode is larger than the legal
3200 : * maximum for an FCode, (0x0fff).
3201 : *
3202 : * Revision History:
3203 : * Updated Thu, 24 Mar 2005 by David L. Paktor
3204 : * Optional warning when name about to be created is a
3205 : * duplicate of an existing name.
3206 : * Updated Wed, 30 Mar 2005 by David L. Paktor
3207 : * Warning when name length exceeds ANSI-specified max (31 chars).
3208 : * Updated Tue, 05 Apr 2005 by David L. Paktor
3209 : * Add "definer" parameter and call to add_definer() . Part
3210 : * of the mechanism to forbid attempts to use the TO
3211 : * directive to change values of CONSTANTs in particular
3212 : * and of inappropriate targets in general.
3213 : * Updated Fri, 06 May 2005 by David L. Paktor
3214 : * Error-detection of DO ... LOOP and BEGIN ... imbalance
3215 : * Error-detection of nextfcode exceeding legal maximum (0x0fff).
3216 : * Updated Wed, 20 Jul 2005 by David L. Paktor
3217 : * Put Duplicate-Name-Test under command-line control...
3218 : * Updated Wed, 24 Aug 2005 by David L. Paktor
3219 : * Error-detection via clear_control_structs() routine.
3220 : * Updated Tue, 10 Jan 2006 by David L. Paktor
3221 : * Convert to tic_hdr_t type vocabulary.
3222 : * Updated Thu, 20 Apr 2006 by David L. Paktor
3223 : * Allow creation of new definition within body of a flow-control
3224 : * structure. (Remove error-detection via clear_control_structs)
3225 : * Updated Tue, 13 Jun 2006 by David L. Paktor
3226 : * Move detection of out-of-bounds nextfcode to assigning_fcode()
3227 : * routine, which also detects Overlapping Ranges error.
3228 : * Updated Thu, 27 Jun 2006 by David L. Paktor
3229 : * Report Error for attempt to create def'n inside control structure.
3230 : *
3231 : * Extraneous Remarks:
3232 : * We must not set incolon to TRUE (if we are creating a colon
3233 : * definition) until *AFTER* this routine has been called, due
3234 : * to the initial error-checking. If we need to detect whether
3235 : * we are creating a colon definition, we can do so by testing
3236 : * whether the parameter, DEFINER, equals COLON .
3237 : *
3238 : **************************************************************************** */
3239 :
3240 : static bool create_word(fwtoken definer)
3241 9982 : {
3242 : signed long wlen;
3243 9982 : bool retval = FALSE;
3244 : char *defn_type_name;
3245 :
3246 : /* If already inside a colon, ERROR and discontinueprocessing */
3247 : /* If an alias to a definer is used, show the name of the alias */
3248 9982 : if ( test_in_colon(statbuf, FALSE, TKERROR, NULL) )
3249 : {
3250 9979 : char defn_type_buffr[32] = "";
3251 9979 : unsigned int old_lineno = lineno; /* For error message */
3252 9979 : bool define_token = TRUE;
3253 :
3254 : { /* Set up definition-type text for error-message */
3255 :
3256 : /* No need to check the return value */
3257 9979 : definer_name(definer, &defn_type_name);
3258 :
3259 9979 : strcat( defn_type_buffr, defn_type_name);
3260 9979 : strcat( defn_type_buffr, " definition");
3261 : }
3262 : /* If in a control-structure, ERROR but continue processing */
3263 9979 : if ( control_stack_depth != 0 )
3264 : {
3265 17 : announce_control_structs( TKERROR, defn_type_buffr, 0);
3266 : /* Leave the new token undefined. */
3267 17 : define_token = FALSE;
3268 : }
3269 :
3270 : /* Get the name of the new token */
3271 9979 : wlen = get_word();
3272 :
3273 : #ifdef DEBUG_SCANNER
3274 : printf("%s:%d: debug: defined new word %s, fcode no 0x%x\n",
3275 : iname, lineno, name, nextfcode);
3276 : #endif
3277 9979 : if ( wlen <= 0 )
3278 : {
3279 0 : warn_unterm( TKERROR, defn_type_buffr, old_lineno);
3280 : }else{
3281 9979 : bool emit_token_name = TRUE;
3282 :
3283 : /* Handle Tracing of new definitions */
3284 9979 : trace_creation( definer, statbuf);
3285 :
3286 : /* Other Error or Warnings as applicable */
3287 9979 : validate_instance( definer);
3288 9979 : warn_if_duplicate( statbuf);
3289 9979 : check_name_length( wlen);
3290 :
3291 : /* Bump FCode; error-check as applicable */
3292 9979 : assigning_fcode();
3293 :
3294 : /* Define the new token, unless disallowed */
3295 9978 : add_to_current( statbuf, nextfcode, definer, define_token);
3296 :
3297 : /* Emit appropriate FCodes: Type of def'n, */
3298 9978 : switch ( hdr_flag )
3299 : {
3300 : case FLAG_HEADERS:
3301 9872 : emit_token("named-token");
3302 9872 : break;
3303 :
3304 : case FLAG_EXTERNAL:
3305 19 : emit_token("external-token");
3306 19 : break;
3307 :
3308 : default: /* FLAG_HEADERLESS */
3309 87 : emit_token("new-token");
3310 87 : emit_token_name = FALSE;
3311 : }
3312 :
3313 : /* Emit name of token, if applicable */
3314 9978 : if ( emit_token_name )
3315 : {
3316 9891 : if ( force_tokens_case )
3317 : {
3318 16 : if ( force_lower_case_tokens )
3319 : {
3320 15 : strlwr( statbuf);
3321 : }else{
3322 1 : strupr( statbuf);
3323 : }
3324 : }
3325 9891 : emit_string((u8 *)statbuf, wlen);
3326 : }
3327 :
3328 : /* Emit the new token's FCode */
3329 9978 : emit_fcode(nextfcode);
3330 :
3331 : /* Prepare FCode Assignment Counter for next definition */
3332 9978 : bump_fcode();
3333 :
3334 : /* Declare victory */
3335 9978 : retval = TRUE;
3336 : }
3337 : }
3338 9981 : return( retval);
3339 : }
3340 :
3341 :
3342 : /* **************************************************************************
3343 : *
3344 : * Function name: cannot_apply
3345 : * Synopsis: Print error message of the form:
3346 : * "Cannot apply <func> to <targ>, which is a <def'n>"
3347 : *
3348 : * Inputs:
3349 : * Parameters:
3350 : * func_nam The name of the function
3351 : * targ_nam The name of the target
3352 : * defr The numeric-code of the definer-type
3353 : *
3354 : * Outputs:
3355 : * Returned Value: NONE
3356 : * Printout:
3357 : * The error message is the entire printout of this routine
3358 : *
3359 : * Error Detection:
3360 : * Error was detected by calling routine
3361 : *
3362 : * Process Explanation:
3363 : * The calling routine already looked up the definer for its
3364 : * own purposes, so we don't need to do that again here.
3365 : *
3366 : * Still to be done:
3367 : * If the definer-name is not found, we might still look up
3368 : * the target name in the various vocabularies and use
3369 : * a phrase for those. E.g., if it is a valid token,
3370 : * we could say it's defined as a "primitive". (I'm
3371 : * not sure what we'd say about an FWord...)
3372 : *
3373 : **************************************************************************** */
3374 :
3375 : static void cannot_apply( char *func_nam, char *targ_nam, fwtoken defr)
3376 32 : {
3377 32 : char *defr_name = "" ;
3378 32 : const char *defr_phrase = ", which is defined as a " ;
3379 :
3380 32 : if ( ! definer_name(defr, &defr_name) )
3381 : {
3382 13 : defr_phrase = "";
3383 : }
3384 :
3385 32 : tokenization_error ( TKERROR ,
3386 : "Cannot apply %s to %s %s%s.\n",
3387 : func_nam, targ_nam, defr_phrase, defr_name );
3388 :
3389 32 : }
3390 :
3391 :
3392 : /* **************************************************************************
3393 : *
3394 : * Function name: lookup_with_definer
3395 : * Synopsis: Return pointer to data-structure of named word,
3396 : * if it's valid in Current context, and supply its
3397 : * definer. If it's not valid in Current context,
3398 : * see if it might be a Local, and supply that definer.
3399 : *
3400 : * Inputs:
3401 : * Parameters:
3402 : * stat_name Name to look up
3403 : * *definr Pointer to place to put the definer.
3404 : *
3405 : * Outputs:
3406 : * Returned Value: Pointer to data-structure, or
3407 : * NULL if not in Current context.
3408 : * Supplied Pointers:
3409 : * *definr Definer; possibly LOCAL_VAL
3410 : *
3411 : * Process Explanation:
3412 : * If the name is not found in the Current context, and does not
3413 : * exist as a Local, *definr will remain unchanged.
3414 : *
3415 : * Extraneous Remarks:
3416 : * This is an odd duck^H^H^H^H^H^H^H^H^H^H^H^H a highly-specialized
3417 : * routine created to meet some corner-case needs engendered by
3418 : * the conversion to tic_hdr_t vocabularies all around, combined
3419 : * with an obsessive urge to preserve a high level of detail in
3420 : * our error-messages.
3421 : *
3422 : **************************************************************************** */
3423 :
3424 : static tic_hdr_t *lookup_with_definer( char *stat_name, fwtoken *definr )
3425 258 : {
3426 258 : tic_hdr_t *retval = lookup_current( stat_name);
3427 258 : if ( retval != NULL )
3428 : {
3429 251 : *definr = retval->fword_defr;
3430 : }else{
3431 7 : if ( exists_as_local( stat_name) ) *definr = LOCAL_VAL;
3432 : }
3433 258 : return ( retval );
3434 : }
3435 :
3436 : /* **************************************************************************
3437 : *
3438 : * Function name: validate_to_target
3439 : * Synopsis: Print a message if the intended target
3440 : * of the TO directive is not valid
3441 : *
3442 : * Inputs:
3443 : * Parameters: NONE
3444 : * Global Variables:
3445 : * statbuf Next symbol to be read from the input stream
3446 : * pc Input-source Scanning pointer
3447 : *
3448 : * Outputs:
3449 : * Returned Value: TRUE = Allow b(to) token to be output.
3450 : * Global Variables:
3451 : * statbuf Advanced to next symbol; must be re-read
3452 : * pc Advanced, then restored to previous value
3453 : *
3454 : * Error Detection:
3455 : * If next symbol is not a valid target of TO , issue ERROR
3456 : * message. Restored pc will cause the next symbol to
3457 : * be processed by ordinary means.
3458 : * Allow b(to) token to be output in selected cases. Even if
3459 : * user has set the "Ignore Errors" flag, certain targets are
3460 : * still too risky to be allowed to follow a b(to) token;
3461 : * if "Ignore Errors" is not set, output won't get created
3462 : * anyway.
3463 : * Issue ERROR in the extremely unlikely case that "to" is the
3464 : * last word in the Source.
3465 : *
3466 : * Process Explanation:
3467 : * Valid targets for a TO directive are words defined by:
3468 : * DEFER, VALUE and arguably VARIABLE. We will also allow
3469 : * CONSTANT, but will still issue an Error message.
3470 : * After the check, restore pc ; this was only a look-ahead.
3471 : * Also restore lineno and abs_token_no
3472 : *
3473 : * Extraneous Remarks:
3474 : * Main part of the mechanism to detect attempts to use the TO
3475 : * directive to change the values of CONSTANTs in particular
3476 : * and of inappropriate targets in general.
3477 : *
3478 : **************************************************************************** */
3479 :
3480 : static bool validate_to_target( void )
3481 202 : {
3482 : signed long wlen;
3483 : tic_hdr_t *test_entry;
3484 202 : u8 *saved_pc = pc;
3485 202 : char *cmd_cpy = strupr( strdup( statbuf)); /* For error message */
3486 202 : unsigned int saved_lineno = lineno;
3487 202 : unsigned int saved_abs_token_no = abs_token_no;
3488 202 : fwtoken defr = UNSPECIFIED ;
3489 202 : bool targ_err = TRUE ;
3490 202 : bool retval = FALSE ;
3491 :
3492 202 : wlen = get_word();
3493 202 : if ( wlen <= 0 )
3494 : {
3495 1 : warn_unterm( TKERROR, cmd_cpy, saved_lineno);
3496 : }else{
3497 :
3498 201 : test_entry = lookup_with_definer( statbuf, &defr);
3499 201 : if ( test_entry != NULL )
3500 : {
3501 197 : switch (defr)
3502 : {
3503 : case VARIABLE:
3504 7 : tokenization_error( WARNING,
3505 : "Applying %s to a VARIABLE (%s) is "
3506 : "not recommended; use ! instead.\n",
3507 : cmd_cpy, statbuf);
3508 : case DEFER:
3509 : case VALUE:
3510 177 : targ_err = FALSE ;
3511 : case CONST:
3512 179 : retval = TRUE ;
3513 : /* No default needed, likewise, no breaks; */
3514 : /* but some compilers get upset without 'em... */
3515 : default:
3516 : break;
3517 : }
3518 : }
3519 :
3520 201 : if ( targ_err )
3521 : {
3522 24 : cannot_apply(cmd_cpy, strupr(statbuf), defr );
3523 : }
3524 :
3525 201 : pc = saved_pc;
3526 201 : lineno = saved_lineno;
3527 201 : abs_token_no = saved_abs_token_no;
3528 : }
3529 202 : free( cmd_cpy);
3530 202 : return( retval);
3531 : }
3532 :
3533 :
3534 : /* **************************************************************************
3535 : *
3536 : * Function name: you_are_here
3537 : * Synopsis: Display a generic Advisory of the Source command
3538 : * or directive encountered and being processed
3539 : *
3540 : * Inputs:
3541 : * Parameters: NONE
3542 : * Global Variables:
3543 : * statbuf The command being processed
3544 : *
3545 : * Outputs:
3546 : * Returned Value: NONE
3547 : * Printout:
3548 : * Advisory message
3549 : *
3550 : **************************************************************************** */
3551 :
3552 : static void you_are_here( void)
3553 335 : {
3554 335 : tokenization_error( INFO,
3555 : "%s encountered; processing...\n",
3556 : strupr(statbuf) );
3557 335 : }
3558 :
3559 :
3560 : /* **************************************************************************
3561 : *
3562 : * Function name: fcode_starter
3563 : * Synopsis: Respond to one of the "FCode Starter" words
3564 : *
3565 : * Inputs:
3566 : * Parameters:
3567 : * token_name The FCode-token for this "Starter" word
3568 : * spread The separation between tokens.
3569 : * is_offs16 Whether we are using a 16-bit number
3570 : * for branch- (and suchlike) -offsets,
3571 : * or the older-style 8-bit offset numbers.
3572 : * Global Variables:
3573 : * iname Input-File name, used to set ifile_name
3574 : * field of current_device_node
3575 : * lineno Current Input line number, used to set
3576 : * line_no field of current_device_node
3577 : * Local Static Variables:
3578 : * fcode_started If this is TRUE, we have an Error.
3579 : * first_fc_starter Control calling reset_fcode_ranges() ;
3580 : * only on the first fcode_starter of
3581 : * a tokenization.
3582 : *
3583 : * Outputs:
3584 : * Returned Value: NONE
3585 : * Global Variables:
3586 : * offs16 Global "16-bit-offsets" flag
3587 : * current_device_node The ifile_name and line_no fields will be
3588 : * loaded with the current input file name
3589 : * and line number. This node will be the
3590 : * top-level device-node.
3591 : * FCode Ranges will be reset the first time per tokenization
3592 : * that this routine is entered.
3593 : * A new FCode Range will be started every time after that.
3594 : * Local Static Variables:
3595 : * fcode_started Set to TRUE. We invoke the starter only
3596 : * once per image-block.
3597 : * first_fc_starter Reset to FALSE if not already
3598 : * Memory Allocated
3599 : * Duplicate of Input-File name
3600 : * When Freed?
3601 : * In fcode_ender()
3602 : *
3603 : * Error Detection:
3604 : * Spread of other than 1 -- Warning message.
3605 : * "FCode Starter" previously encountered -- Warning and ignore.
3606 : *
3607 : * Question under consideration:
3608 : * Do we want directives -- such as definitions of constants --
3609 : * supplied before the "FCode Starter", to be considered as
3610 : * taking place in "Tokenizer Escape" mode? That would mean
3611 : * the "Starter" functions must be recognized in "Tokenizer
3612 : * Escape" mode. Many ramifications to be thought through...
3613 : * I think I'm coming down strongly on the side of "No". The user
3614 : * who wants to do that can very well invoke "Tokenizer Escape"
3615 : * mode explicitly.
3616 : *
3617 : **************************************************************************** */
3618 :
3619 : static void fcode_starter( const char *token_name, int spread, bool is_offs16)
3620 170 : {
3621 170 : you_are_here();
3622 170 : if ( spread != 1 )
3623 : {
3624 0 : tokenization_error( WARNING, "spread of %d not supported.\n", spread);
3625 : }
3626 170 : if ( fcode_started )
3627 : {
3628 0 : tokenization_error( WARNING,
3629 : "Only one \"FCode Starter\" permitted per tokenization. "
3630 : "Ignoring...\n");
3631 : } else {
3632 :
3633 170 : emit_fcodehdr(token_name);
3634 170 : offs16 = is_offs16;
3635 170 : fcode_started = TRUE;
3636 :
3637 170 : current_device_node->ifile_name = strdup(iname);
3638 170 : current_device_node->line_no = lineno;
3639 :
3640 170 : if ( first_fc_starter )
3641 : {
3642 141 : reset_fcode_ranges();
3643 141 : first_fc_starter = FALSE;
3644 : }else{
3645 29 : set_next_fcode( nextfcode);
3646 : }
3647 : }
3648 170 : }
3649 :
3650 : /* **************************************************************************
3651 : *
3652 : * Function name: fcode_end_err_check
3653 : * Synopsis: Do error-checking at end of tokenization,
3654 : * whether due to FCODE-END or end-of-file,
3655 : * and reset the indicators we check.
3656 : *
3657 : * Inputs:
3658 : * Parameters: NONE
3659 : * Global Variables:
3660 : * Data-Stack depth Is anything left on the stack?
3661 : *
3662 : * Outputs:
3663 : * Returned Value: NONE
3664 : * Global Variables:
3665 : * Data-Stack Reset to empty
3666 : *
3667 : * Error Detection:
3668 : * Unresolved control structures detected by clear_control_structs()
3669 : * If anything is left on the stack, it indicates some incomplete
3670 : * condition; we will treat it as a Warning.
3671 : *
3672 : **************************************************************************** */
3673 :
3674 : static void fcode_end_err_check( void)
3675 170 : {
3676 170 : bool stack_imbal = BOOLVAL( stackdepth() != 0 );
3677 :
3678 170 : if ( stack_imbal )
3679 : {
3680 13 : tokenization_error( WARNING,
3681 : "Stack imbalance before end of tokenization.\n");
3682 : }
3683 170 : clear_stack();
3684 170 : clear_control_structs("End of tokenization");
3685 170 : }
3686 :
3687 : /* **************************************************************************
3688 : *
3689 : * Function name: fcode_ender
3690 : * Synopsis: Respond to one of the "FCode Ender" words:
3691 : * The FCode-token for "End0" or "End1"
3692 : * has already been written to the
3693 : * FCode Output buffer.
3694 : * Finish the FCode header: fill in its
3695 : * checksum and length.
3696 : * Reset the token names defined in "normal" mode
3697 : * (Does not reset the FCode-token number)
3698 : *
3699 : * Associated FORTH words: END0, END1
3700 : * Associated Tokenizer directive: FCODE-END
3701 : *
3702 : * Inputs:
3703 : * Parameters: NONE
3704 : * Global Variables:
3705 : * incolon If TRUE, a colon def'n has not been completed
3706 : * last_colon_filename For error message.
3707 : * last_colon_lineno For error message.
3708 : * scope_is_global For error detection
3709 : * is_instance For error detection
3710 : *
3711 : * Outputs:
3712 : * Returned Value: NONE
3713 : * Global Variables:
3714 : * haveend Set to TRUE
3715 : * fcode_started Reset to FALSE. Be ready to start anew.
3716 : * FCode-defined tokens, aliases and macros -- i.e., those
3717 : * *NOT* defined in tokenizer-escape mode -- are reset.
3718 : * (Also, command-line-defined symbols are preserved).
3719 : * Vocabularies will be reset
3720 : * Device-node data structures will be deleted
3721 : * Top-level device-node ifile_name and line_no fields
3722 : * will be reset.
3723 : * Memory Freed
3724 : * Duplicate of Input-File name, in top-level device-node.
3725 : * Printout:
3726 : * Advisory message giving current value of nextfcode
3727 : * (the "FCode-token Assignment Counter")
3728 : *
3729 : * Error Detection:
3730 : * ERROR if a Colon definition has not been completed.
3731 : * ERROR if "instance" is still in effect
3732 : * WARNING if Global-Scope has not been terminated; compensate.
3733 : *
3734 : * Extraneous Remarks:
3735 : * In order to accommodate odd cases, such as multiple FCode blocks
3736 : * within a single PCI header, this routine does not automatically
3737 : * reset nextfcode to h# 0800
3738 : *
3739 : **************************************************************************** */
3740 :
3741 : void fcode_ender(void)
3742 170 : {
3743 170 : if ( incolon )
3744 : {
3745 3 : char *tmp_iname = iname;
3746 3 : iname = last_colon_filename;
3747 3 : unterm_is_colon = TRUE;
3748 3 : warn_unterm( TKERROR, "Colon Definition", last_colon_lineno);
3749 3 : iname = tmp_iname;
3750 : }
3751 :
3752 170 : haveend = TRUE;
3753 :
3754 170 : if ( is_instance )
3755 : {
3756 2 : unresolved_instance( TKERROR);
3757 : }
3758 :
3759 170 : if ( scope_is_global )
3760 : {
3761 6 : tokenization_error( WARNING ,
3762 : "No DEVICE-DEFINITIONS directive encountered before end. "
3763 : "Compensating...\n");
3764 6 : resume_device_scope();
3765 : }
3766 170 : fcode_end_err_check();
3767 170 : reset_normal_vocabs();
3768 170 : finish_fcodehdr();
3769 170 : fcode_started = FALSE;
3770 :
3771 170 : if ( current_device_node->ifile_name != default_top_dev_ifile_name )
3772 : {
3773 169 : free( current_device_node->ifile_name );
3774 169 : current_device_node->ifile_name = default_top_dev_ifile_name;
3775 169 : current_device_node->line_no = 0;
3776 : }
3777 170 : }
3778 :
3779 : /* **************************************************************************
3780 : *
3781 : * Function name: get_token
3782 : * Synopsis: Read the next word in the input stream and retrieve
3783 : * its FCode-token number. If it's not a symbol to
3784 : * which a single token is assigned (e.g., if it's
3785 : * a macro), report an error.
3786 : *
3787 : * Associated FORTH words: ['] '
3788 : * Associated Tokenizer directive: F[']
3789 : *
3790 : * Inputs:
3791 : * Parameters:
3792 : * *tok_entry Place to put the pointer to token entry
3793 : * Global Variables:
3794 : * statbuf The command being processed
3795 : * pc Input stream character pointer
3796 : *
3797 : * Outputs:
3798 : * Returned Value: TRUE if successful (i.e., no error)
3799 : * Supplied Pointers:
3800 : * *tok_entry The token entry, if no error
3801 : * Global Variables:
3802 : * statbuf The next word in the input stream
3803 : * pc Restored to previous value if error
3804 : *
3805 : * Error Detection:
3806 : * The next word in the input stream is expected to be on the
3807 : * same line as the directive. The get_word_in_line()
3808 : * routine will check for that.
3809 : * If the next word in the input stream is not a symbol
3810 : * for which a single-token FCode number is assigned,
3811 : * report an ERROR and restore PC to its previous value.
3812 : *
3813 : **************************************************************************** */
3814 :
3815 : static bool get_token(tic_hdr_t **tok_entry)
3816 58 : {
3817 58 : bool retval = FALSE;
3818 : u8 *save_pc;
3819 :
3820 : /* Copy of command being processed, for error message */
3821 : char cmnd_cpy[FUNC_CPY_BUF_SIZE+1];
3822 58 : strncpy( cmnd_cpy, statbuf, FUNC_CPY_BUF_SIZE);
3823 58 : cmnd_cpy[FUNC_CPY_BUF_SIZE] = 0; /* Guarantee null terminator. */
3824 :
3825 58 : save_pc = pc;
3826 :
3827 58 : if ( get_word_in_line( statbuf) )
3828 : {
3829 57 : fwtoken defr = UNSPECIFIED;
3830 :
3831 : /* We need to scan the newest definitions first; they
3832 : * might supercede standard ones. We need, though,
3833 : * to bypass built-in FWords that need to trigger
3834 : * some tokenizer internals before emitting their
3835 : * synonymous FCode Tokens, (e.g., version1 , end0 ,
3836 : * and start{0-4}); if we find one of those, we will
3837 : * need to search again, specifically within the list
3838 : * of FCode Tokens.
3839 : */
3840 57 : *tok_entry = lookup_with_definer( statbuf, &defr);
3841 57 : if ( *tok_entry != NULL )
3842 : {
3843 : /* Built-in FWords can be uniquely identified by their
3844 : * definer, BI_FWRD_DEFN . The definer for "shared"
3845 : * FWords is COMMON_FWORD but there are none of
3846 : * those that might be synonymous with legitimate
3847 : * FCode Tokens, nor are any likely ever to be...
3848 : */
3849 54 : if ( defr == BI_FWRD_DEFN )
3850 : {
3851 11 : *tok_entry = lookup_token( statbuf);
3852 11 : retval = BOOLVAL( *tok_entry != NULL );
3853 : }else{
3854 43 : retval = entry_is_token( *tok_entry);
3855 : }
3856 : }
3857 :
3858 57 : if ( INVERSE( retval) )
3859 : {
3860 8 : cannot_apply( cmnd_cpy, strupr(statbuf), defr );
3861 8 : pc = save_pc;
3862 : }
3863 : }
3864 :
3865 58 : return ( retval );
3866 : }
3867 :
3868 :
3869 : static void base_change ( int new_base )
3870 93 : {
3871 95 : if ( incolon && ( INVERSE( in_tokz_esc) ) )
3872 : {
3873 2 : emit_literal(new_base );
3874 2 : emit_token("base");
3875 2 : emit_token("!");
3876 : } else {
3877 91 : base = new_base;
3878 : }
3879 93 : }
3880 :
3881 : static void base_val (int new_base)
3882 341 : {
3883 : u8 *old_pc;
3884 :
3885 : char base_cmnd[FUNC_CPY_BUF_SIZE+1];
3886 341 : strncpy( base_cmnd, statbuf, FUNC_CPY_BUF_SIZE);
3887 341 : base_cmnd[FUNC_CPY_BUF_SIZE] = 0; /* Guarantee NULL terminator */
3888 :
3889 341 : old_pc=pc;
3890 341 : if ( get_word_in_line( statbuf) )
3891 : {
3892 341 : u8 basecpy=base;
3893 :
3894 341 : base = new_base;
3895 341 : if ( ! handle_number() )
3896 : {
3897 : /* We did get a word on the line, but it's not a valid number */
3898 6 : tokenization_error( WARNING ,
3899 : "Applying %s to non-numeric value. Ignoring.\n",
3900 : strupr(base_cmnd) );
3901 6 : pc = old_pc;
3902 : }
3903 341 : base=basecpy;
3904 : }
3905 341 : }
3906 :
3907 :
3908 : /* **************************************************************************
3909 : *
3910 : * Function name: eval_string
3911 : * Synopsis: Prepare to tokenize a string, artificially generated
3912 : * by this program or created as a user-defined
3913 : * Macro. When done, resume at existing source.
3914 : * Keep the file-name and line-number unchanged.
3915 : *
3916 : * Inputs:
3917 : * Parameters:
3918 : * inp_bufr String (or buffer) to evaluate
3919 : *
3920 : * Outputs:
3921 : * Returned Value: NONE
3922 : * Global Variables, changed by call to init_inbuf():
3923 : * start Points to given string
3924 : * pc ditto
3925 : * end Points to end of given string
3926 : *
3927 : * Revision History:
3928 : * Updated Thu, 23 Feb 2006 by David L. Paktor
3929 : * This routine no longer calls its own instance of tokenize()
3930 : * It has become the gateway to the mechanism that makes a
3931 : * smooth transition between the body of the Macro, User-
3932 : * defined Symbol or internally-generated string and the
3933 : * resumption of processing the source file.
3934 : * A similar (but more complicated) transition when processing
3935 : * an FLOADed file will be handled elsewhere.
3936 : * Updated Fri, 24 Feb 2006 by David L. Paktor
3937 : * In order to support Macro-recursion protection, this routine
3938 : * is no longer the gateway for Macros; they will have to
3939 : * call push_source() directly.
3940 : *
3941 : **************************************************************************** */
3942 :
3943 : void eval_string( char *inp_bufr)
3944 834 : {
3945 834 : push_source( NULL, NULL, FALSE);
3946 834 : init_inbuf( inp_bufr, strlen(inp_bufr));
3947 834 : }
3948 :
3949 :
3950 : /* **************************************************************************
3951 : *
3952 : * Function name: finish_or_new_device
3953 : * Synopsis: Handle the shared logic for the NEW-DEVICE and
3954 : * FINISH-DEVICE commands.
3955 : *
3956 : * Inputs:
3957 : * Parameters:
3958 : * finishing_device TRUE for FINISH-DEVICE,
3959 : * FALSE for NEW-DEVICE
3960 : * Global Variables:
3961 : * incolon TRUE if inside a colon definition
3962 : * noerrors TRUE if ignoring errors
3963 : * scope_is_global TRUE if "global scope" in effect
3964 : * Local Static Variables:
3965 : * is_instance TRUE if "instance" is in effect
3966 : * dev_change_instance_warning TRUE if warning hasn't been issued
3967 : *
3968 : * Outputs:
3969 : * Returned Value: NONE
3970 : * Local Static Variables:
3971 : * dev_change_instance_warning FALSE if warning is issued
3972 : * instance_definer_gap TRUE if "instance" is in effect
3973 : *
3974 : * Error Detection:
3975 : * NEW-DEVICE and FINISH-DEVICE should not be used outside of
3976 : * a colon-definition if global-scope is in effect. Error
3977 : * message; no further action unless we are ignoring errors.
3978 : * Issue a WARNING if INSTANCE wasn't resolved before the current
3979 : * device-node is changed. Try not to be too repetitive...
3980 : *
3981 : * Process Explanation:
3982 : * The words NEW-DEVICE and FINISH-DEVICE may be incorporated into
3983 : * a colon-definition, whether the word is defined in global-
3984 : * or device- -scope. Such an incorporation does not effect
3985 : * a change in the device-node vocabulary; simply emit the token.
3986 : * If we are in interpretation mode, though, we need to check for
3987 : * errors before changing the device-node vocabulary:
3988 : * If global-scope is in effect, we need to check whether we are
3989 : * ignoring errors; if so, we will compensate by switching to
3990 : * device-scope.
3991 : * If "instance" is in effect, it's "dangling". It will remain
3992 : * in effect through a device-node change, but this is very
3993 : * bad style and deserves a WARNING, but only one for each
3994 : * occurrence. It would be unaesthetic, to say the least,
3995 : * to have multiple messages for the same dangling "instance"
3996 : * in a "finish-device new-device" sequence.
3997 : * We must be careful about the order we do things, because of
3998 : * the messages printed as a side-effect of the node change...
3999 : *
4000 : * Extraneous Remarks:
4001 : * I will violate strict structure here.
4002 : *
4003 : **************************************************************************** */
4004 :
4005 : static void finish_or_new_device( bool finishing_device )
4006 177 : {
4007 177 : if ( INVERSE( incolon ) )
4008 : {
4009 169 : if ( INVERSE( is_instance) )
4010 : {
4011 : /* Arm warning for next time: */
4012 160 : dev_change_instance_warning = TRUE;
4013 : }else{
4014 : /* Dangling "instance" */
4015 9 : instance_definer_gap = TRUE;
4016 : /* Warn only once. */
4017 9 : if ( dev_change_instance_warning )
4018 : {
4019 9 : unresolved_instance( WARNING);
4020 9 : dev_change_instance_warning = FALSE;
4021 : }
4022 : }
4023 :
4024 : /* Note: "Instance" cannot be in effect during "global" scope */
4025 169 : if ( scope_is_global )
4026 : {
4027 11 : glob_not_allowed( TKERROR, noerrors );
4028 11 : if ( noerrors )
4029 : {
4030 8 : resume_device_scope();
4031 : }else{
4032 3 : return;
4033 : }
4034 : }
4035 :
4036 166 : if ( finishing_device )
4037 : {
4038 83 : finish_device_vocab();
4039 : }else{
4040 83 : new_device_vocab();
4041 : }
4042 : }
4043 174 : emit_token( finishing_device ? "finish-device" : "new-device" );
4044 : }
4045 :
4046 :
4047 : /* **************************************************************************
4048 : *
4049 : * Function name: abort_quote
4050 : * Synopsis: Optionally implement the ABORT" function as
4051 : * though it were a macro. Control whether to allow
4052 : * it, and which style to support, via switches set
4053 : * on the command-line at run-time.
4054 : *
4055 : * Inputs:
4056 : * Parameters:
4057 : * tok Numeric-code associated with the
4058 : * FORTH word that was just read.
4059 : * Global Variables:
4060 : * enable_abort_quote Whether to allow ABORT"
4061 : * sun_style_abort_quote SUN-style versus Apple-style
4062 : * abort_quote_throw Whether to use -2 THROW vs ABORT
4063 : *
4064 : * Outputs:
4065 : * Returned Value: TRUE if it was handled
4066 : * Global Variables:
4067 : * report_multiline Reset to FALSE.
4068 : * Printout:
4069 : * ADVISORY: ABORT" in fcode is not defined by IEEE 1275-1994
4070 : *
4071 : * Error Detection:
4072 : * Performed by other routines. If user selected not to
4073 : * allow ABORT" , it will simply be treated as an
4074 : * unknown word.
4075 : * The string following it, however, will still be consumed.
4076 : *
4077 : * Process Explanation:
4078 : * If the supplied tok was not ABORTTXT , then return FALSE.
4079 : * If the enable_abort_quote flag is FALSE, consume the
4080 : * string following the Abort" token, but be careful to
4081 : * leave the Abort" token in statbuf, as it will be used
4082 : * for the error message.
4083 : * Otherwise, create and prepare for processing the appropriate Macro:
4084 : * For Apple Style, we push the specified string onto the stack
4085 : * and do -2 THROW (and hope the stack unwinds correctly).
4086 : * For Sun Style, we test the condition on top of the stack,
4087 : * and if it's true, print the specified string before we
4088 : * do the -2 THROW.
4089 : * We perform the underlying operations directly: placing an "IF"
4090 : * (if Sun Style), then placing the string. This bypasses
4091 : * any issues of double-parsing, as well as of doubly checking
4092 : * for a multi-line string.
4093 : * Finally, we perform the operational equivalents of the remainder
4094 : * of the command sequence.
4095 : *
4096 : * Extraneous Remarks:
4097 : * I would have preferred not to have to directly perform the under-
4098 : * lying operations, and instead simply prepare the entire command
4099 : * sequence in a buffer, but I needed to handle the case where
4100 : * quote-escaped quotes are included in the string: If the string
4101 : * were simply to be reproduced into the buffer, the quote-escaped
4102 : * quotes would appear as plain quote-marks and terminate the
4103 : * string parsing prematurely, leaving the rest of the string
4104 : * to be treated as code instead of text...
4105 : * Also, the introduction of the variability of whether to do the
4106 : * -2 THROW or to compile-in the token for ABORT makes the
4107 : * buffer-interpretation scheme somewhat too messy for my tastes.
4108 : *
4109 : **************************************************************************** */
4110 :
4111 : static bool abort_quote( fwtoken tok)
4112 36 : {
4113 36 : bool retval = FALSE;
4114 36 : if ( tok == ABORTTXT )
4115 : {
4116 14 : if ( ! enable_abort_quote )
4117 : {
4118 : /* ABORT" is not enabled; we'd better consume the string */
4119 : char *save_statbuf;
4120 : signed long wlen;
4121 4 : save_statbuf = strdup( (char *)statbuf);
4122 4 : wlen = get_string( FALSE);
4123 4 : strcpy( statbuf, save_statbuf);
4124 4 : free( save_statbuf);
4125 : }else{
4126 : /* ABORT" is not to be used in FCODE drivers
4127 : * but Apple drivers do use it. Therefore we
4128 : * allow it. We push the specified string to
4129 : * the stack, do -2 THROW and hope that THROW
4130 : * will correctly unwind the stack.
4131 : * Presumably, Apple Source supplies its own
4132 : * IF ... THEN
4133 : */
4134 : char *abort_string;
4135 : signed long wlen;
4136 :
4137 10 : retval = TRUE;
4138 10 : tokenization_error (INFO, "ABORT\" in fcode not "
4139 : "defined by IEEE 1275-1994\n");
4140 10 : test_in_colon("ABORT\"", TRUE, TKERROR, NULL);
4141 10 : wlen=get_string( TRUE);
4142 :
4143 10 : if ( sun_style_abort_quote ) emit_if();
4144 :
4145 10 : emit_token("b(\")");
4146 10 : emit_string(statbuf, wlen);
4147 :
4148 10 : if ( sun_style_abort_quote ) emit_token("type");
4149 :
4150 10 : if ( abort_quote_throw )
4151 : {
4152 9 : emit_literal( -2);
4153 9 : emit_token("throw");
4154 : }else{
4155 1 : emit_token("abort");
4156 : }
4157 :
4158 10 : if ( sun_style_abort_quote ) emit_then();
4159 : /* Sun Style */
4160 10 : abort_string = " type -2 THROW THEN:" ;
4161 : }
4162 : }
4163 36 : return( retval );
4164 : }
4165 :
4166 :
4167 : /* **************************************************************************
4168 : *
4169 : * Function name: create_alias
4170 : * Synopsis: Create an alias, as specified by the user
4171 : *
4172 : * Associated FORTH word: ALIAS
4173 : *
4174 : * Inputs:
4175 : * Parameters: NONE
4176 : * Global Variables:
4177 : * incolon Colon-def'n-in-progress indicator
4178 : * in_tokz_esc "Tokenizer Escape" mode indicator
4179 : * Input Stream
4180 : * Two words will be read.
4181 : *
4182 : * Outputs:
4183 : * Returned Value: TRUE if succeeded.
4184 : * Global Variables:
4185 : * statbuf New name will be copied back into here.
4186 : * Memory Allocated
4187 : * The two words will be copied into freshly-allocated memory
4188 : * that will be passed to the create_..._alias() routine.
4189 : * When Freed?
4190 : * When Current Device Vocabulary is "finished", or at end
4191 : * of tokenization, or upon termination of program.
4192 : * If not able to create alias, the copies will be freed here.
4193 : *
4194 : * Error Detection:
4195 : * If the ALIAS command was given during colon-definition, that
4196 : * can be handled by this tokenizer, but it is not supported
4197 : * by IEEE 1275-1994. Issue a WARNING.
4198 : * If the new name is a copy of an existing word-name, issue a warning.
4199 : * If the word to which an alias is to be created does not exist
4200 : * in the appropriate mode -- relative to "Tokenizer-Escape" --
4201 : * that is an ERROR.
4202 : * If "instance" is in effect, the ALIAS command is an ERROR.
4203 : *
4204 : * Process Explanation:
4205 : * Get two words -- the new name and the "old" word -- from the
4206 : * same line of input as the ALIAS command.
4207 : * Copy the new name back into statbuf for use in trace_creation.
4208 : * Determine whether or not we are in "Tokenizer-Escape" mode.
4209 : * Subsequent searches will take place in that same mode.
4210 : * If the "new" name already exists, issue a warning.
4211 : * In each vocabulary applicable to the current mode -- i.e.,
4212 : * "Tokenizer-Escape" or "Normal" -- (except: cannot
4213 : * make aliases to "Locals"):
4214 : * Try using the create_..._alias() routine.
4215 : * If it succeeds, we are done.
4216 : * IMPORTANT: The order in which we try the vocabularies MUST
4217 : * match the order in which tokenize_one_word() searches them.
4218 : * If all the attempts failed, the "old" word does not exist;
4219 : * declare an ERROR and free up the memory that was allocated.
4220 : *
4221 : * Extraneous Remarks:
4222 : * With the separation of the tokenizer[ state, this
4223 : * function has become too complicated to keep as a
4224 : * simple CASE in the big SWITCH statement anymore...
4225 : *
4226 : * I had earlier thought that it was sufficient to create a
4227 : * macro linking the "new" name to the "old" word. There
4228 : * were too many cases, though, where that didn't work.
4229 : * This is cleaner.
4230 : *
4231 : * I will not be adhering to the strict rules of structure in
4232 : * this routine, as it would get me nested too deeply...
4233 : *
4234 : * Revision History:
4235 : * Updated Tue, 10 Jan 2006 by David L. Paktor
4236 : * Convert to tic_hdr_t type vocabularies.
4237 : *
4238 : **************************************************************************** */
4239 :
4240 : static bool create_alias( void )
4241 214 : {
4242 : char *new_alias ;
4243 :
4244 214 : validate_instance(ALIAS);
4245 214 : if ( incolon )
4246 : {
4247 20 : tokenization_error ( WARNING,
4248 : "ALIAS during colon-definition "
4249 : "is not supported by IEEE 1275-1994\n");
4250 : }
4251 214 : if ( get_word_in_line( "ALIAS") )
4252 : {
4253 :
4254 213 : new_alias = strdup((char *)statbuf);
4255 :
4256 213 : if (get_word_in_line( "ALIAS") )
4257 : {
4258 212 : char *old_name = strdup((char *)statbuf) ;
4259 :
4260 : /* Copy the "new" alias name back into statbuf.
4261 : * This is a HACK ^H^H^H^H awkward way to retrofit
4262 : * support for the trace_creation() function.
4263 : */
4264 212 : strcpy( statbuf, new_alias);
4265 :
4266 : /* We don't call trace_creation() here because we don't
4267 : * know if the creation succeeded. However, we want
4268 : * to issue a "Duplicate" warning based on the attempt,
4269 : * even if it doesn't succeed.
4270 : * We would prefer to have the "Trace" message precede the
4271 : * "Duplicate" warning, but we don't think it's worth
4272 : * the effort. When it becomes worthwhile, the way to
4273 : * do it would be to factor out the block that handles
4274 : * normal-tokenization versus "Tokenizer-Escape" mode;
4275 : * condition the "Trace" message on its success-return,
4276 : * show the "Duplicate" warning in any case, then show
4277 : * the error-message and do the cleanup conditioned on
4278 : * a failure-return.
4279 : * That will also obviate the need for a return value from
4280 : * this routine and for the copy-back into statbuf.
4281 : */
4282 212 : warn_if_duplicate(new_alias);
4283 :
4284 : /*
4285 : * Here is where we begin trying the create_..._alias()
4286 : * routines for the vocabularies.
4287 : */
4288 :
4289 : /*
4290 : * Distinguish between "Normal" tokenization mode
4291 : * and "Tokenizer Escape" mode
4292 : */
4293 212 : if ( in_tokz_esc )
4294 : {
4295 89 : if ( create_tokz_esc_alias( new_alias, old_name) )
4296 80 : return(TRUE);
4297 :
4298 : /*
4299 : * Handle the classes of operatives that are common between
4300 : * "Tokenizer Escape" mode and "Normal" tokenization mode.
4301 : * Those classes include selected non-fcode forth constructs
4302 : * and Conditional-Compilation Operators.
4303 : */
4304 : {
4305 9 : tic_hdr_t *found = lookup_shared_word( old_name);
4306 9 : if ( found != NULL )
4307 : {
4308 4 : if ( create_core_alias( new_alias, old_name) )
4309 4 : return(TRUE);
4310 : }
4311 : }
4312 : }else{
4313 : /* "Normal" tokenization mode */
4314 :
4315 : /* Can create aliases for "Locals", why not? */
4316 123 : if ( create_local_alias( new_alias, old_name) )
4317 1 : return(TRUE);
4318 :
4319 : /*
4320 : * All other classes of operatives -- non-fcode forth
4321 : * constructs, Standard and user-defined fcode
4322 : * tokens, Macros, and Conditional-Compilation
4323 : * Operators, -- are included in the "currently
4324 : * active" vocabulary.
4325 : */
4326 :
4327 122 : if ( create_current_alias( new_alias, old_name) )
4328 110 : return(TRUE);
4329 :
4330 : } /* End of separate handling for normal-tokenization mode
4331 : * versus "Tokenizer-Escape" mode
4332 : */
4333 :
4334 : /* It's not a word, a macro or any of that other stuff. */
4335 17 : tokenized_word_error(old_name);
4336 17 : free(old_name);
4337 : }
4338 18 : free (new_alias);
4339 : }
4340 19 : return(FALSE);
4341 : }
4342 :
4343 :
4344 : /* **************************************************************************
4345 : *
4346 : * Function name: string_err_check
4347 : * Synopsis: Error-check after processing or Ignoring
4348 : * simple strings
4349 : *
4350 : * Inputs:
4351 : * Parameters:
4352 : * is_paren TRUE if string is Dot-Paren .(
4353 : * FALSE if Ess-Quote ( s" )
4354 : * sav_lineno Saved Line Number, for Unterminated Error
4355 : * strt_lineno Start Line Number, for Multiline Warning
4356 : * Global Variables:
4357 : * noerrors TRUE if ignoring errors
4358 : * Local Static Variables:
4359 : * got_until_eof TRUE if reached end of buffer before delim.
4360 : *
4361 : * Outputs:
4362 : * Returned Value: TRUE if did not reach end of buffer, or,
4363 : * if ignoring errors, TRUE anyway.
4364 : *
4365 : * Error Detection:
4366 : * Multi-line warning, "Unterminated" Error messages, as apppropriate
4367 : *
4368 : **************************************************************************** */
4369 :
4370 : static bool string_err_check( bool is_paren,
4371 : unsigned int sav_lineno,
4372 : unsigned int strt_lineno )
4373 37 : {
4374 37 : bool retval = noerrors ;
4375 : char *item_typ = is_paren ?
4376 37 : "Dot-Paren" : "Ess-Quote" ;
4377 37 : if ( got_until_eof ) /* Crude retrofit... */
4378 : {
4379 2 : warn_unterm( TKERROR, item_typ, sav_lineno );
4380 : }else{
4381 35 : retval = TRUE;
4382 35 : warn_if_multiline( item_typ, strt_lineno );
4383 : }
4384 37 : return( retval);
4385 : }
4386 :
4387 :
4388 : /* **************************************************************************
4389 : *
4390 : * Function name: handle_internal
4391 : * Synopsis: Perform the functions associated with FORTH words
4392 : * that do not map directly to a single token. This
4393 : * is the functions that will go into the FUNCT field
4394 : * of entries in the "FWords" and "Shared Words" lists.
4395 : *
4396 : * Inputs:
4397 : * Parameters:
4398 : * pfield Param-field of the tic_hdr_t -type entry
4399 : * associated with the FORTH-Word (FWord)
4400 : * just read that is being "handled".
4401 : * Global Variables:
4402 : * statbuf The word that was just read.
4403 : *
4404 : * Outputs:
4405 : * Returned Value: NONE
4406 : * Global Variables:
4407 : * statbuf More words may be read.
4408 : *
4409 : * Error Detection:
4410 : * Too numerous to list here...
4411 : *
4412 : * Process Explanation:
4413 : * Recast the type of the param-field of a tic_hdr_t -type
4414 : * entry and rename it "tok".
4415 : * The "tok" will be used as the control-expression for a
4416 : * SWITCH statement with a large number of CASE labels.
4417 : * Both "FWords" and "shared_words" list entries will
4418 : * be processed by this routine.
4419 : *
4420 : * Revision History:
4421 : * Updated Wed, 20 Jul 2005 by David L. Paktor
4422 : * Put handling of ABORT" under control of a run-time
4423 : * command-line switch.
4424 : * Put decision to support IBM-style Locals under control
4425 : * of a run-time command-line switch.
4426 : * Updated Tue, 17 Jan 2006 by David L. Paktor
4427 : * Convert to handler for tic_hdr_t type vocab entries.
4428 : *
4429 : * Extraneous Remarks:
4430 : * We would prefer to keep this function private, so we will
4431 : * declare its prototype here and in the one other file
4432 : * where we need it, namely, dictionary.c, rather than
4433 : * exporting it widely in a .h file.
4434 : *
4435 : **************************************************************************** */
4436 :
4437 : void handle_internal( tic_param_t pfield);
4438 : void handle_internal( tic_param_t pfield)
4439 53162 : {
4440 53162 : fwtoken tok = pfield.fw_token;
4441 :
4442 : signed long wlen;
4443 53162 : unsigned int sav_lineno = lineno; /* For error message */
4444 :
4445 53162 : bool handy_toggle = TRUE ; /* Various uses... */
4446 :
4447 : #ifdef DEBUG_SCANNER
4448 : printf("%s:%d: debug: tokenizing control word '%s'\n",
4449 : iname, lineno, statbuf);
4450 : #endif
4451 53162 : switch (tok) {
4452 : case BEGIN:
4453 47 : emit_begin();
4454 47 : break;
4455 :
4456 : case BUFFER:
4457 34 : if ( create_word(tok) )
4458 : {
4459 34 : emit_token("b(buffer:)");
4460 : }
4461 : break;
4462 :
4463 : case CONST:
4464 9077 : if ( create_word(tok) )
4465 : {
4466 9075 : emit_token("b(constant)");
4467 : }
4468 : break;
4469 :
4470 : case COLON:
4471 : {
4472 : /* Collect error- -detection or -reporting items,
4473 : * but don't commit until we're sure the
4474 : * creation was a success.
4475 : */
4476 718 : u16 maybe_last_colon_fcode = nextfcode ;
4477 718 : unsigned int maybe_last_colon_lineno = lineno;
4478 718 : unsigned int maybe_last_colon_abs_token_no = abs_token_no;
4479 718 : unsigned int maybe_last_colon_do_depth = do_loop_depth;
4480 : /* last_colon_defname
4481 : * has to wait until after call to create_word()
4482 : */
4483 :
4484 718 : if ( create_word(tok) )
4485 : {
4486 717 : last_colon_fcode = maybe_last_colon_fcode;
4487 717 : last_colon_lineno = maybe_last_colon_lineno;
4488 717 : last_colon_abs_token_no = maybe_last_colon_abs_token_no;
4489 717 : last_colon_do_depth = maybe_last_colon_do_depth;
4490 717 : collect_input_filename( &last_colon_filename);
4491 : /* Now we can get last_colon_defname */
4492 717 : if ( last_colon_defname != NULL )
4493 : {
4494 607 : free( last_colon_defname);
4495 : }
4496 717 : last_colon_defname = strdup(statbuf);
4497 :
4498 717 : emit_token("b(:)");
4499 717 : incolon=TRUE;
4500 717 : hide_last_colon();
4501 717 : lastcolon = opc;
4502 : }
4503 : }
4504 : break;
4505 :
4506 : case SEMICOLON:
4507 718 : if ( test_in_colon("SEMICOLON", TRUE, TKERROR, NULL) )
4508 : {
4509 714 : ret_stk_balance_rpt( "termination,", TRUE);
4510 : /* Clear Control Structures just back to where
4511 : * the current Colon-definition began.
4512 : */
4513 714 : clear_control_structs_to_limit(
4514 : "End of colon-definition", last_colon_abs_token_no);
4515 :
4516 714 : if ( ibm_locals )
4517 : {
4518 402 : finish_locals();
4519 402 : forget_locals();
4520 : }
4521 :
4522 714 : emit_token("b(;)");
4523 714 : incolon=FALSE;
4524 714 : reveal_last_colon();
4525 : }
4526 : break;
4527 :
4528 : case CREATE:
4529 27 : if ( create_word(tok) )
4530 : {
4531 26 : emit_token("b(create)");
4532 : }
4533 : break;
4534 :
4535 : case DEFER:
4536 5 : if ( create_word(tok) )
4537 : {
4538 5 : emit_token("b(defer)");
4539 : }
4540 : break;
4541 :
4542 : case ALLOW_MULTI_LINE:
4543 12 : report_multiline = FALSE;
4544 12 : break;
4545 :
4546 : case OVERLOAD:
4547 43 : if ( test_in_colon(statbuf, FALSE, WARNING, NULL) )
4548 : {
4549 42 : do_not_overload = FALSE;
4550 : }
4551 : break;
4552 :
4553 : case DEFINED:
4554 26 : if (get_word_in_line( statbuf) )
4555 : {
4556 26 : eval_user_symbol(statbuf);
4557 : }
4558 : break;
4559 :
4560 : case CL_FLAG:
4561 131 : if (get_word_in_line( statbuf) )
4562 : {
4563 131 : set_cl_flag( statbuf, TRUE);
4564 : }
4565 : break;
4566 :
4567 : case SHOW_CL_FLAGS:
4568 12 : show_all_cl_flag_settings( TRUE);
4569 12 : break;
4570 :
4571 : case FIELD:
4572 5 : if ( create_word(tok) )
4573 : {
4574 5 : emit_token("b(field)");
4575 : }
4576 : break;
4577 :
4578 : case VALUE:
4579 63 : if ( create_word(tok) )
4580 : {
4581 63 : emit_token("b(value)");
4582 : }
4583 : break;
4584 :
4585 : case VARIABLE:
4586 53 : if ( create_word(tok) )
4587 : {
4588 53 : emit_token("b(variable)");
4589 : }
4590 : break;
4591 :
4592 : case AGAIN:
4593 28 : emit_again();
4594 28 : break;
4595 :
4596 : case ALIAS:
4597 214 : if ( create_alias() )
4598 : {
4599 195 : trace_creation( ALIAS, statbuf);
4600 : }
4601 : break;
4602 :
4603 : case CONTROL:
4604 17 : if ( get_word_in_line( statbuf) )
4605 : {
4606 17 : emit_literal(statbuf[0]&0x1f);
4607 : }
4608 : break;
4609 :
4610 : case DO:
4611 53 : emit_token("b(do)");
4612 53 : mark_do();
4613 53 : break;
4614 :
4615 : case CDO:
4616 44 : emit_token("b(?do)");
4617 44 : mark_do();
4618 44 : break;
4619 :
4620 : case ELSE:
4621 24 : emit_else();
4622 24 : break;
4623 :
4624 : case CASE:
4625 30 : emit_case();
4626 30 : break;
4627 :
4628 : case ENDCASE:
4629 29 : emit_endcase();
4630 29 : break;
4631 :
4632 : case NEW_DEVICE:
4633 88 : handy_toggle = FALSE;
4634 : case FINISH_DEVICE:
4635 177 : finish_or_new_device( handy_toggle );
4636 177 : break;
4637 :
4638 : case FLITERAL:
4639 : {
4640 : u32 val;
4641 19 : val = dpop();
4642 19 : emit_literal(val);
4643 : }
4644 19 : break;
4645 :
4646 : case OF:
4647 1294 : emit_of();
4648 1294 : break;
4649 :
4650 : case ENDOF:
4651 1293 : emit_endof();
4652 1293 : break;
4653 :
4654 : case EXTERNAL:
4655 12 : set_hdr_flag( FLAG_EXTERNAL );
4656 12 : break;
4657 :
4658 : case HEADERLESS:
4659 6 : set_hdr_flag( FLAG_HEADERLESS );
4660 6 : break;
4661 :
4662 : case HEADERS:
4663 166 : set_hdr_flag( FLAG_HEADERS );
4664 166 : break;
4665 :
4666 : case DECIMAL:
4667 : /* in a definition this is expanded as macro "10 base !" */
4668 32 : base_change ( 0x0a );
4669 32 : break;
4670 :
4671 : case HEX:
4672 55 : base_change ( 0x10 );
4673 55 : break;
4674 :
4675 : case OCTAL:
4676 6 : base_change ( 0x08 );
4677 6 : break;
4678 :
4679 : case OFFSET16:
4680 0 : if (!offs16)
4681 : {
4682 0 : tokenization_error(INFO, "Switching to 16-bit offsets.\n");
4683 : }else{
4684 0 : tokenization_error(WARNING,
4685 : "Call of OFFSET16 is redundant.\n");
4686 : }
4687 0 : emit_token("offset16");
4688 0 : offs16=TRUE;
4689 0 : break;
4690 :
4691 : case IF:
4692 189 : emit_if();
4693 189 : break;
4694 :
4695 : /* **************************************************************************
4696 : *
4697 : * Still to be done:
4698 : * Correct analysis of Return-Stack usage within Do-Loops
4699 : * or before Loop Elements like I and J or UNLOOP or LEAVE.
4700 : *
4701 : **************************************************************************** */
4702 : case UNLOOP:
4703 3 : emit_token("unloop");
4704 3 : must_be_deep_in_do(1);
4705 3 : break;
4706 :
4707 : case LEAVE:
4708 7 : emit_token("b(leave)");
4709 7 : must_be_deep_in_do(1);
4710 7 : break;
4711 :
4712 : case LOOP_I:
4713 60 : emit_token("i");
4714 60 : must_be_deep_in_do(1);
4715 60 : break;
4716 :
4717 : case LOOP_J:
4718 12 : emit_token("j");
4719 12 : must_be_deep_in_do(2);
4720 12 : break;
4721 :
4722 : case LOOP:
4723 85 : emit_token("b(loop)");
4724 85 : resolve_loop();
4725 85 : break;
4726 :
4727 : case PLUS_LOOP:
4728 12 : emit_token("b(+loop)");
4729 12 : resolve_loop();
4730 12 : break;
4731 :
4732 :
4733 : case INSTANCE:
4734 : {
4735 117 : bool set_instance_state = FALSE;
4736 117 : bool emit_instance = TRUE;
4737 : /* We will treat "instance" in a colon-definition as
4738 : * an error, but allow it to be emitted if we're
4739 : * ignoring errors; if we're not ignoring errors,
4740 : * there's no output anyway...
4741 : */
4742 117 : if ( test_in_colon(statbuf, FALSE, TKERROR, NULL) )
4743 : { /* We are in interpretation (not colon) state. */
4744 : /* "Instance" not allowed during "global" scope */
4745 110 : if ( scope_is_global )
4746 : {
4747 22 : glob_not_allowed( WARNING, FALSE );
4748 22 : emit_instance = FALSE;
4749 : }else{
4750 88 : set_instance_state = TRUE;
4751 : }
4752 : }
4753 117 : if ( emit_instance )
4754 : {
4755 95 : if ( set_instance_state )
4756 : {
4757 : /* "Instance" isn't cumulative.... */
4758 88 : if ( is_instance )
4759 : {
4760 6 : unresolved_instance( WARNING);
4761 : }
4762 88 : collect_input_filename( &instance_filename);
4763 88 : instance_lineno = lineno;
4764 88 : is_instance = TRUE;
4765 88 : dev_change_instance_warning = TRUE;
4766 : }
4767 95 : emit_token("instance");
4768 : }
4769 : }
4770 : break;
4771 :
4772 : case GLOB_SCOPE:
4773 65 : if ( test_in_colon(statbuf, FALSE, TKERROR, NULL) )
4774 : {
4775 65 : if ( INVERSE( is_instance) )
4776 : {
4777 63 : enter_global_scope();
4778 : }else{
4779 2 : tokenization_error( TKERROR,
4780 : "Global Scope not allowed. "
4781 : "\"Instance\" is in effect; issued" );
4782 2 : just_where_started( instance_filename,
4783 : instance_lineno );
4784 : }
4785 : }
4786 : break;
4787 :
4788 : case DEV_SCOPE:
4789 48 : if ( test_in_colon(statbuf, FALSE, TKERROR, NULL) )
4790 : {
4791 48 : resume_device_scope();
4792 : }
4793 : break;
4794 :
4795 : case TICK: /* ' */
4796 1 : test_in_colon(statbuf, FALSE, WARNING, "[']");
4797 : case BRACK_TICK: /* ['] */
4798 : {
4799 : tic_hdr_t *token_entry;
4800 40 : if ( get_token( &token_entry) )
4801 : {
4802 34 : emit_token("b(')");
4803 : /* Emit the token; warning or whatever comes gratis */
4804 34 : token_entry->funct( token_entry->pfield);
4805 : }
4806 : }
4807 : break;
4808 :
4809 : case F_BRACK_TICK: /* F['] <name>
4810 : * emits the token-number for <name>
4811 : * Mainly useful to compute the argument
4812 : * to get-token or set-token
4813 : */
4814 : {
4815 : tic_hdr_t *token_entry;
4816 18 : if ( get_token( &token_entry) )
4817 : {
4818 : /* "Obsolete" warning doesn't come gratis here... */
4819 15 : token_entry_warning( token_entry);
4820 : /* In Tokenizer-Escape mode, push the token */
4821 15 : if ( in_tokz_esc )
4822 : {
4823 0 : dpush( token_entry->pfield.deflt_elem);
4824 : }else{
4825 15 : emit_literal( token_entry->pfield.deflt_elem);
4826 : }
4827 : }
4828 : }
4829 : break;
4830 :
4831 : case CHAR:
4832 7 : handy_toggle = FALSE;
4833 : case CCHAR:
4834 16 : test_in_colon(statbuf, handy_toggle, WARNING,
4835 : handy_toggle ? "CHAR" : "[CHAR]" );
4836 : case ASCII:
4837 18 : if ( get_word_in_line( statbuf) )
4838 : {
4839 18 : emit_literal(statbuf[0]);
4840 : }
4841 : break;
4842 :
4843 : case UNTIL:
4844 4 : emit_until();
4845 4 : break;
4846 :
4847 : case WHILE:
4848 11 : emit_while();
4849 11 : break;
4850 :
4851 : case REPEAT:
4852 11 : emit_repeat();
4853 11 : break;
4854 :
4855 : case THEN:
4856 194 : emit_then();
4857 194 : break;
4858 :
4859 : case IS:
4860 42 : tokenization_error ( INFO,
4861 : "Substituting TO for deprecated IS\n");
4862 : case TO:
4863 202 : if ( validate_to_target() )
4864 : {
4865 179 : emit_token("b(to)");
4866 : }
4867 : break;
4868 :
4869 : case FLOAD:
4870 254 : if ( get_word_in_line( statbuf) )
4871 : {
4872 : bool stream_ok ;
4873 :
4874 254 : push_source( close_stream, NULL, TRUE) ;
4875 :
4876 254 : tokenization_error( INFO, "FLOADing %s\n", statbuf );
4877 :
4878 254 : stream_ok = init_stream( statbuf );
4879 254 : if ( INVERSE( stream_ok) )
4880 : {
4881 14 : drop_source();
4882 : }
4883 : }
4884 : break;
4885 :
4886 : case STRING: /* Double-Quote ( " ) string */
4887 184 : handy_toggle = FALSE;
4888 : case PSTRING: /* Dot-Quote ( ." ) string */
4889 35239 : wlen=get_string( TRUE);
4890 35239 : emit_token("b(\")");
4891 35239 : emit_string(statbuf, wlen);
4892 35239 : if ( handy_toggle )
4893 : {
4894 35055 : emit_token("type");
4895 : }
4896 : break;
4897 :
4898 : case SSTRING: /* Ess-Quote ( s" ) string */
4899 7 : handy_toggle = FALSE;
4900 : case PBSTRING: /* Dot-Paren .( string */
4901 29 : if (*pc++=='\n') lineno++;
4902 : {
4903 29 : unsigned int strt_lineno = lineno;
4904 29 : wlen = get_until( handy_toggle ? ')' : '"' );
4905 29 : if ( string_err_check( handy_toggle,
4906 : sav_lineno, strt_lineno) )
4907 : {
4908 28 : emit_token("b(\")");
4909 28 : emit_string(statbuf, wlen);
4910 28 : if ( handy_toggle )
4911 : {
4912 22 : emit_token("type");
4913 : }
4914 : }
4915 : }
4916 : break;
4917 :
4918 : case FUNC_NAME:
4919 58 : if ( test_in_colon( statbuf, TRUE, TKERROR, NULL) )
4920 : {
4921 58 : if ( in_tokz_esc )
4922 : {
4923 2 : tokenization_error( P_MESSAGE, "Currently" );
4924 2 : in_last_colon();
4925 : }else{
4926 56 : emit_token("b(\")");
4927 56 : emit_string( last_colon_defname,
4928 : strlen( last_colon_defname) );
4929 : /* if ( hdr_flag == FLAG_HEADERLESS ) { WARNING } */
4930 : }
4931 : }
4932 : break;
4933 :
4934 : case IFILE_NAME:
4935 2 : emit_token("b(\")");
4936 2 : emit_string( iname, strlen( iname) );
4937 2 : break;
4938 :
4939 : case ILINE_NUM:
4940 2 : emit_literal( lineno);
4941 2 : break;
4942 :
4943 : case HEXVAL:
4944 282 : base_val (0x10);
4945 282 : break;
4946 :
4947 : case DECVAL:
4948 47 : base_val (0x0a);
4949 47 : break;
4950 :
4951 : case OCTVAL:
4952 12 : base_val (8);
4953 12 : break;
4954 :
4955 : case ASC_LEFT_NUM:
4956 12 : handy_toggle = FALSE;
4957 : case ASC_NUM:
4958 26 : if (get_word_in_line( statbuf) )
4959 : {
4960 25 : if ( handy_toggle )
4961 : {
4962 13 : ascii_right_number( statbuf);
4963 : } else {
4964 12 : ascii_left_number( statbuf);
4965 : }
4966 : }
4967 : break;
4968 :
4969 : case CONDL_ENDER: /* Conditional directives out of context */
4970 : case CONDL_ELSE:
4971 23 : tokenization_error ( TKERROR,
4972 : "No conditional preceding %s directive\n",
4973 : strupr(statbuf) );
4974 23 : break;
4975 :
4976 : case PUSH_FCODE:
4977 153 : tokenization_error( INFO,
4978 : "FCode-token Assignment Counter of 0x%x "
4979 : "has been saved on stack.\n", nextfcode );
4980 153 : dpush( (long)nextfcode );
4981 153 : break;
4982 :
4983 : case POP_FCODE:
4984 43 : pop_next_fcode();
4985 43 : break;
4986 :
4987 : case RESET_FCODE:
4988 26 : tokenization_error( INFO,
4989 : "Encountered %s. Resetting FCode-token "
4990 : "Assignment Counter. ", strupr(statbuf) );
4991 26 : list_fcode_ranges( FALSE);
4992 26 : reset_fcode_ranges();
4993 26 : break;
4994 :
4995 : case EXIT:
4996 50 : if ( test_in_colon( statbuf, TRUE, TKERROR, NULL)
4997 : || noerrors )
4998 : {
4999 50 : ret_stk_balance_rpt( NULL, FALSE);
5000 50 : if ( ibm_locals )
5001 : {
5002 18 : finish_locals ();
5003 : }
5004 50 : emit_token("exit");
5005 : }
5006 : break;
5007 :
5008 : case ESCAPETOK:
5009 573 : enter_tokz_esc();
5010 573 : break;
5011 :
5012 : case VERSION1:
5013 : case FCODE_V1:
5014 2 : tokenization_error( INFO, "Using version1 header "
5015 : "(8-bit offsets).\n");
5016 2 : fcode_starter( "version1", 1, FALSE) ;
5017 2 : break;
5018 :
5019 : case START1:
5020 : case FCODE_V2:
5021 : case FCODE_V3: /* Full IEEE 1275 */
5022 168 : fcode_starter( "start1", 1, TRUE);
5023 168 : break;
5024 :
5025 : case START0:
5026 0 : fcode_starter( "start0", 0, TRUE);
5027 0 : break;
5028 :
5029 : case START2:
5030 0 : fcode_starter( "start2", 2, TRUE);
5031 0 : break;
5032 :
5033 : case START4:
5034 0 : fcode_starter( "start4", 4, TRUE);
5035 0 : break;
5036 :
5037 : case END1:
5038 0 : tokenization_error( WARNING,
5039 : "Appearance of END1 in FCode source code "
5040 : "is not intended by IEEE 1275-1994\n");
5041 0 : handy_toggle = FALSE;
5042 : case END0:
5043 : case FCODE_END:
5044 165 : if ( handy_toggle )
5045 : {
5046 165 : you_are_here();
5047 : }
5048 165 : emit_token( handy_toggle ? "end0" : "end1" );
5049 165 : fcode_ender();
5050 165 : FFLUSH_STDOUT
5051 165 : break;
5052 :
5053 : case RECURSE:
5054 6 : if ( test_in_colon(statbuf, TRUE, TKERROR, NULL ) )
5055 : {
5056 5 : emit_fcode(last_colon_fcode);
5057 : }
5058 : break;
5059 :
5060 :
5061 : case RECURSIVE:
5062 6 : if ( test_in_colon(statbuf, TRUE, TKERROR, NULL ) )
5063 : {
5064 5 : reveal_last_colon();
5065 : }
5066 : break;
5067 :
5068 : case RET_STK_FETCH:
5069 6 : ret_stk_access_rpt();
5070 6 : emit_token( "r@");
5071 6 : break;
5072 :
5073 : case RET_STK_FROM:
5074 38 : ret_stk_access_rpt();
5075 38 : bump_ret_stk_depth( -1);
5076 38 : emit_token( "r>");
5077 38 : break;
5078 :
5079 : case RET_STK_TO:
5080 38 : bump_ret_stk_depth( 1);
5081 38 : emit_token( ">r");
5082 38 : break;
5083 :
5084 : case PCIHDR:
5085 30 : emit_pcihdr();
5086 30 : break;
5087 :
5088 : case PCIEND:
5089 29 : finish_pcihdr();
5090 29 : reset_fcode_ranges();
5091 29 : FFLUSH_STDOUT
5092 29 : break;
5093 :
5094 : case PCIREV:
5095 26 : pci_image_rev = dpop();
5096 26 : tokenization_error( INFO,
5097 : "PCI header revision=0x%04x%s\n", pci_image_rev,
5098 : big_end_pci_image_rev ?
5099 : ". Will be saved in Big-Endian format."
5100 : : "" );
5101 26 : break;
5102 :
5103 : case NOTLAST:
5104 12 : handy_toggle = FALSE;
5105 : case ISLAST:
5106 24 : dpush(handy_toggle);
5107 : case SETLAST:
5108 : {
5109 25 : u32 val = dpop();
5110 25 : bool new_pili = BOOLVAL( (val != 0) );
5111 25 : if ( pci_is_last_image != new_pili )
5112 : {
5113 25 : tokenization_error( INFO,
5114 : new_pili ?
5115 : "Last image for PCI header.\n" :
5116 : "PCI header not last image.\n" );
5117 25 : pci_is_last_image = new_pili;
5118 : }
5119 : }
5120 : break;
5121 :
5122 : case SAVEIMG:
5123 0 : if (get_word_in_line( statbuf) )
5124 : {
5125 0 : free(oname);
5126 0 : oname = strdup( statbuf );
5127 0 : tokenization_error( INFO,
5128 : "Output is redirected to file: %s\n", oname);
5129 : }
5130 : break;
5131 :
5132 : case RESETSYMBS:
5133 14 : tokenization_error( INFO,
5134 : "Resetting symbols defined in %s mode.\n",
5135 : in_tokz_esc ? "tokenizer-escape" : "\"normal\"");
5136 14 : if ( in_tokz_esc )
5137 : {
5138 12 : reset_tokz_esc();
5139 : }else{
5140 2 : reset_normal_vocabs();
5141 : }
5142 : break;
5143 :
5144 : case FCODE_DATE:
5145 3 : handy_toggle = FALSE;
5146 : case FCODE_TIME:
5147 : {
5148 : time_t tt;
5149 : char temp_buffr[32];
5150 :
5151 6 : tt=time(NULL);
5152 6 : if ( handy_toggle )
5153 : {
5154 3 : strftime(temp_buffr, 32, "%T %Z", localtime(&tt));
5155 : }else{
5156 3 : strftime(temp_buffr, 32, "%m/%d/%Y", localtime(&tt));
5157 : }
5158 6 : if ( in_tokz_esc )
5159 : {
5160 2 : tokenization_error( MESSAGE, temp_buffr);
5161 : }else{
5162 4 : emit_token("b(\")");
5163 4 : emit_string((u8 *)temp_buffr, strlen(temp_buffr) );
5164 : }
5165 : }
5166 : break;
5167 :
5168 : case ENCODEFILE:
5169 18 : if (get_word_in_line( statbuf) )
5170 : {
5171 18 : encode_file( (char*)statbuf );
5172 : }
5173 : break;
5174 :
5175 : default:
5176 : /* IBM-style Locals, under control of a switch */
5177 200 : if ( ibm_locals )
5178 : {
5179 164 : bool found_it = TRUE;
5180 164 : switch (tok) {
5181 : case CURLY_BRACE:
5182 69 : declare_locals( FALSE);
5183 69 : break;
5184 : case DASH_ARROW:
5185 95 : assign_local();
5186 95 : break;
5187 : default:
5188 0 : found_it = FALSE;
5189 : }
5190 164 : if ( found_it ) break;
5191 : }
5192 :
5193 : /* Down here, we have our last chance to recognize a token.
5194 : * If abort_quote is disallowed, we will still consume
5195 : * the string. In case the string spans more than one
5196 : * line, we want to make sure the line number displayed
5197 : * in the error-message is the one on which the disallowed
5198 : * abort_quote token appeared, not the one where the
5199 : * string ended; therefore, we might need to be able to
5200 : * "fake-out" the line number...
5201 : */
5202 : {
5203 36 : bool fake_out_lineno = FALSE;
5204 36 : unsigned int save_lineno = lineno;
5205 : unsigned int true_lineno;
5206 36 : if ( abort_quote( tok) )
5207 10 : { break;
5208 : }else{
5209 26 : if ( tok == ABORTTXT ) fake_out_lineno = TRUE;
5210 : }
5211 26 : true_lineno = lineno;
5212 :
5213 26 : if ( fake_out_lineno ) lineno = save_lineno;
5214 26 : tokenization_error ( TKERROR,
5215 : "Unimplemented control word '%s'\n", strupr(statbuf) );
5216 26 : if ( fake_out_lineno ) lineno = true_lineno;
5217 : }
5218 : }
5219 53161 : }
5220 :
5221 : /* **************************************************************************
5222 : *
5223 : * Function name: skip_string
5224 : * Synopsis: When Ignoring, skip various kinds of strings. Maps
5225 : * to string-handlers in handle_internal()...
5226 : *
5227 : * Associated FORTH words: Double-Quote ( " ) string
5228 : * Dot-Quote ( ." ) string
5229 : * Ess-Quote ( s" ) string
5230 : * Dot-Paren .( string
5231 : * ABORT" (even if not enabled)
5232 : * { (Local-Values declaration) and -> (Local-Values assignment)
5233 : * are also handled if ibm_locals is enabled.
5234 : *
5235 : * Inputs:
5236 : * Parameters:
5237 : * pfield Param-field of the entry associated with
5238 : * the FWord that is being Ignored.
5239 : * Global Variables:
5240 : * statbuf The word that was just read.
5241 : * pc Input-stream pointer
5242 : * lineno Line-number, used for errors and warnings
5243 : * ibm_locals TRUE if IBM-style Locals are enabled
5244 : *
5245 : * Outputs:
5246 : * Returned Value: NONE
5247 : *
5248 : * Error Detection:
5249 : * Multi-line warnings, "Unterminated" Errors
5250 : * handled by called routines
5251 : *
5252 : * Extraneous Remarks:
5253 : * We would prefer to keep this function private, too, so we
5254 : * will declare its prototype here and in the one other
5255 : * file where we need it, namely, dictionary.c, rather
5256 : * than exporting it widely in a .h file.
5257 : *
5258 : **************************************************************************** */
5259 :
5260 : void skip_string( tic_param_t pfield);
5261 : void skip_string( tic_param_t pfield)
5262 403 : {
5263 403 : fwtoken tok = pfield.fw_token;
5264 403 : unsigned int sav_lineno = lineno;
5265 403 : bool handy_toggle = TRUE ; /* Various uses... */
5266 :
5267 403 : switch (tok) {
5268 : case STRING: /* Double-Quote ( " ) string */
5269 : case PSTRING: /* Dot-Quote ( ." ) string */
5270 : case ABORTTXT: /* ABORT", even if not enabled */
5271 375 : get_string( FALSE); /* Don't truncate; ignoring anyway */
5272 : /* Will handle multi-line warnings, etc. */
5273 375 : break;
5274 :
5275 : case SSTRING: /* Ess-Quote ( s" ) string */
5276 4 : handy_toggle = FALSE;
5277 : case PBSTRING: /* Dot-Paren .( string */
5278 8 : if (*pc++=='\n') lineno++;
5279 : {
5280 8 : unsigned int strt_lineno = lineno;
5281 8 : get_until( handy_toggle ? ')' : '"' );
5282 8 : string_err_check( handy_toggle, sav_lineno, strt_lineno );
5283 : }
5284 8 : break;
5285 :
5286 : default:
5287 : /* IBM-style Locals, under control of a switch */
5288 20 : if ( ibm_locals )
5289 : {
5290 20 : bool found_it = TRUE;
5291 20 : switch (tok) {
5292 : case CURLY_BRACE:
5293 10 : declare_locals( TRUE);
5294 10 : break;
5295 : case DASH_ARROW:
5296 10 : get_word();
5297 10 : break;
5298 : default:
5299 0 : found_it = FALSE;
5300 : }
5301 20 : if ( found_it ) break;
5302 : }
5303 :
5304 0 : tokenization_error ( FATAL, "Program Error. "
5305 : "Unimplemented skip-string word '%s'\n", strupr(statbuf) );
5306 : }
5307 403 : }
5308 :
5309 : /* **************************************************************************
5310 : *
5311 : * Function name: process_remark
5312 : * Synopsis: The active function for remarks (backslash-space)
5313 : * and comments (enclosed within parens)
5314 : *
5315 : * Associated FORTH word(s): \ (
5316 : *
5317 : * Inputs:
5318 : * Parameters:
5319 : * TIC entry "parameter field", init'd to delimiter character.
5320 : *
5321 : * Outputs:
5322 : * Returned Value: NONE
5323 : *
5324 : * Error Detection:
5325 : * Warning if end-of-file encountered before delimiter.
5326 : * Warning if multi-line parentheses-delimited comment.
5327 : *
5328 : * Process Explanation:
5329 : * Skip until the delimiter.
5330 : * If end-of-file was encountered, issue Warning.
5331 : * Otherwise, and if delimiter was not new-line,
5332 : * check for multi-line with Warning.
5333 : *
5334 : **************************************************************************** */
5335 :
5336 : void process_remark( tic_param_t pfield )
5337 4078 : {
5338 4078 : char until_char = (char)pfield.deflt_elem ;
5339 4078 : unsigned int start_lineno = lineno;
5340 :
5341 : #ifdef DEBUG_SCANNER
5342 :
5343 : get_until(until_char);
5344 : printf ("%s:%d: debug: stack diagram: %s)\n",
5345 : iname, lineno, statbuf);
5346 : #else
5347 :
5348 4078 : if ( skip_until( until_char) )
5349 : {
5350 4 : if ( until_char == '\n' )
5351 : {
5352 : /* Don't need any saved line number here ... */
5353 1 : tokenization_error ( WARNING,
5354 : "Unterminated remark.\n");
5355 : }else{
5356 3 : warn_unterm( WARNING, "comment", start_lineno);
5357 : }
5358 : }else{
5359 4074 : if ( until_char != '\n' )
5360 : {
5361 688 : pc++;
5362 688 : warn_if_multiline( "comment", start_lineno);
5363 : }
5364 : }
5365 : #endif /* DEBUG_SCANNER */
5366 4078 : }
5367 :
5368 :
5369 : /* **************************************************************************
5370 : *
5371 : * Function name: filter_comments
5372 : * Synopsis: Process remarks and comments in special conditions
5373 : *
5374 : * Inputs:
5375 : * Parameters:
5376 : * inword Current word just parsed
5377 : *
5378 : * Outputs:
5379 : * Returned Value: TRUE if Current word is a Comment-starter.
5380 : * Comment will be processed
5381 : *
5382 : * Process Explanation:
5383 : * We want to be able to recognize any alias the user may have
5384 : * defined to a comment-delimiter, in whatever applicable
5385 : * vocabulary it might be.
5386 : * The active-function of any such alias will, of necessity, be
5387 : * the process_remark() routine, defined just above.
5388 : * We will search for the TIC-entry of the given word; if we don't
5389 : * find it, it's not a comment-delimiter. If we do find it,
5390 : * and it is one, we invoke its active-function and return TRUE.
5391 : * We also want to permit the "allow-multiline-comments" directive
5392 : * to be processed in the context that calls this routine, so
5393 : * we will check for that condition, too.
5394 : *
5395 : **************************************************************************** */
5396 :
5397 : bool filter_comments( u8 *inword)
5398 629 : {
5399 629 : bool retval = FALSE;
5400 629 : tic_hdr_t *found = lookup_word( inword, NULL, NULL );
5401 :
5402 629 : if ( found != NULL )
5403 : {
5404 219 : if ( found->funct == process_remark )
5405 : {
5406 111 : found->funct( found->pfield);
5407 111 : retval = TRUE;
5408 : }else{
5409 : /* Permit the "allow-multiline-comments" directive */
5410 108 : if ( found->funct == handle_internal )
5411 : {
5412 40 : if ( found->pfield.fw_token == ALLOW_MULTI_LINE )
5413 : {
5414 : /* Make sure any intended side-effects occur... */
5415 4 : found->funct( found->pfield);
5416 4 : retval = TRUE;
5417 : }
5418 : }
5419 : }
5420 : }
5421 629 : return ( retval );
5422 : }
5423 :
5424 :
5425 : /* **************************************************************************
5426 : *
5427 : * Function name: tokenize_one_word
5428 : * Synopsis: Tokenize the currently-obtained word
5429 : * along with whatever it consumes.
5430 : *
5431 : * Inputs:
5432 : * Parameters:
5433 : * wlen Length of symbol just retrieved from the input stream
5434 : * This is not really used here any more; it's
5435 : * left over from an earlier implementation.
5436 : * Global Variables:
5437 : * statbuf The symbol (word) just retrieved from input stream.
5438 : * in_tokz_esc TRUE if "Tokenizer-Escape" mode is in effect; a
5439 : * different set of vocabularies from "Normal"
5440 : * mode will be checked (along with those that
5441 : * are common to both modes).
5442 : * ibm_locals Controls whether to check for IBM-style Locals;
5443 : * set by means of a command-line switch.
5444 : *
5445 : * Outputs:
5446 : * Returned Value: NONE
5447 : * Global Variables:
5448 : * statbuf May be incremented
5449 : * in_tokz_esc May be set if the word just retrieved is
5450 : * the tokenizer[ directive.
5451 : * tic_found
5452 : *
5453 : * Error Detection:
5454 : * If the word could neither be identified nor processed as a number,
5455 : * that is an ERROR; pass it to tokenized_word_error for a
5456 : * message.
5457 : *
5458 : * Process Explanation:
5459 : * Look for the word in each of the various lists and vocabularies
5460 : * in which it might be found, as appropriate to the current
5461 : * state of activity.
5462 : * If found, process it accordingly.
5463 : * If not found, try to process it as a number.
5464 : * If cannot process it as a number, declare an error.
5465 : *
5466 : * Revision History:
5467 : * Updated Tue, 10 Jan 2006 by David L. Paktor
5468 : * Convert to tic_hdr_t type vocabularies.
5469 : * Updated Mon, 03 Apr 2006 by David L. Paktor
5470 : * Replaced bulky "Normal"-vs-"Escape" block with a call
5471 : * to lookup_word . Attend to a small but important
5472 : * side-effect of the "handle_<vocab>" routines that
5473 : * feeds directly into the protection against self-
5474 : * -recursion in a user-defined Macro: Set the global
5475 : * variable tic_found to the entry, just before we
5476 : * execute it, and we're good to go...
5477 : *
5478 : * Extraneous Remarks:
5479 : * We trade off the strict rules of structure for simplicity
5480 : * of coding.
5481 : *
5482 : **************************************************************************** */
5483 :
5484 : void tokenize_one_word( signed long wlen )
5485 109599 : {
5486 :
5487 : /* The shared lookup routine now handles everything. */
5488 109599 : tic_hdr_t *found = lookup_word( statbuf, NULL, NULL );
5489 :
5490 109599 : if ( found != NULL )
5491 : {
5492 98812 : tic_found = found;
5493 98812 : found->funct( found->pfield);
5494 98810 : return ;
5495 : }
5496 :
5497 : /* It's not a word in any of our current contexts.
5498 : * Is it a number?
5499 : */
5500 10787 : if ( handle_number() )
5501 : {
5502 10485 : return ;
5503 : }
5504 :
5505 : /* Could not identify - give a shout. */
5506 302 : tokenized_word_error( statbuf );
5507 : }
5508 :
5509 : /* **************************************************************************
5510 : *
5511 : * Function name: tokenize
5512 : * Synopsis: Tokenize the current input stream.
5513 : * May be called recursively for macros and such.
5514 : *
5515 : * Revision History:
5516 : * Updated Thu, 24 Mar 2005 by David L. Paktor
5517 : * Factor-out comment-filtration; apply to gather_locals
5518 : * Factor-out tokenizing a single word (for conditionals)
5519 : * Separate actions of "Tokenizer-Escape" mode.
5520 : *
5521 : **************************************************************************** */
5522 :
5523 : void tokenize(void)
5524 165 : {
5525 165 : signed long wlen = 0;
5526 :
5527 96616 : while ( wlen >= 0 )
5528 : {
5529 96287 : wlen = get_word();
5530 96287 : if ( wlen > 0 )
5531 : {
5532 95927 : tokenize_one_word( wlen );
5533 : }
5534 : }
5535 164 : }
5536 :
|
