From: Jason Self Date: Sun, 2 Jun 2019 17:11:02 +0000 (-0700) Subject: Add INSPECTOR X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=c86e12139f119f157ac9e7b17e3fae8636e27e37;p=inform-resources.git Add INSPECTOR For poking around inside recent Inform game files From http://www.firthworks.com/roger/downloads/Inspect.zip --- diff --git a/inspect/Inspect.inf b/inspect/Inspect.inf new file mode 100644 index 0000000..81d191a --- /dev/null +++ b/inspect/Inspect.inf @@ -0,0 +1,2513 @@ +!% -GS +!% $MAX_STATIC_DATA=600000 +!% +! ================================================================================================= +! INSPECTOR -- examine Z-Machine files -- Roger Firth (roger@firthworks.com) +! +! V1.1 29Jan04 - removed misleading comment from generated XML +! V1.0 11Nov03 - first public release +! +! This program is strictly for the curious. It reads a compiled Inform 6 .z5 or .z8 game file +! and attempts to display its contents. +! +! The program is a standalone Glulx utility which does not used the Inform library files. +! To compile it, you will need to include on the command line: $MAX_STATIC_DATA=600000 +! and you will require the "infglk.h" header file. To run it, any Glulx interpreter should do. +! +! To make any sense of the XML data produced by the R command, you will require +! the Dia drawing program (http://www.lysator.liu.se/~alla/dia). Unix and Windows only. +! +! IMPORTANT NOTE: The program is much more restrictive than Ztools in the Z-Machine files that +! it will handle, and much less reliable. Its primary advantage is that, being written using +! the Inform language, it is readily amenable to being customized and extended. +! +! This program is copyright Roger Firth 2003-2004. Copying and distribution, with or without +! modification, are permitted in any medium without royalty provided the copyright notice and +! this notice are preserved. +! +! ================================================================================================= +! These arrays should be sufficient, but may need adjusting for an enormous game. + +Constant MAX_GAME 525000; ! For a 512K Z8 game. +Array theGame -> MAX_GAME; + +Constant MAX_ROUTINES 3000; ! Packed Routine addresses. +Array theRoutines --> MAX_ROUTINES; + +Constant MAX_STRINGS 5000; ! Packed String addresses. +Array theStrings --> MAX_STRINGS; + +Constant MAX_ROOMS 200; ! Rooms (for XML map). +Array theRooms --> MAX_ROOMS; + +Constant MAX_DIRPROPS 12; ! Exits from rooms (for XML map). +Array DirPropNums --> MAX_DIRPROPS; + +Array DirPropNames --> + "n_to" "s_to" "e_to" "w_to" + "ne_to" "sw_to" "nw_to" "se_to" + "u_to" "d_to" "in_to" "out_to"; + +Array NfromRoom --> MAX_ROOMS; +Array SfromRoom --> MAX_ROOMS; +Array EfromRoom --> MAX_ROOMS; +Array WfromRoom --> MAX_ROOMS; +Array NEfromRoom --> MAX_ROOMS; +Array SWfromRoom --> MAX_ROOMS; +Array NWfromRoom --> MAX_ROOMS; +Array SEfromRoom --> MAX_ROOMS; +Array UfromRoom --> MAX_ROOMS; +Array DfromRoom --> MAX_ROOMS; +Array INfromRoom --> MAX_ROOMS; +Array OUTfromRoom --> MAX_ROOMS; + +Array theExits --> ! Simulate a two-dimensional array. + NfromRoom SfromRoom EfromRoom WfromRoom + NEfromRoom SWfromRoom NWfromRoom SEfromRoom + UfromRoom DfromRoom INfromRoom OUTfromRoom; + +Constant MAX_DOORS 50; ! Doors (for XML map). +Array theDoors --> MAX_DOORS; + +Array doorToRoom --> MAX_DOORS; + +Constant MAX_INPUT 50; ! Line of keyboard input. +Array theInput -> MAX_INPUT; + +Constant MAX_TOKENS 3; ! Input tokens. +Array TokenStart -> MAX_TOKENS; +Array TokenEnd -> MAX_TOKENS; +Array Tokens --> MAX_TOKENS; ! Command, optional numbers. + +! ================================================================================================= +! Since we're not using the Glulx Inform library files, we need to set up our own Glk +! Input/Output. + +Include "infglk"; ! Use sensible names for calls to Glk. + +Array gg_arguments --> 8; ! General result passing. +Array gg_event --> 4; ! The event handler uses a four-word array. +Global gg_mainwin = 0; ! The main window. +Global gg_helpwin; ! For static help info. +Global gg_scriptfref = 0; ! Fileref for Transcripts. +Global gg_scriptstr = 0; ! I/O Stream for Transcripts. + +Constant ANY_OLD_ROCK 0; ! Rock values don't seem necessary here. + +! ================================================================================================= +! General constants used by the tool. + +Constant NO_GAME_OPEN "Use ~N~ to open a new .Z5 or .Z8 game file."; + +Constant MAX_LOCALS 15; ! First byte of a routine. +Constant STR_TRUNC_TO 20; ! Characters to show with @print_addr, @print_paddr + +Constant BIT00 $0001; +Constant BIT01 $0002; +Constant BIT02 $0004; +Constant BIT03 $0008; +Constant BIT04 $0010; +Constant BIT05 $0020; +Constant BIT06 $0040; +Constant BIT07 $0080; +Constant BIT08 $0100; +Constant BIT09 $0200; +Constant BIT10 $0400; +Constant BIT11 $0800; +Constant BIT12 $1000; +Constant BIT13 $2000; +Constant BIT14 $4000; +Constant BIT15 $8000; + +Constant BITS00_04 BIT00+BIT01+BIT02+BIT03+BIT04; +Constant BITS05_09 BIT05+BIT06+BIT07+BIT08+BIT09; +Constant BITS10_14 BIT10+BIT11+BIT12+BIT13+BIT14; + +Constant BITS00_03 BIT00+BIT01+BIT02+BIT03; +Constant BITS00_05 BITS00_04+BIT05; +Constant BITS00_09 BITS00_04+BITS05_09; +Constant BITS00_14 BITS00_09+BITS10_14; + +Constant HDR_ZCODEVERSION $00; ! byte +Constant HDR_TERPFLAGS $01; ! byte +Constant HDR_GAMERELEASE $02; ! word +Constant HDR_HIGHMEMORY $04; ! word +Constant HDR_INITIALPC $06; ! word +Constant HDR_DICTIONARY $08; ! word +Constant HDR_OBJECTS $0A; ! word +Constant HDR_GLOBALS $0C; ! word +Constant HDR_STATICMEMORY $0E; ! word +Constant HDR_GAMEFLAGS $10; ! word +Constant HDR_GAMESERIAL $12; ! six ASCII characters +Constant HDR_ABBREVIATIONS $18; ! word +Constant HDR_FILELENGTH $1A; ! word +Constant HDR_CHECKSUM $1C; ! word +Constant HDR_TERPNUMBER $1E; ! byte +Constant HDR_TERPVERSION $1F; ! byte +Constant HDR_SCREENHLINES $20; ! byte +Constant HDR_SCREENWCHARS $21; ! byte +Constant HDR_SCREENWUNITS $22; ! word +Constant HDR_SCREENHUNITS $24; ! word +Constant HDR_FONTWUNITS $26; ! byte +Constant HDR_FONTHUNITS $27; ! byte +Constant HDR_ROUTINEOFFSET $28; ! word +Constant HDR_STRINGOFFSET $2A; ! word +Constant HDR_BGCOLOUR $2C; ! byte +Constant HDR_FGCOLOUR $2D; ! byte +Constant HDR_TERMCHARS $2E; ! word +Constant HDR_PIXELSTO3 $30; ! word +Constant HDR_TERPSTANDARD $32; ! two bytes +Constant HDR_ALPHABET $34; ! word +Constant HDR_EXTENSION $36; ! word +Constant HDR_UNUSED $38; ! two words +Constant HDR_INFORMVERSION $3C; ! four ASCII characters +Constant HDR_ENDOFDATA $40; ! Next table starts here + +Constant HDREXTN_SIZE $00; ! word +Constant HDREXTN_MOUSEX $02; ! word +Constant HDREXTN_MOUSEY $04; ! word +Constant HDREXTN_UNICODE $06; ! word + +Array Bit --> ! Used to match Attribute bits. + BIT00 BIT01 BIT02 BIT03 BIT04 BIT05 BIT06 BIT07 BIT08 BIT09 BIT10 BIT11 BIT12 BIT13 BIT14 BIT15; + +Array a_LocalAlpha -> ! Used to unpack ZSCII strings. + 'a' 'b' 'c' 'd' 'e' 'f' 'g' 'h' 'i' 'j' 'k' 'l' 'm' 'n' 'o' 'p' 'q' 'r' 's' 't' 'u' 'v' 'w' 'x' 'y' 'z' + 'A' 'B' 'C' 'D' 'E' 'F' 'G' 'H' 'I' 'J' 'K' 'L' 'M' 'N' 'O' 'P' 'Q' 'R' 'S' 'T' 'U' 'V' 'W' 'X' 'Y' 'Z' + ' ' '^' '0' '1' '2' '3' '4' '5' '6' '7' '8' '9' '.' ',' '!' '?' '_' '#' 039 '"' '/' '\' '-' ':' '(' ')'; + +Array a_LocalUnicode -> ! Used to print 'extra' ZSCII characters. + 69 ! Number of 16-bit entries + $00 $E4 $00 $F6 $00 $FC $00 $C4 $00 $D6 $00 $DC $00 $DF $00 $BB + $00 $AB $00 $EB $00 $EF $00 $FF $00 $CB $00 $CF $00 $E1 $00 $E9 + $00 $ED $00 $F3 $00 $FA $00 $FD $00 $C1 $00 $C9 $00 $CD $00 $D3 + $00 $DA $00 $DD $00 $E0 $00 $E8 $00 $EC $00 $F2 $00 $F9 $00 $C0 + $00 $C8 $00 $CC $00 $D2 $00 $D9 $00 $E2 $00 $EA $00 $EE $00 $F4 + $00 $FB $00 $C2 $00 $CA $00 $CE $00 $D4 $00 $DB $00 $E5 $00 $C5 + $00 $F8 $00 $D8 $00 $E3 $00 $F1 $00 $F5 $00 $C3 $00 $D1 $00 $D5 + $00 $E6 $00 $C6 $00 $E7 $00 $C7 $00 $FE $00 $F0 $00 $DE $00 $D0 + $00 $A3 $01 $53 $01 $52 $00 $A1 $00 $BF; + +! ================================================================================================= +! Variables used by the tool. + +Global modePause = false; ! Pause after each screenful? +Global modeTranscript = false; ! Write a Transcript file? +Global modeExpand = false; ! Expand Property and Action Routines? + +Global currentState; ! Tool state: +Constant STATE_IDLE 0; ! No game open. +Constant STATE_DECODE 1; ! Analysing the game. +Constant STATE_DUMP 2; ! Displaying general game info. +Constant STATE_EMBED 3; ! Displaying embedded strings. + +Global stringOptions; ! Control string printing: +Constant STR_NO_SPACES BIT00; ! Map " " to "_". +Constant STR_NO_QUOTES BIT01; ! Map "'" to "^". +Constant STR_UPPERCASE BIT02; ! Fold alpha to upper case. +Constant STR_TRUNCATE BIT03; ! Show only start of strings. +Constant STR_MULTILINE BIT04; ! Map " " to newline. + +Global zcodeVersion; ! Z-Machine version 1-8 +Global informVersion; ! Compiler version 5-6 +Global p_Multiplier; ! Packed addr multiplier + +Global i_FirstUserObject; ! Obj number for (LibraryMessages) + +Global n_Actions; ! Number of Action routines +Global n_ArrayNames; ! Number of Array names +Global n_AttrNames; ! Number of Attribute names +Global n_Classes; ! Number of Classes +Global n_DictEntries; ! Number of Dictionary entries +Global n_Objects; ! Number of Objects (inc Classes) +Global n_Opcodes; ! Number of Opcodes +Global n_PropNames; ! Number of Property names +Global n_Rooms; ! Number of Rooms +Global n_Doors; ! Number of Doors +Global n_Routines; ! Number of Routines +Global n_Strings; ! Number of Strings +Global n_Verbs; ! Number of Verb grammars + +Global a_Header; ! ZM11 ZMxB +Global a_StringPool; ! TM8.3 +Global a_LowStrings; ! TM8.5 +Global a_Abbrevs; ! TM8.5 +Global a_HeaderExtn; ! TM8.5 +Global a_GameAlpha; ! ZM3.5 TM8.5 +Global a_GameUnicode; ! ZM3.8.5 TM8.3 TM8.5 +Global a_CommonPropDefaults; ! ZM12.2 +Global a_Objects; ! ZM12.3 TM9.4 +Global a_CommonProps; ! ZM12.4 +Global a_ClassToObject; ! TM9.4 +Global a_PropNames; ! TM9.7 +Global a_AttrNames; ! TM9.7 +Global a_ActionNames; ! TM9.7 +Global a_ArrayNames; ! TM9.7 +Global a_IndivProps; ! TM9.5 TM9.6 +Global a_Globals; ! +Global a_Arrays; ! +Global a_TermChars; ! + +Global a_StaticMemory; ! +Global a_GrammarPointers; ! TM8.6 +Global a_Grammars; ! +Global a_Actions; ! +Global a_PreActions; ! +Global a_Prepositions; ! +Global a_Dictionary; ! ZM13.1 TM8.5 + +Global a_HighMemory; ! +Global a_Routines; ! +Global a_TopOfRoutines; ! +Global a_Strings; ! +Global a_TopOfGame; ! + +Global p_Routines; ! ZM4 ZM5 ZM14 +Global p_Strings; ! ZM3 +Global p_TopOfGame; ! + +Global a_LookupAlpha; ! Local or embedded in game. +Global a_LookupUnicode; ! Local or embedded in game. + +! ================================================================================================= +! Instructions for use. + +[ ShowHelp; + "This tool inspects the contents of a Z-Machine game, in much the same way as + (and much slower and less reliably than) Ztools. + It is driven by these commands:^ + ^ + N - open a new game file.^ + Q - quit.^ + ^ + P - toggle Pause mode, which waits for a keypress after each screen.^ + T - toggle Transcript mode, which writes the output to a file.^ + X - toggle eXpanded mode, which shows Property and Action routines.^ + ^ + A - display All (Map, Header, Objects, Grammar).^ + D - display memory Dump in hex.^ + E - display print strings Embedded in Z-code.^ + G - display verb Grammar.^ + H - display Header information.^ + L - display Low-memory strings.^ + M - display Memory map.^ + O - display Objects [long].^ + R - display Rooms and connections in XML for Dia drawing tool [long].^ + S - display high-memory Strings [long].^ + V - display dictionary Vocabulary.^ + Z - display Z-code routines [long].^ + ^ + ? - display these instructions."; +]; + +[ ShowShortHelp; + "Start/stop: ", (b) "N", "ew, ", (b) "Q", "uit. Modes: ", (b) "P", "ause, ", (b) "T", "ranscript, e", (b) "X", "panded.^ + Dumping: ", (b) "O", "bjects, ", (b) "S", "trings, ", (b) "L", "ow strings, ", (b) "E", "mbedded strings, ", (b) "G", "rammar, ", + (b) "V", "ocabulary, ", (b) "H", "eader, ", (b) "M", "emory map, ", (b) "Z", "-code, ", (b) "R", "ooms, ", (b) "A", "ll"; +]; + + +[ b text; + glk_set_style(style_Emphasized); + print (string) text; + glk_set_style(style_Normal); +]; + +! ================================================================================================= +! This is the top-level control loop. + +[ Main; + + @setiosys 2 0; ! Set Glk as the VM's I/O layer. + gg_mainwin = ! Open the main window. + glk_window_open(0, 0, 0, wintype_TextBuffer, ANY_OLD_ROCK); + gg_helpwin = + glk_window_open(gg_mainwin, winmethod_Above+winmethod_Fixed, 3, wintype_TextBuffer, ANY_OLD_ROCK); + glk_set_window(gg_helpwin); + ShowShorthelp(); + glk_set_window(gg_mainwin); ! Make the main window the current window. + + glk_set_style(style_Header); + print "INSPECTOR"; + glk_set_style(style_Normal); + print "^A tool for examining v5 and v8 Z-code files created by Inform 6.^^"; + ShowHelp(); ! Explain what they can do. + + while (true) { ! Loop here until "Q" typed. + new_line; + if (modePause) print "P"; else print "-"; + if (modeTranscript) print "T"; else print "-"; + if (modeExpand) print "X"; else print "-"; + print "> "; ! Prompt for a line of input. + if (~~ParseLine()) continue; ! Nothing typed + Tokens-->0 = theInput->(TokenStart->0); + Tokens-->1 = ParseNumber(TokenStart->1, TokenEnd->1); + Tokens-->2 = ParseNumber(TokenStart->2, TokenEnd->2); + switch (Tokens-->0) { ! Deal with the character, then loop back. + 'A','a': if (~~currentState) print (string) NO_GAME_OPEN, "^"; + else { + DumpMemoryMap(); + DumpHeader(); + DumpObjects(); + DumpGrammar(); + } + 'D','d': DumpData(); + 'E','e': DumpEmbedded(); + 'G','g': DumpGrammar(); + 'H','h': DumpHeader(); + 'L','l': DumpLowStrings(); + 'M','m': DumpMemoryMap(); + 'N','n': DoOpen(); + 'O','o': DumpObjects(); + 'P','p': DoPause(); + 'Q','q': DoQuit(); + 'R','r': DumpRooms(); + 'S','s': DumpStrings(); + 'T','t': DoTranscript(); + 'V','v': DumpVocab(); + 'X','x': DoExpand(); + 'Z','z': DumpZcode(); + '?','/': ShowHelp(); + default: print "Possible keys are N, Q, P|T|X, A|D|E|G|H|L|M|O|R|S|V|Z and ?^"; + } + } +]; + +! [ InputChar; ! Input one keystroke. +! glk_request_char_event(gg_mainwin); +! while (true) { ! Wait for a key to be pressed. +! glk_select(gg_event); ! CharInput is th only interesting event. +! if (gg_event-->0 == evtype_CharInput && gg_event-->1 == gg_mainwin) +! return gg_event-->2; ! Got a character. +! } +! ]; + +[ InputLine buf buflen; ! Input a line of characters. + glk_request_line_event(gg_mainwin, buf, buflen, 0); + while (true) { ! Wait for RETURN to be pressed. + glk_select(gg_event); ! LineInput is the only interesting event. + if (gg_event-->0 == evtype_LineInput && gg_event-->1 == gg_mainwin) + return (gg_event-->2); ! Number of characters. + } +]; + +[ ParseLine ! Read line of input, find tokens + i j n; + for (i=0 : ii = TokenEnd->i = 0; + n = InputLine(theInput, MAX_INPUT); + glk_select_poll(gg_event); + if (n == 0) rfalse; ! Nothing typed. + for (i=j=0 : ij == ' ' or ',') { + j++; + if (j >= n) return i; + } + TokenStart->i = j; + while (theInput->j ~= ' ' or ',') { + j++; + TokenEnd->i = j; + if (j >= n) return i+1; + } + } + return i; +]; + +[ ParseNumber a b ! Parse token as bin/dec/hex number. + char base num i; + if (a == b) return -1; + base = 10; num = 0; + i = a; + if (theInput->i == '-') i++; + if (theInput->i == '$') { + base = 16; i++; + if (theInput->i == '$') { base = 2; i++; } + } + for ( : ii; + 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) num = (num * base) + char; + else return -1; + } + if (theInput->a == '-') num = -num; + return num; +]; + +! ================================================================================================= +! Quit from the utility. + +[ DoQuit; + print "Hit any key to exit.^"; quit; +]; + +! ================================================================================================= +! Toggle Pause mode. + +[ DoPause; + if (modePause) { ! Toggle to OFF. + modePause = false; + "Pause mode now off."; + } + else { ! Toggle to ON. + modePause = true; + "Pause mode now on."; + } +]; + +! ================================================================================================= +! Toggle Transcript mode. + +[ DoTranscript; + if (modeTranscript) { ! Toggle to OFF. + glk_stream_close(gg_scriptstr); ! Close the Transcript stream. + gg_scriptstr = 0; + modeTranscript = false; + "Transcript mode now off."; + } + else { ! Toggle to ON. + if (gg_scriptfref == 0) { + gg_scriptfref = ! Create a fileref for the Transcript. + glk_fileref_create_by_prompt(fileusage_TextMode+fileusage_Transcript, filemode_WriteAppend, ANY_OLD_ROCK); + if (gg_scriptfref == GLK_NULL) "Failed to create Transcript fileref."; + } + gg_scriptstr = ! Open a stream to write the transcript file. + glk_stream_open_file(gg_scriptfref, filemode_WriteAppend, ANY_OLD_ROCK); + if (gg_scriptstr == GLK_NULL) "failed to open Transcript stream."; + ! Echo everything to the Transcript. + glk_window_set_echo_stream(gg_mainwin, gg_scriptstr); + modeTranscript = true; + "Transcript mode now on."; + } +]; + +! ================================================================================================= +! Toggle Expanded mode (for Property and Action routines). + +[ DoExpand; + if (modeExpand) { ! Toggle to OFF. + modeExpand = false; + "Expand mode now off."; + } + else { ! Toggle to ON. + modeExpand = true; + "Expand mode now on."; + } +]; + +! ================================================================================================= +! Memory access routines. + +[ GetByte a; return theGame->a; ]; +[ GetWord a; return (theGame->a) * $00100 + theGame->(a+1); ]; + +[ W_To_A a; return a * 2; ]; +[ P_To_A a; return a * p_Multiplier; ]; +[ A_To_P a; return a / p_Multiplier; ]; + +[ P_RoundUp a + b; b = p_Multiplier-1; return (a + b) & ~b; +]; + +! ================================================================================================= +! Print rules. + +[ dec2 x; if (x<10) print "0"; print x; ]; +[ dec3 x; if (x<10) print "0"; if (x<100) print "0"; print x; ]; + +[ hex2 x; print (hchar) x & $000FF; ]; +[ hex4 x; print (hchar) (x & $0FF00) / $00100, (hchar) x & $000FF; ]; +[ hex5 x; print (hdigit) (x & $F0000) / $10000, (hchar) (x & $0FF00) / $00100, (hchar) x & $000FF; ]; +[ hchar x; print (hdigit) (x & $000F0) / $00010, (hdigit) x & $0000F; ]; +[ hdigit x; if ((x = x%$10) < 10) print x; else print (char) x-10+'A'; ]; + +Constant EXPECTING_A0 0; ! character in Alphabet 0 +Constant EXPECTING_A1 1; ! character in Alphabet 1 +Constant EXPECTING_A2 2; ! character in Alphabet 2 +Constant EXPECTING_B1 3; ! low string 0-31 +Constant EXPECTING_B2 4; ! abbreviation 0-31 +Constant EXPECTING_B3 5; ! abbreviation 32-63 +Constant EXPECTING_Z1 6; ! high bits of ZSCII character +Constant EXPECTING_Z2 7; ! low bits of ZSCII character + +[ Zaddress a ! Print string at byte address. + w c d i n theState; + + theState = EXPECTING_A0; + do { + w = GetWord(a); a = a + 2; + for (i=0 : i<3 : i++) { + switch (i) { + 0: c = (w & BITS10_14) / BIT10; + 1: c = (w & BITS05_09) / BIT05; + 2: c = (w & BITS00_04); + } + switch (theState) { + EXPECTING_A0: ! character in Alphabet 0 + switch (c) { + 0: n = n + Zchar(' '); + 1: theState = EXPECTING_B1; + 2: theState = EXPECTING_B2; + 3: theState = EXPECTING_B3; + 4: theState = EXPECTING_A1; + 5: theState = EXPECTING_A2; + default: + n = n + Zchar(a_LookupAlpha->(c-6)); + } + EXPECTING_A1: ! character in Alphabet 1 + switch (c) { + 0: n = n + Zchar(' '); + theState = EXPECTING_A0; + 1: theState = EXPECTING_B1; + 2: theState = EXPECTING_B2; + 3: theState = EXPECTING_B3; + 4: theState = EXPECTING_A1; + 5: theState = EXPECTING_A2; + default: + n = n + Zchar(a_LookupAlpha->(c-6+26)); + theState = EXPECTING_A0; + } + EXPECTING_A2: ! character in Alphabet 2 + switch (c) { + 0: n = n + Zchar(' '); + theState = EXPECTING_A0; + 1: theState = EXPECTING_B1; + 2: theState = EXPECTING_B2; + 3: theState = EXPECTING_B3; + 4: theState = EXPECTING_A1; + 5: theState = EXPECTING_A2; + 6: theState = EXPECTING_Z1; + 7: n = n + Zchar(13); + theState = EXPECTING_A0; + default: + n = n + Zchar(a_LookupAlpha->(c-6+52)); + theState = EXPECTING_A0; + } + EXPECTING_B1: ! low strings 00-31 + print "@@64", (dec2) c; n = n + 3; + theState = EXPECTING_A0; + EXPECTING_B2: ! abbreviations 00-31 + n = n + Zaddress(W_To_A(GetWord(a_Abbrevs+2*c))); ! recurse + theState = EXPECTING_A0; + EXPECTING_B3: ! abbreviations 32-63 + n = n + Zaddress(W_To_A(GetWord(a_Abbrevs+2*c+64))); ! recurse + theState = EXPECTING_A0; + EXPECTING_Z1: ! hi bits of ZSCII character + d = c * 32; + theState = EXPECTING_Z2; + EXPECTING_Z2: ! lo bits of ZSCII character + n = n + Zchar(d+c); + theState = EXPECTING_A0; + } + } + } until (w & BIT15 || ((stringOptions & STR_TRUNCATE) && n > STR_TRUNC_TO)); + return n; ! number of characters output +]; + +[ Zchar c; ! Print a single ZSCII character. + switch (c) { + 0: ! null + return 0; + 13: ! newline + c = '^'; + 32: ! space + if (stringOptions & STR_NO_SPACES) c = '_'; + if (stringOptions & STR_MULTILINE) { new_line; return 1; } + 34: ! double quotes + c = '~'; + 39: ! single quotes + if (stringOptions & STR_NO_QUOTES) c = '^'; + 64: ! at sign + print (char) 64, (char) 64, "64"; return 4; + 92: ! backslash + print (char) 64, (char) 64, "92"; return 4; + 94: ! circumflex + print (char) 64, (char) 64, "94"; return 4; + 126: ! tilde + print (char) 64, (char) 64, "126"; return 5; + 32 to 126: ! ASCII -- print normally. + ; + 155 to 251: ! ZSCII 'extra characters' + c = c - 154; + if (c > a_LookupUnicode->0) c = '?'; + else c = a_LookupUnicode->(2*c - 1) * 256 + a_LookupUnicode->(2*c); + default: ! Not a ZSCII character. + c = '?'; + } + if (stringOptions & STR_UPPERCASE) c = glk_char_to_upper(c); + print (char) c; + return 1; +]; + +[ Zstring a; ! Print string at packed address. + return Zaddress(P_To_A(a)); +]; + +[ Zname o ! Print external name of object. + a; + if (o == nothing) print "nothing"; + else { + a = a_Objects + (o-1)*14; + a = GetWord(a+12); + print (Zaddress) a+1; + } +]; + +[ Zobject o ! Print internal (hardware) name of object. + a; + if (o == nothing) print "nothing"; + else { + a = a_Objects + (o-1)*14; + a = GetWord(a+12); + if(GetByte(a) == 1 && GetWord(a+1) == $94A5) + print "UnNamed"; + else { + stringOptions = stringOptions | STR_NO_SPACES; + print (Zaddress) a+1; + stringOptions = stringOptions & ~STR_NO_SPACES; + } + print "_", o; + } +]; + +[ Zproperty p ! Print name of property. + x; + if (a_PropNames) + switch (p) { + 2: print "class"; + 3: print "metaclass"; + default: + x = GetWord(a_PropNames + 2*p); + if (x) print (Zstring) x; + else print ""; + } + else + print "(PROP", (dec3) p, ")"; +]; + +[ Zattribute q; ! Print name of attribute. + if (a_AttrNames) + print (Zstring) GetWord(a_AttrNames + 2*q); + else + print "(ATTR", (dec2) q, ")"; +]; + +[ Zaction a; ! Print name of action. + if (a > 255) print "(FAKE", (dec2) a-256, ")"; + else + if (a_ActionNames) + print (Zstring) GetWord(a_ActionNames + 2*a); + else + print "(ACTION", (dec3) a, ")"; +]; + +! ================================================================================================= +! Prompt for a Z-code file, read it into the buffer, and analyse its contents. + +[ DoOpen; + currentState = STATE_IDLE; + if (ReadTheFile(theGame, MAX_GAME)) return; + currentState = STATE_DECODE; + if (DecodeTheGame()) return; + currentState = STATE_DUMP; + font off; + print "^Game contents:^"; + print " Actions ", n_Actions, "^"; + print " Attributes ", n_AttrNames, "^"; + print " Classes ", n_Classes, "^"; + print " Dictionary ", n_DictEntries, "^"; + print " Objects ", n_Objects, "^"; + print " Properties ", n_PropNames, "^"; + print " Routines ", n_Routines, "^"; + print " Strings ", n_Strings, "^"; + print " Verbs ", n_Verbs, "^"; + font on; +]; + +[ ReadTheFile buf buflen + fileref stream; + fileref = glk_fileref_create_by_prompt(fileusage_BinaryMode+fileusage_Data, filemode_Read, ANY_OLD_ROCK); + if (fileref == GLK_NULL) "Failed to create Game fileref."; + stream = glk_stream_open_file(fileref, filemode_Read, ANY_OLD_ROCK); + if (stream == GLK_NULL) "Failed to open Game stream."; + glk_fileref_destroy(fileref); + glk_get_buffer_stream(stream, buf, buflen); + rfalse; ! Successful -- OK to continue. +]; + +[ DecodeTheGame + a b c; + + ! Check which Game/Compiler versions we're dealing with + + a_Header = $00000; + a_StringPool = a_Header+HDR_ENDOFDATA; + a_HeaderExtn = GetWord(a_Header+HDR_EXTENSION); + + zcodeVersion = GetByte(a_Header+HDR_ZCODEVERSION); + switch (zcodeVersion) { + 1,2,3: p_Multiplier = 2; "Sorry -- Z-machine version ", zcodeVersion, " not supported."; + 4,6,7: p_Multiplier = 4; "Sorry -- Z-machine version ", zcodeVersion, " not supported."; + 5: p_Multiplier = 4; ! p_Mask = $FFFFFFFC; + 8: p_Multiplier = 8; ! p_Mask = $FFFFFFF8; + 'G': "Sorry -- Glulx not supported."; + default: "BUG: unexpected Z-Machine version number."; + } + informVersion = GetByte(a_Header+HDR_INFORMVERSION); + switch (informVersion) { + '5': "Sorry -- Inform 5 not supported."; + '6': informVersion = informVersion - '0'; + default: "BUG: unexpected Inform version number."; + } + + ! Initialise variables and those addresses that we know + + i_FirstUserObject = 0; + n_Actions = 0; + n_ArrayNames = 0; + n_AttrNames = 48; + n_Classes = 0; + n_Objects = 0; + n_Opcodes = 256 + 32; ! Standard + Extended + n_PropNames = 0; + n_Rooms = 0; + n_Doors = 0; + n_Routines = 0; + n_Strings = 0; + n_Verbs = 0; + + a_LowStrings = GetWord(a_Header+HDR_ABBREVIATIONS); + a_Abbrevs = a_LowStrings + 64; + a_GameAlpha = GetWord(a_Header+HDR_ALPHABET); + if (a_GameAlpha) a_LookupAlpha = theGame + a_GameAlpha; + else a_LookupAlpha = a_LocalAlpha; + if (a_HeaderExtn) + a_GameUnicode = GetWord(a_HeaderExtn+HDREXTN_UNICODE); + else + a_GameUnicode = 0; + if (a_GameUnicode) a_LookupUnicode = theGame + a_GameUnicode; + else a_LookupUnicode = a_LocalUnicode; + a_CommonPropDefaults = GetWord(a_Header+HDR_OBJECTS); + a_Objects = a_CommonPropDefaults + 126; + a_CommonProps = GetWord(a_Objects+12); + a_ClassToObject = 0; + a_PropNames = 0; + a_AttrNames = 0; + a_ActionNames = 0; + a_ArrayNames = 0; + a_IndivProps = 0; + a_Globals = GetWord(a_Header+HDR_GLOBALS); + a_Arrays = a_Globals + 480; + a_TermChars = GetWord(a_Header+HDR_TERMCHARS); + + a_StaticMemory = GetWord(a_Header+HDR_STATICMEMORY); + a_GrammarPointers = a_StaticMemory; + a_Grammars = GetWord(a_GrammarPointers); + a_Actions = 0; + a_PreActions = 0; + a_Prepositions = 0; + a_Dictionary = GetWord(a_Header+HDR_DICTIONARY); + + a_HighMemory = GetWord(a_Header+HDR_HIGHMEMORY); + a_Routines = a_HighMemory; + p_Routines = A_To_P(a_Routines); + + p_TopOfGame = GetWord(a_Header+HDR_FILELENGTH); + a_TopOfGame = P_To_A(p_TopOfGame); + a_TopOfRoutines = 0; + a_Strings = a_TopOfGame; + p_Strings = p_TopOfGame; + + ! Process the objects. + + for (a=a_Objects : a MAX_LOCALS) a = P_RoundUp(a+1); + if (n_Routines >= MAX_ROUTINES-1) "Too many routines: increase MAX_ROUTINES and recompile."; + theRoutines-->n_Routines++ = A_To_P(a); + a = P_RoundUp(DumpRoutine(a)); + if (n_Routines%100 == 0) { print "*"; glk_select_poll(gg_event); } + } until (a > a_TopOfRoutines); + + ! This bit is dubious -- there may be another routine, so we + ! look for a small number of local variables (strings are + ! unlikely to start with these values). + + if (GetByte(a) < 4) { ! MAX_LOCALS is too big to be safe here + if (n_Routines >= MAX_ROUTINES-1) "Too many routines: increase MAX_ROUTINES and recompile."; + theRoutines-->n_Routines++ = A_To_P(a); + a = P_RoundUp(DumpRoutine(a)); + } + a_TopOfRoutines = a; + + ! The Strings start right after the Routines. + + a_strings = a_TopOfRoutines; + p_Strings = A_To_P(a_Strings); + for (a=a_Strings : a= MAX_STRINGS-1) "Too many strings: increase MAX_STRINGS and recompile."; + theStrings-->n_Strings++ = A_To_P(a); + do { c = GetWord(a); a = a + 2; } until (c & BIT15); + if (n_Strings%100 == 0) { print "*"; glk_select_poll(gg_event); } + } + + rfalse; ! Successful -- OK to continue. +]; + +Constant MAX_STRINGBUF 50; +Array stringBuf1 -> MAX_STRINGBUF; +Array stringBuf2 -> MAX_STRINGBUF; + +[ CompareStrings str printrule val1 val2 + currStream tempStream len1 len2 i j; + + currStream = glk_stream_get_current(); + + tempStream = glk_stream_open_memory(stringBuf1, MAX_STRINGBUF, filemode_Write, ANY_OLD_ROCK); + glk_stream_set_current(tempStream); + print (string) str; + glk_stream_close(tempStream, gg_arguments); + len1 = gg_arguments-->1; + + for (i=val1 : i1; + + glk_stream_set_current(currStream); + if (len1 ~= len2) continue; ! Try next value + for (j=0 : jj ~= stringBuf2->j) jump tryNext; + return i; ! Found a match + .TryNext; + } + rfalse; ! Failed to match any. +]; + +! ================================================================================================= +! Dump the game in hex. + +[ DumpData + i j k m; + if (~~currentState) print_ret (string) NO_GAME_OPEN; + + font off; + new_line; + i = Tokens-->1; if (i == -1) i = 0; else i = (i / $10) * $10; + j = Tokens-->2; if (j == -1) j = i; + if (j < i) j = i + j; + j = ((j + $10) / $10) * $10; + for ( : ii); + print (hex5) a, ": ", (Zaddress) a, "^"; + if (~~modePause) glk_select_poll(gg_event); + } + font on; +]; + +! ================================================================================================= +! Show Strings embedded in @print and @print_ret statements. + +[ DumpEmbedded + i; + if (~~currentState) print_ret (string) NO_GAME_OPEN; + + currentState = STATE_EMBED; + font off; + new_line; + for (i=0 : ii)); + if (~~modePause) glk_select_poll(gg_event); + } + font on; + currentState = STATE_DUMP; +]; + +! ================================================================================================= +! Show the dictionary. + +[ DumpVocab + a n x y; + if (~~currentState) print_ret (string) NO_GAME_OPEN; + + font off; + new_line; + for (a=a_Dictionary+GetByte(a_Dictionary)+4,n=n_DictEntries : n-- : a=a+9) { + if (GetByte(a+6) & BIT00) ! Is this a verb? + stringOptions = stringOptions | STR_UPPERCASE; + x = Zaddress(a); + stringOptions = stringOptions & ~STR_UPPERCASE; + if (++y == 6) { new_line; y = 0; } + else spaces 12-x; + } + new_line; + font on; +]; + +! ================================================================================================= +! Show all verb grammars. + +Array DoneVerb -> 256; +Array ActionsUsed --> 1000; + +[ DumpGrammar + a b n m v tt td n_ActionsUsed; + if (~~currentState) print_ret (string) NO_GAME_OPEN; + + font off; + new_line; + for (n=0 : n<256 : n++) DoneVerb->n = false; + + for (a=a_Dictionary+GetByte(a_Dictionary)+4,n=n_DictEntries : n-- : a=a+9) { + if (GetByte(a+6) & BIT00 == 0) continue; ! Not a verb + v = GetByte(a+7); ! Verb number (from 255 downwards). + if (DoneVerb->v) continue; ! Already processed. + DoneVerb->v = true; + print "Verb '", (Zaddress) a, "'"; + for (b=a+9,m=n-1 : m-- : b=b+9) + if (GetByte(b+7) == v) print " '", (Zaddress) b, "'"; + b = GetWord(a_GrammarPointers + (255-v)*2); + m = GetByte(b++); ! Number of grammar lines. + n_ActionsUsed = 0; ! Action routines for this verb. + while (m--) { + v = GetWord(b); b = b + 2; ! Action number + print "^ *"; + for (tt=GetByte(b++) : tt~=15 : tt=GetByte(b++)) { + td = GetWord(b); b = b + 2; + if (tt & BIT04) print "/"; else print " "; + switch (tt & BITS00_03) { + 1: switch (td) { + 0: print "noun"; + 1: print "held"; + 2: print "multi"; + 3: print "multiheld"; + 4: print "multiexcept"; + 5: print "multiinside"; + 6: print "creature"; + 7: print "number"; + 8: print "special"; + 9: print "topic"; + default: print "????"; + } + 2: print "'", (Zaddress) td, "'"; + 3: print "noun=[; $", (hex5) P_to_A(td), " ]"; + 4: print (Zattribute) td; + 5: print "scope=[; $", (hex5) P_to_A(td), " ]"; + 6: print "[; $", (hex5) P_to_A(td), " ]"; + default: + print "????"; + } + } + print " -> ", (Zaction) v & BITS00_09; + if (v & BIT10) print " reverse"; + v = P_To_A(GetWord(a_Actions + (v & BITS00_09) * 2)); + print " ! [; $", (hex5) v, " ]"; + if (modeExpand && ~~FoundByScan(v, ActionsUsed, n_ActionsUsed)) + ActionsUsed-->n_ActionsUsed++ = v; + } + new_line; new_line; + if (modeExpand) for (m=0 : mm); + new_line; new_line; + } + if (~~modePause) glk_select_poll(gg_event); + } + font on; +]; + +! ================================================================================================= +! Show contents of the game's header. + +[ DumpHeader + x; + if (~~currentState) print_ret (string) NO_GAME_OPEN; + + font off; + new_line; + DumpByte(a_Header+HDR_ZCODEVERSION); print "Z-machine version^"; + DumpByte(a_Header+HDR_TERPFLAGS); print "Interpreter flags^"; + DumpWord(a_Header+HDR_GAMERELEASE); print "Game release^"; + DumpByteAddr(a_Header+HDR_HIGHMEMORY); print "High memory^"; + DumpByteAddr(a_Header+HDR_INITIALPC); print "Initial PC^"; + DumpByteAddr(a_Header+HDR_DICTIONARY); print "Dictionary^"; + DumpByteAddr(a_Header+HDR_OBJECTS); print "Objects^"; + DumpByteAddr(a_Header+HDR_GLOBALS); print "Global variables^"; + DumpByteAddr(a_Header+HDR_STATICMEMORY); print "Static memory^"; + x = DumpWord(a_Header+HDR_GAMEFLAGS); print "Game flags: "; + if (x & BIT15) print "BIT_F "; + if (x & BIT14) print "BIT_E "; + if (x & BIT13) print "BIT_D "; + if (x & BIT12) print "BIT_C "; + if (x & BIT11) print "BIT_B "; + if (x & BIT10) print "print_error "; + if (x & BIT09) print "BIT_9 "; + if (x & BIT08) print "menu "; + if (x & BIT07) print "sound "; + if (x & BIT06) print "colour "; + if (x & BIT05) print "mouse "; + if (x & BIT04) print "undo "; + if (x & BIT03) print "graphic "; + if (x & BIT02) print "BIT_2 "; + if (x & BIT01) print "fixed_pitch "; + if (x & BIT00) print "transcripting "; + new_line; + DumpWord(a_Header+HDR_GAMESERIAL); print "Game serial: "; + DumpASCII(a_Header+HDR_GAMESERIAL,6); new_line; + DumpWord(a_Header+HDR_GAMESERIAL+2); new_line; + DumpWord(a_Header+HDR_GAMESERIAL+4); new_line; + DumpByteAddr(a_Header+HDR_ABBREVIATIONS); print "Abbreviations^"; + DumpPackedAddr(a_Header+HDR_FILELENGTH); print "Length^"; + DumpWord(a_Header+HDR_CHECKSUM); print "Checksum^"; + DumpByte(a_Header+HDR_TERPNUMBER); print "Interpreter number^"; + DumpByte(a_Header+HDR_TERPVERSION); print "Interpreter version^"; + DumpByte(a_Header+HDR_SCREENHLINES); print "Screen height (lines)^"; + DumpByte(a_Header+HDR_SCREENWCHARS); print "Screen width (chars)^"; + DumpWord(a_Header+HDR_SCREENWUNITS); print "Screen width (units)^"; + DumpWord(a_Header+HDR_SCREENHUNITS); print "Screen height (units)^"; + DumpByte(a_Header+HDR_FONTWUNITS); print "Font width (units)^"; + DumpByte(a_Header+HDR_FONTHUNITS); print "Font height (units)^"; + DumpWord(a_Header+HDR_ROUTINEOFFSET); print "V6: Routines offset / 8^"; + DumpWord(a_Header+HDR_STRINGOFFSET); print "V6: Strings offset / 8^"; + DumpByte(a_Header+HDR_BGCOLOUR); print "Background colour^"; + DumpByte(a_Header+HDR_FGCOLOUR); print "Foreground colour^"; + DumpByteAddr(a_Header+HDR_TERMCHARS); print "Terminating chars^"; + DumpWord(a_Header+HDR_PIXELSTO3); print "V6: Pixels to stream 3^"; + DumpWord(a_Header+HDR_TERPSTANDARD); print "Interpreter conformance^"; + DumpByteAddr(a_Header+HDR_ALPHABET); print "Alphabet^"; + DumpByteAddr(a_Header+HDR_EXTENSION); print "Header extension^"; + DumpWord(a_Header+HDR_UNUSED); print "-^"; + DumpWord(a_Header+HDR_UNUSED+2); print "-^"; + DumpWord(a_Header+HDR_INFORMVERSION); print "Inform version: "; + DumpASCII(a_Header+HDR_INFORMVERSION,4); new_line; + DumpWord(a_Header+HDR_INFORMVERSION+2); new_line; + new_line; + + if (a_HeaderExtn) { + DumpWord(a_HeaderExtn+HDREXTN_SIZE); print "Header extension size^"; + DumpWord(a_HeaderExtn+HDREXTN_MOUSEX); print "Mouse X coordinates^"; + DumpWord(a_HeaderExtn+HDREXTN_MOUSEY); print "Mouse Y coordinates^"; + DumpByteAddr(a_HeaderExtn+HDREXTN_UNICODE); print "Unicode^"; + } + font on; +]; + +[ DumpByte a + val; val = GetByte(a); + print (hex5) a, ": ", (hex2) val, " "; + return val; +]; + +[ DumpWord a + val; val = GetWord(a); + print (hex5) a, ": ", (hex4) val, " "; + return val; +]; + +[ DumpByteAddr a + val; val = GetWord(a); + print (hex5) a, ": ", (hex4) val, "b ", (hex5) val, " "; + return val; +]; + +[ DumpPackedAddr a + val; val = GetWord(a); + print (hex5) a, ": ", (hex4) val, "p "; + val = P_To_A(GetWord(a)); + print (hex5) val, " "; + return val; +]; + +[ DumpASCII a n + i; + print "~"; for (i=0 : i 1) print " ", (Zobject) p; + print " with^"; + c = GetByte(b++); ! #words of object's shortname + DoProperties(b+c+c); ! Object's first property block + DoAttributes(a); ! Object's attribute bytes + } + new_line; + if (~~modePause) glk_select_poll(gg_event); + } + font on; +]; + +[ DoProperties a + b p n x; + for (x=GetByte(a++) : x : x=GetByte(a++)) { + p = x & BITS00_05; ! Common property number + if (x & BIT07) { ! Two size-and-number bytes + n = GetByte(a++) & BITS00_05; + if (n == 0) n = 64; + } + else ! One size-and-number byte + if (x & BIT06) n = 2; ! Two bytes of data + else n = 1; ! One byte of data + if (p ~= 3) { + if (currentState == STATE_DUMP) + DoPropNameAndValue(a, p, n); + } + else { ! Individual properties + b = GetWord(a); + if (a_IndivProps == 0) a_IndivProps = b; + for (x=GetWord(b),b=b+2 : x : x=GetWord(b),b=b+2) { + p = x & BITS00_14; ! Individual property number + n = GetByte(b++); + if (currentState == STATE_DUMP) DoPropNameAndValue(b, p, n); + b = b + n; + } + } + a = a + n; + } + return a; +]; + +[ DoPropNameAndValue a p n + i j x; + print " ", (Zproperty) p; + if (n & BIT00) ! odd number of bytes + for (i=0 : i= a_Dictionary && x < a_HighMemory) { + stringOptions = stringOptions | STR_NO_QUOTES; + print " '"; + if (Zaddress(x) == 1) print "//"; + print "'"; + stringOptions = stringOptions & ~STR_NO_QUOTES; + } + else + print " ?", (hex4) x, "?"; ! not a dictionary word; maybe a character constant? + 2: ! ofclass + print " ", (Zname) x; + 3: ! metaclass (individual properties) + "BUG: tried to print property 3."; + default: ! other properties + switch (x) { + $FFFF: + print " -1"; + 0 to 20: ! probably not an object... + print " ", x; + default: + if (x <= n_Objects) print " ", (Zobject) x; + else { + if (x >= p_Routines && x < p_Strings && + FoundByChop(x, theRoutines, n_Routines) && i-j < 3) { + j = i; + if (modeExpand) DumpRoutine(P_To_A(x)); + else print " [; $", (hex5) P_To_A(x), " ]"; + } + else + if (x >= p_Strings && x < p_TopOfGame && + FoundByChop(x, theStrings, n_Strings) && i-j < 3) { + j = i; + if (true) print " ~", (Zstring) x, "~"; + !else print " ~$", (hex5) P_To_A(x), "~"; + } + else + print " ", x; + + } ! end of not-an-object + } ! end of switch(x) + } ! end of switch(p) + print ",^"; +]; + +[ FoundByChop x a l ! Locate value in sorted list by binary chop. + i p q; + p = 0; q = l - 1 ; + do { + i = p + (q-p)/2; ! mid point + if (x == a-->i) return i+1; ! found it! + if (x > a-->i) p = i + 1; ! above the mid point + else q = i - 1; ! below the mid point + } until (p>q); + rfalse; +]; + +[ FoundByScan x a l ! Locate value in unsorted list by sequential scan. + i; + for (i=0 : ii) return i+1; ! found it! + rfalse; +]; + +[ DoAttributes a + i; + if (GetWord(a) | GetWord(a+2) | GetWord(a+4)) print " has "; + for (i=0 : i(7 - q%8)) rtrue; + rfalse; +]; + +! ================================================================================================= +! Create XML markup which could be imported into the Dia diagram tool +! (http://www.lysator.liu.se/~alla/dia), giving an editable map of the game. + +Global CantGoProp; +Global DoorToProp; +Global xmlID; +Global mapSize; + +Constant GRID_SIZE 050; ! Dia snap-to grid (all x100). Rooms are twice this size. +Constant LINE_WIDTH 003; ! For rooms and connections. +Constant TEXT_OFFSET_X 010; ! From top-left of room square +Constant TEXT_OFFSET_Y 022; +Constant TEXT_NAME "Verdana"; +Constant TEXT_SIZE 020; + +Constant ONE_SIDED_DOOR 20; ! Only one link to this door. +Constant UNKNOWN_ROOM 21; ! Link to a 'room' not in the table. +Constant LINK_IS_ROUTINE 22; ! XXX_to is a property routine. + +[ DumpRooms + a b c o p i j n_exits x; + if (~~currentState) print_ret (string) NO_GAME_OPEN; + + ! Calculate the map square necessary to display all objects. + + switch (n_objects) { + 0 to 99: mapSize = 10; + 100 to 399: mapSize = 20; + 400 to 899: mapSize = 30; + 900 to 1599: mapSize = 40; + default: mapsize = 50; + } + + ! Find the XXX_to property numbers, and the 'door' attribute number. + + for (i=0 : ii = CompareStrings(DirPropNames-->i, ZProperty, 1, n_PropNames); + for (j=0 : ji)-->j = 0; + } + CantGoProp = CompareStrings("cant_go", ZProperty, 1, n_PropNames); + DoorToProp = CompareStrings("door_to", ZProperty, 1, n_PropNames); + + ! Identify the room and door objects, and store the exits. + + n_Rooms = 0; n_Doors = 0; + for (a=a_Objects,o=1 : an_Doors = o; + doorToRoom-->n_Doors = x; + n_Doors++; + continue; + } + for (i=0 : ii) { ! Found an exit. + if (++n_exits == 1) { ! First exit - found a new room. + if (n_Rooms == MAX_ROOMS) "Too many rooms: increase MAX_ROOMS and recompile."; + theRooms-->n_Rooms = o; + } + if (x > 0 && x < p_Strings) + (theExits-->i)-->n_Rooms = x; ! room, door or routine + } + if (p == CantGoProp && n_exits == 0) { + if (n_Rooms == MAX_ROOMS) "Too many rooms: increase MAX_ROOMS and recompile."; + theRooms-->n_Rooms = o; + n_exits++; + } + } + if (n_exits) n_Rooms++; + if (~~modePause) glk_select_poll(gg_event); + } + + ! Find doors and replace by direct room-to-room links. + + for (a=0 : ai)-->a; + if (x > 0 && x <= n_Objects) { ! room or door + p = FoundByChop(x, theDoors, n_Doors); + if (~~p) continue; ! room - ignore + p--; + p = doorToRoom-->p; ! door's door_to prop + if (p <= n_Objects) { + (theExits-->i)-->a = p; ! a room + continue; + } + + ! door_to must be a routine + + for (b=a+1 : bj)-->b == x) { + (theExits-->j)-->b = theRooms-->a; + n_exits++; + } + } + if (n_exits) { + for (j=0 : jj)-->a == x) { + (theExits-->j)-->a = theRooms-->b; + } + } + } + } + if ((theExits-->i)-->a == x) { ! couldn't find the door elsewhere + for (j=0 : jj)-->a == x) { + (theExits-->j)-->a = ONE_SIDED_DOOR; + } + } + } + } + } + } + +! for (a=0 : aa; +! print a, " ", (Zobject) o; +! for (i=0 : ii)-->a; +! print " ", (string)DirPropNames-->i, "=", x; +! p = FoundByChop(x, theRooms, n_Rooms); +! if (~~p) continue; +! p--; +! print " at pos ", p; +! for (j=0 : jj)-->p == o) print " matches ", j; +! } +! new_line; +! } + + font off; + new_line; + xmlID = n_objects + 1; ! IDs for generated XML things + XMLheader(); + + ! Generate the XML for the rooms + + XMLroom(ONE_SIDED_DOOR, "INSPECTOR^One-sided^doors"); + XMLroom(UNKNOWN_ROOM, "INSPECTOR^Links to^non-rooms"); + XMLroom(LINK_IS_ROUTINE, "INSPECTOR^Links^are^routines"); + for (a=0 : aa); + if (~~modePause) glk_select_poll(gg_event); + } + + ! Now, generate the connections between rooms. + + for (a=0 : aa; + for (i=0 : ii)-->a; + if (x == 0) continue; + if (x == ONE_SIDED_DOOR) { XMLconnection(o, i, ONE_SIDED_DOOR, 7); continue; } + if (x >= p_Routines) { XMLconnection(o, i, LINK_IS_ROUTINE, 7); continue; } + p = FoundByChop(x, theRooms, n_Rooms); + if (~~p) { XMLconnection(o, i, UNKNOWN_ROOM, 7); continue; } + p--; + n_exits = 0; + j = XOR(i, 1); ! Symmetrical exit + if ((theExits-->j)-->p == o) { + n_exits++; + if (x > o) XMLconnection(o, i, x, j); + } + else { + for (j=0 : jj)-->p == o) { + n_exits++; + if (x > o) XMLconnection(o, i, x, j); + } + } + } + if (n_exits == 0) XMLconnection(o, i, x, MAX_DIRPROPS); + + } + if (~~modePause) glk_select_poll(gg_event); + } + + XMLfooter(); + font on; +]; + +[ XMLheader; + "Save the lines BETWEEN the markers in YourFileName.xml as input to Dia^ + [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[^ + ^ + ^ + ^ + ^ + ^ + ^ + ^ + ^ + ^"; +]; + +[ XMLfooter; + "^ + ^ + ]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]^ + End of input to Dia. Do not include the [[[[[[ and ]]]]]] marker lines"; +]; + +[ XOR a b; return (a | b) & (~(a & b)); ]; + +[ XY p; print p/100, (char) '.', (dec2) p%100; ]; + +[ XMLroom o str + x y; + x = objX(o); + y = objY(o); + print "^ + ^ + ^ + ^ + ^ + ^ + ^ + ^ + ^ + ^ + #"; + stringOptions = stringOptions | STR_MULTILINE; + if (str) print (string) str; + else print (Zname) o; + stringOptions = stringOptions & ~STR_MULTILINE; + "#^ + ^ + ^ + ^ + ^ + ^ + ^ + ^ + ^ + ^ + ^ + ^"; +]; + +[ XMLconnection o1 d1 o2 d2 + x1 x2 y1 y2; + if (o1 == o2) return; ! ignore circular links. + x1 = objX(o1) + connectX->d1; + y1 = objY(o1) + connectY->d1; + x2 = objX(o2) + connectX->d2; + y2 = objY(o2) + connectY->d2; + print "^ + ^ + ^ + ^ + ^ + ^ + ^ + d1, "~/>^ + d2, "~/>^ + ^"; + if (connectArrow->d1) + print "d1, "~/>^ + ^ + ^"; + if (connectArrow->d2) + print "d2, "~/>^ + ^ + ^"; + "^"; +]; + +[ objX o; return o%mapSize * (GRID_SIZE * 3); ]; + +[ objY o; return o/mapSize * (GRID_SIZE * 3); ]; + + Array connectX -> + GRID_SIZE ! North + GRID_SIZE ! South + GRID_SIZE * 2 ! East + 0 ! West + GRID_SIZE * 2 ! Northeast + 0 ! Southwest + 0 ! Northwest + GRID_SIZE * 2 ! SouthEast + GRID_SIZE * 2 ! Up (use Northeast) + 0 ! Down (use Southwest) + 0 ! In (use Northwest) + GRID_SIZE * 2 ! Out (use Southeast) + GRID_SIZE * 2; ! None (use Southeast) + +Array connectY -> + 0 ! North + GRID_SIZE * 2 ! South + GRID_SIZE ! East + GRID_SIZE ! West + 0 ! Northeast + GRID_SIZE * 2 ! Southwest + 0 ! Northwest + GRID_SIZE * 2 ! SouthEast + 0 ! Up (use Northeast) + GRID_SIZE * 2 ! Down (use Southwest) + 0 ! In (use Northwest) + GRID_SIZE * 2 ! Out (use Southeast) + GRID_SIZE * 2; ! None (use Southeast) + +Array connectID -> ! dia connection IDs + 7 ! North + 6 ! South + 5 ! East + 3 ! West + 4 ! Northeast + 2 ! Southwest + 0 ! Northwest + 1 ! SouthEast + 4 ! Up (use Northeast) + 2 ! Down (use Southwest) + 0 ! In (use Northwest) + 1 ! Out (use Southeast) + 1; ! None (use Northwest???) + +Array connectArrow -> ! dia arrowheads + 0 ! North + 0 ! South + 0 ! East + 0 ! West + 0 ! Northeast + 0 ! Southwest + 0 ! Northwest + 0 ! SouthEast + 9 ! Up + 8 ! Down + 3 ! In + 2 ! Out + 21; ! None (not an exit) + +! ================================================================================================= +! Show all Z-code routines. + +[ DumpZcode + i; + if (~~currentState) print_ret (string) NO_GAME_OPEN; + + font off; + new_line; + for (i=0 : ii)); + print ";^^"; + if (~~modePause) glk_select_poll(gg_event); + } + font on; +]; + +Array OpcodeNames --> ! 256 Standard opcodes + 32 Extended opcodes + + ! Long 2OP: small constant, small constant + nothing "je" "jl" "jg" + "dec_chk" "inc_chk" "jin" "test" + "or" "and" "test_attr" "set_attr" + "clear_attr" "store" "insert_obj" "loadw" + "loadb" "get_prop" "get_prop_addr" "get_next_prop" + "add" "sub" "mul" "div" + "mod" "call_2s" "call_2n" "set_colour" + "throw" nothing nothing nothing + + ! Long 2OP: small constant, variable + nothing "je" "jl" "jg" + "dec_chk" "inc_chk" "jin" "test" + "or" "and" "test_attr" "set_attr" + "clear_attr" "store" "insert_obj" "loadw" + "loadb" "get_prop" "get_prop_addr" "get_next_prop" + "add" "sub" "mul" "div" + "mod" "call_2s" "call_2n" "set_colour" + "throw" nothing nothing nothing + + ! Long 2OP: variable, small constant + nothing "je" "jl" "jg" + "dec_chk" "inc_chk" "jin" "test" + "or" "and" "test_attr" "set_attr" + "clear_attr" "store" "insert_obj" "loadw" + "loadb" "get_prop" "get_prop_addr" "get_next_prop" + "add" "sub" "mul" "div" + "mod" "call_2s" "call_2n" "set_colour" + "throw" nothing nothing nothing + + ! Long 2OP: variable, variable + nothing "je" "jl" "jg" + "dec_chk" "inc_chk" "jin" "test" + "or" "and" "test_attr" "set_attr" + "clear_attr" "store" "insert_obj" "loadw" + "loadb" "get_prop" "get_prop_addr" "get_next_prop" + "add" "sub" "mul" "div" + "mod" "call_2s" "call_2n" "set_colour" + "throw" nothing nothing nothing + + ! Short 1OP: large constant + "jz" "get_sibling" "get_child" "get_parent" + "get_prop_len" "inc" "dec" "print_addr" + "call_1s" "remove_obj" "print_obj" "ret" + "jump" "print_paddr" "load" "call_1n" + + ! Short 1OP: small constant + "jz" "get_sibling" "get_child" "get_parent" + "get_prop_len" "inc" "dec" "print_addr" + "call_1s" "remove_obj" "print_obj" "ret" + "jump" "print_paddr" "load" "call_1n" + + ! Short 1OP: variable + "jz" "get_sibling" "get_child" "get_parent" + "get_prop_len" "inc" "dec" "print_addr" + "call_1s" "remove_obj" "print_obj" "ret" + "jump" "print_paddr" "load" "call_1n" + + ! Short 0OP + "rtrue" "rfalse" "print" "print_ret" + "nop" nothing nothing "restart" + "ret_popped" "catch" "quit" "new_line" + nothing "verify" "extended" "piracy" + + ! Variable 2OP: Type byte follows + nothing "je" "jl" "jg" + "dec_chk" "inc_chk" "jin" "test" + "or" "and" "test_attr" "set_attr" + "clear_attr" "store" "insert_obj" "loadw" + "loadb" "get_prop" "get_prop_addr" "get_next_prop" + "add" "sub" "mul" "div" + "mod" "call_2s" "call_2n" "set_colour" + "throw" nothing nothing nothing + + ! Variable VAR: Type byte(s) follow + "call_vs" "storew" "storeb" "put_prop" + "aread" "print_char" "print_num" "random" + "push" "pull" "split_window" "set_window" + "call_vs2" "erase_window" "erase_line" "set_cursor" + "get_cursor" "set_text_style" "buffer_mode" "output_stream" + "input_stream" "sound_effect" "read_char" "scan_table" + "not" "call_vn" "call_vn2" "tokenise" + "encode_text" "copy_table" "print_table" "check_arg_count" + + ! Extended VAR: Type byte follows + "save" "restore" "log_shift" "art_shift" + "set_font" "draw_picture" "picture_data" "erase_picture" + "set_margins" "save_undo" "restore_undo" "print_unicode" + "check_unicode" nothing nothing nothing + "move_window" "window_size" "window_style" "get_wind_prop" + "scroll_window" "pop_stack" "read_mouse" "mouse_window" + "push_stack" "put_wind_prop" "print_form" "make_menu" + "picture_table" nothing nothing nothing; + +! These flags are not part of the ZSpec. + +Constant OK = $$00000000; ! Normal instruction +Constant ST = $$10000000; ! Has Store variable? +Constant BR = $$01000000; ! Has Branch offset? +Constant PR = $$00100000; ! Has Printable text? +Constant TY = $$00010000; ! Has Type byte(s)? +Constant tStS = $$0101; ! Small constant, small constant +Constant tStV = $$0110; ! Small constant, variable +Constant tVtS = $$1001; ! Variable, small constant +Constant tVtV = $$1010; ! Variable, variable +Constant tLtX = $$0011; ! Large constant +Constant tStX = $$0111; ! Small constant +Constant tVtX = $$1011; ! Variable +Constant tXtX = $$1111; ! Nothing +Constant MA = $$00001111; ! Mask for Type [Type count] bytes +Constant ER = $$11111111; ! Error + +Constant tXtXtXtX = $$11111111; + +Array OpcodeFlags -> ! 256 Standard opcodes + 32 Extended opcodes + + ! Long 2OP: small constant, small constant + ER ! $00 ILLEGAL + OK +BR +tStS ! $01 je + OK +BR +tStS ! $02 jl + OK +BR +tStS ! $03 jg + OK +BR +tStS ! $04 dec_chk + OK +BR +tStS ! $05 inc_chk + OK +BR +tStS ! $06 jin + OK +BR +tStS ! $07 test + OK +ST +tStS ! $08 or + OK +ST +tStS ! $09 and + OK +BR +tStS ! $0Atest_attr + OK +tStS ! $0B set_attr + OK +tStS ! $0C clear_attr + OK +tStS ! $0D store + OK +tStS ! $0E insert_obj + OK +ST +tStS ! $0F loadw + OK +ST +tStS ! $10 loadb + OK +ST +tStS ! $11 get_prop + OK +ST +tStS ! $12 get_prop_addr + OK +ST +tStS ! $13 get_next_prop + OK +ST +tStS ! $14 add + OK +ST +tStS ! $15 sub + OK +ST +tStS ! $16 mul + OK +ST +tStS ! $17 div + OK +ST +tStS ! $18 mod + OK +ST +tStS ! $19 call_2s + OK +tStS ! $1A call_2n + OK +tStS ! $1B set_colour + OK +tStS ! $1C throw + ER ! $1D ILLEGAL + ER ! $1E ILLEGAL + ER ! $1F ILLEGAL + + ! Long 2OP: small constant, variable + ER ! $20 ILLEGAL + OK +BR +tStV ! $21 je + OK +BR +tStV ! $22 jl + OK +BR +tStV ! $23 jg + OK +BR +tStV ! $24 dec_chk + OK +BR +tStV ! $25 inc_chk + OK +BR +tStV ! $26 jin + OK +BR +tStV ! $27 test + OK +ST +tStV ! $28 or + OK +ST +tStV ! $29 and + OK +BR +tStV ! $2Atest_attr + OK +tStV ! $2B set_attr + OK +tStV ! $2C clear_attr + OK +tStV ! $2D store + OK +tStV ! $2E insert_obj + OK +ST +tStV ! $2F loadw + OK +ST +tStV ! $30 loadb + OK +ST +tStV ! $31 get_prop + OK +ST +tStV ! $32 get_prop_addr + OK +ST +tStV ! $33 get_next_prop + OK +ST +tStV ! $34 add + OK +ST +tStV ! $35 sub + OK +ST +tStV ! $36 mul + OK +ST +tStV ! $37 div + OK +ST +tStV ! $38 mod + OK +ST +tStV ! $39 call_2s + OK +tStV ! $3A call_2n + OK +tStV ! $3B set_colour + OK +tStV ! $3C throw + ER ! $3D ILLEGAL + ER ! $3E ILLEGAL + ER ! $3F ILLEGAL + + ! Long 2OP: variable, small constant + ER ! $40 ILLEGAL + OK +BR +tVtS ! $41 je + OK +BR +tVtS ! $42 jl + OK +BR +tVtS ! $43 jg + OK +BR +tVtS ! $44 dec_chk + OK +BR +tVtS ! $45 inc_chk + OK +BR +tVtS ! $46 jin + OK +BR +tVtS ! $47 test + OK +ST +tVtS ! $48 or + OK +ST +tVtS ! $49 and + OK +BR +tVtS ! $4Atest_attr + OK +tVtS ! $4B set_attr + OK +tVtS ! $4C clear_attr + OK +tVtS ! $4D store + OK +tVtS ! $4E insert_obj + OK +ST +tVtS ! $4F loadw + OK +ST +tVtS ! $50 loadb + OK +ST +tVtS ! $51 get_prop + OK +ST +tVtS ! $52 get_prop_addr + OK +ST +tVtS ! $53 get_next_prop + OK +ST +tVtS ! $54 add + OK +ST +tVtS ! $55 sub + OK +ST +tVtS ! $56 mul + OK +ST +tVtS ! $57 div + OK +ST +tVtS ! $58 mod + OK +ST +tVtS ! $59 call_2s + OK +tVtS ! $5A call_2n + OK +tVtS ! $5B set_colour + OK +tVtS ! $5C throw + ER ! $5D ILLEGAL + ER ! $5E ILLEGAL + ER ! $5F ILLEGAL + + ! Long 2OP: variable, variable + ER ! $60 ILLEGAL + OK +BR +tVtV ! $61 je + OK +BR +tVtV ! $62 jl + OK +BR +tVtV ! $63 jg + OK +BR +tVtV ! $64 dec_chk + OK +BR +tVtV ! $65 inc_chk + OK +BR +tVtV ! $66 jin + OK +BR +tVtV ! $67 test + OK +ST +tVtV ! $68 or + OK +ST +tVtV ! $69 and + OK +BR +tVtV ! $6Atest_attr + OK +tVtV ! $6B set_attr + OK +tVtV ! $6C clear_attr + OK +tVtV ! $6D store + OK +tVtV ! $6E insert_obj + OK +ST +tVtV ! $6F loadw + OK +ST +tVtV ! $70 loadb + OK +ST +tVtV ! $71 get_prop + OK +ST +tVtV ! $72 get_prop_addr + OK +ST +tVtV ! $73 get_next_prop + OK +ST +tVtV ! $74 add + OK +ST +tVtV ! $75 sub + OK +ST +tVtV ! $76 mul + OK +ST +tVtV ! $77 div + OK +ST +tVtV ! $78 mod + OK +ST +tVtV ! $79 call_2s + OK +tVtV ! $7A call_2n + OK +tVtV ! $7B set_colour + OK +tVtV ! $7C throw + ER ! $7D ILLEGAL + ER ! $7E ILLEGAL + ER ! $7F ILLEGAL + + ! Short 1OP: large constant + OK +BR +tLtX ! $80 jz + OK +ST +BR +tLtX ! $81 get_sibling + OK +ST +BR +tLtX ! $82 get_child + OK +ST +tLtX ! $83 get_parent + OK +ST +tLtX ! $84 get_prop_len + OK +tLtX ! $85 inc + OK +tLtX ! $86 dec + OK +tLtX ! $87 print_addr + OK +ST +tLtX ! $88 call_1s + OK +tLtX ! $89 remove_obj + OK +tLtX ! $8A print_obj + OK +tLtX ! $8B ret + OK +tLtX ! $8C jump + OK +tLtX ! $8D print_paddr + OK +ST +tLtX ! $8E load + OK +tLtX ! $8F call_1n + + ! Short 1OP: small constant + OK +BR +tStX ! $90 jz + OK +ST +BR +tStX ! $91 get_sibling + OK +ST +BR +tStX ! $92 get_child + OK +ST +tStX ! $93 get_parent + OK +ST +tStX ! $94 get_prop_len + OK +tStX ! $95 inc + OK +tStX ! $96 dec + OK +tStX ! $97 print_addr + OK +ST +tStX ! $98 call_1s + OK +tStX ! $99 remove_obj + OK +tStX ! $9A print_obj + OK +tStX ! $9B ret + OK +tStX ! $9C jump + OK +tStX ! $9D print_paddr + OK +ST +tStX ! $9E load + OK +tStX ! $9F call_1n + + ! Short 1OP: variable + OK +BR +tVtX ! $A0 jz + OK +ST +BR +tVtX ! $A1 get_sibling + OK +ST +BR +tVtX ! $A2 get_child + OK +ST +tVtX ! $A3 get_parent + OK +ST +tVtX ! $A4 get_prop_len + OK +tVtX ! $A5 inc + OK +tVtX ! $A6 dec + OK +tVtX ! $A7 print_addr + OK +ST +tVtX ! $A8 call_1s + OK +tVtX ! $A9 remove_obj + OK +tVtX ! $AA print_obj + OK +tVtX ! $AB ret + OK +tVtX ! $AC jump + OK +tVtX ! $AD print_paddr + OK +ST +tVtX ! $AE load + OK +tVtX ! $AF call_1n + + ! Short 0OP + OK +tXtX ! $B0 rtrue + OK +tXtX ! $B1 rfalse + OK +PR +tXtX ! $B2 print + OK +PR +tXtX ! $B3 print_ret + OK +tXtX ! $B4 nop + ER ! $B5 ILLEGAL + ER ! $B6 ILLEGAL + OK +tXtX ! $B7 restart + OK +tXtX ! $B8 ret_popped + OK +ST +tXtX ! $B9 catch + OK +tXtX ! $BA quit + OK +tXtX ! $BB new_line + ER ! $BC ILLEGAL + OK +BR +tXtX ! $BD verify + OK +tXtX ! $BE extended + OK +BR +tXtX ! $BF piracy + + ! Variable 2OP: Type byte follows + ER ! $C0 ILLEGAL + OK +BR +TY +1 ! $C1 je + OK +BR +TY +1 ! $C2 jl + OK +BR +TY +1 ! $C3 jg + OK +BR +TY +1 ! $C4 dec_chk + OK +BR +TY +1 ! $C5 inc_chk + OK +BR +TY +1 ! $C6 jin + OK +BR +TY +1 ! $C7 test + OK +ST +TY +1 ! $C8 or + OK +ST +TY +1 ! $C9 and + OK +BR +TY +1 ! $CAtest_attr + OK +TY +1 ! $CB set_attr + OK +TY +1 ! $CC clear_attr + OK +TY +1 ! $CD store + OK +TY +1 ! $CE insert_obj + OK +ST +TY +1 ! $CF loadw + OK +ST +TY +1 ! $D0 loadb + OK +ST +TY +1 ! $D1 get_prop + OK +ST +TY +1 ! $D2 get_prop_addr + OK +ST +TY +1 ! $D3 get_next_prop + OK +ST +TY +1 ! $D4 add + OK +ST +TY +1 ! $D5 sub + OK +ST +TY +1 ! $D6 mul + OK +ST +TY +1 ! $D7 div + OK +ST +TY +1 ! $D8 mod + OK +ST +TY +1 ! $D9 call_2s + OK +TY +1 ! $DA call_2n + OK +TY +1 ! $DB set_colour + OK +TY +1 ! $DC throw + ER ! $DD ILLEGAL + ER ! $DE ILLEGAL + ER ! $DF ILLEGAL + + ! Variable VAR: Type byte(s) follow + OK +ST +TY +1 ! $E0 call_vs + OK +TY +1 ! $E1 storew + OK +TY +1 ! $E2 storeb + OK +TY +1 ! $E3 put_prop + OK +ST +TY +1 ! $E4 aread + OK +TY +1 ! $E5 print_char + OK +TY +1 ! $E6 print_num + OK +ST +TY +1 ! $E7 random + OK +TY +1 ! $E8 push + OK +TY +1 ! $E9 pull + OK +TY +1 ! $EA split_window + OK +TY +1 ! $EB set_window + OK +ST +TY +2 ! $EC call_vs2 + OK +TY +1 ! $ED erase_window + OK +TY +1 ! $EE erase_line + OK +TY +1 ! $EF set_cursor + OK +TY +1 ! $F0 get_cursor + OK +TY +1 ! $F1 set_text_style + OK +TY +1 ! $F2 buffer_mode + OK +TY +1 ! $F3 output_stream + OK +TY +1 ! $F4 input_stream + OK +TY +1 ! $F5 sound_effect + OK +ST +TY +1 ! $F6 read_char + OK +ST +BR +TY +1 ! $F7 scan_table + OK +ST +TY +1 ! $F8 not + OK +TY +1 ! $F9 call_vn + OK +TY +2 ! $FA call_vn2 + OK +TY +1 ! $FB tokenise + OK +TY +1 ! $FC encode_text + OK +TY +1 ! $FD copy_table + OK +TY +1 ! $FE print_table + OK +BR +TY +1 ! $FF check_arg_count + + ! Extended: Type byte follows + OK +ST +TY +1 ! $00 save + OK +ST +TY +1 ! $01 restore + OK +ST +TY +1 ! $02 log_shift + OK +ST +TY +1 ! $03 art_shift + OK +ST +TY +1 ! $04 set_font + OK +TY +1 ! $05 draw_picture + OK +BR +TY +1 ! $06 picture_data + OK +TY +1 ! $07 erase_picture + OK +TY +1 ! $08 set_margins + OK +ST +TY +1 ! $09 save_undo + OK +ST +TY +1 ! $0A restore_undo + OK +TY +1 ! $0B print_unicode + OK +TY +1 ! $0C check_unicode + ER ! $0D ILLEGAL + ER ! $0E ILLEGAL + ER ! $0F ILLEGAL + OK +TY +1 ! $10 move_window + OK +TY +1 ! $11 window_size + OK +TY +1 ! $12 window_style + OK +ST +TY +1 ! $13 get_wind_prop + OK +TY +1 ! $14 scroll_window + OK +TY +1 ! $15 pop_stack + OK +TY +1 ! $16 read_mouse + OK +TY +1 ! $17 mouse_window + OK +BR +TY +1 ! $18 push_stack + OK +TY +1 ! $19 put_wind_prop + OK +TY +1 ! $1A print_form + OK +BR +TY +1 ! $1B make_menu + OK +TY +1 ! $1C picture_table + ER ! $1D ILLEGAL + ER ! $1E ILLEGAL + ER; ! $1F ILLEGAL + +Constant tLargeCon = 0; ! First four values defined by the ZSpec. +Constant tSmallCon = 1; ! +Constant tVariable = 2; ! +Constant tOmit = 3; ! +Constant tAddress = 4; ! Following values not part of ZSpec. +Constant tObject = 5; ! +Constant tProperty = 6; ! +Constant tAttribute = 7; ! +Constant tString = 8; ! + +Array OperandType -> 8; ! Up to eight operands are permitted. +Array OperandValue --> 8; + +[ DumpRoutine a + opc opf i n maybeHWM addrHWM; + + n = GetByte(a); ! Number of local variables + if (n > MAX_LOCALS) "BUG: bad locals count."; + + if (currentState == STATE_DUMP) { + print " [ ", (hex5) a; + for (i=1 : i<=n : i++) + print " ", (var) i; + print ";^"; + } + a++; + addrHWM = 0; ! Highest referenced address in routine + + ! loop through the individual instructions + + do { + if (addrHWM < a) addrHWM = a; + maybeHWM = false; + if (currentState == STATE_DUMP) print " ", (hex5) a, ": "; + opc = GetByte(a++); + if (opc == $BE) ! Extended - real opcode in next byte + opc = GetByte(a++) + 256; + if (opc >= n_Opcodes || OpcodeNames-->opc == nothing) + "BUG: bad opcode ", n, "."; + opf = OpcodeFlags->opc; + n = opf & MA; + if (opf & TY) switch (n) { ! Types byte(s) follow + 1: SetOperandTypes(0, GetByte(a++)); SetOperandTypes(4, tXtXtXtX); + 2: SetOperandTypes(0, GetByte(a++)); SetOperandTypes(4, GetByte(a++)); + default: "BUG: error in type bits."; + } + else { ! Types known from opcode + SetOperandTypes(0, (n*16)|tXtX); SetOperandTypes(4, tXtXtXtX); + } + for (i=0 : i<8 : i++) switch (OperandType->i) { + tLargeCon: ! Large constant + OperandValue-->i = GetWord(a); a = a + 2; + tSmallCon, tVariable: ! Small constant, Variable + OperandValue-->i = GetByte(a++); + tOmit: ! Omit + ; + default: "BUG: error in types."; + } + + ! We now know the opcode, and the individual operand types and values. + ! Some adjustments are necessary... + + switch (opc) { + + ! These adjustments are essential. + + $87: ! print_addr + OperandType->0 = tAddress; + $8D: ! print_paddr + OperandValue-->0 = P_to_A(OperandValue-->0); + if (currentState == STATE_DECODE && OperandValue-->0 < a_Strings) + a_Strings = OperandValue-->0; + OperandType->0 = tAddress; + $8C: ! jump (signed offset) + if (OperandValue-->0 & BIT15) { + OperandValue-->0 = OperandValue-->0 | $FFFF0000; + maybeHWM = true; + } + OperandValue-->0 = OperandValue-->0 + a - 2; + if (OperandValue-->0 > addrHWM) addrHWM = OperandValue-->0; + OperandType->0 = tAddress; + $8B,$9B,$AB, ! ret + $B0, ! rtrue + $B1, ! rfalse + $B3, ! print_ret + $B8, ! ret_popped + $BA: ! quit + maybeHWM = true; + $88, ! call_1s + $8F: ! call_1n + OperandValue-->0 = P_to_A(OperandValue-->0); + if (currentState == STATE_DECODE && OperandValue-->0 > a_TopOfRoutines) + a_TopOfRoutines = OperandValue-->0; + OperandType->0 = tAddress; + $D9, ! call_2s + $DA, ! call_2n + $E0, ! call_vs + $EC, ! call_vs2 + $F9, ! call_vn + $FA: ! call_vn2 + if (OperandType->0 == tLargeCon) { + OperandValue-->0 = P_to_A(OperandValue-->0); + if (currentState == STATE_DECODE && OperandValue-->0 > a_TopOfRoutines) + a_TopOfRoutines = OperandValue-->0; + OperandType->0 = tAddress; + } + + ! These adjustments are cosmetic. + + $06,$26,$46,$66,$C6, ! jin + $0E,$2E,$4E,$6E,$CE: ! insert_obj + if (OperandType->0 == tLargeCon or tSmallCon) OperandType->0 = tObject; + if (OperandType->1 == tLargeCon or tSmallCon) OperandType->1 = tObject; + $0A,$2A,$4A,$6A,$CA, ! test_attr + $0B,$2B,$4B,$6B,$CB, ! set_attr + $0C,$2C,$4C,$6C,$CC: ! clear_attr + if (OperandType->0 == tLargeCon or tSmallCon) OperandType->0 = tObject; + if (OperandType->1 == tLargeCon or tSmallCon) OperandType->1 = tAttribute; + $11,$31,$51,$71,$D1, ! get_prop + $12,$32,$52,$72,$D2, ! get_prop_addr + $13,$33,$53,$73,$D3, ! get_next_prop + $E3: ! put_prop + if (OperandType->0 == tLargeCon or tSmallCon) OperandType->0 = tObject; + if (OperandType->1 == tLargeCon or tSmallCon) OperandType->1 = tProperty; + $81,$91, ! get_sibling + $82,$92, ! get_child + $83,$93, ! get_parent + $89,$99, ! remove_obj + $8A,$9A: ! print_obj + if (OperandType->0 == tLargeCon or tSmallCon) OperandType->0 = tObject; + + } ! end of switch (opc) + + ! Look for large constants which might be Strings. + + for (i=0 : i<8 : i++) if (OperandType->i == tLargeCon) { + if (FoundByChop(OperandValue-->i, theStrings, n_Strings)) { + OperandValue-->i = P_to_A(OperandValue-->i); + OperandType->i = tString; + } + } + + ! Print the opcode and operands. + + if (currentState == STATE_DUMP) { + print "@@64", (string) OpcodeNames-->opc; + for (i=0 : i<8 : i++) switch (OperandType->i) { + tLargeCon: ! Large constant + print " ", (hex4) OperandValue-->i; + tSmallCon: ! Small constant + print " ", (hex2) OperandValue-->i; + tVariable: ! Variable + print " ", (var) OperandValue-->i; + tOmit: ! No more operands + break; + tAddress: ! Address + print " ", (hex5) OperandValue-->i; + tObject: ! Name of object + print " ", (Zobject) OperandValue-->i; + tProperty: ! Name of property + print " ", (Zproperty) OperandValue-->i; + tAttribute: ! Name of attribute + print " ", (zAttribute) OperandValue-->i; + tString: ! Address of String + print " S", (hex5) OperandValue-->i; + } + } + + ! Deal with the optional Store/Branch/Printstring sections. + + if (opf & ST) { ! Next is a Store variable + n = GetByte(a++); + if (currentState == STATE_DUMP) print " -> ", (var) n; + } + if (opf & BR) { ! Next is a Branch offset + n = GetByte(a++); + if (currentState == STATE_DUMP) if (n & BIT07) print " "; else print " @@126"; + if (n & BIT06) ! Offset 0-63 + n = n & BITS00_05; + else { ! Signed offset + n = (n & BITS00_05) * 256 + GetByte(a++); + if (n & BIT13) n = n | $FFFFC000; + } + switch (n) { + 0: if (currentState == STATE_DUMP) print "rfalse"; + 1: if (currentState == STATE_DUMP) print "rtrue"; + default: + n = a + n - 2; + if (n > addrHWM) addrHWM = n; + if (currentState == STATE_DUMP) print (hex5) n; + } + } + if (opf & PR) { ! Next is an encoded String + if (currentState == STATE_DUMP) print " ~", (Zaddress) a, "~"; + if (currentState == STATE_EMBED) print (hex5) a, ": ", (Zaddress) a, "^"; + do { i = GetWord(a); a = a + 2; } until (i & BIT15); + } + + ! End of opcode. + + if (currentState == STATE_DUMP) { + print ";"; + if (opc == $87 or $8D) { ! print_addr, print_paddr + stringOptions = stringOptions | STR_TRUNCATE; + print " ! ~", (Zaddress) OperandValue-->0, "...~"; + stringOptions = stringOptions & ~STR_TRUNCATE; + } + new_line; + } + } until (maybeHWM && addrHWM < a); + + ! End of routine. + + if (currentState == STATE_DUMP) print " ]"; + return a; +]; + +[ SetOperandTypes n t; + OperandType->(n+0) = (t & $$11000000) / 64; + OperandType->(n+1) = (t & $$00110000) / 16; + OperandType->(n+2) = (t & $$00001100) / 4; + OperandType->(n+3) = (t & $$00000011); +]; + +[ Var n; + switch (n) { + 0: print "SP"; + 1 to MAX_LOCALS: print "L", (dec2) n-1; + 16 to 255: print "G", (dec3) n-16; + default: "BUG: unexpected variable ", n; + } +]; + +! ================================================================================================= +! Miscellaneous information. + +! [ DumpPropertyDefaults +! a i; +! font off; +! new_line; +! for (a=a_CommonPropDefaults,i=1 : i<64 : a=a+2,i++) { +! DumpWord(a); print (Zproperty) i, "^"; +! } +! new_line; +! font on; +! ]; + +! [ DumpClassesToObjects ! Class numbers To Object numbers +! a i x; +! font off; +! new_line; +! a = a_ClassToObject; +! for (x=GetWord(a),a=a+2,i=0 : x : x=GetWord(a),a=a+2,i++) +! print "Class ", i, " maps to Object ", (Zname) x, "^"; +! new_line; +! font on; +! ]; + +! [ DumpIdentifiers +! a i x; +! font off; +! new_line; +! for (a=a_PropNames+2,i=1 : i"; +! } +! new_line; +! } +! new_line; +! for (i=0 : i