\ math.f18 -- the ROM's shared math (docs/v4.0.0/MACHINE.md 2.2).
\
\ Six routines a payload calls through the ROM's entry table, as a GA144
\ application calls its node ROM's multiply and divide steps, and their
\ helpers.  Both ROMs carry them: the host node's and a mesh node's.  They
\ were the system's (capsules/v4/sys: core.f18, numout.f18, qmath.f18) and
\ do exactly what they did there; the system's words of those names now call
\ these.  No names, no headers, no FORTH.
\
\ Constants from the map (tools/mkmap.c): N-1 NODE-ERROR MSB MAXHI 2N+15
\ N-18 N-17, and (Q/), Q./'s five scratch cells, fixed in the memory map
\ (MACHINE.md 2.1).
\
\ ERRORS.  Q./ by zero leaves the result D-11 gives and stores 11, "Division
\ by zero", into NODE-ERROR (D-18).

macro SWAP   over push push drop pop pop   endmacro
macro -      push inv pop + inv            endmacro      \ x y -- x-y
macro NIP    push drop pop                 endmacro
macro ROT    push SWAP pop SWAP            endmacro
macro OR     over inv and xor              endmacro

\ ( u1 u2 -- ulo uhi )   entry 0
: (UM*)
  over 1 and inv 1 +  over 2/ and      \ u1 u2 t0       t0 = u2 2/ if u1 odd
  over a!  N-1 push                    \ A: u2          R: loop count
  push over 2/ pop                     \ u1 u2 s t0     s = u1 2/
  L: +* unext                          \ u1 u2 s hi     A: lo
  push drop pop                        \ u1 u2 hi
  2* a -if L0  drop 1 + jump L1   L0: drop   L1:  push
  over -if L2  drop dup jump L3   L2: drop 0  L3:  push
  dup -if L4  drop over 1 and jump L5   L4: drop 0  L5:
  pop + pop +  push
  and 1 and  a 2* +  pop ;

\ ( ulo uhi ud -- urem uquot )   entry 1.  One step a bit, the divisor in
\ A.  Exact for uhi < ud.
: (UM/MOD)
  a!  N-1 FOR
    -if L0
      2* over -if L1  drop 1 + jump L2
      L1: drop  L2: push 2* pop
      jump SUB
    L0:
      2* over -if L3  drop 1 + jump L4
      L3: drop  L4: push 2* pop
      dup a xor -if L5
        drop -if NOSUB  jump SUB
      L5: drop dup inv a + inv -if L6
        drop jump NOSUB
      L6: push drop pop jump SETBIT
    SUB:    inv a + inv
    SETBIT: push 1 + pop
    NOSUB:
  NEXT
  over push push drop pop pop ;

\ ( d1 d2 -- d3 )   entry 2
: (D+)
  push  over push  push drop pop       \ al bl      R: bh ah
  over over xor -if L1
    drop + -if C1  jump C0
  L1: drop over -if L2
    drop + jump C1
  L2: drop +
  C0: pop pop + ;
  C1: pop pop + 1 + ;

\ ( d -- -d )   entry 3
: (DNEGATE)
  inv over if L1  drop push inv 1 + pop ;
  L1: drop 1 + ;

\ ( q -- n )   the system's Q.TO-INT, which Q.* needs
: (Q>INT)   push a! 0 pop  15 FOR +* UNEXT  drop drop a ;

\ ( a b -- c )   entry 4
: (Q.*)
  SWAP push  over over (UM*) drop
  push  push over pop
  -if L1  SWAP jump L2   L1: SWAP drop 0   L2:
  pop SWAP -  push
  push over pop  (UM*)  pop +
  ROT  pop dup push
  over -if L3  drop dup jump L4   L3: drop 0   L4:
  push (UM*) pop -  (D+)
  ROT pop (UM*)
  SWAP push 0 (D+) pop
  push over pop SWAP (Q>INT)  push (Q>INT) pop SWAP ;

: (QERR11)   NODE-ERROR b! 11 !b ;

: (D2*C) ( lo hi cin -- lo' hi' cout )
  a!  dup -if L1  drop 1 jump L2   L1: drop 0   L2:  push
  over -if L3  drop 1 jump L4   L3: drop 0   L4:
  over + +
  push 2* a + pop  pop ;

: (UQ/) ( a0 a1 b0 b1 -- q0 q1 )
  (Q/)+2 a! SWAP !+ !   (Q/) a! SWAP !+ !   0 0 0
  2N+15 FOR
    push (Q/) a! @+ @ pop  (D2*C)
    push  (Q/)+1 a! !  (Q/) a! !  pop  (D2*C)
    if CMP  drop jump TAKE
    CMP: drop  (Q/)+3 b! @b
      over over xor if EQH  -if SAMEH
      drop drop -if NT1  jump TAKE   NT1: jump NOTAKE
    SAMEH: drop over SWAP  push inv pop + inv
      -if T2  drop jump NOTAKE   T2: drop jump TAKE
    EQH: drop drop  over (Q/)+2 b! @b
      over over xor -if SAMEL
      drop drop -if NT3  drop jump TAKEL   NT3: drop jump NOTAKEL
    SAMEL: drop push inv pop + inv
      -if T4  drop jump NOTAKEL   T4: drop jump TAKEL
    TAKEL:   drop (Q/)+2 b! @b push inv pop + inv  0 1  jump END
    NOTAKEL: 0 jump END
    TAKE:    push  (Q/)+2 b! @b  over over push inv pop + inv  push
      over over xor -if SB  drop NIP -if NB  drop 1 jump BD   NB: drop 0 jump BD
      SB: drop push inv pop + inv  -if NB2  drop 1 jump BD   NB2: drop 0
      BD: pop pop  (Q/)+3 b! @b push inv pop + inv
      push SWAP pop SWAP -  1  jump END
    NOTAKE:  0
    END:
  NEXT
  push (Q/) a! @+ @ pop  (D2*C) drop  push push drop drop pop pop ;

: (Q./) ( a b -- q )   \ entry 5
  over over OR if ZERO  drop
  push over pop SWAP over xor  (Q/)+4 b! !b
  -if L1 (DNEGATE) L1:  push push  -if L2 (DNEGATE) L2:  pop pop
  dup if CHK  drop jump DIV
  CHK: drop  over -131072 and if CHK2  drop jump DIV
  CHK2: drop  push push  dup  pop dup push  N-18 FOR 2* UNEXT
    over over xor -if SAME  drop drop -if NOOV  jump OV
    SAME: drop push inv pop + inv  -if OV
    NOOV: drop pop pop jump DIV
    OV: drop drop drop pop pop drop drop
      (Q/)+4 b! @b -if OVP  drop 0 MSB ;   OVP: drop -1 MAXHI ;
  DIV: (UQ/)  (Q/)+4 b! @b -if L3  drop (DNEGATE) ;   L3: drop ;
  ZERO: drop drop drop
    over over OR if Z0  drop  -if ZP  drop drop 0 MSB jump (QERR11)
    ZP: drop drop -1 MAXHI jump (QERR11)
    Z0: drop jump (QERR11)