\ FORTH/6000 correctness checks -- output is exact, no timings
\ GLM, October 2026

10000 CONSTANT LIMIT
CREATE FLAGS LIMIT 1+ ALLOT

: SIEVE ( limit -- count )
  DUP 2 < IF DROP 0 EXIT THEN
  DUP FLAGS SWAP 1 FILL
  DUP 2 DO
    I FLAGS + C@ IF
      DUP I 2* ?DO 0 I FLAGS + C! J +LOOP
    THEN
  LOOP
  0 SWAP 2 DO I FLAGS + C@ IF 1+ THEN LOOP ;

: FIB ( n -- fib )
  DUP 2 < IF EXIT THEN
  1- DUP 1- RECURSE SWAP RECURSE + ;

: FIBI ( n -- fib )
  DUP 1 < IF EXIT THEN
  0 1 ROT 0 DO TUCK + LOOP DROP ;

: ACK ( m n -- r )
  OVER 0= IF NIP 1+ EXIT THEN
  DUP 0= IF DROP 1- 1 RECURSE EXIT THEN
  2DUP 1- RECURSE >R DROP 1- R> RECURSE ;

: ARRAY ( n "name" -- ) CREATE CELLS ALLOT DOES> SWAP CELLS + ;
10 ARRAY BOARD
: BOARD! ( v i -- ) BOARD ! ;
: BOARD@ ( i -- v ) BOARD @ ;
: INIT 10 0 DO I I BOARD! LOOP ;
: TOTAL 0 10 0 DO I BOARD@ + LOOP ;

: FIRST-DIV-17 ( -- n ) 1000 1 DO I 17 MOD 0= IF I LEAVE THEN LOOP ;
: QDO-SKIP ( -- ) 100 100 ?DO 999 . LOOP ." never" CR ;
: COUNTDOWN ( n -- ) BEGIN DUP 0> WHILE DUP . 1- REPEAT DROP CR ;
: TIMES-TABLE ( -- ) 3 1 DO 3 1 DO J I * 4 .R LOOP CR LOOP ;

INIT
." sieve: " 10 SIEVE . 100 SIEVE . 10000 SIEVE . CR
." fib: " 20 FIB . 24 FIB . 28 FIBI . CR
." ack: " 2 3 ACK . 3 3 ACK . 3 5 ACK . 3 6 ACK . CR
." does: " TOTAL . CR
." leave: " FIRST-DIV-17 . CR
." ?do: " QDO-SKIP
." while: " 3 COUNTDOWN
." nested loops (J and I):" CR TIMES-TABLE
." tick/execute: " 2 3 ' ACK EXECUTE . CR
." string: " S" a small string" TYPE CR