TP3/shell/Runtime.mod

IMPLEMENTATION MODULE Runtime ;

(* 8086 runtime library, assembled byte by byte.  Each little emitter below is
   one 8086 instruction; the ModR/M byte is spelled out in the comment so the
   encoding can be checked by hand against an 8086 table.  This is the same
   approach the compiler itself takes in Compiler.mod (Ebyte/Eword/EmCall),
   so the library needs no external assembler and no binary artifact in the
   tree - RT_Build assembles it every run, which is why the entry offsets are
   known exactly and are not guesses.

   Memory model: a .COM image, so CS = DS = ES = SS = 0 and the whole thing
   lives in one 64K segment.  The runtime occupies image offsets
   RT_Build's base .. base + RT_Size - 1, the generated program follows, and
   the program's globals follow at that + 1000H.

   The base is a parameter rather than an assumption, and that is not
   decoration.  The image begins with a three-byte JMP - a .COM is entered at
   file offset 0, and without it a .COM built by this compiler starts by
   executing initmem - so the runtime does NOT sit at image offset 0.  Every
   address the runtime bakes into its own code (its data block, and the entry
   offsets it hands back) therefore has to be biased by that base.  Two places
   do it, and only two: FixUp for the data block, and RT_Entry for the
   entries.  The emitted BYTES are identical for any base, because both are
   computed after assembly; tests/check_runtime.py and tests/runtime.golden
   pass base 0 and are unaffected.

   Calling conventions, matching Compiler.IoCall:
     WrInt/WrChar/WrBool/WrReal  one 16-bit value on the stack (caller pops)
     RdInt/RdChar/RdBool         one address on the stack (caller pops)
     WrLn/RdLn/StackChk          nothing
     InitMem                     AX = offset of the program header word block
     ProgEnd/Halt                nothing; exits with code 0
   All entries preserve BP and SP, and every register except the documented
   result, so they can be called from the middle of an expression. *)

FROM SYSTEM IMPORT BYTE ;

CONST
   MaxRt  = 4096 ;
   (* MaxLbl and MaxFix were 64 and 400, and M/AddFix used to DROP once full.
      That limit does not announce itself: a dropped label leaves its bytes in
      place, so the runtime still has the right LENGTH and the only symptom is
      one branch whose rel8 came out as LblOff's "not found" value.  String
      concatenation added the four labels that crossed 64, and strcat's
      `jcxz sc_done' ended up pointing 47 bytes past the code - a wrong target
      that ran the machine into the zero gap.  Sizing them with margin fixes
      that case; the fill checks below make any future overflow a HALT instead
      of wrong code.  tests/check_runtime.py's branch-boundary check is what
      caught this one. *)
   MaxLbl = 160 ;       (* the MBF core's labels took the count past 96 *)
   MaxFix = 768 ;
   MaxNm  = 15 ;

   (* Offsets inside the runtime's own data block.  These must agree with the
      bytes EmitData emits, and EmitData ASSERTS that they do - because the
      only other way to find out is to run a program, and a D_ constant that
      is one too high does not crash: the $ that terminates the string it
      points at is simply somewhere else, and a $-string read from the wrong
      address runs on until it happens to find a 24h.  wrln did exactly that
      and printed a screenful of memory, which is what found this.  D_TRUE was
      the only one that was right, and the golden (instructions only) could
      not see any of it. *)
   D_NUM   = 0 ;      (* 8 bytes, decimal conversion scratch *)
   D_TRUE  = 8 ;      (* "TRUE$"  - 5 bytes, 8..12 *)
   D_FALSE = 13 ;     (* "FALSE$" - 6 bytes, 13..18 *)
   D_CRLF  = 19 ;     (* CR LF '$' - 3 bytes, 19..21 *)
   D_REAL  = 22 ;     (* "?REAL?" - 6 bytes, 22..27; reals are not formatted yet *)
   D_PUSH  = 28 ;     (* 2 bytes, 28..29: the one-character pushback.  The high
                          byte is 1 whenever a character is pending, so the
                          word is 0 exactly when the slot is empty - a NUL in
                          the input would otherwise be indistinguishable from
                          "nothing pushed back".  Byte 30 is unused. *)
   D_RSIGN = 30 ;     (* 2 bytes: the result sign word; D_RESAVE (31) is its
                          high byte, which is the sign the reference keeps *)
   D_RESAVE = 31 ;    (* the high byte of D_RSIGN: the saved sign *)
   D_RMANT = 32 ;     (* 2 bytes: the second operand's saved MSB *)
   D_RMANT1 = 33 ;    (* its high byte, mixed with operand 1's sign *)
   D_CVDEC = 34 ;     (* 1 byte: the second exponent during alignment *)
   D_END   = 35 ;     (* the block is padded to here *)

   (* THE LOAD BIAS.  Everything above is an offset into the image as this
      compiler numbers it: the entry JMP is at image 0.  But a DOS .COM is
      NOT loaded at that offset - DOS loads it at CS:0100, because 0000..00FF
      is the PSP - so image offset K lives at CS:(K + 0100h), and since a
      .COM has CS = DS, every address baked into the image as a literal has
      to carry that +0100h.

      Getting this wrong is the single most confusing failure this compiler
      can have, because nothing crashes.  The entry JMP is *relative*, so it
      still lands on the prologue; every CALL is relative, so every call
      still lands on the right runtime entry; initmem still runs and still
      zeroes the data area.  The program therefore starts, runs, and prints
      its first field correctly - and then a $ that is 0100h too low resolves
      to code instead of to data, so the string walk runs on through the
      runtime's own instructions until it happens to hit a 24h.  That is
      exactly what writeln('hi') did: `hi' out of wrtin's inline data, then
      249 bytes of runtime machine code, stopping only at the '$' inside
      "TRUE$".  See tests/fixtures/t02_writeln.out.

      The bias is a CONSTANT, not a variable to be relocated at load time,
      because the 8086 has no way to relocode an image in place and no way
      to set a segment register to a sub-paragraph boundary.  It is the same
      +0100h the original's own output has: TPSRC7 opendest copies the
      generated image to 100h and runs it there, so the original's addresses
      are 0100h-relative too.  The difference is only in how the bytes are
      *numbered* - ours are 0-based in the file, the original's are
      segment-relative - and this constant is where that difference stops.

   The constant itself is declared in Runtime.def, because that is the only
   declaration site a compiler can import - an implementation module does not
   re-declare what its definition module already declared. *)

TYPE
   LblRec = RECORD
      nm  : ARRAY [0..MaxNm] OF CHAR ;
      off : CARDINAL ;
   END ;

   FixRec = RECORD
      kind  : CARDINAL ;     (* 0 = rel8, 1 = rel16, 2 = data address *)
      place : CARDINAL ;     (* offset of the displacement/address field *)
      nm    : ARRAY [0..MaxNm] OF CHAR ;
      val   : CARDINAL ;
   END ;

VAR
   rt     : ARRAY [0..MaxRt - 1] OF BYTE ;
   rpos   : CARDINAL ;
   lbl    : ARRAY [0..MaxLbl - 1] OF LblRec ;
   ltop   : CARDINAL ;
   fix    : ARRAY [0..MaxFix - 1] OF FixRec ;
   nfix   : CARDINAL ;
   dataAt : CARDINAL ;
   rtBase : CARDINAL ;
   built  : BOOLEAN ;
   entNm  : ARRAY [0..23] OF ARRAY [0..MaxNm] OF CHAR ;

(* ---------------------------------------------------------------- *)
(*  name helpers                                                     *)
(* ---------------------------------------------------------------- *)

PROCEDURE StrEq (a, b : ARRAY OF CHAR ) : BOOLEAN ;
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (a)) AND (i <= HIGH (b)) DO
      IF a [i] # b [i] THEN
         RETURN FALSE
      END ;
      INC (i)
   END ;
   RETURN TRUE
END StrEq ;

PROCEDURE SetStr (VAR dst : ARRAY OF CHAR ; src : ARRAY OF CHAR ) ;
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (dst)) AND (i <= HIGH (src)) DO
      dst [i] := src [i] ;
      INC (i)
   END ;
   IF i <= HIGH (dst) THEN
      dst [i] := 0C
   END
END SetStr ;

(* ---------------------------------------------------------------- *)
(*  primitive emitters                                               *)
(* ---------------------------------------------------------------- *)

PROCEDURE B (b : CARDINAL ) ;
(* emit exactly ONE byte.  A two-byte opcode must be written as two B calls -
   B masks to 100H, so B (8BE4H) would silently emit just E4. *)
BEGIN
   IF rpos >= MaxRt THEN
      RETURN                            (* blob is oversized: drop the byte *)
   END ;
   rt [rpos] := VAL (BYTE, b MOD 100H) ;
   INC (rpos)
END B ;

PROCEDURE W (w : CARDINAL ) ;
BEGIN
   B (w MOD 100H) ;
   B ((w DIV 100H) MOD 100H)           (* little endian *)
END W ;

PROCEDURE M (nm : ARRAY OF CHAR ) ;
(* mark: nm is the current offset *)
BEGIN
   (* A dropped label is not a smaller runtime, it is a WRONG one: its bytes
      are still emitted, so only a branch that names it goes off target.  That
      shows up in neither the size nor the entry table, so refuse to build
      rather than drop. *)
   IF ltop >= MaxLbl THEN
      HALT
   END ;
   SetStr (lbl [ltop].nm, nm) ;
   lbl [ltop].off := rpos ;
   INC (ltop)
END M ;

PROCEDURE AddFix (kind, place : CARDINAL ; nm : ARRAY OF CHAR ; val : CARDINAL ) ;
(* Record a displacement to be patched once every label is known.  A dropped
   fixup is an address that is never patched - the same silent-wrong-code
   failure the check in M exists to prevent. *)
BEGIN
   IF nfix >= MaxFix THEN
      HALT
   END ;
   fix [nfix].kind := kind ;
   fix [nfix].place := place ;
   fix [nfix].val := val ;
   SetStr (fix [nfix].nm, nm) ;
   INC (nfix)
END AddFix ;

PROCEDURE LblOff (nm : ARRAY OF CHAR ) : CARDINAL ;
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE i < ltop DO
      IF StrEq (lbl [i].nm, nm) THEN
         RETURN lbl [i].off
      END ;
      INC (i)
   END ;
   RETURN 0
END LblOff ;

PROCEDURE J8 (nm : ARRAY OF CHAR ) ;
BEGIN
   B (0EBH) ;                          (* JMP rel8 *)
   AddFix (0, rpos, nm, 0) ;
   B (0)
END J8 ;

PROCEDURE C8 (nm : ARRAY OF CHAR ) ;
BEGIN
   B (0E8H) ;                          (* CALL rel16 *)
   AddFix (1, rpos, nm, 0) ;
   W (0)
END C8 ;

PROCEDURE Jcc (code : CARDINAL ; nm : ARRAY OF CHAR ) ;
BEGIN
   B (code) ;                          (* Jcc rel8 *)
   AddFix (0, rpos, nm, 0) ;
   B (0)
END Jcc ;

PROCEDURE Dd (delta : CARDINAL ) ;
(* emit a 16-bit address into the runtime's data block; the value is only
   known once the data block has been placed, so it is a fixup *)
BEGIN
   AddFix (2, rpos, "", delta) ;
   W (0)
END Dd ;

(* --- 8-bit / 16-bit register and memory forms, one instruction each --- *)

(*  THE 16-BIT ModR/M EFFECTIVE-ADDRESS TABLE, MEASURED NOT REMEMBERED.
    Every address form below was confirmed by EXECUTING it on a real 8086
    (qemu-system-i386) with a probe that stores a marker through the candidate
    encoding and then reports which physical address received it; see
    tests/probe/modrm19.s.  The mod=11 column is not an address at all -- it
    names a register -- so it is confirmed instead by asking GNU as to
    ENCODE the eight register moves and checking FCML's decode of the result
    (tests/probe/modrm11.py, which also carries the hand-checking anchors).

    Do not "fix" any of these from memory.  The version that comes to mind is
    wrong in exactly the cells called out below, and every one of those
    mistakes shipped as code that decoded cleanly:

       r/m   mod=00        mod=01          mod=10          mod=11
       000   [BX+SI]       [BX+SI]+disp    [BX+SI]+disp    AX
       001   [BX+DI]       [BX+DI]+disp    [BX+DI]+disp    CX
       010   [BP+SI]       [BP+SI]+disp    [BP+SI]+disp    DX
       011   [BP+DI]       [BP+DI]+disp    [BP+DI]+disp    BX
       100   [SI]          [SI]+disp       [SI]+disp       SP
       101   [DI]          [DI]+disp       [DI]+disp       BP
       110   disp16        [BP]+disp       [BP]+disp       SI
       111   [BX]          [BX]+disp       [BX]+disp       DI

    "disp" is disp8 for mod=01 and disp16 for mod=10.

    In mod=11 BOTH fields name a register and BOTH use the same list,
    AX CX DX BX SP BP SI DI -- the reg field and the r/m field do not
    differ, and there is no second BX at code 7.  The memorable version
    drops AX off the front and invents a duplicate BX at the end, which
    shifts every code down by one; that is precisely how MovSiBx and
    CmpSiBx came to be written "89 DC" and "39 DC", which are MOV SP,BX
    and CMP SP,BX.  Note what the shifted table gets right by luck: SP is
    at 100 either way, so the mistake is invisible until you check a
    register below it.  rm=100 is SP, and SI is rm=110, not rm=100.

    And reg/rm swap direction with the opcode, which is the other trap:
       88 /r  MOV r/m8,r8    89 /r  MOV r/m16,r16    reg is the SOURCE
       8A /r  MOV r8,r/m8    8B /r  MOV r16,r/m16    reg is the TARGET
    So ModRM C6 names "DH and AL" either way, but 88 C6 is DH:=AL while
    8A C6 is AL:=DH.  The 8-bit register list is also its own, and it is not
    the word list:
       000 001 010 011 100 101 110 111  =  AL CL DL BL AH CH DH BH
    The two lists agree at every code except 100, where the byte form is AH
    and the word form is SP.  Reading the same ModRM byte as the other size
    silently swaps AH for SP, and 88 C2 is DL:=AL while 88 17 is [BX]<-DL.

    The word-form list, and the four anchors nobody writes by hand:
       83 C4 08   ADD SP, 8    rm=100 -> SP
       83 C6 02   ADD SI, 2    rm=110 -> SI
       8B EC      MOV BP, SP   reg=101 rm=100
       8B E5      MOV SP, BP   reg=100 rm=101
    Asking "which register is rm=100?" and answering SI is the single most
    common error in this file's history.

    Concrete recipes for opcode 8r / 9r (r/m = rm, 16-bit form):
       mod=00 rm=110 -> 06  <disp16>     the only direct form
       mod=00 rm=111 -> 07  = [BX]       2 bytes
       mod=00 rm=101 -> 05  = [DI]       2 bytes
       mod=01 rm=110 -> 46  disp8        = [BP]+disp8
       mod=01 rm=111 -> 47  disp8        = [BX]+disp8
       mod=01 rm=101 -> 45  disp8        = [DI]+disp8
    There is no [SP] form in 16-bit mode: SIB bytes are 386-only.  Anything
    wanting the top of the stack has to go through BP. *)


PROCEDURE PushBp ; BEGIN B (55H) END PushBp ;
PROCEDURE PopBp  ; BEGIN B (5DH) END PopBp ;
PROCEDURE MovBpSp ; BEGIN B (8BH) ; B (0ECH) END MovBpSp ;  (* 8B EC: MOV BP,SP *)
PROCEDURE MovSpBp ; BEGIN B (89H) ; B (0ECH) END MovSpBp ;  (* 89 EC: MOV SP,BP *)
PROCEDURE LeaveR ; BEGIN B (0C9H) END LeaveR ;
PROCEDURE RetR   ; BEGIN B (0C3H) END RetR ;
PROCEDURE Int21  ; BEGIN B (0CDH) ; B (21H) END Int21 ;
PROCEDURE PushDs ; BEGIN B (1EH) END PushDs ;
PROCEDURE PopEs  ; BEGIN B (7H) END PopEs ;

PROCEDURE PushAx ; BEGIN B (50H) END PushAx ;
PROCEDURE PopAx  ; BEGIN B (58H) END PopAx ;
PROCEDURE PushBx ; BEGIN B (53H) END PushBx ;
PROCEDURE PopBx  ; BEGIN B (5BH) END PopBx ;
PROCEDURE PushCx ; BEGIN B (51H) END PushCx ;
PROCEDURE PopCx  ; BEGIN B (59H) END PopCx ;
PROCEDURE PushDx ; BEGIN B (52H) END PushDx ;
PROCEDURE PopDx  ; BEGIN B (5AH) END PopDx ;
PROCEDURE PushDi ; BEGIN B (57H) END PushDi ;
PROCEDURE PopDi  ; BEGIN B (5FH) END PopDi ;
PROCEDURE PushSi ; BEGIN B (56H) END PushSi ;
PROCEDURE PopSi  ; BEGIN B (5EH) END PopSi ;

PROCEDURE XorAxAx ; BEGIN B (31H) ; B (0C0H) END XorAxAx ;  (* 11 000 000 *)
PROCEDURE XorCxCx ; BEGIN B (31H) ; B (0C9H) END XorCxCx ;  (* 11 001 001 *)
PROCEDURE XorDxDx ; BEGIN B (31H) ; B (0D2H) END XorDxDx ;  (* 11 010 010 *)
PROCEDURE XorDiDi ; BEGIN B (31H) ; B (0FFH) END XorDiDi ;  (* 11 111 111 *)

PROCEDURE IncCx ; BEGIN B (41H) END IncCx ;
PROCEDURE IncSi ; BEGIN B (46H) END IncSi ;
PROCEDURE IncDi ; BEGIN B (47H) END IncDi ;
PROCEDURE DecSi ; BEGIN B (4EH) END DecSi ;
PROCEDURE AddDi2 ; BEGIN B (83H) ; B (0C7H) ; B (2) END AddDi2 ;  (* 11 000 111 *)

PROCEDURE CmpAl (v : CARDINAL ) ; BEGIN B (3CH) ; B (v) END CmpAl ;
PROCEDURE CmpAx0 ; BEGIN B (83H) ; B (0F8H) ; B (0) END CmpAx0 ;
PROCEDURE CmpCx0 ; BEGIN B (83H) ; B (0F9H) ; B (0) END CmpCx0 ;
PROCEDURE CmpArg2W0 ;
BEGIN
   B (8BH) ; B (0ECH) ;                 (* MOV BP,SP            *)
   B (83H) ; B (7EH) ; B (2) ; B (0) ;  (* CMP WORD [BP+2],0    *)
   B (89H) ; B (0ECH)                   (* MOV SP,BP            *)
END CmpArg2W0 ;

PROCEDURE CmpArg4W0 ;
(* CMP WORD PTR [BP+4],0 - the same comparison, in the frame where the entry
   pushed BP first.
   The 2 and the 4 are the whole point of having two names.  [SP] is not
   encodable in 16-bit mode, so an entry that takes one 16-bit argument has to
   borrow BP to reach it, and how far up the argument then sits depends on
   whether BP was saved first: 2 bytes without the PUSH, 4 with it.  A single
   emitter taking the displacement as a parameter is the obvious way to write
   this and the wrong one -- a parameter is invisible to tests/audit_helpers.py,
   which reads the NAME and compares it against the decode, so `CmpArgW0 (2)'
   and `CmpArgW0 (4)' would differ by one byte with nothing in the codebase
   able to tell which was meant.  In the name, the audit pins it: a helper
   called CmpArg4W0 that emitted 83 7E 02 00 would fail the run.
   Note the sandwich: MOV BP,SP before and MOV SP,BP after, and no POP BP, so
   the two forms are the ONLY difference.  (Was 83 7C 24 00 00, which decodes
   as CMP WORD [SI+24h],0.)  The imm8 of the 83 form is sign-extended to 16
   bits, so 0 really is a 16-bit zero. *)
BEGIN
   B (8BH) ; B (0ECH) ;                 (* MOV BP,SP            *)
   B (83H) ; B (7EH) ; B (4) ; B (0) ;  (* CMP WORD [BP+4],0    *)
   B (89H) ; B (0ECH)                   (* MOV SP,BP            *)
END CmpArg4W0 ;

PROCEDURE CmpSiBx ; BEGIN B (39H) ; B (0DEH) END CmpSiBx ;  (* 39 DE: CMP SI,BX *)
PROCEDURE CmpCxDx ; BEGIN B (39H) ; B (0D1H) END CmpCxDx ;  (* 11 010 001 *)
PROCEDURE CmpAlDl ; BEGIN B (3AH) ; B (0C2H) END CmpAlDl ;  (* 3A C2: CMP AL,DL.
   The byte-sized comparator cmpstr's loop needs, and the two opcodes are NOT
   interchangeable: 3A /r is `CMP r8,r/m8' (reg is the TARGET) and 38 /r is
   `CMP r/m8,r8' (reg is the SOURCE).  AL is reg=000 and DL is r/m=010, so
   3A C2 is CMP AL,DL and 38 C2 would be CMP DL,AL - the same flags negated,
   which turns every `<` into a `>'.  And there is no `CMP AL,[SI]' name
   pattern in tests/audit_helpers.py (only the Ld/St memory names are), so the
   right-hand character is loaded into DL first rather than compared in
   memory. *)
PROCEDURE CmpDiCx ; BEGIN B (39H) ; B (0CFH) END CmpDiCx ;  (* 11 001 111 *)
PROCEDURE CmpBx0  ; BEGIN B (83H) ; B (0FBH) ; B (0) END CmpBx0 ;
PROCEDURE CmpCxV  (v : CARDINAL ) ; BEGIN B (83H) ; B (0F9H) ; B (v) END CmpCxV ;

PROCEDURE AddDl (v : CARDINAL ) ; BEGIN B (80H) ; B (0C2H) ; B (v) END AddDl ;
PROCEDURE SubAl (v : CARDINAL ) ; BEGIN B (2CH) ; B (v) END SubAl ;
PROCEDURE SubAxBx ; BEGIN B (2BH) ; B (0C3H) END SubAxBx ;  (* 2B C3: AX:=AX-BX *)
PROCEDURE NegAx ; BEGIN B (0F7H) ; B (0D8H) END NegAx ;
PROCEDURE NegDi ; BEGIN B (0F7H) ; B (0DFH) END NegDi ;
PROCEDURE DivCx ; BEGIN B (0F7H) ; B (0F1H) END DivCx ;   (* 11 110 001 *)
PROCEDURE MulBx ; BEGIN B (0F7H) ; B (0E3H) END MulBx ;   (* 11 100 011 *)

PROCEDURE MovAh (v : CARDINAL ) ; BEGIN B (0B4H) ; B (v) END MovAh ;
PROCEDURE MovDl (v : CARDINAL ) ; BEGIN B (0B2H) ; B (v) END MovDl ;
(* The runtime's own data block, addressed by absolute image address.  Four
   emitters cover it, and the difference between them is the whole subject of
   the mistakes recorded below, so they are named systematically:

       Mov<reg>Vx   MOV reg, Vx      -- reg  := the ADDRESS   (BB / BA + Dd)
       Ld<reg>Vx    MOV reg, [Vx]    -- reg  := the CONTENTS (8B 1E + Dd)
       StVx<reg>    MOV [Vx], reg    -- [Vx] := reg          (89 1E + Dd)

   "Vx" is the operand word for "a 16-bit absolute address into the data
   block", spelled with a V precisely so it cannot be confused with a base
   register: on the 8086 there is no [BX] memory form, so the address has to
   go through mod=00 / rm=110, and rm=111 is [BX+SI] - a different, perfectly
   decodable instruction.  tests/audit_helpers.py checks all four.

   The two traps here, both of which happened:

   - Dd versus W.  Dd turns a D_ offset into a FIXUP, so the address can be
     placed only once the data block has been given its final position in the
     image.  W emits the number as it stands.  The two produce the SAME
     instruction, and getch once used MovBxImm where it wanted the address, so
     `MOV BX,D_PUSH' came out as `MOV BX,001Ch' - the raw offset 1Ch, inside
     the entry JMP.  Non-zero, so the pushback slot was never examined, getch
     served a byte of the runtime's own code forever, and readln hung.  Hence
     the Imm suffix: the raw-immediate emitters are named for what they do.

   - address versus contents.  LdBxVx and MovBxVx are both `8B`/`BB` + Dd to
     the eye and completely different instructions.  getch's first cut used
     MovBxVx where it wanted the contents, so it tested the ADDRESS for zero,
     found 02AFh every time, and returned the low byte of memory 02AFh - 0,
     the value it had just stored there - instead of asking DOS. *)
PROCEDURE MovBxImm (v : CARDINAL ) ; BEGIN B (0BBH) ; W (v) END MovBxImm ;
PROCEDURE MovCxImm (v : CARDINAL ) ; BEGIN B (0B9H) ; W (v) END MovCxImm ;
PROCEDURE MovDxImm (v : CARDINAL ) ; BEGIN B (0BAH) ; W (v) END MovDxImm ;
PROCEDURE MovBxVx (delta : CARDINAL ) ; BEGIN B (0BBH) ; Dd (delta) END MovBxVx ;
PROCEDURE MovDxVx (delta : CARDINAL ) ; BEGIN B (0BAH) ; Dd (delta) END MovDxVx ;
PROCEDURE LdBxVx (delta : CARDINAL ) ;
(* 8B 1E lo hi: BX := WORD PTR [Vx] - mod=00 / rm=110, the only 16-bit form
   that can carry a bare absolute address. *)
BEGIN
   B (8BH) ; B (01EH) ; Dd (delta)
END LdBxVx ;

PROCEDURE MovSiAx  ; BEGIN B (8BH) ; B (0F0H) END MovSiAx ;  (* 8B F0: MOV SI,AX *)
PROCEDURE MovAxDi  ; BEGIN B (8BH) ; B (0C7H) END MovAxDi ;   (* 11 000 111 *)
PROCEDURE MovCxSi6 ; BEGIN B (8BH) ; B (4CH) ; B (6) END MovCxSi6 ;
PROCEDURE MovCxDx  ; BEGIN B (8BH) ; B (0CAH) END MovCxDx ;   (* 8B CA: MOV CX,DX *)
PROCEDURE MovDxSi2 ; BEGIN B (8BH) ; B (54H) ; B (2) END MovDxSi2 ;
(* The program header is a block of words laid out by the compiler:
      +0  hdrFlag   1 = image is valid
      +2  hdrCS     end of the generated code, in bytes
      +4  hdrDS     base of the data area     <- initmem wants these two
      +6  hdrHeap   end of the data area      <-
      +8  hdrMax    max open files
   initmem must read the words the COMPILER WRITES, and those are +4 (hdrDS,
   the data base) and +6 (hdrHeap, the data end).  It used to read +8, which
   is hdrMax -- and the compiler patches that to 0 -- so CX came out as 0,
   "cmp cx,dx / jbe im_done" fired immediately, and initmem silently zeroed
   nothing at all.  A 3-byte instruction, so no entry offset moved either
   way; only the header offset in the byte changed.  Nothing caught it
   because the loop was well formed - it just did nothing.  The cross-check
   that would have: tests/run_com_tests.sh now asserts the runtime's SI-relative
   reads against the same header offsets it verifies the words at. *)
PROCEDURE MovDxSi4 ; BEGIN B (8BH) ; B (54H) ; B (4) END MovDxSi4 ;
PROCEDURE MovAxBp4 ; BEGIN B (8BH) ; B (46H) ; B (4) END MovAxBp4 ;  (* AX:=[BP+4] *)
PROCEDURE MovAxBp6 ; BEGIN B (8BH) ; B (46H) ; B (6) END MovAxBp6 ;  (* AX:=[BP+6] *)
PROCEDURE MovBxBp4 ; BEGIN B (8BH) ; B (5EH) ; B (4) END MovBxBp4 ;  (* BX:=[BP+4] *)
PROCEDURE MovBxBp6 ; BEGIN B (8BH) ; B (5EH) ; B (6) END MovBxBp6 ;  (* BX:=[BP+6] *)
PROCEDURE MovAlDh  ; BEGIN B (8AH) ; B (0C6H) END MovAlDh ;  (* 8A C6: AL:=DH *)
PROCEDURE MovDlSi  ; BEGIN B (8AH) ; B (14H) END MovDlSi ;
PROCEDURE MovDlArg2 ; BEGIN B (8AH) ; B (56H) ; B (2) END MovDlArg2 ;  (* DL:=[BP+2] *)

(* The AL twins of the three above.  INT 21h AH=02h displays the character in
   AL, not DL, so every character this runtime writes has to arrive in AL.
   DL is the natural register for the digit scratch in wrint and for a stack
   argument in wrchar, and both of them were loading DL and then calling
   AH=02h - which printed whatever happened to be left in AL.  For wrint that
   was the QUOTIENT's low byte from the preceding DIV, so writeln(1) printed a
   NUL and writeln(2) printed a NUL, and a two-digit number printed its
   quotient instead of itself.  A wrong register is not a wrong encoding: the
   golden bytes were right, `mov dl,[si]' is a perfectly good instruction, and
   every byte-level check stayed green.  Only running it found this. *)
PROCEDURE MovAlD (v : CARDINAL ) ; BEGIN B (0B0H) ; B (v) END MovAlD ;  (* MOV AL,imm8 *)
PROCEDURE MovAlSi  ; BEGIN B (8AH) ; B (04H) END MovAlSi ;  (* 8A 04: AL:=[SI] *)
PROCEDURE MovAlArg2 ; BEGIN B (8AH) ; B (46H) ; B (2) END MovAlArg2 ;  (* AL:=[BP+2] *)
PROCEDURE MovAlArg4 ; BEGIN B (8AH) ; B (46H) ; B (4) END MovAlArg4 ;  (* AL:=[BP+4] *)
PROCEDURE MovAlDl  ; BEGIN B (8AH) ; B (0C2H) END MovAlDl ;  (* 8A C2: AL:=DL *)

PROCEDURE StDiAx   ; BEGIN B (89H) ; B (5H) END StDiAx ;    (* 89 05: [DI]:=AX *)
PROCEDURE StDiAl   ; BEGIN B (88H) ; B (5H) END StDiAl ;    (* 88 05: [DI]:=AL *)
PROCEDURE StSiDl   ; BEGIN B (88H) ; B (14H) END StSiDl ;   (* 88 14: [SI]:=DL *)
PROCEDURE StDiDl   ; BEGIN B (88H) ; B (15H) END StDiDl ;   (* 88 15: [DI]:=DL *)
PROCEDURE StDiCx   ; BEGIN B (89H) ; B (0DH) END StDiCx ;   (* 89 0D: [DI]:=CX *)
PROCEDURE MovDiBp4 ; BEGIN B (8BH) ; B (7EH) ; B (4) END MovDiBp4 ; (* DI:=[BP+4] *)

(* There is NO "store through BX" instruction on the 8086, and writing one
   anyway is the single most expensive mistake this file has produced, so the
   reasoning is recorded rather than left in the probe history.

   In 16-bit addressing the r/m column is a LOCATION, not a register list: for
   mod=00, rm=000..101 are [BX+SI] [BX+DI] [BP+SI] [BP+DI] [SI] [DI], and
   rm=110 is the only one that means "a direct displacement".  rm=111 is
   [BX+SI], NOT [BX].  So `89 1D' - the ModR/M the first version of this used
   for "MOV [BX],CX" - is mod=00 reg=BX r/m=DI, i.e. MOV [DI],BX: the two
   operands swapped AND [BX] inexpressible.  GNU as and objdump in -m i8086
   agree, and the bytes are perfectly well formed, which is why nothing
   objected.  What the program saw was its own address being written over the
   interrupt vector table, and the variable it was asked to fill left holding
   whatever the loader put there: readln(n) then printed 0, and readln(c)
   printed a NUL.  Correct by comparison: the caller puts the address in BX,
   and the store has to go through DI or SI, so the sequence is
   MOV DI,[BP+4] / MOV [DI],<value> - see StoreThrough below. *)
PROCEDURE MovDlAl  ; BEGIN B (88H) ; B (0C2H) END MovDlAl ;
PROCEDURE MovDlCl  ; BEGIN B (8AH) ; B (0D1H) END MovDlCl ;  (* 8A D1: MOV DL,CL *)
PROCEDURE XchgAxDi ; BEGIN B (87H) ; B (0C7H) END XchgAxDi ; (* 87 C7: AX<->DI *)
PROCEDURE AddAxDi  ; BEGIN B (03H) ; B (0C7H) END AddAxDi ;  (* 03 C7: AX:=AX+DI *)
PROCEDURE MovSiBx  ; BEGIN B (89H) ; B (0DEH) END MovSiBx ;  (* 89 DE: MOV SI,BX *)
PROCEDURE MovDiDx  ; BEGIN B (89H) ; B (0D7H) END MovDiDx ;
PROCEDURE MovDiAx  ; BEGIN B (89H) ; B (0C7H) END MovDiAx ;
PROCEDURE AddDiAx  ; BEGIN B (1H) ; B (0C7H) END AddDiAx ;
(* The register-pair emitters strcat (EmitStrCat) needs.  Two registers, so
   the audit's two-register pattern reads them positionally: `AddDxAx' is
   01 C2 = ADD DX,AX (01 /r is `op r/m16,r16'', DX is r/m and AX is reg), and
   the mirror `SubDxAx' is 29 C2.  MovCxAx is 89 C1 (89 /r: reg is the
   source, so CX is r/m and AX is reg).  MovDiSi is 8B FE (8B /r: reg is the
   destination). *)
PROCEDURE MovCxAx  ; BEGIN B (89H) ; B (0C1H) END MovCxAx ;  (* 89 C1: MOV CX,AX *)
PROCEDURE MovDiSi  ; BEGIN B (8BH) ; B (0FEH) END MovDiSi ;  (* 8B FE: MOV DI,SI *)
PROCEDURE AddDxAx  ; BEGIN B (1H) ; B (0C2H) END AddDxAx ;   (* 01 C2: DX:=DX+AX *)
PROCEDURE SubDxAx  ; BEGIN B (29H) ; B (0C2H) END SubDxAx ;   (* 29 C2: DX:=DX-AX *)
PROCEDURE AddDiDx  ; BEGIN B (1H) ; B (0D7H) END AddDiDx ;   (* 01 D7: DI:=DI+DX *)
PROCEDURE StSiCl   ; BEGIN B (88H) ; B (0CH) END StSiCl ;    (* 88 0C: [SI]:=CL *)
PROCEDURE IncBx    ; BEGIN B (43H) END IncBx ;
PROCEDURE LdAlBx   ; BEGIN B (8AH) ; B (07H) END LdAlBx ;   (* 8A 07: AL:=[BX] *)
PROCEDURE MovAlBl  ; BEGIN B (8AH) ; B (0C3H) END MovAlBl ; (* 8A C3: AL:=BL *)
(* 8A 07 and 8A C3 are one letter apart and do opposite things: the
   first reads the byte AT the pointer in BX, the second takes the low
   byte OF BX.  getch's pushback path wanted the second and used the
   first, so it read memory 010Ah - the address of the character - and
   returned whatever was there.  Hence the Ld/Mov split. *)
PROCEDURE MovClBx  ; BEGIN B (8AH) ; B (0FH) END MovClBx ;  (* 8A 0F: CL:=[BX] *)
PROCEDURE XorBxBx  ; BEGIN B (31H) ; B (0DBH) END XorBxBx ;  (* 31 DB: BX:=0 *)
PROCEDURE MovBlDl  ; BEGIN B (8AH) ; B (0DAH) END MovBlDl ;  (* 8A DA: BL:=DL *)
PROCEDURE MovBhAh  ; BEGIN B (88H) ; B (0E7H) END MovBhAh ;  (* 88 E7: BH:=AH *)
PROCEDURE MovDxAx  ; BEGIN B (89H) ; B (0C2H) END MovDxAx ;  (* 89 C2: DX:=AX *)
PROCEDURE MovSiBp4 ; BEGIN B (8BH) ; B (76H) ; B (4) END MovSiBp4 ; (* SI:=[BP+4] *)
PROCEDURE MovSiBp6 ; BEGIN B (8BH) ; B (76H) ; B (6) END MovSiBp6 ; (* SI:=[BP+6] *)
PROCEDURE LdAxSi   ; BEGIN B (8BH) ; B (04H) END LdAxSi ;    (* 8B 04: AX:=[SI] *)
PROCEDURE StDiOffBx (off : CARDINAL) ;
BEGIN B (89H) ; B (5DH) ; B (off MOD 256) END StDiOffBx ; (* MOV [DI+o],BX *)
PROCEDURE StDiOffDx (off : CARDINAL) ;
BEGIN B (89H) ; B (55H) ; B (off MOD 256) END StDiOffDx ; (* MOV [DI+o],DX *)
PROCEDURE Js8  (nm : ARRAY OF CHAR ) ; BEGIN Jcc (78H, nm) END Js8 ;
PROCEDURE Jns8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (79H, nm) END Jns8 ;
PROCEDURE Jmp8 (nm : ARRAY OF CHAR ) ;
BEGIN B (0EBH) ; AddFix (0, rpos, nm, 0) ; B (0) END Jmp8 ;
PROCEDURE MovAxImm (v : CARDINAL ) ; BEGIN B (0B8H) ; W (v) END MovAxImm ;
PROCEDURE XchgDlDh ; BEGIN B (86H) ; B (0D6H) END XchgDlDh ; (* 86 D6: DL<->DH *)
PROCEDURE DecAl    ; BEGIN B (0FEH) ; B (0C8H) END DecAl ;    (* FE C8 *)
PROCEDURE ShlDx1   ; BEGIN B (0D1H) ; B (0E2H) END ShlDx1 ;   (* D1 E2: SHL DX,1 *)
PROCEDURE NegDx    ; BEGIN B (0F7H) ; B (0DAH) END NegDx ;    (* F7 DA: NEG DX *)
PROCEDURE CmpDh0   ; BEGIN B (80H) ; B (0FEH) ; B (0) END CmpDh0 ; (* 80 FE 00 *)
PROCEDURE CmpBh0   ; BEGIN B (80H) ; B (0FFH) ; B (0) END CmpBh0 ; (* 80 FF 00 *)
PROCEDURE CmpDx0   ; BEGIN B (83H) ; B (0FAH) ; B (0) END CmpDx0 ; (* 83 FA 00 *)
PROCEDURE CmpAl0   ; BEGIN B (3CH) ; B (0) END CmpAl0 ;         (* 3C 00 *)
PROCEDURE AndDhImm (v : CARDINAL) ;
BEGIN B (80H) ; B (0E6H) ; B (v MOD 256) END AndDhImm ;   (* 80 E6 imm *)

(* --- the MBF core's register moves and flag helpers --------------------- *)
PROCEDURE MovAxCx ; BEGIN B (89H) ; B (0C8H) END MovAxCx ;  (* AX:=CX *)
PROCEDURE MovBxSi ; BEGIN B (89H) ; B (0F3H) END MovBxSi ;  (* BX:=SI *)
PROCEDURE MovDxDi ; BEGIN B (89H) ; B (0FAH) END MovDxDi ;  (* DX:=DI *)
PROCEDURE MovBxCx ; BEGIN B (89H) ; B (0CBH) END MovBxCx ;  (* BX:=CX *)
PROCEDURE MovBxDx ; BEGIN B (89H) ; B (0D3H) END MovBxDx ;  (* BX:=DX *)
PROCEDURE MovAhBh ; BEGIN B (88H) ; B (0FCH) END MovAhBh ;  (* AH:=BH *)
PROCEDURE MovAhBl ; BEGIN B (88H) ; B (0DCH) END MovAhBl ;  (* AH:=BL *)
PROCEDURE MovBlBh ; BEGIN B (88H) ; B (0FBH) END MovBlBh ;  (* BL:=BH *)
PROCEDURE MovBhDl ; BEGIN B (88H) ; B (0D7H) END MovBhDl ;  (* BH:=DL *)
PROCEDURE MovDlDh ; BEGIN B (88H) ; B (0F2H) END MovDlDh ;  (* DL:=DH *)
PROCEDURE MovDhDl ; BEGIN B (88H) ; B (0D6H) END MovDhDl ;  (* DH:=DL *)
PROCEDURE MovDlBh ; BEGIN B (88H) ; B (0FAH) END MovDlBh ;  (* DL:=BH *)
PROCEDURE MovBlAh ; BEGIN B (88H) ; B (0E3H) END MovBlAh ;  (* BL:=AH *)
PROCEDURE XchgAxCx ; BEGIN B (91H) END XchgAxCx ;           (* XCHG AX,CX *)
PROCEDURE XchgBxSi ; BEGIN B (87H) ; B (0F3H) END XchgBxSi ;
PROCEDURE XchgDxDi ; BEGIN B (87H) ; B (0FAH) END XchgDxDi ;
PROCEDURE XchgAhCh ; BEGIN B (86H) ; B (0ECH) END XchgAhCh ;
PROCEDURE XorDhDh ; BEGIN B (30H) ; B (0F6H) END XorDhDh ;  (* XOR DH,DH *)
PROCEDURE XorAhAh ; BEGIN B (30H) ; B (0E4H) END XorAhAh ;  (* XOR AH,AH *)
PROCEDURE NotAh ; BEGIN B (0F6H) ; B (0D4H) END NotAh ;     (* NOT AH *)
PROCEDURE NotBx ; BEGIN B (0F7H) ; B (0D3H) END NotBx ;     (* NOT BX *)
PROCEDURE NotDx ; BEGIN B (0F7H) ; B (0D2H) END NotDx ;     (* NOT DX *)
PROCEDURE ShrDx1 ; BEGIN B (0D1H) ; B (0EAH) END ShrDx1 ;   (* SHR DX,1 *)
PROCEDURE RcrBx1 ; BEGIN B (0D1H) ; B (0DBH) END RcrBx1 ;   (* RCR BX,1 *)
PROCEDURE RcrDx1 ; BEGIN B (0D1H) ; B (0DAH) END RcrDx1 ;   (* RCR DX,1 *)
PROCEDURE RcrAh1 ; BEGIN B (0D0H) ; B (0DCH) END RcrAh1 ;   (* RCR AH,1 *)
PROCEDURE RclBx1 ; BEGIN B (0D1H) ; B (0D3H) END RclBx1 ;   (* RCL BX,1 *)
PROCEDURE RclDx1 ; BEGIN B (0D1H) ; B (0D2H) END RclDx1 ;   (* RCL DX,1 *)
PROCEDURE ShlAh1 ; BEGIN B (0D0H) ; B (0E4H) END ShlAh1 ;   (* SHL AH,1 *)
PROCEDURE IncAl ; BEGIN B (0FEH) ; B (0C0H) END IncAl ;     (* INC AL *)
PROCEDURE DecCl ; BEGIN B (0FEH) ; B (0C9H) END DecCl ;     (* DEC CL *)
PROCEDURE Stc ; BEGIN B (0F9H) END Stc ;                    (* STC *)
PROCEDURE CmpAlCl ; BEGIN B (38H) ; B (0C8H) END CmpAlCl ;  (* CMP AL,CL *)
PROCEDURE CmpCl0 ; BEGIN B (80H) ; B (0F9H) ; B (0) END CmpCl0 ; (* 80 F9 00 *)
PROCEDURE MovBhBl ; BEGIN B (88H) ; B (0DFH) END MovBhBl ;  (* BH:=BL *)
PROCEDURE SubAhCh ; BEGIN B (28H) ; B (0ECH) END SubAhCh ;  (* AH:=AH-CH *)
PROCEDURE MovClImm (v : CARDINAL) ;
BEGIN B (0B1H) ; B (v MOD 256) END MovClImm ;
PROCEDURE CmpClImm (v : CARDINAL) ;
BEGIN B (80H) ; B (0F9H) ; B (v MOD 256) END CmpClImm ;
PROCEDURE SubClAl ; BEGIN B (28H) ; B (0C1H) END SubClAl ;  (* CL:=CL-AL *)
PROCEDURE SubClImm (v : CARDINAL) ;
BEGIN B (80H) ; B (0E9H) ; B (v MOD 256) END SubClImm ;
PROCEDURE AddAhCh ; BEGIN B (00H) ; B (0ECH) END AddAhCh ;  (* AH:=AH+CH *)
PROCEDURE AddAhImm (v : CARDINAL) ;
BEGIN B (80H) ; B (0C4H) ; B (v MOD 256) END AddAhImm ;
PROCEDURE AdcBxSi ; BEGIN B (11H) ; B (0F3H) END AdcBxSi ;
PROCEDURE AdcDxDi ; BEGIN B (11H) ; B (0FAH) END AdcDxDi ;
PROCEDURE AdcBxImm (v : CARDINAL) ;
BEGIN B (83H) ; B (0D3H) ; B (v MOD 256) END AdcBxImm ;
PROCEDURE AdcDxImm (v : CARDINAL) ;
BEGIN B (83H) ; B (0D2H) ; B (v MOD 256) END AdcDxImm ;
PROCEDURE SbbBxSi ; BEGIN B (19H) ; B (0F3H) END SbbBxSi ;
PROCEDURE SbbDxDi ; BEGIN B (19H) ; B (0FAH) END SbbDxDi ;
PROCEDURE OrDiImm (v : CARDINAL) ;
BEGIN B (81H) ; B (0CFH) ; W (v) END OrDiImm ;              (* DI:=DI OR imm16 *)
PROCEDURE OrDhImm (v : CARDINAL) ;
BEGIN B (80H) ; B (0CEH) ; B (v MOD 256) END OrDhImm ;
PROCEDURE TestDhImm (v : CARDINAL) ;
BEGIN B (0F6H) ; B (0C6H) ; B (v MOD 256) END TestDhImm ;
PROCEDURE StDataImm (delta, v : CARDINAL) ;
BEGIN B (0C7H) ; B (06H) ; Dd (delta) ; W (v) END StDataImm ;
PROCEDURE StDataCl (delta : CARDINAL) ;
BEGIN B (88H) ; B (0EH) ; Dd (delta) END StDataCl ;
PROCEDURE StDataDi (delta : CARDINAL) ;
BEGIN B (89H) ; B (3EH) ; Dd (delta) END StDataDi ;
PROCEDURE LdAlData (delta : CARDINAL) ;
BEGIN B (0A0H) ; Dd (delta) END LdAlData ;
PROCEDURE LdClData (delta : CARDINAL) ;
BEGIN B (8AH) ; B (0EH) ; Dd (delta) END LdClData ;
PROCEDURE XorDiData (delta : CARDINAL) ;
BEGIN B (33H) ; B (3EH) ; Dd (delta) END XorDiData ;          (* XOR DI,[Vx] *)
PROCEDURE XorDataDh (delta : CARDINAL) ;
BEGIN B (30H) ; B (36H) ; Dd (delta) END XorDataDh ;          (* XOR [Vx],DH *)
PROCEDURE XorDhData (delta : CARDINAL) ;
BEGIN B (32H) ; B (36H) ; Dd (delta) END XorDhData ;          (* XOR DH,[Vx] *)
PROCEDURE XorDataImm (delta, v : CARDINAL) ;
BEGIN B (80H) ; B (36H) ; Dd (delta) ; B (v MOD 256) END XorDataImm ;
PROCEDURE AndDataImm (delta, v : CARDINAL) ;
BEGIN B (80H) ; B (26H) ; Dd (delta) ; B (v MOD 256) END AndDataImm ;
PROCEDURE TestDataImm (delta, v : CARDINAL) ;
BEGIN B (0F6H) ; B (06H) ; Dd (delta) ; B (v MOD 256) END TestDataImm ;
PROCEDURE LdCxSiOff (off : CARDINAL) ;
BEGIN B (8BH) ; B (4CH) ; B (off MOD 256) END LdCxSiOff ;
PROCEDURE LdDxSiOff (off : CARDINAL) ;
BEGIN B (8BH) ; B (54H) ; B (off MOD 256) END LdDxSiOff ;
PROCEDURE LdCxDiOff (off : CARDINAL) ;
BEGIN B (8BH) ; B (4DH) ; B (off MOD 256) END LdCxDiOff ;
PROCEDURE LdSiDiOff (off : CARDINAL) ;
BEGIN B (8BH) ; B (75H) ; B (off MOD 256) END LdSiDiOff ;
PROCEDURE LdDiDiOff (off : CARDINAL) ;
BEGIN B (8BH) ; B (7DH) ; B (off MOD 256) END LdDiDiOff ;
PROCEDURE PushBp4 ; BEGIN B (0FFH) ; B (76H) ; B (4) END PushBp4 ; (* PUSH [BP+4] *)
PROCEDURE Call (nm : ARRAY OF CHAR) ;
BEGIN B (0E8H) ; AddFix (1, rpos, nm, 0) ; W (0) END Call ;
PROCEDURE StVxBx   (delta : CARDINAL ) ;
(* 89 1E lo hi: MOV [Vx],BX - the mirror of LdBxVx above, and it must use the
   same mod=00 / rm=110 and the same Dd fixup kind, or one of the two
   addresses a different place. *)
BEGIN
   B (89H) ; B (01EH) ; Dd (delta)
END StVxBx ;
PROCEDURE JmpBx    ; BEGIN B (0FFH) ; B (0E3H) END JmpBx ;  (* FF E3: JMP BX *)
(* JE 74  JNE 75  JB 72  JBE 76  JGE 7D *)
PROCEDURE Je8  (nm : ARRAY OF CHAR ) ; BEGIN Jcc (74H, nm) END Je8 ;
PROCEDURE Jne8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (75H, nm) END Jne8 ;
PROCEDURE Jb8  (nm : ARRAY OF CHAR ) ; BEGIN Jcc (72H, nm) END Jb8 ;
PROCEDURE Jbe8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (76H, nm) END Jbe8 ;
PROCEDURE Jge8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (7DH, nm) END Jge8 ;
PROCEDURE Jle8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (7EH, nm) END Jle8 ;
PROCEDURE Ja8  (nm : ARRAY OF CHAR ) ; BEGIN Jcc (77H, nm) END Ja8 ;
PROCEDURE Jae8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (73H, nm) END Jae8 ;
PROCEDURE Jcxz8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (0E3H, nm) END Jcxz8 ;
PROCEDURE Loop8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (0E2H, nm) END Loop8 ;

(* ---------------------------------------------------------------- *)
(*  the entries                                                      *)
(* ---------------------------------------------------------------- *)

PROCEDURE EmitInitMem ;
(* AX = offset of the program header.  The header holds, at +4 the base of
   the program's data area and at +8 its end, so the globals can be zeroed -
   Pascal leaves them undefined, TP3's runtime clears them.  Also makes
   ES = DS so that any string instruction in the library would work. *)
BEGIN
   M ("initmem") ;
   MovSiAx ;               (* SI = AX = the header offset the caller passed *)
   MovDxSi4 ;              (* DX = [SI+4] = hdrDS  = data base *)
   MovCxSi6 ;              (* CX = [SI+6] = hdrHeap = data end   *)
   CmpCxDx ;
   Jbe8 ("im_done") ;
   MovDiDx ;               (* DI = data base *)
   M ("im_zero") ;
   XorAxAx ;               (* AX = 0: the value written into every global.
                             The caller passes the header offset in AX, so
                             without this the "zeroing" loop would write the
                             header offset into all of them. *)
   StDiAx ;
   AddDi2 ;
   CmpDiCx ;
   Jb8 ("im_zero") ;
   M ("im_done") ;
   PushDs ; PopEs ;
   RetR
END EmitInitMem ;

PROCEDURE EmitEnd ;
(* progend and halt are the same code: the compiler already zeroes AX for
   progend, and a HALT argument is discarded at compile time, so both leave
   with exit code 0. *)
BEGIN
   M ("progend") ;
   M ("halt") ;
   XorAxAx ;
   MovAh (4CH) ;
   Int21 ;
   RetR
END EmitEnd ;

PROCEDURE EmitStackChk ;
(* called from every procedure prologue.  Range and stack checking are not
   compiled in yet, so this must do nothing at all - in particular it must
   not touch a register, because the call site is in the middle of a
   partially evaluated expression. *)
BEGIN
   M ("stackchk") ;
   RetR
END EmitStackChk ;

PROCEDURE EmitGetCh ;
(* AL = next character, 1Ah at end of input.  INT 21h AH=08h reads without
   echoing, so a redirected stdin behaves the same as a keyboard.

   This is TP3's `getbyte' (TPSRC4:94), not a bare INT 21h.  getbyte serves a
   buffered character from the file record without advancing the buffer
   pointer when the "char pre-read" flag ($02) is set, and readnum sets that
   flag on the character that ENDS a number - the terminating blank is *not*
   consumed.  xreadln is then called and it is the xreadln that consumes the
   newline.

   This matters because `readln(n)' is emitted as xrdint followed by xreadln
   (TPSRC8 prdrdln emits xreadln whenever rdlnflg is set).  A getch that
   always consumed its character left xreadln starting on the *following*
   line, so `readln(n); readln(c)' read the char from line 3 of the input.
   One byte of pushback reproduces the flag. *)
BEGIN
   M ("getch") ;
   LdBxVx (D_PUSH) ;             (* BX := the slot's contents *)
   CmpBx0 ;
   Je8 ("gc_dos") ;
   MovAlBl ;                        (* AL := the pending character, i.e. the
                                      low byte OF BX - not the byte at [BX] *)
   XorBxBx ;
   StVxBx (D_PUSH) ;                (* and empty the slot *)
   RetR ;
   M ("gc_dos") ;
   MovAh (08H) ;
   Int21 ;
   RetR
END EmitGetCh ;

PROCEDURE EmitUnGetCh ;
(* put AL back, so the next getch returns it again.  TP3 does this by
   rewinding the buffer pointer; a one-byte slot is the same thing. *)
BEGIN
   M ("ungetch") ;
   MovDlAl ;
   MovBxImm (1) ;                      (* BH := 1 marks the slot occupied, so
                                         a pushed-back NUL is still a
                                         pushed-back NUL *)
   MovBlDl ;
   StVxBx (D_PUSH) ;
   RetR
END EmitUnGetCh ;

PROCEDURE EmitWrInt ;
(* one signed 16-bit value on the stack.  Div CX gives the remainder in DX,
   which is turned into a digit and stored backwards from the end of the
   scratch area, then printed forwards. *)
BEGIN
   M ("wrint") ;
   PushBp ; MovBpSp ;
   MovAxBp4 ;
   CmpAx0 ;
   Jge8 ("wi_pos") ;
   PushAx ;
   MovAlD (ORD ("-")) ; MovAh (2) ; Int21 ;
   PopAx ;
   NegAx ;
   M ("wi_pos") ;
   MovCxImm (10) ;
   MovBxVx (D_NUM + 8) ;    (* BX = one past the last digit *)
   MovSiBx ;
   M ("wi_dig") ;
   XorDxDx ;
   DivCx ;
   AddDl (ORD ("0")) ;
   DecSi ;
   StSiDl ;
   CmpAx0 ;
   Jne8 ("wi_dig") ;
   M ("wi_out") ;
   CmpSiBx ;
   Je8 ("wi_done") ;
   MovAlSi ;                  (* the digit: AH=02h wants it in AL *)
   MovAh (02H) ; Int21 ;
   IncSi ;
   J8 ("wi_out") ;
   M ("wi_done") ;
   MovSpBp ; PopBp ; RetR
END EmitWrInt ;

PROCEDURE EmitWrIntW ;
(* `writeln(I:2)': an integer in a field of `width' columns, right-justified.
   The caller pushes the VALUE first and the WIDTH second, so the value is at
   [BP+6] and the width at [BP+4].  The number of characters the signed
   decimal will occupy is counted first (one extra when negative); the pad is
   max(width - chars, 0) spaces.  The digit loop is wrint's, duplicated rather
   than shared: the two entries have different argument offsets, and a jump
   into the middle of the other entry's frame would be a convention nobody
   could see from either name. *)
BEGIN
   M ("wrintw") ;
   PushBp ; MovBpSp ;
   (* BX := number of characters: sign + digits *)
   MovBxImm (0) ;
   MovAxBp6 ;
   CmpAx0 ;
   Jge8 ("wiw_abs") ;
   IncBx ;                    (* the '-' counts as one column *)
   NegAx ;
   M ("wiw_abs") ;
   MovCxImm (10) ;
   M ("wiw_cnt") ;
   IncBx ;
   XorDxDx ;
   DivCx ;
   CmpAx0 ;
   Jne8 ("wiw_cnt") ;
   (* pad := width - chars; only a positive pad prints *)
   MovAxBp4 ;
   SubAxBx ;
   CmpAx0 ;
   Jle8 ("wiw_body") ;
   MovCxAx ;
   M ("wiw_pad") ;
   MovAlD (ORD (' ')) ; MovAh (02H) ; Int21 ;
   Loop8 ("wiw_pad") ;
   M ("wiw_body") ;
   (* the signed decimal, exactly as wrint prints it *)
   MovAxBp6 ;
   CmpAx0 ;
   Jge8 ("wiw_pos") ;
   PushAx ;
   MovAlD (ORD ('-')) ; MovAh (2) ; Int21 ;
   PopAx ;
   NegAx ;
   M ("wiw_pos") ;
   MovCxImm (10) ;
   MovBxVx (D_NUM + 8) ;
   MovSiBx ;
   M ("wiw_dig") ;
   XorDxDx ;
   DivCx ;
   AddDl (ORD ('0')) ;
   DecSi ;
   StSiDl ;
   CmpAx0 ;
   Jne8 ("wiw_dig") ;
   M ("wiw_out") ;
   CmpSiBx ;
   Je8 ("wiw_done") ;
   MovAlSi ;
   MovAh (02H) ; Int21 ;
   IncSi ;
   J8 ("wiw_out") ;
   M ("wiw_done") ;
   MovSpBp ; PopBp ; RetR
END EmitWrIntW ;

PROCEDURE EmitWrChar ;
(* the low byte of the one 16-bit argument, which sits above the return
   address.  There is no [SP] addressing in 16-bit mode, so BP stands in for
   the stack pointer -- and it has to be SAVED, because BP is the one register
   a caller is entitled to expect back: the test driver keeps its cursor into
   the case record there, so an entry that borrows BP without returning it
   sends the next call to a garbage address.  That is not hypothetical: wrchar
   and wrbool both did it, and "writeln(42) writeln TRUE in one program" hung
   the machine with the record header printed twice, because the driver had
   been sent back to the top of its own loop.  Load BP, use it, hand it back.
   MovAlArg4, not MovAlArg2: BP is pushed first, so the argument is four bytes
   up, not two.  AL, not DL: see the AL twins above. *)
BEGIN
   M ("wrchar") ;
   PushBp ; MovBpSp ;
   MovAlArg4 ;
   MovSpBp ; PopBp ;
   MovAh (02H) ;
   Int21 ;
   RetR
END EmitWrChar ;

PROCEDURE EmitWrInl ;
(* Write an inline string literal - TP3 TPSRC4 "xwrtinl".

   The compiler emits

       CALL wrtinl      <length byte> <character>...

   so the return address on the stack points at the length byte that follows
   the call.  POP BX takes that address, CX picks up the length, and the
   routine finishes with JMP BX - returning to just past the last character.
   That is the whole trick: the literal is self-delimiting, so it needs no
   terminator, no length table and no space in the data segment, and it costs
   the code stream only the characters themselves (TPSRC10 "estring" emits
   exactly <length byte><chars> for the same reason).

   Consequently this entry has NO stack argument, unlike WrInt/WrChar: the
   return address has already been consumed by the POP. *)
BEGIN
   M ("wrtinl") ;
   PopBx ;                           (* BX := address of the length byte *)
   XorCxCx ;
   MovClBx ;                         (* CX := length *)
   IncBx ;                           (* BX -> first character *)
   MovAh (02H) ;                       (* INT 21h/02h: put character, AL *)
   Jcxz8 ("wn_end") ;                (* empty string -> nothing to do *)
   M ("wn_loop") ;
   LdAlBx ;                         (* AL := next character *)
   Int21 ;                           (* (preserves every register but AL) *)
   IncBx ;
   Loop8 ("wn_loop") ;
   M ("wn_end") ;
   JmpBx                             (* resume past the string; no RET here,
                                       the return address is already gone *)
END EmitWrInl ;

PROCEDURE EmitWrStr ;
(* Write a string VARIABLE - TP3 TPSRC4 "xwrtstr", minus the field-width
   formatting this compiler does not compile yet.

   The compiler emits

       <PUSH the string's address>   from EmPushVarAddr
       CALL wrstr

   so the address is the one 16-bit argument on the stack, read through BP
   exactly as WrChar reads its value (there is no [SP] form).  The first byte
   at that address is the current LENGTH and the characters follow it, which
   is the layout TPSRC8's `string' type gives a variable: TPSRC8:83 does
   `INC BX / MOV varsize,BX' for `string [n]', so n+1 bytes, length byte
   first.

   The loop is wrtinl's, pointed at the caller's bytes instead of at the
   bytes behind the call: CL := [BX] is the length, BX moves to the first
   character, and one INT 21h/02h prints each one until CX runs out.  A
   length of 0 prints nothing, so an empty string is silent. *)
BEGIN
   M ("wrstr") ;
   PushBp ; MovBpSp ;
   PushBx ; PushCx ; PushAx ;
   MovBxBp4 ;                        (* BX := the caller's string address *)
   XorCxCx ;
   MovClBx ;                         (* CX := the length byte at [BX] *)
   IncBx ;                           (* BX -> the first character *)
   MovAh (02H) ;                     (* INT 21h/02h: put the character in AL *)
   Jcxz8 ("ws_end") ;                (* empty string -> nothing to do *)
   M ("ws_loop") ;
   LdAlBx ;                          (* AL := next character *)
   Int21 ;                           (* preserves every register but AL *)
   IncBx ;
   Loop8 ("ws_loop") ;
   M ("ws_end") ;
   PopAx ; PopCx ; PopBx ;
   MovSpBp ; PopBp ;
   RetR
END EmitWrStr ;

PROCEDURE EmitWrBool ;
(* 4, not 2, for the reason given on CmpArg4W0: BP is pushed before it is
   borrowed, so the argument is four bytes up.  POP BP before the RET, and
   note that CmpArg4W0 has already handed SP back, so the pop lands on the
   saved BP and not on the argument. *)
BEGIN
   M ("wrbool") ;
   PushBp ;
   CmpArg4W0 ;
   Jne8 ("wb_t") ;
   MovDxVx (D_FALSE) ;
   J8 ("wb_o") ;
   M ("wb_t") ;
   MovDxVx (D_TRUE) ;
   M ("wb_o") ;
   MovAh (09H) ;
   Int21 ;
   PopBp ;
   RetR
END EmitWrBool ;

PROCEDURE EmitWrLn ;
BEGIN
   M ("wrln") ;
   MovDxVx (D_CRLF) ;
   MovAh (09H) ;
   Int21 ;
   RetR
END EmitWrLn ;

PROCEDURE EmitWrReal ;
(* the 6-byte real is on the stack but is not formatted: the compiler does
   not yet load real operands into a form the runtime could read.  A visible
   marker beats printing the mantissa as an integer. *)
BEGIN
   M ("wrreal") ;
   MovDxVx (D_REAL) ;
   MovAh (09H) ;
   Int21 ;
   RetR
END EmitWrReal ;

PROCEDURE EmitRdInt ;
(* Read a number into a 16-bit variable: the caller's address is on the
   stack.  The scan itself is EmitRdScan, shared with rdbyte; an entry owns
   its frame, its address load and its store, nothing else. *)
BEGIN
   M ("rdint") ;
   PushBp ; MovBpSp ;
   PushAx ; PushBx ; PushCx ; PushDx ; PushDi ;
   C8 ("rdscan") ;
   CmpCxV (2) ;
   Je8 ("ri_skip") ;                 (* nothing entered: leave the variable
                                        alone, as TP3's xrdint at rdierr does *)
   MovDiBp4 ;                        (* ...the caller's address into DI... *)
   StDiAx ;                          (* ...and store the word.  MovDiBp4 and
                                        not a [BX] form: there is none; see
                                        the note on the store emitters. *)
   M ("ri_skip") ;
   PopDi ; PopDx ; PopCx ; PopBx ; PopAx ;
   MovSpBp ; PopBp ; RetR
END EmitRdInt ;

PROCEDURE EmitRdScan ;
(* The number reader, called by rdint (word store) and by rdbyte (byte
   store).  A transcription of TP3 TPSRC4 xrdint/readnum, minus the store:

      rnspace:  getbyte ; ^Z ? -> rnend
                consume ; <= 20h ? -> rnspace
      rndig:    [buf]=char ; getbyte ; <= 20h ? -> rnend   (NOT consumed)
                consume ; -> rndig
      rnend:    buf[0] := 0

   It builds NO frame of its own and touches neither BP nor SP, so it is
   called from the caller's frame and that frame's [BP+4] is still the
   caller's argument when it returns.  It clobbers AX BX CX DX DI, which the
   caller has already saved.

   Returns AX = the value, and CX = 0 positive, 1 negative, 2 nothing read.
   CX = 2 is set HERE, on the ^Z path: it is the state both callers test to
   decide not to store, and before this split the check existed only as a
   jump to the exit, so the state itself was never produced.  AX is
   meaningless when CX = 2.

   Two behaviours are load-bearing and neither is obvious:

   - the character that ENDS the scan is left pending, because readnum tests
     it *before* clearing getbyte's pre-read flag.  xreadln, which the
     compiler emits next for a readln, is what consumes the newline.  See the
     note on getch.

   - ^Z before any digit returns without a value, and the caller then returns
     WITHOUT touching the variable: TP3's xrdint reaches rdierr and RETs.

   Sign in CX, value in DI, value in AX on the way out. *)
BEGIN
   M ("rdscan") ;
   M ("ri_lead") ;
   C8 ("getch") ;
   CmpAl (1AH) ;                     (* ^Z: end of input *)
   Je8 ("ri_none") ;
   CmpAl (20H) ;                     (* every control char and the space.
                                         20H, not 20: readnum skips
                                         everything <= #$20, and a literal
                                         that READS like hex but is
                                         decimal compares AL against 14h,
                                         so a leading space is never
                                         skipped and the scan ends with
                                         nothing read.  Every other
                                         literal in this module is
                                         explicit for the same reason. *)
   Jbe8 ("ri_lead") ;
   XorCxCx ;
   CmpAl (ORD ("-")) ;
   Jne8 ("ri_nos") ;
   IncCx ;
   C8 ("getch") ;
   J8 ("ri_dig0") ;
   M ("ri_nos") ;
   CmpAl (ORD ("+")) ;
   Jne8 ("ri_dig0") ;
   C8 ("getch") ;
   M ("ri_dig0") ;
   XorDiDi ;
   M ("ri_dig") ;
   CmpAl (ORD ("0")) ;
   Jb8 ("ri_done") ;
   CmpAl (ORD ("9")) ;
   Ja8 ("ri_done") ;
   SubAl (ORD ("0")) ;
   MovAh (0) ;              (* AX := the digit, 0..9 *)
   XchgAxDi ;               (* AX := the value so far, DI := the digit.
                               The digit has to survive MUL, and the 8-bit
                               reg field of 8A/88 has only AL/CL/DL/BL/AH/
                               CH/DH/BH - there is no SI or DI byte to park
                               it in.  MUL r/m16 writes DX, so the previous
                               version's "keep the digit across the multiply"
                               comment was describing a register the multiply
                               owns.  Every read of an integer therefore
                               returned 0: the digit was computed, moved to
                               DH, and multiplied away one instruction later. *)
   MovBxImm (10) ;
   MulBx ;                  (* DX:AX := value * 10 *)
   AddAxDi ;                (* AX := low word + digit.  A carry out of bit 15
                               is dropped, which is what a 16-bit INTEGER
                               does anyway - the high word of the product is
                               never stored. *)
   MovDiAx ;
   C8 ("getch") ;
   J8 ("ri_dig") ;
   M ("ri_done") ;
   C8 ("ungetch") ;                 (* the delimiter stays pending *)
   CmpCx0 ;
   Je8 ("ri_pos") ;
   NegDi ;
   M ("ri_pos") ;
   MovAxDi ;                        (* the parsed value out of DI and into AX,
                                       where both callers store it from *)
   RetR ;
   M ("ri_none") ;                  (* ^Z first: no value, and CX says so *)
   MovCxImm (2) ;
   RetR
END EmitRdScan ;

PROCEDURE EmitRdByte ;
(* Read a number into a BYTE variable: the same scan, a one-byte store.

   TPSRC8 prdnum dispatches on the variable's size - `CMP varsize,#$01 /
   JA prdemit' keeps xrdint for anything wider and falls through to
   `MOV AX,#xrdbyte' for a one-byte variable - and TPSRC4's two entries
   differ in exactly one store: xrdbyte is `CLC', xrdint is `STC', and rdi1
   stores AX or AL on `JNB rdibyt'.

   The flag form is not transcribed.  It would put the STC at the head of the
   rdint entry, and the BP contract in tests/rt_exec.py requires an entry
   that borrows BP to *start* with `55 8B EC' and to hand BP back from inside
   its own slice - which is what an entry owning its own frame does.  Two
   frames and two stores around one scan is the same idea, with that
   constraint respected.

   The store is the whole reason this entry exists: rdint writes two bytes,
   and the second one is the byte that FOLLOWS the variable, so
   `readln (b)' was reading into b and into whatever the compiler had put
   next to it. *)
BEGIN
   M ("rdbyte") ;
   PushBp ; MovBpSp ;
   PushAx ; PushBx ; PushCx ; PushDx ; PushDi ;
   C8 ("rdscan") ;
   CmpCxV (2) ;
   Je8 ("rby_skip") ;                (* nothing entered: leave it alone *)
   MovDiBp4 ;                        (* the caller's address into DI *)
   StDiAl ;                          (* ONE byte - 88 05, AL not AX *)
   M ("rby_skip") ;
   PopDi ; PopDx ; PopCx ; PopBx ; PopAx ;
   MovSpBp ; PopBp ; RetR
END EmitRdByte ;

PROCEDURE EmitRdChar ;
BEGIN
   M ("rdchar") ;
   PushBp ; MovBpSp ;
   PushAx ; PushBx ; PushDi ;
   C8 ("getch") ;
   MovDlAl ;
   MovDiBp4 ;                  (* no [BX] form: the address goes in DI *)
   StDiDl ;
   PopDi ; PopBx ; PopAx ;
   MovSpBp ; PopBp ; RetR
END EmitRdChar ;

PROCEDURE EmitRdBool ;
(* one character, classified the way TP3 does: T/t/Y/y/1 true, anything else
   false. *)
BEGIN
   M ("rdbool") ;
   PushBp ; MovBpSp ;
   PushAx ; PushBx ; PushCx ; PushDi ;
   C8 ("getch") ;
   XorCxCx ;
   CmpAl (ORD ("T")) ; Je8 ("rb_t") ;
   CmpAl (ORD ("t")) ; Je8 ("rb_t") ;
   CmpAl (ORD ("Y")) ; Je8 ("rb_t") ;
   CmpAl (ORD ("y")) ; Je8 ("rb_t") ;
   CmpAl (ORD ("1")) ; Je8 ("rb_t") ;
   J8 ("rb_s") ;
   M ("rb_t") ;
   IncCx ;
   M ("rb_s") ;
   MovDiBp4 ;                  (* DI = the caller's address, because there is
                                  no [BX] to store through *)
   StDiCx ;
   PopDi ; PopCx ; PopBx ; PopAx ;
   MovSpBp ; PopBp ; RetR
END EmitRdBool ;

PROCEDURE EmitRdLn ;
(* discard the rest of the line, including the terminator *)
BEGIN
   M ("rdln") ;
   PushAx ;
   M ("rl_loop") ;
   C8 ("getch") ;
   CmpAl (0DH) ; Je8 ("rl_e") ;
   CmpAl (0AH) ; Je8 ("rl_e") ;
   CmpAl (1AH) ; Je8 ("rl_e") ;          (* ^Z: end of input *)
   J8 ("rl_loop") ;
   M ("rl_e") ;
   PopAx ;
   RetR
END EmitRdLn ;

PROCEDURE EmitRdStr ;
(* readln(s)/read(s) of a string variable: TPSRC4's xrdstr, the runtime entry
   behind both prdstr and prdrdln.  The caller pushes the variable's address
   (one stack word, read here via BP), sets CX = max_len = varsize-1, and pops
   the word after the call.

   Keyed to ours rather than TP3's exactly: TP3 emits MOV CL,imm8 and clears
   CH the length load; this runtime has no byte-register move into CH/CL, so
   the compiler emits a full MOV CX,imm16 and CX *is* the limit (Loop8 / the
   count arithmetic below rely on it).

   Characters come from getch, which clobbers only AX and BX, so the running
   count lives in BX behind a push/pop around each call.  Reading stops at CR,
   LF or ^Z - LF because our input files are LF-terminated - and the terminator
   is left PENDING via ungetch, exactly as TP3's xrdstr leaves its CR pending
   through the pre-read flag: the readln wrapper then consumes the newline,
   while a bare read(s) leaves it for the next read.  The LOOP truncates a line
   longer than max_len.  dest[0] := length; dest[1..] := chars. *)
BEGIN
   M ("rdstr") ;
   PushBp ; MovBpSp ;
   PushAx ; PushBx ; PushCx ; PushDx ; PushDi ;
   MovDiBp4 ;                (* DI := dest base, for the length byte *)
   MovAxBp4 ; MovSiAx ;      (* SI := dest, walking *)
   IncSi ;                   (* SI := dest + 1: chars live at dest[1..], the
                                length byte at dest[0] is stored at the end *)
   XorBxBx ;                 (* BX := 0: count of characters read *)
   M ("rs_loop") ;
   PushBx ;                  (* getch clobbers BX (and AX) *)
   C8 ("getch") ;
   PopBx ;
   CmpAl (0DH) ; Je8 ("rs_term") ;  (* CR *)
   CmpAl (0AH) ; Je8 ("rs_term") ;  (* LF *)
   CmpAl (1AH) ; Je8 ("rs_term") ;  (* ^Z *)
   MovDlAl ;                 (* DL := char *)
   IncBx ;                   (* count := count + 1 *)
   StSiDl ;                  (* dest[i] := char *)
   IncSi ;
   Loop8 ("rs_loop") ;       (* CX--; loop while CX # 0: truncation *)
   M ("rs_end") ;
   MovAlBl ;                 (* AL := count *)
   StDiAl ;                  (* dest[0] := length *)
   PopDi ; PopDx ; PopCx ; PopBx ; PopAx ;
   MovSpBp ; PopBp ; RetR ;
   M ("rs_term") ;
   PushBx ;                  (* ungetch clobbers BX too *)
   C8 ("ungetch") ;
   PopBx ;
   J8 ("rs_end")
END EmitRdStr ;

PROCEDURE EmitStrStore ;
(* s := t for string variables: TPSRC2's strstore with TPSRC8 asnvar's stack
   shape.  The caller pushes BOTH addresses - destination first, source second,
   so the LAST push (dest) sits at [BP+4] and the source at [BP+6] - sets
   CX = max_len = varsize-1 of the DESTINATION, calls, and pops both words
   (this runtime is caller-pops, unlike TP3's strstore which pops itself).

   TP3's strstore rewrites the length byte of the stack copy of the source to
   min(src[0], max), then copies length byte + chars, truncating at max, with
   the destination TAIL past the new length left untouched.  Here, with both
   variables in memory and no stack copy, that becomes: count := min(src[0],
   max); dest[0] := count; copy count chars src[1..] -> dest[1..].  The source
   variable is never written - truncation is expressed in the destination's own
   length byte only.  A source longer than max is truncated; a shorter one is
   copied whole (CX := src length, count including the empty case where LOOP
   simply never runs). *)
BEGIN
   M ("strstore") ;
   PushBp ; MovBpSp ;
   PushAx ; PushBx ; PushCx ; PushDx ;
   MovAxBp4 ; MovSiAx ;      (* SI := dest, walking *)
   MovBxBp6 ;                (* BX := source *)
   XorDxDx ;
   LdAlBx ; MovDlAl ;        (* DL := src[0], the source length *)
   IncBx ;                   (* BX -> first source character *)
   CmpCxDx ;                 (* CMP CX (max), DX (src length) *)
   Jb8 ("ss_trunc") ;
   MovCxDx ;                 (* not truncated: CX := src length *)
   J8 ("ss_len") ;
   M ("ss_trunc") ;
   MovDlCl ;                 (* truncated: DL := max, for the length store *)
   M ("ss_len") ;
   StSiDl ;                  (* dest[0] := length *)
   IncSi ;                   (* dest -> first character *)
   Jcxz8 ("ss_done") ;       (* an empty source copies nothing; LOOP with
                                CX = 0 would run 65536 times, not zero *)
   M ("ss_loop") ;
   LdAlBx ;                  (* AL := src char *)
   MovDlAl ;                 (* DL := char *)
   StSiDl ;                  (* dest char := src char *)
   IncBx ; IncSi ;
   Loop8 ("ss_loop") ;       (* CX--; loop while CX # 0 *)
   M ("ss_done") ;
   PopDx ; PopCx ; PopBx ; PopAx ;
   MovSpBp ; PopBp ; RetR
END EmitStrStore ;

PROCEDURE EmitCmpStr ;
(* cmpstr: lexicographic comparison of two strings, TPSRC2's cmpstr with the
   addresses taken as arguments rather than the strings pushed by value.

   The caller pushes BOTH addresses - the FIRST (left) operand first, so it
   sits at [BP+6], the second (right) at [BP+4], the same order strstore takes
   its two - calls, and pops both words (caller-pops, unlike TP3's cmpstr,
   which pops itself).  It returns AX = -1, 0 or +1 for left < right, left =
   right, left > right.

   Why AX and not the flags, when TP3's cmpstr leaves them set?  Because TP3's
   cmpstr also REMOVES its own arguments (`MOV SP,BX', TPSRC2 960), so its six
   wrappers (csteq/cstne/cstge/cstle/cstg/cstl, TPSRC2 890-925) can branch on
   the flags immediately after the CALL.  Here the caller pushes the two
   addresses, and dropping them with ADD SP,4 - the one-instruction way - is
   in the CPU's arithmetic group and DESTROYS the flags.  (POP does not, but
   then the flags would have to survive the caller's next emission, which is
   exactly the invisible coupling the notes in this file keep warning about.)
   A signed value in AX costs a few instructions inside the entry and keeps the
   flag convention the compiler's own business, where the six-arm table already
   lives: the caller runs OR AX,AX and the same EmSetcc it runs after every
   numeric comparison, so the two paths cannot drift apart.

   That tail is not invented.  A TP3 wrapper is `MOV AX,#1 / Jcc / DEC AX /
   OR AX,AX' - the same EmSetcc our numeric arm emits, followed by the same
   OR AX,AX - and the only thing this design moves is WHERE it happens: out of
   six one-per-operator runtime entries and into the one shared table.  TP3
   needs the six because its cmpstr is reached through vcompare's vector table
   (TPSRC9 133) by type; we already have the operator as a number.

   The comparison is TPSRC2's, translated to an explicit byte loop because
   this runtime has no REPZ CMPS: min(lenL,lenR) bytes are compared in order,
   the first difference decides, and if the common prefix is equal the LENGTHS
   decide (a prefix is less than the string that continues it).  The byte
   compare is unsigned - CF is the borrow out of AL-DL - which is what
   "lexicographic" means for characters.  The tiebreak re-reads the lengths
   from the arguments rather than keeping them in registers across the loop,
   so CX is free to be LOOP's count, and the empty string is the case where
   that count is 0 and LOOP would run 65536 times instead of none. *)
BEGIN
   M ("cmpstr") ;
   PushBp ; MovBpSp ;
   PushBx ; PushCx ; PushDx ;   (* AX is NOT saved: it is the result *)
   XorCxCx ;                 (* CX := 0, to make the CL load below a length *)
   XorDxDx ;
   MovBxBp6 ;                (* BX := the first (left) string's address *)
   MovClBx ;                 (* CL := lenL *)
   MovAxBp4 ; MovSiAx ;      (* SI := the second (right) string's address *)
   MovDlSi ;                 (* DL := lenR *)
   CmpCxDx ;                 (* CMP lenL, lenR *)
   Jbe8 ("cs_min") ;         (* lenL <= lenR: CX is already the shorter *)
   MovCxDx ;                 (* CX := lenR *)
   M ("cs_min") ;            (* CX = min (lenL,lenR) *)
   Jcxz8 ("cs_len") ;        (* an empty operand: no bytes to compare *)
   IncBx ; IncSi ;           (* past the length byte, to the characters *)
   M ("cs_loop") ;
   LdAlBx ;                  (* AL := left[i] *)
   MovDlSi ;                 (* DL := right[i] *)
   CmpAlDl ;                 (* CMP AL,DL - unsigned, so CF is the order *)
   Jne8 ("cs_flag") ;        (* the first difference decides *)
   IncBx ; IncSi ;
   Loop8 ("cs_loop") ;
   M ("cs_len") ;            (* equal over the common prefix: lengths decide *)
   MovBxBp6 ; MovClBx ;      (* CX := lenL again - BX walked past it *)
   MovAxBp4 ; MovSiAx ;
   XorDxDx ; MovDlSi ;       (* DX := lenR *)
   CmpCxDx ;
   M ("cs_flag") ;           (* flags are (left - right): CF=1 less, ZF=1 equal *)
   MovAlD (0) ; MovAh (0) ;  (* AX := 0.  MOV leaves the flags alone, which
                                is what lets the two tests below still read
                                the comparison. *)
   Jb8 ("cs_less") ;
   Je8 ("cs_done") ;
   MovAlD (1) ;              (* greater *)
   J8 ("cs_done") ;
   M ("cs_less") ;
   MovAlD (0FFH) ; MovAh (0FFH) ;   (* AX := -1 *)
   M ("cs_done") ;
   PopDx ; PopCx ; PopBx ;      (* but NOT AX: AX is the RESULT.  The first
                                   version pushed AX with the others and
                                   popped it back here, which restored the
                                   CALLER's AX - for `a < b' that is the
                                   address of the RIGHT operand, still in AX
                                   from its LEA - and every ordering test read
                                   a positive number.  `<', `<=', `=', `<>',
                                   `>', `>=' over any left<right string came
                                   back FALSE TRUE FALSE FALSE TRUE TRUE,
                                   independently confirmed on qemu.  Saving AX
                                   at all is wrong: there is nothing to keep. *)
   MovSpBp ; PopBp ; RetR
END EmitCmpStr ;

PROCEDURE EmitStrCat ;
(* strcat: dest := dest + src, TPSRC2's xconcat (963) with the two strings
   taken as ADDRESSES rather than pushed by value.

   The caller pushes the SOURCE first and the DESTINATION last, sets CX = the
   destination's capacity in characters, calls, and pops both words (caller
   pops).  That is exactly strstore's argument shape, so the compiler's two
   emitted calls for `a + b' differ only in which entry they name - see
   Compiler.StrConcat.

   TP3's xconcat adds the two length bytes (`ADD.B DL,CL') and takes the CARRY
   as "string too long" (`JB concerr'), then concerr loads runerr's code 16;
   the copy itself is the same append this does.  So an overflowing
   concatenation is a RUNTIME ERROR, not a silent truncation: if dest[0] +
   src[0] exceeds CX the process leaves through INT 21h AH=4Ch with exit code
   16 (10H), which is where TP3's error 16 ends up.  (strstore truncates
   instead, which is also what TP3 does there - the two entries deliberately
   do not agree, because TP3's two routines do not.)

   AX, BX, CX, DX, SI and DI are all preserved: the compiler may hold a string
   element's address in DI across the call that pushes the operand AFTER this
   one (see Compiler.EmPushStrOperand), so strcat cannot be the entry that
   quietly clobbers it. *)
BEGIN
   M ("strcat") ;
   PushBp ; MovBpSp ;
   PushAx ; PushBx ; PushCx ; PushDx ; PushSi ; PushDi ;
   MovAxBp4 ; MovSiAx ;      (* SI := dest *)
   MovBxBp6 ;                (* BX := src *)
   XorDxDx ;
   MovDlSi ;                 (* DL := dest[0], the destination length *)
   XorAxAx ;
   LdAlBx ;                  (* AL := src[0]; AX is now the source length *)
   AddDxAx ;                 (* DX := dest length + source length *)
   CmpCxDx ;                 (* CMP CX (max), DX (total) *)
   Jae8 ("sc_ok") ;          (* max >= total: it fits *)
   MovAlD (10H) ;            (* 10H = 16: TP3's `String too long' error code *)
   MovAh (4CH) ;             (* AH = 4Ch: terminate *)
   Int21 ;                   (* leaving now; the caller's stack is abandoned *)
   M ("sc_ok") ;
   MovCxDx ;                 (* CX := the new length *)
   StSiCl ;                  (* dest[0] := new length (CL) *)
   SubDxAx ;                 (* DX := total - source length = old dest length *)
   MovDiSi ;                 (* DI := dest *)
   IncDi ;                   (* -> first character *)
   AddDiDx ;                 (* -> the append position, dest+1+old length *)
   IncBx ;                   (* BX -> the source's first character *)
   MovCxAx ;                 (* CX := source length, LOOP's count *)
   Jcxz8 ("sc_done") ;       (* an empty source appends nothing *)
   M ("sc_loop") ;
   LdAlBx ;                  (* AL := src char *)
   StDiAl ;                  (* dest char := AL *)
   IncBx ; IncDi ;
   Loop8 ("sc_loop") ;
   M ("sc_done") ;
   PopDi ; PopSi ; PopDx ; PopCx ; PopBx ; PopAx ;
   MovSpBp ; PopBp ; RetR
END EmitStrCat ;

PROCEDURE Str5 (s : ARRAY OF CHAR ; n : CARDINAL) ;
(* emit n characters, so the strings below are visibly the same length as the
   D_ constants claim and an off-by-one in either place is a compile-time
   mismatch rather than a wrong pointer nobody notices *)
VAR i : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE i < n DO
      B (ORD (s [i])) ;
      INC (i)
   END
END Str5 ;

PROCEDURE EmitRealFromInt ;
(* intreal (TPSRC3 130): an INTEGER -> the 6-byte MBF real.

   ABI: the source word's ADDRESS is at [BP+6] and the destination's at
   [BP+4]; the caller pushes the source first, so [BP+6] is the source.  (The
   reference keeps the real in AX/BX/DX, where AL is the exponent byte, AH
   and BX the low 39 mantissa bits and DX the high 16 with the sign in DH's
   bit 7.  Packing is therefore just the two stores.)

   The arithmetic is the reference's, instruction for instruction:

     zero -> all six bytes zero
     sign -> BH, DX := |value|
     AX := 0090h (exponent 144, clear mantissa)
     small value: exponent 88h and shift the mantissa 8
     normalise: shift DX left and decrement AL until DX's sign bit is set
     positive: clear DH bit 7; negative: leave it as the sign
     clear the rest of the mantissa (BX)

   The sign convention here is the packed one: bit 7 of the last byte is the
   sign, and the implicit 1 is not stored.  That is why intreal leaves DX's
   top bit alone for negatives (it becomes the sign) and clears it for
   positives. *)
BEGIN
   M ("real_from_int") ;
   PushBp ; MovBpSp ;
   PushBx ; PushDx ; PushSi ; PushDi ;
   MovSiBp6 ;                       (* SI := source word *)
   LdAxSi ;                         (* AX := the integer *)
   CmpAx0 ;
   Jne8 ("rf_nz") ;
   XorBxBx ;
   XorDxDx ;
   Jmp8 ("rf_store") ;
   M ("rf_nz") ;
   MovBhAh ;                        (* BH := the integer's sign byte *)
   MovDxAx ;
   CmpDx0 ;
   Jns8 ("rf_pos") ;
   NegDx ;
   M ("rf_pos") ;
   MovAxImm (0090H) ;               (* AL = exponent 144, AH = 0 *)
   CmpDh0 ;
   Jne8 ("rf_16") ;
   MovAlD (088H) ;                  (* 16-bit value in the top byte: bias 88 *)
   XchgDlDh ;
   M ("rf_16") ;
   CmpDx0 ;
   Js8 ("rf_done") ;
   M ("rf_nrm") ;
   DecAl ;
   ShlDx1 ;
   Jns8 ("rf_nrm") ;
   M ("rf_done") ;
   CmpBh0 ;
   Js8 ("rf_pos2") ;
   AndDhImm (7FH) ;                 (* positive: bit 7 of DH is not a sign *)
   M ("rf_pos2") ;
   XorBxBx ;                        (* only DX's 16 bits carry the value now *)
   M ("rf_store") ;
   MovDiBp4 ;                       (* DI := the destination *)
   StDiAx ;                         (* bytes 0..1 *)
   StDiOffBx (2) ;                  (* bytes 2..3 *)
   StDiOffDx (4) ;                  (* bytes 4..5, sign in DH bit 7 *)
   PopDi ; PopSi ; PopDx ; PopBx ;
   MovSpBp ; PopBp ; RetR
END EmitRealFromInt ;

PROCEDURE EmitRealAddSub ;
(* readd/resub, TPSRC2 1421-1530, transcribed.

   ABI: [BP+4] is the address of a 12-byte block holding a (6 bytes) then b
   (6 bytes); the result overwrites a.  Both operands are read before the
   result is written, so the in-place destination is safe.  The reference
   keeps a in AX/BX/DX and b in CX/SI/DI, with AL the exponent, AH+BX the low
   mantissa and DX the high 16 carrying the sign in DH bit 7.  The scratch
   bytes are the reference's own (resign/resave, remant/remant1, cvdecexp).

   The sign of b is toggled for subtraction with XOR DI,resign, exactly as
   resub does, and the rest is one shared core.  An exponent overflow leaves
   through the reference's STC + RET; no caller consumes that yet. *)
BEGIN
   M ("real_add") ;
   PushBp ; MovBpSp ;
   PushBx ; PushDx ; PushSi ; PushDi ;
   PushBp4 ;                          (* keep the block address for the store *)
   MovSiBp4 ;
   LdAxSi ;
   LdCxSiOff (2) ; LdDxSiOff (4) ;
   MovBxCx ;
   MovDiSi ;
   LdCxDiOff (6) ; LdSiDiOff (8) ; LdDiDiOff (10) ;
   StDataImm (D_RSIGN, 0) ;
   Call ("rd_core") ;
   PopDi ;
   StDiAx ; StDiOffBx (2) ; StDiOffDx (4) ;
   PopDi ; PopSi ; PopDx ; PopBx ;
   MovSpBp ; PopBp ; RetR ;

   M ("real_sub") ;
   PushBp ; MovBpSp ;
   PushBx ; PushDx ; PushSi ; PushDi ;
   PushBp4 ;
   MovSiBp4 ;
   LdAxSi ;
   LdCxSiOff (2) ; LdDxSiOff (4) ;
   MovBxCx ;
   MovDiSi ;
   LdCxDiOff (6) ; LdSiDiOff (8) ; LdDiDiOff (10) ;
   StDataImm (D_RSIGN, 8000H) ;
   Call ("rd_core") ;
   PopDi ;
   StDiAx ; StDiOffBx (2) ; StDiOffDx (4) ;
   PopDi ; PopSi ; PopDx ; PopBx ;
   MovSpBp ; PopBp ; RetR ;

   M ("rd_core") ;
   CmpCl0 ;
   Je8 ("raret") ;
   XorDiData (D_RSIGN) ;
   CmpAl0 ;
   Jne8 ("ranotriv") ;
   M ("raretn2") ;
   MovAxCx ; MovBxSi ; MovDxDi ;
   M ("raret") ;
   RetR ;
   M ("ranotriv") ;
   CmpAlCl ;
   Jbe8 ("ranoswap") ;
   XchgAxCx ; XchgBxSi ; XchgDxDi ;
   M ("ranoswap") ;
   StDataCl (D_CVDEC) ;
   SubClAl ;
   CmpClImm (28H) ;
   Jb8 ("ranoundr") ;
   LdClData (D_CVDEC) ;
   Jmp8 ("raretn2") ;
   M ("ranoundr") ;
   StDataDi (D_RSIGN) ;                 (* resign; D_RESAVE is its high byte *)
   AndDataImm (D_RESAVE, 80H) ;
   StDataDi (D_RMANT) ;
   XorDataDh (D_RMANT1) ;               (* sign1 XOR sign2 in the high byte *)
   OrDiImm (8000H) ;                  (* b's hidden 1 *)
   OrDhImm (80H) ;                    (* a's hidden 1 *)
   M ("raadj16l") ;
   CmpClImm (10H) ;
   Jb8 ("raadj8") ;
   MovAhBh ; MovBxDx ; XorDxDx ; SubClImm (10H) ;
   Jmp8 ("raadj16l") ;
   M ("raadj8") ;
   CmpClImm (08H) ;
   Jb8 ("raadj8l") ;
   MovAhBl ; MovBlBh ; MovBhDl ; MovDlDh ; XorDhDh ; SubClImm (08H) ;
   M ("raadj8l") ;
   CmpCl0 ;
   Je8 ("raadjend") ;
   M ("raadj1l") ;
   ShrDx1 ; RcrBx1 ; RcrAh1 ; DecCl ; Jne8 ("raadj1l") ;
   M ("raadjend") ;
   LdAlData (D_CVDEC) ;
   TestDataImm (D_RMANT1, 80H) ;
   Jne8 ("radosub") ;
   AddAhCh ; AdcBxSi ; AdcDxDi ;
   Jae8 ("rasign") ;
   RcrDx1 ; RcrBx1 ; RcrAh1 ; IncAl ; Jne8 ("rasign") ;
   Stc ; RetR ;
   M ("radosub") ;
   XchgAhCh ; XchgBxSi ; XchgDxDi ;
   SubAhCh ; SbbBxSi ; SbbDxDi ;
   Jae8 ("ranoneg") ;
   XorDataImm (D_RESAVE, 80H) ;
   NotAh ; NotBx ; NotDx ;
   AddAhImm (1) ; AdcBxImm (0) ; AdcDxImm (0) ;
   M ("ranoneg") ;
   MovClImm (5) ;
   M ("ranrm8l") ;
   CmpDh0 ;
   Jne8 ("ranrm1l") ;
   MovDhDl ; MovDlBh ; MovBhBl ; MovBlAh ; XorAhAh ;
   SubAl (08H) ;
   Jb8 ("razero") ;
   DecCl ;
   Jne8 ("ranrm8l") ;
   Jmp8 ("razero") ;
   M ("ranrm1l") ;
   TestDhImm (80H) ;
   Jne8 ("rasign") ;
   ShlAh1 ; RclBx1 ; RclDx1 ; DecAl ; Jne8 ("ranrm1l") ;
   M ("razero") ;
   XorAxAx ; XorBxBx ; XorDxDx ;
   RetR ;
   M ("rasign") ;
   AndDhImm (7FH) ;
   XorDhData (D_RESAVE) ;
   RetR
END EmitRealAddSub ;

PROCEDURE EmitData ;
(* The runtime's data block.  The D_ constants name the offsets in it and are
   ASSERTED against what is emitted here, three ways: the starting offset of
   each string, the offset just past it, and the block's total length.  A D_
   constant is a 16-bit immediate inside a MOV, so a wrong one is a
   perfectly well-formed instruction that reads the wrong memory - see the
   note on the D_ block. *)
BEGIN
   dataAt := rpos ;
   (* Each D_ is checked BEFORE the string it names is emitted, because it
      names that string's START. *)
   IF dataAt + D_NUM # rpos THEN
      HALT
   END ;
   (* 8 bytes of scratch, never read before written *)
   B (0) ; B (0) ; B (0) ; B (0) ; B (0) ; B (0) ; B (0) ; B (0) ;
   IF dataAt + D_TRUE # rpos THEN
      HALT
   END ;
   Str5 ("TRUE$", 5) ;
   IF dataAt + D_FALSE # rpos THEN
      HALT
   END ;
   Str5 ("FALSE$", 6) ;
   IF dataAt + D_CRLF # rpos THEN
      HALT
   END ;
   B (13) ; B (10) ; B (ORD ("$")) ;
   IF dataAt + D_REAL # rpos THEN
      HALT
   END ;
   Str5 ("?REAL?", 6) ;
   IF dataAt + D_PUSH # rpos THEN
      HALT
   END ;
   B (0) ; B (0) ;                 (* the pushback slot, empty to begin with *)
   IF dataAt + D_RSIGN # rpos THEN
      HALT
   END ;
   B (0) ; B (0) ;                 (* resign/resave *)
   IF dataAt + D_RMANT # rpos THEN
      HALT
   END ;
   B (0) ; B (0) ;                 (* remant/remant1 *)
   IF dataAt + D_CVDEC # rpos THEN
      HALT
   END ;
   B (0) ;
   WHILE rpos < dataAt + D_END DO
      B (0)
   END ;
   (* the total, so D_END is checked too and not just used as a pad target *)
   IF rpos - dataAt # D_END THEN
      HALT
   END
END EmitData ;

PROCEDURE FixUp ;
VAR i, t, rel : CARDINAL ;
BEGIN
   i := 0 ;
   WHILE i < nfix DO
      IF fix [i].kind = 2 THEN
         (* A data address, and the ONE kind that is absolute rather than
            relative: rtBase says where the blob sits in the image, val says
            where inside the blob, and LoadBias says where the image itself
            sits once DOS has loaded it.  All three are needed; omitting any
            one produces a readable-looking address into the wrong bytes. *)
         t := (dataAt + rtBase + fix [i].val + LoadBias) MOD 10000H ;
         rt [fix [i].place] := VAL (BYTE, t MOD 100H) ;
         rt [fix [i].place + 1] := VAL (BYTE, (t DIV 100H) MOD 100H)
      ELSE
         t := LblOff (fix [i].nm) ;
         IF fix [i].kind = 0 THEN
            (* rel8 is measured from the end of the instruction, i.e. one
               byte past the displacement field *)
            rel := (t + 100H - (fix [i].place + 1)) MOD 100H ;
            rt [fix [i].place] := VAL (BYTE, rel)
         ELSE
            rel := (t + 10000H - (fix [i].place + 2)) MOD 10000H ;
            rt [fix [i].place] := VAL (BYTE, rel MOD 100H) ;
            rt [fix [i].place + 1] := VAL (BYTE, (rel DIV 100H) MOD 100H)
         END
      END ;
      INC (i)
   END
END FixUp ;

(* ---------------------------------------------------------------- *)
(*  public interface                                                 *)
(* ---------------------------------------------------------------- *)

PROCEDURE RT_Build (base : CARDINAL) ;
BEGIN
   IF built THEN
      RETURN
   END ;
   rtBase := base ;              (* must precede every Emit*, they read it *)
   rpos := 0 ; ltop := 0 ; nfix := 0 ; dataAt := 0 ;
   EmitInitMem ;
   EmitEnd ;
   EmitStackChk ;
   EmitWrInt ; EmitWrIntW ; EmitWrChar ; EmitWrBool ; EmitWrReal ; EmitWrLn ;
   EmitWrInl ; EmitWrStr ;
   EmitRdInt ; EmitRdScan ; EmitRdByte ;
   EmitRdChar ; EmitRdBool ; EmitRdLn ;
   EmitGetCh ; EmitUnGetCh ;
   EmitRdStr ; EmitStrStore ; EmitCmpStr ; EmitStrCat ;
   EmitRealFromInt ; EmitRealAddSub ;
   EmitData ;
   FixUp ;
   SetStr (entNm [0], "initmem") ;
   SetStr (entNm [1], "progend") ;
   SetStr (entNm [2], "stackchk") ;
   SetStr (entNm [3], "wrint") ;
   SetStr (entNm [4], "wrchar") ;
   SetStr (entNm [5], "wrbool") ;
   SetStr (entNm [6], "wrreal") ;
   SetStr (entNm [7], "wrln") ;
   SetStr (entNm [8], "rdint") ;
   SetStr (entNm [9], "rdchar") ;
   SetStr (entNm [10], "rdbool") ;
   SetStr (entNm [11], "rdln") ;
   SetStr (entNm [12], "halt") ;
   SetStr (entNm [13], "wrtinl") ;
   SetStr (entNm [14], "rdbyte") ;
   SetStr (entNm [15], "wrstr") ;
   SetStr (entNm [16], "rdstr") ;
   SetStr (entNm [17], "strstore") ;
   SetStr (entNm [18], "cmpstr") ;
   SetStr (entNm [19], "strcat") ;
   SetStr (entNm [20], "wrintw") ;
   SetStr (entNm [21], "real_from_int") ;
   SetStr (entNm [22], "real_add") ;
   SetStr (entNm [23], "real_sub") ;
   built := TRUE
END RT_Build ;

PROCEDURE RT_Size () : CARDINAL ;
BEGIN
   IF NOT built THEN
      RT_Build (0)
   END ;
   RETURN rpos
END RT_Size ;

PROCEDURE RT_Byte (i : CARDINAL ) : BYTE ;
BEGIN
   IF NOT built THEN
      RT_Build (0)
   END ;
   IF i >= rpos THEN
      RETURN 0
   END ;
   RETURN rt [i]
END RT_Byte ;

PROCEDURE RT_Entry (i : CARDINAL ) : CARDINAL ;
BEGIN
   IF NOT built THEN
      RT_Build (0)
   END ;
   IF i > 23 THEN
      RETURN 0
   END ;
   RETURN rtBase + LblOff (entNm [i])
END RT_Entry ;

PROCEDURE RT_CodeEnd () : CARDINAL ;
BEGIN
   IF NOT built THEN
      RT_Build (0)
   END ;
   RETURN dataAt
END RT_CodeEnd ;

END Runtime.