194290Sdcs\ #if (FICL_WANT_OOP) 294290Sdcs\ ** ficl/softwords/ficlclass.fr 394290Sdcs\ Classes to model ficl data structures in objects 494290Sdcs\ This is a demo! 594290Sdcs\ John Sadler 14 Sep 1998 694290Sdcs\ 794290Sdcs\ ** C - W O R D 894290Sdcs\ Models a FICL_WORD 994290Sdcs\ 1094290Sdcs\ $FreeBSD: releng/11.0/sys/boot/ficl/softwords/ficlclass.fr 94290 2002-04-09 17:45:28Z dcs $ 1194290Sdcs 1294290Sdcsobject subclass c-word 1394290Sdcs c-word ref: .link 1494290Sdcs c-2byte obj: .hashcode 1594290Sdcs c-byte obj: .flags 1694290Sdcs c-byte obj: .nName 1794290Sdcs c-bytePtr obj: .pName 1894290Sdcs c-cellPtr obj: .pCode 1994290Sdcs c-4byte obj: .param0 2094290Sdcs 2194290Sdcs \ Push word's name... 2294290Sdcs : get-name ( inst class -- c-addr u ) 2394290Sdcs 2dup 2494290Sdcs my=[ .pName get-ptr ] -rot 2594290Sdcs my=[ .nName get ] 2694290Sdcs ; 2794290Sdcs 2894290Sdcs : next ( inst class -- link-inst class ) 2994290Sdcs my=> .link ; 3094290Sdcs 3194290Sdcs : ? 3294290Sdcs ." c-word: " 3394290Sdcs 2dup --> get-name type cr 3494290Sdcs ; 3594290Sdcs 3694290Sdcsend-class 3794290Sdcs 3894290Sdcs\ ** C - W O R D L I S T 3994290Sdcs\ Models a FICL_HASH 4094290Sdcs\ Example of use: 4194290Sdcs\ get-current c-wordlist --> ref current 4294290Sdcs\ current --> ? 4394290Sdcs\ current --> .hash --> ? 4494290Sdcs\ current --> .hash --> next --> ? 4594290Sdcs 4694290Sdcsobject subclass c-wordlist 4794290Sdcs c-wordlist ref: .parent 4894290Sdcs c-ptr obj: .name 4994290Sdcs c-cell obj: .size 5094290Sdcs c-word ref: .hash ( first entry in hash table ) 5194290Sdcs 5294290Sdcs : ? 5394290Sdcs --> get-name ." ficl wordlist " type cr ; 5494290Sdcs : push drop >search ; 5594290Sdcs : pop 2drop previous ; 5694290Sdcs : set-current drop set-current ; 5794290Sdcs : get-name drop wid-get-name ; 5894290Sdcs : words { 2:this -- } 5994290Sdcs this my=[ .size get ] 0 do 6094290Sdcs i this my=[ .hash index ] ( 2list-head ) 6194290Sdcs begin 6294290Sdcs 2dup --> get-name type space 6394290Sdcs --> next over 6494290Sdcs 0= until 2drop cr 6594290Sdcs loop 6694290Sdcs ; 6794290Sdcsend-class 6894290Sdcs 6994290Sdcs\ : named-wid wordlist postpone c-wordlist metaclass => ref ; 7094290Sdcs 7194290Sdcs 7294290Sdcs\ ** C - F I C L S T A C K 7394290Sdcsobject subclass c-ficlstack 7494290Sdcs c-4byte obj: .nCells 7594290Sdcs c-cellPtr obj: .link 7694290Sdcs c-cellPtr obj: .sp 7794290Sdcs c-4byte obj: .stackBase 7894290Sdcs 7994290Sdcs : init 2drop ; 8094290Sdcs : ? 2drop 8194290Sdcs ." ficl stack " cr ; 8294290Sdcs : top 8394290Sdcs --> .sp --> .addr --> prev --> get ; 8494290Sdcsend-class 8594290Sdcs 8694290Sdcs\ #endif 87