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]