@portll/cobolwork 0.6.0 → 0.7.0

package/lib/kernel/source-tree.mjs

@@ -36,6 +36,7 @@ import { basename, dirname, relative, resolve, sep } from 'node:path';
 import { buildFileIndex, parseSource } from '../parser.mjs';
 import { classifyUnder, decodeSource, diskClassifier, heldClassifier, kindOfBytes, looksEbcdic, readSource, relPath } from '../sources.mjs';
 import { revisionBlobs, treeOf, treePathParts } from './git.mjs';
+import { archiveKind, readArchive } from './pds-archive.mjs';
 
 // The shape every adapter answers to. Checked rather than documented, because an adapter missing a
 // method fails at the first rule set that happens to call it rather than at the boundary.
@@ -70,6 +71,7 @@ export function directoryTree(root, opts = {}) {
   const kindOf = diskClassifier();
   classifyUnder(root, kindOf);
   if (top !== root) classifyUnder(top, kindOf);
+  const parseSpec = { copyDirs: idx.copyDirs, fileIndex: idx.index, indexRoot: idx.index.root, systemDirs };
 
   return {
     kind: 'directory',
@@ -81,6 +83,7 @@ export function directoryTree(root, opts = {}) {
     list: () => [...idx.index.values()].sort(),
     bytes: (p) => readFileSync(p),
     text: (p) => readSource(p),
+    decode: decodeSource,
     rel: (p) => relPath(root, p),
     // The same prefix test buildFileIndex applies while walking. It is not the containment
     // mechanism - the walk is, and it resolves symlinks before testing - it is the answer to
@@ -88,17 +91,26 @@ export function directoryTree(root, opts = {}) {
     contains: (p) => { const r = resolve(p); return r === top || r.startsWith(top + sep); },
     // One parse configuration, in one place. `text` is optional: a caller that has already read
     // the source passes it rather than reading twice.
-    parse: (file, text) => parseSource(text ?? readSource(file).text, file, {
-      format: 'auto',
-      includeDirs: idx.copyDirs,
-      fileIndex: idx.index,
-      mainDir: dirname(file),
-      copyFormat: 'auto',
-      systemDirs,
-    }),
+    parse: (file, text) => parseInDirectory(parseSpec, file, text),
+    // The same configuration as data, for a worker thread to parse as this tree does.
+    parseSpec,
   };
 }
 
+// A directory tree's parse, from its parseSpec. A spec cloned into a worker loses the index's root,
+// which the parser reads to refuse a COPY that leaves the tree, so it is put back.
+export function parseInDirectory(spec, file, text) {
+  if (spec.fileIndex.root !== spec.indexRoot) spec.fileIndex.root = spec.indexRoot;
+  return parseSource(text ?? readSource(file).text, file, {
+    format: 'auto',
+    includeDirs: spec.copyDirs,
+    fileIndex: spec.fileIndex,
+    mainDir: dirname(file),
+    copyFormat: 'auto',
+    systemDirs: spec.systemDirs,
+  });
+}
+
 // A tree whose files are held rather than on disk. The parser finds copybooks in the index built
 // here and reads them through `readText`, so a COPY resolves to a held file or to a system copy
 // library outside the tree, never to a file on disk that happens to sit under this tree's root.
@@ -135,6 +147,7 @@ function heldTree({ kind, root, store, rel, systemDirs = [], copyDirs = null, cl
     list: () => [...store.keys()].sort(),
     bytes,
     text,
+    decode: decodeSource,
     rel,
     // Containment by construction: a path this tree does not hold is a path outside it.
     contains: (p) => store.has(p),
@@ -206,24 +219,26 @@ export function unframeRecords(buf) {
   return looksEbcdic(ebcdic) ? ebcdic : lines(0x0A);
 }
 
-// A member is read from the file the walk found. A link put in its place since, or a file that is
-// not a regular one, is refused rather than followed or waited on.
-function readMember(file) {
+// A file the walk found, read as it is or its first `limit` bytes. A link put in its place since, or
+// a file that is not a regular one, is refused rather than followed or waited on.
+function readFound(file, limit = Infinity) {
   const fd = openSync(file, constants.O_RDONLY | (constants.O_NOFOLLOW || 0) | (constants.O_NONBLOCK || 0));
   try {
     const st = fstatSync(fd);
     if (!st.isFile()) throw Object.assign(new Error(`not a regular file: ${file}`), { code: 'ENOTFILE' });
-    const buf = Buffer.alloc(st.size);
+    const size = Math.min(st.size, limit);
+    const buf = Buffer.alloc(size);
     let n = 0;
-    while (n < st.size) {
-      const r = readSync(fd, buf, n, st.size - n, n);
+    while (n < size) {
+      const r = readSync(fd, buf, n, size - n, n);
       if (!r) break;
       n += r;
     }
-    return unframeRecords(buf.subarray(0, n));
+    return buf.subarray(0, n);
   } finally { closeSync(fd); }
 }
 
+
 const QUALIFIER = /^[A-Z@#$][A-Z0-9@#$-]{0,7}$/;
 const MEMBER = /^([A-Z@#$][A-Z0-9@#$]{0,7})(?:\.[^.]*)?$/i;
 const MAX_LISTED = 8;
@@ -243,58 +258,111 @@ const MAX_LISTED = 8;
 export function pdsExportTree(dir, opts = {}) {
   const idx = buildFileIndex(dir);
   const top = realpathSync(dir);
-  const root = `${resolve(dir)}@pds`;
+  const files = [...idx.index.values()].sort().map((file) => {
+    let real;
+    try { real = realpathSync(file); } catch { real = file; }
+    return { rel: relPath(dir, file), escapes: real !== top && !real.startsWith(top + sep), read: (limit) => readFound(real, limit) };
+  });
+  return exportOf({ dir, root: `${resolve(dir)}@pds`, files, systemDirs: opts.systemDirs, symlinks: idx.symlinks,
+    unreadableDirs: idx.unreadableDirs.map((d) => relative(dir, d)) });
+}
+
+// The same export as a git revision holds it, read with plumbing into memory, as gitTree reads one.
+export function pdsExportRevision(repo, ref, opts = {}) {
+  const oid = treeOf(repo, ref);
+  const { blobs } = revisionBlobs(repo, oid, ref);
+  const files = blobs.filter((b) => treePathParts(b.path)).map((b) => ({ rel: b.path, read: (limit = Infinity) => b.bytes.subarray(0, limit) }));
+  const at = `${resolve(repo)}@${oid.slice(0, 12)}`;
+  return Object.assign(exportOf({ dir: at, root: `${at}@pds`, files, systemDirs: opts.systemDirs }), { ref, oid });
+}
+
+// An export's files, each { rel, read(limit), escapes }, held as members: a file whose directory is a
+// data set name and whose name a member name, or an XMIT file or IEBCOPY unload read into its data
+// set. `rel` is the file's path from the export's top, with forward slashes.
+function exportOf({ dir, root, files, systemDirs = [], symlinks = { followed: 0, outside: 0, broken: 0 }, unreadableDirs = [] }) {
   const origins = new Map();
   const found = new Map();
   const notMembers = [];
   const duplicates = [];
   const dataSets = new Set();
-  for (const file of [...idx.index.values()].sort()) {
-    const where = relative(dir, dirname(file)).split(sep).filter(Boolean);
-    const dsn = where.join('.').toUpperCase();
-    const member = MEMBER.exec(basename(file));
+  const archived = new Map();
+  const archives = { files: 0, members: 0, aliases: 0, notRead: [] };
+  for (const { rel, read, escapes } of files) {
+    const parts = rel.split('/');
+    const file = parts.pop();
+    const dsn = parts.join('.').toUpperCase();
+    let head = null;
+    try { head = archiveKind(read(16)); } catch { head = null; }
+    if (head) {
+      if (escapes) { notMembers.push(rel); continue; }
+      let a;
+      try { a = readArchive(read()); } catch (e) { a = { why: reasonOf(e) }; }
+      const name = a.dataSet || file.replace(/\.[^.]*$/, '').toUpperCase();
+      if (!a.why && !(name.length <= 44 && name.split('.').every((q) => QUALIFIER.test(q)))) a.why = `${name} is not a data set name`;
+      if (a.why) { archives.notRead.push(`${rel}: ${a.why}`); continue; }
+      archives.files++;
+      archives.aliases += a.aliases.length;
+      if (a.unmatched) archives.notRead.push(`${rel}: ${a.unmatched} member(s) whose blocks no directory entry names`);
+      if (a.missing) archives.notRead.push(`${rel}: no data for ${a.missing.join(', ')}`);
+      for (const m of a.members) {
+        const at = m.name === null ? resolve(root, name) : resolve(root, name, m.name);
+        const origin = m.name === null ? rel : `${rel}(${m.name})`;
+        if (found.has(at)) { duplicates.push(`${origin}: ${relPath(root, at)} is ${found.get(at)}`); continue; }
+        archived.set(at, m.bytes);
+        found.set(at, origin);
+        dataSets.add(m.name === null ? at : dirname(at));
+        archives.members++;
+      }
+      continue;
+    }
+    const member = MEMBER.exec(file);
     if (!member || dsn.length > 44 || (dsn && !dsn.split('.').every((q) => QUALIFIER.test(q)))) {
-      notMembers.push(relPath(dir, file));
+      notMembers.push(rel);
       continue;
     }
     const at = resolve(root, ...(dsn ? [dsn] : []), member[1].toUpperCase());
-    if (found.has(at)) { duplicates.push(`${relPath(dir, file)}: ${relPath(root, at)} is ${found.get(at)}`); continue; }
-    let real;
-    try { real = realpathSync(file); } catch { real = file; }
-    if (real !== top && !real.startsWith(top + sep)) { notMembers.push(relPath(dir, file)); continue; }
-    origins.set(at, real);
-    found.set(at, relPath(dir, file));
+    if (found.has(at)) { duplicates.push(`${rel}: ${relPath(root, at)} is ${found.get(at)}`); continue; }
+    if (escapes) { notMembers.push(rel); continue; }
+    origins.set(at, read);
+    found.set(at, rel);
     dataSets.add(dirname(at));
   }
   const kinds = new Map();
   const byKind = {};
   const copyDirs = new Set();
-  for (const [at, file] of origins) {
+  const bytesOf = (at) => archived.get(at) ?? unframeRecords(origins.get(at)());
+  for (const at of [...origins.keys(), ...archived.keys()]) {
     let kind = null;
-    try { kind = kindOfBytes(readMember(file)); } catch { kind = null; }
+    try { kind = kindOfBytes(bytesOf(at)); } catch { kind = null; }
     kinds.set(at, kind);
     byKind[kind || 'other'] = (byKind[kind || 'other'] || 0) + 1;
     if (kind !== 'jcl' && kind !== 'bms') copyDirs.add(dirname(at));
   }
   const store = {
-    keys: () => origins.keys(),
-    has: (p) => origins.has(p),
-    get: (p) => (origins.has(p) ? readMember(origins.get(p)) : undefined),
+    keys: () => [...origins.keys(), ...archived.keys()].values(),
+    has: (p) => origins.has(p) || archived.has(p),
+    get: (p) => (origins.has(p) || archived.has(p) ? bytesOf(p) : undefined),
   };
   const tree = heldTree({
-    kind: 'pds-export', root, store, rel: (p) => relPath(root, p), systemDirs: opts.systemDirs || [],
-    copyDirs: [...copyDirs], classify: () => (p) => kinds.get(p) ?? null, symlinks: idx.symlinks,
-    unreadableDirs: idx.unreadableDirs.map((d) => resolve(root, relative(dir, d))),
+    kind: 'pds-export', root, store, rel: (p) => relPath(root, p), systemDirs,
+    copyDirs: [...copyDirs], classify: () => (p) => kinds.get(p) ?? null, symlinks,
+    unreadableDirs: unreadableDirs.map((d) => resolve(root, d)),
   });
   return Object.assign(tree, {
     dir,
     origin: (p) => found.get(p) ?? null,
     export: {
       dataSets: dataSets.size,
-      members: origins.size,
+      members: origins.size + archived.size,
       byKind,
       ...(notMembers.length ? { notMembers: notMembers.length, notMembersListed: notMembers.slice(0, MAX_LISTED) } : {}),
       ...(duplicates.length ? { duplicates: duplicates.length, duplicatesListed: duplicates.slice(0, MAX_LISTED) } : {}),
+      ...(archives.files || archives.notRead.length ? {
+        archives: {
+          files: archives.files, members: archives.members, aliases: archives.aliases,
+          ...(archives.notRead.length ? { notRead: archives.notRead.length, notReadListed: archives.notRead.slice(0, MAX_LISTED) } : {}),
+        },
+      } : {}),
     },
   });
 }

package/lib/kernel/version-key.mjs

@@ -0,0 +1,17 @@
+// SPDX-License-Identifier: AGPL-3.0-or-later
+// The version key and unknown keys of a document cobolwork reads. A document without the key
+// predates versioning and is read as version 0, which holds the same keys as version 1.
+import { printable } from './printable.mjs';
+
+// Why the document cannot be read, as a clause to follow its name, or null when it can.
+export function versionProblem(raw, current) {
+  const version = raw.version === undefined ? 0 : raw.version;
+  if (!Number.isInteger(version) || version < 0) return `has version ${printable(JSON.stringify(version), 40)}, which is not a whole number from 0`;
+  if (version > current) return `is version ${version}, and this cobolwork reads up to version ${current}; upgrade cobolwork`;
+  return null;
+}
+
+// A key opening with an underscore is a note for people, as diag/propose-site.mjs writes them.
+export const unknownKeys = (raw, known) => Object.keys(raw).filter((k) => !known.has(k) && !k.startsWith('_')).sort();
+
+export const ignoredKey = (where, key) => `${where}: ${printable(JSON.stringify(key), 80)} is not a key this cobolwork reads, so it was ignored`;

package/lib/layout.mjs

@@ -22,6 +22,8 @@ function picInfo(pic, constants) {
     if (ch === 'V' || ch === 'P') continue;
     if (ch === '9') { info.digits += n; info.display += n; continue; }
     if (ch === 'N' || ch === 'G') { info.national = true; info.display += 2 * n; continue; }
+    // A U is one UTF-8 character, for which IBM reserves four bytes (Defining UTF-8 data items).
+    if (ch === 'U') { info.utf8 = true; info.display += 4 * n; continue; }
     if (ch === 'X' || ch === 'A') info.alphanumeric = true;
     info.display += n;
   }
@@ -45,9 +47,13 @@ function binaryBytes(digits, scheme) {
 }
 
 function elementarySize(item, scheme, constants) {
+  if (item.byteLength) return item.byteLength;
   if (!item.picture && !item.usage) {
     const constBytes = constants && constants.textBytes;
-    const fromValue = item.values.reduce((n, v) => n + (v.t === 'lit' ? literalBytes(v) : v.t === 'word' && constBytes && constBytes.has(v.u) ? constBytes.get(v.u) : 0), 0);
+    const bytes = (v) => (v.t === 'lit' ? literalBytes(v) : v.t === 'word' && constBytes && constBytes.has(v.u) ? constBytes.get(v.u) : 0);
+    // A screen item shows a numeric VALUE as written, one position per character.
+    const digits = (v) => v.t === 'num' || (v.t === 'word' && /^\d+$/.test(v.v));
+    const fromValue = item.values.reduce((n, v) => n + (item.section === 'SCREEN' && digits(v) ? v.v.length : bytes(v)), 0);
     if (item.section === 'SCREEN' && !fromValue && item.screenRefItem) return item.screenRefItem.size || 0;
     if (item.section === 'SCREEN') return Math.max(1, fromValue);
     if (fromValue) return fromValue;
@@ -147,47 +153,36 @@ export function computeSizes(roots, scheme, constants) {
   for (const r of roots) place(r, 0);
 }
 
-// A report group is laid out by column, not by adding up its items: a line is as wide as the column
-// its rightmost item ends in, COLUMN PLUS counting on from the end of the item before. A group holds
-// its lines one after another, and every 01 group of a report, like the file the report is written
-// to, is as large as the largest group.
+// A report group is as large as the larger of its items laid end to end and the column its
+// rightmost elementary item ends in, COLUMN PLUS counting on from the end of the item before; an
+// elementary item keeps its picture's size. Every 01 group of a report, like the file the report is
+// written to, is as large as the largest group. These are GnuCOBOL's sizes: IBM's Report Writer is a
+// precompiler that writes its own records.
 export function layoutReport(rd) {
   const structural = (x) => x.children.filter(c => c.level !== 88 && c.level !== 66 && c.level !== 78);
   const mark = (x) => { x.rd = rd; for (const c of x.children) mark(c); };
   for (const g of rd.groups) mark(g);
-  let width = 0;
-  // Items printed at the same column under PRESENT WHEN each keep their own storage, so a line is
-  // never smaller than its items laid end to end.
-  const lineWidth = (line) => {
+  const sizeOf = (x) => {
+    const kids = structural(x);
+    if (!kids.length) return x.size || 0;
     let last = 0;
     let right = 0;
     let total = 0;
-    const place = (c) => {
-      const len = c.contributes || c.size || 0;
+    for (const c of kids) {
+      const len = sizeOf(c) * (c.occurs || 1);
+      total += len;
+      if (structural(c).length) continue;
       const start = c.rwColumn ? (c.rwColumn.at != null ? c.rwColumn.at : last + c.rwColumn.plus) : last + 1;
       last = start + len - 1;
       right = Math.max(right, last);
-      total += len;
-    };
-    const walk = (x) => { for (const c of structural(x)) { if (structural(c).length) walk(c); else place(c); } };
-    if (structural(line).length) walk(line);
-    else place(line);
-    return Math.max(right, total);
-  };
-  // The entries that open a line; a group with no LINE clause anywhere in it is one line.
-  for (const g of rd.groups) {
-    const lines = [];
-    const collect = (x) => { if (x.rwLine) { lines.push(x); return; } for (const c of structural(x)) collect(c); };
-    collect(g);
-    if (!lines.length) lines.push(g);
-    let total = 0;
-    for (const line of lines) {
-      const w = lineWidth(line);
-      if (line !== g) { line.size = w; line.contributes = w * (line.occurs || 1); }
-      total += w;
     }
-    width = Math.max(width, total);
-  }
+    const size = Math.max(right, total);
+    x.size = size;
+    x.contributes = size * (x.occurs || 1);
+    return size;
+  };
+  let width = 0;
+  for (const g of rd.groups) width = Math.max(width, sizeOf(g));
   for (const g of rd.groups) { g.size = width; g.contributes = width; }
   rd.width = width;
 }

package/lib/parser.mjs

@@ -210,7 +210,8 @@ function evaluateCondition(text, defines) {
   return null;
 }
 
-export function normalize(src, format, defines, std) {
+// A debugging line (D in the indicator) is source under WITH DEBUGGING MODE and a comment otherwise.
+export function normalize(src, format, defines, std, debugging = false) {
   // Micro Focus reads a free-form line with * or / in column 1 as a comment, as cobc -std=mf does.
   const columnOneComments = std === 'mf' || std === 'mf-strict';
   const phys = src.split(/\r?\n/);
@@ -310,7 +311,7 @@ export function normalize(src, format, defines, std) {
       text = l.slice(7, 7 + width);
       if (!FIXED_INDICATORS.has(indicator)) { diags.push({ kind: 'invalid-indicator', line }); indicator = ' '; }
     }
-    if (indicator === '*' || indicator === '/' || indicator === 'D' || indicator === 'd') continue;
+    if (indicator === '*' || indicator === '/' || ((indicator === 'D' || indicator === 'd') && !debugging)) continue;
     if (fmt === 'free' && (/^\s*\*>/.test(text) || (columnOneComments && /^[*/]/.test(text)))) continue;
     // AUTHOR, INSTALLATION, DATE-WRITTEN, DATE-COMPILED, SECURITY and REMARKS take a comment-entry:
     // any text, a COPY or an apostrophe included. It runs to the end of the header's line, and in
@@ -409,8 +410,9 @@ export function tokenize(norm, file) {
       if (c === ' ' || c === '\t' || c === '\f' || c === '\r') { i++; continue; }
       if (exec && exec.kind === 'SQL' && c === '-' && s[i + 1] === '-') break;
       if (picPending) {
+        // = is no PICTURE symbol, so == closes the pseudo-text a picture string ends.
         let j = i;
-        while (j < n && s[j] !== ' ') j++;
+        while (j < n && s[j] !== ' ' && !(s[j] === '=' && s[j + 1] === '=')) j++;
         let pic = s.slice(i, j);
         if (pic.toUpperCase() === 'IS') { emit(tok('word', pic, line, file)); i = j; continue; }
         let trailingPeriod = false;
@@ -853,7 +855,7 @@ function includeCopy(name, lib, pairs, at, via, ctx, stack, inheritedFormat) {
   // A copybook is read in the format in force where the COPY statement sits, which a >>SOURCE
   // directive earlier in the including file may have changed from the file's starting format.
   const fmt = detectFormat(src) === 'terminal' && ctx.copyFormat === 'auto' ? 'terminal' : (at.fmt || (ctx.copyFormat !== 'auto' ? ctx.copyFormat : (inheritedFormat || ctx.mainFormat)));
-  const norm = normalize(src, fmt, ctx.defines, ctx.std);
+  const norm = normalize(src, fmt, ctx.defines, ctx.std, ctx.debugging);
   // A tag written against other text - :TAG:-FIELD, FS-(), 'X'-CLE - is replaced in the text, as the
   // compiler does, so the text around it joins the replacement into one word. A literal is taken as a
   // tag only where it touches a word; elsewhere it is replaced token for token like any operand.
@@ -896,6 +898,53 @@ function includeCopy(name, lib, pairs, at, via, ctx, stack, inheritedFormat) {
   return out;
 }
 
+// REPLACE ==:TAG:== BY ==text== replaces the colon-delimited operand wherever the program text holds
+// it, inside a word or a PICTURE as much as standing alone (IBM Enterprise COBOL, REPLACE statement,
+// replacement rules). Like a tag in COPY REPLACING it is replaced in the text, from the statement on
+// until REPLACE OFF or a REPLACE that does not name it again; a REPLACE itself is left as written.
+const TAG = /^:[A-Za-z0-9_-]+:$/;
+
+function replaceStatementAt(text, at) {
+  const rest = text.slice(at);
+  const off = /^REPLACE\s+OFF\s*\./i.exec(rest);
+  if (off) return { end: at + off[0].length, off: true, tags: [] };
+  const head = /^REPLACE(\s+ALSO)?\s*/i.exec(rest);
+  let k = head[0].length;
+  const tags = [];
+  let pairs = 0;
+  for (;;) {
+    const pair = /^(?:(?:LEADING|TRAILING)\s+)?==([\s\S]*?)==\s*BY\s*==([\s\S]*?)==\s*/i.exec(rest.slice(k));
+    if (!pair) break;
+    pairs++;
+    if (TAG.test(pair[1].trim())) tags.push([pair[1].trim(), pair[2].trim().replace(/\s+/g, ' ')]);
+    k += pair[0].length;
+  }
+  if (!pairs) return null;
+  if (rest[k] === '.') k++;
+  return { end: at + k, also: !!head[1], tags };
+}
+
+function replaceTags(norm) {
+  const text = norm.entries.map((e) => e.text).join('\n');
+  if (!/==\s*:[A-Za-z0-9_-]+:\s*==/.test(text)) return;
+  let active = [];
+  let out = '';
+  let from = 0;
+  // nosemgrep: javascript.lang.security.audit.detect-non-literal-regexp.detect-non-literal-regexp -- TAG admits no metacharacter
+  const swap = (chunk) => active.reduce((t, [tag, to]) => t.replace(new RegExp(tag, 'gi'), to), chunk);
+  for (const m of text.matchAll(/\bREPLACE\b/gi)) {
+    if (m.index < from) continue;
+    const st = replaceStatementAt(text, m.index);
+    if (!st) continue;
+    out += swap(text.slice(from, m.index)) + text.slice(m.index, st.end);
+    active = st.off ? [] : st.also ? [...active, ...st.tags] : st.tags;
+    from = st.end;
+  }
+  out += swap(text.slice(from));
+  const lines = out.split('\n');
+  if (lines.length === norm.entries.length) norm.entries.forEach((e, i) => { e.text = lines[i]; });
+}
+
 // A REPLACE governs the source up to the next one, which replaces it unless ALSO; OFF ends it; output is not rescanned.
 function applyReplaceStatements(tokens, ctx) {
   let active = [];
@@ -976,6 +1025,8 @@ function parseDataEntry(toks, section, file) {
       continue;
     }
     if (u === 'PIC' || u === 'PICTURE') { j++; if (toks[j] && toks[j].u === 'IS') j++; if (toks[j]) item.picture = toks[j].v; j++; continue; }
+    // PIC U BYTE-LENGTH n: a UTF-8 item of n bytes holding as many characters as fit.
+    if (u === 'BYTE-LENGTH') { j++; if (toks[j] && toks[j].u === 'IS') j++; if (toks[j] && /^\d+$/.test(toks[j].v)) { item.byteLength = Number(toks[j].v); j++; } continue; }
     if (u === 'USAGE') { j++; if (toks[j] && toks[j].u === 'IS') j++; if (toks[j]) { item.usage = toks[j].u; j++; } continue; }
     if (USAGE_WORDS.has(u)) { item.usage = u; j++; continue; }
     // OCCURS DYNAMIC [CAPACITY IN name] [FROM n] [TO m]: sized at its most, none without TO; the
@@ -1048,6 +1099,9 @@ function parseDataEntry(toks, section, file) {
     if (u === 'CONSTANT') { item.constant = true; j++; if (toks[j] && toks[j].u === 'AS') j++; while (toks[j] && (toks[j].t === 'num' || toks[j].t === 'lit' || (toks[j].t === 'word' && /^\d+$/.test(toks[j].v)))) item.values.push(toks[j++]); continue; }
     if (u === 'VALUE' || u === 'VALUES') {
       j++;
+      // A screen item's VALUE is one literal; what follows it is the item's other clauses, and a later
+      // VALUE (two entries run together by a missing period) replaces it.
+      if (section === 'SCREEN') { if (toks[j] && toks[j].u === 'IS') j++; if (toks[j]) { item.values = [toks[j]]; j++; } continue; }
       while (toks[j] && (toks[j].t !== 'word' || !(DATA_CLAUSE_WORDS.has(toks[j].u) || (report && REPORT_CLAUSE_WORDS.has(toks[j].u))) || toks[j].u === 'IS')) { item.values.push(toks[j]); j++; }
       continue;
     }
@@ -1073,6 +1127,25 @@ function debugItem(at) {
   return [root, ...root.children];
 }
 
+// DEBUG-CONTENTS is X(n), n left to the compiler (IBM, DEBUG-ITEM). GnuCOBOL makes it as long as the
+// longest item USE FOR DEBUGGING names, a CD's records included, and never shorter than 30.
+function sizeDebugContents(prog, tokens, from, to, scheme, constants) {
+  const named = [];
+  for (let i = from; i < to - 3; i++) {
+    if (tokens[i].u !== 'USE' || tokens[i + 1].u !== 'FOR' || tokens[i + 2].u !== 'DEBUGGING') continue;
+    for (let k = i + 3; k < to && tokens[k].t !== 'period'; k++) if (tokens[k].t === 'word') named.push(tokens[k].u);
+  }
+  const sizes = named.flatMap((n) => prog.items.filter((it) => it.name === n && it.level < 50 && !it.implicit).map((it) => it.size || 0)
+    .concat(prog.items.filter((it) => it.cd === n).map((it) => it.size || 0)));
+  const longest = Math.max(30, ...sizes);
+  if (longest === 30) return;
+  const root = prog.items.find((it) => it.implicit && it.name === 'DEBUG-ITEM');
+  const contents = root && root.children.find((c) => c.name === 'DEBUG-CONTENTS');
+  if (!contents) return;
+  contents.picture = `X(${longest})`;
+  computeSizes([root], scheme, constants);
+}
+
 // TYPE gives an item the picture, usage and subordinate items of the TYPEDEF it names. The listing
 // prints the typed item alone; what it holds is implied, reachable by qualification (RE OF WS-Z),
 // so the copies are returned as items marked typeClone.
@@ -1169,6 +1242,7 @@ function parseProgram(tokens, from, to, scheme, defines, hostVariables = true) {
           if (s[m]) f.assign = { t: s[m].t, v: s[m].t === 'word' ? s[m].u : s[m].v };
         }
         for (let m = n + 1; m < s.length; m++) if (s[m].t === 'word') f.envRefs.push(s[m]);
+        f.lineSequential = s.some((t, m) => t.u === 'LINE' && s[m + 1] && s[m + 1].u === 'SEQUENTIAL');
         prog.files.push(f);
       } else {
         for (const t of s) if (t.t === 'word') prog.refs.push({ tok: t, zone: 'env' });
@@ -1182,6 +1256,7 @@ function parseProgram(tokens, from, to, scheme, defines, hostVariables = true) {
     let stack = [];
     let currentFd = null;
     let currentRd = null;
+    let currentCd = null;
     const dataSentences = sentences(tokens, dataStart, dataEnd);
     for (let s of dataSentences) {
       // What an EXEC SQL INCLUDE brings in follows it in the same sentence, up to its own first period.
@@ -1196,6 +1271,7 @@ function parseProgram(tokens, from, to, scheme, defines, hostVariables = true) {
         section = first.u === 'RD' ? 'REPORT' : 'COMMUNICATION';
         currentFd = null;
         currentRd = first.u === 'RD' ? { name: s[1].u, line: first.line, file: first.file, groups: [] } : null;
+        currentCd = first.u === 'CD' ? s[1].u : null;
         if (currentRd) (prog.reports ||= []).push(currentRd);
         else (prog.cds ||= []).push(s[1].u);
         stack = [];
@@ -1204,12 +1280,7 @@ function parseProgram(tokens, from, to, scheme, defines, hostVariables = true) {
       if (first.t === 'word' && (first.u === 'FD' || first.u === 'SD') && s[1]) {
         section = 'FILE';
         currentRd = null;
-        currentFd = { kind: first.u, name: s[1].u, line: first.line, file: first.file, records: [], fdTok: s[1], declaredMax: 0, varying: false };
-        const recAt = s.findIndex(x => x.t === 'word' && x.u === 'RECORD');
-        if (recAt >= 0) for (let m = recAt + 1; m < s.length && !['LABEL', 'BLOCK', 'DATA', 'VALUE', 'RECORDING', 'CODE-SET', 'LINAGE', 'REPORT', 'REPORTS', 'DEPENDING'].includes(s[m].u); m++) {
-          if (s[m].u === 'VARYING') currentFd.varying = true;
-          if (/^\d+$/.test(s[m].v)) currentFd.declaredMax = Math.max(currentFd.declaredMax, Number(s[m].v));
-        }
+        currentFd = { kind: first.u, name: s[1].u, line: first.line, file: first.file, records: [], fdTok: s[1], ...recordClause(s) };
         const repAt = s.findIndex(x => x.t === 'word' && (x.u === 'REPORT' || x.u === 'REPORTS'));
         if (repAt >= 0) {
           currentFd.reports = [];
@@ -1225,6 +1296,7 @@ function parseProgram(tokens, from, to, scheme, defines, hostVariables = true) {
       }
       if ((first.t === 'word' || first.t === 'num') && /^\d{1,2}$/.test(first.v)) {
         const item = parseDataEntry(s, section, first.file);
+        if (section === 'COMMUNICATION' && item.level === 1) item.cd = currentCd;
         if (item.level === 88 || item.level === 66) {
           const parent = item.level === 88 ? stack[stack.length - 1] : null;
           if (parent) { parent.children.push(item); item.parent = parent; }
@@ -1283,6 +1355,7 @@ function parseProgram(tokens, from, to, scheme, defines, hostVariables = true) {
         || siblings.find(x => x !== it && x.name === it.redefines) || null;
     }
     computeSizes(roots, scheme, constants);
+    if (prog.debuggingMode && procAt >= 0) sizeDebugContents(prog, tokens, procAt, procEnd, scheme, constants);
     const subtreeCache = new Map();
     const subtree = (record) => {
       if (subtreeCache.has(record)) return subtreeCache.get(record);
@@ -1319,12 +1392,18 @@ function parseProgram(tokens, from, to, scheme, defines, hostVariables = true) {
       it.renamesSpan = all.filter(x => x.offset >= from && x.offset + x.contributes <= to && x !== it);
     }
     for (const rd of prog.reports || []) layoutReport(rd);
-    // A file is as large as the longer of its declared length and its record description; the
-    // compiler warns when a record exceeds the declared maximum but still uses the record. A report
-    // file's record is as wide as the widest line of the reports written to it.
+    // A file's record is as long as its RECORD clause allows, or its longest record description
+    // where that is longer or there is no clause; a record longer than the clause still wins, as the
+    // compiler warns and uses it. The FD of a line-sequential file, which GnuCOBOL has and IBM does
+    // not, is sized by its records whatever RECORD CONTAINS says, though RECORD IS VARYING still sets
+    // its maximum. A report file's record is as wide as the widest line of the reports written to it.
     for (const fd of prog.fds || []) {
       const reports = (fd.reports || []).map(n => (prog.reports || []).find(r => r.name === n)).filter(Boolean);
-      fd.size = Math.max(fd.declaredMax || 0, 0, ...fd.records.map(r => r.size || 0), ...reports.map(r => r.width || 0));
+      const described = Math.max(0, ...fd.records.map(recordLength), ...reports.map(r => r.width || 0));
+      const select = prog.files.find(f => f.name === fd.name);
+      const ignored = select && select.lineSequential && fd.kind === 'FD' && fd.recordFormat !== 3;
+      const clause = ignored ? 0 : fd.fixedLength || fd.varyingMax || fd.rangeMax || 0;
+      fd.size = Math.max(clause, described);
     }
   }
 
@@ -1334,6 +1413,34 @@ function parseProgram(tokens, from, to, scheme, defines, hostVariables = true) {
   return prog;
 }
 
+const FD_CLAUSES = new Set(['LABEL', 'BLOCK', 'DATA', 'VALUE', 'RECORDING', 'CODE-SET', 'LINAGE', 'REPORT', 'REPORTS', 'DEPENDING', 'RECORD']);
+
+// The RECORD clause of an FD in IBM's three formats, CONTAINS n, CONTAINS n TO m and IS VARYING ...
+// TO m, each giving the longest record the file holds. LABEL RECORD and DATA RECORD are other clauses
+// that share the word.
+function recordClause(s) {
+  for (let at = 1; at < s.length; at++) {
+    if (s[at].u !== 'RECORD' || ['LABEL', 'DATA'].includes(s[at - 1].u)) continue;
+    let varying = false;
+    let to = false;
+    const nums = [];
+    let toNum = null;
+    for (let m = at + 1; m < s.length && !FD_CLAUSES.has(s[m].u); m++) {
+      if (s[m].u === 'VARYING') varying = true;
+      else if (s[m].u === 'TO') to = true;
+      else if (/^\d+$/.test(s[m].v)) { nums.push(Number(s[m].v)); if (to && toNum == null) toNum = Number(s[m].v); }
+    }
+    if (varying) return { recordFormat: 3, varyingMax: toNum };
+    if (nums.length === 1 && !to) return { recordFormat: 1, fixedLength: nums[0] };
+    if (nums.length) return { recordFormat: 2, rangeMax: nums.at(-1) };
+  }
+  return { recordFormat: null };
+}
+
+// A record's length in its file. OCCURS on a level-01 record is a GnuCOBOL extension IBM refuses;
+// GnuCOBOL sizes the file by one occurrence.
+const recordLength = (r) => (r.occurs > 1 ? r.size / r.occurs : r.size || 0);
+
 export function segmentEnd(tokens, i, to) {
   let depth = 0;
   for (let k = i + 1; k < to; k++) {
@@ -1485,10 +1592,15 @@ function parseProcedure(tokens, procAt, to, prog, hostVariables) {
         const constText = target.t === 'word' && prog.constants && prog.constants.text
           ? prog.constants.text.get(target.u) : undefined;
         const resolved = target.t === 'lit' ? target.v : constText;
+        // A literal program name is padded to its field; the compiler drops the trailing spaces. A
+        // literal holding a path calls the program its last component names, as the runtime loads it.
+        const literal = resolved === undefined ? null : String(resolved).trimEnd();
+        const name = literal === null ? target.u : literal.split(/[\\/]/).pop();
         prog.calls.push({
-          // A literal program name is padded to its field; the compiler drops the trailing spaces.
           kind: resolved === undefined ? 'I' : 'L',
-          name: resolved === undefined ? target.u : String(resolved).trimEnd(),
+          name,
+          ...(literal !== null && name !== literal ? { calledAs: literal } : {}),
+          ...(target.t === 'lit' && target.prefix === 'X' ? { hex: true } : {}),
           ...(constText !== undefined ? { viaConstant: target.u } : {}),
           line: t.line, file: t.file, targetTok: target, using: args, stmtIndex: prog.statements.length - 1,
         });
@@ -1953,8 +2065,15 @@ export function parseSource(src, file, opts = {}) {
     // Where a copybook's text comes from: the disk, or the source tree the program was read from.
     readText: opts.readText || ((p) => readSource(p).text) };
   collectCopybookDefines(src, format, ctx, 0);
-  const norm = normalize(src, format, ctx.defines, opts.std);
+  let norm = normalize(src, format, ctx.defines, opts.std);
+  // WITH DEBUGGING MODE in SOURCE-COMPUTER makes the debugging lines of the program and its
+  // copybooks source; it is read from the text with those lines still comments.
+  if (/\bSOURCE-COMPUTER\s*\.[^.]*\bDEBUGGING\s+MODE\b/i.test(norm.entries.map(e => e.text).join(' '))) {
+    ctx.debugging = true;
+    norm = normalize(src, format, ctx.defines, opts.std, true);
+  }
   ctx.mainFormat = norm.finalFormat;
+  replaceTags(norm);
   const { tokens: raw, diags } = tokenize(norm, file);
   ctx.diags.push(...norm.diags.map(d => ({ ...d, file })), ...diags);
   const expanded = stripDirecting(applyReplaceStatements(expand(raw, ctx, [resolve(file)], norm.finalFormat), ctx));

package/lib/pli/cursor.mjs

@@ -0,0 +1,15 @@
+// SPDX-License-Identifier: AGPL-3.0-or-later
+// The PL/I statement cursor: the shared token cursor, failing with PliSyntax.
+import { tokenCursor, split } from '../statement-cursor.mjs';
+
+export class PliSyntax extends Error {
+  constructor(message, tok) {
+    super(message);
+    this.name = 'PliSyntax';
+    this.line = tok ? tok.line : null;
+    this.col = tok ? tok.col : null;
+  }
+}
+
+export const cursor = (toks) => tokenCursor(toks, PliSyntax);
+export { split };