X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/blobdiff_plain/a1f4e52df60d8f26327ed57f5a9e7b70d0a04273..8e9db35f299d8f606ba003d3cd8fa9e2c868c880:/fth/utils/dump_struct.fth

diff --git a/fth/utils/dump_struct.fth b/fth/utils/dump_struct.fth
index 39a32c0..5010e57 100644
--- a/fth/utils/dump_struct.fth
+++ b/fth/utils/dump_struct.fth
@@ -1,122 +1,122 @@
-\ @(#) 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]
-
+\ @(#) 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]
+