Powered by ViewCVS 1.0-dev
| 1 : | anton | 1.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 : | jwilke | 1.4 | S" ./../wordsets.fs" INCLUDED |
| 36 : | anton | 1.1 | |
| 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 |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |