\ @(#) dump_struct.fth 97/12/10 1.1\ Dump contents of structure showing values and member names.\\ Author: Phil Burk\ Copyright 1987 Phil Burk\ All Rights Reserved.\\ MOD: PLB 9/4/88 Print size too.\ MOD: PLB 9/9/88 Print U/S , add ADST\ MOD: PLB 12/6/90 Modified to work with H4th\ 941109 PLB Converted to pforth.  Added RP detection.\ 090609 PLB Convert >rel to use->rel and ..! to s! include? task-member.fth member.fthinclude? task-c_struct c_struct.fth ANEW TASK-DUMP_STRUCT : EMIT-TO-COLUMN ( char col -- )    out @ - 0 max 80 min 0    DO  dup emit    LOOP drop; VARIABLE SN-FENCE: STACK.NFAS  ( fencenfa topnfa -- 0 nfa0 nfa1 ... )\ Fill stack with nfas of words until fence hit.    >r sn-fence !    0 r>  ( set terminator )    BEGIN ( -- 0 n0 n1 ... top )      dup sn-fence @ >    WHILE\      dup n>link @   \ JForth       dup prevname   \ HForth    REPEAT    drop; : DST.DUMP.TYPE  ( +-size -- , dump data type, 941109)    dup abs 4 =    IF        0<        IF ." RP"        ELSE ." U4"        THEN    ELSE        dup 0<            IF ascii U            ELSE ascii S            THEN emit abs 1 .r    THEN; : DUMP.MEMBER ( addr member-pfa -- , dump member of structure)    ob.stats  ( -- addr offset size )    >r + r> ( -- addr' size )    dup ABS 4 >  ( -- addr' size flag )    IF   cr 2dup swap . . ABS dump    ELSE tuck @bytes 10 .r ( -- size )        3 spaces dst.dump.type    THEN; VARIABLE DS-ADDR: DUMP.STRUCT ( addr-data addr-structure -- )    >newline swap >r  ( -- as , save addr-data for dumping )\    dup cell+ @ over +  \ JForth    dup code> >name swap cell+ @ over +   \ HForth    stack.nfas   ( fill stack with nfas of members )    BEGIN        dup    WHILE   ( continue until non-zero )        dup name> >body r@ swap dump.member        bl 18 emit-to-column id. cr        ?pause    REPEAT drop rdrop; : DST ( addr <name> -- , dump contents of structure )    ob.findit    state @    IF [compile] literal compile dump.struct    ELSE dump.struct    THEN; immediate : ADST ( absolute_address -- , dump structure )    use->rel [compile] dst     \ mod 090609; immediate \ For Testing Purposesfalse [IF]:STRUCT GOO    LONG DATAPTR    SHORT GOO_WIDTH    USHORT GOO_HEIGHT;STRUCT :STRUCT FOO    LONG ALONG1    STRUCT GOO AGOO    SHORT ASHORT1    BYTE ABYTE    BYTE ABYTE2;STRUCT FOO AFOO: AFOO.INIT    $ 12345678 afoo s! along1    $ -665 afoo s! ashort1    $ 21 afoo s! abyte    $ 43 afoo s! abyte2    -234 afoo .. agoo s! goo_height;afoo.init : TDS ( afoo -- )    dst foo; [THEN]