1 \ @(#) member.fth 98/01/26 1.2
\r
2 \ This files, along with c_struct.fth, supports the definition of
\r
3 \ structure members similar to those used in 'C'.
\r
5 \ Some of this same code is also used by ODE,
\r
6 \ the Object Development Environment.
\r
9 \ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom
\r
11 \ The pForth software code is dedicated to the public domain,
\r
12 \ and any third party may reproduce, distribute and modify
\r
13 \ the pForth software code or any derivative works thereof
\r
14 \ without any compensation or license. The pForth software
\r
15 \ code is provided on an "as is" basis without any warranty
\r
16 \ of any kind, including, without limitation, the implied
\r
17 \ warranties of merchantability and fitness for a particular
\r
18 \ purpose and their equivalents under the laws of any jurisdiction.
\r
20 \ MOD: PLB 1/16/87 Use abort" instead of er.report.
\r
21 \ MOD: PLB 2/19/87 Made OB.MEMBER immediate, use literal.
\r
22 \ MOD: PLB/MDH 6/7/88 Use 16 bit values in member defs.
\r
23 \ MOD: PLB 7/31/88 Add USHORT and UBYTE.
\r
24 \ MOD: PLB 1/20/89 Treat LITERAL as state sensitive.
\r
25 \ MOD: RDG 9/19/90 Add floating point member support.
\r
26 \ MOD: PLB 6/10/91 Add RPTR
\r
27 \ 00001 PLB 8/3/92 Make RPTR a -4 for S@ and S!
\r
28 \ 941102 RDG port to pforth
\r
29 \ 941108 PLB more porting to pforth. Use ?LITERAL instead os smart literal.
\r
30 \ 960710 PLB align long members for SUN
\r
32 ANEW TASK-MEMBER.FTH
\r
35 : FIND.BODY ( -- , pfa true | $name false , look for word in dict. )
\r
36 \ Return address of parameter data.
\r
43 \ Variables shared with object oriented code.
\r
44 VARIABLE OB-STATE ( Compilation state. )
\r
45 VARIABLE OB-CURRENT-CLASS ( ABS_CLASS_BASE of current class )
\r
46 1 constant OB_DEF_CLASS ( defining a class )
\r
47 2 constant OB_DEF_STRUCT ( defining a structure )
\r
49 4 constant OB_OFFSET_SIZE
\r
51 : OB.OFFSET@ ( member_def -- offset ) @ ;
\r
52 : OB.OFFSET, ( value -- ) , ;
\r
53 : OB.SIZE@ ( member_def -- offset )
\r
54 ob_offset_size + @ ;
\r
55 : OB.SIZE, ( value -- ) , ;
\r
57 ( Members are associated with an offset from the base of a structure. )
\r
58 : OB.MAKE.MEMBER ( +-bytes -- , make room in an object at compile time)
\r
59 dup >r ( -- +-b , save #bytes )
\r
61 ob-current-class @ ( -- b addr-space)
\r
62 tuck @ ( as #b c , current space needed )
\r
63 over 3 and 0= ( multiple of four? )
\r
67 over 1 and 0= ( multiple of two? )
\r
72 swap over + rot ! ( update space needed )
\r
73 \ Save data in member definition. %M
\r
74 ob.offset, ( save old offset for ivar )
\r
75 r> ob.size, ( store size in bytes for ..! and ..@ )
\r
78 \ Unions allow one to address the same memory as different members.
\r
79 \ Unions work by saving the current offset for members on
\r
80 \ the stack and then reusing it for different members.
\r
81 : UNION{ ( -- offset , Start union definition. )
\r
82 ob-current-class @ @
\r
85 : }UNION{ ( old-offset -- new-offset , Middle of union )
\r
86 union{ ( Get current for }UNION to compare )
\r
87 swap ob-current-class @ ! ( Set back to old )
\r
90 : }UNION ( offset -- , Terminate union definition, check lengths. )
\r
92 abort" }UNION - Two parts of UNION are not the same size!"
\r
95 \ Make members compile their offset, for "disposable includes".
\r
96 : OB.MEMBER ( #bytes -- , make room in an object at compile time)
\r
97 ( -- offset , run time for structure )
\r
98 CREATE ob.make.member immediate
\r
99 DOES> ob.offset@ ( get offset ) ?literal
\r
102 : OB.FINDIT ( <thing> -- pfa , get pfa of thing or error )
\r
104 IF cr count type ." ???"
\r
105 true abort" OB.FINDIT - Word not found!"
\r
109 : OB.STATS ( member_pfa -- offset #bytes )
\r
110 dup ob.offset@ swap
\r
114 : OB.STATS? ( <member> -- offset #bytes )
\r
118 : SIZEOF() ( <struct>OR<class> -- #bytes , lookup size of object )
\r
123 \ Basic word for defining structure members.
\r
124 : BYTES ( #bytes -- , error check for structure only )
\r
125 ob-state @ ob_def_struct = not
\r
126 abort" BYTES - Only valid in :STRUCT definitions."
\r
130 \ Declare various types of structure members.
\r
131 \ Negative size indicates a signed member.
\r
132 : BYTE ( <name> -- , declare space for a byte )
\r
135 : SHORT ( <name> -- , declare space for a 16 bit value )
\r
138 : LONG ( <name> -- )
\r
141 : UBYTE ( <name> -- , declare space for signed byte )
\r
144 : USHORT ( <name> -- , declare space for signed 16 bit value )
\r
149 : APTR ( <name> -- ) long ;
\r
150 : RPTR ( <name> -- ) -4 bytes ; \ relative relocatable pointer 00001
\r
151 : ULONG ( <name> -- ) long ;
\r
153 : STRUCT ( <struct> <new_ivar> -- , define a structure as an ivar )
\r
154 [compile] sizeof() bytes
\r