! ---------------------------------------------------------------------------- !
!   Dump.h
!       revised  1.1  Apr00 by Roger Firth (roger.firth@tesco.net)
!       revised  1.0  Mar00
!       revised  0.91 Apr99
!       original 0.9  Apr99
!
! ---------------------------------------------------------------------------- !
!   Installation: for the basic package, add the line:
!
!       Include "Dump";
!
!   anywhere in your game AFTER the Include "VerbLib" statement. To include the
!   dump extensions, define the constant DUMP just before it:
!
!       Constant DUMP;
!       Include "Dump";
!
! ---------------------------------------------------------------------------- !
!   Basic package: implements the debugging verbs DUMP and IS.
!
!   DUMP [MAP]
!       displays a summary map of dynamic and static memory.
!
!   DUMP from_addr to_addr
!       (from_addr < to_addr) displays the hexadecimal contents of dynamic
!       and static memory from the first address to the second address.
!
!   DUMP from_addr length
!       (from_addr > length) displays the contents of memory
!       from the address for the specified length.
!
!   DUMP from_addr
!       displays the contents around the specified address.
!
!   IS number
!       suggests what the number might be. This feature is also available
!       as a debugging routine:
!       ...; is(number); ...;
!       print ..., (is) number, ...;
!
! ---------------------------------------------------------------------------- !
!   Dump extensions: implements additional dump syntax.
!
!   DUMP ALL
!       displays a complete map of dynamic and static memory.
!
!   DUMP {HEADER|STRPOOL|LOWSTR|ABBREV|HEXTN|ALPHA|UCODE|PDEFS|OBJECTS|
!           CPROPS|CLASSES|IDENTS|ANAMES|IPROPS|GLOBALS|ARRAYS|GRAMMAR|
!           ACTIONS|PREACTIONS|ADJECT|DICT|ZCODE|STRINGS}
!       displays one section of the map.
!
! ---------------------------------------------------------------------------- !
!   Notes
!
!   DUMP is currently able to handle only version 5 and version 8 games.
!   Also, it cannot decode version 1 of the grammar tables (GV1), and so
!   expects the GV2 found in Library 6/3 (and later).
!
!   Because the function runs within the Z-machine environment, it is
!   subject to the rules which prevent direct access to high (virtual) memory.
!   Only the contents of dynamic and static memory are displayable.
!
!   Addresses are rounded down/up to the next multiple of sixteen.
!   Numeric values may be given in decimal (nnnn), hexadecimal ($nnnn)
!   or binary ($$nnnn) notation.
!
! ---------------------------------------------------------------------------- !
#ifdef DEBUG;
message "Compiling Dump.h (basic)";

[ DumpMapSub;
        if (false) { dd(); ddd(); waddr(); }    ! Avoid compiler warnings.
        if (#version_number ~= 5 && #version_number ~= 8)
            "Sorry - only versions 5 and 8 supported.";
        font off;
        print "------  DYNAMIC (read/write)    ^";
        print (baddr) $0000, ":  Header:                 $0000^";
        print (baddr) $0040, ":  String pool:            $0040^";
        print (baddr) $0018-->0, ":  32 Low strings:         $0018-->0^";
        print (baddr) ($0018-->0)+64, ":  64 Abbreviations:       ($0018-->0)+64^";
        print (baddr) $0036-->0, ":  Header extension:       $0036-->0^";
        print (baddr) $0034-->0, ":  Alphabet:               $0034-->0^";
        print (baddr) (($0036-->0)+6)-->0, ":  UniCode:                (($0036-->0)+6)-->0^";
        print (baddr) $000A-->0, ":  Property defaults:      $000A-->0^";
        print (baddr) ($000A-->0)+126, ":  Object tree:            ($000A-->0)+126^";
        print (baddr) #cpv__start, ":  Common properties:      #cpv__start^";
        print (baddr) #classes_table, ":  Class numbers:          #classes_tables^";
        print (baddr) #identifiers_table, ":  Identifier names:       #identifiers_table^";
        print (baddr) #array_names_offset, ":  Array names:            #array_names_offset^";
        print (baddr) #ipv__start, ":  Individual properties:  #ipv__start^";
        print (baddr) $000C-->0, ":  Global variables:       $000C-->0^";
        print (baddr) #array__start, ":  Arrays:                 #array__start^";
        print (baddr) $002E-->0, ":  Terminating chars:      $002E-->0^";
        print "------  STATIC (read only)      ^";
        print (baddr) $000E-->0, ":  Grammars:               $000E-->0^";
        print (baddr) #actions_table, ":  Action pointers:        #actions_table^";
        print (baddr) #preactions_table, ":  Preactions (not used):  #preactions_table^";
        print (baddr) #adjectives_table, ":  Adjectives (not used):  #adjectives_table^";
        print (baddr) $0008-->0, ":  Dictionary:             $0008-->0^";
        print "------  HIGH (no read/write)    $0004-->0^";
        print (baddr) #readable_memory_offset, ":  First unreadable byte:  #readable_memory_offset^";
        print (baddr) $0006-->0, ":  Initial PC:             $0006-->0^";
        print (paddr) #code_offset, ":  Zcode:                  #code_offset (packed)^";
        print (paddr) #strings_offset, ":  Static strings:         #strings_offset (packed)^";
        print (paddr) $001A-->0, ":  Top of memory           $001A-->0 (packed)^";
        font on;
        ];

[ DumpHexSub
        i j k m;
        i = (noun / $10) * $10;
        if (second) j = second; else j = noun;
        if (UnsignedCompare(j,i) < 0) j = i + j;
        j = ((j + $10) / $10) * $10;
        font off;
        for ( : i<j : i=i+$10) {
            print (baddr) i, ":  ";
            for (k=i : k<i+16 : k=k+4) {
                for (m=0 : m<4 : m++)
                    if (UnsignedCompare(k+m, $0004-->0) < 0) print (hchar) 0->(k+m); else print "xx";
                print " ";
                }
            new_line;
            }
        font on;
        ];

[ DumpValueSub; is(noun,true); ];

[ Is x y
    i j;
        if (~~y) print "************************************^";
        print "** This number: ", x, " $", (hex) x, " $$", (bin) x, "^";
        if (UnsignedCompare(x,#actual_largest_object+1) < 0 && ~~UnsignedCompare(x,1) < 0)
            print "**   Might be an object:    ", (object) x, "^";
        if (UnsignedCompare(x,48) < 0)
            print "**   Might be an attribute: ", (debugAttribute) x, "^";
        if (UnsignedCompare(x,64) < 0)
            print "**   Might be a property:   ", (property) x, "^";
        if (UnsignedCompare(x,(#preactions_table-#actions_table)/2) < 0)
            print "**   Might be an action:    ", (debugAction) x, "^";
        if (UnsignedCompare(x,$000E-->0) < 0)
            print "**   Might be a read/write memory address containing: ", x-->0, " $", (hex) x-->0, " $$", (bin) x-->0, "^";
        if (UnsignedCompare(x,#readable_memory_offset) < 0 && ~~UnsignedCompare(x,$000E-->0) < 0) {
            print "**   Might be a read-only memory address containing: ", x-->0, " $", (hex) x-->0, " $$", (bin) x-->0, "^";
            if (UnsignedCompare(x,$0004-->0) < 0 && ~~UnsignedCompare(x,$0008-->0) < 0) {
                i = $0008-->0; i = i + (i->0) + 2; j = i-->0; i = i + 2;
                while (j--) switch (UnsignedCompare(i,x)) {
                    -1: i = i + 9;
                     0: print "**   which is dictionary word: '", (address) i, "'.^"; jump NotInDict;
                     1: jump NotInDict;
                    }
                }
                .NotInDict;
            }
        if (UnsignedCompare(x,#strings_offset) < 0 && ~~UnsignedCompare(x,#code_offset) < 0)
            print "**   Might be a packed routine address $", (paddr) x, ".^";
        if (UnsignedCompare(x,$001A-->0) < 0 && ~~UnsignedCompare(x,#strings_offset) < 0)
            print "**   Might be a packed string address $", (paddr) x, ": ~", (string) x, "~.^";
        if (~~y) print "************************************^";
        ];

[ baddr x; print "0", (hex) x; ];

[ waddr x; print "0", (hex) x*2; ];

[ paddr x y;
        switch (#version_number) {
            1,2,3:  print (hdigit) ((x & $8000) / $8000) & $0001, (hex) (x & $7FFF) * $0002;
            4,5,6,7:print (hdigit) ((x & $C000) / $4000) & $0003, (hex) (x & $3FFF) * $0004;
                    if (#version_number == 6 or 7)
                        print "+", (hex) y*8;
            8:      print (hdigit) ((x & $E000) / $2000) & $0007, (hex) (x & $1FFF) * $0008;
            }
        ];

[ hex x; print (hchar) (x & $FF00) / $100, (hchar) x & $00FF; ];

[ hchar x; print (hdigit) (x & $00F0) /$10, (hdigit) x & $000F; ];

[ hdigit x; if ((x = x%$10) < 10) print x; else print (char) x-10+'A'; ];

[ dd x; if (x<10) print "0"; print x; ];

[ ddd x; if (x<10) print "0"; if (x<100) print "0"; print x; ];

[ bin x i; for (i=16 : i>0 : i--) { if (x < 0) print "1"; else print "0"; x = x + x; } ];

[ MultiNumber
        addr size char base i;
        if (NextWordStopped() == -1) return 0;
        base = 10; parsed_number = 0;
        addr = WordAddress(wn-1);
        size = WordLength(wn-1);
        i = 0;
        if (addr->i == '-') i++;
        if (addr->i == '$') {
            base = 16; i++;
            if (addr->i == '$') { base = 2; i++; }
            }
        for ( : i<size : i++) {
            char = addr->i;
            if (char >= '0' && char <= '9') char = char - '0';
            else {
                if (char >= 'A' && char <= 'Z') char = char - 'A' + 10;
                else {
                    if (char >= 'a' && char <= 'z') char = char - 'a' + 10;
                    else return -1;
                    }
                }
            if (char < base) parsed_number = (parsed_number * base) + char;
            else return -1;
            }
        if (addr->0 == '-') parsed_number = -parsed_number;
        return 1;
        ];

! ---------------------------------------------------------------------------- !
Verb meta 'dump'
        *                           -> DumpMap
        * 'map'                     -> DumpMap
        * MultiNumber               -> DumpHex
        * MultiNumber MultiNumber   -> DumpHex;

Verb meta 'is'
        * MultiNumber               -> DumpValue;

! ---------------------------------------------------------------------------- !
#ifdef DUMP;
message "Compiling Dump.h (extensions)";

[ DumpGameSub x;
    if (#version_number ~= 5 && #version_number ~= 8)
        "Sorry - only versions 5 and 8 supported.";
    wn--; x = NextWord();
    font off;
    if (x == 'all') print "================= DYNAMIC MEMORY (read/write) ==================";
    if (x == 'all' or 'header')     DumpHeader();
    if (x == 'all' or 'strpool')    DumpStringPool();
    if (x == 'all' or 'lowstr')     DumpLowStrings();
    if (x == 'all' or 'abbrev')     DumpAbbreviations();
    if (x == 'all' or 'hextn')      DumpHeaderExtn();
    if (x == 'all' or 'alpha')      DumpAlphabet();
    if (x == 'all' or 'ucode')      DumpUnicode();
    if (x == 'all' or 'pdefs')      DumpPropertyDefaults();
    if (x == 'all' or 'objects')    DumpObjectTree();
    if (x == 'all' or 'cprops')     DumpCommonProperties();
    if (x == 'all' or 'classes')    DumpClassNumbers();
    if (x == 'all' or 'idents')     DumpIdentifierNames();
    if (x == 'all' or 'anames')     DumpArrayNames();
    if (x == 'all' or 'iprops')     DumpIndivProperties();
    if (x == 'all' or 'globals')    DumpGlobalVariables();
    if (x == 'all' or 'arrays')     DumpArrays();
    if (x == 'all') print "^^================== STATIC MEMORY (read only) ===================";
    if (x == 'all' or 'grammar')    DumpGrammar();
    if (x == 'all' or 'actions')    DumpActions();
    if (x == 'all' or 'preactions') DumpPreactions();
    if (x == 'all' or 'adject')     DumpAdjectives();
    if (x == 'all' or 'dict')       DumpDictionary();
    if (x == 'all') print "^^============= VIRTUAL/HIGH MEMORY (no read/write) ==============";
    if (x == 'all' or 'zcode')      DumpZcode();
    if (x == 'all' or 'strings')    DumpStrings();
    if (x == 'all') print "^^======================== END OF MEMORY =========================^";
    font on;
    ];

! ---------------------------------------------------------------------------- !

[ DumpHeader
    i;
    print "^^------------  Header";
    PrintMem(0,$0000,1); print "Z-machine version";
    i = PrintMem(0,$0001,1); print "Interpreter flags: ";
        if (i & $80) print "timed_keys/";
        if (i & $40) print "BIT_6/";
        if (i & $20) print "sound/";
        if (i & $10) print "fixed_pitch/";
        if (i & $08) print "italic/";
        if (i & $04) print "bold/";
        if (i & $02) print "graphic/";
        if (i & $01) print "colour";
    PrintMem(0,$0002,2); print "Game release";
    PrintMem(0,$0004,3); print "==>High memory";
    PrintMem(0,$0006,3); print "==>Initial PC";
    PrintMem(0,$0008,3); print "==>Dictionary";
    PrintMem(0,$000A,3); print "==>Objects";
    PrintMem(0,$000C,3); print "==>Global variables";
    PrintMem(0,$000E,3); print "==>Static memory";
    i = PrintMem(0,$0010,2); print "Game flags: ";
        if (i & $8000) print "BIT_F/";
        if (i & $4000) print "BIT_E/";
        if (i & $2000) print "BIT_D/";
        if (i & $1000) print "BIT_C/";
        if (i & $0800) print "BIT_B/";
        if (i & $0400) print "print_error/";
        if (i & $0200) print "BIT_9/";
        if (i & $0100) print "menu/";
        if (i & $0080) print "sound/";
        if (i & $0040) print "colour/";
        if (i & $0020) print "mouse/";
        if (i & $0010) print "undo/";
        if (i & $0008) print "graphic/";
        if (i & $0004) print "BIT_2/";
        if (i & $0002) print "fixed_pitch/";
        if (i & $0001) print "transcripting";
    PrintMem(0,$0012,6,6); print "Game serial";
    PrintMem(0,$0018,3); print "==>Abbreviations";
    PrintMem(0,$001A,5); print "Length";
    PrintMem(0,$001C,2); print "Checksum";
    i = PrintMem(0,$001E,1); print "Interpreter: ";
        switch(i) {
        1:  print "DECSystem-20";
        2:  print "Apple IIe";
        3:  print "Macintosh";
        4:  print "Amiga";
        5:  print "Atari ST";
        6:  print "IBM PC";
        7:  print "Commodore 128";
        8:  print "Commodore 64";
        9:  print "Apple IIc";
        10: print "Apple IIgs";
        11: print "Tandy Color";
        default: print "unknown";
        }
    PrintMem(0,$001F,6,1); print "   Interpreter version";
    PrintMem(0,$0020,1); print "Screen height (lines)";
    PrintMem(0,$0021,1); print "Screen width (chars)";
    PrintMem(0,$0022,2); print "Screen height (units)";
    PrintMem(0,$0024,2); print "Screen width (units)";
    PrintMem(0,$0026,1); print "Font width (units)";
    PrintMem(0,$0027,1); print "Font height (units)";
    PrintMem(0,$0028,2); print "Routines offset / 8";
    PrintMem(0,$002A,2); print "Strings offset / 8";
    PrintMem(0,$002C,1); print "Background colour";
    PrintMem(0,$002D,1); print "Foreground colour";
    PrintMem(0,$002E,3); print "==>Terminating chars";
    PrintMem(0,$0030,2); print "Pixels to stream 3";
    PrintMem(0,$0032,1,2); print "Interpreter conformance";
    PrintMem(0,$0034,3); print "==>Alphabet";
    PrintMem(0,$0036,3); print "==>Header extension";
    PrintMem(0,$0038,2); print "-";
    PrintMem(0,$003A,2); print "-";
    PrintMem(0,$003C,6,4); print "Inform version";
    ];

[ DumpStringPool
    a;
    print "^^------------  String pool";
    a = $0040;
    while (a<($0018-->0)) {
        PrintMem(0,a,7);
        while (~~(a-->0 & $8000))
            a = a + 2;
        a = a + 2;
        }
    ];

[ DumpLowStrings
    i j;
    print "^^------------  32 Low strings";
    j = 0;
    for (i=0 : i<31 : i++)
        j = PrintLowStr(($0018-->0)+i+i,i,j);
    PrintLowStr(($0018-->0)+i+i,i,0);
    ];

[ DumpAbbreviations
    i j;
    print "^^------------  64 Abbreviations";
    j = 0;
    for (i=0 : i<63 : i++)
        j = PrintLowStr(($0018-->0)+64+i+i,i,j);
    PrintLowStr(($0018-->0)+64+i+i,i,0);
    ];

[ DumpHeaderExtn;
    print "^^------------  Header extension";
    PrintMem(0,($0036-->0)+0,2); print "Header extension count";
    PrintMem(0,($0036-->0)+2,2); print "Mouse X coordinates";
    PrintMem(0,($0036-->0)+4,2); print "Mouse Y coordinates";
    PrintMem(0,($0036-->0)+6,3); print "==>Unicode";
    ];

[ DumpAlphabet;
    print "^^------------  Alphabet";
    if ($0034-->0) {
        PrintMem(0,($0034-->0)+0,6,26);
        PrintMem(0,($0034-->0)+26,6,26);
        PrintMem(0,($0034-->0)+52,6,26);
        }
    else
        print "^default";
    ];

[ DumpUnicode
    a i;
    print "^^------------  Unicode";
    a = (($0036-->0)+6)-->0;
    if (a) {
        i = PrintMem(0,a++,1);
        while (i--) {
            PrintMem(0,a,2); a = a + 2;
            }
        }
    else
        print "^default";
    ];

[ DumpPropertyDefaults
    i;
    print "^^------------  Property default values";
    for (i=1 : i<64 : i++) {
        PrintMem(0,($000A-->0)-2+i+i,2); PrintPropertyName(i);
        }
    ];

[ DumpObjectTree
    a b i;
    print "^^------------  Object tree";
    a = ($000A-->0)+126;
    for (i=1 : a<#cpv__start : i++) {
        PrintMem(0,a,1,6); print "attrs 0..47 for "; PrintObjectName(i);
        PrintAttributeList(a); a = a + 6;
        b = PrintMem(0,a,2); print "parnt: "; PrintObjectName(b); a = a + 2;
        b = PrintMem(0,a,2); print "sblng: "; PrintObjectName(b); a = a + 2;
        b = PrintMem(0,a,2); print "child: "; PrintObjectName(b); a = a + 2;
        b = PrintMem(0,a,3); print "       shortname, common properties..."; a = a + 2;
        b = PrintPropertyList(b + 1 + (b->0)*2);
!!      if (i<5 || (a-8)-->0==1) {
        if (metaclass(i) == 1) {
            print "       -----  inheritance data for instances of class";
            PrintMem(7,b,1,6); print "attrs 0..47";
            PrintAttributeList(b);
            b = PrintPropertyList(b + 6);
            }
        }
    ];

[ DumpCommonProperties;
    print "^------------  Common property tables (details in Object tree)";
    PrintMem(0,#cpv__start,2);
    print "^. . .";
    PrintMem(0,#cpv__end-2,2);
    ];

[ DumpClassNumbers
    i j;
    print "^^------------  Class numbers";
    for (i=0 : : i++) {
        j = PrintMem(0,#classes_table+i+i,2);
        if (j) {
            print "class[", i, "] maps to "; PrintObjectName(j);
            }
        else {
            print "EOL";
            break;
            }
        }
    ];

[ DumpIdentifierNames
    i j;
    print "^^------------  Identifier names";
    PrintMem(0,#identifiers_table,2); print "property count";
    for (i=1: #identifiers_table+i+i<#array_names_offset : i++) {
        j = PrintMem(0,#identifiers_table+i+i,5);
        if (j)
            print "ident[", i, "]=", (string) j;
        }
    ];

[ DumpArrayNames
    i j;
    print "^^------------  Array names";
    for (i=0: #array_names_offset+i+i<#ipv__start : i++) {
        j = PrintMem(0,#array_names_offset+i+i,5); print "array[", i, "]=", (string) j;
        }
    ];

[ DumpIndivProperties;
    print "^^------------  Individual property tables (details in Object tree)";
    PrintMem(0,#ipv__start,2);
    print "^. . .";
    PrintMem(0,#ipv__end-2,2);
    ];

[ DumpGlobalVariables
    i j;
    print "^^------------  Global variables";
    for (i=0 : i<240 : i++) {
        j = PrintMem(0,($000C-->0)+i+i,2); print "var[", i+$10, "]=", j;
        }
    ];

[ DumpArrays;
    print "^^------------  Arrays (no further info available)";
    PrintMem(0,#array__start,2);
    print "^. . .";
    PrintMem(0,#array__end-2,2);
    ];

[ DumpGrammar
    i j k m n;
    print "^^------------  Grammar pointers";
    i = 255;
    for (j=($000E-->0) : j<(($000E-->0)-->0) : j=j+2) {
        k = PrintMem(0,j,3); print "grammar[", (ddd) i--, "]";
        m = PrintMem(7,k++,1);
        while (m--) {
            n = PrintMem(7,k,2); PrintActionName(n & $03FF); k = k + 2;
            if (n & $0400)
                print " (swap args)";
            n = k;  !! remember address
            while (k->0 ~= 15) {
                if (k->0 & $0010) print "/"; else print " ";
                switch (k->0 & $000F) {
                    1:  switch ((k+1)-->0) {
                            0:  print "noun";
                            1:  print "held";
                            2:  print "multi";
                            3:  print "multiheld";
                            4:  print "multiexcept";
                            5:  print "multiinside";
                            6:  print "creature";
                            7:  print "special";
                            8:  print "number";
                            9:  print "topic";
                            default:
                                print "bad token type";
                            }
                    2:  print "'", (address) (k+1)-->0, "'";
                    3:  print "noun="; PrintRoutineName((k+1)-->0);
                    4:  print (DebugAttribute) (k+1)-->0;
                    5:  print "scope="; PrintRoutineName((k+1)-->0);
                    6:  PrintRoutineName((k+1)-->0);
                    default:
                        print "bad token";
                    }
                k = k + 3;
                }
            k++;
            PrintMem(7,n,1,k-n);
            }
        new_line;
        }

    print "^^------------  Grammars (details in Grammar pointers)";
    PrintMem(0,j,2);
    print "^. . .";
    PrintMem(0,#actions_table-2,2);
    ];

[ DumpActions
    i j;
    print "^^------------  Action pointers";
    for (i=0 : #actions_table+i+i<#preactions_table : i++) {
        j = PrintMem(0,#actions_table+i+i,3); PrintActionName(i);
        print " calls "; PrintRoutineName(j);
        }
    ];

[ DumpPreactions;
    print "^^------------  Preactions (none)";
    PrintMem(0,#preactions_table,2);
    ];

[ DumpAdjectives;
    print "^^------------  Adjectives (none)";
    PrintMem(0,#adjectives_table,2);
    ];

[ DumpDictionary
    i j k m n;
    print "^^------------  Dictionary";
    i = $0008-->0;
    j = PrintMem(0,i++,1); print "separator count";
    PrintMem(0,i,6,j); print "separators"; i = i + j;
    PrintMem(0,i++,1); print "entry length";
    j = PrintMem(0,i,2); print "entry count^"; i = i + 2;
    while (j--) {
        PrintMem(0,i,7); i = i + 6;
        k = PrintMem(0,i++,1); print "   flags: ";
        if (~~k) print "none";
        else {
            if (k & $80) print "noun/";
            if (k & $40) print "BIT_6/";
            if (k & $20) print "BIT_5/";
            if (k & $10) print "BIT_4/";
            if (k & $08) print "preposition/";
            if (k & $04) print "plural/";
            if (k & $02) print "meta/";
            if (k & $01) print "verb";
            }
        m = PrintMem(0,i,1,2); i = i + 2;
        n = ($000E-->0)-->(255-m);
        if (k & $01)
            print "grammar[", (ddd) m, "]==>", (baddr) n;
        }
    ];

[ DumpZcode;
    print "^^------------  Zcode (unable to display)^";
    print (paddr) #code_offset, ":  ";
    print "^. . .^";
    print (paddr) #strings_offset, ":  ";
    ];

[ DumpStrings;
    print "^^------------  Strings (unable to display)^";
    print (paddr) #strings_offset, ":  ";
    print "^. . .^";
    print (paddr) $001A-->0, ":  ";
    ];

! ---------------------------------------------------------------------------- !

[ PrintAttributeList x
    i j k;
    for (i=0 : i<48 : i++) {
        j = 7 - (i % 8);
        k = 1;
        while (j--)
            k = k + k;
        if ((x->(i/8)) & k) {
            new_line; spaces 21; PrintAttributeName(i);
            }
        }
    ];

[ PrintPropertyList x
    i j k;
    while (true) {
        i = PrintMem(7,x++,1);
        if (~~i) {
            print "EOL^";
            return x;
            }
        j = i & $3F;
        PrintPropertyName(j);
        switch (j) {
            1:  print ":";
                if (i & $80) {
                    k = x + 1;
                    i = (x->0) & $3F; if (~~i) i = 64;
                    for ( : i>0 : i=i-2) {
                        print " '", (address) k-->0, "'";
                        k = k + 2;
                        }
                    i = (x->0) & $3F; if (~~i) i = 64;
                    PrintMem(7,x,1,++i);
                    }
                else {
                    print " '", (address) x-->0, "'";
                    PrintMem(7,x,2);
                    i = 2;
                    }
            2:  if (i & $80) {
                    k = x + 1;
                    i = (x->0) & $3F; if (~~i) i = 64;
                    for ( : i>0 : i=i-2) {
                        PrintMem(7,k,2);
                        print "     "; PrintObjectName(k-->0);
                        k = k + 2;
                        }
                    i = (x->0) & $3F; if (~~i) i = 64;
                    i++;
                    }
                else {
                    PrintMem(7,x,2);
                    print "     "; PrintObjectName(x-->0);
                    i = 2;
                    }
            3:  PrintMem(7,x,3); i = 2;
                print "individual properties...";
                PrintIndivPropList(x-->0);
            default:
                if (i & $80) {
                    i = (x->0) & $3F; if (~~i) i = 64;
                    PrintMem(7,x,1,++i);
                    }
                else {
                    if (i & $40) {
                        PrintMem(7,x,2);
                        i = x-->0;
                        switch (ZRegionPlus(i)) {
                            1:  print "     "; PrintObjectName(i);
                            2:  print "     "; PrintRoutinename(i);
                            3:  print "     ~", (string) i, "~";
                            }
                        i = 2;
                        }
                    else {
                        PrintMem(7,x,1); i = 1;
                        }
                    }
            }
        x = x + i;
        }
    ];

[ PrintIndivPropList x
    i;
    while (true) {
        i = PrintMem(14,x,2); x = x + 2;
        if (~~i) {
            print "EOL";
            return x;
            }
        PrintPropertyName(i & $7FFF);
        if (i & $8000)
            print " (private)";
        i = x->0;
        PrintMem(14,x,1,++i); x = x + i;
        }
    ];

[ PrintObjectName x;
    if (x)
        print "obj[", x, "]=", (object) x;
    else
        print "obj[0]=Nothing";
    ];

[ PrintAttributeName x;
    print "attr[", (dd) x, "]=", (DebugAttribute) x;
    ];

[ PrintPropertyName x;
    print "prop[", (dd) x, "]=";
    switch (x) {
        2:  print "(ofclass)";
        3:  print "(metaclass)";
        default:
            print (property) x;
        }
    ];

[ PrintActionName x;
    print "action[", (ddd) x, "]=", (DebugAction) x;
    ];

[ PrintRoutineName x;
        print (paddr) x, "[ ... ]";
    ];

[ PrintLowStr x y z
    i;
    i = (x-->0) * 2;
    if (i == (z & $FFFE)) {
        if (~~(z & $0001)) {
            z = z | $0001;
            print "^. . .";
            }
        }
    else {
        z = i;
        PrintMem(0,x,4); print "str[", (dd) y, "]='", (address) i, "'";
        }
    return z;
    ];

[ PrintMem w x y z
    i j;
    new_line; spaces w;
    if (~~z) z = 1;
    print (baddr) x, ": ";
    switch (y) {
        0:  print " ";
            for (i=x : i<x+16 : i=i+4) {
                for (j=0 : j<4 : j++)
                    if (UnsignedCompare(i+j, $0004-->0) < 0) print (hchar) 0->(i+j); else print "xx";
                print " ";
                }
            print " ";
            return x;

        1:  print "   "; for (i=0 : i<z : i++) print (hchar) x->i, " "; print " ";
            return x->0;
        2:  print " "; for (i=0 : i<z : i++) print (hex) x-->i, " "; print " ";
            return x-->0;

        3:  print (baddr) x-->0, "  ";
            return x-->0;
        4:  print (waddr) x-->0, "  ";
            return x-->0;
        5:  print (paddr) x-->0, "  ";
            return x-->0;

        6:  print "~"; for (i=0 : i<z : i++) print (char) x->i; print "~ ";
            return x->0;
        7:  print "'", (address) x, "' ";
            return x-->0;
        default:
            return 0;
        }
    ];

[ ZRegionPlus addr; switch(metaclass(addr)) {
        nothing: return 0;
        Object, Class: return 1;
        Routine: return 2;
        String: if (UnsignedCompare(addr,$001A-->0) < 0) return 3; else return 0;
        } ];

! ---------------------------------------------------------------------------- !
Extend 'dump'
        * 'all'/'header'/'strpool'/'lowstr'/'abbrev'/'hextn'/'alpha'/'ucode'/
            'pdefs'/'objects'/'cprops'/'classes'/'idents'/'anames'/'iprops'/
            'globals'/'arrays'/'grammar'/'actions'/'preactions'/'adject'/
            'dict'/'zcode'/'strings'
                                    -> DumpGame;
#endif;

#endif;
! ---------------------------------------------------------------------------- !