Return to checkans.fs CVS log

Up to [gforth] / gforth / test

Annotation of gforth/test/checkans.fs, revision 1.2

1.1       anton       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: 
1.2     ! anton      36: S" ../wordsets.fs" INCLUDED
1.1       anton      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