/* Interpretation of Xconq GDL.
   Copyright (C) 1989, 1991-1999 Stanley T. Shebs.

Xconq is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.  See the file COPYING.  */

/* Syntax is el cheapo Lisp. */

#include "conq.h"
extern int lookup_action_type(char *name);
extern void interp_utype_list(short *arr, Obj *lis);
extern void interp_short_array(short *arr, Obj *lis, int n);
extern void interp_long_array(long *arr, Obj *lis, int n);
extern int eval_number(Obj *val, int *isnumber);
extern int warnings_suppressed;
extern int warnings_logged;
extern void log_warning(char *typ, char *str);
#include "kernel.h"
#include "imf.h"

extern void interp_utype_value_list(short *arr, Obj *lis);
extern void interp_mtype_value_list(short *arr, Obj *lis);
extern void interp_atype_value_list(short *arr, Obj *lis);
extern void read_layer(Obj *contents, void (*setter)(int, int, int));
extern void read_rle(Obj *contents, void (*setter)(int, int, int),
		     short *chartable);

extern int actually_read_lisp;

static void module_and_line(Module *module, char *buf);
static void init_constant(int key, int val);
static void init_self_eval(int key);
static void useless_form_warning(Module *module, Obj *form);
static void include_module(Obj *form, Module *module);
static void start_conditional(Obj *form, Module *module);
static void start_else(Obj *form, Module *module);
static void end_conditional(Obj *form, Module *module);
static Variant *interp_variant_defns(Obj *lis);
static void interp_utype(Obj *form);
static void fill_in_utype(int u, Obj *list);
static int set_utype_property(int u, char *propname, Obj *val);
static void interp_mtype(Obj *form);
static void fill_in_mtype(int m, Obj *list);
static void interp_ttype(Obj *form);
static void fill_in_ttype(int t, Obj *list);
static void interp_atype(Obj *form);
static void fill_in_atype(int s, Obj *list);

static void interp_table(Obj *form);
static void add_to_table(Obj *tablename, int tbl, Obj *clauses);
static void interp_one_clause(Obj *tablename, int tbl, int lim1, int lim2,
			      Obj *indexes1, Obj *indexes2, Obj *values);
static void interp_variable(Obj *form, int isnew);
static void undefine_variable(Obj *form);
static void add_properties(Obj *form);
static int list_lengths_match(Obj *types, Obj *values, char *formtype,
			      Obj *form);
static void add_to_utypes(Obj *types, Obj *prop, Obj *values);
static void add_to_mtypes(Obj *types, Obj *prop, Obj *values);
static void add_to_ttypes(Obj *types, Obj *prop, Obj *values);
static void add_to_atypes(Obj *types, Obj *prop, Obj *values);
static void interp_world(Obj *form);
static void interp_area(Obj *form);
static void add_to_area(Obj *form);
static void fill_in_terrain(Obj *contents);
static void fill_in_aux_terrain(Obj *contents);
static void fill_in_people_sides(Obj *contents);
static void fill_in_control_sides(Obj *contents);
static void fill_in_features(Obj *contents);
static void fill_in_elevations(Obj *contents);
static void fill_in_cell_material(Obj *contents);
static void fill_in_temperatures(Obj *contents);
static void fill_in_winds(Obj *contents);
static void fill_in_clouds(Obj *contents);
static void fill_in_cloud_bottoms(Obj *contents);
static void fill_in_cloud_heights(Obj *contents);
static void fill_in_users(Obj *contents);

static void interp_side(Obj *form, Side *side);
static void interp_standing_order(Side *side, Obj *form);
static void check_name_uniqueness(Side *side, char *str, char *kind);
static void merge_unit_namers(Side *side, Obj *lis);
static void interp_side_value_list(short *arr, Obj *lis);
static void interp_side_mask_list(SideMask *mask, Obj *lis);
static void interp_atkstats_list(Side *side, Obj *lis);
static void interp_hitstats_list(Side *side, Obj *lis);
static void read_view_layer(Side *side, Obj *contents,
			    void (*setter)(int, int, int));
static void read_aux_terrain_view_layer(Side *side, Obj *contents,
					void (*setter)(int, int, int));
static void read_material_view_layer(Side *side, Obj *contents,
				     void (*setter)(int, int, int));
static void read_general_doctrine(Side *side, Obj *props);
static void read_utype_doctrine(Side *side, Obj *list);
static void interp_doctrine(Obj *form);
static void fill_in_doctrine(struct a_doctrine *doctrine, Obj *props);
static void interp_player(Obj *form);
static void fill_in_player(struct a_player *player, Obj *props);
static void interp_agreement(Obj *form);
static void interp_unit_defaults(Obj *form);
static Unit *interp_unit(Obj *form);
static Obj *find_unit_spec_by_name(char *name);
static Obj *find_unit_spec_by_number(int num);
static void interp_action(Action *action, Obj *props);
static void interp_unit_plan(Unit *unit, Obj *props);
static Task *interp_task(Obj *form);
static Goal *interp_goal(Obj *form);
static void interp_namer(Obj *form);
static void interp_text_generator(Obj *form);
static void interp_scorekeeper(Obj *form);
static void interp_history(Obj *form);
static void interp_past_unit(Obj *form);

static void too_many_types(char *typename, int maxnum, Obj *name);
static void unknown_property(char *type, char *inst, char *name);

/* This is the module from which forms are being read and
   interpreted, if they are coming from a module. */

Module *curmodule;

Obj *cond_read_stack;

/* True if game will start up in the middle of a turn. */

int midturnrestore = FALSE;

/* The count of cells that did not have valid terrain data. */

int numbadterrain = 0;

/* True if should warn about bad terrain. */

int warnbadterrain = TRUE;

char *readerrbuf;

/* This is the list of side defaults that will be applied
   to all sides read subsequently. */

Obj *side_defaults;

/* Defaults to use for filling in unit properties. */

int uxoffset = 0, uyoffset = 0;

static short default_unit_side_number = -1;

static short default_unit_origside_number = -1;

static short default_unit_cp = -1;

static short default_unit_hp = -1;

static short default_unit_cxp = -1;

static short default_unit_z = -1;

static short default_transport_id = -1;

static Obj *default_unit_hook;

static short *default_supply;

static short *default_tooling;

Obj *unit_specs;

Obj *last_unit_spec;

Obj *default_unit_spec;

/* Globals used to communicate with the RLE reader. */

short layer_use_default;
int layer_default;
int layer_multiplier;
int layer_adder;
short layer_area_x, layer_area_y;
short layer_area_w, layer_area_h;

int ignore_specials;

/* This is the table of keywords. */

struct a_key {
    char *name;
    short key;
} keywordtable[] = {

#undef  DEF_KWD
#define DEF_KWD(NAME,CODE)  { NAME, CODE },

#include "keyword.def"

    { NULL, 0 }
};

/* Given a string, return the enum of the matching keyword,
   if found, else -1. */

int
keyword_code(str)
char *str;
{
    int i;

    /* (should do a binary search first, then switch to exhaustive) */
    for (i = 0; keywordtable[i].name != NULL; ++i) {
	if (strcmp(str, keywordtable[i].name) == 0)
	  return keywordtable[i].key;
    }
    return (-1);
}

char *
keyword_name(k)
enum keywords k;
{
    return keywordtable[k].name;
}

#define TYPEPROP(TYPES, N, DEFNS, I, TYPE)  \
  ((TYPE *) &(((char *) (&(TYPES[N])))[DEFNS[I].offset]))[0]

/* This is a generic syntax check and escape. */

#define SYNTAX(X,TEST,MSG)  \
  if (!(TEST)) {  \
      syntax_error((X), (MSG));  \
      return;  \
  }
  
#define SYNTAX_RETURN(X,TEST,MSG,RET)  \
  if (!(TEST)) {  \
      syntax_error((X), (MSG));  \
      return (RET);  \
  }

void  
syntax_error(x, msg)
Obj *x;
char *msg;
{
    sprintlisp(readerrbuf, x, BUFSIZE);
    read_warning("syntax error in `%s' - %s", readerrbuf, msg);
}

/* This is specifically for typechecking. */

#define TYPECHECK(PRED,X,MSG)  \
  if (!PRED(X)) {  \
      type_error((X), (MSG));  \
      return;  \
  }

#define TYPECHECK_RETURN(PRED,X,MSG,RET)  \
  if (!PRED(X)) {  \
      type_error((X), (MSG));  \
      return (RET);  \
  }

void
type_error(Obj *x, char *msg)
{
    sprintlisp(readerrbuf, x, BUFSIZE);
    read_warning("type error in `%s' - %s", readerrbuf, msg);
}

/* Parse the (propertyname value) lists that most forms use. */

#define PARSE_PROPERTY(BDG,NAME,VAL)  \
  SYNTAX(BDG, (consp(BDG) && symbolp(car(BDG))), "property binding");  \
  (NAME) = c_string(car(BDG));  \
  (VAL) = cadr(BDG);

#define PARSE_PROPERTY_RETURN(BDG,NAME,VAL,RET)  \
  SYNTAX_RETURN(BDG, (consp(BDG) && symbolp(car(BDG))), "property binding", (RET));  \
  (NAME) = c_string(car(BDG));  \
  (VAL) = cadr(BDG);

static void
module_and_line(Module *module, char *buf)
{
    if (module) {
	if (module->startlineno != module->endlineno) {
	    sprintf(buf, "%s:%d-%d: ",
		    module->name, module->startlineno, module->endlineno);
	} else {
	    sprintf(buf, "%s:%d: ",
		    module->name, module->startlineno);
	}
    } else {
	buf[0] = '\0';
    }
}

static void
init_constant(int key, int val)
{
    Obj *sym = intern_symbol(keyword_name(key));

    setq(sym, new_number(val));
    flag_as_constant(sym);
}

static void
init_self_eval(int key)
{
    Obj *sym = intern_symbol(keyword_name(key));

    setq(sym, sym);
    flag_as_constant(sym);
}

void
init_predefined_symbols(void)
{
    int m;

    /* Predefined constants. */
    init_constant(K_FALSE, 0);
    init_constant(K_TRUE, 1);
    init_constant(K_NON_UNIT, -1);
    init_constant(K_NON_MATERIAL, -1);
    init_constant(K_NON_TERRAIN, -1);
    init_constant(K_CELL, 0);
    init_constant(K_BORDER, 1);
    init_constant(K_CONNECTION, 2);
    init_constant(K_COATING, 3);
    init_constant(K_RIVER_X, 10);
    init_constant(K_VALLEY_X, 11);
    init_constant(K_ROAD_X, 12);
    init_constant(K_OVER_NOTHING, 0);
    init_constant(K_OVER_OWN, 1);
    init_constant(K_OVER_BORDER, 2);
    init_constant(K_OVER_ALL, 3);
    init_constant(K_WIN, 1);
    init_constant(K_LOSE, -1);
    init_constant(K_DRAW, 0);
    /* Random self-evaluating symbols. */
    init_self_eval(K_AND);
    init_self_eval(K_OR);
    init_self_eval(K_NOT);
    init_self_eval(K_REJECT);
    init_self_eval(K_RESET);
    init_self_eval(K_USUAL);
    /* Leave these unbound so that first ref computes correct list. */
    intern_symbol(keyword_name(K_USTAR));
    intern_symbol(keyword_name(K_MSTAR));
    intern_symbol(keyword_name(K_TSTAR));
    intern_symbol(keyword_name(K_ASTAR));

    /* These just need to be inited somewhere before reading. */
    side_defaults = lispnil;
    unit_specs = last_unit_spec = lispnil;
    default_unit_spec = lispnil;
    /* Same for this. */
    /* (Can't use nummtypes because not set up yet.) */
    if (default_supply == NULL) {
	default_supply = (short *) xmalloc(MAXMTYPES * sizeof(short));
	for (m = 0; m < MAXMTYPES; ++m)
	  default_supply[m] = -1;
    }
    /* And for this. */
    if (readerrbuf == NULL)
      readerrbuf = (char *) xmalloc(BUFSIZE);
}

/* This is the basic interpreter of a form appearing in a module. */

void
interp_form(module, form)
Module *module;
Obj *form;
{
    Obj *thecar;
    char *name;

    /* Put the passed-in module into a global; for use in error messages. */
    curmodule = module;
    if (consp(form) && symbolp(thecar = car(form))) {
	name = c_string(thecar);
	if (Debug) {
	    /* If in a module, report the line number(s) of a form. */
	    if (module != NULL) {
		Dprintf("Line %d", module->startlineno);
		if (module->endlineno != module->startlineno)
		  Dprintf("-%d", module->endlineno);
	    }
	    Dprintf(": (%s ", name);
	    Dprintlisp(cadr(form));
	    if (cddr(form) != lispnil) {
		Dprintf(" ");
		Dprintlisp(caddr(form));
		if (cdddr(form) != lispnil)
		  Dprintf(" ...");
	    }
	    Dprintf(")\n");
	}
	switch (keyword_code(name)) {
	  case K_GAME_MODULE:
	    interp_game_module(form, module);
	    load_base_module(module);
	    break;
	  case K_UNIT_TYPE:
	    interp_utype(form);
	    break;
	  case K_MATERIAL_TYPE:
	    interp_mtype(form);
	    break;
	  case K_TERRAIN_TYPE:
	    interp_ttype(form);
	    break;
	  case K_ADVANCE_TYPE:
	    interp_atype(form);
	    break;
	  case K_TABLE:
	    interp_table(form);
	    break;
          case K_DEFINE:
	    interp_variable(form, TRUE);
	    break;
	  case K_SET:
	    interp_variable(form, FALSE);
	    break;
	  case K_UNDEFINE:
	    undefine_variable(form);
	    break;
	  case K_ADD:
	    add_properties(form);
	    break;
	  case K_WORLD:
	    interp_world(form);
	    break;
	  case K_AREA:
	    interp_area(form);
	    break;
	  case K_SIDE:
	    interp_side(form, NULL);
	    break;
	  case K_SIDE_DEFAULTS:
	    side_defaults = cdr(form);
	    break;
	  case K_DOCTRINE:
	    interp_doctrine(form);
	    break;
	  case K_INDEPENDENT_UNITS:
	    interp_side(form, indepside);
	    break;
	  case K_PLAYER:
	    interp_player(form);
	    break;
	  case K_AGREEMENT:
	    interp_agreement(form);
	    break;
	  case K_SCOREKEEPER:
	    interp_scorekeeper(form);
	    break;
	  case K_EVT:
	    interp_history(form);
	    break;
	  case K_EXU:
	    interp_past_unit(form);
	    break;
	  case K_UNIT:
	    /* We must have some unit types! */
	    if (numutypes == 0)
	      load_default_game();
	    interp_unit(cdr(form));
	    break;
	  case K_UNIT_DEFAULTS:
	    interp_unit_defaults(cdr(form));
	    break;
	  case K_NAMER:
	    interp_namer(form);
	    break;
	  case K_TEXT:
	    interp_text_generator(form);
	    break;
	  case K_IMF:
	    interp_imf(form);
	    break;
	  case K_PALETTE:
	    interp_palette(form);
	    break;
	  case K_INCLUDE:
	    include_module(form, module);
	    break;
	  case K_IF:
	    start_conditional(form, module);
	    break;
	  case K_ELSE:
	    start_else(form, module);
	    break;
	  case K_END_IF:
	    end_conditional(form, module);
	    break;
	  case K_PRINT:
	    print_form(cadr(form));
	    break;
	  default:
	    if (numutypes == 0)
	      load_default_game();
	    if ((boundp(thecar) && utypep(symbol_value(thecar)))
		|| utype_from_name(name) != NONUTYPE) {
		interp_unit(form);
	    } else {
		useless_form_warning(module, form);
	    }
	}
    } else {
	useless_form_warning(module, form);
    }
}

static void
useless_form_warning(module, form)
Module *module;
Obj *form;
{
    char posbuf[BUFSIZE], buf[BUFSIZE];

    if (!actually_read_lisp)
      return;
    module_and_line(module, posbuf);
    sprintlisp(buf, form, BUFSIZE);
    init_warning("%sA useless form: %s", posbuf, buf);
}

/* Inclusion is half-module-like, not strictly textual. */

static void
include_module(form, module)
Obj *form;
Module *module;
{
    char *name;
    Obj *mname = cadr(form);
    Module *submodule;

    SYNTAX(mname, (symbolp(mname) || stringp(mname)),
	   "included module name not a string or symbol");
    name = c_string(mname);
    Dprintf("Including \"%s\" ...\n", name);
    submodule = add_game_module(name, module);
    load_game_module(submodule, TRUE);
    if (submodule->loaded) {
    	do_module_variants(submodule, cddr(form));
    } 
    Dprintf("... Done including \"%s\".\n", name);
}

static void
start_conditional(form, module)
Obj *form;
Module *module;
{
    Obj *testform, *rslt;

    testform = cadr(form);
    rslt = eval(testform);
    if (numberp(rslt) && c_number(rslt) == 1) {
	actually_read_lisp = TRUE;
    } else {
	actually_read_lisp = FALSE;
    }
}

static void
start_else(form, module)
Obj *form;
Module *module;
{
    /* (should match up with cond read stack) */
    actually_read_lisp = !actually_read_lisp;
}

static void
end_conditional(form, module)
Obj *form;
Module *module;
{
    /* should match up with cond read stack */
    actually_read_lisp = TRUE;
}

/* Given a list of variant-defining forms, allocate and return an
   array of variant objects. */

static Variant *
interp_variant_defns(lis)
Obj *lis;
{
    int i = 0, len;
    Obj *varrest, *vardef, *varhead;
    Variant *varray, *var;

    if (lis == lispnil)
      return NULL;
    len = length(lis);
    varray = (Variant *) xmalloc((len + 1) * sizeof(Variant));
    i = 0;
    for_all_list(lis, varrest) {
	vardef = car(varrest);
	var = varray + i;
	var->id = var->dflt = var->range = var->cases = lispnil;
	if (symbolp(vardef)) {
	    var->id = vardef;
	    /* Make the variant's name be the same as its symbol. */
	    var->name = c_string(var->id);
	} else if (consp(vardef)) {
	    varhead = car(vardef);
	    /* If a string is at the front, it is a name to use in the
	       interface - peel off and record. */
	    if (stringp(varhead)) {
		var->name = c_string(varhead);
		vardef = cdr(vardef);
	    }
	    varhead = car(vardef);
	    if (symbolp(varhead)) {
		var->id = varhead;
		if (var->name == NULL)
		  var->name = c_string(var->id);
		vardef = cdr(vardef);
	    } else {
		read_warning("variant with no symbol (#%d), ignoring",
			     len - length(varrest));
		/* Go to next list element, leaving i unchanged. */
		continue;
	    }
	    /* Pick up a default value if specified. */
	    varhead = car(vardef);
	    if (!consp(varhead)) {
	    	var->dflt = varhead;
	    	vardef = cdr(vardef);
	    } else if (match_keyword(var->id, K_WORLD_SIZE)) {
	    	var->dflt = varhead;
	    	vardef = cdr(vardef);
	    } else if (match_keyword(var->id, K_REAL_TIME)) {
	    	var->dflt = varhead;
	    	vardef = cdr(vardef);
	    }
	    /* (should recognize and pick up a range spec if present) */
	    /* Case clauses are everything that's left over. */
	    var->cases = vardef;
	} else {
	    read_warning("bad variant (#%d), ignoring", len - length(varrest));
	    /* Go to next list element, leaving i unchanged. */
	    continue;
	}
	/* Add standard text for standard variants. */
	if (match_keyword(var->id, K_WORLD_SEEN)
	    && strcmp(c_string(var->id), var->name) == 0) {
	    var->name = "World Seen";
	    /* (should add variant help here also) */
	} else if (match_keyword(var->id, K_SEE_ALL)
		   && strcmp(c_string(var->id), var->name) == 0) {
	    var->name = "See All";
	} else if (match_keyword(var->id, K_SEQUENTIAL)
		   && strcmp(c_string(var->id), var->name) == 0) {
	    var->name = "Sequential";
	}
	++i;
    }
    /* Terminate the array with an id that never appears otherwise. */
    varray[i].id = lispnil;
    return varray;
}

/* Digest the form defining the module as a whole. */

void
interp_game_module(form, module)
Obj *form;
Module *module;
{
    char *name = NULL, *propname, *strval = NULL;
    Obj *props = cdr(form), *bdg, *propval;

    /* This can't work if the form appears out of context (such as when
       typed in), so just escape. */
    if (module == NULL)
      return;
    /* Collect and set the module name if supplied by this form. */
    if (stringp(car(props))) {
	name = c_string(car(props));
	props = cdr(props);
    }
    if (name != NULL) {
	if (empty_string(module->name)) {
	    module->name = name;
	} else {
	    if (strcmp(name, module->name) != 0) {
		read_warning("Module name `%s' does not match declared name `%s', ignoring declared name",
			     module->name, name);
	    }
	}
    }
    for (; props != lispnil; props = cdr(props)) {
	bdg = car(props);
	PARSE_PROPERTY(bdg, propname, propval);
	if (stringp(propval))
	  strval = c_string(propval);
	switch (keyword_code(propname)) {
	  case K_TITLE:
	    module->title = strval;
	    break;
	  case K_BLURB:
	    module->blurb = strval;
	    break;
	  case K_PICTURE_NAME:
	    module->picturename = strval;
	    break;
	  case K_BASE_MODULE:
	    module->basemodulename = strval;
	    break;
	  case K_DEFAULT_BASE_MODULE:
	    module->defaultbasemodulename = strval;
	    break;
	  case K_BASE_GAME:
	    module->basegame = strval;
	    break;
	  case K_INSTRUCTIONS:
	    /* The instructions are a list of strings. */
	    module->instructions = propval;
	    break;
	  case K_VARIANTS:
	    module->variants = interp_variant_defns(cdr(bdg));
	    break;
	  case K_NOTES:
	    /* The player notes are a list of strings. */
	    module->notes = propval;
	    break;
	  case K_DESIGN_NOTES:
	    /* The design notes are a list of strings. */
	    module->designnotes = propval;
	    break;
	  case K_VERSION:
	    module->version = strval;
	    break;
	  case K_PROGRAM_VERSION:
	    module->programversion = strval;
	    break;
	  case K_ORIGINAL_MODULE:
	    module->origmodulename = strval;
	    break;
	  case K_ORIGINAL_VARIANTS:
	    module->origvariants = interp_variant_defns(cdr(bdg));
	    break;
	  case K_ORIGINAL_VERSION:
	    module->origversion = strval;
	    break;
	  default:
	    unknown_property("game module", module->name, propname);
	}
    }
    /* Should be smarter about earlier vs later versions. */
    if (!empty_string(module->programversion)
	&& strcmp(module->programversion, version_string()) != 0) {
	/* This should become some sort of alert on some systems. */
	read_warning("The module `%s' is claimed to be for Xconq version `%s', but you are actually running version `%s'",
		     module->name, module->programversion, version_string());
    }
}

/* Create a new type of unit and fill in info about it. */

static void
interp_utype(form)
Obj *form;
{
    int u;
    Obj *name = cadr(form), *utype;

    TYPECHECK(symbolp, name, "unit-type name not a symbol");
    if (!canaddutype)
      read_warning("Should not be defining more unit types");
    if (numutypes < MAXUTYPES) {
	u = numutypes++;
	utype = new_utype(u);
	/* Set default values for the unit type's props first. */
	/* Any default type name shouldn't confuse the code below. */
	default_unit_type(u);
	setq(name, utype);
	/* Set the values of random props. */
	fill_in_utype(u, cddr(form));
	/* If no internal type name string given, use the defined name. */
	if (empty_string(u_internal_name(u))) {
	    set_u_internal_name(u, c_string(name));
	}
	if (empty_string(u_type_name(u))) {
	    set_u_type_name(u, u_internal_name(u));
	}
	/* If the official type name is different from the internal name,
	   make it a variable bound to the type. */ 
	if (strcmp(u_type_name(u), u_internal_name(u)) != 0) {
	    setq(intern_symbol(u_type_name(u)), utype);
	}
    } else {
	too_many_types("unit", MAXUTYPES, name);
    }
    /* Blast any cached list of types. */
    makunbound(intern_symbol(keyword_name(K_USTAR)));
    eval_symbol(intern_symbol(keyword_name(K_USTAR)));
}

/* Trudge through assorted properties, filling them in. */

static void
fill_in_utype(u, list)
int u;
Obj *list;
{
    char *propname;
    Obj *bdg, *val;

    for ( ; list != lispnil; list = cdr(list)) {
	bdg = car(list);
	PARSE_PROPERTY(bdg, propname, val);
	set_utype_property(u, propname, val);
    }
}

/* Given a unit type, property name, and a value, find the
   definition of the property and set its value. */

static int
set_utype_property(u, propname, val)
int u;
char *propname;
Obj *val;
{
    int i, found = FALSE, numval;
    char *strval;

    for (i = 0; utypedefns[i].name != NULL; ++i) {
	if (strcmp(propname, utypedefns[i].name) == 0) {
	    if (utypedefns[i].intgetter) {
		val = eval(val);
		if (!numberishp(val)) {
		    read_warning("unit type %s property %s value not a number",
				 u_type_name(u), utypedefns[i].name);
		    return TRUE;
		}
		numval = c_number(val);
		if (!between(utypedefns[i].lo, numval, utypedefns[i].hi)) {
		    read_warning("unit type %s property %s value %d not between %d and %d",
				 u_type_name(u), utypedefns[i].name, numval,
				 utypedefns[i].lo, utypedefns[i].hi);
		    /* Let it pass through, at least for now. */
		}
		TYPEPROP(utypes, u, utypedefns, i, short) = numval;
	    } else if (utypedefns[i].strgetter) {
		val = eval(val);
		if (!stringp(val)) {
		    read_warning("unit type %s property %s value not a string",
				 u_type_name(u), utypedefns[i].name);
		    return TRUE;
		}
		strval = c_string(val);
		TYPEPROP(utypes, u, utypedefns, i, char *) = strval;
	    } else {
		TYPEPROP(utypes, u, utypedefns, i, Obj *) = val;
	    }
	    found = TRUE;
	    break;
	}
    }
    if (!found)
      unknown_property("unit type", u_type_name(u), propname);
    return found;
}

/* Declare a new type of material and fill in info about it. */

static void
interp_mtype(form)
Obj *form;
{
    int m;
    Obj *name = cadr(form), *mtype;
    
    TYPECHECK(symbolp, name, "material-type name not a symbol");
    if (!canaddmtype)
      read_warning("Should not be defining more material types");
    if (nummtypes < MAXMTYPES) {
	m = nummtypes++;
	mtype = new_mtype(m);
	/* Set default values for the material type's properties first. */
	default_material_type(m);
	setq(name, mtype);
	/* Set the values of random props. */
	fill_in_mtype(m, cddr(form));
	/* If no type name string given, use the defined name. */
	if (empty_string(m_type_name(m))) {
	    set_m_type_name(m, c_string(name));
	}
    } else {
	too_many_types("material", MAXMTYPES, name);
    }
    /* Blast and remake any cached list of types. */
    makunbound(intern_symbol(keyword_name(K_MSTAR)));
    eval_symbol(intern_symbol(keyword_name(K_MSTAR)));
}

/* Declare a new type of advance and fill in info about it. */

static void
interp_atype(form)
Obj *form;
{
    int s;
    Obj *name = cadr(form), *atype;
    
    TYPECHECK(symbolp, name, "advance type name not a symbol");
    if (!canaddatype)
      read_warning("Should not be defining more advance types");
    if (numatypes < MAXATYPES) {
	s = numatypes++;
	atype = new_atype(s);
	/* Set default values for the material type's properties first. */
	default_advance_type(s);
	setq(name, atype);
	/* Set the values of random props. */
	fill_in_atype(s, cddr(form));
	/* If no type name string given, use the defined name. */
	if (empty_string(a_type_name(s))) {
	    set_a_type_name(s, c_string(name));
	}
    } else {
	too_many_types("advance", MAXATYPES, name);
    }
    /* Blast and remake any cached list of types. */
    makunbound(intern_symbol(keyword_name(K_ASTAR)));
    eval_symbol(intern_symbol(keyword_name(K_ASTAR)));
}

/* Go through a list of prop name/value pairs and fill in the
   material type description from them. */

static void
fill_in_mtype(m, list)
int m;
Obj *list;
{
    int i, found, numval;
    char *strval;
    Obj *bdg, *val;
    char *propname;

    for ( ; list != lispnil; list = cdr(list)) {
	bdg = car(list);
	PARSE_PROPERTY(bdg, propname, val);
	found = FALSE;
	for (i = 0; mtypedefns[i].name != NULL; ++i) {
	    if (strcmp(propname, mtypedefns[i].name) == 0) {
		if (mtypedefns[i].intgetter) {
		    val = eval(val);
		    if (!numberishp(val)) {
			read_warning("material type %s property %s value not a number",
				     m_type_name(m), mtypedefns[i].name);
			return;
		    }
		    numval = c_number(val);
		    if (!between(mtypedefns[i].lo, numval, mtypedefns[i].hi)) {
			read_warning("material type %s property %s value %d not between %d and %d",
				     m_type_name(m), mtypedefns[i].name, numval,
				     mtypedefns[i].lo, mtypedefns[i].hi);
			/* Let it pass through, at least for now. */
		    }
		    TYPEPROP(mtypes, m, mtypedefns, i, short) = numval;
		} else if (mtypedefns[i].strgetter) {
		    val = eval(val);
		    if (!stringp(val)) {
			read_warning("material type %s property %s value not a string",
				     m_type_name(m), mtypedefns[i].name);
			return;
		    }
		    strval = c_string(val);
		    TYPEPROP(mtypes, m, mtypedefns, i, char *) = strval;
		} else {
		    TYPEPROP(mtypes, m, mtypedefns, i, Obj *) = val;
		}
		found = TRUE;
		break;
	    }
	}
	if (!found)
	  unknown_property("material type", m_type_name(m), propname);
    }
}


/* Go through a list of prop name/value pairs and fill in the
   advance type description from them. */

static void
fill_in_atype(a, list)
int a;
Obj *list;
{
    int i, found, numval;
    char *strval;
    Obj *bdg, *val;
    char *propname;

    for ( ; list != lispnil; list = cdr(list)) {
	bdg = car(list);
	PARSE_PROPERTY(bdg, propname, val);
	found = FALSE;
	for (i = 0; atypedefns[i].name != NULL; ++i) {
	    if (strcmp(propname, atypedefns[i].name) == 0) {
		if (atypedefns[i].intgetter) {
		    val = eval(val);
		    if (!numberishp(val)) {
			read_warning("advance type %s property %s value not a number",
				     a_type_name(a), atypedefns[i].name);
			return;
		    }
		    numval = c_number(val);
		    if (!between(atypedefns[i].lo, numval, atypedefns[i].hi)) {
			read_warning("advance type %s property %s value %d not between %d and %d",
				     a_type_name(a), atypedefns[i].name, numval,
				     atypedefns[i].lo, atypedefns[i].hi);
			/* Let it pass through, at least for now. */
		    }
		    TYPEPROP(atypes, a, atypedefns, i, short) = numval;
		} else if (atypedefns[i].strgetter) {
		    val = eval(val);
		    if (!stringp(val)) {
			read_warning("advance type %s property %s value not a string",
				     a_type_name(a), atypedefns[i].name);
			return;
		    }
		    strval = c_string(val);
		    TYPEPROP(atypes, a, atypedefns, i, char *) = strval;
		} else {
		    TYPEPROP(atypes, a, atypedefns, i, Obj *) = val;
		}
		found = TRUE;
		break;
	    }
	}
	if (!found)
	  unknown_property("advance type", a_type_name(a), propname);
    }
}

/* Declare a new type of terrain and fill in info about it. */

static void
interp_ttype(form)
Obj *form;
{
    int t;
    Obj *name = cadr(form), *ttype;

    TYPECHECK(symbolp, name, "terrain-type name not a symbol");
    if (!canaddttype)
      read_warning("Should not be defining more terrain types");
    if (numttypes < MAXTTYPES) {
	t = numttypes++;
	ttype = new_ttype(t);
	/* Set default values for the terrain type's props first. */
	default_terrain_type(t);
	setq(name, ttype);
	/* Set the values of random properties. */
	fill_in_ttype(t, cddr(form));
	/* If no type name string given, use the defined name. */
	if (empty_string(t_type_name(t))) {
	    set_t_type_name(t, c_string(name));
	}
    } else {
	too_many_types("terrain", MAXTTYPES, name);
    }
    /* Blast and remake any cached list of all types. */
    makunbound(intern_symbol(keyword_name(K_TSTAR)));
    eval_symbol(intern_symbol(keyword_name(K_TSTAR)));
}

/* Go through a list of prop name/value pairs and fill in the
   terrain type description from them. */

static void
fill_in_ttype(t, list)
int t;
Obj *list;
{
    int i, found, numval;
    char *strval;
    char *propname;
    Obj *bdg, *val;

    for ( ; list != lispnil; list = cdr(list)) {
	bdg = car(list);
	PARSE_PROPERTY(bdg, propname, val);
	found = FALSE;
	for (i = 0; ttypedefns[i].name != NULL; ++i) {
	    if (strcmp(propname, ttypedefns[i].name) == 0) {
		if (ttypedefns[i].intgetter) {
		    val = eval(val);
		    if (!numberishp(val)) {
			read_warning("terrain type %s property %s value not a number",
				     t_type_name(t), ttypedefns[i].name);
			return;
		    }
		    numval = c_number(val);
		    if (!between(ttypedefns[i].lo, numval, ttypedefns[i].hi)) {
			read_warning("terrain type %s property %s value %d not between %d and %d",
				     t_type_name(t), ttypedefns[i].name, numval,
				     ttypedefns[i].lo, ttypedefns[i].hi);
			/* Let it pass through, at least for now. */
		    }
		    TYPEPROP(ttypes, t, ttypedefns, i, short) = numval;
		} else if (ttypedefns[i].strgetter) {
		    val = eval(val);
		    if (!stringp(val)) {
			read_warning("terrain type %s property %s value not a string",
				     t_type_name(t), ttypedefns[i].name);
			return;
		    }
		    strval = c_string(val);
		    TYPEPROP(ttypes, t, ttypedefns, i, char *) = strval;
		} else {
		    TYPEPROP(ttypes, t, ttypedefns, i, Obj *) = val;
		}
		found = TRUE;
		break;
	    }
	}
	if (!found)
	  unknown_property("terrain type", t_type_name(t), propname);
    }
    /* Recalculate the count of subtypes. */
    count_terrain_subtypes();
}

/* Fill in a table. */

static void
interp_table(form)
Obj *form;
{
    int i, found, reset = TRUE;
    Obj *formsym = cadr(form), *body = cddr(form);
    char *tablename;

    /* It's impossible to know whether all the types indexed by a
       specific table have been defined when the table form is
       evaluated, so don't try any heuristic tricks to load a
       default game here. */
    TYPECHECK(symbolp, formsym, "table name not a symbol");
    tablename = c_string(formsym);
    found = FALSE;
    /* Search in the list of tables for one with the given name. */
    for (i = 0; tabledefns[i].name != NULL; ++i) {
	if (strcmp(tablename, tabledefns[i].name) == 0) {
	    if (match_keyword(car(body), K_ADD)) {
		body = cdr(body);
		reset = FALSE;
	    }
	    allocate_table(i, reset);
	    add_to_table(formsym, i, body);
	    found = TRUE;
	    break;
	}
    }
    if (!found)
      read_warning( "Undefined table `%s'", tablename);
}

/* Given a table and a list of value-setting clauses, fill in the table. */

#define INDEXP(typ, x) \
  ((typ == UTYP) ? utypep(x) : ((typ == MTYP) ? mtypep(x) : ((typ == TTYP) ? ttypep(x) : atypep(x))))

#define nonlist(x) (!consp(x) && x != lispnil)

#define CHECK_INDEX_1(tbl, x)  \
  if (!INDEXP(tabledefns[tbl].index1, (x))) {  \
      char errbuf[BUFSIZE]; \
      sprintlisp(errbuf, (x), BUFSIZE); \
      read_warning("table %s index 1 value `%s' has wrong type, skipping clause",  \
		   tabledefns[tbl].name, errbuf);  \
      return;  \
  }

#define CHECK_INDEX_2(tbl, x)  \
  if (!INDEXP(tabledefns[tbl].index2, (x))) {  \
      char errbuf[BUFSIZE]; \
      sprintlisp(errbuf, (x), BUFSIZE); \
      read_warning("table %s index 2 value `%s' has wrong type, skipping clause",  \
		   tabledefns[tbl].name, errbuf);  \
      return;  \
  }

#define CHECK_VALUE(tbl, x)  \
  if (!numberishp(x)) {  \
      read_warning("table %s value is not a number, skipping clause",  \
		   tabledefns[tbl].name);  \
      return;  \
  } \
  { int checknum = c_number(x);  \
    if (!between(tabledefns[tbl].lo, checknum, tabledefns[tbl].hi)) {  \
	read_warning("table %s value %d not within bounds %d to %d, skipping clause",  \
		     tabledefns[tbl].name, checknum, tabledefns[tbl].lo, tabledefns[tbl].hi);  \
	return;  \
    }  \
  }

#define CHECK_LISTS(tablename, lis1, lis2)  \
  if (consp(lis2)  \
      && !list_lengths_match(lis1, lis2, "table", tablename))  {  \
      return;  \
  }


static void
add_to_table(tablename, tbl, clauses)
int tbl;
Obj *tablename, *clauses;
{
    int i, num, lim1, lim2;
    Obj *clause, *indexes1, *indexes2, *values;

    lim1 = numtypes_from_index_type(tabledefns[tbl].index1);
    lim2 = numtypes_from_index_type(tabledefns[tbl].index2);
    for ( ; clauses != lispnil; clauses = cdr(clauses)) {
	clause = car(clauses);
	switch (clause->type) {
	  case SYMBOL:
	    clause = eval_symbol(clause);
	    TYPECHECK(numberp, clause, "table clause does not eval to number");
	    /* Now treat it as a number. */
	  case NUMBER:
	    /* A constant value for the table - blast over everything. */
	    CHECK_VALUE(tbl, clause);
	    num = c_number(clause);
	    /* Make sure the table is allocated first. */
	    if (tabledefns[tbl].table == NULL)
	      allocate_table(tbl, TRUE);
	    for (i = 0; i < lim1 * lim2; ++i)
	      (*(tabledefns[tbl].table))[i] = num;
	    break;
	  case CONS:
	    /* Evaluate the three parts of a clause. */
	    indexes1 = eval(car(clause));
	    indexes2 = eval(cadr(clause));
	    values = eval(caddr(clause));
	    if (cdddr(clause) != lispnil) {
		sprintlisp(readerrbuf, clause, BUFSIZE);
		read_warning("In table `%s', extra junk at end of clause `%s', ignoring",
			     c_string(tablename), readerrbuf);
	    }
	    interp_one_clause(tablename, tbl, lim1, lim2,
			      indexes1, indexes2, values);
	    break;
	  case STRING:
	    break; /* error? */
	  default:
	    /* who knows? */
	    break;
	}
    }
}

static void
interp_one_clause(tablename, tbl, lim1, lim2, indexes1, indexes2, values)
Obj *tablename, *indexes1, *indexes2, *values;
int tbl, lim1, lim2;
{
    int i, j, num;
    Obj *tmp1, *tmp2, *in1, *in2, *value, *subvalue;

    if (nonlist(indexes1)) {
	CHECK_INDEX_1(tbl, indexes1);
	i = c_number(indexes1);
	if (nonlist(indexes2) ) {
	    CHECK_INDEX_2(tbl, indexes2);
	    j = c_number(indexes2);
	    value = values;
	    CHECK_VALUE(tbl, value);
	    num = c_number(value);
	    (*(tabledefns[tbl].table))[lim2 * i + j] = num;
	} else {
	    CHECK_LISTS(tablename, indexes2, values);
	    for_all_list(indexes2, tmp2) {
		in2 = car(tmp2);
		CHECK_INDEX_2(tbl, in2);
		j = c_number(in2);
		value = (consp(values) ? car(values) : values);
		CHECK_VALUE(tbl, value);
		num = c_number(value);
		(*(tabledefns[tbl].table))[lim2 * i + j] = num;
		if (consp(values))
		  values = cdr(values);
	    }
	}
    } else {
	CHECK_LISTS(tablename, indexes1, values);
	for_all_list(indexes1, tmp1) {
	    in1 = car(tmp1);
	    CHECK_INDEX_1(tbl, in1);
	    i = c_number(in1);
	    value = (consp(values) ? car(values) : values);
	    if (nonlist(indexes2)) {
		CHECK_INDEX_2(tbl, indexes2);
		j = c_number(indexes2);
		CHECK_VALUE(tbl, value);
		num = c_number(value);
		(*(tabledefns[tbl].table))[lim2 * i + j] = num;
	    } else {
		if (nonlist(value)) {
		    subvalue = value;
		    CHECK_VALUE(tbl, subvalue);
		    num = c_number(subvalue);
		    for_all_list(indexes2, tmp2) {
			in2 = car(tmp2);
			CHECK_INDEX_2(tbl, in2);
			j = c_number(in2);
			(*(tabledefns[tbl].table))[lim2 * i + j] = num;
		    }
		} else {
		    CHECK_LISTS(tablename, indexes2, value);
		    for_all_list(indexes2, tmp2) {
			in2 = car(tmp2);
			CHECK_INDEX_2(tbl, in2);
			j = c_number(in2);
			subvalue = car(value);
			CHECK_VALUE(tbl, subvalue);
			num = c_number(subvalue);
			(*(tabledefns[tbl].table))[lim2 * i + j] = num;
			value = cdr(value);
		    }
		}
	    }
	    if (consp(values))
	      values = cdr(values);
	}
    }
}

/* Set the binding of an existing known variable. */

static void
interp_variable(form, isnew)
Obj *form;
int isnew;
{
    int i, numval;
    Obj *var = cadr(form);
    Obj *val = eval(caddr(form));
    char *name;

    SYNTAX(form, symbolp(var), "variable is not a symbol");
    name = c_string(var);

    if (isnew) {
	if (boundp(var))
	  read_warning("Symbol `%s' has been bound already, overwriting", name);
	setq(var, val);
    } else {
	/* Look through the set of defined globals. */
	for (i = 0; vardefns[i].name != 0; ++i) {
	    if (strcmp(name, vardefns[i].name) == 0) {
		if (vardefns[i].intgetter != NULL) {
		    TYPECHECK(numberishp, val, "is not a number or type");
		    numval = c_number(val);
		    if (!between(vardefns[i].lo, numval, vardefns[i].hi)) {
			read_warning("global %s value %d not between %d and %d",
				     vardefns[i].name, numval,
				     vardefns[i].lo, vardefns[i].hi);
			/* Let it pass through, at least for now. */
		    }
		    (*(vardefns[i].intsetter))(numval);
		} else if (vardefns[i].strgetter != NULL) {
		    TYPECHECK(stringp, val, "is not a string");
		    (*(vardefns[i].strsetter))(c_string(val));
		} else if (vardefns[i].objgetter != NULL) {
		    (*(vardefns[i].objsetter))(val);
		} else {
		    abort();
		}
		return;
	    }
	}
	/* Try as a random symbol. */
	if (boundp(var)) {
	    setq(var, val);
	    return;
	}
	/* Out of luck. */
	read_warning("Can't set unknown global named `%s'", name);
    }
}

static void
undefine_variable(form)
Obj *form;
{
    Obj *var = cadr(form);

    if (!symbolp(var)) {
	read_warning("Can't undefine a non-symbol!");
	return;
    }
    makunbound(var);
}

/* General function to augment types. */

static void
add_properties(form)
Obj *form;
{
    Obj *rest, *types, *prop, *values;

    rest = cdr(form);
    types = eval(car(rest));
    rest = cdr(rest);
    prop = car(rest);
    SYNTAX(form, symbolp(prop), "not a property name in third position");
    rest = cdr(rest);
    SYNTAX(form, rest != lispnil, "no property values supplied");
    values = eval(car(rest));
    /* Complain about, but ignore, extra things. */
    if (cdr(rest) != lispnil) {
	sprintlisp(readerrbuf, form, BUFSIZE);
	read_warning("Extra junk at the end of `%s', ignoring", readerrbuf);
    }
    if (utypep(types) || (consp(types) && utypep(car(types)))) {
	add_to_utypes(types, prop, values);
    } else if (mtypep(types) || (consp(types) && mtypep(car(types)))) {
	add_to_mtypes(types, prop, values);
    } else if (ttypep(types) || (consp(types) && ttypep(car(types)))) {
	add_to_ttypes(types, prop, values);
    } else if (atypep(types) || (consp(types) && atypep(car(types)))) {
	add_to_atypes(types, prop, values);
    } else {
	sprintlisp(readerrbuf, form, BUFSIZE);
	read_warning("No types to add to in `%s'", readerrbuf);
    }
}

/* Compare a list of types with a list of values, complain if
   they don't match up. */

static int
list_lengths_match(types, values, formtype, form)
Obj *types, *values, *form;
char *formtype;
{
    if (length(types) != length(values)) {
	sprintlisp(spbuf, form, BUFSIZE);
	read_warning("Lists of differing lengths (%d vs %d) in %s `%s'",
		     length(types), length(values), formtype, spbuf);
	return FALSE;
    }
    return TRUE;
}

static void
add_to_utypes(types, prop, values)
Obj *types, *prop, *values;
{
    char *propname = c_string(prop);
    Obj *lis1, *lis2, *carlis1;

    if (utypep(types)) {
	set_utype_property(types->v.num, propname, values);
    } else if (consp(types)) {
	if (consp(values)) {
	    if (!list_lengths_match(types, values, "utype property", prop))
	      return;
	    for_both_lists(types, values, lis1, lis2) {
		carlis1 = car(lis1);
		TYPECHECK(utypep, carlis1, "not a unit type");
		if (!set_utype_property(carlis1->v.num, propname, car(lis2)))
		  break;
	    }
	} else {
	    for_all_list(types, lis1) {
		carlis1 = car(lis1);
		TYPECHECK(utypep, carlis1, "not a unit type");
		if (!set_utype_property(carlis1->v.num, propname, values))
		  break;
	    }
	}
    }
}

static void
add_to_mtypes(types, prop, values)
Obj *types, *prop, *values;
{
    Obj *lis1, *lis2, *carlis1;

    if (mtypep(types)) {
	fill_in_mtype(types->v.num,
		      cons(cons(prop, cons(values, lispnil)), lispnil));
    } else if (consp(types)) {
	if (consp(values)) {
	    if (!list_lengths_match(types, values, "mtype property", prop))
	      return;
	    for_both_lists(types, values, lis1, lis2) {
		carlis1 = car(lis1);
		TYPECHECK(mtypep, carlis1, "not a unit type");
		fill_in_mtype(carlis1->v.num,
			      cons(cons(prop, cons(car(lis2), lispnil)),
				   lispnil));
	    }
	} else {
	    for_all_list(types, lis1) {
		carlis1 = car(lis1);
		TYPECHECK(mtypep, carlis1, "not a material type");
		fill_in_mtype(carlis1->v.num,
			      cons(cons(prop, cons(values, lispnil)),
				   lispnil));
	    }
	}
    }
}

static void
add_to_ttypes(types, prop, values)
Obj *types, *prop, *values;
{
    Obj *lis1, *lis2, *carlis1;

    if (ttypep(types)) {
	fill_in_ttype(types->v.num,
		      cons(cons(prop, cons(values, lispnil)), lispnil));
    } else if (consp(types)) {
	if (consp(values)) {
	    if (!list_lengths_match(types, values, "ttype property", prop))
	      return;
	    for_both_lists(types, values, lis1, lis2) {
		carlis1 = car(lis1);
		TYPECHECK(ttypep, carlis1, "not a terrain type");
		fill_in_ttype(carlis1->v.num,
			      cons(cons(prop, cons(car(lis2), lispnil)),
				   lispnil));
	    }
	} else {
	    for_all_list(types, lis1) {
		carlis1 = car(lis1);
		TYPECHECK(ttypep, carlis1, "not a terrain type");
		fill_in_ttype(carlis1->v.num,
			      cons(cons(prop, cons(values, lispnil)),
				   lispnil));
	    }
	}
    }
}

static void
add_to_atypes(types, prop, values)
Obj *types, *prop, *values;
{
    Obj *lis1, *lis2, *carlis1;

    if (atypep(types)) {
	fill_in_atype(types->v.num,
		      cons(cons(prop, cons(values, lispnil)), lispnil));
    } else if (consp(types)) {
	if (consp(values)) {
	    if (!list_lengths_match(types, values, "atype property", prop))
	      return;
	    for_both_lists(types, values, lis1, lis2) {
		carlis1 = car(lis1);
		TYPECHECK(atypep, carlis1, "not an advance type");
		fill_in_atype(carlis1->v.num,
			      cons(cons(prop, cons(car(lis2), lispnil)),
				   lispnil));
	    }
	} else {
	    for_all_list(types, lis1) {
		carlis1 = car(lis1);
		TYPECHECK(atypep, carlis1, "not an advance type");
		fill_in_atype(carlis1->v.num,
			      cons(cons(prop, cons(values, lispnil)),
				   lispnil));
	    }
	}
    }
}

/* Interpret a world-specifying form. */

static void
interp_world(form)
Obj *form;
{
    int numval;
    Obj *props, *bdg, *propval;
    char *propname;

    props = cdr(form);
    if (symbolp(car(props))) {
	/* This is the id of the world (eventually). */
	props = cdr(props);
    }
    if (numberp(car(props))) {
    	set_world_circumference(c_number(car(props)), TRUE);
	props = cdr(props);
    }
    for ( ; props != lispnil; props = cdr(props)) {
	bdg = car(props);
	PARSE_PROPERTY(bdg, propname, propval);
	if (numberp(propval))
	  numval = c_number(propval);
	switch (keyword_code(propname)) {
	  case K_CIRCUMFERENCE:
	    set_world_circumference(numval, TRUE);
	    break;
	  case K_DAY_LENGTH:
	    world.daylength = numval;
	    break;
	  case K_YEAR_LENGTH:
	    world.yearlength = numval;
	    break;
	  case K_AXIAL_TILT:
	    world.axial_tilt = numval;
	    break;
	  case K_DAYLIGHT_FRACTION:
	    world.daylight_fraction = numval;
	    break;
	  case K_TWILIGHT_FRACTION:
	    world.twilight_fraction = numval;
	    break;
	  default:
	    unknown_property("world", "", propname);
	}
    }
}

/* Only one area, of fixed size.  Created anew if shape/size is supplied, else
   just modified. */

static void
interp_area(form)
Obj *form;
{
    int newarea = FALSE, newwidth = 0, newheight = 0, numval;
    Obj *props, *subprop, *bdg, *propval, *rest, *val;
    char *propname, *strval;

    props = cdr(form);
    if (match_keyword(car(props), K_ADD)) {
	add_to_area(cdr(props));
	return;
    }
    /* (eventually this will be an id or name) */
    if (symbolp(car(props))) {
	props = cdr(props);
	newarea = TRUE;
    }
    /* Collect the width of the area. */
    if (numberp(car(props))) {
	newwidth = newheight = c_number(car(props));
    	if (area.fullwidth == 0)
	  newarea = TRUE;
	if (area.fullwidth > 0 && area.fullwidth != newwidth)
	  read_warning("weird areas - %d vs %d", area.fullwidth, newwidth);
	props = cdr(props);
    }
    /* Collect the height of the area. */
    if (numberp(car(props))) {
	newheight = c_number(car(props));
    	if (area.fullheight == 0)
	  newarea = TRUE;
	if (area.fullheight > 0 && area.fullheight != newheight)
	  read_warning("weird areas - %d vs %d", area.fullheight, newheight);
	props = cdr(props);
    }
    /* See if we're restricting ourselves to a piece of a larger area. */
    if (consp(car(props))
        && match_keyword(car(car(props)), K_RESTRICT)) {
        subprop = cdr(car(props));
	val = car(subprop);
        if (numberp(val)) {
	    area.fullwidth = c_number(val);
	    subprop = cdr(subprop);
	    val = car(subprop);
	    TYPECHECK(numberp, val, "restriction parm not a number");
	    area.fullheight = c_number(val);
	    subprop = cdr(subprop);
	    val = car(subprop);
	    TYPECHECK(numberp, val, "restriction parm not a number");
	    area.fullx = c_number(val);
	    subprop = cdr(subprop);
	    val = car(subprop);
	    TYPECHECK(numberp, val, "restriction parm not a number");
	    area.fully = c_number(val);
        } else if (match_keyword(car(subprop), K_RESET)) {
	    area.fullwidth = area.fullheight = 0;
	    area.fullx = area.fully = 0;
        } else {
	    syntax_error(car(props), "not 4 numbers or 'reset'");
	    return;
        }
	props = cdr(props);        
    }
    /* If this is setting the area's shape for the first time,
       actually do it. */
    if (newarea)
      set_area_shape(newwidth, newheight, TRUE);
    for ( ; props != lispnil; props = cdr(props)) {
	bdg = car(props);
	PARSE_PROPERTY(bdg, propname, propval);
	if (numberp(propval))
	  numval = c_number(propval);
	rest = cdr(bdg);
	switch (keyword_code(propname)) {
	  case K_WIDTH:
	    /* Note that this may fail if the height has to change at
	       at the same time. */
	    set_area_shape(numval, area.height, TRUE);
	    break;
	  case K_HEIGHT:
	    /* Note that this may fail if the width has to change at
	       at the same time. */
	    set_area_shape(area.width, numval, TRUE);
	    break;
	  case K_LATITUDE:
	    area.latitude = numval;
	    break;
	  case K_LONGITUDE:
	    area.longitude = numval;
	    break;
	  case K_PROJECTION:
	    area.projection = numval;
	    break;
	  case K_CELL_WIDTH:
	    area.cellwidth = numval;
	    break;
	  case K_SUN:
	    area.sunx = numval;
	    area.suny = c_number(cadr(rest));
	    break;
	  case K_TEMPERATURE_YEAR_CYCLE:
	    area.temp_year = propval;
	    break;
	  case K_IMAGE_NAME:
	    strval = NULL;
	    if (stringp(propval))
	      strval = c_string(propval);
	    area.image_name = strval;
	    break;
	  case K_TERRAIN:
	    fill_in_terrain(rest);
	    break;
	  case K_AUX_TERRAIN:
	    fill_in_aux_terrain(rest);
	    break;
	  case K_PEOPLE_SIDES:
	    fill_in_people_sides(rest);
	    break;
	  case K_CONTROL_SIDES:
	    fill_in_control_sides(rest);
	    break;
	  case K_FEATURES:
	    fill_in_features(rest);
	    break;
	  case K_ELEVATIONS:
	    fill_in_elevations(rest);
	    break;
	  case K_MATERIAL:
	    fill_in_cell_material(rest);
	    break;
	  case K_TEMPERATURES:
	    fill_in_temperatures(rest);
	    break;
	  case K_WINDS:
	    fill_in_winds(rest);
	    break;
	  case K_CLOUDS:
	    fill_in_clouds(rest);
	    break;
	  case K_CLOUD_BOTTOMS:
	    fill_in_cloud_bottoms(rest);
	    break;
	  case K_CLOUD_HEIGHTS:
	    fill_in_cloud_heights(rest);
	    break;
	  case K_USER:
	    fill_in_users(rest);
	    break;
	  default:
	    unknown_property("area", "", propname);
	}
    }
}

/* The general plan of reading is similar for all layers - create a blank
   layer if none allocated, then call read_layer and pass a function that will
   actually put a value into a cell of the layer.  We need to define those
   functions because most of the setters are macros, and because we can do
   some extra error checking. */

/* Read the area terrain. */

static void
fill_in_terrain(contents)
Obj *contents;
{
    /* We must have some terrain types or we're going to lose bigtime. */
    if (numttypes == 0)
      load_default_game();
    numbadterrain = 0;
    /* Make sure the terrain layer exists. */
    if (!terrain_defined())
      allocate_area_terrain();
    read_layer(contents, fn_set_terrain_at);
    if (numbadterrain > 0) {
	read_warning("%d occurrences of unknown terrain in all",
		     numbadterrain);
    }
}

/* Read a layer of auxiliary terrain. */

static void
fill_in_aux_terrain(contents)
Obj *contents;
{
    int t;
    Obj *typesym = car(contents), *typeval;

    if (symbolp(typesym) && ttypep(typeval = eval(typesym))) {
	t = c_number(typeval);
	contents = cdr(contents);
	/* Make sure aux terrain space exists, but don't overwrite. */
	allocate_area_aux_terrain(t);
	tmpttype = t;
	read_layer(contents, fn_set_aux_terrain_at);
	/* Ensure that borders and connections have all their bits
	   correctly set. */
	patch_linear_terrain(t);
    } else {
	/* not a valid aux terrain type */
    }
}

static void
fill_in_people_sides(contents)
Obj *contents;
{
    /* Make sure the people sides layer exists. */
    allocate_area_people_sides();
    read_layer(contents, fn_set_people_side_at);
}

static void
fill_in_control_sides(contents)
Obj *contents;
{
    /* Make sure the people sides layer exists. */
    allocate_area_control_sides();
    read_layer(contents, fn_set_control_side_at);
}

/* This should recompute size etc of all these features too. */

static void
fill_in_features(contents)
Obj *contents;
{
    int fid;
    Obj *featspec, *flist, *feattype, *featname;
    Feature *feat;

    init_features();
    for_all_list(car(contents), flist) {
	featspec = car(flist);
	fid = 0;
	feat = NULL;
	if (numberp(car(featspec))) {
	    fid = c_number(car(featspec));
	    feat = find_feature(fid);
	    featspec = cdr(featspec);
	}
	if (feat == NULL) {
	    feattype = car(featspec);
	    featname = cadr(featspec);
	    if ((stringp(feattype) || symbolp(feattype))
		&& (stringp(featname) || symbolp(featname))) {
		feat = create_feature(c_string(feattype), c_string(featname));
		if (fid > 0)
		  feat->id = fid;
	    } else {
		syntax_error(featspec, "not a valid feature spec");
	    }
	} else {
	    /* complain if data doesn't match? */
	}
    }
    read_layer(cdr(contents), fn_set_raw_feature_at);
}

static void
fill_in_elevations(contents)
Obj *contents;
{
    /* Make sure the elevation layer exists. */
    allocate_area_elevations();
    read_layer(contents, fn_set_elevation_at);
}

static void
fill_in_cell_material(contents)
Obj *contents;
{
    int m;
    Obj *typesym = car(contents), *typeval;

    if (symbolp(typesym) && mtypep(typeval = eval(typesym))) {
	m = c_number(typeval);
	contents = cdr(contents);
	/* Make sure this material layer exists. */
	allocate_area_material(m);
	tmpmtype = m;
	read_layer(contents, fn_set_material_at);
    } else {
	/* not a valid material type spec, should warn */
    }
}

static void
fill_in_temperatures(contents)
Obj *contents;
{
    /* Make sure the temperature layer exists. */
    allocate_area_temperatures();
    read_layer(contents, fn_set_temperature_at);
}

static void
fill_in_winds(contents)
Obj *contents;
{
    /* Make sure the winds layer exists. */
    allocate_area_winds();
    read_layer(contents, fn_set_raw_wind_at);
}

static void
fill_in_clouds(contents)
Obj *contents;
{
    /* Make sure the clouds layer exists. */
    allocate_area_clouds();
    read_layer(contents, fn_set_raw_cloud_at);
}

static void
fill_in_cloud_bottoms(contents)
Obj *contents;
{
    /* Make sure the cloud bottoms layer exists. */
    allocate_area_cloud_bottoms();
    read_layer(contents, fn_set_raw_cloud_bottom_at);
}

static void
fill_in_cloud_heights(contents)
Obj *contents;
{
    /* Make sure the cloud heights layer exists. */
    allocate_area_cloud_heights();
    read_layer(contents, fn_set_raw_cloud_height_at);
}

static void
fill_in_users(contents)
Obj *contents;
{
    /* Make sure the user layer exists. */
    if (!user_defined()) 
    	allocate_area_users();
    read_layer(contents, fn_set_user_at);
}

static void
add_to_area(spec)
Obj *spec;
{
    int x0, y0, w, h, t, x, y;
    char *propname;
    Obj *val, *typeval;

    /* Collect the dimensions of the area to modify. */
    if (numberp(car(spec))) {
	x0 = c_number(car(spec));
	spec = cdr(spec);
    }
    if (numberp(car(spec))) {
	y0 = c_number(car(spec));
	spec = cdr(spec);
    }
    if (numberp(car(spec))) {
	w = c_number(car(spec));
	spec = cdr(spec);
	if (numberp(car(spec))) {
	    h = c_number(car(spec));
	    spec = cdr(spec);
	} else {
	    h = w;
	}
    } else {
	w = h = 1;
    }
    PARSE_PROPERTY(spec, propname, val);
    switch (keyword_code(propname)) {
      case K_TERRAIN:
	if (symbolp(val) && ttypep(typeval = eval(val))) {
	    t = c_number(typeval);
	    for (x = x0; x < x0 + w; ++x) {
		for (y = y0; y < y0 + h; ++y) {
		    if (in_area(x, y)) {
			set_terrain_at(x, y, t);
		    }
		}
	    }
	}
	break;
      case K_AUX_TERRAIN:
	break;
      case K_PEOPLE_SIDES:
	break;
      case K_CONTROL_SIDES:
	break;
      case K_FEATURES:
	break;
      case K_ELEVATIONS:
	break;
      case K_MATERIAL:
	break;
      case K_TEMPERATURES:
	break;
      case K_WINDS:
	break;
      case K_CLOUDS:
	break;
      case K_CLOUD_BOTTOMS:
	break;
      case K_CLOUD_HEIGHTS:
	break;
      default:
	unknown_property("area", "", propname);
    }
}

/* This is like init_warning, but with a module and line(s) glued in. */
/* (This may seem like a strange position for this routine, but it's
   necessary to accommodate a Mac 16-bit PC-relative addressing limit;
   in the middle of the file, it's close enough to all of its callers.
   Nasty remarks about Mac runtime architecture to Dev:Null please.) */

void
#ifdef __STDC__
read_warning(char *str, ...)
#else
read_warning(str, a1, a2, a3, a4, a5, a6, a7, a8, a9)
char *str;
long a1, a2, a3, a4, a5, a6, a7, a8, a9;
#endif
{
    char buf[BUFSIZE];

    module_and_line(curmodule, buf);
#ifdef __STDC__
    {
	va_list ap;

	va_start(ap, str);
	vtprintf(buf, str, ap);
	va_end(ap);
    }
#else
    tprintf(buf, str, a1, a2, a3, a4, a5, a6, a7, a8, a9);
#endif
    if (warnings_logged)
      log_warning("READ", buf);
    if (warnings_suppressed)
      return;
    low_init_warning(buf);
}

/* Interpret a side spec. */

static void
interp_side(form, side)
Obj *form;
Side *side;
{
    int id = -1;
    Obj *ident = lispnil, *sym = lispnil, *props = cdr(form);

    /* See if there's an optional side identifier and pick it off. */
    if (!listp(car(props))) {
	ident = car(props);
	props = cdr(props);
    }
    if (numberp(ident)) {
	id = c_number(ident);
	side = side_n(id);
    } else if (symbolp(ident)) {
	if (boundp(ident) && numberp(symbol_value(ident))) {
	    id = c_number(symbol_value(ident));
	    side = side_n(id);
	} else {
	    sym = ident;
	}
    } else if (stringp(ident)) {
	side = find_side_by_name(c_string(ident));
    } else {
	/* We want to create a new side. */
    }
    if (symbolp(car(props))) {
	sym = car(props);
	props = cdr(props);
    }
    if (side == NULL) {
	side = create_side();
	/* Replace with the read-in id if it was given. */
	if (id >= 0)
	  side->id = id;
    }
    if (sym != lispnil) {
	/* Record the symbol as going with this side. */
	side->symbol = sym;
	/* Also let it eval to the side's id, warning about conflicts. */
	if (boundp(sym))
	  read_warning("Symbol `%s' has been bound already, overwriting", c_string(sym));
	setq(sym, new_number(side->id));
    }
    /* Apply the current side defaults first. */
    fill_in_side(side, side_defaults, FALSE);
    /* Now fill in from the explicitly specified properties. */
    fill_in_side(side, props, FALSE);
    Dprintf("  Got side %s\n", side_desig(side));
}

/* Given a side, fill in some of its properties. */

void
fill_in_side(side, props, userdata)
Side *side;
Obj *props;
int userdata;
{
    int numval, isnumber, permission, u;
    char *propname, *strval = NULL, *checkuniq;
    Obj *bdg, *rest, *propval;

    /* Use this macro with every slot that the user may not arbitrarily
       change when the game starts up. */
#define CHECK_PERMISSION  \
	    if (userdata) {  \
		permission = FALSE;  \
		break;  \
	    }

    for (; props != lispnil; props = cdr(props)) {
	permission = TRUE;
	bdg = car(props);
	PARSE_PROPERTY(bdg, propname, propval);
	if (symbolp(propval))
	  propval = eval(propval);
	numval = eval_number(propval, &isnumber);
	if (stringp(propval))
	  strval = c_string(propval);
	rest = cdr(bdg);
	checkuniq = NULL;
	switch (keyword_code(propname)) {
	  case K_NAME:
	    side->name = strval;
	    checkuniq = "name";
	    break;
	  case K_LONG_NAME:
	    side->longname = strval;
	    checkuniq = "long name";
	    break;
	  case K_SHORT_NAME:
	    side->shortname = strval;
	    checkuniq = "short name";
	    break;
	  case K_NOUN:
	    side->noun = strval;
	    checkuniq = "noun";
	    break;
	  case K_PLURAL_NOUN:
	    side->pluralnoun = strval;
	    checkuniq = "plural noun";
	    break;
	  case K_ADJECTIVE:
	    side->adjective = strval;
	    checkuniq = "adjective";
	    break;
	  case K_COLOR:
	    side->colorscheme = strval;
	    checkuniq = "color";
	    break;
	  case K_EMBLEM_NAME:
	    side->emblemname = strval;
	    checkuniq = "emblem";
	    break;
	  case K_UNIT_NAMERS:
	    /* Allocate space if not already done so. */
	    if (side->unitnamers == NULL)
	      side->unitnamers = (char **) xmalloc(numutypes * sizeof(char *));
	    merge_unit_namers(side, rest);
	    break;
	  case K_FEATURE_NAMERS:
	    /* An empty list means to clear the side's list, otherwise we "merge"
	       by gluing onto the front. */
	    if (rest == lispnil)
	      side->featurenamers = lispnil;
	    else
	      side->featurenamers = append_two_lists(rest, side->featurenamers);
	    break;
	  case K_NAMES_LOCKED:
	    side->nameslocked = numval;
	    break;
	  case K_UNITS:
	    side->possible_units = propval;
	    break;
	  case K_CLASS:
	    CHECK_PERMISSION;
	    side->sideclass = strval;
	    break;
	  case K_SELF_UNIT:
	    CHECK_PERMISSION;
	    side->self_unit_id = numval;
	    break;
	  case K_CONTROLLED_BY:
	    CHECK_PERMISSION;
	    side->controlled_by_id = numval;
	    break;
	  case K_TRUSTS:
	    interp_side_value_list(side->trusts, rest);
	    break;
	  case K_TRADES:
	    interp_side_value_list(side->trades, rest);
	    break;
	  case K_START_WITH:
	    CHECK_PERMISSION;
	    if (side->startwith == NULL)
	      side->startwith = (short *) xmalloc(numutypes * sizeof(short));
	    interp_utype_value_list(side->startwith, rest);
	    break;
	  case K_NEXT_NUMBERS:
	    CHECK_PERMISSION;
	    if (side->counts == NULL)
	      side->counts = (short *) xmalloc(numutypes * sizeof(short));
	    interp_utype_value_list(side->counts, rest);
	    break;
	  case K_TECH:
	    CHECK_PERMISSION;
	    if (side->tech == NULL)
	      side->tech = (short *) xmalloc(numutypes * sizeof(short));
	    interp_utype_value_list(side->tech, rest);
	    break;
	  case K_INIT_TECH:
	    CHECK_PERMISSION;
	    if (side->inittech == NULL)
	      side->inittech = (short *) xmalloc(numutypes * sizeof(short));
	    interp_utype_value_list(side->inittech, rest);
	    break;
	  case K_ACTION_PRIORITIES:
	    CHECK_PERMISSION;
	    if (side->action_priorities == NULL) {
		side->action_priorities = (short *) xmalloc(numutypes * sizeof(short));
		for_all_unit_types(u)
		  side->action_priorities[u] = -1;
	    }
	    interp_utype_value_list(side->action_priorities, rest);
	    break;
	  case K_ALREADY_SEEN:
	    CHECK_PERMISSION;
	    if (side->already_seen == NULL) {
		side->already_seen = (short *) xmalloc(numutypes * sizeof(short));
		for_all_unit_types(u)
		  side->already_seen[u] = -1;
	    }
	    interp_utype_value_list(side->already_seen, rest);
	    break;
	  case K_ALREADY_SEEN_INDEPENDENT:
	    CHECK_PERMISSION;
	    if (side->already_seen_indep == NULL) {
		side->already_seen_indep = (short *) xmalloc(numutypes * sizeof(short));
		for_all_unit_types(u)
		  side->already_seen_indep[u] = -1;
	    }
	    interp_utype_value_list(side->already_seen_indep, rest);
	    break;
	  case K_DEFAULT_DOCTRINE:
	    read_general_doctrine(side, rest);
	    break;
	  case K_DOCTRINES:
	    read_utype_doctrine(side, rest);
	    break;
	  case K_DOCTRINES_LOCKED:
	    side->doctrines_locked = numval;
	    break;
	  case K_TERRAIN_VIEW:
	    CHECK_PERMISSION;
	    read_view_layer(side, rest, fn_set_terrain_view);
	    break;
	  case K_TERRAIN_VIEW_DATES:
	    CHECK_PERMISSION;
	    read_view_layer(side, rest, fn_set_terrain_view_date);
	    break;
	  case K_AUX_TERRAIN_VIEW:
	    CHECK_PERMISSION;
	    read_aux_terrain_view_layer(side, rest, fn_set_aux_terrain_view);
	    break;
	  case K_AUX_TERRAIN_VIEW_DATES:
	    CHECK_PERMISSION;
	    read_aux_terrain_view_layer(side, rest, fn_set_aux_terrain_view_date);
	    break;
	  case K_UNIT_VIEW:
	    CHECK_PERMISSION;
	    read_view_layer(side, rest, fn_set_unit_view);
	    side->unit_view_restored = TRUE;
	    break;
	  case K_UNIT_VIEW_DATES:
	    CHECK_PERMISSION;
	    read_view_layer(side, rest, fn_set_unit_view_date);
	    break;
	  case K_MATERIAL_VIEW:
	    CHECK_PERMISSION;
	    read_material_view_layer(side, rest, fn_set_material_view);
	    break;
	  case K_MATERIAL_VIEW_DATES:
	    CHECK_PERMISSION;
	    read_material_view_layer(side, rest, fn_set_material_view_date);
	    break;
	  case K_TEMPERATURE_VIEW:
	    CHECK_PERMISSION;
	    read_view_layer(side, rest, fn_set_temp_view);
	    break;
	  case K_TEMPERATURE_VIEW_DATES:
	    CHECK_PERMISSION;
	    read_view_layer(side, rest, fn_set_temp_view_date);
	    break;
	  case K_CLOUD_VIEW:
	    CHECK_PERMISSION;
	    read_view_layer(side, rest, fn_set_cloud_view);
	    break;
	  case K_CLOUD_BOTTOM_VIEW:
	    CHECK_PERMISSION;
	    read_view_layer(side, rest, fn_set_cloud_bottom_view);
	    break;
	  case K_CLOUD_HEIGHT_VIEW:
	    CHECK_PERMISSION;
	    read_view_layer(side, rest, fn_set_cloud_height_view);
	    break;
	  case K_CLOUD_VIEW_DATES:
	    CHECK_PERMISSION;
	    read_view_layer(side, rest, fn_set_cloud_view_date);
	    break;
	  case K_WIND_VIEW:
	    CHECK_PERMISSION;
	    read_view_layer(side, rest, fn_set_wind_view);
	    break;
	  case K_WIND_VIEW_DATES:
	    CHECK_PERMISSION;
	    read_view_layer(side, rest, fn_set_wind_view_date);
	    break;
	  case K_ACTIVE:
	    CHECK_PERMISSION;
	    side->ingame = numval;
	    break;
	  case K_EVER_ACTIVE:
	    CHECK_PERMISSION;
	    side->everingame = numval;
	    break;
	  case K_PRIORITY:
	    CHECK_PERMISSION;
	    side->priority = numval;
	    break;
	  case K_STATUS:
	    CHECK_PERMISSION;
	    side->status = numval;
	    break;
	  case K_SCORES:
	    CHECK_PERMISSION;
	    /* The data in this slot will be interpreted later,
	       after scorekeepers exist. */
	    side->rawscores = rest;
	    break;
	  case K_WILLING_TO_DRAW:
	    side->willingtodraw = numval;
	    break;
	  case K_FINISHED_TURN:
	    side->finishedturn = numval;
	    break;
	  case K_TURN_TIME_USED:
	    CHECK_PERMISSION;
	    side->turntimeused = numval;
	    break;
	  case K_TOTAL_TIME_USED:
	    CHECK_PERMISSION;
	    side->totaltimeused = numval;
	    break;
	  case K_TIMEOUTS:
	    CHECK_PERMISSION;
	    side->timeouts = numval;
	    break;
	  case K_TIMEOUTS_USED:
	    CHECK_PERMISSION;
	    side->timeoutsused = numval;
	    break;
	  case K_ADVANTAGE:
	    CHECK_PERMISSION;
	    side->advantage = numval;
	    break;
	  case K_ADVANTAGE_MIN:
	    CHECK_PERMISSION;
	    side->minadvantage = numval;
	    break;
	  case K_ADVANTAGE_MAX:
	    CHECK_PERMISSION;
	    side->maxadvantage = numval;
	    break;
	  case K_INITIAL_CENTER_AT:
	    /* (should support unit names, etc here also) */
	    side->init_center_x = numval;
	    side->init_center_y = c_number(caddr(bdg));
	    break;
	  case K_PLAYER:
	    side->playerid = numval;
	    break;
	  case K_INSTRUCTIONS:
	    /* The instructions are a list of strings. */
	    side->instructions = propval;
	    break;
	  case K_GAIN_COUNTS:
	    CHECK_PERMISSION;
	    interp_short_array(side->gaincounts, rest, numutypes * num_gain_reasons);
	    break;
	  case K_LOSS_COUNTS:
	    CHECK_PERMISSION;
	    interp_short_array(side->losscounts, rest, numutypes * num_loss_reasons);
	    break;
	  case K_ATTACK_STATS:
	    CHECK_PERMISSION;
	    interp_atkstats_list(side, rest);
	    break;
	  case K_HIT_STATS:
	    CHECK_PERMISSION;
	    interp_hitstats_list(side, rest);
	    break;
	  case K_AI_DATA:
	    /* The data in this slot will be interpreted when the AI is
	       ready to look at it. */
	    side->aidata = rest;
	    break;
	  case K_UI_DATA:
	    /* The data in this slot will be interpreted when the interface
	       is ready to look at it. */
	    side->uidata = rest;
	    break;
	  case K_STANDING_ORDER:
	    interp_standing_order(side, rest);
	    break;
	  case K_NUMADVANCES:
	    side->numadvances = numval;
	    break;
	  case K_ADVANCE:
	    interp_atype_value_list(side->advance, rest);
	    break;
	  case K_TREASURY:
	    interp_mtype_value_list(side->treasury, rest);
	    break;
	  default:
	    unknown_property("side", side_desig(side), propname);
	}
	if (!permission) {
	    read_warning("No permission to set property `%s'", propname);
	}
	if (checkuniq != NULL) {
	    check_name_uniqueness(side, strval, checkuniq);
	}
    }
    /* Calculate the plural form of the noun for units if it was not
       explicitly defined. */
    if (side->noun != NULL && side->pluralnoun == NULL) {
	side->pluralnoun = copy_string(plural_form(side->noun));
    }
}

static void 
interp_standing_order(side, form)
Side *side;
Obj *form;
{
    enum sordercond condtyp;
    short arr[MAXUTYPES];
    int u;
    char *condname;
    Obj *rest = form, *subform;
    StandingOrder *sorder;

    sorder = new_standing_order();
    for_all_unit_types(u)
      arr[u] = FALSE;
    interp_utype_list(arr, car(rest));
    for_all_unit_types(u)
      sorder->types[u] = arr[u];
    rest = cdr(rest);
    subform = car(rest);
    condname = c_string(car(subform));
    switch (keyword_code(condname)) {
      case K_ALWAYS:
	condtyp = sorder_always;
        break;
      case K_AT:
	condtyp = sorder_at;
        break;
      case K_IN:
	condtyp = sorder_in;
        break;
      case K_NEAR:
	condtyp = sorder_near;
        break;
      default:
	unknown_property("standing order condition", side_desig(side), condname);
	return;
    }
    sorder->condtype = condtyp;
    subform = cdr(subform);
    if (subform != lispnil) {
	sorder->a1 = c_number(car(subform));
	subform = cdr(subform);
    }
    if (subform != lispnil) {
	sorder->a2 = c_number(car(subform));
	subform = cdr(subform);
    }
    if (subform != lispnil) {
	sorder->a3 = c_number(car(subform));
    }
    rest = cdr(rest);
    sorder->task = interp_task(car(rest));

    add_standing_order(side, sorder, 1);
}

static void
check_name_uniqueness(side, str, kind)
Side *side;
char *str, *kind;
{
    if (name_in_use(side, str)) {
	init_warning("Side %s `%s' is already in use", kind, str);
    }
}

/* Given a list of (utype str) pairs, set unit namers appropriately. */

static void
merge_unit_namers(side, lis)
Side *side;
Obj *lis;
{
    int u, u2 = 0;
    Obj *rest, *elt, *types, *typesrest, *type1, *namer;

    for_all_list(lis, rest) {
	elt = car(rest);
	if (consp(elt)) {
	    types = eval(car(elt));
	    namer = cadr(elt);
	    if (stringp(namer) || symbolp(namer)) {
		if (utypep(types)) {
		    u = c_number(types);
		    side->unitnamers[u] = c_string(namer);
		} else if (listp(types)) {
		    /* If a list of unit types, iterate. */
		    for_all_list(types, typesrest) {
			type1 = car(typesrest);
			if (utypep(type1)) {
			    u = c_number(type1);
			    side->unitnamers[u] = c_string(namer);
			} else {
			    syntax_error(type1, "not a unit type");
			}
		    }
		} else {
		    syntax_error(types, "garbled unit types for namer");
		}
	    } else {
		syntax_error(elt, "garbled unit namer");
	    }
	} else if (stringp(elt) || symbolp(elt)) {
	    if (u2 < numutypes) {
		side->unitnamers[u2++] = c_string(elt);
	    } else {
		read_warning("more unit namers than unit types, ignoring extra");
	    }
	} else {
	    syntax_error(elt, "not a valid unit namer");
	}
    }
}

static void
interp_side_mask_list(maskp, lis)
SideMask *maskp;
Obj *lis;
{
    Obj *rest, *head;

    if (maskp == NULL)
      run_error("null mask for side mask list?");
    *maskp = NOSIDES;
    for_all_list(lis, rest) {
    	head = car(rest);
	if (numberp(head)) {
	    *maskp = c_number(head);
	    return;
	} else if (symbolp(head)) {
	    int s2 = c_number(eval(head));

	    if (between(1, s2, g_sides_max()))
	      add_side_to_set(side_n(s2), *maskp);
	    else
	      read_warning("bad side spec");
	} else if (consp(head)) {
	    Obj *sidespec = car(head);
	    int s2, val2 = c_number(cadr(head));

	    if (numberp(sidespec) || symbolp(sidespec)) {
		s2 = c_number(eval(sidespec));
		if (between(1, s2, g_sides_max())) {
		    if (val2)
		      add_side_to_set(side_n(s2), *maskp);
		    /* (should have option to remove a side from mask) */
		} else
		  read_warning("bad side spec");
	    } else if (consp(sidespec)) {
	    	read_warning("not implemented");
	    } else {
	    	read_warning("not implemented");
	    }
	} else {
	    read_warning("not implemented");
	}
    }
}

static void
interp_side_value_list(arr, lis)
short *arr;
Obj *lis;
{
    int s = 0;
    Obj *rest, *head;

    if (arr == NULL)
      run_error("null array for side value list?");
    for_all_list(lis, rest) {
    	head = car(rest);
	if (numberp(head)) {
	    if (s > g_sides_max())
	      break;
	    arr[s++] = c_number(head);
	} else if (symbolp(head)) {
	    int s2 = c_number(eval(head));

	    if (between(1, s2, g_sides_max()))
	      arr[s2] = TRUE;
	    else
	      read_warning("bad side spec");
	} else if (consp(head)) {
	    Obj *sidespec = car(head);
	    int s2, val2 = c_number(cadr(head));

	    if (numberp(sidespec) || symbolp(sidespec)) {
		s2 = c_number(eval(sidespec));
		if (between(1, s2, g_sides_max()))
		  arr[s2] = val2;
		else
		  read_warning("bad side spec");
	    } else if (consp(sidespec)) {
	    	read_warning("not implemented");
	    } else {
	    	read_warning("not implemented");
	    }
	} else {
	    read_warning("not implemented");
	}
    }
}

static void
interp_atkstats_list(Side *side, Obj *lis)
{
    int u;
    Obj *rest, *head;

    for_all_list(lis, rest) {
    	head = car(rest);
    	if (consp(head) && symbolp(car(head))) {
	    u = utype_from_symbol(car(head));
	    if (!is_unit_type(u)) {
		init_warning("non unit type");
		continue;
	    }
	    if (side->atkstats[u] == NULL)
	      side->atkstats[u] = (long *) xmalloc(numutypes * sizeof(long));
	    interp_long_array(side->atkstats[u], cdr(head), numutypes);
	}
    }
}

static void
interp_hitstats_list(Side *side, Obj *lis)
{
    int u;
    Obj *rest, *head;

    for_all_list(lis, rest) {
    	head = car(rest);
    	if (consp(head) && symbolp(car(head))) {
	    u = utype_from_symbol(car(head));
	    if (!is_unit_type(u)) {
		init_warning("non unit type");
		continue;
	    }
	    if (side->hitstats[u] == NULL)
	      side->hitstats[u] = (long *) xmalloc(numutypes * sizeof(long));
	    interp_long_array(side->hitstats[u], cdr(head), numutypes);
	}
    }
}

static void
read_view_layer(side, contents, setter)
Side *side;
Obj *contents;
void (*setter)(int x, int y, int val);
{
    if (g_see_all())
      return;
    init_view(side);
    tmpside = side;
    read_layer(contents, setter);
}

static void
read_aux_terrain_view_layer(side, contents, setter)
Side *side;
Obj *contents;
void (*setter)(int x, int y, int val);
{
    int t;
    Obj *typesym = car(contents), *typeval;

    if (g_see_all())
      return;
    init_view(side);
    tmpside = side;
    if (!symbolp(typesym)) {
	return;
    }
    typeval = eval(typesym);
    if (!ttypep(typeval)) {
	return;
    }
    t = c_number(typeval);
    if (!t_is_cell(t)) {
	return;
    }
    contents = cdr(contents);
    tmpttype = t;
    read_layer(contents, setter);
}

static void
read_material_view_layer(side, contents, setter)
Side *side;
Obj *contents;
void (*setter)(int x, int y, int val);
{
    int m;
    Obj *typesym = car(contents), *typeval;

    if (all_see_all)
      return;
    init_view(side);
    tmpside = side;
    if (!symbolp(typesym)) {
	return;
    }
    typeval = eval(typesym);
    if (!mtypep(typeval)) {
	return;
    }
    m = c_number(typeval);
    contents = cdr(contents);
    tmpmtype = m;
    read_layer(contents, setter);
}

/* Interpret the default doctrine for the side. */

static void
read_general_doctrine(side, props)
Side *side;
Obj *props;
{
    int id = -1;
    char *name = NULL;
    Obj *ident = lispnil;
    Doctrine *doctrine = NULL;

    if (props == lispnil) {
	read_warning("no doctrine information supplied");
	return;
    }
    ident = car(props);
    props = cdr(props);
    if (numberp(ident)) {
	id = c_number(ident);
	doctrine = find_doctrine(id);
    } else if (symbolp(ident) || stringp(ident)) {
	name = c_string(ident);
	doctrine = find_doctrine_by_name(name);
    } else {
	type_error(ident, "invalid doctrine reference");
	return;
    }
    if (doctrine == NULL) {
	doctrine = new_doctrine(id);
	doctrine->name = name;
    }
    fill_in_doctrine(doctrine, props);
    side->default_doctrine = doctrine;
}

/* Interpret doctrine info pertaining to a particular unit type. */

static void
read_utype_doctrine(side, lis)
Side *side;
Obj *lis;
{
    short arr[MAXUTYPES];
    int u, id;
    char *name;
    Obj *item, *rest, *ulist, *props, *ident;
    Doctrine *doctrine;
    
    for_all_list(lis, rest) {
	item = car(rest);
	ulist = car(item);
	props = cdr(item);
	for_all_unit_types(u)
	  arr[u] = FALSE;
	interp_utype_list(arr, ulist);
	ident = car(props);
	props = cdr(props);
	id = 0;
	name = NULL;
	if (numberp(ident)) {
	    id = c_number(ident);
	    doctrine = find_doctrine(id);
	} else if (symbolp(ident) || stringp(ident)) {
	    name = c_string(ident);
	    doctrine = find_doctrine_by_name(name);
	} else {
	    type_error(ident, "invalid doctrine reference");
	    return;
	}
	if (doctrine == NULL) {
	    doctrine = new_doctrine(id);
	    doctrine->name = name;
	}
	fill_in_doctrine(doctrine, props);
	for_all_unit_types(u) {
	    if (arr[u]) {
		if (side->udoctrine == NULL)
		  init_doctrine(side);
		side->udoctrine[u] = doctrine;
	    }
	}
    }
}

/* Interpret a form as a doctrine. */

static void
interp_doctrine(form)
Obj *form;
{
    int id = -1;
    char *name = NULL;
    Obj *ident = lispnil, *props = cdr(form);
    Doctrine *doctrine = NULL;

    /* Pick up an optional numeric or symbolic id. */
    if (props != lispnil) {
	if (!consp(car(props))) {
	    ident = car(props);
	    props = cdr(props);
	}
    }
    /* Use the id to find an existing doctrine. */
    if (numberp(ident)) {
	id = c_number(ident);
	doctrine = find_doctrine(id);
    }
    if (symbolp(ident)) {
	name = c_string(ident);
	doctrine = find_doctrine_by_name(name);
    }
    if (doctrine == NULL) {
	doctrine = new_doctrine(id);
	doctrine->name = name;
    }
    /* Give the symbol a binding so eval'ing works. */
    if (symbolp(ident))
      setq(ident, new_string(name));
    fill_in_doctrine(doctrine, props);
    Dprintf("  Got doctrine\n");
}

static void
fill_in_doctrine(doctrine, props)
Doctrine *doctrine;
Obj *props;
{
    int numval;
    char *propname;
    Obj *bdg, *val;

    for (; props != lispnil; props = cdr(props)) {
	bdg = car(props);
	PARSE_PROPERTY(bdg, propname, val);
	if (numberp(val))
	  numval = c_number(val);
	switch (keyword_code(propname)) {
	  case K_RESUPPLY_PERCENT:
	    doctrine->resupply_percent = numval;
	    break;
	  case K_REARM_PERCENT:
	    doctrine->rearm_percent = numval;
	    break;
	  case K_REPAIR_PERCENT:
	    doctrine->repair_percent = numval;
	    break;
	  case K_CONSTRUCTION_RUN:
	    interp_utype_value_list(doctrine->construction_run, cdr(bdg));
	    break;
	  case K_LOCKED:
	    doctrine->locked = numval;
	    break;
	  default:
	    unknown_property("doctrine", "", propname);
	}
    }
}

/* Interpret a form that defines a player. */

static void
interp_player(form)
Obj *form;
{
    int id = -1;
    Obj *ident = lispnil, *props = cdr(form);
    Player *player = NULL;

    if (props != lispnil) {
	if (!consp(car(props))) {
	    ident = car(props);
	    props = cdr(props);
	}
    }
    if (numberp(ident)) {
	id = c_number(ident);
	player = find_player(id);
    }
    if (player == NULL) {
	player = add_player();
    }
    if (id > 0)
      player->id = id;
    fill_in_player(player, props);
    Dprintf("  Got player %s\n", player_desig(player));
}

static void
fill_in_player(player, props)
Player *player;
Obj *props;
{
    char *propname, *strval;
    Obj *bdg, *propval;

    for (; props != lispnil; props = cdr(props)) {
	bdg = car(props);
	PARSE_PROPERTY(bdg, propname, propval);
	if (stringp(propval))
	  strval = c_string(propval);
	switch (keyword_code(propname)) {
	  case K_NAME:
	    player->name = strval;
	    break;
	  case K_CONFIG_NAME:
	    player->configname = strval;
	    break;
	  case K_DISPLAY_NAME:
	    player->displayname = strval;
	    break;
	  case K_AI_TYPE_NAME:
	    player->aitypename = strval;
	    break;
	  case K_INITIAL_ADVANTAGE:
	    player->advantage = c_number(propval);
	    break;
	  case K_PASSWORD:
	    player->password = strval;
	    break;
	  default:
	    unknown_property("player", player_desig(player), propname);
	}
    }
    canonicalize_player(player);
}

/* Create and fill in an agreement, as specified by the form. */

static void
interp_agreement(form)
Obj *form;
{
    int id = 0;
    char *propname;
    Obj *props = cdr(form), *agid, *bdg, *val;
    Agreement *ag;

    agid = car(props);
    if (numberp(agid)) {
    	id = c_number(agid);
	/* should use the number eventually */
	props = cdr(props);
    }
    if (1 /* must create a new agreement object */) {
	ag = create_agreement(id);
	/* Fill in defaults for the slots. */
	ag->state = draft;  /* default for now */
	ag->drafters = NOSIDES;
	ag->proposers = NOSIDES;
	ag->signers = NOSIDES;
	ag->willing = NOSIDES;
	ag->knownto = NOSIDES;
    }
    /* Interpret the properties. */
    for (; props != lispnil; props = cdr(props)) {
	bdg = car(props);
	PARSE_PROPERTY(bdg, propname, val);
	switch (keyword_code(propname)) {
	  case K_TYPE_NAME:
	    ag->typename = c_string(val);
	    break;
	  case K_NAME:
	    ag->name = c_string(val);
	    break;
	  case K_STATE:
	    ag->state = c_number(val);
	    break;
	  case K_TERMS:
	    ag->terms = val;
	    break;
	  case K_DRAFTERS:
	    break;
	  case K_PROPOSERS:
	    break;
	  case K_SIGNERS:
	    break;
	  case K_WILLING_TO_SIGN:
	    break;
	  case K_KNOWN_TO:
	    break;
	  case K_ENFORCEMENT:
	    ag->enforcement = c_number(val);
	    break;
	    break;
	  default:
	    unknown_property("agreement", "", propname);
	}
    }
}

static void
interp_unit_defaults(form)
Obj *form;
{
    int u, m, numval, wasnum, variablelength;
    Obj *props = form, *bdg, *val;
    char *propname;

    default_unit_spec = form;
    if (match_keyword(car(props), K_RESET)) {
	/* Reset all the tweakable defaults. */
	uxoffset = 0, uyoffset = 0;
	default_unit_side_number = -1;
	default_unit_origside_number = -1;
	default_unit_cp = -1;
	default_unit_hp = -1;
	default_unit_cxp = -1;
	default_unit_z = -1;
	default_transport_id = -1;
	default_unit_hook = lispnil;
	for_all_material_types(m)
	  default_supply[m] = -1;
	canaddmtype = FALSE;
	if (default_tooling != NULL) {
	    for_all_unit_types(u)
	      default_tooling[m] = -1;
	}
	props = cdr(props);
    }
    for (; props != lispnil; props = cdr(props)) {
	bdg = car(props);
	PARSE_PROPERTY(bdg, propname, val);
	numval = 0;
	wasnum = FALSE;
	if (numberp(val)) {
	    numval = c_number(val);
	    wasnum = TRUE;
	}
	variablelength = FALSE;
	/* Note that not all unit slots can get default values. */
	switch (keyword_code(propname)) {
	  case K_AT:
	    uxoffset = numval;
	    uyoffset = c_number(caddr(bdg));
	    /* The property is not really variable-length, but mollify the error check. */
	    variablelength = TRUE;
	    break;
	  case K_S:
	    if (!wasnum)
	      numval = c_number(eval(val));
	    default_unit_side_number = numval;
	    break;
	  case K_OS:
	    if (!wasnum)
	      numval = c_number(eval(val));
	    default_unit_origside_number = numval;
	    break;
	  case K_CP:
	    default_unit_cp = numval;
	    break;
	  case K_HP:
	    default_unit_hp = numval;
	    break;
	  case K_CXP:
	    default_unit_cxp = numval;
	    break;
	  case K_M:
	    interp_mtype_value_list(default_supply, cdr(bdg));
	    variablelength = TRUE;
	    break;
	  case K_TP:
	    if (default_tooling == NULL)
	      default_tooling = (short *) xmalloc(numutypes * sizeof(short));
	    interp_utype_value_list(default_tooling, cdr(bdg));
	    variablelength = TRUE;
	    break;
	  case K_IN:
	    default_transport_id = numval;
	    break;
	  case K_Z:
	    default_unit_z = numval;
	    break;
	  case K_X:
	    default_unit_hook = cdr(bdg);
	    variablelength = TRUE;
	    break;
	  default:
	    unknown_property("unit-defaults", "", propname);
	}
	if (!variablelength && cddr(bdg) != lispnil)
	  read_warning("Extra junk in a default %s property, ignoring", propname);
    }
}

/* Try to find a unit type named by the string. */
/* (should move these elsewhere, but where?) */

int
utype_from_name(str)
char *str;
{
    char *tmpstr;
    int u;
    Obj *sym;

    for_all_unit_types(u) {
	if (strcmp(str, u_type_name(u)) == 0)
	  return u;
    }
    /* Try evaluating the symbol. */
    sym = intern_symbol(str);
    if (boundp(sym) && utypep(symbol_value(sym)))
      return c_number(symbol_value(sym));
    /* Try some less common possibilities. */
    for_all_unit_types(u) {
	tmpstr = u_short_name(u);
	if (tmpstr && strcmp(str, tmpstr) == 0)
	  return u;
    }
    for_all_unit_types(u) {
	tmpstr = u_long_name(u);
	if (tmpstr && strcmp(str, tmpstr) == 0)
	  return u;
    }
    return NONUTYPE;
}

/* Try to find a material type named by the string. */

int
mtype_from_name(char *str)
{
    int m;
    Obj *sym;

    for_all_material_types(m) {
	if (strcmp(str, m_type_name(m)) == 0)
	  return m;
    }
    /* Try evaluating the symbol. */
    sym = intern_symbol(str);
    if (boundp(sym) && mtypep(symbol_value(sym)))
      return c_number(symbol_value(sym));
    return NONMTYPE;
}

/* Try to find an advance type named by the string. */

int
atype_from_name(char *str)
{
    int a;
    Obj *sym;

    for_all_advance_types(a) {
	if (strcmp(str, a_type_name(a)) == 0)
	  return a;
    }
    /* Try evaluating the symbol. */
    sym = intern_symbol(str);
    if (boundp(sym) && atypep(symbol_value(sym)))
      return c_number(symbol_value(sym));
    return NONATYPE;
}

/* Try to find a terrain type named by the string. */

int
ttype_from_name(char *str)
{
    int t;
    Obj *sym;

    for_all_terrain_types(t) {
	if (strcmp(str, t_type_name(t)) == 0)
	  return t;
    }
    /* Try evaluating the symbol. */
    sym = intern_symbol(str);
    if (boundp(sym) && ttypep(symbol_value(sym)))
      return c_number(symbol_value(sym));
    return NONTTYPE;
}

/* Try to find a unit type named by the string. */

int
utype_from_symbol(sym)
Obj *sym;
{
    char *str, *tmpstr;
    int u;

    if (boundp(sym) && utypep(symbol_value(sym)))
      return c_number(symbol_value(sym));
    str = c_string(sym);
    for_all_unit_types(u) {
	if (strcmp(str, u_type_name(u)) == 0)
	  return u;
    }
    /* Try some less common possibilities. */
    for_all_unit_types(u) {
	tmpstr = u_short_name(u);
	if (tmpstr && strcmp(str, tmpstr) == 0)
	  return u;
    }
    for_all_unit_types(u) {
	tmpstr = u_long_name(u);
	if (tmpstr && strcmp(str, tmpstr) == 0)
	  return u;
    }
    return NONUTYPE;
}

/* This creates an individual unit and fills in data about it. */

static Unit *
interp_unit(form)
Obj *form;
{
    int u, u2, m, tp_varies, numval, numval2, wasnum, nuid = 0, variablelength, unitnum;
    int nusn = -1, nuosn = -1;
    char *propname, *unitname;
    Obj *head = car(form), *props = cdr(form), *bdg, *val, *bdgrest, *val2;
    Obj *save, *unitspec;
    Unit *unit, *unit2;
    extern int nextid;

    if (!g_create_units()) {
	/* Stash the unit form and current defaults for later use. */
	Dprintf("Saving the unit spec ");
	Dprintlisp(form);
	Dprintf("\n");
	save = cons(cons(form, cons(default_unit_spec, lispnil)), lispnil);
	if (unit_specs != lispnil) {
	    set_cdr(last_unit_spec, save);
	    last_unit_spec = save;
	} else {
	    unit_specs = last_unit_spec = save;
	}
	return NULL;
    }
    Dprintf("Reading a unit from ");
    Dprintlisp(form);
    Dprintf("\n");
    if (symbolp(head)) {
	u = utype_from_symbol(head);
     	if (u != NONUTYPE) {
	    unit = create_unit(u, FALSE);
	    canaddmtype = FALSE;
	    if (unit == NULL) {
		read_warning("Failed to create a unit, skipping the form");
		return NULL;
	    }
	} else {
	    read_warning("\"%s\" not a known unit type, skipping the form",
			 c_string(head));
	    return NULL;
	}
    } else if (stringp(head)) {
	unitname = c_string(head);
	unit = find_unit_by_name(unitname);
	if (unit == NULL) {
	    if (unit_specs != lispnil) {
		unitspec = find_unit_spec_by_name(unitname);
		if (unitspec != lispnil) {
		    /* First set up the saved defaults. */
		    interp_unit_defaults(cadr(unitspec));
		    unit = interp_unit(car(unitspec));
		    /* Restore the current defaults. */
		    interp_unit_defaults(default_unit_spec);
		    if (unit == NULL) {
			read_warning("Failed to create unit from saved spec");
			return NULL;
		    }
		} else {
		    read_warning("No unit spec named \"%s\", skipping the form",
				 unitname);
		    return NULL;
		}
	    } else {
		read_warning("No unit named \"%s\", skipping the form",
			     unitname);
		return NULL;
	    }
    	}
    } else if (numberp(head)) {
	unitnum = c_number(head);
	unit = find_unit_by_number(unitnum);
	if (unit == NULL) {
	    if (unit_specs != lispnil) {
		unitspec = find_unit_spec_by_number(unitnum);
		if (unitspec != lispnil) {
		    /* First set up the saved defaults. */
		    interp_unit_defaults(cadr(unitspec));
		    unit = interp_unit(car(unitspec));
		    /* Restore the current defaults. */
		    interp_unit_defaults(default_unit_spec);
		    if (unit == NULL) {
			read_warning("Failed to create unit from saved spec");
			return NULL;
		    }
		} else {
		    read_warning("No unit spec numbered %d, skipping the form",
				 unitnum);
		    return NULL;
		}
	    } else {
		read_warning("No unit numbered %d, skipping the form",
			     unitnum);
		return NULL;
	    }
    	}
    }
    /* At this point we're guaranteed to have a unit to work with. */
    /* Modify the unit according to current defaults. */
    if (default_unit_side_number >= 0)
      nusn = default_unit_side_number;
    if (default_unit_origside_number >= 0)
      nuosn = default_unit_origside_number;
    if (default_unit_cp >= 0)
      unit->cp = default_unit_cp;
    if (default_unit_hp >= 0)
      unit->hp = unit->hp2 = default_unit_hp;
    if (default_unit_cxp >= 0)
      unit->cxp = default_unit_cxp;
    /* First default supplies using the generic supply initialize. */
    init_supply(unit);
    /* Then fill in anything from the unit defaults. */
    for_all_material_types(m) {
	if (default_supply[m] >= 0)
	  unit->supply[m] = default_supply[m];
    }
    /* Fill in any default toolings that might have been set up. */
    if (default_tooling != NULL) {
	tp_varies = FALSE;
	for_all_unit_types(u2) {
	    if (default_tooling[u2] > 0) {
		tp_varies = TRUE;
		break;
	    }
	}
	if (tp_varies) {
	    if (unit->tooling == NULL)
	      init_unit_tooling(unit);
	    for_all_unit_types(u2)
	      unit->tooling[u] = default_tooling[u];
	}
    }
    /* Peel off fixed-position properties, if they're supplied. */
    if (numberp(car(props))) {
	unit->prevx = c_number(car(props)) + uxoffset - area.fullx;
	props = cdr(props);
    }
    if (numberp(car(props))) {
	unit->prevy = c_number(car(props)) + uyoffset - area.fully;
	props = cdr(props);
    }
    if (props != lispnil && !consp(car(props))) {
	nusn = c_number(eval(car(props)));
	props = cdr(props);
    }
    /* Now crunch through optional stuff.  The unit's properties must *already*
       be correct. */
    for (; props != lispnil; props = cdr(props)) {
	bdg = car(props);
	PARSE_PROPERTY_RETURN(bdg, propname, val, unit);
	numval = 0;
	wasnum = FALSE;
	if (numberp(val)) {
	    numval = c_number(val);
	    wasnum = TRUE;
	}
	variablelength = FALSE;
	switch (keyword_code(propname)) {
	  case K_N:
	    unit->name = c_string(val);
	    break;
	  case K_SHARP:
	    nuid = numval;
	    break;
	  case K_S:
	    if (!wasnum)
	      numval = c_number(eval(val));
	    nusn = numval;
	    break;
	  case K_OS:
	    if (!wasnum)
	      numval = c_number(eval(val));
	    nuosn = numval;
	    break;
	  case K_AT:
	    if (numberp(caddr(bdg))) {
		numval2 = c_number(caddr(bdg));
	    } else {
		type_error(caddr(bdg), "not a number");
		numval2 = 0;
	    }
	    unit->prevx = numval + uxoffset - area.fullx;
	    unit->prevy = numval2 + uyoffset - area.fully;
	    variablelength = TRUE;
	    break;
	  case K_NB:
	    unit->number = numval;
	    break;
	  case K_CP:
	    unit->cp = numval;
	    break;
	  case K_HP:
	    /* Note if the unit is read in as damaged, we don't want
	       damage reckoning to replace with a default hp2. */
	    unit->hp = unit->hp2 = numval;
	    break;
	  case K_CXP:
	    unit->cxp = numval;
	    break;
	  case K_MO:
	    unit->morale = numval;
	    break;
	  case K_TRK:
	    interp_side_mask_list(&(unit->tracking), cdr(bdg));
	    variablelength = TRUE;
	    break;
	  case K_M:
	    interp_mtype_value_list(unit->supply, cdr(bdg));
	    variablelength = TRUE;
	    break;
	  case K_TP:
	    if (unit->tooling == NULL)
	      init_unit_tooling(unit);
	    interp_utype_value_list(unit->tooling, cdr(bdg));
	    variablelength = TRUE;
	    break;
	  case K_OPINIONS:
	    if (unit->opinions == NULL)
	      init_unit_opinions(unit, numsides);
	    if (unit->opinions != NULL) {
		interp_side_value_list(unit->opinions, cdr(bdg));
	    } else {
		read_warning("Unit %s cannot have opinions, ignoring attempt to set",
			     unit_desig(unit));
	    }
	    variablelength = TRUE;
	    break;
	  case K_IN:
	    unit->transport_id = val;
	    break;
	  case K_ACP:
	    if (unit->act == NULL)
	      init_unit_actorstate(unit, TRUE);
	    if (unit->act != NULL)
	      unit->act->acp = numval;
	    else
	      read_warning("Unit %s cannot have acp, ignoring attempt to set",
			   unit_desig(unit));
	    break;
	  case K_ACP0:
	    if (unit->act == NULL)
	      init_unit_actorstate(unit, TRUE);
	    if (unit->act != NULL)
	      unit->act->initacp = numval;
	    else
	      read_warning("Unit %s cannot have acp0, ignoring attempt to set",
			   unit_desig(unit));
	    break;
	  case K_AM:
	    if (unit->act == NULL)
	      init_unit_actorstate(unit, TRUE);
	    if (unit->act != NULL)
	      unit->act->actualmoves = numval;
	    else
	      read_warning("Unit %s cannot have am, ignoring attempt to set",
			   unit_desig(unit));
	    break;
	  case K_A:
	    if (unit->act == NULL)
	      init_unit_actorstate(unit, TRUE);
	    if (unit->act != NULL)
	      interp_action(&(unit->act->nextaction), val);
	    else
	      read_warning("Unit %s cannot have action, ignoring attempt to set",
			   unit_desig(unit));
	    variablelength = TRUE;
	    break;
	  case K_PLAN:
	    interp_unit_plan(unit, cdr(bdg));
	    variablelength = TRUE;
	    break;
	  case K_Z:
	    unit->z = numval;
	    break;
	  case K_SIZE:
	    unit->size = numval;
	    break;
	  case K_REACH:
	    unit->reach = numval;
	    break;
	  case K_USEDCELLS:
	    unit->usedcells = numval;
	    break;
	  case K_MAXCELLS:
	    unit->maxcells = numval;
	    break;
	  case K_CURADVANCE:
	    unit->curadvance = numval;
	    break;
	  case K_PRODUCTION:
	    interp_mtype_value_list(unit->production, cdr(bdg));
	    variablelength = TRUE;
	    break;
	  case K_POPULATION:
	    unit->population = numval;
	    break;
	  case K_CP_STASH:
	    unit->cp_stash = numval;
	    break;
	  case K_AUTOPLAN:
	    unit->autoplan = numval;
	    break;
	  case K_AUTOBUILD:
	    unit->autobuild = numval;
	    break;
	  case K_AUTORESEARCH:
	    unit->autoresearch = numval;
	    break;
	  case K_POINT_VALUE:
	    if (unit->extras == NULL)
	      init_unit_extras(unit);
	    unit->extras->point_value = numval;
	    break;
	  case K_APPEAR:
	    if (unit->extras == NULL)
	      init_unit_extras(unit);
	    unit->extras->appear = numval;
	    /* Get the xy variation if supplied. */
	    bdgrest = cddr(bdg);
	    if (bdgrest != lispnil) {
		val2 = car(bdgrest);
		if (numberp(val2)) {
		    unit->extras->appear_var_x = c_number(val2);
		    bdgrest = cdr(bdgrest);
		    val2 = car(bdgrest);
		    if (numberp(val2)) {
			unit->extras->appear_var_y = c_number(val2);
		    }
		}
	    }
	    variablelength = TRUE;
	    break;
	  case K_DISAPPEAR:
	    if (unit->extras == NULL)
	      init_unit_extras(unit);
	    unit->extras->disappear = numval;
	    break;
	  case K_PRIORITY:
	    if (unit->extras == NULL)
	      init_unit_extras(unit);
	    unit->extras->priority = numval;
	    break;
	  case K_SYM:
	    if (unit->extras == NULL)
	      init_unit_extras(unit);
	    unit->extras->sym = val;
	    break;
	  case K_X:
	    if (unit->extras == NULL)
	      init_unit_extras(unit);
	    unit->extras->hook = cdr(bdg);
	    variablelength = TRUE;
	    break;
	  default:
	    unknown_property("unit", unit_desig(unit), propname);
	}
	if (!variablelength && cddr(bdg) != lispnil)
	  read_warning("Extra junk in the %s property of %s, ignoring",
		       propname, unit_desig(unit));
    }
    /* If the unit id was given, assign it to the unit, avoiding
       duplication. */
    if (nuid > 0) {
    	/* If this id is already in use by some other unit, complain. */
    	unit2 = find_unit(nuid);
    	if (unit2 != NULL && unit2 != unit)
	  init_error("Id %d already in use by %s", nuid, unit_desig(unit2)); 
     	/* Guaranteed distinct, safe to use. */
	unit->id = nuid;
	/* Ensure that future random ids won't step on this one. */
	nextid = max(nextid, nuid + 1);
    }
    if (nusn >= 0) {
	/* (should check that this is an allowed side?) */
	set_unit_side(unit, side_n(nusn));
    }
    if (nuosn >= 0) {
	/* (should check that this is an allowed side?) */
	set_unit_origside(unit, side_n(nuosn));
    } else {
	set_unit_origside(unit, unit->side);
    }
    Dprintf("  Got %s\n", unit_desig(unit));
    return unit;
}

static Obj *
find_unit_spec_by_name(char *name)
{
    Obj *rest, *spec, *props, *bdg, *val;
    char *propname;

    for_all_list(unit_specs, rest) {
	spec = car(car(rest));
	for_all_list(spec, props) {
	    bdg = car(props);
	    if (consp(bdg)) {
		PARSE_PROPERTY_RETURN(bdg, propname, val, lispnil);
		if (keyword_code(propname) == K_N) {
		    if (strcmp(name, c_string(val)) == 0)
		      return car(rest);
		}
	    }
	}
    }
    return lispnil;
}

static Obj *
find_unit_spec_by_number(int num)
{
    Obj *rest, *spec, *props, *bdg, *val;
    char *propname;

    for_all_list(unit_specs, rest) {
	spec = car(car(rest));
	for_all_list(spec, props) {
	    bdg = car(props);
	    if (consp(bdg)) {
		PARSE_PROPERTY_RETURN(bdg, propname, val, lispnil);
		if (keyword_code(propname) == K_NB) {
		    if (num == c_number(val))
		      return car(rest);
		}
	    }
	}
    }
    return lispnil;
}

static void
interp_action(action, form)
Action *action;
Obj *form;
{
    int atype, i, numargs;
    char *argtypes;
    Obj *actiontypesym, *arg;

    actiontypesym = car(form);
    form = cdr(form);
    atype = lookup_action_type(c_string(actiontypesym));
    if (atype < 0) {
	/* (should complain about this?) */
	return;
    }
    action->type = atype;
    argtypes = actiondefns[atype].argtypes;
    numargs = strlen(argtypes);
    for (i = 0; i < numargs; ++i) {
	if (form == lispnil)
	  break;
	arg = car(form);
	SYNTAX(arg, numberp(arg), "action arg must be a number");
	action->args[i] = c_number(arg);
	form = cdr(form);
    }
    if (form != lispnil) {
	/* (should allow non-ids also) */
	action->actee = c_number(car(form));
	form = cdr(form);
    }
    /* (should complain about any leftovers) */
}

/* Fill in a unit's plan. */

static void
interp_unit_plan(unit, props)
Unit *unit;
Obj *props;
{
    int isnumber, numval;
    Obj *bdg, *propval, *plantypesym, *val, *trest;
    char *propname;
    Goal *goal;
    Plan *plan;
    Task *task, *task1;

    if (unit->plan == NULL) {
	/* Create the plan explicitly, even if unit type doesn't allow it
	   (type might be changed later in the reading process). */
	plan = (Plan *) xmalloc(sizeof(Plan));
	/* From init_unit_plan: can't call it directly, might not behave
	   right (should fix to be callable from here - problem is that
	   other unit props such as cp might not be set right yet) */
	/* Allow AIs to make this unit do things. */
	plan->aicontrol = TRUE;
	/* Enable supply alarms by default. */
	plan->supply_alarm = TRUE;
	/* Attach to unit. */
	unit->plan = plan;
    }
    plantypesym = car(props);
    SYNTAX(props, symbolp(plantypesym), "plan type must be a symbol");
    plan->type = lookup_plan_type(c_string(plantypesym));
    props = cdr(props);
    val = car(props);
    SYNTAX(props, numberp(val), "plan creation turn must be a number");
    plan->creation_turn = c_number(val);
    props = cdr(props);
    for (; props != lispnil; props = cdr(props)) {
	bdg = car(props);
	PARSE_PROPERTY(bdg, propname, propval);
	numval = eval_number(propval, &isnumber);
	switch (keyword_code(propname)) {
	  case K_INITIAL_TURN:
	    plan->initial_turn = numval;
	    break;
	  case K_FINAL_TURN:
	    plan->final_turn = numval;
	    break;
	  case K_ASLEEP:
	    plan->asleep = numval;
	    break;
	  case K_RESERVE:
	    plan->reserve = numval;
	    break;
	  case K_DELAYED:
	    plan->delayed = numval;
	    break;
	  case K_WAIT:
	    plan->waitingfortasks = numval;
	    break;
	  case K_AI_CONTROL:
	    plan->aicontrol = numval;
	    break;
	  case K_SUPPLY_ALARM:
	    plan->supply_alarm = numval;
	    break;
	  case K_SUPPLY_IS_LOW:
	    plan->supply_is_low = numval;
	    break;
	  case K_WAIT_TRANSPORT:
	    plan->waitingfortransport = numval;
	    break;
	  case K_GOAL:
	    goal = interp_goal(cdr(bdg));
	    plan->maingoal = goal;
	    break;
	  case K_FORMATION:
	    goal = interp_goal(cdr(bdg));
	    plan->formation = goal;
	    /* Object patching will fill in plan's funit slot later. */
	    break;
	  case K_TASKS:
	    task1 = NULL;
	    for_all_list(cdr(bdg), trest) {
	    	task = interp_task(car(trest));
		if (task) {
		    /* Add tasks to the agenda in same order as saved. */
		    if (task1) {
			task1->next = task;
		    } else {
			plan->tasks = task;
		    }
		    task1 = task;
		}
	    }
	    break;
	  default:
	    unknown_property("unit plan", unit_desig(unit), propname);
	}
    }
}

static Task *
interp_task(form)
Obj *form;
{
    int tasktype, numargs, i;
    char *argtypes;
    Obj *tasktypesym;
    Task *task;

    tasktypesym = car(form);
    SYNTAX_RETURN(form, symbolp(tasktypesym), "task type must be a symbol", NULL);
    tasktype = lookup_task_type(c_string(tasktypesym));
    task = create_task(tasktype);
    form = cdr(form);
    task->execnum = c_number(car(form));
    form = cdr(form);
    task->retrynum = c_number(car(form));
    form = cdr(form);
    argtypes = taskdefns[tasktype].argtypes;
    numargs = strlen(argtypes);
    for (i = 0; i < numargs; ++i) {
	if (form == lispnil)
	  break;
	SYNTAX_RETURN(form, numberp(car(form)), "task arg must be a number", NULL);
	task->args[i] = c_number(car(form));
	form = cdr(form);
    }
    /* Warn about unused data, but not a serious problem. */
    if (form != lispnil)
      read_warning("Excess args for task %s", task_desig(task));
    return task;
}

static Goal *
interp_goal(form)
Obj *form;
{
    int goaltype, tf, numargs, i;
    char *argtypes;
    Obj *goaltypesym;
    Goal *goal;
    Side *side;

    SYNTAX_RETURN(form, numberp(car(form)), "goal side must be a number", NULL);
    side = side_n(c_number(car(form)));
    form = cdr(form);
    SYNTAX_RETURN(form, numberp(car(form)), "goal tf must be a number", NULL);
    tf = c_number(car(form));
    form = cdr(form);
    goaltypesym = car(form);
    SYNTAX_RETURN(form, symbolp(goaltypesym), "goal type must be a symbol", NULL);
    goaltype = lookup_goal_type(c_string(goaltypesym));
    goal = create_goal(goaltype, side, tf);
    form = cdr(form);
    argtypes = goaldefns[goaltype].argtypes;
    numargs = strlen(argtypes);
    for (i = 0; i < numargs; ++i) {
	if (form == lispnil)
	  break;
	if (argtypes[i] == 'U'
	    && (stringp(car(form)))) {
	    /* (should find unit by name) */
	} else {
	    SYNTAX_RETURN(form, numberp(car(form)), "goal arg must be a number", NULL);
	}
	goal->args[i] = c_number(car(form));
	form = cdr(form);
    }
    /* Warn about unused data, but not a serious problem. */
    if (form != lispnil)
      read_warning("Excess args for goal %s", goal_desig(goal));
    return goal;
}

/* Make a namer from the form. */

static void
interp_namer(form)
Obj *form;
{
    Obj *id = cadr(form), *meth = caddr(form);

    if (symbolp(id)) {
	setq(id, make_namer(id, meth));
    }
}

static void
interp_text_generator(form)
Obj *form;
{
    Obj *id = cadr(form);

    if (symbolp(id)) {
	setq(id, lispnil);
    }
}

/* Make a scorekeeper from the given form. */

static void
interp_scorekeeper(form)
Obj *form;
{
    int id = 0;
    char *propname;
    Obj *props = cdr(form), *bdg, *propval;
    Scorekeeper *sk = NULL;

    if (numberp(car(props))) {
	id = c_number(car(props));
	props = cdr(props);
    }
    if (id > 0) {
	sk = find_scorekeeper(id);
    }
    /* Create a new scorekeeper object if necessary. */
    if (sk == NULL) {
	sk = create_scorekeeper();
	if (id > 0) {
	    sk->id = id;
	}
    }
    /* Interpret the properties. */
    for (; props != lispnil; props = cdr(props)) {
	bdg = car(props);
	PARSE_PROPERTY(bdg, propname, propval);
	switch (keyword_code(propname)) {
	  case K_TITLE:
	    sk->title = c_string(propval);
	    break;
	  case K_WHEN:
	    sk->when = propval;
	    break;
	  case K_APPLIES_TO:
	    sk->who = propval;
	    break;
	  case K_KNOWN_TO:
	    sk->knownto = propval;
	    break;
	  case K_TRIGGER:
	    sk->trigger = propval;
	    break;
	  case K_DO:
	    sk->body = propval;
	    break;
	  case K_TRIGGERED:
	    sk->triggered = c_number(propval);
	    break;
	  case K_INITIAL:
	    sk->initial = c_number(propval);
	    break;
	  case K_NOTES:
	    sk->notes = propval;
	    break;
	  default:
	    unknown_property("scorekeeper", "??", propname);
	}
    }
}

/* Make a past unit from the form. */

static void
interp_past_unit(form)
Obj *form;
{
    int u = NONUTYPE, nid;
    char *propname;
    Obj *props, *bdg, *propval, *idval;
    PastUnit *pastunit;

    Dprintf("Reading a past unit from ");
    Dprintlisp(form);
    Dprintf("\n");
    props = cdr(form);
    idval = car(props);
    TYPECHECK(numberp, idval, "id not a number")
    nid = c_number(idval);
    props = cdr(props);
    if (symbolp(car(props))) {
	u = utype_from_symbol(car(props));
	props = cdr(props);
    }
    if (u == NONUTYPE) {
	read_warning("bad exu");
	return;
    }
    pastunit = create_past_unit(u, nid);
    /* Peel off fixed-position properties, if they're supplied. */
    if (numberp(car(props))) {
	pastunit->x = c_number(car(props));
	props = cdr(props);
    }
    if (numberp(car(props))) {
	pastunit->y = c_number(car(props));
	props = cdr(props);
    }
    if (!consp(car(props))) {
	pastunit->side = side_n(c_number(eval(car(props))));
	props = cdr(props);
    }
    for (; props != lispnil; props = cdr(props)) {
	bdg = car(props);
	PARSE_PROPERTY(bdg, propname, propval);
	switch (keyword_code(propname)) {
	  case K_Z:
	    pastunit->z = c_number(propval);
	    break;
	  case K_N:
	    pastunit->name = c_string(propval);
	    break;
	  case K_NB:
	    pastunit->number = c_number(propval);
	    break;
	  default:
	    unknown_property("exu", "??", propname);
	}
    }
}

/* Make a historical event from the form. */

static void
interp_history(form)
Obj *form;
{
    int startdate, type, i;
    char *typename;
    SideMask observers;
    Obj *props, *val;
    HistEvent *hevt;

    Dprintf("Reading a hist event from ");
    Dprintlisp(form);
    Dprintf("\n");
    props = cdr(form);
    /* Get the event's date. */
    val = car(props);
    TYPECHECK(numberp, val, "date not a number")
    startdate = c_number(val);
    props = cdr(props);
    /* Get the event's type. */
    val = car(props);
    TYPECHECK(symbolp, val, "type not a symbol")
    typename = c_string(val);
    /* (should be in separate routine) */
    type = -1;
    for (i = 0; hevtdefns[i].name != NULL; ++i) {
	if (strcmp(typename, hevtdefns[i].name) == 0) {
	    type = i;
	    break;
	}
    }
    if (type < 0) {
	read_warning("Historical event type `%s' not recognized", typename);
	return;
    }
    props = cdr(props);
    /* Get the bit vector of observers. */
    if (numberp(car(props))) {
	observers = c_number(car(props));
	props = cdr(props);
    } else if (symbolp(car(props))
	       && keyword_code(c_string(car(props))) == K_ALL) {
	observers = ALLSIDES;
	props = cdr(props);
    } else {
	syntax_error(form, "bad hevt observers");
	return;
    }
    hevt = create_historical_event(type);
    hevt->startdate = startdate;
    hevt->observers = observers;
    /* Read up to 4 remaining numbers. */
    i = 0;
    for (; props != lispnil && i < 4; props = cdr(props)) {
	hevt->data[i++] = c_number(car(props));
    }
    /* Insert the newly created event. */
    /* (linking code should be in its own routine) */
    hevt->next = history;
    hevt->prev = history->prev;
    history->prev->next = hevt;
    history->prev = hevt;
}

/* Designer is trying to define too many different types. */

static void
too_many_types(typename, maxnum, name)
char *typename;
int maxnum;
Obj *name;
{
    read_warning("Limited to %d types of %s", maxnum, typename);
    sprintlisp(spbuf, name, BUFSIZE);
    read_warning("(Failed to create type with name `%s')", spbuf);
}

/* Property name is unknown, either misspelled or misapplied. */

static void
unknown_property(type, inst, name)
char *type, *inst, *name;
{
    read_warning("The %s form %s has no property named %s", type, inst, name);
}
