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