@portll/cobolwork 0.2.76 → 0.2.140

package/lib/parser.mjs

@@ -9,6 +9,8 @@ import {
 } from './words.mjs';
 import { CICS_COMMANDS, CICS_EVERY_COMMAND } from './cics-commands.mjs';
 import { cicsCommand } from './precompile-cics.mjs';
+import { BINARY_SIZE, literalBytes, computeSizes, layoutReport } from './layout.mjs';
+import { hostVariablesIn } from './embedded-sql.mjs';
 import { join, dirname, basename, resolve, isAbsolute, sep, delimiter } from 'node:path';
 
 const FIXED_INDICATORS = new Set([' ', '*', '/', '-', 'D', 'd', '$']);
@@ -24,7 +26,6 @@ const MAX_REPLACED_CHARS = 16000000;
 // an absent ATTRIBUTES.cpy as a system copybook, which made an incomplete tree read as covered.
 const SYSTEM_COPY = /^(?:(?:DFH|DSN|CEE|IGZ|EZA|BPX|CSQ|CMQ|DLI)[A-Z0-9$#@]{0,5}|SQLCA|SQLDA|ATTRIB)$/i;
 const EXEC_KINDS = new Set(['SQL', 'CICS', 'DLI', 'SQLIMS', 'ADO', 'HTML', 'ORACLE', 'TP', 'IDMS', 'XML']);
-const BINARY_SIZE = { default: '1-2-4-8', ibm: '2-4-8', mf: '1--8' };
 
 export const VERBS = new Set(`ACCEPT ADD ALLOCATE ALTER CALL CANCEL CLOSE COMMIT COMPUTE CONTINUE DELETE DISABLE DISPLAY DIVIDE
 ENABLE ENTRY EVALUATE EXHIBIT EXIT FREE GENERATE GO GOBACK IF INITIALIZE INITIALISE INITIATE INSPECT INVOKE JSON MERGE MOVE MULTIPLY
@@ -58,7 +59,7 @@ export function expandTabs(line, width = 8) {
 }
 
 export function detectFormat(src) {
-  let nonblank = 0, badIndicator = 0, fixedMarkers = 0, starCol1Bad = 0, codeCol2to7 = 0, seqDigits = 0;
+  let nonblank = 0, badIndicator = 0, fixedMarkers = 0, starCol1Bad = 0, codeCol2to7 = 0, seqDigits = 0, columnSevenComments = 0;
   for (const raw of src.split(/\r?\n/, 600)) {
     const l = expandTabs(raw);
     if (!l.trim()) continue;
@@ -69,17 +70,20 @@ export function detectFormat(src) {
     if (/^(IDENTIFICATION|ID|PROCEDURE|DATA|ENVIRONMENT)\s+DIVISION/i.test(l) || /^(WORKING-STORAGE|LINKAGE|FILE|LOCAL-STORAGE)\s+SECTION/i.test(l)) return 'free';
     if (l.length >= 7 && !FIXED_INDICATORS.has(l[6])) badIndicator++;
     if (/^\d{6}/.test(l) || /^.{6}[*\/]/.test(l)) fixedMarkers++;
+    if (/^[ \d]{6}[*\/](?!>)/.test(l)) columnSevenComments++;
   }
   if (!nonblank) return 'fixed';
   if (starCol1Bad > 0 && codeCol2to7 > 0 && seqDigits === 0) return 'terminal';
   if (badIndicator / nonblank > 0.1 && badIndicator > fixedMarkers) return 'free';
-  return seqDigits === 0 && codePastColumn72(src) ? 'free' : 'fixed';
+  // Code past 72 in a program that keeps column 7 for its comments is variable format: fixed columns, long lines.
+  if (seqDigits === 0 && codePastColumn72(src)) return columnSevenComments > 0 ? 'variable' : 'free';
+  return 'fixed';
 }
 
 // Code a fixed-form reading would cut off at column 72, in a program written for -free: a literal
 // still open there that the next line does not continue, a token running across the boundary, or a
 // line past 80 whose code does not end its sentence by 72. An inline comment, a comment entry and a
-// lone tag of up to eight characters are what fixed-form programs keep there. Of the 54,487 programs
+// lone tag of up to eight characters whose parentheses balance are what fixed-form programs keep there. Of the 54,487 programs
 // cobc compiled in a 3,184-repository corpus, 54,154 are then read in a format cobc accepts.
 function codePastColumn72(src) {
   const lines = src.split(/\r?\n/, 2001);
@@ -89,7 +93,9 @@ function codePastColumn72(src) {
     const { quote, comment } = stateAtColumn72(l);
     if (comment) continue;
     if (quote && expandTabs(lines[i + 1] || '')[6] !== '-') return true;
-    const tag = /^\S{1,8}$/.test(l.slice(72).trim());
+    const tail = l.slice(72).trim();
+    // A tail closing a parenthesis it did not open finishes code cut at 72, as in `...LENGTH(WS-IDX)`.
+    const tag = /^\S{1,8}$/.test(tail) && balanced(tail);
     if (/\S/.test(l[71]) && /\S/.test(l[72]) && !tag) return true;
     const code = l.slice(7, 72).trim();
     if (l.length > 80 && !tag && code && !code.endsWith('.')) return true;
@@ -97,6 +103,15 @@ function codePastColumn72(src) {
   return false;
 }
 
+function balanced(s) {
+  let depth = 0;
+  for (const c of s) {
+    if (c === '(') depth++;
+    else if (c === ')' && --depth < 0) return false;
+  }
+  return depth === 0;
+}
+
 function stateAtColumn72(l) {
   let quote = null;
   for (let i = 7; i < 72 && i < l.length; i++) {
@@ -857,78 +872,6 @@ function stripDirecting(tokens) {
   return out;
 }
 
-function picInfo(pic, constants) {
-  const info = { digits: 0, display: 0, signed: false, alphanumeric: false, national: false };
-  const re = /(.)\(([A-Za-z0-9_-]+)\)|(.)/g;
-  let m;
-  while ((m = re.exec(pic))) {
-    const ch = (m[1] || m[3]).toUpperCase();
-    let n = 1;
-    if (m[1]) {
-      const raw = m[2];
-      n = /^\d+$/.test(raw) ? Number(raw) : Number(constants && constants.get(raw.toUpperCase()));
-      if (!Number.isFinite(n) || n < 0) n = 0;
-    }
-    if (ch === 'S') { info.signed = true; continue; }
-    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; }
-    if (ch === 'X' || ch === 'A') info.alphanumeric = true;
-    info.display += n;
-  }
-  return info;
-}
-
-// Storage bytes of a literal: hexadecimal literals hold one byte per two digits, a Z literal adds a
-// terminating null, a national literal holds two bytes per character.
-function literalBytes(tok) {
-  const prefix = tok.prefix || '';
-  if (prefix === 'X' || prefix === 'BX' || prefix === 'NX') return Math.floor(tok.v.length / (prefix === 'NX' ? 4 : 2)) * (prefix === 'NX' ? 2 : 1);
-  if (prefix === 'Z') return tok.v.length + 1;
-  if (prefix === 'N' || prefix === 'NC' || prefix === 'U') return tok.v.length * 2;
-  return tok.v.length;
-}
-
-function binaryBytes(digits, scheme) {
-  if (scheme === '2-4-8') return digits <= 4 ? 2 : digits <= 9 ? 4 : 8;
-  if (scheme === '1--8') return [1, 1, 1, 2, 2, 3, 3, 4, 4, 4, 5, 5, 6, 6, 6, 7, 7, 8, 8][Math.min(digits, 18)] || 8;
-  return digits <= 2 ? 1 : digits <= 4 ? 2 : digits <= 9 ? 4 : 8;
-}
-
-function elementarySize(item, scheme, constants) {
-  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);
-    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;
-  }
-  if (item.section === 'SCREEN' && !item.picture) return 1;
-  const usage = item.effectiveUsage || 'DISPLAY';
-  const p = item.picture ? picInfo(item.picture, constants) : null;
-  const digits = p ? p.digits : 0;
-  const u = usage.replace('COMPUTATIONAL', 'COMP');
-  if (u === 'COMP-1' || u === 'FLOAT-SHORT') return 4;
-  if (u === 'COMP-2' || u === 'FLOAT-LONG' || u === 'FLOAT-DECIMAL-16') return 8;
-  if (u === 'FLOAT-DECIMAL-34') return 16;
-  if (u === 'INDEX') return 4;
-  if (u === 'POINTER' || u === 'PROGRAM-POINTER' || u === 'FUNCTION-POINTER' || u === 'PROCEDURE-POINTER') return 8;
-  if (u === 'BINARY-CHAR') return 1;
-  if (u === 'BINARY-SHORT' || u === 'SIGNED-SHORT' || u === 'UNSIGNED-SHORT') return 2;
-  if (u === 'BINARY-LONG' || u === 'BINARY-INT' || u === 'SIGNED-INT' || u === 'UNSIGNED-INT') return 4;
-  if (u === 'BINARY-DOUBLE' || u === 'BINARY-LONG-LONG' || u === 'BINARY-C-LONG' || u === 'SIGNED-LONG' || u === 'UNSIGNED-LONG') return 8;
-  if (u === 'COMP-3' || u === 'PACKED-DECIMAL') return Math.floor(digits / 2) + 1;
-  if (u === 'COMP-6') return Math.ceil(digits / 2);
-  if (u === 'COMP-X' || u === 'COMP-N' || (u === 'COMP-5' && p && p.alphanumeric)) {
-    if (p && p.alphanumeric) return p.display;
-    return Math.max(1, Math.ceil((digits * Math.log(10)) / Math.log(256)));
-  }
-  if (u === 'COMP' || u === 'COMP-4' || u === 'COMP-5' || u === 'BINARY') return binaryBytes(digits, scheme);
-  let len = p ? p.display : 0;
-  if (item.signSeparate && p && p.signed) len++;
-  return len;
-}
-
 function parseDataEntry(toks, section, file) {
   const levelTok = toks[0];
   const level = Number(levelTok.v);
@@ -1032,6 +975,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; }
@@ -1095,120 +1039,6 @@ function applyTypes(items) {
   return added;
 }
 
-// SYNCHRONIZED aligns a binary, floating-point, pointer or index item to its own length; packed,
-// COMP-X and display items are not moved.
-const ALIGNED_USAGE = /^(COMP|COMP-[1245]|BINARY(-[A-Z-]+)?|FLOAT-[A-Z0-9-]+|(PROGRAM-|FUNCTION-|PROCEDURE-)?POINTER|INDEX|(UN)?SIGNED-[A-Z]+)$/;
-
-function computeSizes(roots, scheme, constants) {
-  // `at` is where the item starts, counted from the start of its record, because the compiler aligns
-  // a SYNCHRONIZED item against the record and puts the slack inside the group that holds it. A
-  // table's entry is laid out from its own start and rounded up to its widest alignment, so every
-  // occurrence aligns alike.
-  const visit = (item, inheritedUsage, inheritedSignSeparate, at) => {
-    item.effectiveUsage = item.usage || inheritedUsage || null;
-    if (inheritedSignSeparate && !item.signExplicit) item.signSeparate = true;
-    const structural = item.children.filter(c => c.level !== 88 && c.level !== 66 && c.level !== 78);
-    if (!structural.length) {
-      const one = elementarySize(item, scheme, constants);
-      item.contributes = one * item.occurs;
-      // The listing prints the whole table only for POINTER and INDEX; every other usage prints one occurrence.
-      const wholeTable = /^(POINTER|INDEX)$/.test(item.effectiveUsage || '');
-      item.size = wholeTable ? item.contributes : one;
-      const usage = (item.effectiveUsage || '').replace('COMPUTATIONAL', 'COMP');
-      item.align = item.sync && ALIGNED_USAGE.test(usage) ? Math.min(one, 8) : 1;
-      item.maxAlign = item.align;
-      return;
-    }
-    const base = item.occurs > 1 ? 0 : at;
-    let offset = 0;
-    let end = 0;
-    let maxAlign = 1;
-    const startOf = new Map();
-    for (const c of structural) {
-      if (c.redefines) {
-        // REDEFINES names a SIBLING. Resolving it by name across the whole program reached the
-        // first item of that name anywhere, which crossed records.
-        const known = startOf.has(c.redefines);
-        visit(c, item.effectiveUsage, item.signSeparate, base + (known ? startOf.get(c.redefines) : offset));
-        const start = known ? startOf.get(c.redefines) : offset - c.contributes;
-        startOf.set(c.name, start);
-        c.localStart = start;
-        end = Math.max(end, start + c.contributes);
-        // A REDEFINES larger than the item it redefines pushes the next sibling past its end.
-        offset = Math.max(offset, start + c.contributes);
-        maxAlign = Math.max(maxAlign, c.maxAlign);
-        continue;
-      }
-      visit(c, item.effectiveUsage, item.signSeparate, base + offset);
-      const skew = (base + offset) % c.align;
-      if (c.align > 1 && skew) offset += c.align - skew;
-      startOf.set(c.name, offset);
-      c.localStart = offset;
-      offset += c.contributes;
-      end = Math.max(end, offset);
-      maxAlign = Math.max(maxAlign, c.maxAlign);
-    }
-    if (item.occurs > 1 && end % maxAlign) end += maxAlign - (end % maxAlign);
-    item.size = end * item.occurs;
-    item.contributes = item.size;
-    item.align = 1;
-    item.maxAlign = maxAlign;
-  };
-  for (const r of roots) visit(r, null, false, 0);
-  // Offsets are assigned after sizing: a child's absolute start depends on its parent's, which is
-  // only known once the parent's own siblings have been laid out.
-  const place = (item, at) => {
-    item.offset = at;
-    for (const c of item.children) if (c.localStart != null) place(c, at + c.localStart);
-  };
-  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.
-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) => {
-    let last = 0;
-    let right = 0;
-    let total = 0;
-    const place = (c) => {
-      const len = c.contributes || c.size || 0;
-      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);
-  }
-  for (const g of rd.groups) { g.size = width; g.contributes = width; }
-  rd.width = width;
-}
-
 const ENV_PARAGRAPHS = new Set(['CONFIGURATION', 'SOURCE-COMPUTER', 'OBJECT-COMPUTER', 'SPECIAL-NAMES', 'REPOSITORY', 'INPUT-OUTPUT', 'FILE-CONTROL', 'I-O-CONTROL']);
 
 const SECTION_NAMES = { 'WORKING-STORAGE': 'WORKING-STORAGE', 'LOCAL-STORAGE': 'LOCAL-STORAGE', LINKAGE: 'LINKAGE', FILE: 'FILE', SCREEN: 'SCREEN', REPORT: 'REPORT', COMMUNICATION: 'COMMUNICATION' };
@@ -1638,6 +1468,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)
@@ -1665,13 +1509,19 @@ function indexTokens(seg) {
       if (depth === 1 && t.t === 'op' && t.v === ':' && colonAt < 0) colonAt = j;
     }
     if (host) {
+      // A constant on the other side of the colon: X(I:3) ends 2 past I, and X(5:N) starts at 5.
+      const lone = (from, to) => (to - from === 1 && (seg[from].t === 'word' || seg[from].t === 'num') && /^\d+$/.test(seg[from].v) ? Number(seg[from].v) : null);
+      const refLength = colonAt < 0 ? null : lone(colonAt + 1, close);
+      const refStart = colonAt < 0 ? null : lone(k + 1, colonAt);
       for (let j = k + 1; j < close; j++) {
         const t = seg[j];
         // A number is tokenized as a word, and no name is all digits.
         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' });
+        const kind = colonAt < 0 ? 'subscript' : j < colonAt ? 'refmod-offset' : 'refmod-length';
+        const other = kind === 'refmod-offset' ? refLength : kind === 'refmod-length' ? refStart : null;
+        out.push({ host, tok: t, kind, offset: offsetOf(seg, j, k, close, colonAt), ...(other ? { span: other } : {}) });
       }
     }
     lastHost = host;
@@ -1700,22 +1550,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);
 }
@@ -1736,12 +1593,35 @@ function markReceiving(verb, seg, set) {
     case 'SET': { const k = stopAt(0, ['TO', 'UP', 'DOWN']); mark(0, k); break; }
     case 'INITIALISE': case 'INITIALIZE': { mark(0, stopAt(0, ['REPLACING', 'WITH', 'ALL', 'TO', 'THEN', 'DEFAULT', 'FILLER', 'ALPHANUMERIC', 'NUMERIC', 'VALUE'])); break; }
     case 'STRING': { const k = at(['INTO']); if (k >= 0) mark(k + 1, stopAt(k + 1, tail)); const p = at(['POINTER']); if (p >= 0) mark(p + 1, p + 2); break; }
-    case 'UNSTRING': { const k = at(['INTO']); if (k >= 0) mark(k + 1, stopAt(k + 1, ['DELIMITER', 'COUNT', 'WITH', 'TALLYING', 'ON', 'NOT', 'POINTER'])); for (const w of ['POINTER']) { const p = at([w]); if (p >= 0) mark(p + 1, p + 2); } break; }
+    case 'UNSTRING': {
+      // Every receiver is written, and so is each field a DELIMITER IN or COUNT IN phrase names.
+      const k = at(['INTO']);
+      if (k >= 0) {
+        const end = stopAt(k + 1, ['WITH', 'POINTER', 'TALLYING', 'ON', 'NOT']);
+        // The field after DELIMITER IN or COUNT IN starts its own run, which identifierTokens would read as a qualifier.
+        const own = (j) => { const t = seg[j]; if (t && t.t === 'word') set.set(t, verb); };
+        let from = k + 1;
+        let phrase = false;
+        for (let j = k + 1, depth = 0; j <= end; j++) {
+          const t = seg[j];
+          if (t && t.t === 'sep') { depth += t.v === '(' ? 1 : t.v === ')' ? -1 : 0; continue; }
+          if (j < end && (depth || t.t !== 'word' || (t.u !== 'DELIMITER' && t.u !== 'COUNT'))) continue;
+          if (j > from) { if (phrase) { own(from); if (j > from + 1) mark(from + 1, j); } else mark(from, j); }
+          from = j + 1 + (seg[j + 1] && seg[j + 1].t === 'word' && seg[j + 1].u === 'IN' ? 1 : 0);
+          phrase = true;
+        }
+      }
+      const p = at(['POINTER']);
+      if (p >= 0) mark(p + 1, p + 2);
+      const tl = at(['TALLYING']);
+      if (tl >= 0) { const t = seg[tl + 1] && seg[tl + 1].t === 'word' && seg[tl + 1].u === 'IN' ? seg[tl + 2] : seg[tl + 1]; if (t && t.t === 'word') set.set(t, verb); }
+      break;
+    }
     case 'INSPECT': { if (at(['REPLACING', 'CONVERTING']) >= 0) mark(0, 1); const tl = at(['TALLYING']); if (tl >= 0) mark(tl + 1, tl + 2); break; }
     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;
   }
@@ -1880,20 +1760,11 @@ const NOT_A_NAME_AFTER = new Set(['OF', 'IN', 'FUNCTION', 'DFHRESP', 'DFHVALUE']
 // by A, and the variables of a SELECT or FETCH INTO list, up to FROM, are written. An INSERT's INTO
 // names a table. The block keeps them, each by the token that resolves to its item.
 function hostVariableRefs(exec, refs, receiving) {
-  const toks = exec.toks;
-  const into = ['SELECT', 'FETCH'].includes(toks[0]?.u) ? toks.findIndex((x) => x.t === 'word' && x.u === 'INTO') : -1;
-  const fromAt = into < 0 ? -1 : toks.findIndex((x, k) => k > into && x.t === 'word' && x.u === 'FROM');
-  const intoEnd = fromAt < 0 ? toks.length : fromAt;
   exec.hostVariables = [];
-  for (let k = 0; k + 1 < toks.length; k++) {
-    if (!(toks[k].t === 'op' && toks[k].v === ':' && toks[k + 1].t === 'word')) continue;
-    const path = [toks[k + 1]];
-    for (let j = k + 2; j + 1 < toks.length && toks[j].t === 'period' && toks[j].joined && toks[j + 1].t === 'word'; j += 2) path.push(toks[j + 1]);
-    const name = path[path.length - 1];
+  for (const { path, tok: name, written } of hostVariablesIn(exec.toks)) {
     name.verb = 'EXEC SQL';
     refs.push({ tok: name, zone: 'sql' });
     for (let q = path.length - 2; q >= 0; q--) refs.push({ tok: { t: 'word', u: 'OF', line: name.line, file: name.file }, zone: 'sql' }, { tok: path[q], zone: 'sql' });
-    const written = into >= 0 && k > into && k < intoEnd;
     if (written) receiving.set(name, 'EXEC SQL');
     exec.hostVariables.push({ tok: name, written });
   }

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

@@ -7,6 +7,7 @@
 // name routines nothing implements: the goal is a program that compiles.
 import { detectFormat, expandTabs } from './parser.mjs';
 import { EIB_LAYOUT } from './words.mjs';
+import { sqlTokens, sqlRoles } from './embedded-sql.mjs';
 import { builtinValue, translateCics, eibCopybook, CONSTANT_COPYBOOKS, constantsCopybook, symbolicMapCopybook } from './precompile-cics.mjs';
 
 const isFree = (format) => format === 'free' || format === 'terminal';
@@ -84,20 +85,6 @@ function findBlocks(lines, format) {
   return { blocks, builtins };
 }
 
-// The words, host variables and literals of a statement. A host variable is :NAME, qualified as
-// :GROUP.NAME, and may carry an indicator variable, :NAME:IND or :NAME INDICATOR :IND.
-function tokenize(sql) {
-  const toks = [];
-  const re = /'(?:[^']|'')*'|"(?:[^"]|"")*"|:\s*[A-Z0-9_$#@-]+(?:\.[A-Z0-9_$#@-]+)*|[A-Z0-9_$#@-]+|[(),=<>+*/;.]/gi;
-  for (const m of sql.matchAll(re)) {
-    const t = m[0];
-    if (t.startsWith(':')) toks.push({ host: t.slice(1).trim().toUpperCase() });
-    else if (/^['"]/.test(t)) toks.push({ lit: t });
-    else toks.push({ word: t.toUpperCase() });
-  }
-  return toks;
-}
-
 // How many subscripts a host variable needs: one for each OCCURS on it or on a group holding it.
 function subscriptCounter(items = []) {
   const byName = new Map();
@@ -116,72 +103,6 @@ function subscriptCounter(items = []) {
 // where the array starts.
 const cobolName = (host, subscripts = 0) => host.split('.').reverse().join(' OF ') + (subscripts ? ` (${Array(subscripts).fill(1).join(' ')})` : '');
 
-// Clauses that end an INTO list.
-const AFTER_INTO = new Set(['FROM', 'WHERE', 'GROUP', 'HAVING', 'ORDER', 'FETCH', 'FOR', 'WITH', 'OPTIMIZE', 'QUERYNO', 'SKIP', 'UNION', 'USING', 'VALUES']);
-
-// Which host variables a statement reads and which it writes, as Db2's SQL reference gives them. A
-// variable both read and written is in both lists. INTO a host variable writes it (INSERT INTO and
-// MERGE INTO name a table); so do SET's targets, GET DIAGNOSTICS' and ASSOCIATE LOCATORS' list. A
-// procedure's argument that is a lone variable may be IN, OUT or INOUT, which only the server knows.
-function roles(toks) {
-  const sending = [];
-  const receiving = [];
-  const read = (h) => { if (!sending.includes(h)) sending.push(h); };
-  const write = (h) => { if (!receiving.includes(h)) receiving.push(h); };
-  const verb = toks.find((t) => t.word)?.word;
-  if (verb === 'CALL') return callRoles(toks, read, write), { sending, receiving };
-  // DESCRIBE and PREPARE read the SQLDA's SQLN and write the rest of it.
-  const intoBoth = verb === 'DESCRIBE' || verb === 'PREPARE';
-  let into = false;
-  let assigning = verb === 'SET';
-  let depth = 0;
-  for (let i = 0; i < toks.length; i++) {
-    const t = toks[i];
-    const next = toks[i + 1];
-    if (t.word === '(') depth++;
-    else if (t.word === ')') depth--;
-    else if (verb === 'SET' && t.word === '=' && depth === 0) assigning = false;
-    else if (verb === 'SET' && t.word === ',' && depth === 0) assigning = true;
-    if (t.word === 'INTO' && next && (next.host || next.word === 'DESCRIPTOR')) { into = true; continue; }
-    if (into && t.word && AFTER_INTO.has(t.word)) into = false;
-    if (t.word === 'DESCRIPTOR' && next?.host) {
-      // FETCH ... INTO DESCRIPTOR and USING DESCRIPTOR are synonyms: the program fills the SQLDA and Db2 writes where it points.
-      if (verb === 'FETCH' || intoBoth) { read(next.host); write(next.host); } else read(next.host);
-      i++;
-      continue;
-    }
-    if (!t.host) continue;
-    const written = into || assigning
-      || (verb === 'GET' && next?.word === '=')
-      || (verb === 'ASSOCIATE' && !toks.slice(0, i).some((x) => x.word === 'WITH'));
-    if (!written || (into && intoBoth)) read(t.host);
-    if (written) write(t.host);
-  }
-  return { sending, receiving };
-}
-
-// CALL :name reads the name. Each argument that is a lone variable, with or without its indicator,
-// is read and may be written; any other argument is an expression, IN only.
-function callRoles(toks, read, write) {
-  let depth = 0;
-  let arg = [];
-  const close = () => {
-    const hosts = arg.filter((t) => t.host);
-    const lone = hosts.length && arg.every((t) => t.host || t.word === 'INDICATOR');
-    for (const h of hosts) { read(h.host); if (lone) write(h.host); }
-    arg = [];
-  };
-  for (let i = 1; i < toks.length; i++) {
-    const t = toks[i];
-    if (t.word === 'DESCRIPTOR' && toks[i + 1]?.host) { read(toks[i + 1].host); write(toks[i + 1].host); i++; continue; }
-    if (t.word === '(') { if (depth++ > 0) arg.push(t); continue; }
-    if (t.word === ')') { if (--depth > 0) arg.push(t); else close(); continue; }
-    if (depth === 0) { if (t.host) read(t.host); continue; }
-    if (depth === 1 && t.word === ',') { close(); continue; }
-    arg.push(t);
-  }
-}
-
 // 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 = {
@@ -197,12 +118,12 @@ const declarative = (words) => words[0] === 'DECLARE' && words[1] !== 'GLOBAL';
 
 // What one block becomes, as COBOL text on one logical line, or '' to blank it.
 function translate(block, state) {
-  const toks = tokenize(block.text);
+  const toks = sqlTokens(block.text);
   const words = toks.filter((t) => t.word).map((t) => t.word);
   const verb = words[0] || '';
   if (verb === 'INCLUDE') return words[1] ? `COPY ${words[1]}` : '';
   if (!state.procedure) {
-    if (declarative(words) && words.includes('CURSOR')) state.cursors.set(words[1], roles(toks).sending);
+    if (declarative(words) && words.includes('CURSOR')) state.cursors.set(words[1], sqlRoles(toks).sending);
     return '';
   }
   if (verb === 'WHENEVER') {
@@ -216,11 +137,11 @@ function translate(block, state) {
     return 'CONTINUE';
   }
   if (declarative(words)) {
-    if (words.includes('CURSOR')) state.cursors.set(words[1], roles(toks).sending);
+    if (words.includes('CURSOR')) state.cursors.set(words[1], sqlRoles(toks).sending);
     return 'CONTINUE';
   }
   if (NOT_EXECUTABLE.has(verb)) return 'CONTINUE';
-  let { sending, receiving } = roles(toks);
+  let { sending, receiving } = sqlRoles(toks);
   let name = verb;
   if (verb === 'OPEN' && state.cursors.has(words[1])) sending = [...new Set([...state.cursors.get(words[1]), ...sending])];
   if (verb === 'EXECUTE' && words[1] === 'IMMEDIATE') name = 'EXECUTE-IMMEDIATE';