Return to checkans.fs CVS log

Up to [gforth] / gforth / test

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

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: 
                      6: DECIMAL
                      7: 
                      8: VARIABLE CharCount
                      9: 30 CONSTANT MaxChars
                     10: VARIABLE Flag
                     11: 
                     12: CREATE Names 125 CELLS ALLOT
                     13: VARIABLE PNT Names PNT !
                     14: 
                     15: : INIT TRUE Flag ! 0 CharCount ! ;
                     16: 
                     17: : ^     PNT @ DUP @ 1+ SWAP !
                     18:         BL WORD FIND
                     19:         0= IF PNT @ CELL+ DUP @ 1+ SWAP !
                     20:               Flag @ IF CR ." Missing: " FALSE Flag ! THEN
                     21:               COUNT DUP CharCount +! TYPE SPACE
                     22:               CharCount @ MaxChars U< 0= IF CR 9 SPACES 0 CharCount ! THEN
                     23:            ELSE DROP THEN ;
                     24: 
                     25: : PLACE ( adr cnt adr -- ) 2DUP C! 1+ SWAP MOVE ;
                     26: 
                     27: : WS    INIT
                     28:         PNT @ 2 CELLS + PNT !
                     29:         BL WORD
                     30:         CR CR ." Checking " DUP COUNT TYPE ."  wordset..."
                     31:         DUP COUNT PNT @ PLACE COUNT SWAP DROP 1+
                     32:         PNT @ + ALIGNED DUP PNT !
                     33:         DUP 0 SWAP ! CELL+ 0 SWAP ! ;
                     34: 
1.4     ! jwilke     35: S" ./../wordsets.fs" INCLUDED
1.1       anton      36: 
                     37: : END
                     38:         CR CR ." Wordset:            Status:  Words:" CR
                     39: 
                     40:         Names 2 CELLS +
                     41:         BEGIN
                     42:                 DUP COUNT TYPE
                     43:                 DUP COUNT SWAP DROP 20 SWAP - SPACES
                     44:                 COUNT + ALIGNED
                     45:                 DUP @ OVER CELL+ @
                     46:                 2DUP 0=
                     47:                 IF ." complete " . DROP DROP
                     48:                 ELSE OVER =
                     49:                  IF ." missing  " . DROP
                     50:                  ELSE ." partial  " OVER SWAP - . ." / " .
                     51:                  THEN
                     52:                 THEN CR
                     53:                 2 CELLS +
                     54:                 DUP PNT @ U< 0=
                     55:         UNTIL DROP ;
                     56: 
                     57: END