Commit | Line | Data |
---|---|---|
8e9db35f PB |
1 | \ @(#) dump_struct.fth 97/12/10 1.1 |
2 | \ Dump contents of structure showing values and member names. | |
3 | \ | |
4 | \ Author: Phil Burk | |
5 | \ Copyright 1987 Phil Burk | |
6 | \ All Rights Reserved. | |
7 | \ | |
8 | \ MOD: PLB 9/4/88 Print size too. | |
9 | \ MOD: PLB 9/9/88 Print U/S , add ADST | |
10 | \ MOD: PLB 12/6/90 Modified to work with H4th | |
11 | \ 941109 PLB Converted to pforth. Added RP detection. | |
12 | \ 090609 PLB Convert >rel to use->rel and ..! to s! | |
13 | ||
14 | include? task-member.fth member.fth | |
15 | include? task-c_struct c_struct.fth | |
16 | ||
17 | ANEW TASK-DUMP_STRUCT | |
18 | ||
19 | : EMIT-TO-COLUMN ( char col -- ) | |
20 | out @ - 0 max 80 min 0 | |
21 | DO dup emit | |
22 | LOOP drop | |
23 | ; | |
24 | ||
25 | VARIABLE SN-FENCE | |
26 | : STACK.NFAS ( fencenfa topnfa -- 0 nfa0 nfa1 ... ) | |
27 | \ Fill stack with nfas of words until fence hit. | |
28 | >r sn-fence ! | |
29 | 0 r> ( set terminator ) | |
30 | BEGIN ( -- 0 n0 n1 ... top ) | |
31 | dup sn-fence @ > | |
32 | WHILE | |
33 | \ dup n>link @ \ JForth | |
34 | dup prevname \ HForth | |
35 | REPEAT | |
36 | drop | |
37 | ; | |
38 | ||
39 | : DST.DUMP.TYPE ( +-size -- , dump data type, 941109) | |
40 | dup abs 4 = | |
41 | IF | |
42 | 0< | |
43 | IF ." RP" | |
44 | ELSE ." U4" | |
45 | THEN | |
46 | ELSE | |
47 | dup 0< | |
48 | IF ascii U | |
49 | ELSE ascii S | |
50 | THEN emit abs 1 .r | |
51 | THEN | |
52 | ; | |
53 | ||
54 | : DUMP.MEMBER ( addr member-pfa -- , dump member of structure) | |
55 | ob.stats ( -- addr offset size ) | |
56 | >r + r> ( -- addr' size ) | |
57 | dup ABS 4 > ( -- addr' size flag ) | |
58 | IF cr 2dup swap . . ABS dump | |
59 | ELSE tuck @bytes 10 .r ( -- size ) | |
60 | 3 spaces dst.dump.type | |
61 | THEN | |
62 | ; | |
63 | ||
64 | VARIABLE DS-ADDR | |
65 | : DUMP.STRUCT ( addr-data addr-structure -- ) | |
66 | >newline swap >r ( -- as , save addr-data for dumping ) | |
67 | \ dup cell+ @ over + \ JForth | |
68 | dup code> >name swap cell+ @ over + \ HForth | |
69 | stack.nfas ( fill stack with nfas of members ) | |
70 | BEGIN | |
71 | dup | |
72 | WHILE ( continue until non-zero ) | |
73 | dup name> >body r@ swap dump.member | |
74 | bl 18 emit-to-column id. cr | |
75 | ?pause | |
76 | REPEAT drop rdrop | |
77 | ; | |
78 | ||
79 | : DST ( addr <name> -- , dump contents of structure ) | |
80 | ob.findit | |
81 | state @ | |
82 | IF [compile] literal compile dump.struct | |
83 | ELSE dump.struct | |
84 | THEN | |
85 | ; immediate | |
86 | ||
87 | : ADST ( absolute_address -- , dump structure ) | |
88 | use->rel [compile] dst \ mod 090609 | |
89 | ; immediate | |
90 | ||
91 | \ For Testing Purposes | |
92 | false [IF] | |
93 | :STRUCT GOO | |
94 | LONG DATAPTR | |
95 | SHORT GOO_WIDTH | |
96 | USHORT GOO_HEIGHT | |
97 | ;STRUCT | |
98 | ||
99 | :STRUCT FOO | |
100 | LONG ALONG1 | |
101 | STRUCT GOO AGOO | |
102 | SHORT ASHORT1 | |
103 | BYTE ABYTE | |
104 | BYTE ABYTE2 | |
105 | ;STRUCT | |
106 | ||
107 | FOO AFOO | |
108 | : AFOO.INIT | |
109 | $ 12345678 afoo s! along1 | |
110 | $ -665 afoo s! ashort1 | |
111 | $ 21 afoo s! abyte | |
112 | $ 43 afoo s! abyte2 | |
113 | -234 afoo .. agoo s! goo_height | |
114 | ; | |
115 | afoo.init | |
116 | ||
117 | : TDS ( afoo -- ) | |
118 | dst foo | |
119 | ; | |
120 | ||
121 | [THEN] | |
122 |