\ test.f  fairly minimal test code
HEX
 0000 org   \ reset address
code RESET ( - (6)
      mov   0 #, fl
      ldd   08 rp
      ldd   0a sp
label *COLD
      call  0           \ vectored to TEST word
end-code

 0008 org   \ directly addressable memory: 08, 0A, 0C, 0E
label RP0  0 ,          \ return stack grows up from address stored here
label SP0  0 ,          \ data stack grows down from address stored here

 0010 org
code RX ( - c (13+5i+3j)  \ receive a character, waiting if necessary
      --st  ts, [sp]    \ push data stack
      begin
      mov   8 #, ts     \ mask for REQ bit
      and   fl, ts
  nz? until             \ wait until character is available (REQ==1)
  nz? in    g1          \ (2-cycle NOP in loop)
      or    4 #, fl     \ set ACK bit
      begin
      and   fl, ts
   z? until             \ wait until receipt is acknowledged (REQ==0)
   z? and   1 #, fl     \ clear ACK bit (NOP in loop)
 ret& mov   g1, ts
end-code

code TX ( c - (17+3h+4i+3j)  \ send a character, waiting until it is received
      out   ts
      or    2 #, fl     \ set OUT bit
      mov   8 #, ts     \ mask for REQ bit
      begin
      and   fl, ts
   z? until             \ wait until OK to send (OUT==1,REQ==0)
   z? or    4 #, fl     \ set ACK bit (NOP in loop)
      begin
      mov   8 #, ts     \ mask for REQ bit
      and   fl, ts
  nz? until             \ wait until request is acknowledged (REQ==1)
  nz? and   3 #, fl     \ clear ACK bit (NOP in loop)
      begin
      and   fl, ts
   z? until             \ wait until character is received (REQ==0)
   z? and   1 #, fl     \ clear OUT bit (NOP in loop)
 ret& ld++  [sp], ts    \ pop data stack
end-code

code _LIT ( - x (5)
      --st  ts, [sp]    \ push data stack
 ret& ld++  [ra], ts
end-code

code UMUL ( x - x  g2,g1: pph.ppl - pph'.ppl' sp: u2 (6) \ unsigned multiply step
      rrc   g1, ts      \ u2[0] -> C
      sbb   ts          \ copy C to ts[15:0]
  nz? add   sp, g2      \ pph = u2[0]? pph+u2: pph;
      rrc   g2          \ C.pph.ppl>>1
 ret& sr    g1
end-code



code UM* ( u1 u2 - ud (112) \ would be 21 cycles with 1-cycle multiply step
      nest
      ++st  sp, [rp]    \ save sp (rp)
      ld    [sp], sp    \ u1 -> sp
      mov   0 #, g2     \ 0 -> high partial product (pph)
      mov   ts, g1      \ u2 -> low partial product (ppl)
      call ' UMUL       \ do multiply step 16 times
      call ' UMUL    call ' UMUL    call ' UMUL    call ' UMUL    call ' UMUL
      call ' UMUL    call ' UMUL    call ' UMUL    call ' UMUL    call ' UMUL
      call ' UMUL    call ' UMUL    call ' UMUL    call ' UMUL    call ' UMUL
      ld--  [rp], sp    \ restore sp
      mov   g2, ts      \ pph -> top of stack
      st    g1, [sp]    \ ppl -> 2nd on stack
      exit
end-code

code TEST ( - (?)
      mov   5 #, ts           \ test byte write/read & misc alu opcodes
      +stb  ts, [sp]
      inv   ts                \ ts = fffa
      +stb  ts, [sp]
      neg   ts                \ ts = 0006
      ldb-  [sp], ts
      rlc   ts                \ ts should = 01f4
      ldb-  [sp], ts
      clc
      rrc   1 #, fl           \ test override of C (1->C, 0->fl)
      call  ' _LIT  8765 ,    \ test multiply
      call  ' _LIT  DCBA ,
      call  ' UM*    \ result = 74BD.2B62
      ahead          \ --,
      call  ' TX     \   |    \   ^^       (in delay slot)
      begin          \ <-|--,
      call  ' RX     \   |  |
   z? jpi   ' RESET  \   |  | \ global exit from loop
      entry          \ <-'  |
      again          \ -----'
      call  ' TX              \        ^^  (in delay slot)
end-code

\ initialize RAM locations =================================================

   ' TEST *COLD !             \ cold-start address

   HERE  2 CELLS + RP0 !   \ return stack grows up from here
   HERE 40 CELLS + SP0 !   \ operand stack grows down from here

\ ==========================================================================
