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