! ---------------------------------------------------------------------------- !
!   Dump.h
!       revised  1.1  Apr00 by Roger Firth ([email protected])
!       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;
! ---------------------------------------------------------------------------- !