Return to checkans.fs CVS log

Up to [gforth] / gforth / test

repaired "make test"

    1: \ CHECKANS.STR ANS Forth wordset checker                01may93jaw
    2: 
    3: \ 1-3MAY93 Jens A. Wilke
    4: \ This program is public domain
    5: \ Not for commercial usage!
    6: 
    7: DECIMAL
    8: 
    9: VARIABLE CharCount
   10: 30 CONSTANT MaxChars
   11: VARIABLE Flag
   12: 
   13: CREATE Names 125 CELLS ALLOT
   14: VARIABLE PNT Names PNT !
   15: 
   16: : INIT TRUE Flag ! 0 CharCount ! ;
   17: 
   18: : ^     PNT @ DUP @ 1+ SWAP !
   19:         BL WORD FIND
   20:         0= IF PNT @ CELL+ DUP @ 1+ SWAP !
   21:               Flag @ IF CR ." Missing: " FALSE Flag ! THEN
   22:               COUNT DUP CharCount +! TYPE SPACE
   23:               CharCount @ MaxChars U< 0= IF CR 9 SPACES 0 CharCount ! THEN
   24:            ELSE DROP THEN ;
   25: 
   26: : PLACE ( adr cnt adr -- ) 2DUP C! 1+ SWAP MOVE ;
   27: 
   28: : WS    INIT
   29:         PNT @ 2 CELLS + PNT !
   30:         BL WORD
   31:         CR CR ." Checking " DUP COUNT TYPE ."  wordset..."
   32:         DUP COUNT PNT @ PLACE COUNT SWAP DROP 1+
   33:         PNT @ + ALIGNED DUP PNT !
   34:         DUP 0 SWAP ! CELL+ 0 SWAP ! ;
   35: 
   36: S" ../wordsets.fs" INCLUDED
   37: 
   38: : END
   39:         CR CR ." Wordset:            Status:  Words:" CR
   40: 
   41:         Names 2 CELLS +
   42:         BEGIN
   43:                 DUP COUNT TYPE
   44:                 DUP COUNT SWAP DROP 20 SWAP - SPACES
   45:                 COUNT + ALIGNED
   46:                 DUP @ OVER CELL+ @
   47:                 2DUP 0=
   48:                 IF ." complete " . DROP DROP
   49:                 ELSE OVER =
   50:                  IF ." missing  " . DROP
   51:                  ELSE ." partial  " OVER SWAP - . ." / " .
   52:                  THEN
   53:                 THEN CR
   54:                 2 CELLS +
   55:                 DUP PNT @ U< 0=
   56:         UNTIL DROP ;
   57: 
   58: END