sys/boot/ficl/softwords/ficlclass.fr

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