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