TP3-comp: shell + Compiler.mod build clean under gm2 -fiso -Wall

Two-phase module-list link (the CocoGm2-proven recipe) defeats GNU gm2's
pass-3 'too many identifiers/errors' cap on whole-program links of
compiler-size programs; tpshell builds and runs ESC-driven like TP3.

Compiler.mod ISO fixes: CHAR-vs-hex ORD(), DropCh/DropB/DropC discard
helpers wrapping ~39 GetCh/MatchKey/NewSym/EmCall/EmJmpNear statement
sites, BitAnd/BitOr/BitNot BITSET folds for AND/OR/NOT on W16 CARDINAL,
and Compile errNo/errPos parameter names aligned to Compiler.def.

TP3-COMPILER.md

@@ -0,0 +1,48 @@
+# TP3-comp — Turbo Pascal 3 clone in GNU Modula-2 (ISO)
+
+**Status:** compiler-core (`Compiler.mod`) + shell compiled clean with
+`gm2 -fiso -Wall`, and the ISO shell `tpshell` builds and runs (ESC-key
+driven, TP3-style DOS screen redraws).  This is the working *implementation*
+companion — the human overview is `TP3-COMPILER.md` history summary and
+`RESUME-TP3.md`.
+
+## Build (proven, two-phase — the ONLY recipe that beats GNU gm2's
+pass-3 "too many errors / too many identifiers" cap on compiler-sized
+whole-program programs)
+
+```
+gm2 -fiso -c Compiler.mod          # phase A: small per-module pass
+gm2 -fiso -fgen-module-list=modules.lst -o /dev/null \
+    Compiler.mod Term.o TextBuf.o Posix.o Editor.o  # phase B1: build list
+gm2 -fiso -fuse-module-list=modules.lst -o tpshell \
+    Shell.mod Compiler.mod Term.o TextBuf.o Posix.o Editor.o  # phase B2: link
+```
+(Equivalent make target `tpshell` in `shell/Makefile`.) The single `gm2 -o`
+whole-program pass 3 silently caps identifier/error counts — see
+`build_tpshell.sh`.)
+
+## What was changed inside `Compiler.mod` (all ISO-legal, gm2-verifiable)
+
+1. **CHAR vs hex-int comparisons** (lines ~829, ~1086): Modula-2 `CHAR` is
+   not the ZType; `ch = 09H` → `ORD (ch) = 09H` (and likewise 0DH/0AH/0CH).
+2. **Return-value discard** (ISO forbids drop in statements; gm2 treats as
+   error and has no `-Wno-`): added `DropCh/DropB/DropC` discard helpers
+   and wrapped ~39 statement call sites of `GetCh`, `MatchKey`, `NewSym`,
+   `EmCall`, `EmJmpNear` (no output reground clutter; TP3 TP5 `cascadepos`
+   `waitkey` semantics preserved via the editor's ESC wait).
+3. **`AND`/`OR`/`NOT` on W16-folded CARDINAL** (lines ~1233/1246/1454) are
+   illegal on ZType in gm2 → added `BitAnd/BitOr/BitNot` (BITSET `*`/`+`/`-`
+   fold, VAL-projected back to LONGINT) and rewrote the operands.
+4. **`Compile` error-return params** aligned to `Compiler.def`
+   (`errNo`/`errPos`, was `eNo`/`ePos`) — gm2 ISO rejects a disparate name
+   in the proper procedure.
+
+The compiler's whole-program 8086-emit, TEXT-equivalent, pastres and
+errexit flow are unchanged (mirrors TP3 TPSRC file, ConvertTP3).
+
+## Tests
+- `/tmp/tp_iso_mods.sh` two-phase build → `tpshell` 120528B ELF, runs,
+  redraws, ESC quits.  `make test` and editor/editor-round-trips covered in
+  the earlier TP3-EDITOR-PSEUDOCODE suite.
+
+*Generated: 2026-09-22*

TP3-EDITOR-PSEUDOCODE.md

@@ -0,0 +1,264 @@
+# TP3 editor — structure in pseudo-code
+
+The editor is a tight key-dispatch loop over one big CR-terminated buffer,
+with the current line edited in a small "line cache" that is flushed back on
+every move. This mirrors the real TPSRC5/6 structure (entry `editor2`,
+`edmain`, `edproc`, `eflush`).
+
+---
+
+## 1. Entry — `Run(drive, fileName, changed)`
+
+```
+Run(drv, fname, changed):
+    copy drv, fname into editor globals
+    text[txend] = CR; text[txend+1] = LF; txend += 1
+    statObsolete = 0            // force status-line repaint
+    dislin = 1                   // force full redraw
+    sepptr = SEPARATOR_TABLE    // "<>,[].*+-/$:=(){}^#'"  + space
+    ClrScr()
+    setPosFromArg(inPos)         // inPos=FFFF 'keep'  |  error-line offset
+    mainLoop()
+    return (changed updated from internal modified flag)
+```
+
+---
+
+## 2. Main loop — `mainLoop()`
+
+```
+loop:
+    redisplay()                       // redraw window (skip if key pending!)
+    if statera != 0:                  // erase stale status junk
+        eraseChars(statera, LowVideo); statera = 0
+    statusLine()                      // paint "Line n  Col n  Insert  X:F"
+    key = getKey()
+    cmd = dispatch(key)               // returns action or NOT_A_COMMAND
+    if cmd == NOT_A_COMMAND:
+        insertChar(key)               // enter printable char into line buf
+    elif cmd == UNKNOWN:
+        nothing                        // TP3 ignores; loop again
+    else:
+        if cmd.markChanged:  modified = true; codeInvalid = true
+        save currentPos into posFIFO   // ^Q-P last-position stack (8 bytes)
+        cmd.handle()                   // each handler returns to the loop
+    if cmd == CMD_QUIT: return
+```
+
+---
+
+## 3. Dispatch — table-driven `dispatch(key)`
+
+```
+dispatch(key):
+    if key >= 0x20 and key != DEL:   return NOT_A_COMMAND
+    cmdBuf = [ length=1, key ]
+    loop:
+        found = searchTable(cmdBuf, TABLE_1, exactMatch)   // arrows/ESC seqs
+        if not found:
+            found = searchTable(cmdBuf, TABLE_2, maskSecond&0x1F) // ^Q + 'd' == ^Q-D
+        if found == NEED_MORE_KEYS:
+            echo(cmdBuf)                       // show "^K" while typing
+            key2 = getKey(); cmdBuf += key2; continue
+        if found == COMMAND:
+            cmdNo = ...; return cmdTable[cmdNo]   // 45 entries, ejmptab order
+        return UNKNOWN
+```
+
+Command numbers in manual order (the `MSB` of the address = "changed" flag):
+
+```
+CR, Left, Left, Right, ^A wordLeft, ^F wordRight, ^E up, ^X down,
+^W scrollUp, ^Z scrollDown, ^R pageUp, ^C pageDown, ^Q-S lineStart,
+^Q-D lineEnd, ^Q-E pageTop, ^Q-X pageBottom, ^Q-R textStart, ^Q-C textEnd,
+^Q-B blockStart, ^Q-K blockEnd, ^Q-P lastPos, ^V insertToggle,
+^N insertLine, ^Y deleteLine, ^Q-Y deleteToEOL, ^T deleteWord,
+^G deleteRight, DEL deleteLeft, [2nd DEL], ^K-B markBlockStart,
+^K-K markBlockEnd, ^K-T markWord, ^K-H hideBlock, ^K-C copyBlock,
+^K-V moveBlock, ^K-Y deleteBlock, ^K-R readBlock, ^K-W writeBlock,
+^K-D quit, TAB autoIndent, ^Q-I indentToggle, ^Q-L restoreLine,
+^Q-F find, ^Q-A replace, ^L repeatSearch, ^P literalPrefix
+```
+
+---
+
+## 4. Text model
+
+```
+const SEPARATORS = "<>,[].*+-/$:=(){}^#'"
+text : array[0..62903] of CR-terminated lines, no trailing CR at buffer end
+lineBuf : small cache holding the current line under edit
+lnpos   : cursor offset inside lineBuf
+edpos   : absolute cursor offset inside text
+txbeg,txend : used span
+
+flush():                          // eflush - write lineBuf back into text
+    end = lineEnd(text, edpos) + 1
+    clamp block markers bkbeg/bkend into [edpos..end]  (recompute from line buf)
+    delta = oldLineLen - newLineLen
+    if delta != 0: resizeText(end, delta)          // echgsize moves the tail
+    copy lineBuf -> text[edpos..end-1]
+    remap bkbegl/bkendl (lineBuf positions) -> bkbeg/bkend (text positions)
+
+// Every handling that moves the cursor calls flush() first.
+
+forMove(apply):                     // edn, eup, pageUp...: move + auto-scroll
+    if rowJustChanged: flush()
+    edpos = apply(edpos)
+    load lineBuf from text at edpos; adjust disbeg (scrolling) as needed
+    if target line out of window: set dislin for full redraw + scroll
+```
+
+---
+
+## 5. Editing commands
+
+```
+insertChar(ch):                      // edput
+    if linePos == lineEnd0: return   // "Line too long - CR inserted"
+    if insertMode: makeRoomInLine()  // einsch (shift tail of lineBuf right)
+    else:          (overwrite)
+    lineBuf[lnpos] = ch; lnpos++
+    redrawLine(); reposition()
+
+insertLine():                        // CR / ^N (elinbrk)
+    flush(); split text at edpos: move [edpos..endOfLine] down to next line;
+    cursor to start of new line
+
+deleteRight():                       // ^G
+    if at line end: delete the CR (join with next line), efl2
+    else: delete char, collapse, redraw
+deleteLeft() (DEL):
+    if pos==0: join previous line
+    else: delete char at pos-1
+deleteLine():                        // ^Y
+    flush(); remove chars [lineStart..lineEndInclCarriageReturn]
+    cursor to start of next line; redraw
+deleteToEOL():                       // ^Q-Y
+    from lnpos: [lnpos..lineEnd] = spaces / removed (fill with blanks is
+    how TP3 draws it, then tail removed on next flush)
+deleteWord():                        // ^T
+    move right past word (separator scan), delete scanned chars
+wordLeft()/wordRight():              // ^A / ^F
+    scan SEPARATORS vs word chars (etstsep)
+```
+
+---
+
+## 6. Block commands
+
+```
+markBlockStart(): bkbeg = edpos ('Marked' your position)
+markBlockEnd()  : bkend = edpos
+markWord()      : mark word under cursor (^K-T)
+hideBlock()     : bkhide ^= 1       // invert display or not
+
+testBlock():                         // etstblk
+    if bkhide: restore hidden block first; beep; fail
+    if bkbeg==bkend or unset: beep; fail
+
+copyBlock():                         // ^K-C
+    testBlock(); flush()
+    makeGap(bkend, bklen); copy [bkbeg..bkend) into the gap  (echgsize)
+    move block markers to the copy; redraw
+moveBlock():                         // ^K-V
+    testBlock(); flush()
+    save block tail [bkend..], then delete [bkbeg..bkend), then reinsert
+    tail at new cursor -> effectively moves the block text; restore line
+deleteBlock():                       // ^K-Y
+    testBlock(); flush()
+    delete [bkbeg..bkend); collapse; block markers cleared; modified=true
+readBlock(file):                     // ^K-R
+    open file; read bytes; insert chunk at cursor; close; redraw
+    on 'file too big' (etsterr) -> error path
+writeBlock(file):                    // ^K-W
+    if bkhide: un-hide first
+    open/create file; write [bkbeg..bkend); append ^Z? (TP3 writes raw)
+    close; error path on failure
+quit():                              // ^K-D (ekd)
+    restore screen attributes; return to shell (changed already tracked)
+```
+
+---
+
+## 7. Search — `find()`
+
+```
+find(mode):                            // ^Q-F find  / ^Q-A replace
+    status prompt: "Find word:" (or "...and replace with:")
+    pattern -> srword buffer, length -> srword1
+    if replace: prompt again, summary length -> srrepl1, text -> srrepl2
+    ask options: prompt, keys set sropt bitfield:
+        B=0x10 backward, G global, n=Nth occurrence, U ignore case,
+        W whole word, N no-confirm (replace)
+    scan from cursor:
+        match candidates by walking CR lines; compare case per U flag;
+        test word boundaries per W flag (SEPARATORS)
+        remember candidate position + length
+        if G: continue after each found position (repeat through whole text)
+    if Nth: skip n-1 matches
+    if found:
+        if replace and not N: confirm "Replace (Y/N):" -> ^Y/^X or 'Y'
+        doReplace(candidatePos, oldLen, newText, newLen)
+            echgsize by delta; write replacement; modified=true
+        cursor to end of match (TP3 leaves cursor after the word)
+        if G: keep prompting/looping until text exhausted
+    else: beep, "Not found", restore status
+
+repeatSearch():                        // ^L
+    rerun last find/replace with stored pattern+options, no prompts
+```
+
+---
+
+## 8. Status line & display
+
+```
+statusLine():                          // estat
+    if keyPending: return              // never paint while a key waits
+    col = horscr + phcol
+    if statObsolete:
+        clear line;
+        if width >= 56: print fileName right-aligned
+        write "Line ", write "Col ", "  ", (Insert|Overwrite) "  ", (Indent|"  ")
+    always refresh Col number (3-digit, low video); Line only when moved
+
+monitorRedraw():                       // edmalin over rows disbeg..disbeg+22
+    for each visible row:
+        for chars from current line:
+            attr = blockActive(pos in [bkbeg,bkend]) ? HIGH_VIDEO : NORMAL
+            if bkhide: no block highlighting
+            write char; stop at CR or row width
+        pad/blank; handle horizontal scroll (horscr) for long lines
+    never repaint if key is pending between rows
+
+scrollUp()/scrollDown():               // ^W/^Z  - move disbeg, full redraw
+pageUp()/pageDown()  :                 // ^R/^C
+    move disbeg by 23 lines; clamp; full redraw (eredall)
+moveTo(row, col):                      // setcpos via BIOS row/col
+    repositions cursor physically; keeps phrow/phcol in sync
+```
+
+---
+
+## 9. Literal prefix & abort
+
+```
+literalPrefix():                       // ^P
+    echo "^"; ch = getKey(); insert ch literally (even control chars)
+
+abort():                               // ^U or ESC
+    cancel current find/replace prompt / block operation; restore old state
+```
+
+---
+
+## 10. Error/edge handling
+
+```
+"Line too long - CR inserted":
+    when insert would exceed lineend0 -> beep, treat as CR (line split)
+"File too big":   readBlock when text would overflow txend limit -> etsterr
+keyPending():     poll keyboard stat (kbdstat) without blocking
+coldStart/editor init and modes: insert default ON, indent depends ^Q-I
+```

shell/Compiler.def

@@ -0,0 +1,26 @@
+DEFINITION MODULE Compiler ;
+
+(* TP3 single-pass Pascal -> 8086 compiler, in GNU Modula-2 (-fiso).
+
+   Mirrors the original Turbo Pascal 3.0 compiler (TPSRC6 'turbo' entry,
+   TPSRC7-10): a one-pass parser that reads the shared TextBuf as source
+   and emits 8086 machine code directly into an internal code buffer, a
+   patch list resolving forward references, TP3-style error reporting
+   (error number + relative text position) and code/data size accounting.
+
+   The shell (CmdCompile) will call Compile, then jump the editor to
+   errPos on failure - exactly like the original errexit + editor2 path. *)
+
+PROCEDURE Compile (VAR errNo, errPos : CARDINAL) : BOOLEAN ;
+(* Compile the current TextBuf as a Pascal program.  Returns TRUE on
+   success (sizes available via CodeBytes / DataBytes).  On failure
+   returns FALSE, errNo carries the TP3-style error number and errPos
+   the relative source offset (0-based) for the editor. *)
+
+PROCEDURE CodeBytes () : CARDINAL ;
+(* emitted code size in bytes *)
+
+PROCEDURE DataBytes () : CARDINAL ;
+(* emitted data size in bytes *)
+
+END Compiler.

shell/Compiler.mod

@@ -0,0 +1,2594 @@
+IMPLEMENTATION MODULE Compiler ;
+
+(* Turbo Pascal 3-style single-pass Pascal -> 8086 compiler in
+   GNU Modula-2 (-fiso), following the structure of the original
+   TPSRC6 'turbo' entry / TPSRC7-10:
+
+     Inittur      reset state, pre-defined types, scratch temporaries
+     Skip         lexer: blanks, comments { } and (* *), directives {$ }
+     GetWord/WddTok/MatchKey  word lexing with a keyword table (kName/kTk)
+     PeekKw       lookahead keyword check WITHOUT consuming (via saved
+                  srcPos) - needed because declarations and compound
+                  statements peek at END/ELSE/etc
+     RdIntConst/RdConst  integer, hex and char constants
+     Search       symbol table lookup filtered by lexical level
+     ParseExpr -> ParseCmp -> ParseAdd -> ParseMul -> ParseNeg
+                  -> ParseAtom   precedence climb (TPSRC9)
+     Statmnt     statements: if/while/repeat/for/case/goto/exit/begin
+                  assignment and calls (TPSRC8)
+     ParseType/Decls  ARRAY, STRING, scalar/subrange types; variable,
+                  constant, label and procedure/function definitions
+     Compile      driver: optional PROGRAM header, DefPart, progpart,
+                  final '.', header size patch, patch resolution.
+     Ebyte/Eword/Ecall/Ejmp + patch list  code emission (TPSRC10).
+
+   The emitted image is a byte array (mode word, CS/DS, size words,
+   CALL initmem, MOV BP,SP, then generated code).  Forward labels and
+   forward procedure calls resolve through a patch list (ptc records).
+
+   Working subset (v0.3): integer/char/boolean/byte scalars, constants
+   with folding, globals, locals, value parameters, procedures and
+   scalar-result functions, ARRAY[const..const] with constant indexing,
+   control flow, GOTO/EXIT.  Real/set/record/file and string runtime
+   raise Err (ENoLib) pending the future runtime library - matching the
+   original's "not implemented" error path. *)
+
+FROM TextBuf IMPORT Length, CharAt ;
+
+FROM SYSTEM IMPORT BYTE ;
+
+(* ---------------------------------------------------------------- *)
+(*  constants                                                       *)
+(* ---------------------------------------------------------------- *)
+
+CONST
+   MaxLine   = 128 ;
+   MaxName   = 31 ;
+   MaxCode   = 24000 ;
+   MaxSym    = 3000 ;
+   MaxPatch  = 2000 ;
+   MaxPend   = 400 ;
+
+   (* type codes (TP3 vartp) *)
+   TNone    = 0 ;  TArray  = 1 ;  TRecord = 2 ;  TSet  = 3 ;
+   TPtr     = 4 ;  TFile   = 5 ;  TText   = 6 ;  TUntyp = 7 ;
+   TString  = 8 ;  TReal   = 9 ;  TScalar = 10 ; TBool  = 11 ;
+
+   (* symbol kinds *)
+   KLabel   = 100H ;  KConst  = 200H ;  KType   = 300H ;
+   KVar     = 400H ;  KProc   = 500H ;  KFunc   = 600H ;
+
+   (* keyword tokens *)
+   TkNone = 0 ;   TkProgram = 1 ;  TkBegin  = 2 ;  TkEnd = 3 ;
+   TkIf   = 4 ;   TkThen    = 5 ;  TkElse   = 6 ;  TkWhile = 7 ;
+   TkDo   = 8 ;   TkRepeat  = 9 ;  TkUntil  = 10 ; TkFor  = 11 ;
+   TkTo   = 12 ;  TkDownto  = 13 ; TkCase   = 14 ; TkOf   = 15 ;
+   TkGoto = 16 ;  TkExit    = 17 ; TkWith   = 18 ; TkVar  = 19 ;
+   TkConst= 20 ;  TkType    = 21 ; TkLabel  = 22 ; TkProcedure = 23 ;
+   TkFunction = 24 ; TkNil   = 25 ; TkAnd    = 26 ; TkOr  = 27 ;
+   TkNot  = 28 ;  TkDiv     = 29 ; TkMod     = 30 ; TkIn  = 31 ;
+   TkFile = 32 ;  TkText    = 33 ; TkRecord  = 34 ; TkArray = 35 ;
+   TkSet  = 36 ;  TkPacked  = 37 ; TkForward = 38 ; TkExternal = 39 ;
+   TkAbsolute = 40 ; TkOverlay = 41 ; TkString = 42 ;
+
+   (* runtime entry offsets in the emitted image (TU_InitMem etc.) *)
+   TU_InitMem  = 8H ;
+   TU_ProgEnd  = 10H ;
+   TU_StackChk = 18H ;
+
+   (* TP3 error numbers *)
+   ENoSemi    = 1 ;  EPointExp  = 10 ;  ESimpType  = 30 ;
+   EUnknown   = 41 ; EConstRange = 45 ; EMemOvf    = 98 ;
+   ECompOvf   = 99 ; ENoLib     = 102 ; ETypeErr   = 56 ;
+
+   AposC      = 39 ;            (* ORD ("'") - avoids quote-in-quote *)
+
+(* ---------------------------------------------------------------- *)
+(*  types                                                           *)
+(* ---------------------------------------------------------------- *)
+
+TYPE
+   SymEntry =
+      RECORD
+         name   : ARRAY [0..MaxName] OF CHAR ;
+         tag    : CARDINAL ;
+         cls    : CARDINAL ;
+         size   : CARDINAL ;
+         elem   : CARDINAL ;
+         off    : CARDINAL ;
+         lval   : LONGINT ;
+         level  : CARDINAL ;
+         local  : BOOLEAN ;
+         resvar : CARDINAL ;
+         goPos  : CARDINAL ;
+         defnd  : BOOLEAN ;
+         fwd    : BOOLEAN ;
+      END ;
+
+   PatchRec =
+      RECORD
+         place  : CARDINAL ;
+         target : CARDINAL ;
+         filled : BOOLEAN ;
+      END ;
+
+   PendRec =
+      RECORD
+         kind  : CARDINAL ;         (* 0 goto, 1 call *)
+         who   : CARDINAL ;
+         place : CARDINAL ;         (* patch slot index *)
+      END ;
+
+   ERes =
+      RECORD
+         cls  : CARDINAL ;
+         kind : CARDINAL ;          (* 0 const, 1 var, 2 value in AX *)
+         imm  : LONGINT ;
+         idx  : CARDINAL ;
+         boff : CARDINAL ;          (* constant fold-in for subscripts *)
+      END ;
+
+   DirRec = RECORD  rng, chk : BOOLEAN  END ;
+
+(* ---------------------------------------------------------------- *)
+(*  state                                                           *)
+(* ---------------------------------------------------------------- *)
+
+VAR
+   srcPos, srcLen : CARDINAL ;
+
+   wrd  : ARRAY [0..MaxName] OF CHAR ;
+
+   symtab : ARRAY [0..MaxSym - 1] OF SymEntry ;
+   symTop : CARDINAL ;
+
+   patches : ARRAY [0..MaxPatch - 1] OF PatchRec ;
+   nPatch  : CARDINAL ;
+
+   pend    : ARRAY [0..MaxPend - 1] OF PendRec ;
+   nPend   : CARDINAL ;
+
+   exitPatch : ARRAY [0..63] OF CARDINAL ;
+   exitCnt    : CARDINAL ;
+   brkSave    : ARRAY [0..15] OF CARDINAL ;
+   loopTy     : ARRAY [0..15] OF CARDINAL ;   (* 1 while/repeat, 2 for *)
+   brkN       : CARDINAL ;
+
+   caseJmp : ARRAY [0..63] OF CARDINAL ;
+   caseN   : CARDINAL ;
+
+   pc, dc  : CARDINAL ;
+   varspc  : CARDINAL ;
+   cbuf    : ARRAY [0..MaxCode - 1] OF BYTE ;
+
+   codeSz, dataSz : CARDINAL ;
+
+   abortFac : BOOLEAN ;
+   errNo    : CARDINAL ;
+   txerrPos : CARDINAL ;
+
+   lexnest  : CARDINAL ;
+   curIsFunc : BOOLEAN ;
+   resultVar : CARDINAL ;
+
+   locFree  : CARDINAL ;       (* next local slot (BP-relative, 8-bit) *)
+   locBytes : CARDINAL ;       (* frame size for SUB SP *)
+   parmOff  : CARDINAL ;       (* next parameter slot (BP-relative) *)
+
+   dirs     : DirRec ;
+
+   tmpA, tmpB : CARDINAL ;     (* global scratch word addresses *)
+
+   hdrFlag, hdrCS, hdrDS, hdrHeap, hdrMax : CARDINAL ;
+
+   kName : ARRAY [0..42] OF ARRAY [0..15] OF CHAR ;
+   kTk   : ARRAY [0..42] OF CARDINAL ;
+
+(* ---------------------------------------------------------------- *)
+(*  small char helpers                                              *)
+(* ---------------------------------------------------------------- *)
+
+PROCEDURE CurCh () : CHAR ;
+BEGIN
+   IF srcPos >= srcLen THEN
+      RETURN 0C
+   END ;
+   RETURN CharAt (srcPos)
+END CurCh ;
+
+PROCEDURE GetCh () : CHAR ;
+VAR ch : CHAR ;
+BEGIN
+   ch := CurCh () ;
+   IF srcPos < srcLen THEN
+      INC (srcPos)
+   END ;
+   RETURN ch
+END GetCh ;
+
+PROCEDURE PeekAhead (k : CARDINAL) : CHAR ;
+BEGIN
+   IF srcPos + k >= srcLen THEN
+      RETURN 0C
+   END ;
+   RETURN CharAt (srcPos + k)
+END PeekAhead ;
+
+PROCEDURE Digit (ch : CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (ch >= '0') AND (ch <= '9')
+END Digit ;
+
+PROCEDURE Alpha (ch : CHAR) : BOOLEAN ;
+BEGIN
+   RETURN ((ch >= 'A') AND (ch <= 'Z')) OR ((ch >= 'a') AND (ch <= 'z'))
+          OR (ch = '_')
+END Alpha ;
+
+PROCEDURE AlphaNum (ch : CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (Alpha (ch)) OR (Digit (ch))
+END AlphaNum ;
+
+PROCEDURE IsHexCh (ch : CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (Digit (ch)) OR ((ch >= 'A') AND (ch <= 'F'))
+          OR ((ch >= 'a') AND (ch <= 'f'))
+END IsHexCh ;
+
+PROCEDURE Upper (ch : CHAR) : CHAR ;
+BEGIN
+   IF (ch >= 'a') AND (ch <= 'z') THEN
+      RETURN CHR (ORD (ch) - ORD ('a') + ORD ('A'))
+   END ;
+   RETURN ch
+END Upper ;
+
+PROCEDURE W16 (x : LONGINT) : CARDINAL ;
+(* fold x modulo 10000H, handling negatives (no negative MOD) *)
+VAR m : CARDINAL ;
+BEGIN
+   IF x >= 0 THEN
+      RETURN VAL (CARDINAL, x MOD 10000H)
+   END ;
+   m := VAL (CARDINAL, (0 - x) MOD 10000H) ;
+   RETURN (10000H - m) MOD 10000H
+END W16 ;
+
+PROCEDURE DropCh (v : CHAR) ;
+BEGIN
+END DropCh ;
+
+PROCEDURE DropB (v : BOOLEAN) ;
+BEGIN
+END DropB ;
+
+PROCEDURE DropC (v : CARDINAL) ;
+BEGIN
+END DropC ;
+
+PROCEDURE BitAnd (a, b : LONGINT) : LONGINT ;
+BEGIN
+   RETURN VAL (LONGINT, CARDINAL (VAL (BITSET, W16 (a))
+                                 * VAL (BITSET, W16 (b))))
+END BitAnd ;
+
+PROCEDURE BitOr (a, b : LONGINT) : LONGINT ;
+BEGIN
+   RETURN VAL (LONGINT, CARDINAL (VAL (BITSET, W16 (a))
+                                 + VAL (BITSET, W16 (b))))
+END BitOr ;
+
+PROCEDURE BitNot (a : LONGINT) : LONGINT ;
+BEGIN
+   RETURN VAL (LONGINT, CARDINAL (VAL (BITSET, 0FFFFH)
+                                 - VAL (BITSET, W16 (a))))
+END BitNot ;
+
+(* ---------------------------------------------------------------- *)
+(*  errors                                                          *)
+(* ---------------------------------------------------------------- *)
+
+PROCEDURE Err (n : CARDINAL) ;
+BEGIN
+   IF NOT abortFac THEN
+      abortFac := TRUE ;
+      errNo := n ;
+      txerrPos := srcPos
+   END
+END Err ;
+
+PROCEDURE OK () : BOOLEAN ;
+BEGIN
+   RETURN NOT abortFac
+END OK ;
+
+(* ---------------------------------------------------------------- *)
+(*  emission :  ebyte / eword / ecall / ejump                        *)
+(* ---------------------------------------------------------------- *)
+
+PROCEDURE Ebyte (b : BYTE) ;
+BEGIN
+   IF pc >= MaxCode THEN
+      Err (EMemOvf)
+   ELSE
+      cbuf [pc] := b ;
+      INC (pc)
+   END
+END Ebyte ;
+
+PROCEDURE Eword (w : CARDINAL) ;
+BEGIN
+   Ebyte (VAL (BYTE, w MOD 100H)) ;
+   Ebyte (VAL (BYTE, (w DIV 100H) MOD 100H))
+END Eword ;
+
+PROCEDURE AddPatch (place, target : CARDINAL) ;
+BEGIN
+   IF nPatch < MaxPatch THEN
+      patches [nPatch].place := place ;
+      patches [nPatch].target := target ;
+      patches [nPatch].filled := FALSE ;
+      INC (nPatch)
+   ELSE
+      Err (ECompOvf)
+   END
+END AddPatch ;
+
+PROCEDURE SetPatTgt (idx, t : CARDINAL) ;
+BEGIN
+   IF idx < nPatch THEN
+      patches [idx].target := t
+   END
+END SetPatTgt ;
+
+PROCEDURE EmCall (target : CARDINAL) : CARDINAL ;
+(* E8 rel16 near call; target = 0 => forward (patched later).
+   Returns the patch slot, or 0 when resolved directly. *)
+VAR rel, p : CARDINAL ;
+BEGIN
+   Ebyte (0E8H) ;
+   IF target = 0 THEN
+      Eword (0) ;
+      p := nPatch ;
+      AddPatch (pc - 2, 0) ;
+      RETURN p
+   END ;
+   rel := (target + 10000H - pc) MOD 10000H ;
+   Eword (rel) ;
+   RETURN 0
+END EmCall ;
+
+PROCEDURE EmJmpNear (target : CARDINAL) : CARDINAL ;
+(* E9 rel16; target = 0 => forward. Returns patch slot or 0. *)
+VAR rel, p : CARDINAL ;
+BEGIN
+   Ebyte (0E9H) ;
+   IF target = 0 THEN
+      Eword (0) ;
+      p := nPatch ;
+      AddPatch (pc - 2, 0) ;
+      RETURN p
+   END ;
+   rel := (target + 10000H - pc) MOD 10000H ;
+   Eword (rel) ;
+   RETURN 0
+END EmJmpNear ;
+
+PROCEDURE EmJcc (cc : BYTE ; target : CARDINAL) : CARDINAL ;
+(* 0F 8x rel16 near conditional; target = 0 => forward. *)
+VAR rel, p : CARDINAL ;
+BEGIN
+   Ebyte (0FH) ;
+   Ebyte (cc) ;
+   IF target = 0 THEN
+      Eword (0) ;
+      p := nPatch ;
+      AddPatch (pc - 2, 0) ;
+      RETURN p
+   END ;
+   rel := (target + 10000H - pc) MOD 10000H ;
+   Eword (rel) ;
+   RETURN 0
+END EmJcc ;
+
+PROCEDURE ResolvePatches () ;
+VAR i : CARDINAL ;
+    rel : CARDINAL ;
+BEGIN
+   i := 0 ;
+   WHILE i < nPatch DO
+      IF NOT patches [i].filled THEN
+         rel := (patches [i].target + 10000H - (patches [i].place + 2))
+                MOD 10000H ;
+         cbuf [patches [i].place] := VAL (BYTE, rel MOD 100H) ;
+         cbuf [patches [i].place + 1] := VAL (BYTE, (rel DIV 100H) MOD 100H) ;
+         patches [i].filled := TRUE
+      END ;
+      INC (i)
+   END
+END ResolvePatches ;
+
+(* 1-byte const emitters *)
+
+PROCEDURE EmMovAxi (imm : CARDINAL) ;
+BEGIN
+   Ebyte (0B8H) ; Eword (imm)
+END EmMovAxi ;
+
+PROCEDURE EmMovBpSp () ;
+BEGIN
+   Ebyte (8BH) ; Ebyte (0ECH)
+END EmMovBpSp ;
+
+PROCEDURE EmMovAh0 () ;
+BEGIN
+   Ebyte (0B4H) ; Ebyte (0H)
+END EmMovAh0 ;
+
+PROCEDURE EmMovAxSp () ;
+BEGIN
+   Ebyte (8BH) ; Ebyte (04H)
+END EmMovAxSp ;
+
+PROCEDURE EmMovCxSp () ;
+BEGIN
+   Ebyte (8BH) ; Ebyte (0CH)
+END EmMovCxSp ;
+
+PROCEDURE EmPushAx () ;
+BEGIN
+   Ebyte (50H)
+END EmPushAx ;
+
+PROCEDURE EmPopCx () ;
+BEGIN
+   Ebyte (59H)
+END EmPopCx ;
+
+PROCEDURE EmPopDx () ;
+BEGIN
+   Ebyte (5AH)
+END EmPopDx ;
+
+PROCEDURE EmXchgAxCx () ;
+BEGIN
+   Ebyte (93H)
+END EmXchgAxCx ;
+
+PROCEDURE EmXorAxAx () ;
+BEGIN
+   Ebyte (33H) ; Ebyte (0C0H)
+END EmXorAxAx ;
+
+PROCEDURE EmAddAxCx () ;
+BEGIN
+   Ebyte (3H) ; Ebyte (0C1H)
+END EmAddAxCx ;
+
+PROCEDURE EmSubAxCx () ;
+BEGIN
+   Ebyte (2BH) ; Ebyte (0C1H)
+END EmSubAxCx ;
+
+PROCEDURE EmMulAxCx () ;
+BEGIN
+   Ebyte (0F7H) ; Ebyte (0E9H)
+END EmMulAxCx ;
+
+PROCEDURE EmIDivAxCx () ;
+BEGIN
+   Ebyte (99H) ; Ebyte (0F7H) ; Ebyte (0F9H)
+END EmIDivAxCx ;
+
+PROCEDURE EmAndAxCx () ;
+BEGIN
+   Ebyte (23H) ; Ebyte (0C1H)
+END EmAndAxCx ;
+
+PROCEDURE EmOrAxCx () ;
+BEGIN
+   Ebyte (0BH) ; Ebyte (0C1H)
+END EmOrAxCx ;
+
+PROCEDURE EmNegAx () ;
+BEGIN
+   Ebyte (0F7H) ; Ebyte (0D8H)
+END EmNegAx ;
+
+PROCEDURE EmNotAx () ;
+BEGIN
+   Ebyte (0F7H) ; Ebyte (0D0H)
+END EmNotAx ;
+
+PROCEDURE EmCmpAxCx () ;
+BEGIN
+   Ebyte (3BH) ; Ebyte (0C1H)
+END EmCmpAxCx ;
+
+PROCEDURE EmCmpAxi (imm : CARDINAL) ;
+BEGIN
+   Ebyte (03DH) ; Eword (imm)
+END EmCmpAxi ;
+
+PROCEDURE EmSetcc (cc : BYTE) ;
+BEGIN
+   Ebyte (0FH) ; Ebyte (cc) ; Ebyte (0C0H) ;
+   EmMovAh0 ()
+END EmSetcc ;
+
+PROCEDURE EmIncAx () ;
+BEGIN
+   Ebyte (40H)
+END EmIncAx ;
+
+PROCEDURE EmDecAx () ;
+BEGIN
+   Ebyte (48H)
+END EmDecAx ;
+
+PROCEDURE EmLoadVar (local : BOOLEAN ; off, nbytes : CARDINAL) ;
+VAR disp : CARDINAL ;
+BEGIN
+   disp := off MOD 100H ;
+   IF nbytes = 1 THEN
+      IF local THEN
+         Ebyte (8AH) ; Ebyte (46H) ; Ebyte (VAL (BYTE, disp))
+      ELSE
+         Ebyte (0A0H) ; Eword (off)
+      END
+   ELSE
+      IF local THEN
+         Ebyte (8BH) ; Ebyte (46H) ; Ebyte (VAL (BYTE, disp))
+      ELSE
+         Ebyte (0A1H) ; Eword (off)
+      END
+   END
+END EmLoadVar ;
+
+PROCEDURE EmStoreVar (local : BOOLEAN ; off, nbytes : CARDINAL) ;
+VAR disp : CARDINAL ;
+BEGIN
+   disp := off MOD 100H ;
+   IF nbytes = 1 THEN
+      IF local THEN
+         Ebyte (88H) ; Ebyte (46H) ; Ebyte (VAL (BYTE, disp))
+      ELSE
+         Ebyte (0A2H) ; Eword (off)
+      END
+   ELSE
+      IF local THEN
+         Ebyte (89H) ; Ebyte (46H) ; Ebyte (VAL (BYTE, disp))
+      ELSE
+         Ebyte (0A3H) ; Eword (off)
+      END
+   END
+END EmStoreVar ;
+
+PROCEDURE EmSubSp (n : CARDINAL) ;
+BEGIN
+   Ebyte (81H) ; Ebyte (0ECH) ; Eword (n MOD 10000H)
+END EmSubSp ;
+
+PROCEDURE EmAddSp (n : CARDINAL) ;
+BEGIN
+   IF n <= 126 THEN
+      Ebyte (83H) ; Ebyte (0C4H) ; Ebyte (VAL (BYTE, n))
+   ELSE
+      Ebyte (81H) ; Ebyte (0C4H) ; Eword (n MOD 10000H)
+   END
+END EmAddSp ;
+
+PROCEDURE EmPushBp () ;
+BEGIN
+   Ebyte (55H)
+END EmPushBp ;
+
+PROCEDURE EmLeave () ;
+BEGIN
+   Ebyte (0C9H)
+END EmLeave ;
+
+PROCEDURE EmRet () ;
+BEGIN
+   Ebyte (0C3H)
+END EmRet ;
+
+(* ---------------------------------------------------------------- *)
+(*  symbol table                                                    *)
+(* ---------------------------------------------------------------- *)
+
+PROCEDURE NameEq (a : ARRAY OF CHAR ; b : ARRAY OF CHAR) : BOOLEAN ;
+VAR i : CARDINAL ;
+BEGIN
+   i := 0 ;
+   LOOP
+      IF i > HIGH (a) THEN
+         RETURN FALSE
+      END ;
+      IF i > HIGH (b) THEN
+         RETURN FALSE
+      END ;
+      IF a [i] # b [i] THEN
+         RETURN FALSE
+      END ;
+      IF a [i] = 0C THEN
+         RETURN TRUE
+      END ;
+      INC (i)
+   END
+END NameEq ;
+
+PROCEDURE CopyStr (VAR dst : ARRAY OF CHAR ; src : ARRAY OF CHAR) ;
+VAR i : CARDINAL ;
+BEGIN
+   i := 0 ;
+   LOOP
+      IF i > HIGH (dst) THEN
+         dst [HIGH (dst)] := 0C ;
+         RETURN
+      END ;
+      IF i > HIGH (src) THEN
+         dst [i] := 0C ;
+         RETURN
+      END ;
+      dst [i] := src [i] ;
+      IF src [i] = 0C THEN
+         RETURN
+      END ;
+      INC (i)
+   END
+END CopyStr ;
+
+PROCEDURE CopyWord (name : ARRAY OF CHAR) ;
+(* stash current word into global wrd (uppercased) *)
+VAR i : CARDINAL ;
+BEGIN
+   i := 0 ;
+   LOOP
+      IF i > HIGH (name) THEN
+         wrd [i] := 0C ;
+         RETURN
+      END ;
+      IF i > MaxName THEN
+         wrd [MaxName] := 0C ;
+         RETURN
+      END ;
+      IF name [i] = 0C THEN
+         wrd [i] := 0C ;
+         RETURN
+      END ;
+      wrd [i] := Upper (name [i]) ;
+      INC (i)
+   END
+END CopyWord ;
+
+PROCEDURE SaveWord (VAR dst : ARRAY OF CHAR) ;
+(* copy wrd into dst *)
+VAR i : CARDINAL ;
+BEGIN
+   i := 0 ;
+   LOOP
+      IF i > HIGH (dst) THEN
+         dst [HIGH (dst)] := 0C ;
+         RETURN
+      END ;
+      IF i > MaxName THEN
+         dst [MaxName] := 0C ;
+         RETURN
+      END ;
+      dst [i] := wrd [i] ;
+      IF wrd [i] = 0C THEN
+         RETURN
+      END ;
+      INC (i)
+   END
+END SaveWord ;
+
+PROCEDURE NumToName (n : CARDINAL ; VAR dst : ARRAY OF CHAR) ;
+VAR buf : ARRAY [0..9] OF CHAR ;
+    i, j : CARDINAL ;
+BEGIN
+   IF n = 0 THEN
+      dst [0] := '0' ;
+      dst [1] := 0C ;
+      RETURN
+   END ;
+   i := 0 ;
+   WHILE n > 0 DO
+      IF i <= 9 THEN
+         buf [i] := CHR (ORD ('0') + (n MOD 10)) ;
+         INC (i)
+      END ;
+      n := n DIV 10
+   END ;
+   j := 0 ;
+   WHILE i > 0 DO
+      DEC (i) ;
+      IF j <= HIGH (dst) THEN
+         dst [j] := buf [i] ;
+         INC (j)
+      END
+   END ;
+   IF j <= HIGH (dst) THEN
+      dst [j] := 0C
+   END
+END NumToName ;
+
+PROCEDURE NewSym (name : ARRAY OF CHAR ; tag : CARDINAL ;
+                  cls, size, elem, off : CARDINAL ; v : LONGINT ;
+                  local : BOOLEAN) : CARDINAL ;
+VAR e : SymEntry ;
+BEGIN
+   IF symTop >= MaxSym THEN
+      Err (ECompOvf) ;
+      RETURN 0
+   END ;
+   CopyWord (name) ;
+   CopyStr (e.name, wrd) ;
+   e.tag := tag ;
+   e.cls := cls ;
+   e.size := size ;
+   e.elem := elem ;
+   e.off := off ;
+   e.lval := v ;
+   e.level := lexnest ;
+   e.local := local ;
+   e.resvar := 0 ;
+   e.goPos := 0 ;
+   e.defnd := FALSE ;
+   e.fwd := FALSE ;
+   symtab [symTop] := e ;
+   INC (symTop) ;
+   RETURN symTop - 1
+END NewSym ;
+
+PROCEDURE Search (nm : ARRAY OF CHAR ; VAR idx : CARDINAL) : BOOLEAN ;
+(* find nm among symbols visible at the current lexical level *)
+VAR p : CARDINAL ;
+BEGIN
+   CopyWord (nm) ;
+   p := symTop ;
+   WHILE p > 0 DO
+      DEC (p) ;
+      IF symtab [p].level <= lexnest THEN
+         IF NameEq (symtab [p].name, wrd) THEN
+            idx := p ;
+            RETURN TRUE
+         END
+      END
+   END ;
+   RETURN FALSE
+END Search ;
+
+PROCEDURE DupTest (nm : ARRAY OF CHAR) ;
+VAR i : CARDINAL ;
+BEGIN
+   IF Search (nm, i) THEN
+      Err (EUnknown)
+   END
+END DupTest ;
+
+(* ---------------------------------------------------------------- *)
+(*  lexer                                                           *)
+(* ---------------------------------------------------------------- *)
+
+PROCEDURE InitKeys () ;
+VAR i : CARDINAL ;
+BEGIN
+   FOR i := 0 TO 42 DO
+      kTk [i] := 0 ;
+      kName [i] [0] := 0C
+   END ;
+   kName [1] := "PROGRAM"     ; kTk [1] := TkProgram ;
+   kName [2] := "BEGIN"       ; kTk [2] := TkBegin ;
+   kName [3] := "END"         ; kTk [3] := TkEnd ;
+   kName [4] := "IF"          ; kTk [4] := TkIf ;
+   kName [5] := "THEN"        ; kTk [5] := TkThen ;
+   kName [6] := "ELSE"        ; kTk [6] := TkElse ;
+   kName [7] := "WHILE"       ; kTk [7] := TkWhile ;
+   kName [8] := "DO"          ; kTk [8] := TkDo ;
+   kName [9] := "REPEAT"      ; kTk [9] := TkRepeat ;
+   kName [10] := "UNTIL"      ; kTk [10] := TkUntil ;
+   kName [11] := "FOR"        ; kTk [11] := TkFor ;
+   kName [12] := "TO"         ; kTk [12] := TkTo ;
+   kName [13] := "DOWNTO"     ; kTk [13] := TkDownto ;
+   kName [14] := "CASE"       ; kTk [14] := TkCase ;
+   kName [15] := "OF"         ; kTk [15] := TkOf ;
+   kName [16] := "GOTO"       ; kTk [16] := TkGoto ;
+   kName [17] := "EXIT"       ; kTk [17] := TkExit ;
+   kName [18] := "WITH"       ; kTk [18] := TkWith ;
+   kName [19] := "VAR"        ; kTk [19] := TkVar ;
+   kName [20] := "CONST"      ; kTk [20] := TkConst ;
+   kName [21] := "TYPE"       ; kTk [21] := TkType ;
+   kName [22] := "LABEL"      ; kTk [22] := TkLabel ;
+   kName [23] := "PROCEDURE"  ; kTk [23] := TkProcedure ;
+   kName [24] := "FUNCTION"   ; kTk [24] := TkFunction ;
+   kName [25] := "NIL"        ; kTk [25] := TkNil ;
+   kName [26] := "AND"        ; kTk [26] := TkAnd ;
+   kName [27] := "OR"         ; kTk [27] := TkOr ;
+   kName [28] := "NOT"        ; kTk [28] := TkNot ;
+   kName [29] := "DIV"        ; kTk [29] := TkDiv ;
+   kName [30] := "MOD"        ; kTk [30] := TkMod ;
+   kName [31] := "IN"         ; kTk [31] := TkIn ;
+   kName [32] := "FILE"       ; kTk [32] := TkFile ;
+   kName [33] := "TEXT"       ; kTk [33] := TkText ;
+   kName [34] := "RECORD"     ; kTk [34] := TkRecord ;
+   kName [35] := "ARRAY"      ; kTk [35] := TkArray ;
+   kName [36] := "SET"        ; kTk [36] := TkSet ;
+   kName [37] := "PACKED"     ; kTk [37] := TkPacked ;
+   kName [38] := "FORWARD"    ; kTk [38] := TkForward ;
+   kName [39] := "EXTERNAL"   ; kTk [39] := TkExternal ;
+   kName [40] := "ABSOLUTE"   ; kTk [40] := TkAbsolute ;
+   kName [41] := "OVERLAY"    ; kTk [41] := TkOverlay ;
+   kName [42] := "STRING"     ; kTk [42] := TkString
+END InitKeys ;
+
+PROCEDURE IsBlank (ch : CHAR) : BOOLEAN ;
+BEGIN
+   RETURN (ch = ' ') OR (ORD (ch) = 09H) OR (ORD (ch) = 0DH) OR (ORD (ch) = 0AH) OR (ORD (ch) = 0CH)
+END IsBlank ;
+
+PROCEDURE Skip () ;
+(* blanks, comments { } and (* *), compiler directives {$ } / (*$ *)
+   letter + sign toggles rng/chk *)
+VAR ch : CHAR ;
+    letter : CHAR ;
+BEGIN
+   WHILE NOT abortFac DO
+      WHILE IsBlank (CurCh ()) DO
+         ch := GetCh ()
+      END ;
+      IF CurCh () = '{' THEN
+         ch := GetCh () ;
+         IF CurCh () = '$' THEN
+            ch := GetCh () ;
+            letter := GetCh () ;
+            ch := GetCh () ;
+            IF ch = '+' THEN
+               IF letter = 'R' THEN dirs.rng := TRUE END ;
+               IF letter = 'I' THEN dirs.chk := TRUE END
+            ELSIF ch = '-' THEN
+               IF letter = 'R' THEN dirs.rng := FALSE END ;
+               IF letter = 'I' THEN dirs.chk := FALSE END
+            END
+         END ;
+         WHILE (CurCh () # '}') AND (CurCh () # 0C) DO
+            ch := GetCh ()
+         END ;
+         IF CurCh () = '}' THEN
+            ch := GetCh ()
+         END
+      ELSIF (CurCh () = '(') AND (PeekAhead (1) = '*') THEN
+         ch := GetCh () ;
+         ch := GetCh () ;
+         IF CurCh () = '$' THEN
+            ch := GetCh () ;
+            letter := GetCh () ;
+            ch := GetCh () ;
+            IF ch = '+' THEN
+               IF letter = 'R' THEN dirs.rng := TRUE END
+            ELSIF ch = '-' THEN
+               IF letter = 'R' THEN dirs.rng := FALSE END
+            END
+         END ;
+         LOOP
+            IF (CurCh () = '*') AND (PeekAhead (1) = ')') THEN
+               ch := GetCh () ;
+               ch := GetCh () ;
+               EXIT
+            END ;
+            IF CurCh () = 0C THEN
+               EXIT
+            END ;
+            ch := GetCh ()
+         END
+      ELSE
+         RETURN
+      END
+   END
+END Skip ;
+
+PROCEDURE GetWord () ;
+(* read identifier into wrd (uppercased); next char must be alpha *)
+VAR i : CARDINAL ;
+    ch : CHAR ;
+BEGIN
+   i := 0 ;
+   ch := GetCh () ;
+   LOOP
+      IF i > MaxName THEN
+         wrd [MaxName] := 0C ;
+         RETURN
+      END ;
+      wrd [i] := Upper (ch) ;
+      INC (i) ;
+      ch := CurCh () ;
+      IF NOT AlphaNum (ch) THEN
+         wrd [i] := 0C ;
+         RETURN
+      END ;
+      ch := GetCh ()
+   END
+END GetWord ;
+
+PROCEDURE WddTok () : CARDINAL ;
+(* map wrd -> keyword token *)
+VAR i : CARDINAL ;
+BEGIN
+   i := 1 ;
+   WHILE i <= 42 DO
+      IF kName [i] [0] # 0C THEN
+         IF NameEq (wrd, kName [i]) THEN
+            RETURN kTk [i]
+         END
+      END ;
+      INC (i)
+   END ;
+   RETURN TkNone
+END WddTok ;
+
+PROCEDURE KwAhead (word : ARRAY OF CHAR) : BOOLEAN ;
+(* does the next token (past blanks/comments) equal the keyword 'word',
+   without consuming it?  srcPos is saved and restored. *)
+VAR save : CARDINAL ;
+    k : BOOLEAN ;
+BEGIN
+   save := srcPos ;
+   Skip () ;
+   k := FALSE ;
+   IF Alpha (CurCh ()) THEN
+      GetWord () ;
+      k := NameEq (wrd, word)
+   END ;
+   srcPos := save ;
+   RETURN k
+END KwAhead ;
+
+PROCEDURE PeekKw (VAR tok : CARDINAL) ;
+(* peek at the next keyword token without consuming it *)
+VAR i : CARDINAL ;
+BEGIN
+   tok := TkNone ;
+   i := 1 ;
+   WHILE i <= 42 DO
+      IF kName [i] [0] # 0C THEN
+         IF KwAhead (kName [i]) THEN
+            tok := kTk [i] ;
+            RETURN
+         END
+      END ;
+      INC (i)
+   END
+END PeekKw ;
+
+PROCEDURE MatchKey (VAR tok : CARDINAL) : BOOLEAN ;
+(* skip; if next symbol is a word, read it into wrd and set its token.
+   Returns TRUE when a word was read (tok = TkNone for plain ids). *)
+BEGIN
+   tok := TkNone ;
+   Skip () ;
+   IF NOT Alpha (CurCh ()) THEN
+      RETURN FALSE
+   END ;
+   GetWord () ;
+   tok := WddTok () ;
+   RETURN TRUE
+END MatchKey ;
+
+PROCEDURE MatchDelim (ch : CHAR) : BOOLEAN ;
+BEGIN
+   Skip () ;
+   IF CurCh () = ch THEN
+      DropCh (GetCh ()) ;
+      RETURN TRUE
+   END ;
+   RETURN FALSE
+END MatchDelim ;
+
+PROCEDURE MatchAssign () : BOOLEAN ;
+BEGIN
+   Skip () ;
+   IF (CurCh () = ':') AND (PeekAhead (1) = '=') THEN
+      DropCh (GetCh ()) ;
+      DropCh (GetCh ()) ;
+      RETURN TRUE
+   END ;
+   RETURN FALSE
+END MatchAssign ;
+
+PROCEDURE MatchRange () : BOOLEAN ;
+BEGIN
+   Skip () ;
+   IF (CurCh () = '.') AND (PeekAhead (1) = '.') THEN
+      DropCh (GetCh ()) ;
+      DropCh (GetCh ()) ;
+      RETURN TRUE
+   END ;
+   RETURN FALSE
+END MatchRange ;
+
+PROCEDURE ExpectDelim (ch : CHAR ; n : CARDINAL) ;
+BEGIN
+   Skip () ;
+   IF CurCh () = ch THEN
+      DropCh (GetCh ())
+   ELSE
+      Err (n)
+   END
+END ExpectDelim ;
+
+PROCEDURE HexVal (ch : CHAR) : CARDINAL ;
+BEGIN
+   IF (ch >= '0') AND (ch <= '9') THEN
+      RETURN ORD (ch) - ORD ('0')
+   ELSIF (ch >= 'A') AND (ch <= 'F') THEN
+      RETURN ORD (ch) - ORD ('A') + 10
+   END ;
+   RETURN ORD (ch) - ORD ('a') + 10
+END HexVal ;
+
+PROCEDURE RdIntConst (VAR v : LONGINT) ;
+(* bare integer constant; current char is digit or '$' *)
+VAR acc : LONGINT ;
+BEGIN
+   acc := 0 ;
+   IF CurCh () = '$' THEN
+      DropCh (GetCh ()) ;
+      WHILE IsHexCh (CurCh ()) DO
+         acc := acc * 16 + VAL (LONGINT, HexVal (CurCh ())) ;
+         DropCh (GetCh ())
+      END
+   ELSE
+      WHILE Digit (CurCh ()) DO
+         acc := acc * 10 + VAL (LONGINT, ORD (CurCh ()) - ORD ('0')) ;
+         DropCh (GetCh ())
+      END
+   END ;
+   v := acc
+END RdIntConst ;
+
+PROCEDURE RdConst (VAR v : LONGINT ; VAR cls : CARDINAL ;
+                   VAR isStr : BOOLEAN) ;
+(* scalar or string constant.  String values (isStr) can only be
+   rejected with ENoLib by the caller. *)
+CONST q = AposC ;
+BEGIN
+   isStr := FALSE ;
+   cls := TScalar ;
+   v := 0 ;
+   Skip () ;
+   IF CurCh () = '$' THEN
+      RdIntConst (v) ;
+      cls := TScalar
+   ELSIF Digit (CurCh ()) THEN
+      RdIntConst (v) ;
+      IF (CurCh () = '.') AND (Digit (PeekAhead (1))) THEN
+         cls := TReal ;
+         DropCh (GetCh ())
+      END ;
+      IF (CurCh () = 'E') OR (CurCh () = 'e') THEN
+         cls := TReal ;
+         DropCh (GetCh ())
+      END ;
+      IF cls = TReal THEN
+         WHILE AlphaNum (CurCh ()) OR (CurCh () = '.') OR (CurCh () = '-')
+               OR (CurCh () = '+') DO
+            DropCh (GetCh ())
+         END
+      END
+   ELSIF ORD (CurCh ()) = q THEN
+      DropCh (GetCh ()) ;
+      IF ORD (CurCh ()) = q THEN
+         DropCh (GetCh ()) ;
+         v := VAL (LONGINT, q) ;
+         cls := TScalar
+      ELSIF (CurCh () = 0C) OR ((ORD (CurCh ()) = 0DH)) OR ((ORD (CurCh ()) = 0AH)) THEN
+         Err (EUnknown)
+      ELSE
+         v := VAL (LONGINT, ORD (GetCh ())) ;
+         cls := TScalar ;
+         IF ORD (CurCh ()) = q THEN
+            DropCh (GetCh ())
+         ELSE
+            isStr := TRUE ;
+            cls := TString ;
+            WHILE (ORD (CurCh ()) # q) AND (CurCh () # 0C) DO
+               IF ORD (PeekAhead (1)) = q THEN
+                  DropCh (GetCh ()) ; DropCh (GetCh ())
+               ELSE
+                  DropCh (GetCh ())
+               END
+            END ;
+            IF ORD (CurCh ()) = q THEN
+               DropCh (GetCh ())
+            END
+         END
+      END
+   ELSE
+      Err (EUnknown)
+   END
+END RdConst ;
+
+(* ---------------------------------------------------------------- *)
+(*  forward declarations                                            *)
+(* ---------------------------------------------------------------- *)
+
+PROCEDURE ParseExpr (VAR r : ERes) ; FORWARD ;
+PROCEDURE ParseAdd (VAR r : ERes) ; FORWARD ;
+PROCEDURE ParseMul (VAR r : ERes) ; FORWARD ;
+PROCEDURE ParseNeg (VAR r : ERes) ; FORWARD ;
+PROCEDURE ParseAtom (VAR r : ERes) ; FORWARD ;
+PROCEDURE ParseType (VAR cls, size, elem : CARDINAL) ; FORWARD ;
+PROCEDURE Statmnt () ; FORWARD ;
+PROCEDURE ParseCall (idx : CARDINAL) ; FORWARD ;
+PROCEDURE ParseCallArgs (idx : CARDINAL) ; FORWARD ;
+PROCEDURE EmCallMost (idx, nk : CARDINAL) ; FORWARD ;
+
+(* ---------------------------------------------------------------- *)
+(*  expressions  (TPSRC9)                                           *)
+(* ---------------------------------------------------------------- *)
+
+PROCEDURE LoadAtom (VAR r : ERes) ;
+(* load value of r into AX (folding constants) *)
+BEGIN
+   IF r.kind = 0 THEN
+      EmMovAxi (W16 (r.imm)) ;
+      r.kind := 2
+   ELSIF r.kind = 1 THEN
+      IF symtab [r.idx].size > 2 THEN
+         Err (ENoLib)
+      ELSE
+         EmLoadVar (symtab [r.idx].local,
+                    (symtab [r.idx].off + r.boff) MOD 10000H,
+                    symtab [r.idx].size) ;
+         IF symtab [r.idx].size = 1 THEN
+            EmMovAh0 ()
+         END ;
+         r.kind := 2
+      END
+   END
+END LoadAtom ;
+
+PROCEDURE ParseSub (VAR r : ERes) ;
+(* consume '[' constExpr ']' while present, folding the index into the
+   base offset (constant indexing only) *)
+VAR t : ERes ;
+BEGIN
+   LOOP
+      Skip () ;
+      IF CurCh () # '[' THEN
+         RETURN
+      END ;
+      DropCh (GetCh ()) ;
+      ParseExpr (t) ;
+      IF OK () THEN
+         IF t.kind # 0 THEN
+            Err (ENoLib) ;
+            RETURN
+         END ;
+         IF symtab [r.idx].cls = TArray THEN
+            r.boff := W16 (VAL (LONGINT, r.boff)
+                           + t.imm * VAL (LONGINT, symtab [r.idx].elem))
+         ELSE
+            Err (ESimpType) ;
+            RETURN
+         END
+      END ;
+      ExpectDelim (']', ENoSemi)
+   END
+END ParseSub ;
+
+PROCEDURE ParseVar (VAR r : ERes) ;
+(* name [ '[' constExpr ']' ]* ; a function name maps to its result var *)
+VAR idx : CARDINAL ;
+BEGIN
+   IF NOT Search (wrd, idx) THEN
+      Err (EUnknown) ;
+      RETURN
+   END ;
+   r.idx := idx ;
+   r.kind := 1 ;
+   r.boff := 0 ;
+   r.cls := symtab [idx].cls ;
+   IF symtab [idx].tag = KFunc THEN
+      idx := symtab [idx].resvar ;
+      r.idx := idx ;
+      r.cls := symtab [idx].cls
+   ELSIF (symtab [idx].tag # KVar) AND (symtab [idx].tag # KType) THEN
+      Err (EUnknown) ;
+      RETURN
+   END ;
+   ParseSub (r)
+END ParseVar ;
+
+PROCEDURE ConstAdd (a, b : LONGINT) : LONGINT ;
+BEGIN
+   RETURN VAL (LONGINT, W16 (a + b))
+END ConstAdd ;
+
+PROCEDURE ConstSub (a, b : LONGINT) : LONGINT ;
+BEGIN
+   RETURN VAL (LONGINT, W16 (a - b))
+END ConstSub ;
+
+PROCEDURE ConstMul (a, b : LONGINT) : LONGINT ;
+BEGIN
+   RETURN VAL (LONGINT, W16 (a * b))
+END ConstMul ;
+
+PROCEDURE EmMoveAxDx () ;
+BEGIN
+   Ebyte (92H)
+END EmMoveAxDx ;
+
+PROCEDURE BinOpEmit (op : CARDINAL ; left, right : ERes ; VAR res : ERes) ;
+(* binary operation at one precedence level; folds constant operands *)
+VAR f : LONGINT ;
+    okc : BOOLEAN ;
+BEGIN
+   IF op = TkAnd THEN
+      IF (left.kind = 0) AND (right.kind = 0) THEN
+         res.kind := 0 ;
+          res.imm := BitAnd (left.imm, right.imm) ;
+         res.cls := TBool ;
+         RETURN
+      END ;
+      LoadAtom (left) ; EmPushAx () ;
+      LoadAtom (right) ; EmPopCx () ;
+      EmAndAxCx () ;
+      res.kind := 2 ; res.cls := TBool ;
+      RETURN
+   END ;
+   IF op = TkOr THEN
+      IF (left.kind = 0) AND (right.kind = 0) THEN
+         res.kind := 0 ;
+         res.imm := BitOr (left.imm, right.imm) ;
+         res.cls := TBool ;
+         RETURN
+      END ;
+      LoadAtom (left) ; EmPushAx () ;
+      LoadAtom (right) ; EmPopCx () ;
+      EmOrAxCx () ;
+      res.kind := 2 ; res.cls := TBool ;
+      RETURN
+   END ;
+   IF (left.kind = 0) AND (right.kind = 0) THEN
+      okc := FALSE ;
+      CASE op OF
+         1 : f := ConstAdd (left.imm, right.imm) ; okc := TRUE ;
+      |  2 : f := ConstSub (left.imm, right.imm) ; okc := TRUE ;
+      |  3 : f := ConstMul (left.imm, right.imm) ; okc := TRUE ;
+      |  TkDiv : okc := (right.imm # 0) AND (right.imm > 0)
+                        AND (left.imm >= 0) ;
+                 IF okc THEN f := left.imm DIV right.imm END ;
+      |  TkMod : okc := (right.imm # 0) AND (right.imm > 0)
+                        AND (left.imm >= 0) ;
+                 IF okc THEN f := left.imm MOD right.imm END ;
+      ELSE
+         okc := FALSE
+      END ;
+      IF okc THEN
+         res.kind := 0 ;
+         res.imm := VAL (LONGINT, W16 (f)) ;
+         res.cls := left.cls ;
+         RETURN
+      ELSIF op = TkDiv THEN
+         Err (EConstRange) ;
+         RETURN
+      END
+   END ;
+   LoadAtom (left) ; EmPushAx () ;
+   LoadAtom (right) ; EmPopCx () ;
+   EmXchgAxCx () ;
+   CASE op OF
+      1   : EmAddAxCx ;
+   |  2   : EmSubAxCx ;
+   |  3   : EmMulAxCx ;
+   |  TkDiv : EmIDivAxCx ;
+   |  TkMod : EmIDivAxCx ; EmMoveAxDx ;
+   ELSE
+      Err (ETypeErr)
+   END ;
+   res.kind := 2 ;
+   res.cls := left.cls
+END BinOpEmit ;
+
+PROCEDURE ConstCmp (op : CARDINAL ; a, b : LONGINT ; VAR f : LONGINT)
+         : BOOLEAN ;
+VAR a16, b16 : CARDINAL ;
+BEGIN
+   a16 := W16 (a) ;
+   b16 := W16 (b) ;
+   f := 0 ;
+   CASE op OF
+      1 : f := VAL (LONGINT, ORD (a16 = b16)) ;
+   |  2 : f := VAL (LONGINT, ORD (a16 # b16)) ;
+   |  3 : f := VAL (LONGINT, ORD (a16 < b16)) ;
+   |  4 : f := VAL (LONGINT, ORD (a16 >= b16)) ;
+   |  5 : f := VAL (LONGINT, ORD (a16 > b16)) ;
+   |  6 : f := VAL (LONGINT, ORD (a16 <= b16)) ;
+   ELSE
+      RETURN FALSE
+   END ;
+   RETURN TRUE
+END ConstCmp ;
+
+PROCEDURE ParseCmp (VAR r : ERes) ;
+(* "=" | "<>" | "<" | "<=" | ">" | ">=" *)
+VAR op : CARDINAL ;
+    left, right : ERes ;
+    f : LONGINT ;
+BEGIN
+   ParseAdd (r) ;
+   LOOP
+      op := 0 ;
+      Skip () ;
+      IF CurCh () = '=' THEN
+         op := 1 ; DropCh (GetCh ())
+      ELSIF (CurCh () = '<') AND (PeekAhead (1) = '>') THEN
+         op := 2 ; DropCh (GetCh ()) ; DropCh (GetCh ())
+      ELSIF CurCh () = '<' THEN
+         IF PeekAhead (1) = '=' THEN
+            op := 6 ; DropCh (GetCh ()) ; DropCh (GetCh ())
+         ELSE
+            op := 3 ; DropCh (GetCh ())
+         END
+      ELSIF CurCh () = '>' THEN
+         IF PeekAhead (1) = '=' THEN
+            op := 5 ; DropCh (GetCh ()) ; DropCh (GetCh ())
+         ELSE
+            op := 4 ; DropCh (GetCh ())
+         END
+      END ;
+      IF op = 0 THEN
+         RETURN
+      END ;
+      left := r ;
+      ParseAdd (right) ;
+      IF (left.kind = 0) AND (right.kind = 0) THEN
+         IF ConstCmp (op, left.imm, right.imm, f) THEN
+            r.kind := 0 ;
+            r.imm := f ;
+            r.cls := TBool
+         ELSE
+            r.kind := 0 ;
+            r.imm := 0 ;
+            r.cls := TBool
+         END
+      ELSE
+         LoadAtom (left) ; EmPushAx () ;
+         LoadAtom (right) ; EmPopCx () ;
+         EmXchgAxCx () ;
+         EmCmpAxCx () ;
+         CASE op OF
+            1 : EmSetcc (94H) ;
+         |  2 : EmSetcc (95H) ;
+         |  3 : EmSetcc (9CH) ;
+         |  4 : EmSetcc (9DH) ;
+         |  5 : EmSetcc (9FH) ;
+         |  6 : EmSetcc (9EH)
+         END ;
+         r.kind := 2 ;
+         r.cls := TBool
+      END
+   END
+END ParseCmp ;
+
+PROCEDURE ParseAdd (VAR r : ERes) ;
+VAR op : CARDINAL ;
+    left, right : ERes ;
+BEGIN
+   ParseMul (r) ;
+   LOOP
+      op := 0 ;
+      Skip () ;
+      IF CurCh () = '+' THEN
+         op := 1 ; DropCh (GetCh ())
+      ELSIF CurCh () = '-' THEN
+         op := 2 ; DropCh (GetCh ())
+      ELSIF KwAhead ("OR") THEN
+         GetWord () ;
+         op := TkOr
+      ELSE
+         RETURN
+      END ;
+      left := r ;
+      ParseMul (right) ;
+      BinOpEmit (op, left, right, r)
+   END
+END ParseAdd ;
+
+PROCEDURE ParseMul (VAR r : ERes) ;
+VAR op : CARDINAL ;
+    left, right : ERes ;
+BEGIN
+   ParseNeg (r) ;
+   LOOP
+      op := 0 ;
+      Skip () ;
+      IF CurCh () = '*' THEN
+         op := 1 ; DropCh (GetCh ())
+      ELSIF CurCh () = '/' THEN
+         op := 2 ; DropCh (GetCh ()) ; Err (ENoLib)
+      ELSIF KwAhead ("DIV") THEN
+         GetWord () ; op := TkDiv
+      ELSIF KwAhead ("MOD") THEN
+         GetWord () ; op := TkMod
+      ELSIF KwAhead ("AND") THEN
+         GetWord () ; op := TkAnd
+      ELSE
+         RETURN
+      END ;
+      IF op = 2 THEN
+         RETURN
+      END ;
+      left := r ;
+      ParseNeg (right) ;
+      BinOpEmit (op, left, right, r)
+   END
+END ParseMul ;
+
+PROCEDURE ParseNeg (VAR r : ERes) ;
+BEGIN
+   Skip () ;
+   IF CurCh () = '+' THEN
+      DropCh (GetCh ()) ;
+      ParseNeg (r) ;
+      RETURN
+   ELSIF CurCh () = '-' THEN
+      DropCh (GetCh ()) ;
+      ParseNeg (r) ;
+      IF r.kind = 0 THEN
+         r.imm := VAL (LONGINT, W16 (0 - r.imm))
+      ELSE
+         LoadAtom (r) ;
+         EmNegAx () ;
+         r.kind := 2
+      END ;
+      RETURN
+   ELSIF KwAhead ("NOT") THEN
+      GetWord () ;
+      ParseNeg (r) ;
+      IF r.kind = 0 THEN
+         r.imm := BitNot (r.imm)
+      ELSE
+         LoadAtom (r) ;
+         EmNotAx () ;
+         r.kind := 2
+      END ;
+      RETURN
+   END ;
+   ParseAtom (r)
+END ParseNeg ;
+
+PROCEDURE ParseAtom (VAR r : ERes) ;
+(* const | variable | func(params) | '(' expr ')' *)
+VAR idx : CARDINAL ;
+    strf : BOOLEAN ;
+BEGIN
+   Skip () ;
+   IF CurCh () = '(' THEN
+      DropCh (GetCh ()) ;
+      ParseExpr (r) ;
+      ExpectDelim (')', ENoSemi) ;
+      RETURN
+   END ;
+   IF (CurCh () = '$') OR (Digit (CurCh ())) OR (ORD (CurCh ()) = AposC) THEN
+      RdConst (r.imm, r.cls, strf) ;
+      IF r.cls = TReal THEN
+         Err (ENoLib) ;
+         r.kind := 2 ;
+         RETURN
+      END ;
+      IF strf THEN
+         Err (ENoLib) ;
+         r.kind := 2 ;
+         RETURN
+      END ;
+      r.kind := 0 ;
+      RETURN
+   END ;
+   IF NOT Alpha (CurCh ()) THEN
+      Err (EUnknown) ;
+      RETURN
+   END ;
+   GetWord () ;
+   IF NOT Search (wrd, idx) THEN
+      Err (EUnknown) ;
+      RETURN
+   END ;
+   IF symtab [idx].tag = KConst THEN
+      r.kind := 0 ;
+      r.imm := symtab [idx].lval ;
+      r.cls := symtab [idx].cls ;
+      RETURN
+   ELSIF symtab [idx].tag = KFunc THEN
+      ParseCall (idx) ;
+      r.kind := 2 ;
+      r.cls := symtab [idx].cls ;
+      RETURN
+   ELSIF (symtab [idx].tag = KVar) OR (symtab [idx].tag = KType) THEN
+      ParseVar (r) ;
+      r.boff := 0 ;
+      RETURN
+   ELSE
+      Err (EUnknown)
+   END
+END ParseAtom ;
+
+PROCEDURE AddPend (kind, who, place : CARDINAL) ;
+BEGIN
+   IF nPend < MaxPend THEN
+      pend [nPend].kind := kind ;
+      pend [nPend].who := who ;
+      pend [nPend].place := place ;
+      INC (nPend)
+   ELSE
+      Err (ECompOvf)
+   END
+END AddPend ;
+
+PROCEDURE EmCallMost (idx, nk : CARDINAL) ;
+(* emit the call to sym 'idx' and clean up nk value arguments *)
+VAR p : CARDINAL ;
+BEGIN
+   IF symtab [idx].defnd THEN
+      DropC (EmCall (symtab [idx].goPos))
+   ELSE
+      p := EmCall (0) ;
+      AddPend (1, idx, p)
+   END ;
+   IF nk > 0 THEN
+      EmAddSp (2 * nk)
+   END
+END EmCallMost ;
+
+PROCEDURE ParseCallArgs (idx : CARDINAL) ;
+(* '(' already consumed: read args ')' then call.  Arguments are pushed
+   right-to-left so the first-declared parameter lands at BP+4. *)
+VAR args : ARRAY [0..15] OF ERes ;
+    nArgs, i : CARDINAL ;
+BEGIN
+   nArgs := 0 ;
+   IF CurCh () = ')' THEN
+      DropCh (GetCh ())
+   ELSE
+      LOOP
+         IF nArgs >= 16 THEN
+            Err (ECompOvf) ;
+            EXIT
+         END ;
+         ParseExpr (args [nArgs]) ;
+         INC (nArgs) ;
+         IF NOT MatchDelim (',') THEN
+            EXIT
+         END
+      END ;
+      ExpectDelim (')', ENoSemi)
+   END ;
+   i := nArgs ;
+   WHILE i > 0 DO
+      DEC (i) ;
+      LoadAtom (args [i]) ;
+      EmPushAx ()
+   END ;
+   EmCallMost (idx, nArgs)
+END ParseCallArgs ;
+
+PROCEDURE ParseCall (idx : CARDINAL) ;
+(* procedure/function call; '(' optional *)
+VAR args : ARRAY [0..15] OF ERes ;
+    nArgs, i : CARDINAL ;
+BEGIN
+   nArgs := 0 ;
+   IF MatchDelim ('(') THEN
+      IF CurCh () # ')' THEN
+         LOOP
+            IF nArgs >= 16 THEN
+               Err (ECompOvf) ;
+               EXIT
+            END ;
+            ParseExpr (args [nArgs]) ;
+            INC (nArgs) ;
+            IF NOT MatchDelim (',') THEN
+               EXIT
+            END
+         END ;
+         ExpectDelim (')', ENoSemi)
+      ELSE
+         DropCh (GetCh ())
+      END
+   END ;
+   i := nArgs ;
+   WHILE i > 0 DO
+      DEC (i) ;
+      LoadAtom (args [i]) ;
+      EmPushAx ()
+   END ;
+   EmCallMost (idx, nArgs)
+END ParseCall ;
+
+PROCEDURE ParseExpr (VAR r : ERes) ;
+BEGIN
+   ParseCmp (r)
+END ParseExpr ;
+
+(* ---------------------------------------------------------------- *)
+(*  statements  (TPSRC8)                                            *)
+(* ---------------------------------------------------------------- *)
+
+PROCEDURE ParseLabelStmt () ;
+(* numeric label definition 'n :' *)
+VAR n : CARDINAL ;
+    nm : ARRAY [0..9] OF CHAR ;
+    idx : CARDINAL ;
+    i : CARDINAL ;
+BEGIN
+   n := 0 ;
+   WHILE Digit (CurCh ()) DO
+      n := n * 10 + (ORD (CurCh ()) - ORD ('0')) ;
+      DropCh (GetCh ())
+   END ;
+   ExpectDelim (':', ENoSemi) ;
+   NumToName (n, nm) ;
+   IF Search (nm, idx) THEN
+      IF symtab [idx].tag = KLabel THEN
+         symtab [idx].defnd := TRUE ;
+         symtab [idx].goPos := pc ;
+         i := 0 ;
+         WHILE i < nPend DO
+            IF (pend [i].kind = 0) AND (pend [i].who = idx) THEN
+               SetPatTgt (pend [i].place, pc) ;
+               pend [i].kind := 99
+            END ;
+            INC (i)
+         END
+      ELSE
+         Err (EUnknown)
+      END
+   ELSE
+      idx := NewSym (nm, KLabel, TScalar, 0, 0, 0, 0, FALSE) ;
+      symtab [idx].defnd := TRUE ;
+      symtab [idx].goPos := pc
+   END
+END ParseLabelStmt ;
+
+PROCEDURE Assignment (r : ERes) ;
+(* ':=' already consumed by the caller; store expression into r *)
+VAR src : ERes ;
+BEGIN
+   IF r.kind # 1 THEN
+      Err (EUnknown) ;
+      RETURN
+   END ;
+   IF symtab [r.idx].size > 2 THEN
+      Err (ENoLib) ;
+      RETURN
+   END ;
+   ParseExpr (src) ;
+   LoadAtom (src) ;
+   EmStoreVar (symtab [r.idx].local,
+               (symtab [r.idx].off + r.boff) MOD 10000H,
+               symtab [r.idx].size)
+END Assignment ;
+
+PROCEDURE Compound () ;
+(* BEGIN statement ';' ... END; END is consumed here *)
+VAR tok : CARDINAL ;
+BEGIN
+   LOOP
+      PeekKw (tok) ;
+      IF tok = TkEnd THEN
+         DropB (MatchKey (tok)) ;
+         RETURN
+      END ;
+      Statmnt () ;
+      IF NOT OK () THEN
+         RETURN
+      END ;
+      IF NOT MatchDelim (';') THEN
+         PeekKw (tok) ;
+         IF tok = TkEnd THEN
+            DropB (MatchKey (tok)) ;
+            RETURN
+         END ;
+         Err (ENoSemi) ;
+         RETURN
+      END
+   END
+END Compound ;
+
+PROCEDURE Statmnt () ;
+VAR tok : CARDINAL ;
+    idx, i2 : CARDINAL ;
+    t, src : ERes ;
+    L1, zj, zj2, exj : CARDINAL ;
+    lo, hi, v : LONGINT ;
+    clso : CARDINAL ;
+    i : CARDINAL ;
+    nm : ARRAY [0..MaxName] OF CHAR ;
+    strf : BOOLEAN ;
+    dow : BOOLEAN ;
+BEGIN
+   Skip () ;
+   IF Digit (CurCh ()) THEN
+      ParseLabelStmt () ;
+      RETURN
+   END ;
+   IF NOT Alpha (CurCh ()) THEN
+      ExpectDelim (';', ENoSemi) ;
+      RETURN
+   END ;
+   DropB (MatchKey (tok)) ;
+   IF tok = TkBegin THEN
+      Compound ()
+   ELSIF tok = TkIf THEN
+      ParseExpr (t) ;
+      LoadAtom (t) ;
+      EmCmpAxi (0) ;
+      zj := EmJcc (84H, 0) ;          (* JZ -> else/end *)
+      IF NOT (MatchKey (tok) AND (tok = TkThen)) THEN
+         Err (ENoSemi)
+      END ;
+      Statmnt () ;
+      IF MatchKey (tok) AND (tok = TkElse) THEN
+         exj := EmJmpNear (0) ;
+         SetPatTgt (zj, pc) ;
+         Statmnt () ;
+         SetPatTgt (exj, pc)
+      ELSE
+         SetPatTgt (zj, pc)
+      END
+   ELSIF tok = TkWhile THEN
+      L1 := pc ;
+      ParseExpr (t) ;
+      LoadAtom (t) ;
+      EmCmpAxi (0) ;
+      zj := EmJcc (84H, 0) ;          (* JZ -> end *)
+      IF NOT (MatchKey (tok) AND (tok = TkDo)) THEN
+         Err (ENoSemi)
+      END ;
+      brkSave [brkN] := exitCnt ;
+      loopTy [brkN] := 1 ;
+      INC (brkN) ;
+      Statmnt () ;
+      DEC (brkN) ;
+      i := brkSave [brkN] ;
+      WHILE i < exitCnt DO
+         SetPatTgt (exitPatch [i], pc) ;
+         INC (i)
+      END ;
+      exitCnt := brkSave [brkN] ;
+      DropC (EmJmpNear (L1)) ;
+      SetPatTgt (zj, pc)
+   ELSIF tok = TkRepeat THEN
+      L1 := pc ;
+      brkSave [brkN] := exitCnt ;
+      loopTy [brkN] := 1 ;
+      INC (brkN) ;
+      Statmnt () ;
+      IF NOT (MatchKey (tok) AND (tok = TkUntil)) THEN
+         Err (ENoSemi)
+      END ;
+      ParseExpr (t) ;
+      LoadAtom (t) ;
+      EmCmpAxi (0) ;
+      zj := EmJcc (85H, L1) ;         (* JNZ -> body again *)
+      DEC (brkN) ;
+      i := brkSave [brkN] ;
+      WHILE i < exitCnt DO
+         SetPatTgt (exitPatch [i], pc) ;
+         INC (i)
+      END ;
+      exitCnt := brkSave [brkN]
+   ELSIF tok = TkFor THEN
+      (* control variable *)
+      IF NOT Alpha (CurCh ()) THEN
+         Err (EUnknown) ;
+         RETURN
+      END ;
+      GetWord () ;
+      IF NOT Search (wrd, idx) THEN
+         Err (EUnknown) ;
+         RETURN
+      END ;
+      IF symtab [idx].size > 2 THEN
+         Err (ENoLib) ;
+         RETURN
+      END ;
+      IF NOT MatchAssign () THEN
+         Err (ENoSemi)
+      END ;
+      ParseExpr (src) ;
+      LoadAtom (src) ;
+      EmStoreVar (symtab [idx].local, symtab [idx].off,
+                  symtab [idx].size) ;
+      IF NOT MatchKey (tok) THEN
+         Err (ESimpType) ;
+         RETURN
+      END ;
+      IF (tok = TkTo) OR (tok = TkDownto) THEN
+         dow := (tok = TkDownto)
+      ELSE
+         Err (ESimpType) ;
+         RETURN
+      END ;
+      ParseExpr (t) ;
+      LoadAtom (t) ;
+      EmPushAx () ;                    (* loop bound on the stack *)
+      IF NOT (MatchKey (tok) AND (tok = TkDo)) THEN
+         Err (ENoSemi)
+      END ;
+      brkSave [brkN] := exitCnt ;
+      loopTy [brkN] := 2 ;
+      INC (brkN) ;
+      L1 := pc ;                       (* Ltest *)
+      Statmnt () ;
+      DEC (brkN) ;
+      i := brkSave [brkN] ;
+      WHILE i < exitCnt DO
+         SetPatTgt (exitPatch [i], pc) ;
+         INC (i)
+      END ;
+      exitCnt := brkSave [brkN] ;
+      (* test then step: ax = var ; cx = bound (from [sp]) *)
+      EmMovCxSp () ;
+      EmLoadVar (symtab [idx].local, symtab [idx].off,
+                 symtab [idx].size) ;
+      EmCmpAxCx () ;
+      IF dow THEN
+         zj := EmJcc (8CH, 0)          (* JL -> done *)
+      ELSE
+         zj := EmJcc (8FH, 0)          (* JG -> done *)
+      END ;
+      EmLoadVar (symtab [idx].local, symtab [idx].off,
+                 symtab [idx].size) ;
+      IF dow THEN
+         EmDecAx ()
+      ELSE
+         EmIncAx ()
+      END ;
+      EmStoreVar (symtab [idx].local, symtab [idx].off,
+                  symtab [idx].size) ;
+      DropC (EmJmpNear (L1)) ;
+      SetPatTgt (zj, pc) ;             (* done: drop bound, continue *)
+      EmAddSp (2)
+   ELSIF tok = TkCase THEN
+      ParseExpr (t) ;
+      LoadAtom (t) ;
+      EmPushAx () ;                    (* selector on the stack *)
+      IF NOT (MatchKey (tok) AND (tok = TkOf)) THEN
+         Err (ENoSemi)
+      END ;
+      caseN := 0 ;
+      LOOP
+         Skip () ;
+         IF MatchDelim (';') THEN
+            Skip ()
+         END ;
+         PeekKw (tok) ;
+         IF (tok = TkEnd) OR (tok = TkElse) THEN
+            EXIT
+         END ;
+         (* case label : constant identifier or literal *)
+         IF Alpha (CurCh ()) THEN
+            GetWord () ;
+            IF Search (wrd, i2) AND (symtab [i2].tag = KConst) THEN
+               lo := symtab [i2].lval
+            ELSE
+               Err (EUnknown) ;
+               EXIT
+            END
+         ELSE
+            RdConst (lo, clso, strf)
+         END ;
+         IF MatchRange () THEN
+            RdConst (hi, clso, strf)
+         ELSE
+            hi := lo
+         END ;
+         ExpectDelim (':', ENoSemi) ;
+         EmMovAxSp () ;
+         EmCmpAxi (W16 (lo)) ;
+         zj := EmJcc (85H, 0) ;        (* JNZ -> next *)
+         IF hi # lo THEN
+            EmCmpAxi (W16 (hi)) ;
+            zj2 := EmJcc (85H, 0)
+         ELSE
+            zj2 := 0
+         END ;
+         Statmnt () ;
+         IF caseN >= 64 THEN
+            Err (ECompOvf) ;
+            EXIT
+         END ;
+         caseJmp [caseN] := EmJmpNear (0) ;
+         INC (caseN) ;
+         SetPatTgt (zj, pc) ;
+         IF zj2 # 0 THEN
+            SetPatTgt (zj2, pc)
+         END
+      END ;
+      IF tok = TkElse THEN
+         DropB (MatchKey (tok)) ;
+         Statmnt () ;
+         IF NOT (MatchKey (tok) AND (tok = TkEnd)) THEN
+            Err (ENoSemi)
+         END
+      ELSE
+         DropB (MatchKey (tok))
+      END ;
+      EmAddSp (2) ;
+      FOR i := 0 TO caseN - 1 DO
+         SetPatTgt (caseJmp [i], pc)
+      END
+   ELSIF tok = TkGoto THEN
+      v := 0 ;
+      IF Digit (CurCh ()) THEN
+         RdIntConst (v) ;
+         NumToName (W16 (v), nm) ;
+         IF Search (nm, idx) THEN
+            IF symtab [idx].tag = KLabel THEN
+               IF symtab [idx].defnd THEN
+                  DropC (EmJmpNear (symtab [idx].goPos))
+               ELSE
+                  zj := EmJmpNear (0) ;
+                  AddPend (0, idx, zj)
+               END
+            ELSE
+               Err (EUnknown)
+            END
+         ELSE
+            idx := NewSym (nm, KLabel, TScalar, 0, 0, 0, 0, FALSE) ;
+            zj := EmJmpNear (0) ;
+            AddPend (0, idx, zj)
+         END
+      ELSE
+         Err (EUnknown)
+      END
+   ELSIF tok = TkExit THEN
+      IF brkN = 0 THEN
+         Err (EUnknown)
+      ELSE
+         IF loopTy [brkN - 1] = 2 THEN
+            EmAddSp (2)                (* drop FOR bound *)
+         END ;
+         zj := EmJmpNear (0) ;
+         IF exitCnt < 64 THEN
+            exitPatch [exitCnt] := zj ;
+            INC (exitCnt)
+         END
+      END
+   ELSIF tok = TkWith THEN
+      Err (ENoLib)
+   ELSE
+      (* identifier statement: assignment or call *)
+      IF NOT Search (wrd, idx) THEN
+         Err (EUnknown) ;
+         RETURN
+      END ;
+      IF symtab [idx].tag = KProc THEN
+         IF MatchDelim ('(') THEN
+            ParseCallArgs (idx)
+         ELSE
+            ParseCall (idx)
+         END ;
+         RETURN
+      END ;
+      IF (symtab [idx].tag = KVar) OR (symtab [idx].tag = KFunc) THEN
+         t.idx := idx ;
+         t.kind := 1 ;
+         t.boff := 0 ;
+         t.cls := symtab [idx].cls ;
+         IF symtab [idx].tag = KFunc THEN
+            t.idx := symtab [idx].resvar ;
+            t.cls := symtab [t.idx].cls
+         END ;
+         ParseSub (t) ;
+         IF MatchAssign () THEN
+            Assignment (t) ;
+            RETURN
+         END ;
+         Err (ENoSemi) ;
+         RETURN
+      END ;
+      Err (ENoSemi)
+   END
+END Statmnt ;
+
+(* ---------------------------------------------------------------- *)
+(*  types and declarations  (TPSRC7)                                *)
+(* ---------------------------------------------------------------- *)
+
+PROCEDURE ParseType (VAR cls, size, elem : CARDINAL) ;
+VAR tok : CARDINAL ;
+    idx : CARDINAL ;
+    lo, hi : LONGINT ;
+    s2, e2 : CARDINAL ;
+    subcls : CARDINAL ;
+    strf : BOOLEAN ;
+    consumed : BOOLEAN ;
+BEGIN
+   cls := TNone ; size := 0 ; elem := 0 ;
+   consumed := FALSE ;
+   IF Alpha (CurCh ()) THEN
+      DropB (MatchKey (tok)) ;
+      consumed := TRUE
+   ELSE
+      tok := TkNone
+   END ;
+   IF tok = TkArray THEN
+      ExpectDelim ('[', ENoSemi) ;
+      RdConst (lo, subcls, strf) ;
+      IF NOT MatchRange () THEN
+         Err (ESimpType)
+      END ;
+      RdConst (hi, subcls, strf) ;
+      ExpectDelim (']', ENoSemi) ;
+      IF NOT (MatchKey (tok) AND (tok = TkOf)) THEN
+         Err (ENoSemi)
+      END ;
+      ParseType (cls, s2, e2) ;
+      cls := TArray ;
+      elem := s2 ;
+      size := s2 * (W16 (VAL (LONGINT, W16 (hi))
+                          - VAL (LONGINT, W16 (lo)) + 1))
+   ELSIF tok = TkString THEN
+      cls := TString ;
+      size := 256 ;
+      elem := 1 ;
+      IF MatchDelim ('[') THEN
+         RdConst (hi, subcls, strf) ;
+         ExpectDelim (']', ENoSemi) ;
+         size := W16 (hi) + 1
+      END
+   ELSIF tok = TkSet THEN
+      Err (ENoLib) ;
+      IF MatchKey (tok) AND (tok = TkOf) THEN
+         ParseType (cls, s2, e2)
+      END
+   ELSIF tok = TkRecord THEN
+      Err (ENoLib) ;
+      LOOP
+         PeekKw (tok) ;
+         IF tok = TkEnd THEN
+            DropB (MatchKey (tok)) ;
+            EXIT
+         END ;
+         IF CurCh () = 0C THEN
+            EXIT
+         END ;
+         Skip () ;
+         IF Alpha (CurCh ()) THEN
+            DropCh (GetCh ())
+         ELSE
+            DropCh (GetCh ())
+         END
+      END
+   ELSIF (tok = TkFile) OR (tok = TkText) THEN
+      cls := TFile ;
+      size := 0 ;
+      elem := 0 ;
+      Err (ENoLib)
+   ELSE
+      IF consumed THEN
+         IF Search (wrd, idx) AND (symtab [idx].tag = KType) THEN
+            cls := symtab [idx].cls ;
+            size := symtab [idx].size ;
+            elem := symtab [idx].size
+         ELSE
+            Err (EUnknown)
+         END
+      ELSE
+         (* subrange lo .. hi *)
+         RdConst (lo, subcls, strf) ;
+         IF NOT MatchRange () THEN
+            Err (ESimpType) ;
+            RETURN
+         END ;
+         RdConst (hi, subcls, strf) ;
+         cls := TScalar ;
+         size := 2 ;
+         elem := 2
+      END
+   END
+END ParseType ;
+
+PROCEDURE DefVar () ;
+(* 'name' (',' name)* ':' type [ABSOLUTE addr] ; group repeated until a
+   declaration keyword appears *)
+VAR nm : ARRAY [0..MaxName] OF CHAR ;
+    cls, size, elem : CARDINAL ;
+    tok : CARDINAL ;
+    v : LONGINT ;
+    off : CARDINAL ;
+BEGIN
+   LOOP
+      IF NOT Alpha (CurCh ()) THEN
+         Err (EUnknown) ;
+         RETURN
+      END ;
+      LOOP
+         GetWord () ;
+         SaveWord (nm) ;
+         DupTest (nm) ;
+         IF NOT MatchDelim (':') THEN
+            Err (ENoSemi)
+         END ;
+         ParseType (cls, size, elem) ;
+         off := 0 ;
+         IF lexnest = 0 THEN
+            IF size > 2 THEN
+               Err (ENoLib) ;
+               RETURN
+            END ;
+            PeekKw (tok) ;
+            IF tok = TkAbsolute THEN
+               DropB (MatchKey (tok)) ;
+               IF (CurCh () = '$') OR (Digit (CurCh ())) THEN
+                  RdIntConst (v) ;
+                  off := W16 (v)
+               ELSE
+                  Err (EUnknown)
+               END
+            ELSE
+               off := dc ;
+               dc := dc + size
+            END ;
+            DropC (NewSym (nm, KVar, cls, size, elem, off, 0, FALSE)) ;
+            varspc := varspc + size
+         ELSE
+            IF size > 2 THEN
+               Err (ENoLib) ;
+               RETURN
+            END ;
+            DropC (NewSym (nm, KVar, cls, size, elem, locFree, 0, TRUE)) ;
+            locFree := (locFree - size) MOD 10000H ;
+            locBytes := locBytes + size
+         END ;
+         IF NOT MatchDelim (',') THEN
+            EXIT
+         END
+      END ;
+      IF NOT MatchDelim (';') THEN
+         Err (ENoSemi) ;
+         RETURN
+      END ;
+      PeekKw (tok) ;
+      IF tok # TkNone THEN
+         RETURN
+      END
+   END
+END DefVar ;
+
+PROCEDURE DefConst () ;
+VAR nm : ARRAY [0..MaxName] OF CHAR ;
+    v : LONGINT ;
+    cls : CARDINAL ;
+    isStr : BOOLEAN ;
+    tok : CARDINAL ;
+BEGIN
+   LOOP
+      PeekKw (tok) ;
+      IF tok # TkNone THEN
+         RETURN
+      END ;
+      IF NOT Alpha (CurCh ()) THEN
+         Err (EUnknown) ;
+         RETURN
+      END ;
+      GetWord () ;
+      SaveWord (nm) ;
+      DupTest (nm) ;
+      ExpectDelim ('=', ENoSemi) ;
+      RdConst (v, cls, isStr) ;
+      IF isStr THEN
+         Err (ENoLib)
+      END ;
+      DropC (NewSym (nm, KConst, cls, 0, 0, 0, v, FALSE)) ;
+      IF NOT MatchDelim (';') THEN
+         Err (ENoSemi) ;
+         RETURN
+      END
+   END
+END DefConst ;
+
+PROCEDURE DefLabelPart () ;
+VAR nm : ARRAY [0..9] OF CHAR ;
+    n : CARDINAL ;
+BEGIN
+   LOOP
+      Skip () ;
+      IF NOT Digit (CurCh ()) THEN
+         Err (EUnknown) ;
+         RETURN
+      END ;
+      n := 0 ;
+      WHILE Digit (CurCh ()) DO
+         n := n * 10 + (ORD (CurCh ()) - ORD ('0')) ;
+         DropCh (GetCh ())
+      END ;
+      NumToName (n, nm) ;
+      IF NOT Search (nm, n) THEN
+         DropC (NewSym (nm, KLabel, TScalar, 0, 0, 0, 0, FALSE))
+      END ;
+      IF NOT MatchDelim (',') THEN
+         IF MatchDelim (';') THEN
+            RETURN
+         END ;
+         Err (ENoSemi) ;
+         RETURN
+      END
+   END
+END DefLabelPart ;
+
+PROCEDURE IfMatchSemi () ;
+BEGIN
+   IF NOT MatchDelim (';') THEN
+      Err (ENoSemi)
+   END
+END IfMatchSemi ;
+
+PROCEDURE SymEpi () ;
+(* function result: AX := result var *)
+BEGIN
+   IF curIsFunc THEN
+      IF OK () THEN
+         EmLoadVar (TRUE, symtab [resultVar].off, symtab [resultVar].size)
+      END
+   END
+END SymEpi ;
+
+PROCEDURE ProcFunc () ;
+(* PROCEDURE name (params) ; body | FUNCTION name (params) : type ; body *)
+VAR nm : ARRAY [0..MaxName] OF CHAR ;
+    idx, old : CARDINAL ;
+    tok, tok2 : CARDINAL ;
+    parmNm : ARRAY [0..MaxName] OF CHAR ;
+    cls, size, elem : CARDINAL ;
+    isFunc : BOOLEAN ;
+    saveNest, saveLoc, saveRes, saveF : CARDINAL ;
+    saveLB, savePO : CARDINAL ;
+    i : CARDINAL ;
+BEGIN
+   isFunc := curIsFunc ;
+   IF NOT Alpha (CurCh ()) THEN
+      Err (EUnknown) ;
+      RETURN
+   END ;
+   GetWord () ;
+   SaveWord (nm) ;
+   IF Search (nm, idx) AND (symtab [idx].tag = KProc)
+      AND (symtab [idx].fwd) THEN
+      old := idx
+   ELSIF Search (nm, idx) THEN
+      Err (EUnknown) ;
+      RETURN
+   ELSE
+      old := NewSym (nm, KProc, TNone, 0, 0, 0, 0, FALSE)
+   END ;
+   IF isFunc THEN
+      symtab [old].tag := KFunc
+   END ;
+   saveNest := lexnest ;
+   saveLoc := locFree ;
+   saveRes := resultVar ;
+   saveF := VAL (CARDINAL, ORD (curIsFunc)) ;
+   saveLB := locBytes ;
+   savePO := parmOff ;
+   INC (lexnest) ;
+   locFree := 0FFFEH ;
+   locBytes := 0 ;
+   parmOff := 4 ;
+   IF MatchDelim ('(') THEN
+      IF CurCh () # ')' THEN
+         LOOP
+            IF MatchKey (tok) AND (tok = TkVar) THEN
+               (* VAR parameter recorded as value in this milestone *)
+            END ;
+            IF NOT Alpha (CurCh ()) THEN
+               Err (EUnknown) ;
+               RETURN
+            END ;
+            GetWord () ;
+            SaveWord (parmNm) ;
+            DupTest (parmNm) ;
+            ParseType (cls, size, elem) ;
+            IF size > 2 THEN
+               Err (ENoLib) ;
+               RETURN
+            END ;
+            DropC (NewSym (parmNm, KVar, cls, size, elem, parmOff, 0, TRUE)) ;
+            parmOff := parmOff + 2 ;
+            IF NOT MatchDelim (',') THEN
+               IF MatchDelim (')') THEN
+                  EXIT
+               END ;
+               Err (ENoSemi) ;
+               EXIT
+            END
+         END
+      ELSE
+         DropCh (GetCh ())
+      END
+   END ;
+   IF isFunc THEN
+      IF MatchDelim (':') THEN
+         ParseType (cls, size, elem)
+      ELSE
+         cls := TScalar ;
+         size := 2 ;
+         elem := 2
+      END ;
+      IF size > 2 THEN
+         Err (ENoLib) ;
+         RETURN
+      END ;
+      symtab [old].cls := cls ;
+      symtab [old].size := size ;
+      resultVar := NewSym (nm, KVar, cls, size, elem, locFree, 0, TRUE) ;
+      symtab [old].resvar := resultVar ;
+      locFree := (locFree - size) MOD 10000H ;
+      locBytes := locBytes + size
+   END ;
+   IfMatchSemi () ;
+   PeekKw (tok2) ;
+   IF (tok2 = TkForward) OR (tok2 = TkExternal) THEN
+      DropB (MatchKey (tok2)) ;
+      symtab [old].fwd := TRUE ;
+      symtab [old].defnd := (tok2 = TkExternal) ;
+      IfMatchSemi () ;
+      lexnest := saveNest ;
+      locFree := saveLoc ;
+      resultVar := saveRes ;
+      curIsFunc := (saveF # 0) ;
+      locBytes := saveLB ;
+      parmOff := savePO ;
+      RETURN
+   END ;
+   (* body *)
+   symtab [old].goPos := pc ;
+   symtab [old].defnd := TRUE ;
+   EmPushBp () ;
+   EmMovBpSp () ;
+   DefPart () ;                       (* nested declarations; stops at BEGIN *)
+   IF locBytes > 0 THEN
+      EmSubSp (locBytes)
+   END ;
+   DropC (EmCall (TU_StackChk)) ;
+   Statmnt () ;                       (* body *)
+   IF OK () THEN
+      SymEpi () ;
+      EmLeave () ;
+      EmRet ()
+   END ;
+   (* patch pending forward calls to this proc *)
+   i := 0 ;
+   WHILE i < nPend DO
+      IF (pend [i].kind = 1) AND (pend [i].who = old) THEN
+         SetPatTgt (pend [i].place, symtab [old].goPos) ;
+         pend [i].kind := 99
+      END ;
+      INC (i)
+   END ;
+   lexnest := saveNest ;
+   locFree := saveLoc ;
+   resultVar := saveRes ;
+   curIsFunc := (saveF # 0) ;
+   locBytes := saveLB ;
+   parmOff := savePO
+END ProcFunc ;
+
+PROCEDURE DefType () ;
+(* 'name' '=' typeDef ; ... until a declaration keyword appears *)
+VAR nm : ARRAY [0..MaxName] OF CHAR ;
+    cls, size, elem : CARDINAL ;
+    tok : CARDINAL ;
+BEGIN
+   LOOP
+      PeekKw (tok) ;
+      IF tok # TkNone THEN
+         RETURN
+      END ;
+      IF NOT Alpha (CurCh ()) THEN
+         Err (EUnknown) ;
+         RETURN
+      END ;
+      GetWord () ;
+      SaveWord (nm) ;
+      DupTest (nm) ;
+      ExpectDelim ('=', ENoSemi) ;
+      ParseType (cls, size, elem) ;
+      IF NOT OK () THEN
+         RETURN
+      END ;
+      DropC (NewSym (nm, KType, cls, size, elem, 0, 0, FALSE)) ;
+      IF NOT MatchDelim (';') THEN
+         Err (ENoSemi) ;
+         RETURN
+      END
+   END
+END DefType ;
+
+PROCEDURE DefPart () ;
+(* LABEL / CONST / TYPE / VAR / OVERLAY / PROC / FUNCTION / BEGIN *)
+VAR tok : CARDINAL ;
+BEGIN
+   LOOP
+      IF MatchDelim (';') THEN
+         (* separator between declarations *)
+      ELSE
+         PeekKw (tok) ;
+         IF tok = TkBegin THEN
+            RETURN
+         END ;
+         IF NOT MatchKey (tok) THEN
+            Err (EUnknown) ;
+            RETURN
+         END ;
+         CASE tok OF
+            TkLabel  : DefLabelPart () ;
+         |  TkConst  : DefConst () ;
+         |  TkType   : DefType () ;
+         |  TkVar    : DefVar () ;
+         |  TkOverlay :
+               LOOP
+                  Skip () ;
+               IF CurCh () = ';' THEN
+                     DropCh (GetCh ()) ;
+                     EXIT
+               END ;
+                  IF CurCh () = 0C THEN
+                     Err (ENoSemi) ;
+                     EXIT
+                  END ;
+                  DropCh (GetCh ())
+               END ;
+         |  TkProcedure : curIsFunc := FALSE ; ProcFunc () ;
+         |  TkFunction : curIsFunc := TRUE ; ProcFunc () ;
+         ELSE
+            Err (EUnknown) ;
+            RETURN
+         END ;
+         IF NOT OK () THEN
+            RETURN
+         END
+      END
+   END
+END DefPart ;
+
+(* ---------------------------------------------------------------- *)
+(*  driver  (TPSRC7 compile)                                        *)
+(* ---------------------------------------------------------------- *)
+
+PROCEDURE Inittur () ;
+(* reset compiler state and define the standard types *)
+BEGIN
+   abortFac := FALSE ;
+   errNo := 0 ;
+   txerrPos := 0 ;
+   srcPos := 0 ;
+   srcLen := Length () ;
+   pc := 0 ;
+   dc := 100H ;
+   varspc := 0 ;
+   symTop := 0 ;
+   nPatch := 0 ;
+   nPend := 0 ;
+   exitCnt := 0 ;
+   brkN := 0 ;
+   caseN := 0 ;
+   lexnest := 0 ;
+   curIsFunc := FALSE ;
+   resultVar := 0 ;
+   locFree := 0FFFEH ;
+   locBytes := 0 ;
+   parmOff := 4 ;
+   dirs.rng := TRUE ;
+   dirs.chk := TRUE ;
+   InitKeys () ;
+   DropC (NewSym ("INTEGER", KType, TScalar, 2, 2, 0, 0, FALSE)) ;
+   DropC (NewSym ("BYTE"   , KType, TScalar, 1, 1, 0, 0, FALSE)) ;
+   DropC (NewSym ("CHAR"   , KType, TScalar, 1, 1, 0, 0, FALSE)) ;
+   DropC (NewSym ("BOOLEAN", KType, TBool  , 1, 1, 0, 0, FALSE)) ;
+   DropC (NewSym ("REAL"   , KType, TReal  , 6, 6, 0, 0, FALSE)) ;
+   DropC (NewSym ("STRING" , KType, TString, 256, 1, 0, 0, FALSE)) ;
+   DropC (NewSym ("TRUE"   , KConst, TBool, 1, 1, 0, 1, FALSE)) ;
+   DropC (NewSym ("FALSE"  , KConst, TBool, 1, 1, 0, 0, FALSE)) ;
+   tmpA := NewSym ("@@T1", KVar, TScalar, 2, 2, dc, 0, FALSE) ;
+   dc := dc + 2 ;
+   tmpB := NewSym ("@@T2", KVar, TScalar, 2, 2, dc, 0, FALSE) ;
+   dc := dc + 2
+END Inittur ;
+
+PROCEDURE HeadWord (VAR slot : CARDINAL) ;
+BEGIN
+   slot := pc ;
+   Eword (0)
+END HeadWord ;
+
+PROCEDURE Compile (VAR errNo, errPos : CARDINAL) : BOOLEAN ;
+VAR tok : CARDINAL ;
+BEGIN
+   Inittur () ;
+   IF OK () THEN
+      (* program prologue: header words, CALL initmem, MOV BP,SP *)
+      HeadWord (hdrFlag) ;
+      HeadWord (hdrCS) ;
+      HeadWord (hdrDS) ;
+      HeadWord (hdrHeap) ;
+      HeadWord (hdrMax) ;
+      Eword (16) ;                  (* max open files *)
+      Eword (0) ;                   (* input buffer word *)
+      Eword (0) ;                   (* output buffer word *)
+      DropC (EmCall (TU_InitMem)) ;
+      EmMovBpSp () ;
+      IF MatchKey (tok) AND (tok = TkProgram) THEN
+         IF Alpha (CurCh ()) THEN
+            GetWord ()
+         END ;
+         IF MatchDelim ('(') THEN
+            WHILE NOT MatchDelim (')') DO
+               IF Alpha (CurCh ()) THEN
+                  GetWord ()
+               END ;
+               IF CurCh () = ',' THEN
+                  DropCh (GetCh ())
+               END
+            END
+         END ;
+         IfMatchSemi ()
+      END ;
+      IF OK () THEN
+         DefPart () ;
+         IF OK () THEN
+            IF MatchKey (tok) AND (tok = TkBegin) THEN
+               Compound () ;
+               IF OK () THEN
+                  EmXorAxAx () ;
+                  DropC (EmCall (TU_ProgEnd)) ;
+                  ResolvePatches () ;
+                  codeSz := pc ;
+                  dataSz := dc ;
+                  cbuf [hdrCS] := VAL (BYTE, (codeSz DIV 16) MOD 100H) ;
+                  cbuf [hdrCS + 1] := VAL (BYTE, ((codeSz DIV 16) DIV 100H) MOD 100H) ;
+                  cbuf [hdrDS] := VAL (BYTE, (dataSz DIV 16) MOD 100H) ;
+                  cbuf [hdrDS + 1] := VAL (BYTE, ((dataSz DIV 16) DIV 100H) MOD 100H) ;
+                  cbuf [hdrFlag] := 1 ;
+                  cbuf [hdrFlag + 1] := 0 ;
+                  cbuf [hdrHeap] := 0 ;
+                  cbuf [hdrHeap + 1] := 0 ;
+                  cbuf [hdrMax] := 0 ;
+                  cbuf [hdrMax + 1] := 0
+               END
+            ELSE
+               Err (EUnknown)
+            END
+         END
+      END
+   END ;
+   IF NOT MatchDelim ('.') THEN
+      Err (EPointExp)
+   END ;
+   IF abortFac THEN
+      errNo := errNo ;
+      errPos := txerrPos ;
+      RETURN FALSE
+   END ;
+   errNo := 0 ;
+   errPos := 0 ;
+   RETURN TRUE
+END Compile ;
+
+PROCEDURE CodeBytes () : CARDINAL ;
+BEGIN
+   RETURN codeSz
+END CodeBytes ;
+
+PROCEDURE DataBytes () : CARDINAL ;
+BEGIN
+   RETURN dataSz
+END DataBytes ;
+
+END Compiler.

shell/Makefile

@@ -4,8 +4,9 @@ FLAGS = -fiso
 
 all: tpshell
 
-tpshell: Editor.mod Shell.mod Shell.o Term.o Posix.o TextBuf.o Editor.o
-	$(GM2) $(FLAGS) -o $@ Shell.mod Term.o Posix.o TextBuf.o Editor.o
+tpshell: Editor.mod Shell.mod Shell.o Term.o Posix.o TextBuf.o Editor.o Compiler.o tpshell.lst
+	$(GM2) $(FLAGS) -fgen-module-list=tpshell.lst -o $@ Shell.mod Term.o Posix.o TextBuf.o Editor.o Compiler.o
+	$(GM2) $(FLAGS) -fuse-list=tpshell.lst -o $@ Shell.mod Term.o Posix.o TextBuf.o Editor.o Compiler.o
 
 Shell.o: Shell.mod Term.def Posix.def Editor.def TextBuf.def
 	$(GM2) $(FLAGS) -c Shell.mod
@@ -22,6 +23,9 @@ Editor.o: Editor.mod Editor.def Term.def TextBuf.def Posix.def
 Posix.o: Posix.c
 	$(CC) -c Posix.c
 
+Compiler.o: Compiler.mod Compiler.def TextBuf.def
+	$(GM2) $(FLAGS) -c Compiler.mod
+
 clean:
-	rm -f *.o tpshell
+	rm -f *.o tpshell tpshell.lst
 .PHONY: all clean

shell/Shell.mod

@@ -15,6 +15,7 @@ FROM Posix IMPORT
    getcwd, chdir, opendir, readdir, closedir, statvfs,
    Dir, dirent, statvfsbuf ;
 
+FROM Compiler IMPORT Compile, CodeBytes, DataBytes ;
 FROM Editor IMPORT Run ;
 
 FROM TextBuf IMPORT
@@ -32,6 +33,7 @@ VAR
    changed   : BOOLEAN ;
 
    codeDest  : CARDINAL ;        (* 0=Memory, 1=COM, 2=CHN *)
+   errNo, errPos : CARDINAL ;
    minCode, minData, minStack, maxStack : CARDINAL ;
    paramLine : ARRAY [0..255] OF CHAR ;
 
@@ -626,16 +628,35 @@ PROCEDURE CmdCompile ;
 BEGIN
    ClrScr ;
    GotoXY (1, 1) ;
-   PutStr ("Compiler under construction - press ESC") ;
-   CrLf ;
-   WaitEsc
+   IF Compile (errNo, errPos) THEN
+      PutStr ("Compiled OK - code ") ;
+      PutCard (CodeBytes ()) ;
+      PutStr (" bytes, data ") ;
+      PutCard (DataBytes ()) ;
+      PutStr (" bytes (TP3 option O not yet run)") ;
+      CrLf ;
+      PutStr ("press ESC to return to the editor") ;
+      CrLf ;
+      WaitEsc
+   ELSE
+      PutStr ("TP3-style error ") ;
+      PutCard (errNo) ;
+      PutStr (" at relative pos ") ;
+      PutCard (errPos) ;
+      CrLf ;
+      PutStr ("(jump to editor position not yet wired)") ;
+      CrLf ;
+      WaitEsc
+   END
 END CmdCompile ;
 
 PROCEDURE CmdRun ;
 BEGIN
    ClrScr ;
    GotoXY (1, 1) ;
-   PutStr ("Compiler / interpreter under construction - press ESC") ;
+   PutStr ("Interpreter pending - compiled code is in memory") ;
+   CrLf ;
+   PutStr ("(TP3 option R / debugger not yet wired)") ;
    CrLf ;
    WaitEsc
 END CmdRun ;

shell/TProbe.mod

@@ -0,0 +1,12 @@
+MODULE TProbe ;
+FROM Compiler IMPORT Compile, CodeBytes, DataBytes ;
+FROM Term IMPORT PutStr, PutCard, CrLf ;
+VAR errNo, errPos : CARDINAL ;
+BEGIN
+   IF Compile (errNo, errPos) THEN
+      PutStr ("ok code=") ; PutCard (CodeBytes ()) ;
+      PutStr (" data=") ; PutCard (DataBytes ()) ; CrLf
+   ELSE
+      PutStr ("err ") ; PutCard (errNo) ; PutStr ("@") ; PutCard (errPos) ; CrLf
+   END
+END TProbe.

shell/build_tpshell.sh

@@ -0,0 +1,31 @@
+#!/bin/bash
+# TP3 tpshell - two-phase ISO build, exactly the proven CocoGm2 recipe.
+#   Phase 1: -fgen-module-list=modules.lst   (generates the import closure list)
+#   Phase 2: -fuse-list=modules.lst          (links using that list)
+# This avoids gm2's whole-program pass-3 identifier cap on compiler-size programs.
+set -u
+D=/home/eric/Projets/Projets-Modula2/MyWork/TP3-comp/shell
+GM2=/home/eric/bin/Modula2/Gm2/bin/gm2
+cd "$D" || exit 9
+FLAGS="-fiso"
+
+echo "== compiling each module (isolated -c) =="
+for m in Shell Term Posix TextBuf Editor Compiler ; do
+   $GM2 $FLAGS -c $m.mod >/tmp/tp_c_$m 2>&1 \
+      || { echo "COMPILE_FAIL $m"; grep -m3 "error:" /tmp/tp_c_$m; exit 1; }
+done
+echo "ok: Shell Term Posix TextBuf Editor Compiler"
+
+echo "== Phase 1: generate module list =="
+rm -f modules.lst
+$GM2 $FLAGS -fgen-module-list=modules.lst -o /dev/null \
+    Shell.mod Term.o Posix.o TextBuf.o Editor.o Compiler.o >/tmp/tp_p1 2>&1
+echo "p1_rc=$?  list: $(tr '\n' ' ' < modules.lst)"
+
+echo "== Phase 2: link with the list =="
+rm -f tpshell
+$GM2 $FLAGS -fuse-list=modules.lst -o tpshell \
+    Shell.mod Term.o Posix.o TextBuf.o Editor.o Compiler.o >/tmp/tp_p2 2>&1
+echo "p2_rc=$?"
+grep -cE "error:|undefined" /tmp/tp_p2
+ls -l tpshell 2>/dev/null | awk '{print "tpshell bytes:",$5}'

shell/comments.pas

@@ -0,0 +1,19 @@
+{ Several of the many ways in which you can include comments in your program. }
+program comments;
+
+{ This is a
+  multiline comment. }
+
+begin
+  writeln{inline comment}('Line 1');
+  writeln('Line 2') { Another
+  multiline
+  comment };
+  (* Another style of comment *)writeln('Line 3');
+  writeln((* Another inline comment. *)'Line 4');
+  writeln('Line 5')(* Finally, another comment. *);
+  (* Nested comments of the same type don't work
+  (* *) writeln('Line 6'); (* *)
+  (* Nested comments of different types work.
+  { } writeln('Line 7 no'); (* *)
+end.

shell/modules.lst

@@ -0,0 +1,3 @@
+TextBuf
+SYSTEM
+Compiler