LTP GCOV extension - code coverage report
Current view: directory - fcode-utils/toke - flowcontrol.c
Test: Toke 1.0.2
Date: 2006-10-30 Instrumented lines: 240
Code covered: 100.0 % Executed lines: 240
Legend: not executed executed converted-only

       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            3285 : {
     381                 :     cstag_group_t *cs_temp;
     382                 : 
     383            3285 :     cs_temp = control_stack;
     384            3285 :     control_stack = safe_malloc( sizeof(cstag_group_t), "pushing CSTag");
     385                 : 
     386            3285 :     control_stack->cs_tag = cstag;
     387            3285 :     control_stack->cs_inp_fil = strdup(iname);
     388            3285 :     control_stack->cs_line_num = lineno;
     389            3285 :     control_stack->cs_abs_token_num = abs_token_no;
     390            3285 :     control_stack->cs_word = strdup(statbuf);
     391            3285 :     control_stack->cs_not_dup = TRUE;
     392            3285 :     control_stack->cs_datum = datum;
     393            3285 :     control_stack->prev = cs_temp;
     394                 : 
     395            3285 :     control_stack_depth++;
     396                 :     
     397            3285 : }
     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            3297 : {
     431                 : 
     432            3297 :     if ( control_stack != NULL )
     433                 :     {
     434                 :         cstag_group_t *cs_temp;
     435                 : 
     436            3285 :         cs_temp = control_stack->prev;
     437            3285 :         free( control_stack->cs_word );
     438            3285 :         free( control_stack->cs_inp_fil );
     439            3285 :         free( control_stack );
     440            3285 :         control_stack = cs_temp;
     441                 : 
     442            3285 :         control_stack_depth--;
     443                 :     }
     444            3297 : }
     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           10400 : {
     475           10400 :     bool retval = TRUE;
     476                 : 
     477           10400 :     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( TRUE);
     483                 : 
     484              17 :         not_cs_underflow = FALSE;   /*  See expl'n early on in this file  */
     485                 :     }
     486                 : 
     487           10400 :     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              50 : {
     584              50 :     if ( control_stack->cs_not_dup || didnt_print_otl )
     585                 :     {
     586              41 :         tokenization_error( TKERROR,
     587                 :             "Branch offset is too large between %s and the %s" ,
     588                 :                 strupr(statbuf), strupr(control_stack->cs_word));
     589              41 :         where_started( control_stack->cs_inp_fil, control_stack->cs_line_num );
     590              41 :         if ( INVERSE( offs16 ) )
     591                 :         {
     592              22 :             if ( too_large_for_16 )
     593                 :             {
     594               5 :                 tokenization_error ( INFO,
     595                 :                     "Offset would be too large even if 16-bit offsets "
     596                 :                         "were in effect.\n");
     597                 :             }else{
     598              17 :                 tokenization_error ( INFO,
     599                 :                     "Offset might fit if 16-bit offsets "
     600                 :                         "(e.g., fcode-version2) were used.\n" );
     601                 :             }
     602                 :         }
     603                 :     }
     604              50 :     didnt_print_otl = FALSE;
     605              50 : }
     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            3194 : {
     643            3194 :     int fc_offs_s16 = (s16)fc_offset;
     644            3194 :     int fc_offs_s8  =  (s8)fc_offset;
     645            3194 :     bool too_large_for_8  = BOOLVAL( fc_offset != fc_offs_s8 );
     646            3194 :     bool too_large_for_16 = BOOLVAL( fc_offset != fc_offs_s16);
     647                 : 
     648            3194 :     if ( too_large_for_16 || ( INVERSE(offs16) && too_large_for_8 ) )
     649                 :     {
     650              50 :         offset_too_large( too_large_for_16 );
     651              50 :         if ( noerrors )
     652                 :         {
     653              50 :             int coded_as = offs16 ? (int)fc_offs_s16 : (int)fc_offs_s8 ;
     654              50 :             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            3194 :     emit_offset( fc_offs_s16 );
     662            3194 : }
     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            4862 : {
     728            4862 :     bool retval = FALSE;
     729                 : 
     730            4862 :     if ( control_stack_size_test( 1) )
     731                 :     {
     732            4851 :         retval = TRUE;
     733                 : 
     734            4851 :         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            4862 :     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            4241 : {
     798            4241 :     if ( control_stack_size_test( 2) )
     799                 :     {
     800                 :         cstag_group_t *cs_temp;
     801                 : 
     802            4236 :         cs_temp = control_stack->prev;
     803                 : 
     804            4236 :         control_stack->prev = cs_temp->prev;
     805            4236 :         cs_temp->prev = control_stack;
     806            4236 :         control_stack = cs_temp;
     807                 :     }
     808            4241 : }
     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             157 : {
     857                 :     bool retval;
     858                 :     bool topmatch;
     859             157 :     bool nextmatch = FALSE;
     860             157 :     bool sav_noerrors = noerrors;
     861             157 :     noerrors = FALSE;
     862             157 :     not_consuming_two = FALSE;
     863                 : 
     864             157 :     not_cs_underflow = TRUE;
     865             157 :     topmatch = matchup_control_structure( top_cstag);
     866             157 :     if ( not_cs_underflow )
     867                 :     {
     868             155 :         control_structure_swap();
     869             155 :         if ( not_cs_underflow )
     870                 :         {
     871             154 :            nextmatch = matchup_control_structure( next_cstag);
     872             154 :            control_structure_swap();
     873                 :         }
     874                 :     }
     875                 : 
     876             157 :     retval = BOOLVAL( topmatch && nextmatch);
     877                 : 
     878             157 :     if ( INVERSE( retval) )
     879                 :     {
     880              13 :         pop_cstag();
     881              13 :         pop_cstag();
     882                 :     }
     883                 : 
     884             157 :     not_consuming_two = TRUE;
     885             157 :     noerrors = sav_noerrors;
     886             157 :     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            3251 : {
     922            3251 :     push_cstag( cstag, (unsigned long)opc);
     923            3251 : }
     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            3054 : {
     966            3054 :     mark_backward_target(cstag );
     967            3054 :     emit_offset(0);
     968            3054 : }
     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             180 : {
    1020                 :     unsigned long targ_opc;
    1021             180 :     int fc_offset = 0;
    1022                 : 
    1023             180 :     if ( matchup_control_structure( cstag) )
    1024                 :     {
    1025             178 :         targ_opc = control_stack->cs_datum;
    1026             178 :         fc_offset = targ_opc - opc;
    1027                 :     }
    1028                 : 
    1029             180 :     emit_fc_offset( fc_offset );
    1030             180 :     pop_cstag();
    1031             180 : }
    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            3040 : {
    1091                 :     unsigned long resvd_opc;
    1092            3040 :     bool sav_noerrors = noerrors;
    1093                 :     bool cs_match_result;
    1094            3040 :     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            3040 :     cs_match_result = matchup_control_structure( cstag);
    1099            3040 :     noerrors = sav_noerrors;
    1100                 : 
    1101            3040 :     if ( cs_match_result )
    1102                 :     {
    1103                 :         int saved_opc;
    1104                 :         int fc_offset;
    1105                 : 
    1106            3014 :         resvd_opc = control_stack->cs_datum;
    1107            3014 :         fc_offset = opc - resvd_opc;
    1108                 : 
    1109            3014 :         saved_opc = opc;
    1110            3014 :         opc = resvd_opc;
    1111                 : 
    1112                 : 
    1113            3014 :         emit_fc_offset( fc_offset );
    1114            3014 :         opc = saved_opc;
    1115                 :     }
    1116            3040 :     pop_cstag();
    1117            3040 : }
    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             269 : {
    1157             269 :     emit_token("b?branch");
    1158             269 :     mark_forward_branch( IF_CSTAG );
    1159             269 : }
    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             316 : {
    1198             316 :     emit_token("b(>resolve)");
    1199             316 :     if ( control_stack != NULL )
    1200                 :     {
    1201             311 :         if ( control_stack->cs_tag == WHILE_CSTAG )
    1202                 :         {
    1203               3 :             control_stack->cs_tag = IF_CSTAG;
    1204                 :         }
    1205                 :     }
    1206             316 :     resolve_forward( IF_CSTAG );
    1207             316 : }
    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              45 : {
    1260              45 :     if ( control_stack_depth > 0 )
    1261                 :     {
    1262              42 :         emit_token("bbranch");
    1263              42 :         mark_forward_branch( IF_CSTAG );
    1264                 :     }
    1265              45 :     not_cs_underflow = TRUE;
    1266              45 :     control_structure_swap();
    1267              45 :     if ( not_cs_underflow )
    1268                 :     {
    1269              42 :         emit_then();
    1270                 :     }
    1271              45 : }
    1272                 : 
    1273                 : 
    1274                 : /* **************************************************************************
    1275                 :  *
    1276                 :  *      Function name:  emit_begin
    1277                 :  *      Synopsis:       All the actions when BEGIN is encountered
    1278                 :  *
    1279                 :  *      Associated FORTH word:                 BEGIN
    1280                 :  *
    1281                 :  *      Inputs:
    1282                 :  *         Parameters:             NONE
    1283                 :  *
    1284                 :  *      Outputs:
    1285                 :  *         Returned Value:         NONE
    1286                 :  *         Items Pushed onto Control-Stack:
    1287                 :  *             Top:                Begin_BACKw_BEGIN
    1288                 :  *                 (Datum is current OPC, target of future backward-branch)
    1289                 :  *         FCode Output buffer:
    1290                 :  *             Token for target of backward branch -- b(<mark)
    1291                 :  *
    1292                 :  **************************************************************************** */
    1293                 : 
    1294                 : void emit_begin( void )
    1295              51 : {
    1296              51 :     emit_token("b(<mark)");
    1297              51 :     mark_backward_target( BEGIN_CSTAG );
    1298              51 : }
    1299                 : 
    1300                 : 
    1301                 : /* **************************************************************************
    1302                 :  *
    1303                 :  *      Function name:  emit_again
    1304                 :  *      Synopsis:       All the actions when AGAIN is encountered
    1305                 :  *
    1306                 :  *      Associated FORTH words:               AGAIN  REPEAT
    1307                 :  *
    1308                 :  *      Inputs:
    1309                 :  *         Parameters:             NONE
    1310                 :  *         Control-Stack Items:
    1311                 :  *             Top:                Begin_BACKw_BEGIN
    1312                 :  *                        (Datum is OPC of backward-branch target at BEGIN)
    1313                 :  *
    1314                 :  *      Outputs:
    1315                 :  *         Returned Value:         NONE
    1316                 :  *         Control-Stack, # of Items Popped:   1
    1317                 :  *         FCode Output buffer:
    1318                 :  *             Token for unconditional branch -- bbranch -- followed by
    1319                 :  *                 FCode-offset that reaches just after the  b(<mark) 
    1320                 :  *                 token at the corresponding  BEGIN  statement. 
    1321                 :  *
    1322                 :  *      Process Explanation:
    1323                 :  *          The FCode-offset is calculated as the difference between our
    1324                 :  *              current OPC and the target-OPC saved on the Control-Stack.
    1325                 :  *              
    1326                 :  **************************************************************************** */
    1327                 : 
    1328                 : void emit_again( void )
    1329              37 : {
    1330              37 :     emit_token("bbranch");
    1331              37 :     resolve_backward( BEGIN_CSTAG );
    1332              37 : }
    1333                 : 
    1334                 : /* **************************************************************************
    1335                 :  *
    1336                 :  *      Function name:  emit_until
    1337                 :  *      Synopsis:       All the actions when UNTIL is encountered
    1338                 :  *
    1339                 :  *      Associated FORTH word:                 UNTIL
    1340                 :  *
    1341                 :  *      Process Explanation:
    1342                 :  *          Same as AGAIN except token is conditional branch -- b?branch --
    1343                 :  *              instead of unconditional.
    1344                 :  *
    1345                 :  **************************************************************************** */
    1346                 : 
    1347                 : void emit_until( void )
    1348               4 : {
    1349               4 :     emit_token("b?branch");
    1350               4 :     resolve_backward( BEGIN_CSTAG );
    1351               4 : }
    1352                 : 
    1353                 : /* **************************************************************************
    1354                 :  *
    1355                 :  *      Function name:  emit_while
    1356                 :  *      Synopsis:       All the actions when WHILE is encountered
    1357                 :  *
    1358                 :  *      Associated FORTH word:                 WHILE
    1359                 :  *
    1360                 :  *      Inputs:
    1361                 :  *         Parameters:                  NONE
    1362                 :  *         Global Variables:
    1363                 :  *             control_stack_depth       Number of items on "Control-Stack"
    1364                 :  *         Control-Stack Items:
    1365                 :  *             Top:                      Begin_BACKw_BEGIN
    1366                 :  *                                 (Datum is OPC of backward-branch target)
    1367                 :  *
    1368                 :  *      Outputs:
    1369                 :  *         Returned Value:              NONE
    1370                 :  *         Control-Stack:        1 item added below top item.
    1371                 :  *         Items on Control-Stack:
    1372                 :  *             Top:                Begin_BACKw_BEGIN
    1373                 :  *             Next:               While_FORw_WHILE
    1374                 :  *         FCode Output buffer:
    1375                 :  *             Token for conditional branch -- b?branch -- followed by
    1376                 :  *                 place-holder of zero for FCode-offset
    1377                 :  *
    1378                 :  *      Error Detection:
    1379                 :  *          If the "Control-Stack" is empty, bypass creating the branch
    1380                 :  *              and let the call to  control_structure_swap()  report
    1381                 :  *              the underflow error.
    1382                 :  *
    1383                 :  *      Process Explanation:
    1384                 :  *          Output a conditional forward-branch sequence, similar to  IF 
    1385                 :  *              (except with a WHILE CSTAG), but be sure to leave the
    1386                 :  *              control-structure branch-marker that was created by the
    1387                 :  *              preceding  BEGIN   on top of the one just generated:
    1388                 :  *              the  BEGIN  needs to be resolved first in any case, and
    1389                 :  *              doing this here is the key to implementing the extended
    1390                 :  *              control-flow structures as described in sec. A.3.2.3.2
    1391                 :  *              of the ANSI Forth Spec.
    1392                 :  *
    1393                 :  *      Extraneous Remarks:
    1394                 :  *          It was for the use of this function that Wil Baden coined the
    1395                 :  *              name BUT for the control-structure swap routine.  The idea
    1396                 :  *              was that the implementation of WHILE could be boiled down
    1397                 :  *              to:  IF BUT   (couldn't quite fit an AND in there...;-} )
    1398                 :  *          Naturally, this implementation is a smidgeon more complicated...
    1399                 :  *
    1400                 :  **************************************************************************** */
    1401                 : 
    1402                 : void emit_while( void )
    1403              11 : {
    1404              11 :     if ( control_stack_depth > 0 )
    1405                 :     {
    1406              10 :         emit_token("b?branch");
    1407              10 :         mark_forward_branch( WHILE_CSTAG );
    1408                 :     }
    1409              11 :     control_structure_swap();
    1410              11 : }
    1411                 : 
    1412                 : /* **************************************************************************
    1413                 :  *
    1414                 :  *      Function name:  emit_repeat
    1415                 :  *      Synopsis:       All the actions when REPEAT is encountered
    1416                 :  *
    1417                 :  *      Associated FORTH word:                 REPEAT
    1418                 :  *
    1419                 :  *      Inputs:
    1420                 :  *         Parameters:                  NONE
    1421                 :  *         Local Static Variables:
    1422                 :  *             not_cs_underflow    If FALSE after first call to resolve marker,
    1423                 :  *                                     an underflow resulted; skip second call.
    1424                 :  *         Control-Stack Items:
    1425                 :  *             Top:                Begin_BACKw_BEGIN
    1426                 :  *                        (Datum is OPC of backward-branch target at BEGIN)
    1427                 :  *             Next:               If_FORw_IF
    1428                 :  *                        (Datum is OPC of FCode-offset place-holder)
    1429                 :  *
    1430                 :  *      Outputs:
    1431                 :  *         Returned Value:                    NONE
    1432                 :  *         Local Static Variables:
    1433                 :  *             not_consuming_two              Cleared, then restored
    1434                 :  *         Control-Stack, # of Items Popped:   2
    1435                 :  *         FCode Output buffer:
    1436                 :  *             Token for unconditional branch -- bbranch -- followed by
    1437                 :  *                 FCode-offset that reaches just after the  b(<mark) 
    1438                 :  *                 token at the corresponding  BEGIN  statement.  Then
    1439                 :  *                 the token for forward-resolve -- b(>resolve) -- and
    1440                 :  *                 the space reserved for the conditional forward-branch
    1441                 :  *                 FCode-offset is filled in so that it reaches the token
    1442                 :  *                 after the  b(>resolve) .
    1443                 :  *
    1444                 :  *      Process Explanation:
    1445                 :  *          The action is identical to that taken for AGAIN followed
    1446                 :  *               by the action for THEN.
    1447                 :  *          The Local Static Variable  not_consuming_two  gets cleared
    1448                 :  *               and restored by this routine.
    1449                 :  *
    1450                 :  **************************************************************************** */
    1451                 : 
    1452                 : void emit_repeat( void )
    1453              11 : {
    1454              11 :     if ( matchup_two_control_structures( BEGIN_CSTAG, WHILE_CSTAG ) )
    1455                 :     {
    1456               5 :         not_cs_underflow = TRUE;
    1457               5 :         not_consuming_two = FALSE;
    1458               5 :         emit_again();
    1459               5 :         if ( not_cs_underflow )
    1460                 :         {
    1461               5 :             emit_token("b(>resolve)");
    1462               5 :             resolve_forward( WHILE_CSTAG );
    1463                 :         }
    1464               5 :         not_consuming_two = TRUE;
    1465                 :     }
    1466              11 : }
    1467                 : 
    1468                 : /* **************************************************************************
    1469                 :  *
    1470                 :  *      Function name:  mark_do
    1471                 :  *      Synopsis:       Common routine for marking the branches for
    1472                 :  *                      the "do" variants
    1473                 :  *
    1474                 :  *      Associated FORTH words:              DO  ?DO
    1475                 :  *
    1476                 :  *      Inputs:
    1477                 :  *         Parameters:                  NONE
    1478                 :  *
    1479                 :  *      Outputs:
    1480                 :  *         Returned Value:              NONE
    1481                 :  *         Global Variables:
    1482                 :  *             do_loop_depth         Incremented
    1483                 :  *         Items Pushed onto Control-Stack:
    1484                 :  *             Top:              Do_FORw_DO
    1485                 :  *             Next:             Do_BACKw_DO
    1486                 :  *         FCode Output buffer:
    1487                 :  *             Place-holder of zero for FCode-offset
    1488                 :  *
    1489                 :  *      Error Detection:
    1490                 :  *          The  do_loop_depth  counter will be used by other routines
    1491                 :  *              to detect misplaced "LEAVE", "UNLOOP", "I" and suchlike.
    1492                 :  *              (Imbalanced "LOOP"  statements are detected by the CSTag
    1493                 :  *              matching mechanism.)
    1494                 :  *
    1495                 :  *      Process Explanation:
    1496                 :  *          Just before this function is called, the forward-branching token
    1497                 :  *              for the "DO" variant that begins the control-structure was
    1498                 :  *              written to the FCode Output buffer.
    1499                 :  *          It needs an FCode-offset for a forward-branch to just after
    1500                 :  *              its corresponding "LOOP" variant and the FCode-offset
    1501                 :  *              associated therewith.
    1502                 :  *          That "LOOP" variant's associated FCode-offset is targeted
    1503                 :  *              to the token that follows the one for this "DO" variant
    1504                 :  *              and its FCode-offset.
    1505                 :  *          Mark the forward-branch with the C-S Tag for DO and write a
    1506                 :  *              place-holder FCode-offset of zero to FCode Output.
    1507                 :  *          Indicate that the mark that will be processed second (but which
    1508                 :  *              was made first) is a duplicate of the one that will be
    1509                 :  *              processed first.
    1510                 :  *          Then mark the backward-branch target, also with the DO C-S Tag.
    1511                 :  *          Finally, increment the  do_loop_depth  counter.
    1512                 :  *
    1513                 :  *      Extraneous Remarks:
    1514                 :  *          This is more complicated to describe than to code...  ;-)
    1515                 :  *
    1516                 :  **************************************************************************** */
    1517                 : 
    1518                 : void mark_do( void )
    1519             146 : {
    1520             146 :     mark_forward_branch( DO_CSTAG);
    1521             146 :     control_stack->cs_not_dup = FALSE;
    1522             146 :     mark_backward_target( DO_CSTAG);
    1523             146 :     do_loop_depth++;
    1524             146 : }
    1525                 : 
    1526                 : 
    1527                 : /* **************************************************************************
    1528                 :  *
    1529                 :  *      Function name:  resolve_loop
    1530                 :  *      Synopsis:       Common routine for resolving the branches for
    1531                 :  *                      the "loop" variants.
    1532                 :  *
    1533                 :  *      Associated FORTH words:              LOOP  +LOOP
    1534                 :  *
    1535                 :  *      Inputs:
    1536                 :  *         Parameters:                  NONE
    1537                 :  *         Global Variables:
    1538                 :  *             statbuf             Word read from input stream (either "loop"
    1539                 :  *                                     or "+loop"), used for Error Message.
    1540                 :  *         Local Static Variables:
    1541                 :  *             not_cs_underflow    If FALSE after first call to resolve marker,
    1542                 :  *                                     an underflow resulted; skip second call.
    1543                 :  *         Control-Stack Items:
    1544                 :  *             Top:                Do_FORw_DO
    1545                 :  *             Next:               Do_BACKw_DO
    1546                 :  *
    1547                 :  *      Outputs:
    1548                 :  *         Returned Value:                    NONE
    1549                 :  *         Global Variables:
    1550                 :  *             do_loop_depth                  Decremented
    1551                 :  *         Local Static Variables:
    1552                 :  *             not_consuming_two              Cleared, then restored
    1553                 :  *             didnt_print_otl                Set, then set again at end.
    1554                 :  *         Control-Stack, # of Items Popped:   2
    1555                 :  *         FCode Output buffer:
    1556                 :  *             FCode-offset that reaches just after the token of the
    1557                 :  *                 corresponding "DO" variant.  Then the space reserved
    1558                 :  *                 for the FCode-offset of the forward-branch associated
    1559                 :  *                 with the "DO" variant is filled in so that it reaches
    1560                 :  *                 the token just after the "DO" variant's FCode-offset.
    1561                 :  *                 
    1562                 :  *      Error Detection:
    1563                 :  *          A value of zero in  do_loop_depth  before it's decremented
    1564                 :  *              indicates a  DO ... LOOP  imbalance, which is an ERROR,
    1565                 :  *              but our other error-reporting mechanisms will catch it,
    1566                 :  *              so we don't check or report it here.
    1567                 :  *
    1568                 :  *      Process Explanation:
    1569                 :  *          Just before this function is called, the backward-branching
    1570                 :  *              token for the "LOOP" variant that ends the control-structure
    1571                 :  *              was written to the FCode Output buffer.
    1572                 :  *          It needs an FCode-offset for a backward-branch targeted just
    1573                 :  *              after its corresponding "DO" variant and the FCode-offset
    1574                 :  *              associated therewith.
    1575                 :  *          That "DO" variant's associated FCode-offset is targeted to
    1576                 :  *              the token that follows the one for this "LOOP" variant
    1577                 :  *              and its FCode-offset.
    1578                 :  *          Make sure there are two DO C-S Tag entries on the Control Stack.
    1579                 :  *          Resolve the backward-branch, matching your target to the first
    1580                 :  *              C-S Tag for DO
    1581                 :  *          Then resolve the forward-branch, targeting to your new OPC
    1582                 :  *              position, and also making sure you match the DO C-S Tag.
    1583                 :  *          We keep track of  do_loop_depth  for other error-detection
    1584                 :  *              by decrementing it; make sure it doesn't go below zero.
    1585                 :  *          Don't bother resolving the forward-branch if we underflowed
    1586                 :  *              the "Control Stack" trying to resolve the backward-branch.
    1587                 :  *          If the two top C-S Tag entries are not for a DO statement, the
    1588                 :  *              matchup_two_control_structures() routine will consume both
    1589                 :  *              or up to two of them, and we will place a dummy offset of
    1590                 :  *              zero to follow-up the backward-branching token that has
    1591                 :  *              already been written.
    1592                 :  *      
    1593                 :  *      Extraneous Remarks:
    1594                 :  *          This is only a little more complicated to describe
    1595                 :  *              than to code...  ;-)
    1596                 :  *
    1597                 :  **************************************************************************** */
    1598                 : 
    1599                 : void resolve_loop( void )
    1600             146 : {
    1601             146 :     if ( INVERSE( matchup_two_control_structures( DO_CSTAG, DO_CSTAG) ) )
    1602                 :     {
    1603               7 :         emit_offset( 0 );
    1604                 :     }else{
    1605             139 :         not_cs_underflow = TRUE;
    1606             139 :         didnt_print_otl = TRUE;
    1607             139 :         not_consuming_two = FALSE;
    1608             139 :         resolve_backward( DO_CSTAG);
    1609             139 :         if ( not_cs_underflow )
    1610                 :         {
    1611             139 :             resolve_forward( DO_CSTAG);
    1612                 :         }
    1613             139 :         if ( do_loop_depth > 0 ) do_loop_depth--;
    1614             139 :         not_consuming_two = TRUE;
    1615             139 :         didnt_print_otl = TRUE;   /*  Might have gotten cleared   */
    1616                 :     }
    1617             146 : }
    1618                 : 
    1619                 : /* **************************************************************************
    1620                 :  *
    1621                 :  *      Function name:  emit_case
    1622                 :  *      Synopsis:       All the actions when CASE is encountered
    1623                 :  *
    1624                 :  *      Associated FORTH word:                 CASE
    1625                 :  *
    1626                 :  *      Inputs:
    1627                 :  *         Parameters:             NONE
    1628                 :  *
    1629                 :  *      Outputs:
    1630                 :  *         Returned Value:         NONE
    1631                 :  *         Items Pushed onto Control-Stack:
    1632                 :  *             Top:              N_OFs=0...CASE_CSTAG
    1633                 :  *                    (Datum is 0 , Initial count of  OF .. ENDOF  pairs)
    1634                 :  *         FCode Output buffer:
    1635                 :  *             Token for start of a CASE structure -- b(case)
    1636                 :  *                 Does not require an FCode-offset.
    1637                 :  *
    1638                 :  **************************************************************************** */
    1639                 : 
    1640                 : void emit_case( void )
    1641              34 : {
    1642              34 :     push_cstag( CASE_CSTAG, 0);
    1643              34 :     emit_token("b(case)");
    1644              34 : }
    1645                 : 
    1646                 : 
    1647                 : /* **************************************************************************
    1648                 :  *
    1649                 :  *      Function name:  emit_of
    1650                 :  *      Synopsis:       All the actions when OF is encountered
    1651                 :  *
    1652                 :  *      Associated FORTH word:                 OF
    1653                 :  *
    1654                 :  *      Inputs:
    1655                 :  *         Parameters:             NONE
    1656                 :  *         Control-Stack Items:
    1657                 :  *             Top:                N_OFs...CASE_CSTAG
    1658                 :  *                    (Datum is OF-count, number of  OF .. ENDOF  pairs)
    1659                 :  *            {Next and beyond}:   {Endof_FORw_ENDOF}1..n_ofs
    1660                 :  *            { Repeat for OF-count number of times }
    1661                 :  *
    1662                 :  *      Outputs:
    1663                 :  *         Returned Value:         NONE
    1664                 :  *         Control-Stack, 1 Item Pushed, 1 modified:
    1665                 :  *             Top:                Of_FORw_OF
    1666                 :  *             Next:               N_OFs+1...CASE_CSTAG
    1667                 :  *                    (Datum has been incremented)
    1668                 :  *            {3rd and beyond}:    {Endof_FORw_ENDOF}1..n_ofs
    1669                 :  *            { Repeat for 1 through the un-incremented OF-count }
    1670                 :  *            (Same as Next etcetera at input-time.)
    1671                 :  *         FCode Output buffer:
    1672                 :  *             Token for OF statement -- b(of) -- followed by
    1673                 :  *                 place-holder FCode-offset of zero
    1674                 :  *
    1675                 :  *      Error Detection:
    1676                 :  *          Matchup CASE-cstag before incrementing OF-count
    1677                 :  *
    1678                 :  *      Process Explanation:
    1679                 :  *          Main difference between this implementation and that outlined
    1680                 :  *              in "the book" (see below) is that we do not directly use
    1681                 :  *              the routine for the IF statement's flow-control; we will
    1682                 :  *              use a different CSTAG for better mismatch detection.
    1683                 :  *
    1684                 :  *      Extraneous Remarks:
    1685                 :  *          This is a "by the book" (ANSI Forth spec, section A.3.2.3.2)
    1686                 :  *              implementation (mostly).  Incrementing the OF-count here,
    1687                 :  *              after we've matched up the CSTAG, gives us (and the user)
    1688                 :  *              just a little bit more protection...
    1689                 :  *
    1690                 :  **************************************************************************** */
    1691                 : 
    1692                 : void emit_of( void )
    1693            1298 : {
    1694                 : 
    1695            1298 :     if ( matchup_control_structure( CASE_CSTAG ) )
    1696                 :     {
    1697            1291 :         emit_token("b(of)");
    1698                 : 
    1699                 :         /*
    1700                 :          *  See comment-block about "Control-Stack" Diagram Notation
    1701                 :          *       early on in this file.
    1702                 :          *
    1703                 :          */
    1704                 : 
    1705                 :         /* (    {Endof_FORw_ENDOF}1..n_ofs  N_OFs...CASE_CSTAG -- )          */
    1706                 : 
    1707                 :         /*  Increment the OF-count .  */
    1708            1291 :         (control_stack->cs_datum)++;
    1709                 : 
    1710                 :         /* (    {Endof_FORw_ENDOF}1..n_ofs  N_OFs+1...CASE_CSTAG -- )        */
    1711                 : 
    1712            1291 :         mark_forward_branch( OF_CSTAG );
    1713                 :         /* ( -- {Endof_FORw_ENDOF}1..n_ofs  N_OFs+1...CASE_CSTAG Of_FORw_OF )
    1714                 :          */
    1715                 :     }
    1716                 :     /*  Leave the CSTAG-Group on the "Control-Stack" .  */
    1717            1298 : }
    1718                 : 
    1719                 : 
    1720                 : /* **************************************************************************
    1721                 :  *
    1722                 :  *      Function name:  emit_endof
    1723                 :  *      Synopsis:       All the actions when ENDOF is encountered
    1724                 :  *
    1725                 :  *      Associated FORTH word:                 ENDOF
    1726                 :  *
    1727                 :  *      Inputs:
    1728                 :  *         Parameters:             NONE
    1729                 :  *         Control-Stack Items:
    1730                 :  *             Top:                Of_FORw_OF
    1731                 :  *             Next:               N_OFs+1...CASE_CSTAG
    1732                 :  *                    (Datum has been incremented)
    1733                 :  *            {3rd and beyond}:    {Endof_FORw_ENDOF}1..n_ofs
    1734                 :  *            { Repeat for 1 through the un-incremented OF-count )
    1735                 :  *
    1736                 :  *      Outputs:
    1737                 :  *         Returned Value:         NONE
    1738                 :  *         Control-Stack, 1 Item Popped, 1 new Item Pushed.
    1739                 :  *             Top:                N_OFs...CASE_CSTAG
    1740                 :  *                    (The count itself is unchanged from input-time, but
    1741                 :  *                         the number of {Endof_FORw_ENDOF} CSTAG-Groups
    1742                 :  *                         has caught up with this number, so it is
    1743                 :  *                         no longer notated as " + 1 ").
    1744                 :  *            {Next and beyond}:   {Endof_FORw_ENDOF}1..n_ofs
    1745                 :  *            { Repeat for 1 through the updated OF-count )
    1746                 :  *         FCode Output buffer:
    1747                 :  *             Token for ENDOF statement -- b(endof) -- followed by
    1748                 :  *                 place-holder FCode-offset of zero.  Then the space reserved
    1749                 :  *                 for the FCode-offset of the forward-branch associated
    1750                 :  *                 with the "OF" statement is filled in so that it reaches
    1751                 :  *                 the token just after the "ENDOF" statement's FCode-offset.
    1752                 :  *
    1753                 :  *      Error Detection:
    1754                 :  *          If control-stack depth  is not at least 2, CS underflow ERROR
    1755                 :  *              and no further action.
    1756                 :  *          Routine that resolves the forward-branch checks for matchup error.
    1757                 :  *
    1758                 :  **************************************************************************** */
    1759                 : 
    1760                 : void emit_endof( void )
    1761            1297 : {
    1762            1297 :     if ( control_stack_size_test( 2) )
    1763                 :     {
    1764            1296 :         emit_token("b(endof)");
    1765                 : 
    1766                 :         /*  See "Control-Stack" Diagram Notation comment-block  */
    1767                 : 
    1768                 :         /*  Stack-diagrams might need to be split across lines.  */
    1769                 : 
    1770                 :         /* (    {Endof_FORw_ENDOF}1..n_ofs  N_OFs+1...CASE_CSTAG  ...  
    1771                 :          *                       ...                          Of_FORw_OF -- )
    1772                 :          */
    1773            1296 :         mark_forward_branch(ENDOF_CSTAG);
    1774                 :         /* ( -- {Endof_FORw_ENDOF}1..n_ofs  N_OFs+1...CASE_CSTAG  ...  
    1775                 :          *                       ...  Of_FORw_OF  {Endof_FORw_ENDOF}n_ofs+1 )
    1776                 :          */
    1777                 : 
    1778            1296 :         control_structure_swap();
    1779                 :         /* ( -- {Endof_FORw_ENDOF}1..n_ofs  N_OFs+1...CASE_CSTAG  ...
    1780                 :          *                       ...  {Endof_FORw_ENDOF}n_ofs+1  Of_FORw_OF )
    1781                 :          */
    1782                 : 
    1783            1296 :         resolve_forward( OF_CSTAG );
    1784                 :         /* ( -- {Endof_FORw_ENDOF}1..n_ofs  N_OFs+1...CASE_CSTAG        ...
    1785                 :          *                       ...  {Endof_FORw_ENDOF}n_ofs+1  )
    1786                 :          */
    1787                 : 
    1788            1296 :         control_structure_swap();
    1789                 :         /* ( -- {Endof_FORw_ENDOF}1..n_ofs         ...
    1790                 :          *                       ...  {Endof_FORw_ENDOF}n_ofs+1   ...
    1791                 :          *                                        ...  N_OFs+1...CASE_CSTAG )
    1792                 :          */
    1793                 : 
    1794                 :         /*  The number of ENDOF-tagged Forward-Marker pairs has now
    1795                 :          *     caught up with the incremented OF-count; therefore,
    1796                 :          *     we can notate the above as:
    1797                 :          *
    1798                 :          *  ( {Endof_FORw_ENDOF}1..n_ofs  N_OFs CASE_CSTAG )
    1799                 :          *
    1800                 :          *     and we are ready for another  OF ... ENDOF  pair,
    1801                 :          *     or for the ENDCASE statement.
    1802                 :          */
    1803                 :     }
    1804                 : 
    1805            1297 : }
    1806                 : 
    1807                 : /* **************************************************************************
    1808                 :  *
    1809                 :  *      Function name:  emit_endcase
    1810                 :  *      Synopsis:       All the actions when ENDCASE is encountered
    1811                 :  *
    1812                 :  *      Associated FORTH word:                 ENDCASE
    1813                 :  *
    1814                 :  *      Inputs:
    1815                 :  *         Parameters:             NONE
    1816                 :  *         Control-Stack Items:
    1817                 :  *             Top:                N_OFs...CASE_CSTAG
    1818                 :  *                    (Datum is OF-count, number of  OF .. ENDOF  pairs)
    1819                 :  *            {Next and beyond}:   {Endof_FORw_ENDOF}1..n_ofs
    1820                 :  *            { Repeat for OF-count number of times }
    1821                 :  *
    1822                 :  *      Outputs:
    1823                 :  *         Returned Value:         NONE
    1824                 :  *         Control-Stack, # of Items Popped:  OF-count + 1
    1825                 :  *         FCode Output buffer:
    1826                 :  *             Token for ENDCASE statement -- b(endcase)
    1827                 :  *             Then the spaces reserved for the FCode-offsets of all the
    1828                 :  *                 forward-branches associated with the OF-count number
    1829                 :  *                 of ENDOF statements are filled in so that they reach
    1830                 :  *                 the token just after this "ENDCASE" statement.
    1831                 :  *
    1832                 :  *      Error Detection:
    1833                 :  *          Routine that resolves the forward-branch checks for matchup error
    1834                 :  *              for each forward-branch filled in, plus the matchup routine
    1835                 :  *              checks before the OF-count is retrieved.
    1836                 :  *
    1837                 :  *      Process Explanation:
    1838                 :  *          Retrieve the OF-count and resolve that number of ENDOF statements
    1839                 :  *      
    1840                 :  *      Extraneous Remarks:
    1841                 :  *          The setup makes coding this routine appear fairly simple...  ;-}
    1842                 :  *
    1843                 :  **************************************************************************** */
    1844                 : 
    1845                 : void emit_endcase( void )
    1846              33 : {
    1847                 :     unsigned long n_endofs ;
    1848              33 :     if ( matchup_control_structure( CASE_CSTAG) )
    1849                 :     {
    1850                 :         int indx;
    1851                 : 
    1852              29 :         emit_token("b(endcase)");
    1853              29 :         n_endofs = control_stack->cs_datum;
    1854            1313 :         for ( indx = 0 ; indx < n_endofs ; indx++ )
    1855                 :         {
    1856                 :             /*  Because  matchup_control_structure  doesn't pop the
    1857                 :              *      control-stack, we have the  N_OFs...CASE_CSTAG
    1858                 :              *      item on top of the  Endof_FORw_ENDOF  item we
    1859                 :              *      want to resolve.  We need to keep it there so
    1860                 :              *      the  POP  is valid for the other path as well
    1861                 :              *      as at the end of this one.
    1862                 :              *  So we  SWAP  to get at the  Endof_FORw_ENDOF  item.
    1863                 :              */
    1864            1284 :             control_structure_swap();
    1865            1284 :             resolve_forward( ENDOF_CSTAG);
    1866                 :         }
    1867                 :     }
    1868              33 :     pop_cstag();
    1869              33 : }
    1870                 : 
    1871                 : 
    1872                 : /* **************************************************************************
    1873                 :  *
    1874                 :  *      Function name:  control_struct_incomplete
    1875                 :  *      Synopsis:       Print a Message of given severity with origin info for
    1876                 :  *                          a control-structure that has not been completed.
    1877                 :  *
    1878                 :  *      Inputs:
    1879                 :  *         Parameters:
    1880                 :  *             c_s_entry             Control-structure about which to display
    1881                 :  *             severity              Severity of the messages to display.
    1882                 :  *             call_cond             String identifying Calling Condition;
    1883                 :  *                                       used in the message.
    1884                 :  *
    1885                 :  *      Outputs:
    1886                 :  *         Returned Value:           NONE
    1887                 :  *             
    1888                 :  *         Printout:
    1889                 :  *             Message of given severity...
    1890                 :  *
    1891                 :  *      Process Explanation:
    1892                 :  *          The calling routine will be responsible for all filtering of
    1893                 :  *               duplicate structures and the like.  This routine will
    1894                 :  *               simply display a message.
    1895                 :  *
    1896                 :  **************************************************************************** */
    1897                 : 
    1898                 : static void control_struct_incomplete(
    1899                 :                             int severity,
    1900                 :                                 char *call_cond,
    1901                 :                                     cstag_group_t *c_s_entry)
    1902              45 : {
    1903              45 :     tokenization_error ( severity,
    1904                 :         "%s before completion of %s" ,
    1905                 :             call_cond, strupr(c_s_entry->cs_word));
    1906              45 :     where_started( c_s_entry->cs_inp_fil, c_s_entry->cs_line_num );
    1907              45 : }
    1908                 : 
    1909                 : /* **************************************************************************
    1910                 :  *
    1911                 :  *      Function name:  announce_control_structs
    1912                 :  *      Synopsis:       Print a series of Messages (of severity as specified)
    1913                 :  *                          announcing that the calling event is occurring
    1914                 :  *                          in the context of Control-Flow structure(s),
    1915                 :  *                          back to the given limit.  Leave the control
    1916                 :  *                          structures in effect.
    1917                 :  *
    1918                 :  *      Inputs:
    1919                 :  *         Parameters:
    1920                 :  *             severity              Severity of the messages to display.
    1921                 :  *             call_cond             String identifying Calling Condition;
    1922                 :  *                                       used in the message.
    1923                 :  *             abs_token_limit       Limit, in terms of abs_token_no
    1924                 :  *         Local Static Variables:
    1925                 :  *             control_stack         Pointer to "Top" of "Control-Stack"
    1926                 :  *
    1927                 :  *      Outputs:
    1928                 :  *         Returned Value:           NONE
    1929                 :  *         Printout:
    1930                 :  *             A Message for each unresolved Control-Flow structure.
    1931                 :  *
    1932                 :  **************************************************************************** */
    1933                 : 
    1934                 : void announce_control_structs( int severity, char *call_cond,
    1935                 :                                           unsigned int abs_token_limit)
    1936             312 : {
    1937             312 :     cstag_group_t *cs_temp = control_stack;
    1938             668 :     while ( cs_temp != NULL )
    1939                 :     {
    1940              45 :         if ( cs_temp->cs_abs_token_num < abs_token_limit )
    1941                 :         {
    1942               1 :             break;
    1943                 :         }
    1944              44 :         if ( cs_temp->cs_not_dup )
    1945                 :         {
    1946              29 :             control_struct_incomplete( severity, call_cond, cs_temp );
    1947                 :         }
    1948              44 :         cs_temp = cs_temp->prev;
    1949                 :     }
    1950             312 : }
    1951                 : 
    1952                 : /* **************************************************************************
    1953                 :  *
    1954                 :  *      Function name:  clear_control_structs_to_limit
    1955                 :  *      Synopsis:       Clear items from the "Control-Stack" back to the given
    1956                 :  *                          limit.  Print error-messages with origin info for
    1957                 :  *                          control-structures that have not been completed.
    1958                 :  *
    1959                 :  *      Inputs:
    1960                 :  *         Parameters:
    1961                 :  *             call_cond                 String identifying Calling Condition;
    1962                 :  *                                           used in the Error message.
    1963                 :  *             abs_token_limit           Limit, in terms of abs_token_no
    1964                 :  *         Global Variables:
    1965                 :  *             control_stack_depth       Number of items on "Control-Stack"
    1966                 :  *             control_stack             Pointer to "Top" of "Control-Stack"
    1967                 :  *         Control-Stack Items:
    1968                 :  *             The  cs_inp_fil  and  cs_line_num  tags of any item cleared
    1969                 :  *                 from the "Control-Stack" are used in error-messages.
    1970                 :  *
    1971                 :  *      Outputs:
    1972                 :  *         Returned Value: 
    1973                 :  *         Global Variables:
    1974                 :  *             do_loop_depth             Decremented when "DO" item cleared.
    1975                 :  *             control_stack_depth       Decremented by called routine.
    1976                 :  *         Control-Stack, # of Items Popped:  As many as go back to given limit
    1977                 :  *         Memory Freed
    1978                 :  *             By called routine.
    1979                 :  *
    1980                 :  *      Error Detection:
    1981                 :  *          Any item on the "Control-Stack" represents a Control-Structure
    1982                 :  *              that was not completed when the Calling Condition was
    1983                 :  *              encountered.  Error; identify the origin of the structure.
    1984                 :  *          No special actions if  noerrors  is set.
    1985                 :  *
    1986                 :  *      Process Explanation:
    1987                 :  *          The given limit corresponds to the value of  abs_token_no  at
    1988                 :  *              the time the colon-definition (or whatever...) was created.
    1989                 :  *              Any kind of Control-Structure imbalance at the end of the
    1990                 :  *              colon-definition is an error and the entries must be cleared,
    1991                 :  *              but the colon-definition may have been created inside nested
    1992                 :  *              interpretation-time Control-Structures, and those must be
    1993                 :  *              preserved. 
    1994                 :  *             
    1995                 :  *          Of course, if this routine is called with a given limit of zero,
    1996                 :  *              that would mean all the entries are to be cleared.  That will
    1997                 :  *              be the way  clear_control_structs()  is implemented.
    1998                 :  *          We control the loop by the  cs_abs_token_num  field, but also
    1999                 :  *              make sure we haven't underflowed  control_stack_depth
    2000                 :  *          We skip messages and other processing for items that are duplicates
    2001                 :  *                    of others, based on the  cs_not_dup  field.
    2002                 :  *               If the cs_tag field is  DO_CSTAG  we decrement  do_loop_depth
    2003                 :  *          The  pop_cstag()  routine takes care of the rest.
    2004                 :  *               
    2005                 :  *      Extraneous Remarks:
    2006                 :  *          This is a retrofit; necessary because we now  permit definitions
    2007                 :  *              to occur inside interpretation-time Control-Structures.  Calls
    2008                 :  *              to  clear_control_structs()  are already scattered around...
    2009                 :  *
    2010                 :  **************************************************************************** */
    2011                 : 
    2012                 : void clear_control_structs_to_limit( char *call_cond,
    2013                 :                                           unsigned int abs_token_limit)
    2014            1089 : {
    2015            2196 :     while ( control_stack_depth > 0 )
    2016                 :     {
    2017              27 :         if ( control_stack->cs_abs_token_num < abs_token_limit )
    2018                 :         {
    2019               9 :             break;
    2020                 :         }
    2021              18 :         if ( control_stack->cs_not_dup )
    2022                 :         {
    2023              16 :             control_struct_incomplete( TKERROR, call_cond, control_stack );
    2024              16 :             if ( control_stack->cs_tag == DO_CSTAG) do_loop_depth--;
    2025                 :         }
    2026              18 :         pop_cstag();
    2027                 :     }
    2028            1089 : }
    2029                 : 
    2030                 : /* **************************************************************************
    2031                 :  *
    2032                 :  *      Function name:  clear_control_structs
    2033                 :  *      Synopsis:       Make sure the "Control-Stack" is cleared, and print
    2034                 :  *                          error-messages (giving origin information) for
    2035                 :  *                          control-structures that have not been completed.
    2036                 :  *
    2037                 :  *      Inputs:
    2038                 :  *         Parameters:
    2039                 :  *             call_cond                 String identifying Calling Condition;
    2040                 :  *                                           used in the Error message.
    2041                 :  *         Global Variables:
    2042                 :  *             control_stack_depth       Number of items on "Control-Stack"
    2043                 :  *             control_stack             Pointer to "Top" of "Control-Stack"
    2044                 :  *         Control-Stack Items:
    2045                 :  *             The  cs_inp_fil  and  cs_line_num  tags of any item found on
    2046                 :  *                 the "Control-Stack" are used in error-messages.
    2047                 :  *
    2048                 :  *      Outputs:
    2049                 :  *         Returned Value:               NONE
    2050                 :  *         Global Variables:
    2051                 :  *             control_stack_depth       Reset to zero.
    2052                 :  *             do_loop_depth             Reset to zero.
    2053                 :  *         Control-Stack, # of Items Popped:    All of them
    2054                 :  *             
    2055                 :  *      Error Detection:
    2056                 :  *          Any item on the "Control-Stack" represents a Control-Structure
    2057                 :  *              that was not completed when the Calling Condition was
    2058                 :  *              encountered.  Error; identify the origin of the structure.
    2059                 :  *          No special actions if  noerrors  is set.
    2060                 :  *
    2061                 :  *      Process Explanation:
    2062                 :  *          Filter the duplicate messages caused by structures (e.g., DO)
    2063                 :  *              that place two entries on the "Control-Stack" by testing
    2064                 :  *              the  cs_not_dup  field of the "Top" "Control-Stack" item,
    2065                 :  *              which would indicate double-entry...
    2066                 :  *
    2067                 :  *      Extraneous Remarks:
    2068                 :  *          This is called before a definition of any kind, and after a 
    2069                 :  *              colon-definition.  Flow-control constructs should *never*
    2070                 :  *              be allowed to cross over between immediate-execution mode
    2071                 :  *              and compilation mode.  Likewise, not between device-nodes.
    2072                 :  *          Also, at the end of tokenization, there should not be any
    2073                 :  *              unresolved flow-control constructs.
    2074                 :  *
    2075                 :  **************************************************************************** */
    2076                 : 
    2077                 : void clear_control_structs( char *call_cond)
    2078             190 : {
    2079             190 :     clear_control_structs_to_limit( call_cond, 0);
    2080             190 : }

Generated by: LTP GCOV extension version 1.5