//! @file jit.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
//!
//! Just-in-time compilation of FORMAT strings.

#include <vif.h>

#define HEAP_SIZE 8192
#define MAX_ITEMS 256

static char heap[HEAP_SIZE];
static char *fmtarr[MAX_ITEMS];
static size_t heaptr, arrptr;

static char *jit_str_list (char *, char *, int *, int *);

static void jit_error (char *where, char *msg)
{
  NEW_RECORD (diag);
  _srecordf (diag, "format compiler: %s", msg);
  RTE (where, diag);
}

static char *alloc (char *where, char *elem)
{
  size_t N = strlen (elem) + 1;
  if ((heaptr + N) >= (HEAP_SIZE - 1)) {
    jit_error (where, "heap overflow");
    return NO_TEXT;
  } else {
    char *q = &heap[heaptr];
    strcpy (q, elem);
    heaptr += N;
    return q;
  }
}

static void add_mark (char *where, char *elem)
{
  if (arrptr == (MAX_ITEMS - 1)) {
    jit_error (where, "too many items");
  } else {
    fmtarr[arrptr ++] = elem;
  }
}

static void add_item (char *where, char *elem)
{
  if (arrptr == (MAX_ITEMS - 1)) {
    jit_error (where, "too many items");
  } else {
    if (elem == NO_TEXT) {
      fmtarr[arrptr ++] = NO_TEXT;
    } else {
      fmtarr[arrptr ++] = alloc (where, elem);
    }
  }
}

static void jit_elem (char *where, char *lex, int_4 *elems)
{
  NEW_RECORD (rstr);
  NEW_RECORD (wstr);
  int_4 width, digits, expwid;
  if (LEQUAL ("a", lex)) {
    if (sscanf (&lex[1], "%d", &width) != 1) {
      _srecordf (rstr, "%%s");
      _srecordf (wstr, "%%s");
    } else if (width < 1) {
      jit_error (where, lex);
      _srecordf (rstr, "%%s");
      _srecordf (wstr, "%%s");
    } else {
      _srecordf (rstr, "%%%ds", width);
      _srecordf (wstr, "%%-%ds", width);
    }
    add_mark (where, FMT_CHAR);
    (*elems)++;
  } else if (LEQUAL ("i", lex)) {
    if (sscanf (&lex[1], "%d", &width) != 1) {
      jit_error (where, "expected width");
      _srecordf (rstr, "%%d");
      _srecordf (wstr, "%%d");
    } else if (width < 1) {
      jit_error (where, lex);
      _srecordf (rstr, "%%d");
      _srecordf (wstr, "%%d");
    } else {
      _srecordf (rstr, "%%%dd", width);
      _srecordf (wstr, "%%%dd", width);
    }
    add_mark (where, FMT_INT);
    (*elems)++;
  } else if (LEQUAL ("l", lex)) {
    if (sscanf (&lex[1], "%d", &width) != 1) {
      jit_error (where, "expected width");
      _srecordf (rstr, "%%s");
      _srecordf (wstr, "%%s");
    } else if (width < 1) {
      jit_error (where, lex);
      _srecordf (rstr, "%%s");
      _srecordf (wstr, "%%s");
    } else {
      _srecordf (rstr, "%%%ds", width);
      _srecordf (wstr, "%%-%ds", width);
    }
    add_mark (where, FMT_INT);
    (*elems)++;
  } else if (LEQUAL ("d", lex) || LEQUAL ("e", lex) || LEQUAL ("g", lex) || LEQUAL ("n", lex)) {
    width = digits = expwid = 0;
    if (sscanf (&lex[1], "%d.%d.%d", &width, &digits, &expwid) == 3) {
      ;
    } else if (sscanf (&lex[1], "%d.%d", &width, &digits) == 2) {
      ;
    } else {
      jit_error (where, "expected width, decimals, [width]");
    }
    if (width < 0 || digits < 0) {
      jit_error (where, lex);
    }
// Reading a REAL - specify width only!
    _srecordf (rstr, "%%%de", width);
// Writing a REAL - specify all. 
    if (tolower (lex[0]) == 'n') {
      if (islower (lex[0])) {
        _srecordf (wstr, "%%%d.%d.%dn", width, digits, expwid);
      } else {
        _srecordf (wstr, "%%%d.%d.%dN", width, digits, expwid);
      }
    } else {
      if (islower (lex[0])) {
        _srecordf (wstr, "%%%d.%d.%de", width, digits, expwid);
      } else {
        _srecordf (wstr, "%%%d.%d.%dE", width, digits, expwid);
      }
    }
    add_mark (where, FMT_REAL);
    (*elems)++;
  } else if (LEQUAL ("f", lex)) {
    sscanf (&lex[1], "%d.%d", &width, &digits);
    if (sscanf (&lex[1], "%d.%d", &width, &digits) != 2) {
      jit_error (where, "expected width, decimals");
      _srecordf (rstr, "%%f");
      _srecordf (wstr, "%%f");
    } else if (width < 1 || digits < 0) {
      jit_error (where, lex);
      _srecordf (rstr, "%%f");
      _srecordf (wstr, "%%f");
    } else {
      _srecordf (rstr, "%%%df", width);
      _srecordf (wstr, "%%%d.%df", width, digits);
    }
    add_mark (where, FMT_REAL);
    (*elems)++;
  } else {
    jit_error (where, lex);
    rstr[0] = wstr[0] = '\0';
    (*elems)++;
  }
  NEW_RECORD (fstr);
  _srecordf (fstr, "%s", rstr);
  add_item (where, fstr);
  _srecordf (fstr, "%s", wstr);
  add_item (where, fstr);
}

static void jit_scale (char *where, int_4 N)
{
  add_mark (where, FMT_TEXT);
  add_item (where, "");
  if (N == 0) {
    add_item (where, "0");
  } else if (N == 1) {
    add_item (where, "1");
  } else if (N == 2) {
    add_item (where, "2");
  } else if (N == 3) {
    add_item (where, "3");
  } else {
    add_item (where, "1");
  }
}

static void jit_x (char *where, int_4 N)
{
  NEW_RECORD (str);
  str[0] = '\0';
  for (int_4 k = 0; k < N && k < RECLN; k ++) {
    bufcat (str, " ", RECLN);
  }
  add_mark (where, FMT_TEXT);
  add_item (where, str);
  add_item (where, str);
}

static void jit_nl (char *where, int_4 N)
{
  NEW_RECORD (str);
  _srecordf (str, "\\n");
  for (int_4 k = 0; k < N; k ++) {
    add_mark (where, FMT_TEXT);
    add_item (where, str);
    add_item (where, str);
  }
}

static void jit_text (char *where, int_4 N, char *lex)
{
  for (int_4 k = 0; k < N; k ++) {
    add_mark (where, FMT_TEXT);
    add_item (where, lex);
    add_item (where, lex);
  }
}

static char *jit_str_list (char *where, char *fmt, int *nest, int *elems)
{
  #define LETTER(ch) (tolower (fmt[0]) == ch)
  if (fmt[0] == '(') {
    fmt++;
  } else {
    jit_error (where, "expected '('"); 
  }
  while (fmt[0] != ')' && fmt[0] != '\0') {
    if (fmt[0] == ',') {
      fmt++;
    }
    while (isspace (fmt[0])) {
      fmt++;
    }
    int_4 N;
    if (!isdigit (fmt[0])) {
      N = 1;
    } else {
      char *end;
      N = strtol (fmt, &end, 10);
      fmt = end;
    }
    if (LETTER ('p')) {
      jit_scale (where, N);
      (*elems)++;
      fmt++;
    } else if (LETTER ('x')) {
      jit_x (where, N);
      (*elems)++;
      fmt++;
    } else if (fmt[0] == '/') {
      jit_nl (where, N);
      (*elems)++;
      fmt++;
    } else if (LETTER ('h')) {
      fmt++;
      NEW_RECORD (str);
      int_4 k = 0;
      for (int_4 M = 0; M < N && fmt[0] != '\0'; M++) {
        str[k++] = (fmt++)[0];
      }
      jit_text (where, 1, str);
      (*elems)++;
    } else if (fmt[0] == '\"') {
      fmt++;
      NEW_RECORD (str);
      int_4 k = 0;
      int_4 go_on = TRUE;
      while (go_on) {
        if (fmt[0] == '\0') {
          go_on = FALSE;
        } else if (fmt[0] == '"') {
          if ((++fmt)[0] == '"') {
            str[k++] = '"';
            fmt++;
          } else {
            go_on = FALSE;
          }
        } else {
          str[k++] = (fmt++)[0];
        }
      }
      jit_text (where, N, str);
      (*elems)++;
    } else if (fmt[0] == '\'') {
      fmt++;
      NEW_RECORD (str);
      int_4 k = 0;
      int_4 go_on = TRUE;
      while (go_on) {
        if (fmt[0] == '\0') {
          go_on = FALSE;
        } else if (fmt[0] == '\'') {
          if ((++fmt)[0] == '\'') {
            str[k++] = '\'';
            fmt++;
          } else {
            go_on = FALSE;
          }
        } else {
          str[k++] = (fmt++)[0];
        }
      }
      jit_text (where, N, str);
      (*elems)++;
    } else {
      for (int_4 k = 0; k < N; k++) {
        char *sav = fmt, *rtn = NO_TEXT;
        if (fmt[0] == '(') {
          (*nest)++;
          rtn = jit_str_list (where, fmt, nest, elems);
        } else if (fmt[0] == ')') {
          break;
        } else if (strchr ("adefgiln", tolower (fmt[0])) == NO_TEXT) {
          jit_error (where, fmt);
        } else {
          NEW_RECORD (lex);
          char *p = lex;
          do {
            (p++)[0] = (fmt++)[0];
            while (isdigit (fmt[0])) {
              (p++)[0] = (fmt++)[0];
            }
          } while (fmt[0] == '.');
          jit_elem (where, lex, elems);
        }
        if (k < N - 1) {
          fmt = sav;
        } else if (rtn != NO_TEXT) {
          fmt = rtn;
        }
      }
    }
  }
  if (fmt[0] != ')') {
    jit_error (where, "expected ')'"); 
    return fmt;
  } else if (*nest > 0) {
    (*nest)--;
  }
  return &fmt[1];
#undef LETTER
}

char **_vif_jit (char *where, char *arg)
{
  int_4 nest = 0, elems = 0;
  NEW_RECORD (cpy);
  fmtarr[0] = NO_TEXT;
  heaptr = 0;
  arrptr = 0;
  strcpy (cpy, arg);
  char *fmt = (char *) cpy;
  if (fmt[0] == '"') {
    fmt++;
  }
  if (fmt[strlen (fmt) - 1] == '"') {
    fmt[strlen (fmt) - 1] = '\0';
  }
  (void) jit_str_list (where, fmt, &nest, &elems);
  if (nest != 0) {
    jit_error (where, "unbalanced parentheses");
  }
  if (elems == 0) {
    jit_error (where, "empty format");
  }
  add_item (where, NO_TEXT);
  add_item (where, NO_TEXT);
  add_item (where, NO_TEXT);
  return fmtarr;
}
