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-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 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 (EXPECT_NONE);
  33    rc = scan (EXPECT_NONE);
  34    rc = scan (EXPECT_NONE);
  35    if (rc != WORD) {
  36      EXPECT (2201, "variable")
  37    } else {
  38      int_4 go_on;
  39      do {
  40        if (rc != WORD) {
  41          EXPECT (2202, "variable");
  42        }
  43        strcpy (name[*N], curlex);
  44        (*N)++;
  45        rc = scan (EXPECT_NONE);
  46        if (TOKEN (",")) {
  47          go_on = TRUE;
  48          rc = scan (EXPECT_NONE);
  49        } else if (TOKEN (")")) {
  50          rc = scan (EXPECT_NONE);
  51          CHECKPOINT (2203, "=");
  52          go_on = FALSE;
  53        } else {
  54          EXPECT (2204, ", 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 (EXPECT_NONE);
  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 (EXPECT_NONE);
 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 (EXPECT_NONE);
 115    while (! TOKEN ("=")) {
 116      (void) scan (EXPECT_NONE);
 117    }
 118    (void) scan (EXPECT_NONE);
 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 (EXPECT_NONE);
 138      if (rc == END_OF_MODULE) {
 139        RESTORE_POS;
 140        return;
 141      } else if (reserved (curlex)) {
 142        RESTORE_POS;
 143        go_on = FALSE;
 144      } else if (rc == WORD) {
 145        MODE mode;
 146        RECORD name;
 147        RECCLR (name);
 148        strcpy (name, curlex);
 149        IDENT *idf = find_local (name, &mode);
 150        if (idf != NO_IDENT && (idf->external || idf->parm || IS_ROW (idf->mode))) {
 151          RESTORE_POS;
 152          go_on = FALSE;
 153        } else {
 154          rc = scan (EXPECT_NONE);
 155          if (TOKEN ("(")) {
 156            if (idf == NO_IDENT) {
 157              idf = add_local (name, NOTYPE, NOLEN, UNIQ, NOPATCH, NOARG, LOCAL, MACRO);
 158          impl_type (name, &idf->mode);
 159            }
 160            idf->line = curlin;
 161        idf->source = MACRO;
 162            do {
 163              rc = scan (EXPECT_NONE);
 164            } while (rc != END_OF_LINE && ! TOKEN (")"));
 165            if (rc == END_OF_LINE) {
 166              EXPECT (2205, "=");
 167            } else {
 168              rc = scan (EXPECT_NONE);
 169              CHECKPOINT (2206, "=");
 170              skip_card (FALSE);
 171            }
 172          } else {
 173            RESTORE_POS;
 174            go_on = FALSE;
 175          }
 176        }
 177      } else {
 178  // Backspace and RESTORE_POS.
 179        RESTORE_POS;
 180        go_on = FALSE;
 181      }
 182    }
 183  }
Deze website is gearchiveerd door de KB, nationale bibliotheek.

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