Return to checkans.fs CVS log

Up to [gforth] / gforth / test

Added relative (./) includes.

    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: 
   35: S" ./../wordsets.fs" INCLUDED
   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