forml.fr revision 94290
194290Sdcs\ examples from FORML conference paper Nov 98 294290Sdcs\ sadler 394290Sdcs\ 494290Sdcs\ $FreeBSD: head/sys/boot/ficl/softwords/forml.fr 94290 2002-04-09 17:45:28Z dcs $ 594290Sdcs 694290Sdcs.( loading FORML examples ) cr 794290Sdcsobject --> sub c-example 894290Sdcs cell: .cell0 994290Sdcs c-4byte obj: .nCells 1094290Sdcs 4 c-4byte array: .quad 1194290Sdcs c-byte obj: .length 1294290Sdcs 79 chars: .name 1394290Sdcs 1494290Sdcs : init ( inst class -- ) 1594290Sdcs 2dup object => init 1694290Sdcs s" aardvark" 2swap --> set-name 1794290Sdcs ; 1894290Sdcs 1994290Sdcs : get-name ( inst class -- c-addr u ) 2094290Sdcs 2dup 2194290Sdcs --> .name -rot ( c-addr inst class ) 2294290Sdcs --> .length --> get 2394290Sdcs ; 2494290Sdcs 2594290Sdcs : set-name { c-addr u 2:this -- } 2694290Sdcs u this --> .length --> set 2794290Sdcs c-addr this --> .name u move 2894290Sdcs ; 2994290Sdcs 3094290Sdcs : ? ( inst class ) c-example => get-name type cr ; 3194290Sdcsend-class 3294290Sdcs 3394290Sdcs 3494290Sdcs: test ." this is a test" cr ; 3594290Sdcs' test 3694290Sdcsc-word --> ref testref 3794290Sdcs 3894290Sdcs\ add a method to c-word... 3994290Sdcsc-word --> get-wid ficl-set-current 4094290Sdcs\ list dictionary thread 4194290Sdcs: list ( inst class ) 4294290Sdcs begin 4394290Sdcs 2dup --> get-name type cr 4494290Sdcs --> next over 4594290Sdcs 0= until 4694290Sdcs 2drop 4794290Sdcs; 4894290Sdcsset-current 4994290Sdcs 5094290Sdcsobject subclass c-led 5194290Sdcs c-byte obj: .state 5294290Sdcs 5394290Sdcs : on { led# 2:this -- } 5494290Sdcs this --> .state --> get 5594290Sdcs 1 led# lshift or dup !oreg 5694290Sdcs this --> .state --> set 5794290Sdcs ; 5894290Sdcs 5994290Sdcs : off { led# 2:this -- } 6094290Sdcs this --> .state --> get 6194290Sdcs 1 led# lshift invert and dup !oreg 6294290Sdcs this --> .state --> set 6394290Sdcs ; 6494290Sdcs 6594290Sdcsend-class 6694290Sdcs 6794290Sdcs 6894290Sdcsobject subclass c-switch 6994290Sdcs 7094290Sdcs : ?on { bit# 2:this -- flag } 7194290Sdcs 7294290Sdcs 1 bit# lshift 7394290Sdcs ; 7494290Sdcsend-class 7594290Sdcs 76