Algol 68 Genie

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-2024 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 == NULL) {
  31      ERROR (1801, "no such label", curlex);
  32      return NULL;
  33    } else if (L->nonexe) {
  34      ERROR (1802, "label of non-executable", curlex);
  35      return NULL;
  36    }
  37    L->jumped++;
  38    return L;
  39  }
  40  
  41  void jump (void)
  42  {
  43    int_4 rc = scan (NULL);
  44    if (rc == INT_NUMBER) {
  45  // GOTO label
  46      LBL *L = get_label ();
  47      if (L == NULL) {
  48        return;
  49      }
  50      RECORD str;
  51      _srecordf (str, "goto _l%d;\n", L->num);
  52      code (nprocs, BODY, str);
  53      skip_card ();
  54    } else if (TOKEN ("(")) {
  55  // GOTO (...), expr
  56      code (nprocs, BODY, "switch (");
  57      int_4 apatch = code (nprocs, BODY, NULL);
  58      code (nprocs, BODY, ") {\n");
  59      code (nprocs, BODY, "default:\n");
  60      rc = scan (NULL);
  61      int_4 N = 1;
  62      while (rc == INT_NUMBER) {
  63        RECORD str;
  64        LBL *L = get_label ();
  65        if (L == NULL) {
  66          return;
  67        }
  68        _srecordf (str, "case %d: goto _l%d;\n", N++, L->num);
  69        code (nprocs, BODY, str);
  70        rc = scan (NULL);
  71        if (TOKEN (",")) {
  72          rc = scan (NULL);
  73        }
  74      };
  75      CHECKPOINT (1803, ")");
  76      rc = scan (NULL);
  77      if (TOKEN (",")) {
  78        rc = scan (NULL);
  79      }
  80      EXPR var;
  81      express (&var, INTEGER, 4);
  82      patch (apatch, var.str);
  83      code (nprocs, BODY, "}\n");
  84      skip_card ();
  85    } else if (rc == WORD) {
  86  // GOTO idf [, (...)]
  87      IDENT *idf = find_local (curlex, NULL);
  88      if (idf == NULL ) {
  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      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 (NULL);
 102      if (TOKEN (",") || TOKEN ("(")) {
 103    // Emit indicated labels.
 104        if (TOKEN (",")) {
 105          rc = scan (NULL);
 106        }
 107        rc = scan (NULL);
 108        while (rc == INT_NUMBER) {
 109          LBL *L = get_label ();
 110          if (L == NULL) {
 111            return;
 112          }
 113          _srecordf (str, "case %d: goto _l%d;\n", L->index, L->num);
 114          code (nprocs, BODY, str);
 115          rc = scan (NULL);
 116          if (TOKEN (",")) {
 117            rc = scan (NULL);
 118          }
 119        }
 120        CHECKPOINT (1805, ")");
 121        code (nprocs, BODY, "}\n");
 122        skip_card ();
 123      } else {
 124    // Default, emit all labels.
 125        for (int_4 k = 0; k < nlabels; k++) {
 126          LBL *L = &labels[k];
 127          if (! L->nonexe) {
 128            L->jumped++;
 129            _srecordf (str, "case %d: goto _l%d;\n", L->index, L->num);
 130            code (nprocs, BODY, str);
 131          }
 132        }
 133        code (nprocs, BODY, "}\n");
 134        skip_card ();
 135      }
 136    }
 137  }
Deze website is gearchiveerd door de KB, nationale bibliotheek.

This website is archived by the National Library of the Netherlands.