@portll/cobolwork 0.2.76 → 0.2.117

package/lib/ironwork.mjs

@@ -0,0 +1,111 @@
+// SPDX-License-Identifier: AGPL-3.0-or-later
+// `ironwork check` over every program in a tree: IBM Enterprise COBOL's front end as ironwork models
+// it, for an estate whose compile step runs on z/OS and so never meets the build gate otherwise.
+// ironwork is run as a separate program, as cobc is; nothing here links it.
+import { spawnSync } from 'node:child_process';
+import { tmpdir } from 'node:os';
+import { resolve } from 'node:path';
+import { directoryTree } from './kernel/source-tree.mjs';
+import { printable } from './kernel/printable.mjs';
+import { buildFileIndex, VERBS } from './parser.mjs';
+import { isProgram, relPath } from './sources.mjs';
+import { EIB_FIELDS, DIB_FIELDS, SQLCA_FIELDS } from './words.mjs';
+
+// ironwork check exits with IBM's highest return code: 0 clean, 4 warnings only (compiled), 8 E,
+// 12 S, 16 U. Only 0 and 4 produce a program.
+const COMPILED = new Set([0, 4]);
+const REJECTED = new Set([8, 12, 16]);
+// Warnings and informational lines follow the errors, and say nothing about why a program failed.
+const NOT_AN_ERROR = /^(?:informational:|.*?: warning: )/;
+const PER_PROGRAM_MS = 60000;
+const MAX_LISTED = 10;
+
+// ironwork refuses by name what it does not model yet; that says nothing about the program. Where its
+// parser stops at a statement it does not read (ENTRY, ALTER), or at a name the CICS, DL/I or SQL
+// translator declares, it says so without the name, so both are read as its gap, not the program's.
+const NOT_SUPPORTED = /\bnot supported\b/i;
+const TRANSLATOR_NAMES = [EIB_FIELDS, DIB_FIELDS, SQLCA_FIELDS];
+function notModelled(message) {
+  if (NOT_SUPPORTED.test(message)) return true;
+  const verb = /^a statement, found ([A-Z][A-Z-]*)$/.exec(message);
+  if (verb) return VERBS.has(verb[1]);
+  const name = /^([A-Z][A-Z0-9-]*) is not defined$/.exec(message);
+  return !!name && TRANSLATOR_NAMES.some((s) => s.has(name[1]));
+}
+// A copy library the tree does not hold leaves the program unread, as it does for the scan.
+const UNRESOLVED = /\bno such member in the copy libraries\b/i;
+// A diagnostic can quote a literal from the program, and no output of the gate carries source text.
+const redact = (s) => String(s).replace(/'[^']*'|"[^"]*"/g, "'…'");
+
+// `file:line:col: message` or `file: message`, as ironwork's Error::place writes them. `file` is the
+// program as it was passed, or the COPY member the position is in.
+function diagnostic(line, programPath, rel) {
+  const m = /^(.*?):(\d+):(\d+): (.*)$/.exec(line) || /^(.*?): (.*)$/.exec(line);
+  if (!m) return { path: rel, message: printable(redact(line), 200) };
+  const [file, ln, col, text] = m.length === 5 ? [m[1], Number(m[2]), Number(m[3]), m[4]] : [m[1], null, null, m[2]];
+  const inProgram = resolve(file) === programPath;
+  return {
+    path: rel, ...(ln ? { line: ln, col } : {}), ...(inProgram ? {} : { member: printable(file, 80) }),
+    message: printable(redact(text), 200),
+  };
+}
+
+export function ironworkVersion(path, { env = process.env } = {}) {
+  const r = spawnSync(path, ['--version'], { cwd: tmpdir(), env, encoding: 'utf8', timeout: 10000, windowsHide: true, stdio: ['ignore', 'pipe', 'ignore'] });
+  return r.status === 0 ? printable(String(r.stdout).trim(), 80) || null : null;
+}
+
+// Runs `ironwork check` on each program under `root`, with the tree's copy directories and the
+// estate's copy libraries as -I, and sorts the programs into those it accepts, those it rejects,
+// and those it could not decide: a construct it does not model, a copybook the tree lacks, or a
+// run that ended some other way.
+export function checkWithIronwork(path, root, { allow = null, copylibs = [], env = process.env } = {}) {
+  const programs = [...new Set(directoryTree(root).list())].filter((p) => isProgram(p) && (!allow || allow.has(p))).sort();
+  const libraries = [...buildFileIndex(root).copyDirs, ...copylibs].flatMap((d) => ['-I', d]);
+  const out = { programs: programs.length, accepted: 0, warned: 0, failed: [], notModelled: [], unresolved: [], unrun: [] };
+  for (const file of programs) {
+    const rel = relPath(root, file);
+    const r = spawnSync(path, ['check', file, ...libraries], {
+      cwd: tmpdir(), env, encoding: 'utf8', timeout: PER_PROGRAM_MS, maxBuffer: 1 << 20, windowsHide: true, stdio: ['ignore', 'ignore', 'pipe'],
+    });
+    if (COMPILED.has(r.status)) { out.accepted++; if (r.status === 4) out.warned++; continue; }
+    if (!REJECTED.has(r.status)) {
+      const why = r.error ? (r.error.code === 'ETIMEDOUT' ? `no answer in ${PER_PROGRAM_MS / 1000}s` : r.error.message) : `ironwork exited ${r.status ?? r.signal}`;
+      out.unrun.push({ path: rel, why: printable(why, 200) });
+      continue;
+    }
+    const found = String(r.stderr || '').split(/\r?\n/).filter((l) => l && !NOT_AN_ERROR.test(l)).map((l) => diagnostic(l, resolve(file), rel));
+    const errors = found.filter((d) => !notModelled(d.message) && !UNRESOLVED.test(d.message));
+    if (errors.length) out.failed.push({ ...errors[0], errors: errors.length });
+    else if (found.some((d) => UNRESOLVED.test(d.message))) out.unresolved.push(found.find((d) => UNRESOLVED.test(d.message)));
+    else out.notModelled.push(found[0] || { path: rel, message: `ironwork exited ${r.status} and gave no error` });
+  }
+  return out;
+}
+
+// The compile check from a checkWithIronwork result: false where a program does not compile, null
+// where every program that did not pass is one ironwork could not decide, true otherwise.
+export function ironworkVerdict(result) {
+  if (result.failed.length) return false;
+  return result.notModelled.length || result.unresolved.length || result.unrun.length ? null : true;
+}
+
+export function ironworkReasons(result) {
+  const reasons = [];
+  const at = (d) => `${d.path}${d.line ? `:${d.line}:${d.col}` : ''}${d.member ? ` (in ${d.member})` : ''}`;
+  if (result.failed.length) {
+    reasons.push(`ironwork check: ${result.failed.length} of ${result.programs} program(s) do not compile as Enterprise COBOL`);
+    for (const d of result.failed.slice(0, MAX_LISTED)) reasons.push(`${at(d)}: ${d.message}`);
+  }
+  if (result.notModelled.length) reasons.push(`ironwork check: ${result.notModelled.length} program(s) use what ironwork does not model yet, so whether they compile is not decided; the first is ${at(result.notModelled[0])}: ${result.notModelled[0].message}`);
+  if (result.unresolved.length) reasons.push(`ironwork check: ${result.unresolved.length} program(s) copy a member the copy libraries do not hold; name the estate's with --copylib`);
+  if (result.unrun.length) reasons.push(`ironwork check: ${result.unrun.length} program(s) were not checked; the first, ${result.unrun[0].path}: ${result.unrun[0].why}`);
+  return reasons;
+}
+
+export const listed = (result) => ({
+  programs: result.programs, accepted: result.accepted, warned: result.warned,
+  failed: result.failed.slice(0, MAX_LISTED), notModelled: result.notModelled.slice(0, MAX_LISTED),
+  unresolved: result.unresolved.slice(0, MAX_LISTED), unrun: result.unrun.slice(0, MAX_LISTED),
+  counts: { failed: result.failed.length, notModelled: result.notModelled.length, unresolved: result.unresolved.length, unrun: result.unrun.length },
+});

package/lib/kernel/findings.mjs

@@ -42,6 +42,17 @@ export const EVIDENCE = Object.freeze({
   context: 'describes the estate - an entry point, a product in use - and asserts no defect',
 });
 
+// Whether an attacker can use a path finding, most urgent first. lib/exploitability.mjs decides it.
+export const EXPLOITABILITY = Object.freeze({
+  confirmed: 'the estate reproduced it on a system it owns and brought the result as a witness feed',
+  exploitable: 'input an attacker supplies reaches the operation with no check on every route, and the estate declares an entry that carries it open to any user',
+  'attacker-driven': 'input whoever runs an entry supplies reaches the operation with no check on every route; the estate has not declared who may run that entry',
+  restricted: 'input reaches the operation with no check on every route, and every entry that carries it is behind a control the estate named',
+  mitigated: 'input reaches the operation, but a check runs first on every route, or SSRANGE turns an overrun into an abend',
+  upstream: 'the value comes from a file record or a database row, so whoever can write that data drives it',
+  refuted: 'no harmful value arrives: a check leaves only values the operation can take, or no route reaches it',
+});
+
 export const WHO_ACTS = Object.freeze({
   path: "the program's owner",
   construct: 'the owner, or whoever can rotate a credential',

package/lib/kernel/registry.mjs

@@ -25,6 +25,8 @@ import { scanWeb, WEB_RULES } from '../sets/web.mjs';
 import { scanPriv, PRIV_RULES } from '../sets/priv.mjs';
 import { scanLog, LOG_RULES } from '../sets/log.mjs';
 import { scanCompile, COMPILE_RULES } from '../sets/compile.mjs';
+import { scanSemantics, SEMANTICS_RULES } from '../sets/semantics.mjs';
+import { scanZowe, ZOWE_RULES } from '../sets/zowe.mjs';
 import { toolName } from './ruleset.mjs';
 
 // The order is the order a scan runs them and the order --only lists them. It is not significant
@@ -43,6 +45,8 @@ export const REGISTRY = [
   { name: 'compile', scan: scanCompile, rules: COMPILE_RULES },
   { name: 'priv', scan: scanPriv, rules: PRIV_RULES },
   { name: 'log', scan: scanLog, rules: LOG_RULES },
+  { name: 'semantics', scan: scanSemantics, rules: SEMANTICS_RULES },
+  { name: 'zowe', scan: scanZowe, rules: ZOWE_RULES },
 ];
 
 // Re-exported from the kernel's ruleset module, which is where it has to live: this file imports

package/lib/option-diff.mjs

@@ -0,0 +1,49 @@
+// SPDX-License-Identifier: AGPL-3.0-or-later
+// Which compiler options a change to a program's CBL and PROCESS cards changes, for the families
+// that change arithmetic, validation or collation without touching a statement
+// (docs/spec/evidence.md §13.4). Spellings come from IBM's option table (lib/enterprise-options.mjs).
+import { OPTION_SPELLINGS } from './enterprise-options.mjs';
+import { optionCards, optionTokens } from './options.mjs';
+
+export const WATCHED = ['TRUNC', 'ARITH', 'NUMPROC', 'NUMCHECK', 'SSRANGE', 'CODEPAGE', 'INTDATE'];
+const ARITH_SUBS = { C: 'COMPAT', COMPAT: 'COMPAT', E: 'EXTEND', EXTEND: 'EXTEND' };
+
+// One option token as `FAMILY(SUB,...)` or `NOFAMILY`, or null for a family not watched.
+function settingOf(token) {
+  const m = /^([A-Z0-9-]+)(?:\((.*)\))?$/.exec(token);
+  if (!m) return null;
+  const spelled = OPTION_SPELLINGS[m[1]];
+  if (!spelled || !WATCHED.includes(spelled[0])) return null;
+  const [family, off] = spelled;
+  if (off) return { family, value: `NO${family}` };
+  let subs = m[2] === undefined ? [] : optionTokens(m[2]);
+  if (family === 'ARITH') subs = subs.map((s) => ARITH_SUBS[s] || s);
+  if (family === 'NUMCHECK' || family === 'SSRANGE') subs = [...subs].sort();
+  return { family, value: subs.length ? `${family}(${subs.join(',')})` : family };
+}
+
+// The watched options a program's cards set, the later card winning, each with its line.
+export function optionsInForce(text) {
+  const state = new Map();
+  for (const card of optionCards(text)) {
+    for (const token of card.options) {
+      const s = settingOf(token);
+      if (s) state.set(s.family, { value: s.value, line: card.line });
+    }
+  }
+  return state;
+}
+
+export function optionChanges(baseText, headText) {
+  const before = optionsInForce(baseText);
+  const after = optionsInForce(headText);
+  const out = [];
+  for (const family of WATCHED) {
+    const b = before.get(family);
+    const a = after.get(family);
+    const base = b ? b.value : 'default';
+    const head = a ? a.value : 'default';
+    if (base !== head) out.push({ option: family, base, head, line: (a || b).line });
+  }
+  return out;
+}

package/lib/options.mjs

@@ -1,10 +1,11 @@
 // SPDX-License-Identifier: AGPL-3.0-or-later
 // Whether the options a program is compiled with generate the run-time checks a policy requires:
 // docs/spec/build-gate.md §7. Enterprise COBOL's options and what they mean are from IBM's
-// documentation; the GnuCOBOL flags are recorded in provenance/compiler-options.json with how each
-// was confirmed by compiling. Nothing here is taken from GnuCOBOL's source (spec §16).
+// documentation; the GnuCOBOL and gcobol flags are recorded in provenance/compiler-options.json with
+// how each was confirmed by compiling. Nothing here is taken from either compiler's source (spec §16).
 import { basename, posix } from 'node:path';
 import { PROGRAM_EXT } from './sources.mjs';
+import { OPTION_SPELLINGS } from './enterprise-options.mjs';
 
 // Split on blanks and commas outside parentheses: SSRANGE(NOZLEN,ABD) is one option.
 export function optionTokens(text) {
@@ -43,13 +44,10 @@ const parse = (token) => {
   return m ? { name: m[1], subs: m[2] === undefined ? [] : optionTokens(m[2]) } : { name: token, subs: [] };
 };
 
-// Each family's spellings. An abbreviation IBM does not document is not accepted, so an option the
-// gate cannot read counts as absent, which fails closed.
-const FAMILIES = {
-  SSRANGE: { on: ['SSRANGE', 'SSR'], off: ['NOSSRANGE', 'NOSSR'] },
-  NUMCHECK: { on: ['NUMCHECK'], off: ['NONUMCHECK'] },
-  PARMCHECK: { on: ['PARMCHECK', 'PC'], off: ['NOPARMCHECK', 'NOPC'] },
-};
+// Each family's spellings, as IBM's option table gives them. A spelling the table does not hold is
+// not accepted, so an option the gate cannot read counts as absent, which fails closed.
+const spellingsOf = (option, off) => Object.keys(OPTION_SPELLINGS).filter((s) => OPTION_SPELLINGS[s][0] === option && OPTION_SPELLINGS[s][1] === off);
+const FAMILIES = Object.fromEntries(['SSRANGE', 'NUMCHECK', 'PARMCHECK'].map((f) => [f, { on: spellingsOf(f, false), off: spellingsOf(f, true) }]));
 const FAMILY_OF_CHECK = { subscript: 'SSRANGE', 'reference-modification': 'SSRANGE', 'numeric-data': 'NUMCHECK', 'argument-length': 'PARMCHECK' };
 
 // Whether one family's setting abends on a failed check. A bare SSRANGE is SSRANGE(NOZLEN,ABD); a
@@ -121,7 +119,17 @@ const EXCEPTION_OF_CHECK = {
   'argument-length': 'EC-PROGRAM-ARG-MISMATCH',
 };
 
-export const isCobc = (command) => /^cobc(\.exe)?$/i.test(basename(String(command || '')));
+// gcobol 16 refuses to compile with these enabled ("sorry, unimplemented"), and EC-ALL does not
+// generate them.
+const GCOBOL_UNIMPLEMENTED = new Set(['EC-DATA-INCOMPATIBLE', 'EC-PROGRAM-ARG-MISMATCH']);
+
+// GnuCOBOL's cobc, or GCC's gcobol under its versioned or cross-compiler names.
+export function compilerOf(command) {
+  const name = basename(String(command || '')).replace(PREFIX, '');
+  if (/^cobc(\.exe)?$/i.test(name)) return 'gnucobol';
+  if (/^(?:[a-z0-9_]+-)*gcobol(?:-\d+(?:\.\d+)*)?(\.exe)?$/i.test(name)) return 'gcobol';
+  return null;
+}
 
 const exceptionName = (v) => {
   const u = String(v).toUpperCase();
@@ -251,17 +259,21 @@ const argsOf = (words) => {
   return out;
 };
 
-// The argument vector of each cobc command in one simple command. A command held in one word -
-// sh -c "…", an alias, a CMD's string - is read as a command line of its own.
-function cobcCommands(words, dialect, depth = 0) {
+// Text that may run cobc or gcobol.
+const NAMES_A_COMPILER = /cobc|gcobol/i;
+
+// The compiler and argument vector of each cobc or gcobol command in one simple command. A command
+// held in one word - sh -c "…", an alias, a CMD's string - is read as a command line of its own.
+function compilerCommands(words, dialect, depth = 0) {
   const at = leadOf(words);
   if (at < 0 || MESSAGE.test(words[at].replace(PREFIX, ''))) return [];
   for (let i = at; i < words.length; i++) {
     const w = words[i];
-    if (isCobc(w.replace(PREFIX, ''))) return [argsOf(words.slice(i + 1))];
+    const compiler = compilerOf(w);
+    if (compiler) return [{ compiler, args: argsOf(words.slice(i + 1)) }];
     const inner = w.replace(/^[A-Za-z_]\w*=/, '');
-    if (depth < 2 && /\s/.test(inner) && /cobc/i.test(inner)) {
-      const found = commandsOf(shellTokens(inner, dialect)).flatMap((ws) => cobcCommands(ws, dialect, depth + 1));
+    if (depth < 2 && /\s/.test(inner) && NAMES_A_COMPILER.test(inner)) {
+      const found = commandsOf(shellTokens(inner, dialect)).flatMap((ws) => compilerCommands(ws, dialect, depth + 1));
       if (found.length) return found;
     }
   }
@@ -272,15 +284,15 @@ function cobcCommands(words, dialect, depth = 0) {
 const changeDir = (dir, to) => (!to || /[$%~`]/.test(to) || /^(?:\/|[A-Za-z]:[\\/]|-$)/.test(to) ? null
   : posix.normalize(posix.join(dir || '.', to.replace(/\\/g, '/'))));
 
-// The cobc commands in a command line, each with the directory a cd before it on the line moved to.
-// `state.dir` carries a cd forward to later lines, for a script whose lines one shell runs.
+// The compiler commands in a command line, each with the directory a cd before it on the line moved
+// to. `state.dir` carries a cd forward to later lines, for a script whose lines one shell runs.
 function commandLine(text, dialect, state, line, out) {
   for (const words of commandsOf(Array.isArray(text) ? text.map((word) => ({ word })) : shellTokens(text, dialect))) {
     const at = leadOf(words);
     const lead = at >= 0 ? words[at].replace(PREFIX, '').toLowerCase() : '';
     if (lead === 'cd' || lead === 'pushd' || lead === 'set-location') { state.dir = changeDir(state.dir, words.slice(at + 1).find((w) => !/^-./.test(w))); continue; }
-    for (const args of cobcCommands(words, dialect)) {
-      if (cobcOperands(args).length) out.push({ line, args, ...(state.dir && state.dir !== '.' ? { dir: state.dir } : {}) });
+    for (const { compiler, args } of compilerCommands(words, dialect)) {
+      if (sourceOperands(args, compiler).length) out.push({ line, compiler, args, ...(state.dir && state.dir !== '.' ? { dir: state.dir } : {}) });
     }
   }
 }
@@ -328,11 +340,12 @@ function expanded(text, vars, kind) {
   return t;
 }
 
-// Every cobc command a build script runs that names a source file, with the variables the same file
-// assigns substituted: [{ line, args, dir? }]. `kind` is make, sh, yaml, docker, batch or powershell.
-// A command whose options come from a variable set elsewhere keeps the reference, which reads as no
-// option; one that names no source - cobc --version, which cobc - compiles nothing and is left out.
-export function cobcInvocations(text, { kind = 'sh' } = {}) {
+// Every cobc or gcobol command a build script runs that names a source file, with the variables the
+// same file assigns substituted: [{ line, compiler, args, dir? }]. `kind` is make, sh, yaml, docker,
+// batch or powershell. A command whose options come from a variable set elsewhere keeps the
+// reference, which reads as no option; one that names no source - cobc --version, which cobc -
+// compiles nothing and is left out.
+export function compilerInvocations(text, { kind = 'sh' } = {}) {
   const dialect = kind === 'batch' || kind === 'powershell' ? kind : 'sh';
   const vars = new Map();
   const continuation = { batch: /\^$/, powershell: /`$/ }[kind] || /\\$/;
@@ -403,11 +416,11 @@ function looseJson(text) {
   return JSON.parse(out.replace(/,(\s*[}\]])/g, '$1'));
 }
 
-// The cobc commands an editor's task file runs: VS Code's tasks.json. A task's command line is its
-// command and its arguments, read as its shell reads them, with the variants it gives for Windows,
-// Linux and macOS; it runs in the workspace folder, or in its options.cwd. ${workspaceFolder} is that
-// folder, and a variable that names the open file stands for any file.
-export function cobcTasks(text) {
+// The cobc and gcobol commands an editor's task file runs: VS Code's tasks.json. A task's command
+// line is its command and its arguments, read as its shell reads them, with the variants it gives for
+// Windows, Linux and macOS; it runs in the workspace folder, or in its options.cwd. ${workspaceFolder}
+// is that folder, and a variable that names the open file stands for any file.
+export function compilerTasks(text) {
   let doc;
   try { doc = looseJson(text); } catch { return []; }
   const lines = String(text).split(/\r?\n/);
@@ -428,7 +441,7 @@ export function cobcTasks(text) {
     for (const [variant, dialect] of [[task, 'sh'], [task.linux, 'sh'], [task.osx, 'sh'], [task.windows, 'powershell']]) {
       if (!variant || typeof variant !== 'object') continue;
       const command = valueOf(variant.command);
-      if (typeof command !== 'string' || !/cobc/i.test(`${command} ${JSON.stringify(variant.args || task.args || [])}`)) continue;
+      if (typeof command !== 'string' || !NAMES_A_COMPILER.test(`${command} ${JSON.stringify(variant.args || task.args || [])}`)) continue;
       const args = Array.isArray(variant.args) ? variant.args : Array.isArray(task.args) ? task.args : [];
       const cwd = (variant.options && variant.options.cwd) || (task.options && task.options.cwd);
       const dir = typeof cwd === 'string' ? changeDir(null, folder(cwd)) : null;
@@ -443,19 +456,25 @@ export function cobcTasks(text) {
 }
 
 // Options whose value is the next argument, which is not a source file: the output file, include and
-// library directories, a library, and options for the C compiler and the linker. Each was observed to
-// take the next argument (provenance/compiler-options.json).
-const TAKES_VALUE = new Set(['-o', '-I', '-L', '-l', '-A', '-Q', '-fec', '-fno-ec']);
+// library directories, a library, options for the C compiler and the linker, and for gcobol a CDF
+// name, a language, a dialect, a copybook extension and an included file. Each was observed to take
+// the next argument (provenance/compiler-options.json). gcobol's -main takes none: it marks the source
+// that follows it.
+const TAKES_VALUE = {
+  gnucobol: new Set(['-o', '-I', '-L', '-l', '-A', '-Q', '-fec', '-fno-ec']),
+  gcobol: new Set(['-o', '-I', '-L', '-l', '-D', '-x', '-dialect', '-copyext', '-include', '-fcobol-exceptions', '-fno-cobol-exceptions']),
+};
 const SOURCE_FILE = new RegExp(`(?:${PROGRAM_EXT.map((e) => e.replace('.', '\\.')).join('|')})$`, 'i');
 // A variable, a batch argument, a glob or find's {}: a file the command names only when it runs.
 const UNNAMED = /[$%*?!]|\{\}/;
 
-// The operands of a cobc command that name source files, as written.
-export function cobcOperands(args) {
+// The operands of a cobc or gcobol command that name source files, as written.
+export function sourceOperands(args, compiler = 'gnucobol') {
+  const takesValue = TAKES_VALUE[compiler];
   const out = [];
   for (let i = 0; i < args.length; i++) {
     const a = String(args[i]);
-    if (TAKES_VALUE.has(a)) { i++; continue; }
+    if (takesValue.has(a)) { i++; continue; }
     if (a.startsWith('-')) continue;
     if (SOURCE_FILE.test(a) || UNNAMED.test(a)) out.push(a);
   }
@@ -486,11 +505,6 @@ export function cobcChecks(args, { required, forbid = [] }) {
     if (value === undefined) continue;
     set(exceptionName(value), !m[1], shown);
   }
-  const forbidden = [];
-  for (const entry of forbid) {
-    const hit = args.find((a) => a === entry || String(a).startsWith(`${entry}=`));
-    if (hit) forbidden.push(`${hit} is on the command line, and the policy forbids it`);
-  }
   const add = [];
   const checks = required.map((check) => {
     if (state.get(check) === true) return { check, ok: true, why: 'turned on by the command line' };
@@ -499,14 +513,63 @@ export function cobcChecks(args, { required, forbid = [] }) {
     if (!add.includes(flag)) add.push(flag);
     return { check, ok: true, added: true, why: `added as ${flag}` };
   });
-  return { checks, forbidden, add };
+  return { checks, forbidden: forbiddenOn(args, forbid), add };
 }
 
+const forbiddenOn = (args, forbid) => forbid
+  .map((entry) => args.find((a) => a === entry || String(a).startsWith(`${entry}=`)))
+  .filter(Boolean).map((hit) => `${hit} is on the command line, and the policy forbids it`);
+
+// A gcobol argument vector, as cobcChecks reads cobc's. -fcobol-exceptions enables each condition it
+// lists; -fno-cobol-exceptions N withdraws the enabled conditions N covers, so after EC-BOUND it does
+// not withdraw EC-BOUND-SUBSCRIPT, and it never stops a later enable. A check whose condition gcobol
+// does not implement cannot be generated at all.
+export function gcobolChecks(args, { required, forbid = [] }) {
+  let enabled = [];
+  const turnedOff = new Map();
+  const listed = (v) => String(v).split(',').map((n) => n.trim().toUpperCase()).filter(Boolean);
+  for (let i = 0; i < args.length; i++) {
+    const a = String(args[i]);
+    const m = /^-f(no-)?cobol-exceptions(?:=(.*))?$/.exec(a);
+    if (!m) continue;
+    const value = m[2] !== undefined ? m[2] : args[++i];
+    if (value === undefined) continue;
+    const shown = m[2] !== undefined ? a : `${a} ${value}`;
+    for (const name of listed(value)) {
+      for (const check of required) {
+        if (!covers(name, EXCEPTION_OF_CHECK[check])) continue;
+        if (m[1]) turnedOff.set(check, shown); else turnedOff.delete(check);
+      }
+      enabled = m[1] ? enabled.filter((e) => !covers(name, e)) : [...enabled, name];
+    }
+  }
+  const add = [];
+  const checks = required.map((check) => {
+    const condition = EXCEPTION_OF_CHECK[check];
+    if (GCOBOL_UNIMPLEMENTED.has(condition)) return { check, ok: false, why: `${check} needs ${condition}, which gcobol does not implement` };
+    if (enabled.some((e) => covers(e, condition))) return { check, ok: true, why: 'turned on by the command line' };
+    if (turnedOff.has(check)) return { check, ok: false, why: `${turnedOff.get(check)} turns off the ${check} check` };
+    const flag = `-fcobol-exceptions=${condition}`;
+    add.push(flag);
+    return { check, ok: true, added: true, why: `added as ${flag}` };
+  });
+  return { checks, forbidden: forbiddenOn(args, forbid), add };
+}
+
+const CHECKS_OF = { gnucobol: cobcChecks, gcobol: gcobolChecks };
+const NOT_GIVEN = {
+  gnucobol: (check, c) => `${check} needs -fec=${c} or -debug, and the command gives neither`,
+  gcobol: (check, c) => `${check} needs -fcobol-exceptions=${c}, and the command does not give it`,
+};
+
+// The checks one compiler's argument vector generates: cobcChecks or gcobolChecks.
+export const compilerChecks = (compiler, args, opts) => CHECKS_OF[compiler](args, opts);
+
 // The same, for a command the gate reads rather than runs: a check nothing turned on is missing.
-export function scriptedCobcChecks(args, opts) {
-  const r = cobcChecks(args, opts);
+export function scriptedChecks(compiler, args, opts) {
+  const r = compilerChecks(compiler, args, opts);
   return {
-    checks: r.checks.map((c) => (c.added ? { check: c.check, ok: false, why: `${c.check} needs -fec=${EXCEPTION_OF_CHECK[c.check]} or -debug, and the command gives neither` } : c)),
+    checks: r.checks.map((c) => (c.added ? { check: c.check, ok: false, why: NOT_GIVEN[compiler](c.check, EXCEPTION_OF_CHECK[c.check]) } : c)),
     forbidden: r.forbidden,
   };
 }

package/lib/parser.mjs

@@ -1032,6 +1032,7 @@ function parseDataEntry(toks, section, file) {
       j++;
       continue;
     }
+    if (u === 'EXTERNAL') { item.external = true; j++; continue; }
     if (u === 'SEPARATE') { item.signSeparate = true; j++; continue; }
     if (u === 'SIGN' || u === 'LEADING' || u === 'TRAILING') { item.signExplicit = true; j++; continue; }
     if (u === 'SYNC' || u === 'SYNCHRONIZED') { item.sync = true; j++; continue; }
@@ -1638,6 +1639,20 @@ function identifierTokens(seg, from, to) {
   return out;
 }
 
+// The constant an index name is shifted by where it stands alone as `NAME + n` or `NAME - n`; 0 for a
+// bare name and for any longer expression, which is judged as the bare name.
+function offsetOf(seg, j, open, close, colonAt) {
+  const isNum = (t) => t && (t.t === 'word' || t.t === 'num') && /^\d+$/.test(t.v);
+  const op = seg[j + 1];
+  if (!op || op.t !== 'op' || (op.v !== '+' && op.v !== '-') || !isNum(seg[j + 2]) || j + 2 >= close) return 0;
+  const prev = seg[j - 1];
+  const starts = j - 1 === open || (j - 1 === colonAt) || (prev.t === 'word' && !['OF', 'IN', 'FUNCTION'].includes(prev.u));
+  const after = seg[j + 3];
+  const ends = j + 3 === close || j + 3 === colonAt || (after && after.t === 'word' && !['OF', 'IN'].includes(after.u));
+  if (!starts || !ends) return 0;
+  return op.v === '-' ? -Number(seg[j + 2].v) : Number(seg[j + 2].v);
+}
+
 // What a statement indexes with. identifierTokens leaves subscripts out, because a subscript is not
 // the data a statement moves; a rule about where a statement reads or writes needs exactly them.
 // For each parenthesised group after a data name - reached back over OF and IN, so ELEM OF TAB (I)
@@ -1671,7 +1686,7 @@ function indexTokens(seg) {
         if (t.t !== 'word' || /^\d+$/.test(t.v)) continue;
         const prev = seg[j - 1];
         if (prev && prev.t === 'word' && (prev.u === 'OF' || prev.u === 'IN' || prev.u === 'FUNCTION')) continue;
-        out.push({ host, tok: t, kind: colonAt < 0 ? 'subscript' : j < colonAt ? 'refmod-offset' : 'refmod-length' });
+        out.push({ host, tok: t, kind: colonAt < 0 ? 'subscript' : j < colonAt ? 'refmod-offset' : 'refmod-length', offset: offsetOf(seg, j, k, close, colonAt) });
       }
     }
     lastHost = host;
@@ -1700,22 +1715,29 @@ function untilTokens(seg) {
 // AFTER J ... UNTIL c after it. A bare PERFORM UNTIL has a condition and no counter.
 function loopsOf(seg) {
   const out = [];
-  let depth = 0, cur = null, inUntil = false;
+  let depth = 0, cur = null, inUntil = false, into = null;
   for (let k = 0; k < seg.length; k++) {
     const x = seg[k];
-    if (x.t === 'sep') { depth += x.v === '(' ? 1 : -1; if (inUntil && cur) cur.until.push(x); continue; }
-    if (depth === 0 && x.t === 'word' && (x.u === 'VARYING' || x.u === 'AFTER')) {
-      cur = { counter: seg[k + 1] && seg[k + 1].t === 'word' ? seg[k + 1] : null, until: [] };
+    if (x.t === 'sep') { depth += x.v === '(' ? 1 : -1; if (inUntil && cur) cur.until.push(x); else if (into) into.push(x); continue; }
+    if (depth === 0 && x.t === 'word' && (x.u === 'VARYING' || (x.u === 'AFTER' && !(k && seg[k - 1].u === 'TEST')))) {
+      cur = { counter: seg[k + 1] && seg[k + 1].t === 'word' ? seg[k + 1] : null, from: [], by: null, until: [] };
       out.push(cur);
       inUntil = false;
+      into = null;
+      continue;
+    }
+    if (depth === 0 && !inUntil && cur && x.t === 'word' && (x.u === 'FROM' || x.u === 'BY')) {
+      into = x.u === 'FROM' ? cur.from : (cur.by = []);
       continue;
     }
     if (depth === 0 && x.t === 'word' && x.u === 'UNTIL') {
-      if (!cur) { cur = { counter: null, until: [] }; out.push(cur); }
+      if (!cur) { cur = { counter: null, from: [], by: null, until: [] }; out.push(cur); }
       inUntil = true;
+      into = null;
       continue;
     }
     if (inUntil && cur) cur.until.push(x);
+    else if (into && k > 0) into.push(x);
   }
   return out.filter((l) => l.until.length);
 }
@@ -1741,7 +1763,7 @@ function markReceiving(verb, seg, set) {
     case 'READ': case 'RETURN': { const k = at(['INTO']); if (k >= 0) mark(k + 1, k + 2); break; }
     case 'WRITE': case 'REWRITE': case 'RELEASE': { if (at(['FROM']) >= 0) mark(0, 1); break; }
     case 'CALL': { const k = at(['RETURNING', 'GIVING']); if (k >= 0) mark(k + 1, k + 2); break; }
-    case 'PERFORM': { const v = at(['VARYING']); if (v >= 0) mark(v + 1, v + 2); break; }
+    case 'PERFORM': { for (let k = 0; k < seg.length; k++) if (seg[k].t === 'word' && (seg[k].u === 'VARYING' || (seg[k].u === 'AFTER' && !(k && seg[k - 1].u === 'TEST')))) mark(k + 1, k + 2); break; }
     case 'SEARCH': { const v = at(['VARYING']); if (v >= 0) mark(v + 1, v + 2); break; }
     default: break;
   }

package/lib/policy.mjs

@@ -12,7 +12,7 @@ import { CLASSES, TIERS, TIER_RANK } from './consequence.mjs';
 
 export const POLICY_FILE = 'cobolwork.policy.json';
 export const CHECKS = ['subscript', 'reference-modification', 'numeric-data', 'argument-length'];
-export const COMPILERS = ['enterprise', 'gnucobol'];
+export const COMPILERS = ['enterprise', 'gnucobol', 'gcobol'];
 
 export const DEFAULT_POLICY = Object.freeze({
   policyVersion: 1,
@@ -24,9 +24,12 @@ export const DEFAULT_POLICY = Object.freeze({
   options: 'warn',
   waivers: { maxDays: 180 },
   checks: ['subscript', 'reference-modification'],
-  forbid: { enterprise: [], gnucobol: [] },
+  forbid: { enterprise: [], gnucobol: [], gcobol: [] },
+  requireEquivalence: 'never',
 });
 
+export const EQUIVALENCE_MODES = ['never', 'machineAuthored', 'always'];
+
 const KEYS = Object.keys(DEFAULT_POLICY);
 const isObject = (v) => v !== null && typeof v === 'object' && !Array.isArray(v);
 const isStrings = (v) => Array.isArray(v) && v.every((x) => typeof x === 'string' && x.trim() !== '');
@@ -60,8 +63,9 @@ export function validatePolicy(raw) {
     if (!isStrings(raw.checks)) errs.push(`checks must be a list drawn from ${CHECKS.join(', ')}`);
     else for (const c of raw.checks) if (!CHECKS.includes(c)) errs.push(`checks: ${printable(c, 40)} is not one of ${CHECKS.join(', ')}`);
   }
+  if ('requireEquivalence' in raw && !EQUIVALENCE_MODES.includes(raw.requireEquivalence)) errs.push(`requireEquivalence takes ${EQUIVALENCE_MODES.join(', ')}`);
   if ('forbid' in raw) {
-    if (!isObject(raw.forbid)) errs.push(`forbid must be an object keyed by ${COMPILERS.join(' or ')}`);
+    if (!isObject(raw.forbid)) errs.push(`forbid must be an object keyed by ${COMPILERS.join(', ')}`);
     else for (const [c, list] of Object.entries(raw.forbid)) {
       if (!COMPILERS.includes(c)) errs.push(`forbid: ${printable(c, 40)} is not one of ${COMPILERS.join(', ')}`);
       else if (!isStrings(list)) errs.push(`forbid.${c} must be a list of options`);
@@ -137,6 +141,7 @@ export function combinePolicies({ floor = null, repository = null } = {}) {
     waivers: pick('waivers', (a, b) => ({ maxDays: Math.min(a.maxDays, b.maxDays) })),
     checks: checks.value,
     forbid: Object.fromEntries(COMPILERS.map((c) => [c, union((f.forbid || {})[c] || [], (r.forbid || {})[c] || [])])),
+    requireEquivalence: pick('requireEquivalence', (a, b) => (EQUIVALENCE_MODES.indexOf(a) >= EQUIVALENCE_MODES.indexOf(b) ? a : b)),
     rules: {},
   };
   setBy.checks = checks.by;

package/lib/precompile.mjs

@@ -182,6 +182,10 @@ function callRoles(toks, read, write) {
   }
 }
 
+export function hostVariableRoles(sql) {
+  return roles(tokenize(sql));
+}
+
 // The WHENEVER tests after each executable statement, from Db2's definitions of the conditions. IBM
 // does not document which wins when two hold at once, so the order is fixed, not the source's.
 const WHENEVER_TEST = {