Add -m32 and -x c to Makefile for 64-bit Snow Leopard.

[pforth] / fth / utils / dump_struct.fth

\ @(#) 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