compiler: split shared state, utilities, source and emitters into modules

SUMMARY.md

@@ -1211,6 +1211,10 @@ CALC compiles to its final `.`, and every default check is green.
 - CALC: **27,519 B code, 19,694 B data, 38,497 B `.COM`**.
 - The working `Sources/` tree contains only `Dezip/pascsrc` (78 files,
   71 `.pas`, no archives).
+- The compiler implementation is now split into `CompilerShared` (image,
+  patch and error state), `CompilerUtil` (pure helpers), `CompilerSource`
+  (cursor and `{$I}` expansion) and `CompilerEmit` (primitive 8086 emitters).
+  `Compiler.mod` retains the parser, symbol table, declarations and driver.
 
 This does not claim the whole Turbo Pascal 3 standard library or every TP3
 compiler option.  The corpus is the regression target; the historical notes

shell/CompilerEmit.def

@@ -0,0 +1,67 @@
+DEFINITION MODULE CompilerEmit ;
+
+(* Primitive 8086 emitters and patch machinery.  Implementation:
+   CompilerEmit.mod.  State is in CompilerShared. *)
+
+FROM SYSTEM IMPORT BYTE ;
+
+PROCEDURE Ebyte (b : BYTE) ;
+PROCEDURE Eword (w : CARDINAL) ;
+PROCEDURE PatchWord (at, w : CARDINAL) ;
+PROCEDURE AddPatch (place, target : CARDINAL) ;
+PROCEDURE SetPatTgt (idx, t : CARDINAL) ;
+PROCEDURE EmCall (target : CARDINAL) : CARDINAL ;
+PROCEDURE EmJmpNear (target : CARDINAL) : CARDINAL ;
+PROCEDURE JccShort (cc : BYTE) : BYTE ;
+PROCEDURE JccShortInv (cc : BYTE) : BYTE ;
+PROCEDURE EmJcc (cc : BYTE ; target : CARDINAL) : CARDINAL ;
+PROCEDURE ResolvePatches () ;
+PROCEDURE EmMovAxi (imm : CARDINAL) ;
+PROCEDURE EmMovCxi (imm : CARDINAL) ;
+PROCEDURE EmMovBpSp () ;
+PROCEDURE EmMovAh0 () ;
+PROCEDURE EmMovAxSp () ;
+PROCEDURE EmMovCxSp () ;
+PROCEDURE EmPushAx () ;
+PROCEDURE EmPopCx () ;
+PROCEDURE EmPopDx () ;
+PROCEDURE EmPopSi () ;
+PROCEDURE EmPopAx () ;
+PROCEDURE EmPushBx () ;
+PROCEDURE EmPushCx () ;
+PROCEDURE EmPushDx () ;
+PROCEDURE EmPopBx () ;
+PROCEDURE EmMovAxCx () ;
+PROCEDURE EmMovChAl () ;
+PROCEDURE EmMovChImm (v : CARDINAL) ;
+PROCEDURE EmXchgAxCx () ;
+PROCEDURE EmXorAxAx () ;
+PROCEDURE EmAddAxCx () ;
+PROCEDURE EmSubAxCx () ;
+PROCEDURE EmMulAxCx () ;
+PROCEDURE EmIDivAxCx () ;
+PROCEDURE EmAndAxCx () ;
+PROCEDURE EmOrAxCx () ;
+PROCEDURE EmOrAxAx () ;
+PROCEDURE EmNegAx () ;
+PROCEDURE EmNotAx () ;
+PROCEDURE EmXorAl01 () ;
+PROCEDURE EmCmpAxCx () ;
+PROCEDURE EmCmpAxi (imm : CARDINAL) ;
+PROCEDURE EmSetcc (cc : BYTE) ;
+PROCEDURE EmRelSetcc (op : CARDINAL) ;
+PROCEDURE EmIncAx () ;
+PROCEDURE EmDecAx () ;
+PROCEDURE EmBpDisp (off, regf : CARDINAL) ;
+PROCEDURE EmBxDisp (off, regf : CARDINAL) ;
+PROCEDURE EmMovBxBp () ;
+PROCEDURE EmMovDxBp () ;
+PROCEDURE EmMovDxBx () ;
+PROCEDURE EmMovDxAx () ;
+PROCEDURE EmMovAxDx () ;
+PROCEDURE EmLdBxBx (off : CARDINAL) ;
+PROCEDURE EmLoadVarBx (off, nbytes : CARDINAL) ;
+PROCEDURE EmStoreVarBx (off, nbytes : CARDINAL) ;
+PROCEDURE EmLeaDiBx (off : CARDINAL) ;
+
+END CompilerEmit.

shell/CompilerEmit.mod

@@ -0,0 +1,599 @@
+IMPLEMENTATION MODULE CompilerEmit ;
+
+(* Low-level 8086 emission: byte/word writers, patch list, calls/jumps,
+   short conditional branches and the primitive instruction helpers.
+   All shared state lives in CompilerShared; Compiler imports these names
+   unqualified, so the parser and code generator are unchanged. *)
+
+FROM SYSTEM IMPORT BYTE ;
+
+FROM CompilerShared IMPORT MaxCode, CodeMax, MaxPatch, EMemOvf, ECompOvf,
+                          cbuf, pc, imgReady, patches, nPatch, Err ;
+
+(* ---------------------------------------------------------------- *)
+(*  emission :  ebyte / eword / ecall / ejump                        *)
+(* ---------------------------------------------------------------- *)
+
+PROCEDURE Ebyte (b : BYTE) ;
+BEGIN
+   IF (pc >= MaxCode) OR (imgReady AND (pc >= CodeMax)) THEN
+      (* The image buffer bound (MaxCode) and the boot harness's code ceiling
+         (CodeMax).  Globals no longer sit immediately above the code - they
+         live at DataStart and initmem zeroes them - so this is purely a
+         capacity check: cbuf cannot hold another byte, or the image would
+         reach the configured data base.  Reported as TP3's error
+         98 (memory overflow) rather than a silent truncation. *)
+      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 PatchWord (at, w : CARDINAL) ;
+(* Store a 16-bit word into cbuf at an absolute offset.
+
+   A helper, because writing this inline got it wrong in all four header
+   words: the low byte was (w DIV 16) MOD 100H, which is a NIBBLE shift, not
+   the byte shift (w MOD 100H).  So 1181h - the data base - was stored as
+   0118h = 280.  It was invisible for as long as nothing read those words,
+   which is exactly what "write it inline once and trust it" buys you. *)
+BEGIN
+   cbuf [at] := VAL (BYTE, w MOD 100H) ;
+   cbuf [at + 1] := VAL (BYTE, (w DIV 100H) MOD 100H)
+END PatchWord ;
+
+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 ;
+   (* rel16 is measured from the END of the instruction.  Here pc already
+      points past the opcode(s) and at the displacement field, so the
+      instruction ends at pc+2 - the same convention ResolvePatches uses
+      with "place + 2".  Omitting the +2 lands every direct call/jump 2 bytes
+      past its target. *)
+   rel := (target + 10000H - (pc + 2)) 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 + 2)) MOD 10000H ;   (* see EmCall *)
+   Eword (rel) ;
+   RETURN 0
+END EmJmpNear ;
+
+PROCEDURE JccShort (cc : BYTE) : BYTE ;
+(* The 8086 SHORT Jcc opcode for a condition nibble.  70h..7Fh is exactly
+   70h + nibble:  70 JO  71 JNO  72 JB  73 JAE  74 JE  75 JNE  76 JBE  77 JA
+   78 JS  79 JNS  7A JP  7B JNP  7C JL  7D JGE  7E JLE  7F JG.
+   So 70H + cc is the same condition the 386-only `0F 8x rel16' (for a Jcc) or
+   `0F 9x' (for a SETcc) encoded, which is what lets the seven EmJcc sites and
+   the six EmSetcc arms go on passing the low byte they always passed. *)
+VAR n : CARDINAL ;
+BEGIN
+   n := VAL (CARDINAL, cc) MOD 10H ;
+   RETURN VAL (BYTE, 70H + n)
+END JccShort ;
+
+PROCEDURE JccShortInv (cc : BYTE) : BYTE ;
+(* The same, for a jump that is taken when the condition does NOT hold.
+   EmJcc needs this one and EmSetcc needs the other, and the difference is the
+   whole bug, so it is worth being explicit about where it comes from: the low
+   bit of a Jcc code IS the negation bit.  4/5, C/D, E/F, 2/3, 6/7, A/9, B/8 and
+   0/1 are the eight (condition, its negation) pairs, so negating a condition is
+   `n XOR 1' and nothing more - `JE' and `JNE' are 0x74 and 0x75.
+
+   Gm2 under -fiso has no XOR on integers at all: BITAND and BAND are both
+   syntax errors, and arithmetic on a BYTE operand is rejected too, which is
+   why every operand here goes through VAL.  n + 1 - 2*(n MOD 2) is XOR 1 for a
+   four-bit n and it lives in one named place rather than open-coded, because
+   an open-coded negation at two call sites is how they end up disagreeing. *)
+VAR n : CARDINAL ;
+BEGIN
+   n := VAL (CARDINAL, cc) MOD 10H ;
+   RETURN VAL (BYTE, 70H + n + 1 - 2 * (n MOD 2))
+END JccShortInv ;
+
+PROCEDURE EmJcc (cc : BYTE ; target : CARDINAL) : CARDINAL ;
+(* A conditional branch, 8086 style.  `cc' is the condition nibble, and it is
+   exactly the low byte of the `0F 8x rel16' this used to emit.
+
+   That was a real fault and nothing in the build could see it: `0F' is a
+   386-and-later opcode prefix and the 8086 has none, so EVERY conditional
+   branch in EVERY compiled program was an illegal instruction on the machine
+   TP3 targets.  FCML decoded it happily, because FCML's -m16 mode is 386 --
+   and FCML is this project's independent disassembler, so the one tool that
+   could have objected was the one guaranteed to agree.  qemu-system-i386 has
+   no 8086 model either; its lowest is 486.  So the compile succeeded, the
+   .COM linked, the layout checked, the golden held and all 30 fixtures ran to
+   the right answers, all at once, with the bug in.
+
+   TPSRC8 lays IF, WHILE and REPEAT out as
+
+       MOV AL,brnchop ; MOV AH,#$03 ; CALL eword ; PUSH pc ; CALL ejump
+
+   i.e. a SHORT Jcc of displacement 3, stepping over a 3-byte EJMP.  That is
+   the shape here too, and EmJmpNear already owns the displacement arithmetic
+   and the patch slot, so it is three lines and there is no second copy of
+   that rule.
+
+   The one thing that is NOT the same as TPSRC8, and cost a round of "every
+   conditional is inverted" (t09_if printed pos/nonpos/lt for a program that
+   must print nonpos/pos/ge): TP3's brnchop is the branch taken when the
+   condition is TRUE, and TP3 steps over the EJMP when it is taken.  Here `cc'
+   is the branch taken when the condition is FALSE -- IF's `EmJcc (84H)' is
+   JZ, patched to the ELSE, so it must fire when the test failed.  EmJcc jumps
+   to the target, it does not step over it, so stepping over an EJMP and then
+   falling into the destination is the wrong way round: the byte has to be
+   JccShortInv, not JccShort.  The control flow that comes out is identical to
+   the `0F 8x' form this replaces; only which of the pair is spelled differs.
+
+   The flags survive, and the FOR test needs them to: it emits CMP and then
+   Jcc with nothing in between, so anything that wrote a flag here would
+   break the loop.  Jcc and EJMP both leave the flags alone. *)
+BEGIN
+   Ebyte (JccShortInv (cc)) ;        (* Jcc_s, taken when cc does NOT hold *)
+   Ebyte (03H) ;                     (* rel8: step over the 3-byte EJMP *)
+   RETURN EmJmpNear (target)         (* target = 0 => forward, see above *)
+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 EmMovCxi (imm : CARDINAL) ;
+BEGIN
+   Ebyte (0B9H) ; Eword (imm)
+END EmMovCxi ;
+
+PROCEDURE EmMovBpSp () ;
+BEGIN
+   Ebyte (8BH) ; Ebyte (0ECH)
+END EmMovBpSp ;
+
+PROCEDURE EmMovAh0 () ;
+BEGIN
+   Ebyte (0B4H) ; Ebyte (0H)
+END EmMovAh0 ;
+
+PROCEDURE EmMovAxSp () ;
+(* Read the top of the stack into AX, leaving the stack unchanged.
+
+   The obvious encoding, MOV AX,[SP], DOES NOT EXIST on the 8086.  There is
+   no encoding of [SP] as a memory operand: SIB bytes, which is how [ESP]
+   would be written, did not exist until the 386, and mod=00 / rm=100 is
+   [SI], not [SP].  The first version of this emitted 8B 44 24 00 - mod=01,
+   rm=100, SIB=24h, disp8=0 - which is correct only on a 386 and above.  Two
+   of this project's oracles agree that it is wrong: fcml in 16-bit mode
+   decodes it as MOV AX,[SI+0x24h], and so does qemu executing it, because
+   qemu follows the CPU's rules for the encoding it is given rather than
+   guessing.  It was not the encoder's fault that the bytes were well formed;
+   they were, and they read SI+24h.
+
+   The observable effect was that CASE compiled to no branches at all: each
+   label test loaded a garbage address, every comparison failed, and the
+   program fell straight past the whole statement and exited without printing.
+   A CASE fixture caught it.  Nothing else could have - the encoding is
+   valid, the size is right, and the byte-level checks have no way to know
+   what register was meant.
+
+   So: POP then PUSH the same value.  Two bytes, no SIB, correct on every
+   8086, and observationally identical to peeking - the stack pointer ends
+   where it started, holding the same value. *)
+BEGIN
+   Ebyte (58H) ;                     (* POP AX  *)
+   Ebyte (50H)                      (* PUSH AX *)
+END EmMovAxSp ;
+
+PROCEDURE EmMovCxSp () ;
+(* The same, for CX - the FOR loop's bound, pushed by the FOR statement and
+   re-read on every iteration.  This one was emitting 8B 0C and nothing else,
+   which is MOV CX,[SI] with the SIB slot missing: the *next* instruction was
+   consumed as the SIB byte and the displacement.  Same root cause, same fix,
+   and it had not been noticed only because no FOR fixture is executed yet. *)
+BEGIN
+   Ebyte (59H) ;                     (* POP CX  *)
+   Ebyte (51H)                      (* PUSH CX *)
+END EmMovCxSp ;
+
+PROCEDURE EmPushAx () ;
+BEGIN
+   Ebyte (50H)
+END EmPushAx ;
+
+PROCEDURE EmPopCx () ;
+BEGIN
+   Ebyte (59H)
+END EmPopCx ;
+
+PROCEDURE EmPopDx () ;
+BEGIN
+   Ebyte (5AH)
+END EmPopDx ;
+
+PROCEDURE EmPopSi () ;
+BEGIN
+   Ebyte (5EH)                                   (* POP SI *)
+END EmPopSi ;
+
+PROCEDURE EmPopAx () ;
+BEGIN
+   Ebyte (58H)                                   (* POP AX *)
+END EmPopAx ;
+
+PROCEDURE EmPushBx () ;
+BEGIN Ebyte (53H) END EmPushBx ;
+
+PROCEDURE EmPushCx () ;
+BEGIN Ebyte (51H) END EmPushCx ;
+
+PROCEDURE EmPushDx () ;
+BEGIN Ebyte (52H) END EmPushDx ;
+
+PROCEDURE EmPopBx () ;
+BEGIN Ebyte (5BH) END EmPopBx ;
+
+PROCEDURE EmMovAxCx () ;
+BEGIN Ebyte (89H) ; Ebyte (0C8H) END EmMovAxCx ;   (* MOV AX,CX *)
+
+PROCEDURE EmMovChAl () ;
+BEGIN Ebyte (88H) ; Ebyte (0C5H) END EmMovChAl ;   (* MOV CH,AL *)
+
+PROCEDURE EmMovChImm (v : CARDINAL) ;
+BEGIN Ebyte (0B5H) ; Ebyte (VAL (BYTE, v MOD 256)) END EmMovChImm ;
+
+(* 91 = XCHG AX,CX, and NOT 93.  LoadPair hands the operator the left
+   operand in CX and the right in AX (in the original, and still the
+   commonest, shape: it pushes the left, loads the right, then pops the
+   left into CX), so the exchange is what puts LEFT in AX for the
+   operation to act on.
+   Without it, `a - b` computes `b - a`; with the wrong register, `a + b`
+   computes `AX' + a` where AX' is whatever BX happened to hold.
+
+   This emitted 93H = XCHG BX,AX for its entire life, which is the same class
+   of mistake as MovSiBx = 89 DC in Runtime.mod: the right opcode, the wrong
+   ModRM, decoding cleanly.  Byte counts were right, the compile matrix was
+   green, and no exec fixture did arithmetic on two variables - the first one
+   to do so, `c := a + b` with a=7 b=5, printed 263 = 0100h+7, where 0100h
+   was the caller's leftover BX.  The name was the only thing wrong, and
+   nothing read the name: audit_helpers.py swept Runtime.mod and not
+   Compiler.mod, which is where most of these emitters live.  It does both
+   modules now. *)
+PROCEDURE EmXchgAxCx () ;
+BEGIN
+   Ebyte (91H)
+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 EmOrAxAx () ;
+(* 09 C0: OR AX,AX - the 8086's flag-only test of AX, and the one the string
+   comparison needs, because cmpstr hands back a signed -1/0/+1 rather than
+   flags.  OR AX,AX sets SF and ZF from the value and clears OF and CF, which
+   is exactly the flag state a CMP AX,0 would leave - see EmSetcc and
+   ParseCmp's EmRelSetcc.  TEST AX,AX (85 C0) does the same thing, but
+   tests/audit_helpers.py's name grammar has no `Test' mnemonic, and an
+   emitter that cannot be name-checked is worse than one that can.
+
+   It is NOT EmXorAxAx: XORing AX with itself zeroes it, which would throw
+   away the very value the flags are supposed to describe. *)
+BEGIN
+   Ebyte (09H) ; Ebyte (0C0H)
+END EmOrAxAx ;
+
+PROCEDURE EmNegAx () ;
+BEGIN
+   Ebyte (0F7H) ; Ebyte (0D8H)
+END EmNegAx ;
+
+PROCEDURE EmNotAx () ;
+BEGIN
+   Ebyte (0F7H) ; Ebyte (0D0H)
+END EmNotAx ;
+
+PROCEDURE EmXorAl01 () ;
+(* XOR AL,#01 - TPSRC9 neglevel's *boolean* NOT:
+
+       CALL loadatom ; CALL ecode ; B $02,$34,$01
+
+   neglevel tests the type first (CMP CL,#$0A -> integer -> NOT AX,
+   CMP CL,#$0B -> boolean -> XOR AL,#01) and reports error 47 for anything
+   else.  Emitting NOT AX for a boolean leaves 0FFFEh or 0FFFFh, and the
+   runtime's wrbool tests [BP+4] <> 0, so `not (a = a)' came out TRUE. *)
+BEGIN
+   Ebyte (34H) ; Ebyte (01H)
+END EmXorAl01 ;
+
+PROCEDURE EmCmpAxCx () ;
+BEGIN
+   Ebyte (3BH) ; Ebyte (0C1H)
+END EmCmpAxCx ;
+
+PROCEDURE EmCmpAxi (imm : CARDINAL) ;
+BEGIN
+   Ebyte (03DH) ; Eword (imm)
+END EmCmpAxi ;
+
+PROCEDURE EmSetcc (cc : BYTE) ;
+(* Flags -> a Boolean in AX, on an 8086.  `cc' is the SETcc opcode's low byte
+   (94H = E, 95H = NE, 9CH = L, 9DH = GE, 9EH = LE, 9FH = G), i.e. the same
+   condition nibble EmJcc takes.
+
+   This used to emit `0F cc C0' - SETcc - which is 386-and-later, and then a
+   MOV AH,0.  The 8086 cannot read its flags as a value at all, so there was
+   nothing else to fall back on.
+
+   TPSRC9's flgbool is the fallback, and emits exactly this for exactly this
+   case (CH = 04h, a comparison whose result is wanted as a value rather than
+   as a branch):
+
+       CALL ecode ; B $03,$B8,$01,$00   ->  MOV AX,#0001
+       MOV AL,brnchop ; CALL ebyte     ->  JNZ +1
+       CALL ecode ; B $02,$01,$48      ->  DEC AX
+
+   AX stays 1 because the DEC was stepped over, and becomes 0 because it ran.
+   So the shape is one MOV, one short Jcc whose displacement is the length of
+   the DEC, and the DEC - which is EmJcc's shape with a different displacement,
+   and the reason both are two instructions and a byte.
+
+   The polarity is the opposite of EmJcc's, and deliberately so: here the jump
+   must be taken when the comparison is TRUE, because what is being asked is
+   "is this comparison true", and the nibble the six ParseCmp arms pass is the
+   comparison's own opcode.  So this is JccShort and EmJcc is JccShortInv --
+   see EmJcc for why the difference is there at all.  TP3's flgbool writes JNZ
+   for the same reason; in the one case IT reaches flgbool from, the boolean is
+   sitting in AX rather than in the flags, so JNZ is how it says "AX is
+   non-zero".
+
+   AH comes out 0 for free, which is why the EmMovAh0 this used to end with is
+   gone: 6 bytes here where the old sequence was 5.  The FLAGS do not survive,
+   which the old SETcc did - and nothing reads them.  Every conditional branch
+   in the compiler is preceded by its own CMP (see EmJcc's note on the FOR
+   test), and a comparison's value is consumed either as an AX operand or by
+   the test that follows it; the 30 executed fixtures are what holds that
+   down, not this comment. *)
+BEGIN
+   Ebyte (0B8H) ; Eword (1) ;                           (* MOV AX,#0001 *)
+   Ebyte (JccShort (cc)) ;            (* taken when the comparison HOLDS *)
+   Ebyte (01H) ;                     (* rel8: step over the DEC AX *)
+   Ebyte (48H)                                          (* DEC AX *)
+END EmSetcc ;
+
+PROCEDURE EmRelSetcc (op : CARDINAL) ;
+(* The relational operator -> SETcc table, in ONE place, because there are now
+   two callers: ParseCmp's numeric arm, whose flags come from EmCmpAxCx, and
+   its string arm, whose flags come from a cmpstr result put through
+   EmOrAxAx.  It was factored out of ParseCmp when the string arm arrived, and
+   the note it carried is repeated here rather than referenced, because a
+   comment in the caller about a table in another routine is a comment nobody
+   reads.
+
+   The mnemonic is written next to every opcode on purpose.  `op' is a number,
+   so the arm for ">" and the arm for ">=" differed only by two hex digits
+   that are each one letter from the other meaning -- SETG (9FH) and SETGE
+   (9DH).  They were swapped once, which made a > b mean a >= b and a >= b
+   mean a > b.  Only the equality boundary could see it: 6>5, 5<5, -1>-2 and
+   every other case I tried were already right.  An opcode on its own does not
+   say which comparison it is the answer to.
+
+   `op' is ParseCmp's own numbering: 1 "=", 2 "<>", 3 "<", 4 ">", 5 ">=",
+   6 "<=".  The condition nibbles are the SIGNED ones (L/G/GE/LE), and both
+   callers hand it a value whose SIGN is the answer - ParseCmp's numeric arm
+   compares with CMP AX,CX on signed data, and cmpstr answers -1/0/+1 - so
+   the signed test is the right one in both places.  One table also means that
+   swap cannot come back in one arm and not the other: tests/nonvacuity.sh
+   mutates exactly these two lines, and it now breaks the string comparison
+   at the same time as the numeric one. *)
+BEGIN
+   CASE op OF
+      1 : EmSetcc (94H) ;          (* =  SETE  *)
+   |  2 : EmSetcc (95H) ;          (* <> SETNE *)
+   |  3 : EmSetcc (9CH) ;          (* <  SETL  *)
+   |  4 : EmSetcc (9FH) ;          (* >  SETG  *)
+   |  5 : EmSetcc (9DH) ;          (* >= SETGE *)
+   |  6 : EmSetcc (9EH)            (* <= SETLE *)
+   END
+END EmRelSetcc ;
+
+PROCEDURE EmIncAx () ;
+BEGIN
+   Ebyte (40H)
+END EmIncAx ;
+
+PROCEDURE EmDecAx () ;
+BEGIN
+   Ebyte (48H)
+END EmDecAx ;
+
+PROCEDURE EmBpDisp (off, regf : CARDINAL) ;
+(* Emit the ModR/M byte and displacement for a [BP+off] operand, picking the
+   encoding from the size of off.  This is the ONE place that choice is made,
+   because getting it wrong is invisible: 8B 46 d8 and 8B 86 lo hi are both
+   well-formed MOVs, both decode cleanly, and only one of them reads the
+   variable the symbol table names.  So the two are chosen here, once, rather
+   than re-derived at each of the four call sites.  See the ModR/M table in
+   Runtime.mod.
+
+      off <= 127 -> mod=01 rm=110 -> 46 <disp8>      3 bytes with the opcode
+      otherwise  -> mod=10 rm=110 -> 86 <disp16>     4 bytes with the opcode
+
+   Both displacements are SIGNED, and that is the whole subtlety:
+
+     - `off` is a 16-bit value and locals are packed top-anchored below BP:
+       locFree is the highest still-free byte (0FFFFh = -1 at entry), a local of
+       size n is based so its LAST byte sits on locFree, and locFree then drops
+       by n.  So the first INTEGER local is at off = 0FFFEh = -2, the second at
+       0FFFCh = -4, and so on - and a string local, which grows UP from its
+       base, lands wholly below BP instead of straddling it.  The disp16 form
+       reads those same two bytes as a signed value and addresses the negative
+       slot correctly.  There is no overflow case: all 65536 values of `off`
+       are representable, and a frame larger than 64K is a different problem.
+     - The old code took `off MOD 100H` and always emitted disp8.  That is
+       the correct low byte for every displacement, so it was accidentally
+       right across -32768..+127, which is where locals actually live.  It
+       went wrong at +128, where disp8 80h is -128 and not +128.  So this
+       changes no existing program's bytes and fixes the one case that was
+       broken -- a bug nobody had hit yet, which is exactly why it wanted a
+       test rather than an argument. *)
+BEGIN
+   (* mod=01 rm=110 -> 40H + regf*8 + 6H, mod=10 rm=110 -> 80H + regf*8 + 6H.
+      regf is the ModR/M reg field: 0 when the opcode's register is the
+      accumulator (every original caller), 7 for the DI forms EmLeaDi needs.
+      rm is 110 ([BP+disp]) in both. *)
+   IF off <= 127 THEN
+      Ebyte (VAL (BYTE, 40H + regf * 8 + 6H)) ; Ebyte (VAL (BYTE, off))
+   ELSE
+      Ebyte (VAL (BYTE, 80H + regf * 8 + 6H)) ; Eword (off)
+   END
+END EmBpDisp ;
+
+PROCEDURE EmBxDisp (off, regf : CARDINAL) ;
+(* The [BX+disp] twin of EmBpDisp.  A nested procedure reaches an enclosing
+   frame through the static link in BX; the displacement rules are identical
+   except for the rm field (111 for BX instead of 110 for BP). *)
+BEGIN
+   IF off <= 127 THEN
+      Ebyte (VAL (BYTE, 40H + regf * 8 + 7H)) ; Ebyte (VAL (BYTE, off))
+   ELSE
+      Ebyte (VAL (BYTE, 80H + regf * 8 + 7H)) ; Eword (off)
+   END
+END EmBxDisp ;
+
+PROCEDURE EmMovBxBp () ;
+BEGIN Ebyte (89H) ; Ebyte (0EBH) END EmMovBxBp ;   (* MOV BX,BP *)
+
+PROCEDURE EmMovDxBp () ;
+BEGIN Ebyte (89H) ; Ebyte (0EAH) END EmMovDxBp ;   (* MOV DX,BP *)
+
+PROCEDURE EmMovDxBx () ;
+BEGIN Ebyte (89H) ; Ebyte (0DAH) END EmMovDxBx ;   (* MOV DX,BX *)
+
+PROCEDURE EmMovDxAx () ;
+BEGIN Ebyte (89H) ; Ebyte (0C2H) END EmMovDxAx ;       (* DX:=AX *)
+
+PROCEDURE EmMovAxDx () ;
+BEGIN Ebyte (89H) ; Ebyte (0D0H) END EmMovAxDx ;   (* MOV AX,DX *)
+
+PROCEDURE EmLdBxBx (off : CARDINAL) ;
+(* BX := [BX+off] - one step up the static-link chain. *)
+BEGIN Ebyte (8BH) ; EmBxDisp (off, 3) END EmLdBxBx ;
+
+PROCEDURE EmLoadVarBx (off, nbytes : CARDINAL) ;
+BEGIN
+   IF nbytes = 1 THEN
+      Ebyte (8AH) ; EmBxDisp (off, 0)
+   ELSE
+      Ebyte (8BH) ; EmBxDisp (off, 0)
+   END
+END EmLoadVarBx ;
+
+PROCEDURE EmStoreVarBx (off, nbytes : CARDINAL) ;
+BEGIN
+   IF nbytes = 1 THEN
+      Ebyte (88H) ; EmBxDisp (off, 0)
+   ELSE
+      Ebyte (89H) ; EmBxDisp (off, 0)
+   END
+END EmStoreVarBx ;
+
+PROCEDURE EmLeaDiBx (off : CARDINAL) ;
+BEGIN Ebyte (8DH) ; EmBxDisp (off, 7) END EmLeaDiBx ;
+
+END CompilerEmit.

shell/CompilerShared.def

@@ -0,0 +1,42 @@
+DEFINITION MODULE CompilerShared ;
+
+(* State shared by the Compiler modules: the image buffer, program counter,
+   patch list, source/error state, and the error reporter.  Keeping this in a
+   small definition module is the first step of splitting the old monolithic
+   Compiler.mod; identifiers are imported unqualified so the parser and code
+   generator read exactly as before. *)
+
+FROM SYSTEM IMPORT BYTE ;
+
+CONST
+   MaxCode = 0A000H ;
+   CodeMax = 0A000H ;
+   MaxPatch = 2000 ;
+   EMemOvf = 98 ;
+   ECompOvf = 99 ;
+   EFileNF = 90 ;
+   EInclNest = 96 ;
+
+TYPE
+   PatchRec =
+      RECORD
+         place  : CARDINAL ;
+         target : CARDINAL ;
+         filled : BOOLEAN ;
+      END ;
+
+VAR
+   cbuf    : ARRAY [0..MaxCode - 1] OF BYTE ;
+   pc      : CARDINAL ;
+   imgReady : BOOLEAN ;
+   patches : ARRAY [0..MaxPatch - 1] OF PatchRec ;
+   nPatch  : CARDINAL ;
+   srcPos  : CARDINAL ;
+   abortFac : BOOLEAN ;
+   errNum   : CARDINAL ;
+   txerrPos : CARDINAL ;
+
+PROCEDURE Err (n : CARDINAL) ;
+PROCEDURE OK () : BOOLEAN ;
+
+END CompilerShared.

shell/CompilerShared.mod

@@ -0,0 +1,17 @@
+IMPLEMENTATION MODULE CompilerShared ;
+
+PROCEDURE Err (n : CARDINAL) ;
+BEGIN
+   IF NOT abortFac THEN
+      abortFac := TRUE ;
+      errNum := n ;
+      txerrPos := srcPos
+   END
+END Err ;
+
+PROCEDURE OK () : BOOLEAN ;
+BEGIN
+   RETURN NOT abortFac
+END OK ;
+
+END CompilerShared.

shell/CompilerSource.def

@@ -0,0 +1,18 @@
+DEFINITION MODULE CompilerSource ;
+
+(* Source-buffer cursor and include expansion.  The exported include state is
+   reset by Compiler.Inittur and used by the lexer's lookahead. *)
+
+VAR
+   srcLen     : CARDINAL ;
+   inclEnd    : CARDINAL ;
+   inclActive : BOOLEAN ;
+
+PROCEDURE CurCh () : CHAR ;
+PROCEDURE GetCh () : CHAR ;
+PROCEDURE PeekAhead (k : CARDINAL) : CHAR ;
+PROCEDURE Upper (ch : CHAR) : CHAR ;
+PROCEDURE SetSourcePath (path : ARRAY OF CHAR) ;
+PROCEDURE ExpandIncludes () ;
+
+END CompilerSource.

shell/CompilerSource.mod

@@ -0,0 +1,256 @@
+IMPLEMENTATION MODULE CompilerSource ;
+
+(* Source-buffer access and {$I file} expansion.  The parser still sees one
+   flat TextBuf; this module owns the cursor, include state and the include
+   pre-pass. *)
+
+FROM SYSTEM IMPORT BYTE, ADR ;
+FROM TextBuf IMPORT TextLimit, Length, CharAt, DeleteFromTo, InsertStr ;
+FROM Posix IMPORT open, read, close ;
+FROM CompilerShared IMPORT srcPos, Err, OK, EMemOvf, EFileNF, EInclNest ;
+
+VAR
+   srcName    : ARRAY [0..255] OF CHAR ;
+   inclName   : ARRAY [0..127] OF CHAR ;
+   inclPath   : ARRAY [0..383] OF CHAR ;
+   incBuf     : ARRAY [0..TextLimit] OF CHAR ;
+
+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 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 SetSourcePath (path : ARRAY OF CHAR) ;
+(* remember the path the buffer was loaded from; MakeIncludePath keeps only its
+   directory *)
+VAR i : CARDINAL ;
+BEGIN
+   i := 0 ;
+   WHILE (i < 255) AND (i <= HIGH (path)) AND (path [i] # 0C) DO
+      srcName [i] := path [i] ;
+      INC (i)
+   END ;
+   srcName [i] := 0C
+END SetSourcePath ;
+
+PROCEDURE ReadWholeFile (path : ARRAY OF CHAR ; VAR n : CARDINAL) : BOOLEAN ;
+(* Read path into incBuf with the same CR/LF normalisation as LoadWorkFile,
+   and report its length in n.  FALSE if it could not be opened.  ^Z ends the
+   text, as it does for every other reader here. *)
+VAR fd : INTEGER ;
+    k : LONGINT ;
+    b : BYTE ;
+    ch : CHAR ;
+    prevCR, emit : BOOLEAN ;
+BEGIN
+   n := 0 ;
+   fd := open (ADR (path), 0, 0) ;
+   IF fd < 0 THEN
+      RETURN FALSE
+   END ;
+   prevCR := FALSE ;
+   LOOP
+      k := read (fd, ADR (b), 1) ;
+      IF k # 1 THEN EXIT END ;
+      IF b = 26 THEN EXIT END ;            (* ^Z *)
+      emit := TRUE ;
+      IF b = 10 THEN
+         IF prevCR THEN
+            emit := FALSE
+         ELSE
+            ch := CHR (13)                 (* lone LF -> CR *)
+         END ;
+         prevCR := FALSE
+      ELSIF b = 13 THEN
+         ch := CHR (13) ;
+         prevCR := TRUE
+      ELSE
+         ch := CHR (ORD (b)) ;
+         prevCR := FALSE
+      END ;
+      IF emit AND (n <= TextLimit) THEN
+         incBuf [n] := ch ;
+         INC (n)
+      END
+   END ;
+   k := close (fd) ;
+   RETURN TRUE
+END ReadWholeFile ;
+
+PROCEDURE MakeIncludePath () ;
+(* inclPath := directory (srcName) + inclName, defaulting the extension to
+   .PAS when the name has none (TPSRC10 kpasext). *)
+VAR i, j, last : CARDINAL ; dot : BOOLEAN ;
+BEGIN
+   dot := FALSE ;
+   i := 0 ;
+   WHILE (i < 127) AND (inclName [i] # 0C) DO
+      IF inclName [i] = '.' THEN dot := TRUE END ;
+      INC (i)
+   END ;
+   IF (NOT dot) AND (i <= 123) THEN
+      inclName [i]     := '.' ;
+      inclName [i + 1] := 'P' ;
+      inclName [i + 2] := 'A' ;
+      inclName [i + 3] := 'S' ;
+      inclName [i + 4] := 0C
+   END ;
+   last := 0 ;
+   i := 0 ;
+   WHILE (i < 256) AND (srcName [i] # 0C) DO
+      IF srcName [i] = '/' THEN last := i + 1 END ;
+      INC (i)
+   END ;
+   j := 0 ;
+   WHILE j < last DO
+      inclPath [j] := srcName [j] ;
+      INC (j)
+   END ;
+   i := 0 ;
+   WHILE (i < 127) AND (inclName [i] # 0C) DO
+      inclPath [j] := inclName [i] ;
+      INC (j) ;
+      INC (i)
+   END ;
+   inclPath [j] := 0C
+END MakeIncludePath ;
+
+PROCEDURE ExpandIncludes () ;
+(* Replace every {$I name} directive in the buffer with the named file's text,
+   BEFORE parsing.
+
+   This is a pre-pass, and it has to be.  Skip is called by lookahead routines
+   (DeclaresProc, PeekKw, KwAhead) that SAVE AND RESTORE srcPos; an include
+   performed inside Skip would run once during the lookahead and once for real,
+   and the second pass would see the first splice's text and report error 96.
+   A splice also grows the buffer, which a rewind cannot undo.  So the whole
+   expansion is done here, in one forward scan with no lookahead, and the
+   parser only ever sees the finished text.
+
+   The scan has to recognise exactly what the lexer does, or it would expand a
+   directive that the lexer would have read as a string or a comment: a quoted
+   literal is skipped, then star-paren comments (which is why {$I} written
+   inside one is inert - t56_include.inc relies on that), then brace comments,
+   and only then a brace directive.
+
+   Divergence from the original: TP3 STREAMS the include file line by line and
+   switches back to the outer file at EOF (TPSRC10 fileline/getincl/fileeof);
+   we hold the whole source in TextBuf and address it by index, so the include
+   is spliced in place.  A nested {$I} therefore cannot switch back on its own
+   - which TP3 also refuses, and that is the error 96 reported here. *)
+VAR i, d0, d1, k, ni, n : CARDINAL ;
+    c, letter : CHAR ;
+    isInc : BOOLEAN ;
+BEGIN
+   i := 0 ;
+   inclActive := FALSE ;
+   inclEnd := 0 ;
+   WHILE (i < Length ()) AND OK () DO
+      c := CharAt (i) ;
+      IF c = "'" THEN
+         INC (i) ;
+         WHILE (i < Length ()) AND (CharAt (i) # "'") DO INC (i) END ;
+         IF i < Length () THEN INC (i) END
+      ELSIF (c = '(') AND (i + 1 < Length ()) AND (CharAt (i + 1) = '*') THEN
+         INC (i, 2) ;
+         WHILE (i < Length ()) AND NOT ((CharAt (i) = '*')
+                     AND (i + 1 < Length ()) AND (CharAt (i + 1) = ')')) DO
+            INC (i)
+         END ;
+         IF i < Length () THEN INC (i, 2) END
+      ELSIF (c = '{') AND (i + 1 < Length ()) AND (CharAt (i + 1) = '$') THEN
+         d0 := i ;
+         d1 := i + 2 ;
+         WHILE (d1 < Length ()) AND (CharAt (d1) # '}') DO INC (d1) END ;
+         IF i + 2 < Length () THEN
+            letter := Upper (CharAt (i + 2))
+         ELSE
+            letter := 0C
+         END ;
+         isInc := FALSE ;
+         IF letter = 'I' THEN
+            k := i + 3 ;
+            WHILE (k < d1) AND ((CharAt (k) = ' ') OR (CharAt (k) = CHR (9))) DO
+               INC (k)
+            END ;
+            IF (k >= d1) OR ((CharAt (k) # '+') AND (CharAt (k) # '-')) THEN
+               isInc := TRUE
+            END
+         END ;
+         IF isInc THEN
+            IF inclActive AND (d0 < inclEnd) THEN
+               srcPos := d0 ;
+               Err (EInclNest) ;                  (* 96 *)
+               RETURN
+            END ;
+            ni := 0 ;
+            WHILE (k < d1) AND (ni < 127) DO
+               inclName [ni] := CharAt (k) ;
+               INC (k) ;
+               INC (ni)
+            END ;
+            WHILE (ni > 0) AND ((inclName [ni - 1] = ' ')
+                                OR (inclName [ni - 1] = CHR (9))) DO
+               DEC (ni)
+            END ;
+            inclName [ni] := 0C ;
+            MakeIncludePath () ;
+            IF NOT ReadWholeFile (inclPath, n) THEN
+               srcPos := d0 ;
+               Err (EFileNF) ;                    (* 90 *)
+               RETURN
+            END ;
+            DeleteFromTo (d0, d1 - d0 + 1) ;
+            IF NOT InsertStr (d0, incBuf, n) THEN
+               srcPos := d0 ;
+               Err (EMemOvf) ;
+               RETURN
+            END ;
+            inclEnd := d0 + n ;
+            inclActive := TRUE ;
+            i := d0                                 (* scan the new text too *)
+         ELSE
+            i := d1 + 1                             (* ordinary directive: leave it *)
+         END
+      ELSIF c = '{' THEN
+         INC (i) ;
+         WHILE (i < Length ()) AND (CharAt (i) # '}') DO INC (i) END ;
+         IF i < Length () THEN INC (i) END
+      ELSE
+         INC (i)
+      END
+   END ;
+   srcLen := Length () ;
+   srcPos := 0
+END ExpandIncludes ;
+
+END CompilerSource.

shell/CompilerUtil.def

@@ -0,0 +1,20 @@
+DEFINITION MODULE CompilerUtil ;
+
+(* Pure utility procedures shared by the compiler modules. *)
+
+PROCEDURE Digit (ch : CHAR) : BOOLEAN ;
+PROCEDURE Alpha (ch : CHAR) : BOOLEAN ;
+PROCEDURE AlphaNum (ch : CHAR) : BOOLEAN ;
+PROCEDURE IsHexCh (ch : CHAR) : BOOLEAN ;
+PROCEDURE W16 (x : LONGINT) : CARDINAL ;
+PROCEDURE DropCh (v : CHAR) ;
+PROCEDURE DropB (v : BOOLEAN) ;
+PROCEDURE DropC (v : CARDINAL) ;
+PROCEDURE BitAnd (a, b : LONGINT) : LONGINT ;
+PROCEDURE BitOr (a, b : LONGINT) : LONGINT ;
+PROCEDURE BitNot (a : LONGINT) : LONGINT ;
+PROCEDURE NameEq (a : ARRAY OF CHAR ; b : ARRAY OF CHAR) : BOOLEAN ;
+PROCEDURE CopyStr (VAR dst : ARRAY OF CHAR ; src : ARRAY OF CHAR) ;
+PROCEDURE NumToName (n : CARDINAL ; VAR dst : ARRAY OF CHAR) ;
+
+END CompilerUtil.

shell/CompilerUtil.mod

@@ -0,0 +1,141 @@
+IMPLEMENTATION MODULE CompilerUtil ;
+
+(* Pure helpers: character classification, 16-bit folding, bit operations and
+   fixed-buffer string/name copies.  No compiler state is touched. *)
+
+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 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 ;
+
+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 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 ;
+
+END CompilerUtil.

shell/Makefile

@@ -6,8 +6,8 @@ FLAGS = -fiso
 # pass-3 rollup on a compiler-size program ("too many errors in pass 3"), so
 # the import closure is generated first and the link then consumes it.  Phase 1
 # exiting 1 is the expected rollup, hence the `|| true`.
-MODS  = Shell Term TermCfg Keys Posix TextBuf Editor Compiler Runtime Linker Exec86
-LINK  = Shell.mod Term.o TermCfg.o Keys.o Posix.o TextBuf.o Editor.o Compiler.o Runtime.o Linker.o Exec86.o
+MODS  = Shell Term TermCfg Keys Posix TextBuf Editor CompilerShared CompilerUtil CompilerSource CompilerEmit Compiler Runtime Linker Exec86
+LINK  = Shell.mod Term.o TermCfg.o Keys.o Posix.o TextBuf.o Editor.o CompilerShared.o CompilerUtil.o CompilerSource.o CompilerEmit.o Compiler.o Runtime.o Linker.o Exec86.o
 
 all: tpshell tp3cfg
 
@@ -45,7 +45,19 @@ Editor.o: Editor.mod Editor.def Term.def TextBuf.def Posix.def Keys.def
 Posix.o: Posix.c Posix.def
 	$(CC) -c Posix.c
 
-Compiler.o: Compiler.mod Compiler.def TextBuf.def Runtime.def
+CompilerShared.o: CompilerShared.mod CompilerShared.def
+	$(GM2) $(FLAGS) -c CompilerShared.mod
+
+CompilerUtil.o: CompilerUtil.mod CompilerUtil.def
+	$(GM2) $(FLAGS) -c CompilerUtil.mod
+
+CompilerSource.o: CompilerSource.mod CompilerSource.def CompilerShared.def
+	$(GM2) $(FLAGS) -c CompilerSource.mod
+
+CompilerEmit.o: CompilerEmit.mod CompilerEmit.def CompilerShared.def
+	$(GM2) $(FLAGS) -c CompilerEmit.mod
+
+Compiler.o: Compiler.mod Compiler.def TextBuf.def Runtime.def CompilerShared.def CompilerUtil.def CompilerSource.def CompilerEmit.def
 	$(GM2) $(FLAGS) -c Compiler.mod
 
 Runtime.o: Runtime.mod Runtime.def

shell/tests/audit_helpers.py

@@ -324,7 +324,7 @@ RE_BYTE = re.compile(r"(?:\bB|\bEbyte)\s*\(\s*([0-9A-Fa-f]+)H?\s*\)")
 # where the name says XCHG AX,CX) all live: bugs that break every two-variable
 # arithmetic and comparison in every program, invisible because the audit
 # looked at Runtime.mod and found nothing wrong there.
-MODULES = ["Runtime.mod", "Compiler.mod"]
+MODULES = ["Runtime.mod", "Compiler.mod", "CompilerEmit.mod"]
 
 # --- name grammar -----------------------------------------------------
 #
@@ -1005,6 +1005,11 @@ def sweep(src, mod, verbose):
     # entries would stop suppressing their helpers and the report would look
     # like a genuine finding rather than like a broken table.
     documented = set(NON_ONE_LINE.get(mod, {}))
+    if mod == "CompilerEmit.mod":
+        # The primitive emitters moved out of Compiler.mod unchanged, so the
+        # same documented exclusions apply.  Their names are already in the
+        # stripped form the audit uses.
+        documented |= set(NON_ONE_LINE.get("Compiler.mod", {}))
     audited_elsewhere = ({strip(n) for n in _NONLINE_VX}
                          if mod == "Runtime.mod" else set())
     unexamined = (declared - seen - {strip(e) for e in excluded}

shell/tests/run_com_exec.py

@@ -212,8 +212,8 @@ def ensure_comtest():
     # stale compiler, so a fix is invisible and a test that should have gone
     # red stays green.  The .mod files are kept in the list anyway, so editing a
     # source without running make also forces a relink.
-    objs = ["TextBuf.o", "Posix.o", "Compiler.o", "Runtime.o", "Linker.o"]
-    newer = objs + ["Compiler.mod", "Runtime.mod", "Linker.mod", "TextBuf.mod",
+    objs = ["TextBuf.o", "Posix.o", "CompilerShared.o", "CompilerUtil.o", "CompilerSource.o", "CompilerEmit.o", "Compiler.o", "Runtime.o", "Linker.o"]
+    newer = objs + ["CompilerShared.mod", "CompilerUtil.mod", "CompilerSource.mod", "CompilerEmit.mod", "Compiler.mod", "Runtime.mod", "Linker.mod", "TextBuf.mod",
                     "Posix.c", os.path.join("tests", "ComTest.mod")]
     if os.path.exists(exe):
         t = os.path.getmtime(exe)

shell/tests/run_com_tests.sh

@@ -39,7 +39,7 @@ if [ -n "$CHECK_ONLY" ]; then
     [ -d "$OUT" ] || { echo "RESULT: FAIL (no such directory: $OUT)"; exit 1; }
 else
 [ -f Posix.o ] || cc -c Posix.c || exit 1
-for m in TextBuf Compiler Runtime Linker; do
+for m in TextBuf CompilerShared CompilerUtil CompilerSource CompilerEmit Compiler Runtime Linker; do
    $GM2 $FLAGS -c $m.mod >../tmp/cm_c_$m 2>&1 \
       || { echo "COMPILE_FAIL $m"; grep -m5 "error:" ../tmp/cm_c_$m; exit 1; }
 done
@@ -48,11 +48,11 @@ $GM2 $FLAGS -c tests/ComTest.mod >../tmp/cm_c_ComTest 2>&1 \
 
 rm -f tests/ct.lst comtest
 $GM2 $FLAGS -fgen-module-list=tests/ct.lst -o /dev/null \
-    tests/ComTest.mod TextBuf.o Posix.o Compiler.o Runtime.o Linker.o \
+    tests/ComTest.mod TextBuf.o Posix.o CompilerShared.o CompilerUtil.o CompilerSource.o CompilerEmit.o Compiler.o Runtime.o Linker.o \
     >../tmp/cm_p1 2>&1
 p1=$?
 $GM2 $FLAGS -fuse-list=tests/ct.lst -o comtest \
-    tests/ComTest.mod TextBuf.o Posix.o Compiler.o Runtime.o Linker.o \
+    tests/ComTest.mod TextBuf.o Posix.o CompilerShared.o CompilerUtil.o CompilerSource.o CompilerEmit.o Compiler.o Runtime.o Linker.o \
     >../tmp/cm_p2 2>&1
 p2=$?
 if [ $p2 -ne 0 ]; then

shell/tests/run_compile_tests.sh

@@ -27,9 +27,9 @@ mkdir -p ../tmp
 # So compiletest is rebuilt whenever it is older than ANY input: the object
 # files it links, the sources those came from, and its own source.
 STALE=no
-for f in compiletest TextBuf.o Posix.o Compiler.o Runtime.o \
+for f in compiletest TextBuf.o Posix.o CompilerShared.o CompilerUtil.o CompilerSource.o CompilerEmit.o Compiler.o Runtime.o \
          tests/CompileTest.mod TextBuf.mod Posix.c Posix.def \
-         Compiler.mod Runtime.mod Linker.mod; do
+         CompilerShared.mod CompilerUtil.mod CompilerSource.mod CompilerEmit.mod Compiler.mod Runtime.mod Linker.mod; do
     if [ -e "$f" ] && [ compiletest -ot "$f" ]; then STALE=yes; break; fi
 done
 if [ "$STALE" = yes ]; then
@@ -37,11 +37,17 @@ if [ "$STALE" = yes ]; then
     rm -f compiletest
 fi
 
-if [ ! -f TextBuf.o ] || [ ! -f Compiler.o ] || [ ! -f Posix.o ] \
-   || [ ! -f Runtime.o ] \
-   || [ TextBuf.mod -nt TextBuf.o ] || [ Compiler.mod -nt Compiler.o ] \
+if [ ! -f TextBuf.o ] || [ ! -f CompilerShared.o ] || [ ! -f CompilerUtil.o ] || [ ! -f CompilerSource.o ] || [ ! -f CompilerEmit.o ] \
+   || [ ! -f Compiler.o ] || [ ! -f Posix.o ] || [ ! -f Runtime.o ] \
+   || [ TextBuf.mod -nt TextBuf.o ] || [ CompilerShared.mod -nt CompilerShared.o ] \
+   || [ CompilerShared.def -nt CompilerShared.o ] \
+   || [ CompilerUtil.mod -nt CompilerUtil.o ] || [ CompilerUtil.def -nt CompilerUtil.o ] \
+   || [ CompilerSource.mod -nt CompilerSource.o ] || [ CompilerSource.def -nt CompilerSource.o ] \
+   || [ CompilerEmit.mod -nt CompilerEmit.o ] || [ CompilerEmit.def -nt CompilerEmit.o ] \
+   || [ Compiler.mod -nt Compiler.o ] \
    || [ Runtime.mod -nt Runtime.o ] || [ Runtime.def -nt Runtime.o ] \
    || [ Compiler.def -nt Compiler.o ] \
+   || [ CompilerShared.def -nt Compiler.o ] || [ CompilerUtil.def -nt Compiler.o ] || [ CompilerSource.def -nt Compiler.o ] || [ CompilerEmit.def -nt Compiler.o ] \
    || [ Posix.c -nt Posix.o ] || [ Posix.def -nt Posix.o ]; then
    echo "building support modules (source newer than object)..."
    # Runtime is listed because Compiler now links against it: the blob is
@@ -53,7 +59,7 @@ if [ ! -f TextBuf.o ] || [ ! -f Compiler.o ] || [ ! -f Posix.o ] \
       cc -c Posix.c >../tmp/ct_c_Posix 2>&1 \
          || { echo "COMPILE_FAIL Posix"; grep -m5 "error:" ../tmp/ct_c_Posix; exit 1; }
    fi
-   for m in TextBuf Compiler Runtime; do
+   for m in TextBuf CompilerShared CompilerUtil CompilerSource CompilerEmit Compiler Runtime; do
       $GM2 $FLAGS -c $m.mod >../tmp/ct_c_$m 2>&1
       if [ $? -ne 0 ]; then
          echo "COMPILE_FAIL $m"
@@ -66,10 +72,10 @@ fi
 
 rm -f tests/ct.lst compiletest
 $GM2 $FLAGS -fgen-module-list=tests/ct.lst -o /dev/null \
-    tests/CompileTest.mod TextBuf.o Posix.o Compiler.o Runtime.o >../tmp/ct_p1 2>&1
+    tests/CompileTest.mod TextBuf.o Posix.o CompilerShared.o CompilerUtil.o CompilerSource.o CompilerEmit.o Compiler.o Runtime.o >../tmp/ct_p1 2>&1
 p1=$?
 $GM2 $FLAGS -fuse-list=tests/ct.lst -o compiletest \
-    tests/CompileTest.mod TextBuf.o Posix.o Compiler.o Runtime.o >../tmp/ct_p2 2>&1
+    tests/CompileTest.mod TextBuf.o Posix.o CompilerShared.o CompilerUtil.o CompilerSource.o CompilerEmit.o Compiler.o Runtime.o >../tmp/ct_p2 2>&1
 p2=$?
 if [ $p2 -ne 0 ]; then
    echo "LINK_FAIL p1_rc=$p1 p2_rc=$p2"