/fth/utils/dump_struct.fth
https://github.com/philburk/pforth · Forth · 122 lines · 107 code · 15 blank · 0 comment · 0 complexity · 448692ea6aa49e03507ee6bd4a395d1d MD5 · raw file
- \ @(#) 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.fth
- include? 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 Purposes
- false [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]