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 (2001, "no such label", curlex);
    32      return NO_LABEL;
    33    } else if (L->nonexe) {
    34      ERROR (2002, "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 (2003, ")");
    76      rc = scan (EXPECT_NONE);
    77      if (TOKEN (",")) {
    78        rc = scan (EXPECT_NONE);
    79      }
    80      EXPR var;
    81      express (&var, INTEGER, 4);
    82      patch (apatch, var.str);
    83      code (nprocs, BODY, "}\n");
    84      skip_card (FALSE);
    85    } else if (rc == WORD) {
    86  // GOTO idf [, (...)]
    87      IDENT *idf = find_local (curlex, NO_MODE);
    88      if (idf == NO_IDENT ) {
    89        return;
    90      }
    91      if (idf->mode.type != INTEGER) {
    92        EXPECT (2004, "integer variable");
    93      }
    94      NEW_RECORD (str);
    95      EXPR var; MODE mode;
    96      var.str[0] = '\0';
    97      factor_variable (&var, idf, &mode, curlex);
    98      _srecordf (str, "switch (%s) {\n", var.str);
    99      code (nprocs, BODY, str);
   100      code (nprocs, BODY, "default:\n");
   101      rc = scan (EXPECT_NONE);
   102      if (TOKEN (",") || TOKEN ("(")) {
   103    // Emit indicated labels.
   104        if (TOKEN (",")) {
   105          rc = scan (EXPECT_NONE);
   106        }
   107        CHECKPOINT (2005, "(");
   108        rc = scan (EXPECT_LABEL);
   109        while (rc == LABEL) {
   110          LBL *L = get_label ();
   111          if (L == NO_LABEL) {
   112            return;
   113          }
   114          _srecordf (str, "case %d: goto _l%d;\n", L->index, L->num);
   115          code (nprocs, BODY, str);
   116          rc = scan (EXPECT_LABEL);
   117          if (TOKEN (",")) {
   118            rc = scan (EXPECT_LABEL);
   119          }
   120        }
   121        CHECKPOINT (2006, ")");
   122        code (nprocs, BODY, "}\n");
   123        skip_card (FALSE);
   124      } else {
   125    // Default, emit all labels.
   126        for (int_4 k = 0; k < nlabels; k++) {
   127          LBL *L = &labels[k];
   128          if (! L->nonexe) {
   129            L->jumped++;
   130            _srecordf (str, "case %d: goto _l%d;\n", L->index, L->num);
   131            code (nprocs, BODY, str);
   132          }
   133        }
   134        code (nprocs, BODY, "}\n");
   135        skip_card (FALSE);
   136      }
   137    }
   138  }


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