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 :
172 : static char *int_to_str( int num, char *bufr)
173 862 : {
174 862 : char* prefix = "d# ";
175 862 : if ( num < 8 ) prefix = "";
176 862 : sprintf(bufr,"%s%d",prefix, num);
177 862 : 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 :
229 : static void invoke_local( tic_param_t pfield )
230 618 : {
231 : char local_num_buf[10];
232 618 : int loc_num = (int)pfield.deflt_elem;
233 :
234 618 : int_to_str(loc_num, local_num_buf);
235 618 : sprintf( eval_buf, "%s %s %s", local_num_buf, local_addr, local_op );
236 618 : eval_string( eval_buf);
237 :
238 618 : }
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 :
280 : static bool locals_separator( char subj )
281 166 : {
282 166 : bool retval = FALSE;
283 : /* Is it the preferred (i.e., non-legacy) separator? */
284 166 : if ( subj == '|' )
285 : {
286 49 : retval = TRUE;
287 49 : return ( retval );
288 : }
289 :
290 117 : if ( ibm_locals_legacy_separator )
291 : {
292 108 : if ( subj == ';' )
293 : {
294 17 : retval = TRUE;
295 17 : if ( ibm_legacy_separator_message )
296 : {
297 14 : tokenization_error ( WARNING , "Semicolon as separator in "
298 : "Locals declaration is deprecated in favor of '|'\n");
299 : }
300 : }
301 : }
302 117 : 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 :
335 : static void add_local( TIC_P_DEFLT_TYPE lnum, char *lname)
336 336 : {
337 : char *lnamecopy ;
338 :
339 336 : lnamecopy = strdup( lname);
340 336 : add_tic_entry( lnamecopy, invoke_local, lnum,
341 : LOCAL_VAL, 0, FALSE, NULL,
342 : &local_names );
343 336 : }
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 :
393 : static bool gather_locals( bool initted, int *counter )
394 137 : {
395 : signed long wlen;
396 137 : bool retval = FALSE;
397 :
398 : while ( TRUE )
399 : {
400 683 : wlen = get_word();
401 :
402 683 : if ( wlen <= 0 )
403 : {
404 6 : warn_unterm( TKERROR, "Local-Values Declaration", l_d_lineno);
405 6 : break;
406 : }
407 :
408 : /* Allow comments to be interspersed among the declarations. */
409 677 : if ( filter_comments( statbuf) )
410 : {
411 : /* Unterminated and Multi-line checking already handled */
412 115 : continue;
413 : }
414 : /* Is this the terminator or the separator? */
415 562 : if ( wlen == 1 ) /* Maybe */
416 : {
417 : /* Check for separator */
418 166 : if (locals_separator( statbuf[0] ) )
419 : {
420 : /* If gathering initted Local names, separator is legit */
421 66 : if ( initted )
422 : {
423 61 : retval = TRUE;
424 61 : break;
425 : }else{
426 5 : tokenization_error ( TKERROR,
427 : "Excess separator -- %s -- found "
428 : "in Local-Values declaration", statbuf);
429 5 : in_last_colon( TRUE);
430 5 : continue;
431 : }
432 : }
433 : /* Haven't found the separator. Check for the terminator */
434 100 : if ( statbuf[0] == '}' )
435 : {
436 70 : 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 426 : if ( word_exists ( statbuf, &where_pt1, &where_pt2 ) )
445 : {
446 87 : tokenization_error ( TKERROR, "Cannot declare %s "
447 : "as a Local-Name; it's already defined %s%s",
448 : statbuf, where_pt1, where_pt2 );
449 87 : show_node_start();
450 87 : continue;
451 : }
452 : /* Error-check for numbers. */
453 339 : if ( get_number(&tmp) )
454 : {
455 3 : tokenization_error ( TKERROR, "Cannot declare %s "
456 : "as a Local-Name; it's a number.\n", statbuf );
457 3 : 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 336 : *counter += 1;
465 :
466 : /* Define our new local-name in the Locals' vocabulary */
467 336 : add_local( localno, statbuf );
468 :
469 : /* Bump the running Local-Number */
470 336 : localno++;
471 :
472 : }
473 : }
474 137 : 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 :
516 : static void activate_locals( void )
517 76 : {
518 : char ilocals_buf[10];
519 : char ulocals_buf[10];
520 :
521 76 : int_to_str(num_ilocals, ilocals_buf );
522 76 : int_to_str(num_ulocals, ulocals_buf );
523 76 : sprintf( eval_buf,"%s %s %s",ilocals_buf, ulocals_buf, push_locals);
524 76 : eval_string( eval_buf);
525 76 : }
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 :
563 : static bool error_check_locals ( void )
564 81 : {
565 81 : bool retval = FALSE;
566 :
567 81 : if ( ! incolon )
568 : {
569 4 : tokenization_error ( TKERROR,
570 : "Can only declare Locals inside of a Colon-definition.\n");
571 4 : retval = TRUE;
572 : } else {
573 77 : if ( last_local_colon == lastcolon )
574 : {
575 1 : tokenization_error ( TKERROR, "Excess Locals Declaration");
576 1 : in_last_colon( TRUE);
577 1 : retval = TRUE;
578 : }else{
579 76 : last_local_colon = lastcolon;
580 76 : if ( opc > lastcolon )
581 : {
582 5 : tokenization_error ( WARNING,
583 : "Declaring Locals after the body of a Colon-definition "
584 : "has begun is not recommended.\n");
585 : }
586 76 : announce_control_structs( TKERROR,
587 : "Local-Values Declaration encountered",
588 : last_colon_abs_token_no);
589 : }
590 : }
591 81 : 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 :
632 : void declare_locals ( bool ignoring)
633 91 : {
634 91 : num_ilocals = 0;
635 91 : num_ulocals = 0;
636 91 : localno = 0;
637 :
638 91 : l_d_lineno = lineno;
639 91 : bool sav_rep_mul_lin = report_multiline;
640 91 : report_multiline = TRUE;
641 :
642 91 : if ( ignoring || error_check_locals() )
643 : {
644 15 : if ( skip_until ( '}' ) )
645 : {
646 2 : warn_unterm(TKERROR,
647 : "misplaced Local-Values Declaration", l_d_lineno);
648 : }else{
649 13 : pc++ ; /* Get past the close-curly-brace */
650 : }
651 : }else{
652 76 : if (gather_locals( TRUE, &num_ilocals ) )
653 : {
654 61 : 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 91 : if ( pc < end )
665 : {
666 83 : report_multiline = sav_rep_mul_lin;
667 83 : 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 91 : if ( localno != 0 )
673 : {
674 76 : activate_locals();
675 : }
676 91 : }
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 :
695 : static bool handle_local( char *lname)
696 103 : {
697 103 : bool retval = handle_tic_vocab( lname, local_names );
698 103 : 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 :
719 : tic_hdr_t *lookup_local( char *lname)
720 16576 : {
721 16576 : tic_hdr_t *retval = lookup_tic_entry( lname, local_names );
722 16576 : 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 :
750 : bool create_local_alias(char *new_name, char *old_name)
751 163 : {
752 163 : bool retval = create_tic_alias( new_name, old_name, &local_names );
753 163 : 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 :
771 : bool exists_as_local( char *stat_name )
772 50 : {
773 50 : bool retval = exists_in_tic_vocab(stat_name, local_names );
774 50 : 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 :
819 : void assign_local ( void )
820 107 : {
821 : signed long wlen;
822 : bool is_okay;
823 107 : u8 *savd_pc = pc;
824 107 : unsigned int savd_lineno = lineno;
825 :
826 107 : wlen = get_word();
827 :
828 107 : if ( wlen <= 0 )
829 : {
830 4 : warn_unterm(TKERROR, "Locals Assignment", lineno);
831 4 : return;
832 : }
833 :
834 103 : local_op = "!"; /* Set to Store */
835 :
836 103 : is_okay = handle_local( statbuf);
837 103 : if( INVERSE(is_okay) )
838 : {
839 6 : tokenization_error ( TKERROR,
840 : "Cannot apply -> to %s, only to a declared Local.\n", statbuf );
841 6 : pc = savd_pc;
842 6 : lineno = savd_lineno;
843 : }
844 103 : 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 :
894 : void finish_locals ( void )
895 585 : {
896 : /* Don't do anything if Locals are not in use */
897 585 : if ( localno > 0 )
898 : {
899 : char nlocals_buf[10];
900 :
901 92 : int_to_str(localno, nlocals_buf );
902 92 : sprintf( eval_buf,"%s %s",nlocals_buf, pop_locals);
903 92 : eval_string( eval_buf);
904 92 : tokenize_one_word( get_word() );
905 92 : tokenize_one_word( get_word() );
906 : }
907 585 : }
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 :
936 : void forget_locals ( void )
937 567 : {
938 : /* Don't do anything if Locals are not in use */
939 567 : if ( localno != 0 )
940 : {
941 74 : reset_tic_vocab( &local_names, NULL ) ;
942 :
943 74 : num_ilocals = 0;
944 74 : num_ulocals = 0;
945 74 : localno = 0;
946 : }
947 567 : }
|
