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      RECORD jline, step, name, oper, parm;
  54  // Log the line.
  55      jcllin++;
  56      RECCLR (jline);
  57      _srecordf (jline, "// %6d %6d //%s\n", curlin, jcllin, &CUR_LIN.text[2]);
  58      code (0, JCL, jline);
  59  //
  60      int_4 k = 0, N = 0, fn;
  61  // Parse step and name field.
  62      curcol = 2;
  63      RECCLR (step);
  64      RECCLR (name);
  65      while (N < RECLN && (isalpha (CUR_COL) || (strlen (name) > 0 ? isdigit (CUR_COL) : FALSE))) {
  66        name[k++] = tolower (CUR_COL);
  67        curcol++;
  68        N++;
  69      }
  70      if (CUR_COL == '.') {
  71        strcpy (step, name);
  72        RECCLR (name);
  73        curcol++;
  74        k = 0;
  75        N = 0;
  76        while (N < RECLN && (isalpha (CUR_COL) || (strlen (name) > 0 ? isdigit (CUR_COL) : FALSE))) {
  77          name[k++] = tolower (CUR_COL);
  78          curcol++;
  79          N++;
  80        }
  81      }
  82  // Parse operation field.
  83      while (isspace (CUR_COL)) {
  84        curcol++;
  85      }
  86      RECCLR (oper);
  87      k = 0;
  88      while (N < RECLN && (isalpha (CUR_COL) || (strlen (oper) > 0 ? isdigit (CUR_COL) : FALSE))) {
  89        oper[k++] = tolower (CUR_COL);
  90        curcol++;
  91        N++;
  92      }
  93  // Parse parameter field.
  94      while (isspace (CUR_COL)) {
  95        curcol++;
  96      }
  97      RECCLR (parm);
  98      k = 0;
  99      while (N < RECLN && CUR_COL != '\0' && isprint (CUR_COL)) {
 100        parm[k++] = CUR_COL;
 101        curcol++;
 102        N++;
 103      }
 104  // Match FT..F001.
 105      if (sscanf(name, "ft%02df001", &fn) == 1 && EQUAL (oper, "dd")) {
 106        if (EQUAL (parm, "*")) {
 107          RECORD str;
 108          CUR_LIN.jcl = TRUE;
 109          CUR_LIN.isn = 0;
 110  // Write as row of chars as C cannot have comments in string denotations.
 111          _srecordf (str, "char %s[] = {\n", name);
 112          code (0, CONSTANTS, str);
 113          _ffile[fn].in_stream = TRUE;
 114          _ffile[fn].name = f_stralloc (name);
 115          curlin++;
 116          int_4 col = 0;
 117          while (curlin < nftnlines && !EQUAL (CUR_LIN.text, "/*")) {
 118            _srecordf (str, "//%s\n", CUR_LIN.text);
 119            code (0, CONSTANTS, str);
 120            CUR_LIN.jcl = TRUE;
 121            CUR_LIN.isn = 0;
 122  // Pad to 80 characters (vintage punch card record length).
 123            for (int_4 m = 0; m < 80; m++) {
 124              if (m < strlen (CUR_LIN.text)) {
 125                _srecordf (str, "'\\x%02x',", CUR_LIN.text[m]);
 126              } else {
 127                _srecordf (str, "'\\x%02x',", ' ');
 128              }
 129              code (0, CONSTANTS, str);
 130              if (col == 9) {
 131                code (0, CONSTANTS, "\n");
 132                col = 0;
 133              } else {
 134                code (0, CONSTANTS, " ");
 135                col++;
 136              }
 137            }
 138            _srecordf (str, "'\\x%02x'\n,", '\n');
 139            code (0, CONSTANTS, str);
 140            curlin++;
 141          }
 142          code (0, CONSTANTS, "'\\0'\n");
 143          code (0, CONSTANTS, "};");
 144          while (curlin < nftnlines) {
 145            if (! IS_JCL (CUR_LIN.text[0])) {
 146              FATAL (2101, "jcl error", CUR_LIN.text);
 147            }
 148            curlin++;
 149          }
 150        }
 151      }
 152    }
 153  }
Deze website is gearchiveerd door de KB, nationale bibliotheek.

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