| Current Path : /sys/amd64/compile/hs32/modules/usr/src/sys/modules/mvs/@/amd64/compile/hs32/modules/usr/src/sys/modules/zfs/@/boot/ficl/softwords/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
| Current File : //sys/amd64/compile/hs32/modules/usr/src/sys/modules/mvs/@/amd64/compile/hs32/modules/usr/src/sys/modules/zfs/@/boot/ficl/softwords/forml.fr |
\ examples from FORML conference paper Nov 98
\ sadler
\
\ $FreeBSD: release/9.1.0/sys/boot/ficl/softwords/forml.fr 94290 2002-04-09 17:45:28Z dcs $
.( loading FORML examples ) cr
object --> sub c-example
cell: .cell0
c-4byte obj: .nCells
4 c-4byte array: .quad
c-byte obj: .length
79 chars: .name
: init ( inst class -- )
2dup object => init
s" aardvark" 2swap --> set-name
;
: get-name ( inst class -- c-addr u )
2dup
--> .name -rot ( c-addr inst class )
--> .length --> get
;
: set-name { c-addr u 2:this -- }
u this --> .length --> set
c-addr this --> .name u move
;
: ? ( inst class ) c-example => get-name type cr ;
end-class
: test ." this is a test" cr ;
' test
c-word --> ref testref
\ add a method to c-word...
c-word --> get-wid ficl-set-current
\ list dictionary thread
: list ( inst class )
begin
2dup --> get-name type cr
--> next over
0= until
2drop
;
set-current
object subclass c-led
c-byte obj: .state
: on { led# 2:this -- }
this --> .state --> get
1 led# lshift or dup !oreg
this --> .state --> set
;
: off { led# 2:this -- }
this --> .state --> get
1 led# lshift invert and dup !oreg
this --> .state --> set
;
end-class
object subclass c-switch
: ?on { bit# 2:this -- flag }
1 bit# lshift
;
end-class