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