afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ examples from FORML conference paper Nov 98
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ sadler
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome.( loading FORML examples ) cr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeobject --> sub c-example
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome cell: .cell0
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-4byte obj: .nCells
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 4 c-4byte array: .quad
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-byte obj: .length
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 79 chars: .name
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : init ( inst class -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 2dup object => init
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome s" aardvark" 2swap --> set-name
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : get-name ( inst class -- c-addr u )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 2dup
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome --> .name -rot ( c-addr inst class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome --> .length --> get
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : set-name { c-addr u 2:this -- }
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome u this --> .length --> set
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-addr this --> .name u move
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : ? ( inst class ) c-example => get-name type cr ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeend-class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: test ." this is a test" cr ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome' test
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomec-word --> ref testref
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ add a method to c-word...
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomec-word --> get-wid ficl-set-current
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ list dictionary thread
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome: list ( inst class )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome begin
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 2dup --> get-name type cr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome --> next over
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 0= until
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 2drop
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeset-current
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeobject subclass c-led
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-byte obj: .state
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : on { led# 2:this -- }
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome this --> .state --> get
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 1 led# lshift or dup !oreg
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome this --> .state --> set
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : off { led# 2:this -- }
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome this --> .state --> get
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 1 led# lshift invert and dup !oreg
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome this --> .state --> set
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeend-class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeobject subclass c-switch
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : ?on { bit# 2:this -- flag }
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 1 bit# lshift
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeend-class