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