1 /*
2 * OpenBIOS - free your system!
3 * ( FCode tokenizer )
4 *
5 * This program is part of a free implementation of the IEEE 1275-1994
6 * Standard for Boot (Initialization Configuration) Firmware.
7 *
8 * Copyright (C) 2001-2005 Stefan Reinauer, <stepan@openbios.org>
9 *
10 * This program is free software; you can redistribute it and/or modify
11 * it under the terms of the GNU General Public License as published by
12 * the Free Software Foundation; version 2 of the License.
13 *
14 * This program is distributed in the hope that it will be useful,
15 * but WITHOUT ANY WARRANTY; without even the implied warranty of
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 * GNU General Public License for more details.
18 *
19 * You should have received a copy of the GNU General Public License
20 * along with this program; if not, write to the Free Software
21 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA, 02110-1301 USA
22 *
23 */
24
25 /* **************************************************************************
26 *
27 * Parsing functions for IBM-style Local Values
28 *
29 * (C) Copyright 2005 IBM Corporation. All Rights Reserved.
30 * Module Author: David L. Paktor dlpaktor@us.ibm.com
31 *
32 **************************************************************************** */
33
34 /* **************************************************************************
35 *
36 * Functions Exported:
37 * declare_locals Pick up the Locals' names after the {
38 * handle_local Insert the code to access a Local
39 * exists_as_local Confirm whether a name is in the Locals vocab
40 * assign_local Process the "Assign to a Local" operator ( -> )
41 * finish_locals Insert the code for exiting a routine
42 * that uses locals
43 * forget_locals Remove the locals' names from the search
44 *
45 **************************************************************************** */
46
47 /* **************************************************************************
48 *
49 * These are the names of the three routines that will be invoked
50 * when Locals are used. Their definitions exist in a separate
51 * Local Values Support FCode source-file that must be FLOADed
52 * into the user's tokenization source.
53 *
54 **************************************************************************** */
55
56 /* Note that the enclosing curly-braces are part of the name */
57 static const char* push_locals = "{push-locals}"; /* ( #ilocals #ulocals -- ) */
58 static const char* pop_locals = "{pop-locals}"; /* ( #locals -- ) */
59 static const char* local_addr = "_{local}"; /* ( local# -- addr ) */
60
61 /* Switchable Fetch or Store operator to apply to local_addr. */
62 static const char* local_op = "@"; /* Initially Fetch */
63
64
65 /* **************************************************************************
66 *
67 * Revision History:
68 * Updated Wed, 13 Jul 2005 by David L. Paktor
69 * Command-line control for:
70 * Support for Locals in general
71 * Whether to accept the "legacy" separator (semicolon)
72 * Whether to issue a message for the "legacy" separator
73 * Updated Tue, 10 Jan 2006 by David L. Paktor
74 * Convert to tic_hdr_t type vocabulary.
75 *
76 **************************************************************************** */
77
78 #include <stdio.h>
79 #include <stdlib.h>
80 #include <string.h>
81
82 #include "parselocals.h"
83 #include "ticvocab.h"
84 #include "dictionary.h"
85 #include "scanner.h"
86 #include "errhandler.h"
87 #include "clflags.h"
88 #include "stream.h"
89 #include "emit.h"
90 #include "devnode.h"
91 #include "flowcontrol.h"
92 #include "tracesyms.h"
93
94 /* **************************************************************************
95 *
96 * Global Variables Imported
97 * statbuf
98 * pc
99 * opc
100 * incolon
101 * lastcolon
102 * ibm_locals_legacy_separator Accept ; as the "legacy" separator
103 * ibm_legacy_separator_message Issue a message for "legacy" sep'r
104 *
105 **************************************************************************** */
106
107 /* **************************************************************************
108 *
109 * Internal Static Variables
110 * local_names Vocabulary for new local-names
111 * num_ilocals Number of initialized local variables
112 * num_ulocals Number of uninitialized local variables
113 * localno Running Local-Number to be assigned
114 * eval_buf Internally-generated string to be parsed
115 * l_d_lineno Locals Declaration Line Number
116 *
117 **************************************************************************** */
118
119 static tic_hdr_t *local_names = NULL;
120 static int num_ilocals = 0;
121 static int num_ulocals = 0;
122 static int localno = 0;
123 static char eval_buf[64];
124 static unsigned int l_d_lineno; /* For Error Messages */
125
126 /* **************************************************************************
127 *
128 * The local_names vocabulary follows the same tic_hdr_t structure
129 * as the dictionaries of tokens, special-functions, etcetera. Its
130 * "parameter field" is an integer, used to store the Local's number,
131 * an its "function" is invoke_local(), defined further below.
132 *
133 * The vocabulary is initially empty, so there's no need for an "init"
134 * or a "reset" routine.
135 *
136 **************************************************************************** */
137
138 /* **************************************************************************
139 *
140 * Function name: int_to_str
141 * Synopsis: Convert an integer into a compilable string.
142 * Suport routine for invoke_local().
143 *
144 * Inputs:
145 * Parameters:
146 * num The number to convert
147 * bufr The buffer into which to place it.
148 * Needn't be very long:
149 * five at least, ten is enough
150 *
151 * Outputs:
152 * Returned Value: Pointer to bufr
153 * bufr Contents are changed.
154 *
155 * Process Explanation:
156 * Convert into decimal. If the number is greater than 8,
157 * prepend a d# in front of it. If less, don't.
158 * We specifically want to avoid a d# in front of
159 * the numbers 0 1 2 and 3, which are also named constants;
160 * there's no need to treat 'em as literals.
161 * The calling routine will be responsible for allocating
162 * and freeing the buffer.
163 *
164 * Extraneous Remarks:
165 * Too bad atoi() isn't a Standard C function; I could convert
166 * using the current base, and be guaranteed that it would be
167 * interpreted in the same base.
168 * Instead, I have to fiddle-faddle around with d# ...
169 *
170 **************************************************************************** */
171
int_to_str(int num,char * bufr)172 static char *int_to_str( int num, char *bufr)
173 {
174 char* prefix = "d# ";
175 if ( num < 8 ) prefix = "";
176 sprintf(bufr,"%s%d",prefix, num);
177 return (bufr);
178 }
179
180
181
182 /* **************************************************************************
183 *
184 * Function name: invoke_local
185 * Synopsis: Compile-in the code to access the Local whose
186 * assigned Number is given. This function is
187 * entered into the Local-Names Vocabulary entry.
188 *
189 * Inputs:
190 * Parameters:
191 * pfield The Vocabulary entry's Param field, taken
192 * from the Assigned Number of the Local.
193 * Local Static Variables:
194 * local_addr Name of _{local} routine, invoked
195 * when a Local is used
196 * local_op Fetch or Store operator to apply.
197 *
198 * Outputs:
199 * Returned Value: None
200 * Local Static Variables:
201 * eval_buf Phrase constructed here; will become new
202 * Source Input Buffer, temporarily
203 *
204 * Error Detection:
205 * If the Local Values Support FCode source-file was not
206 * FLOADed into the user's tokenization source, then
207 * the function _{local} will be an "unknown name".
208 *
209 * Process Explanation:
210 * We are going to generate a string of the form:
211 * " #local _{local} OP"
212 * and pass it to the Parser for evaluation.
213 * The call to _{local} is preceded by its parameter, which is
214 * its Assigned Local-Number, and followed by the appropriate
215 * OPerator, which will be "Fetch" if the Local's name was
216 * invoked by itself, or "Store" if its invocation was made
217 * in conjuction with the -> operator.
218 * The string-buffer may be local, but it must be stable.
219 *
220 * Revision History:
221 * Updated Thu, 24 Mar 2005 by David L. Paktor
222 * Factored-out to permit lookup_local() to be a "pure"
223 * function that can be used for duplicate-name detection.
224 * Updated Tue, 10 Jan 2006 by David L. Paktor
225 * Accommodate conversion to tic_hdr_t type vocabulary.
226 *
227 **************************************************************************** */
228
invoke_local(tic_param_t pfield)229 static void invoke_local( tic_param_t pfield )
230 {
231 char local_num_buf[10];
232 int loc_num = (int)pfield.deflt_elem;
233
234 int_to_str(loc_num, local_num_buf);
235 sprintf( eval_buf, "%s %s %s", local_num_buf, local_addr, local_op );
236 eval_string( eval_buf);
237
238 }
239
240
241 /* **************************************************************************
242 *
243 * Function name: locals_separator
244 * Synopsis: Test whether the given character is the separator
245 * between initted and uninitted Local Names.
246 * Optionally, allow Semi-Colon as a separator and issue
247 * an optional Advisory.
248 *
249 * Inputs:
250 * Parameters:
251 * subj One-character "subject" of the test
252 * Global Variables:
253 * ibm_locals_legacy_separator Allow Semi-Colon as a separator?
254 * ibm_legacy_separator_message Issue an Advisory message?
255 *
256 * Outputs:
257 * Returned Value: TRUE if the character is the separator
258 *
259 * Error Detection:
260 * If the separator is Semi-Colon, and ibm_locals_legacy_separator
261 * is TRUE, then if ibm_legacy_separator_message is TRUE,
262 * issue an Advisory message.
263 * If the flag to allow Semi-Colon is FALSE, then simply do not
264 * acknowledge a valid separator. Other routines will report
265 * an erroneous attempt to use an already-defined symbol.
266 *
267 * Revision History:
268 * Updated Wed, 13 Jul 2005 by David L. Paktor
269 * Bring the questions of whether to accept semicolon as a separator
270 * -- and whether to issue a message for it -- under the control
271 * of external flags (eventually set by command-line switches),
272 * rather than being hard-compiled.
273 *
274 * Extraneous Remarks:
275 * In the interest of avoiding too deeply nested "IF"s, I will
276 * not be adhering strictly to the rules of structure.
277 *
278 **************************************************************************** */
279
locals_separator(char subj)280 static bool locals_separator( char subj )
281 {
282 bool retval = FALSE;
283 /* Is it the preferred (i.e., non-legacy) separator? */
284 if ( subj == '|' )
285 {
286 retval = TRUE;
287 return ( retval );
288 }
289
290 if ( ibm_locals_legacy_separator )
291 {
292 if ( subj == ';' )
293 {
294 retval = TRUE;
295 if ( ibm_legacy_separator_message )
296 {
297 tokenization_error ( WARNING , "Semicolon as separator in "
298 "Locals declaration is deprecated in favor of '|'\n");
299 }
300 }
301 }
302 return ( retval );
303 }
304
305 /* **************************************************************************
306 *
307 * Function name: add_local
308 * Synopsis: Given a pointer to a name and a number, enter
309 * them into the vocabulary for new Local names.
310 *
311 * Inputs:
312 * Parameters:
313 * lnum The assigned number
314 * lname Pointer to the name
315 * Local Static Variables:
316 * local_names The vocabulary for new Local names
317 *
318 * Outputs:
319 * Returned Value: NONE
320 * Local Static Variables:
321 * local_names Enter the new Local's name and number.
322 * Memory Allocated:
323 * A place into which the name will be copied
324 * When Freed?
325 * When forget_locals() routine frees up all memory
326 * allocations in the "Local Names" Vocabulary.
327 *
328 * Process Explanation:
329 * Allocate a stable place in memory for the name, via strdup().
330 * The entry's "action" will be the invoke_local() function,
331 * defined above. The "parameter field" size is zero.
332 *
333 **************************************************************************** */
334
add_local(TIC_P_DEFLT_TYPE lnum,char * lname)335 static void add_local( TIC_P_DEFLT_TYPE lnum, char *lname)
336 {
337 char *lnamecopy ;
338
339 lnamecopy = strdup( lname);
340 add_tic_entry( lnamecopy, invoke_local, lnum,
341 LOCAL_VAL, 0, FALSE, NULL,
342 &local_names );
343 }
344
345
346 /* **************************************************************************
347 *
348 * Function name: gather_locals
349 * Synopsis: Collect Local names, for both initted and uninitted
350 * Return an indication as to whether to continue
351 * gathering Locals' names
352 *
353 * Inputs:
354 * Parameters:
355 * initted TRUE if we are gathering initted Local names.
356 * counter Pointer to variable that's counting names.
357 * Global Variables:
358 * statbuf The symbol just retrieved from the input stream.
359 * Local Static Variables:
360 * localno Running Local-Number to be assigned
361 * l_d_lineno Line # of Locals Declar'n start (for err mssg)
362 *
363 * Outputs:
364 * Returned Value: TRUE = Ended with initted/uninitted separator
365 * Local Static Variables:
366 * localno Incremented for each Local name declared
367 * local_names Enter the new locals' names into the Vocabulary.
368 * Numeric field is assigned local number.
369 *
370 * Error Detection:
371 * A Local-name that duplicates an existing name is an ERROR.
372 * Especially if that name is <Semicolon> and the flag
373 * called ibm_locals_legacy_separator was not set.
374 * Issue an Error if close-curly-brace terminator is not found,
375 * or if imbedded comment is not terminated, before end of file.
376 * If the Separator is found a second-or-more time, issue an Error
377 * and continue collecting uninitted Local names.
378 *
379 * Revision History:
380 * Updated Thu, 24 Mar 2005 by David L. Paktor
381 * Allow comments to be interspersed among the declarations.
382 * Error-check duplicate Local-name.
383 * Updated Wed, 30 Mar 2005 by David L. Paktor
384 * Warning when name length exceeds ANSI-specified max (31 chars).
385 * Updated Thu, 07 Jul 2005 by David L. Paktor
386 * Protect against PC pointer-overrun due to unterminated
387 * comment or declaration.
388 * Error-check for numbers.
389 * No name-length check; doesn't go into FCode anyway.
390 *
391 **************************************************************************** */
392
gather_locals(bool initted,int * counter)393 static bool gather_locals( bool initted, int *counter )
394 {
395 signed long wlen;
396 bool retval = FALSE;
397
398 while ( TRUE )
399 {
400 wlen = get_word();
401
402 if ( wlen <= 0 )
403 {
404 warn_unterm( TKERROR, "Local-Values Declaration", l_d_lineno);
405 break;
406 }
407
408 /* Allow comments to be interspersed among the declarations. */
409 if ( filter_comments( statbuf) )
410 {
411 /* Unterminated and Multi-line checking already handled */
412 continue;
413 }
414 /* Is this the terminator or the separator? */
415 if ( wlen == 1 ) /* Maybe */
416 {
417 /* Check for separator */
418 if (locals_separator( statbuf[0] ) )
419 {
420 /* If gathering initted Local names, separator is legit */
421 if ( initted )
422 {
423 retval = TRUE;
424 break;
425 }else{
426 tokenization_error ( TKERROR,
427 "Excess separator -- %s -- found "
428 "in Local-Values declaration", statbuf);
429 in_last_colon( TRUE);
430 continue;
431 }
432 }
433 /* Haven't found the separator. Check for the terminator */
434 if ( statbuf[0] == '}' )
435 {
436 break;
437 }
438 }
439 /* It was not the terminator or the separator */
440 {
441 long tmp;
442 char *where_pt1; char *where_pt2;
443 /* Error-check for duplicated names */
444 if ( word_exists ( statbuf, &where_pt1, &where_pt2 ) )
445 {
446 tokenization_error ( TKERROR, "Cannot declare %s "
447 "as a Local-Name; it's already defined %s%s",
448 statbuf, where_pt1, where_pt2 );
449 show_node_start();
450 continue;
451 }
452 /* Error-check for numbers. */
453 if ( get_number(&tmp) )
454 {
455 tokenization_error ( TKERROR, "Cannot declare %s "
456 "as a Local-Name; it's a number.\n", statbuf );
457 continue;
458 }
459
460 /* We've got a valid new local-name */
461 /* Don't need to check name length; it won't go into the FCode */
462
463 /* Increment our counting-v'ble */
464 *counter += 1;
465
466 /* Define our new local-name in the Locals' vocabulary */
467 add_local( localno, statbuf );
468
469 /* Bump the running Local-Number */
470 localno++;
471
472 }
473 }
474 return ( retval );
475 }
476
477
478 /* **************************************************************************
479 *
480 * Function name: activate_locals
481 * Synopsis: Compile-in the call to {push-locals} that
482 * the new definition under construction will need,
483 * now that the Locals have been declared.
484 *
485 * Inputs:
486 * Parameters: NONE
487 * Global Variables:
488 * num_ilocals First argument to {push-locals}
489 * num_ulocals Second argument to {push-locals}
490 * push_locals Name of {push-locals} routine.
491 *
492 * Outputs:
493 * Returned Value: NONE
494 * Local Static Variables:
495 * eval_buf Phrase constructed here; will become
496 * new Source Input Buffer, temporarily
497 *
498 * Error Detection:
499 * If the Local Values Support FCode source-file was not
500 * FLOADed into the user's tokenization source, then
501 * the function {push-locals} will be an "unknown name".
502 *
503 * Process Explanation:
504 * We are going to generate a string of the form:
505 * " #ilocals #ulocals {push-locals}"
506 * and pass it to the Parser for evaluation.
507 * The string-buffer may be local, but it must be stable.
508 *
509 * Question under consideration.:
510 * Do we want to check if {push-locals} is an unknown name,
511 * and give the user a hint of what's needed? And, if so,
512 * do we do it only once, or every time?
513 *
514 **************************************************************************** */
515
activate_locals(void)516 static void activate_locals( void )
517 {
518 char ilocals_buf[10];
519 char ulocals_buf[10];
520
521 int_to_str(num_ilocals, ilocals_buf );
522 int_to_str(num_ulocals, ulocals_buf );
523 sprintf( eval_buf,"%s %s %s",ilocals_buf, ulocals_buf, push_locals);
524 eval_string( eval_buf);
525 }
526
527 /* **************************************************************************
528 *
529 * Function name: error_check_locals
530 * Synopsis: Indicate whether Locals declaration is erronious
531 *
532 * Inputs:
533 * Parameters: NONE
534 * Global Variables:
535 * incolon TRUE if colon def'n is in effect.
536 * opc FCode Output buffer Position Counter
537 * lastcolon Value of opc when Colon def'n was started
538 *
539 * Outputs:
540 * Returned Value: TRUE if found errors severe enough to
541 * preclude further processing of Decl'n
542 *
543 * Errors Detected:
544 * Colon definition not in effect. ERROR and return TRUE.
545 * Locals declaration inside body of colon-definition (i.e., after
546 * something has been compiled-in to it) is potentially risky,
547 * but may be valid, and is a part of legacy practice. It
548 * will not be treated as an outright ERROR, but it will
549 * generate a WARNING...
550 * Multiple locals declarations inside a single colon-definition
551 * are completely disallowed. ERROR and return TRUE.
552 * Locals declaration inside a control-structure is prohibited.
553 * Generate an ERROR, but return FALSE to allow processing
554 * of the declaration to continue.
555 *
556 **************************************************************************** */
557
558 /* The value of lastcolon when Locals Declaration is made.
559 * If it's the same, that detects multiple locals declaration attempt.
560 */
561 static int last_local_colon = 0;
562
error_check_locals(void)563 static bool error_check_locals ( void )
564 {
565 bool retval = FALSE;
566
567 if ( ! incolon )
568 {
569 tokenization_error ( TKERROR,
570 "Can only declare Locals inside of a Colon-definition.\n");
571 retval = TRUE;
572 } else {
573 if ( last_local_colon == lastcolon )
574 {
575 tokenization_error ( TKERROR, "Excess Locals Declaration");
576 in_last_colon( TRUE);
577 retval = TRUE;
578 }else{
579 last_local_colon = lastcolon;
580 if ( opc > lastcolon )
581 {
582 tokenization_error ( WARNING,
583 "Declaring Locals after the body of a Colon-definition "
584 "has begun is not recommended.\n");
585 }
586 announce_control_structs( TKERROR,
587 "Local-Values Declaration encountered",
588 last_colon_abs_token_no);
589 }
590 }
591 return ( retval );
592 }
593
594 /* **************************************************************************
595 *
596 * Function name: declare_locals
597 * Synopsis: Process (or Ignore) the Declaration of Locals,
598 * upon encountering Curly-brace ( { )
599 *
600 * Inputs:
601 * Parameters:
602 * ignoring TRUE if "Ignoring"
603 * Global Variables:
604 * statbuf Next symbol to process.
605 * lineno Current Line Number in Input File
606 * report_multiline FALSE to suspend multiline warning
607 *
608 * Outputs:
609 * Returned Value: NONE
610 * Global Variables:
611 * statbuf Advanced to end of Locals Declaration.
612 * pc Bumped past the close-curly-brace
613 * Local Static Variables:
614 * localno Init'd, then updated by gather_locals()
615 * l_d_lineno Line Number of start of Locals Declaration
616 *
617 * Error Detection:
618 * See error_check_locals()
619 * After Error messages, will bypass further processing until the
620 * terminating close-curly-brace of a Locals Declaration.
621 * If the terminating close-curly-brace missing under those
622 * circumstances, issue an Error
623 * If terminating close-curly-brace is missing when the Locals
624 * Declaration is otherwise valid, gather_locals() will
625 * detect and report the Error.
626 * Warning if multiline declaration. Because embedded comments
627 * may also supppress the multiline warning, we need to save
628 * and restore the state of the report_multiline switch...
629 *
630 **************************************************************************** */
631
declare_locals(bool ignoring)632 void declare_locals ( bool ignoring)
633 {
634 num_ilocals = 0;
635 num_ulocals = 0;
636 localno = 0;
637
638 l_d_lineno = lineno;
639 bool sav_rep_mul_lin = report_multiline;
640 report_multiline = TRUE;
641
642 if ( ignoring || error_check_locals() )
643 {
644 if ( skip_until ( '}' ) )
645 {
646 warn_unterm(TKERROR,
647 "misplaced Local-Values Declaration", l_d_lineno);
648 }else{
649 pc++ ; /* Get past the close-curly-brace */
650 }
651 }else{
652 if (gather_locals( TRUE, &num_ilocals ) )
653 {
654 gather_locals( FALSE, &num_ulocals );
655 }
656 }
657
658 /* If PC has reached the END, gather_locals() will
659 * have already issued an "unterminated" Error;
660 * a "multiline" warning would be redundant
661 * repetitive, unnecessary, excessive, unaesthetic
662 * and -- did I already mention? -- redundant.
663 */
664 if ( pc < end )
665 {
666 report_multiline = sav_rep_mul_lin;
667 warn_if_multiline( "Local-Values declaration", l_d_lineno);
668 }
669
670 /* Don't do anything if no Locals were declared */
671 /* This could happen if the { } field is empty */
672 if ( localno != 0 )
673 {
674 activate_locals();
675 }
676 }
677
678 /* **************************************************************************
679 *
680 * Function name: handle_local
681 * Synopsis: Process the given name as a Local Name;
682 * indicate if it was a valid Local Name.
683 *
684 * Inputs:
685 * Parameters:
686 * lname The "Local" name for which to look
687 * Local Static Variables:
688 * local_names The vocabulary for Local names
689 *
690 * Outputs:
691 * Returned Value: TRUE if the name is a valid "Local Name"
692 *
693 **************************************************************************** */
694
handle_local(char * lname)695 static bool handle_local( char *lname)
696 {
697 bool retval = handle_tic_vocab( lname, local_names );
698 return ( retval ) ;
699 }
700
701 /* **************************************************************************
702 *
703 * Function name: lookup_local
704 * Synopsis: Return a pointer to the data-structure of the named
705 * word, only if it was a valid Local Name.
706 *
707 * Inputs:
708 * Parameters:
709 * lname The "Local" name for which to look
710 * Local Static Variables:
711 * local_names The vocabulary for Local names
712 *
713 * Outputs:
714 * Returned Value: Pointer to the data-structure, or
715 * NULL if not found.
716 *
717 **************************************************************************** */
718
lookup_local(char * lname)719 tic_hdr_t *lookup_local( char *lname)
720 {
721 tic_hdr_t *retval = lookup_tic_entry( lname, local_names );
722 return ( retval ) ;
723 }
724
725
726 /* **************************************************************************
727 *
728 * Function name: create_local_alias
729 * Synopsis: Create an alias in the "Local Names" Vocabulary
730 *
731 * Associated FORTH word: ALIAS
732 *
733 * Inputs:
734 * Parameters:
735 * old_name Name of existing entry
736 * new_name New name for which to create an entry
737 *
738 * Outputs:
739 * Returned Value: TRUE if old_name found in "Locals" vocab
740 * Global Variables:
741 * local_names Will point to the new entry
742 * Memory Allocated:
743 * Memory for the new entry, by the support routine
744 * When Freed?
745 * When forget_locals() routine frees up all memory
746 * allocations in the "Local Names" Vocabulary.
747 *
748 **************************************************************************** */
749
create_local_alias(char * new_name,char * old_name)750 bool create_local_alias(char *new_name, char *old_name)
751 {
752 bool retval = create_tic_alias( new_name, old_name, &local_names );
753 return ( retval );
754 }
755
756 /* **************************************************************************
757 *
758 * Function name: exists_as_local
759 * Synopsis: Simply confirm whether a given name exists
760 * within the Locals vocabulary.
761 *
762 * Inputs:
763 * Parameters:
764 * stat_name Name to look up
765 *
766 * Outputs:
767 * Returned Value: TRUE if stat_name was a Local
768 *
769 **************************************************************************** */
770
exists_as_local(char * stat_name)771 bool exists_as_local( char *stat_name )
772 {
773 bool retval = exists_in_tic_vocab(stat_name, local_names );
774 return ( retval );
775 }
776
777
778 /* **************************************************************************
779 *
780 * Function name: assign_local
781 * Synopsis: Process the "Assign to a Local" operator ( -> )
782 *
783 * Inputs:
784 * Parameters: NONE
785 * Global Variables:
786 * statbuf Next symbol to process
787 * pc Input-source Scanning pointer
788 * lineno Input-source Line Number. Used for Err Mssg.
789 *
790 * Outputs:
791 * Returned Value: NONE
792 * Global Variables:
793 * statbuf Advanced to next symbol
794 * pc Advanced; may be unchanged if error.
795 * lineno Advanced; may be unchanged if error
796 * local_op Will be set to Store and then reset to Fetch.
797 * Global Behavior:
798 * Construct a phrase and pass it to the Tokenizer.
799 *
800 * Error Detection:
801 * If next symbol is not a Local name, print ERROR message
802 * and restore pc so that the next symbol will be
803 * processed by ordinary means.
804 * In the extremely unlikely case that -> is last symbol in
805 * the source-file, report an ERROR.
806 *
807 * Process Explanation:
808 * Save the PC.
809 * Get the next symbol; check for end-of-file.
810 * Set Local Operator ( local_op ) to "Store", to prepare to apply it.
811 * Pass the next symbol to handle_local() .
812 * If handle_local() failed to find the name, you have
813 * detected an error; restore pc .
814 * Otherwise, you have invoked the local and applied "Store" to it.
815 * At the end, reset local_op to "Fetch".
816 *
817 **************************************************************************** */
818
assign_local(void)819 void assign_local ( void )
820 {
821 signed long wlen;
822 bool is_okay;
823 u8 *savd_pc = pc;
824 unsigned int savd_lineno = lineno;
825
826 wlen = get_word();
827
828 if ( wlen <= 0 )
829 {
830 warn_unterm(TKERROR, "Locals Assignment", lineno);
831 return;
832 }
833
834 local_op = "!"; /* Set to Store */
835
836 is_okay = handle_local( statbuf);
837 if( INVERSE(is_okay) )
838 {
839 tokenization_error ( TKERROR,
840 "Cannot apply -> to %s, only to a declared Local.\n", statbuf );
841 pc = savd_pc;
842 lineno = savd_lineno;
843 }
844 local_op = "@"; /* Reset to Fetch */
845 }
846
847 /* **************************************************************************
848 *
849 * Function name: finish_locals
850 * Synopsis: Compile-in the call to {pop-locals} that the
851 * new definition under construction will need
852 * when it's about to complete execution, i.e.,
853 * before an EXIT or a SemiColon. But only if the
854 * current definition under construction is using Locals.
855 *
856 * Inputs:
857 * Parameters: NONE
858 *
859 * Local Static Variables:
860 * localno Total # of Locals.
861 * Both a param to {pop-locals}
862 * and an indicator that Locals are in use.
863 * pop_locals Name of {pop-locals} routine.
864 *
865 * Outputs:
866 * Returned Value: NONE
867 * Local Static Variables:
868 * eval_buf Phrase constructed here; will become new
869 * Source Input Buffer, temporarily
870 *
871 * Error Detection:
872 * If the Local Values Support FCode source-file was not
873 * FLOADed into the user's tokenization source, then
874 * the function {pop-locals} will be an "unknown name".
875 *
876 * Revision History:
877 * Updated Fri, 24 Feb 2006 by David L. Paktor
878 * The eval_string() routine no longer calls its own
879 * instance of tokenize() . In order to make a
880 * smooth transition between the processing the
881 * internally-generated string and the resumption
882 * of processing the source file, it simply sets
883 * up the string to be processed next.
884 * In this case, however, we need to have the string
885 * processed right away, as the calling routine
886 * emits a token that must follow those generated
887 * by this.
888 * Fortunately, we know the exact contents of the string.
889 * Two calls to tokenize_one_word() will satisfy the
890 * requirement.
891 *
892 **************************************************************************** */
893
finish_locals(void)894 void finish_locals ( void )
895 {
896 /* Don't do anything if Locals are not in use */
897 if ( localno > 0 )
898 {
899 char nlocals_buf[10];
900
901 int_to_str(localno, nlocals_buf );
902 sprintf( eval_buf,"%s %s",nlocals_buf, pop_locals);
903 eval_string( eval_buf);
904 tokenize_one_word( get_word() );
905 tokenize_one_word( get_word() );
906 }
907 }
908
909 /* **************************************************************************
910 *
911 * Function name: forget_locals
912 * Synopsis: Remove the Locals' names from the special Vocabulary
913 * free-up their allocated memory, and reset the Locals'
914 * counters (which are also the indication that Locals
915 * are in use). This is done at the time a SemiColon
916 * is processed. But only if the current definition
917 * under construction is using Locals.
918 *
919 * Inputs:
920 * Parameters: NONE
921 * Local Static Variables:
922 * local_names The vocabulary for new Local names
923 *
924 * Outputs:
925 * Returned Value: NONE
926 * Local Static Variables:
927 * local_names Emptied and pointing at NULL.
928 * num_ilocals Reset to zero
929 * num_ulocals ditto
930 * localno ditto
931 * Memory Freed
932 * All memory allocations in the "Local Names" Vocabulary.
933 *
934 **************************************************************************** */
935
forget_locals(void)936 void forget_locals ( void )
937 {
938 /* Don't do anything if Locals are not in use */
939 if ( localno != 0 )
940 {
941 reset_tic_vocab( &local_names, NULL ) ;
942
943 num_ilocals = 0;
944 num_ulocals = 0;
945 localno = 0;
946 }
947 }
948