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