//! @file call.c
//! @author J. Marcel van der Veer
//
//! @section Copyright
//
// This file is part of VIF - vintage FORTRAN compiler.
// Copyright 2020-2025 J. Marcel van der Veer <algol68g@xs4all.nl>.
//
//! @section License
//
// This program is free software; you can redistribute it and/or modify it 
// under the terms of the GNU General Public License as published by the 
// Free Software Foundation; either version 3 of the License, or 
// (at your option) any later version.
//
// This program is distributed in the hope that it will be useful, but 
// WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
// or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 
// more details. You should have received a copy of the GNU General Public 
// License along with this program. If not, see <http://www.gnu.org/licenses/>.

//! @section Synopsis
//!
//! Compile CALL and function calls.

#include <vif.h>

void code_parms (RECORD pack)
{
  int_4 rc = scan (EXPECT_NONE);
  if (TOKEN ("(") && strlen (pack) == 0) {
    bufcat (pack, "(", RECLN);
    code_parms (pack);
  } else if (TOKEN (",")) {
    bufcat (pack, ", ", RECLN);
    code_parms (pack);
  } else if (TOKEN (")")) {
    bufcat (pack, ")", RECLN);
    return;
  } else {
    EXPR reg;
    NEW_RECORD (str);
    NEW_RECORD (name);
    RECCPY (name, curlex);
    memset (&reg, 0, sizeof (EXPR));
    macro_depth = 0;
    express (&reg, NOTYPE, 0);
    if (reg.variant == EXPR_VAR) {
      if (IS_ROW (reg.mode) || reg.mode.type == CHARACTER) {
        _srecordf (str, "%s", reg.str);
      } else if (reg.str[0] == '*') {
        _srecordf (str, "%s", &reg.str[1]);
      } else if (reg.idf->external) {
        _srecordf (str, "%s", edit_f (reg.str));
      } else if (reg.idf->intrinsic) {
        _srecordf (str, "%s", edit_i (reg.str));
      } else if (reg.idf->arg || reg.idf->alias != NO_IDENT) {
        // Peephole optimization: &(*x) -> x
        _srecordf (str, "%s", C_NAME (reg.idf));
      } else {
        (void) impl_decl (name, NO_MODE);
        _srecordf (str, "&%s", reg.str);
      }
      bufcat (pack, str, RECLN);
    } else if (reg.variant == EXPR_SLICE) {
      _srecordf (str, "&%s", reg.str);
      bufcat (pack, str, RECLN);
    } else if (reg.variant == EXPR_CONST && reg.mode.type == CHARACTER) {
      bufcat (pack, reg.str, RECLN);
    } else if (reg.variant == EXPR_CONST && EQUAL (reg.str, "-1")) {
      bufcat (pack, "&_km1", RECLN);
    } else if (reg.variant == EXPR_CONST && EQUAL (reg.str, "0")) {
      bufcat (pack, "&_k0", RECLN);
    } else if (reg.variant == EXPR_CONST && EQUAL (reg.str, "1")) {
      bufcat (pack, "&_k1", RECLN);
    } else {
      NEW_RECORD (tmp);
      _srecordf (tmp, "%s", edit_tmp (nloctmps++));
      if (reg.mode.len > 0) {
        add_local (tmp, reg.mode.type, reg.mode.len, UNIQ, NOPATCH, NOARG, LOCAL, TEMP);
      } else {
        add_local (tmp, reg.mode.type, MAX_STRLEN, UNIQ, NOPATCH, NOARG, LOCAL, TEMP);
      }
      if (reg.mode.type == CHARACTER) {
        norm_mode (&reg.mode);
        _srecordf (str, "(bufcpy (%s, %s, %d), %s)", tmp, reg.str, reg.mode.len, tmp);
      } else {
        _srecordf (str, "(%s = %s, &%s)", tmp, reg.str, tmp);
      }
      bufcat (pack, str, RECLN);
    }
    code_parms (pack);
  }
  (void) rc;
}

void factor_function_call (EXPR *loc, RECORD name)
{
  UNSCAN;
  MODE mode;
  IDENT *idf = find_local (name, &mode);
  NEW_RECORD (pack);
  curlin = prelin;
  curcol = precol;
  code_parms (pack);
  if (idf != NO_IDENT && idf->intrinsic) {
    _srecordf (loc->str, "%s %s", edit_i (name), pack);
  } else {
    _srecordf (loc->str, "%s %s", edit_f (name), pack);
  }
  loc->variant = EXPR_OTHER;
  loc->idf = NO_IDENT;
  if (idf == NO_IDENT) {
    idf = extf_decl (name, &(loc->mode));
  } else {
    loc->mode = idf->mode;
  }
  if (loc->mode.type == NOTYPE) {
    ERROR (401, "function has no type", name);
  }
  idf->external = TRUE;
  idf->used = TRUE;
}

void recursion (EXPR *loc, RECORD fun, IDENT * idf)
{
  UNSCAN;
  NEW_RECORD (pack);
  curlin = prelin;
  curcol = precol;
  code_parms (pack);
  _srecordf (loc->str, "%s %s", edit_f (fun), pack);
  loc->variant = EXPR_OTHER;
  loc->idf = NO_IDENT;
  loc->mode = idf->mode;
}

void call (void)
{
  int_4 rc = scan (EXPECT_NONE);
  NEW_RECORD (str);
  if (TOKEN ("exit")) {
    _srecordf (str, "_vif_exit ();\n");
    code (nprocs, BODY, str);
    _srecordf (str, "exit (EXIT_SUCCESS);\n", curlex);
    code (nprocs, BODY, str);
    return;
  } else {
    MODE mode;
    IDENT *idf = find_local (curlex, &mode);
    if (idf != NO_IDENT) {
      if (idf->arg == ARG) {
        idf->external = TRUE;
      }
      idf->used = TRUE;
      idf->mode = (MODE) {.type = INTEGER, .len = 4};
    }
    _srecordf (str, "(void) %s", edit_f (curlex));
    code (nprocs, BODY, str);
  }
  rc = scan (EXPECT_NONE);
  if (TOKEN ("(")) {
    UNSCAN;
    RECCLR (str);
    code_parms (str);
    code (nprocs, BODY, str);
  } else {
    if (rc != END_OF_LINE) {
      UNSCAN;
    }
    code (nprocs, BODY, " ()");
  }
  (void) rc;
}

