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 statements.
  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 (1801, "no such label", curlex);
  32      return NO_LABEL;
  33    } else if (L->nonexe) {
  34      ERROR (1802, "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      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        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 (1803, ")");
  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 (1804, "integer variable");
  93      }
  94      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 (1805, "(");
 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 (1806, ")");
 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)