Add word TICKS

Adding a delay such as the 20ms one we have in AVR programmer's
initialization routine is tricky without a word like TICKS.

This implementation is highly inaccurate, but more accurate and
reliable than a "ballpark" DO..LOOP...

blk/160

@@ -10,7 +10,7 @@ VARIABLE aspprevx
 : asprdy ( -- ) BEGIN 0 0 0 0xf0 _cmd 1 AND NOT UNTIL ;
 : asp$ ( spidevid -- )
     ( RESET pulse ) DUP (spie) 0 (spie) (spie)
-    ( wait >20ms ) 5000 0 DO LOOP
+    ( wait >20ms ) 220 TICKS
     ( enable prog ) 0xac (spix) DROP
     0x53 _x DROP 0 _xc DROP 0 _x DROP ;
 : asperase 0 0 0x80 0xac _cmd asprdy ;

blk/282

@@ -1 +1,5 @@
 VARIABLE lbluflw VARIABLE lblexec
+( see comment at TICKS' definition )
+( 7.373MHz target: 737t. outer: 37t inner: 16t )
+( tickfactor = (737 - 37) / 16 )
+CREATE tickfactor 44 ,

blk/321

@@ -0,0 +1,13 @@
+( The word below is designed to wait the proper 100us per tick
+  at 500kHz when tickfactor is 1. If the CPU runs faster,
+  tickfactor has to be adjusted accordingly. "t" in comments
+  below means "T-cycle", which at 500kHz is worth 2us. )
+CODE TICKS
+    HL POP, chkPS,
+    ( we pre-dec to compensate for initialization )
+    BEGIN,
+        HL DECd, ( 6t )
+        IFZ, ( 12t ) JPNEXT, THEN,
+        A tickfactor @ LDri, ( 7t )
+        BEGIN, A DECr, ( 4t ) JRNZ, ( 12t ) AGAIN,
+    JR, ( 12t ) AGAIN, ( outer: 37t inner: 16t )

blk/441

@@ -10,4 +10,4 @@ size of stack. This allows for some interesting optimization.
 For example, in SWAP, no need to pop, chkPS, then push, we can
 chkPS and then proceed to optimized swapping in PS.
 
-To assemble, load blocks 445 through 460
+To assemble, load blocks 445 through 461

blk/461

@@ -0,0 +1,9 @@
+( See comment in B321. TODO: test on real hardware. in qemu,
+  the resulting delay is more than 10x too long. )
+CODE TICKS 1 chkPS, ( n=100us )
+    SI DX MOVxx, ( protect IP )
+    AX POPx, BX 100 MOVxI, BX MULx,
+    CX DX MOVxx, ( high ) DX AX MOVxx, ( low )
+    AX 0x8600 MOVxI, ( 86h, WAIT ) 0x15 INT,
+    DX SI MOVxx, ( restore IP )
+;CODE

cvm/vm.c

@@ -1,6 +1,7 @@
 #include <stdlib.h>
 #include <stdio.h>
 #include <string.h>
+#include <unistd.h>
 #include "vm.h"
 
 // Port for block reads. Each read or write has to be done in 5 IO writes:
@@ -263,6 +264,7 @@ static void MINUS2() { push(pop()-2); }
 static void PLUS2() { push(pop()+2); }
 static void RSHIFT() { word u = pop(); push(pop()>>u); }
 static void LSHIFT() { word u = pop(); push(pop()<<u); }
+static void TICKS() { usleep(pop()); }
 
 static void native(NativeWord func) {
     vm.nativew[vm.nativew_count++] = func;
@@ -316,11 +318,11 @@ VM* VM_init(char *blkfs_path) {
     native(_br_);
     native(_cbr_);
     native(_loop_);
-    native(SP_to_R_2);
     native(nlit);
     native(slit);
     native(SP_to_R);
     native(R_to_SP);
+    native(SP_to_R_2);
     native(R_to_SP_2);
     native(EXECUTE);
     native(ROT);
@@ -367,6 +369,7 @@ VM* VM_init(char *blkfs_path) {
     native(MINUS2);
     native(RSHIFT);
     native(LSHIFT);
+    native(TICKS);
     vm.IP = gw(0x04) + 1; // BOOT
     sw(SYSVARS+0x02, gw(0x08)); // CURRENT
     sw(SYSVARS+0x04, gw(0x08)); // HERE

cvm/xcomp.fs

@@ -17,11 +17,11 @@ H@ 4 + XCURRENT ! ( make next CODE have 0 prev field )
 0x01 CODE (br)
 0x02 CODE (?br)
 0x03 CODE (loop)
-0x05 CODE (n)
+0x04 CODE (n)
-0x06 CODE (s)
+0x05 CODE (s)
-0x04 CODE 2>R
+0x06 CODE >R
-0x07 CODE >R
+0x07 CODE R>
-0x08 CODE R>
+0x08 CODE 2>R
 0x09 CODE 2R>
 0x0a CODE EXECUTE
 0x0b CODE ROT
@@ -68,6 +68,7 @@ H@ 4 + XCURRENT ! ( make next CODE have 0 prev field )
 0x34 CODE 2-
 0x35 CODE RSHIFT
 0x36 CODE LSHIFT
+0x37 CODE TICKS
 353 LOAD  ( xcomp core low )
 : (emit) 0 PC! ;
 : (key) 0 PC@ ;

doc/dict.txt

@@ -242,9 +242,6 @@ S=      a1 a2 -- f Returns whether string a1 == a2.
                call to (print).
 C<?     -- f   Returns whether there's a char waiting in buf.
 C<      -- c   Read one char from buffered input.
-DUMP    n a -- Prints n bytes at addr a in a hexdump format.
-               Prints in chunks of 8 bytes. Doesn't do partial
-               lines. Output is designed to fit in 32 columns.
 EMIT    c --   Spit char c to output stream
 IN>     -- a   Address of variable containing current pos in
                input buffer.
@@ -270,7 +267,6 @@ BLK(   -- a      Beginning addr of blk buf.
 BLK)   -- a      Ending addr of blk buf.
 COPY   s d --    Copy contents of s block to d block.
 FLUSH  --        Write current block to disk if dirty.
-FREEBLKS? a b -- List free blocks between blocks a and b.
 LIST   n --      Prints the contents of the block n on screen
                  in the form of 16 lines of 64 columns.
 LOAD   n --      Interprets Forth code from block n
@@ -279,3 +275,11 @@ LOADR  n1 n2 --  Load block range between n1 and n2, inclusive.
 LOADR+ n1 n2 --  Relative ranged load.
 WIPE   --        Empties current block
 WIPED? -- f      Whether current block is empty
+
+# Other
+
+DUMP    n a -- Prints n bytes at addr a in a hexdump format.
+               Prints in chunks of 8 bytes. Doesn't do partial
+               lines. Output is designed to fit in 32 columns.
+TICKS   n --   Wait for approximately 0.1 millisecond. Don't
+               use with n=0.

recipes/pcat/blk/612

@@ -3,7 +3,7 @@
 RS_ADDR 0x80 - CONSTANT SYSVARS
 30 LOAD   ( 8086 asm )
 262 LOAD  ( xcomp ) 270 LOAD  ( xcomp overrides )
-445 460 LOADR ( 8086 boot code )
+445 461 LOADR ( 8086 boot code )
 353 LOAD  ( xcomp core low )
 604 LOAD  ( KEY/EMIT drivers )
 606 608 LOADR  ( BLK drivers )