home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / GAMES / informosk.lha / inform.c < prev    next >
Text File  |  1993-11-27  |  159KB  |  4,231 lines
  1. /* -------------------------------------------------------------------------------- */
  2. /*   Inform:  Version 3 Z-code compiler                                             */
  3. /*                                                                                  */
  4. /*   (c) Graham Nelson, 1993                                                        */
  5. /*   A manual for this language is available from the if-archive at ftp.gmd.de.     */
  6. /*   Please read the legal note below.                                              */
  7. /* -------------------------------------------------------------------------------- */
  8.  
  9. #define RELEASE_STRING "Release 3 (November 16th 1993)"
  10. #define RELEASE_NUMBER 796
  11.  
  12. /* -------------------------------------------------------------------------------- */
  13. /*   Our machine for today is...                                                    */
  14. /*                                                                                  */
  15. /*   [ Inform should compile and work without trouble if you simply:                */
  16. /*                                                                                  */
  17. /*     #define ARCHIMEDES  -  Norcroft C for the Acorn Archimedes                   */
  18. /*                            (link with ansilib only, no need for RISC_OSlib)      */
  19. /*     #define UNIX        -  gcc under Unix (see below)                            */
  20. /*     #define VAX         -  for Digital's VAX C   ]                               */
  21. /*                                                                                  */
  22. /*     #define PC sets up sensible definitions for IBM PCs, but I don't yet know    */
  23. /*     whether Inform then works.                                                   */
  24. /*                                                                                  */
  25. /*   (If no machine is defined, then cautious #defines will be made.)               */
  26. /* -------------------------------------------------------------------------------- */
  27.  
  28. #define UNIX
  29. #define ALLOCATE_BIG_ARRAYS
  30.  
  31. /* -------------------------------------------------------------------------------- */
  32. /*   The other #definable options (some of them set by the above) are:              */
  33. /*                                                                                  */
  34. /*   USE_TEMPORARY_FILES - use scratch files for workspace rather than memory       */
  35. /*   ALLOCATE_BIG_ARRAYS - use calloc() for arrays rather than global variables     */
  36. /*   PROMPT_INPUT        - prompt input rather than use Unix-style command line     */
  37. /*   TIME_UNAVAILABLE    - don't use ANSI time routines to work out today's date    */
  38. /*   ARC_PROFILING       - do clumsy profiling in Norcroft C on the Archimedes      */
  39. /*   GRAHAM              - for Graham's machine only                                */
  40. /* -------------------------------------------------------------------------------- */
  41. /*                                                                                  */
  42. /*   Any use of this program may be made, provided that no profit is involved and   */
  43. /*   that this message is preserved in all modified versions; see the documentation */
  44. /*   for fuller legal details.  Note that it is not public domain.                  */
  45. /*                                                                                  */
  46. /* -------------------------------------------------------------------------------- */
  47. /*   Hello, Porter!                                                                 */
  48. /*                                                                                  */
  49. /*   The code is in ANSI C.  At present it assumes that at least long integers are  */
  50. /*   32 bit, though ordinary integers can be either 16 or 32 bit, and stored in     */
  51. /*   either order (high to low or vice versa).  It no longer uses strtoul, and can  */
  52. /*   manage without strftime.  See the details below.                               */
  53. /*                                                                                  */
  54. /*   To use Inform (once it's compiled) you need about 700K maximum of filespace    */
  55. /*   (much less for small games) and at most 200K of spare memory (i.e., memory     */
  56. /*   not physically occupied by Inform).                                            */
  57. /*                                                                                  */
  58. /*   If you succeed in porting Inform to a new compiler, please email the author    */
  59. /*   to say how, so that whatever you did can be incorporated in the next release.  */
  60. /* -------------------------------------------------------------------------------- */
  61. /*   UNIX port (by Dilip Sequeira):  The right optimisation to use is               */
  62. /*      gcc -O2 -fwritable-strings -finline-functions -fomit-frame-pointer inform.c */
  63. /*   (making an executable of size about 100K on a SparcStation II).                */
  64. /*   The temporary files option is not on by default, but if it is used, temporary  */
  65. /*     file names are used which contain the process ID.                            */
  66. /* -------------------------------------------------------------------------------- */
  67. /*                                                                                  */
  68. /*   The first archive release (0.5) was on April 30th 1993.                        */
  69. /*   The second archive release (0.6) had the following improvements:               */
  70. /*                                                                                  */
  71. /*     One #ifdef ARCHIMEDES altered to correct a bug in non-Archimedes version     */
  72. /*     (the Acorn Archimedes A5000 being the author's make of computer)             */
  73. /*     Checking on the MAX_ACTIONS limit put in ("Curses" finally exceeded 100!)    */
  74. /*     Checking on MAX_STATIC_STRINGS put in; -m information extended               */
  75. /*     -x (hash printing) option introduced                                         */
  76. /*     -a (list assembly lines only) option, and ATRACE/NOATRACE introduced         */
  77. /*     Void prototypes explicitly declared (void)                                   */
  78. /*     Defunct Inform directives "STRING" and "SET" removed                         */
  79. /*     Opcode data now made static, and faster opcode-parsing routine put in        */
  80. /*     Preprocessor stack rewritten, and now checking for overflow                  */
  81. /*     Showdict produces more useful output                                         */
  82. /*     Filename extension #defines added                                            */
  83. /*     Command line parsing improved                                                */
  84. /*                                                                                  */
  85. /*     Some ASCII-esque assumptions in the first edition are now removed;           */
  86. /*     tolower and toupper are used more cautiously and it should be possible to    */
  87. /*     port to EBCDIC and other monstrosities, by altering the "character set"      */
  88. /*     routines below                                                               */
  89. /*                                                                                  */
  90. /*     The first edition presumed integers to be 32-bits long;                      */
  91. /*     some typedefs below attempt to force this on an otherwise unwilling compiler */
  92. /*     (but will give up with an error if even long ints are only 16-bit)           */
  93. /*                                                                                  */
  94. /*   The main improvement over the first edition is in memory management which      */
  95. /*     has been heavily reformed, at the expense of a certain charm.  It can now    */
  96. /*     malloc() less than 75K memory (as opposed to over 800K before!). (See below) */
  97. /*                                                                                  */
  98. /*     USE_TEMPORARY_FILES version: if this is #defined, scratch files amounting    */
  99. /*        to at most about 100K and 50K respectively are used to hold partial       */
  100. /*        results; this saves about another 150K.                                   */
  101. /*        (At worst three files are simultaneously open under this regime.)         */
  102. /*        The temporary file names are #define'd below.  They are automatically     */
  103. /*        deleted.                                                                  */
  104. /*                                                                                  */
  105. /*   The third release (1.0) has been generally tidied up and reorganised: most     */
  106. /*   of the sillier variable and routine names have been made more comprehensible.  */
  107. /*   It is also 3 to 6 times faster; I wish to thank Dilip Sequeira for giving      */
  108. /*   me profiling output, and also David Moore for his... comments.                 */
  109. /*                                                                                  */
  110. /*   The program itself has the following improvements:                             */
  111. /*                                                                                  */
  112. /*     @xx string indirection via the synonyms table added                          */
  113. /*     Objects allowed to have multiple internal names                              */
  114. /*     New constant form #n$word... added                                           */
  115. /*     And #r$routine...                                                            */
  116. /*     New high-level commands "write" and "give" for easier object alteration      */
  117. /*     Fatal errors fractionally more informative                                   */
  118. /*     Non-fatal errors quite a lot more informative, and more sensibly worded      */
  119. /*     Grievous bug in stack long slot routines fixed                               */
  120. /*     The checksum and length words are now properly set (though few interpreters  */
  121. /*       need them)                                                                 */
  122. /*     Error checking on exceeding MAX_VERBS                                        */
  123. /*     -e (economy mode) added: causes abbreviations to be worked out, slowly       */
  124. /*     #SWITCHES directive added                                                    */
  125. /*     -i (ignore switches) and -o (print offsets) added                            */
  126. /*     Checking added on whether routines have too many local variables (the        */
  127. /*       Z-machine crashes in a very strange way if so!)                            */
  128. /*     Minor bug in printing object tree fixed                                      */
  129. /*     Two unused bytes spare at end of property defaults table are now zeroed      */
  130. /*     Temporary files now deleted after use                                        */
  131. /*     Checking on excessively long variable names added                            */
  132. /*     STATUSLINE directive added (for games with hours/minutes on the status line) */
  133. /*     The former SMALL_MEMORY compilation option is now mandatory.  (Previously,   */
  134. /*       Inform could be compiled so that it read source files into an enormous     */
  135. /*       buffer, rather than reading them twice through a bit at a time.  This      */
  136. /*       could only be useful on machines with huge memory and very slow filing     */
  137. /*       systems, of which there are few, and it complicated the code.)             */
  138. /*     The way input file names are processed has been reformed: they are now not   */
  139. /*       altered if they contain a '.' or a '/'                                     */
  140. /*     INCLUDE directive added, so that Inform #includes files like C               */
  141. /*     Old -p (both passes) directive renamed -b, and new -p (percentage breakdown) */
  142. /*     Warnings added: variables not used; checking that Main behaves properly;     */
  143. /*       small bug in line counting fixed; checking on number of function arguments */
  144. /*     Meta-verbs added                                                             */
  145. /*     -f (frequencies) and -t (assembly trace) switches added                      */
  146. /*     Small bug to do with stubbed routines removed                                */
  147. /*     Possibly unused bytes (due to word alignment) in data, now zeroed            */
  148. /*       (so that different machines will not produce different game files)         */
  149. /*     -f now calculates bytes yielded by abbreviations                             */
  150. /*     New SERIAL directive for machines without access to today's date             */
  151. /*     Now handles more complicated multiple expressions within the same command    */
  152. /*     New STRING command added for writing to the synonyms table                   */
  153. /*     New FONT command for proportional fonts control                              */
  154. /*     New DEFAULT and STUB directives, for stubbing undeclared CONSTANTs and code  */
  155. /*     Checking on no. of attributes and properties added, and property-counting    */
  156. /*                                                                                  */
  157. /*   Speed improvements in the third release:                                       */
  158. /*                                                                                  */
  159. /*     The following have been rewritten in the interests of speed and generally    */
  160. /*       not being O(n^2) for the sake of it: the line reader and tokeniser,        */
  161. /*       management of local variables, the dictionary builder, the text            */
  162. /*       translator, the line parser and the symbols table (courtesy of hash coding */
  163. /*       by Dilip).                                                                 */
  164. /*                         Curses    Dejavu       (compiling times in seconds       */
  165. /*                                                 on my machine)                   */
  166. /*        Release 2...        300        45       (including 1-2 seconds for        */
  167. /*        Tokeniser & locals  205        26        printing statistics)             */
  168. /*        Dictionary           89        19                                         */
  169. /*        Symbols hashing      74        17                                         */
  170. /*        Tokeniser II         69        16                                         */
  171. /*        Abbreviations        55        16                                         */
  172. /*        Hashing reserveds    49        14                                         */
  173. /*                                                                                  */
  174. /*   Compatibility improvements in the third release:                               */
  175. /*                                                                                  */
  176. /*     The sort_number routine has been rewritten at the suggestion of Jon Drukman  */
  177. /*       in order to defend against compilers determined to sign chars; and so have */
  178. /*       some structure definitions and variable types                              */
  179. /*     Subtraction of pointers is now done by an easily altered macro (the point    */
  180. /*       being that you can't always subtract by casting to int, if int is 16 bit)  */
  181. /*     File naming improved slightly                                                */
  182. /*     The two points where ASCII is used now go through translate_to_ascii         */
  183. /*     Some stupid alterations made for VAX C compatibility                         */
  184. /*       (in the idiot world of VAX C, # commands must start on column 1,           */
  185. /*       x=-1 is read as x-=1, typedef isn't ANSI, the word "signed" is rejected,   */
  186. /*       values like MAX_INT are wrongly set and string consts don't concatenate)   */
  187. /*     A general rewrite has been made to sort out 16-bit from 32-bit integers:     */
  188. /*       Inform now properly works when int is 16 bit by default.                   */
  189. /*     VAX version now working (so presumably Inform does not rely on the order of  */
  190. /*       bytes in a word)                                                           */
  191. /*     Long constants explicitly declared so (to keep Borland C++ happy)            */
  192. /*                                                                                  */
  193. /*     Because some C compilers (especially PC ones) don't like large static arrays */
  194. /*     there's now an ALLOCATE_BIG_ARRAYS option (#define PC forces it) which uses  */
  195. /*     calloc to allocate memory from the heap for them.                            */
  196. /*                                                                                  */
  197. /*     Altogether Inform is going to need about 190K of workspace, and that's that: */
  198. /*     in a big flat memory machine, this will split about equally between static   */
  199. /*     arrays and dynamic allocation.  With ALLOCATE_BIG_ARRAYS set it will be      */
  200. /*     almost entirely dynamically allocated.                                       */
  201. /*                                                                                  */
  202. /*     If PROMPT_INPUTS is defined (and the VAX and PC versions force this), Inform */
  203. /*       gets file names and options by prompting for keyboard input, rather than   */
  204. /*       using a Unix-style command line.                                           */
  205. /*                                                                                  */
  206. /*     If TIME_UNAVAILABLE is defined, Inform doesn't try to use strftime and       */
  207. /*       doesn't enter today's date for the serial number: the programmer will have */
  208. /*       to use a SERIAL directive in Inform, instead.                              */
  209. /* -------------------------------------------------------------------------------- */
  210. /*  A rough tourist's map of this program:                                          */
  211. /*                                                                                  */
  212. /*        Comments                                                                  */
  213. /*        #defines                                                                  */
  214. /*        Integer types, local character set                                        */
  215. /*        Structures                                                                */
  216. /*        Arrays                                                                    */
  217. /*        Global variables                                                          */
  218. /*                                                                                  */
  219. /*        Text translation                  Routines used throughout                */
  220. /*        File handling                     (cast in order of appearance)           */
  221. /*        Preprocessor stack                                                        */
  222. /*        Character-level parsing                                                   */
  223. /*        Error reporting                                                           */
  224. /*        Dictionary maker                                                          */
  225. /*        Symbols table maker                                                       */
  226. /*        Printing diagnostics                                                      */
  227. /*        Action maker                                                              */
  228. /*                                                                                  */
  229. /*        Main                              Higher level routines                   */
  230. /*          Initialisation                  (second half; in logical order)         */
  231. /*          Command line switches                                                   */
  232. /*          Top level line parser                                                   */
  233. /*            Compiler                                                              */
  234. /*              Expression evaluator                                                */
  235. /*            Assembler directives                                                  */
  236. /*              Make objects                                                        */
  237. /*              Make globals                                                        */
  238. /*              Make verbs                                                          */
  239. /*            Line assembler                                                        */
  240. /*              Z-code database                                                     */
  241. /*          Construct output file                                                   */
  242. /*                                                                                  */
  243. /* -------------------------------------------------------------------------------- */
  244. /*   By setting up the prefixes and extensions in the definitions below, you should */
  245. /*   be able to get something sensible for your filing system.                      */
  246. /*   In the last resort, the clumsy "z3" prefix below is chosen to cause least      */
  247. /*   offense to different filing systems.                                           */
  248. /*   Note that if both Code_Prefix and Code_Extension are empty, then Inform may    */
  249. /*   overwrite its source code with the object code... so don't allow this.         */
  250. /*   (For Unix the extension is ".z3" rather than ".zip" to avoid looking like the  */
  251. /*   file compression trailer...)                                                   */
  252. /*                                                                                  */
  253. /*   On an Archimedes or a PC, set USE_TEMPORARY_FILES: otherwise don't, by default */
  254. /* -------------------------------------------------------------------------------- */
  255.  
  256. #ifdef GRAHAM
  257. #include "h.version"
  258. #define ARCHIMEDES
  259. #else
  260. #define VNUMBER RELEASE_NUMBER
  261. #endif
  262.  
  263. #ifdef ARCHIMEDES
  264. #define MACHINE_STRING   "Archimedes"
  265. #define Source_Prefix    "Zcode."
  266. #define Source_Extension ""
  267. #define Include_Prefix   "Zcode.h."
  268. #define Code_Prefix      "Zgames."
  269. #define Code_Extension   ""
  270. #define USE_TEMPORARY_FILES
  271. #define Temp1_Name "ram:InfTemp1"
  272. #define Temp2_Name "ram:InfTemp2"
  273. #ifdef ARC_PROFILING
  274.      extern int _fmapstore(char *);
  275. #endif
  276. #endif
  277.  
  278. #ifdef UNIX
  279. #define MACHINE_STRING   "Unix"
  280. #define Source_Prefix    ""
  281. #define Source_Extension ".inf"
  282. #define Include_Extension ".h"
  283. #define Code_Prefix      ""
  284. #define Code_Extension   ".z3"
  285. char Temp1_Name[50], Temp2_Name[50];
  286. #define Temp1_Hdr "/tmp/InformTemp1"
  287. #define Temp2_Hdr "/tmp/InformTemp2"
  288. #endif
  289.  
  290. #ifdef PC
  291. #define PROMPT_INPUT
  292. #define MACHINE_STRING   "PC"
  293. #define Source_Prefix    ""
  294. #define Source_Extension ".inf"
  295. #define Include_Extension ".h"
  296. #define Code_Prefix      ""
  297. #define Code_Extension   ".zip"
  298. #define Temp1_Name "Inftmp1.tmp"
  299. #define Temp2_Name "Inftmp2.tmp"
  300. #define USE_TEMPORARY_FILES
  301. #define ALLOCATE_BIG_ARRAYS
  302. #endif
  303.  
  304. #ifdef VAX
  305. #define PROMPT_INPUT
  306. #define TIME_UNAVAILABLE
  307. #define MACHINE_STRING   "VAX"
  308. #define Source_Prefix    ""
  309. #define Source_Extension ".inf"
  310. #define Include_Extension ".h"
  311. #define Code_Prefix      ""
  312. #define Code_Extension   ".zip"
  313. #define Temp1_Name "Inftmp1.tmp"
  314. #define Temp2_Name "Inftmp2.tmp"
  315. #endif
  316.  
  317. #ifndef Source_Prefix
  318. #define Source_Prefix    ""
  319. #define Source_Extension ""
  320. #define Code_Prefix      "z3"
  321. #define Code_Extension   ""
  322. #define Temp1_Name "Inftemp1"
  323. #define Temp2_Name "Inftemp2"
  324. #endif
  325.  
  326. #ifndef Include_Prefix
  327. #define Include_Prefix Source_Prefix
  328. #endif
  329. #ifndef Include_Extension
  330. #define Include_Extension Source_Extension
  331. #endif
  332.  
  333. /* -------------------------------------------------------------------------------- */
  334. /*   What the #defines mean:                                                        */
  335. /*                                                                                  */
  336. /*   1. Memory-expensive ones, which could be reduced for smaller games             */
  337. /*                                                                                  */
  338. /*   MAX_DICT_ENTRIES       Most full games need at least 500; "Curses" needs 750   */
  339. /*   MAX_SYMBOLS            Total symbols (system and user); eg, "Curses" has 3400  */
  340. /*   MAX_BANK_SIZE          Symbols are indexed in 7 "banks" for quick searching    */
  341. /*   MAX_VERBS              About 130 bytes each; eg, "Curses" has 105              */
  342. /*                                                                                  */
  343. /*   BUFFER_LENGTH          Source code lines (between ;'s) must be < this          */
  344. /*                          Some routines have local strings this large, so it eats */
  345. /*                          the C stack a little.  Inform has two global buffers    */
  346. /*                          plus STACK_LONG_SLOTS more, all this size.              */
  347. /*                                                                                  */
  348. /*   MAX_EXPRESSION_NODES   Measures of how complicated expressions can be:         */
  349. /*   MAX_ARITY              about (7+MA)*4*MEN bytes are consumed by the expression */
  350. /*                          evaluator's main array; less than 8K even when large    */
  351. /*                          (since MA is at most 5 for the Z-machine, there's no    */
  352. /*                          point in increasing it)                                 */
  353. /*                                                                                  */
  354. /*   MAX_OLDEPTH            Maximum "objectloop" nesting (costs c. 40 bytes each)   */ 
  355. /*                                                                                  */
  356. /*   STACK_SIZE             The preprocessor stack malloc's                         */
  357. /*   STACK_LONG_SLOTS          SS*SSL + SLS*BL                                      */
  358. /*   STACK_SHORT_LENGTH     bytes.  SS must be at least 10 or so.  SSL could        */
  359. /*                          probably be reduced to 50 or so at a pinch.             */
  360. /*                          SLS is small anyway (but so it should be!)              */
  361. /*                                                                                  */
  362. /*   MAX_INCLUSION_DEPTH    How deeply source files can #include each other         */
  363. /*                          (these cost about 72 bytes each)                        */
  364. /*                                                                                  */
  365. /*   2. Cheap ones; sizes of integer arrays and the like                            */
  366. /*                                                                                  */
  367. /*   MAX_ACTIONS            Actions are not very expensive; eg "Curses" has 120     */
  368. /*   MAX_ADJECTIVES         Again, cheap.  Typical Infocom games have 16-20         */
  369. /*   MAX_STATIC_DATA        Size of an int array.  Must be >= 1024; "Curses" 1300   */
  370. /*   MAX_TOKENS             Tokens per source line; this is cheap to increase       */
  371. /*   MAX_BLOCK_NESTING      Nesting of braces {, }                                  */
  372. /*   MAX_ROUTINES           eg, "Curses" only has 350                               */
  373. /*   MAX_GCONSTANTS         Too complicated for this margin, but cheap and rare     */
  374. /*   MAX_ERRORS             Number of errors allowed before Inform gives up         */
  375. /*   MAX_ABBREVS            Maximum declared abbreviations (must be <=64)           */
  376. /*   MAX_ABBREV_LENGTH      Storage for abbrevs = product of these two              */
  377. /*   MAX_IDENTIFIER_LENGTH  Max size of variable names, etc: say 32                 */
  378. /*                                                                                  */
  379. /*   3. Sizes in bytes of malloc'ated memory                                        */
  380. /*                                                                                  */
  381. /*   MAX_INITIAL_DATA_SIZE  Holds story file up to the code area; don't reduce it   */
  382. /*   MAX_PROP_TABLE_SIZE    Holds properties table; eg, "Curses" needs 7500         */
  383. /*   MAX_INPUT_LENGTH       Cache for holding source code; eg, "Curses" is 350K     */
  384. /*                          (only used in large memory version)                     */
  385. /*   MAX_STATIC_STRINGS     In temporary files version, must be >= as large as      */
  386. /*   MAX_ZCODE_SIZE         largest likely string;                                  */
  387. /*                          in large memory version, must be >= as large as strings */
  388. /*                          area (c. 40K) and code area (c. 80K) respectively       */
  389. /*                                                                                  */
  390. /*   SYMBOLS_CHUNK_SIZE     Symbols table is malloc'd in chunks as needed           */
  391. /*                                                                                  */
  392. /*   With ALLOCATE_BIG_ARRAYS set, (and with the other two options on) Inform       */
  393. /*   malloc's about 190K, of which the largest continuous segment is 48000 bytes.   */
  394. /* -------------------------------------------------------------------------------- */
  395. /*   Inclusions and the important macro definitions:                                */
  396. /* -------------------------------------------------------------------------------- */
  397.  
  398. #include <stdio.h>
  399. #include <stdlib.h>
  400. #include <ctype.h>
  401. #include <string.h>
  402. #include <time.h>
  403. #include <limits.h>
  404.  
  405. #define BUFFER_LENGTH       2000
  406. #define MAX_SYMBOLS         3500
  407. #define MAX_BANK_SIZE       2000
  408. #define SYMBOLS_CHUNK_SIZE  5000
  409. #define HASH_TAB_SIZE       512
  410.  
  411. #define MAX_ACTIONS          125
  412. #define MAX_ADJECTIVES        50
  413. #define MAX_DICT_ENTRIES     750
  414. #define MAX_STATIC_DATA     1500
  415.  
  416. #define MAX_TOKENS           100
  417. #define MAX_BLOCK_NESTING     32
  418. #define MAX_OLDEPTH            8
  419. #define MAX_ROUTINES         400
  420. #define MAX_GCONSTANTS        50
  421. #define MAX_ERRORS           100
  422. #define MAX_IDENTIFIER_LENGTH 32
  423.  
  424. #define MAX_INITIAL_DATA_SIZE  25000
  425. #define MAX_PROP_TABLE_SIZE    10000
  426.  
  427. #define MAX_ARITY              5
  428.  
  429. #define STACK_SIZE            20
  430. #define STACK_LONG_SLOTS       5
  431. #define STACK_SHORT_LENGTH    80
  432.  
  433. #define MAX_ABBREVS           64
  434. #define MAX_ABBREV_LENGTH     64
  435.  
  436. #define MAX_EXPRESSION_NODES   40
  437. #define MAX_VERBS             110
  438.  
  439. #define MAX_INCLUSION_DEPTH    4
  440.  
  441. #ifdef USE_TEMPORARY_FILES
  442. #define MAX_STATIC_STRINGS      2000
  443. #define MAX_ZCODE_SIZE          2000
  444. #else
  445. #define MAX_STATIC_STRINGS     50000
  446. #define MAX_ZCODE_SIZE        100000
  447. #endif
  448.  
  449. /* -------------------------------------------------------------------------------- */
  450. /*   Twisting the C compiler's arm to get a convenient 32-bit integer type          */
  451. /*   Warning: chars are presumed unsigned in this code, which I think is ANSI std;  */
  452. /*   but they were presumed signed by K&R, so confusion reigns.  Anyway a compiler  */
  453. /*   ought to be able to cast either way as needed.                                 */
  454. /*   Subtracting pointers is in a macro here for convenience: if even 32 bit ints   */
  455. /*   won't reliably hold pointers on your machine, rewrite properly using ptrdiff_t */
  456. /* -------------------------------------------------------------------------------- */
  457.  
  458. #ifndef VAX
  459. #if   SCHAR_MAX >= 0x7FFFFFFFL && SCHAR_MIN <= -0x7FFFFFFFL
  460.       typedef signed char       int32; 
  461.       typedef unsigned char     uint32; 
  462. #elif SHRT_MAX >= 0x7FFFFFFFL  && SHRT_MIN <= -0x7FFFFFFFL
  463.       typedef signed short int  int32;
  464.       typedef unsigned short int uint32;
  465. #elif INT_MAX >= 0x7FFFFFFFL   && INT_MIN <= -0x7FFFFFFFL
  466.       typedef signed int        int32;
  467.       typedef unsigned int      uint32;
  468. #elif LONG_MAX >= 0x7FFFFFFFL  && LONG_MIN <= -0x7FFFFFFFL
  469.       typedef signed long int   int32;
  470.       typedef unsigned long int uint32;
  471. #else
  472.       #error No type large enough to support 32-bit integers.
  473. #endif
  474. #else
  475.       typedef int int32;
  476.       typedef unsigned int uint32;
  477. #endif
  478.  
  479. #define subtract_pointers(p1,p2) (((int32) p1)-((int32) p2))
  480.  
  481. /* -------------------------------------------------------------------------------- */
  482. /*  This hideous line is here only for checking on my machine that Inform runs      */
  483. /*  properly when int is 16-bit                                                     */
  484. /* -------------------------------------------------------------------------------- */
  485.  
  486. /* #define int short int */
  487.  
  488. /* -------------------------------------------------------------------------------- */
  489. /*  Routines which use unusual ANSI library functions:                              */
  490. /*                                                                                  */
  491. /*  write_serialnumber writes today's date in the form YYMMDD as a string           */
  492. /*    (as can be seen, the VAX doesn't know it)                                     */
  493. /* -------------------------------------------------------------------------------- */
  494.  
  495. int time_set=0; char time_given[7];
  496. void write_serialnumber(char *buffer)
  497. {   time_t tt;  tt=time(0);
  498.     if (time_set==0)
  499. #ifdef TIME_UNAVAILABLE
  500.       sprintf(buffer,"930000");
  501. #else
  502.       strftime(buffer,10,"%y%m%d",localtime(&tt));
  503. #endif
  504.     else
  505.       sprintf(buffer,"%06s",time_given);
  506. }
  507.  
  508. /* -------------------------------------------------------------------------------- */
  509. /*   Character set                                                                  */
  510. /*   (Alter translate_to_ascii if need be to convert your local character set)      */
  511. /* -------------------------------------------------------------------------------- */
  512.  
  513. void make_lower_case(char *str)
  514. {   int i;
  515.     for (i=0; str[i]!=0; i++)
  516.         if (isupper(str[i])) str[i]=tolower(str[i]);
  517. }
  518.  
  519. void make_upper_case(char *str)
  520. {   int i;
  521.     for (i=0; str[i]!=0; i++)
  522.         if (islower(str[i])) str[i]=toupper(str[i]);
  523. }
  524.  
  525. int translate_to_ascii(char c)
  526. {   return((int) c);
  527. }
  528.  
  529. #define SINGLE_QUOTE '\''
  530.  
  531. /* -------------------------------------------------------------------------------- */
  532. /*   Structure definitions                                                          */
  533. /* -------------------------------------------------------------------------------- */
  534.  
  535. typedef struct sourcefile
  536. {   FILE *handle;
  537.     char filename[64];
  538.     int  source_line;
  539. } Sourcefile;
  540.  
  541. typedef struct opcode
  542. {   char *name;
  543.     int code, offset, type1, type2, no;
  544. } opcode;
  545.  
  546. typedef struct operand_t
  547. {   int32 value; int type;
  548. } operand_t;
  549.  
  550. typedef struct treenode {
  551.     int arity;
  552.     int g[MAX_ARITY];
  553.     int wnumber;
  554.     int type;
  555.     int gcount;
  556.     int up;
  557.     int priority;
  558.     char *op;
  559. } treenode;
  560.  
  561. typedef struct verbl {
  562.     unsigned char e[8];
  563. } verbl;
  564.  
  565. typedef struct verbt {
  566.     int lines;
  567.     verbl l[16];
  568. } verbt;
  569.  
  570. typedef struct prop {
  571.     unsigned char l, num, p[10];
  572. } prop;
  573.  
  574. typedef struct propt {
  575.     char l;
  576.     prop pp[32];
  577. } propt;
  578.  
  579. typedef struct objectt {
  580.     unsigned char atts[4], parent, next, child;
  581.     int propsize;
  582. } objectt;
  583.  
  584. /* -------------------------------------------------------------------------------- */
  585. /*   All the arrays of larger than tiny size                                        */
  586. /* -------------------------------------------------------------------------------- */
  587.  
  588. #ifndef ALLOCATE_BIG_ARRAYS
  589.   verbt   vs[MAX_VERBS];
  590.   objectt objects[256];
  591.   int     table_init[MAX_STATIC_DATA];
  592.   int32   actions[MAX_ACTIONS],
  593.           preactions[MAX_ACTIONS],
  594.           adjectives[MAX_ADJECTIVES],
  595.           adjcomps[MAX_ADJECTIVES];
  596.   char *  symbs[MAX_SYMBOLS];
  597.   int32   svals[MAX_SYMBOLS],
  598.           gvalues[240];
  599.   int     gflags[240];
  600. #ifdef VAX
  601.   char    stypes[MAX_SYMBOLS];
  602. #else
  603.   signed char  stypes[MAX_SYMBOLS];
  604. #endif
  605.   int     abbrev_values[MAX_ABBREVS];
  606.   int     abbrev_quality[MAX_ABBREVS];
  607.   int     abbrev_freqs[MAX_ABBREVS];
  608.   char    buffer[BUFFER_LENGTH];
  609.   int     banks[7][MAX_BANK_SIZE];
  610.   int     bank1_next[MAX_BANK_SIZE];
  611.   int32   bank1_hash[HASH_TAB_SIZE];
  612.   int     bank6_next[MAX_BANK_SIZE];
  613.   int32   bank6_hash[HASH_TAB_SIZE];
  614.   int     routine_keys[MAX_ROUTINES];
  615.   int     dict_places_list[MAX_DICT_ENTRIES],
  616.           dict_places_back[MAX_DICT_ENTRIES],
  617.           dict_places_inverse[MAX_DICT_ENTRIES];
  618.   int32   dict_sorts[MAX_DICT_ENTRIES];
  619.   treenode   woods[MAX_EXPRESSION_NODES];
  620. #else
  621.   verbt   *vs;
  622.   objectt *objects;
  623.   int     *table_init;
  624.   int32   *actions,
  625.           *preactions,
  626.           *adjectives,
  627.           *adjcomps;
  628.   char *  *symbs;
  629.   int32   *svals,
  630.           *gvalues;
  631.   int     *gflags;
  632. #ifdef VAX
  633.   char    *stypes;
  634. #else
  635.   signed char  *stypes;
  636. #endif
  637.   int     *abbrev_values;
  638.   int     *abbrev_quality;
  639.   int     *abbrev_freqs;
  640.   char    *buffer;
  641.   int     *banks_are_at;
  642.   int     *routine_keys;
  643.   int     *dict_places_list,
  644.           *dict_places_back,
  645.           *dict_places_inverse;
  646.   int32   *dict_sorts;
  647.   int     *banks[7];
  648.   int     *bank1_next;
  649.   int32   *bank1_hash;
  650.   int     *bank6_next;
  651.   int32   *bank6_hash;
  652.   treenode   *woods;
  653. #endif
  654.  
  655. void *my_calloc(int, int);
  656. void allocate_the_arrays()
  657. {   
  658. #ifdef ALLOCATE_BIG_ARRAYS
  659.     int i;
  660.     vs         = my_calloc(sizeof(verbt),   MAX_VERBS);
  661.     objects    = my_calloc(sizeof(objectt), 256);
  662.     table_init = my_calloc(sizeof(int),     MAX_STATIC_DATA);
  663.     actions    = my_calloc(sizeof(int32),   MAX_ACTIONS);
  664.     preactions = my_calloc(sizeof(int32),   MAX_ACTIONS);
  665.     adjectives = my_calloc(sizeof(int32),   MAX_ADJECTIVES);
  666.     adjcomps   = my_calloc(sizeof(int32),   MAX_ADJECTIVES);
  667.     symbs      = my_calloc(sizeof(char *),  MAX_SYMBOLS);
  668.     svals      = my_calloc(sizeof(int32),   MAX_SYMBOLS);
  669.     gvalues    = my_calloc(sizeof(int32),   240);
  670.     gflags     = my_calloc(sizeof(int),     240);
  671.     stypes     = my_calloc(sizeof(char),MAX_SYMBOLS);
  672.     abbrev_values = my_calloc(sizeof(int),  MAX_ABBREVS);
  673.     abbrev_quality = my_calloc(sizeof(int), MAX_ABBREVS);
  674.     abbrev_freqs = my_calloc(sizeof(int),  MAX_ABBREVS);
  675.     buffer     = my_calloc(sizeof(char),    BUFFER_LENGTH);
  676.     banks_are_at = my_calloc(sizeof(int),   7*MAX_BANK_SIZE);
  677.     bank1_next = my_calloc(sizeof(int),     MAX_BANK_SIZE);
  678.     bank1_hash = my_calloc(sizeof(int32),   MAX_BANK_SIZE);
  679.     bank6_next = my_calloc(sizeof(int),     MAX_BANK_SIZE);
  680.     bank6_hash = my_calloc(sizeof(int32),   MAX_BANK_SIZE);
  681.     for (i=0; i<7; i++)
  682.         banks[i] = banks_are_at + i*MAX_BANK_SIZE;
  683.     routine_keys = my_calloc(sizeof(int),   MAX_ROUTINES);
  684.     dict_places_list = my_calloc(sizeof(int),  MAX_DICT_ENTRIES);
  685.     dict_places_back = my_calloc(sizeof(int),  MAX_DICT_ENTRIES);
  686.     dict_places_inverse = my_calloc(sizeof(int),  MAX_DICT_ENTRIES);
  687.     dict_sorts = my_calloc(sizeof(int32),   MAX_DICT_ENTRIES);
  688.     woods      = my_calloc(sizeof(treenode),   MAX_EXPRESSION_NODES);
  689. #else
  690.     return;
  691. #endif
  692. }
  693.  
  694. /* -------------------------------------------------------------------------------- */
  695. /*   The important global variables                                                 */
  696. /* -------------------------------------------------------------------------------- */
  697.  
  698. int no_verbs=0,    no_actions=0,  no_adjectives=0,  no_abbrevs=0,   no_attributes,
  699.     no_properties, no_globals=0,  no_objects,       dict_entries;
  700.  
  701. int no_symbols=0,  no_routines,   no_dummy_labels,  no_blocks_made, no_gconstants=0,
  702.     no_errors=0,   no_warnings=0, no_locals,        no_stubbed;
  703. int fp_no_actions, in_routine_flag;
  704.  
  705. int brace_stack[MAX_BLOCK_NESTING], brace_sp, next_block_type, forloop_flag;
  706. int stub_flags[32];
  707.  
  708. int ppstack_openb, ppstack_closeb;
  709.  
  710. int globals_size, properties_size;
  711.  
  712. int32 prop_defaults[32]; int prop_longflag[32]; char *properties_table;
  713.  
  714. int release_number=1, statusline_flag=0;
  715.  
  716. propt full_object;
  717.  
  718. char *zcode,      *zcode_p,
  719.      *symbols_p,  *symbols_top,
  720.      *strings,    *strings_p,
  721.      *dictionary, *dict_p,
  722.      *output_p,   *abbreviations_at;
  723.  
  724. int statistics_mode=0,     offsets_mode=0,    memout_mode=0,   economy_mode=0,
  725.     ignoreswitches_mode=0, bothpasses_mode=0, double_spaced=0, hash_mode=0,
  726.     percentages_mode=0,    trace_mode,        ltrace_mode,     etrace_mode,
  727.     listing_mode=0,        concise_mode=0,    nowarnings_mode=0,
  728.     frequencies_mode=0,    tracing_mode;
  729. int abbrev_mode=1;
  730.  
  731. Sourcefile InputFiles[MAX_INCLUSION_DEPTH];
  732. int input_file, total_files_read;
  733.  
  734. int32 marker_in_file;
  735. int internal_line, total_source_line, pass_number, return_flag,
  736.     firsthash_flag=1, recenthash_flag=0, endofpass_flag=0;
  737.  
  738. int code_offset       = 0x400,
  739.     actions_offset    = 0x800,
  740.     preactions_offset = 0x800,
  741.     dictionary_offset = 0x800,
  742.     adjectives_offset = 0x800,
  743.     variables_offset  = 0,
  744.     strings_offset    = 0x800;
  745.  
  746. int32 Out_Size, Write_Code_At, Write_Strings_At;
  747.  
  748. char Source_Name[100], Code_Name[100];
  749.  
  750. #ifdef USE_TEMPORARY_FILES
  751.     FILE *Temp1_fp=NULL, *Temp2_fp=NULL;
  752.     char *utf_zcode_p;
  753. #endif
  754.  
  755. /* -------------------------------------------------------------------------------- */
  756. /*   Text translation routines (using synonyms only as told)                        */
  757. /* -------------------------------------------------------------------------------- */
  758.  
  759. const char *alphabet[3] = {
  760.     "abcdefghijklmnopqrstuvwxyz",
  761.     "ABCDEFGHIJKLMNOPQRSTUVWXYZ",
  762.     " ^0123456789.,!?_#'~/\\-:()"
  763. };
  764.  
  765. int chars_lookup[256];
  766. int abbrevs_lookup[256], almade_flag=0;
  767.  
  768. void make_lookup()
  769. {   int i, j, k;
  770.     for (j=0; j<256; j++)
  771.     {   chars_lookup[j]=127; abbrevs_lookup[j]= -1; }
  772.     for (j=0; j<3; j++)
  773.         for (k=0; k<26; k++)
  774.         {   i=(int) ((alphabet[j])[k]);
  775.             chars_lookup[i]=k+j*26;
  776.         }
  777. }
  778.  
  779. void make_abbrevs_lookup()
  780. {   int i, j, k, l; char p[MAX_ABBREV_LENGTH]; char *p1, *p2;
  781.     do
  782.     { for (i=0, j=0; j<no_abbrevs; j++)
  783.         for (k=j+1; k<no_abbrevs; k++)
  784.         {   p1=abbreviations_at+j*MAX_ABBREV_LENGTH;
  785.             p2=abbreviations_at+k*MAX_ABBREV_LENGTH;
  786.             if (strcmp(p1,p2)>0)
  787.             {   i=1; strcpy(p,p1); strcpy(p1,p2); strcpy(p2,p);
  788.                 l=abbrev_values[j]; abbrev_values[j]=abbrev_values[k];
  789.                 abbrev_values[k]=l;
  790.                 l=abbrev_quality[j]; abbrev_quality[j]=abbrev_quality[k];
  791.                 abbrev_quality[k]=l;
  792.             }
  793.         }
  794.     } while (i==1);
  795.     for (j=no_abbrevs-1; j>=0; j--)
  796.     {   p1=abbreviations_at+j*MAX_ABBREV_LENGTH;
  797.         abbrevs_lookup[p1[0]]=j;
  798.         abbrev_freqs[j]=0;
  799.     }
  800.     almade_flag=1;
  801. }
  802.  
  803. int z_chars[3], uptothree;
  804. int total_chars_trans, total_zchars_trans, total_bytes_trans, trans_length;
  805. unsigned char *text_pc;
  806.  
  807. void write_z_char(int i)
  808. {   uint32 j;
  809.     total_zchars_trans++;
  810.     z_chars[uptothree++]=(i%32);
  811.     if (uptothree!=3) return;
  812.     j= z_chars[0]*0x0400 + z_chars[1]*0x0020 + z_chars[2];
  813.     text_pc[0] = j/256;
  814.     text_pc[1] = j%256;
  815.     uptothree=0; text_pc+=2;
  816.     total_bytes_trans+=2;
  817. }
  818.  
  819. void end_z_chars(void)
  820. {   unsigned char *p;
  821.     trans_length=total_zchars_trans-trans_length;
  822.     while (uptothree!=0) write_z_char(5);
  823.     p=(unsigned char *) text_pc;
  824.     *(p-2)= *(p-2)+128;
  825. }
  826.  
  827.  
  828. int try_abbreviations_from(unsigned char *text, int i, int from)
  829. {   int j, k; char *p, c;
  830.     c=text[i];
  831.     for (j=from, p=abbreviations_at+from*MAX_ABBREV_LENGTH;
  832.          (j<no_abbrevs)&&(c==p[0]); j++, p+=MAX_ABBREV_LENGTH)
  833.     {   if (text[i+1]==p[1])
  834.         {   for (k=2; p[k]!=0; k++)
  835.                 if (text[i+k]!=p[k]) goto NotMatched;
  836.             for (k=0; p[k]!=0; k++) text[i+k]=1;
  837.             abbrev_freqs[j]++;
  838.             return(j);
  839.             NotMatched: ; 
  840.         }
  841.     }
  842.     return(-1);
  843. }
  844.  
  845. char *translate_text(char *p, char *s_text)
  846. {   int i, j, k, newa, cc, value, value2;
  847.     unsigned char *text;
  848.  
  849.     trans_length=total_zchars_trans;
  850.  
  851.     if ((almade_flag==0)&&(no_abbrevs!=0)&&(abbrev_mode!=0))
  852.         make_abbrevs_lookup();
  853.  
  854.     text=(unsigned char *) s_text;
  855.  
  856.     uptothree=0; text_pc=(unsigned char *) p;
  857.     for (i=0; text[i]!=0; i++)
  858.     {   total_chars_trans++;
  859.         if (double_spaced==1)
  860.         {   if ((text[i]=='.')&&(text[i+1]==' ')&&(text[i+2]==' ')) text[i+2]=1;
  861.         }
  862.         if ((economy_mode==1)&&(abbrev_mode!=0)
  863.             &&((k=abbrevs_lookup[text[i]])!=-1))
  864.         {   if ((j=try_abbreviations_from(text, i, k))!=-1)
  865.             {   if (j<32) { write_z_char(2); write_z_char(j); }
  866.                 else { write_z_char(3); write_z_char(j-32); }
  867.             }
  868.         }
  869.         if (text[i]=='@')
  870.         {   value= -1;
  871.             switch(text[i+1])
  872.             {   case '0': value=0; break;
  873.                 case '1': value=1; break;
  874.                 case '2': value=2; break;
  875.                 case '3': value=3; break;
  876.                 case '4': value=4; break;
  877.                 case '5': value=5; break;
  878.                 case '6': value=6; break;
  879.                 case '7': value=7; break;
  880.                 case '8': value=8; break;
  881.                 case '9': value=9; break;
  882.             }
  883.             value2= -1;
  884.             switch(text[i+2])
  885.             {   case '0': value2=0; break;
  886.                 case '1': value2=1; break;
  887.                 case '2': value2=2; break;
  888.                 case '3': value2=3; break;
  889.                 case '4': value2=4; break;
  890.                 case '5': value2=5; break;
  891.                 case '6': value2=6; break;
  892.                 case '7': value2=7; break;
  893.                 case '8': value2=8; break;
  894.                 case '9': value2=9; break;
  895.             }
  896.             if ((value!=-1)&&(value2!=-1))
  897.             {   i++; i++;
  898.                 write_z_char(1); write_z_char(value*10+value2);
  899.             }
  900.         }
  901.         else
  902.         {   if (text[i]!=1)
  903.             {   if (text[i]==' ') write_z_char(0);
  904.                 else
  905.                 {   cc=chars_lookup[(int) (text[i])];
  906.                     if (cc==127)
  907.                     {   write_z_char(5); write_z_char(6);
  908.                         j=translate_to_ascii(text[i]);
  909.                         write_z_char(j/32); write_z_char(j%32);
  910.                     }
  911.                     else
  912.                     {   newa=cc/26; value=cc%26;
  913.                         if (newa==1) write_z_char(4);
  914.                         if (newa==2) write_z_char(5);
  915.                         write_z_char(value+6);
  916.                     }
  917.                 }
  918.             }
  919.         }
  920.     }
  921.     end_z_chars();
  922.     return((char *) text_pc);
  923. }
  924.  
  925. /* ---------------------------------------------------------------------------------- */
  926. /*   The (static) Z-code database (using a table adapted from that in the InfoToolkit */
  927. /*   disassembler "txd")                                                              */
  928. /* ---------------------------------------------------------------------------------- */
  929.  
  930. #define NONE    0
  931. #define STORE   1
  932. #define BRANCH  2
  933. #define CALL    3
  934. #define JUMP    4
  935. #define RETURN  5
  936. #define NCALL   6
  937. #define PCHAR   7
  938. #define VATTR   8
  939. #define ILLEGAL 9
  940. #define INDIR  10
  941.  
  942. #define VAR     1
  943. #define TEXT    2
  944. #define OBJECT  3
  945.  
  946. #define VARI   -1
  947. #define ZERO    0
  948. #define ONE     1
  949. #define TWO     2
  950.  
  951. opcode the_opcode(int i,char *s,int k,int l,int m)
  952. {   opcode op;  op.name=s;  op.code=i;  op.type1=k;  op.type2=l;  op.no=m;
  953.     return(op);
  954. }
  955.  
  956. opcode opcs(int i)
  957. {
  958.     switch(i)
  959.     {
  960.     case  0: return(the_opcode(0x01, "JE",                    BRANCH,   NONE, TWO));
  961.     case  1: return(the_opcode(0x02, "JLE",                   BRANCH,   NONE, TWO));
  962.     case  2: return(the_opcode(0x03, "JGE",                   BRANCH,   NONE, TWO));
  963.     case  3: return(the_opcode(0x04, "DEC_CHK",               BRANCH,    VAR, TWO));
  964.     case  4: return(the_opcode(0x05, "INC_CHK",               BRANCH,    VAR, TWO));
  965.     case  5: return(the_opcode(0x06, "COMPARE_POBJ",          BRANCH,   NONE, TWO));
  966.     case  6: return(the_opcode(0x07, "TEST",                  BRANCH,   NONE, TWO));
  967.     case  7: return(the_opcode(0x08, "OR",                     STORE,   NONE, TWO));
  968.     case  8: return(the_opcode(0x09, "AND",                    STORE,   NONE, TWO));
  969.     case  9: return(the_opcode(0x0A, "TEST_ATTR",             BRANCH,   NONE, TWO));
  970.     case 10: return(the_opcode(0x0B, "SET_ATTR",                NONE,   NONE, TWO));
  971.     case 11: return(the_opcode(0x0C, "CLEAR_ATTR",              NONE,   NONE, TWO));
  972.     case 12: return(the_opcode(0x0D, "STORE",                   NONE,    VAR, TWO));
  973.     case 13: return(the_opcode(0x0D, "LSTORE",                  NONE,    VAR, VARI));
  974.     case 14: return(the_opcode(0x0E, "INSERT_OBJ",              NONE,   NONE, TWO));
  975.     case 15: return(the_opcode(0x0F, "LOADW",                  STORE,   NONE, TWO));
  976.     case 16: return(the_opcode(0x10, "LOADB",                  STORE,   NONE, TWO));
  977.     case 17: return(the_opcode(0x11, "GET_PROP",               STORE,   NONE, TWO));
  978.     case 18: return(the_opcode(0x12, "GET_PROP_ADDR",          STORE,   NONE, TWO));
  979.     case 19: return(the_opcode(0x13, "GET_NEXT_PROP",          STORE,   NONE, TWO));
  980.     case 20: return(the_opcode(0x14, "ADD",                    STORE,   NONE, TWO));
  981.     case 21: return(the_opcode(0x15, "SUB",                    STORE,   NONE, TWO));
  982.     case 22: return(the_opcode(0x16, "MUL",                    STORE,   NONE, TWO));
  983.     case 23: return(the_opcode(0x17, "DIV",                    STORE,   NONE, TWO));
  984.     case 24: return(the_opcode(0x18, "MOD",                    STORE,   NONE, TWO));
  985.  
  986.     case 25: return(the_opcode(0x01, "VJE",                   BRANCH,   NONE, VARI));
  987.  
  988.     case 26: return(the_opcode(0x20, "CALL",                    CALL,   NONE, VARI));
  989.     case 27: return(the_opcode(0x20, "ICALL",                  STORE,   NONE, VARI));
  990.     case 28: return(the_opcode(0x21, "STOREW",                  NONE,   NONE, VARI));
  991.     case 29: return(the_opcode(0x22, "STOREB",                  NONE,   NONE, VARI));
  992.     case 30: return(the_opcode(0x23, "PUT_PROP",                NONE,   NONE, VARI));
  993.     case 31: return(the_opcode(0x24, "READ",                    NONE,   NONE, VARI));
  994.     case 32: return(the_opcode(0x25, "PRINT_CHAR",             PCHAR,   NONE, VARI));
  995.     case 33: return(the_opcode(0x26, "PRINT_NUM",               NONE,   NONE, VARI));
  996.     case 34: return(the_opcode(0x27, "RANDOM",                 STORE,   NONE, VARI));
  997.     case 35: return(the_opcode(0x28, "PUSH",                    NONE,   NONE, VARI));
  998.     case 36: return(the_opcode(0x29, "PULL",                    NONE,    VAR, VARI));
  999.     case 37: return(the_opcode(0x2A, "STATUS_SIZE",             NONE,   NONE, VARI));
  1000.     case 38: return(the_opcode(0x2B, "SET_WINDOW",              NONE,   NONE, VARI));
  1001.  
  1002.     case 39: return(the_opcode(0x33, "SET_PRINT",               NONE,   NONE, VARI));
  1003.     case 40: return(the_opcode(0x34, "#RECORD_MODE",            NONE,   NONE, VARI));
  1004.     case 41: return(the_opcode(0x35, "SOUND",                   NONE,   NONE, VARI));
  1005.  
  1006.     case 42: return(the_opcode(0x00, "JZ",                    BRANCH,   NONE, ONE));
  1007.     case 43: return(the_opcode(0x01, "GET_SIBLING",            STORE, OBJECT, ONE));
  1008.     case 44: return(the_opcode(0x02, "GET_CHILD",              STORE, OBJECT, ONE));
  1009.     case 45: return(the_opcode(0x03, "GET_PARENT",             STORE,   NONE, ONE));
  1010.     case 46: return(the_opcode(0x04, "GET_PROP_LEN",           STORE,   NONE, ONE));
  1011.     case 47: return(the_opcode(0x05, "INC",                     NONE,    VAR, ONE));
  1012.     case 48: return(the_opcode(0x06, "DEC",                     NONE,    VAR, ONE));
  1013.     case 49: return(the_opcode(0x07, "PRINT_ADDR",              NONE,   NONE, ONE));
  1014.  
  1015.     case 50: return(the_opcode(0x09, "REMOVE_OBJ",              NONE,   NONE, ONE));
  1016.     case 51: return(the_opcode(0x0A, "PRINT_OBJ",               NONE,   NONE, ONE));
  1017.     case 52: return(the_opcode(0x0B, "RET",                   RETURN,   NONE, ONE));
  1018.     case 53: return(the_opcode(0x0C, "JUMP",                    JUMP,   NONE, ONE));
  1019.     case 54: return(the_opcode(0x0D, "PRINT_PADDR",             NONE,   NONE, ONE));
  1020.     case 55: return(the_opcode(0x0E, "LOAD",                   STORE,    VAR, ONE));
  1021.     case 56: return(the_opcode(0x0F, "NOT",                    STORE,   NONE, ONE));
  1022.  
  1023.     case 57: return(the_opcode(0x00, "RET#TRUE",              RETURN,   NONE, ZERO));
  1024.     case 58: return(the_opcode(0x01, "RET#FALSE",             RETURN,   NONE, ZERO));
  1025.     case 59: return(the_opcode(0x02, "PRINT",                   NONE,   TEXT, ZERO));
  1026.     case 60: return(the_opcode(0x03, "PRINT_RET",             RETURN,   TEXT, ZERO));
  1027.     case 61: return(the_opcode(0x05, "SAVE",                  BRANCH,   NONE, ZERO));
  1028.     case 62: return(the_opcode(0x06, "RESTORE",               BRANCH,   NONE, ZERO));
  1029.     case 63: return(the_opcode(0x07, "RESTART",                 NONE,   NONE, ZERO));
  1030.     case 64: return(the_opcode(0x08, "RET(SP)+",              RETURN,   NONE, ZERO));
  1031.     case 65: return(the_opcode(0x09, "POP",                     NONE,   NONE, ZERO));
  1032.     case 66: return(the_opcode(0x0A, "QUIT",                    NONE,   NONE, ZERO));
  1033.     case 67: return(the_opcode(0x0B, "NEW_LINE",                NONE,   NONE, ZERO));
  1034.     case 68: return(the_opcode(0x0C, "SHOW_SCORE",              NONE,   NONE, ZERO));
  1035.     case 69: return(the_opcode(0x0D, "VERIFY",                BRANCH,   NONE, ZERO));
  1036.     }
  1037.     return(the_opcode(0xff,"???",NONE,NONE,ZERO));
  1038. }
  1039.  
  1040. /* -------------------------------------------------------------------------------- */
  1041. /*   File handling                                                                  */
  1042. /*                                                                                  */
  1043. /*   Arguably the temporary files should be made using "tmpfile" in ANSI C, but     */
  1044. /*   we do it by hand since tmpfile is a bit uncommon                               */
  1045. /* -------------------------------------------------------------------------------- */
  1046.  
  1047. int current_source_line()
  1048. {   return(InputFiles[input_file-1].source_line);
  1049. }
  1050.  
  1051. int override_error_line=0;
  1052. void print_error_line()
  1053. {   int i=override_error_line;
  1054.     if (input_file>1) printf("\"%s\", ",InputFiles[input_file-1].filename);
  1055.     if (i==0) i=current_source_line();
  1056.     else override_error_line=0;
  1057.     printf("line %d: ",i);
  1058. }
  1059.  
  1060. void fatalerror(char *s)
  1061. {   print_error_line();
  1062.     printf("Fatal error: %s\n",s);
  1063.     exit(1);
  1064. }
  1065.  
  1066. int malloced_bytes=0;
  1067. char *my_malloc(int size, char *whatfor)
  1068. {   char *c;
  1069.     if (memout_mode==1)
  1070.         printf("Allocating %d bytes for %s\n",size,whatfor);
  1071.     c=malloc(size); malloced_bytes+=size;
  1072.     if (c==0) fatalerror("Couldn't allocate memory");
  1073.     return(c);
  1074. }
  1075. void *my_calloc(int size, int howmany)
  1076. {   void *c;
  1077.     if (memout_mode==1)
  1078.         printf("Allocating %d bytes: array of %d entries of size %d\n",
  1079.             size*howmany,howmany,size);
  1080.     c=calloc(howmany,size); malloced_bytes+=size*howmany;
  1081.     if (c==0) fatalerror("Couldn't allocate memory for an array");
  1082.     return(c);
  1083. }
  1084.  
  1085. void load_sourcefile(char *story_name)
  1086. {   char name[128], theerror[128]; int i, flag=0;
  1087.  
  1088.     if (input_file==MAX_INCLUSION_DEPTH)
  1089.     {   fatalerror("Too many files have included each other: \
  1090. increase #define MAX_INCLUSION_DEPTH");
  1091.     }
  1092.     strcpy(InputFiles[input_file].filename,story_name);
  1093.  
  1094.     for (i=0; story_name[i]!=0; i++)
  1095.         if ((story_name[i]=='/') || (story_name[i]=='.')) flag=1;
  1096.     if (flag==0)
  1097.     {   if (input_file>0)
  1098.           sprintf(name,"%s%s%s",
  1099.             Include_Prefix,story_name,Include_Extension);
  1100.         else
  1101.           sprintf(name,"%s%s%s",
  1102.             Source_Prefix,story_name,Source_Extension);
  1103.     }
  1104.     else
  1105.         strcpy(name,story_name);
  1106.  
  1107.     InputFiles[input_file].handle = fopen(name,"r");
  1108.     if (InputFiles[input_file].handle==NULL)
  1109.     {   sprintf(theerror, "Couldn't open input file \"%s\"",name);
  1110.         fatalerror(theerror);
  1111.     }
  1112.     InputFiles[input_file++].source_line = 1;
  1113.     total_files_read++;
  1114.  
  1115.     if ((ltrace_mode!=0)||(trace_mode!=0))
  1116.     {   printf("\nOpening file \"%s\"\n",name);
  1117.     }
  1118. }
  1119.  
  1120. void close_sourcefile()
  1121. {   fclose(InputFiles[--input_file].handle);
  1122.     if ((ltrace_mode!=0)||(trace_mode!=0))
  1123.     {   printf("\nClosing file\n");
  1124.     }
  1125. }
  1126.  
  1127. int32 last_char_marker= -1; int last_char;
  1128. int file_char(int32 marker)
  1129. {   if (marker==last_char_marker) return(last_char);
  1130.     last_char_marker=marker;
  1131.     if (input_file==0) return(0);
  1132.     last_char=fgetc(InputFiles[input_file-1].handle);
  1133.     if (last_char==EOF)
  1134.     {   close_sourcefile();
  1135.         if (input_file==0) last_char=0; else last_char='\n';
  1136.     }
  1137.     return(last_char);
  1138. }
  1139.  
  1140. int file_end(int32 marker)
  1141. {   int i;
  1142.     i=file_char(marker);
  1143.     if (i==0) return(1);
  1144.     return(0);
  1145. }
  1146.  
  1147. unsigned int checksum_code=0, checksum_string=0, checksum_body=0;
  1148.  
  1149. void output_file(void)
  1150. {   FILE *fout; char *t; int32 length=0, blanks=0, size=0;
  1151.     fout=fopen(Code_Name,"wb");
  1152.     if (fout==NULL) fatalerror("Couldn't open output file");
  1153.  
  1154. #ifndef USE_TEMPORARY_FILES
  1155.     checksum_code=0;
  1156.     for (t=zcode; t<zcode_p; t++) { checksum_code+=(unsigned) *t; }
  1157.     checksum_string=0;
  1158.     for (t=strings; t<strings_p; t++) { checksum_string+=(unsigned) *t; }
  1159. #endif
  1160.     checksum_body=checksum_code+checksum_string;
  1161.     for (t=output_p+0x0040; t<output_p+Write_Code_At; t++)
  1162.     {   checksum_body+=(unsigned) *t; }
  1163.  
  1164.     length=((int32) Write_Strings_At)+ subtract_pointers(strings_p,strings);
  1165.     if ((length%2)==1) { length++; blanks=1; }
  1166.     length=length/2;
  1167.     output_p[26]=(length & 0xff00)/0x100;
  1168.     output_p[27]=(length & 0xff);
  1169.  
  1170.     while (((2*length)+blanks-1)%512 != 511) blanks++;
  1171.  
  1172.     output_p[28]=(checksum_body & 0xff00)/0x100;
  1173.     output_p[29]=(checksum_body & 0xff);
  1174.  
  1175.     for (t=output_p; t<output_p+Write_Code_At; t++) { fputc(*t,fout); size++; }
  1176.  
  1177. #ifdef USE_TEMPORARY_FILES
  1178.     {   FILE *fin;
  1179.         fclose(Temp2_fp);
  1180.         fin=fopen(Temp2_Name,"r");
  1181.         if (fin==NULL) fatalerror("Couldn't reopen temporary file 2");
  1182.         for (t=zcode; t<zcode_p; t++) { fputc(fgetc(fin),fout); size++; }
  1183.         fclose(fin);
  1184.     }
  1185. #else
  1186.     for (t=zcode; t<zcode_p; t++) { fputc(*t,fout); size++; }
  1187. #endif  
  1188.     while (size<Write_Strings_At) { fputc(0,fout); size++; }
  1189.  
  1190. #ifdef USE_TEMPORARY_FILES
  1191.     {   FILE *fin;
  1192.         fclose(Temp1_fp);
  1193.         fin=fopen(Temp1_Name,"r");
  1194.         if (fin==NULL) fatalerror("Couldn't reopen temporary file 1");
  1195.         for (t=strings; t<strings_p; t++) { fputc(fgetc(fin),fout); }
  1196.         fclose(fin);
  1197.         remove(Temp1_Name); remove(Temp2_Name);
  1198.     }
  1199. #else
  1200.     for (t=strings; t<strings_p; t++) { fputc(*t,fout); }
  1201. #endif  
  1202.     while (blanks>0) { fputc(0,fout); blanks--; }
  1203.  
  1204.     fclose(fout);
  1205.     if (statistics_mode==2) printf("%d bytes written to '%s'\n",length,Code_Name);
  1206. #ifdef ARCHIMEDES
  1207.     sprintf(buffer,"settype %s 065",Code_Name);
  1208.     system(buffer);
  1209. #endif
  1210. }
  1211.  
  1212. #ifdef USE_TEMPORARY_FILES
  1213. void open_temporary_files(void)
  1214. {
  1215. #ifdef UNIX
  1216.     sprintf(Temp1_Name, "%s.proc%d",Temp1_Hdr,(int)getpid());
  1217.     sprintf(Temp2_Name, "%s.proc%d",Temp2_Hdr,(int)getpid());
  1218. #endif
  1219.     Temp1_fp=fopen(Temp1_Name,"wb");
  1220.     if (Temp1_fp==NULL) fatalerror("Couldn't open temporary file 1");
  1221.     Temp2_fp=fopen(Temp2_Name,"wb");
  1222.     if (Temp2_fp==NULL) fatalerror("Couldn't open temporary file 2");
  1223. }
  1224. #endif
  1225.  
  1226. /* -------------------------------------------------------------------------------- */
  1227. /*   Preprocessor stack routines                                                    */
  1228. /*   This is a first-in first-out stack, used when (eg) a source line like          */
  1229. /*   "if 2*fish+5*loaves > multitude" is replaced by assembly lines; the assembly   */
  1230. /*   lines are stacked up and will be read in before the next source line.  The     */
  1231. /*   stack needs a reasonable size (10 at the very least) but almost all its lines  */
  1232. /*   will be used for short assembler instructions, so it needs little provision    */
  1233. /*   for full-blown lines (probably only one "long slot" will ever be used).        */ 
  1234. /* -------------------------------------------------------------------------------- */
  1235.  
  1236. int stacktop=0, stackbot=0;
  1237. char *stack[STACK_SIZE], *stack_longs[STACK_LONG_SLOTS];
  1238.  
  1239. void stack_create(void)
  1240. {   int i; char *stackp;
  1241.     stackp=my_malloc(STACK_SIZE*STACK_SHORT_LENGTH,"preprocessor stack");
  1242.     for (i=0; i<STACK_SIZE; i++) stack[i]=stackp+i*STACK_SHORT_LENGTH;
  1243.     stackp=my_malloc(STACK_LONG_SLOTS*BUFFER_LENGTH,"pp stack long slots");
  1244.     for (i=0; i<STACK_LONG_SLOTS; i++)
  1245.     {   stack_longs[i]=stackp+i*BUFFER_LENGTH;
  1246.         *(stack_longs[i])=0;
  1247.     }
  1248. }
  1249.  
  1250. int stack_move(int sp)
  1251. {   sp++; if (sp==STACK_SIZE) sp=0;
  1252.     return(sp);
  1253. }
  1254.  
  1255. void stack_line(char *p)
  1256. {   int i, f;
  1257.     if (strlen(p)<STACK_SHORT_LENGTH)
  1258.         strcpy(stack[stacktop],p);
  1259.     else
  1260.     {   *(stack[stacktop])=0; f=0;
  1261.         for (i=0; i<STACK_LONG_SLOTS; i++)
  1262.             if ((*(stack_longs[i])==0)&&(f==0))
  1263.             {   strcpy(stack_longs[i],p);
  1264.                 *(stack[stacktop]+1)=i;
  1265.                 f=1;
  1266.             }
  1267.         if (f==0) {
  1268.             fatalerror("The preprocessor stack has (amazingly) run out \
  1269. of long slots; increase #define STACK_LONG_SLOTS to extend it");
  1270.         }
  1271.     }
  1272.     stacktop=stack_move(stacktop);
  1273.     if (stacktop==stackbot)
  1274.         fatalerror("The preprocessor stack has run out \
  1275. (probably due to huge expression): increase #define STACK_SIZE to extend it");
  1276. }
  1277.  
  1278. void destack_line(char *p)
  1279. {   int i;
  1280.     i= *(stack[stackbot]);
  1281.     if (i!=0)
  1282.         strcpy(p,stack[stackbot]);
  1283.     else
  1284.     {   i= *(stack[stackbot]+1);
  1285.         strcpy(p,stack_longs[i]);
  1286.         *(stack_longs[i])=0;
  1287.     }
  1288.     stackbot=stack_move(stackbot);
  1289. }
  1290.  
  1291. /* -------------------------------------------------------------------------------- */
  1292. /*   Character-level parsing and error reporting routines                           */
  1293. /* -------------------------------------------------------------------------------- */
  1294.  
  1295. void begin_pass(void)
  1296. {   total_source_line=0; total_files_read=1; almade_flag=0;
  1297.     internal_line=0; endofpass_flag=0; marker_in_file=0;
  1298.     trace_mode=tracing_mode; no_routines=0; no_stubbed=0;
  1299.     no_abbrevs=0; in_routine_flag=1;
  1300.     zcode_p=zcode; properties_size=0;
  1301. #ifdef USE_TEMPORARY_FILES
  1302.     utf_zcode_p=zcode;
  1303.     if (pass_number==2) open_temporary_files();
  1304. #endif
  1305.     no_blocks_made=1; brace_sp=0; ltrace_mode=0; forloop_flag=0;
  1306.     next_block_type=0; strings_p=strings; no_dummy_labels=0; no_objects=0;
  1307.     no_verbs=0; fp_no_actions=no_actions; no_actions=0; no_adjectives=0;
  1308.     dict_p=dictionary+7;
  1309.     no_properties=2; no_attributes=0;
  1310.     ppstack_openb=0; ppstack_closeb=0;
  1311.  
  1312.     total_chars_trans=0; total_bytes_trans=0;
  1313.  
  1314.     if (pass_number==2) ltrace_mode=listing_mode;
  1315.  
  1316.     objects[0].parent=0; objects[0].child=0; objects[0].next=0;
  1317.     firsthash_flag=1; recenthash_flag=0;
  1318. }
  1319.  
  1320. void print_hash()
  1321. {   if (firsthash_flag==1) { printf("%d:",pass_number); firsthash_flag=0; }
  1322.     printf("#"); recenthash_flag=1; fflush(stdout);
  1323. }
  1324.  
  1325. int errors[MAX_ERRORS];
  1326. char forerrors_buff[BUFFER_LENGTH];
  1327.  
  1328. void message(int style, char *s)
  1329. {   if (recenthash_flag==1) printf("\n");
  1330.     recenthash_flag=0;
  1331.     print_error_line();
  1332.     printf("%s: %s\n",(style==1)?"Error":"Warning",s);
  1333.     if ((style==1)&&(concise_mode==0))
  1334.     {   sprintf(forerrors_buff+68,"  ...etc");
  1335.         printf("> %s\n",forerrors_buff);
  1336.     }
  1337. }
  1338.  
  1339. void error(char *s)
  1340. {   int i;
  1341.     if (no_errors==MAX_ERRORS) { fatalerror("Too many errors: giving up"); }
  1342.     for (i=0; i<no_errors; i++)
  1343.         if (errors[i]==internal_line) return;
  1344.     errors[no_errors++]=internal_line;
  1345.     message(1,s);
  1346. }
  1347.  
  1348. void warning_named(char *s1, char *s2)
  1349. {   char b[128];
  1350.     sprintf(b,"%s \"%s\"",s1,s2);
  1351.     no_warnings++;
  1352.     message(2,b);
  1353. }
  1354.  
  1355. void error_named(char *s1, char *s2)
  1356. {   char b[128];
  1357.     sprintf(b,"%s \"%s\"",s1,s2);
  1358.     error(b);
  1359. }
  1360.  
  1361. void no_such_label(char *lname)
  1362. {   error_named("No such label as",lname);
  1363. }
  1364.  
  1365. void reached_new_line()
  1366. {   total_source_line++;
  1367.     InputFiles[input_file-1].source_line++;
  1368.     if ((hash_mode==1)&&(total_source_line%100==0)) print_hash();
  1369. }
  1370.  
  1371. int not_line_end(char c)
  1372. {   if (c=='\n') reached_new_line();
  1373.     if ((c==0)||(c=='\n')) return(0);
  1374.     return(1);
  1375. }
  1376.  
  1377. int quoted_mode;
  1378. int non_terminator(char c)
  1379. {   if (c=='\n') reached_new_line();
  1380.     if (quoted_mode!=0)
  1381.     {   if ((c==0)||(c=='\\')) return(0);
  1382.         return(1);
  1383.     }
  1384.     if ((c==0)||(c==';')||(c=='!')||(c=='\\')||(c=='{')||(c=='}')) return(0);
  1385.     return(1);
  1386. }
  1387.  
  1388. /* -------------------------------------------------------------------------------- */
  1389. /*   Get the next line of input, and return 1 if it came from the preprocessor      */
  1390. /*   stack and 0 if it really came from the source files.                           */
  1391. /*   So:                                                                            */
  1392. /*     If something's waiting on the stack, send that.                              */
  1393. /*     If there are braces to be opened or closed, send those.                      */
  1394. /*     If at the end of the source, send an "end" directive.                        */
  1395. /*     Otherwise, keep going until a ; is reached which is not in 's or "s;         */
  1396. /*       throw away everything on any text line after a comment ! character;        */
  1397. /*       fold out characters between a \ and the first non-space on the next line.  */
  1398. /* -------------------------------------------------------------------------------- */
  1399.  
  1400. int get_next_line(void)
  1401. {   int i, j; char d;
  1402.     internal_line++;
  1403.     quoted_mode=0;
  1404.     do
  1405.     {   if (stacktop!=stackbot)  { destack_line(buffer); return(1); }
  1406.         if (ppstack_openb>0) { strcpy(buffer,"{"); ppstack_openb--; return(1); }
  1407.         if (ppstack_closeb>0) { strcpy(buffer,"}"); ppstack_closeb--; return(1); }
  1408.         if (file_end(marker_in_file)==1) { strcpy(buffer,"#end"); return(1); }
  1409.         i=0; j=0;
  1410.       GNLL:
  1411.         for (; non_terminator(d=file_char(marker_in_file+i)); i++, j++)
  1412.         {   buffer[j]=d; if (d=='\"') quoted_mode=1-quoted_mode;
  1413.         }
  1414.         switch(d)
  1415.         {   case '!': while (not_line_end(file_char(marker_in_file+i))) i++;
  1416.                       i++; goto GNLL;
  1417.             case '{': ppstack_openb++; break;
  1418.             case '}': ppstack_closeb++; break;
  1419.             case '\\':
  1420.                 while (not_line_end(file_char(marker_in_file+i))) i++; i++;
  1421.                 while (file_char(marker_in_file+i)==' ') i++; goto GNLL;
  1422.         }
  1423.  
  1424.         buffer[j]=0;
  1425.         marker_in_file+=i+1;
  1426.  
  1427.         for (i=0; buffer[i]!=0; i++)
  1428.           if (buffer[i]=='\n') buffer[i]=' ';
  1429.  
  1430.         for (i=0; buffer[i]!=0; i++)
  1431.           if (buffer[i]!=' ') return(0);
  1432.     } while (1==1);
  1433.     return(0);
  1434. }
  1435.  
  1436. /* -------------------------------------------------------------------------------- */
  1437. /*   The Tokeniser (18)... coming to cinemas near you                               */
  1438. /*     incorporating the martial arts classic                                       */
  1439. /*   Tokeniser II - This Time It's Optimal,                                         */
  1440. /*     with Dolph Lundgren as Dilip Sequeira and Gan as the two short planks        */
  1441. /* -------------------------------------------------------------------------------- */
  1442.  
  1443. int no_tokens;
  1444. char *tokens, *tokens_p, *token_adds[MAX_TOKENS];
  1445.  
  1446. #define NUMBER_SEPARATORS 19
  1447.  
  1448. #define QUOTE_CODE    1000
  1449. #define DQUOTE_CODE   1001
  1450. #define NEWLINE_CODE  1002
  1451. #define NULL_CODE     1003
  1452. #define SPACE_CODE    1004
  1453.  
  1454. const char separators[NUMBER_SEPARATORS][4] = { 
  1455.     "+", "->", "-->", "-", "*", "/", "%", "|", "&", "==", "=", "~=", ">=", ">", 
  1456.     "<=", "<", "(", ")", "," };
  1457.  
  1458. int char_grid[256];
  1459.  
  1460. void make_s_grid()
  1461. {   int i, j;
  1462.     for (i=0; i<256; i++) char_grid[i]=0;
  1463.     for (i=0; i<NUMBER_SEPARATORS; i++)
  1464.     { j=separators[i][0];
  1465.       if(char_grid[j]==0) char_grid[j]=i*16+1; else char_grid[j]++;
  1466.     }
  1467.     char_grid['\''] = QUOTE_CODE;
  1468.     char_grid['\"'] = DQUOTE_CODE;
  1469.     char_grid['\n'] = NEWLINE_CODE;
  1470.     char_grid[0]    = NULL_CODE;
  1471.     char_grid[' ']  = SPACE_CODE;
  1472. }
  1473.  
  1474. void tokenise_line(void)
  1475. {   char *p,*q; int i, j, k, bite, tok_l; const char *r;
  1476.     no_tokens=0; tokens_p=tokens; token_adds[0]=tokens_p;
  1477.     p=buffer;
  1478.     for (i=0, tok_l=0; i<MAX_TOKENS; i++)
  1479.     { if(tok_l) {for(j=0;j<tok_l;j++) *tokens_p++= *p++; tok_l=0;goto got_tok;}
  1480.       while(*p==' ') p++;
  1481.       for(bite=0;1;)
  1482.       {
  1483.         switch(char_grid[*p]) 
  1484.         {  case 0:            *tokens_p++= *p++; bite=1; break;
  1485.            case SPACE_CODE:   goto got_tok;
  1486.            case DQUOTE_CODE:  do *tokens_p++= *p++; while (*p && *p!='\n' && *p!='\"');
  1487.                               if (*p=='\"') *tokens_p++= *p++; goto got_tok;
  1488.            case NEWLINE_CODE: reached_new_line(); if (bite) goto got_tok; return;
  1489.            case QUOTE_CODE:   do *tokens_p++= *p++; while (*p && *p!='\n' && *p!='\'');
  1490.                               if (*p=='\'') *tokens_p++= *p++; goto got_tok;
  1491.            case NULL_CODE:    if (bite) goto got_tok; return;
  1492.            default:  for (j=char_grid[*p]>>4,k=j+(char_grid[*p]&15);j<k;j++) 
  1493.                      {   for (q=p,r=separators[j];*q== *r && *r;q++,r++);
  1494.                          if (!*r) 
  1495.                          {   if(bite) tok_l=q-p; else while(p<q) *tokens_p++= *p++;
  1496.                              goto got_tok;
  1497.                          }
  1498.                       }
  1499.                       *tokens_p++= *p++;bite=1;
  1500.         }
  1501.       }
  1502.     got_tok:
  1503.       *tokens_p++=0; token_adds[++no_tokens]=tokens_p;
  1504.     }
  1505.     error("Too many tokens on line"); no_tokens=MAX_TOKENS-1;
  1506. }
  1507.  
  1508. void word(char *b1, int w)
  1509. {   if (w>no_tokens) { b1[0]=0; return; }
  1510.     strcpy(b1, token_adds[w-1]);
  1511. }
  1512.  
  1513. void dequote_text(char *b1)
  1514. {   int i;
  1515.     if (*b1!='\"') error("Open quotes expected for text");
  1516.     for (i=0; b1[i]!=0; i++) b1[i]=b1[i+1];
  1517.     i=i-2;
  1518.     if (b1[i]!='\"') error("Close quotes expected for text");
  1519.     b1[i]=0;
  1520. }
  1521.  
  1522. void textword(char *b1, int w)
  1523. {   word(b1,w); dequote_text(b1);
  1524. }
  1525.  
  1526. /* -------------------------------------------------------------------------------- */
  1527. /*   Dictionary table builder                                                       */
  1528. /*   The dictionary is, so to speak, thumb-indexed: the beginning of each letter    */
  1529. /*   in the double-linked-list is marked.  Experiments with increasing the number   */
  1530. /*   of markers (to the first two letters, say) result in extra bureaucracy which   */
  1531. /*   cancels out any speed gain.                                                    */
  1532. /* -------------------------------------------------------------------------------- */
  1533.  
  1534. #define NUMBER_DICT_MARKERS 26
  1535.  
  1536. int total_dict_entries; int32 letter_keys[NUMBER_DICT_MARKERS];
  1537. int letter_starts[NUMBER_DICT_MARKERS];
  1538. int start_list;
  1539. int prepared_bytes[4]; int32 prepared_sort; int initial_letter;
  1540.  
  1541. void dictionary_startpass(void)
  1542. {   int i, j;
  1543.     total_dict_entries=dict_entries; dict_entries=0;
  1544.     if (pass_number==1)
  1545.     {   start_list=0; dict_places_list[0]= -2; dict_places_back[0]= -1;
  1546.         for (i=0; i<NUMBER_DICT_MARKERS; i++)
  1547.         {   letter_keys[i]=(int32) 0x7fffffffL;
  1548.             letter_starts[i]= -1;
  1549.         }
  1550.     }
  1551.     else
  1552.     {   for (j=start_list, i=0; i<total_dict_entries; i++)
  1553.         {   dict_places_inverse[j]=i; j=dict_places_list[j]; }
  1554.     }
  1555. }
  1556.  
  1557. int32 sort_number(char *y)
  1558. {   unsigned char *x;
  1559.     x= (unsigned char *) y;
  1560.     return(((int32) 0x1000000L)*((x[0])%128)
  1561.            + ((int32) 0x10000L)*(x[1])
  1562.            + ((int32) 0x100L)*(x[2])
  1563.            + ((int32) (x[3])) );
  1564. }
  1565.  
  1566.  
  1567. uint32 dictionary_prepare(char *dword)
  1568. {   int i, wd[6]; uint32 tot;
  1569.     for (i=0; (i<6)&&(dword[i]!=0); i++)
  1570.     {   wd[i]=6+((chars_lookup[(int) (dword[i])])%26);
  1571.     }
  1572.     for (; i<6; i++) wd[i]=5;
  1573.     initial_letter = wd[0]-6;
  1574.     /* Note... this doesn't depend on A to Z being contiguous in the
  1575.        machine's character set */
  1576.     tot = wd[5] + wd[4]*(1<<5) + wd[3]*(1<<10)
  1577.          + wd[2]*(1<<16) + wd[1]*(1<<21) + wd[0]*(1<<26);
  1578.     prepared_bytes[3]=tot%0x100;
  1579.     prepared_bytes[2]=0x80 + (tot/0x100)%0x100;
  1580.     prepared_bytes[1]=(tot/((uint32) 0x10000L))%0x100;
  1581.     prepared_bytes[0]=(tot/((uint32) 0x1000000L))%0x100;
  1582.     prepared_sort=tot;
  1583.     return(tot);
  1584. }
  1585.  
  1586. int dictionary_find(char *dword, int scope)
  1587. {   int32 i, j, j2, k, jlim;
  1588.     i=dictionary_prepare(dword);
  1589.     if (scope==1) jlim=dict_entries; else jlim=total_dict_entries;
  1590.  
  1591.     if (pass_number==1)
  1592.     {   for (j=0; j<jlim; j++)
  1593.             if (i==dict_sorts[j]) return(j+1);
  1594.         return(0);
  1595.     }
  1596.     if ((k=letter_starts[initial_letter])==-1) return(0);
  1597.     j=initial_letter+1;
  1598.     while ((j<NUMBER_DICT_MARKERS)&&((j2=letter_starts[j])==-1)) j++;
  1599.     if (j==NUMBER_DICT_MARKERS) { j2= -2; }
  1600.     while (k!=j2)
  1601.     {
  1602.         if ((i==dict_sorts[k])&&(k<jlim))
  1603.             return(dict_places_inverse[k]+1);
  1604.         k=dict_places_list[k];
  1605.     }
  1606.     return(0);
  1607. }        
  1608.  
  1609. void show_letter(int code)
  1610. {
  1611.     if (code<6) { printf("."); return; }
  1612.     printf("%c",(alphabet[0])[code-6]);
  1613. }
  1614.  
  1615. void show_dictionary(void)
  1616. {   int i, j, k; char *p;
  1617.     k=dict_entries; if (k==0) k=total_dict_entries;
  1618.     printf("Dictionary contains %d entries:\n",dict_entries);
  1619.     for (i=0; i<dict_entries; i++)
  1620.     {   p=dictionary+7+7*i;
  1621.         if (dict_entries==0)
  1622.           printf("Entry %03d (%03d > %03d) at %04x: ",
  1623.             i,dict_places_back[i],dict_places_list[i],
  1624.             dictionary_offset+7+7*i);
  1625.         else
  1626.           printf("Entry %03d at %04x: ",i,dictionary_offset+7+7*i);
  1627.         show_letter( (((int) p[0])&0x7c)/4 );
  1628.         show_letter( 8*(((int) p[0])&0x3) + (((int) p[1])&0xe0)/32 );
  1629.         show_letter( ((int) p[1])&0x1f );
  1630.         show_letter( (((int) p[2])&0x7c)/4 );
  1631.         show_letter( 8*(((int) p[2])&0x3) + (((int) p[3])&0xe0)/32 );
  1632.         show_letter( ((int) p[3])&0x1f );
  1633.         printf("  ");
  1634.         for (j=0; j<7; j++) printf("%02x ",p[j]);
  1635.         printf("Sort number %d",sort_number(p));
  1636.         printf("\n");
  1637.     }
  1638. }
  1639.  
  1640. int dictionary_add(char *dword, int x, int y, int z)
  1641. {   int off, i, k, l; char *p; int32 pcomp, qcomp;
  1642.  
  1643.     if (dict_entries==MAX_DICT_ENTRIES)
  1644.     {   fatalerror("Dictionary full: increase #define MAX_DICT_ENTRIES"); }
  1645.  
  1646.     i=dictionary_find(dword,1);
  1647.     if (i!=0)
  1648.     {   p=dictionary+i*7+4;
  1649.         p[0]=(p[0])|x; p[1]=(p[1])|y; p[2]=(p[2])|z;
  1650.         return(dictionary_offset+7*i);
  1651.     }
  1652.  
  1653.     if (pass_number==1) i=dict_entries;
  1654.     else { i=dict_places_inverse[dict_entries]; }
  1655.  
  1656.     off=7*i+7;
  1657.     p=dictionary+off;
  1658.  
  1659.     p[0]=prepared_bytes[0]; p[1]=prepared_bytes[1];
  1660.     p[2]=prepared_bytes[2]; p[3]=prepared_bytes[3];
  1661.     p[4]=x; p[5]=y; p[6]=z;
  1662.  
  1663.     if (pass_number==1)
  1664.     {   pcomp=prepared_sort;
  1665.         if (dict_entries==0)
  1666.         {   dict_places_list[0]= -2; dict_places_list[1]= -1; goto PlaceFound; }
  1667.         l=initial_letter; do { k=letter_starts[l--]; } while ((l>=0)&&(k==-1));
  1668.         if (k==-1) k=start_list;
  1669.         for (; k!=-2; k=dict_places_list[k])
  1670.         {   qcomp=dict_sorts[k];
  1671.             if (pcomp<qcomp)
  1672.             {   l=dict_places_back[k];
  1673.                 if (l==-1)
  1674.                 {   dict_places_list[dict_entries]=start_list;
  1675.                     dict_places_back[dict_entries]= -1;
  1676.                     dict_places_back[k]=dict_entries;
  1677.                     start_list=dict_entries; goto PlaceFound;
  1678.                 }
  1679.                 dict_places_list[l]=dict_entries;
  1680.                 dict_places_back[k]=dict_entries;
  1681.                 dict_places_list[dict_entries]=k;
  1682.                 dict_places_back[dict_entries]=l;
  1683.                 goto PlaceFound;
  1684.             }
  1685.             l=k;
  1686.         }
  1687.         dict_places_list[l]=dict_entries;
  1688.         dict_places_back[dict_entries]=l;
  1689.         dict_places_list[dict_entries]= -2;
  1690.         PlaceFound: dict_sorts[dict_entries]=pcomp;
  1691.         if (pcomp<letter_keys[initial_letter])
  1692.         {   letter_keys[initial_letter]=pcomp;
  1693.             letter_starts[initial_letter]=dict_entries;
  1694.         }        
  1695.     }
  1696.  
  1697.     dict_entries++; dict_p+=7;
  1698.     /* show_dictionary(); */
  1699.     return(dictionary_offset+off);
  1700. }
  1701.  
  1702. /* -------------------------------------------------------------------------------- */
  1703. /*   Symbols table and address fixing                                               */
  1704. /* -------------------------------------------------------------------------------- */
  1705.  
  1706. int banksize[7];
  1707.  
  1708. void init_symbol_banks(void)
  1709. {   int i, j;
  1710.     banksize[0]=0; banksize[1]=0;
  1711.     for (j=2; j<7; j++)
  1712.     {   for (i=0; i<MAX_BANK_SIZE; i++)
  1713.         {   banks[j][i]= -1;
  1714.         }
  1715.     }
  1716.     for (i=0; i<MAX_ROUTINES; i++) routine_keys[i]= -1;
  1717.     for (i=0;i<HASH_TAB_SIZE;i++) { bank1_hash[i]= -1; bank6_hash[i]= -1; }
  1718. }
  1719.  
  1720. int used_local_variable[16];
  1721. char *local_varname[16];
  1722. int routine_starts_line;
  1723. char reserveds_buffer[32];
  1724.  
  1725. void prim_new_symbol(char *p, int32 value, int type, int bank)
  1726. {   int i, j; int32 this, last, key, start=0; char *r;
  1727.     if (p[0]==0) { error("Symbol name expected"); return; }
  1728.     if (bank==6)
  1729.     {   strcpy(reserveds_buffer,p); p=reserveds_buffer; }
  1730.     make_lower_case(p);
  1731.     if (bank==0)
  1732.     {   start=routine_keys[no_routines]; if (start<0) goto NotDupl;
  1733.         for (i=start; i<banksize[bank]; i++)
  1734.         {   j=banks[bank][i];
  1735.             if (strcmp(symbs[j],p)==0)
  1736.             {   error_named("Duplicated symbol name",p);
  1737.                 return;
  1738.             }
  1739.         }
  1740.         NotDupl: j=banksize[bank]++;
  1741.     }
  1742.     else
  1743.     if (bank==1)
  1744.     {   for(r=p,key=0; *r; r++) key=(key*67+*r)%HASH_TAB_SIZE;
  1745.         for(this=bank1_hash[key], j=last= -1;
  1746.            this!=-1 && (j=strcmp(symbs[banks[1][this]],p))<0;
  1747.            last=this, this=bank1_next[this]);
  1748.         if(!j)
  1749.         { if (pass_number==1)
  1750.           { error_named("Duplicated symbol name",p); return;}
  1751.           return;
  1752.         }
  1753.         j=banksize[1]++;
  1754.     }
  1755.     else
  1756.     if (bank==6)
  1757.     {   for(r=p,key=0; *r; r++) key=(key*67+*r)%HASH_TAB_SIZE;
  1758.         for(this=bank6_hash[key], j=last= -1;
  1759.            this!=-1 && (j=strcmp(symbs[banks[6][this]],p))<0;
  1760.            last=this, this=bank6_next[this]);
  1761.         if(!j)
  1762.         { if (pass_number==1)
  1763.           { error_named("Duplicated symbol name",p); return;}
  1764.           return;
  1765.         }
  1766.         j=banksize[6]++;
  1767.     }
  1768.     else
  1769.     {   j=atoi(p+2);
  1770.         if (banks[bank][j]!=-1)
  1771.         {   error_named("Duplicated system symbol name",p);
  1772.             return;
  1773.         }
  1774.         banks[bank][j]=no_symbols;
  1775.     }
  1776.  
  1777.     if (j>=MAX_BANK_SIZE)
  1778.     {   fatalerror("Symbols bank exhausted: \
  1779. increase #define MAX_BANK_SIZE"); return; }
  1780.  
  1781.     banks[bank][j]=no_symbols;
  1782.  
  1783.     if (bank==0)
  1784.     {   if (routine_keys[no_routines]==-1) routine_keys[no_routines]=j;
  1785.         if (nowarnings_mode==0)
  1786.         {   local_varname[value]=symbols_p;
  1787.         }
  1788.     }
  1789.     if (bank==1) 
  1790.     { if (last==-1) {bank1_next[j]=bank1_hash[key];bank1_hash[key]=j;}
  1791.       else          {bank1_next[j]=this; bank1_next[last]=j;}
  1792.     }
  1793.     if (bank==6) 
  1794.     { if (last==-1) {bank6_next[j]=bank6_hash[key];bank6_hash[key]=j;}
  1795.       else          {bank6_next[j]=this; bank6_next[last]=j;}
  1796.     }
  1797.  
  1798.     if (no_symbols==MAX_SYMBOLS)
  1799.     {   fatalerror("Symbols table exhausted: increase #define MAX_SYMBOLS"); }
  1800.  
  1801.     if (symbols_p+strlen(p)+1 >= symbols_top)
  1802.     {   symbols_p=my_malloc(SYMBOLS_CHUNK_SIZE,"symbols table chunk");
  1803.         symbols_top=symbols_p+SYMBOLS_CHUNK_SIZE;
  1804.     }
  1805.     strcpy(symbols_p,p); symbs[no_symbols]=symbols_p;
  1806.     symbols_p+=strlen(symbols_p)+1;
  1807.  
  1808.     svals[no_symbols]=value; stypes[no_symbols]=type;
  1809.  
  1810.     no_symbols++;
  1811. }
  1812.  
  1813. int prim_find_symbol(char *q, int bank)
  1814. {   char c[50], *r; int i, j, start=0, finish=banksize[bank];
  1815.     int32 key, this;
  1816.  
  1817.     strcpy(c,q); make_lower_case(c);
  1818.  
  1819.     if (bank==0)
  1820.     {   start=routine_keys[no_routines]; if (start<0) return -1;
  1821.         i=routine_keys[no_routines+1]; if (i>=0) finish=i;
  1822.         if (finish>start+15) finish=start+15;
  1823.         for (i=start; i<finish; i++)
  1824.         {   j=banks[bank][i];
  1825.             if (strcmp(symbs[j],c)==0)
  1826.             {   used_local_variable[svals[j]]=1;
  1827.                 return(j);
  1828.             }
  1829.         }
  1830.         return(-1);
  1831.     }
  1832.     else
  1833.     if (bank==1)
  1834.     { for(r=c, key=0; *r; r++) key=(key*67+*r)%HASH_TAB_SIZE;
  1835.       for(this=bank1_hash[key],j= -1;
  1836.           this!=-1 && (j=strcmp(symbs[banks[1][this]],c))<0;
  1837.           this=bank1_next[this]);
  1838.       if(!j) return banks[1][this];
  1839.       return(-1);
  1840.     }
  1841.     else
  1842.     if (bank==6)
  1843.     { for(r=c, key=0; *r; r++) key=(key*67+*r)%HASH_TAB_SIZE;
  1844.       for(this=bank6_hash[key],j= -1;
  1845.           this!=-1 && (j=strcmp(symbs[banks[6][this]],c))<0;
  1846.           this=bank6_next[this]);
  1847.       if(!j) return banks[6][this];
  1848.       return(-1);
  1849.     }
  1850.  
  1851.     j=atoi(c+2);
  1852.     return(banks[bank][j]);
  1853. }
  1854.  
  1855. int find_symbol(char *q)
  1856. {   if (q[0]!='_') return(prim_find_symbol(q,1));
  1857.     if (q[1]=='s') return(prim_find_symbol(q,2));
  1858.     if (q[1]=='S') return(prim_find_symbol(q,2));
  1859.     if (q[1]=='w') return(prim_find_symbol(q,3));
  1860.     if (q[1]=='W') return(prim_find_symbol(q,3));
  1861.     if (q[1]=='f') return(prim_find_symbol(q,4));
  1862.     if (q[1]=='F') return(prim_find_symbol(q,4));
  1863.     if (q[1]=='x') return(prim_find_symbol(q,5));
  1864.     if (q[1]=='X') return(prim_find_symbol(q,5));
  1865.     error("Names are not permitted to start with an _");
  1866.     return(-1);
  1867. }
  1868.  
  1869. int local_find_symbol(char *q)
  1870. {   return(prim_find_symbol(q,0));
  1871. }
  1872.  
  1873. void new_symbol(char *p, int32 value, int type)
  1874. {   if (pass_number==2) return;
  1875.     if (strlen(p)>MAX_IDENTIFIER_LENGTH)
  1876.     {   error_named("Name is too long:",p);
  1877.         return;
  1878.     }
  1879.     if (type==3) { prim_new_symbol(p,value,type,0); return; }
  1880.     if (p[0]!='_') { prim_new_symbol(p,value,type,1); return; }
  1881.     if (p[1]=='s') { prim_new_symbol(p,value,type,2); return; }
  1882.     if (p[1]=='S') { prim_new_symbol(p,value,type,2); return; }
  1883.     if (p[1]=='w') { prim_new_symbol(p,value,type,3); return; }
  1884.     if (p[1]=='W') { prim_new_symbol(p,value,type,3); return; }
  1885.     if (p[1]=='f') { prim_new_symbol(p,value,type,4); return; }
  1886.     if (p[1]=='F') { prim_new_symbol(p,value,type,4); return; }
  1887.     if (p[1]=='x') { prim_new_symbol(p,value,type,5); return; }
  1888.     if (p[1]=='X') { prim_new_symbol(p,value,type,5); return; }
  1889.     error("Names are not permitted to start with an _");
  1890. }
  1891.  
  1892. /* -------------------------------------------------------------------------------- */
  1893. /*   Creating reserved words                                                        */
  1894. /* -------------------------------------------------------------------------------- */
  1895.  
  1896. #define ABBREVIATE_CODE  0
  1897. #define ATTRIBUTE_CODE   1
  1898. #define CONSTANT_CODE    2
  1899. #define DICTIONARY_CODE  3
  1900. #define END_CODE         4
  1901. #define INCLUDE_CODE     5
  1902. #define GLOBAL_CODE      6
  1903. #define OBJECT_CODE      7
  1904. #define PROPERTY_CODE    8
  1905. #define RELEASE_CODE     9
  1906. #define SWITCHES_CODE    10
  1907. #define STATUSLINE_CODE  11
  1908. #define VERB_CODE        12
  1909. #define TRACE_CODE       13
  1910. #define NOTRACE_CODE     14
  1911. #define ETRACE_CODE      15
  1912. #define NOETRACE_CODE    16
  1913. #define BTRACE_CODE      17
  1914. #define NOBTRACE_CODE    18
  1915. #define LTRACE_CODE      19
  1916. #define NOLTRACE_CODE    20
  1917. #define ATRACE_CODE      21
  1918. #define NOATRACE_CODE    22
  1919. #define LISTSYMBOLS_CODE 23
  1920. #define LISTOBJECTS_CODE 24
  1921. #define LISTVERBS_CODE   25
  1922. #define LISTDICT_CODE    26
  1923. #define OPENBLOCK_CODE   27
  1924. #define CLOSEBLOCK_CODE  28
  1925. #define SERIAL_CODE      29
  1926. #define DEFAULT_CODE     30
  1927. #define STUB_CODE        31
  1928.  
  1929. #define PRINT_ADDR_CODE  0
  1930. #define PRINT_CHAR_CODE  1
  1931. #define PRINT_PADDR_CODE 2
  1932. #define PRINT_OBJ_CODE   3 
  1933. #define PRINT_NUM_CODE   4
  1934. #define REMOVE_CODE      5
  1935. #define RETURN_CODE      6
  1936. #define DO_CODE          7
  1937. #define FOR_CODE         8
  1938. #define IF_CODE          9
  1939. #define OBJECTLOOP_CODE  10
  1940. #define UNTIL_CODE       11
  1941. #define WHILE_CODE       12
  1942. #define BREAK_CODE       13
  1943. #define ELSE_CODE        14
  1944. #define GIVE_CODE        15
  1945. #define INVERSION_CODE   16
  1946. #define MOVE_CODE        17
  1947. #define PUT_CODE         18
  1948. #define WRITE_CODE       19
  1949. #define STRING_CODE      20
  1950. #define FONT_CODE        21
  1951.  
  1952. #define ASSIGNMENT_CODE  100
  1953. #define FUNCTION_CODE    101
  1954.  
  1955. #define CreateD_(x,y) prim_new_symbol(x,y,14,6)
  1956. #define CreateC_(x,y) prim_new_symbol(x,y,15,6)
  1957. #define CreateB_(x,y,z) prim_new_symbol(x,z+y*100,16,6)
  1958. #define CreateA_(x,y) prim_new_symbol(x,y,17,6)
  1959.  
  1960. void stockup_symbols()
  1961. {   char *r1="RET#TRUE", *r2="RET#FALSE";
  1962.  
  1963.     new_symbol("nothing",0,9);
  1964.  
  1965.     new_symbol("sp",0,4);    new_symbol("ret#true",1,4);
  1966.     new_symbol("rtrue",1,4); new_symbol("ret#false",2,4);  new_symbol("rfalse",2,4);
  1967.  
  1968.     new_symbol("=",1,10);    new_symbol("==",1,10);        new_symbol(">",2,10);
  1969.     new_symbol("<",3,10);    new_symbol("has",4,10);       new_symbol("near",5,10);
  1970.     new_symbol("~=",6,10);   new_symbol("<=",7,10);        new_symbol(">=",8,10);
  1971.     new_symbol("hasnt",9,10);  new_symbol("far",10,10);
  1972.  
  1973.     new_symbol("name",1,7);
  1974.  
  1975.     CreateD_("ABBREVIATE", ABBREVIATE_CODE);
  1976.     CreateD_("ATTRIBUTE",  ATTRIBUTE_CODE);
  1977.     CreateD_("CONSTANT",   CONSTANT_CODE);
  1978.     CreateD_("DICTIONARY", DICTIONARY_CODE);
  1979.     CreateD_("END",        END_CODE);
  1980.     CreateD_("INCLUDE",    INCLUDE_CODE);
  1981.     CreateD_("GLOBAL",     GLOBAL_CODE);
  1982.     CreateD_("OBJECT",     OBJECT_CODE);
  1983.     CreateD_("PROPERTY",   PROPERTY_CODE);
  1984.     CreateD_("RELEASE",    RELEASE_CODE);
  1985.     CreateD_("SWITCHES",   SWITCHES_CODE);
  1986.     CreateD_("STATUSLINE", STATUSLINE_CODE); 
  1987.     CreateD_("VERB",       VERB_CODE);
  1988.     CreateD_("TRACE",      TRACE_CODE);
  1989.     CreateD_("NOTRACE",    NOTRACE_CODE);
  1990.     CreateD_("ETRACE",     ETRACE_CODE);
  1991.     CreateD_("NOETRACE",   NOETRACE_CODE);
  1992.     CreateD_("BTRACE",     BTRACE_CODE);
  1993.     CreateD_("NOBTRACE",   NOBTRACE_CODE);
  1994.     CreateD_("LTRACE",     LTRACE_CODE);
  1995.     CreateD_("NOLTRACE",   NOLTRACE_CODE);
  1996.     CreateD_("ATRACE",     ATRACE_CODE);
  1997.     CreateD_("NOATRACE",   NOATRACE_CODE);
  1998.     CreateD_("LISTSYMBOLS", LISTSYMBOLS_CODE);
  1999.     CreateD_("LISTOBJECTS", LISTOBJECTS_CODE);
  2000.     CreateD_("LISTVERBS",  LISTVERBS_CODE);
  2001.     CreateD_("LISTDICT",   LISTDICT_CODE);
  2002.     CreateD_("[",          OPENBLOCK_CODE);
  2003.     CreateD_("]",          CLOSEBLOCK_CODE);
  2004.     CreateD_("SERIAL",     SERIAL_CODE);
  2005.     CreateD_("DEFAULT",    DEFAULT_CODE);
  2006.     CreateD_("STUB",       STUB_CODE);
  2007.  
  2008.     CreateB_("PRINT_ADDR", PRINT_ADDR_CODE, 49);
  2009.     CreateB_("PRINT_CHAR", PRINT_CHAR_CODE, 32);
  2010.     CreateB_("PRINT_PADDR", PRINT_PADDR_CODE, 54);
  2011.     CreateB_("PRINT_OBJ",  PRINT_OBJ_CODE, 51);
  2012.     CreateB_("PRINT_NUM",  PRINT_NUM_CODE, 33);
  2013.  
  2014.     CreateC_("REMOVE",     REMOVE_CODE);
  2015.     CreateC_("RETURN",     RETURN_CODE);
  2016.     CreateC_("DO",         DO_CODE);
  2017.     CreateC_("FOR",        FOR_CODE);
  2018.     CreateC_("IF",         IF_CODE);
  2019.     CreateC_("OBJECTLOOP", OBJECTLOOP_CODE);
  2020.     CreateC_("UNTIL",      UNTIL_CODE);
  2021.     CreateC_("WHILE",      WHILE_CODE);
  2022.     CreateC_("BREAK",      BREAK_CODE);
  2023.     CreateC_("ELSE",       ELSE_CODE);
  2024.     CreateC_("GIVE",       GIVE_CODE);
  2025.     CreateC_("INVERSION",  INVERSION_CODE);
  2026.     CreateC_("MOVE",       MOVE_CODE);
  2027.     CreateC_("PUT",        PUT_CODE);
  2028.     CreateC_("WRITE",      WRITE_CODE);
  2029.     CreateC_("STRING",     STRING_CODE);
  2030.     CreateC_("FONT",       FONT_CODE);
  2031.  
  2032.     CreateA_("JE",0);
  2033.     CreateA_("JLE",1);
  2034.     CreateA_("JGE",2);
  2035.     CreateA_("JZ",42);
  2036.     CreateA_("JUMP",53);
  2037.     CreateA_("READ",31);
  2038.     CreateA_("RANDOM",34);
  2039.     CreateA_("RET",52);
  2040.     CreateA_(r1,57);
  2041.     CreateA_(r2,58);
  2042.     CreateA_("RTRUE",57);
  2043.     CreateA_("RFALSE",58);
  2044.     CreateA_("RESTORE",62);
  2045.     CreateA_("RESTART",63);
  2046.     CreateA_("RETSP",64);
  2047.     CreateA_("REMOVE_OBJ",50);
  2048.     CreateA_("PUT_PROP",30);
  2049.     CreateA_("PUSH",35);
  2050.     CreateA_("PULL",36);
  2051.     CreateA_("PRINT",59);
  2052.     CreateA_("PRINT_RET",60);
  2053.     CreateA_("POP",65);
  2054.     CreateA_("GET_SIBLING",43);
  2055.     CreateA_("GET_CHILD",44);
  2056.     CreateA_("GET_PARENT",45);
  2057.     CreateA_("GET_PROP_LEN",46);
  2058.     CreateA_("GET_PROP",17);
  2059.     CreateA_("GET_PROP_ADDR",18);
  2060.     CreateA_("GET_NEXT_PROP",19);
  2061.     CreateA_("SET_ATTR",10);
  2062.     CreateA_("STORE",12);
  2063.     CreateA_("SUB",21);
  2064.     CreateA_("STOREW",28);
  2065.     CreateA_("STOREB",29);
  2066.     CreateA_("STATUS_SIZE",37);
  2067.     CreateA_("SET_WINDOW",38);
  2068.     CreateA_("SET_PRINT",39);
  2069.     CreateA_("SOUND",41);
  2070.     CreateA_("SAVE",61);
  2071.     CreateA_("SHOW_SCORE",68);
  2072.     CreateA_("DEC_CHK",3);
  2073.     CreateA_("INC_CHK",4);
  2074.     CreateA_("COMPARE_POBJ",5);
  2075.     CreateA_("TEST",6);
  2076.     CreateA_("OR",7);
  2077.     CreateA_("AND",8);
  2078.     CreateA_("TEST_ATTR",9);
  2079.     CreateA_("CLEAR_ATTR",11);
  2080.     CreateA_("LSTORE",13);
  2081.     CreateA_("INSERT_OBJ",14);
  2082.     CreateA_("LOADW",15);
  2083.     CreateA_("LOADB",16);
  2084.     CreateA_("ADD",20);
  2085.     CreateA_("MUL",22);
  2086.     CreateA_("DIV",23);
  2087.     CreateA_("MOD",24);
  2088.     CreateA_("VJE",25);
  2089.     CreateA_("CALL",26);
  2090.     CreateA_("ICALL",27);
  2091.     CreateA_("RECORD_MODE",40);
  2092.     CreateA_("INC",47);
  2093.     CreateA_("DEC",48);
  2094.     CreateA_("LOAD",55);
  2095.     CreateA_("NOT",56);
  2096.     CreateA_("QUIT",66);
  2097.     CreateA_("NEW_LINE",67);
  2098.     CreateA_("VERIFY",69);
  2099. }
  2100.  
  2101. /* -------------------------------------------------------------------------------- */
  2102. /*   Printing diagnostics                                                           */
  2103. /* -------------------------------------------------------------------------------- */
  2104.  
  2105. char *typename(int type)
  2106. {   switch(type)
  2107.     {   case 1: return("Global label");
  2108.         case 2: return("Global variable");
  2109.         case 3: return("Local variable");
  2110.         case 4: return("Reserved word");
  2111.         case 5: return("Static string");
  2112.         case 6: return("Local label");
  2113.         case 7: return("Attribute");
  2114.         case 8: return("Integer constant");
  2115.         case 9: return("Object");
  2116.         case 10: return("Condition");
  2117.         case 11: return("Constant string address");
  2118.  
  2119.         case 14: return("Assembler directive");
  2120.         case 15: return("Compiler-modified opcode");
  2121.         case 16: return("Compiled command");
  2122.         case 17: return("Opcode");
  2123.  
  2124.         default: return("(Unknown type)");
  2125.     }
  2126. }
  2127.  
  2128. void list_symbols(void)
  2129. {   int i, j, k;
  2130.     for (j=0; j<2; j++)
  2131.     {   printf("In bank %d\n", j);
  2132.         for (i=0; i<banksize[j]; i++)
  2133.         {   k=banks[j][i];
  2134.             printf("%4d  %-16s  %04x  %s\n",
  2135.                 k,symbs[k],svals[k],typename(stypes[k]));
  2136.         }
  2137.     }
  2138.     for (j=2; j<6; j++)
  2139.     {   printf("In bank %d\n", j);
  2140.         for (i=0; i<MAX_BANK_SIZE; i++)
  2141.         {   k=banks[j][i];
  2142.             if (k!=-1)
  2143.             {   printf("%4d  %-16s  %04x  %s\n",
  2144.                     k,symbs[k],svals[k],typename(stypes[k]));
  2145.             }
  2146.         }
  2147.     }
  2148.     printf("Full list:\n");
  2149.     for (i=0; i<no_symbols; i++)
  2150.         printf("%-16s  %04x  %s\n",
  2151.             symbs[i],svals[i],typename(stypes[i]));
  2152. }
  2153.  
  2154. void list_object_tree(void)
  2155. {   int i;
  2156.     printf("obj   par nxt chl   Object tree:\n");
  2157.     for (i=0; i<no_objects; i++)
  2158.         printf("%3d   %3d %3d %3d\n",
  2159.             i+1,objects[i].parent,objects[i].next, objects[i].child);
  2160. }
  2161.  
  2162. void list_verb_table(void)
  2163. {   int i, j, k;
  2164.     for (i=0; i<no_verbs; i++)
  2165.     {   printf("Verb entry %2d  [%d]\n",i,vs[i].lines);
  2166.         for (j=0; j<vs[i].lines; j++)
  2167.         {   for (k=0; k<8; k++) printf("%03d ",vs[i].l[j].e[k]);
  2168.             printf("\n");
  2169.         }
  2170.     }
  2171. }
  2172.  
  2173. /* -------------------------------------------------------------------------------- */
  2174. /*   Keep track of actions                                                          */
  2175. /* -------------------------------------------------------------------------------- */
  2176.  
  2177. int make_action(int addr)
  2178. {   int i;
  2179.     if (no_actions>=MAX_ACTIONS)
  2180.       fatalerror("Limit on number of actions exceeded: \
  2181. increase #define MAX_ACTIONS");
  2182.     for (i=0; i<no_actions; i++) if (actions[i]==addr) return(i);
  2183.     actions[no_actions]=addr; preactions[no_actions]= -1;
  2184.     return(no_actions++);
  2185. }
  2186.  
  2187. int find_action(int addr)
  2188. {   int i;
  2189.     for (i=0; i<fp_no_actions; i++) if (actions[i]==addr) return(i);
  2190.     if (pass_number==2) error("That's not an action routine");
  2191.     return(0);
  2192. }
  2193.  
  2194. /* -------------------------------------------------------------------------------- */
  2195. /*   Decode arguments as constants and variables                                    */
  2196. /*   (Gratuitous Space 1999 reference by Mr Dilip Sequeira of Edinburgh University) */
  2197. /* -------------------------------------------------------------------------------- */
  2198.  
  2199. int no_locals; char *nlp;
  2200.  
  2201. char lnb[MAX_IDENTIFIER_LENGTH+8];
  2202. char *localname(char *p)
  2203. {   sprintf(lnb,"#%d%s",no_routines,p);
  2204.     return(lnb);
  2205. }
  2206.  
  2207. int cvflag;
  2208. int32 constant_value(char *b)
  2209. {   int32 i, j, k, base=10, f, rv, moon, alpha, victor;
  2210.     cvflag=0;
  2211.     if (b[0]=='#') b++;
  2212.     if (b[0]=='\"')
  2213.     {   dequote_text(b);
  2214.         j= subtract_pointers(strings_p,strings);
  2215.  
  2216. #ifdef USE_TEMPORARY_FILES
  2217.       { char *c;
  2218.         c=translate_text(strings,b);
  2219.         i= subtract_pointers(c,strings);;
  2220.         strings_p+=i;
  2221.         if (pass_number==2)
  2222.         {   for (c=strings; c<strings+i; c++)
  2223.             {   fputc(*c,Temp1_fp); checksum_string+=(unsigned) *c; }
  2224.         }
  2225.       }
  2226. #else
  2227.         strings_p=translate_text(strings_p,b);
  2228.         i= subtract_pointers(strings_p,strings);
  2229.         if (i>MAX_STATIC_STRINGS)
  2230.             fatalerror("Constant strings space exhausted: \
  2231. increase #define MAX_STATIC_STRINGS.");
  2232. #endif
  2233.  
  2234.         j=(strings_offset+j)/2;
  2235.         /* printf("Translation at %d %04x\n",j,strings_offset); */
  2236.         cvflag=1;
  2237.         return(j);
  2238.     }
  2239.     if(*b=='$') 
  2240.       if(*++b=='$') {b++;base=2;} else base=16;
  2241.     else for (i=0; b[i]; i++) if (!isdigit(b[i])) goto nonumber;
  2242.  
  2243.     for(;isspace(*b);b++);
  2244.     if(*b=='-') {victor=1; b++;} else victor=0;
  2245.     for(moon=0;*b;b++) 
  2246.     {  alpha=isalpha(*b)?(tolower(*b)-'a'+10):*b-'0';
  2247.        if(alpha>=base || alpha<0) break; else moon=moon*base+alpha;
  2248.     }
  2249.     return(victor?-moon:moon);  
  2250.     nonumber:
  2251.  
  2252.     f=0;
  2253.     if (strcmp(b,"adjectives_table")==0) return(adjectives_offset);
  2254.     if (strcmp(b,"preactions_table")==0) return(preactions_offset);
  2255.     if (strcmp(b,"actions_table")==0) return(actions_offset);
  2256.     if ((b[0]=='a')&&(b[1]=='$')) { b+=2; f=1; }
  2257.     if ((b[0]=='w')&&(b[1]=='$'))
  2258.     {   k=dictionary_find(b+2,2);
  2259.         rv=dictionary_offset+7*k;
  2260.         if ((k==0)&&(pass_number==2))
  2261.             error_named("Dictionary word not found for constant",b);
  2262.     }
  2263.     else
  2264.     {   if ((b[0]=='n')&&(b[1]=='$'))
  2265.         {   rv=dictionary_add(b+2,0x80,0,0);
  2266.         }
  2267.         else
  2268.         {   if ((b[0]=='r')&&(b[1]=='$'))
  2269.             {   i=find_symbol(b+2);
  2270.                 if (i<0)
  2271.                 {   if (pass_number==2)
  2272.                       error_named("Unrecognised constant value",b);
  2273.                     return(0);
  2274.                 }
  2275.                 rv=svals[i]; if (rv<256) rv=256;
  2276.             }
  2277.             else
  2278.             {   i=find_symbol(b);
  2279.                 if (i<0)
  2280.                 {   if (pass_number==2)
  2281.                       error_named("Unrecognised constant value",b);
  2282.                     return(0);
  2283.                 }
  2284.                 rv=svals[i];
  2285.             }
  2286.         }
  2287.     }
  2288.     switch(stypes[i])
  2289.     {   case 1: rv=(rv+code_offset)/2; break;
  2290.         case 2:
  2291.         case 3: error_named("Not a constant:",b); return(0);
  2292.         case 4:
  2293.         case 10: error_named("Reserved word as constant",b); return(0);
  2294.     }
  2295.     if (f==0) return(rv);
  2296.     j=find_action(svals[i]);
  2297.     return(j);
  2298. }
  2299.  
  2300. char known_unknowns[MAX_IDENTIFIER_LENGTH*16];
  2301. int  no_knowns;
  2302.  
  2303. int32 parse_argument(char *b)
  2304. {   int i, flag=0;
  2305.     if (b[0]=='#') return(1000+constant_value(b+1));
  2306.     if ((b[0]=='$')||(b[0]=='\"')) return(1000+constant_value(b));
  2307.     if ((b[0]==SINGLE_QUOTE)&&(b[2]==SINGLE_QUOTE))
  2308.     {   return(1000+translate_to_ascii(b[1]));
  2309.     }
  2310.     for (i=0; b[i]!=0; i++) if (isdigit(b[i])==0) flag=1;
  2311.     if (flag==0) return(1000+constant_value(b));
  2312.     if (in_routine_flag==1)
  2313.     {   i=local_find_symbol(b);
  2314.         if (i>=0) return(1+svals[i]);
  2315.     }
  2316.     i=find_symbol(b);
  2317.     if (i>=0)
  2318.     {   switch(stypes[i])
  2319.         {   case 1: return(1000+svals[i]);
  2320.             case 2: return(16+svals[i]);
  2321.             case 4: if (svals[i]==0) return(0);
  2322.             case 7:
  2323.             case 8:
  2324.             case 9: return(1000+constant_value(b));
  2325.             default: error_named("Type mismatch in argument",b);
  2326.               return(0);
  2327.         }
  2328.     }
  2329.     if (pass_number==2) { return(0); }
  2330.     for (i=0; i<no_knowns; i++)
  2331.         if (strcmp(known_unknowns+i*MAX_IDENTIFIER_LENGTH,b)==0)
  2332.             return(0);
  2333.     if (no_knowns<16)
  2334.         strcpy(known_unknowns+(no_knowns++)*MAX_IDENTIFIER_LENGTH,b);
  2335.     error_named("Unknown variable",b); return(0);
  2336. }
  2337.  
  2338. /* -------------------------------------------------------------------------------- */
  2339. /*   Assembler of individual lines                                                  */
  2340. /* -------------------------------------------------------------------------------- */
  2341.  
  2342. void byteout(int i)
  2343. {   *zcode_p=(unsigned char) i; zcode_p++;
  2344. #ifdef USE_TEMPORARY_FILES
  2345.     utf_zcode_p++;
  2346. #endif
  2347.     if (subtract_pointers(zcode_p,zcode) >= MAX_ZCODE_SIZE)
  2348.     {   fatalerror("Too much code: increase MAX_ZCODE_SIZE");
  2349.     }
  2350. }
  2351.  
  2352. operand_t parse_operand(opcode o, char *b, int wn)
  2353. {   int32 j, opt; operand_t rval;
  2354.     word(b,wn); j=parse_argument(b);
  2355.  
  2356.     if (j>=1256) { opt=0; j=j-1000; }
  2357.     else if (j>=1000) { opt=1; j=j-1000; }
  2358.     else opt=2;
  2359.  
  2360.     if ((o.type2==VAR)&&(opt==2)&&(wn==2)) opt=1;
  2361.  
  2362.     rval.value=j; rval.type=opt;
  2363.     return(rval);
  2364. }
  2365.  
  2366. void write_operand(operand_t op)
  2367. {   int32 j;
  2368.     j=op.value;
  2369.     if (j<256) byteout(j);
  2370.     else { byteout(j/256); byteout(j%256); }
  2371. }
  2372.  
  2373. int assemble_opcode(char *b, int32 offset, opcode opco)
  2374. {   char *opc, *opcname, *ac;
  2375.     int32 j, topbits, fullcode, addr, cargs, ccode, oldccode,
  2376.           multi, mask, flag, longf, branchword;
  2377.     operand_t oper1, oper2;
  2378.  
  2379.     return_flag=0;
  2380.     if (opco.type1==RETURN) return_flag=1;
  2381.     opcname=opco.name;
  2382.     switch(opco.no)
  2383.     {   case VARI: topbits=0xc0; break;
  2384.         case ZERO: topbits=0xb0; break;
  2385.         case ONE:  topbits=0x80; break;
  2386.         case TWO:  topbits=0x00; break;
  2387.     }
  2388.     fullcode=topbits+opco.code; opc=zcode_p;
  2389.     if (opco.type1==INDIR)
  2390.     {   byteout(0xE0); byteout(0xBF); byteout(0);  byteout(0);
  2391.         goto Line_Done;
  2392.     }
  2393.     byteout(fullcode);
  2394.  
  2395.     if (opco.type1==JUMP)
  2396.     {   word(b,2);
  2397.         if (pass_number==1) addr=0;
  2398.         else
  2399.         {   j=find_symbol(b);
  2400.             if (j<0) { no_such_label(b); return(1); }
  2401.             if (stypes[j]!=6) { error_named("Not a label:",b); return(1); }
  2402.             addr=svals[j]-offset-1;
  2403.             if (addr<0) addr+=(int32) 0x10000L;
  2404.         }
  2405.         byteout(addr/256); byteout(addr%256);
  2406.         goto Line_Done;
  2407.     }
  2408.  
  2409.     if (opco.type2==TEXT)
  2410.     {   char *tmp;
  2411.         textword(b,2); tmp=zcode_p; zcode_p=translate_text(zcode_p,b);
  2412.         j=subtract_pointers(zcode_p,tmp);
  2413. #ifdef USE_TEMPORARY_FILES
  2414.         utf_zcode_p+=j;  
  2415. #endif
  2416.     }
  2417.  
  2418.     switch(opco.no)
  2419.     {   case VARI:
  2420.             ac=zcode_p; byteout(0);
  2421.             cargs= -1; ccode=0xff;
  2422.             while (word(b,(++cargs)+2),(b[0]!=0))
  2423.             {   if (b[0]=='?') { branchword=cargs+2; break; }
  2424.                 switch(cargs)
  2425.                 {   case 0: multi=0x40; mask=0xc0; break;
  2426.                     case 1: multi=0x10; mask=0x30; break;
  2427.                     case 2: multi=0x04; mask=0x0c; break;
  2428.                     case 3: multi=0x01; mask=0x03; break;
  2429.                     case 4: multi=0;
  2430.                             if ((opco.type1!=CALL)&&(opco.type1!=STORE))
  2431.                                 error("Too many arguments");
  2432.                             break;
  2433.                     default: error("Too many arguments"); break;
  2434.                 }
  2435.                 if ((opco.type1==CALL)&&(cargs==0))
  2436.                 {   if (pass_number==2)
  2437.                     {   j=find_symbol(b);
  2438.                         if (j==-1) { no_such_label(b); }
  2439.                         if (stypes[j]!=1) { error_named("Not a label:",b); }
  2440.                         oper1.value=(code_offset+svals[j])/2; oper1.type=0;
  2441.                     }
  2442.                     else { oper1.value=0x1000; oper1.type=0; }
  2443.                 }
  2444.                 else
  2445.                     oper1=parse_operand(opco,b,cargs+2);
  2446.  
  2447.                 write_operand(oper1);
  2448.                 oldccode=ccode; ccode = (ccode & (~mask)) + oper1.type*multi;
  2449.             }
  2450.             if ((opco.type1==CALL)||(opco.type1==STORE))
  2451.             {   if (oper1.type!=2) { error("Can't store to that"); }
  2452.                 *ac=oldccode;
  2453.             }
  2454.             else *ac=ccode;
  2455.             break;
  2456.         case ONE:
  2457.             oper1=parse_operand(opco,b,2);
  2458.             *opc=(*opc) + oper1.type*0x10;
  2459.             write_operand(oper1);
  2460.             break;
  2461.         case TWO:
  2462.             oper1=parse_operand(opco,b,2);
  2463.             oper2=parse_operand(opco,b,3);
  2464.  
  2465.             if ((oper1.type==0)||(oper2.type==0))
  2466.             {   *opc=(*opc) + 0xc0; byteout(oper1.type*0x40 + oper2.type*0x10 + 0x0f);
  2467.             }
  2468.             else
  2469.             {   if (oper1.type==2) *opc=(*opc) + 0x40;
  2470.                 if (oper2.type==2) *opc=(*opc) + 0x20;
  2471.             }
  2472.             write_operand(oper1);
  2473.             write_operand(oper2);
  2474.             break;                    
  2475.         case ZERO:
  2476.             break;
  2477.     }
  2478.  
  2479.     if ((opco.no==ONE) || (opco.no==TWO))
  2480.     {   if (opco.type1==STORE)
  2481.         {   if (opco.no==ONE) oper1=parse_operand(opco,b,3);
  2482.             if (opco.no==TWO) oper1=parse_operand(opco,b,4);
  2483.             if (oper1.type!=2) { error("Can't store to that"); }
  2484.             byteout(oper1.value);
  2485.         }
  2486.     }
  2487.  
  2488.     if ((opco.type1==BRANCH)||(opco.type2==OBJECT))
  2489.     {   int o=0, pca;
  2490.         pca= subtract_pointers(zcode_p,opc) -1;
  2491.         switch(opco.no)
  2492.         {   case ZERO: word(b,2); break;
  2493.             case ONE:  if (opco.type2!=OBJECT) { word(b,3); break; }
  2494.             case TWO:  word(b,4); break;
  2495.             case VARI: word(b,branchword); break;
  2496.         }
  2497.         if (b[0]=='?') { longf=1; o++; }
  2498.         else
  2499.         {   int o2=0;
  2500.             if (b[0]=='~') o2=1;
  2501.             if (pass_number==1)
  2502.             {   j=find_symbol(b+o2);
  2503.                 if (j<0) longf=0;
  2504.                 else longf=1;
  2505.             }
  2506.             else
  2507.             {   j=find_symbol(b+o2);
  2508.                 if (j<0) longf=0;
  2509.                 else
  2510.                 {   if (offset-svals[j]>0) longf=1;
  2511.                     else longf=0;
  2512.                     if ((svals[j]-offset-pca)>30)
  2513.                     { error("Branch too far forward: use '?'"); return(1); }
  2514.                 }
  2515.             }
  2516.         }
  2517.         /* printf("Branch at %04x has longf=%d\n",offset,longf); */
  2518.         if (pass_number==1) { byteout(0); if (longf==1) byteout(0); }
  2519.         else
  2520.         {   if (b[o]=='~') { flag=0; o++; } else flag=1;
  2521.             j=find_symbol(b+o);
  2522.             if (j<0) { no_such_label(b+o); return(1); }
  2523.             switch(stypes[j])
  2524.             {   case 4:
  2525.                   switch(svals[j])
  2526.                   {   case 1: addr=1; longf=0; break;
  2527.                       case 2: addr=0x20; longf=0; break;
  2528.                       default: error("Unknown return condition"); return(1);
  2529.                   }
  2530.                   break;
  2531.                 case 1: error("Can't branch to a routine label"); return(1);
  2532.                 case 6:
  2533.                   if (longf==1) pca++;
  2534.                   addr=svals[j]-offset-pca;
  2535.                   if (addr<0) addr+=(int32) 0x10000L; break;
  2536.                 default: error_named("Not a label:",b+o); return(1);
  2537.             }
  2538.             addr=addr&0x3fff;
  2539.             if (longf==1)
  2540.             {   byteout(flag*0x80 + addr/256); byteout(addr%256); }
  2541.             else
  2542.                 byteout(flag*0x80+ 0x40 + (addr&0x3f));
  2543.         }
  2544.     }
  2545.  
  2546.     Line_Done:
  2547.     if (trace_mode==1)
  2548.     {   printf("%04d %04x  %-14s  ", current_source_line(),offset,opcname);
  2549.         for (j=0;opc<zcode_p; j++, opc++)
  2550.         {   printf("%02x ", *opc);
  2551.             if (j%16==15) printf("\n                           ");
  2552.         }
  2553.         printf("\n");
  2554.     }
  2555.  
  2556. #ifdef USE_TEMPORARY_FILES
  2557.       { char *c; int i;
  2558.         i= subtract_pointers(zcode_p,zcode);
  2559.         if (pass_number==2)
  2560.         {   for (c=zcode; c<zcode+i; c++)
  2561.             {   fputc(*c,Temp2_fp); checksum_code+=(unsigned) *c; }
  2562.         }
  2563.         zcode_p=zcode;
  2564.       }
  2565. #endif
  2566.  
  2567.     return(1);
  2568. }
  2569.  
  2570. /* -------------------------------------------------------------------------------- */
  2571. /*   Parsing the grammar table, and making new adjectives and verbs                 */
  2572. /*   (see the documentation for what the verb table it makes looks like)            */
  2573. /* -------------------------------------------------------------------------------- */
  2574.  
  2575. #define On_(x)  if (strcmp(b,x)==0)
  2576. #define IfPass2 if (pass_number==2)
  2577.  
  2578. int make_adjective(char *c)
  2579. {   int i; char dump[32]; int32 acomp;
  2580.     abbrev_mode=0; translate_text(dump,c); abbrev_mode=1;
  2581.     acomp=sort_number(c);
  2582.     for (i=0; i<no_adjectives; i++)
  2583.     {   if (acomp==adjcomps[i]) return(0xff-i);
  2584.     }
  2585.     adjectives[no_adjectives]=dictionary_add(c,8,0,0xff-no_adjectives);
  2586.     adjcomps[no_adjectives]=acomp;
  2587.     return(0xff-no_adjectives++);
  2588. }
  2589.  
  2590. void make_verb(char *b)
  2591. {   int i, j, k, flag=0;
  2592.     int lines=0, vargs, vtokens, vinsert;
  2593.     i=2;
  2594.     if (no_verbs==MAX_VERBS)
  2595.     { error("Too many verbs: increase #define MAX_VERBS"); return; }
  2596.     word(b,i);
  2597.     On_("meta") { i++; flag=2; }
  2598.     do
  2599.     {   word(b,i);
  2600.         if (b[0]!='\"') break;
  2601.         textword(b,i++);
  2602.         dictionary_add(b,0x41+flag,0xff-no_verbs,0);
  2603.     } while (1==1);
  2604.     do
  2605.     {   word(b,i++); flag=2;
  2606.         if (b[0]==0) break;
  2607.         if (strcmp(b,"*")!=0)
  2608.         {   error_named("* divider expected, but found",b); return; }
  2609.         vtokens=1; vargs=0; for (j=0; j<8; j++) vs[no_verbs].l[lines].e[j]=0;
  2610.         do
  2611.         {   word(b,i++);
  2612.             if (b[0]==0) { error("-> clause missing"); return; }
  2613.             if (strcmp(b,"->")==0) break;
  2614.             if (b[0]=='\"')
  2615.             {   textword(b,i-1); vinsert=make_adjective(b);
  2616.             }
  2617.  
  2618.             else On_("noun")        { vargs++; vinsert=0; }
  2619.             else On_("held")        { vargs++; vinsert=1; }
  2620.             else On_("multi")       { vargs++; vinsert=2; }
  2621.             else On_("multiheld")   { vargs++; vinsert=3; }
  2622.             else On_("multiexcept") { vargs++; vinsert=4; }
  2623.             else On_("multiinside") { vargs++; vinsert=5; }
  2624.             else On_("creature")    { vargs++; vinsert=6; }
  2625.             else On_("special")     { vargs++; vinsert=7; }
  2626.  
  2627.             else { error_named("Unknown particle of grammar",b); return; }
  2628.             vs[no_verbs].l[lines].e[vtokens]=vinsert;
  2629.             vtokens++;
  2630.         } while (1==1);
  2631.  
  2632.         word(b,i++);
  2633.         j=find_symbol(b);
  2634.         if ((j==-1)&&(pass_number==2)) { no_such_label(b); return; }
  2635.         if (j==-1) k=0;
  2636.         else
  2637.         {   if (stypes[j]!=1) { error_named("Not a label",b); return; }
  2638.             k=svals[j];
  2639.         }
  2640.         vs[no_verbs].l[lines].e[0]=vargs;
  2641.         vs[no_verbs].l[lines].e[7]=make_action(k);
  2642.         lines++;
  2643.     } while (1==1);
  2644.     if (lines==0) error("No lines of grammar given for verb");
  2645.     vs[no_verbs].lines=lines;
  2646.     no_verbs++;
  2647. }
  2648.  
  2649. /* -------------------------------------------------------------------------------- */
  2650. /*   Object manufacture.  Note that property lists are not kept for each object,    */
  2651. /*   only written in game-file format and then forgotten; but the object tree       */
  2652. /*   structure so far, is kept                                                      */
  2653. /* -------------------------------------------------------------------------------- */
  2654.  
  2655. int properties(int w)
  2656. {   int i, j, x, y; char b[BUFFER_LENGTH];
  2657.     do
  2658.     {   word(b,w++);
  2659.         if (b[0]==0) return(w-1);
  2660.         if (strcmp(b,"has")==0) return(w-1);
  2661.         i=find_symbol(b);
  2662.         if ((i==-1)||(stypes[i]!=7))
  2663.         { error_named("Bad property name",b); return(w); }
  2664.         i=svals[i];
  2665.         x=full_object.l++;
  2666.         full_object.pp[x].num=i;
  2667.         y=0;
  2668.         do
  2669.         {   word(b,w++);
  2670.             if (strcmp(b,",")==0) break;
  2671.             if (strcmp(b,"has")==0) { w--; break; }
  2672.             if (b[0]==0) break;
  2673.             if (i==1)
  2674.             {   textword(b,w-1); j=dictionary_add(b,0x80,0,0); }
  2675.             else
  2676.             {   j=constant_value(b);
  2677.                 if (j==0)
  2678.                 {   if (prop_defaults[i]>=256) j=0x1000;
  2679.                 }
  2680.             }
  2681.             if ((j>=256)||(prop_longflag[i]==1))
  2682.                 full_object.pp[x].p[y++]=j/256;
  2683.             full_object.pp[x].p[y++]=j%256;
  2684.         } while (1==1);
  2685.         full_object.pp[x].l=y;
  2686.  
  2687.     } while (1==1);
  2688.     return(0);
  2689. }
  2690.  
  2691. int attributes(int w)
  2692. {   int i; char b[BUFFER_LENGTH]; uint32 z;
  2693.     do
  2694.     {   word(b,w++);
  2695.         if (b[0]==0) return(w-1);
  2696.         if (strcmp(b,"with")==0) return(w-1);
  2697.         i=find_symbol(b);
  2698.         if ((i==-1)||(stypes[i]!=7))
  2699.         { error_named("Bad attribute name",b); return(w); }
  2700.         i=svals[i];
  2701.         z= ((int32) 0x1000000L)*objects[no_objects].atts[0]
  2702.            + ((int32) 0x10000L)*objects[no_objects].atts[1]
  2703.            +   ((int32) 0x100L)*objects[no_objects].atts[2]
  2704.            +         objects[no_objects].atts[3];
  2705.         z=z | (1<<(31-i));
  2706.         objects[no_objects].atts[0]=z/((int32) 0x1000000L);
  2707.         objects[no_objects].atts[1]=z/((int32) 0x10000L);
  2708.         objects[no_objects].atts[2]=z/((int32) 0x100L);
  2709.         objects[no_objects].atts[3]=z;
  2710.     } while (1==1);
  2711.     return(0);
  2712. }
  2713.  
  2714. int write_properties(char *p, char *shortname)
  2715. {   int props=0, oldprops=0, l, j, k; char *tmp;
  2716.         p[props]=3;
  2717.         oldprops=props;
  2718.         tmp=translate_text(p+props+1,shortname);
  2719.         props=subtract_pointers(tmp,p);
  2720.         p[oldprops]=(props-oldprops-1)/2;
  2721.  
  2722.         for (l=31; l>0; l--)
  2723.         {   for (j=0; j<full_object.l; j++)
  2724.             {   if (full_object.pp[j].num == l)
  2725.                 {   p[props++]=full_object.pp[j].num + (full_object.pp[j].l - 1)*32;
  2726.                     for (k=0; k<full_object.pp[j].l; k++)
  2727.                     {   p[props++]=full_object.pp[j].p[k];
  2728.                     }
  2729.                 }
  2730.             }
  2731.         }
  2732.  
  2733.         p[props]=0; props++;
  2734.         properties_size+=props;
  2735.         if (properties_size >= MAX_PROP_TABLE_SIZE)
  2736.           fatalerror("Properties table exhausted: \
  2737. increase #define MAX_PROP_TABLE_SIZE");
  2738.     return(props);
  2739. }
  2740.  
  2741. void make_object(char *b)
  2742. {   int i, j, k, non=0;
  2743.     char object_shortname[100];
  2744.     
  2745.     word(b,2); new_symbol(b,no_objects+1,9);
  2746.     do
  2747.     {   word(b,3+non);
  2748.         if (b[0]!='\"') { new_symbol(b,no_objects+1,9); non++; }
  2749.     } while (b[0]!='\"');
  2750.  
  2751.     textword(b,3+non);
  2752.     strcpy(object_shortname,b);
  2753.     word(b,4+non);
  2754.     i=find_symbol(b);
  2755.     if (i<0) { error_named("No such object as",b); return; }
  2756.     if (stypes[i]!=9) { error_named("Not an object:",b); return; }
  2757.  
  2758.     objects[no_objects].atts[0]=0;
  2759.     objects[no_objects].atts[1]=0;
  2760.     objects[no_objects].atts[2]=0;
  2761.     objects[no_objects].atts[3]=0;
  2762.     objects[no_objects].parent=svals[i];
  2763.     objects[no_objects].next=0;
  2764.     objects[no_objects].child=0;
  2765.     full_object.l=0;
  2766.  
  2767.     if (svals[i]>0)
  2768.     {   j=svals[i]-1; k=objects[j].child;
  2769.         if (k==0)
  2770.         {   objects[j].child=no_objects+1; }
  2771.         else
  2772.         {   while(objects[k-1].next!=0) { k=objects[k-1].next; }
  2773.             objects[k-1].next=no_objects+1;
  2774.         }
  2775.     }
  2776.     j=5+non;
  2777.     do
  2778.     {   word(b,j++);
  2779.         if (b[0]==0) break;
  2780.         if (strcmp(b,"with")==0) j=properties(j);
  2781.         else if (strcmp(b,"has")==0) j=attributes(j);
  2782.         else error("Expected \"with\" or \"has\" in object definition");
  2783.     } while (1==1);
  2784.     j=objects[no_objects].propsize;
  2785.     objects[no_objects].propsize=
  2786.       write_properties(properties_table+properties_size,object_shortname);
  2787.     if (pass_number==2)
  2788.     {   if (j != objects[no_objects].propsize)
  2789.         {   error("Object has altered in memory usage between passes");
  2790.         }
  2791.     }
  2792.     no_objects++;
  2793. }
  2794.  
  2795. /* -------------------------------------------------------------------------------- */
  2796. /*   Making (and, which is trickier, initialising) globals and global arrays        */
  2797. /* -------------------------------------------------------------------------------- */
  2798.  
  2799. int32 gcs[MAX_GCONSTANTS], gcvals[MAX_GCONSTANTS];
  2800.  
  2801. void fix_gconstants(char *globs)
  2802. {   int i;
  2803.     for (i=0; i<no_gconstants; i++)
  2804.         globs[gcs[i]]=gcvals[i];
  2805. } 
  2806.  
  2807. void make_global(char *b)
  2808. {   int i, j, iflag, sflag;
  2809.  
  2810.     if (pass_number>1) return;
  2811.     word(b,2); new_symbol(b,no_globals,2); no_globals++;
  2812.     word(b,3); iflag=0;
  2813.     if (b[0]==0) return;
  2814.     if (strcmp(b,"string")==0) sflag=1;
  2815.     else if (strcmp(b,"data")==0) sflag=0;
  2816.     else if (strcmp(b,"initial")==0) { sflag=0; iflag=1; }
  2817.     else if (strcmp(b,"initstr")==0) { sflag=0; iflag=2; }
  2818.     else
  2819.     {   if (strcmp(b,"=")!=0)
  2820.         { error_named("Expected \"string\", \"data\", \"initial\", \
  2821. \"initstr\" or \"=\" but found",b); return; }
  2822.         word(b,4); i=constant_value(b);
  2823.         gvalues[no_globals-1]=i; gflags[no_globals-1]=0;
  2824.         return;
  2825.     }
  2826.     if (iflag==0)
  2827.     {   word(b,4);
  2828.         i=constant_value(b);
  2829.     }
  2830.     if (iflag==1)
  2831.     {   i=0;
  2832.         do
  2833.         {   word(b,4+i); if (b[0]==0) break;
  2834.             j=constant_value(b); table_init[globals_size+i]=j; i++;
  2835.         } while (1==1);
  2836.     }
  2837.     if (iflag==2)
  2838.     {   textword(b,4);
  2839.         for (i=0; b[i]!=0; i++)
  2840.         {   j=b[i]; table_init[globals_size+i]=j;
  2841.         }
  2842.     }
  2843.     if (sflag==1)
  2844.     {   gcs[no_gconstants]=globals_size; gcvals[no_gconstants++]=i++;
  2845.     }
  2846.     gvalues[no_globals-1]=globals_size;
  2847.     gflags[no_globals-1]=2;
  2848.     globals_size+=i;
  2849. }
  2850.  
  2851. /* -------------------------------------------------------------------------------- */
  2852. /*   Assembler directives: for diagnosis, and making the non-code part of the file  */
  2853. /* -------------------------------------------------------------------------------- */
  2854.  
  2855. void switches(char *, int);
  2856.  
  2857. void assemble_label(int offset, char *b)
  2858. {   int i;
  2859.     if (pass_number==1) new_symbol(b+1,offset,6);
  2860.     else
  2861.     {   i=find_symbol(b+1);
  2862.         if (svals[i]!=offset)
  2863.         error("A label has moved between passes.  This suggests either \
  2864. a problem in Inform, or an improper use of a routine address as a constant value");
  2865.     }
  2866.     if (trace_mode==1) printf(".%s\n",b+1);
  2867.     return_flag=0;
  2868. }
  2869.  
  2870. void stack_sline(char *s1, char *b)
  2871. {   char rw[100];
  2872.     sprintf(rw,s1,b); stack_line(rw);
  2873. }
  2874.  
  2875. void assemble_directive(char *b, int offset, int code)
  2876. {   int i, j;
  2877.  
  2878.   switch(code)
  2879.   { case OPENBLOCK_CODE:
  2880.     {   if ((offset%2) ==1) { byteout(0); offset++; }
  2881.         word(b,2);
  2882.         new_symbol(b,offset,1);
  2883.         if (trace_mode==1) printf("<Routine %d, '%s' begins at %04x; ",
  2884.           no_routines,b,offset);
  2885.         no_locals= -1; no_knowns=0;
  2886.         routine_starts_line=current_source_line();
  2887.         no_routines++; in_routine_flag=1; return_flag=0;
  2888.         while (word(b,(++no_locals)+3),(b[0]!=0))
  2889.             new_symbol(b,no_locals,3);
  2890.  
  2891.         byteout(no_locals);
  2892.         for (i=0; i<no_locals; i++) { byteout(0); byteout(0); }
  2893.         if (trace_mode==1) printf("%d locals>\n",no_locals);
  2894.         if (no_locals>15) error("Routine has more than 15 local variables");
  2895.         if ((no_routines==1)&&(pass_number==1))
  2896.         {   word(b,2); make_lower_case(b);
  2897.             if (strcmp(b,"main")!=0)
  2898.             {   warning_named("Control will begin from the routine",b);
  2899.             }
  2900.             if (no_locals!=0)
  2901.               error("The \"Main\" routine is not allowed to have local variables");            
  2902.         }
  2903.         if (nowarnings_mode==0)
  2904.             for (i=0; i<16; i++) used_local_variable[i]=0;
  2905.         break;
  2906.     }
  2907.  
  2908.     case CLOSEBLOCK_CODE:
  2909.     {   if (trace_mode==1)  printf("<Routine ends>\n");
  2910.         if (return_flag==0) stack_line("  @ret#true");
  2911.         if (brace_sp>0)
  2912.         {   error("Brace mismatch in previous routine");
  2913.             brace_sp=0;
  2914.         }
  2915.         in_routine_flag=0;
  2916.         if ((nowarnings_mode==0)&&(pass_number==1))
  2917.         {   for (i=0; i<no_locals; i++)
  2918.             {   if (used_local_variable[i]==0)
  2919.                 {   override_error_line = routine_starts_line;
  2920.                     warning_named("Local variable unused:",
  2921.                       local_varname[i]);
  2922.                 }
  2923.             }
  2924.         }
  2925.         break;
  2926.     }
  2927.  
  2928.     case ABBREVIATE_CODE:
  2929.     {   textword(b,2);
  2930.         if (pass_number==1)
  2931.         {   if (no_abbrevs==MAX_ABBREVS)
  2932.             {   error("Too many abbreviations declared"); break; }
  2933.             if (almade_flag==1) 
  2934.             {   error("All abbreviations must be declared together"); break; }
  2935.             if (strlen(b)<2)
  2936.             {   error("Abbreviation not worth bothering with"); break; }
  2937.         }
  2938.         strcpy(abbreviations_at+no_abbrevs*MAX_ABBREV_LENGTH, b);
  2939.         word(b,2);
  2940.         abbrev_mode=0;
  2941.         abbrev_values[no_abbrevs]=constant_value(b);
  2942.         abbrev_quality[no_abbrevs++]=trans_length-2;
  2943.         abbrev_mode=1;
  2944.         break;
  2945.     }
  2946.  
  2947.     case ATTRIBUTE_CODE:
  2948.     {   if (no_attributes==32)
  2949.         { error("All 32 attributes already declared."); return; }
  2950.         word(b,2); new_symbol(b,no_attributes++,7); break; }
  2951.  
  2952.     case CONSTANT_CODE:
  2953.     {   word(b,3);
  2954.         IfPass2
  2955.         {   i=constant_value(b);
  2956.             word(b,2);
  2957.             i=find_symbol(b);
  2958.             if (stypes[i]==11)
  2959.               svals[i]=svals[i]-0x400+strings_offset/2;
  2960.         }
  2961.         else
  2962.         {   i=constant_value(b);
  2963.             word(b,2);
  2964.             if (cvflag==1) new_symbol(b,i,11);
  2965.             else new_symbol(b,i,8);
  2966.         }
  2967.         break;
  2968.     }
  2969.  
  2970.     case DEFAULT_CODE:
  2971.     {   word(b,3);
  2972.         IfPass2
  2973.         {
  2974.         }
  2975.         else
  2976.         {   i=constant_value(b);
  2977.             word(b,2);
  2978.             if (find_symbol(b)==-1)
  2979.             {   if (cvflag==1)
  2980.                 { error("Defaulted constants can't be strings"); return; }
  2981.                 new_symbol(b,i,8);
  2982.             }
  2983.         }
  2984.         break;
  2985.     }
  2986.  
  2987.     case STUB_CODE:
  2988.     {   i=0;
  2989.         IfPass2 { if (stub_flags[no_stubbed++]==1) i=1; }
  2990.         else
  2991.         {   word(b,2); if (find_symbol(b)==-1) i=1;
  2992.             stub_flags[no_stubbed++]=i;
  2993.         }
  2994.         if (i==1)
  2995.         {
  2996.             word(b,3); i=constant_value(b); word(b,2);
  2997.             switch(i)
  2998.             {   case 0: stack_sline("[ %s",b); stack_line("rfalse"); stack_line("]");
  2999.                         break;
  3000.                 case 1: stack_sline("[ %s x1",b); stack_line("@store x1 0");
  3001.                         stack_line("rfalse"); stack_line("]"); break;
  3002.                 case 2: stack_sline("[ %s x1 x2",b); stack_line("@store x1 0"); stack_line("@store x2 0");
  3003.                         stack_line("rfalse"); stack_line("]");
  3004.                 case 3: stack_sline("[ %s x1 x2 x3",b);
  3005.                         stack_line("@store x1 0"); stack_line("@store x2 0"); stack_line("@store x3 0");
  3006.                         stack_line("rfalse"); stack_line("]");
  3007.                 default: error("Must specify 0 to 3 variables in stubbed routine");
  3008.                         return;
  3009.             }
  3010.         }
  3011.         break;
  3012.     }
  3013.  
  3014.     case DICTIONARY_CODE:
  3015.     {   textword(b,3); i=dictionary_add(b,4,0,0);
  3016.         word(b,2);
  3017.         IfPass2
  3018.         { j=find_symbol(b); svals[j]=i; } else new_symbol(b,i,8);
  3019.         break;
  3020.     }
  3021.  
  3022.     case END_CODE:
  3023.     {   endofpass_flag=1;
  3024.         if (trace_mode==1) printf("<end>\n");
  3025.         break;
  3026.     }
  3027.  
  3028.     case INCLUDE_CODE:
  3029.     {   textword(b,2); load_sourcefile(b); break;
  3030.     }
  3031.  
  3032.     case GLOBAL_CODE: { make_global(b); break; }
  3033.  
  3034.     case OBJECT_CODE: { make_object(b); break; }
  3035.  
  3036.     case PROPERTY_CODE:
  3037.     {   int32 def=0, fl=0;
  3038.         if (no_properties==32)
  3039.         { error("All 30 properties already declared."); return; }
  3040.         word(b,2);
  3041.         if (strcmp(b,"long")==0) { fl=1; }
  3042.         word(b,3+fl);
  3043.         if (b[0]!=0) def=constant_value(b);
  3044.         word(b,2+fl); prop_defaults[no_properties]=def;
  3045.         prop_longflag[no_properties]=fl;
  3046.         new_symbol(b,no_properties++,7); break;
  3047.     }
  3048.  
  3049.     case RELEASE_CODE:
  3050.     {   word(b,2); release_number=constant_value(b); break; }
  3051.         
  3052.     case SWITCHES_CODE:
  3053.     {   if (ignoreswitches_mode==0) { word(b,2); switches(b,0); }
  3054.         break;
  3055.     }
  3056.  
  3057.     case STATUSLINE_CODE: 
  3058.     {   word(b,2);
  3059.         On_("score") { statusline_flag=0; break; }
  3060.         On_("time")  { statusline_flag=1; break; }
  3061.         error("Status line must be \"score\" or \"time\""); break;
  3062.     }
  3063.  
  3064.     case SERIAL_CODE:
  3065.     {   textword(b,2);
  3066.         if (strlen(b)!=6)
  3067.         {   error("The serial number must be a 6-digit date"); break; }
  3068.         for (i=0; i<6; i++)
  3069.           if (isdigit(b[i])==0)
  3070.           {   error("The serial number must be a 6-digit date"); break; }
  3071.         strcpy(time_given,b); time_set=1; break;
  3072.     }
  3073.  
  3074.     case VERB_CODE:   { make_verb(b); break; }
  3075.  
  3076.     case TRACE_CODE:    { IfPass2 trace_mode=1;  break; }
  3077.     case NOTRACE_CODE:  { IfPass2 trace_mode=tracing_mode;  break; }
  3078.     case ETRACE_CODE:   { IfPass2 etrace_mode=1; break; }
  3079.     case NOETRACE_CODE: { IfPass2 etrace_mode=0; break; }
  3080.     case BTRACE_CODE:   {         trace_mode=1;  break; }
  3081.     case NOBTRACE_CODE: {         trace_mode=0;  break; }
  3082.     case LTRACE_CODE:   { IfPass2 ltrace_mode=1; break; }
  3083.     case NOLTRACE_CODE: { IfPass2 ltrace_mode=listing_mode; break; }
  3084.     case ATRACE_CODE:   { IfPass2 ltrace_mode=2; break; }
  3085.     case NOATRACE_CODE: { IfPass2 ltrace_mode=listing_mode; break; }
  3086.  
  3087.     case LISTSYMBOLS_CODE: { IfPass2 list_symbols();     break; }
  3088.     case LISTOBJECTS_CODE: { IfPass2 list_object_tree(); break; }
  3089.     case LISTVERBS_CODE:   { IfPass2 list_verb_table();  break; }
  3090.     case LISTDICT_CODE:    { IfPass2 show_dictionary();  break; }
  3091.  
  3092.     default: error("Internal error - no such directive code");
  3093.   }
  3094.     return;
  3095. }
  3096.  
  3097. /* -------------------------------------------------------------------------------- */
  3098. /*   Compiler expression evaluator                                                  */
  3099. /*                                                                                  */
  3100. /*   This works in a rather lugubrious way, making a tree out of the expression and */
  3101. /*   then clearing it off again by clipping off nodes and stacking up corresponding */
  3102. /*   assembly lines.  The tricky point is to get it in the right order, since the   */
  3103. /*   stack can't very conveniently be re-ordered.                                   */
  3104. /*                                                                                  */
  3105. /*   Logically this process ought to end with an answer on the stack assigned to    */
  3106. /*   something, but a little optimisation avoids the waste of lines like            */
  3107. /*      sp=23+i, j=sp    and instead does the obvious j=23+i                        */
  3108. /*                                                                                  */
  3109. /*   To see it working in grisly detail, try compiling with expression tracing on   */
  3110. /* -------------------------------------------------------------------------------- */
  3111.  
  3112. int treenodes, tlevel, tflag, targ, top_exps, tsave;
  3113.  
  3114. void show_tree(char *c)
  3115. {   int i, j; char b[BUFFER_LENGTH];
  3116.     printf("%s\n",c);
  3117.     for (i=0; i<treenodes; i++)
  3118.     {   printf("%d %s  up=%d  ",i,(i==tlevel)?"*":" ",woods[i].up);
  3119.         for (j=0; j<woods[i].arity; j++)
  3120.         {   if (j<woods[i].gcount) printf("%d ",woods[i].g[j]);
  3121.             else printf(". ");
  3122.         }
  3123.         switch(woods[i].type)
  3124.         {   case -3: printf("  <root>"); break;
  3125.             case -2: printf("  <blank>"); break;
  3126.             case -1: printf("  <sp>"); break;
  3127.             case 0: word(b,woods[i].wnumber); printf("  <leaf '%s'>",b); break;
  3128.             default: printf("  %s",woods[i].op); break;
  3129.         }
  3130.         if (woods[i].priority!=0) { printf(" (%d)",woods[i].priority); }
  3131.         printf("\n");
  3132.     }
  3133. }
  3134.  
  3135. void sprout(int a, int wn, int type, char *opcode, int prio)
  3136. {   int i, tup;
  3137.  
  3138.     if (a>=MAX_ARITY)
  3139.     {   error("A function may be called with up to 3 arguments only"); return; }
  3140.  
  3141.     tup=woods[tlevel].up;
  3142.  
  3143.     if ((tflag==0)&&(targ==0))
  3144.     {   error("Operator has too few arguments"); return; }
  3145.     if (targ!=0) { targ=0; tsave=tlevel; }
  3146.  
  3147.     while (woods[tup].priority>prio)
  3148.     {   tlevel=tup; tup=woods[tlevel].up;
  3149.     }
  3150.  
  3151.     while (woods[tlevel].type== -2)
  3152.     {   for (i=1; i<woods[tup].arity; i++)
  3153.             if (woods[tup].g[i]==tlevel)
  3154.             { tlevel=woods[tup].g[i-1]; break; }
  3155.     }
  3156.  
  3157.     woods[treenodes]=woods[tlevel];
  3158.  
  3159.     woods[tlevel].arity=a;
  3160.     woods[tlevel].wnumber=wn;
  3161.     woods[tlevel].gcount=1;
  3162.     woods[tlevel].type=type;
  3163.     woods[tlevel].op=opcode;
  3164.     woods[tlevel].priority=prio;
  3165.  
  3166.     woods[tlevel].g[0]=treenodes;
  3167.     woods[treenodes++].up=tlevel;
  3168.  
  3169.     for (i=1; i<a; i++)
  3170.     {   woods[tlevel].g[i]=treenodes;
  3171.         woods[treenodes].type= -2;
  3172.         woods[treenodes].arity=0;
  3173.         woods[treenodes].gcount=0;
  3174.         woods[treenodes].priority=0;
  3175.         woods[treenodes++].up=tlevel;
  3176.     }
  3177.     tlevel=woods[tlevel].g[1];
  3178.     tflag=0;
  3179.  
  3180.     if (etrace_mode==1) show_tree("Sprout to");
  3181. }
  3182.  
  3183. void attach(int wn)
  3184. {   int tup;
  3185.  
  3186.     tup=woods[tlevel].up;
  3187.  
  3188.     woods[tlevel].arity=0;
  3189.     woods[tlevel].wnumber=wn;
  3190.     woods[tlevel].gcount=0;
  3191.     woods[tlevel].type=0;
  3192.     woods[tlevel].priority=0;
  3193.  
  3194.     woods[tup].gcount++;
  3195.     if (woods[tup].gcount<woods[tup].arity)
  3196.     { tlevel=woods[tup].g[woods[tup].gcount];
  3197.       tflag=0;
  3198.     }
  3199.     else tflag=1;
  3200.  
  3201.     if (etrace_mode==1) show_tree("Attach to");
  3202.     return;
  3203.  
  3204. }
  3205.  
  3206. void eword(char *b, int bn)
  3207. {   if (woods[bn].type==-1) strcpy(b,"sp");
  3208.     else word(b,woods[bn].wnumber);
  3209.     /* printf("Eword %d -> %d <%s>\n",bn,woods[bn].wnumber,b); */
  3210. }
  3211.  
  3212. int exp_hwm;
  3213.  
  3214. int expression(int fromword)
  3215. {   int i, j, pp, t, countas, brackets[32], blev, clev, npri=0, sarity, sflag;
  3216.     char rwb[BUFFER_LENGTH], b[BUFFER_LENGTH];
  3217.     woods[0].up= -1;
  3218.     woods[0].type= -3;
  3219.     woods[0].g[0]=1;
  3220.     woods[0].arity=1;
  3221.     woods[0].gcount=0;
  3222.     woods[0].priority=0;
  3223.     treenodes=2; targ=0;
  3224.     tlevel=1; tflag=0; woods[1].up=0; woods[1].type= -2; woods[1].priority=0;
  3225.     blev=0;
  3226.     pp=fromword;
  3227.  
  3228.     do
  3229.     {   word(b,pp++);
  3230.         if (b[0]==0) break;
  3231.              On_("=")   sprout(2,pp-1,1,"store",2+npri);
  3232.         else On_("+")   sprout(2,pp-1,2,"add",  3+npri);
  3233.         else On_("-")   sprout(2,pp-1,2,"sub",  3+npri);
  3234.         else On_("*")   sprout(2,pp-1,2,"mul",  4+npri);
  3235.         else On_("/")   sprout(2,pp-1,2,"div",  4+npri);
  3236.         else On_("%")   sprout(2,pp-1,2,"mod",  4+npri);
  3237.         else On_("&")   sprout(2,pp-1,2,"and",  4+npri);
  3238.         else On_("|")   sprout(2,pp-1,2,"or",   4+npri);
  3239.         else On_("->")  sprout(2,pp-1,2,"loadb",5+npri);
  3240.         else On_("-->") sprout(2,pp-1,2,"loadw",5+npri);
  3241.         else On_(",")
  3242.              {   if ((blev==0)||(brackets[blev-1]==1))
  3243.                      error("Spurious comma");
  3244.                  targ=1;
  3245.                  if (woods[tlevel].type!=-2)
  3246.                  {   tlevel=woods[tsave].up;
  3247.                      for (i=0; i<woods[tlevel].arity; i++)
  3248.                          if (woods[woods[tlevel].g[i]].type==-2)
  3249.                          { tlevel=woods[tlevel].g[i]; break; }
  3250.                  }
  3251.              }
  3252.         else On_("(")
  3253.              {   npri+=10;
  3254.                  if (tflag==0)
  3255.                  {   brackets[blev++]=1;
  3256.                  }
  3257.                  else
  3258.                  {   brackets[blev++]=0;
  3259.                      j=pp; countas=2; clev=blev; word(b,pp);
  3260.                      On_(")") countas=1;
  3261.                      else
  3262.                      do { word(b,j++);
  3263.                           if (b[0]==0) { error("Missing ) in function call"); break; }
  3264.                           if ((strcmp(b,",")==0)&&(blev==clev)) countas++;
  3265.                           On_("(") clev++;
  3266.                           On_(")") clev--;
  3267.                         } while (clev>=blev);
  3268.                      sprout(countas,pp-1,2,"call",1+npri);
  3269.                      targ=1;
  3270.                  }
  3271.              }
  3272.         else On_(")")
  3273.              {   if (blev--==0) break;
  3274.                  npri-=10;
  3275.              }
  3276.         else if ((tflag==1)&&(targ==0))
  3277.              {   if (blev>0) error("Operator has too many arguments");
  3278.                  break;
  3279.              }
  3280.         else if (woods[tlevel].type==-2) attach(pp-1);
  3281.         else break;
  3282.  
  3283.     } while (1==1);
  3284.  
  3285.     if (b[0]==0) exp_hwm= -1; else exp_hwm=pp-1;
  3286.  
  3287.     if (blev>0) error("Too many (s in expression");
  3288.  
  3289.     if (etrace_mode==1) show_tree("Made the tree:");
  3290.  
  3291.     do
  3292.     {   i=0;
  3293.         DownDown:
  3294.         for (j=woods[i].gcount-1; j>=0; j--)
  3295.         {   t=woods[woods[i].g[j]].type;
  3296.             if ((t!=0)&&(t!=-1)) { i=woods[i].g[j]; goto DownDown; }
  3297.         }
  3298.  
  3299.         if (etrace_mode==1) printf("Detaching %d\n",i);
  3300.         if (i==0)
  3301.         {   if (woods[woods[0].g[0]].type==-1) j= -1;
  3302.             else j=woods[woods[0].g[0]].wnumber;
  3303.             if (etrace_mode==1) printf("Answer is in %d and word is %d\n",j,exp_hwm);
  3304.             return(j);
  3305.         }
  3306.  
  3307.         if (woods[i].gcount<woods[i].arity)
  3308.             error("Not enough arguments in operator");
  3309.  
  3310.         sarity=0; sflag=0;
  3311.         if (strcmp(woods[i].op,"call")==0)
  3312.         {   eword(b,woods[i].g[0]);
  3313.             On_("parent")    { sarity=1; woods[i].op="get_parent";    }
  3314.             On_("sibling")   { sarity=1; woods[i].op="get_sibling"; sflag=1; }
  3315.             On_("child")     { sarity=1; woods[i].op="get_child";   sflag=1; }
  3316.             On_("random")    { sarity=1; woods[i].op="random";        }
  3317.             On_("prop_len")  { sarity=1; woods[i].op="get_prop_len";  }
  3318.             On_("prop_addr") { sarity=2; woods[i].op="get_prop_addr"; }
  3319.             On_("prop")      { sarity=2; woods[i].op="get_prop";      }
  3320.             On_("indirect")
  3321.             {   if (woods[i].gcount<2)
  3322.                 { error("Two few arguments on indirect function call"); }
  3323.                 sarity=1; woods[i].op="icall";
  3324.             }
  3325.             else
  3326.             if (sarity!=0)
  3327.             {   if (sarity+1!=woods[i].gcount)
  3328.                 {   error("Wrong number of arguments to system function");
  3329.                 }
  3330.             }
  3331.         }
  3332.         sprintf(rwb,"@%s ",woods[i].op);
  3333.         t=woods[i].type;
  3334.  
  3335.         if (sarity>0) sarity=1;
  3336.         for (j=sarity; j<woods[i].gcount; j++)
  3337.         {   eword(b,woods[i].g[j]);
  3338.             sprintf(rwb+strlen(rwb),"%s ",b);
  3339.         }
  3340.         if (t!=1)
  3341.         {   if (woods[woods[i].up].type==1)
  3342.             {   word(b,woods[woods[woods[i].up].g[0]].wnumber);
  3343.                 sprintf(rwb+strlen(rwb),"%s",b);
  3344.                 i=woods[i].up; t=1;
  3345.             }
  3346.             else sprintf(rwb+strlen(rwb),"sp");
  3347.         }
  3348.         if (sflag==1)
  3349.         {   sprintf(rwb+strlen(rwb)," _x%d",no_dummy_labels);
  3350.         }
  3351.         stack_line(rwb);
  3352.         if (sflag==1)
  3353.         {   sprintf(rwb,"@._x%d",no_dummy_labels++);
  3354.             stack_line(rwb);
  3355.         }
  3356.  
  3357.         if (t==1) woods[i]=woods[woods[i].g[0]];
  3358.         else
  3359.         {   woods[i].arity=0;
  3360.             woods[i].type= -1;
  3361.             woods[i].gcount=0;
  3362.         }
  3363.         if (etrace_mode==1) show_tree("to");
  3364.     } while (1==1);
  3365.     return(1);
  3366. }
  3367.  
  3368. /* -------------------------------------------------------------------------------- */
  3369. /*   Compiler top level: block structures, loops, if statements and commands        */
  3370. /*   (all using the expression evaluator)                                           */
  3371. /* -------------------------------------------------------------------------------- */
  3372.  
  3373. int objlb[MAX_OLDEPTH]; char objlv[36][MAX_OLDEPTH]; int oldepth=0;
  3374.  
  3375. char forvariable[MAX_IDENTIFIER_LENGTH];
  3376.  
  3377. void cword(char *b, int n)
  3378. {   if (n==-1) strcpy(b,"sp");
  3379.     else word(b,n);
  3380. }
  3381.  
  3382. void compile_openbrace()
  3383. {   
  3384.     char rwb[BUFFER_LENGTH];
  3385.     brace_stack[brace_sp++]=next_block_type+no_blocks_made++;
  3386.     if (forloop_flag==1)
  3387.     {   sprintf(rwb,"@inc %s",forvariable);
  3388.         stack_line(rwb);
  3389.         forloop_flag=0;
  3390.     }
  3391. }
  3392.  
  3393. void compile_closebrace(char *b)
  3394. {   int j;
  3395.     char rwb[BUFFER_LENGTH];
  3396.     get_next_line(); tokenise_line(); word(b,1);
  3397.  
  3398.     make_upper_case(b);
  3399.  
  3400.     j=brace_stack[--brace_sp];
  3401.     if (j>=10000)
  3402.     {   j-=10000;
  3403.         if (oldepth>0)
  3404.         {   if (brace_sp==objlb[oldepth-1])
  3405.             {   oldepth--;
  3406.                 sprintf(rwb,"@get_sibling %s %s _x%d",
  3407.                 objlv[oldepth],objlv[oldepth],no_dummy_labels);
  3408.                 stack_line(rwb);
  3409.                 sprintf(rwb,"@._x%d",no_dummy_labels++); stack_line(rwb);
  3410.             }
  3411.         }
  3412.         sprintf(rwb,"  @jump _w%d",j);
  3413.         stack_line(rwb);
  3414.     }
  3415.     On_("ELSE")
  3416.     {   sprintf(rwb,"@jump _f%d",no_blocks_made);
  3417.         stack_line(rwb);
  3418.     }
  3419.     sprintf(rwb,"@._f%d",j); return_flag=0;
  3420.     stack_line(rwb);
  3421.     stack_line(buffer);
  3422. }
  3423.  
  3424. void rearrange_stack(int a, int b, int c)
  3425. {   
  3426.      if ((a==-1)&&(b==-1)&&(c==-1))
  3427.      {   stack_line("  @pull #253");
  3428.          stack_line("  @pull #254");
  3429.          stack_line("  @pull #255");
  3430.          stack_line("  @push #253");
  3431.          stack_line("  @push #254");
  3432.          stack_line("  @push #255"); return;
  3433.      }
  3434.      if ( ((a==-1)&&(b==-1))
  3435.           || ((a==-1)&&(c==-1))
  3436.           || ((b==-1)&&(c==-1)))
  3437.      {   stack_line("  @pull #254");
  3438.          stack_line("  @pull #255");
  3439.          stack_line("  @push #254");
  3440.          stack_line("  @push #255");
  3441.      }
  3442. }
  3443.  
  3444. void compiler(char *b, int code)
  3445. {   int i, j, k, trans, pflag, dir, labnum,
  3446.         brace_spc, doexp, dofrom, popflag, cnum;
  3447.     char rwb[BUFFER_LENGTH];
  3448.     char *cond="";
  3449.  
  3450.     doexp=0; trans=0;
  3451.  
  3452.   switch(code)
  3453.   { case ASSIGNMENT_CODE:  doexp=1; dofrom=1; popflag=0; goto DoExpression;
  3454.     case FUNCTION_CODE:    doexp=1; dofrom=1; popflag=1; goto DoExpression;
  3455.  
  3456.     case DO_CODE:    return;
  3457.      
  3458.     case FOR_CODE:
  3459.     {   forloop_flag=1;
  3460.         word(b,2);
  3461.         strcpy(forvariable,b);
  3462.         i=expression(3);
  3463.         cword(b,i);
  3464.         sprintf(rwb,"  @store %s %s",forvariable,b);
  3465.         stack_line(rwb);
  3466.         sprintf(rwb,"  @dec %s",forvariable);
  3467.         stack_line(rwb);
  3468.         if (exp_hwm==-1) { error("'to' missing"); return; }
  3469.         word(b,exp_hwm++);
  3470.         if (strcmp(b,"to")!=0) { error("'to' expected"); return; }
  3471.         word(b,exp_hwm);
  3472.         if (b[0]==0) { error("Final value missing"); return; }
  3473.         i=expression(exp_hwm);
  3474.         if (exp_hwm!=-1) { error("'{' expected after for"); return; }
  3475.         if (i==-1) { error("For loops must have simple final values"); return; }
  3476.         cword(b,i);
  3477.         sprintf(rwb,"  while %s < %s",forvariable,b);
  3478.         stack_line(rwb);
  3479.         return;
  3480.     }
  3481.  
  3482.     case IF_CODE:    trans=1; goto Translation;
  3483.     case UNTIL_CODE: trans=4; goto Translation;
  3484.     case WHILE_CODE: trans=2; goto Translation;
  3485.  
  3486.     case BREAK_CODE:
  3487.     {   brace_spc=brace_sp;
  3488.         do { j=brace_stack[--brace_spc]; } while ((j<10000)&&(brace_spc>=0));
  3489.         sprintf(rwb,"@jump _f%d",j-10000);
  3490.         stack_line(rwb);
  3491.         return;
  3492.     }
  3493.  
  3494.     case ELSE_CODE: return;
  3495.  
  3496.     case FONT_CODE:
  3497.         word(b,2);
  3498.         On_("on") { stack_line("put 0 word 8 $fffd&(0-->8)"); return; }
  3499.         On_("off") { stack_line("put 0 word 8 2|(0-->8)"); return; }
  3500.         error("Font must be switched \"on\" or \"off\"."); return; 
  3501.  
  3502.     case GIVE_CODE:
  3503.     {   i=expression(2);
  3504.         if (exp_hwm==-1) { error("Expected some attributes"); return; }
  3505.         if (i==-1)
  3506.         { error("The object must be simply a variable or a constant"); return; }
  3507.         do
  3508.         {   char *bb;
  3509.             word(b,exp_hwm);
  3510.             if (b[0]!=0)
  3511.             {   if (b[0]=='~') { sprintf(rwb, "@clear_attr "); bb=b+1; }
  3512.                 else { bb=b; sprintf(rwb, "@set_attr "); }
  3513.                 cword(b,i);
  3514.                 sprintf(rwb+strlen(rwb), "%s ",b);
  3515.                 word(b,exp_hwm); exp_hwm++;
  3516.                 sprintf(rwb+strlen(rwb), "%s",bb);
  3517.                 stack_line(rwb);
  3518.             }
  3519.         } while (b[0]!=0);
  3520.         return;
  3521.     }
  3522.  
  3523.     case INVERSION_CODE:
  3524.     {   sprintf(rwb,"@print \"%d\"",VNUMBER);
  3525.         stack_line(rwb);
  3526.         return;
  3527.     }
  3528.  
  3529.     case MOVE_CODE:
  3530.     {   i=expression(2);
  3531.         if (exp_hwm==-1) { error("Expected 'to'"); return; }
  3532.         word(b,exp_hwm++);
  3533.         if (strcmp(b,"to")!=0)
  3534.         { error_named("Expected \"to\" but found",b); return; }
  3535.         j=expression(exp_hwm);
  3536.         cword(b,i);
  3537.         sprintf(rwb, "@insert_obj %s",b);
  3538.         cword(b,j);
  3539.         sprintf(rwb+strlen(rwb), " %s",b);
  3540.         rearrange_stack(i,j,0);
  3541.         stack_line(rwb);
  3542.         return;
  3543.     }
  3544.  
  3545.     case OBJECTLOOP_CODE:
  3546.     {   forloop_flag=1;
  3547.         word(b,2);
  3548.         strcpy(forvariable,b);
  3549.         word(b,3);
  3550.         On_("from") { sprintf(rwb,"  %s = ",forvariable); pflag=0; }
  3551.         else On_("in") { sprintf(rwb,"  %s = child(",forvariable); pflag=1; }
  3552.         else { error("Objectloops can only be from or in something"); return; }
  3553.         i=expression(4);
  3554.         cword(b,i);
  3555.         sprintf(rwb+strlen(rwb),"%s%s",b,(pflag==1)?")":"");
  3556.         stack_line(rwb);
  3557.         if (exp_hwm!=-1) { error("'{' expected after objectloop"); return; }
  3558.         sprintf(rwb,"  while %s ~= 0",forvariable);
  3559.         stack_line(rwb);
  3560.         objlb[oldepth]=brace_sp; strcpy(objlv[oldepth++],forvariable);
  3561.         if (oldepth==MAX_OLDEPTH) { oldepth--;
  3562.             error("Maximum object loop nesting exceeded (increase MAX_OLDEPTH)"); }
  3563.         return;
  3564.     }
  3565.  
  3566.     case PRINT_ADDR_CODE:  doexp=2; dofrom=2; cond="print_addr";  goto DoExpression;
  3567.     case PRINT_CHAR_CODE:  doexp=2; dofrom=2; cond="print_char";  goto DoExpression;
  3568.     case PRINT_PADDR_CODE: doexp=2; dofrom=2; cond="print_paddr"; goto DoExpression;
  3569.     case PRINT_OBJ_CODE:   doexp=2; dofrom=2; cond="print_obj";   goto DoExpression;
  3570.     case PRINT_NUM_CODE:   doexp=2; dofrom=2; cond="print_num";   goto DoExpression;
  3571.     case PUT_CODE:
  3572.     {   i=expression(2);
  3573.         if (exp_hwm==-1) { error("Expected 'byte' or 'word'"); return; }
  3574.         word(b,exp_hwm++);
  3575.         On_("byte") cond="B";
  3576.         else On_("word") cond="W";
  3577.         else
  3578.         { error_named("Expected 'byte' or 'word' but found",b); return; }
  3579.         j=expression(exp_hwm);
  3580.         k=expression(exp_hwm);
  3581.         cword(b,i);
  3582.         sprintf(rwb, "@store%s %s",cond,b);
  3583.         cword(b,j);
  3584.         sprintf(rwb+strlen(rwb), " %s",b);
  3585.         cword(b,k);
  3586.         sprintf(rwb+strlen(rwb), " %s",b);
  3587.         rearrange_stack(i,j,k);
  3588.         stack_line(rwb);
  3589.         return;
  3590.     }
  3591.  
  3592.     case REMOVE_CODE:      doexp=2; dofrom=2; cond="remove_obj";  goto DoExpression;
  3593.  
  3594.     case RETURN_CODE:
  3595.         word(b,2); if (b[0]==0) { stack_line("@ret#true"); return; }
  3596.         doexp=2; dofrom=2; cond="ret"; goto DoExpression;
  3597.  
  3598.     case STRING_CODE:
  3599.         i=expression(2);
  3600.         if (exp_hwm==-1) { error("Expected a string value"); return; }
  3601.         cword(b,i);
  3602.         sprintf(rwb, "put $0042 word %s ",b);
  3603.         word(b,exp_hwm);
  3604.         sprintf(rwb+strlen(rwb), "%s",b);
  3605.         stack_line(rwb);
  3606.         return; 
  3607.  
  3608.     case WRITE_CODE:
  3609.     {   i=expression(2);
  3610.         if (exp_hwm==-1) { error("Expected some properties"); return; }
  3611.         if (i==-1)
  3612.         { error("The object must be simply a variable or a constant"); return; }
  3613.         do
  3614.         {   if (exp_hwm!=-1)
  3615.             {   j=expression(exp_hwm);
  3616.                 if (exp_hwm==-1) { error("Expected property value"); return; }
  3617.                 k=expression(exp_hwm);
  3618.                 cword(b,i);
  3619.                 sprintf(rwb, "@put_prop %s",b);
  3620.                 cword(b,j);
  3621.                 sprintf(rwb+strlen(rwb), " %s",b);
  3622.                 cword(b,k);
  3623.                 sprintf(rwb+strlen(rwb), " %s",b);
  3624.                 rearrange_stack(j,k,0);
  3625.                 stack_line(rwb);
  3626.             }
  3627.         } while (exp_hwm!=-1);
  3628.         return;
  3629.     }
  3630.     default: error("Internal error - unknown compiler code");
  3631.   }
  3632.     return;
  3633.  
  3634.     DoExpression:
  3635.         i=expression(dofrom);
  3636.         if (i>=1) word(b,i); else strcpy(b,"sp");
  3637.         switch(doexp)
  3638.         {   case 1: if ((popflag==1)&&(i==-1)) stack_line("@pop"); break;
  3639.             case 2: sprintf(rwb,"@%s %s",cond, b); stack_line(rwb); break;
  3640.         }
  3641.         if (exp_hwm!=-1) error("Spurious terms after expression");
  3642.     return;
  3643.  
  3644.     Translation:
  3645.         next_block_type=0;
  3646.         if (trans==2)
  3647.         {   sprintf(rwb,"@._w%d",no_blocks_made);
  3648.             next_block_type=10000;
  3649.             stack_line(rwb);
  3650.         }
  3651.  
  3652.         k=expression(2);
  3653.  
  3654.         if (exp_hwm==-1) { error("No condition"); return; }
  3655.         word(b,exp_hwm);
  3656.         i=find_symbol(b);
  3657.         if ((i<0)||(stypes[i]!=10)) { error_named("Bad condition",b); return; }
  3658.         if (svals[i]>=6) { j=svals[i]-5; pflag=1; }
  3659.         else { j=svals[i]; pflag=0; }
  3660.         cnum=j;
  3661.         switch(cnum)
  3662.         {   case 1: cond="je"; break;
  3663.             case 2: cond="jge"; break;
  3664.             case 3: cond="jle"; break;
  3665.             case 4: cond="test_attr"; break;
  3666.             case 5: cond="compare_pobj"; break;
  3667.         }
  3668.  
  3669.         j=expression(exp_hwm+1);
  3670.         if (exp_hwm>=0)
  3671.         {   word(b,exp_hwm);
  3672.             On_("or")
  3673.             {   if (cnum!=1)
  3674.                 {   error("You can only use 'or' on the '==' condition.");
  3675.                     return; }
  3676.                 cond="vje";
  3677.             }
  3678.         }
  3679.     
  3680.         cword(b,k);
  3681.  
  3682.         rearrange_stack(j,k,0);
  3683.  
  3684.         sprintf(rwb,"  @%s %s ",cond,b);
  3685.  
  3686.         if (trans!=4)
  3687.         {   dir=1; labnum=no_blocks_made; }
  3688.         else
  3689.         {   dir=0; labnum=brace_stack[brace_sp]; }
  3690.  
  3691.         cword(b,j);
  3692.         sprintf(rwb+strlen(rwb),"%s ",b);
  3693.  
  3694.         if (exp_hwm!=-1)
  3695.         {   do
  3696.             {   word(b,exp_hwm++);
  3697.                 if (b[0]==0) break;
  3698.                 if (strcmp(b,"or")!=0)
  3699.                 { error("'{' expected before block of code"); return; }
  3700.                 word(b,exp_hwm++);
  3701.                 if (b[0]==0)
  3702.                 {   error("Missing alternative value"); return; }
  3703.                 sprintf(rwb+strlen(rwb),"%s ",b);
  3704.             } while (1==1);
  3705.         }
  3706.  
  3707.         sprintf(rwb+strlen(rwb),"?%s_%s%d",
  3708.           (pflag==1)?"":"~",(dir==1)?"f":"s",labnum);
  3709.         stack_line(rwb);
  3710.         return;
  3711. }
  3712.  
  3713. /* -------------------------------------------------------------------------------- */
  3714. /*   Line parser: decides whether to send line to compiler or assembler             */
  3715. /* -------------------------------------------------------------------------------- */
  3716.  
  3717. void parse_line(void)
  3718. {   char b[BUFFER_LENGTH]; int i, j; opcode opco;
  3719.     int32 offset, expect=0;
  3720.  
  3721. #ifdef USE_TEMPORARY_FILES
  3722.     offset=(subtract_pointers(utf_zcode_p,zcode));
  3723. #else
  3724.     offset=(subtract_pointers(zcode_p,zcode));
  3725. #endif
  3726.  
  3727.     word(b,2);
  3728.     if (strcmp(b,"=")==0) { compiler(b,ASSIGNMENT_CODE); return; }
  3729.  
  3730.     word(b,1); if (b[0]==0) return;
  3731.     make_upper_case(b);
  3732.  
  3733.     if (b[0]=='.') { assemble_label(offset,b); return; }
  3734.     if ((b[0]=='@')&&(b[1]=='.')) { assemble_label(offset,b+1); return; }
  3735.     if (b[0]=='{') { compile_openbrace(); return; }
  3736.     if (b[0]=='}') { compile_closebrace(b); return; }
  3737.     if (b[0]=='#') expect=1;
  3738.     if (b[0]=='@') expect=2;
  3739.     if (expect==0) i=prim_find_symbol(b,6);
  3740.     else i=prim_find_symbol(b+1,6);
  3741.  
  3742.     if ((expect==1) && ((i==-1)||(stypes[i]!=14)))
  3743.     {   error_named("Unknown # directive",b); return;
  3744.     }
  3745.     if ((expect==2) && ((i==-1)||( (stypes[i]!=16) && (stypes[i]!=17) )))
  3746.     {   error_named("Unknown assembly opcode",b); return;
  3747.     }
  3748.     if (i==-1)
  3749.     {   word(b,2);
  3750.         if (strcmp(b,"(")==0) { compiler(b,FUNCTION_CODE); return; }
  3751.         word(b,1);
  3752.         error_named("Unknown command, directive or opcode: ",b); return;
  3753.     }
  3754.  
  3755.     j=stypes[i];
  3756.  
  3757.     if (j==17)
  3758.     {   opco=opcs(svals[i]); assemble_opcode(b,offset,opco); return; }
  3759.  
  3760.     if (j==16)
  3761.     {   if (expect==2)
  3762.         {   opco=opcs((svals[i])%100); assemble_opcode(b,offset,opco); return; }
  3763.         compiler(b,(svals[i])/100); return;
  3764.     }
  3765.  
  3766.     if (j==14) { assemble_directive(b,offset,svals[i]); return; }
  3767.  
  3768.     compiler(b,svals[i]);
  3769.  
  3770.     return;
  3771. }
  3772.  
  3773. /* -------------------------------------------------------------------------------- */
  3774. /*   Construct story file up as far as code area                                    */
  3775. /*   (see documentation for description of what goes on here)                       */
  3776. /* -------------------------------------------------------------------------------- */
  3777.  
  3778. void percentage(char *name, int x, int total)
  3779. {   printf("   %-20s %2d.%d%%\n",name,x*100/total,(x*1000/total)%10);
  3780. }
  3781.  
  3782. void construct_storyfile(void)
  3783. {   char *p; int32 i, j, k; int32 excess;
  3784.     int32 syns, objs, props, vars, parse, code, strs, dict, nparse,
  3785.         actshere, preactshere;
  3786.     int32 synsat, glpat, objat, propat, parsat;
  3787.     int32 code_length, strings_length;
  3788.  
  3789.     p=output_p;
  3790.  
  3791.     for (i=0; i<=0x3f; i++) p[i]=0;
  3792.  
  3793.     p[0]=3; p[1]=statusline_flag*2;
  3794.     p[2]=(release_number/256); p[3]=(release_number%256);
  3795.     p[16]=0; p[17]=0;
  3796.  
  3797.     write_serialnumber(buffer);
  3798.     for (i=0; i<6; i++) p[18+i]=buffer[i];
  3799.  
  3800.     syns=0x40;
  3801.     p[syns]=0x80; p[syns+1]=0; syns+=2;
  3802.  
  3803.     p[24]=syns/256; p[25]=syns%256; synsat=syns;
  3804.     for (i=0; i<3*32; i++)
  3805.     {   p[syns++]=0; p[syns++]=0x20;
  3806.     }
  3807.  
  3808.     for (i=0; i<no_abbrevs; i++)
  3809.     {   p[synsat+64+2*i]=(abbrev_values[i])/256;
  3810.         p[synsat+65+2*i]=(abbrev_values[i])%256;
  3811.     }
  3812.     objs=syns;
  3813.  
  3814.     p[10]=objs/256; p[11]=objs%256; glpat=objs;
  3815.     p[objs]=0; p[objs+1]=0;
  3816.     for (i=2; i<32; i++)
  3817.     {   p[objs+2*i-2]=prop_defaults[i]/256;
  3818.         p[objs+2*i-1]=prop_defaults[i]%256;
  3819.     }
  3820.     objs+=62; props=objs+9*no_objects; objat=objs; propat=props;
  3821.  
  3822.     for (i=0; i<properties_size; i++)
  3823.         p[props+i]=properties_table[i];
  3824.  
  3825.     for (i=0; i<no_objects; i++)
  3826.     {   p[objs]=objects[i].atts[0];
  3827.         p[objs+1]=objects[i].atts[1];
  3828.         p[objs+2]=objects[i].atts[2];
  3829.         p[objs+3]=objects[i].atts[3];
  3830.         p[objs+4]=objects[i].parent;
  3831.         p[objs+5]=objects[i].next;
  3832.         p[objs+6]=objects[i].child;
  3833.         p[objs+7]=props/256;
  3834.         p[objs+8]=props%256;
  3835.         objs+=9;
  3836.  
  3837.         props+=objects[i].propsize;
  3838.     }
  3839.  
  3840.     vars=props;
  3841.  
  3842.     p[12]=(vars/256); p[13]=(vars%256);
  3843.  
  3844.     for (i=vars; i<vars+globals_size; i++) p[i]=table_init[i-vars];
  3845.  
  3846.     parse=vars+globals_size;
  3847.  
  3848.     p[14]=(parse/256); p[15]=(parse%256);  parsat=parse;
  3849.     nparse=parse+no_verbs*2;
  3850.     for (i=0; i<no_verbs; i++)
  3851.     {   p[parse]=(nparse/256); p[parse+1]=(nparse%256);
  3852.         parse+=2;
  3853.         p[nparse]=vs[i].lines; nparse++;
  3854.         for (j=0; j<vs[i].lines; j++)
  3855.         {   for (k=0; k<8; k++) p[nparse+k]=vs[i].l[j].e[k];
  3856.             nparse+=8;
  3857.         }
  3858.     }
  3859.  
  3860.     actshere=nparse; nparse+=2*no_actions;
  3861.     preactshere=nparse; nparse+=2*no_actions;
  3862.  
  3863.     p[nparse]=0; p[nparse+1]=no_adjectives; nparse+=2;
  3864.  
  3865.     dict=nparse+4*no_adjectives;
  3866.  
  3867.     adjectives_offset=nparse;
  3868.  
  3869.     for (i=0; i<no_adjectives; i++)
  3870.     {   j=adjectives[no_adjectives-i-1];
  3871.         p[nparse]=j/256; p[nparse+1]=j%256; p[nparse+2]=0;
  3872.         p[nparse+3]=(256-no_adjectives+i); nparse+=4;
  3873.     }
  3874.  
  3875.     dictionary[5]=(dict_entries/256); dictionary[6]=(dict_entries%256);
  3876.     p[8]=(dict/256);     p[9]=(dict%256);
  3877.     for (i=0; i+dictionary<dict_p; i++) p[dict+i]=dictionary[i];
  3878.     code=dict+i; if ((code%2)==1) { p[code++]=0; }
  3879.  
  3880.     p[4]=(code/256);     p[5]=(code%256);
  3881.     p[6]=((code+1)/256); p[7]=((code+1)%256);
  3882.  
  3883.     Write_Code_At = code;
  3884.     code_length=subtract_pointers(zcode_p,zcode);
  3885.  
  3886.     strs=code+code_length; if ((strs%2) != 0) p[strs++]=0;
  3887.     Write_Strings_At = strs;
  3888.     strings_length=subtract_pointers(strings_p,strings);
  3889.  
  3890.     Out_Size=strs+strings_length; excess=Out_Size-((int32) 0x20000L);
  3891.  
  3892.     if (excess>0)
  3893.     {   sprintf(buffer,
  3894.           "Story file exceeds 128K by %d bytes",excess);
  3895.         fatalerror(buffer);
  3896.     }
  3897.  
  3898.     code_offset = code;
  3899.     dictionary_offset = dict;
  3900.     variables_offset = vars;
  3901.     strings_offset = strs;
  3902.     actions_offset = actshere;
  3903.     preactions_offset = preactshere;
  3904.  
  3905.     j=(Out_Size/2);
  3906.     p[26]=j/256; p[27]=j%256; p[28]=0; p[29]=0;
  3907.  
  3908.     for (i=0; i<no_actions; i++)
  3909.     {   j=(actions[i]+code)/2;
  3910.         p[actshere+i*2]=j/256; p[actshere+i*2+1]=j%256;
  3911.         if (preactions[i]==-1) j=0; else j=(preactions[i]+code)/2;
  3912.         p[preactshere+i*2]=j/256; p[preactshere+i*2+1]=j%256;
  3913.     }
  3914.  
  3915.     for (i=0; i<240; i++)
  3916.     {   j=gvalues[i];
  3917.         switch(gflags[i])
  3918.         {   case 1: j+=(code/2); break;
  3919.             case 2: j+=vars; break;
  3920.         }
  3921.         p[vars+i*2]   = j/256;
  3922.         p[vars+i*2+1] = j%256;
  3923.     }
  3924.  
  3925.     fix_gconstants(p+vars);
  3926.  
  3927.     if (statistics_mode==1)
  3928.     {   int k_long, rate; char *k_str;
  3929.         k_long=(Out_Size/1024);
  3930.         if ((Out_Size-1024*k_long) >= 512) { k_long++; k_str=""; }
  3931.         else if ((Out_Size-1024*k_long) > 0) { k_str=".5"; }
  3932.         rate=total_bytes_trans*1000/total_chars_trans;
  3933.         if ((pass_number==2)||(bothpasses_mode==1))
  3934.         {   printf("Input %d lines (%d statements, %d chars)",
  3935.                 total_source_line,internal_line,marker_in_file);
  3936.             if (total_files_read > 1) { printf(" from %d files",
  3937.                 total_files_read); }
  3938.             printf(
  3939. "\n%4d objects (maximum 255)     %4d dictionary entries (maximum %d)\n\
  3940. %4d attributes (maximum 32)   %4d properties (maximum 30)\n\
  3941. %4d adjectives (maximum 240)  %4d verbs (maximum %d)\n\
  3942. %4d actions (maximum %3d)     %4d abbreviations (maximum %d)\n\
  3943. %4d globals (maximum 240)     %4d variable space (maximum %d)\n\
  3944. %4d symbols (maximum %4d)    %4d routines (maximum %d)\n\
  3945. %4d characters of text (compressed to %d bytes, rate 0.%d)\n\
  3946. Output story file is %3d%sK long (maximum 128K)\n",
  3947.                    no_objects,dict_entries,MAX_DICT_ENTRIES,
  3948.                    no_attributes,no_properties-2,
  3949.                    no_adjectives,no_verbs,MAX_VERBS,
  3950.                    no_actions,MAX_ACTIONS,no_abbrevs,MAX_ABBREVS,
  3951.                    no_globals,globals_size,MAX_STATIC_DATA,
  3952.                    no_symbols,MAX_SYMBOLS,no_routines,MAX_ROUTINES,
  3953.                    total_chars_trans,total_bytes_trans,rate,k_long,k_str);
  3954.         }
  3955.     }
  3956.     if (offsets_mode==1)
  3957.     {   if ((pass_number==2)||(bothpasses_mode==1))
  3958.         {   printf(
  3959. "\nOffsets in story file:\n\
  3960. %04x Synonyms     %04x Defaults     %04x Objects    %04x Properties\n\
  3961. %04x Variables    %04x Parse table  %04x Actions    %04x Preactions\n\
  3962. %04x Adjectives   %04x Dictionary   %04x Code       %04x Strings\n\n",
  3963.                    synsat, glpat, objat, propat, vars, parsat, actshere, preactshere,
  3964.                    adjectives_offset, dict, code, strs);
  3965.         }
  3966.     }
  3967.     if (percentages_mode==1)
  3968.     {   if ((pass_number==2)||(bothpasses_mode==1))
  3969.         {   printf("Approximate percentage breakdown of story file:\n");
  3970.             percentage("Z-code",code_length,Out_Size);
  3971.             percentage("Static strings",strings_length,Out_Size);
  3972.             percentage("Dictionary",code-dict,Out_Size);
  3973.             percentage("Objects",vars-glpat,Out_Size);
  3974.             percentage("Globals",parsat-vars,Out_Size);
  3975.             percentage("Parsing tables",dict-parsat,Out_Size);
  3976.             percentage("Header and synonyms",glpat,Out_Size);
  3977.             percentage("Total of save area",parsat,Out_Size);
  3978.             percentage("Total of text",total_bytes_trans,Out_Size);
  3979.         }
  3980.     }
  3981.     if (frequencies_mode==1)
  3982.     {   if ((pass_number==2)||(bothpasses_mode==1))
  3983.         {   printf("How frequently abbreviations were used, and rough measure\n");
  3984.             printf("of how many bytes each saved:\n");
  3985.             for (i=0; i<no_abbrevs; i++)
  3986.             {   printf("%5d  %5d %10s  ",abbrev_freqs[i],
  3987.                     2*(abbrev_freqs[i]*abbrev_quality[i])/3,
  3988.                     abbreviations_at+i*MAX_ABBREV_LENGTH);
  3989.                 if ((i%3)==2) printf("\n");
  3990.             }
  3991.             if ((i%3)!=0) printf("\n");
  3992.             if (no_abbrevs==0) printf("None were declared.\n");
  3993.         }
  3994.     }
  3995.     if (((statistics_mode==1)||(economy_mode==1))&&(pass_number==2))
  3996.     {   printf("Essential size %d bytes: %d remaining\n",Out_Size,128*1024-Out_Size);
  3997.     }
  3998. }
  3999.  
  4000. /* -------------------------------------------------------------------------------- */
  4001. /*   Initialisation and main                                                        */
  4002. /* -------------------------------------------------------------------------------- */
  4003.  
  4004. void initialise(void)
  4005. {   
  4006.     abbreviations_at = my_malloc(MAX_ABBREVS*MAX_ABBREV_LENGTH,"abbreviations");
  4007.  
  4008.     zcode             =my_malloc(MAX_ZCODE_SIZE,"zcode");                zcode_p=zcode;
  4009.     dictionary        =my_malloc(7*MAX_DICT_ENTRIES+7,"dictionary");     dict_p=dictionary;
  4010.     output_p          =my_malloc(MAX_INITIAL_DATA_SIZE,"output buffer");
  4011.     strings           =my_malloc(MAX_STATIC_STRINGS,"static strings");   strings_p=strings;
  4012.     tokens            =my_malloc(2*BUFFER_LENGTH,"tokens");
  4013.     properties_table  =my_malloc(MAX_PROP_TABLE_SIZE,"properties table");
  4014.  
  4015.     symbols_p=NULL; symbols_top=symbols_p;
  4016.  
  4017.     stack_create();
  4018.  
  4019.     dictionary[0]=3; dictionary[1]='.'; dictionary[2]=','; dictionary[3]='"';
  4020.     dictionary[4]=7; dict_p=dictionary+7; dict_entries=0;
  4021.  
  4022.     globals_size=0x1e0;
  4023.     no_globals=0;
  4024.  
  4025.     init_symbol_banks();
  4026.     no_symbols=0;
  4027.  
  4028.     stockup_symbols();
  4029.  
  4030.     make_s_grid(); make_lookup();
  4031. }
  4032.  
  4033. void switches(char *p, int cmode)
  4034. {   int i;
  4035.     if (cmode==1)
  4036.     {   if (p[0]!='-')
  4037.         { printf("Ignoring second word which should be a -list of switches.\n"); return; }
  4038.     }
  4039.     for (i=cmode; p[i]!=0; i++)
  4040.     {   if (p[i]=='l') listing_mode=1;
  4041.         else if (p[i]=='a') listing_mode=2;
  4042.         else if (p[i]=='c') concise_mode=1;
  4043.         else if (p[i]=='e') economy_mode=1;
  4044.         else if (p[i]=='f') frequencies_mode=1;
  4045.         else if (p[i]=='i') ignoreswitches_mode=1;
  4046.         else if (p[i]=='s') statistics_mode=1;
  4047.         else if (p[i]=='t') tracing_mode=1;
  4048.         else if (p[i]=='o') offsets_mode=1;
  4049.         else if (p[i]=='m') memout_mode=1;
  4050.         else if (p[i]=='d') double_spaced=1;
  4051.         else if (p[i]=='b') { statistics_mode=1; bothpasses_mode=1; }
  4052.         else if (p[i]=='p') percentages_mode=1;
  4053.         else if (p[i]=='x') hash_mode=1;
  4054.         else if (p[i]=='w') nowarnings_mode=1;
  4055.         else if (p[i]=='h')
  4056.         {    printf(RELEASE_STRING); printf("\n");
  4057. #ifdef ALLOCATE_BIG_ARRAYS
  4058.     printf("(allocating memory for arrays) ");
  4059. #endif
  4060. #ifdef PROMPT_INPUT
  4061.     printf("(prompting input) ");
  4062. #endif
  4063. #ifdef USE_TEMPORARY_FILES
  4064.     printf("(temporary files) ");
  4065. #endif
  4066.   printf(
  4067. "\n\nThis program is a compiler to version-3 Infocom format story files.\n\
  4068. It is copyright (C) Graham Nelson, 1993.\n\n");
  4069. #ifndef PROMPT_INPUT
  4070.   printf("Its syntax is \"inform [-list] <file1> [<file2>]\"\n\n\
  4071. <file1> is the name of the Inform source file; Inform translates this into\n\
  4072.    \"");
  4073. printf(Source_Prefix); printf("<file1>"); printf(Source_Extension);
  4074. printf("\"\n\
  4075. (unless <file1> contains a '.' or '/', in which case it is left alone).\n\
  4076. <file2> may optionally be given as the name of the story file to make.\n\
  4077. If it isn't given, Inform writes to\n\
  4078.    \"");
  4079. printf(Code_Prefix); printf("<file1>"); printf(Code_Extension);
  4080. printf("\"\n\
  4081. but if it is, then Inform takes <file2> as the full filename.\n\n");
  4082. #endif
  4083.    printf("\
  4084. -list is an optional list of switch letters following the initial hyphen:\n\
  4085.   a   list assembly-level instructions compiled\n\
  4086.   b   give statistics after both passes\n\
  4087.   c   more concise error messages\n\
  4088.   d   contract double spaces after full stops in text\n\
  4089.   e   economy mode (slower): make use of declared abbreviations\n\
  4090.   f   frequencies mode: show how useful abbreviations are\n\
  4091.   h   print this information\n\
  4092.   i   ignore default switches set within the file\n\
  4093.   l   list all assembly lines\n\
  4094.   m   say how much memory has been allocated\n\
  4095.   o   print offset addresses\n\
  4096.   p   give percentage breakdown of story file\n\
  4097.   s   give statistics\n\
  4098.   t   trace Z-code assembly\n\
  4099.   w   disable warning messages\n\
  4100.   x   print # for every 100 lines compiled (in both passes)\n\n");
  4101. #ifndef PROMPT_INPUT
  4102.     printf("For example: \"inform -dex curses ram:curses\".\n");
  4103. #endif
  4104.         }
  4105.         else { printf("Switch \"-%c\" unknown (try \"inform -h\" for help)\n",p[i]); break; }
  4106.     }
  4107. }
  4108.  
  4109. void banner()
  4110. {
  4111. #ifdef MACHINE_STRING
  4112.     printf(MACHINE_STRING); printf(" ");
  4113. #endif
  4114.     printf("Inform 1.0 (v%d/",VNUMBER);
  4115. #ifdef ALLOCATE_BIG_ARRAYS
  4116.     printf("a");
  4117. #endif
  4118. #ifdef PROMPT_INPUT
  4119.     printf("p");
  4120. #endif
  4121. #ifdef USE_TEMPORARY_FILES
  4122.     printf("t");
  4123. #endif
  4124. #ifdef TIME_UNAVAILABLE
  4125.     printf("u");
  4126. #endif
  4127.     printf(")\n");
  4128. }
  4129.  
  4130. void trace_line(int origin)
  4131. {   int i; char b[BUFFER_LENGTH];
  4132.     word(b,1);
  4133.     if ((ltrace_mode==1)||(b[0]=='@')||(b[0]=='.')||(b[0]=='[')||(b[0]==']'))
  4134.     {   printf("%4d%s   ",current_source_line(),(origin==0)?" ":"*");
  4135.         i=1; do { word(b,i++); printf("%s ",b); } while (b[0]!=0);
  4136.         printf("\n");
  4137.     }
  4138. }
  4139.  
  4140. int main(int argc, char **argv)
  4141. {   char *story_name="source", *code_name="output"; int origin, t1, t2, i, flag=0;
  4142. #ifdef PROMPT_INPUT
  4143.     char buffer1[100], buffer2[100], buffer3[100];
  4144. #endif
  4145.  
  4146.     t1=time(0);
  4147.  
  4148.     banner();
  4149.  
  4150. #ifdef PROMPT_INPUT
  4151.     i=0;
  4152.     printf("Source filename?\n> ");
  4153.     while (gets(buffer1)==NULL); story_name=buffer1;
  4154.     printf("Output filename (RETURN for the same)?\n> ");
  4155.     while (gets(buffer2)==NULL); code_name=buffer2;
  4156.     if (buffer2[0]!=0) flag=1;
  4157.     do
  4158.     {   printf("List of switches (RETURN to finish; \"h\" for help)?\n> ");
  4159.         while (gets(buffer3)==NULL); switches(buffer3,0);
  4160.     } while (buffer3[0]!=0);
  4161. #else
  4162.     if (argc==1) { switches("-h",1); return(0); }
  4163.     i=1; while ((*(argv[i]))=='-') switches(argv[i++],1);
  4164.     if (argc==i) { printf("[No input file named.]\n"); return(0); }
  4165.     story_name=argv[i++];
  4166.     if (argc==i) { flag=0; } else { flag=1; code_name=argv[i]; }
  4167.     if (argc>i+1)
  4168.     { printf("Ignoring rest of command line (only first %d words used)\n",i+1); }
  4169. #endif
  4170.  
  4171.     allocate_the_arrays();
  4172.  
  4173.     if (flag==0)
  4174.     {   sprintf(Code_Name,"%s%s%s",Code_Prefix,story_name,Code_Extension); }
  4175.     else
  4176.     {   sprintf(Code_Name,"%s",code_name); }
  4177.  
  4178.     initialise();
  4179.  
  4180.     for (pass_number=1; pass_number<=2; pass_number++)
  4181.     {   input_file = 0;
  4182.         load_sourcefile(story_name);
  4183.         begin_pass();
  4184.         dictionary_startpass();
  4185.         do
  4186.         {   origin=get_next_line();
  4187.             if (origin==0) strcpy(forerrors_buff,buffer);
  4188.             tokenise_line();
  4189.             if (ltrace_mode>=1) trace_line(origin);
  4190.             parse_line();
  4191.  
  4192.         } while (endofpass_flag==0);
  4193.         if (hash_mode==1) printf("\n");
  4194. #ifdef USE_TEMPORARY_FILES
  4195.         zcode_p=utf_zcode_p;
  4196. #endif
  4197.         construct_storyfile();
  4198.     }
  4199.     if (no_errors==0) output_file();
  4200.  
  4201.     t2=time(0)-t1;
  4202.  
  4203.     if (memout_mode==1)
  4204.     {   printf("Static strings table used %d\n", subtract_pointers(strings_p,strings));
  4205.         printf("Output buffer used %d\n",        Write_Code_At);
  4206.         printf("Code area table used %d\n",      subtract_pointers(zcode_p,zcode));
  4207.         printf("Properties table used %d\n",     properties_size);
  4208. #ifdef USE_TEMPORARY_FILES
  4209.         printf("(NB: strings and code area can safely be larger than allocation)\n");
  4210. #endif
  4211.         printf("Allocated a total of %d bytes of memory\n",malloced_bytes); }
  4212.     if ((no_errors+no_warnings)!=0)
  4213.         printf("Compiled with %d error%s and %d warning%s%s\n",
  4214.             no_errors,(no_errors==1)?"":"s",
  4215.             no_warnings,(no_warnings==1)?"":"s",
  4216.             (no_errors>0)?" (no output)":"");
  4217.     if (statistics_mode==1)
  4218.         printf("Completed in %d seconds.\n",t2);
  4219.     if (no_errors!=0) return(1);
  4220.  
  4221. #ifdef ARC_PROFILING
  4222.     _fmapstore("ram:profile");
  4223. #endif
  4224.  
  4225.     return(0);
  4226. }
  4227.  
  4228. /* -------------------------------------------------------------------------------- */
  4229. /*   End of code                                                                    */
  4230. /* -------------------------------------------------------------------------------- */
  4231.