home: hub: 9ficl

ref: 5a81e15d663cfea8832155f39f0e8f3557ff3fae
dir: /softwords/ficlclass.fr/

\ ** 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...

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
        --> .pName --> get-ptr  -rot
        --> .nName --> get
    ;

    : next   ( inst class -- link-inst class )
        --> .link ;
        
    : ?
        ." ficl word: " 
        2dup --> get-name type cr
        ." hash = "
        2dup --> .hashcode --> get x. cr
        ." flags = "
        --> .flags --> get x. cr
    ;

end-class

\ ** C - W O R D L I S T
\ Example of use:
\ get-current c-wordlist --> ref current
\ current --> ?
\ current --> .hash --> ?
\ current --> .hash --> next --> ?

object subclass c-wordlist
	c-wordlist ref: .parent
	c-4byte    obj: .size
	c-word     ref: .hash

    : ?
        2drop ." ficl wordlist " cr ;
	: push  drop  >search ;
	: pop   2drop previous ;
	: set-current   drop set-current ;
	: words   --> push  words previous ;
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


\ ** C - S T R I N G
\ counted string, size set at creation time (if by NEW)
\ Can also be ref instantiated to wrap an existing string
\ No check for bounds overrun...
\ Creation example:
\   80 c-string --> new str80
\   s" arf arf!!" str80 --> set
\   str80 --> type  cr
\
object subclass c-string
    c-byte obj: .count
          char: .text

    : type   ( inst class -- )
        2dup --> .text 
        -rot --> .count --> get 
        type  ;

    : init   ( size inst class -- )
        rot allot  object => init   ;

    : set   ( c-addr u inst class )
        locals| class inst |
        dup
        inst class --> .count --> set
        inst class --> .text  swap move  ;

    : get   ( inst class -- c-addr u )
        2dup 
        --> .text   -rot 
        --> .count --> get 
    ;

end-class