vms-ec70: MMK.EXE native — MadGoat MMK parses descrip.mms + drives the toolchain (self-host spine #4)

src/libvms/include/lib$routines.h

@@ -138,6 +138,16 @@ uint32_t lib$delete_vm_zone(
     const uint32_t *zone_id
 );
 
+/*
+ * lib$reset_vm_zone - Bulk-free all memory in a zone, keeping the zone active.
+ *
+ * @param zone_id    Pointer to zone identifier to reset
+ * @return SS$_NORMAL, or LIB$_BADZONE for an invalid/inactive zone
+ */
+uint32_t lib$reset_vm_zone(
+    const uint32_t *zone_id
+);
+
 /* ================================================================
  * Terminal I/O Routines
  * ================================================================ */

src/libvms/include/tpadef.h

@@ -38,6 +38,9 @@ struct _tpadef {
     char    *tpa$l_tokenptr;    /* Pointer to start of most recent token */
     uint32_t tpa$l_number;      /* Numeric value of most recent numeric token */
     uint32_t tpa$l_param;       /* User parameter (passed from state table) */
+    uint8_t  tpa$b_char;        /* First character of the most recent token match
+                                 * (VMS TPARSE exposes the matched character here;
+                                 * MMK reads it to build suffix rules char-by-char). */
 };
 
 typedef struct _tpadef TPADEF;

src/libvms/rtl/lib_output.c

@@ -13,6 +13,7 @@
 #include "rmsdef.h"
 #include "descrip.h"
 #include "lib$routines.h"
+#include "str$routines.h"
 
 /*
  * lib$put_output - Write descriptor contents to stdout with a newline.
@@ -175,7 +176,12 @@ uint32_t lib$get_foreign(struct dsc$descriptor_s *result,
                          const struct dsc$descriptor_s *prompt,
                          uint16_t *result_len,
                          ...) {
-    if (!result || !result->dsc$a_pointer) return SS$_BADPARAM;
+    /* A dynamic (class D) descriptor legitimately starts with a NULL pointer
+     * and zero length — str$copy_dx allocates it below.  Only a static
+     * descriptor must already point at a buffer. */
+    if (!result) return SS$_BADPARAM;
+    if (result->dsc$b_class != DSC$K_CLASS_D && !result->dsc$a_pointer)
+        return SS$_BADPARAM;
 
     /* First call with a foreign command line present: return the raw tail
      * DCL published, then consume it so a second call reads SYS$INPUT. An
@@ -184,6 +190,23 @@ uint32_t lib$get_foreign(struct dsc$descriptor_s *result,
     if (tail && tail[0] != '\0') {
         size_t len = strlen(tail);
 
+        /* Dynamic (class D) result descriptor: allocate/resize to hold the whole
+         * tail via str$copy_dx, matching VMS LIB$GET_FOREIGN, which accepts a
+         * dynamic string descriptor and returns the full command line.  (Callers
+         * such as MMK pass an INIT_DYNDESC descriptor whose dsc$w_length starts
+         * at 0; the static path below would otherwise copy zero bytes.) */
+        if (result->dsc$b_class == DSC$K_CLASS_D) {
+            struct dsc$descriptor_s src;
+            src.dsc$w_length  = (uint16_t)len;
+            src.dsc$b_dtype   = DSC$K_DTYPE_T;
+            src.dsc$b_class   = DSC$K_CLASS_S;
+            src.dsc$a_pointer = (char *)tail;
+            uint32_t st = str$copy_dx(result, &src);
+            if (result_len) *result_len = (uint16_t)len;
+            unsetenv("VMS_FOREIGN_CMD");
+            return (st & 1) ? SS$_NORMAL : st;
+        }
+
         uint16_t copylen = (uint16_t)len;
         int truncated = 0;
         if (len > result->dsc$w_length) {

src/libvms/rtl/lib_tparse.c

@@ -95,6 +95,9 @@ static void tpa_take(tpa_ctx *ctx, char *start, uint32_t n) {
     TPADEF *t = ctx->tpa;
     t->tpa$l_tokenptr = start;
     t->tpa$l_tokencnt = n;
+    /* Expose the first matched character (VMS TPA$B_CHAR); MMK reads it after a
+     * single-character (TPA$_ANY / literal) match to accrete suffix strings. */
+    if (n >= 1) t->tpa$b_char = (uint8_t)start[0];
     t->tpa$l_stringptr = start + n;
     /* stringcnt was measured from `start`; subtract what we consumed. */
     t->tpa$l_stringcnt = t->tpa$l_stringcnt - n;

src/libvms/rtl/lib_vm.c

@@ -294,6 +294,12 @@ uint32_t lib$get_vm(const uint32_t *num_bytes, void **base_adr, ...)
     hdr->zone_id = zid;
 
     *base_adr = (char *)raw + sizeof(struct alloc_hdr);
+    /* Zero the returned block.  VMS callers routinely create zones with
+     * LIB$M_VM_GET_FILL0 (e.g. MMK's symbol/rule/dependency zones) and rely on
+     * fresh allocations being zeroed — a struct whose pointer fields must read
+     * as NULL until set.  Lookaside reuse returns dirty memory, so zero here to
+     * honour the FILL0 contract.  (vms-ec70) */
+    memset(*base_adr, 0, hdr->size);
     return SS$_NORMAL;
 }
 
@@ -473,6 +479,54 @@ uint32_t lib$delete_vm_zone(const uint32_t *zone_id)
     return SS$_NORMAL;
 }
 
+/*
+ * lib$reset_vm_zone - Bulk-free all memory in a zone but keep the zone ALIVE.
+ *
+ * Like lib$delete_vm_zone, all extents are munmap'd in one shot; unlike delete,
+ * the zone slot stays active and is re-initialised empty so the caller can keep
+ * allocating from it.  (VMS callers use this to recycle a scratch zone between
+ * passes — e.g. MMK's pattern-substitution leaf zone.)  Added for vms-ec70.
+ */
+uint32_t lib$reset_vm_zone(const uint32_t *zone_id)
+{
+    if (!zone_id)
+        return SS$_BADPARAM;
+
+    uint32_t zid = *zone_id;
+
+    ensure_init();
+
+    pthread_mutex_lock(&zone_table_lock);
+
+    if (zid >= MAX_ZONES || !zones[zid].active) {
+        pthread_mutex_unlock(&zone_table_lock);
+        return LIB$_BADZONE;
+    }
+
+    struct vm_zone *zone = &zones[zid];
+
+    pthread_mutex_lock(&zone->lock);
+
+    struct extent *ext = zone->extents;
+    while (ext) {
+        struct extent *next = ext->next;
+        munmap((void *)ext, ext->size);
+        ext = next;
+    }
+    zone->extents     = NULL;
+    zone->bump_ptr    = NULL;
+    zone->bump_remain = 0;
+    for (int i = 0; i < LOOKASIDE_CLASSES; i++)
+        zone->lookaside[i] = NULL;
+    zone->total_alloc = 0;
+    zone->total_free  = 0;
+
+    pthread_mutex_unlock(&zone->lock);
+    pthread_mutex_unlock(&zone_table_lock);
+
+    return SS$_NORMAL;
+}
+
 /*
  * lib$get_vm_page - Allocate memory in VMS page units (512 bytes each).
  */

src/vmslink/libvms_shr.vec

@@ -386,3 +386,4 @@ vms_uring_init=PROCEDURE
 vms_uring_process_completions=PROCEDURE
 vms_uring_submit_rw=PROCEDURE
 vms_uring_wait_completion=PROCEDURE
+lib$reset_vm_zone=PROCEDURE

src/vmslink/libvms_shr.vec.frozen

@@ -348,3 +348,4 @@ vms_uring_init=PROCEDURE
 vms_uring_process_completions=PROCEDURE
 vms_uring_submit_rw=PROCEDURE
 vms_uring_wait_completion=PROCEDURE
+lib$reset_vm_zone=PROCEDURE

src/vmslink/mk_mmk.sh

@@ -0,0 +1,118 @@
+#!/bin/sh
+# mk_mmk.sh — build recipe for MMK.EXE, the MadGoat MMK ("make" for VMS) built
+# AS a VMS-native EXECUTABLE image (bead vms-ec70, self-host spine #4). Mirrors
+# mk_dcl.sh / mk_tcc.sh exactly: compile every TU with the proven freestanding-
+# musl CFLAGS, then LINK.EXE --executable --use {DECC$SHR + the six OVMX
+# shareables} -o MMK.EXE, activated by IMGACT.EXE.
+#
+# COMPOSITION (see tests/toolchain/CMakeLists.txt for the identical source list
+# used by the host functional ctest toolchain-mmk-parse):
+#   - 15 vendored MadGoat make-engine TUs (tests/corpus/tier3-mmk/), stock except
+#     for tagged "OVMX (vms-ec70)" seams — grep the tag to see every edit;
+#   - the vms-486 PARSE_TABLES.MAR -> C grammar (tests/libvms/mmk_parse_tables.c),
+#     compiled -DOVMX_MMK_PRODUCTION so its transitions fire MMK's real
+#     parse_store / parse_obj_store (not the vms-486 test probe);
+#   - the OVMX companions (tests/corpus/tier3-mmk/ovmx/):
+#       ovmx_mmk_compat.c   RTL call-arity forwarding wrappers,
+#       ovmx_mmk_cld.c      compiles mmk_cld.cld at run time via cli$compile_cld,
+#       ovmx_mmk_sp.c       subprocess boundary (NOACTION dry-run; real exec is
+#                           the deferred DCL-subprocess drive — see the header),
+#       ovmx_mmk_cms.c      honest CMS-not-available stubs,
+#       ovmx_mmk_builtins.c _INSQUE/_REMQUE + sp_once/lib$find_image_symbol.
+#
+# The force-included ovmx_mmk_compat.h adapts the stock vendored source to the
+# OVMX RTL (VMS storage-class keywords, struct/constant spellings, the va_count
+# call-site counting macro, the RTL arity wrappers).  See its header for the full
+# rationale; every OVMX-defined representation is labeled a design choice (Rule 8).
+#
+# link.c / imgact.c are the complete toolchain and are OUT of file-domain here —
+# do NOT edit them.  The RTL entry points MMK imports (lib$table_parse,
+# cli$compile_cld/cli$dcl_parse/cli$present/cli$get_value, lib$reset_vm_zone,
+# sys$filescan, ...) are auto-exported in the producer shareables' symbol vectors
+# (mk_*_shr.sh generate the vector from the objects' global symbols).
+#
+# Usage:  mk_mmk.sh <LINK.EXE> <out-MMK.EXE> \
+#             <DECC$SHR.EXE> <LIBVMS$SHR.EXE> <LIBVMSPROCESS$SHR.EXE> \
+#             <LIBVMSFS$SHR.EXE> <LIBVMSLNM$SHR.EXE> <LIBVMSRMS$SHR.EXE> \
+#             <LIBVMSSYS$SHR.EXE> [repo-src-dir]
+# Env:    CC (default gcc), CFLAGS (default aarch64 musl; x86_64 caller sets its own)
+# Must run in the musl container where the producer .EXE already exist.
+set -e
+
+LINK_EXE=${1:?usage: mk_mmk.sh <LINK.EXE> <out> <DECC\$SHR> <LIBVMS\$SHR> <LIBVMSPROCESS\$SHR> <LIBVMSFS\$SHR> <LIBVMSLNM\$SHR> <LIBVMSRMS\$SHR> <LIBVMSSYS\$SHR> [repo-src]}
+OUT=${2:?need output MMK.EXE path}
+DECC_SHR=${3:?need DECC\$SHR.EXE}
+VMS_SHR=${4:?need LIBVMS\$SHR.EXE}
+PROC_SHR=${5:?need LIBVMSPROCESS\$SHR.EXE}
+FS_SHR=${6:?need LIBVMSFS\$SHR.EXE}
+LNM_SHR=${7:?need LIBVMSLNM\$SHR.EXE}
+RMS_SHR=${8:?need LIBVMSRMS\$SHR.EXE}
+SYS_SHR=${9:?need LIBVMSSYS\$SHR.EXE}
+HERE=$(cd "$(dirname "$0")" && pwd)                      # src/vmslink
+REPO_SRC=${10:-$(cd "$HERE/.." && pwd)}                  # src
+REPO=$(cd "$REPO_SRC/.." && pwd)                         # repo root
+CORPUS="$REPO/tests/corpus/tier3-mmk"
+OVMX="$CORPUS/ovmx"
+GRAMMAR="$REPO/tests/libvms/mmk_parse_tables.c"
+CC=${CC:-gcc}
+
+for f in "$DECC_SHR" "$VMS_SHR" "$PROC_SHR" "$FS_SHR" "$LNM_SHR" "$RMS_SHR" "$SYS_SHR"; do
+    [ -f "$f" ] || { echo "mk_mmk: producer image not found: $f"; exit 1; }
+done
+[ -d "$CORPUS" ] || { echo "mk_mmk: MMK corpus not found: $CORPUS"; exit 1; }
+
+WORK=${WORK:-/tmp/mk-mmk}
+rm -rf "$WORK"; mkdir -p "$WORK"
+
+# Embed mmk_cld.cld as a C string (mmk_cld_src.h), the same header the host
+# ctest generates via gen_mmk_cld_src.cmake.
+{
+    echo "static const char mmk_cld_source[] ="
+    sed -e 's/\\/\\\\/g' -e 's/"/\\"/g' -e 's/^/  "/' -e 's/$/\\n"/' "$CORPUS/mmk_cld.cld"
+    echo ";"
+} > "$WORK/mmk_cld_src.h"
+
+CFLAGS="${CFLAGS:--fPIC -O2 -ffreestanding -fno-builtin -fno-stack-protector -mno-outline-atomics -U_FORTIFY_SOURCE}"
+DEFS="-D_POSIX_C_SOURCE=200809L -D_DEFAULT_SOURCE -D__CRTL_VER=80400000 -DOVMX_MMK"
+INCS="-I$WORK -I$OVMX -I$CORPUS -I$REPO/tests/libvms \
+-I$REPO_SRC/libvms/include -I$REPO_SRC/vmsrms/include -I$REPO_SRC/vmsfs/include \
+-I$REPO_SRC/vmslnm/include -I$REPO_SRC/vmsprocess/include"
+FINC="-include $OVMX/ovmx_mmk_compat.h"
+
+CORPUS_TUS="mmk parse_descrip parse_objects build_target misc mem fileio symbols \
+objects default_rules get_rdt readdesc str"
+COMPANIONS="ovmx_mmk_cld ovmx_mmk_sp ovmx_mmk_cms ovmx_mmk_builtins"
+
+echo "mk_mmk: CC=$CC  LINK.EXE=$LINK_EXE"
+OBJS=""
+for t in $CORPUS_TUS; do
+    echo "  cc $t.c"
+    $CC $CFLAGS $DEFS $FINC $INCS -c -o "$WORK/$t.o" "$CORPUS/$t.c"
+    OBJS="$OBJS $WORK/$t.o"
+done
+echo "  cc mmk_parse_tables.c (OVMX_MMK_PRODUCTION — real parse_store)"
+$CC $CFLAGS $DEFS -DOVMX_MMK_PRODUCTION $FINC $INCS -c -o "$WORK/mmk_parse_tables.o" "$GRAMMAR"
+OBJS="$OBJS $WORK/mmk_parse_tables.o"
+for t in $COMPANIONS; do
+    echo "  cc $t.c"
+    $CC $CFLAGS $DEFS $FINC $INCS -c -o "$WORK/$t.o" "$OVMX/$t.c"
+    OBJS="$OBJS $WORK/$t.o"
+done
+# ovmx_mmk_compat.c carries #undefs for the wrapper macros, so it is safe to
+# force-include the compat header uniformly with every other TU.
+echo "  cc ovmx_mmk_compat.c (RTL arity wrappers)"
+$CC $CFLAGS $DEFS $FINC $INCS -c -o "$WORK/ovmx_mmk_compat.o" "$OVMX/ovmx_mmk_compat.c"
+OBJS="$OBJS $WORK/ovmx_mmk_compat.o"
+
+NOBJ=$(echo $OBJS | wc -w)
+echo "mk_mmk: $NOBJ objects compiled (13 corpus + grammar + 5 companions = 19 expected)"
+[ "$NOBJ" -eq 19 ] || { echo "mk_mmk: FAIL: expected 19 objects, got $NOBJ"; exit 1; }
+
+echo "mk_mmk: LINK.EXE --executable --use {7 producers} -> $OUT"
+# shellcheck disable=SC2086
+"$LINK_EXE" --executable \
+    --use "$DECC_SHR" --use "$VMS_SHR" --use "$PROC_SHR" \
+    --use "$FS_SHR" --use "$LNM_SHR" --use "$RMS_SHR" --use "$SYS_SHR" \
+    -o "$OUT" $OBJS
+
+echo "mk_mmk: created $OUT"

src/vmsrms/include/rms/nam.h

@@ -45,6 +45,13 @@ struct NAM {
     uint32_t nam$l_wcc;        /* Wildcard context (internal) */
     /* Internal */
     void    *nam$$l_context;   /* Wildcard search context (internal) */
+    /* Parse-control / related-file / device-id fields (vms-ec70: needed by
+     * callers such as MadGoat MMK that set NAM$M_SYNCHK for syntax-only
+     * $PARSE, chain a related-file NAM, or read the device-id back).  Appended
+     * at the end so all pre-existing field offsets are unchanged. */
+    uint8_t  nam$b_nop;        /* $PARSE options (NAM$M_SYNCHK etc.) */
+    struct NAM *nam$l_rlf;     /* Related-file NAM for relative $PARSE */
+    char     nam$t_dvi[16];    /* Device-id (counted string) after $PARSE */
 };
 
 /* NAM flags (nam$l_fnb) */
@@ -69,4 +76,8 @@ struct NAM {
     .nam$b_bln = sizeof(struct NAM) \
 }
 
+/* nam$b_nop $PARSE option flags */
+#define NAM$M_SYNCHK      0x08    /* Syntax-only parse (no device/dir check) */
+#define NAM$M_PWD         0x10    /* Parse-with-directory (search list) */
+
 #endif /* __RMS_NAM_H */

tests/corpus/tier3-mmk/default_rules.c

@@ -57,7 +57,12 @@
 #pragma module DEFAULT_RULES "V1.3"
 #include "mmk.h"
 #include "globals.h"
+#ifdef OVMX_MMK          /* OVMX (vms-ec70): generated at build time by
+                          * mmk_compile_rules into WORK, found via -I$WORK */
+#include "mmk_default_rules.h"
+#else
 #include "etc_dir:mmk_default_rules.h"
+#endif
 
 /*
 **++

tests/corpus/tier3-mmk/get_rdt.c

@@ -63,15 +63,21 @@
 #pragma module GET_RDT "V1.4"
 #include "mmk.h"
 #include <rms.h>
+#ifndef OVMX_MMK          /* OVMX (vms-ec70): the LBR (.OLB module-date) path is
+                           * seamed out below — OVMX has no lbr$ callable RTL.
+                           * See the OVMX stubs at the bottom of this #ifndef. */
 #include <mhddef.h>
 #include <lbrdef.h>
+#endif
 
 /*
 ** Forward declarations
 */
     unsigned int lbr_get_rdt(char *, char *, TIME *);
     void lbr_flush(void);
 
+#ifndef OVMX_MMK
+
 /*
 ** Context structure and header for the list that tracks them
 */
@@ -283,6 +289,17 @@ void lbr_flush (void) {
     }
     lbrcount = 0;
 }
+#else  /* OVMX_MMK — honest stubs: .OLB module revision-date lookup is not wired
+        * (deferred; see vms-ec70 PR).  Returns an even (failure) status so a
+        * library-module target is treated as needing a rebuild rather than
+        * silently reporting a bogus date. */
+unsigned int lbr_get_rdt (char *lib, char *mod, TIME *rdt) {
+    (void)lib; (void)mod;
+    if (rdt) memset(rdt, 0, sizeof(*rdt));
+    return RMS$_FNF;   /* module not found -> forces "stale" */
+}
+void lbr_flush (void) { }
+#endif /* OVMX_MMK */
 
 /*
 **++

tests/corpus/tier3-mmk/misc.c

@@ -95,7 +95,9 @@
 */
     void Build_Suffix_List(char *, int);
     char *itoa(int);
+#ifndef OVMX_MMK   /* OVMX (vms-ec70): cat() is the counted ovmx_cat form (mmk.h) */
     char *cat(char *, ...);
+#endif
     char *trim(char *);
     char *find_char(char *, char *, char *);
     void upcase(char *);
@@ -255,15 +257,24 @@ char *itoa(int i) {
 **
 **--
 */
+#ifdef OVMX_MMK   /* OVMX (vms-ec70): counted form; the call-site macro (mmk.h)
+                   * supplies ovmx_ac = total arg count in place of va_count. */
+char *ovmx_cat(int ovmx_ac, char *in, ...) {
+#else
 char *cat(char *in, ...) {
+#endif
 
     int actualcount;
     va_list ap;
     char *str, *out, *outp;
     int i, inlen, len, outlen;
 
     outlen = inlen = (in == (char *)0) ? 0 : strlen(in);
+#ifdef OVMX_MMK
+    actualcount = ovmx_ac;
+#else
     va_count(actualcount);
+#endif
     va_start(ap, in);
     i = 1;
     while (i < actualcount) {