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