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 : * Support Functions for tokenizing FORTH Flow-Control structures.
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 : * These first two do their work after the calling routine
38 : * has written the token for the required variant:
39 : *
40 : * mark_do Mark branches for "do" variants
41 : * resolve_loop Resolve "loop" variants' branches
42 : *
43 : * The remaining routines' descriptions are all similar:
44 : * Write the token(s), handle the outputs, mark
45 : * or resolve the branches, and verify correct
46 : * control-structure matching, for tokenizing
47 : * the ........................ statement in FORTH
48 : * emit_if IF
49 : * emit_else ELSE
50 : * emit_then THEN
51 : * emit_begin BEGIN
52 : * emit_again AGAIN
53 : * emit_until UNTIL
54 : * emit_while WHILE
55 : * emit_repeat REPEAT
56 : * emit_case CASE
57 : * emit_of OF
58 : * emit_endof ENDOF
59 : * emit_endcase ENDCASE
60 : *
61 : * Three additional routines deal with matters of overall balance
62 : * of the Control-Structures, and identify the start of any that
63 : * were not balanced. The first just displays Messages:
64 : *
65 : * announce_control_structs
66 : *
67 : * The other two clear and re-balance them:
68 : *
69 : * clear_control_structs_to_limit
70 : * clear_control_structs
71 : *
72 : **************************************************************************** */
73 :
74 : /* **************************************************************************
75 : *
76 : * Still to be done:
77 : * Correct analysis of Return-Stack usage around Flow-Control
78 : * constructs, including within Do-Loops or before Loop
79 : * Elements like I and J or UNLOOP or LEAVE.
80 : * Similarly, Return-Stack usage around IF ... ELSE ... THEN
81 : * statements needs analysis. For instance, the following:
82 : *
83 : * blablabla >R yadayada IF R> gubble ELSE flubble R> THEN
84 : *
85 : * is, in fact, correct, while something like:
86 : *
87 : * blablabla >R yadayada IF R> gubble THEN
88 : *
89 : * is an error.
90 : *
91 : * Implementing an analysis that would be sufficiently accurate
92 : * to justify reporting an ERROR with certainty (rather than
93 : * a mere WARNING speculatively) would probably require full
94 : * coordination with management of Flow-Control constructs,
95 : * and so is noted here.
96 : *
97 : **************************************************************************** */
98 :
99 : #include <stdlib.h>
100 : #include <stdio.h>
101 : #include <string.h>
102 :
103 : #include "types.h"
104 : #include "toke.h"
105 : #include "emit.h"
106 : #include "vocabfuncts.h"
107 : #include "scanner.h"
108 : #include "stack.h"
109 : #include "errhandler.h"
110 : #include "flowcontrol.h"
111 : #include "stream.h"
112 :
113 : /* **************************************************************************
114 : *
115 : * Global Variables Imported
116 : * opc FCode Output Buffer Position Counter
117 : * noerrors "Ignore Errors" flag, set by "-i" switch
118 : * do_loop_depth How deep we are inside DO ... LOOP variants
119 : * incolon State of tokenization; TRUE if inside COLON
120 : * statbuf The word just read from the input stream
121 : * iname Name of input file currently being processed
122 : * lineno Current line-number being processed
123 : *
124 : **************************************************************************** */
125 :
126 : /* **************************************************************************
127 : *
128 : * Global Variables Exported
129 : * control_stack_depth Number of items on "Control-Stack"
130 : *
131 : **************************************************************************** */
132 :
133 : int control_stack_depth = 0;
134 :
135 :
136 : /* **************************************************************************
137 : *
138 : * Internal Static Functions:
139 : * push_cstag Push an item onto the Control-Stack
140 : * pop_cstag Pop one item from the Control-Stack
141 : * control_stack_size_test Test C-S depth; report if error
142 : * control_structure_mismatch Print error-message
143 : * offset_too_large Print error-message
144 : * matchup_control_structure Error-check Control-Stack
145 : * matchup_two_control_structures Error-check two Control-Stack entries
146 : * emit_fc_offset Error-check and output FCode-Offset
147 : * control_structure_swap Swap control-struct branch-markers
148 : * mark_backward_target Mark target of backward-branch
149 : * resolve_backward Resolve backward-target for branch
150 : * mark_forward_branch Mark forward-branch
151 : * resolve_forward Resolve forward-branch at target
152 : *
153 : **************************************************************************** */
154 :
155 : /* **************************************************************************
156 : *
157 : * Internal Named Constants
158 : * Note: These control-structure identifier tags -- a.k.a. cstags --
159 : * are used to identify the matching components of particular
160 : * control-structures. They are passed as parameters, and either
161 : * "Pushed" onto the "Control-Stack", or compared with what is on
162 : * "Top" of the "Control-Stack", as an error-check.
163 : *
164 : * name used by forth words:
165 : * BEGIN_CSTAG BEGIN AGAIN UNTIL REPEAT
166 : * IF_CSTAG IF ELSE THEN
167 : * WHILE_CSTAG WHILE REPEAT THEN
168 : * DO_CSTAG DO ?DO LOOP +LOOP
169 : * CASE_CSTAG CASE OF ENDCASE
170 : * OF_CSTAG OF ENDOF
171 : * ENDOF_CSTAG ENDOF ENDCASE
172 : *
173 : * The numbers assigned are arbitrary; they were selected for a
174 : * high unlikelihood of being encountered in normal usage,
175 : * and constructed with a hint of mnemonic value in mind.
176 : *
177 : **************************************************************************** */
178 : /* Mnemonic: */
179 : #define BEGIN_CSTAG 0xC57be916 /* CST BEGIN */
180 : #define IF_CSTAG 0xC57A901f /* CSTAG (0) IF */
181 : #define WHILE_CSTAG 0xC573412e /* CST WHILE */
182 : #define DO_CSTAG 0xC57A90d0 /* CSTAG (0) DO */
183 : #define CASE_CSTAG 0xC57Aca5e /* CSTA CASE */
184 : #define OF_CSTAG 0xC57A90f0 /* CSTAG OF (0) */
185 : #define ENDOF_CSTAG 0xC57e6d0f /* CST ENDOF */
186 :
187 :
188 : /* **************************************************************************
189 : *
190 : * Control-Structure identification, matching, completion and error
191 : * messaging will be supported by a data structure, which we
192 : * will call a CSTAG-Group
193 : *
194 : * It consists of one "Data-item" and several "Marker" items, thus:
195 : *
196 : * The Data-item in most cases will be a value of OPC (the Output
197 : * Buffer Position Counter) which will be used in calculating
198 : * an offset or placing an offset or both, as the case may be,
199 : * for the control structure in question. The one exception
200 : * is for a CSTAG-Group generated by a CASE statement; its
201 : * Data-item will be an integer count of the number of "OF"s
202 : * to be resolved when the ENDCASE statement is reached.
203 : *
204 : * The CSTAG for the FORTH word, as described above
205 : * The name of the input file in which the word was encountered
206 : * (actually, a pointer to a mem-alloc'ed copy of the filename)
207 : * The line number, within the input file, of the word's invocation
208 : * The Absolute Token Number in all Source Input of the word
209 : * The FORTH word that started the structure, (used in error messages)
210 : * A flag to indicate when two CSTAG-Groups are created together,
211 : * which will be used to prevent duplicate error messages when,
212 : * for instance, a DO is mismatched with a REPEAT .
213 : *
214 : **************************************************************************** */
215 :
216 : /* **************************************************************************
217 : *
218 : * "Control-Stack" Diagram Notation
219 : *
220 : * The CSTAG-Groups will be kept in an order resembling a data-stack,
221 : * (even though it won't be the data-stack itself). We will refer
222 : * to this list of structures as the "Control Stack", and in our
223 : * comments we will show their arrangement in a format resembling
224 : * stack-diagram remarks.
225 : *
226 : * In these "Control-Stack Diagrams", we will use the notation:
227 : * <Stmt>_{FOR|BACK}w_<TAGNAM>
228 : * to represent a CSTAG-Group generated by a <Stmt> -type of
229 : * statement, with a "FORw"ard or "BACKw"ard branch-marker and
230 : * a CSTAG of the <TAGNAM> type.
231 : *
232 : * A CASE-CSTAG-Group will have a different notation:
233 : * N_OFs...CASE_CSTAG
234 : *
235 : * In all cases, a CSTAG-Group will be manipulated as a unit.
236 : *
237 : * The notation for Control-Stack Diagram remarks will largely resemble
238 : * the classic form used in FORTH, i.e., enclosed in parentheses,
239 : * lowest item to the left, top item on the right, with a double-
240 : * hyphen to indicate "before" or "after".
241 : *
242 : * Enclosure in {curly-braces} followed by a subscript-range indicates
243 : * that the Stack-item or Group is repeated.
244 : *
245 : **************************************************************************** */
246 :
247 : /* **************************************************************************
248 : *
249 : * We are not keeping the "Control Stack" structures on the regular
250 : * data stack because a sneaky combination of user-inputs could
251 : * throw things into chaos were we to use that scheme. Consider
252 : * what would happen if a number were put on the stack, say, in
253 : * tokenizer-escape mode, in between elements of a flow-control
254 : * structure... Theoretically, there is no reason to prohibit
255 : * that, but it would be unexpectedly problematical for most
256 : * FORTH-based tokenizers.
257 : *
258 : * Maintaining the "Control Stack" structures in a linked-list would
259 : * be a more nearly bullet-proof approach. The theory of operation
260 : * would be the same, broadly speaking, and there would be no need
261 : * to check for NOT_CSTAG and no risk of getting the elements of
262 : * the control-structures out of sync.
263 : *
264 : **************************************************************************** */
265 :
266 : /* **************************************************************************
267 : *
268 : * Structure Name: cstag_group_t
269 : * Synopsis: Control-Structure Tag Group
270 : *
271 : * Fields:
272 : * cs_tag Control-structure identifier tag
273 : * cs_inp_fil Name of input file where C-S was started
274 : * cs_line_num Line-number in Current Source when C-S was started
275 : * cs_abs_token_num "Absolute" Token Number when C-S was started
276 : * cs_word The FORTH word that started the C-S
277 : * cs_not_dup FALSE if second "Control Stack" entry for same word
278 : * cs_datum Data-Item of the Group
279 : * prev Pointer to previous CSTAG-Group in linked-list
280 : *
281 : * All data using this structure will remain private to this file,
282 : * so we declare it here rather than in the .h file
283 : *
284 : **************************************************************************** */
285 :
286 : typedef struct cstag_group {
287 : unsigned long cs_tag;
288 : char *cs_inp_fil;
289 : unsigned int cs_line_num;
290 : unsigned int cs_abs_token_num;
291 : char *cs_word;
292 : bool cs_not_dup;
293 : unsigned long cs_datum;
294 : struct cstag_group *prev;
295 : } cstag_group_t;
296 :
297 : /* **************************************************************************
298 : *
299 : * Internal Static Variables
300 : * control_stack "Thread" Pointer to the linked-list of
301 : * "Control Stack" structure entries
302 : * not_cs_underflow Flag used to prevent duplicate messages
303 : * not_consuming_two Flag used to prevent loss of messages
304 : * didnt_print_otl Flag used to prevent duplicate messages
305 : *
306 : **************************************************************************** */
307 :
308 : static cstag_group_t *control_stack = NULL; /* "Top" of the "Stack" */
309 :
310 : /* **************************************************************************
311 : *
312 : * not_cs_underflow is used only by routines that make two calls to
313 : * resolve a marker. It is set TRUE before the first call; if
314 : * that call had a control-stack underflow, the error-message
315 : * routine resets it to FALSE. The calling routine can then
316 : * test it as the condition for the second call.
317 : * Routines that make only one call to resolve a marker can ignore it.
318 : *
319 : **************************************************************************** */
320 :
321 : static bool not_cs_underflow; /* No need to initialize. */
322 :
323 : /* **************************************************************************
324 : *
325 : * not_consuming_two is also used only by routines that make two calls
326 : * to resolve a marker, but for this case, those routines only need
327 : * to reset it to FALSE and not to test it; that will be done by
328 : * the control_structure_mismatch() routine when it looks at
329 : * the cs_not_dup field. If the mismatch occurred because of
330 : * a combination of control-structures that consume one each,
331 : * the message will be printed even for the second "Control Stack"
332 : * entry. The routine that changed it will have to set it back to
333 : * TRUE when it's done with it.
334 : *
335 : * didnt_print_otl is used similarly, but only for the offset-too-large
336 : * error in the DO ... LOOP type of control-structures.
337 : *
338 : **************************************************************************** */
339 :
340 : static bool not_consuming_two = TRUE;
341 : static bool didnt_print_otl = TRUE;
342 :
343 :
344 : /* **************************************************************************
345 : *
346 : * Function name: push_cstag
347 : * Synopsis: Push a new CSTAG-Group onto the front ("Top")
348 : * of the (notional) Control-Stack.
349 : *
350 : * Inputs:
351 : * Parameters:
352 : * cstag ID Tag for Control-Structure to "Push"
353 : * datum The Data-Item for the new CSTAG-Group
354 : * Global Variables:
355 : * iname Name of input file currently being processed
356 : * lineno Current-Source line-number being processed
357 : * abs_tokenno "Absolute"Token Number of word being processed
358 : * statbuf The word just read, which started the C-S
359 : * Local Static Variables:
360 : * control_stack Will become the new entry's "prev"
361 : *
362 : * Outputs:
363 : * Returned Value: None
364 : * Global Variables:
365 : * control_stack_depth Incremented
366 : * Local Static Variables:
367 : * control_stack Will become the "previous" entry in the list
368 : * Items Pushed onto Control-Stack:
369 : * Top: A new CSTAG-Group, params as given
370 : * Memory Allocated
371 : * New CSTAG-Group structure
372 : * Duplicate of name of current input file
373 : * Duplicate of word just read
374 : * When Freed?
375 : * When Removing a CSTAG-Group, in pop_cstag()
376 : *
377 : **************************************************************************** */
378 :
379 : static void push_cstag( unsigned long cstag, unsigned long datum)
380 3077 : {
381 : cstag_group_t *cs_temp;
382 :
383 3077 : cs_temp = control_stack;
384 3077 : control_stack = safe_malloc( sizeof(cstag_group_t), "pushing CSTag");
385 :
386 3077 : control_stack->cs_tag = cstag;
387 3077 : control_stack->cs_inp_fil = strdup(iname);
388 3077 : control_stack->cs_line_num = lineno;
389 3077 : control_stack->cs_abs_token_num = abs_token_no;
390 3077 : control_stack->cs_word = strdup(statbuf);
391 3077 : control_stack->cs_not_dup = TRUE;
392 3077 : control_stack->cs_datum = datum;
393 3077 : control_stack->prev = cs_temp;
394 :
395 3077 : control_stack_depth++;
396 :
397 3077 : }
398 :
399 : /* **************************************************************************
400 : *
401 : * Function name: pop_cstag
402 : * Synopsis: Remove a CSTAG-Group from the front ("Top") of the
403 : * (notional) Control-Stack.
404 : *
405 : * Inputs:
406 : * Parameters: NONE
407 : * Global Variables:
408 : * Local Static Variables:
409 : * control_stack CSTAG-Group on "Top"
410 : *
411 : * Outputs:
412 : * Returned Value: NONE
413 : * Global Variables:
414 : * control_stack_depth Decremented
415 : * Local Static Variables:
416 : * control_stack "Previous" entry will become current
417 : * Memory Freed
418 : * mem-alloc'ed copy of input filename
419 : * mem-alloc'ed copy of Control-structure FORTH word
420 : * CSTAG-Group structure
421 : * Control-Stack, # of Items Popped: 1
422 : *
423 : * Process Explanation:
424 : * The calling routine might not check for empty Control-Stack,
425 : * so we have to be sure and check it here.
426 : *
427 : **************************************************************************** */
428 :
429 : static void pop_cstag( void)
430 3089 : {
431 :
432 3089 : if ( control_stack != NULL )
433 : {
434 : cstag_group_t *cs_temp;
435 :
436 3077 : cs_temp = control_stack->prev;
437 3077 : free( control_stack->cs_word );
438 3077 : free( control_stack->cs_inp_fil );
439 3077 : free( control_stack );
440 3077 : control_stack = cs_temp;
441 :
442 3077 : control_stack_depth--;
443 : }
444 3089 : }
445 :
446 : /* **************************************************************************
447 : *
448 : * Function name: control_stack_size_test
449 : * Synopsis: Detect Control Stack underflow; report if an ERROR.
450 : *
451 : * Inputs:
452 : * Parameters:
453 : * min_depth Minimum depth needed
454 : * Global Variables:
455 : * control_stack_depth Current depth of Control Stack
456 : * statbuf Word to name in error message
457 : *
458 : * Outputs:
459 : * Returned Value: TRUE if adequate depth
460 : * Local Static Variables:
461 : * not_cs_underflow Reset to FALSE if underflow detected.
462 : * Printout:
463 : * Error message is printed.
464 : * Identify the colon definition if inside one.
465 : *
466 : * Process Explanation:
467 : * Some statements need more than one item on the Control Stack;
468 : * they will do their own control_stack_depth testing and
469 : * make a separate call to this routine.
470 : *
471 : **************************************************************************** */
472 :
473 : static bool control_stack_size_test( int min_depth )
474 9955 : {
475 9955 : bool retval = TRUE;
476 :
477 9955 : if ( control_stack_depth < min_depth )
478 : {
479 17 : retval = FALSE;
480 17 : tokenization_error ( TKERROR,
481 : "Control-Stack underflow at %s", strupr(statbuf) );
482 17 : in_last_colon();
483 :
484 17 : not_cs_underflow = FALSE; /* See expl'n early on in this file */
485 : }
486 :
487 9955 : return( retval );
488 : }
489 :
490 : /* **************************************************************************
491 : *
492 : * Function name: control_structure_mismatch
493 : * Synopsis: Report an ERROR after a Control Structure mismatch
494 : * was detected.
495 : *
496 : * Inputs:
497 : * Parameters: NONE
498 : * Global Variables:
499 : * statbuf Word encountered, to name in error message
500 : * Local Static Variables:
501 : * control_stack "Pushed" Control-Structure Tag Group
502 : * not_consuming_two See explanation early on in this file
503 : * Control-Stack Items:
504 : * Top: "Current" Control-Structure Tag Group
505 : * Some of its "Marker" information
506 : * will be used in the error message
507 : *
508 : * Outputs:
509 : * Returned Value: NONE
510 : * Printout:
511 : * Error message is printed
512 : *
513 : * Process Explanation:
514 : * This routine is called after a mismatch is detected, and
515 : * before the CSTAG-Group is "Popped" from the notional
516 : * Control-Stack.
517 : * If the control_stack pointer is NULL, print a different
518 : * Error message
519 : * Don't print if the "Control Stack" entry is a duplicate and
520 : * we're processing a statement that consumes two entries.
521 : *
522 : **************************************************************************** */
523 :
524 : static void control_structure_mismatch( void )
525 51 : {
526 51 : if ( control_stack->cs_not_dup || not_consuming_two )
527 : {
528 48 : tokenization_error ( TKERROR,
529 : "The %s is mismatched with the %s" ,
530 : strupr(statbuf), strupr(control_stack->cs_word));
531 48 : where_started( control_stack->cs_inp_fil, control_stack->cs_line_num );
532 : }
533 51 : }
534 :
535 :
536 : /* **************************************************************************
537 : *
538 : * Function name: offset_too_large
539 : * Synopsis: Report an ERROR after a too-large fcode-offset
540 : * was detected.
541 : *
542 : * Inputs:
543 : * Parameters:
544 : * too_large_for_16 TRUE if the offset is too large to be
545 : * expressed as a 16-bit signed number.
546 : * Global Variables:
547 : * statbuf Word encountered, to name in error message
548 : * offs16 Whether we are using 16-bit offsets
549 : * Local Static Variables:
550 : * control_stack "Pushed" Control-Structure Tag Group
551 : * didnt_print_otl Switch to prevent duplicate message
552 : * Control-Stack Items:
553 : * Top: "Current" Control-Structure Tag Group
554 : * Some of its "Marker" information
555 : * will be used in the error message
556 : *
557 : * Outputs:
558 : * Returned Value: NONE
559 : * Local Static Variables:
560 : * didnt_print_otl Will be reset to FALSE
561 : *
562 : * Printout:
563 : * Error message:
564 : * Branch offset too large between <here> and <there>
565 : * Advisory message, if we are using 8-bit offsets, will
566 : * indicate whether switching to 16-bit offsets would help
567 : *
568 : * Process Explanation:
569 : * Two branches are involved in a DO ... LOOP structure: an "outer"
570 : * forward-branch and a slightly smaller "inner" backward-branch.
571 : * In the majority of cases, if one offset exceeds the limit,
572 : * both will. There is, however, a very small but distinct
573 : * possibility that the offset for the smaller branch will not
574 : * exceed the limit while the larger one does. To prevent two
575 : * messages from being printed in the routine instance, but still
576 : * assure that one will be printed in the rare eventuality, we
577 : * utilize the flag called didnt_print_otl in conjunction
578 : * with the cs_not_dup field.
579 : *
580 : **************************************************************************** */
581 :
582 : static void offset_too_large( bool too_large_for_16 )
583 34 : {
584 34 : if ( control_stack->cs_not_dup || didnt_print_otl )
585 : {
586 28 : tokenization_error( TKERROR,
587 : "Branch offset is too large between %s and the %s" ,
588 : strupr(statbuf), strupr(control_stack->cs_word));
589 28 : where_started( control_stack->cs_inp_fil, control_stack->cs_line_num );
590 28 : if ( INVERSE( offs16 ) )
591 : {
592 9 : if ( too_large_for_16 )
593 : {
594 0 : tokenization_error ( INFO,
595 : "Offset would be too large even if 16-bit offsets "
596 : "were in effect.\n");
597 : }else{
598 9 : tokenization_error ( INFO,
599 : "Offset might fit if 16-bit offsets "
600 : "(e.g., fcode-version2) were used.\n" );
601 : }
602 : }
603 : }
604 34 : didnt_print_otl = FALSE;
605 34 : }
606 :
607 : /* **************************************************************************
608 : *
609 : * Function name: emit_fc_offset
610 : * Synopsis: Test whether the given FCode-Offset is out-of-range;
611 : * before placing it into the FCode Output Buffer.
612 : *
613 : * Inputs:
614 : * Parameters:
615 : * fc_offset The given FCode-Offset
616 : * Global Variables:
617 : * offs16 Whether we are using 16-bit offsets
618 : * noerrors "Ignore Errors" flag
619 : *
620 : * Outputs:
621 : * Returned Value: NONE
622 : *
623 : * Error Detection:
624 : * Error if the given FCode-Offset exceeds the range that can
625 : * be expressed by the size (i.e., 8- or 16- -bits) of the
626 : * offsets we are using. Call offset_too_large() to print
627 : * the Error message; also, if noerrors is in effect, issue
628 : * a Warning showing the actual offset and how it will be coded.
629 : *
630 : * Process Explanation:
631 : * For forward-branches, the OPC will have to be adjusted to
632 : * indicate the location that was reserved for the offset
633 : * to be written, rather than the current location. That
634 : * will all be handled by the calling routine.
635 : * We will rely on "C"'s type-conversion (type-casting) facilities.
636 : * Look at the offset value both as an 8-bit and as a 16-bit offset,
637 : * then determine the relevant course of action.
638 : *
639 : **************************************************************************** */
640 :
641 : static void emit_fc_offset( int fc_offset)
642 2990 : {
643 2990 : int fc_offs_s16 = (s16)fc_offset;
644 2990 : int fc_offs_s8 = (s8)fc_offset;
645 2990 : bool too_large_for_8 = BOOLVAL( fc_offset != fc_offs_s8 );
646 2990 : bool too_large_for_16 = BOOLVAL( fc_offset != fc_offs_s16);
647 :
648 2990 : if ( too_large_for_16 || ( INVERSE(offs16) && too_large_for_8 ) )
649 : {
650 34 : offset_too_large( too_large_for_16 );
651 34 : if ( noerrors )
652 : {
653 34 : int coded_as = offs16 ? (int)fc_offs_s16 : (int)fc_offs_s8 ;
654 34 : tokenization_error( WARNING,
655 : "Actual offset is 0x%x (=dec %d), "
656 : "but it will be coded as 0x%x (=dec %d).\n",
657 : fc_offset, fc_offset, coded_as, coded_as );
658 : }
659 : }
660 :
661 2990 : emit_offset( fc_offs_s16 );
662 2990 : }
663 :
664 :
665 : /* **************************************************************************
666 : *
667 : * Function name: matchup_control_structure
668 : * Synopsis: Error-check. Compare the given control-structure
669 : * identifier tag with the one in the CSTAG-Group
670 : * on "Top" of the "Control Stack".
671 : * If they don't match, report an error, and, if not
672 : * "Ignoring Errors", return Error indication.
673 : * If no error, pass the Data-item back to the caller.
674 : * Do not consume the CSTAG-Group; that will be the
675 : * responsibility of the calling routine.
676 : *
677 : * Inputs:
678 : * Parameters:
679 : * cstag Control-struc ID Tag expected by calling function
680 : * Global Variables:
681 : * noerrors "Ignore Errors" flag
682 : * Local Static Variables:
683 : * control_stack "Pushed" (current) Control-Structure Tag Group
684 : * Control-Stack Items:
685 : * Top: Current CSTAG-Group
686 : *
687 : * Outputs:
688 : * Returned Value: TRUE = Successful match, no error.
689 : *
690 : * Error Detection:
691 : * Control Stack underflow or cstag mismatch. See below for details.
692 : *
693 : * Process Explanation:
694 : * If the expected cstag does not match the cs_tag from the CSTAG
695 : * Group on "Top" of the "Control Stack", print an ERROR message,
696 : * and, unless the "Ignore Errors" flag is in effect, prepare
697 : * to return FALSE.
698 : * However, if we've "underflowed" the "Control Stack", we dare not
699 : * ignore errors; that could lead to things like attempting to
700 : * write a forward-branch FCode-offset to offset ZERO, over the
701 : * FCODE- or PCI- -header block. We don't want that...
702 : * So, if the control_stack pointer is NULL, we will print an
703 : * ERROR message and immediately return FALSE.
704 : * Since we will not consume the CSTAG-Group, the calling routine
705 : * can access the Data-Item and any "Marker" information it may
706 : * still require via the local control_stack pointer. The caller
707 : * will be responsible for removing the CSTAG-Group.
708 : *
709 : * Special Exception to "Ignore Errors":
710 : * At the last usage of the CASE_CSTAG , for the ENDCASE statement,
711 : * this routine will be called to control freeing-up memory, etc.
712 : * For the OF statement, it will be called to control incrementing
713 : * the OF-count datum.
714 : * Processing an ENDCASE statement with the datum from any other
715 : * CSTAG-Group can lead to a huge loop.
716 : * Processing any other "resolver" with the datum from an ENDCASE
717 : * CSTAG-Group can lead to mistaking a very low number for an
718 : * offset into the Output Buffer and attempting to write to it.
719 : * Incrementing the datum from any other CSTAG-Group can lead to
720 : * a variety of unacceptable errors, too many to guess.
721 : * So, if either the given cstag or the cs_tag field of the "Top"
722 : * CSTAG-Group is a CASE_CSTAG , we will not ignore errors.
723 : *
724 : **************************************************************************** */
725 :
726 : static bool matchup_control_structure( unsigned long cstag )
727 4552 : {
728 4552 : bool retval = FALSE;
729 :
730 4552 : if ( control_stack_size_test( 1) )
731 : {
732 4541 : retval = TRUE;
733 :
734 4541 : if ( control_stack->cs_tag != cstag )
735 : {
736 51 : control_structure_mismatch();
737 :
738 51 : if ( ( INVERSE(noerrors) )
739 : || ( cstag == CASE_CSTAG )
740 : || ( control_stack->cs_tag == CASE_CSTAG )
741 : )
742 : {
743 49 : retval = FALSE;
744 : }
745 : }
746 :
747 : }
748 4552 : return ( retval );
749 : }
750 :
751 : /* **************************************************************************
752 : *
753 : * Function name: control_structure_swap
754 : * Synopsis: Swap control-structure branch-marker Groups
755 : *
756 : * Inputs:
757 : * Parameters: NONE
758 : * Local Static Variables:
759 : * control_stack Pointer to "Control Stack" linked-list
760 : * Control-Stack Items:
761 : * Top: CSTAG-Group_0
762 : * Next: CSTAG-Group_1
763 : *
764 : * Outputs:
765 : * Returned Value: NONE
766 : * Local Static Variables:
767 : * control_stack Points to former "previous" and vice-versa
768 : * Items on Control-Stack:
769 : * Top: CSTAG-Group_1
770 : * Next: CSTAG-Group_0
771 : *
772 : * Error Detection:
773 : * If control-stack depth is not at least 2, CS underflow ERROR.
774 : * This might trigger other routines' error detections also...
775 : *
776 : * Extraneous Remarks:
777 : * Before control-structure identification was implemented, offsets
778 : * were kept on the data-stack, and this was a single SWAP.
779 : * When CSTAGs were added, the "Group" was only a pair kept on the
780 : * data-stack -- the CSTAG and the Data-item -- and this
781 : * became a TWO_SWAP()
782 : * For a while, when I tried keeping the CSTAG-Group on the stack,
783 : * this became a FOUR_SWAP()
784 : * That turned out to be unacceptably brittle; this way is much
785 : * more robust.
786 : * I am so glad I called this functionality out into a separate
787 : * routine, early on in the development process.
788 : *
789 : * This is the function called 1 CSROLL in section A.3.2.3.2
790 : * of the ANSI Forth spec, which likewise corresponds to the
791 : * modifier that Wil Baden, in his characteristically elegant
792 : * nomenclature, dubbed: BUT
793 : *
794 : **************************************************************************** */
795 :
796 : static void control_structure_swap( void )
797 4110 : {
798 4110 : if ( control_stack_size_test( 2) )
799 : {
800 : cstag_group_t *cs_temp;
801 :
802 4105 : cs_temp = control_stack->prev;
803 :
804 4105 : control_stack->prev = cs_temp->prev;
805 4105 : cs_temp->prev = control_stack;
806 4105 : control_stack = cs_temp;
807 : }
808 4110 : }
809 :
810 : /* **************************************************************************
811 : *
812 : * Function name: matchup_two_control_structures
813 : * Synopsis: For functions that resolve two CSTAG-Groups, both
814 : * matchup both "Top of Control Stack" entries
815 : * before processing them...
816 : *
817 : * Inputs:
818 : * Parameters:
819 : * top_cstag Control-struc ID Tag expected on "Top" CS entry
820 : * next_cstag Control-struc ID Tag expected on "Next" CS entry
821 : * Local Static Variables:
822 : * not_cs_underflow Used for underflow detection.
823 : * Control-Stack Items:
824 : * Top: Current CSTAG-Group
825 : * Next: Next CSTAG-Group
826 : *
827 : * Outputs:
828 : * Returned Value: TRUE = Successful matches, no error.
829 : * Global Variables:
830 : * noerrors "Ignore Errors" flag; cleared, then restored
831 : * Local Static Variables:
832 : * not_consuming_two Cleared, then restored
833 : * Control-Stack, # of Items Popped: 2 (if matches unsuccessful)
834 : *
835 : * Error Detection:
836 : * Control Stack underflow detected by control_structure_swap()
837 : * Control Structure mismatch detected by control_structure_mismatch()
838 : *
839 : * Process Explanation:
840 : * We will use matchup_control_structure() to do the "heavy lifting".
841 : * We will not be ignoring errors in these cases.
842 : * Save the results of a match of top_cstag
843 : * Swap the top two CS entries.
844 : * If an underflow was detected, there's no more matching to be done.
845 : * Otherwise:
846 : * Save the results of a match of next_cstag
847 : * Swap the top two CS entries again, to their original order.
848 : * The result is TRUE if both matches were successful.
849 : * If the matches were not successful, consume the top two entries
850 : * (unless there's only one, in which case consume it).
851 : *
852 : **************************************************************************** */
853 :
854 : static bool matchup_two_control_structures( unsigned long top_cstag,
855 : unsigned long next_cstag)
856 108 : {
857 : bool retval;
858 : bool topmatch;
859 108 : bool nextmatch = FALSE;
860 108 : bool sav_noerrors = noerrors;
861 108 : noerrors = FALSE;
862 108 : not_consuming_two = FALSE;
863 :
864 108 : not_cs_underflow = TRUE;
865 108 : topmatch = matchup_control_structure( top_cstag);
866 108 : if ( not_cs_underflow )
867 : {
868 106 : control_structure_swap();
869 106 : if ( not_cs_underflow )
870 : {
871 105 : nextmatch = matchup_control_structure( next_cstag);
872 105 : control_structure_swap();
873 : }
874 : }
875 :
876 108 : retval = BOOLVAL( topmatch && nextmatch);
877 :
878 108 : if ( INVERSE( retval) )
879 : {
880 13 : pop_cstag();
881 13 : pop_cstag();
882 : }
883 :
884 108 : not_consuming_two = TRUE;
885 108 : noerrors = sav_noerrors;
886 108 : return ( retval );
887 : }
888 :
889 : /* **************************************************************************
890 : *
891 : * Function name: mark_backward_target
892 : * Synopsis: Mark the target of an expected backward-branch
893 : *
894 : * Associated FORTH words: BEGIN DO ?DO
895 : *
896 : * Inputs:
897 : * Parameters:
898 : * cstag Control-structure ID tag for calling function
899 : * Global Variables:
900 : * opc Output Buffer Position Counter
901 : *
902 : * Outputs:
903 : * Returned Value: NONE
904 : * Items Pushed onto Control-Stack:
905 : * Top: <Stmt>_BACKw_<TAGNAM>
906 : *
907 : * Process Explanation:
908 : * Just before this function is called, the token that begins the
909 : * control-structure was written to the FCode Output buffer.
910 : * OPC, the FCode Output Buffer Position Counter, is at the
911 : * destination to which the backward-branch will be targeted.
912 : * Create a CSTAG-Group with the given C-S Tag, and OPC as its datum;
913 : * push it onto the Control-Stack.
914 : * Later, when the backward-branch is installed, the FCode-offset
915 : * will be calculated as the difference between the OPC at
916 : * that time and the target-OPC we saved here.
917 : *
918 : **************************************************************************** */
919 :
920 : static void mark_backward_target(unsigned long cstag )
921 3047 : {
922 3047 : push_cstag( cstag, (unsigned long)opc);
923 3047 : }
924 :
925 : /* **************************************************************************
926 : *
927 : * Function name: mark_forward_branch
928 : * Synopsis: Mark the location of, and reserve space for, the
929 : * FCode-offset associated with a forward branch.
930 : *
931 : * Associated FORTH words: IF WHILE ELSE
932 : *
933 : * Inputs:
934 : * Parameters:
935 : * cstag Control-structure ID tag for calling function
936 : *
937 : * Outputs:
938 : * Returned Value: NONE
939 : * Items Pushed onto Control-Stack:
940 : * Top: <Stmt>_FORw_<TAGNAM>
941 : * FCode Output buffer:
942 : * Place-holder FCode-offset of zero.
943 : *
944 : * Process Explanation:
945 : * Just before this function is called, the forward-branch token
946 : * that begins the control-structure was written to the FCode
947 : * Output buffer.
948 : * It will need an FCode-offset to the destination to which it will
949 : * be targeted, once that destination is known.
950 : * Create a CSTAG-Group with the given C-S Tag, and OPC as its datum;
951 : * push it onto the Control-Stack. (This is the same action as
952 : * for marking a backward-target.)
953 : * Then write a place-holder FCode-offset of zero to the FCode
954 : * Output buffer.
955 : * Later, when the destination is known, the FCode-offset will be
956 : * calculated as the difference between the OPC at that time
957 : * and the FCode-offset location we're saving now. That offset
958 : * will be over-written onto the place-holder offset of zero at
959 : * the location in the Output buffer that we saved on the
960 : * Control-Stack in this routine.
961 : *
962 : **************************************************************************** */
963 :
964 : static void mark_forward_branch(unsigned long cstag )
965 2903 : {
966 2903 : mark_backward_target(cstag );
967 2903 : emit_offset(0);
968 2903 : }
969 :
970 : /* **************************************************************************
971 : *
972 : * Function name: resolve_backward
973 : * Synopsis: Resolve backward-target when a backward branch
974 : * is reached. Write FCode-offset to reach saved
975 : * target from current location.
976 : *
977 : * Associated FORTH words: AGAIN UNTIL REPEAT
978 : * LOOP +LOOP
979 : *
980 : * Inputs:
981 : * Parameters:
982 : * cstag Control-structure ID tag for calling function
983 : * Global Variables:
984 : * opc Output Buffer Position Counter
985 : * Control-Stack Items:
986 : * Top: <Stmt>_BACKw_<TAGNAM>
987 : *
988 : * Outputs:
989 : * Returned Value: NONE
990 : * Global Variables:
991 : * opc Incremented by size of an FCode-offset
992 : * Control-Stack, # of Items Popped: 1
993 : * FCode Output buffer:
994 : * FCode-offset to reach backward-target
995 : *
996 : * Error Detection:
997 : * Test for Control-structure ID tag match.
998 : *
999 : * Process Explanation:
1000 : * Just before this function is called, the backward-branch token
1001 : * that ends the control-structure was written to the FCode
1002 : * Output buffer.
1003 : * The current OPC is at the point from which the FCode-offset
1004 : * is to be calculated, and at which it is to be written.
1005 : * The top of the Control-Stack should have the CSTAG-Group from
1006 : * the statement that prepared the backward-branch target that
1007 : * we expect to resolve. Its datum is the OPC of the target
1008 : * of the backward branch.
1009 : * If the supplied Control-structure ID tag does not match the one
1010 : * on top of the Control-Stack, announce an error. We will
1011 : * still write an FCode-offset, but it will be a place-holder
1012 : * of zero.
1013 : * Otherwise, the FCode-offset we will write will be the difference
1014 : * between the target-OPC and our current OPC.
1015 : *
1016 : **************************************************************************** */
1017 :
1018 : static void resolve_backward( unsigned long cstag)
1019 127 : {
1020 : unsigned long targ_opc;
1021 127 : int fc_offset = 0;
1022 :
1023 127 : if ( matchup_control_structure( cstag) )
1024 : {
1025 125 : targ_opc = control_stack->cs_datum;
1026 125 : fc_offset = targ_opc - opc;
1027 : }
1028 :
1029 127 : emit_fc_offset( fc_offset );
1030 127 : pop_cstag();
1031 127 : }
1032 :
1033 : /* **************************************************************************
1034 : *
1035 : * Function name: resolve_forward
1036 : * Synopsis: Resolve a forward-branch when its target has been
1037 : * reached. Write the FCode-offset into the space
1038 : * that was reserved.
1039 : *
1040 : * Associated FORTH words: ELSE THEN REPEAT
1041 : * LOOP +LOOP
1042 : *
1043 : * Inputs:
1044 : * Parameters:
1045 : * cstag Control-structure ID tag for calling function
1046 : * Global Variables:
1047 : * opc Output Buffer Position Counter
1048 : * Control-Stack Items:
1049 : * Top: <Stmt>_FORw_<TAGNAM>
1050 : *
1051 : * Outputs:
1052 : * Returned Value: NONE
1053 : * Global Variables:
1054 : * opc Changed, then restored.
1055 : * Control-Stack, # of Items Popped: 1
1056 : * FCode Output buffer:
1057 : * FCode-offset is written to location where space was reserved
1058 : * when the forward-branch was marked.
1059 : *
1060 : * Error Detection:
1061 : * Test for Control-structure ID tag match.
1062 : *
1063 : * Process Explanation:
1064 : * Just before this function is called, the last token -- and
1065 : * possibly, FCode-offset -- that is within the scope of
1066 : * what the branch might skip was written to the FCode
1067 : * Output buffer.
1068 : * The current OPC is at the point from which the FCode-offset
1069 : * is to be calculated, but not at which it is to be written.
1070 : * The top of the Control-Stack should have the CSTAG-Group from
1071 : * the statement that prepared the forward-branch we expect
1072 : * to resolve, and for which our current OPC is the target.
1073 : * Its datum is the OPC of the space that was reserved for
1074 : * the forward-branch whose target we have just reached.
1075 : * If the supplied Control-structure ID tag does not match the one
1076 : * on top of the Control-Stack, announce an error and we're done.
1077 : * Otherwise, the datum is used both as part of the calculation of
1078 : * the FCode-offset we are about to write, and as the location
1079 : * to which we will write it.
1080 : * The FCode-offset is calculated as the difference between our
1081 : * current OPC and the reserved OPC location.
1082 : * We will not be ignoring errors in these cases, because we would
1083 : * be over-writing something that might not be a place-holder
1084 : * for a forward-branch at an earlier location in the FCode
1085 : * Output buffer.
1086 : *
1087 : **************************************************************************** */
1088 :
1089 : static void resolve_forward( unsigned long cstag)
1090 2889 : {
1091 : unsigned long resvd_opc;
1092 2889 : bool sav_noerrors = noerrors;
1093 : bool cs_match_result;
1094 2889 : noerrors = FALSE;
1095 : /* Restore the "ignore-errors" flag before we act on our match result
1096 : * because we want it to remain in effect for emit_fc_offset()
1097 : */
1098 2889 : cs_match_result = matchup_control_structure( cstag);
1099 2889 : noerrors = sav_noerrors;
1100 :
1101 2889 : if ( cs_match_result )
1102 : {
1103 : int saved_opc;
1104 : int fc_offset;
1105 :
1106 2863 : resvd_opc = control_stack->cs_datum;
1107 2863 : fc_offset = opc - resvd_opc;
1108 :
1109 2863 : saved_opc = opc;
1110 2863 : opc = resvd_opc;
1111 :
1112 :
1113 2863 : emit_fc_offset( fc_offset );
1114 2863 : opc = saved_opc;
1115 : }
1116 2889 : pop_cstag();
1117 2889 : }
1118 :
1119 :
1120 : /* **************************************************************************
1121 : *
1122 : * The functions that follow are the exported routines that
1123 : * utilize the preceding support-routines to effect their
1124 : * associated FORTH words.
1125 : *
1126 : * The routines they call will take care of most of the Error
1127 : * Detection via stack-depth checking and Control-structure
1128 : * ID tag matching, so those will not be called-out in the
1129 : * prologues.
1130 : *
1131 : **************************************************************************** */
1132 :
1133 :
1134 : /* **************************************************************************
1135 : *
1136 : * Function name: emit_if
1137 : * Synopsis: All the actions when IF is encountered
1138 : *
1139 : * Associated FORTH word: IF
1140 : *
1141 : * Inputs:
1142 : * Parameters: NONE
1143 : *
1144 : * Outputs:
1145 : * Returned Value: NONE
1146 : * Items Pushed onto Control-Stack:
1147 : * Top: If_FORw_IF
1148 : * FCode Output buffer:
1149 : * Token for conditional branch -- b?branch -- followed by
1150 : * place-holder of zero for FCode-offset
1151 : *
1152 : *
1153 : **************************************************************************** */
1154 :
1155 : void emit_if( void )
1156 196 : {
1157 196 : emit_token("b?branch");
1158 196 : mark_forward_branch( IF_CSTAG );
1159 196 : }
1160 :
1161 : /* **************************************************************************
1162 : *
1163 : * Function name: emit_then
1164 : * Synopsis: All the actions when THEN is encountered; also
1165 : * part of another forward-branch resolver's action.
1166 : *
1167 : * Associated FORTH words: THEN ELSE
1168 : *
1169 : * Inputs:
1170 : * Parameters: NONE
1171 : * Local Static Variables:
1172 : * control_stack Points to "Top" Control-Structure Tag Group
1173 : * Control-Stack Items:
1174 : * Top: If_FORw_IF | While_FORw_WHILE
1175 : *
1176 : * Outputs:
1177 : * Returned Value: NONE
1178 : * Control-Stack, # of Items Popped: 1
1179 : * FCode Output buffer:
1180 : * Token for forward-resolve -- b(>resolve) -- then the space
1181 : * reserved for the forward-branch FCode-offset is filled
1182 : * in so that it reaches the token after the b(>resolve) .
1183 : *
1184 : * Process Explanation:
1185 : * The THEN statement or the ELSE statement must be able to resolve
1186 : * a WHILE statement, in order to implement the extended flow-
1187 : * -control structures as described in sec. A.3.2.3.2 of the
1188 : * ANSI Forth Spec.
1189 : * But we must prevent the sequence IF ... BEGIN ... REPEAT from
1190 : * compiling as though it were: IF ... BEGIN ... AGAIN THEN
1191 : * We do this by having a separate CSTAG for WHILE and allowing
1192 : * it here but not allowing the IF_CSTAG when processing REPEAT.
1193 : *
1194 : **************************************************************************** */
1195 :
1196 : void emit_then( void )
1197 222 : {
1198 222 : emit_token("b(>resolve)");
1199 222 : if ( control_stack != NULL )
1200 : {
1201 217 : if ( control_stack->cs_tag == WHILE_CSTAG )
1202 : {
1203 3 : control_stack->cs_tag = IF_CSTAG;
1204 : }
1205 : }
1206 222 : resolve_forward( IF_CSTAG );
1207 222 : }
1208 :
1209 :
1210 : /* **************************************************************************
1211 : *
1212 : * Function name: emit_else
1213 : * Synopsis: All the actions when ELSE is encountered
1214 : *
1215 : * Associated FORTH word: ELSE
1216 : *
1217 : * Inputs:
1218 : * Parameters: NONE
1219 : * Global Variables:
1220 : * control_stack_depth Current depth of Control Stack
1221 : * Local Static Variables:
1222 : * not_cs_underflow If this is FALSE after the c-s swap, it
1223 : * means an underflow resulted; skip
1224 : * the call to resolve the first marker.
1225 : * Control-Stack Items:
1226 : * Top: {If_FORw_IF}1
1227 : * (Datum is OPC of earlier forward-branch; must be resolved.)
1228 : *
1229 : * Outputs:
1230 : * Returned Value: NONE
1231 : * Control-Stack, # of Items Popped: 1
1232 : * Items Pushed onto Control-Stack:
1233 : * Top: {If_FORw_IF}2
1234 : * (Datum is current OPC, after forward-branch is placed.)
1235 : * FCode Output buffer:
1236 : * Token for unconditional branch -- bbranch-- followed by
1237 : * place-holder of zero for FCode-offset. Then, token
1238 : * for forward-resolve -- b(>resolve) -- and the space
1239 : * reserved earlier for the conditional forward-branch
1240 : * FCode-offset is filled in to reach the token after
1241 : * the b(>resolve) .
1242 : *
1243 : * Error Detection:
1244 : * If the "Control-Stack" is empty, bypass the forward branch
1245 : * and let the call to control_structure_swap() report
1246 : * the underflow error. Then use not_cs_underflow to
1247 : * control whether to resolve the forward-branch.
1248 : *
1249 : * Process Explanation:
1250 : * The final item needed within the scope of what the earlier
1251 : * conditional branch might skip is an unconditional branch
1252 : * over the "else"-clause to follow. After that, the earlier
1253 : * conditional branch needs to be resolved. This last step
1254 : * is identical to the action of THEN .
1255 : *
1256 : **************************************************************************** */
1257 :
1258 : void emit_else( void )
1259 24 : {
1260 24 : if ( control_stack_depth > 0 )
1261 : {
1262 21 : emit_token("bbranch");
1263 21 : mark_forward_branch( IF_CSTAG );
1264 : }
1265 24 : not_cs_underflow = TRUE;
1266 24 : control_structure_swap();
|
