1S" FICL_WANT_OOP" ENVIRONMENT? drop [if] 2\ ** ficl/softwords/ficlclass.fr 3\ Classes to model ficl data structures in objects 4\ This is a demo! 5\ John Sadler 14 Sep 1998 6\ 7\ ** C - W O R D 8\ Models a FICL_WORD 9 10object subclass c-word 11 c-word ref: .link 12 c-2byte obj: .hashcode 13 c-byte obj: .flags 14 c-byte obj: .nName 15 c-bytePtr obj: .pName 16 c-cellPtr obj: .pCode 17 c-4byte obj: .param0 18 19 \ Push word's name... 20 : get-name ( inst class -- c-addr u ) 21 2dup 22 my=[ .pName get-ptr ] -rot 23 my=[ .nName get ] 24 ; 25 26 : next ( inst class -- link-inst class ) 27 my=> .link ; 28 29 : ? 30 ." c-word: " 31 2dup --> get-name type cr 32 ; 33 34end-class 35 36\ ** C - W O R D L I S T 37\ Models a FICL_HASH 38\ Example of use: 39\ get-current c-wordlist --> ref current 40\ current --> ? 41\ current --> .hash --> ? 42\ current --> .hash --> next --> ? 43 44object subclass c-wordlist 45 c-wordlist ref: .parent 46 c-ptr obj: .name 47 c-cell obj: .size 48 c-word ref: .hash ( first entry in hash table ) 49 50 : ? 51 --> get-name ." ficl wordlist " type cr ; 52 : push drop >search ; 53 : pop 2drop previous ; 54 : set-current drop set-current ; 55 : get-name drop wid-get-name ; 56 : words { 2:this -- } 57 this my=[ .size get ] 0 do 58 i this my=[ .hash index ] ( 2list-head ) 59 begin 60 2dup --> get-name type space 61 --> next over 62 0= until 2drop cr 63 loop 64 ; 65end-class 66 67\ : named-wid wordlist postpone c-wordlist metaclass => ref ; 68 69 70\ ** C - F I C L S T A C K 71object subclass c-ficlstack 72 c-4byte obj: .nCells 73 c-cellPtr obj: .link 74 c-cellPtr obj: .sp 75 c-4byte obj: .stackBase 76 77 : init 2drop ; 78 : ? 2drop 79 ." ficl stack " cr ; 80 : top 81 --> .sp --> .addr --> prev --> get ; 82end-class 83 84[endif] 85