Algol 68 Genie

macro.c

     
   1  //! @file macro.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 function statements.
  25  
  26  #include <vif.h>
  27  
  28  int_4 macro_nest;
  29  
  30  static void macro_args (RECORD *name, int_4 *N)
  31  {
  32    int_4 rc = scan (NULL);
  33    rc = scan (NULL);
  34    rc = scan (NULL);
  35    if (rc != WORD) {
  36      EXPECT (2101, "variable")
  37    } else {
  38      int_4 go_on;
  39      do {
  40        if (rc != WORD) {
  41          EXPECT (2102, "variable");
  42        }
  43        strcpy (name[*N], curlex);
  44        (*N)++;
  45        rc = scan (NULL);
  46        if (TOKEN (",")) {
  47          go_on = TRUE;
  48          rc = scan (NULL);
  49        } else if (TOKEN (")")) {
  50          rc = scan (NULL);
  51          CHECKPOINT (2103, "=");
  52          go_on = FALSE;
  53        } else {
  54          EXPECT (2104, ", or )");
  55          go_on = FALSE;
  56        }
  57      } while (go_on);
  58    }
  59  }
  60  
  61  static void macro_parms (RECORD *pack, RECORD expr, int_4 N, int_4 *M)
  62  {
  63    (void) scan (NULL);
  64    if (TOKEN ("(")) {
  65      macro_parms (pack, expr, N, M);
  66    } else if (TOKEN (",")) {
  67      macro_parms (pack, expr, N, M);
  68    } else if (TOKEN (")")) {
  69      return;
  70    } else {
  71      MODE mode;
  72      EXPR reg;
  73      RECORD res;
  74      int k = macro_nest;
  75      memset (&reg, 0, sizeof (EXPR));
  76      (void) express (&reg, NOTYPE, 0);
  77      macro_nest = k;
  78      (void) add_nest (pack[*M], macro_nest, &mode);
  79      _srecordf (res, "%s %s = %s; ", wtype (&mode, NOARG, NOFUN), edit_vn (pack[*M], macro_nest), reg.str);
  80      (*M)++;
  81      bufcat (expr, res, RECLN);
  82      macro_parms (pack, expr, N, M);
  83    }
  84  }
  85  
  86  void macro (EXPR *loc, IDENT *idf)
  87  {
  88    UNSCAN;
  89    int_4 savlin = curlin, savcol = curcol;
  90  // Gather arguments.
  91    curlin = idf->line;
  92    curcol = 0;
  93    RECORD pack[MAX_ARGS], expr;
  94    bzero (pack, sizeof (pack));
  95    bufcpy (expr, "({", RECLN);
  96    int_4 N = 0, M = 0;
  97    macro_args (pack, &N);
  98  // Work out arguments.
  99    curlin = savlin;
 100    curcol = savcol;
 101    (void) scan (NULL);
 102    macro_parms (pack, expr, N, &M);
 103    savlin = curlin;
 104    savcol = curcol;
 105    int_4 savprl = prelin;
 106    int_4 savprc = precol;
 107    RECORD savlex;
 108    bufcpy (savlex, curlex, RECLN);
 109  // Work out macro expression. 
 110    curlin = idf->line;
 111    curcol = 0;
 112    EXPR reg;
 113    memset (&reg, 0, sizeof (reg));
 114    (void) scan (NULL);
 115    while (! TOKEN ("=")) {
 116      (void) scan (NULL);
 117    }
 118    (void) scan (NULL);
 119    express (&reg, NOTYPE, 0);
 120    bufcat (expr, reg.str, RECLN);
 121    bufcat (expr, ";})", RECLN);
 122    bufcpy (loc->str, expr, RECLN);
 123    loc->variant = EXPR_OTHER;
 124    loc->mode = reg.mode;
 125    curlin = savlin;
 126    curcol = savcol;
 127    prelin = savprl;
 128    precol = savprc;
 129    bufcpy (curlex, savlex, RECLN);
 130  }
 131  
 132  void decl_macros (void)
 133  {
 134    int_4 go_on = TRUE;
 135    while (go_on) {
 136      SAVE_POS;
 137      int_4 rc = scan (NULL);
 138      if (reserved (curlex)) {
 139        RESTORE_POS;
 140        go_on = FALSE;
 141      } else if (rc == WORD) {
 142        RECORD name;
 143        MODE mode;
 144        strcpy (name, curlex);
 145        IDENT *idf = find_local (name, &mode);
 146        if (idf != NULL && (idf->external || idf->parm || idf->mode.dim > 0)) {
 147          RESTORE_POS;
 148          go_on = FALSE;
 149        } else {
 150          rc = scan (NULL);
 151          if (TOKEN ("(")) {
 152            if (idf == NULL) {
 153              idf = add_local (name, NOTYPE, NOLEN, UNIQ, NOPATCH, NOARG, LOCAL, MACRO);
 154          impl_type (name, &idf->mode);
 155            }
 156            idf->line = curlin;
 157        idf->source = MACRO;
 158            do {
 159              rc = scan (NULL);
 160            } while (rc != END_OF_LINE && ! TOKEN (")"));
 161            if (rc == END_OF_LINE) {
 162              EXPECT (2105, "=");
 163            } else {
 164              rc = scan (NULL);
 165              CHECKPOINT (2106, "=");
 166              skip_card ();
 167            }
 168          } else {
 169            RESTORE_POS;
 170            go_on = FALSE;
 171          }
 172        }
 173      } else {
 174  // Backspace and RESTORE_POS.
 175        RESTORE_POS;
 176        go_on = FALSE;
 177      }
 178    }
 179  }
Deze website is gearchiveerd door de KB, nationale bibliotheek.

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