! ---------------------------------------------------------------------------- !
! 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;
! ---------------------------------------------------------------------------- !