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.