//! @file jcl.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
//!
//! Rudimentary JCL handler

// Most JCL does not map onto UNIX and is ignored here.
// This code manages in-stream redirections like
//
//   //FT02F001 DD *
//     ...
//     ...
//     ...
//   /*
//
// Above means that UNIT 2 will be initialized to read
// the enclosed data upon READ (2, ...).

#include <vif.h>

int_4 jcllin = 0;

extern int_4 n_dc;

void vif_jcl (void)
{
  if (CUR_LIN.jcl) {
    return;
  }
  CUR_LIN.jcl = TRUE;
  if (POS (0) == '/' && POS (1) == '*') {
    return;
  } else if (POS (0) == '/' && POS (1) == '/') {
// Log the line.
    NEW_RECORD (jline);
    jcllin++;
    _srecordf (jline, "// %6d %6d //%s\n", curlin, jcllin, &CUR_LIN.text[2]);
    code (0, JCL, jline);
//
    int_4 k = 0, N = 0, fn;
// Parse step and name field.
    NEW_RECORD (step);
    NEW_RECORD (name);
    curcol = 2;
    while (N < RECLN && (isalpha (CUR_COL) || (strlen (name) > 0 ? isdigit (CUR_COL) : FALSE))) {
      name[k++] = tolower (CUR_COL);
      curcol++;
      N++;
    }
    if (CUR_COL == '.') {
      RECCPY (step, name);
      RECCLR (name);
      curcol++;
      k = 0;
      N = 0;
      while (N < RECLN && (isalpha (CUR_COL) || (strlen (name) > 0 ? isdigit (CUR_COL) : FALSE))) {
        name[k++] = tolower (CUR_COL);
        curcol++;
        N++;
      }
    }
// Parse operation field.
    while (isspace (CUR_COL)) {
      curcol++;
    }
    NEW_RECORD (oper);
    k = 0;
    while (N < RECLN && (isalpha (CUR_COL) || (strlen (oper) > 0 ? isdigit (CUR_COL) : FALSE))) {
      oper[k++] = tolower (CUR_COL);
      curcol++;
      N++;
    }
// Parse parameter field.
    while (isspace (CUR_COL)) {
      curcol++;
    }
    NEW_RECORD (parm);
    k = 0;
    while (N < RECLN && CUR_COL != '\0' && isprint (CUR_COL)) {
      parm[k++] = CUR_COL;
      curcol++;
      N++;
    }
// Match FT..F001.
    if (sscanf(name, "ft%02df001", &fn) == 1 && EQUAL (oper, "dd")) {
      if (EQUAL (parm, "*")) {
        NEW_RECORD (str);
        CUR_LIN.jcl = TRUE;
        CUR_LIN.isn = 0;
// Write as row of chars as C cannot have comments in string denotations.
        _srecordf (str, "char %s[] = {\n", name);
        code (0, CONSTANTS, str);
        _ffile[fn].in_stream = TRUE;
        _ffile[fn].name = f_stralloc (name);
        curlin++;
        int_4 col = 0;
        while (curlin < nftnlines && !EQUAL (CUR_LIN.text, "/*")) {
          _srecordf (str, "//%s\n", CUR_LIN.text);
          code (0, CONSTANTS, str);
          CUR_LIN.jcl = TRUE;
          CUR_LIN.isn = 0;
// Pad to 80 characters (vintage punch card record length).
          for (int_4 m = 0; m < 80; m++) {
            if (m < strlen (CUR_LIN.text)) {
              _srecordf (str, "'\\x%02x',", CUR_LIN.text[m]);
            } else {
              _srecordf (str, "'\\x%02x',", ' ');
            }
            code (0, CONSTANTS, str);
            if (col == 9) {
              code (0, CONSTANTS, "\n");
              col = 0;
            } else {
              code (0, CONSTANTS, " ");
              col++;
            }
          }
          _srecordf (str, "'\\x%02x'\n,", '\n');
          code (0, CONSTANTS, str);
          curlin++;
        }
        code (0, CONSTANTS, "'\\0'\n");
        code (0, CONSTANTS, "};");
        while (curlin < nftnlines) {
          if (! IS_JCL (CUR_LIN.text[0])) {
            FATAL (2401, "jcl error", CUR_LIN.text);
          }
          curlin++;
        }
      }
    }
  }
}
