goto.c

     1  //! @file goto.c
     2  //! @author J. Marcel van der Veer
     3  //
     4  //! @section Copyright
     5  //
     6  // This file is part of VIF - vintage FORTRAN compiler.
     7  // Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
     8  //
     9  //! @section License
    10  //
    11  // This program is free software; you can redistribute it and/or modify it 
    12  // under the terms of the GNU General Public License as published by the 
    13  // Free Software Foundation; either version 3 of the License, or 
    14  // (at your option) any later version.
    15  //
    16  // This program is distributed in the hope that it will be useful, but 
    17  // WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
    18  // or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 
    19  // more details. You should have received a copy of the GNU General Public 
    20  // License along with this program. If not, see <http://www.gnu.org/licenses/>.
    21  
    22  //! @section Synopsis
    23  //!
    24  //! Compile GOTO.
    25  
    26  #include <vif.h>
    27  
    28  static LBL *get_label (void) {
    29    LBL *L = find_label (curlex);
    30    if (L == NO_LABEL) {
    31      ERROR (2101, "no such label", curlex);
    32      return NO_LABEL;
    33    } else if (L->nonexe) {
    34      ERROR (2102, "label of non-executable", curlex);
    35      return NO_LABEL;
    36    }
    37    L->jumped++;
    38    return L;
    39  }
    40  
    41  void jump (void)
    42  {
    43    int_4 rc = scan (EXPECT_LABEL);
    44    if (rc == LABEL) {
    45  // GOTO label
    46      LBL *L = get_label ();
    47      if (L == NO_LABEL) {
    48        return;
    49      }
    50      NEW_RECORD (str);
    51      _srecordf (str, "goto _l%d;\n", L->num);
    52      code (nprocs, BODY, str);
    53      skip_card (FALSE);
    54    } else if (TOKEN ("(")) {
    55  // GOTO (...), expr
    56      code (nprocs, BODY, "switch (");
    57      int_4 apatch = code (nprocs, BODY, NO_TEXT);
    58      code (nprocs, BODY, ") {\n");
    59      code (nprocs, BODY, "default:\n");
    60      rc = scan (EXPECT_LABEL);
    61      int_4 N = 1;
    62      while (rc == LABEL) {
    63        NEW_RECORD (str);
    64        LBL *L = get_label ();
    65        if (L == NO_LABEL) {
    66          return;
    67        }
    68        _srecordf (str, "case %d: goto _l%d;\n", N++, L->num);
    69        code (nprocs, BODY, str);
    70        rc = scan (EXPECT_NONE);
    71        if (TOKEN (",")) {
    72          rc = scan (EXPECT_LABEL);
    73        }
    74      };
    75      CHECKPOINT (2103, ")");
    76      rc = scan (EXPECT_NONE);
    77      if (TOKEN (",")) {
    78        rc = scan (EXPECT_NONE);
    79      }
    80      EXPR var;
    81      macro_depth = 0;
    82      express (&var, INTEGER, 4);
    83      patch (apatch, var.str);
    84      code (nprocs, BODY, "}\n");
    85      skip_card (FALSE);
    86    } else if (rc == WORD) {
    87  // GOTO idf [, (...)]
    88      IDENT *idf = find_local (curlex, NO_MODE);
    89      if (idf == NO_IDENT ) {
    90        return;
    91      }
    92      if (idf->mode.type != INTEGER) {
    93        EXPECT (2104, "integer variable");
    94      }
    95      NEW_RECORD (str);
    96      EXPR var; MODE mode;
    97      var.str[0] = '\0';
    98      factor_variable (&var, idf, &mode, curlex);
    99      _srecordf (str, "switch (%s) {\n", var.str);
   100      code (nprocs, BODY, str);
   101      code (nprocs, BODY, "default:\n");
   102      rc = scan (EXPECT_NONE);
   103      if (TOKEN (",") || TOKEN ("(")) {
   104    // Emit indicated labels.
   105        if (TOKEN (",")) {
   106          rc = scan (EXPECT_NONE);
   107        }
   108        CHECKPOINT (2105, "(");
   109        rc = scan (EXPECT_LABEL);
   110        while (rc == LABEL) {
   111          LBL *L = get_label ();
   112          if (L == NO_LABEL) {
   113            return;
   114          }
   115          _srecordf (str, "case %d: goto _l%d;\n", L->index, L->num);
   116          code (nprocs, BODY, str);
   117          rc = scan (EXPECT_LABEL);
   118          if (TOKEN (",")) {
   119            rc = scan (EXPECT_LABEL);
   120          }
   121        }
   122        CHECKPOINT (2106, ")");
   123        code (nprocs, BODY, "}\n");
   124        skip_card (FALSE);
   125      } else {
   126    // Default, emit all labels.
   127        for (int_4 k = 0; k < nlabels; k++) {
   128          LBL *L = &labels[k];
   129          if (! L->nonexe) {
   130            L->jumped++;
   131            _srecordf (str, "case %d: goto _l%d;\n", L->index, L->num);
   132            code (nprocs, BODY, str);
   133          }
   134        }
   135        code (nprocs, BODY, "}\n");
   136        skip_card (FALSE);
   137      }
   138    }
   139  }


© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)