afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas SoomeS" FICL_WANT_OOP" ENVIRONMENT? drop [if]
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ** F I C L 2 . 0 C L A S S E S
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ john sadler 1 sep 98
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome.( loading ficl utility classes ) cr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomealso oop definitions
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ REF subclass holds a pointer to an object. It's
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ mainly for aggregation to help in making data structures.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeobject subclass c-ref
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome cell: .class
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome cell: .instance
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : get ( inst class -- refinst refclass )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : set ( refinst refclass inst class -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeobject subclass c-byte
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome char: .payload
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : get drop c@ ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : set drop c! ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeobject subclass c-2byte
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 2 chars: .payload
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : get drop w@ ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : set drop w! ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeobject subclass c-4byte
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 4 chars: .payload
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : get drop q@ ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : set drop q! ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeobject subclass c-cell
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome cell: .payload
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : get drop @ ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : set drop ! ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ** C - P T R
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Base class for pointers to scalars (not objects).
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Note: use c-ref to make references to objects. C-ptr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ subclasses refer to untyped quantities of various sizes.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Derived classes must specify the size of the thing
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ they point to, and supply get and set methods.
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ All derived classes must define the @size method:
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ @size ( inst class -- addr-units )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Returns the size in address units of the thing the pointer
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeobject subclass c-ptr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-cell obj: .addr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome \ get the value of the pointer
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : get-ptr ( inst class -- addr )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-ptr => .addr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-cell => get
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome \ set the pointer to address supplied
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : set-ptr ( addr inst class -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-ptr => .addr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-cell => set
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome \ force the pointer to be null
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 0 -rot c-ptr => .addr c-cell => set
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome \ return flag indicating null-ness
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : ?null ( inst class -- flag )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-ptr => get-ptr 0=
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome \ increment the pointer in place
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : inc-ptr ( inst class -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 2dup 2dup ( i c i c i c )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-ptr => get-ptr -rot ( i c addr i c )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome --> @size + -rot ( addr' i c )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-ptr => set-ptr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome \ decrement the pointer in place
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : dec-ptr ( inst class -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome 2dup 2dup ( i c i c i c )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-ptr => get-ptr -rot ( i c addr i c )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome --> @size - -rot ( addr' i c )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-ptr => set-ptr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome \ index the pointer in place
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : index-ptr { index 2:this -- }
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome this --> get-ptr ( addr )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome this --> @size index * + ( addr' )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome this --> set-ptr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ** C - C E L L P T R
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Models a pointer to cell (a 32 or 64 bit scalar).
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomec-ptr subclass c-cellPtr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : @size 2drop 1 cells ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome \ fetch and store through the pointer
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : get ( inst class -- cell )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-ptr => get-ptr @
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : set ( value inst class -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-ptr => get-ptr !
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ** C - 4 B Y T E P T R
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Models a pointer to a quadbyte scalar
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomec-ptr subclass c-4bytePtr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : @size 2drop 4 ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome \ fetch and store through the pointer
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : get ( inst class -- value )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-ptr => get-ptr q@
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : set ( value inst class -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-ptr => get-ptr q!
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ** C - 2 B Y T E P T R
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Models a pointer to a 16 bit scalar
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomec-ptr subclass c-2bytePtr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : @size 2drop 2 ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome \ fetch and store through the pointer
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : get ( inst class -- value )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-ptr => get-ptr w@
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : set ( value inst class -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-ptr => get-ptr w!
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ ** C - B Y T E P T R
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome\ Models a pointer to an 8 bit scalar
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomec-ptr subclass c-bytePtr
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : @size 2drop 1 ;
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome \ fetch and store through the pointer
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : get ( inst class -- value )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-ptr => get-ptr c@
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome : set ( value inst class -- )
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soome c-ptr => get-ptr c!
afc2ba1deb75b323afde536f2dd18bcafdaa308dToomas Soomeprevious definitions