#Relay-Version: version Notes 2.7.5 (840 Contrib) 87/2/5; site hpesoc1.HP.COM
#From: games-request@tekred.TEK.COM
#Date: Tue, 4 Aug 87 23:47:33 GMT
#Date-Received: Wed, 5 Aug 87 20:49:44 GMT
#Subject: v02i025:  adl - Adventure Definition Language, Part08/11
#Message-ID: <1479@tekred.TEK.COM>
#Path: hpesoc1!hpda!hplabs!ucbvax!ucbcad!ames!ll-xn!mit-eddie!uw-beaver!tektronix!tekgen!tekred!games-request
#Newsgroups: comp.sources.games
#Sender: billr@tekred.TEK.COM
#Approved: billr@tekred.TEK.COM
#Lines: 2326
#
#Submitted by: cunniff%hpda@hplabs.HP.COM (Ross Cunniff)
#Comp.sources.games: Volume 2, Issue 25
#Archive-name: adl/Part08
#
#
#
#
#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of archive 8 (of 11)."
# Contents:  adlcomp/adlobj.c adlcomp/predef.c adlcomp/routcomp.c
#   adlrun/adlrun.c adlrun/adlspec.c adlrun/rtlex.c
#   samples/aard/objects.adl
# Wrapped by billr@tekred on Tue Aug  4 16:27:46 1987
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f adlcomp/adlobj.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"adlcomp/adlobj.c\"
else
echo shar: Extracting \"adlcomp/adlobj.c\" \(6864 characters\)
sed "s/^X//" >adlcomp/adlobj.c <<'END_OF_adlcomp/adlobj.c'
X	/***************************************************************\
X	*								*
X	*	adlobj.c - routines dealing with the compilation of	*
X	*	object declaractions and assigments.			*
X	*	Copyright 1987 by Ross Cunniff.				*
X	*								*
X	\***************************************************************/
X
X#include <stdio.h>
X
X#include "adltypes.h"
X#include "adlprog.h"
X#include "adldef.h"
X#include "adlcomp.h"
X
X
X	/***************************************************************\
X	*								*
X	*	noun_exists( adj, noun ) - returns an object ID iff	*
X	*	an object exists with noun ID noun and adjective id	*
X	*	adj.  Returns -1 otherwise.				*
X	*								*
X	\***************************************************************/
X
Xint16
Xnoun_exists( adj, noun )
Xint16
X    adj,
X    noun;
X{
X    int16
X	t;
X
X    for( t = nounspace[ noun ]; t != 0; t = objspace[ t ].others )
X	if( objspace[ t ].adj == adj )
X	    return t;
X    return -1;
X}
X
X
X	/***************************************************************\
X	*								*
X	*	move_obj( obj, dest ) - moves object obj to object	*
X	*	dest, taking care to put obj at the END of the list	*
X	*	of objects contained in dest.				*
X	*								*
X	\***************************************************************/
X
Xmove_obj( obj, dest )
Xint16
X    obj, dest;
X{
X    int16
X	t;
X
X    /* Find the object whose link is obj (if any) */
X    t = objspace[ obj ].loc;
X    if( objspace[ t ].cont != obj ) {
X	/* Obj must be a link */
X	t = objspace[ t ].cont;
X	while( objspace[ t ].link != obj )
X	    t = objspace[ t ].link;
X	objspace[ t ].link = objspace[ objspace[ t ].link ].link;
X    }
X    else
X	/* Obj is the head of the list. */
X	objspace[ t ].cont = objspace[ objspace[ t ].cont ].link;
X
X    /* Seek to the end of the list and place obj there. */
X    objspace[ obj ].loc = dest;
X    t = objspace[ dest ].cont;
X    objspace[ obj ].link = 0;
X    if( t ) {
X	/* Jump to the end of the list */
X	while( objspace[ t ].link )
X	    t = objspace[ t ].link;
X	objspace[ t ].link = obj;
X    }
X    else
X	/* There is nothing in the list. */
X	objspace[ dest ].cont = obj;
X}
X
X
X	/***************************************************************\
X	*								*
X	*	new_noun( mod, noun ) - create a new object with	*
X	*	modifier list mod and noun ID noun.  The object is	*
X	*	initially placed in .ALL.				*
X	*								*
X	\***************************************************************/
X
Xint16
Xnew_noun( mod, noun )
Xint16
X    mod, noun;
X{
X    int16
X	obj;
X
X    obj = NUMOBJ++;
X    objspace[ obj ].others = nounspace[ noun ];
X    nounspace[ noun ] = obj;
X    objspace[ obj ].loc = _ALL;
X    objspace[ obj ].link = objspace[ _ALL ].cont;
X    objspace[ _ALL ].cont = obj;
X    objspace[ obj ].adj = mod;
X    objspace[ obj ].noun = noun;
X    return obj;
X} 
X
X
X	/***************************************************************\
X	*								*
X	*	getnew( t_read ) - read a new modified object from the	*
X	*	token stream and return its id.	t_read is nonzero	*
X	*	iff the first token in the list has already been read.	*
X	*								*
X	\***************************************************************/
X
Xint16
Xgetnew( t_read )
Xint16
X    t_read;
X{
X    int16
X	t_save;
X
X    if( !t_read )
X	lexer();
X    if( t_type == VERB ) {
X	t_val = -t_val;
X	t_type = ADJEC;
X    }
X    if( t_type == ADJEC ) {
X	t_save = t_val;
X	lexer();
X	if( t_type == UNDECLARED ) {
X	    insertkey( token, NOUN, NUMNOUN, 1 );
X	    return new_noun( t_save, NUMNOUN++ );
X	}
X	else if( t_type == NOUN ) {
X	    if(		(noun_exists( t_save, t_val ) >= 0) ||
X			(noun_exists( 0, t_val ) >= 0) )
X		error( "Attempt to redeclare a noun.\n" );
X	    else
X		return new_noun( t_save, t_val );
X	}
X	else
X	    error( NOUN_WANTED );
X    }
X    else if( t_type == UNDECLARED ) {
X	insertkey( token, NOUN, NUMNOUN, 1 );
X	return new_noun( 0, NUMNOUN++ );
X    }
X    else
X	error( ILLEGAL_SYMBOL );
X    return -1;
X}
X
X
X	/***************************************************************\
X	*								*
X	*	getold( t_read, t_save ) - read a previously declared	*
X	*	object from the token string.  t_read is the number	*
X	*	of tokens already read, and t_save is the value of the	*
X	*	previous token (if such exists).			*
X	*								*
X	\***************************************************************/
X
Xint16
Xgetold( t_read, t_save )
Xint16
X    t_read,
X    t_save;
X{
X    if( t_read == 0 )
X	lexer();
X    if( t_read != 2 ) {
X	if( t_type == NOUN_SYN )
X	    return t_val;
X	if( t_type == VERB ) {
X	    t_type = ADJEC;
X	    t_val = -t_val;
X	}
X	if( t_type == ADJEC ) {
X	    t_save = t_val;
X	    lexer();
X	}
X    }
X    if( t_type != NOUN ) {
X	error( ILLEGAL_SYMBOL );
X	return -1;
X    }
X    if( (t_save = noun_exists( t_save, t_val )) < 0 )
X	error( ATTEMPT );
X    return t_save;
X}
X
X
X	/***************************************************************\
X	*								*
X	*	setprop( obj, which, val ) - set the which'th property	*
X	*	of object obj to be val.				*
X	*								*
X	\***************************************************************/
X
Xsetprop( obj, which, val )
Xint16
X    obj,
X    which,
X    val;
X{
X    static char
X	*ALREADY = "Noun property already assigned.\n";
X
X    if( (which >=1) && (which <= 16) ) {
X	/* Boolean property */
X	if( objspace[ obj ].props1to16 & bitpat[ which - 1 ] )
X	    warning( ALREADY );
X	if( val )
X	    objspace[ obj ].props1to16 |= bitpat[ which - 1 ];
X	else
X	    objspace[ obj ].props1to16 &= ibitpat[ which - 1 ];
X    }
X    else if( (which >= 17) && (which <= _ACT ) ) {
X	if( objspace[ obj ].props[ which - 17 ] )
X	    warning( ALREADY );
X	objspace[ obj ].props[ which - 17 ] = val;
X    }
X    else
X	error( "Invalid object property number.\n" );
X}
X  
X
X/***************************************************************\
X*								*
X*	nounassign( t_read, t_save ) - parse and interpret a	*
X*	noun property assignment.				*
X*								*
X\***************************************************************/
X
Xnounassign( t_read, t_save )
Xint16
X    t_read,
X    t_save;
X{
X    int16
X	obj,
X	which,
X	getassign();
X
X    obj = getold( t_read, t_save );
X    lexer();
X    if( t_type != '(' )
X	_ERR_FIX( LEFT_EXPECTED, ';' );
X    lexer();
X    if( t_type != CONST )
X	_ERR_FIX( CONST_EXPECTED, ';' );
X    which = t_val;
X    lexer();
X    if( t_type != ')' )
X	_ERR_FIX( RIGHT_EXPECTED, ';' );
X    setprop( obj, which, getassign( 0 ) );
X}
X
X
X	/***************************************************************\
X	*								*
X	*	getnouns() - parse and interpret a NOUN declaration.	*
X	*								*
X	\***************************************************************/
X
Xgetnouns()
X{
X    int16
X	obj, loc;
X
X    while( t_type != ';' ) {
X	if( (obj = getnew( 0 )) >= 0 ) {
X	    lexer();
X	    if( t_type == '(' ) {
X		loc = getold( 0, 0 );
X		move_obj( obj, loc );
X		lexer();
X		if( t_type != ')' )
X		    _ERR_FIX( RIGHT_EXPECTED, ';' );
X		lexer();
X	    }
X	    else if( (t_type != ',') && (t_type != ';') )
X		_ERR_FIX( COMMA_EXPECTED, ';' );
X	}
X	else
X	    eatuntil( ';' );
X    }
X}
X
X/*** EOF adlobj.c ***/
END_OF_adlcomp/adlobj.c
if test 6864 -ne `wc -c <adlcomp/adlobj.c`; then
    echo shar: \"adlcomp/adlobj.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f adlcomp/predef.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"adlcomp/predef.c\"
else
echo shar: Extracting \"adlcomp/predef.c\" \(4775 characters\)
sed "s/^X//" >adlcomp/predef.c <<'END_OF_adlcomp/predef.c'
X/* predef.c - predeclared symbols for adlcomp */
X#include <stdio.h>		/* To get EOF */
X#include "adltypes.h"
X#include "adlprog.h"
X#include "adldef.h"
X#include "builtins.h"
X
Xinit_predefs()
X{
X    insert_sys(  ".ME",		MYVAL, 0 );
X
X    insert_sys( "INCLUDE",	INCLUDE,	0 );
X    insert_sys( "MESSAGE",	MESSAGE,	0 );
X    insert_sys( "VAR",		VAR_D,		0 );
X    insert_sys( "ROUTINE",	ROUT_D,		0 );
X    insert_sys( "LOCAL",	LOCAL_D,	0 );
X
X    insert_sys( "ARTICLE",	ART_D,		0 );
X    insert_sys( "PREP",		PREP_D,		0 );
X    insert_sys( "ADJEC",	ADJEC_D,	0 );
X    insert_sys( "NOUN",		NOUN_D,		0 );
X    insert_sys( "VERB",		VERB_D,		0 );
X
X    insert_sys( "DWIMD",	ROUTINE,	_DWIMD );
X    insert_sys( "DWIMI",	ROUTINE,	_DWIMI );
X    insert_sys( "START",	ROUTINE,	_START );
X
X    insert_sys( "NOVERB",	VERB,		_NOVERB );
X    insert_sys( "TELLER",	VERB,		_TELLER );
X
X    insert_sys( "LDESC",	CONST,		_LD );
X    insert_sys( "SDESC",	CONST,		_SD );
X    insert_sys( "ACTION",	CONST,		_ACT );
X    insert_sys( "PREACT",	CONST,		_PREACT );
X
X    insert_sys( "Verb",		VAR,		_VERB_G );
X    insert_sys( "Dobj",		VAR,		_DOBJ_G );
X    insert_sys( "Iobj",		VAR,		_IOBJ_G );
X    insert_sys( "Prep",		VAR,		_PREP_G );
X    insert_sys( "Conj",		VAR,		_CONJ_G );
X    insert_sys( "Numd",		VAR,		_NUMD_G );
X
X    insert_sys( ".ALL",		NOUN_SYN,	_ALL );
X    insert_sys( "STRING",	NOUN_SYN,	_STRING );
X
X    insert_sys( "WHILE",	WHILE,		0 );
X    insert_sys( "DO",		DO,		0 );
X    insert_sys( "IF",		IF,		0 );
X    insert_sys( "THEN",		THEN,		0 );
X    insert_sys( "ELSEIF",	ELSEIF,		0 );
X    insert_sys( "ELSE",		ELSE,		0 );
X
X    insert_sys( "$loc",		ROUTINE,	_LOC );
X    insert_sys( "$cont",	ROUTINE,	_CONT );
X    insert_sys( "$link",	ROUTINE,	_LINK );
X    insert_sys( "$ldesc",	ROUTINE,	_LDESC );
X    insert_sys( "$sdesc",	ROUTINE,	_SDESC );
X    insert_sys( "$action",	ROUTINE,	_ACTION );
X    insert_sys( "$prop",	ROUTINE,	_PROP );
X    insert_sys( "$setp",	ROUTINE,	_SETP );
X    insert_sys( "$move",	ROUTINE,	_MOVE );
X    insert_sys( "$modif",	ROUTINE,	_MODIF );
X
X    insert_sys( "$vset",	ROUTINE,	_VSET );
X    insert_sys( "$vprop",	ROUTINE,	_VPROP );
X
X    insert_sys( "$plus",	ROUTINE,	_PLUS );
X    insert_sys( "$minus",	ROUTINE,	_MINUS );
X    insert_sys( "$times",	ROUTINE,	_TIMES );
X    insert_sys( "$div",		ROUTINE,	_DIV );
X    insert_sys( "$mod",		ROUTINE,	_MOD );
X    insert_sys( "$rand",	ROUTINE,	_RAND );
X
X    insert_sys( "$and",		ROUTINE,	_AND );
X    insert_sys( "$or",		ROUTINE,	_OR );
X    insert_sys( "$not",		ROUTINE,	_NOT );
X    insert_sys( "$yorn",	ROUTINE,	_YORN );
X    insert_sys( "$pct",		ROUTINE,	_PCT );
X    insert_sys( "$eq",		ROUTINE,	_EQ );
X    insert_sys( "$ne",		ROUTINE,	_NE );
X    insert_sys( "$lt",		ROUTINE,	_LT );
X    insert_sys( "$gt",		ROUTINE,	_GT );
X    insert_sys( "$le",		ROUTINE,	_LE );
X    insert_sys( "$ge",		ROUTINE,	_GE );
X
X    insert_sys( "$say",		ROUTINE,	_SAY );
X    insert_sys( "$arg",		ROUTINE,	_ARG );
X    insert_sys( "$exit",	ROUTINE,	_EXIT );
X    insert_sys( "$return",	ROUTINE,	_RETURN );
X    insert_sys( "$val",		ROUTINE,	_VAL );
X    insert_sys( "$phase",	ROUTINE,	_PHASE );
X    insert_sys( "$spec",	ROUTINE,	_SPEC );
X
X    insert_sys( "$setg",	ROUTINE,	_SETG );
X    insert_sys( "$global",	ROUTINE,	_GLOBAL );
X    insert_sys( "$verb",	ROUTINE,	_VERB );
X    insert_sys( "$dobj",	ROUTINE,	_DOBJ );
X    insert_sys( "$iobj",	ROUTINE,	_IOBJ );
X    insert_sys( "$prep",	ROUTINE,	_PREP );
X    insert_sys( "$conj",	ROUTINE,	_CONJ );
X    insert_sys( "$numd",	ROUTINE,	_NUMD );
X
X    insert_sys( "$setv",	ROUTINE,	_SETV );
X    insert_sys( "$hit",		ROUTINE,	_HIT );
X    insert_sys( "$miss",	ROUTINE,	_MISS );
X
X    insert_sys( "$eqst",	ROUTINE,	_EQST );
X    insert_sys( "$subs",	ROUTINE,	_SUBS );
X    insert_sys( "$leng",	ROUTINE,	_LENG );
X    insert_sys( "$cat",		ROUTINE,	_CAT );
X    insert_sys( "$pos",		ROUTINE,	_POS );
X    insert_sys( "$chr",		ROUTINE,	_CHR );
X    insert_sys( "$ord",		ROUTINE,	_ORD );
X    insert_sys( "$read",	ROUTINE,	_READ );
X    insert_sys( "$savestr",	ROUTINE,	_SAVESTR );
X    insert_sys( "$name",	ROUTINE,	_NAME );
X    insert_sys( "$vname",	ROUTINE,	_VNAME );
X    insert_sys( "$mname",	ROUTINE,	_MNAME );
X    insert_sys( "$pname",	ROUTINE,	_PNAME );
X    insert_sys( "$define",	ROUTINE,	_DEFINE );
X    insert_sys( "$undef",	ROUTINE,	_UNDEF );
X    insert_sys( "$str",		ROUTINE,	_STR );
X    insert_sys( "$num",		ROUTINE,	_NUM );
X
X    insert_sys( "$sdem",	ROUTINE,	_SDEM );
X    insert_sys( "$ddem",	ROUTINE,	_DDEM );
X    insert_sys( "$sfus",	ROUTINE,	_SFUS );
X    insert_sys( "$dfus",	ROUTINE,	_DFUS );
X    insert_sys( "$incturn",	ROUTINE,	_INCTURN );
X    insert_sys( "$turns",	ROUTINE,	_TURNS );
X    insert_sys( "$prompt",	ROUTINE,	_PROMPT );
X    insert_sys( "$actor",	ROUTINE,	_ACTOR );
X    insert_sys( "$delact",	ROUTINE,	_DELACT );
X}
X
X/*** EOF predef.c ***/
END_OF_adlcomp/predef.c
if test 4775 -ne `wc -c <adlcomp/predef.c`; then
    echo shar: \"adlcomp/predef.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f adlcomp/routcomp.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"adlcomp/routcomp.c\"
else
echo shar: Extracting \"adlcomp/routcomp.c\" \(6801 characters\)
sed "s/^X//" >adlcomp/routcomp.c <<'END_OF_adlcomp/routcomp.c'
X	/***************************************************************\
X	*								*
X	*	routcomp.c - routines to compile ADL routines.		*
X	*	Copyright 1987 by Ross Cunniff.				*
X	*								*
X	\***************************************************************/
X
X#include <stdio.h>
X
X#include "adltypes.h"
X#include "adlprog.h"
X#include "builtins.h"
X#include "adldef.h"
X#include "adlcomp.h"
X
X
Xint16
X    inrout;			/* Are we inside a routine?	*/
Xextern int16
X    filenum;			/* Current file number		*/
X
Xint16	getargs();	/* Forward declaration for daisy chaining	*/
X
X
Xchar	*UNDEC_ID = "Undeclared identifier\n";
X
X
X	/***************************************************************\
X	*								*
X	*	getglob() - generate the instruction for the '@glob'	*
X	*	construct.						*
X	*								*
X	\***************************************************************/
X
Xgetglob()
X{
X    lexer();
X    newcode( PUSH, _GLOBAL );
X    if( t_type == VAR )
X	newcode( PUSH, t_val );
X    else if( t_type == LOCAL )
X	newcode( PUSHLOCL, t_val );
X    else if( t_type == ARGUMENT )
X	newcode( PUSHARG, t_val );
X    else if( t_type == UNDECLARED )
X	error( UNDEC_ID );
X    else
X	error( "Illegal '@'.\n" );
X    newcode( CALL, 2L );
X}
X
X
X	/***************************************************************\
X	*								*
X	*	getpair() - generate code for the '[ mod noun ]'	*
X	*	construct.						*
X	*								*
X	\***************************************************************/
X
Xgetpair()
X{
X    int16
X	getold();
X
X    newcode( PUSH, getold( 0, 0 ) );
X    lexer();
X    if( t_type != ']' )
X	_ERR_FIX( BRACKET_EXPECTED, ']' );
X}
X
X
X	/***************************************************************\
X	*								*
X	*	getexpr( t_read ) - generates code for an ADL routine	*
X	*	expression.  t_read is 0 if a token has not already	*
X	*	been read.						*
X	*								*
X	\***************************************************************/
X
Xgetexpr( t_read )
Xint16
X    t_read;
X{
X    if( !t_read )
X	lexer();
X    if( t_type == '(' )
X	getform();
X    else if( t_type == '@' )
X	getglob();
X    else if( t_type == '[' )
X	getpair();
X    else if( t_type == ARGUMENT )
X	newcode( PUSHARG, t_val );
X    else if( t_type == LOCAL )
X	newcode( PUSHLOCL, t_val );
X    else if( t_type == MYVAL )
X	newcode( PUSHME, 0 );
X    else if( t_type == NOUN) {
X	if( (t_val = noun_exists( 0, t_val )) < 0 )
X	    error( ATTEMPT );
X	else
X	    newcode( PUSH, t_val );
X    }
X    else if( (t_type >= MIN_LEGAL) && (t_type <= MAX_LEGAL) )
X	newcode( PUSH, t_val );
X    else if( t_type == UNDECLARED )
X	error( UNDEC_ID );
X    else
X	error( ILLEGAL_SYMBOL );
X}
X
X
X	/***************************************************************\
X	*								*
X	*	getform() - get a routine form such as			*
X	*		(name arg arg...)				*
X	*	or							*
X	*		(IF expr THEN arg arg ... ELSEIF ......)	*
X	*	or							*
X	*		(WHILE expr DO arg arg ...)			*
X	*								*
X	\***************************************************************/
X
Xgetform()
X{
X    int16
X	t_save,
X	getargs();
X
X    lexer();
X    if( t_type == IF )
X	getif();
X    else if( t_type == WHILE )
X	getwhile();
X    else {
X	t_save = t_type;
X	if( t_type == UNDECLARED )
X	    _ERR_FIX( UNDEC_ID, ')' )	/* Note - no semicolon! */
X	else if( t_type == '(' )
X	    getform();
X	else if( t_type == ARGUMENT )
X	    newcode( PUSHARG, t_val );
X	else if( t_type == '@' )
X	    getglob();
X	else
X	    newcode( PUSH, t_val );
X	lexer();
X	if(	(t_save == '@') || (t_save == ROUTINE) ||
X		(t_save == '(') || (t_save == ARGUMENT) )
X	    newcode( CALL, getargs() + 1 );
X	else
X	    error( "Illegal function call.\n" );
X    }
X}
X
X
X	/***************************************************************\
X	*								*
X	*	getwhile() - generate code for the WHILE form.		*
X	*								*
X	\***************************************************************/
X
Xgetwhile()
X{
X    address
X	topaddr,
X	breakaddr;
X
X    topaddr = currcode();	/* Top of loop */
X    getexpr( 0 );		/* Conditional */
X
X    breakaddr = newcode( JMPZ, 0 );	/* If 0 then exit loop */
X    newcode( POP, 0 );		/* Pop the condition code */
X
X    lexer();
X    if( t_type != DO )
X	error( "'DO' expected in WHILE loop.\n" );
X
X    getroutine( 0 );
X    if( t_type != ')' )
X	_ERR_FIX( RIGHT_EXPECTED, ')' );
X    newcode( POP, 0 );
X    newcode( JMP, topaddr );
X
X    oldcode( breakaddr, JMPZ, currcode() );	/* Fix up the breakaddr */
X}
X
X
X	/***************************************************************\
X	*								*
X	*	getif() - generate code for the IF...ELSEIF...ELSE form	*
X	*								*
X	\***************************************************************/
X
Xgetif()
X{
X    address
X	oldaddr,
X	breakaddr;
X
X    getexpr( 0 );				/* Get the conditional */
X    oldaddr = newcode( JMPZ, 0 );		/* Save the cond. br. addr */
X
X    lexer();					/* Read the THEN */
X    if( t_type != THEN )
X	error( "'THEN' expected.\n" );
X
X    newcode( POP, 0 );				/* Pop the condition */
X    getroutine( 0 );				/* Get the body of the IF */
X
X    if( t_type == ')' ) {
X	/* We're done reading the IF statement */
X	oldcode( oldaddr, JMPZ, currcode() );	/* Fix up the IF jump */
X    }
X
X    else {
X	/* There was an ELSE or ELSEIF somewhere */
X	breakaddr = newcode( JMP, 0 );		/* Skip the ELSE or ELSEIF */
X	oldcode( oldaddr, JMPZ, currcode() );	/* Fix up the IF jump */
X	newcode( POP, 0 );			/* Pop the condition code */
X
X	if( t_type == ELSEIF ) {
X	    /* This should be almost the same as an IF statement */
X	    getif();		/* Recursively read the ELSEIF...ELSE */
X	    oldcode( breakaddr, JMP, currcode() ); /* Fixup */
X	}
X
X	else if( t_type == ELSE ) {
X	    /* This is slightly different */
X	    getroutine( 0 );			/* Get the ELSE body */
X	    if( t_type != ')' )
X		_ERR_FIX( RIGHT_EXPECTED, ')' );
X	    oldcode( breakaddr, JMP, currcode() );	/* Fixup */
X	}
X
X	else
X	    _ERR_FIX( ILLEGAL_SYMBOL, ')' );
X    }
X}
X
X
X	/***************************************************************\
X	*								*
X	*	getargs() - generate code for a list of arguments to	*
X	*	a routine call.						*
X	*								*
X	\***************************************************************/
X
Xint16
Xgetargs()
X{
X    int16
X	temp = 0;	/* Number of arguments found */
X
X    while( 1 ) {
X	if( t_type == ')' )
X	    /* We're done reading arguments */
X	    return temp;
X	getexpr( 1 );	/* Get an argument */
X	lexer();	/* Get the next token */
X	temp++;		/* Increment the number of args found */
X    }
X}
X
X	/***************************************************************\
X	*								*
X	*	getroutine( t_read ) - parse and generate code for	*
X	*	an ADL routine.						*
X	*								*
X	\***************************************************************/
X
Xgetroutine( t_read )
Xint16
X    t_read;
X{
X    int16
X	irsave;
X
X    irsave = inrout;
X    if( !inrout ) {
X	inrout = 1;
X	emit_file();
X    }
X    if( !t_read )
X	lexer();
X    while( t_type == '(' ) {
X	getform();
X	lexer();
X	if( t_type == '(' )
X	    newcode( POP, 0 );
X    }
X    inrout = irsave;
X}
X
X/*** EOF routcomp.c ***/
END_OF_adlcomp/routcomp.c
if test 6801 -ne `wc -c <adlcomp/routcomp.c`; then
    echo shar: \"adlcomp/routcomp.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f adlrun/adlrun.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"adlrun/adlrun.c\"
else
echo shar: Extracting \"adlrun/adlrun.c\" \(8493 characters\)
sed "s/^X//" >adlrun/adlrun.c <<'END_OF_adlrun/adlrun.c'
X#include <stdio.h>
X#include <fcntl.h>
X
X#include "adltypes.h"
X#include "adlprog.h"
X#include "adlrun.h"
X#include "adldef.h"
X#include "virtmem.h"
X#include "vstring.h"
X
Xstruct	pagetab
X    codetab;
Xstruct	actrec
X    actlist[ 10 ];
Xaddress
X    ip;
Xint16
X    stack[ STACKSIZE ],
X    sp,
X    bp,
X    numact,
X    curract,
X    Verb,
X    Prep,
X    Iobj,
X    Inoun,
X    Imod,
X    NumDobj,
X    Conj[ NUMDO ],
X    Dnoun[ NUMDO ],
X    Dobj[ NUMDO ],
X    Dmod[ NUMDO ],
X    vecverb[ 10 ],
X    demons[ 10 ],
X    fuses[ 10 ],
X    ftimes[ 10 ],
X    f_actors[ 10 ],
X    numd,
X    numf,
X    currturn,
X    prompter,
X    wordwrite,
X    numsave,
X    restarted,
X    debug,
X    header,
X#if AMIGA
X    scrwidth = 70,
X#else
X    scrwidth = 79,
X#endif
X    numcol,
X    Phase,
X    /* The following 6 vars are not actually used in adlrun,
X       but we need to define them for the loader. */
X    NUM_VARS,
X    NUM_ROUTS,
X    NUM_OBJS,
X    NUM_VERBS,
X    NUM_PREP;
Xchar
X    *inname = "adlcomp.out",
X    *r_name = "\0",
X    *USAGE = "Usage: adlrun [filename] [-d] [-h] [-r savefile]\n",
X    *H_STR = "%-48sScore: %-4d  Moves: %-4d\n",
X    tempc[ 4096 ],		/* Temporary strings */
X    savec[ 1024 ];		/* "Permanent" strings */
Xint
X    infile = -1;
XFILE
X#if MULTIPLEX
X    *CURRTTY,			/* Current output file */
X    *SYSTTY,			/* Default output file */
X#endif
X    *wordfile = (FILE *)0,
X    *scriptfile = (FILE *)0;
X
Xstruct exit_place
X    exits[ 5 ];
X
X#if MSDOS
X	extern char
X	    *getml();
X#	define calloc( size, num )	getml( (long)(size * num) )
X#else
X	extern char
X	    *calloc();
X#endif
X
X#define	islegal(c)	(c&&(c!=' ')&&(c!='\t')&&(c!='\n')&&(c!='-'))
X
X
Xmain( argc, argv )
Xint	argc;
Xchar	*argv[];
X{
X    getadlargs( argc, argv );
X    while( 1 )
X	if( SET_EXIT( 4 ) == 0 )
X	    break;
X    if( restarted )
X	init( 0 );
X    else
X	init( 1 );
X    driver();
X}
X
X
Xgetadlargs( argc, argv )
Xint
X    argc;
Xchar
X    *argv[];
X{  
X    int
X	i;
X    char
X	*getnext();
X
X    for( i = 1; i < argc; i++ ) {
X	if( *argv[ i ] == '-' )
X	    switch( *++argv[ i ] ) {
X		case 'd' :
X		    debug = 1;
X		    break;
X		case 'h' :
X		    header = 1;
X		    break;
X		case 'r' :
X		    r_name = getnext( &i, argv );
X		    break;
X		default  :
X		    fputs( USAGE, stderr );
X		    exit( -1 );
X	    }
X	else if( !strcmp( inname, "adlcomp.out" ) )
X	    inname = argv[ i ];
X	else {
X	    fputs( USAGE, stderr );
X	    exit( -1 );
X	}
X    }
X}
X
X
Xinit( first )
Xint16
X    first;
X{
X    int16
X	me,
X	*temp;
X
X    if( first ) {
X	insertkey( ",",		COMMA,	0, 0 );
X	insertkey( "and",	CONJ,	0, 0 );
X	insertkey( "but",	CONJ,	1, 0 );
X	insertkey( ".",		SEP,	0, 0 );
X	insertkey( "!",		SEP,	0, 0 );
X	insertkey( "?",		SEP,	0, 0 );
X	insertkey( "then",	SEP,	0, 0 );
X
X	SRAND( rand_seed() );
X	if( (infile = open( inname, RB )) < 0 ) {
X	    fprintf( stderr, "Error opening file %s\n", inname );
X	    exit( -1 );
X	}
X
X#if MULTIPLEX
X	SYSTTY = fopen( "/dev/tty", "r+" );
X	if( SYSTTY == (FILE *)0 ) {
X	    fprintf( stderr, "Unable to open output device.\n" );
X	    exit( -1 );
X	}
X	CURRTTY = SYSTTY;
X#endif
X
X	head_setup();
X	sayer( "ADL interpreter - Version 3.2 - June 7, 1987\n" );
X	sayer( "Copyright 1985, 1986, 1987 by Ross Cunniff\n" );
X	sayer( "All rights reserved.\n" );
X
X	/* Read in the input file */
X	lseek( infile, 0L, 0 );
X	read( infile, &hdr, sizeof( struct header ) );
X	if( hdr.magic != M_ADL ) {
X	    fprintf( stderr, "%s: Not an ADL datafile.\n", inname );
X	    head_term();
X	    exit( -1 );
X	}
X
X	/* Read the arrays */
X
X	read_symtab( infile, &hdr.symindex );
X	loadarray( (char **)&routspace,	&hdr.routindex, 1 );
X	loadarray( (char **)&str_tab,	&hdr.strtabindex, 1 );
X	loadarray( (char **)&prepspace,	&hdr.prepindex, 1 );
X	loadarray( (char **)&verbsyn,	&hdr.vsindex, 1 );
X	loadarray( (char **)&nounspace,	&hdr.nounindex, 1 );
X
X	/* Initialize virtual code and string stuff */
X	vsinit( infile, hdr.strindex.ptr, 1, tempc, savec, &numsave, str_tab );
X	vm_init( infile, hdr.codeindex.ptr, &codetab );
X
X    }	/* if( first ) */
X
X    temp = stack;
X    loadarray( (char **)&temp,		&hdr.varindex, 0 );
X    loadarray( (char **)&verbspace,	&hdr.verbindex, first );
X    loadarray( (char **)&objspace,	&hdr.objindex, first );
X
X    if( scriptfile != (FILE *)0 ) {
X	fclose( scriptfile );
X	scriptfile = (FILE *)0;
X    }
X
X    if( wordwrite )
X	fclose( wordfile );
X
X    /* Initialize some variables (This is for ($spec 2) -> restart) */
X    sp = bp = NUMVAR;
X    ip = curract = numd = numf = 0;
X    wordwrite = numsave = prompter = currturn = 0;
X
X    actlist[ 0 ].linebuf = actlist[ 0 ].savebuf;
X    *actlist[ 0 ].linebuf = '\0';
X    actlist[ 0 ].interact = 1;
X    numact = 0;
X
X    clearmacro();
X
X    if( *r_name ) {
X	restoregame( r_name );
X	r_name = "\0";
X    }
X    else
X	callone( _START );
X
X    restarted = 0;
X}
X
X
Xdriver()
X{
X    int
X	i;
X
X    /* Outermost adlrun loop (never exited except to quit adlrun) */
X    while( 1 ) {
X
X	vsflush();	/* Clear out the temporary strings */
X	curract = 0;
X
X	/* Daemon loop */
X	for( curract = numact - 1; curract >= 0; curract-- ) {
X#if MULTIPLEX
X	    if( actrec[ curract ].ttyfile == (FILE *)0 )
X		CURRTTY = SYSTTY;
X	    else
X		CURRTTY = actrec[ curract ].ttyfile;
X#endif
X	    Phase = 0;
X	    if( SET_EXIT( 1 ) == 0 ) {
X		if( SET_EXIT( 0 ) == 0 )
X		    execdems();
X	    }
X	}
X	CLR_EXIT( 0 );
X
X	/* Main actor loop */
X	for( curract = numact - 1; curract >= 0; curract-- ) {
X#if MULTIPLEX
X	    if( actlist[ curract ].ttyfile == (FILE *)0 )
X		CURRTTY = SYSTTY;
X	    else
X		CURRTTY = actlist[ curract ].ttyfile;
X#endif
X
X	    if( SET_EXIT( 1 ) != 0 )
X		continue;
X
X	    /* Delete actor if not interactive and line buffer is empty */
X	    if( (*PSTRING == 0) && (INTERACT == 0) ) {
X		delactor( CURRACT );
X		continue;		/* with for loop */
X	    }
X
X	    /* Read and parse the user's input */
X	    initvars();
X	    while( 1 )
X		if( SET_EXIT( 3 ) == 0 )
X		    break;
X	    if( get_buffer() < 0 )
X		continue;
X
X	    /* Call the appropriate routines */
X	    callrouts();
X
X	    CLR_EXIT( 3 );
X	}	/* for( curract ... ) */
X    }		/* outer while( 1 ) */
X}
X
X
Xchar *
Xgetnext( which, argv )
Xint
X    *which;
Xchar
X    *argv[];
X{
X    if( *++argv[ *which ] )
X	return argv[ *which ];
X    else
X	return argv[ ++*which ];
X}
X
X
Xrand_seed()
X{
X    long
X	time();
X
X    SRAND( (int)time( (long *)0 ) );
X}
X
Xsayer( s )
Xchar
X    *s;
X{
X    char
X	word[ 80 ];
X
X    while( *s ) {
X	getchunk( &s, word );
X	if( *word == '\n' ) {
X	    crlf();
X	    continue;
X	}
X	else if( (numcol + strlen( word )) > scrwidth ) {
X	    while( *word == ' ' )	/* Eat up blanks */
X		getchunk( &s, word );
X	    if( !*word ) {
X		fflush( stdout );
X		return;			/* The string was blank terminated */
X	    }
X	    crlf();
X	}
X	numcol += strlen( word );
X#if MULTIPLEX
X	fputs( word, CURRTTY );
X	fflush( CURRTTY );
X#else
X	fputs( word, stdout );
X	fflush( stdout );
X#endif
X	if( scriptfile != (FILE *)0 )
X	    fputs( word, scriptfile );
X    }
X#if MULTIPLEX
X    fflush( CURRTTY );
X#else
X    fflush( stdout );
X#endif
X}
X
X
X/* VARARGS */
Xloadarray( a, d, first )
Xchar
X    **a;
Xstruct	adldir
X    *d;
Xint16
X    first;
X{
X    if( first && (d->numobjs * d->objsize) ) {
X	*a = calloc( d->numobjs, d->objsize );
X	if( *a == (char *)0 )
X	    error( 27 );		/* Out of memory */
X    }
X    lseek( infile, d->ptr, 0 );
X    read( infile, *a, d->numobjs * d->objsize );
X}
X
X
Xgetchunk( s, word )
Xchar
X    **s,
X    *word;
X{
X    if( !**s ) {
X	*word = '\0';
X	return;
X    }
X    if( islegal( **s ) )
X	while( islegal( **s ) )
X	    *word++ = *((*s)++);
X    else if( **s == '\t' ) {			/* Expand the tab */
X	strcpy( word, "        " );
X	word[ 8 - (numcol % 8) ] = '\0';
X	(*s)++;
X	return;
X    }
X    else
X	*word++ = *((*s)++);
X    *word = '\0';
X}
X
X
Xcrlf()
X{
X#if MULTIPLEX
X    putc( '\n', CURRTTY );
X#else
X    putchar( '\n' );
X#endif
X    if( scriptfile != (FILE *)0 )
X	putc( '\n', scriptfile );
X    numcol = 0;
X}
X
X
Xget_buffer()
X{
X    /* Loop for user input */
X    while( 1 ) {
X
X	/* Get a non-empty line */
X	if( !*PSTRING ) {
X	    PSTRING = &SAVEBUF[ 0 ];
X	    u_prompt();
X	    getstring( PSTRING );
X	}
X
X	/* Parse the string */
X	if( !parse() ) {
X	    *PSTRING = '\0';
X	    initvars();		/* Failed parse; init the variables	*/
X	    if( INTERACT )
X		continue;	/* with While (interactive actor, try again) */
X	    else {
X		delactor( CURRACT );
X	    	return -1;		/* from While (the actor needs to die) */
X	    }
X	}
X	else
X	    break;		/* The parse was successful */
X    }
X    return 0;
X}
X
X
Xint16
Xnoun_exists( adj, noun )
Xint16
X    adj, noun;
X{
X    int16
X	t;
X
X    for( t = nounspace[ noun ]; t != 0; t = objspace[ t ].others )
X	if( objspace[ t ].adj == adj )
X	    return t;
X    return -1;
X}
X
X/*** EOF adlrun.c ***/
END_OF_adlrun/adlrun.c
if test 8493 -ne `wc -c <adlrun/adlrun.c`; then
    echo shar: \"adlrun/adlrun.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f adlrun/adlspec.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"adlrun/adlspec.c\"
else
echo shar: Extracting \"adlrun/adlspec.c\" \(8484 characters\)
sed "s/^X//" >adlrun/adlspec.c <<'END_OF_adlrun/adlspec.c'
X#include <stdio.h>
X#include <fcntl.h>
X
X#include "adltypes.h"
X#include "adlprog.h"
X#include "builtins.h"
X#include "vstring.h"
X#include "adlrun.h"
X
X
Xextern
Xchar	*H_STR;
X
X
Xspecial()
X{
X    int16
X	t;
X
X    assertargs( "$spec", 1 );	/* Have to have at least ($spec F) */
X    switch( ARG( 1 ) ) {
X	case 1 :
X	    debug = !debug;
X	    break;
X	case 2 :
X	    restart();
X	    /* NOTREACHED */
X	case 3 :
X	    head_term();
X	    exit( 0 );		/* terminate game */
X	case 4 :
X	    assertargs( "$spec 4", 2 );
X	    savegame( virtstr( ARG( 2 ) ) );
X	    break;
X	case 5 :
X	    assertargs( "$spec 5", 2 );
X	    if( restoregame( virtstr( ARG( 2 ) ) ) )
X		return;	/* Skip the fixup stuff */
X	    break;
X	case 6 :
X	    callextern();
X	    break;
X	case 7 :
X	    do_wordfile();
X	    break;
X	case 8 :
X	    scripter();
X	    break;
X	case 9 :
X	    write_head();
X	    break;
X	case 10 :
X	    assertargs( "$spec 10", 2 );
X	    scrwidth = ARG( 2 );
X	    break;
X	case 11 :
X	    set_tty();
X	    break;
X	case 12 :
X	    change_tty();
X	    break;
X	default :
X	    error( 24 );	/* Illegal parameter for $spec */
X    }
X    popip();
X    t = pop();
X    sp = bp + 1;
X    bp = t;
X}
X
Xrestart()
X{
X    int
X	i;
X
X#if MULTIPLEX
X    for( i = 0; i < numact; i++ ) {
X	if( actlist[ i ].ttyfile != (FILE *)0 ) {
X	    /* Close the tty */
X	    fclose( actlist[ i ].ttyfile );
X	    *actlist[ i ].ttyname = '\0';
X	}
X    }
X#endif
X    restarted = 1;
X    DO_EXIT( 4 );
X}
X
X
Xset_tty()
X{
X#if MULTIPLEX
X    int
X	i;
X
X    /* Set the actor's TTY */
X    assertargs( "$spec 11", 3 );
X    if( (ARG( 1 ) < 0) || (ARG( 1 ) > NUMOBJ) )
X	error( 31 );		/* Illegal actor for $spec 11 */
X    for( i = 0; i < numact; i++ ) {
X	if( actlist[ i ].actor == ARG( 1 ) ) {
X	    /* We found the actor */
X	    if( actlist[ i ].ttyfile != (FILE *)0 )
X		/* Close the old tty */
X		fclose( actlist[ i ].ttyfile );
X	    actlist[ i ].ttyfile = fopen( virstr( ARG( 2 ) ), "r+" );
X	    if( actlist[ i ].ttyfile == (FILE *)0 )
X		error( 32 );	/* Bad tty name */
X	    strcpy( actlist[ i ].ttyname, virtstr( ARG( 2 ) ) );
X	    return;
X	}
X    }
X    error( 31 );		/* Illegal actor for $spec 11 */
X#endif
X}
X
X
Xchange_tty()
X{
X#if MULTIPLEX
X    int
X	i;
X
X    /* Set the current TTY */
X    assertargs( "$spec 12", 2 );
X    if( (ARG( 1 ) < 0) || (ARG( 1 ) > NUMOBJ) )
X	error( 33 );		/* Illegal actor for $spec 11 */
X    for( i = 0; i < numact; i++ ) {
X	if( actlist[ i ].actor == ARG( 1 ) ) {
X	    /* We found the actor */
X	    if( actlist[ i ].ttyfile == (FILE *)0 )
X		CURRTTY = SYSTTY;
X	    else
X		CURRTTY = actlist[ i ].ttyfile;
X	    return;
X	}
X    }
X    error( 33 );		/* Illegal actor for $spec 12 */
X#endif
X}
X
X
Xinvert( s, n )
Xchar
X    *s;
Xint16
X    n;
X{
X    int16
X	i;
X
X    for( i = 0; i < n; i++ )
X	s[ i ] ^= CODE_CHAR;
X}
X
X
Xsavegame( savename )
Xchar
X    *savename;
X{
X    int
X	savefile,
X	cmask;
X    char
X	tempstr[ 80 ];
X    int16
X	yesno(),
X	temp,
X	i;
X    struct macro
X	*m;
X
X    RETVAL = 0;
X    savefile = open( savename, RB );
X    if( savefile >= 0 ) {
X	close( savefile );
X	sayer( "File " );
X	sayer( savename );
X	sayer( " already exists. Destroy it? " );
X	if( !yesno() )
X	    return;
X    }
X    savefile = open( savename, WB );
X    if( savefile < 0 ) {
X	sayer( "Error opening file " );
X	sayer( savename );
X	sayer( "\n" );
X	return;
X    }
X    invert( savec, numsave );
X    for( i = 0; i < numact; i++ ) {
X	strcpy( tempstr, actlist[ i ].linebuf );
X	strcpy( actlist[ i ].savebuf, tempstr );
X	actlist[ i ].linebuf = actlist[ i ].savebuf;
X    }
X    temp = nummacro();
X    write( savefile, &hdr.adlid,	  sizeof( int32 ) );
X    write( savefile, &numsave,		  sizeof( int16 ) );
X    write( savefile, savec,		  numsave );
X    write( savefile, &numact,		  sizeof( int16 ) );
X    write( savefile, actlist,	numact *  sizeof( struct actrec ) );
X    write( savefile, vecverb,	10 *	  sizeof( int16 ) );
X    write( savefile, &currturn,		  sizeof( int16 ) );
X    write( savefile, &prompter,		  sizeof( int16 ) );
X    write( savefile, &numd,		  sizeof( int16 ) );
X    write( savefile, demons,	10 *	  sizeof( int16 ) );
X    write( savefile, &numf,		  sizeof( int16 ) );
X    write( savefile, fuses,	10 *	  sizeof( int16 ) );
X    write( savefile, ftimes,	10 *	  sizeof( int16 ) );
X    write( savefile, f_actors,	10 *	  sizeof( int16 ) );
X    write( savefile, objspace,	NUMOBJ  * sizeof( struct objrec ) );
X    write( savefile, verbspace,	NUMVERB * sizeof( struct verbrec ) );
X    write( savefile, stack,	NUMVAR  *  sizeof( int16 ) );
X    write( savefile, &temp,		  sizeof( int16 ) );
X    for( m = mactab; m; m = m->next ) {
X	invert( m->name, 10 );
X	invert( m->val, 80 );
X	write( savefile, m->name, 10 );
X	write( savefile, m->val,  80 );
X	invert( m->name, 10 );
X	invert( m->val, 80 );
X    }
X    close( savefile );
X#if UNIX
X    cmask = umask( 0 );
X    (void)umask( cmask );
X    chmod( savename, 0666 & ~cmask );
X#endif
X    invert( savec, numsave );
X    RETVAL = 1;
X}
X
X
Xrestoregame( savename )
Xchar
X    *savename;
X{
X    int
X	savefile;
X    char
X	mname[ 10 ],
X	mval[ 80 ];
X    int32
X	tempid;
X    int16
X	num,
X	i;
X
X    savefile = open( savename, RB );
X    if( savefile < 0 ) {
X	sayer( "Error opening file " );
X	sayer( savename );
X	sayer( "\n" );
X	return 0;
X    }
X    read( savefile, &tempid,	sizeof( int32 ) );
X    if( tempid != hdr.adlid ) {
X	sayer( "Error: \"" );
X	sayer( savename );
X	sayer( "\" is not a save file for this game.\n" );
X	return 0;
X    }
X#if MULTIPLEX
X    for( i = 0; i < numact; i++ )
X	if( actlist[ i ].ttyfile != (FILE *)0 )
X	    /* Close the tty */
X	    fclose( actlist[ i ].ttyfile );
X#endif
X    read( savefile, &numsave,		 sizeof( int16 ) );
X    read( savefile, savec,		 numsave );
X    read( savefile, &numact,		 sizeof( int16 ) );
X    read( savefile, actlist,	numact * sizeof( struct actrec ) );
X    read( savefile, vecverb,	10 *	 sizeof( int16 ) );
X    read( savefile, &currturn,		 sizeof( int16 ) );
X    read( savefile, &prompter,		 sizeof( int16 ) );
X    read( savefile, &numd,		 sizeof( int16 ) );
X    read( savefile, demons,	10 *	 sizeof( int16 ) );
X    read( savefile, &numf,		 sizeof( int16 ) );
X    read( savefile, fuses,	10 *	 sizeof( int16 ) );
X    read( savefile, ftimes,	10 *	 sizeof( int16 ) );
X    read( savefile, f_actors,	10 *	 sizeof( int16 ) );
X    read( savefile, objspace,	NUMOBJ * sizeof( struct objrec ) );
X    read( savefile, verbspace,	NUMVERB * sizeof( struct verbrec ) );
X    read( savefile, stack,	NUMVAR * sizeof( int16 ) );
X    read( savefile, &num,		 sizeof( int16 ) );
X    clearmacro();
X    for( i = 0; i < num; i++ ) {
X	read( savefile, mname,	10 );
X	read( savefile, mval,	80 );
X	invert( mname, 10 );
X	invert( mval, 80 );
X	define( mname, mval );
X    }
X    close( savefile );
X
X    /* Fix up the actlist string pointers, which may have changed since
X       the file was saved. */
X    for( i = 0; i < numact; i++ )
X	actlist[ i ].linebuf = actlist[ i ].savebuf;
X
X    /* Decode the saved character buffer */
X    invert( savec, numsave );
X
X#if MULTIPLEX
X    /* Reopen the actor tty's */
X    for( i = 0; i < numact; i++ )
X	if( actlist[ i ].ttyfile != (FILE *)0 )
X	    actlist[ i ].ttyfile = fopen( actlist[ i ].ttyname, "r+" );
X#endif
X
X    /* It was a successful restore, so stop running */
X    ip = 0L;
X    bp = sp = NUMVAR;
X    return 1;
X}
X
X
Xdo_wordfile()
X{
X    assertargs( "$spec 7", 2 );
X    if( wordwrite )
X	fclose( wordfile );
X    wordwrite = 0;
X    if( ARG( 2 ) ) {
X	wordwrite = 1;
X	wordfile = fopen( virtstr( ARG( 2 ) ), "a" );
X    }
X}
X
X
Xcallextern()
X{
X#if UNIX
X    int
X	i;
X    char
X	**argv,
X	*t;
X
X    /* Have to have at least ($spec 6 "name" 0) */
X    assertargs( "$spec 6", 3 );
X    if( fork() )
X	/* We're the parent - wait for the child to die */
X	RETVAL = wait( 0 );
X    else {
X	/* We're the child. Get memory for the argument vector */
X	argv = (char **)malloc( (RETVAL - 1) * sizeof( char * ) );
X	if( argv == (char **)0 )
X	    error( 27 );			/* Out of memory */
X
X	/* Fill the argument vectors */
X	for( i = 2; i < RETVAL && ARG( i ); i++ ) {
X	    t = virtstr( ARG( i ) );
X	    argv[ i - 2 ] = malloc( strlen( t ) + 1 );
X	    if( argv[ i - 2 ] == (char *)0 )
X		error( 27 );			/* Out of memory */
X
X	    strcpy( argv[ i - 2 ], t );
X	}
X
X	/* Set the last argument to be zero */
X	argv[ RETVAL - 2 ] = (char *)0;
X
X	/* Execute the program */
X	execv( argv[ 0 ], argv );
X
X	/* In case the exec failed, exit. */
X	head_term();
X	exit( -1 );
X    }
X#endif
X}
X
X
X
Xscripter()
X{
X    assertargs( "$spec 8", 2 );
X    if( scriptfile != (FILE *)0 )
X	fclose( scriptfile );
X    scriptfile = (FILE *)0;
X    if( ARG( 2 ) )
X	scriptfile = fopen( virtstr( ARG( 2 ) ), "w" );
X}
X
X/*** EOF adlspec.c ***/
END_OF_adlrun/adlspec.c
if test 8484 -ne `wc -c <adlrun/adlspec.c`; then
    echo shar: \"adlrun/adlspec.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f adlrun/rtlex.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"adlrun/rtlex.c\"
else
echo shar: Extracting \"adlrun/rtlex.c\" \(6842 characters\)
sed "s/^X//" >adlrun/rtlex.c <<'END_OF_adlrun/rtlex.c'
X#include <ctype.h>
X#include <stdio.h>
X
X#include "adltypes.h"
X#include "adlprog.h"
X#include "vstring.h"
X#include "adldef.h"
X#include "adlrun.h"
X
X#define MAXDEPTH	20	/* Maximum nesting of macros */
X
Xint16
X    t_type,		/* Current token type */
X    t_val,		/* Current token value */
X    read_t;		/* Instruction to lexer to read another token */
Xchar
X    *s,			/* Save area for current token */
X    *xp;		/* Expansion of s */
X
X
X	/***************************************************************\
X	*								*
X	*	gettoken() - Read the first token from PSTRING, macro	*
X	*	expand it, and place the type and value of the token	*
X	*	in t_type and t_val, respectively.  The actual token	*
X	*	is located in the external string s.  On an error,	*
X	*	t_type will contain one of the following values:	*
X	*		-1	:	unknown word			*
X	*		-2	:	ambiguous abbreviation		*
X	*		-3	:	invalid macro expansion		*
X	*								*
X	\***************************************************************/
X
Xgettoken()
X{
X    int
X	depth,		/* Depth of the macro expansion */
X	success;	/* Did the token expand? */
X
X
X    /* Check to see whether we want to read a new token */
X    if( !read_t ) {
X	read_t = 1;
X	return;
X    }
X
X    for( depth = 0; depth < MAXDEPTH; depth++ ) {
X	/* Get the first token from the string */
X	if( lexer() )
X	    return;		/* The lexer fully handled the token */
X
X	/* Process the token. */
X	if( !*s ) {
X	    /* The string was empty, so return SEP (separator) */
X	    t_type = SEP;
X	    t_val = 0;
X	    return;
X	}
X	else {
X	    success = try_expand();
X	    if( success < 0 ) {
X		/* An error occured during expansion */
X		t_type = -3;	/* Invalid macro expansion */
X		t_val = 0;
X		return;
X	    }
X	    else if( success == 0 ) {
X		/* The token WASN'T a macro, so process it and return. */
X		if( numberp( s ) ) {
X		    /* The token was a number. Coerce it into a string */
X		    t_type = STRING;
X		    t_val = newtstr( s );
X		}
X		else {
X		    /* The token was an identifier.  Look it up. */
X		    t_type = lookup( s, &t_val, 1 );
X		    if( t_type < 0 && wordwrite )
X			/* Write the token to the unknown words file */
X			fprintf( wordfile, "%s\n", s );
X		}
X		return;	/* Don't try to further expand this token */
X            }
X	}
X    }
X    /* If we get here, we expanded the thing MAXDEPTH times. */
X    t_type = -3;	/* Invalid macro expansion */
X}
X
X/**/
X
X	/***************************************************************\
X	*								*
X	*	lexer() - read the first token from PSTRING.  Returns	*
X	*	1 if the token is a quoted string, 0 otherwise.		*
X	*								*
X	\***************************************************************/
X
Xlexer()
X{
X    int
X	count = 0;	/* Number of chars in the token */
X    char
X	c,		/* Current char in the token */
X	*t;		/* Holding place for the beginning of the token */
X
X    eatwhite();		/* Delete leading whitespace */
X    t = s;		/* Save the starting address. */
X
X    if( *PSTRING ) {
X	/* There are indeed non-blank characters in the string */
X
X	if( !adlchr( *PSTRING ) ) {
X	    /* The current character can't appear in an identifier */
X
X	    if( (*PSTRING == '"') || (*PSTRING == '\'') ) {
X		/* We need to (recursively) find a quoted string */
X		getquotes( *PSTRING++ );
X		*(--s) = '\0';		/* Destroy closing quote */
X		s = t;
X		t_val = newtstr( s );
X		t_type = STRING;
X
X		/* Return the fact that we handled everything */
X		return 1;
X	    }
X	    else
X		/* The current character is simply punctuation */
X		*s++ = *PSTRING++;
X	}
X
X	else {
X	    /* The current character is the first of an identifier */
X
X	    while( adlchr( c = *PSTRING++ ) ) {
X		/* Read the characters into s (iff there is room in s) */
X		if( SLEN > ++count ) {
X		    if( isupper( c ) )
X			*s++ = tolower( c );
X		    else
X			*s++ = c;
X        	}
X	    }
X	    PSTRING--;		/* Put back the last character. */
X	}
X    }
X    *s = '\0';			/* Null terminate the string */
X    s = t;			/* Point to the beginning of the token */
X    return 0;			/* Further processing is required. */
X}
X
X/**/
X
X	/***************************************************************\
X	*								*
X	*	try_expand() - attempt to expand the current token.	*
X	*	Returns 1 if the token expands, 0 if the token doesn't	*
X	*	expand, and -1 if expanding the token would overflow	*
X	*	the string.						*
X	*								*
X	\***************************************************************/
X
Xtry_expand()
X{
X    char
X	tsave[ SLEN ];		/* Save area for concatenation */
X
X    xp = expand( s );
X    if( strcmp( xp, s ) != 0 ) {
X	/* The token was a macro - put it in the right place */
X
X	if( (strlen( xp ) + strlen( PSTRING )) > (SLEN - 1) ) {
X	    /* Macro expansion overflow - not enough room */
X	    return -1;		/* error */
X	}
X	else {
X	    /* PSTRING := concat( xp, PSTRING ) */
X
X	    strcpy( tsave, PSTRING );
X	    PSTRING = actlist[ curract ].savebuf;
X	    strcpy( PSTRING, xp );
X	    strcat( PSTRING, tsave );
X	    return 1;		/* successful expansion */
X	}
X    }
X    else
X	return 0;		/* It didn't expand */
X}
X
X/**/
X
X	/***************************************************************\
X	*								*
X	*	numberp( s ) - returns 1 if s is a valid signed		*
X	*	integer, 0 otherwise.					*
X	*								*
X	\***************************************************************/
X
Xnumberp( s )
Xchar
X    *s;
X{
X    if( *s == '-' ) {
X	/* Preceding minus sign */
X	s++;
X	if( !*s ) {
X	    /* Just a minus sign is NOT a number */
X	    return 0;
X	}
X    }
X    while( *s ) {
X	if( !isdigit( *s ) )
X	    return 0;
X	else
X	    s++;
X    }
X    return 1;
X}
X
X
X	/***************************************************************\
X	*								*
X	*	getquotes( ch ) - Get a quoted string delimited by ch	*
X	*	from PSTRING.  Nesting of strings is allowed, e.g.:	*
X	*								*
X	*		'The string "foobar 'bletch'" is legal.'	*
X	*								*
X	*	Note that the trailing quote is optional.  If the	*
X	*	trailing quote is absent, the end of the string is	*
X	*	delimited by the end of the line.			*
X	*								*
X	\***************************************************************/
X
Xgetquotes( ch )
Xint16
X    ch;
X{
X    while( (*PSTRING) && (*PSTRING != ch) ) {
X	*s++ = *PSTRING;
X	if( (*PSTRING == '\"') || (*PSTRING == '\'') )
X	    getquotes( *PSTRING++ );
X	else
X	    PSTRING++;
X    }
X    *s++ = ch;
X    if( *PSTRING )
X	PSTRING++;		/* Eat up closing quote */
X}
X
X
X	/***************************************************************\
X	*								*
X	*	eatwhite() - Removes leading blanks from PSTRING.	*
X	*								*
X	\***************************************************************/
X
Xeatwhite()
X{
X    while( (*PSTRING == ' ') || (*PSTRING == '\t') )
X	PSTRING++;
X}
X
X
X
X	/***************************************************************\
X	*								*
X	*	adlchr( c ) - returns 1 if c is a valid character in an	*
X	*	ADL identifier, 0 otherwise.				*
X	*								*
X	\***************************************************************/
X
Xadlchr( c )
Xint	c;
X{
X    return isalnum(c) || (c == '-');
X}
X
X/*** EOF rtlex.c ***/
END_OF_adlrun/rtlex.c
if test 6842 -ne `wc -c <adlrun/rtlex.c`; then
    echo shar: \"adlrun/rtlex.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f samples/aard/objects.adl -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"samples/aard/objects.adl\"
else
echo shar: Extracting \"samples/aard/objects.adl\" \(7768 characters\)
sed "s/^X//" >samples/aard/objects.adl <<'END_OF_samples/aard/objects.adl'
X{*** OBJECTS ***}
X
XNOUN pen(mrm2);
Xpen(weight) = 1;
Xpen(LDESC) = ($say "There is a ball-point pen here.\n");
Xpen(SDESC) = ($say "a ball-point pen");
X
XNOUN paper(mrm2);
Xrelease = paper;
Xform = paper;
Xpaper(weight) = 1;
Xpaper(LDESC) =
X    (IF ($eq ($prop paper readl) 0) THEN
X	($say "There is a slip of paper here.\n")
X     ELSE
X	($say "There is a release form here.\n")
X    )
X;
Xpaper(SDESC) =
X    (IF ($eq ($prop paper readl) 0) THEN
X	($say "a slip of paper")
X     ELSE
X	($say "a release form")
X    )
X;
X
X
XNOUN spices(irm6);
Xspices(weight) = 3;
Xspices(LDESC) = ($say "There is a bag of spices here.\n");
Xspices(SDESC) = ($say "spices");
Xspices(rarea) = 1;
Xspices(pfound) = 5;
Xspices(pplace) = 9;
X
XNOUN rupees(irm7);
Xcoins=rupees;
Xrupees(weight) = 5;
Xrupees(LDESC) = ($say "There is a bag of rupees (Indian coins) here.\n");
Xrupees(SDESC) = ($say "rupees (coins)");
Xrupees(rarea) = 1;
Xrupees(pfound) = 5;
Xrupees(pplace) = 15;
X
XNOUN coconut(irm3);
Xcoconut(weight) = 3;
Xcoconut(LDESC) = ($say "There is a large coconut here.\n");
Xcoconut(SDESC) = ($say "a coconut");
X
XNOUN rope(mrm1);
Xrope(weight) = 3;
Xrldesc =
X    (IF ($prop rope ropstf) THEN
X	($say
X"There is a long piece of rope here, magically
X  rising up in mid-air.\n"
X	)
X     ELSE
X	($say "There is a coil of rope here.\n")
X    )
X;
Xrsdesc =
X    ($say "a rope")
X;
Xrope(LDESC) = rldesc;
Xrope(SDESC) = rsdesc;
X
XNOUN clarinet(irm2);
Xclarinet(weight) = 2;
Xclarinet(LDESC) = ($say "There is a clarinet here.\n");
Xclarinet(SDESC) = ($say "clarinet");
X
XNOUN cobra(irm22);
Xcobra(NOTAKE) = TRUE;
Xcobra(LDESC) = ($say "There is a king cobra at the bottom of the pit.\n");
Xcobra(SDESC) = ($say "a cobra");
Xsnake = cobra;
Xelapid = cobra;
X
XNOUN river;
Xriver(NOTAKE) = TRUE;
X
XNOUN statue;
Xstatue(NOTAKE) = TRUE;
X
XNOUN banana(irm3);
Xbanana(weight) = 2;
Xbanana(LDESC) = ($say "There is a banana here.\n");
Xbanana(SDESC) = ($say "a banana");
X
XNOUN peel;
Xpeel(weight) = 1;
Xpeel(LDESC) = ($say "On the ground, there is a banana peel.\n");
Xpeel(SDESC) = ($say "a banana peel");
X
XNOUN vishnu(irm11);
Xvishnu(NOTAKE) = TRUE;
X
XNOUN mara(irm10);
Xmara(NOTAKE) = TRUE;
X
XNOUN lakshmi(irm12);
Xlakshmi(NOTAKE) = TRUE;
X
XNOUN crocodile;
Xcrocodile(NOTAKE) = TRUE;
X
XNOUN rhino(irm13);
Xrhino(NOTAKE) = TRUE;
Xrhino(LDESC) =
X    (IF ($prop rhino cutflg) THEN
X	($say "There is a rhino sleeping here with his horn removed.\n")
X     ELSE
X	($say "There is a rhinoceros sleeping in the corner.\n")
X    )
X    (IF ($prop rhino earplg) THEN
X	($say "  There are two pieces of cotton stuck in his ears.\n")
X    )
X;
Xrhino(SDESC) = ($say "a sleeping rhino");
X
XNOUN saw(irm2);
Xsaw(weight) = 2;
Xsaw(LDESC) = ($say "There is a hack-saw on the ground.\n");
Xsaw(SDESC) = ($say "a hack-saw");
Xhacksaw = saw;
Xhack-saw = saw;
X
XNOUN horn(irm13);
Xhorn(weight) = 2;
Xhorn(NOTAKE) = TRUE;
Xhorn(LDESC) =
X    (IF ($prop rhino cutflg) THEN
X	($say "There is a rhinoceros horn here.\n")
X    )
X;
Xhorn(SDESC) =
X    (IF ($prop rhino cutflg) THEN
X	($say "a rhino horn")
X    )
X;
Xhorn(rarea) = 1;
Xhorn(pfound) = 14;
Xhorn(pplace) = 7;
X
XNOUN cotton;
Xcotton(weight) = 1;
Xcotton(LDESC) = ($say "There is a large wad of cotton on the ground.\n");
Xcotton(SDESC) = ($say "a wad of cotton");
X
XNOUN lattice(irm13);
Xlattice(NOTAKE) = TRUE;
X
XNOUN monkey(irm20);
Xmonkey(NOTAKE) = TRUE;
Xmonkey(LDESC) = ($say "There is a sacred temple monkey here.\n");
Xmonkey(SDESC) = ($say "a monkey");
X
XNOUN tandoor(irm4);
Xoven = tandoor;
Xtandoor(NOTAKE) = TRUE;
X
XNOUN comb(irm14);
Xcomb(weight) = 1;
Xcomb(LDESC) = ($say "There is an expertly carved jade comb here.\n");
Xcomb(SDESC) = ($say "a jade comb");
Xcomb(rarea) = 1;
Xcomb(pfound) = 7;
Xcomb(pplace) = 6;
X
XNOUN ruby(irm17);
Xruby(weight) = 2;
Xruby(LDESC) = ($say "There is a crimson ruby here.\n");
Xruby(SDESC) = ($say "a ruby");
Xruby(rarea) = 1;
Xruby(pfound) = 8;
Xruby(pplace) = 7;
X
XNOUN bowl(irm21);
Xbowl(weight) = 3;
Xbowl(LDESC) = ($say "There is a crystal bowl here.\n");
Xbowl(SDESC) = ($say "a bowl");
Xbowl(rarea) = 1;
Xbowl(pfound) = 10;
Xbowl(pplace) = 10;
X
XNOUN bracelet(irm23);
Xbracelet(weight) = 1;
Xbracelet(LDESC) =
X	($say "There is a golden bracelet in the shape of a snake here.\n")
X;
Xbracelet(SDESC) = ($say "a bracelet");
Xbracelet(rarea) = 1;
Xbracelet(pfound) = 11;
Xbracelet(pplace) = 6;
X
XNOUN shovel(mrm1);
Xshovel(weight) = 3;
Xshovel(LDESC) = ($say "There is a shovel here.\n");
Xshovel(SDESC) = ($say "a shovel");
X
XNOUN ears(irm13);
Xears(NOTAKE) = TRUE;
X
XNOUN pole(prm2);
Xpole(NOTAKE) = TRUE;
X
XNOUN amber(prm3);
Xamber(weight) = 2;
Xamber(LDESC) = ($say "There is a polished piece of amber here.\n");
Xamber(SDESC) = ($say "a piece of amber");
Xamber(rarea) = 2;
Xamber(pfound) = 12;
Xamber(pplace) = 6;
X
XNOUN lamp(mrm1);
Xlamp(weight) = 3;
Xlamp(LDESC) = ($say  "There is a carbide-flame lamp here.\n");
Xlamp(SDESC) = ($say "a lamp");
X
XNOUN grate(mrm5);
Xgrate(NOTAKE) = TRUE;
X
XNOUN nugget;
Xgold = nugget;
Xnugget(weight) = 4;
Xnugget(LDESC) = ($say "There is a gold nugget lying on the ground.\n");
Xnugget(SDESC) = ($say "a gold nugget");
Xnugget(rarea) = 2;
Xnugget(pfound) = 13;
Xnugget(pplace) = 7;
X
XNOUN axe(prm1);
Xaxe(weight) = 1;
Xaxe(LDESC) = ($say "There is an stone-age axe here.\n");
Xaxe(SDESC) = ($say "an axe");
X
XNOUN spear(prm17);
Xspear(weight) = 2;
Xspear(LDESC) =
X    (IF ($prop spear tooky) THEN
X	($say "There is a Neanderthal hunting spear here.\n")
X     ELSE
X	($say "There is a Neanderthal hunting spear stuck in the ground.\n")
X    )
X;
Xspear(SDESC) = ($say "a spear");
X
XNOUN plant(prm2);
Xplant(weight) = 4;
Xplant(LDESC) = ($say "There is a strange looking potted plant here.\n");
Xplant(SDESC) = ($say "a plant");
X
XNOUN smilodon(prm6);  {Putty tat}
Xsmilo = smilodon;
Xsabre = smilodon;
Xsmilodon(NOTAKE) = TRUE;
X
XNOUN troglodyte(prm8);
Xtrogl = troglodyte;
Xtroglodyte(NOTAKE) = TRUE;
X
XNOUN cheese(prm4);
Xcheese(weight) = 1;
Xcheese(LDESC) =
X    ($say "There's a piece of Swiss cheese (aged 1,000,000 years) here.\n")
X;
Xcheese(SDESC) = ($say "a piece of cheese");
X
XNOUN towel(prm4);
Xtowel(weight) = 2;
Xtowel(LDESC) = ($say "There is an old towel here.\n");
Xtowel(SDESC) = ($say "a towel");
X
XNOUN mammoth(prm14);
Xmammoth(LDESC) =
X    ($say "There is a large wooly mammoth blocking the path to the south.\n")
X;
Xmammoth(SDESC) = ($say "a mammoth");
Xelephant = mammoth;
Xpachyderm = mammoth;
X
XNOUN feet;
Xfeet(NOTAKE) = TRUE;
X
XNOUN diamond(prm12);
Xdiamond(weight) = 1;
Xdiamond(LDESC) = ($say "There is a small diamond here.\n");
Xdiamond(SDESC) = ($say "a diamond");
Xdiamond(rarea) = 2;
Xdiamond(pfound) = 7;
Xdiamond(pplace) = 8;
X
XNOUN ivory(prm15);
Xivory(weight) = 2;
Xivory(LDESC) = ($say "There is a piece of ivory here.\n");
Xivory(SDESC) = ($say "a piece of ivory");
Xivory(rarea) = 2;
Xivory(pfound) = 9;
Xivory(pplace) = 8;
X
XNOUN pendant;
Xpendant(weight) = 2;
Xpendant(LDESC) = ($say "There is a ancient pendant here.\n");
Xpendant(SDESC) = ($say "a pendant");
Xpendant(rarea) = 2;
Xpendant(pfound) = 14;
Xpendant(pplace) = 4;
X
XNOUN cairn(prm18);
Xskulls = cairn;
Xcairn(NOTAKE) = TRUE;
X
XNOUN bear(prm19);
Xbear(NOTAKE) = TRUE;
Xbear(LDESC) =
X    ($say "There is a ferocious cave bear blocking your path to the north.\n")
X;
Xbear(SDESC) = ($say "a cave bear");
X
XNOUN necklace(prm20);
Xnecklace(weight) = 1;
Xnecklace(LDESC) = ($say "There is a pearl necklace here.\n");
Xnecklace(SDESC) = ($say "a necklace");
Xnecklace(rarea) = 2;
Xnecklace(pfound) = 13;
Xnecklace(pplace) = 6;
X
XNOUN tyranosaur(prm22);
Xtyranosaur(NOTAKE) = TRUE;
X
XNOUN ring(prm23);
Xring(weight) = 1;
Xring(LDESC) = ($say "There is a large diamond ring here.\n");
Xring(SDESC) = ($say "a ring");
Xring(rarea) = 2;
Xring(pfound) = 13;
Xring(pplace) = 10;
X
XNOUN hole;
Xhole(NOTAKE) = TRUE;
X
XNOUN newspaper(mrm1);
Xnewspaper(weight) = 1;
Xnewspaper(LDESC) = ($say "There is a copy of a newspaper here.\n");
Xnewspaper(SDESC) = ($say "a newspaper");
X
XNOUN crack;
Xcrack(NOTAKE) = TRUE;
XNOUN shaft;
Xshaft(NOTAKE) = TRUE;
END_OF_samples/aard/objects.adl
if test 7768 -ne `wc -c <samples/aard/objects.adl`; then
    echo shar: \"samples/aard/objects.adl\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 8 \(of 11\).
cp /dev/null ark8isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 11 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
    echo Making adl.doc
    (cd man; cat doc.aa doc.ab doc.ac >adl.doc; rm doc.a[a-c])
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0
