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