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