classes.fr revision 61149
140843Smsmith\ ** ficl/softwords/classes.fr 240843Smsmith\ ** F I C L 2 . 0 C L A S S E S 340843Smsmith\ john sadler 1 sep 98 440843Smsmith\ Needs oop.fr 560959Sdcs\ 660959Sdcs\ $FreeBSD: head/sys/boot/ficl/softwords/classes.fr 61149 2000-06-01 18:10:44Z dcs $ 740843Smsmith 840843Smsmith.( loading ficl utility classes ) cr 940843Smsmithalso oop definitions 1040843Smsmith 1140843Smsmith\ REF subclass holds a pointer to an object. It's 1240843Smsmith\ mainly for aggregation to help in making data structures. 1340843Smsmith\ 1440843Smsmithobject subclass c-ref 1540843Smsmith cell: .class 1640843Smsmith cell: .instance 1740843Smsmith 1840843Smsmith : get ( inst class -- refinst refclass ) 1940843Smsmith drop 2@ ; 2040843Smsmith : set ( refinst refclass inst class -- ) 2140843Smsmith drop 2! ; 2240843Smsmithend-class 2340843Smsmith 2440843Smsmithobject subclass c-byte 2540843Smsmith char: .payload 2640843Smsmith 2740843Smsmith : get drop c@ ; 2840843Smsmith : set drop c! ; 2940843Smsmithend-class 3040843Smsmith 3140843Smsmithobject subclass c-2byte 3240843Smsmith 2 chars: .payload 3340843Smsmith 3440843Smsmith : get drop w@ ; 3540843Smsmith : set drop w! ; 3640843Smsmithend-class 3740843Smsmith 3840843Smsmithobject subclass c-4byte 3961149Sdcs 4 chars: .payload 4061149Sdcs 4161149Sdcs : get drop i@ ; 4261149Sdcs : set drop i! ; 4361149Sdcsend-class 4461149Sdcs 4561149Sdcsobject subclass c-cell 4640843Smsmith cell: .payload 4740843Smsmith 4840843Smsmith : get drop @ ; 4940843Smsmith : set drop ! ; 5040843Smsmithend-class 5140843Smsmith 5240843Smsmith 5340843Smsmith\ ** C - P T R 5440843Smsmith\ Base class for pointers to scalars (not objects). 5540843Smsmith\ Note: use c-ref to make references to objects. C-ptr 5640843Smsmith\ subclasses refer to untyped quantities of various sizes. 5740843Smsmith 5840843Smsmith\ Derived classes must specify the size of the thing 5940843Smsmith\ they point to, and supply get and set methods. 6040843Smsmith 6140843Smsmith\ All derived classes must define the @size method: 6240843Smsmith\ @size ( inst class -- addr-units ) 6340843Smsmith\ Returns the size in address units of the thing the pointer 6440843Smsmith\ refers to. 6540843Smsmithobject subclass c-ptr 6661149Sdcs c-cell obj: .addr 6740843Smsmith 6840843Smsmith \ get the value of the pointer 6940843Smsmith : get-ptr ( inst class -- addr ) 7061149Sdcs c-ptr => .addr 7161149Sdcs c-cell => get 7240843Smsmith ; 7340843Smsmith 7440843Smsmith \ set the pointer to address supplied 7540843Smsmith : set-ptr ( addr inst class -- ) 7661149Sdcs c-ptr => .addr 7761149Sdcs c-cell => set 7840843Smsmith ; 7940843Smsmith 8060959Sdcs \ force the pointer to be null 8160959Sdcs : clr-ptr 8261149Sdcs 0 -rot c-ptr => .addr c-cell => set 8360959Sdcs ; 8460959Sdcs 8560959Sdcs \ return flag indicating null-ness 8660959Sdcs : ?null ( inst class -- flag ) 8760959Sdcs c-ptr => get-ptr 0= 8860959Sdcs ; 8960959Sdcs 9040843Smsmith \ increment the pointer in place 9140843Smsmith : inc-ptr ( inst class -- ) 9240843Smsmith 2dup 2dup ( i c i c i c ) 9340843Smsmith c-ptr => get-ptr -rot ( i c addr i c ) 9440843Smsmith --> @size + -rot ( addr' i c ) 9540843Smsmith c-ptr => set-ptr 9640843Smsmith ; 9740843Smsmith 9840843Smsmith \ decrement the pointer in place 9940843Smsmith : dec-ptr ( inst class -- ) 10040843Smsmith 2dup 2dup ( i c i c i c ) 10140843Smsmith c-ptr => get-ptr -rot ( i c addr i c ) 10240843Smsmith --> @size - -rot ( addr' i c ) 10340843Smsmith c-ptr => set-ptr 10440843Smsmith ; 10540843Smsmith 10640843Smsmith \ index the pointer in place 10740843Smsmith : index-ptr ( index inst class -- ) 10840843Smsmith locals| class inst index | 10940843Smsmith inst class c-ptr => get-ptr ( addr ) 11040843Smsmith inst class --> @size index * + ( addr' ) 11140843Smsmith inst class c-ptr => set-ptr 11240843Smsmith ; 11340843Smsmith 11440843Smsmithend-class 11540843Smsmith 11640843Smsmith 11740843Smsmith\ ** C - C E L L P T R 11861149Sdcs\ Models a pointer to cell (a 32 or 64 bit scalar). 11940843Smsmithc-ptr subclass c-cellPtr 12061149Sdcs : @size 2drop 1 cells ; 12140843Smsmith \ fetch and store through the pointer 12240843Smsmith : get ( inst class -- cell ) 12340843Smsmith c-ptr => get-ptr @ 12440843Smsmith ; 12540843Smsmith : set ( value inst class -- ) 12640843Smsmith c-ptr => get-ptr ! 12740843Smsmith ; 12840843Smsmithend-class 12940843Smsmith 13040843Smsmith 13161149Sdcs\ ** C - I N T P T R 13261149Sdcs\ Models a pointer to an int (a 32 bit scalar). 13361149Sdcsc-ptr subclass c-4bytePtr 13461149Sdcs : @size 2drop 4 ; 13561149Sdcs \ fetch and store through the pointer 13661149Sdcs : get ( inst class -- value ) 13761149Sdcs c-ptr => get-ptr i@ 13861149Sdcs ; 13961149Sdcs : set ( value inst class -- ) 14061149Sdcs c-ptr => get-ptr i! 14161149Sdcs ; 14261149Sdcsend-class 14361149Sdcs 14461149Sdcs 14540843Smsmith\ ** C - 2 B Y T E P T R 14640843Smsmith\ Models a pointer to a 16 bit scalar 14740843Smsmithc-ptr subclass c-2bytePtr 14840843Smsmith : @size 2drop 2 ; 14940843Smsmith \ fetch and store through the pointer 15040843Smsmith : get ( inst class -- value ) 15140843Smsmith c-ptr => get-ptr w@ 15240843Smsmith ; 15340843Smsmith : set ( value inst class -- ) 15440843Smsmith c-ptr => get-ptr w! 15540843Smsmith ; 15640843Smsmithend-class 15740843Smsmith 15840843Smsmith 15940843Smsmith\ ** C - B Y T E P T R 16040843Smsmith\ Models a pointer to an 8 bit scalar 16140843Smsmithc-ptr subclass c-bytePtr 16240843Smsmith : @size 2drop 1 ; 16340843Smsmith \ fetch and store through the pointer 16440843Smsmith : get ( inst class -- value ) 16540843Smsmith c-ptr => get-ptr c@ 16640843Smsmith ; 16740843Smsmith : set ( value inst class -- ) 16840843Smsmith c-ptr => get-ptr c! 16940843Smsmith ; 17040843Smsmithend-class 17140843Smsmith 17240843Smsmith 17340843Smsmithprevious definitions 174