Algol 68 Genie

jcl.c

     1  //! @file jcl.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  //! Rudimentary JCL handler
    25  
    26  // Most JCL does not map onto UNIX and is ignored here.
    27  // This code manages in-stream redirections like
    28  //
    29  //   //FT02F001 DD *
    30  //     ...
    31  //     ...
    32  //     ...
    33  //   /*
    34  //
    35  // Above means that UNIT 2 will be initialized to read
    36  // the enclosed data upon READ (2, ...).
    37  
    38  #include <vif.h>
    39  
    40  int_4 jcllin = 0;
    41  
    42  extern int_4 n_dc;
    43  
    44  void vif_jcl (void)
    45  {
    46    if (CUR_LIN.jcl) {
    47      return;
    48    }
    49    CUR_LIN.jcl = TRUE;
    50    if (POS (0) == '/' && POS (1) == '*') {
    51      return;
    52    } else if (POS (0) == '/' && POS (1) == '/') {
    53  // Log the line.
    54      NEW_RECORD (jline);
    55      jcllin++;
    56      _srecordf (jline, "// %6d %6d //%s\n", curlin, jcllin, &CUR_LIN.text[2]);
    57      code (0, JCL, jline);
    58  //
    59      int_4 k = 0, N = 0, fn;
    60  // Parse step and name field.
    61      NEW_RECORD (step);
    62      NEW_RECORD (name);
    63      curcol = 2;
    64      while (N < RECLN && (isalpha (CUR_COL) || (strlen (name) > 0 ? isdigit (CUR_COL) : FALSE))) {
    65        name[k++] = tolower (CUR_COL);
    66        curcol++;
    67        N++;
    68      }
    69      if (CUR_COL == '.') {
    70        RECCPY (step, name);
    71        RECCLR (name);
    72        curcol++;
    73        k = 0;
    74        N = 0;
    75        while (N < RECLN && (isalpha (CUR_COL) || (strlen (name) > 0 ? isdigit (CUR_COL) : FALSE))) {
    76          name[k++] = tolower (CUR_COL);
    77          curcol++;
    78          N++;
    79        }
    80      }
    81  // Parse operation field.
    82      while (isspace (CUR_COL)) {
    83        curcol++;
    84      }
    85      NEW_RECORD (oper);
    86      k = 0;
    87      while (N < RECLN && (isalpha (CUR_COL) || (strlen (oper) > 0 ? isdigit (CUR_COL) : FALSE))) {
    88        oper[k++] = tolower (CUR_COL);
    89        curcol++;
    90        N++;
    91      }
    92  // Parse parameter field.
    93      while (isspace (CUR_COL)) {
    94        curcol++;
    95      }
    96      NEW_RECORD (parm);
    97      k = 0;
    98      while (N < RECLN && CUR_COL != '\0' && isprint (CUR_COL)) {
    99        parm[k++] = CUR_COL;
   100        curcol++;
   101        N++;
   102      }
   103  // Match FT..F001.
   104      if (sscanf(name, "ft%02df001", &fn) == 1 && EQUAL (oper, "dd")) {
   105        if (EQUAL (parm, "*")) {
   106          NEW_RECORD (str);
   107          CUR_LIN.jcl = TRUE;
   108          CUR_LIN.isn = 0;
   109  // Write as row of chars as C cannot have comments in string denotations.
   110          _srecordf (str, "char %s[] = {\n", name);
   111          code (0, CONSTANTS, str);
   112          _ffile[fn].in_stream = TRUE;
   113          _ffile[fn].name = f_stralloc (name);
   114          curlin++;
   115          int_4 col = 0;
   116          while (curlin < nftnlines && !EQUAL (CUR_LIN.text, "/*")) {
   117            _srecordf (str, "//%s\n", CUR_LIN.text);
   118            code (0, CONSTANTS, str);
   119            CUR_LIN.jcl = TRUE;
   120            CUR_LIN.isn = 0;
   121  // Pad to 80 characters (vintage punch card record length).
   122            for (int_4 m = 0; m < 80; m++) {
   123              if (m < strlen (CUR_LIN.text)) {
   124                _srecordf (str, "'\\x%02x',", CUR_LIN.text[m]);
   125              } else {
   126                _srecordf (str, "'\\x%02x',", ' ');
   127              }
   128              code (0, CONSTANTS, str);
   129              if (col == 9) {
   130                code (0, CONSTANTS, "\n");
   131                col = 0;
   132              } else {
   133                code (0, CONSTANTS, " ");
   134                col++;
   135              }
   136            }
   137            _srecordf (str, "'\\x%02x'\n,", '\n');
   138            code (0, CONSTANTS, str);
   139            curlin++;
   140          }
   141          code (0, CONSTANTS, "'\\0'\n");
   142          code (0, CONSTANTS, "};");
   143          while (curlin < nftnlines) {
   144            if (! IS_JCL (CUR_LIN.text[0])) {
   145              FATAL (2301, "jcl error", CUR_LIN.text);
   146            }
   147            curlin++;
   148          }
   149        }
   150      }
   151    }
   152  }
Deze website is gearchiveerd door de KB, nationale bibliotheek.

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