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

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: 
        !            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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>