Algol 68 Genie

call.c

     
   1  //! @file call.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 subprogram calls.
  25  
  26  #include <vif.h>
  27  
  28  void code_parms (RECORD pack)
  29  {
  30    int_4 rc = scan (EXPECT_NONE);
  31    if (TOKEN ("(") && strlen (pack) == 0) {
  32      bufcat (pack, "(", RECLN);
  33      code_parms (pack);
  34    } else if (TOKEN (",")) {
  35      bufcat (pack, ", ", RECLN);
  36      code_parms (pack);
  37    } else if (TOKEN (")")) {
  38      bufcat (pack, ")", RECLN);
  39      return;
  40    } else {
  41      EXPR reg;
  42      RECORD str, name;
  43      RECCLR (name);
  44      strcpy (name, curlex);
  45      memset (&reg, 0, sizeof (EXPR));
  46      express (&reg, NOTYPE, 0);
  47      if (reg.variant == EXPR_VAR) {
  48        if (IS_ROW (reg.mode) || reg.mode.type == CHARACTER) {
  49          _srecordf (str, "%s", reg.str);
  50        } else if (reg.str[0] == '*') {
  51          _srecordf (str, "%s", &reg.str[1]);
  52        } else if (reg.idf->external) {
  53          _srecordf (str, "%s", edit_f (reg.str));
  54        } else if (reg.idf->intrinsic) {
  55          _srecordf (str, "%s", edit_f (reg.str));
  56        } else if (reg.idf->arg || reg.idf->alias != NO_IDENT) {
  57          // Peephole optimization: &(*x) -> x
  58          _srecordf (str, "%s", C_NAME (reg.idf));
  59        } else {
  60          (void) impl_decl (name, NO_MODE);
  61          _srecordf (str, "&%s", reg.str);
  62        }
  63        bufcat (pack, str, RECLN);
  64      } else if (reg.variant == EXPR_SLICE) {
  65        _srecordf (str, "&%s", reg.str);
  66        bufcat (pack, str, RECLN);
  67      } else if (reg.variant == EXPR_CONST && reg.mode.type == CHARACTER) {
  68        bufcat (pack, reg.str, RECLN);
  69      } else if (reg.variant == EXPR_CONST && EQUAL (reg.str, "-1")) {
  70        bufcat (pack, "&_km1", RECLN);
  71      } else if (reg.variant == EXPR_CONST && EQUAL (reg.str, "0")) {
  72        bufcat (pack, "&_k0", RECLN);
  73      } else if (reg.variant == EXPR_CONST && EQUAL (reg.str, "1")) {
  74        bufcat (pack, "&_k1", RECLN);
  75      } else {
  76        RECORD tmp;
  77        _srecordf (tmp, "%s", edit_tmp (nloctmps++));
  78        add_local (tmp, reg.mode.type, reg.mode.len, UNIQ, NOPATCH, NOARG, LOCAL, TEMP);
  79        if (reg.mode.type == CHARACTER) {
  80          norm_mode (&reg.mode);
  81          _srecordf (str, "(bufcpy (%s, %s, %d), %s)", tmp, reg.str, reg.mode.len, tmp);
  82        } else {
  83          _srecordf (str, "(%s = %s, &%s)", tmp, reg.str, tmp);
  84        }
  85        bufcat (pack, str, RECLN);
  86      }
  87      code_parms (pack);
  88    }
  89    (void) rc;
  90  }
  91  
  92  void factor_function_call (EXPR *loc, RECORD name)
  93  {
  94    RECORD pack;
  95    UNSCAN;
  96    MODE mode;
  97    IDENT *idf = find_local (name, &mode);
  98    RECCLR (pack);
  99    curlin = prelin;
 100    curcol = precol;
 101    code_parms (pack);
 102    _srecordf (loc->str, "%s %s", edit_f (name), pack);
 103    loc->variant = EXPR_OTHER;
 104    loc->idf = NO_IDENT;
 105    if (idf == NO_IDENT) {
 106      idf = extf_decl (name, &(loc->mode));
 107    } else {
 108      loc->mode = idf->mode;
 109    }
 110    if (loc->mode.type == NOTYPE) {
 111      ERROR (401, "function has no type", name);
 112    }
 113    idf->external = TRUE;
 114    idf->used = TRUE;
 115  }
 116  
 117  void recursion (EXPR *loc, RECORD fun, IDENT * idf)
 118  {
 119    RECORD pack;
 120    UNSCAN;
 121    RECCLR (pack);
 122    curlin = prelin;
 123    curcol = precol;
 124    code_parms (pack);
 125    _srecordf (loc->str, "%s %s", edit_f (fun), pack);
 126    loc->variant = EXPR_OTHER;
 127    loc->idf = NO_IDENT;
 128    loc->mode = idf->mode;
 129  }
 130  
 131  void call (void)
 132  {
 133    int_4 rc = scan (EXPECT_NONE);
 134    RECORD str;
 135    if (TOKEN ("exit")) {
 136      _srecordf (str, "_vif_exit ();\n");
 137      code (nprocs, BODY, str);
 138      _srecordf (str, "exit (EXIT_SUCCESS);\n", curlex);
 139      code (nprocs, BODY, str);
 140      return;
 141    } else {
 142      MODE mode;
 143      IDENT *idf = find_local (curlex, &mode);
 144      if (idf != NO_IDENT) {
 145        if (idf->arg == ARG) {
 146          idf->external = TRUE;
 147        }
 148        idf->used = TRUE;
 149        idf->mode.type = NOTYPE; // void
 150      }
 151      _srecordf (str, "(void) %s", edit_f (curlex));
 152      code (nprocs, BODY, str);
 153    }
 154    rc = scan (EXPECT_NONE);
 155    if (TOKEN ("(")) {
 156      UNSCAN;
 157      RECCLR (str);
 158      code_parms (str);
 159      code (nprocs, BODY, str);
 160    } else {
 161      if (rc != END_OF_LINE) {
 162        UNSCAN;
 163      }
 164      code (nprocs, BODY, " ()");
 165    }
 166    (void) rc;
 167  }
 168
Deze website is gearchiveerd door de KB, nationale bibliotheek.

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