freebsd-nq/stand/ficl/softwords/ficlclass.fr
2017-11-14 23:02:19 +00:00

87 lines
1.9 KiB
Plaintext

\ #if (FICL_WANT_OOP)
\ ** ficl/softwords/ficlclass.fr
\ Classes to model ficl data structures in objects
\ This is a demo!
\ John Sadler 14 Sep 1998
\
\ ** C - W O R D
\ Models a FICL_WORD
\
\ $FreeBSD$
object subclass c-word
c-word ref: .link
c-2byte obj: .hashcode
c-byte obj: .flags
c-byte obj: .nName
c-bytePtr obj: .pName
c-cellPtr obj: .pCode
c-4byte obj: .param0
\ Push word's name...
: get-name ( inst class -- c-addr u )
2dup
my=[ .pName get-ptr ] -rot
my=[ .nName get ]
;
: next ( inst class -- link-inst class )
my=> .link ;
: ?
." c-word: "
2dup --> get-name type cr
;
end-class
\ ** C - W O R D L I S T
\ Models a FICL_HASH
\ Example of use:
\ get-current c-wordlist --> ref current
\ current --> ?
\ current --> .hash --> ?
\ current --> .hash --> next --> ?
object subclass c-wordlist
c-wordlist ref: .parent
c-ptr obj: .name
c-cell obj: .size
c-word ref: .hash ( first entry in hash table )
: ?
--> get-name ." ficl wordlist " type cr ;
: push drop >search ;
: pop 2drop previous ;
: set-current drop set-current ;
: get-name drop wid-get-name ;
: words { 2:this -- }
this my=[ .size get ] 0 do
i this my=[ .hash index ] ( 2list-head )
begin
2dup --> get-name type space
--> next over
0= until 2drop cr
loop
;
end-class
\ : named-wid wordlist postpone c-wordlist metaclass => ref ;
\ ** C - F I C L S T A C K
object subclass c-ficlstack
c-4byte obj: .nCells
c-cellPtr obj: .link
c-cellPtr obj: .sp
c-4byte obj: .stackBase
: init 2drop ;
: ? 2drop
." ficl stack " cr ;
: top
--> .sp --> .addr --> prev --> get ;
end-class
\ #endif