2 !% $MAX_STATIC_DATA=600000
\r
4 ! =================================================================================================
\r
5 ! INSPECTOR -- examine Z-Machine files -- Roger Firth (roger@firthworks.com)
\r
7 ! V1.1 29Jan04 - removed misleading comment from generated XML
\r
8 ! V1.0 11Nov03 - first public release
\r
10 ! This program is strictly for the curious. It reads a compiled Inform 6 .z5 or .z8 game file
\r
11 ! and attempts to display its contents.
\r
13 ! The program is a standalone Glulx utility which does not used the Inform library files.
\r
14 ! To compile it, you will need to include on the command line: $MAX_STATIC_DATA=600000
\r
15 ! and you will require the "infglk.h" header file. To run it, any Glulx interpreter should do.
\r
17 ! To make any sense of the XML data produced by the R command, you will require
\r
18 ! the Dia drawing program (http://www.lysator.liu.se/~alla/dia). Unix and Windows only.
\r
20 ! IMPORTANT NOTE: The program is much more restrictive than Ztools in the Z-Machine files that
\r
21 ! it will handle, and much less reliable. Its primary advantage is that, being written using
\r
22 ! the Inform language, it is readily amenable to being customized and extended.
\r
24 ! This program is copyright Roger Firth 2003-2004. Copying and distribution, with or without
\r
25 ! modification, are permitted in any medium without royalty provided the copyright notice and
\r
26 ! this notice are preserved.
\r
28 ! =================================================================================================
\r
29 ! These arrays should be sufficient, but may need adjusting for an enormous game.
\r
31 Constant MAX_GAME 525000; ! For a 512K Z8 game.
\r
32 Array theGame -> MAX_GAME;
\r
34 Constant MAX_ROUTINES 3000; ! Packed Routine addresses.
\r
35 Array theRoutines --> MAX_ROUTINES;
\r
37 Constant MAX_STRINGS 5000; ! Packed String addresses.
\r
38 Array theStrings --> MAX_STRINGS;
\r
40 Constant MAX_ROOMS 200; ! Rooms (for XML map).
\r
41 Array theRooms --> MAX_ROOMS;
\r
43 Constant MAX_DIRPROPS 12; ! Exits from rooms (for XML map).
\r
44 Array DirPropNums --> MAX_DIRPROPS;
\r
46 Array DirPropNames -->
\r
47 "n_to" "s_to" "e_to" "w_to"
\r
48 "ne_to" "sw_to" "nw_to" "se_to"
\r
49 "u_to" "d_to" "in_to" "out_to";
\r
51 Array NfromRoom --> MAX_ROOMS;
\r
52 Array SfromRoom --> MAX_ROOMS;
\r
53 Array EfromRoom --> MAX_ROOMS;
\r
54 Array WfromRoom --> MAX_ROOMS;
\r
55 Array NEfromRoom --> MAX_ROOMS;
\r
56 Array SWfromRoom --> MAX_ROOMS;
\r
57 Array NWfromRoom --> MAX_ROOMS;
\r
58 Array SEfromRoom --> MAX_ROOMS;
\r
59 Array UfromRoom --> MAX_ROOMS;
\r
60 Array DfromRoom --> MAX_ROOMS;
\r
61 Array INfromRoom --> MAX_ROOMS;
\r
62 Array OUTfromRoom --> MAX_ROOMS;
\r
64 Array theExits --> ! Simulate a two-dimensional array.
\r
65 NfromRoom SfromRoom EfromRoom WfromRoom
\r
66 NEfromRoom SWfromRoom NWfromRoom SEfromRoom
\r
67 UfromRoom DfromRoom INfromRoom OUTfromRoom;
\r
69 Constant MAX_DOORS 50; ! Doors (for XML map).
\r
70 Array theDoors --> MAX_DOORS;
\r
72 Array doorToRoom --> MAX_DOORS;
\r
74 Constant MAX_INPUT 50; ! Line of keyboard input.
\r
75 Array theInput -> MAX_INPUT;
\r
77 Constant MAX_TOKENS 3; ! Input tokens.
\r
78 Array TokenStart -> MAX_TOKENS;
\r
79 Array TokenEnd -> MAX_TOKENS;
\r
80 Array Tokens --> MAX_TOKENS; ! Command, optional numbers.
\r
82 ! =================================================================================================
\r
83 ! Since we're not using the Glulx Inform library files, we need to set up our own Glk
\r
86 Include "infglk"; ! Use sensible names for calls to Glk.
\r
88 Array gg_arguments --> 8; ! General result passing.
\r
89 Array gg_event --> 4; ! The event handler uses a four-word array.
\r
90 Global gg_mainwin = 0; ! The main window.
\r
91 Global gg_helpwin; ! For static help info.
\r
92 Global gg_scriptfref = 0; ! Fileref for Transcripts.
\r
93 Global gg_scriptstr = 0; ! I/O Stream for Transcripts.
\r
95 Constant ANY_OLD_ROCK 0; ! Rock values don't seem necessary here.
\r
97 ! =================================================================================================
\r
98 ! General constants used by the tool.
\r
100 Constant NO_GAME_OPEN "Use ~N~ to open a new .Z5 or .Z8 game file.";
\r
102 Constant MAX_LOCALS 15; ! First byte of a routine.
\r
103 Constant STR_TRUNC_TO 20; ! Characters to show with @print_addr, @print_paddr
\r
105 Constant BIT00 $0001;
\r
106 Constant BIT01 $0002;
\r
107 Constant BIT02 $0004;
\r
108 Constant BIT03 $0008;
\r
109 Constant BIT04 $0010;
\r
110 Constant BIT05 $0020;
\r
111 Constant BIT06 $0040;
\r
112 Constant BIT07 $0080;
\r
113 Constant BIT08 $0100;
\r
114 Constant BIT09 $0200;
\r
115 Constant BIT10 $0400;
\r
116 Constant BIT11 $0800;
\r
117 Constant BIT12 $1000;
\r
118 Constant BIT13 $2000;
\r
119 Constant BIT14 $4000;
\r
120 Constant BIT15 $8000;
\r
122 Constant BITS00_04 BIT00+BIT01+BIT02+BIT03+BIT04;
\r
123 Constant BITS05_09 BIT05+BIT06+BIT07+BIT08+BIT09;
\r
124 Constant BITS10_14 BIT10+BIT11+BIT12+BIT13+BIT14;
\r
126 Constant BITS00_03 BIT00+BIT01+BIT02+BIT03;
\r
127 Constant BITS00_05 BITS00_04+BIT05;
\r
128 Constant BITS00_09 BITS00_04+BITS05_09;
\r
129 Constant BITS00_14 BITS00_09+BITS10_14;
\r
131 Constant HDR_ZCODEVERSION $00; ! byte
\r
132 Constant HDR_TERPFLAGS $01; ! byte
\r
133 Constant HDR_GAMERELEASE $02; ! word
\r
134 Constant HDR_HIGHMEMORY $04; ! word
\r
135 Constant HDR_INITIALPC $06; ! word
\r
136 Constant HDR_DICTIONARY $08; ! word
\r
137 Constant HDR_OBJECTS $0A; ! word
\r
138 Constant HDR_GLOBALS $0C; ! word
\r
139 Constant HDR_STATICMEMORY $0E; ! word
\r
140 Constant HDR_GAMEFLAGS $10; ! word
\r
141 Constant HDR_GAMESERIAL $12; ! six ASCII characters
\r
142 Constant HDR_ABBREVIATIONS $18; ! word
\r
143 Constant HDR_FILELENGTH $1A; ! word
\r
144 Constant HDR_CHECKSUM $1C; ! word
\r
145 Constant HDR_TERPNUMBER $1E; ! byte
\r
146 Constant HDR_TERPVERSION $1F; ! byte
\r
147 Constant HDR_SCREENHLINES $20; ! byte
\r
148 Constant HDR_SCREENWCHARS $21; ! byte
\r
149 Constant HDR_SCREENWUNITS $22; ! word
\r
150 Constant HDR_SCREENHUNITS $24; ! word
\r
151 Constant HDR_FONTWUNITS $26; ! byte
\r
152 Constant HDR_FONTHUNITS $27; ! byte
\r
153 Constant HDR_ROUTINEOFFSET $28; ! word
\r
154 Constant HDR_STRINGOFFSET $2A; ! word
\r
155 Constant HDR_BGCOLOUR $2C; ! byte
\r
156 Constant HDR_FGCOLOUR $2D; ! byte
\r
157 Constant HDR_TERMCHARS $2E; ! word
\r
158 Constant HDR_PIXELSTO3 $30; ! word
\r
159 Constant HDR_TERPSTANDARD $32; ! two bytes
\r
160 Constant HDR_ALPHABET $34; ! word
\r
161 Constant HDR_EXTENSION $36; ! word
\r
162 Constant HDR_UNUSED $38; ! two words
\r
163 Constant HDR_INFORMVERSION $3C; ! four ASCII characters
\r
164 Constant HDR_ENDOFDATA $40; ! Next table starts here
\r
166 Constant HDREXTN_SIZE $00; ! word
\r
167 Constant HDREXTN_MOUSEX $02; ! word
\r
168 Constant HDREXTN_MOUSEY $04; ! word
\r
169 Constant HDREXTN_UNICODE $06; ! word
\r
171 Array Bit --> ! Used to match Attribute bits.
\r
172 BIT00 BIT01 BIT02 BIT03 BIT04 BIT05 BIT06 BIT07 BIT08 BIT09 BIT10 BIT11 BIT12 BIT13 BIT14 BIT15;
\r
174 Array a_LocalAlpha -> ! Used to unpack ZSCII strings.
\r
175 '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
176 '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
177 ' ' '^' '0' '1' '2' '3' '4' '5' '6' '7' '8' '9' '.' ',' '!' '?' '_' '#' 039 '"' '/' '\' '-' ':' '(' ')';
\r
179 Array a_LocalUnicode -> ! Used to print 'extra' ZSCII characters.
\r
180 69 ! Number of 16-bit entries
\r
181 $00 $E4 $00 $F6 $00 $FC $00 $C4 $00 $D6 $00 $DC $00 $DF $00 $BB
\r
182 $00 $AB $00 $EB $00 $EF $00 $FF $00 $CB $00 $CF $00 $E1 $00 $E9
\r
183 $00 $ED $00 $F3 $00 $FA $00 $FD $00 $C1 $00 $C9 $00 $CD $00 $D3
\r
184 $00 $DA $00 $DD $00 $E0 $00 $E8 $00 $EC $00 $F2 $00 $F9 $00 $C0
\r
185 $00 $C8 $00 $CC $00 $D2 $00 $D9 $00 $E2 $00 $EA $00 $EE $00 $F4
\r
186 $00 $FB $00 $C2 $00 $CA $00 $CE $00 $D4 $00 $DB $00 $E5 $00 $C5
\r
187 $00 $F8 $00 $D8 $00 $E3 $00 $F1 $00 $F5 $00 $C3 $00 $D1 $00 $D5
\r
188 $00 $E6 $00 $C6 $00 $E7 $00 $C7 $00 $FE $00 $F0 $00 $DE $00 $D0
\r
189 $00 $A3 $01 $53 $01 $52 $00 $A1 $00 $BF;
\r
191 ! =================================================================================================
\r
192 ! Variables used by the tool.
\r
194 Global modePause = false; ! Pause after each screenful?
\r
195 Global modeTranscript = false; ! Write a Transcript file?
\r
196 Global modeExpand = false; ! Expand Property and Action Routines?
\r
198 Global currentState; ! Tool state:
\r
199 Constant STATE_IDLE 0; ! No game open.
\r
200 Constant STATE_DECODE 1; ! Analysing the game.
\r
201 Constant STATE_DUMP 2; ! Displaying general game info.
\r
202 Constant STATE_EMBED 3; ! Displaying embedded strings.
\r
204 Global stringOptions; ! Control string printing:
\r
205 Constant STR_NO_SPACES BIT00; ! Map " " to "_".
\r
206 Constant STR_NO_QUOTES BIT01; ! Map "'" to "^".
\r
207 Constant STR_UPPERCASE BIT02; ! Fold alpha to upper case.
\r
208 Constant STR_TRUNCATE BIT03; ! Show only start of strings.
\r
209 Constant STR_MULTILINE BIT04; ! Map " " to newline.
\r
211 Global zcodeVersion; ! Z-Machine version 1-8
\r
212 Global informVersion; ! Compiler version 5-6
\r
213 Global p_Multiplier; ! Packed addr multiplier
\r
215 Global i_FirstUserObject; ! Obj number for (LibraryMessages)
\r
217 Global n_Actions; ! Number of Action routines
\r
218 Global n_ArrayNames; ! Number of Array names
\r
219 Global n_AttrNames; ! Number of Attribute names
\r
220 Global n_Classes; ! Number of Classes
\r
221 Global n_DictEntries; ! Number of Dictionary entries
\r
222 Global n_Objects; ! Number of Objects (inc Classes)
\r
223 Global n_Opcodes; ! Number of Opcodes
\r
224 Global n_PropNames; ! Number of Property names
\r
225 Global n_Rooms; ! Number of Rooms
\r
226 Global n_Doors; ! Number of Doors
\r
227 Global n_Routines; ! Number of Routines
\r
228 Global n_Strings; ! Number of Strings
\r
229 Global n_Verbs; ! Number of Verb grammars
\r
231 Global a_Header; ! ZM11 ZMxB
\r
232 Global a_StringPool; ! TM8.3
\r
233 Global a_LowStrings; ! TM8.5
\r
234 Global a_Abbrevs; ! TM8.5
\r
235 Global a_HeaderExtn; ! TM8.5
\r
236 Global a_GameAlpha; ! ZM3.5 TM8.5
\r
237 Global a_GameUnicode; ! ZM3.8.5 TM8.3 TM8.5
\r
238 Global a_CommonPropDefaults; ! ZM12.2
\r
239 Global a_Objects; ! ZM12.3 TM9.4
\r
240 Global a_CommonProps; ! ZM12.4
\r
241 Global a_ClassToObject; ! TM9.4
\r
242 Global a_PropNames; ! TM9.7
\r
243 Global a_AttrNames; ! TM9.7
\r
244 Global a_ActionNames; ! TM9.7
\r
245 Global a_ArrayNames; ! TM9.7
\r
246 Global a_IndivProps; ! TM9.5 TM9.6
\r
247 Global a_Globals; !
\r
249 Global a_TermChars; !
\r
251 Global a_StaticMemory; !
\r
252 Global a_GrammarPointers; ! TM8.6
\r
253 Global a_Grammars; !
\r
254 Global a_Actions; !
\r
255 Global a_PreActions; !
\r
256 Global a_Prepositions; !
\r
257 Global a_Dictionary; ! ZM13.1 TM8.5
\r
259 Global a_HighMemory; !
\r
260 Global a_Routines; !
\r
261 Global a_TopOfRoutines; !
\r
262 Global a_Strings; !
\r
263 Global a_TopOfGame; !
\r
265 Global p_Routines; ! ZM4 ZM5 ZM14
\r
266 Global p_Strings; ! ZM3
\r
267 Global p_TopOfGame; !
\r
269 Global a_LookupAlpha; ! Local or embedded in game.
\r
270 Global a_LookupUnicode; ! Local or embedded in game.
\r
272 ! =================================================================================================
\r
273 ! Instructions for use.
\r
276 "This tool inspects the contents of a Z-Machine game, in much the same way as
\r
277 (and much slower and less reliably than) Ztools.
\r
278 It is driven by these commands:^
\r
280 N - open a new game file.^
\r
283 P - toggle Pause mode, which waits for a keypress after each screen.^
\r
284 T - toggle Transcript mode, which writes the output to a file.^
\r
285 X - toggle eXpanded mode, which shows Property and Action routines.^
\r
287 A - display All (Map, Header, Objects, Grammar).^
\r
288 D - display memory Dump in hex.^
\r
289 E - display print strings Embedded in Z-code.^
\r
290 G - display verb Grammar.^
\r
291 H - display Header information.^
\r
292 L - display Low-memory strings.^
\r
293 M - display Memory map.^
\r
294 O - display Objects [long].^
\r
295 R - display Rooms and connections in XML for Dia drawing tool [long].^
\r
296 S - display high-memory Strings [long].^
\r
297 V - display dictionary Vocabulary.^
\r
298 Z - display Z-code routines [long].^
\r
300 ? - display these instructions.";
\r
304 "Start/stop: ", (b) "N", "ew, ", (b) "Q", "uit. Modes: ", (b) "P", "ause, ", (b) "T", "ranscript, e", (b) "X", "panded.^
\r
305 Dumping: ", (b) "O", "bjects, ", (b) "S", "trings, ", (b) "L", "ow strings, ", (b) "E", "mbedded strings, ", (b) "G", "rammar, ",
\r
306 (b) "V", "ocabulary, ", (b) "H", "eader, ", (b) "M", "emory map, ", (b) "Z", "-code, ", (b) "R", "ooms, ", (b) "A", "ll";
\r
311 glk_set_style(style_Emphasized);
\r
312 print (string) text;
\r
313 glk_set_style(style_Normal);
\r
316 ! =================================================================================================
\r
317 ! This is the top-level control loop.
\r
321 @setiosys 2 0; ! Set Glk as the VM's I/O layer.
\r
322 gg_mainwin = ! Open the main window.
\r
323 glk_window_open(0, 0, 0, wintype_TextBuffer, ANY_OLD_ROCK);
\r
325 glk_window_open(gg_mainwin, winmethod_Above+winmethod_Fixed, 3, wintype_TextBuffer, ANY_OLD_ROCK);
\r
326 glk_set_window(gg_helpwin);
\r
328 glk_set_window(gg_mainwin); ! Make the main window the current window.
\r
330 glk_set_style(style_Header);
\r
332 glk_set_style(style_Normal);
\r
333 print "^A tool for examining v5 and v8 Z-code files created by Inform 6.^^";
\r
334 ShowHelp(); ! Explain what they can do.
\r
336 while (true) { ! Loop here until "Q" typed.
\r
338 if (modePause) print "P"; else print "-";
\r
339 if (modeTranscript) print "T"; else print "-";
\r
340 if (modeExpand) print "X"; else print "-";
\r
341 print "> "; ! Prompt for a line of input.
\r
342 if (~~ParseLine()) continue; ! Nothing typed
\r
343 Tokens-->0 = theInput->(TokenStart->0);
\r
344 Tokens-->1 = ParseNumber(TokenStart->1, TokenEnd->1);
\r
345 Tokens-->2 = ParseNumber(TokenStart->2, TokenEnd->2);
\r
346 switch (Tokens-->0) { ! Deal with the character, then loop back.
\r
347 'A','a': if (~~currentState) print (string) NO_GAME_OPEN, "^";
\r
354 'D','d': DumpData();
\r
355 'E','e': DumpEmbedded();
\r
356 'G','g': DumpGrammar();
\r
357 'H','h': DumpHeader();
\r
358 'L','l': DumpLowStrings();
\r
359 'M','m': DumpMemoryMap();
\r
361 'O','o': DumpObjects();
\r
362 'P','p': DoPause();
\r
364 'R','r': DumpRooms();
\r
365 'S','s': DumpStrings();
\r
366 'T','t': DoTranscript();
\r
367 'V','v': DumpVocab();
\r
368 'X','x': DoExpand();
\r
369 'Z','z': DumpZcode();
\r
370 '?','/': ShowHelp();
\r
371 default: print "Possible keys are N, Q, P|T|X, A|D|E|G|H|L|M|O|R|S|V|Z and ?^";
\r
376 ! [ InputChar; ! Input one keystroke.
\r
377 ! glk_request_char_event(gg_mainwin);
\r
378 ! while (true) { ! Wait for a key to be pressed.
\r
379 ! glk_select(gg_event); ! CharInput is th only interesting event.
\r
380 ! if (gg_event-->0 == evtype_CharInput && gg_event-->1 == gg_mainwin)
\r
381 ! return gg_event-->2; ! Got a character.
\r
385 [ InputLine buf buflen; ! Input a line of characters.
\r
386 glk_request_line_event(gg_mainwin, buf, buflen, 0);
\r
387 while (true) { ! Wait for RETURN to be pressed.
\r
388 glk_select(gg_event); ! LineInput is the only interesting event.
\r
389 if (gg_event-->0 == evtype_LineInput && gg_event-->1 == gg_mainwin)
\r
390 return (gg_event-->2); ! Number of characters.
\r
394 [ ParseLine ! Read line of input, find tokens
\r
396 for (i=0 : i<MAX_TOKENS : i++) TokenStart->i = TokenEnd->i = 0;
\r
397 n = InputLine(theInput, MAX_INPUT);
\r
398 glk_select_poll(gg_event);
\r
399 if (n == 0) rfalse; ! Nothing typed.
\r
400 for (i=j=0 : i<MAX_TOKENS : i++) {
\r
401 while (theInput->j == ' ' or ',') {
\r
403 if (j >= n) return i;
\r
406 while (theInput->j ~= ' ' or ',') {
\r
409 if (j >= n) return i+1;
\r
415 [ ParseNumber a b ! Parse token as bin/dec/hex number.
\r
417 if (a == b) return -1;
\r
418 base = 10; num = 0;
\r
420 if (theInput->i == '-') i++;
\r
421 if (theInput->i == '$') {
\r
423 if (theInput->i == '$') { base = 2; i++; }
\r
425 for ( : i<b : i++) {
\r
426 char = theInput->i;
\r
427 if (char >= '0' && char <= '9') char = char - '0';
\r
429 if (char >= 'A' && char <= 'Z') char = char - 'A' + 10;
\r
431 if (char >= 'a' && char <= 'z') char = char - 'a' + 10;
\r
435 if (char < base) num = (num * base) + char;
\r
438 if (theInput->a == '-') num = -num;
\r
442 ! =================================================================================================
\r
443 ! Quit from the utility.
\r
446 print "Hit any key to exit.^"; quit;
\r
449 ! =================================================================================================
\r
450 ! Toggle Pause mode.
\r
453 if (modePause) { ! Toggle to OFF.
\r
455 "Pause mode now off.";
\r
457 else { ! Toggle to ON.
\r
459 "Pause mode now on.";
\r
463 ! =================================================================================================
\r
464 ! Toggle Transcript mode.
\r
467 if (modeTranscript) { ! Toggle to OFF.
\r
468 glk_stream_close(gg_scriptstr); ! Close the Transcript stream.
\r
470 modeTranscript = false;
\r
471 "Transcript mode now off.";
\r
473 else { ! Toggle to ON.
\r
474 if (gg_scriptfref == 0) {
\r
475 gg_scriptfref = ! Create a fileref for the Transcript.
\r
476 glk_fileref_create_by_prompt(fileusage_TextMode+fileusage_Transcript, filemode_WriteAppend, ANY_OLD_ROCK);
\r
477 if (gg_scriptfref == GLK_NULL) "Failed to create Transcript fileref.";
\r
479 gg_scriptstr = ! Open a stream to write the transcript file.
\r
480 glk_stream_open_file(gg_scriptfref, filemode_WriteAppend, ANY_OLD_ROCK);
\r
481 if (gg_scriptstr == GLK_NULL) "failed to open Transcript stream.";
\r
482 ! Echo everything to the Transcript.
\r
483 glk_window_set_echo_stream(gg_mainwin, gg_scriptstr);
\r
484 modeTranscript = true;
\r
485 "Transcript mode now on.";
\r
489 ! =================================================================================================
\r
490 ! Toggle Expanded mode (for Property and Action routines).
\r
493 if (modeExpand) { ! Toggle to OFF.
\r
494 modeExpand = false;
\r
495 "Expand mode now off.";
\r
497 else { ! Toggle to ON.
\r
499 "Expand mode now on.";
\r
503 ! =================================================================================================
\r
504 ! Memory access routines.
\r
506 [ GetByte a; return theGame->a; ];
\r
507 [ GetWord a; return (theGame->a) * $00100 + theGame->(a+1); ];
\r
509 [ W_To_A a; return a * 2; ];
\r
510 [ P_To_A a; return a * p_Multiplier; ];
\r
511 [ A_To_P a; return a / p_Multiplier; ];
\r
514 b; b = p_Multiplier-1; return (a + b) & ~b;
\r
517 ! =================================================================================================
\r
520 [ dec2 x; if (x<10) print "0"; print x; ];
\r
521 [ dec3 x; if (x<10) print "0"; if (x<100) print "0"; print x; ];
\r
523 [ hex2 x; print (hchar) x & $000FF; ];
\r
524 [ hex4 x; print (hchar) (x & $0FF00) / $00100, (hchar) x & $000FF; ];
\r
525 [ hex5 x; print (hdigit) (x & $F0000) / $10000, (hchar) (x & $0FF00) / $00100, (hchar) x & $000FF; ];
\r
526 [ hchar x; print (hdigit) (x & $000F0) / $00010, (hdigit) x & $0000F; ];
\r
527 [ hdigit x; if ((x = x%$10) < 10) print x; else print (char) x-10+'A'; ];
\r
529 Constant EXPECTING_A0 0; ! character in Alphabet 0
\r
530 Constant EXPECTING_A1 1; ! character in Alphabet 1
\r
531 Constant EXPECTING_A2 2; ! character in Alphabet 2
\r
532 Constant EXPECTING_B1 3; ! low string 0-31
\r
533 Constant EXPECTING_B2 4; ! abbreviation 0-31
\r
534 Constant EXPECTING_B3 5; ! abbreviation 32-63
\r
535 Constant EXPECTING_Z1 6; ! high bits of ZSCII character
\r
536 Constant EXPECTING_Z2 7; ! low bits of ZSCII character
\r
538 [ Zaddress a ! Print string at byte address.
\r
539 w c d i n theState;
\r
541 theState = EXPECTING_A0;
\r
543 w = GetWord(a); a = a + 2;
\r
544 for (i=0 : i<3 : i++) {
\r
546 0: c = (w & BITS10_14) / BIT10;
\r
547 1: c = (w & BITS05_09) / BIT05;
\r
548 2: c = (w & BITS00_04);
\r
550 switch (theState) {
\r
551 EXPECTING_A0: ! character in Alphabet 0
\r
553 0: n = n + Zchar(' ');
\r
554 1: theState = EXPECTING_B1;
\r
555 2: theState = EXPECTING_B2;
\r
556 3: theState = EXPECTING_B3;
\r
557 4: theState = EXPECTING_A1;
\r
558 5: theState = EXPECTING_A2;
\r
560 n = n + Zchar(a_LookupAlpha->(c-6));
\r
562 EXPECTING_A1: ! character in Alphabet 1
\r
564 0: n = n + Zchar(' ');
\r
565 theState = EXPECTING_A0;
\r
566 1: theState = EXPECTING_B1;
\r
567 2: theState = EXPECTING_B2;
\r
568 3: theState = EXPECTING_B3;
\r
569 4: theState = EXPECTING_A1;
\r
570 5: theState = EXPECTING_A2;
\r
572 n = n + Zchar(a_LookupAlpha->(c-6+26));
\r
573 theState = EXPECTING_A0;
\r
575 EXPECTING_A2: ! character in Alphabet 2
\r
577 0: n = n + Zchar(' ');
\r
578 theState = EXPECTING_A0;
\r
579 1: theState = EXPECTING_B1;
\r
580 2: theState = EXPECTING_B2;
\r
581 3: theState = EXPECTING_B3;
\r
582 4: theState = EXPECTING_A1;
\r
583 5: theState = EXPECTING_A2;
\r
584 6: theState = EXPECTING_Z1;
\r
585 7: n = n + Zchar(13);
\r
586 theState = EXPECTING_A0;
\r
588 n = n + Zchar(a_LookupAlpha->(c-6+52));
\r
589 theState = EXPECTING_A0;
\r
591 EXPECTING_B1: ! low strings 00-31
\r
592 print "@@64", (dec2) c; n = n + 3;
\r
593 theState = EXPECTING_A0;
\r
594 EXPECTING_B2: ! abbreviations 00-31
\r
595 n = n + Zaddress(W_To_A(GetWord(a_Abbrevs+2*c))); ! recurse
\r
596 theState = EXPECTING_A0;
\r
597 EXPECTING_B3: ! abbreviations 32-63
\r
598 n = n + Zaddress(W_To_A(GetWord(a_Abbrevs+2*c+64))); ! recurse
\r
599 theState = EXPECTING_A0;
\r
600 EXPECTING_Z1: ! hi bits of ZSCII character
\r
602 theState = EXPECTING_Z2;
\r
603 EXPECTING_Z2: ! lo bits of ZSCII character
\r
604 n = n + Zchar(d+c);
\r
605 theState = EXPECTING_A0;
\r
608 } until (w & BIT15 || ((stringOptions & STR_TRUNCATE) && n > STR_TRUNC_TO));
\r
609 return n; ! number of characters output
\r
612 [ Zchar c; ! Print a single ZSCII character.
\r
619 if (stringOptions & STR_NO_SPACES) c = '_';
\r
620 if (stringOptions & STR_MULTILINE) { new_line; return 1; }
\r
621 34: ! double quotes
\r
623 39: ! single quotes
\r
624 if (stringOptions & STR_NO_QUOTES) c = '^';
\r
626 print (char) 64, (char) 64, "64"; return 4;
\r
628 print (char) 64, (char) 64, "92"; return 4;
\r
630 print (char) 64, (char) 64, "94"; return 4;
\r
632 print (char) 64, (char) 64, "126"; return 5;
\r
633 32 to 126: ! ASCII -- print normally.
\r
635 155 to 251: ! ZSCII 'extra characters'
\r
637 if (c > a_LookupUnicode->0) c = '?';
\r
638 else c = a_LookupUnicode->(2*c - 1) * 256 + a_LookupUnicode->(2*c);
\r
639 default: ! Not a ZSCII character.
\r
642 if (stringOptions & STR_UPPERCASE) c = glk_char_to_upper(c);
\r
647 [ Zstring a; ! Print string at packed address.
\r
648 return Zaddress(P_To_A(a));
\r
651 [ Zname o ! Print external name of object.
\r
653 if (o == nothing) print "nothing";
\r
655 a = a_Objects + (o-1)*14;
\r
657 print (Zaddress) a+1;
\r
661 [ Zobject o ! Print internal (hardware) name of object.
\r
663 if (o == nothing) print "nothing";
\r
665 a = a_Objects + (o-1)*14;
\r
667 if(GetByte(a) == 1 && GetWord(a+1) == $94A5)
\r
670 stringOptions = stringOptions | STR_NO_SPACES;
\r
671 print (Zaddress) a+1;
\r
672 stringOptions = stringOptions & ~STR_NO_SPACES;
\r
678 [ Zproperty p ! Print name of property.
\r
683 3: print "metaclass";
\r
685 x = GetWord(a_PropNames + 2*p);
\r
686 if (x) print (Zstring) x;
\r
687 else print "<unknown property ", p, ">";
\r
690 print "(PROP", (dec3) p, ")";
\r
693 [ Zattribute q; ! Print name of attribute.
\r
695 print (Zstring) GetWord(a_AttrNames + 2*q);
\r
697 print "(ATTR", (dec2) q, ")";
\r
700 [ Zaction a; ! Print name of action.
\r
701 if (a > 255) print "(FAKE", (dec2) a-256, ")";
\r
704 print (Zstring) GetWord(a_ActionNames + 2*a);
\r
706 print "(ACTION", (dec3) a, ")";
\r
709 ! =================================================================================================
\r
710 ! Prompt for a Z-code file, read it into the buffer, and analyse its contents.
\r
713 currentState = STATE_IDLE;
\r
714 if (ReadTheFile(theGame, MAX_GAME)) return;
\r
715 currentState = STATE_DECODE;
\r
716 if (DecodeTheGame()) return;
\r
717 currentState = STATE_DUMP;
\r
719 print "^Game contents:^";
\r
720 print " Actions ", n_Actions, "^";
\r
721 print " Attributes ", n_AttrNames, "^";
\r
722 print " Classes ", n_Classes, "^";
\r
723 print " Dictionary ", n_DictEntries, "^";
\r
724 print " Objects ", n_Objects, "^";
\r
725 print " Properties ", n_PropNames, "^";
\r
726 print " Routines ", n_Routines, "^";
\r
727 print " Strings ", n_Strings, "^";
\r
728 print " Verbs ", n_Verbs, "^";
\r
732 [ ReadTheFile buf buflen
\r
734 fileref = glk_fileref_create_by_prompt(fileusage_BinaryMode+fileusage_Data, filemode_Read, ANY_OLD_ROCK);
\r
735 if (fileref == GLK_NULL) "Failed to create Game fileref.";
\r
736 stream = glk_stream_open_file(fileref, filemode_Read, ANY_OLD_ROCK);
\r
737 if (stream == GLK_NULL) "Failed to open Game stream.";
\r
738 glk_fileref_destroy(fileref);
\r
739 glk_get_buffer_stream(stream, buf, buflen);
\r
740 rfalse; ! Successful -- OK to continue.
\r
746 ! Check which Game/Compiler versions we're dealing with
\r
749 a_StringPool = a_Header+HDR_ENDOFDATA;
\r
750 a_HeaderExtn = GetWord(a_Header+HDR_EXTENSION);
\r
752 zcodeVersion = GetByte(a_Header+HDR_ZCODEVERSION);
\r
753 switch (zcodeVersion) {
\r
754 1,2,3: p_Multiplier = 2; "Sorry -- Z-machine version ", zcodeVersion, " not supported.";
\r
755 4,6,7: p_Multiplier = 4; "Sorry -- Z-machine version ", zcodeVersion, " not supported.";
\r
756 5: p_Multiplier = 4; ! p_Mask = $FFFFFFFC;
\r
757 8: p_Multiplier = 8; ! p_Mask = $FFFFFFF8;
\r
758 'G': "Sorry -- Glulx not supported.";
\r
759 default: "BUG: unexpected Z-Machine version number.";
\r
761 informVersion = GetByte(a_Header+HDR_INFORMVERSION);
\r
762 switch (informVersion) {
\r
763 '5': "Sorry -- Inform 5 not supported.";
\r
764 '6': informVersion = informVersion - '0';
\r
765 default: "BUG: unexpected Inform version number.";
\r
768 ! Initialise variables and those addresses that we know
\r
770 i_FirstUserObject = 0;
\r
776 n_Opcodes = 256 + 32; ! Standard + Extended
\r
784 a_LowStrings = GetWord(a_Header+HDR_ABBREVIATIONS);
\r
785 a_Abbrevs = a_LowStrings + 64;
\r
786 a_GameAlpha = GetWord(a_Header+HDR_ALPHABET);
\r
787 if (a_GameAlpha) a_LookupAlpha = theGame + a_GameAlpha;
\r
788 else a_LookupAlpha = a_LocalAlpha;
\r
790 a_GameUnicode = GetWord(a_HeaderExtn+HDREXTN_UNICODE);
\r
793 if (a_GameUnicode) a_LookupUnicode = theGame + a_GameUnicode;
\r
794 else a_LookupUnicode = a_LocalUnicode;
\r
795 a_CommonPropDefaults = GetWord(a_Header+HDR_OBJECTS);
\r
796 a_Objects = a_CommonPropDefaults + 126;
\r
797 a_CommonProps = GetWord(a_Objects+12);
\r
798 a_ClassToObject = 0;
\r
804 a_Globals = GetWord(a_Header+HDR_GLOBALS);
\r
805 a_Arrays = a_Globals + 480;
\r
806 a_TermChars = GetWord(a_Header+HDR_TERMCHARS);
\r
808 a_StaticMemory = GetWord(a_Header+HDR_STATICMEMORY);
\r
809 a_GrammarPointers = a_StaticMemory;
\r
810 a_Grammars = GetWord(a_GrammarPointers);
\r
813 a_Prepositions = 0;
\r
814 a_Dictionary = GetWord(a_Header+HDR_DICTIONARY);
\r
816 a_HighMemory = GetWord(a_Header+HDR_HIGHMEMORY);
\r
817 a_Routines = a_HighMemory;
\r
818 p_Routines = A_To_P(a_Routines);
\r
820 p_TopOfGame = GetWord(a_Header+HDR_FILELENGTH);
\r
821 a_TopOfGame = P_To_A(p_TopOfGame);
\r
822 a_TopOfRoutines = 0;
\r
823 a_Strings = a_TopOfGame;
\r
824 p_Strings = p_TopOfGame;
\r
826 ! Process the objects.
\r
828 for (a=a_Objects : a<a_CommonProps : a=a+14) {
\r
829 n_Objects++; ! Object's number
\r
830 if (n_Objects%100 == 0) { print "*"; glk_select_poll(gg_event); }
\r
831 b = GetWord(a+12); ! Object's property table
\r
832 c = GetByte(b++); ! #words of shortname
\r
833 if (CompareStrings("(LibraryMessages)", Zname, n_Objects, n_Objects+1))
\r
834 i_FirstUserObject = n_Objects;
\r
835 b = DoProperties(b+c+c); ! First property block
\r
836 if (GetWord(a+6) == 1 || n_Objects <= 4) ! It's a Class
\r
837 b = DoProperties(b+6); ! Inheritance property block
\r
840 ! Process the classes-to-objects table, which starts after the Objects.
\r
842 a_ClassToObject = b;
\r
843 for (a=GetWord(b),b=b+2 : a : a=GetWord(b),b=b+2) n_Classes++;
\r
845 ! Process the names of Properties, Attributes, Actions and Arrays,
\r
846 ! which start after the classes-to-objects table.
\r
849 n_PropNames = GetWord(b); ! Actually, numNames + 1
\r
850 a_AttrNames = a_PropNames + (n_PropNames * 2);
\r
851 a_ActionNames = a_AttrNames + (n_AttrNames * 2);
\r
853 ! Process the Grammars (Version 2 only).
\r
855 for (a=a_GrammarPointers : a<a_Grammars : a=a+2,n_Verbs++) {
\r
856 b = GetWord(a); ! address of grammar
\r
857 c = GetByte(b++); ! number of grammar lines
\r
859 b = b + 2; ! skip action number
\r
860 while (GetByte(b++) ~= 15)
\r
861 b = b + 2; ! skip rest of token
\r
865 while (GetWord(b) && b < a_Dictionary) { b = b + 2; n_Actions++; }
\r
868 ! Process the dictionary.
\r
870 n_DictEntries = GetWord(a_Dictionary + GetByte(a_Dictionary) + 2);
\r
872 ! This next bit is not true, since we haven't counted the Fake Actions.
\r
873 ! At the moment, they are included with the Array Names.
\r
875 a_ArrayNames = a_ActionNames + (n_Actions * 2);
\r
876 n_ArrayNames = (a_IndivProps - a_ArrayNames) / 2;
\r
878 ! Process the Z-code.
\r
882 while (GetByte(a) > MAX_LOCALS) a = P_RoundUp(a+1);
\r
883 if (n_Routines >= MAX_ROUTINES-1) "Too many routines: increase MAX_ROUTINES and recompile.";
\r
884 theRoutines-->n_Routines++ = A_To_P(a);
\r
885 a = P_RoundUp(DumpRoutine(a));
\r
886 if (n_Routines%100 == 0) { print "*"; glk_select_poll(gg_event); }
\r
887 } until (a > a_TopOfRoutines);
\r
889 ! This bit is dubious -- there may be another routine, so we
\r
890 ! look for a small number of local variables (strings are
\r
891 ! unlikely to start with these values).
\r
893 if (GetByte(a) < 4) { ! MAX_LOCALS is too big to be safe here
\r
894 if (n_Routines >= MAX_ROUTINES-1) "Too many routines: increase MAX_ROUTINES and recompile.";
\r
895 theRoutines-->n_Routines++ = A_To_P(a);
\r
896 a = P_RoundUp(DumpRoutine(a));
\r
898 a_TopOfRoutines = a;
\r
900 ! The Strings start right after the Routines.
\r
902 a_strings = a_TopOfRoutines;
\r
903 p_Strings = A_To_P(a_Strings);
\r
904 for (a=a_Strings : a<a_TopOfGame : a=P_RoundUp(a)) {
\r
905 if (n_Strings >= MAX_STRINGS-1) "Too many strings: increase MAX_STRINGS and recompile.";
\r
906 theStrings-->n_Strings++ = A_To_P(a);
\r
907 do { c = GetWord(a); a = a + 2; } until (c & BIT15);
\r
908 if (n_Strings%100 == 0) { print "*"; glk_select_poll(gg_event); }
\r
911 rfalse; ! Successful -- OK to continue.
\r
914 Constant MAX_STRINGBUF 50;
\r
915 Array stringBuf1 -> MAX_STRINGBUF;
\r
916 Array stringBuf2 -> MAX_STRINGBUF;
\r
918 [ CompareStrings str printrule val1 val2
\r
919 currStream tempStream len1 len2 i j;
\r
921 currStream = glk_stream_get_current();
\r
923 tempStream = glk_stream_open_memory(stringBuf1, MAX_STRINGBUF, filemode_Write, ANY_OLD_ROCK);
\r
924 glk_stream_set_current(tempStream);
\r
925 print (string) str;
\r
926 glk_stream_close(tempStream, gg_arguments);
\r
927 len1 = gg_arguments-->1;
\r
929 for (i=val1 : i<val2 : i++) {
\r
930 tempStream = glk_stream_open_memory(stringBuf2, MAX_STRINGBUF, filemode_Write, ANY_OLD_ROCK);
\r
931 glk_stream_set_current(tempStream);
\r
933 glk_stream_close(tempStream, gg_arguments);
\r
934 len2 = gg_arguments-->1;
\r
936 glk_stream_set_current(currStream);
\r
937 if (len1 ~= len2) continue; ! Try next value
\r
938 for (j=0 : j<len1 : j++) if (stringBuf1->j ~= stringBuf2->j) jump tryNext;
\r
939 return i; ! Found a match
\r
942 rfalse; ! Failed to match any.
\r
945 ! =================================================================================================
\r
946 ! Dump the game in hex.
\r
950 if (~~currentState) print_ret (string) NO_GAME_OPEN;
\r
954 i = Tokens-->1; if (i == -1) i = 0; else i = (i / $10) * $10;
\r
955 j = Tokens-->2; if (j == -1) j = i;
\r
956 if (j < i) j = i + j;
\r
957 j = ((j + $10) / $10) * $10;
\r
958 for ( : i<j : i=i+$10) {
\r
959 print (hex5) i, ": ";
\r
960 for (k=i : k<i+16 : k=k+4) {
\r
961 for (m=0 : m<4 : m++)
\r
962 if (k+m < a_TopOfGame) print (hchar) GetByte(k+m); else print "xx";
\r
970 ! =================================================================================================
\r
971 ! Show all low-memory strings.
\r
975 if (~~currentState) print_ret (string) NO_GAME_OPEN;
\r
979 for (a=a_StringPool : a<a_LowStrings : ) {
\r
980 print (hex5) a, ": ~", (Zaddress) a, "~^";
\r
981 do { c = GetWord(a); a = a + 2; } until (c & BIT15);
\r
986 ! =================================================================================================
\r
987 ! Show all high-memory strings.
\r
991 if (~~currentState) print_ret (string) NO_GAME_OPEN;
\r
995 for (i=0 : i<n_Strings : i++) {
\r
996 a = P_To_A(theStrings-->i);
\r
997 print (hex5) a, ": ", (Zaddress) a, "^";
\r
998 if (~~modePause) glk_select_poll(gg_event);
\r
1003 ! =================================================================================================
\r
1004 ! Show Strings embedded in @print and @print_ret statements.
\r
1008 if (~~currentState) print_ret (string) NO_GAME_OPEN;
\r
1010 currentState = STATE_EMBED;
\r
1013 for (i=0 : i<n_Routines : i++) {
\r
1014 DumpRoutine(P_To_A(theRoutines-->i));
\r
1015 if (~~modePause) glk_select_poll(gg_event);
\r
1018 currentState = STATE_DUMP;
\r
1021 ! =================================================================================================
\r
1022 ! Show the dictionary.
\r
1026 if (~~currentState) print_ret (string) NO_GAME_OPEN;
\r
1030 for (a=a_Dictionary+GetByte(a_Dictionary)+4,n=n_DictEntries : n-- : a=a+9) {
\r
1031 if (GetByte(a+6) & BIT00) ! Is this a verb?
\r
1032 stringOptions = stringOptions | STR_UPPERCASE;
\r
1034 stringOptions = stringOptions & ~STR_UPPERCASE;
\r
1035 if (++y == 6) { new_line; y = 0; }
\r
1042 ! =================================================================================================
\r
1043 ! Show all verb grammars.
\r
1045 Array DoneVerb -> 256;
\r
1046 Array ActionsUsed --> 1000;
\r
1049 a b n m v tt td n_ActionsUsed;
\r
1050 if (~~currentState) print_ret (string) NO_GAME_OPEN;
\r
1054 for (n=0 : n<256 : n++) DoneVerb->n = false;
\r
1056 for (a=a_Dictionary+GetByte(a_Dictionary)+4,n=n_DictEntries : n-- : a=a+9) {
\r
1057 if (GetByte(a+6) & BIT00 == 0) continue; ! Not a verb
\r
1058 v = GetByte(a+7); ! Verb number (from 255 downwards).
\r
1059 if (DoneVerb->v) continue; ! Already processed.
\r
1060 DoneVerb->v = true;
\r
1061 print "Verb '", (Zaddress) a, "'";
\r
1062 for (b=a+9,m=n-1 : m-- : b=b+9)
\r
1063 if (GetByte(b+7) == v) print " '", (Zaddress) b, "'";
\r
1064 b = GetWord(a_GrammarPointers + (255-v)*2);
\r
1065 m = GetByte(b++); ! Number of grammar lines.
\r
1066 n_ActionsUsed = 0; ! Action routines for this verb.
\r
1068 v = GetWord(b); b = b + 2; ! Action number
\r
1070 for (tt=GetByte(b++) : tt~=15 : tt=GetByte(b++)) {
\r
1071 td = GetWord(b); b = b + 2;
\r
1072 if (tt & BIT04) print "/"; else print " ";
\r
1073 switch (tt & BITS00_03) {
\r
1078 3: print "multiheld";
\r
1079 4: print "multiexcept";
\r
1080 5: print "multiinside";
\r
1081 6: print "creature";
\r
1082 7: print "number";
\r
1083 8: print "special";
\r
1085 default: print "????";
\r
1087 2: print "'", (Zaddress) td, "'";
\r
1088 3: print "noun=[; $", (hex5) P_to_A(td), " ]";
\r
1089 4: print (Zattribute) td;
\r
1090 5: print "scope=[; $", (hex5) P_to_A(td), " ]";
\r
1091 6: print "[; $", (hex5) P_to_A(td), " ]";
\r
1096 print " -> ", (Zaction) v & BITS00_09;
\r
1097 if (v & BIT10) print " reverse";
\r
1098 v = P_To_A(GetWord(a_Actions + (v & BITS00_09) * 2));
\r
1099 print " ! [; $", (hex5) v, " ]";
\r
1100 if (modeExpand && ~~FoundByScan(v, ActionsUsed, n_ActionsUsed))
\r
1101 ActionsUsed-->n_ActionsUsed++ = v;
\r
1103 new_line; new_line;
\r
1104 if (modeExpand) for (m=0 : m<n_ActionsUsed : m++) {
\r
1106 DumpRoutine(ActionsUsed-->m);
\r
1107 new_line; new_line;
\r
1109 if (~~modePause) glk_select_poll(gg_event);
\r
1114 ! =================================================================================================
\r
1115 ! Show contents of the game's header.
\r
1119 if (~~currentState) print_ret (string) NO_GAME_OPEN;
\r
1123 DumpByte(a_Header+HDR_ZCODEVERSION); print "Z-machine version^";
\r
1124 DumpByte(a_Header+HDR_TERPFLAGS); print "Interpreter flags^";
\r
1125 DumpWord(a_Header+HDR_GAMERELEASE); print "Game release^";
\r
1126 DumpByteAddr(a_Header+HDR_HIGHMEMORY); print "High memory^";
\r
1127 DumpByteAddr(a_Header+HDR_INITIALPC); print "Initial PC^";
\r
1128 DumpByteAddr(a_Header+HDR_DICTIONARY); print "Dictionary^";
\r
1129 DumpByteAddr(a_Header+HDR_OBJECTS); print "Objects^";
\r
1130 DumpByteAddr(a_Header+HDR_GLOBALS); print "Global variables^";
\r
1131 DumpByteAddr(a_Header+HDR_STATICMEMORY); print "Static memory^";
\r
1132 x = DumpWord(a_Header+HDR_GAMEFLAGS); print "Game flags: ";
\r
1133 if (x & BIT15) print "BIT_F ";
\r
1134 if (x & BIT14) print "BIT_E ";
\r
1135 if (x & BIT13) print "BIT_D ";
\r
1136 if (x & BIT12) print "BIT_C ";
\r
1137 if (x & BIT11) print "BIT_B ";
\r
1138 if (x & BIT10) print "print_error ";
\r
1139 if (x & BIT09) print "BIT_9 ";
\r
1140 if (x & BIT08) print "menu ";
\r
1141 if (x & BIT07) print "sound ";
\r
1142 if (x & BIT06) print "colour ";
\r
1143 if (x & BIT05) print "mouse ";
\r
1144 if (x & BIT04) print "undo ";
\r
1145 if (x & BIT03) print "graphic ";
\r
1146 if (x & BIT02) print "BIT_2 ";
\r
1147 if (x & BIT01) print "fixed_pitch ";
\r
1148 if (x & BIT00) print "transcripting ";
\r
1150 DumpWord(a_Header+HDR_GAMESERIAL); print "Game serial: ";
\r
1151 DumpASCII(a_Header+HDR_GAMESERIAL,6); new_line;
\r
1152 DumpWord(a_Header+HDR_GAMESERIAL+2); new_line;
\r
1153 DumpWord(a_Header+HDR_GAMESERIAL+4); new_line;
\r
1154 DumpByteAddr(a_Header+HDR_ABBREVIATIONS); print "Abbreviations^";
\r
1155 DumpPackedAddr(a_Header+HDR_FILELENGTH); print "Length^";
\r
1156 DumpWord(a_Header+HDR_CHECKSUM); print "Checksum^";
\r
1157 DumpByte(a_Header+HDR_TERPNUMBER); print "Interpreter number^";
\r
1158 DumpByte(a_Header+HDR_TERPVERSION); print "Interpreter version^";
\r
1159 DumpByte(a_Header+HDR_SCREENHLINES); print "Screen height (lines)^";
\r
1160 DumpByte(a_Header+HDR_SCREENWCHARS); print "Screen width (chars)^";
\r
1161 DumpWord(a_Header+HDR_SCREENWUNITS); print "Screen width (units)^";
\r
1162 DumpWord(a_Header+HDR_SCREENHUNITS); print "Screen height (units)^";
\r
1163 DumpByte(a_Header+HDR_FONTWUNITS); print "Font width (units)^";
\r
1164 DumpByte(a_Header+HDR_FONTHUNITS); print "Font height (units)^";
\r
1165 DumpWord(a_Header+HDR_ROUTINEOFFSET); print "V6: Routines offset / 8^";
\r
1166 DumpWord(a_Header+HDR_STRINGOFFSET); print "V6: Strings offset / 8^";
\r
1167 DumpByte(a_Header+HDR_BGCOLOUR); print "Background colour^";
\r
1168 DumpByte(a_Header+HDR_FGCOLOUR); print "Foreground colour^";
\r
1169 DumpByteAddr(a_Header+HDR_TERMCHARS); print "Terminating chars^";
\r
1170 DumpWord(a_Header+HDR_PIXELSTO3); print "V6: Pixels to stream 3^";
\r
1171 DumpWord(a_Header+HDR_TERPSTANDARD); print "Interpreter conformance^";
\r
1172 DumpByteAddr(a_Header+HDR_ALPHABET); print "Alphabet^";
\r
1173 DumpByteAddr(a_Header+HDR_EXTENSION); print "Header extension^";
\r
1174 DumpWord(a_Header+HDR_UNUSED); print "-^";
\r
1175 DumpWord(a_Header+HDR_UNUSED+2); print "-^";
\r
1176 DumpWord(a_Header+HDR_INFORMVERSION); print "Inform version: ";
\r
1177 DumpASCII(a_Header+HDR_INFORMVERSION,4); new_line;
\r
1178 DumpWord(a_Header+HDR_INFORMVERSION+2); new_line;
\r
1181 if (a_HeaderExtn) {
\r
1182 DumpWord(a_HeaderExtn+HDREXTN_SIZE); print "Header extension size^";
\r
1183 DumpWord(a_HeaderExtn+HDREXTN_MOUSEX); print "Mouse X coordinates^";
\r
1184 DumpWord(a_HeaderExtn+HDREXTN_MOUSEY); print "Mouse Y coordinates^";
\r
1185 DumpByteAddr(a_HeaderExtn+HDREXTN_UNICODE); print "Unicode^";
\r
1191 val; val = GetByte(a);
\r
1192 print (hex5) a, ": ", (hex2) val, " ";
\r
1197 val; val = GetWord(a);
\r
1198 print (hex5) a, ": ", (hex4) val, " ";
\r
1203 val; val = GetWord(a);
\r
1204 print (hex5) a, ": ", (hex4) val, "b ", (hex5) val, " ";
\r
1208 [ DumpPackedAddr a
\r
1209 val; val = GetWord(a);
\r
1210 print (hex5) a, ": ", (hex4) val, "p ";
\r
1211 val = P_To_A(GetWord(a));
\r
1212 print (hex5) val, " ";
\r
1218 print "~"; for (i=0 : i<n : i++) print (char) GetByte(a+i); print "~";
\r
1221 ! =================================================================================================
\r
1222 ! Show the Z-Machine memory map.
\r
1225 if (~~currentState) print_ret (string) NO_GAME_OPEN;
\r
1229 print "Header ", (hex5) a_Header, "^";
\r
1230 print "String pool ", (hex5) a_StringPool, "^";
\r
1231 print "32 Low strings ", (hex5) a_LowStrings, "^";
\r
1232 print "64 Abbreviations ", (hex5) a_Abbrevs, "^";
\r
1233 print "Header extension ", (hex5) a_HeaderExtn, "^";
\r
1234 print "Alphabet table ", (hex5) a_GameAlpha, "^";
\r
1235 print "Unicode table ", (hex5) a_GameUnicode, "^";
\r
1236 print "Property defaults ", (hex5) a_CommonPropDefaults, "^";
\r
1237 print "Objects ", (hex5) a_Objects, "^";
\r
1238 print "Common properties ", (hex5) a_CommonProps, "^";
\r
1239 print "Class-To-Object ", (hex5) a_ClassToObject, "^";
\r
1240 print "Property names ", (hex5) a_PropNames, "^";
\r
1241 print "Attribute names ", (hex5) a_AttrNames, "^";
\r
1242 print "Action names ", (hex5) a_ActionNames, "^";
\r
1243 print "Array names ", (hex5) a_ArrayNames, "^";
\r
1244 print "Individual props ", (hex5) a_IndivProps, "^";
\r
1245 print "Global variables ", (hex5) a_Globals, "^";
\r
1246 print "Arrays ", (hex5) a_Arrays, "^";
\r
1247 print "Terminating Chars ", (hex5) a_TermChars, "^";
\r
1250 print "Static Memory ", (hex5) a_StaticMemory, "^";
\r
1251 print "Grammar addresses ", (hex5) a_GrammarPointers, "^";
\r
1252 print "Grammars ", (hex5) a_Grammars, "^";
\r
1253 print "Actions ", (hex5) a_Actions, "^";
\r
1254 print "Parse routines ", (hex5) a_PreActions, "^";
\r
1255 print "Prepositions ", (hex5) a_Prepositions, "^";
\r
1256 print "Dictionary ", (hex5) a_Dictionary, "^";
\r
1259 print "High Memory ", (hex5) a_HighMemory, "^";
\r
1260 print "Routines ", (hex5) a_Routines, "^";
\r
1261 print "Strings ", (hex5) a_Strings, "^";
\r
1262 print "Top of the game ", (hex5) a_TopOfGame, "^";
\r
1266 ! =================================================================================================
\r
1267 ! Show all objects, optionally expanding Routines.
\r
1272 if (~~currentState) print_ret (string) NO_GAME_OPEN;
\r
1276 for (a=a_Objects : a<a_CommonProps : a=a+14) {
\r
1277 o++; ! Object's number
\r
1278 if (o < i_FirstUserObject) continue; ! Skip early objects
\r
1279 p = GetWord(a+6); ! Object's parent
\r
1280 b = GetWord(a+12); ! Object's property table
\r
1281 if (p == 1 || o <= 4) { ! It's a Class
\r
1282 print "Class ~", (Zaddress) b+1, "~ with^";
\r
1283 c = GetByte(b++); ! #words of class's shortname
\r
1284 b = DoProperties(b+c+c); ! Class's first property block
\r
1285 print " ! Following values are inherited by instances of the class^";
\r
1286 DoProperties(b+6); ! Inheritance property block
\r
1287 DoAttributes(b); ! Inheritance attribute bytes
\r
1289 else { ! It's an Object
\r
1290 print "Object ", (Zobject) o, " ~", (Zaddress) b+1, "~";
\r
1291 if (p > 1) print " ", (Zobject) p;
\r
1293 c = GetByte(b++); ! #words of object's shortname
\r
1294 DoProperties(b+c+c); ! Object's first property block
\r
1295 DoAttributes(a); ! Object's attribute bytes
\r
1298 if (~~modePause) glk_select_poll(gg_event);
\r
1305 for (x=GetByte(a++) : x : x=GetByte(a++)) {
\r
1306 p = x & BITS00_05; ! Common property number
\r
1307 if (x & BIT07) { ! Two size-and-number bytes
\r
1308 n = GetByte(a++) & BITS00_05;
\r
1309 if (n == 0) n = 64;
\r
1311 else ! One size-and-number byte
\r
1312 if (x & BIT06) n = 2; ! Two bytes of data
\r
1313 else n = 1; ! One byte of data
\r
1315 if (currentState == STATE_DUMP)
\r
1316 DoPropNameAndValue(a, p, n);
\r
1318 else { ! Individual properties
\r
1320 if (a_IndivProps == 0) a_IndivProps = b;
\r
1321 for (x=GetWord(b),b=b+2 : x : x=GetWord(b),b=b+2) {
\r
1322 p = x & BITS00_14; ! Individual property number
\r
1324 if (currentState == STATE_DUMP) DoPropNameAndValue(b, p, n);
\r
1333 [ DoPropNameAndValue a p n
\r
1335 print " ", (Zproperty) p;
\r
1336 if (n & BIT00) ! odd number of bytes
\r
1337 for (i=0 : i<n : i++) print " ", GetByte(a++);
\r
1338 else ! even number of bytes
\r
1339 for (i=0,x=GetWord(a) : i<n : i=i+2,x=GetWord(a+i)) switch (p) {
\r
1341 if (x >= a_Dictionary && x < a_HighMemory) {
\r
1342 stringOptions = stringOptions | STR_NO_QUOTES;
\r
1344 if (Zaddress(x) == 1) print "//";
\r
1346 stringOptions = stringOptions & ~STR_NO_QUOTES;
\r
1349 print " ?", (hex4) x, "?"; ! not a dictionary word; maybe a character constant?
\r
1351 print " ", (Zname) x;
\r
1352 3: ! metaclass (individual properties)
\r
1353 "BUG: tried to print property 3.";
\r
1354 default: ! other properties
\r
1358 0 to 20: ! probably not an object...
\r
1361 if (x <= n_Objects) print " ", (Zobject) x;
\r
1363 if (x >= p_Routines && x < p_Strings &&
\r
1364 FoundByChop(x, theRoutines, n_Routines) && i-j < 3) {
\r
1366 if (modeExpand) DumpRoutine(P_To_A(x));
\r
1367 else print " [; $", (hex5) P_To_A(x), " ]";
\r
1370 if (x >= p_Strings && x < p_TopOfGame &&
\r
1371 FoundByChop(x, theStrings, n_Strings) && i-j < 3) {
\r
1373 if (true) print " ~", (Zstring) x, "~";
\r
1374 !else print " ~$", (hex5) P_To_A(x), "~";
\r
1379 } ! end of not-an-object
\r
1380 } ! end of switch(x)
\r
1381 } ! end of switch(p)
\r
1385 [ FoundByChop x a l ! Locate value in sorted list by binary chop.
\r
1387 p = 0; q = l - 1 ;
\r
1389 i = p + (q-p)/2; ! mid point
\r
1390 if (x == a-->i) return i+1; ! found it!
\r
1391 if (x > a-->i) p = i + 1; ! above the mid point
\r
1392 else q = i - 1; ! below the mid point
\r
1397 [ FoundByScan x a l ! Locate value in unsorted list by sequential scan.
\r
1399 for (i=0 : i<l : i++)
\r
1400 if (x == a-->i) return i+1; ! found it!
\r
1406 if (GetWord(a) | GetWord(a+2) | GetWord(a+4)) print " has ";
\r
1407 for (i=0 : i<n_AttrNames : i++)
\r
1408 if (TestAttr(a, i)) print " ", (Zattribute) i;
\r
1413 if (GetByte(a + q/8) & Bit-->(7 - q%8)) rtrue;
\r
1417 ! =================================================================================================
\r
1418 ! Create XML markup which could be imported into the Dia diagram tool
\r
1419 ! (http://www.lysator.liu.se/~alla/dia), giving an editable map of the game.
\r
1421 Global CantGoProp;
\r
1422 Global DoorToProp;
\r
1426 Constant GRID_SIZE 050; ! Dia snap-to grid (all x100). Rooms are twice this size.
\r
1427 Constant LINE_WIDTH 003; ! For rooms and connections.
\r
1428 Constant TEXT_OFFSET_X 010; ! From top-left of room square
\r
1429 Constant TEXT_OFFSET_Y 022;
\r
1430 Constant TEXT_NAME "Verdana";
\r
1431 Constant TEXT_SIZE 020;
\r
1433 Constant ONE_SIDED_DOOR 20; ! Only one link to this door.
\r
1434 Constant UNKNOWN_ROOM 21; ! Link to a 'room' not in the table.
\r
1435 Constant LINK_IS_ROUTINE 22; ! XXX_to is a property routine.
\r
1438 a b c o p i j n_exits x;
\r
1439 if (~~currentState) print_ret (string) NO_GAME_OPEN;
\r
1441 ! Calculate the map square necessary to display all objects.
\r
1443 switch (n_objects) {
\r
1444 0 to 99: mapSize = 10;
\r
1445 100 to 399: mapSize = 20;
\r
1446 400 to 899: mapSize = 30;
\r
1447 900 to 1599: mapSize = 40;
\r
1448 default: mapsize = 50;
\r
1451 ! Find the XXX_to property numbers, and the 'door' attribute number.
\r
1453 for (i=0 : i<MAX_DIRPROPS : i++) {
\r
1454 DirPropNums-->i = CompareStrings(DirPropNames-->i, ZProperty, 1, n_PropNames);
\r
1455 for (j=0 : j<MAX_ROOMS : j++) (theExits-->i)-->j = 0;
\r
1457 CantGoProp = CompareStrings("cant_go", ZProperty, 1, n_PropNames);
\r
1458 DoorToProp = CompareStrings("door_to", ZProperty, 1, n_PropNames);
\r
1460 ! Identify the room and door objects, and store the exits.
\r
1462 n_Rooms = 0; n_Doors = 0;
\r
1463 for (a=a_Objects,o=1 : a<a_CommonProps : a=a+14,o++) {
\r
1465 b = GetWord(a+12); ! Object's property table
\r
1466 c = GetByte(b++); ! #words of object's shortname
\r
1467 b = b + c + c; ! Object's first property block
\r
1469 for (c=GetByte(b++) : c : c=GetByte(b++)) {
\r
1470 p = c & BITS00_05; ! Common property number
\r
1471 if (c & BIT07) { ! Two size-and-number bytes
\r
1472 c = GetByte(b++) & BITS00_05;
\r
1473 if (c == 0) c = 64;
\r
1475 else ! One size-and-number byte
\r
1476 if (c & BIT06) c = 2; ! Two bytes of data
\r
1477 else c = 1; ! One byte of data (should never happen)
\r
1478 ! b = start of property data, c = length of data
\r
1479 x = GetWord(b); ! First word of property data
\r
1481 if (p == DoorToProp) {
\r
1482 if (n_Doors == MAX_DOORS) "Too many doors: increase MAX_DOORS and recompile.";
\r
1483 theDoors-->n_Doors = o;
\r
1484 doorToRoom-->n_Doors = x;
\r
1488 for (i=0 : i<MAX_DIRPROPS : i++)
\r
1489 if (p == DirPropNums-->i) { ! Found an exit.
\r
1490 if (++n_exits == 1) { ! First exit - found a new room.
\r
1491 if (n_Rooms == MAX_ROOMS) "Too many rooms: increase MAX_ROOMS and recompile.";
\r
1492 theRooms-->n_Rooms = o;
\r
1494 if (x > 0 && x < p_Strings)
\r
1495 (theExits-->i)-->n_Rooms = x; ! room, door or routine
\r
1497 if (p == CantGoProp && n_exits == 0) {
\r
1498 if (n_Rooms == MAX_ROOMS) "Too many rooms: increase MAX_ROOMS and recompile.";
\r
1499 theRooms-->n_Rooms = o;
\r
1503 if (n_exits) n_Rooms++;
\r
1504 if (~~modePause) glk_select_poll(gg_event);
\r
1507 ! Find doors and replace by direct room-to-room links.
\r
1509 for (a=0 : a<n_Rooms : a++) {
\r
1510 for (i=0 : i<MAX_DIRPROPS : i++) {
\r
1511 x = (theExits-->i)-->a;
\r
1512 if (x > 0 && x <= n_Objects) { ! room or door
\r
1513 p = FoundByChop(x, theDoors, n_Doors);
\r
1514 if (~~p) continue; ! room - ignore
\r
1516 p = doorToRoom-->p; ! door's door_to prop
\r
1517 if (p <= n_Objects) {
\r
1518 (theExits-->i)-->a = p; ! a room
\r
1522 ! door_to must be a routine
\r
1524 for (b=a+1 : b<n_Rooms : b++) {
\r
1526 for (j=0 : j<MAX_DIRPROPS : j++) {
\r
1527 if ((theExits-->j)-->b == x) {
\r
1528 (theExits-->j)-->b = theRooms-->a;
\r
1533 for (j=0 : j<MAX_DIRPROPS : j++) {
\r
1534 if ((theExits-->j)-->a == x) {
\r
1535 (theExits-->j)-->a = theRooms-->b;
\r
1540 if ((theExits-->i)-->a == x) { ! couldn't find the door elsewhere
\r
1541 for (j=0 : j<MAX_DIRPROPS : j++) {
\r
1542 if ((theExits-->j)-->a == x) {
\r
1543 (theExits-->j)-->a = ONE_SIDED_DOOR;
\r
1551 ! for (a=0 : a<n_Rooms : a++) {
\r
1552 ! o = theRooms-->a;
\r
1553 ! print a, " ", (Zobject) o;
\r
1554 ! for (i=0 : i<MAX_DIRPROPS : i++) {
\r
1555 ! x = (theExits-->i)-->a;
\r
1556 ! print " ", (string)DirPropNames-->i, "=", x;
\r
1557 ! p = FoundByChop(x, theRooms, n_Rooms);
\r
1558 ! if (~~p) continue;
\r
1560 ! print " at pos ", p;
\r
1561 ! for (j=0 : j<MAX_DIRPROPS : j++)
\r
1562 ! if ((theExits-->j)-->p == o) print " matches ", j;
\r
1569 xmlID = n_objects + 1; ! IDs for generated XML things
\r
1572 ! Generate the XML for the rooms
\r
1574 XMLroom(ONE_SIDED_DOOR, "INSPECTOR^One-sided^doors");
\r
1575 XMLroom(UNKNOWN_ROOM, "INSPECTOR^Links to^non-rooms");
\r
1576 XMLroom(LINK_IS_ROUTINE, "INSPECTOR^Links^are^routines");
\r
1577 for (a=0 : a<n_Rooms : a++) {
\r
1578 XMLroom(theRooms-->a);
\r
1579 if (~~modePause) glk_select_poll(gg_event);
\r
1582 ! Now, generate the connections between rooms.
\r
1584 for (a=0 : a<n_Rooms : a++) {
\r
1586 for (i=0 : i<MAX_DIRPROPS : i++) {
\r
1587 x = (theExits-->i)-->a;
\r
1588 if (x == 0) continue;
\r
1589 if (x == ONE_SIDED_DOOR) { XMLconnection(o, i, ONE_SIDED_DOOR, 7); continue; }
\r
1590 if (x >= p_Routines) { XMLconnection(o, i, LINK_IS_ROUTINE, 7); continue; }
\r
1591 p = FoundByChop(x, theRooms, n_Rooms);
\r
1592 if (~~p) { XMLconnection(o, i, UNKNOWN_ROOM, 7); continue; }
\r
1595 j = XOR(i, 1); ! Symmetrical exit
\r
1596 if ((theExits-->j)-->p == o) {
\r
1598 if (x > o) XMLconnection(o, i, x, j);
\r
1601 for (j=0 : j<MAX_DIRPROPS : j++) {
\r
1602 if ((theExits-->j)-->p == o) {
\r
1604 if (x > o) XMLconnection(o, i, x, j);
\r
1608 if (n_exits == 0) XMLconnection(o, i, x, MAX_DIRPROPS);
\r
1611 if (~~modePause) glk_select_poll(gg_event);
\r
1619 "Save the lines BETWEEN the markers in YourFileName.xml as input to Dia^
\r
1620 [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[^
\r
1621 <?xml version=~1.0~ encoding=~UTF-8~?>^
\r
1622 <dia:diagram xmlns:dia=~http://www.lysator.liu.se/@@126alla/dia/~>^
\r
1623 <dia:diagramdata>^
\r
1624 <dia:attribute name=~grid~><dia:composite type=~grid~>^
\r
1625 <dia:attribute name=~width_x~><dia:real val=~", (XY) GRID_SIZE, "~/></dia:attribute>^
\r
1626 <dia:attribute name=~width_y~><dia:real val=~", (XY) GRID_SIZE, "~/></dia:attribute>^
\r
1627 </dia:composite></dia:attribute>^
\r
1628 </dia:diagramdata>^
\r
1629 <dia:layer name=~Background~ visible=~true~>^";
\r
1635 ]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]^
\r
1636 End of input to Dia. Do not include the [[[[[[ and ]]]]]] marker lines";
\r
1639 [ XOR a b; return (a | b) & (~(a & b)); ];
\r
1641 [ XY p; print p/100, (char) '.', (dec2) p%100; ];
\r
1647 print "<dia:group>^
\r
1648 <dia:object type=~Geometric - Perfect Square~ version=~0~ id=~O", o, "~>^
\r
1649 <dia:attribute name=~border_width~><dia:real val=~", (XY) LINE_WIDTH, "~/></dia:attribute>^
\r
1650 <dia:attribute name=~elem_corner~><dia:point val=~", (XY) x, ",", (XY) y, "~/></dia:attribute>^
\r
1651 <dia:attribute name=~elem_width~><dia:real val=~", (XY) GRID_SIZE * 2, "~/></dia:attribute>^
\r
1652 <dia:attribute name=~elem_height~><dia:real val=~", (XY) GRID_SIZE * 2, "~/></dia:attribute>^
\r
1654 <dia:object type=~Standard - Text~ version=~0~ id=~O", xmlID++, "~>^
\r
1655 <dia:attribute name=~text~><dia:composite type=~text~>^
\r
1656 <dia:attribute name=~string~>^
\r
1658 stringOptions = stringOptions | STR_MULTILINE;
\r
1659 if (str) print (string) str;
\r
1660 else print (Zname) o;
\r
1661 stringOptions = stringOptions & ~STR_MULTILINE;
\r
1664 <dia:attribute name=~font~>^
\r
1665 <dia:font family=~sans~ style=~0~ name=~", (string) TEXT_NAME, "~/>^
\r
1667 <dia:attribute name=~height~><dia:real val=~", (XY) TEXT_SIZE, "~/></dia:attribute>^
\r
1668 <dia:attribute name=~pos~>^
\r
1669 <dia:point val=~", (XY) x+TEXT_OFFSET_X, ",", (XY) y+TEXT_OFFSET_Y, "~/>^
\r
1671 </dia:composite></dia:attribute>^
\r
1676 [ XMLconnection o1 d1 o2 d2
\r
1678 if (o1 == o2) return; ! ignore circular links.
\r
1679 x1 = objX(o1) + connectX->d1;
\r
1680 y1 = objY(o1) + connectY->d1;
\r
1681 x2 = objX(o2) + connectX->d2;
\r
1682 y2 = objY(o2) + connectY->d2;
\r
1683 print "<dia:object type=~Standard - Line~ version=~0~ id=~O", xmlID++, "~>^
\r
1684 <dia:attribute name=~line_width~><dia:real val=~", (XY) LINE_WIDTH, "~/></dia:attribute>^
\r
1685 <dia:attribute name=~conn_endpoints~>^
\r
1686 <dia:point val=~", (XY) x1, ",", (XY) y1, "~/>^
\r
1687 <dia:point val=~", (XY) x2, ",", (XY) y2, "~/>^
\r
1689 <dia:connections>^
\r
1690 <dia:connection handle=~0~ to=~O", o1, "~ connection=~", connectID->d1, "~/>^
\r
1691 <dia:connection handle=~1~ to=~O", o2, "~ connection=~", connectID->d2, "~/>^
\r
1692 </dia:connections>^";
\r
1693 if (connectArrow->d1)
\r
1694 print "<dia:attribute name=~start_arrow~><dia:enum val=~", connectArrow->d1, "~/></dia:attribute>^
\r
1695 <dia:attribute name=~start_arrow_length~><dia:real val=~0.15~/></dia:attribute>^
\r
1696 <dia:attribute name=~start_arrow_width~><dia:real val=~0.15~/></dia:attribute>^";
\r
1697 if (connectArrow->d2)
\r
1698 print "<dia:attribute name=~end_arrow~><dia:enum val=~", connectArrow->d2, "~/></dia:attribute>^
\r
1699 <dia:attribute name=~end_arrow_length~><dia:real val=~0.15~/></dia:attribute>^
\r
1700 <dia:attribute name=~end_arrow_width~><dia:real val=~0.15~/></dia:attribute>^";
\r
1704 [ objX o; return o%mapSize * (GRID_SIZE * 3); ];
\r
1706 [ objY o; return o/mapSize * (GRID_SIZE * 3); ];
\r
1711 GRID_SIZE * 2 ! East
\r
1713 GRID_SIZE * 2 ! Northeast
\r
1716 GRID_SIZE * 2 ! SouthEast
\r
1717 GRID_SIZE * 2 ! Up (use Northeast)
\r
1718 0 ! Down (use Southwest)
\r
1719 0 ! In (use Northwest)
\r
1720 GRID_SIZE * 2 ! Out (use Southeast)
\r
1721 GRID_SIZE * 2; ! None (use Southeast)
\r
1725 GRID_SIZE * 2 ! South
\r
1729 GRID_SIZE * 2 ! Southwest
\r
1731 GRID_SIZE * 2 ! SouthEast
\r
1732 0 ! Up (use Northeast)
\r
1733 GRID_SIZE * 2 ! Down (use Southwest)
\r
1734 0 ! In (use Northwest)
\r
1735 GRID_SIZE * 2 ! Out (use Southeast)
\r
1736 GRID_SIZE * 2; ! None (use Southeast)
\r
1738 Array connectID -> ! dia connection IDs
\r
1747 4 ! Up (use Northeast)
\r
1748 2 ! Down (use Southwest)
\r
1749 0 ! In (use Northwest)
\r
1750 1 ! Out (use Southeast)
\r
1751 1; ! None (use Northwest???)
\r
1753 Array connectArrow -> ! dia arrowheads
\r
1766 21; ! None (not an exit)
\r
1768 ! =================================================================================================
\r
1769 ! Show all Z-code routines.
\r
1773 if (~~currentState) print_ret (string) NO_GAME_OPEN;
\r
1777 for (i=0 : i<n_Routines : i++) {
\r
1779 DumpRoutine(P_To_A(theRoutines-->i));
\r
1781 if (~~modePause) glk_select_poll(gg_event);
\r
1786 Array OpcodeNames --> ! 256 Standard opcodes + 32 Extended opcodes
\r
1788 ! Long 2OP: small constant, small constant
\r
1789 nothing "je" "jl" "jg"
\r
1790 "dec_chk" "inc_chk" "jin" "test"
\r
1791 "or" "and" "test_attr" "set_attr"
\r
1792 "clear_attr" "store" "insert_obj" "loadw"
\r
1793 "loadb" "get_prop" "get_prop_addr" "get_next_prop"
\r
1794 "add" "sub" "mul" "div"
\r
1795 "mod" "call_2s" "call_2n" "set_colour"
\r
1796 "throw" nothing nothing nothing
\r
1798 ! Long 2OP: small constant, variable
\r
1799 nothing "je" "jl" "jg"
\r
1800 "dec_chk" "inc_chk" "jin" "test"
\r
1801 "or" "and" "test_attr" "set_attr"
\r
1802 "clear_attr" "store" "insert_obj" "loadw"
\r
1803 "loadb" "get_prop" "get_prop_addr" "get_next_prop"
\r
1804 "add" "sub" "mul" "div"
\r
1805 "mod" "call_2s" "call_2n" "set_colour"
\r
1806 "throw" nothing nothing nothing
\r
1808 ! Long 2OP: variable, small constant
\r
1809 nothing "je" "jl" "jg"
\r
1810 "dec_chk" "inc_chk" "jin" "test"
\r
1811 "or" "and" "test_attr" "set_attr"
\r
1812 "clear_attr" "store" "insert_obj" "loadw"
\r
1813 "loadb" "get_prop" "get_prop_addr" "get_next_prop"
\r
1814 "add" "sub" "mul" "div"
\r
1815 "mod" "call_2s" "call_2n" "set_colour"
\r
1816 "throw" nothing nothing nothing
\r
1818 ! Long 2OP: variable, variable
\r
1819 nothing "je" "jl" "jg"
\r
1820 "dec_chk" "inc_chk" "jin" "test"
\r
1821 "or" "and" "test_attr" "set_attr"
\r
1822 "clear_attr" "store" "insert_obj" "loadw"
\r
1823 "loadb" "get_prop" "get_prop_addr" "get_next_prop"
\r
1824 "add" "sub" "mul" "div"
\r
1825 "mod" "call_2s" "call_2n" "set_colour"
\r
1826 "throw" nothing nothing nothing
\r
1828 ! Short 1OP: large constant
\r
1829 "jz" "get_sibling" "get_child" "get_parent"
\r
1830 "get_prop_len" "inc" "dec" "print_addr"
\r
1831 "call_1s" "remove_obj" "print_obj" "ret"
\r
1832 "jump" "print_paddr" "load" "call_1n"
\r
1834 ! Short 1OP: small constant
\r
1835 "jz" "get_sibling" "get_child" "get_parent"
\r
1836 "get_prop_len" "inc" "dec" "print_addr"
\r
1837 "call_1s" "remove_obj" "print_obj" "ret"
\r
1838 "jump" "print_paddr" "load" "call_1n"
\r
1840 ! Short 1OP: variable
\r
1841 "jz" "get_sibling" "get_child" "get_parent"
\r
1842 "get_prop_len" "inc" "dec" "print_addr"
\r
1843 "call_1s" "remove_obj" "print_obj" "ret"
\r
1844 "jump" "print_paddr" "load" "call_1n"
\r
1847 "rtrue" "rfalse" "print" "print_ret"
\r
1848 "nop" nothing nothing "restart"
\r
1849 "ret_popped" "catch" "quit" "new_line"
\r
1850 nothing "verify" "extended" "piracy"
\r
1852 ! Variable 2OP: Type byte follows
\r
1853 nothing "je" "jl" "jg"
\r
1854 "dec_chk" "inc_chk" "jin" "test"
\r
1855 "or" "and" "test_attr" "set_attr"
\r
1856 "clear_attr" "store" "insert_obj" "loadw"
\r
1857 "loadb" "get_prop" "get_prop_addr" "get_next_prop"
\r
1858 "add" "sub" "mul" "div"
\r
1859 "mod" "call_2s" "call_2n" "set_colour"
\r
1860 "throw" nothing nothing nothing
\r
1862 ! Variable VAR: Type byte(s) follow
\r
1863 "call_vs" "storew" "storeb" "put_prop"
\r
1864 "aread" "print_char" "print_num" "random"
\r
1865 "push" "pull" "split_window" "set_window"
\r
1866 "call_vs2" "erase_window" "erase_line" "set_cursor"
\r
1867 "get_cursor" "set_text_style" "buffer_mode" "output_stream"
\r
1868 "input_stream" "sound_effect" "read_char" "scan_table"
\r
1869 "not" "call_vn" "call_vn2" "tokenise"
\r
1870 "encode_text" "copy_table" "print_table" "check_arg_count"
\r
1872 ! Extended VAR: Type byte follows
\r
1873 "save" "restore" "log_shift" "art_shift"
\r
1874 "set_font" "draw_picture" "picture_data" "erase_picture"
\r
1875 "set_margins" "save_undo" "restore_undo" "print_unicode"
\r
1876 "check_unicode" nothing nothing nothing
\r
1877 "move_window" "window_size" "window_style" "get_wind_prop"
\r
1878 "scroll_window" "pop_stack" "read_mouse" "mouse_window"
\r
1879 "push_stack" "put_wind_prop" "print_form" "make_menu"
\r
1880 "picture_table" nothing nothing nothing;
\r
1882 ! These flags are not part of the ZSpec.
\r
1884 Constant OK = $$00000000; ! Normal instruction
\r
1885 Constant ST = $$10000000; ! Has Store variable?
\r
1886 Constant BR = $$01000000; ! Has Branch offset?
\r
1887 Constant PR = $$00100000; ! Has Printable text?
\r
1888 Constant TY = $$00010000; ! Has Type byte(s)?
\r
1889 Constant tStS = $$0101; ! Small constant, small constant
\r
1890 Constant tStV = $$0110; ! Small constant, variable
\r
1891 Constant tVtS = $$1001; ! Variable, small constant
\r
1892 Constant tVtV = $$1010; ! Variable, variable
\r
1893 Constant tLtX = $$0011; ! Large constant
\r
1894 Constant tStX = $$0111; ! Small constant
\r
1895 Constant tVtX = $$1011; ! Variable
\r
1896 Constant tXtX = $$1111; ! Nothing
\r
1897 Constant MA = $$00001111; ! Mask for Type [Type count] bytes
\r
1898 Constant ER = $$11111111; ! Error
\r
1900 Constant tXtXtXtX = $$11111111;
\r
1902 Array OpcodeFlags -> ! 256 Standard opcodes + 32 Extended opcodes
\r
1904 ! Long 2OP: small constant, small constant
\r
1906 OK +BR +tStS ! $01 je
\r
1907 OK +BR +tStS ! $02 jl
\r
1908 OK +BR +tStS ! $03 jg
\r
1909 OK +BR +tStS ! $04 dec_chk
\r
1910 OK +BR +tStS ! $05 inc_chk
\r
1911 OK +BR +tStS ! $06 jin
\r
1912 OK +BR +tStS ! $07 test
\r
1913 OK +ST +tStS ! $08 or
\r
1914 OK +ST +tStS ! $09 and
\r
1915 OK +BR +tStS ! $0Atest_attr
\r
1916 OK +tStS ! $0B set_attr
\r
1917 OK +tStS ! $0C clear_attr
\r
1918 OK +tStS ! $0D store
\r
1919 OK +tStS ! $0E insert_obj
\r
1920 OK +ST +tStS ! $0F loadw
\r
1921 OK +ST +tStS ! $10 loadb
\r
1922 OK +ST +tStS ! $11 get_prop
\r
1923 OK +ST +tStS ! $12 get_prop_addr
\r
1924 OK +ST +tStS ! $13 get_next_prop
\r
1925 OK +ST +tStS ! $14 add
\r
1926 OK +ST +tStS ! $15 sub
\r
1927 OK +ST +tStS ! $16 mul
\r
1928 OK +ST +tStS ! $17 div
\r
1929 OK +ST +tStS ! $18 mod
\r
1930 OK +ST +tStS ! $19 call_2s
\r
1931 OK +tStS ! $1A call_2n
\r
1932 OK +tStS ! $1B set_colour
\r
1933 OK +tStS ! $1C throw
\r
1938 ! Long 2OP: small constant, variable
\r
1940 OK +BR +tStV ! $21 je
\r
1941 OK +BR +tStV ! $22 jl
\r
1942 OK +BR +tStV ! $23 jg
\r
1943 OK +BR +tStV ! $24 dec_chk
\r
1944 OK +BR +tStV ! $25 inc_chk
\r
1945 OK +BR +tStV ! $26 jin
\r
1946 OK +BR +tStV ! $27 test
\r
1947 OK +ST +tStV ! $28 or
\r
1948 OK +ST +tStV ! $29 and
\r
1949 OK +BR +tStV ! $2Atest_attr
\r
1950 OK +tStV ! $2B set_attr
\r
1951 OK +tStV ! $2C clear_attr
\r
1952 OK +tStV ! $2D store
\r
1953 OK +tStV ! $2E insert_obj
\r
1954 OK +ST +tStV ! $2F loadw
\r
1955 OK +ST +tStV ! $30 loadb
\r
1956 OK +ST +tStV ! $31 get_prop
\r
1957 OK +ST +tStV ! $32 get_prop_addr
\r
1958 OK +ST +tStV ! $33 get_next_prop
\r
1959 OK +ST +tStV ! $34 add
\r
1960 OK +ST +tStV ! $35 sub
\r
1961 OK +ST +tStV ! $36 mul
\r
1962 OK +ST +tStV ! $37 div
\r
1963 OK +ST +tStV ! $38 mod
\r
1964 OK +ST +tStV ! $39 call_2s
\r
1965 OK +tStV ! $3A call_2n
\r
1966 OK +tStV ! $3B set_colour
\r
1967 OK +tStV ! $3C throw
\r
1972 ! Long 2OP: variable, small constant
\r
1974 OK +BR +tVtS ! $41 je
\r
1975 OK +BR +tVtS ! $42 jl
\r
1976 OK +BR +tVtS ! $43 jg
\r
1977 OK +BR +tVtS ! $44 dec_chk
\r
1978 OK +BR +tVtS ! $45 inc_chk
\r
1979 OK +BR +tVtS ! $46 jin
\r
1980 OK +BR +tVtS ! $47 test
\r
1981 OK +ST +tVtS ! $48 or
\r
1982 OK +ST +tVtS ! $49 and
\r
1983 OK +BR +tVtS ! $4Atest_attr
\r
1984 OK +tVtS ! $4B set_attr
\r
1985 OK +tVtS ! $4C clear_attr
\r
1986 OK +tVtS ! $4D store
\r
1987 OK +tVtS ! $4E insert_obj
\r
1988 OK +ST +tVtS ! $4F loadw
\r
1989 OK +ST +tVtS ! $50 loadb
\r
1990 OK +ST +tVtS ! $51 get_prop
\r
1991 OK +ST +tVtS ! $52 get_prop_addr
\r
1992 OK +ST +tVtS ! $53 get_next_prop
\r
1993 OK +ST +tVtS ! $54 add
\r
1994 OK +ST +tVtS ! $55 sub
\r
1995 OK +ST +tVtS ! $56 mul
\r
1996 OK +ST +tVtS ! $57 div
\r
1997 OK +ST +tVtS ! $58 mod
\r
1998 OK +ST +tVtS ! $59 call_2s
\r
1999 OK +tVtS ! $5A call_2n
\r
2000 OK +tVtS ! $5B set_colour
\r
2001 OK +tVtS ! $5C throw
\r
2006 ! Long 2OP: variable, variable
\r
2008 OK +BR +tVtV ! $61 je
\r
2009 OK +BR +tVtV ! $62 jl
\r
2010 OK +BR +tVtV ! $63 jg
\r
2011 OK +BR +tVtV ! $64 dec_chk
\r
2012 OK +BR +tVtV ! $65 inc_chk
\r
2013 OK +BR +tVtV ! $66 jin
\r
2014 OK +BR +tVtV ! $67 test
\r
2015 OK +ST +tVtV ! $68 or
\r
2016 OK +ST +tVtV ! $69 and
\r
2017 OK +BR +tVtV ! $6Atest_attr
\r
2018 OK +tVtV ! $6B set_attr
\r
2019 OK +tVtV ! $6C clear_attr
\r
2020 OK +tVtV ! $6D store
\r
2021 OK +tVtV ! $6E insert_obj
\r
2022 OK +ST +tVtV ! $6F loadw
\r
2023 OK +ST +tVtV ! $70 loadb
\r
2024 OK +ST +tVtV ! $71 get_prop
\r
2025 OK +ST +tVtV ! $72 get_prop_addr
\r
2026 OK +ST +tVtV ! $73 get_next_prop
\r
2027 OK +ST +tVtV ! $74 add
\r
2028 OK +ST +tVtV ! $75 sub
\r
2029 OK +ST +tVtV ! $76 mul
\r
2030 OK +ST +tVtV ! $77 div
\r
2031 OK +ST +tVtV ! $78 mod
\r
2032 OK +ST +tVtV ! $79 call_2s
\r
2033 OK +tVtV ! $7A call_2n
\r
2034 OK +tVtV ! $7B set_colour
\r
2035 OK +tVtV ! $7C throw
\r
2040 ! Short 1OP: large constant
\r
2041 OK +BR +tLtX ! $80 jz
\r
2042 OK +ST +BR +tLtX ! $81 get_sibling
\r
2043 OK +ST +BR +tLtX ! $82 get_child
\r
2044 OK +ST +tLtX ! $83 get_parent
\r
2045 OK +ST +tLtX ! $84 get_prop_len
\r
2046 OK +tLtX ! $85 inc
\r
2047 OK +tLtX ! $86 dec
\r
2048 OK +tLtX ! $87 print_addr
\r
2049 OK +ST +tLtX ! $88 call_1s
\r
2050 OK +tLtX ! $89 remove_obj
\r
2051 OK +tLtX ! $8A print_obj
\r
2052 OK +tLtX ! $8B ret
\r
2053 OK +tLtX ! $8C jump
\r
2054 OK +tLtX ! $8D print_paddr
\r
2055 OK +ST +tLtX ! $8E load
\r
2056 OK +tLtX ! $8F call_1n
\r
2058 ! Short 1OP: small constant
\r
2059 OK +BR +tStX ! $90 jz
\r
2060 OK +ST +BR +tStX ! $91 get_sibling
\r
2061 OK +ST +BR +tStX ! $92 get_child
\r
2062 OK +ST +tStX ! $93 get_parent
\r
2063 OK +ST +tStX ! $94 get_prop_len
\r
2064 OK +tStX ! $95 inc
\r
2065 OK +tStX ! $96 dec
\r
2066 OK +tStX ! $97 print_addr
\r
2067 OK +ST +tStX ! $98 call_1s
\r
2068 OK +tStX ! $99 remove_obj
\r
2069 OK +tStX ! $9A print_obj
\r
2070 OK +tStX ! $9B ret
\r
2071 OK +tStX ! $9C jump
\r
2072 OK +tStX ! $9D print_paddr
\r
2073 OK +ST +tStX ! $9E load
\r
2074 OK +tStX ! $9F call_1n
\r
2076 ! Short 1OP: variable
\r
2077 OK +BR +tVtX ! $A0 jz
\r
2078 OK +ST +BR +tVtX ! $A1 get_sibling
\r
2079 OK +ST +BR +tVtX ! $A2 get_child
\r
2080 OK +ST +tVtX ! $A3 get_parent
\r
2081 OK +ST +tVtX ! $A4 get_prop_len
\r
2082 OK +tVtX ! $A5 inc
\r
2083 OK +tVtX ! $A6 dec
\r
2084 OK +tVtX ! $A7 print_addr
\r
2085 OK +ST +tVtX ! $A8 call_1s
\r
2086 OK +tVtX ! $A9 remove_obj
\r
2087 OK +tVtX ! $AA print_obj
\r
2088 OK +tVtX ! $AB ret
\r
2089 OK +tVtX ! $AC jump
\r
2090 OK +tVtX ! $AD print_paddr
\r
2091 OK +ST +tVtX ! $AE load
\r
2092 OK +tVtX ! $AF call_1n
\r
2095 OK +tXtX ! $B0 rtrue
\r
2096 OK +tXtX ! $B1 rfalse
\r
2097 OK +PR +tXtX ! $B2 print
\r
2098 OK +PR +tXtX ! $B3 print_ret
\r
2099 OK +tXtX ! $B4 nop
\r
2102 OK +tXtX ! $B7 restart
\r
2103 OK +tXtX ! $B8 ret_popped
\r
2104 OK +ST +tXtX ! $B9 catch
\r
2105 OK +tXtX ! $BA quit
\r
2106 OK +tXtX ! $BB new_line
\r
2108 OK +BR +tXtX ! $BD verify
\r
2109 OK +tXtX ! $BE extended
\r
2110 OK +BR +tXtX ! $BF piracy
\r
2112 ! Variable 2OP: Type byte follows
\r
2114 OK +BR +TY +1 ! $C1 je
\r
2115 OK +BR +TY +1 ! $C2 jl
\r
2116 OK +BR +TY +1 ! $C3 jg
\r
2117 OK +BR +TY +1 ! $C4 dec_chk
\r
2118 OK +BR +TY +1 ! $C5 inc_chk
\r
2119 OK +BR +TY +1 ! $C6 jin
\r
2120 OK +BR +TY +1 ! $C7 test
\r
2121 OK +ST +TY +1 ! $C8 or
\r
2122 OK +ST +TY +1 ! $C9 and
\r
2123 OK +BR +TY +1 ! $CAtest_attr
\r
2124 OK +TY +1 ! $CB set_attr
\r
2125 OK +TY +1 ! $CC clear_attr
\r
2126 OK +TY +1 ! $CD store
\r
2127 OK +TY +1 ! $CE insert_obj
\r
2128 OK +ST +TY +1 ! $CF loadw
\r
2129 OK +ST +TY +1 ! $D0 loadb
\r
2130 OK +ST +TY +1 ! $D1 get_prop
\r
2131 OK +ST +TY +1 ! $D2 get_prop_addr
\r
2132 OK +ST +TY +1 ! $D3 get_next_prop
\r
2133 OK +ST +TY +1 ! $D4 add
\r
2134 OK +ST +TY +1 ! $D5 sub
\r
2135 OK +ST +TY +1 ! $D6 mul
\r
2136 OK +ST +TY +1 ! $D7 div
\r
2137 OK +ST +TY +1 ! $D8 mod
\r
2138 OK +ST +TY +1 ! $D9 call_2s
\r
2139 OK +TY +1 ! $DA call_2n
\r
2140 OK +TY +1 ! $DB set_colour
\r
2141 OK +TY +1 ! $DC throw
\r
2146 ! Variable VAR: Type byte(s) follow
\r
2147 OK +ST +TY +1 ! $E0 call_vs
\r
2148 OK +TY +1 ! $E1 storew
\r
2149 OK +TY +1 ! $E2 storeb
\r
2150 OK +TY +1 ! $E3 put_prop
\r
2151 OK +ST +TY +1 ! $E4 aread
\r
2152 OK +TY +1 ! $E5 print_char
\r
2153 OK +TY +1 ! $E6 print_num
\r
2154 OK +ST +TY +1 ! $E7 random
\r
2155 OK +TY +1 ! $E8 push
\r
2156 OK +TY +1 ! $E9 pull
\r
2157 OK +TY +1 ! $EA split_window
\r
2158 OK +TY +1 ! $EB set_window
\r
2159 OK +ST +TY +2 ! $EC call_vs2
\r
2160 OK +TY +1 ! $ED erase_window
\r
2161 OK +TY +1 ! $EE erase_line
\r
2162 OK +TY +1 ! $EF set_cursor
\r
2163 OK +TY +1 ! $F0 get_cursor
\r
2164 OK +TY +1 ! $F1 set_text_style
\r
2165 OK +TY +1 ! $F2 buffer_mode
\r
2166 OK +TY +1 ! $F3 output_stream
\r
2167 OK +TY +1 ! $F4 input_stream
\r
2168 OK +TY +1 ! $F5 sound_effect
\r
2169 OK +ST +TY +1 ! $F6 read_char
\r
2170 OK +ST +BR +TY +1 ! $F7 scan_table
\r
2171 OK +ST +TY +1 ! $F8 not
\r
2172 OK +TY +1 ! $F9 call_vn
\r
2173 OK +TY +2 ! $FA call_vn2
\r
2174 OK +TY +1 ! $FB tokenise
\r
2175 OK +TY +1 ! $FC encode_text
\r
2176 OK +TY +1 ! $FD copy_table
\r
2177 OK +TY +1 ! $FE print_table
\r
2178 OK +BR +TY +1 ! $FF check_arg_count
\r
2180 ! Extended: Type byte follows
\r
2181 OK +ST +TY +1 ! $00 save
\r
2182 OK +ST +TY +1 ! $01 restore
\r
2183 OK +ST +TY +1 ! $02 log_shift
\r
2184 OK +ST +TY +1 ! $03 art_shift
\r
2185 OK +ST +TY +1 ! $04 set_font
\r
2186 OK +TY +1 ! $05 draw_picture
\r
2187 OK +BR +TY +1 ! $06 picture_data
\r
2188 OK +TY +1 ! $07 erase_picture
\r
2189 OK +TY +1 ! $08 set_margins
\r
2190 OK +ST +TY +1 ! $09 save_undo
\r
2191 OK +ST +TY +1 ! $0A restore_undo
\r
2192 OK +TY +1 ! $0B print_unicode
\r
2193 OK +TY +1 ! $0C check_unicode
\r
2197 OK +TY +1 ! $10 move_window
\r
2198 OK +TY +1 ! $11 window_size
\r
2199 OK +TY +1 ! $12 window_style
\r
2200 OK +ST +TY +1 ! $13 get_wind_prop
\r
2201 OK +TY +1 ! $14 scroll_window
\r
2202 OK +TY +1 ! $15 pop_stack
\r
2203 OK +TY +1 ! $16 read_mouse
\r
2204 OK +TY +1 ! $17 mouse_window
\r
2205 OK +BR +TY +1 ! $18 push_stack
\r
2206 OK +TY +1 ! $19 put_wind_prop
\r
2207 OK +TY +1 ! $1A print_form
\r
2208 OK +BR +TY +1 ! $1B make_menu
\r
2209 OK +TY +1 ! $1C picture_table
\r
2214 Constant tLargeCon = 0; ! First four values defined by the ZSpec.
\r
2215 Constant tSmallCon = 1; !
\r
2216 Constant tVariable = 2; !
\r
2217 Constant tOmit = 3; !
\r
2218 Constant tAddress = 4; ! Following values not part of ZSpec.
\r
2219 Constant tObject = 5; !
\r
2220 Constant tProperty = 6; !
\r
2221 Constant tAttribute = 7; !
\r
2222 Constant tString = 8; !
\r
2224 Array OperandType -> 8; ! Up to eight operands are permitted.
\r
2225 Array OperandValue --> 8;
\r
2228 opc opf i n maybeHWM addrHWM;
\r
2230 n = GetByte(a); ! Number of local variables
\r
2231 if (n > MAX_LOCALS) "BUG: bad locals count.";
\r
2233 if (currentState == STATE_DUMP) {
\r
2234 print " [ ", (hex5) a;
\r
2235 for (i=1 : i<=n : i++)
\r
2236 print " ", (var) i;
\r
2240 addrHWM = 0; ! Highest referenced address in routine
\r
2242 ! loop through the individual instructions
\r
2245 if (addrHWM < a) addrHWM = a;
\r
2247 if (currentState == STATE_DUMP) print " ", (hex5) a, ": ";
\r
2248 opc = GetByte(a++);
\r
2249 if (opc == $BE) ! Extended - real opcode in next byte
\r
2250 opc = GetByte(a++) + 256;
\r
2251 if (opc >= n_Opcodes || OpcodeNames-->opc == nothing)
\r
2252 "BUG: bad opcode ", n, ".";
\r
2253 opf = OpcodeFlags->opc;
\r
2255 if (opf & TY) switch (n) { ! Types byte(s) follow
\r
2256 1: SetOperandTypes(0, GetByte(a++)); SetOperandTypes(4, tXtXtXtX);
\r
2257 2: SetOperandTypes(0, GetByte(a++)); SetOperandTypes(4, GetByte(a++));
\r
2258 default: "BUG: error in type bits.";
\r
2260 else { ! Types known from opcode
\r
2261 SetOperandTypes(0, (n*16)|tXtX); SetOperandTypes(4, tXtXtXtX);
\r
2263 for (i=0 : i<8 : i++) switch (OperandType->i) {
\r
2264 tLargeCon: ! Large constant
\r
2265 OperandValue-->i = GetWord(a); a = a + 2;
\r
2266 tSmallCon, tVariable: ! Small constant, Variable
\r
2267 OperandValue-->i = GetByte(a++);
\r
2270 default: "BUG: error in types.";
\r
2273 ! We now know the opcode, and the individual operand types and values.
\r
2274 ! Some adjustments are necessary...
\r
2278 ! These adjustments are essential.
\r
2281 OperandType->0 = tAddress;
\r
2282 $8D: ! print_paddr
\r
2283 OperandValue-->0 = P_to_A(OperandValue-->0);
\r
2284 if (currentState == STATE_DECODE && OperandValue-->0 < a_Strings)
\r
2285 a_Strings = OperandValue-->0;
\r
2286 OperandType->0 = tAddress;
\r
2287 $8C: ! jump (signed offset)
\r
2288 if (OperandValue-->0 & BIT15) {
\r
2289 OperandValue-->0 = OperandValue-->0 | $FFFF0000;
\r
2292 OperandValue-->0 = OperandValue-->0 + a - 2;
\r
2293 if (OperandValue-->0 > addrHWM) addrHWM = OperandValue-->0;
\r
2294 OperandType->0 = tAddress;
\r
2295 $8B,$9B,$AB, ! ret
\r
2304 OperandValue-->0 = P_to_A(OperandValue-->0);
\r
2305 if (currentState == STATE_DECODE && OperandValue-->0 > a_TopOfRoutines)
\r
2306 a_TopOfRoutines = OperandValue-->0;
\r
2307 OperandType->0 = tAddress;
\r
2314 if (OperandType->0 == tLargeCon) {
\r
2315 OperandValue-->0 = P_to_A(OperandValue-->0);
\r
2316 if (currentState == STATE_DECODE && OperandValue-->0 > a_TopOfRoutines)
\r
2317 a_TopOfRoutines = OperandValue-->0;
\r
2318 OperandType->0 = tAddress;
\r
2321 ! These adjustments are cosmetic.
\r
2323 $06,$26,$46,$66,$C6, ! jin
\r
2324 $0E,$2E,$4E,$6E,$CE: ! insert_obj
\r
2325 if (OperandType->0 == tLargeCon or tSmallCon) OperandType->0 = tObject;
\r
2326 if (OperandType->1 == tLargeCon or tSmallCon) OperandType->1 = tObject;
\r
2327 $0A,$2A,$4A,$6A,$CA, ! test_attr
\r
2328 $0B,$2B,$4B,$6B,$CB, ! set_attr
\r
2329 $0C,$2C,$4C,$6C,$CC: ! clear_attr
\r
2330 if (OperandType->0 == tLargeCon or tSmallCon) OperandType->0 = tObject;
\r
2331 if (OperandType->1 == tLargeCon or tSmallCon) OperandType->1 = tAttribute;
\r
2332 $11,$31,$51,$71,$D1, ! get_prop
\r
2333 $12,$32,$52,$72,$D2, ! get_prop_addr
\r
2334 $13,$33,$53,$73,$D3, ! get_next_prop
\r
2336 if (OperandType->0 == tLargeCon or tSmallCon) OperandType->0 = tObject;
\r
2337 if (OperandType->1 == tLargeCon or tSmallCon) OperandType->1 = tProperty;
\r
2338 $81,$91, ! get_sibling
\r
2339 $82,$92, ! get_child
\r
2340 $83,$93, ! get_parent
\r
2341 $89,$99, ! remove_obj
\r
2342 $8A,$9A: ! print_obj
\r
2343 if (OperandType->0 == tLargeCon or tSmallCon) OperandType->0 = tObject;
\r
2345 } ! end of switch (opc)
\r
2347 ! Look for large constants which might be Strings.
\r
2349 for (i=0 : i<8 : i++) if (OperandType->i == tLargeCon) {
\r
2350 if (FoundByChop(OperandValue-->i, theStrings, n_Strings)) {
\r
2351 OperandValue-->i = P_to_A(OperandValue-->i);
\r
2352 OperandType->i = tString;
\r
2356 ! Print the opcode and operands.
\r
2358 if (currentState == STATE_DUMP) {
\r
2359 print "@@64", (string) OpcodeNames-->opc;
\r
2360 for (i=0 : i<8 : i++) switch (OperandType->i) {
\r
2361 tLargeCon: ! Large constant
\r
2362 print " ", (hex4) OperandValue-->i;
\r
2363 tSmallCon: ! Small constant
\r
2364 print " ", (hex2) OperandValue-->i;
\r
2365 tVariable: ! Variable
\r
2366 print " ", (var) OperandValue-->i;
\r
2367 tOmit: ! No more operands
\r
2369 tAddress: ! Address
\r
2370 print " ", (hex5) OperandValue-->i;
\r
2371 tObject: ! Name of object
\r
2372 print " ", (Zobject) OperandValue-->i;
\r
2373 tProperty: ! Name of property
\r
2374 print " ", (Zproperty) OperandValue-->i;
\r
2375 tAttribute: ! Name of attribute
\r
2376 print " ", (zAttribute) OperandValue-->i;
\r
2377 tString: ! Address of String
\r
2378 print " S", (hex5) OperandValue-->i;
\r
2382 ! Deal with the optional Store/Branch/Printstring sections.
\r
2384 if (opf & ST) { ! Next is a Store variable
\r
2386 if (currentState == STATE_DUMP) print " -> ", (var) n;
\r
2388 if (opf & BR) { ! Next is a Branch offset
\r
2390 if (currentState == STATE_DUMP) if (n & BIT07) print " "; else print " @@126";
\r
2391 if (n & BIT06) ! Offset 0-63
\r
2392 n = n & BITS00_05;
\r
2393 else { ! Signed offset
\r
2394 n = (n & BITS00_05) * 256 + GetByte(a++);
\r
2395 if (n & BIT13) n = n | $FFFFC000;
\r
2398 0: if (currentState == STATE_DUMP) print "rfalse";
\r
2399 1: if (currentState == STATE_DUMP) print "rtrue";
\r
2402 if (n > addrHWM) addrHWM = n;
\r
2403 if (currentState == STATE_DUMP) print (hex5) n;
\r
2406 if (opf & PR) { ! Next is an encoded String
\r
2407 if (currentState == STATE_DUMP) print " ~", (Zaddress) a, "~";
\r
2408 if (currentState == STATE_EMBED) print (hex5) a, ": ", (Zaddress) a, "^";
\r
2409 do { i = GetWord(a); a = a + 2; } until (i & BIT15);
\r
2414 if (currentState == STATE_DUMP) {
\r
2416 if (opc == $87 or $8D) { ! print_addr, print_paddr
\r
2417 stringOptions = stringOptions | STR_TRUNCATE;
\r
2418 print " ! ~", (Zaddress) OperandValue-->0, "...~";
\r
2419 stringOptions = stringOptions & ~STR_TRUNCATE;
\r
2423 } until (maybeHWM && addrHWM < a);
\r
2427 if (currentState == STATE_DUMP) print " ]";
\r
2431 [ SetOperandTypes n t;
\r
2432 OperandType->(n+0) = (t & $$11000000) / 64;
\r
2433 OperandType->(n+1) = (t & $$00110000) / 16;
\r
2434 OperandType->(n+2) = (t & $$00001100) / 4;
\r
2435 OperandType->(n+3) = (t & $$00000011);
\r
2441 1 to MAX_LOCALS: print "L", (dec2) n-1;
\r
2442 16 to 255: print "G", (dec3) n-16;
\r
2443 default: "BUG: unexpected variable ", n;
\r
2447 ! =================================================================================================
\r
2448 ! Miscellaneous information.
\r
2450 ! [ DumpPropertyDefaults
\r
2454 ! for (a=a_CommonPropDefaults,i=1 : i<64 : a=a+2,i++) {
\r
2455 ! DumpWord(a); print (Zproperty) i, "^";
\r
2461 ! [ DumpClassesToObjects ! Class numbers To Object numbers
\r
2465 ! a = a_ClassToObject;
\r
2466 ! for (x=GetWord(a),a=a+2,i=0 : x : x=GetWord(a),a=a+2,i++)
\r
2467 ! print "Class ", i, " maps to Object ", (Zname) x, "^";
\r
2472 ! [ DumpIdentifiers
\r
2476 ! for (a=a_PropNames+2,i=1 : i<n_PropNames : a=a+2,i++) {
\r
2478 ! print "PROP", (dec3) i, " = ";
\r
2480 ! print (Zstring) x;
\r
2483 ! 2: print "(ofclass)";
\r
2484 ! 3: print "(metaclass)";
\r
2486 ! print "<unknown property>";
\r
2491 ! for (i=0 : i<n_AttrNames : i++,a=a+2)
\r
2492 ! print "ATTR", (dec3) i, " = ", (Zstring) GetWord(a), "^";
\r
2494 ! for (i=0 : i<n_Actions : i++,a=a+2)
\r
2495 ! print "ACTN", (dec3) i, " = ", (Zstring) GetWord(a), "^";
\r
2497 ! for (i=0 : i<n_ArrayNames : i++,a=a+2)
\r
2498 ! print "FAKE", (dec3) i, " = ", (Zstring) GetWord(a), "^";
\r
2503 ! [ DumpGlobalVariables
\r
2507 ! for (a=a_Globals,i=0 : i<240 : a=a+2,i++)
\r
2508 ! print "G", (dec3) i, " = ", (hex4) GetWord(a), "^";
\r
2513 ! =================================================================================================
\r
projects / inform-resources.git / blob