sys/boot/ficl/softwords/forml.fr

   1 \ examples from FORML conference paper Nov 98
   2 \ sadler
   3 \
   4 \ $FreeBSD$
   5
   6 .( loading FORML examples ) cr
   7 object --> sub c-example
   8              cell: .cell0
   9     c-4byte   obj: .nCells
  10   4 c-4byte array: .quad
  11        c-byte obj: .length
  12          79 chars: .name
  13
  14     : init   ( inst class -- )
  15         2dup  object => init
  16         s" aardvark"  2swap  --> set-name
  17     ;
  18
  19     : get-name  ( inst class -- c-addr u )
  20         2dup
  21         --> .name  -rot      ( c-addr inst class )
  22         --> .length --> get
  23     ;
  24
  25     : set-name  { c-addr u 2:this -- }
  26         u       this --> .length --> set
  27         c-addr  this --> .name  u move
  28     ;
  29
  30     : ?  ( inst class ) c-example => get-name type cr ;
  31 end-class
  32
  33
  34 : test ." this is a test" cr ;
  35 ' test
  36 c-word --> ref testref
  37
  38 \ add a method to c-word...
  39 c-word --> get-wid ficl-set-current
  40 \ list dictionary thread
  41 : list  ( inst class )
  42     begin
  43         2dup --> get-name type cr
  44         --> next over
  45     0= until
  46     2drop
  47 ;
  48 set-current
  49
  50 object subclass c-led
  51     c-byte obj: .state
  52
  53     : on   { led# 2:this -- }
  54         this --> .state --> get
  55         1 led# lshift or dup !oreg
  56         this --> .state --> set
  57     ;
  58
  59     : off   { led# 2:this -- }
  60         this --> .state --> get
  61         1 led# lshift invert and dup !oreg
  62         this --> .state --> set
  63     ;
  64
  65 end-class
  66
  67
  68 object subclass c-switch
  69
  70     : ?on   { bit# 2:this -- flag }
  71
  72         1 bit# lshift
  73     ;
  74 end-class
  75