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