141 lines
3.2 KiB
Plaintext
141 lines
3.2 KiB
Plaintext
|
\ ** ficl/softwords/classes.fr
|
||
|
|
\ ** F I C L 2 . 0 C L A S S E S
|
||
|
|
\ john sadler 1 sep 98
|
||
|
|
\ Needs oop.fr
|
||
|
|
|
||
|
|
.( loading ficl utility classes ) cr
|
||
|
|
also oop definitions
|
||
|
|
|
||
|
|
\ REF subclass holds a pointer to an object. It's
|
||
|
|
\ mainly for aggregation to help in making data structures.
|
||
|
|
\
|
||
|
|
object subclass c-ref
|
||
|
|
cell: .class
|
||
|
|
cell: .instance
|
||
|
|
|
||
|
|
: get ( inst class -- refinst refclass )
|
||
|
|
drop 2@ ;
|
||
|
|
: set ( refinst refclass inst class -- )
|
||
|
|
drop 2! ;
|
||
|
|
end-class
|
||
|
|
|
||
|
|
object subclass c-byte
|
||
|
|
char: .payload
|
||
|
|
|
||
|
|
: get drop c@ ;
|
||
|
|
: set drop c! ;
|
||
|
|
end-class
|
||
|
|
|
||
|
|
object subclass c-2byte
|
||
|
|
2 chars: .payload
|
||
|
|
|
||
|
|
: get drop w@ ;
|
||
|
|
: set drop w! ;
|
||
|
|
end-class
|
||
|
|
|
||
|
|
object subclass c-4byte
|
||
|
|
cell: .payload
|
||
|
|
|
||
|
|
: get drop @ ;
|
||
|
|
: set drop ! ;
|
||
|
|
end-class
|
||
|
|
|
||
|
|
|
||
|
|
\ ** C - P T R
|
||
|
|
\ Base class for pointers to scalars (not objects).
|
||
|
|
\ Note: use c-ref to make references to objects. C-ptr
|
||
|
|
\ subclasses refer to untyped quantities of various sizes.
|
||
|
|
|
||
|
|
\ Derived classes must specify the size of the thing
|
||
|
|
\ they point to, and supply get and set methods.
|
||
|
|
|
||
|
|
\ All derived classes must define the @size method:
|
||
|
|
\ @size ( inst class -- addr-units )
|
||
|
|
\ Returns the size in address units of the thing the pointer
|
||
|
|
\ refers to.
|
||
|
|
object subclass c-ptr
|
||
|
|
c-4byte obj: .addr
|
||
|
|
|
||
|
|
\ get the value of the pointer
|
||
|
|
: get-ptr ( inst class -- addr )
|
||
|
|
c-ptr => .addr
|
||
|
|
c-4byte => get
|
||
|
|
;
|
||
|
|
|
||
|
|
\ set the pointer to address supplied
|
||
|
|
: set-ptr ( addr inst class -- )
|
||
|
|
c-ptr => .addr
|
||
|
|
c-4byte => set
|
||
|
|
;
|
||
|
|
|
||
|
|
\ increment the pointer in place
|
||
|
|
: inc-ptr ( inst class -- )
|
||
|
|
2dup 2dup ( i c i c i c )
|
||
|
|
c-ptr => get-ptr -rot ( i c addr i c )
|
||
|
|
--> @size + -rot ( addr' i c )
|
||
|
|
c-ptr => set-ptr
|
||
|
|
;
|
||
|
|
|
||
|
|
\ decrement the pointer in place
|
||
|
|
: dec-ptr ( inst class -- )
|
||
|
|
2dup 2dup ( i c i c i c )
|
||
|
|
c-ptr => get-ptr -rot ( i c addr i c )
|
||
|
|
--> @size - -rot ( addr' i c )
|
||
|
|
c-ptr => set-ptr
|
||
|
|
;
|
||
|
|
|
||
|
|
\ index the pointer in place
|
||
|
|
: index-ptr ( index inst class -- )
|
||
|
|
locals| class inst index |
|
||
|
|
inst class c-ptr => get-ptr ( addr )
|
||
|
|
inst class --> @size index * + ( addr' )
|
||
|
|
inst class c-ptr => set-ptr
|
||
|
|
;
|
||
|
|
|
||
|
|
end-class
|
||
|
|
|
||
|
|
|
||
|
|
\ ** C - C E L L P T R
|
||
|
|
\ Models a pointer to cell (a 32 bit scalar).
|
||
|
|
c-ptr subclass c-cellPtr
|
||
|
|
: @size 2drop 4 ;
|
||
|
|
\ fetch and store through the pointer
|
||
|
|
: get ( inst class -- cell )
|
||
|
|
c-ptr => get-ptr @
|
||
|
|
;
|
||
|
|
: set ( value inst class -- )
|
||
|
|
c-ptr => get-ptr !
|
||
|
|
;
|
||
|
|
end-class
|
||
|
|
|
||
|
|
|
||
|
|
\ ** C - 2 B Y T E P T R
|
||
|
|
\ Models a pointer to a 16 bit scalar
|
||
|
|
c-ptr subclass c-2bytePtr
|
||
|
|
: @size 2drop 2 ;
|
||
|
|
\ fetch and store through the pointer
|
||
|
|
: get ( inst class -- value )
|
||
|
|
c-ptr => get-ptr w@
|
||
|
|
;
|
||
|
|
: set ( value inst class -- )
|
||
|
|
c-ptr => get-ptr w!
|
||
|
|
;
|
||
|
|
end-class
|
||
|
|
|
||
|
|
|
||
|
|
\ ** C - B Y T E P T R
|
||
|
|
\ Models a pointer to an 8 bit scalar
|
||
|
|
c-ptr subclass c-bytePtr
|
||
|
|
: @size 2drop 1 ;
|
||
|
|
\ fetch and store through the pointer
|
||
|
|
: get ( inst class -- value )
|
||
|
|
c-ptr => get-ptr c@
|
||
|
|
;
|
||
|
|
: set ( value inst class -- )
|
||
|
|
c-ptr => get-ptr c!
|
||
|
|
;
|
||
|
|
end-class
|
||
|
|
|
||
|
|
|
||
|
|
previous definitions
|