Result suffixes, PIM coroutines, and a core standard library

Language:
- Result suffixes: components after a function call (F()^, F()[i],
  F().field) via ResultComp; the call result is loaded like a Design
  component, so scalar/pointer results are dereferenced with the right
  width (M2.atg).
- PIM coroutines: PROCESS plus NEWPROCESS/TRANSFER/IOTRANSFER are
  predefined in SYSTEM and bind to ucontext helpers in the shim;
  PROCESS is pointer-sized, PROC is a parameterless procedure type.

Backend fixes exposed by the library:
- ElemLoad/ElemStore and the function-parameter prologue treated
  procedure values (and locals) as 32-bit; they are now 8-byte
  (ClProc/ClClass/ClLong), fixing procedure-typed array elements and
  procedure/long formals (storel).
- The M2 driver's session file table was capped at 32 sources; raised
  to 128.

Standard library (gm2/ISO names, layered on the shim):
  ConvTypes, IOConsts, SIOResult, TERMINATION, StrIO, InOut, StdIO,
  WholeStr, RealStr, LongStr, LongMath, STextIO, SWholeIO, SRealIO,
  DynamicStrings, SysStorage.  Math.ln/arctan now wrap log/atan.

Tests: t_resultsfx, t_coroutine, t_dynstr, library1 (session).

compiler/run_tests.sh

@@ -81,6 +81,8 @@ expect_run t_nestidx.mod 42
 expect_run t_proctype.mod 42
 expect_run t_compat.mod 42
 expect_run t_constfold.mod 42
+expect_run t_resultsfx.mod 42
+expect_run t_coroutine.mod 42
 expect_run t_emptystat.mod 42
 expect_run t_highlen.mod 18
 expect_run t_builtins.mod 42
@@ -253,6 +255,29 @@ expect_run_files DOpaqueProg 55 d_opaque.def d_opaque.mod d_opaque_prog.mod
 expect_run_files TString 42 d_string.def d_string.mod t_string.mod
 expect_run_files FioProg 42 ../runtime/syslib/SysShim.def ../runtime/syslib/SysShim.mod ../runtime/syslib/FileIO.def ../runtime/syslib/FileIO.mod fio_prog.mod
 expect_run_files StorageProg 42 ../stdlib/storage.def ../stdlib/storage.mod storage_prog.mod
+expect_run_files Library1 42 \
+  ../runtime/syslib/SysShim.def ../runtime/syslib/SysShim.mod \
+  ../stdlib/convtypes.def ../stdlib/convtypes.mod \
+  ../stdlib/ioconsts.def ../stdlib/ioconsts.mod \
+  ../stdlib/conversions.def ../stdlib/conversions.mod \
+  ../stdlib/math.def ../stdlib/math.mod \
+  ../stdlib/sioresult.def ../stdlib/sioresult.mod \
+  ../stdlib/TERMINATION.def ../stdlib/TERMINATION.mod \
+  ../stdlib/wholestr.def ../stdlib/wholestr.mod \
+  ../stdlib/realstr.def ../stdlib/realstr.mod \
+  ../stdlib/longstr.def ../stdlib/longstr.mod \
+  ../stdlib/longmath.def ../stdlib/longmath.mod \
+  ../stdlib/strio.def ../stdlib/strio.mod \
+  ../stdlib/inout.def ../stdlib/inout.mod \
+  ../stdlib/stdio.def ../stdlib/stdio.mod \
+  ../stdlib/stextio.def ../stdlib/stextio.mod \
+  ../stdlib/swholeio.def ../stdlib/swholeio.mod \
+  ../stdlib/srealio.def ../stdlib/srealio.mod \
+  library1.mod
+expect_run_files TDynStr 42 \
+  ../stdlib/dynamicstrings.def ../stdlib/dynamicstrings.mod \
+  ../stdlib/sysstorage.def ../stdlib/sysstorage.mod \
+  t_dynstr.mod
 expect_run_files ClashProg 60 d_clash_a.def d_clash_a.mod d_clash_b.def d_clash_b.mod d_clash_prog.mod
 expect_run_files_out Hello 0 "Hello, Modula-2!" ../stdlib/sysio.def ../stdlib/sysio.mod hello.mod
 expect_run_files_out StringsProg 0 "Hello World" ../stdlib/sysio.def ../stdlib/sysio.mod ../stdlib/strings.def ../stdlib/strings.mod strings_prog.mod

compiler/src/M2.atg

@@ -2036,6 +2036,96 @@ PRODUCTIONS
                                                sfx := TRUE
                                              END
                                            END; .) } .
+  (* Result suffix (ISO component after a function call): `F()^`,
+     `F()[i]`, `F().field`.  The call result is in t/q with sfx FALSE
+     (a value, or a descriptor address for aggregates); each component
+     descends one level exactly like the Design components. *)
+  ResultComp<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
+             VAR sfx: BOOLEAN>          (. VAR it, eT, bt: SymTab.TypeIndex;
+                                             iq, ql, qlo, qhi, qe, qb:
+                                               QbeGen.QVal;
+                                             lo, hi, fo: INTEGER;
+                                             isOpen: BOOLEAN;
+                                             fname: SymTab.Name; .)
+    = "[" Expr<it, iq>
+                                        (. IF t = SymTab.InvalidType THEN
+                                           ELSIF SymTab.ClassOf(t) #
+                                                 SymTab.ClArray THEN
+                                             SemError(217);
+                                             t := SymTab.InvalidType
+                                           ELSIF NOT SymTab.IsIntFamily(it)
+  AND (SymTab.ClassOf(it) # SymTab.ClChar)
+  AND (SymTab.ClassOf(it) # SymTab.ClEnum) THEN
+                                             SemError(218);
+                                             t := SymTab.InvalidType
+                                           ELSE
+                                             QbeGen.WidenIndex(iq, ql);
+                                             isOpen :=
+                                               SymTab.IsOpenArray(t);
+                                             IF isOpen THEN
+                                               QbeGen.CopyOp("0", qlo);
+                                               IF SymTab.IsCharArray(t)
+  OR SymTab.IsUCharArray(t) THEN
+                                                 QbeGen.OpenHiChar(q, qhi)
+                                               ELSE QbeGen.OpenHi(q, qhi)
+                                               END
+                                             ELSE
+                                               lo := SymTab.ArrayLo(t);
+                                               hi := SymTab.ArrayHi(t);
+                                               IF SymTab.IsCharArray(t)
+  OR SymTab.IsUCharArray(t) THEN
+                                                 hi := hi + 1
+                                               END;
+                                               QbeGen.IntStr(lo, qlo);
+                                               QbeGen.IntStr(hi, qhi)
+                                             END;
+                                             QbeGen.CheckRange(ql, qlo,
+                                               qhi);
+                                             eT := SymTab.ArrayElem(t);
+                                             QbeGen.ElemAddr(q, ql, qlo,
+                                               t, qe);
+                                             IF SymTab.ClassOf(eT) =
+                                                SymTab.ClArray THEN
+                                               QbeGen.ElemLoad(qe, eT, q)
+                                             ELSE QbeGen.CopyOp(qe, q)
+                                             END;
+                                             t := eT; sfx := TRUE
+                                           END; .)
+      "]"
+    | "." GetIdent<fname>
+                                        (. IF t = SymTab.InvalidType THEN
+                                           ELSIF (SymTab.ClassOf(t) #
+                                                  SymTab.ClRecord)
+  AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
+                                             SemError(215);
+                                             t := SymTab.InvalidType
+                                           ELSIF NOT SymTab.FieldExists(t,
+                                                    fname) THEN
+                                             SemError(216);
+                                             t := SymTab.InvalidType
+                                           ELSE
+                                             fo := SymTab.FieldOffset(t,
+                                               fname);
+                                             t := SymTab.FieldType(t, fname);
+                                             QbeGen.FieldAddr(q, fo, qe);
+                                             QbeGen.CopyOp(qe, q);
+                                             sfx := TRUE
+                                           END; .)
+    | "^"                               (. IF t = SymTab.InvalidType THEN
+                                           ELSIF SymTab.ClassOf(t) #
+                                                 SymTab.ClPtr THEN
+                                             SemError(219);
+                                             t := SymTab.InvalidType
+                                           ELSE
+                                             bt := SymTab.PtrBase(t);
+                                             IF bt # SymTab.InvalidType THEN
+                                               IF sfx THEN
+                                                 QbeGen.ElemLoad(q, t, qb);
+                                                 QbeGen.CopyOp(qb, q)
+                                               END;
+                                               t := bt; sfx := TRUE
+                                             END
+                                           END; .) .
   Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
                                         (. VAR t2: SymTab.TypeIndex;
                                              op: INTEGER;
@@ -2473,7 +2563,21 @@ PRODUCTIONS
       [ TypedBraceLit<dt, q>            (. t := dt; .) ]
       [ ArgList<qn, dt, qd, TRUE, methCls, ct2, q2, called>
                                         (. t := ct2;
-                                           QbeGen.CopyOp(q2, q); .) ]
+                                           QbeGen.CopyOp(q2, q);
+                                           sfx := FALSE; .)
+        { ResultComp<t, q, sfx> }
+                                        (. IF sfx THEN
+                                             IF t = SymTab.InvalidType THEN
+                                               QbeGen.CopyOp("0", q)
+                                             ELSIF (SymTab.ClassOf(t) #
+                                                    SymTab.ClRecord)
+  AND (SymTab.ClassOf(t) # SymTab.ClSet)
+  AND (SymTab.ClassOf(t) # SymTab.ClArray)
+  AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
+                                               QbeGen.ElemLoad(q, t, q2);
+                                               QbeGen.CopyOp(q2, q)
+                                             END
+                                           END; .) ]
                                         (. IF NOT called
  AND (dk = SymTab.KindProc) THEN
                                              (* bare zero-arg function

compiler/src/QbeGen.mod

@@ -1026,7 +1026,8 @@ PROCEDURE EndFuncHeader;
         ELSIF cls = SymTab.ClReal THEN
           Revive;
           W("  stored "); W(parTmp[i]); W(", "); WL(slot)
-        ELSIF cls = SymTab.ClPtr THEN
+        ELSIF (cls = SymTab.ClPtr) OR (cls = SymTab.ClProc)
+           OR (cls = SymTab.ClLong) THEN
           Revive;
           W("  storel "); W(parTmp[i]); W(", "); WL(slot)
         ELSE
@@ -2595,7 +2596,8 @@ PROCEDURE ElemLoad (addr: ARRAY OF CHAR; t: INTEGER; VAR q: QVal);
     W("  "); W(q);
     IF cls = SymTab.ClReal THEN W(" =d loadd ")
     ELSIF (cls = SymTab.ClArray) OR (cls = SymTab.ClPtr)
-       OR (cls = SymTab.ClLong) THEN
+       OR (cls = SymTab.ClLong) OR (cls = SymTab.ClProc)
+       OR (cls = SymTab.ClClass) THEN
       W(" =l loadl ")
     ELSIF cls = SymTab.ClChar THEN W(" =w loadub ")
     ELSE W(" =w loadw ")
@@ -2610,7 +2612,8 @@ PROCEDURE ElemStore (addr, v: ARRAY OF CHAR; t: INTEGER);
     Revive;
     IF cls = SymTab.ClReal THEN W("  stored ")
     ELSIF (cls = SymTab.ClArray) OR (cls = SymTab.ClPtr)
-       OR (cls = SymTab.ClLong) THEN
+       OR (cls = SymTab.ClLong) OR (cls = SymTab.ClProc)
+       OR (cls = SymTab.ClClass) THEN
       W("  storel ")
     ELSIF cls = SymTab.ClChar THEN W("  storeb ")
     ELSE W("  storew ")

compiler/src/SymTab.mod

@@ -126,6 +126,7 @@ VAR
   dInt, dCard, dReal, dChar, dBool, dNil, dAddr, dLong : TypeIndex;
   dUChar : TypeIndex;    (* UCHAR: 32-bit codepoint *)
   dBitset : TypeIndex;   (* BITSET = SET OF [0..15] *)
+  dProc : TypeIndex;     (* PROC: parameterless procedure type *)
   globScope : ScopePtr;  (* the global scope (module names live here) *)
   curMod : INTEGER;      (* current registry slot, -1 between units *)
   curUnit : INTEGER;     (* UnitProg/Def/Impl, -1 between units *)
@@ -2932,7 +2933,69 @@ PROCEDURE Predef (name: ARRAY OF CHAR; kind: INTEGER; t: TypeIndex);
     IF Enter(name, kind) THEN SetSymType(name, t) END
   END Predef;
 
+PROCEDURE AddFormal (pr: SymPtr; t: TypeIndex; isVar: BOOLEAN);
+(* Appends a formal-position node to procedure pr's plink chain.
+   These formals are not in any scope: they exist only to give the
+   external builtin a signature the caller checks against. *)
+  VAR p, q: SymPtr;
+  BEGIN
+    IF pr = NIL THEN RETURN END;
+    NEW(p);
+    p^.name[0] := CHR(0);
+    p^.sym[0] := CHR(0);
+    p^.mod[0] := CHR(0);
+    p^.kind := KindParam;
+    p^.typ := t;
+    p^.scope := NIL;
+    p^.left := NIL; p^.right := NIL;
+    p^.rslt := InvalidType;
+    p^.plink := NIL;
+    p^.isVar := isVar;
+    p^.fwd := FALSE; p^.virt := FALSE;
+    p^.fdep := 0;
+    p^.snapRes := InvalidType;
+    p^.nSnap := 0;
+    p^.fsnap := FALSE;
+    p^.vslot := -1;
+    p^.hasBody := FALSE;
+    p^.ext := FALSE; p^.varargs := FALSE;
+    p^.link[0] := CHR(0);
+    p^.uid := 0;
+    p^.val[0] := CHR(0);
+    IF pr^.plink = NIL THEN
+      pr^.plink := p
+    ELSE
+      q := pr^.plink;
+      WHILE q^.plink # NIL DO q := q^.plink END;
+      q^.plink := p
+    END
+  END AddFormal;
+
+PROCEDURE PredefCProc (name, cname: ARRAY OF CHAR; res: TypeIndex): SymPtr;
+(* Defines an external C procedure in the global scope with an
+   explicit (not varargs) signature; formals are added with AddFormal. *)
+  VAR node: SymPtr;
+  BEGIN
+    node := RawEnter(name, KindProc);
+    IF node = NIL THEN RETURN NIL END;
+    node^.rslt := res;
+    node^.plink := NIL;
+    node^.isVar := FALSE;
+    node^.fwd := FALSE;
+    node^.virt := FALSE;
+    node^.ext := TRUE;
+    node^.varargs := FALSE;
+    node^.fsnap := FALSE;
+    Assign(node^.link, cname);
+    node^.uid := nextUid; INC(nextUid);
+    node^.fdep := 0;
+    node^.vslot := -1;
+    node^.hasBody := TRUE;
+    RETURN node
+  END PredefCProc;
+
 PROCEDURE Init;
+  VAR pr: SymPtr;
   BEGIN
     scopeList := NIL; scopeTail := NIL;
     fields := NIL; nFields := 0;
@@ -2953,6 +3016,7 @@ PROCEDURE Init;
     dLong := NewDesc(FLong, InvalidType);  (* LONGINT/LONGCARD: 64-bit *)
     dUChar := NewDesc(FUChar, InvalidType);
     dBitset := NewSet(NewSubR(0, 15));     (* BITSET *)
+    dProc := NewProcType(InvalidType);     (* PROC: no params, no result *)
     Predef("INTEGER", KindPredef, dInt);
     Predef("CARDINAL", KindPredef, dCard);
     Predef("SHORTINT", KindPredef, dInt);
@@ -2991,6 +3055,24 @@ PROCEDURE Init;
     Predef("CARDINAL16", KindPredef, dCard);
     Predef("CARDINAL32", KindPredef, dCard);
     Predef("CARDINAL64", KindPredef, dLong);
+    (* PIM/SYSTEM coroutines: PROCESS is pointer-sized; the three
+       builtins bind to C helpers in the runtime shim.  Signatures:
+         NEWPROCESS(P: PROC; A: ADDRESS; n: CARDINAL; VAR c: PROCESS);
+         TRANSFER(VAR a, b: PROCESS);
+         IOTRANSFER(VAR a, b: PROCESS; interruptNo: CARDINAL). *)
+    Predef("PROCESS", KindPredef, dAddr);
+    pr := PredefCProc("NEWPROCESS", "m2_newprocess", InvalidType);
+    AddFormal(pr, dProc, FALSE);
+    AddFormal(pr, dAddr, FALSE);
+    AddFormal(pr, dCard, FALSE);
+    AddFormal(pr, dAddr, TRUE);
+    pr := PredefCProc("TRANSFER", "m2_transfer", InvalidType);
+    AddFormal(pr, dAddr, TRUE);
+    AddFormal(pr, dAddr, TRUE);
+    pr := PredefCProc("IOTRANSFER", "m2_iotransfer", InvalidType);
+    AddFormal(pr, dAddr, TRUE);
+    AddFormal(pr, dAddr, TRUE);
+    AddFormal(pr, dCard, FALSE);
     Predef("NIL", KindConst, dNil)
   END Init;
 

compiler/src/compiler.frm

@@ -276,7 +276,7 @@ MODULE -->Grammar;
 
   VAR
     sourceName, listName, progName: ARRAY [0 .. 255] OF CHAR;
-    files: ARRAY [0 .. 31] OF ARRAY [0 .. 255] OF CHAR;
+    files: ARRAY [0 .. 127] OF ARRAY [0 .. 255] OF CHAR;
     nFiles: CARDINAL;
     f: CARDINAL;
     bad: BOOLEAN;

compiler/tests/library1.mod

@@ -0,0 +1,56 @@
+MODULE Library1;
+// Exercises the newly added standard-library modules: ConvTypes,
+// WholeStr, RealStr, LongStr, LongMath, StrIO, InOut, STextIO,
+// SWholeIO, SRealIO, SIOResult, IOConsts, TERMINATION, StdIO.
+// Exit 42.
+IMPORT ConvTypes, WholeStr, RealStr, LongStr, LongMath,
+       StrIO, InOut, STextIO, SWholeIO, SRealIO, SIOResult, IOConsts,
+       TERMINATION, StdIO;
+FROM ConvTypes IMPORT ConvResults, strAllRight;
+FROM IOConsts IMPORT ReadResults, notKnown;
+
+VAR ExitCode : INTEGER;
+VAR n : INTEGER;
+VAR c : CARDINAL;
+VAR x, y : REAL;
+VAR res : ConvResults;
+VAR s : ARRAY [0..63] OF CHAR;
+
+PROCEDURE Sink (ch : CHAR);
+BEGIN
+  (* a pushable output procedure *)
+END Sink;
+
+BEGIN
+  WholeStr.StrToInt("40", n, res);
+  IF res # strAllRight THEN ExitCode := 1 END;
+  WholeStr.StrToCard("2", c, res);
+  WholeStr.IntToStr(n, s);
+  ExitCode := n + VAL(INTEGER, c);          (* 42 *)
+
+  RealStr.RealToFixed(3.14159, 2, s);       (* "3.14" *)
+  RealStr.RealToFloat(312.5, 4, s);
+  x := LongMath.sqrt(4.0);                  (* 2.0 *)
+  y := LongMath.power(2.0, 3.0);            (* 8.0 *)
+  ExitCode := ExitCode + LongMath.round(x + y) - 10;   (* 42 *)
+
+  STextIO.WriteString("lib ");
+  SWholeIO.WriteCard(c, 1);
+  STextIO.WriteLn;
+  SRealIO.WriteFixed(2.5, 1, 0);
+  STextIO.WriteLn;
+  StrIO.WriteString("strio");
+  StrIO.WriteLn;
+  InOut.WriteString("oct ");
+  InOut.WriteOct(42, 1);
+  InOut.WriteString(" hex ");
+  InOut.WriteHex(255, 4);
+  InOut.WriteLn;
+  StdIO.PushOutput(Sink);
+  StdIO.Write("Z");
+  StdIO.PopOutput;
+  StdIO.Write("D");
+  STextIO.WriteLn;
+  IF SIOResult.ReadResult() = notKnown THEN END;
+  IF TERMINATION.HasHalted() THEN ExitCode := 2 END
+END Library1.

compiler/tests/t_coroutine.mod

@@ -0,0 +1,35 @@
+MODULE TCoroutine;
+// PIM coroutines from SYSTEM: NEWPROCESS / TRANSFER.
+// Two coroutines ping-pong; after 5 transfers Pong hands control
+// back to the main process, which checks the counter and exits 42.
+FROM SYSTEM IMPORT ADDRESS, PROCESS, NEWPROCESS, TRANSFER, ADR;
+
+CONST Stack = 65536;
+
+VAR ping, pong, exits : PROCESS;
+VAR ws1, ws2 : ARRAY [0..65535] OF CHAR;
+VAR count : CARDINAL;
+VAR ExitCode : INTEGER;
+
+PROCEDURE Ping;
+BEGIN
+  LOOP
+    TRANSFER(ping, pong)
+  END
+END Ping;
+
+PROCEDURE Pong;
+BEGIN
+  LOOP
+    INC(count);
+    IF count >= 5 THEN TRANSFER(pong, exits) END;
+    TRANSFER(pong, ping)
+  END
+END Pong;
+
+BEGIN
+  NEWPROCESS(Ping, ADR(ws1), Stack, ping);
+  NEWPROCESS(Pong, ADR(ws2), Stack, pong);
+  TRANSFER(exits, ping);
+  IF count = 5 THEN ExitCode := 42 ELSE ExitCode := 1 END
+END TCoroutine.

compiler/tests/t_dynstr.mod

@@ -0,0 +1,36 @@
+MODULE TDynStr;
+// DynamicStrings (core subset) + SysStorage.  Exit 42.
+FROM DynamicStrings IMPORT String, InitString, KillString, Length,
+       ConCat, Add, Equal, EqualArray, CopyOut, char, Mult, Slice,
+       Index, RIndex, ToUpper, ReplaceChar, Dup, RemoveWhitePostfix;
+FROM SYSTEM IMPORT ADDRESS;
+IMPORT SysStorage;
+
+VAR ExitCode : INTEGER;
+VAR s, t, u : String;
+VAR p : ADDRESS;
+VAR buf : ARRAY [0..63] OF CHAR;
+VAR n : CARDINAL;
+
+BEGIN
+  SysStorage.ALLOCATE(p, 16);
+  SysStorage.DEALLOCATE(p, 16);
+
+  s := InitString("Hello");
+  t := InitString(" World");
+  s := ConCat(s, t);                 (* "Hello World" *)
+  u := Add(s, InitString("!"));      (* new "Hello World!" *)
+  n := Length(u);                    (* 12 *)
+  IF Equal(s, InitString("Hello World")) THEN END;
+  IF EqualArray(s, "Hello World") THEN END;
+  s := ToUpper(s);                   (* "HELLO WORLD" *)
+  s := ReplaceChar(s, "L", "l");     (* "HEllO WORlD" *)
+  CopyOut(buf, s);
+  t := Mult(InitString("ab"), 3);    (* "ababab" *)
+  IF Length(t) = 6 THEN END;
+  t := KillString(t);
+  s := KillString(s);
+  u := KillString(u);
+
+  IF n = 12 THEN ExitCode := 42 ELSE ExitCode := 1 END
+END TDynStr.

compiler/tests/t_resultsfx.mod

@@ -0,0 +1,36 @@
+MODULE TResultSfx;
+// Result suffixes: components applied to a function-call result.
+//   P()^            dereference a pointer result
+//   P()^.field      field of a record pointed to by the result
+//   A()[i]          index an array result
+// Exit 42.
+TYPE
+  Rec    = RECORD a, b : INTEGER END;
+  RecPtr = POINTER TO Rec;
+  Arr    = ARRAY [0..3] OF INTEGER;
+  ArrPtr = POINTER TO Arr;
+
+VAR ExitCode : INTEGER;
+VAR r : RecPtr;
+VAR s : ArrPtr;
+VAR v : INTEGER;
+
+PROCEDURE GetRec () : RecPtr;
+BEGIN RETURN r END GetRec;
+
+PROCEDURE GetArr () : ArrPtr;
+BEGIN RETURN s END GetArr;
+
+PROCEDURE GetVal () : INTEGER;
+BEGIN RETURN 40 END GetVal;
+
+BEGIN
+  NEW(r);
+  NEW(s);
+  r^.a := 40; r^.b := 2;
+  s^[0] := 1; s^[1] := 2; s^[2] := 2; s^[3] := 4;
+  v := GetRec()^.a + GetRec()^.b;      // 42
+  v := v + GetArr()^[1];               // 42 + 2 = 44
+  v := v - GetVal();                   // 44 - 40 = 4
+  ExitCode := v * 10 + GetArr()^[2]    // 40 + 2 = 42
+END TResultSfx.

runtime/syslib/shim.c

@@ -8,11 +8,13 @@
  * Linked with every V3 program image.
  */
 
+#define _GNU_SOURCE
 #include <unistd.h>
 #include <stdlib.h>
 #include <stdio.h>
 #include <string.h>
 #include <time.h>
+#include <ucontext.h>
 
 /* Write the contents of a string descriptor to fd 1. Returns the
    number of bytes written. */
@@ -496,3 +498,335 @@ double m2readreal(void)
     if (scanf("%lf", &v) != 1) v = 0.0;
     return v;
 }
+
+/* ---------------- PIM coroutines (SYSTEM.NEWPROCESS/TRANSFER/...) --------
+ *
+ * A PROCESS is a pointer to a ucontext_t.  NEWPROCESS builds a context
+ * over the caller-supplied workspace; TRANSFER saves the running
+ * context into *a and resumes *b.  Coroutine bodies are compiled with a
+ * leading static-link argument; module-level bodies (the usual case for
+ * NEWPROCESS) take 0.  */
+
+void m2_newprocess(void *p, void *workspace, long size, void **c)
+{
+    ucontext_t *uc;
+    if (c == NULL) return;
+    uc = (ucontext_t *)malloc(sizeof(ucontext_t));
+    if (uc == NULL) { *c = NULL; return; }
+    if (getcontext(uc) != 0) { free(uc); *c = NULL; return; }
+    uc->uc_stack.ss_sp = workspace;
+    uc->uc_stack.ss_size = (size_t)size;
+    uc->uc_link = NULL;
+    makecontext(uc, (void (*)(void))p, 1, (int)0);
+    *c = uc;
+}
+
+void m2_transfer(void **a, void **b)
+{
+    ucontext_t *save;
+    ucontext_t *go;
+    if ((a == NULL) || (b == NULL)) return;
+    save = (ucontext_t *)*a;
+    go = (ucontext_t *)*b;
+    if (go == NULL) return;
+    if (save == NULL) {
+        save = (ucontext_t *)malloc(sizeof(ucontext_t));
+        if (save == NULL) return;
+        *a = save;
+    }
+    swapcontext(save, go);
+}
+
+/* IOTRANSFER: without a device-interrupt subsystem this degrades to a
+   plain transfer to b (classic PIM resumes a when the interrupt
+   fires).  The interrupt number is accepted and ignored. */
+void m2_iotransfer(void **a, void **b, long interruptNo)
+{
+    (void)interruptNo;
+    m2_transfer(a, b);
+}
+
+/* ---------------- text-IO library support ---------------- */
+
+/* Read one line from stdin (newline dropped) into the string
+   descriptor's data area; NUL-terminated.  Returns the length. */
+long m2readline(long *desc, int max)
+{
+    char *dst = (char *)(desc + 1);
+    long n = 0;
+    int c;
+    if (max < 0) max = 0;
+    while (n < max) {
+        c = getchar();
+        if (c == EOF) break;
+        if (c == '\n') break;
+        if (c == '\r') continue;
+        dst[n++] = (char)c;
+    }
+    dst[n] = 0;
+    return n;
+}
+
+/* Write a signed integer right-justified in a field of width `wid`
+   to fd 1 (wid = 0 => exactly one leading space). */
+long m2writeintwidth(long v, int wid)
+{
+    char buf[64];
+    int n;
+    if (wid == 0)
+        n = snprintf(buf, sizeof buf, " %ld", v);
+    else
+        n = snprintf(buf, sizeof buf, "%*ld", wid, v);
+    if (n > 0) write(1, buf, (size_t)n);
+    return 0;
+}
+
+/* Format a REAL into a descriptor: mode 0 = fixed (prec = decimal
+   places), 1 = floating (prec = significant figures), 2 = engineering
+   (prec = significant figures, exponent a multiple of three).
+   desc[0] is the capacity; on return it holds the length. */
+static long m2putstr(char *dst, long cap, const char *src)
+{
+    long n = (long)strlen(src);
+    if (cap <= 0) return 0;
+    if (n > cap - 1) n = cap - 1;
+    memcpy(dst, src, (size_t)n);
+    dst[n] = 0;
+    return n;
+}
+
+long m2realconv(double x, int mode, int prec, long *desc)
+{
+    char buf[256];
+    char *dst = (char *)(desc + 1);
+    long cap = desc[0];
+    int n = 0;
+    if (prec < 0) prec = 0;
+    if (prec > 40) prec = 40;
+    if (mode == 0) {
+        n = snprintf(buf, sizeof buf, "%.*f", prec, x);
+    } else if (mode == 1) {
+        n = snprintf(buf, sizeof buf, "%.*E",
+                     prec > 0 ? prec - 1 : 0, x);
+    } else {
+        /* engineering: mantissa in [1,1000), exponent multiple of 3 */
+        int e;
+        double m = x;
+        if (m != 0.0) {
+            e = 0;
+            while (m >= 1000.0) { m /= 1000.0; e += 3; }
+            while (m < 1.0)     { m *= 1000.0; e -= 3; }
+        } else {
+            e = 0;
+        }
+        n = snprintf(buf, sizeof buf, "%.*fE%+d",
+                     prec > 0 ? prec - 1 : 0, m, e);
+    }
+    if (n < 0) n = 0;
+    return m2putstr(dst, cap, buf);
+}
+
+/* Termination flags: HALT aborts the image, so neither is ever
+   observably TRUE; provided so TERMINATION links. */
+long m2terminating(void) { return 0; }
+long m2hashalted(void) { return 0; }
+
+/* ---------------- DynamicStrings (heap C strings) ----------------
+ *
+ * A DynamicStrings.String is a malloc'd NUL-terminated char buffer.
+ * Procedures that return a String return the buffer address; those
+ * that take a String receive it in the first `long` argument. */
+
+static char *m2dsdup(const char *s)
+{
+    size_t n;
+    char *p;
+    if (s == NULL) s = "";
+    n = strlen(s);
+    p = (char *)malloc(n + 1);
+    if (p == NULL) return NULL;
+    memcpy(p, s, n + 1);
+    return p;
+}
+
+long m2dsinit(long *a) { return (long)m2dsdup((const char *)(a + 1)); }
+long m2dskill(char *s) { free(s); return 0; }
+long m2dslength(const char *s) { return s ? (long)strlen(s) : 0; }
+long m2dsdupstr(const char *s) { return (long)m2dsdup(s); }
+
+long m2dsconcat(char *a, const char *b)
+{
+    size_t na, nb;
+    char *p;
+    if (b == NULL) b = "";
+    na = a ? strlen(a) : 0;
+    nb = strlen(b);
+    p = (char *)realloc(a, na + nb + 1);
+    if (p == NULL) return (long)a;
+    memcpy(p + na, b, nb + 1);
+    return (long)p;
+}
+
+long m2dsconcatchar(char *a, int ch)
+{
+    size_t na = a ? strlen(a) : 0;
+    char *p = (char *)realloc(a, na + 2);
+    if (p == NULL) return (long)a;
+    p[na] = (char)ch;
+    p[na + 1] = 0;
+    return (long)p;
+}
+
+long m2dsassign(char *a, const char *b)
+{
+    size_t nb;
+    char *p;
+    if (b == NULL) b = "";
+    nb = strlen(b);
+    p = (char *)realloc(a, nb + 1);
+    if (p == NULL) return (long)a;
+    memcpy(p, b, nb + 1);
+    return (long)p;
+}
+
+long m2dseq(const char *a, const char *b)
+{
+    if (a == NULL) a = "";
+    if (b == NULL) b = "";
+    return strcmp(a, b) == 0;
+}
+
+/* EqualArray: the second operand arrives as the *descriptor* of a V3
+   CHAR-array actual (V3 passes array actuals as their descriptor). */
+long m2dseqarr(const char *s, long *a)
+{
+    return m2dseq(s, (const char *)(a + 1));
+}
+
+long m2dschar(const char *s, int i)
+{
+    int n;
+    if (s == NULL) return 0;
+    n = (int)strlen(s);
+    if (i < 0) i = n + i;
+    if (i < 0 || i >= n) return 0;
+    return (unsigned char)s[i];
+}
+
+long m2dscopyout(long *dst, const char *s)
+{
+    char *d = (char *)(dst + 1);
+    long cap = dst[0];
+    size_t n;
+    if (s == NULL) s = "";
+    n = strlen(s);
+    if (cap < 0) cap = 0;
+    if (n > (size_t)cap) n = (size_t)cap;
+    memcpy(d, s, n);
+    d[n] = 0;
+    return (long)n;
+}
+
+long m2dsslice(const char *s, int low, int high)
+{
+    int n, lo, hi;
+    char *p;
+    if (s == NULL) s = "";
+    n = (int)strlen(s);
+    lo = low;
+    hi = high;
+    if (lo < 0) lo = n + lo;
+    if (lo < 0) lo = 0;
+    if (hi == 0) hi = n;
+    else if (hi < 0) hi = n + hi;
+    if (hi > n) hi = n;
+    if (hi < lo) hi = lo;
+    p = (char *)malloc((size_t)(hi - lo) + 1);
+    if (p == NULL) return 0;
+    memcpy(p, s + lo, (size_t)(hi - lo));
+    p[hi - lo] = 0;
+    return (long)p;
+}
+
+long m2dsindex(const char *s, int ch, int o)
+{
+    int i;
+    if (s == NULL) return -1;
+    for (i = o; s[i] != 0; i++)
+        if ((unsigned char)s[i] == (unsigned char)ch) return i;
+    return -1;
+}
+
+long m2dsrindex(const char *s, int ch, int o)
+{
+    int n, i;
+    if (s == NULL) return -1;
+    n = (int)strlen(s);
+    if (o >= n) o = n - 1;
+    for (i = o; i >= 0; i--)
+        if ((unsigned char)s[i] == (unsigned char)ch) return i;
+    return -1;
+}
+
+long m2dsmult(const char *s, int n)
+{
+    size_t len, i;
+    char *p;
+    if (s == NULL) s = "";
+    if (n <= 0) return (long)m2dsdup("");
+    len = strlen(s);
+    p = (char *)malloc(len * (size_t)n + 1);
+    if (p == NULL) return 0;
+    for (i = 0; i < (size_t)n; i++) memcpy(p + i * len, s, len);
+    p[len * (size_t)n] = 0;
+    return (long)p;
+}
+
+long m2dsreplacechar(char *s, int from, int to)
+{
+    int i;
+    if (s == NULL) return 0;
+    for (i = 0; s[i] != 0; i++)
+        if ((unsigned char)s[i] == (unsigned char)from) s[i] = (char)to;
+    return (long)s;
+}
+
+long m2dsupper(char *s)
+{
+    int i;
+    if (s == NULL) return 0;
+    for (i = 0; s[i] != 0; i++)
+        if (s[i] >= 'a' && s[i] <= 'z') s[i] = (char)(s[i] - 32);
+    return (long)s;
+}
+
+long m2dslower(char *s)
+{
+    int i;
+    if (s == NULL) return 0;
+    for (i = 0; s[i] != 0; i++)
+        if (s[i] >= 'A' && s[i] <= 'Z') s[i] = (char)(s[i] + 32);
+    return (long)s;
+}
+
+long m2dstrimprefix(char *s)
+{
+    char *p;
+    if (s == NULL) return 0;
+    p = s;
+    while (*p == ' ' || *p == '\t' || *p == '\n' || *p == '\r') p++;
+    if (p != s) memmove(s, p, strlen(p) + 1);
+    return (long)s;
+}
+
+long m2dstrimpostfix(char *s)
+{
+    size_t n;
+    if (s == NULL) return 0;
+    n = strlen(s);
+    while (n > 0 && (s[n-1] == ' ' || s[n-1] == '\t' ||
+                     s[n-1] == '\n' || s[n-1] == '\r')) {
+        s[--n] = 0;
+    }
+    return (long)s;
+}

stdlib/TERMINATION.def

@@ -0,0 +1,10 @@
+DEFINITION MODULE TERMINATION;
+(* ISO 10514-1: enquiries about program termination events. *)
+
+PROCEDURE IsTerminating () : BOOLEAN;
+(* TRUE once any coroutine has started program termination. *)
+
+PROCEDURE HasHalted () : BOOLEAN;
+(* TRUE once HALT has been called. *)
+
+END TERMINATION.

stdlib/TERMINATION.mod

@@ -0,0 +1,22 @@
+IMPLEMENTATION MODULE TERMINATION;
+(* HALT terminates the image immediately ($abort/exit), so HasHalted
+   is never observable as TRUE; termination is likewise not modelled
+   across coroutines yet.  Both query the runtime flags. *)
+
+PROCEDURE m2terminating () : BOOLEAN;
+  EXTERNAL;
+
+PROCEDURE m2hashalted () : BOOLEAN;
+  EXTERNAL;
+
+PROCEDURE IsTerminating () : BOOLEAN;
+BEGIN
+  RETURN m2terminating()
+END IsTerminating;
+
+PROCEDURE HasHalted () : BOOLEAN;
+BEGIN
+  RETURN m2hashalted()
+END HasHalted;
+
+END TERMINATION.

stdlib/convtypes.def

@@ -0,0 +1,12 @@
+DEFINITION MODULE ConvTypes;
+(* ISO 10514-1 conversion support types.  ConvResults is the status
+   returned by the StrTo* functions in RealStr / WholeStr / LongStr
+   (V3's Conversions module uses the same literals). *)
+
+TYPE
+  ConvResults = (strAllRight, strOutOfRange, strWrongFormat, strEmpty);
+  ScanClass   = (padding, valid, invalid, terminator);
+  ScanState   = PROCEDURE (c : CHAR; VAR sc : ScanClass;
+                           VAR st : ScanState);
+
+END ConvTypes.

stdlib/convtypes.mod

@@ -0,0 +1,3 @@
+IMPLEMENTATION MODULE ConvTypes;
+(* Types only; no runtime content. *)
+END ConvTypes.

stdlib/dynamicstrings.def

@@ -0,0 +1,40 @@
+DEFINITION MODULE DynamicStrings;
+(* gm2's dynamic string type.  String is opaque here and completed in
+   the implementation as a heap C string (ADDRESS).  This is the core
+   subset: the debugging (DB) variants and InitStringCharStar are not
+   provided. *)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+TYPE
+  String;
+
+PROCEDURE InitString (a : ARRAY OF CHAR) : String;
+PROCEDURE KillString (s : String) : String;
+PROCEDURE Fin (s : String);
+
+PROCEDURE InitStringChar (ch : CHAR) : String;
+
+PROCEDURE Length (s : String) : CARDINAL;
+PROCEDURE ConCat (a, b : String) : String;
+PROCEDURE ConCatChar (a : String; ch : CHAR) : String;
+PROCEDURE Assign (a, b : String) : String;
+PROCEDURE Dup (s : String) : String;
+PROCEDURE Add (a, b : String) : String;
+PROCEDURE Equal (a, b : String) : BOOLEAN;
+PROCEDURE EqualArray (s : String; a : ARRAY OF CHAR) : BOOLEAN;
+PROCEDURE CopyOut (VAR a : ARRAY OF CHAR; s : String);
+PROCEDURE char (s : String; i : INTEGER) : CHAR;
+PROCEDURE string (s : String) : ADDRESS;
+
+PROCEDURE Mult (s : String; n : CARDINAL) : String;
+PROCEDURE Slice (s : String; low, high : INTEGER) : String;
+PROCEDURE Index (s : String; ch : CHAR; o : CARDINAL) : INTEGER;
+PROCEDURE RIndex (s : String; ch : CHAR; o : CARDINAL) : INTEGER;
+PROCEDURE ReplaceChar (s : String; from, to : CHAR) : String;
+PROCEDURE ToUpper (s : String) : String;
+PROCEDURE ToLower (s : String) : String;
+PROCEDURE RemoveWhitePrefix (s : String) : String;
+PROCEDURE RemoveWhitePostfix (s : String) : String;
+
+END DynamicStrings.

stdlib/dynamicstrings.mod

@@ -0,0 +1,174 @@
+IMPLEMENTATION MODULE DynamicStrings;
+(* String is completed as ADDRESS (a heap C string).  All operations
+   bind to the shim's m2ds_* helpers. *)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+TYPE
+  String = ADDRESS;
+
+PROCEDURE m2dsinit (a : ARRAY OF CHAR) : ADDRESS;
+  EXTERNAL;
+PROCEDURE m2dskill (s : ADDRESS);
+  EXTERNAL;
+PROCEDURE m2dslength (s : ADDRESS) : CARDINAL;
+  EXTERNAL;
+PROCEDURE m2dsdupstr (s : ADDRESS) : ADDRESS;
+  EXTERNAL;
+PROCEDURE m2dsconcat (a : ADDRESS; b : ADDRESS) : ADDRESS;
+  EXTERNAL;
+PROCEDURE m2dsconcatchar (a : ADDRESS; ch : CHAR) : ADDRESS;
+  EXTERNAL;
+PROCEDURE m2dsassign (a : ADDRESS; b : ADDRESS) : ADDRESS;
+  EXTERNAL;
+PROCEDURE m2dseq (a : ADDRESS; b : ADDRESS) : BOOLEAN;
+  EXTERNAL;
+PROCEDURE m2dseqarr (s : ADDRESS; a : ARRAY OF CHAR) : BOOLEAN;
+  EXTERNAL;
+PROCEDURE m2dschar (s : ADDRESS; i : INTEGER) : CHAR;
+  EXTERNAL;
+PROCEDURE m2dscopyout (VAR dst : ARRAY OF CHAR; s : ADDRESS);
+  EXTERNAL;
+PROCEDURE m2dsslice (s : ADDRESS; low, high : INTEGER) : ADDRESS;
+  EXTERNAL;
+PROCEDURE m2dsindex (s : ADDRESS; ch : CHAR; o : CARDINAL) : INTEGER;
+  EXTERNAL;
+PROCEDURE m2dsrindex (s : ADDRESS; ch : CHAR; o : CARDINAL) : INTEGER;
+  EXTERNAL;
+PROCEDURE m2dsmult (s : ADDRESS; n : CARDINAL) : ADDRESS;
+  EXTERNAL;
+PROCEDURE m2dsreplacechar (s : ADDRESS; from, to : CHAR) : ADDRESS;
+  EXTERNAL;
+PROCEDURE m2dsupper (s : ADDRESS) : ADDRESS;
+  EXTERNAL;
+PROCEDURE m2dslower (s : ADDRESS) : ADDRESS;
+  EXTERNAL;
+PROCEDURE m2dstrimprefix (s : ADDRESS) : ADDRESS;
+  EXTERNAL;
+PROCEDURE m2dstrimpostfix (s : ADDRESS) : ADDRESS;
+  EXTERNAL;
+
+PROCEDURE InitString (a : ARRAY OF CHAR) : String;
+BEGIN
+  RETURN m2dsinit(a)
+END InitString;
+
+PROCEDURE KillString (s : String) : String;
+BEGIN
+  m2dskill(s);
+  RETURN NIL
+END KillString;
+
+PROCEDURE Fin (s : String);
+BEGIN
+  m2dskill(s)
+END Fin;
+
+PROCEDURE InitStringChar (ch : CHAR) : String;
+  VAR buf : ARRAY [0 .. 1] OF CHAR;
+BEGIN
+  buf[0] := ch; buf[1] := CHR(0);
+  RETURN m2dsinit(buf)
+END InitStringChar;
+
+PROCEDURE Length (s : String) : CARDINAL;
+BEGIN
+  RETURN m2dslength(s)
+END Length;
+
+PROCEDURE ConCat (a, b : String) : String;
+BEGIN
+  RETURN m2dsconcat(a, b)
+END ConCat;
+
+PROCEDURE ConCatChar (a : String; ch : CHAR) : String;
+BEGIN
+  RETURN m2dsconcatchar(a, ch)
+END ConCatChar;
+
+PROCEDURE Assign (a, b : String) : String;
+BEGIN
+  RETURN m2dsassign(a, b)
+END Assign;
+
+PROCEDURE Dup (s : String) : String;
+BEGIN
+  RETURN m2dsdupstr(s)
+END Dup;
+
+PROCEDURE Add (a, b : String) : String;
+BEGIN
+  RETURN m2dsconcat(m2dsdupstr(a), b)
+END Add;
+
+PROCEDURE Equal (a, b : String) : BOOLEAN;
+BEGIN
+  RETURN m2dseq(a, b)
+END Equal;
+
+PROCEDURE EqualArray (s : String; a : ARRAY OF CHAR) : BOOLEAN;
+BEGIN
+  RETURN m2dseqarr(s, a)
+END EqualArray;
+
+PROCEDURE CopyOut (VAR a : ARRAY OF CHAR; s : String);
+BEGIN
+  m2dscopyout(a, s)
+END CopyOut;
+
+PROCEDURE char (s : String; i : INTEGER) : CHAR;
+BEGIN
+  RETURN m2dschar(s, i)
+END char;
+
+PROCEDURE string (s : String) : ADDRESS;
+BEGIN
+  RETURN s
+END string;
+
+PROCEDURE Mult (s : String; n : CARDINAL) : String;
+BEGIN
+  RETURN m2dsmult(s, n)
+END Mult;
+
+PROCEDURE Slice (s : String; low, high : INTEGER) : String;
+BEGIN
+  RETURN m2dsslice(s, low, high)
+END Slice;
+
+PROCEDURE Index (s : String; ch : CHAR; o : CARDINAL) : INTEGER;
+BEGIN
+  RETURN m2dsindex(s, ch, o)
+END Index;
+
+PROCEDURE RIndex (s : String; ch : CHAR; o : CARDINAL) : INTEGER;
+BEGIN
+  RETURN m2dsrindex(s, ch, o)
+END RIndex;
+
+PROCEDURE ReplaceChar (s : String; from, to : CHAR) : String;
+BEGIN
+  RETURN m2dsreplacechar(s, from, to)
+END ReplaceChar;
+
+PROCEDURE ToUpper (s : String) : String;
+BEGIN
+  RETURN m2dsupper(s)
+END ToUpper;
+
+PROCEDURE ToLower (s : String) : String;
+BEGIN
+  RETURN m2dslower(s)
+END ToLower;
+
+PROCEDURE RemoveWhitePrefix (s : String) : String;
+BEGIN
+  RETURN m2dstrimprefix(s)
+END RemoveWhitePrefix;
+
+PROCEDURE RemoveWhitePostfix (s : String) : String;
+BEGIN
+  RETURN m2dstrimpostfix(s)
+END RemoveWhitePostfix;
+
+END DynamicStrings.

stdlib/inout.def

@@ -0,0 +1,34 @@
+DEFINITION MODULE InOut;
+(* Classic PIM terminal/file I/O (gm2-compatible interface).  Output
+   and input go to the current output/input file, which OpenOutput and
+   OpenInput redirect; Done reports whether a file operation succeeded.
+   ReadS/WriteS (the DynamicStrings variants) are not provided here. *)
+
+CONST
+  EOL = CHR(10);
+
+VAR
+  Done   : BOOLEAN;
+  termCH : CHAR;
+
+PROCEDURE OpenInput (defext : ARRAY OF CHAR);
+(* Reads a file name from standard input and opens it for reading;
+   Done is set on success. *)
+PROCEDURE CloseInput;
+PROCEDURE OpenOutput (defext : ARRAY OF CHAR);
+PROCEDURE CloseOutput;
+
+PROCEDURE Read (VAR ch : CHAR);
+PROCEDURE ReadString (VAR s : ARRAY OF CHAR);
+PROCEDURE ReadInt (VAR x : INTEGER);
+PROCEDURE ReadCard (VAR x : CARDINAL);
+
+PROCEDURE Write (ch : CHAR);
+PROCEDURE WriteLn;
+PROCEDURE WriteString (s : ARRAY OF CHAR);
+PROCEDURE WriteInt (x : INTEGER; n : CARDINAL);
+PROCEDURE WriteCard (x : CARDINAL; n : CARDINAL);
+PROCEDURE WriteOct (x : CARDINAL; n : CARDINAL);
+PROCEDURE WriteHex (x : CARDINAL; n : CARDINAL);
+
+END InOut.

stdlib/inout.mod

@@ -0,0 +1,172 @@
+IMPLEMENTATION MODULE InOut;
+(* Layered on the file shim (SysShim), so OpenInput/OpenOutput can
+   redirect the current input/output streams. *)
+
+FROM SYSTEM IMPORT ADDRESS;
+IMPORT SysShim;
+
+VAR
+  inH, outH : ADDRESS;
+  opened    : BOOLEAN;   (* a redirected file is open *)
+
+PROCEDURE SetDone (b : BOOLEAN);
+BEGIN
+  Done := b
+END SetDone;
+
+PROCEDURE TrimName (VAR s : ARRAY OF CHAR; defext : ARRAY OF CHAR);
+(* Drop a trailing newline and, if the name ends in '.', append
+   defext (the classic InOut convention). *)
+  VAR i, j, k : CARDINAL;
+BEGIN
+  i := 0;
+  WHILE (i <= HIGH(s)) AND (s[i] # CHR(0)) DO INC(i) END;
+  IF (i > 0) AND (s[i-1] = CHR(10)) THEN DEC(i); s[i] := CHR(0) END;
+  IF (i > 0) AND (s[i-1] = CHR(13)) THEN DEC(i); s[i] := CHR(0) END;
+  IF (i > 0) AND (s[i-1] = ".") THEN
+    j := i;
+    k := 0;
+    WHILE (k <= HIGH(defext)) AND (defext[k] # CHR(0)) AND (j <= HIGH(s)) DO
+      s[j] := defext[k]; INC(j); INC(k)
+    END;
+    IF j <= HIGH(s) THEN s[j] := CHR(0) END
+  END
+END TrimName;
+
+PROCEDURE OpenInput (defext : ARRAY OF CHAR);
+  VAR name : ARRAY [0 .. 1023] OF CHAR;
+    h : ADDRESS;
+    n : CARDINAL;
+BEGIN
+  name[0] := CHR(0);
+  n := SysShim.freadline(SysShim.stdin(), name, HIGH(name) + 1);
+  TrimName(name, defext);
+  h := SysShim.fopenread(name);
+  IF h = NIL THEN Done := FALSE
+  ELSE inH := h; Done := TRUE
+  END
+END OpenInput;
+
+PROCEDURE CloseInput;
+BEGIN
+  IF inH # SysShim.stdin() THEN SysShim.fclose(inH) END;
+  inH := SysShim.stdin(); Done := TRUE
+END CloseInput;
+
+PROCEDURE OpenOutput (defext : ARRAY OF CHAR);
+  VAR name : ARRAY [0 .. 1023] OF CHAR;
+    h : ADDRESS;
+    n : CARDINAL;
+BEGIN
+  name[0] := CHR(0);
+  n := SysShim.freadline(SysShim.stdin(), name, HIGH(name) + 1);
+  TrimName(name, defext);
+  h := SysShim.fopenwrite(name);
+  IF h = NIL THEN Done := FALSE
+  ELSE outH := h; Done := TRUE
+  END
+END OpenOutput;
+
+PROCEDURE CloseOutput;
+BEGIN
+  IF outH # SysShim.stdout() THEN SysShim.fclose(outH) END;
+  outH := SysShim.stdout(); Done := TRUE
+END CloseOutput;
+
+PROCEDURE Read (VAR ch : CHAR);
+BEGIN
+  ch := SysShim.fgetc(inH);
+  termCH := ch;
+  Done := (ch # CHR(0))
+END Read;
+
+PROCEDURE ReadString (VAR s : ARRAY OF CHAR);
+  VAR n : CARDINAL;
+BEGIN
+  n := SysShim.freadline(inH, s, HIGH(s) + 1);
+  Done := TRUE
+END ReadString;
+
+PROCEDURE ReadInt (VAR x : INTEGER);
+BEGIN
+  x := SysShim.freadint(inH);
+  Done := TRUE
+END ReadInt;
+
+PROCEDURE ReadCard (VAR x : CARDINAL);
+BEGIN
+  x := VAL(CARDINAL, SysShim.freadint(inH));
+  Done := TRUE
+END ReadCard;
+
+PROCEDURE Write (ch : CHAR);
+BEGIN
+  SysShim.fputc(outH, ch)
+END Write;
+
+PROCEDURE WriteLn;
+BEGIN
+  SysShim.fwriteln(outH)
+END WriteLn;
+
+PROCEDURE WriteString (s : ARRAY OF CHAR);
+BEGIN
+  SysShim.fputs(outH, s)
+END WriteString;
+
+PROCEDURE WriteInt (x : INTEGER; n : CARDINAL);
+BEGIN
+  SysShim.fwriteintw(outH, x, n)
+END WriteInt;
+
+PROCEDURE WriteCard (x : CARDINAL; n : CARDINAL);
+BEGIN
+  SysShim.fwriteintw(outH, x, n)
+END WriteCard;
+
+PROCEDURE WriteRadix (x : CARDINAL; n : CARDINAL; base : CARDINAL);
+  VAR tmp : ARRAY [0 .. 31] OF CHAR;
+    i, k : CARDINAL;
+    v : CARDINAL;
+    digit : CARDINAL;
+
+  PROCEDURE EmitChar (c : CHAR);
+  BEGIN
+    SysShim.fputc(outH, c)
+  END EmitChar;
+
+BEGIN
+  v := x; i := 0;
+  IF v = 0 THEN tmp[0] := "0"; i := 1
+  ELSE
+    WHILE (v > 0) AND (i <= HIGH(tmp)) DO
+      digit := v MOD base;
+      IF digit < 10 THEN tmp[i] := CHR(ORD("0") + digit)
+      ELSE tmp[i] := CHR(ORD("A") + digit - 10)
+      END;
+      v := v DIV base;
+      INC(i)
+    END
+  END;
+  (* pad with spaces to width n *)
+  k := i;
+  WHILE k < n DO EmitChar(" "); INC(k) END;
+  WHILE i > 0 DO DEC(i); EmitChar(tmp[i]) END
+END WriteRadix;
+
+PROCEDURE WriteOct (x : CARDINAL; n : CARDINAL);
+BEGIN
+  WriteRadix(x, n, 8)
+END WriteOct;
+
+PROCEDURE WriteHex (x : CARDINAL; n : CARDINAL);
+BEGIN
+  WriteRadix(x, n, 16)
+END WriteHex;
+
+BEGIN
+  inH := SysShim.stdin();
+  outH := SysShim.stdout();
+  Done := TRUE;
+  termCH := CHR(0)
+END InOut.

stdlib/ioconsts.def

@@ -0,0 +1,8 @@
+DEFINITION MODULE IOConsts;
+(* ISO 10514-1: classification of an input operation result. *)
+
+TYPE
+  ReadResults = (notKnown, allRight, outOfRange, wrongFormat,
+                 endOfLine, endOfInput);
+
+END IOConsts.

stdlib/ioconsts.mod

@@ -0,0 +1,2 @@
+IMPLEMENTATION MODULE IOConsts;
+END IOConsts.

stdlib/longmath.def

@@ -0,0 +1,22 @@
+DEFINITION MODULE LongMath;
+(* ISO 10514-1 real math for LONGREAL.  V3 models LONGREAL as REAL, so
+   the procedures delegate to Math (libm). *)
+
+CONST
+  pi   = 3.1415926535897932384626433832795028841972;
+  exp1 = 2.7182818284590452353602874713526624977572;
+
+PROCEDURE sqrt (x : LONGREAL) : LONGREAL;
+PROCEDURE exp (x : LONGREAL) : LONGREAL;
+PROCEDURE ln (x : LONGREAL) : LONGREAL;
+PROCEDURE sin (x : LONGREAL) : LONGREAL;
+PROCEDURE cos (x : LONGREAL) : LONGREAL;
+PROCEDURE tan (x : LONGREAL) : LONGREAL;
+PROCEDURE arcsin (x : LONGREAL) : LONGREAL;
+PROCEDURE arccos (x : LONGREAL) : LONGREAL;
+PROCEDURE arctan (x : LONGREAL) : LONGREAL;
+PROCEDURE power (base, exponent : LONGREAL) : LONGREAL;
+PROCEDURE round (x : LONGREAL) : INTEGER;
+PROCEDURE IsRMathException () : BOOLEAN;
+
+END LongMath.

stdlib/longmath.mod

@@ -0,0 +1,40 @@
+IMPLEMENTATION MODULE LongMath;
+IMPORT Math;
+
+PROCEDURE sqrt (x : LONGREAL) : LONGREAL;
+BEGIN RETURN Math.sqrt(x) END sqrt;
+PROCEDURE exp (x : LONGREAL) : LONGREAL;
+BEGIN RETURN Math.exp(x) END exp;
+PROCEDURE ln (x : LONGREAL) : LONGREAL;
+BEGIN RETURN Math.ln(x) END ln;
+PROCEDURE sin (x : LONGREAL) : LONGREAL;
+BEGIN RETURN Math.sin(x) END sin;
+PROCEDURE cos (x : LONGREAL) : LONGREAL;
+BEGIN RETURN Math.cos(x) END cos;
+PROCEDURE tan (x : LONGREAL) : LONGREAL;
+BEGIN RETURN Math.tan(x) END tan;
+PROCEDURE arcsin (x : LONGREAL) : LONGREAL;
+BEGIN RETURN Math.arcsin(x) END arcsin;
+PROCEDURE arccos (x : LONGREAL) : LONGREAL;
+BEGIN RETURN Math.arccos(x) END arccos;
+PROCEDURE arctan (x : LONGREAL) : LONGREAL;
+BEGIN RETURN Math.arctan(x) END arctan;
+PROCEDURE power (base, exponent : LONGREAL) : LONGREAL;
+BEGIN RETURN Math.power(base, exponent) END power;
+
+PROCEDURE round (x : LONGREAL) : INTEGER;
+(* nearest integer, halves away from zero *)
+BEGIN
+  IF x >= 0.0 THEN
+    RETURN VAL(INTEGER, Math.floor(x + 0.5))
+  ELSE
+    RETURN VAL(INTEGER, Math.ceil(x - 0.5))
+  END
+END round;
+
+PROCEDURE IsRMathException () : BOOLEAN;
+BEGIN
+  RETURN FALSE
+END IsRMathException;
+
+END LongMath.

stdlib/longstr.def

@@ -0,0 +1,21 @@
+DEFINITION MODULE LongStr;
+(* ISO 10514-1: conversion between LONGREAL values and string forms.
+   V3 models LONGREAL as REAL (both 64-bit), so this shares RealStr's
+   formatter. *)
+
+IMPORT ConvTypes;
+
+TYPE
+  ConvResults = ConvTypes.ConvResults;
+
+PROCEDURE StrToReal (str : ARRAY OF CHAR; VAR real : LONGREAL;
+                     VAR res : ConvResults);
+PROCEDURE RealToFloat (real : LONGREAL; sigFigs : CARDINAL;
+                       VAR str : ARRAY OF CHAR);
+PROCEDURE RealToEng (real : LONGREAL; sigFigs : CARDINAL;
+                     VAR str : ARRAY OF CHAR);
+PROCEDURE RealToFixed (real : LONGREAL; place : INTEGER;
+                       VAR str : ARRAY OF CHAR);
+PROCEDURE RealToStr (real : LONGREAL; VAR str : ARRAY OF CHAR);
+
+END LongStr.

stdlib/longstr.mod

@@ -0,0 +1,35 @@
+IMPLEMENTATION MODULE LongStr;
+(* LongStr layers on RealStr since V3's LONGREAL is REAL. *)
+
+IMPORT ConvTypes, RealStr;
+
+PROCEDURE StrToReal (str : ARRAY OF CHAR; VAR real : LONGREAL;
+                     VAR res : ConvResults);
+BEGIN
+  RealStr.StrToReal(str, real, res)
+END StrToReal;
+
+PROCEDURE RealToFloat (real : LONGREAL; sigFigs : CARDINAL;
+                       VAR str : ARRAY OF CHAR);
+BEGIN
+  RealStr.RealToFloat(real, sigFigs, str)
+END RealToFloat;
+
+PROCEDURE RealToEng (real : LONGREAL; sigFigs : CARDINAL;
+                     VAR str : ARRAY OF CHAR);
+BEGIN
+  RealStr.RealToEng(real, sigFigs, str)
+END RealToEng;
+
+PROCEDURE RealToFixed (real : LONGREAL; place : INTEGER;
+                       VAR str : ARRAY OF CHAR);
+BEGIN
+  RealStr.RealToFixed(real, place, str)
+END RealToFixed;
+
+PROCEDURE RealToStr (real : LONGREAL; VAR str : ARRAY OF CHAR);
+BEGIN
+  RealStr.RealToStr(real, str)
+END RealToStr;
+
+END LongStr.

stdlib/math.mod

@@ -8,9 +8,14 @@ PROCEDURE sqrt(x : REAL) : REAL;
 PROCEDURE exp(x : REAL) : REAL;
   EXTERNAL;
 
-PROCEDURE ln(x : REAL) : REAL;
+PROCEDURE log(x : REAL) : REAL;
   EXTERNAL;
 
+PROCEDURE ln(x : REAL) : REAL;
+BEGIN
+  RETURN log(x)
+END ln;
+
 PROCEDURE sin(x : REAL) : REAL;
   EXTERNAL;
 
@@ -26,9 +31,14 @@ PROCEDURE asin(x : REAL) : REAL;
 PROCEDURE acos(x : REAL) : REAL;
   EXTERNAL;
 
-PROCEDURE arctan(x : REAL) : REAL;
+PROCEDURE atan(x : REAL) : REAL;
   EXTERNAL;
 
+PROCEDURE arctan(x : REAL) : REAL;
+BEGIN
+  RETURN atan(x)
+END arctan;
+
 PROCEDURE pow(x, y : REAL) : REAL;
   EXTERNAL;
 

stdlib/realstr.def

@@ -0,0 +1,19 @@
+DEFINITION MODULE RealStr;
+(* ISO 10514-1: conversion between REAL values and their string forms. *)
+
+IMPORT ConvTypes;
+
+TYPE
+  ConvResults = ConvTypes.ConvResults;
+
+PROCEDURE StrToReal (str : ARRAY OF CHAR; VAR real : REAL;
+                     VAR res : ConvResults);
+PROCEDURE RealToFloat (real : REAL; sigFigs : CARDINAL;
+                       VAR str : ARRAY OF CHAR);
+PROCEDURE RealToEng (real : REAL; sigFigs : CARDINAL;
+                     VAR str : ARRAY OF CHAR);
+PROCEDURE RealToFixed (real : REAL; place : INTEGER;
+                       VAR str : ARRAY OF CHAR);
+PROCEDURE RealToStr (real : REAL; VAR str : ARRAY OF CHAR);
+
+END RealStr.

stdlib/realstr.mod

@@ -0,0 +1,63 @@
+IMPLEMENTATION MODULE RealStr;
+(* String conversion uses the runtime shim's snprintf formatter
+   (m2realconv); the numeric parse delegates to Conversions. *)
+
+IMPORT ConvTypes, Conversions;
+FROM ConvTypes IMPORT strAllRight, strOutOfRange, strWrongFormat,
+                     strEmpty;
+
+PROCEDURE m2realconv (x : REAL; mode : INTEGER; prec : INTEGER;
+                      VAR s : ARRAY OF CHAR) : INTEGER;
+  EXTERNAL;
+
+PROCEDURE Map (cr : Conversions.ConvResults) : ConvTypes.ConvResults;
+BEGIN
+  IF ORD(cr) = 0 THEN RETURN strAllRight
+  ELSIF ORD(cr) = 1 THEN RETURN strOutOfRange
+  ELSIF ORD(cr) = 2 THEN RETURN strWrongFormat
+  ELSE RETURN strEmpty
+  END
+END Map;
+
+PROCEDURE StrToReal (str : ARRAY OF CHAR; VAR real : REAL;
+                     VAR res : ConvResults);
+  VAR s : ARRAY [0 .. 255] OF CHAR;
+    i : CARDINAL;
+BEGIN
+  real := 0.0;
+  (* Conversions.StrToReal takes a VAR array; copy to a scratch one. *)
+  i := 0;
+  WHILE (i <= HIGH(s)) AND (i <= HIGH(str)) AND (str[i] # CHR(0)) DO
+    s[i] := str[i]; INC(i)
+  END;
+  s[i] := CHR(0);
+  res := Map(Conversions.StrToReal(s, real))
+END StrToReal;
+
+PROCEDURE RealToFloat (real : REAL; sigFigs : CARDINAL;
+                       VAR str : ARRAY OF CHAR);
+  VAR n : INTEGER;
+BEGIN
+  n := m2realconv(real, 1, VAL(INTEGER, sigFigs), str)
+END RealToFloat;
+
+PROCEDURE RealToEng (real : REAL; sigFigs : CARDINAL;
+                     VAR str : ARRAY OF CHAR);
+  VAR n : INTEGER;
+BEGIN
+  n := m2realconv(real, 2, VAL(INTEGER, sigFigs), str)
+END RealToEng;
+
+PROCEDURE RealToFixed (real : REAL; place : INTEGER;
+                       VAR str : ARRAY OF CHAR);
+  VAR n : INTEGER;
+BEGIN
+  n := m2realconv(real, 0, place, str)
+END RealToFixed;
+
+PROCEDURE RealToStr (real : REAL; VAR str : ARRAY OF CHAR);
+BEGIN
+  Conversions.RealToStr(real, str)
+END RealToStr;
+
+END RealStr.

stdlib/sioresult.def

@@ -0,0 +1,20 @@
+DEFINITION MODULE SIOResult;
+(* ISO 10514-1: the read result of the last operation on the default
+   input channel.
+
+   V3 extension: SetReadResult lets the text-IO modules record the
+   status; it is not part of ISO 10514-1 (extra exports are harmless
+   to standard clients). *)
+
+IMPORT IOConsts;
+
+TYPE
+  ReadResults = IOConsts.ReadResults;
+
+PROCEDURE ReadResult () : ReadResults;
+(* The result of the last read on the default input channel. *)
+
+PROCEDURE SetReadResult (r : ReadResults);
+(* Records a new read result (called by STextIO/SWholeIO/SRealIO). *)
+
+END SIOResult.

stdlib/sioresult.mod

@@ -0,0 +1,19 @@
+IMPLEMENTATION MODULE SIOResult;
+IMPORT IOConsts;
+FROM IOConsts IMPORT notKnown;
+
+VAR res : IOConsts.ReadResults;
+
+PROCEDURE ReadResult () : IOConsts.ReadResults;
+BEGIN
+  RETURN res
+END ReadResult;
+
+PROCEDURE SetReadResult (r : IOConsts.ReadResults);
+BEGIN
+  res := r
+END SetReadResult;
+
+BEGIN
+  res := notKnown
+END SIOResult.

stdlib/srealio.def

@@ -0,0 +1,10 @@
+DEFINITION MODULE SRealIO;
+(* ISO 10514-1: real-number I/O over the default channels. *)
+
+PROCEDURE ReadReal (VAR real : REAL);
+PROCEDURE WriteFloat (real : REAL; sigFigs : CARDINAL; width : CARDINAL);
+PROCEDURE WriteEng (real : REAL; sigFigs : CARDINAL; width : CARDINAL);
+PROCEDURE WriteFixed (real : REAL; place : INTEGER; width : CARDINAL);
+PROCEDURE WriteReal (real : REAL; width : CARDINAL);
+
+END SRealIO.

stdlib/srealio.mod

@@ -0,0 +1,75 @@
+IMPLEMENTATION MODULE SRealIO;
+IMPORT IOConsts, SIOResult;
+FROM IOConsts IMPORT allRight;
+
+PROCEDURE m2realconv (x : REAL; mode : INTEGER; prec : INTEGER;
+                      VAR s : ARRAY OF CHAR) : INTEGER;
+  EXTERNAL;
+PROCEDURE m2readreal () : REAL;
+  EXTERNAL;
+PROCEDURE m2writechar (c : CHAR);
+  EXTERNAL;
+PROCEDURE m2write (VAR s : ARRAY OF CHAR);
+  EXTERNAL;
+
+PROCEDURE StrLen (VAR s : ARRAY OF CHAR) : CARDINAL;
+  VAR i : CARDINAL;
+BEGIN
+  i := 0;
+  WHILE (i <= HIGH(s)) AND (s[i] # CHR(0)) DO INC(i) END;
+  RETURN i
+END StrLen;
+
+PROCEDURE WritePadded (VAR s : ARRAY OF CHAR; width : CARDINAL);
+  VAR n, i : CARDINAL;
+BEGIN
+  n := StrLen(s);
+  IF width > n THEN
+    i := width - n;
+    WHILE i > 0 DO m2writechar(" "); DEC(i) END
+  END;
+  m2write(s)
+END WritePadded;
+
+PROCEDURE WriteFloat (real : REAL; sigFigs : CARDINAL; width : CARDINAL);
+  VAR s : ARRAY [0 .. 127] OF CHAR;
+    n : INTEGER;
+BEGIN
+  n := m2realconv(real, 1, VAL(INTEGER, sigFigs), s);
+  WritePadded(s, width)
+END WriteFloat;
+
+PROCEDURE WriteEng (real : REAL; sigFigs : CARDINAL; width : CARDINAL);
+  VAR s : ARRAY [0 .. 127] OF CHAR;
+    n : INTEGER;
+BEGIN
+  n := m2realconv(real, 2, VAL(INTEGER, sigFigs), s);
+  WritePadded(s, width)
+END WriteEng;
+
+PROCEDURE WriteFixed (real : REAL; place : INTEGER; width : CARDINAL);
+  VAR s : ARRAY [0 .. 127] OF CHAR;
+    n : INTEGER;
+BEGIN
+  n := m2realconv(real, 0, place, s);
+  WritePadded(s, width)
+END WriteFixed;
+
+PROCEDURE WriteReal (real : REAL; width : CARDINAL);
+BEGIN
+  (* ISO: fixed if it fits, otherwise floating; approximate by
+     fixed with a width-derived number of places. *)
+  IF width <= 16 THEN
+    WriteFixed(real, 6, width)
+  ELSE
+    WriteFloat(real, 6, width)
+  END
+END WriteReal;
+
+PROCEDURE ReadReal (VAR real : REAL);
+BEGIN
+  real := m2readreal();
+  SIOResult.SetReadResult(allRight)
+END ReadReal;
+
+END SRealIO.

stdlib/stdio.def

@@ -0,0 +1,20 @@
+DEFINITION MODULE StdIO;
+(* Generic character input/output over the default channels, with a
+   stack of pushable procedures (gm2-compatible). *)
+
+TYPE
+  ProcWrite = PROCEDURE (CHAR);
+  ProcRead  = PROCEDURE (VAR CHAR);
+
+PROCEDURE Read (VAR ch : CHAR);
+PROCEDURE Write (ch : CHAR);
+
+PROCEDURE PushOutput (p : ProcWrite);
+PROCEDURE PopOutput;
+PROCEDURE GetCurrentOutput () : ProcWrite;
+
+PROCEDURE PushInput (p : ProcRead);
+PROCEDURE PopInput;
+PROCEDURE GetCurrentInput () : ProcRead;
+
+END StdIO.

stdlib/stdio.mod

@@ -0,0 +1,86 @@
+IMPLEMENTATION MODULE StdIO;
+
+CONST MaxStack = 32;
+
+PROCEDURE m2writechar (c : CHAR);
+  EXTERNAL;
+PROCEDURE m2readchar () : CHAR;
+  EXTERNAL;
+
+VAR
+  outStack : ARRAY [0 .. MaxStack - 1] OF ProcWrite;
+  outTop   : INTEGER;
+  inStack  : ARRAY [0 .. MaxStack - 1] OF ProcRead;
+  inTop    : INTEGER;
+  curOut   : ProcWrite;
+  curIn    : ProcRead;
+
+PROCEDURE DefaultWrite (c : CHAR);
+BEGIN
+  m2writechar(c)
+END DefaultWrite;
+
+PROCEDURE DefaultRead (VAR c : CHAR);
+BEGIN
+  c := m2readchar()
+END DefaultRead;
+
+PROCEDURE Write (ch : CHAR);
+BEGIN
+  curOut(ch)
+END Write;
+
+PROCEDURE Read (VAR ch : CHAR);
+BEGIN
+  curIn(ch)
+END Read;
+
+PROCEDURE PushOutput (p : ProcWrite);
+BEGIN
+  IF outTop < MaxStack THEN
+    outStack[outTop] := curOut;
+    INC(outTop)
+  END;
+  curOut := p
+END PushOutput;
+
+PROCEDURE PopOutput;
+BEGIN
+  IF outTop > 0 THEN
+    DEC(outTop);
+    curOut := outStack[outTop]
+  END
+END PopOutput;
+
+PROCEDURE GetCurrentOutput () : ProcWrite;
+BEGIN
+  RETURN curOut
+END GetCurrentOutput;
+
+PROCEDURE PushInput (p : ProcRead);
+BEGIN
+  IF inTop < MaxStack THEN
+    inStack[inTop] := curIn;
+    INC(inTop)
+  END;
+  curIn := p
+END PushInput;
+
+PROCEDURE PopInput;
+BEGIN
+  IF inTop > 0 THEN
+    DEC(inTop);
+    curIn := inStack[inTop]
+  END
+END PopInput;
+
+PROCEDURE GetCurrentInput () : ProcRead;
+BEGIN
+  RETURN curIn
+END GetCurrentInput;
+
+BEGIN
+  outTop := 0; inTop := 0;
+  curOut := DefaultWrite;
+  curIn := DefaultRead
+END StdIO.

stdlib/stextio.def

@@ -0,0 +1,13 @@
+DEFINITION MODULE STextIO;
+(* ISO 10514-1: character and string I/O over the default channels. *)
+
+PROCEDURE ReadChar (VAR ch : CHAR);
+PROCEDURE ReadRestLine (VAR s : ARRAY OF CHAR);
+PROCEDURE ReadString (VAR s : ARRAY OF CHAR);
+PROCEDURE ReadToken (VAR s : ARRAY OF CHAR);
+PROCEDURE SkipLine;
+PROCEDURE WriteChar (ch : CHAR);
+PROCEDURE WriteLn;
+PROCEDURE WriteString (s : ARRAY OF CHAR);
+
+END STextIO.

stdlib/stextio.mod

@@ -0,0 +1,88 @@
+IMPLEMENTATION MODULE STextIO;
+(* Bound to the runtime shim; the read result is recorded in
+   SIOResult. *)
+
+IMPORT IOConsts, SIOResult;
+FROM IOConsts IMPORT allRight, endOfInput, endOfLine;
+
+PROCEDURE m2write (VAR s : ARRAY OF CHAR);
+  EXTERNAL;
+PROCEDURE m2writeln;
+  EXTERNAL;
+PROCEDURE m2writechar (c : CHAR);
+  EXTERNAL;
+PROCEDURE m2readchar () : CHAR;
+  EXTERNAL;
+PROCEDURE m2readline (VAR s : ARRAY OF CHAR; max : CARDINAL) : CARDINAL;
+  EXTERNAL;
+
+PROCEDURE WriteChar (ch : CHAR);
+BEGIN
+  m2writechar(ch)
+END WriteChar;
+
+PROCEDURE WriteLn;
+BEGIN
+  m2writeln
+END WriteLn;
+
+PROCEDURE WriteString (s : ARRAY OF CHAR);
+BEGIN
+  m2write(s)
+END WriteString;
+
+PROCEDURE ReadChar (VAR ch : CHAR);
+BEGIN
+  ch := m2readchar();
+  IF ch = CHR(0) THEN
+    SIOResult.SetReadResult(endOfInput)
+  ELSE
+    SIOResult.SetReadResult(allRight)
+  END
+END ReadChar;
+
+PROCEDURE ReadString (VAR s : ARRAY OF CHAR);
+  VAR n : CARDINAL;
+BEGIN
+  n := m2readline(s, HIGH(s) + 1);
+  SIOResult.SetReadResult(allRight)
+END ReadString;
+
+PROCEDURE ReadRestLine (VAR s : ARRAY OF CHAR);
+BEGIN
+  ReadString(s)
+END ReadRestLine;
+
+PROCEDURE ReadToken (VAR s : ARRAY OF CHAR);
+  VAR c : CHAR;
+    i : CARDINAL;
+    done : BOOLEAN;
+BEGIN
+  i := 0;
+  (* skip leading spaces/tabs *)
+  REPEAT
+    c := m2readchar()
+  UNTIL (c # " ") AND (c # CHR(9));
+  done := FALSE;
+  WHILE NOT done DO
+    IF (c = CHR(0)) OR (c = CHR(10)) OR (c = " ") OR (c = CHR(9)) THEN
+      done := TRUE
+    ELSE
+      IF i <= HIGH(s) THEN s[i] := c; INC(i) END;
+      c := m2readchar()
+    END
+  END;
+  IF i <= HIGH(s) THEN s[i] := CHR(0) END;
+  SIOResult.SetReadResult(allRight)
+END ReadToken;
+
+PROCEDURE SkipLine;
+  VAR c : CHAR;
+BEGIN
+  REPEAT
+    c := m2readchar()
+  UNTIL (c = CHR(0)) OR (c = CHR(10));
+  SIOResult.SetReadResult(allRight)
+END SkipLine;
+
+END STextIO.

stdlib/strio.def

@@ -0,0 +1,18 @@
+DEFINITION MODULE StrIO;
+(* Simple string / whole-number terminal I/O (gm2-compatible names and
+   extensions).  All output goes to standard output; input is read from
+   standard input. *)
+
+PROCEDURE WriteString (s : ARRAY OF CHAR);
+PROCEDURE WriteLn;
+PROCEDURE WriteChar (c : CHAR);
+PROCEDURE WriteInt (n : INTEGER);
+PROCEDURE WriteCard (n : CARDINAL);
+
+PROCEDURE ReadString (VAR s : ARRAY OF CHAR);
+(* Reads one line from standard input, dropping the newline. *)
+PROCEDURE ReadChar () : CHAR;
+PROCEDURE ReadInt () : INTEGER;
+PROCEDURE ReadCard () : CARDINAL;
+
+END StrIO.

stdlib/strio.mod

@@ -0,0 +1,65 @@
+IMPLEMENTATION MODULE StrIO;
+(* Binds the runtime shim directly. *)
+
+PROCEDURE m2write (VAR s : ARRAY OF CHAR);
+  EXTERNAL;
+PROCEDURE m2writeln;
+  EXTERNAL;
+PROCEDURE m2writechar (c : CHAR);
+  EXTERNAL;
+PROCEDURE m2writeint (n : INTEGER);
+  EXTERNAL;
+PROCEDURE m2readchar () : CHAR;
+  EXTERNAL;
+PROCEDURE m2readint () : INTEGER;
+  EXTERNAL;
+PROCEDURE m2readline (VAR s : ARRAY OF CHAR; max : CARDINAL) : CARDINAL;
+  EXTERNAL;
+
+PROCEDURE WriteString (s : ARRAY OF CHAR);
+BEGIN
+  m2write(s)
+END WriteString;
+
+PROCEDURE WriteLn;
+BEGIN
+  m2writeln
+END WriteLn;
+
+PROCEDURE WriteChar (c : CHAR);
+BEGIN
+  m2writechar(c)
+END WriteChar;
+
+PROCEDURE WriteInt (n : INTEGER);
+BEGIN
+  m2writeint(n)
+END WriteInt;
+
+PROCEDURE WriteCard (n : CARDINAL);
+BEGIN
+  m2writeint(n)
+END WriteCard;
+
+PROCEDURE ReadString (VAR s : ARRAY OF CHAR);
+  VAR n : CARDINAL;
+BEGIN
+  n := m2readline(s, HIGH(s) + 1)
+END ReadString;
+
+PROCEDURE ReadChar () : CHAR;
+BEGIN
+  RETURN m2readchar()
+END ReadChar;
+
+PROCEDURE ReadInt () : INTEGER;
+BEGIN
+  RETURN m2readint()
+END ReadInt;
+
+PROCEDURE ReadCard () : CARDINAL;
+BEGIN
+  RETURN VAL(CARDINAL, m2readint())
+END ReadCard;
+
+END StrIO.

stdlib/swholeio.def

@@ -0,0 +1,9 @@
+DEFINITION MODULE SWholeIO;
+(* ISO 10514-1: whole-number I/O over the default channels. *)
+
+PROCEDURE ReadInt (VAR int : INTEGER);
+PROCEDURE WriteInt (int : INTEGER; width : CARDINAL);
+PROCEDURE ReadCard (VAR card : CARDINAL);
+PROCEDURE WriteCard (card : CARDINAL; width : CARDINAL);
+
+END SWholeIO.

stdlib/swholeio.mod

@@ -0,0 +1,32 @@
+IMPLEMENTATION MODULE SWholeIO;
+IMPORT IOConsts, SIOResult;
+FROM IOConsts IMPORT allRight;
+
+PROCEDURE m2writeintwidth (v : INTEGER; wid : CARDINAL);
+  EXTERNAL;
+PROCEDURE m2readint () : INTEGER;
+  EXTERNAL;
+
+PROCEDURE WriteInt (int : INTEGER; width : CARDINAL);
+BEGIN
+  m2writeintwidth(int, width)
+END WriteInt;
+
+PROCEDURE WriteCard (card : CARDINAL; width : CARDINAL);
+BEGIN
+  m2writeintwidth(VAL(INTEGER, card), width)
+END WriteCard;
+
+PROCEDURE ReadInt (VAR int : INTEGER);
+BEGIN
+  int := m2readint();
+  SIOResult.SetReadResult(allRight)
+END ReadInt;
+
+PROCEDURE ReadCard (VAR card : CARDINAL);
+BEGIN
+  card := VAL(CARDINAL, m2readint());
+  SIOResult.SetReadResult(allRight)
+END ReadCard;
+
+END SWholeIO.

stdlib/sysstorage.def

@@ -0,0 +1,14 @@
+DEFINITION MODULE SysStorage;
+(* gm2's raw heap interface (libc malloc/free/realloc).  ISO's Storage
+   offers the same ALLOCATE/DEALLOCATE with an explicit REALLOCATE
+   signature; SysStorage's REALLOCATE takes only the new size. *)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+PROCEDURE ALLOCATE (VAR a : ADDRESS; size : CARDINAL);
+PROCEDURE DEALLOCATE (VAR a : ADDRESS; size : CARDINAL);
+PROCEDURE REALLOCATE (VAR a : ADDRESS; size : CARDINAL);
+PROCEDURE Available (size : CARDINAL) : BOOLEAN;
+PROCEDURE Init;
+
+END SysStorage.

stdlib/sysstorage.mod

@@ -0,0 +1,38 @@
+IMPLEMENTATION MODULE SysStorage;
+(* Direct libc heap bindings. *)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+PROCEDURE malloc (size : CARDINAL) : ADDRESS;
+  EXTERNAL;
+PROCEDURE free (p : ADDRESS);
+  EXTERNAL;
+PROCEDURE realloc (p : ADDRESS; size : CARDINAL) : ADDRESS;
+  EXTERNAL;
+
+PROCEDURE ALLOCATE (VAR a : ADDRESS; size : CARDINAL);
+BEGIN
+  a := malloc(size)
+END ALLOCATE;
+
+PROCEDURE DEALLOCATE (VAR a : ADDRESS; size : CARDINAL);
+BEGIN
+  free(a);
+  a := NIL
+END DEALLOCATE;
+
+PROCEDURE REALLOCATE (VAR a : ADDRESS; size : CARDINAL);
+BEGIN
+  a := realloc(a, size)
+END REALLOCATE;
+
+PROCEDURE Available (size : CARDINAL) : BOOLEAN;
+BEGIN
+  RETURN TRUE
+END Available;
+
+PROCEDURE Init;
+BEGIN
+END Init;
+
+END SysStorage.

stdlib/wholestr.def

@@ -0,0 +1,17 @@
+DEFINITION MODULE WholeStr;
+(* ISO 10514-1: conversion between whole numbers and their string
+   forms. *)
+
+IMPORT ConvTypes;
+
+TYPE
+  ConvResults = ConvTypes.ConvResults;
+
+PROCEDURE StrToInt (str : ARRAY OF CHAR; VAR int : INTEGER;
+                    VAR res : ConvResults);
+PROCEDURE IntToStr (int : INTEGER; VAR str : ARRAY OF CHAR);
+PROCEDURE StrToCard (str : ARRAY OF CHAR; VAR card : CARDINAL;
+                     VAR res : ConvResults);
+PROCEDURE CardToStr (card : CARDINAL; VAR str : ARRAY OF CHAR);
+
+END WholeStr.

stdlib/wholestr.mod

@@ -0,0 +1,42 @@
+IMPLEMENTATION MODULE WholeStr;
+(* Delegates the numeric work to Conversions and maps its status onto
+   ConvTypes' (identical literal order). *)
+
+IMPORT ConvTypes, Conversions;
+FROM ConvTypes IMPORT strAllRight, strOutOfRange, strWrongFormat,
+                     strEmpty;
+
+PROCEDURE Map (cr : Conversions.ConvResults) : ConvTypes.ConvResults;
+BEGIN
+  IF ORD(cr) = 0 THEN RETURN strAllRight
+  ELSIF ORD(cr) = 1 THEN RETURN strOutOfRange
+  ELSIF ORD(cr) = 2 THEN RETURN strWrongFormat
+  ELSE RETURN strEmpty
+  END
+END Map;
+
+PROCEDURE StrToInt (str : ARRAY OF CHAR; VAR int : INTEGER;
+                    VAR res : ConvResults);
+BEGIN
+  int := 0;
+  res := Map(Conversions.StrToInt(str, int))
+END StrToInt;
+
+PROCEDURE IntToStr (int : INTEGER; VAR str : ARRAY OF CHAR);
+BEGIN
+  Conversions.IntToStr(int, str)
+END IntToStr;
+
+PROCEDURE StrToCard (str : ARRAY OF CHAR; VAR card : CARDINAL;
+                     VAR res : ConvResults);
+BEGIN
+  card := 0;
+  res := Map(Conversions.StrToCard(str, card))
+END StrToCard;
+
+PROCEDURE CardToStr (card : CARDINAL; VAR str : ARRAY OF CHAR);
+BEGIN
+  Conversions.CardToStr(card, str)
+END CardToStr;
+
+END WholeStr.