games-request@tekred.TEK.COM (08/05/87)
Submitted by: cunniff%hpda@hplabs.HP.COM (Ross Cunniff)
Comp.sources.games: Volume 2, Issue 23
Archive-name: adl/Part06
#! /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 6 (of 11)."
# Contents: adlrun/adlmach.c misc/adldebug.c samples/aard/objrouts.adl
# samples/demos/actdemo.adl
# Wrapped by billr@tekred on Tue Aug 4 16:27:43 1987
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f adlrun/adlmach.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"adlrun/adlmach.c\"
else
echo shar: Extracting \"adlrun/adlmach.c\" \(5979 characters\)
sed "s/^X//" >adlrun/adlmach.c <<'END_OF_adlrun/adlmach.c'
X#include <stdio.h>
X
X#include "adltypes.h"
X#include "adlprog.h"
X#include "adlrun.h"
X#include "adldef.h"
X#include "virtmem.h"
X
X
Xextern
Xstruct pagetab codetab;
X
Xextern
Xint16 filenum, /* From adlerr.c */
X linenum, /* From adlerr.c */
X foundfile; /* From adlerr.c */
X
X
Xcallrouts()
X{
X int16
X i, dirobj;
X
X if( dwimi() < 0 ) /* Iobj DWIMMING */
X return;
X
X if( dwimd() < 0 ) /* Dobj DWIMMING */
X return;
X
X for( (dirobj = NumDobj ? NumDobj : 1), i = 0; i < dirobj; i++ ) {
X if( SET_EXIT( 2 ) != 0 )
X /* $exit 2 */
X continue;
X
X *Conj = Conj[ i ];
X *Dobj = Dobj[ i ];
X
X Phase = 2;
X if( SET_EXIT( 0 ) == 0 )
X /* Actor ACTION */
X callone( objspace[ CURRACT ].props[ _ACT - 17 ] );
X
X Phase = 3;
X if( SET_EXIT( 0 ) == 0 )
X /* Verb PREACT */
X callone( verbspace[ Verb ].preact );
X
X Phase = 4;
X if( SET_EXIT( 0 ) == 0 )
X /* Indirect object ACTION */
X callone( objspace[ ((Iobj < 0)?_STRING:Iobj) ].props[ _ACT - 17 ] );
X
X Phase = 5;
X if( SET_EXIT( 0 ) == 0 )
X /* Dobj ACTION */
X callone( objspace[((*Dobj < 0)?_STRING:*Dobj)].props[ _ACT - 17 ] );
X
X Phase = 6;
X if( SET_EXIT( 0 ) == 0 )
X /* Verb ACTION */
X callone( verbspace[ Verb ].postact );
X }
X CLR_EXIT( 2 );
X
X Phase = 7;
X if( SET_EXIT( 0 ) == 0 )
X /* ROOM ACTION */
X callone( objspace[ objspace[ CURRACT ].loc ].props[ _ACT - 17 ] );
X CLR_EXIT( 0 );
X
X CLR_EXIT( 1 );
X}
X
X
Xexecdems()
X{
X int16
X i;
X
X if( !numact ) {
X fputs( "No actors active. ADL aborting.\n", stderr );
X head_term();
X exit( -1 );
X }
X for( i = 0; i < numd; i++ )
X callone( demons[ i ] );
X}
X
X
Xexecfuses()
X{
X int16
X i;
X
X for( i = numf - 1; i >= 0; i-- )
X if( (ftimes[ i ] <= currturn) && (f_actors[ i ] == CURRACT) ) {
X ip = routspace[ fuses[ i ] ];
X push( 1 ); /* stackdepth */
X push( bp );
X push( 0 ); /* ip (make it 0 so runprog returns
X after executing just this fuse */
X bp = sp - 3; /* new bp */
X runprog();
X if( sp <= NUMVAR ) /* We did a $exit */
X return;
X pop(); /* retval */
X delfuse( CURRACT, fuses[ i ] );
X }
X}
X
X
Xrunprog()
X{
X#if DEBUG
X address
X tip;
X#endif
X int16
X instr,
X t,
X t1;
X#if DEBUG
X int16
X tbp,
X tsp;
X#endif
X
X while( ip ) {
X#if DEBUG
X tip = ip;
X tbp = bp;
X tsp = sp;
X t1 = 0;
X#endif
X instr = vm_get8( (int32)(ip++), &codetab );
X if( instr & PUSHN ) {
X if( instr & 0x07F )
X t = 0xFF00 | instr; /* Sign extend the thing */
X else
X t = 0;
X instr = PUSHN;
X push( t );
X#if DEBUG
X t1 = t;
X#endif
X }
X else if( instr & (PUSHARG | PUSHLOCL | CALL) ) {
X t = instr & 0x01F;
X instr &= (PUSHARG | PUSHLOCL | CALL);
X switch( instr ) {
X case PUSHARG :
X if( t )
X push( stack[ bp + t ] );
X else
X push( stack[ bp ] - 1 );
X break;
X case PUSHLOCL :
X push( bp + stack[ bp ] + 2 + t );
X break;
X case CALL :
X docall( t );
X break;
X }
X#if DEBUG
X t1 = t;
X#endif
X }
X else if( instr & (PUSHS | JMP | JMPZ) ) {
X switch( instr & (PUSHS | JMP | JMPZ) ) {
X case PUSHS :
X t = (instr & 0x03) << 8;
X t |= (vm_get8( (int32)(ip++), &codetab ) & 0x0FF);
X push( t );
X#if DEBUG
X t1 = t;
X#endif
X break;
X case JMP :
X t1 = vm_get16( (int32)ip, &codetab ) & 0x0FFFF;
X ip = t1;
X break;
X case JMPZ :
X t1 = vm_get16( (int32)ip, &codetab ) & 0x0FFFF;
X if( stack[ sp - 1 ] == 0 )
X ip = t1; /* Jump to the target */
X else
X ip += 2; /* Skip the operand */
X break;
X }
X instr &= (PUSHS | JMP | JMPZ);
X }
X else switch( instr ) {
X case POP :
X pop();
X break;
X case PUSHME :
X push( CURRACT );
X break;
X case RET :
X doret();
X break;
X case PUSH :
X t = vm_get16( (int32)ip, &codetab );
X ip += 2; /* Skip over operand */
X push( t );
X#if DEBUG
X t1 = t;
X#endif
X break;
X#if DEBUG
X case FILEN :
X foundfile = 1;
X t = vm_get16( (int32)ip, &codetab );
X ip += 2;
X filenum = t;
X t1 = t;
X break;
X case LINEN :
X foundfile = 1;
X t = vm_get16( (int32)ip, &codetab );
X ip += 2;
X linenum = t;
X t1 = t;
X break;
X#endif
X default :
X error( 11 ); /* Illegal instruction */
X }
X#if DEBUG
X if( debug ) {
X fprintf( stderr, "ip = %d, bp = %d, sp = %d, instr = 0x%02x %d\n",
X tip, tbp, tsp, instr, t1 );
X printstack();
X }
X#endif
X }
X}
X
X
X#if DEBUG
Xpush( x )
Xint16
X x;
X{
X stack[ sp++ ] = x;
X if( sp >= STACKSIZE )
X error( 8 ); /* Stack overflow */
X}
X
X
Xint16
Xpop()
X{
X if( sp <= NUMVAR )
X error( 9 ); /* Stack underflow */
X return stack[ --sp ];
X}
X#endif
X
X
Xdoret()
X{
X int16
X retval, tbp;
X
X retval = pop();
X sp = bp + stack[ bp ] + 2; /* Remove locals from stack */
X popip();
X tbp = pop();
X sp = bp;
X bp = tbp;
X push( retval );
X}
X
X
Xbreaker()
X{
X printf( "***BREAK***\n" );
X exit( 1 );
X}
X
X
Xdocall( stackdepth )
Xint16
X stackdepth;
X{
X int16
X which;
X
X checkbreak( breaker ); /* Check for ^C */
X push( bp );
X puship();
X bp = sp - stackdepth - 2;
X which = stack[ bp ];
X#if DEBUG
X if( debug )
X fprintf( stderr, "Calling routine %d\n", which );
X#endif
X stack[ bp ] = stackdepth;
X if( which < 0 ) {
X dosysfunc( which );
X }
X#if DEBUG
X else if( which > NUMROUT )
X error( 10 ); /* Illegal routine call */
X#endif
X else {
X ip = routspace[ which ];
X if( !ip ) /* null routine */ {
X push( 0 );
X doret();
X }
X }
X}
X
X
X#if DEBUG
Xprintstack()
X{
X int16
X i;
X
X fputs( "Stack = ", stderr );
X for( i = NUMVAR; i < sp; i++ )
X fprintf( stderr, "%04x ", stack[ i ] );
X fputs( "\n", stderr );
X}
X#endif
X
X
Xcallone( rp )
Xint16
X rp;
X{
X#if DEBUG
X if( debug )
X fprintf( stderr, "Calling routine %d\n", rp );
X#endif
X
X if( !rp )
X return;
X#if DEBUG
X else if( (rp < 0) || (rp > NUMROUT) )
X error( 12 ); /* Illegal routine call */
X#endif
X bp = sp = NUMVAR;
X ip = routspace[ rp ];
X push( 1 ); /* stackdepth */
X push( NUMVAR ); /* bp */
X push( 0 ); /* ip */
X runprog();
X}
X
X
Xu_prompt()
X{
X callone( prompter );
X}
X
X/*** EOF adlmach.c ***/
END_OF_adlrun/adlmach.c
if test 5979 -ne `wc -c <adlrun/adlmach.c`; then
echo shar: \"adlrun/adlmach.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f misc/adldebug.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"misc/adldebug.c\"
else
echo shar: Extracting \"misc/adldebug.c\" \(16449 characters\)
sed "s/^X//" >misc/adldebug.c <<'END_OF_misc/adldebug.c'
X#if UNIX
X# include <signal.h>
X#endif
X#include <ctype.h>
X#include <stdio.h>
X#include <fcntl.h>
X
X#include "adltypes.h"
X#include "adlprog.h"
X#include "adldef.h"
X#include "vstring.h"
X#include "virtmem.h"
X
X#define NUMCODE (hdr.codeindex.numobjs * 512)
X
X#undef max
X#undef min
X#define max(a,b) (a > b ? a : b)
X#define min(a,b) (a < b ? a : b)
X
Xchar
X *inname; /* Input file name */
Xint
X infile; /* Input file */
X
Xstruct pagetab
X codetab; /* Virtual memory table */
X
Xaddress
X *sortedrouts, /* Sorted list of routine entry points */
X bot, top; /* Beginning and ending of action range */
Xint16
X blocked, /* Semaphore for breaker */
X was_signaled, /* Were we signaled? */
X my_nums; /* Temporary for virtual strings */
Xstruct symbol
X *symtab; /* Symbol table */
X
Xstruct header hdr; /* Actual header */
Xstruct verbrec *verbspace; /* Verb contents */
Xstruct objrec *objspace; /* Object contents */
Xstruct preprec *prepspace; /* Preposition contents */
Xstruct vp_syn *verbsyn; /* Verb synonyms */
Xint16 *varspace; /* Stack & variables */
Xint16 *nounspace; /* Noun indices */
Xaddress *routspace; /* Routine indexes */
Xint32 *str_tab; /* String table */
X
Xchar
X *malloc(); /* Memory allocator */
X
Xmain( argc, argv )
Xint
X argc;
Xchar
X *argv[];
X{
X if( argc != 2 ) {
X /* Too few command line arguments */
X printf( "Usage: %s dungeon.\n", argv[ 0 ] );
X exit( -1 );
X }
X inname = argv[ 1 ]; /* Save the input file name */
X init(); /* Initialize the structures */
X adldebug(); /* Do the debugging */
X}
X
X
Xinit()
X{
X int
X breaker(); /* Signal catcher */
X
X /* Open the file */
X if( (infile = open( inname, RB )) < 0 ) {
X printf( "Error opening file %s\n", inname );
X exit( -1 );
X }
X
X /* Read the header structure */
X lseek( infile, 0L, 0 );
X read( infile, &hdr, sizeof( struct header ) );
X if( hdr.magic != M_ADL ) {
X printf( "%s : not an ADL datafile.\n", inname );
X exit( -1 );
X }
X
X /* Load the arrays of things */
X loadarray( &varspace, &hdr.varindex );
X NUMROUT++;
X loadarray( &routspace, &hdr.routindex );
X NUMROUT--;
X loadarray( &symtab, &hdr.symindex );
X loadarray( &verbspace, &hdr.verbindex );
X loadarray( &objspace, &hdr.objindex );
X loadarray( &nounspace, &hdr.nounindex );
X loadarray( &str_tab, &hdr.strtabindex );
X
X /* Initialize the virtual memory routines */
X vsinit( infile, hdr.strindex.ptr, 1, (char *)NULL, (char *)NULL, &my_nums,
X str_tab );
X vm_init( infile, hdr.codeindex.ptr, &codetab, 0 );
X
X /* Print the copyright messages */
X fputs( "ADL debugger - Version 2.1 - April 28, 1987\n", stderr );
X fputs( "Copyright 1985, 1986, 1987 by Ross Cunniff\n", stderr );
X fputs( "All rights reserved.\n", stderr );
X fflush( stderr );
X
X /* Sort the routine entry points, and decode the symbol table */
X sortrouts();
X sym_decode();
X
X /* All done. Print the prompt and enable the break catcher. */
X fputs( "Type ? for help.\n", stderr );
X fflush( stderr );
X}
X
X
Xloadarray( a, d )
Xchar **a;
Xstruct adldir *d;
X{
X if( d->numobjs * d->objsize ) {
X lseek( infile, d->ptr, 0 );
X *a = malloc( d->numobjs * d->objsize );
X if( *a == (char *)0 ) {
X fprintf( stderr, "Out of memory.\n" );
X exit( -1 );
X }
X read( infile, *a, d->numobjs * d->objsize );
X }
X}
X
X
Xsortrouts()
X{
X int16
X i, j; /* Loop counters */
X char
X *used;
X
X /* Tell the user what we're doing */
X fputs( "Sorting routines...", stderr );
X fflush( stderr );
X
X /* Get memory for the sorted routines and zero it out */
X sortedrouts = (address *)malloc( sizeof( int16 ) * (NUMROUT + 1) );
X used = malloc( sizeof( char ) * (NUMROUT + 1) );
X if( (sortedrouts == (address *)0) || (used == (char *)0) ) {
X fprintf( stderr, "Out of memory.\n" );
X exit( -1 );
X }
X
X for( i = 0; i <= NUMROUT; i++ )
X used[ i ] = sortedrouts[ i ] = 0;
X
X /* Use a simple selection sort. (yeah, yeah, O(N**2), but I'm lazy) */
X for( i = 1; i <= NUMROUT; i++ ) {
X for( j = 0; j < NUMROUT; j++ ) {
X if( !used[ j ] &&
X (routspace[ j ] > routspace[ sortedrouts[ NUMROUT - i ] ]) )
X sortedrouts[ NUMROUT - i ] = j;
X }
X used[ sortedrouts[ NUMROUT - i ] ] = 1;
X }
X
X routspace[ NUMROUT ] = NUMCODE + 1;
X
X /* All done! */
X fputs( "Done.\n", stderr );
X fflush( stderr );
X sortedrouts[ NUMROUT ] = NUMROUT;
X free( used );
X}
X
X
Xsym_decode()
X{
X int16
X i, j;
X
X /* Tell the user what we're doing */
X fputs( "Decoding symbol table...", stderr );
X fflush( stderr );
X
X /* Un-encode the symbol table, by inverting each character */
X for( i = 1; i < NUMSYM; i++ ) {
X if( !*symtab[ i ].name ) {
X /* This name is null - make it a question mark */
X symtab[ i ].name[ 0 ] = '?';
X symtab[ i ].name[ 1 ] = '\0';
X }
X else {
X for( j = 0; symtab[ i ].name[ j ]; j++ )
X symtab[ i ].name[ j ] ^= CODE_CHAR;
X }
X }
X
X /* All done! */
X fputs( "Done.\n", stderr );
X fflush( stderr );
X}
X
X
Xbreaker()
X{
X if( !blocked ) {
X blocked = was_signaled = 1;
X puts( "\n" );
X }
X}
X
X
Xadldebug()
X{
X int
X prompt = 1;
X
X while( 1 ) {
X was_signaled = 0;
X blocked = 0;
X if( prompt ) {
X fflush( stdout );
X fputs( "> ", stderr );
X fflush( stderr );
X }
X prompt = 1;
X switch( getchar() ) {
X /* Execute the user's command */
X case 'a' : eatEOL(); dumpsymbols( ADJEC ); break;
X case 'd' : eatEOL(); dumpdir(); break;
X case 'g' : getargs( 0, NUMVAR - 1 ); dumpglobs(); break;
X case 'i' : getargs( 1, NUMCODE - 1 ); dumpinstr(); break;
X case 'm' : getargs( 1, NUMSTR - 1 ); dumpstrings(); break;
X case 'n' : getargs( 0, NUMNOUN - 1 ); dumpnouns(); break;
X case 'o' : getargs( 0, NUMOBJ - 1 ); dumpobjs(); break;
X case 'r' : getargs( 1, NUMROUT - 1 ); dumprouts(); break;
X case 's' : getargs( 0, NUMSYM - 1 ); dumpsymbols( 0 ); break;
X case 'v' : getargs( 0, NUMVERB - 1 ); dumpverbs(); break;
X case '?' : eatEOL(); dohelp(); break;
X case EOF :
X case 'q' : exit( 0 );
X case '\t':
X case ' ' : prompt = 0;
X case '\n': break;
X default : eatEOL(); puts( "\007" );
X }
X }
X}
X
X
XeatEOL()
X{
X while( getchar() != '\n' )
X /* NOTHING */;
X}
X
X
Xgetargs( lower, upper )
Xaddress
X lower, upper;
X{
X int
X ch;
X
X bot = top = 0;
X ch = eatwhite( ' ' );
X if( ch == '$' ) {
X bot = upper;
X ch = mygetchar();
X }
X else
X while( isdigit( ch ) ) {
X bot = 10L * bot + (ch - '0');
X ch = mygetchar();
X }
X bot = min( max( bot, lower), upper );
X ch = eatwhite( ch );
X if( ch == '\n' ) {
X top = bot;
X return;
X }
X else if( ch != '-' ) {
X top = bot - 1;
X while( ch != '\n' )
X ch = mygetchar();
X return;
X }
X
X ch = eatwhite( ' ' );
X if( ch == '$' )
X top = upper;
X else
X while( isdigit( ch ) ) {
X top = 10L * top + (ch - '0');
X ch = mygetchar();
X }
X top = min( max( top, lower ), upper );
X while( ch != '\n' )
X ch = mygetchar();
X}
X
X
Xmygetchar()
X{
X int
X ch;
X
X if( (ch = getchar()) == EOF )
X exit( 0 );
X return ch;
X}
X
X
Xeatwhite( ch )
Xint
X ch;
X{
X while( (ch == ' ') || (ch == '\t') )
X ch = mygetchar();
X return ch;
X}
X
X
Xdumpsymbols( t )
Xint16
X t;
X{
X int
X i;
X char
X *print_type();
X
X if( t ) {
X bot = 1; top = NUMSYM - 1;
X }
X for( i = bot; i <= top; i++ ) {
X checkbreak( breaker );
X if( was_signaled )
X return;
X if( t && symtab[ i ].type != t )
X continue;
X printf( "symtab[ %4d ].type = %s .val = %4d, .name = \"%s\"\n", i,
X print_type( symtab[ i ].type ),
X symtab[ i ].val, symtab[ i ].name );
X }
X}
X
X
Xchar *
Xprint_type( type )
Xint
X type;
X{
X switch( type ) {
X case NOUN : return "NOUN, ";
X case VERB : return "VERB, ";
X case ADJEC : return "ADJEC, ";
X case PREP : return "PREP, ";
X case ROUTINE : return "ROUTINE, ";
X case STRING : return "STRING, ";
X case CONST : return "CONST, ";
X case VAR : return "GLOBAL, ";
X case ARGUMENT : return "ARGUMENT,";
X case NOUN_SYN : return "NOUN_SYN,";
X case ARTICLE : return "ARTICLE, ";
X default : return "UNKNOWN, ";
X }
X}
X
X
Xdumpdir()
X{
X printf( "File name is %s\n", inname );
X printf( "ADL id is %d\n", hdr.adlid );
X printf( "%8d bytes in instructions\n",
X hdr.codeindex.numobjs * hdr.codeindex.objsize );
X printf( "%8ld bytes in messages\n\n",
X (int32)((int32)hdr.strindex.numobjs * (int32)hdr.strindex.objsize ) );
X printf( "%8d bytes in %8d string table entries\n",
X 4*hdr.strtabindex.numobjs, hdr.strtabindex.numobjs );
X printf( "%8d bytes in %8d symbols",
X NUMSYM*hdr.symindex.objsize, NUMSYM );
X printf( " (%d legal)\n", find_leg() );
X printf( "%8d bytes in %8d verbs\n",
X NUMVERB*hdr.verbindex.objsize, NUMVERB );
X printf( "%8d bytes in %8d objects\n", NUMOBJ*hdr.objindex.objsize, NUMOBJ );
X printf( "%8d bytes in %8d nouns\n",
X NUMNOUN*hdr.nounindex.objsize, NUMNOUN );
X printf( "%8d bytes in %8d routines\n",
X NUMROUT*hdr.routindex.objsize,NUMROUT);
X printf( "%8d bytes in %8d globals\n",
X NUMVAR * hdr.varindex.objsize, NUMVAR );
X printf( "%8d adjectives\n", findone( ADJEC ) );
X printf( "%8d articles\n", findone( ART ) );
X}
X
X
Xfind_leg()
X{
X int
X i, num_leg;
X
X num_leg = 0;
X for( i = 0; i < NUMSYM; i++ )
X if( *symtab[ i ].name != '?')
X num_leg++;
X return num_leg;
X}
X
X
Xfindone( type )
Xint
X type;
X{
X int
X i, num;
X
X num = 0;
X for( i = 1; i < NUMSYM; i++ )
X if( symtab[ i ].type == type )
X num++;
X return num;
X}
X
X
Xdumpglobs()
X{
X int
X i;
X
X fputs( "Globals:\n", stdout );
X for( i = bot; i <= top; i++ ) {
X checkbreak( breaker );
X if( was_signaled )
X return;
X printf( "\tVAR( %d ) = %d\n", i, varspace[ i ] );
X }
X}
X
X
Xdumpinstr()
X{
X long
X i, /* Loop counter */
X lastrout; /* Last routine we've seen */
X address
X t;
X char
X printone(); /* Routine to print an instruction */
X
X /* Find which routine this instruction is in */
X lastrout = 0;
X while( (((long)routspace[ sortedrouts[ lastrout ] ]) <= ((long)bot)) &&
X (((long)lastrout) < ((long)NUMROUT)) )
X lastrout++;
X lastrout--;
X
X /* Print the instructions */
X printf( "ROUTINE %d + %ld:\n", sortedrouts[ lastrout ],
X (long)bot - (long)routspace[ sortedrouts[ lastrout ] ] );
X for( i = bot; i <= top; /* NULL */ ) {
X checkbreak( breaker );
X if( was_signaled )
X return;
X if( ((long)i) >= ((long)routspace[ sortedrouts[ lastrout + 1 ] ]) ) {
X /* We crossed a routine boundary */
X if( lastrout < NUMROUT ) {
X lastrout++;
X printf( "ROUTINE %d:\n", sortedrouts[ lastrout ] );
X }
X else
X return;
X }
X t = i;
X (void)printone( &t );
X i = t;
X }
X}
X
X
Xchar
Xprintone( addr )
Xaddress
X *addr;
X{
X char
X opr, *s;
X address
X num;
X int16
X opnd;
X
X opr = vm_get8( (int32)(*addr), &codetab );
X if( opr & PUSHN ) {
X /* The high order bit is set - this is a PUSH NEG */
X if( opr & 0x7F )
X opnd = 0xFF00 | opr; /* Perform the sign extension */
X else
X opnd = 0;
X opr = num = 1;
X printf( "\t\t%08d : PUSH %d\n", *addr, opnd );
X }
X else if( opr & (PUSHARG | PUSHLOCL | CALL) ) {
X switch( opr & (PUSHARG | PUSHLOCL | CALL) ) {
X case PUSHARG : s = "PUSHARG "; break;
X case PUSHLOCL : s = "PUSHLOCL "; break;
X case CALL : s = "CALL "; break;
X }
X printf( "\t\t%08d : %s%d\n", *addr, s, opr & 0x01F );
X opr = num = 1;
X }
X else if( opr & (PUSHS | JMP | JMPZ) ) {
X switch( opr & (PUSHS | JMP | JMPZ) ) {
X case PUSHS:
X s = "PUSH ";
X opnd = (opr & 0x07) << 8;
X opnd |= vm_get8( (int32)(*addr + 1), &codetab ) & 0xFF;
X if( opnd > 1023 )
X /* Sign extend the thing */
X opnd = opnd - 2048;
X num = 2;
X break;
X case JMP :
X s = "JMP ";
X opnd = vm_get16( (int32)(*addr) + 1, &codetab ) & 0x0FFFF;
X num = 3;
X break;
X case JMPZ :
X s = "JMPZ ";
X opnd = vm_get16( (int32)(*addr) + 1, &codetab ) & 0x0FFFF;
X num = 3;
X break;
X }
X printf( "\t\t%08d : %s%d\n", *addr, s, opnd );
X opr = 1;
X }
X else {
X switch( opr ) {
X case NOP : s = "NOP "; num = 1; break;
X case PUSHME : s = "PUSHME "; num = 1; break;
X case POP : s = "POP "; num = 1; break;
X case RET : s = "RET "; num = 1; break;
X case FILEN : s = "FILEN "; num = 3; break;
X case LINEN : s = "LINEN "; num = 3; break;
X case PUSH : s = "PUSH "; num = 3; break;
X default : s = "ILLEGAL "; num = 0; opr = -1;
X }
X if( num <= 1 )
X printf( "\t\t%08ld : %s\n", (long) *addr, s );
X else
X printf( "\t\t%08ld : %s%d\n", (long) *addr, s,
X vm_get16( (int32)(*addr + 1), &codetab ) );
X }
X *addr += num;
X return opr;
X}
X
X
Xdumpstrings()
X{
X int16
X i;
X
X for( i = bot; i <= top; i++ ) {
X checkbreak( breaker );
X if( was_signaled )
X return;
X printf( "Virtstr( %d ) = %s\n", i, virtstr( i ) );
X }
X}
X
X
Xdumpnouns()
X{
X int16
X i;
X
X fputs( "Nouns:\n", stdout );
X for( i = bot; i <= top; i++ ) {
X checkbreak( breaker );
X if( was_signaled )
X return;
X printf( "\tNOUN %s\n", symtab[ find_sym( NOUN, i ) ].name );
X printf( "\t\tnounspace[ %5d ] = %d\n", i, nounspace[ i ] );
X }
X}
X
X
Xfind_sym( t, v )
Xint
X t;
Xint16
X v;
X{
X int
X i;
X
X for( i = 0; i < NUMSYM; i++ )
X if( symtab[ i ].type == t && symtab[ i ].val == v )
X return i;
X return 0;
X}
X
X
Xdumpobjs()
X{
X int16
X i, j, t;
X
X fputs( "Objects:\n", stdout );
X for( i = bot; i <= top; i++ ) {
X checkbreak( breaker );
X if( was_signaled )
X return;
X
X /* Print the object name */
X t = objspace[ i ].adj;
X if( t < 0 )
X /* This modifier is a verb */
X printf( "\tOBJECT %s %s", symtab[ find_sym( VERB, -t ) ].name,
X symtab[ find_sym( NOUN, objspace[ i ].noun ) ].name );
X else if( t > 0 )
X /* This modifier is an adjective */
X printf( "\tOBJECT %s %s", symtab[ find_sym( ADJEC, t ) ].name,
X symtab[ find_sym( NOUN, objspace[ i ].noun ) ].name );
X else
X /* This object has no modifier */
X printf( "\tOBJECT %s",
X symtab[ find_sym( NOUN, objspace[ i ].noun ) ].name );
X printf( "\t{val is %d}\n", i );
X
X /* Print the object properties */
X printf( "\t\tLOC = %d\n", objspace[ i ].loc );
X printf( "\t\tCONT = %d\n", objspace[ i ].cont );
X printf( "\t\tLINK = %d\n", objspace[ i ].link );
X printf( "\t\tOTHERS = %d\n", objspace[ i ].others );
X printf( "\t\tPROPS 1-16 = %04x\n", objspace[ i ].props1to16 );
X for( j = 0; j < _LD - 17; j++ )
X printf( "\t\tPROP[ %d ] = %d\n", j + 17, objspace[i].props[j]);
X printf( "\t\tLDESC = %d\n", objspace[ i ].props[ _LD - 17] );
X printf( "\t\tSDESC = %d\n", objspace[ i ].props[ _SD - 17 ] );
X printf( "\t\tACTION = %d\n",objspace[i].props[ _ACT - 17 ]);
X fputs( "\n", stdout );
X }
X fputs( "\n", stdout );
X}
X
X
Xdumprouts()
X{
X address
X j;
X int16
X i;
X char
X t;
X
X fputs( "Routines:\n", stdout );
X for( i = bot; i <= top; i++ ) {
X printf( "\tROUTINE %d:\n", i );
X j = routspace[ i ];
X if( !j )
X fputs( "\t\tNULL\n", stdout );
X else {
X t = printone( &j );
X while( (t != RET) && (t >= 0) ) {
X checkbreak( breaker );
X if( was_signaled )
X return;
X t = printone( &j );
X }
X }
X fputs( "\n", stdout );
X }
X}
X
X
Xdumpverbs()
X{
X int16
X i, v;
X
X fputs( "Verbs:\n", stdout );
X for( i = bot; i <= top; i++ ) {
X v = find_sym( VERB, i );
X checkbreak( breaker );
X if( was_signaled )
X return;
X printf( "\tVERB %s; { val is %d }\n", symtab[ v ].name, i );
X printf( "\t\tPREACT = %d\n", verbspace[ i ].preact );
X printf( "\t\tACTION = %d\n", verbspace[ i ].postact );
X fputs( "\n", stdout );
X }
X fputs( "\n", stdout );
X}
X
X
Xdohelp()
X{
X puts( "Commands available:" );
X puts( " a -- print out all adjectives" );
X puts( " d -- print out debugging information" );
X puts( " g RANGE -- print out globals in RANGE" );
X puts( " i RANGE -- print out instructions in RANGE" );
X puts( " m RANGE -- print out virtual strings in RANGE" );
X puts( " n RANGE -- print out nouns in RANGE" );
X puts( " o RANGE -- print out objects in RANGE" );
X puts( " q -- quit adldebug" );
X puts( " r RANGE -- print out routines in RANGE" );
X puts( " s RANGE -- print out symbols in RANGE" );
X puts( " v RANGE -- print out verbs in RANGE" );
X puts( " ? -- print out this list" );
X puts( "\nRANGE is either NUMBER, or NUMBER-NUMBER, where NUMBER" );
X puts( "is either a number or the character '$' (representing the" );
X puts( "largest possible value)." );
X}
X
X/*** EOF adldebug.c ***/
END_OF_misc/adldebug.c
if test 16449 -ne `wc -c <misc/adldebug.c`; then
echo shar: \"misc/adldebug.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f samples/aard/objrouts.adl -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"samples/aard/objrouts.adl\"
else
echo shar: Extracting \"samples/aard/objrouts.adl\" \(16618 characters\)
sed "s/^X//" >samples/aard/objrouts.adl <<'END_OF_samples/aard/objrouts.adl'
X{*** FUNNY OBJECT ROUTINES ***}
X
Xpaper(ACTION) =
X (IF ($eq ($verb) sign) THEN
X (IF ($prop paper signed) THEN
X ($say "You already signed it.\n")
X ($exit 1)
X )
X (IF ($ne ($loc pen) .ME) THEN
X ($say "You don't have anything to write with.\n")
X ($exit 1)
X )
X (IF ($ne ($loc paper) .ME) THEN
X ($say "You don't have the release with you.\n")
X ($exit 1)
X )
X ($setp paper signed 1)
X ($move grate .ALL)
X (IF ($eq ($loc .ME) mrm3) THEN
X ($say
X"In a blinding flash of light, a stone archway appears in the east wall!\n"
X )
X ELSEIF ($eq ($loc .ME) mrm5) THEN
X ($say "The grate magically disappears into thin air.\n")
X ($exit 1)
X ELSE
X ($say "You hear strange noises in the nearby rooms.\n")
X )
X ($exit 1)
X ELSEIF ($eq ($verb) read) THEN
X (IF ($ne ($loc paper) .ME) THEN
X ($say "You don't have the paper with you.\n")
X ELSE
X ($say
X" THIS CONTRACT LIMITS OUR LIABILITY
X READ IT
X
XI, the undersigned, will not hold the AARDVARK, the UCLA Computer Sciences
XDepartment, the UCLA Computer Club, Bell Labs, or the Digital Equipment
XCorporation responsible for any injuries or deaths due to my executing
Xthis program.\n"
X )
X ($setp paper readl 1)
X )
X ($exit 1)
X )
X;
X
X
Xspices(ACTION) =
X (IF ($and ($eq ($verb) throw) ($eq ($loc .ME) irm8)) THEN
X ($say "The bag of spices lands on the other side of the river.\n")
X ($move spices irm9)
X ($exit 1)
X ELSEIF ($eq ($verb) eat) THEN
X ($say "Munch, Munch Munch. It needed a little more salt.\n")
X ($move spices .ALL)
X ($exit 1)
X ELSEIF ($and ($eq ($verb) throw) ($eq ($loc .ME) irm9)) THEN
X ($say
X"The bag of spices gets intercepted by one of the
Xcrocodiles, who promptly swallows it.\n"
X )
X ($move spices .ALL)
X ($exit 1)
X )
X;
X
X
Xrupees(ACTION) =
X (IF ($and ($eq ($verb) throw)
X ($or ($eq ($loc .ME) irm8) ($eq ($loc .ME) irm9)))
X THEN
X ($say
X"The bag is too heavy to throw across the river. It lands in the middle
Xof the river and sinks to the bottom.\n"
X )
X ($move rupees .ALL)
X ($exit 1)
X )
X;
X
X
Xcoconut(ACTION) =
X (IF ($and ($eq ($loc .ME) irm19) ($eq ($verb) drop)) THEN
X (IF ($not ($prop rupees wellbt)) THEN
X ($say "The water in the well rises.\n")
X ELSE
X ($say
X"The water level in the well slowly rises.
XMagically floating on the water is a bag of rupees.\n"
X )
X ($setp rupees wellbt 0)
X ($move rupees irm19)
X )
X ELSEIF ($and ($eq ($verb) eat) ($eq ($loc coconut) .ME)) THEN
X ($say "The coconut is too large for you to consume.\n")
X ($exit 1)
X )
X;
X
X
Xclarinet(ACTION) =
X (IF ($and ($eq ($verb) play) ($eq ($loc clarinet) .ME)) THEN
X (IF ($and ($eq ($loc .ME) irm22) ($eq ($loc cobra) irm22)) THEN
X ($say
X"Your clarinet playing sounds so poor that the cobra
Xslithers off in terror.\n"
X )
X ($move cobra .ALL)
X ($exit 1)
X ELSEIF ($and ($eq ($loc .ME) irm16) ($eq ($loc rope) irm16)) THEN
X (IF ($eq ($prop rope ropstf) 0) THEN
X ($say "The rope magically extends itself up into the air.\n")
X ($setp rope ropstf 1)
X ($exit 1)
X )
X )
X ($say "Benny Goodman you ain't.\n")
X ($exit 1)
X )
X;
X
X
Xrope(ACTION) =
X (IF ($and ($prop rope ropstf) ($eq ($verb) take)) THEN
X ($setp rope ropstf 0)
X ($return 0)
X ELSEIF ($or ($eq ($loc .ME) prm2) ($eq ($loc .ME) prm3)) THEN
X (IF ($prop rope rtied) THEN
X (IF ($eq ($verb) take) THEN
X ($say "You have to untie the rope first.\n")
X ($setg Skip TRUE)
X ELSEIF ($eq ($verb) tie) THEN
X ($say "It's already tied, turkey.\n")
X ($exit 1)
X ELSEIF ($eq ($verb) untie) THEN
X (IF ($eq ($loc .ME) prm2) THEN
X ($move rope .ME)
X ($setp rope rtied 0)
X ($setp rope LDESC rldesc)
X ($setp rope SDESC rsdesc)
X ($say "You untie the rope and coil it up.\n")
X ELSEIF ($eq ($loc .ME) prm3) THEN
X ($say "It's tied down at the other end.\n")
X )
X ($exit 1)
X )
X ELSE
X (IF ($eq ($verb) tie) THEN
X (IF ($eq ($loc .ME) prm2) THEN
X ($say
X"You tie one end of the rope around the pole; the other
Xend dangles down into the canyon.\n"
X )
X ($move rope prm2)
X ($setp rope rtied 1)
X ($setp rope LDESC 0)
X ($setp rope SDESC 0)
X ($exit 1)
X )
X ($say "I see nothing to which to tie it.\n")
X ($exit 1)
X ELSEIF ($eq ($verb) untie) THEN
X ($say "It's already untied.\n")
X )
X )
X )
X;
X
X
Xriver(ACTION) =
X (IF ($and ($ne ($loc .ME) irm8) ($ne ($loc .ME) irm9)) THEN
X ($say "You see no river here.\n")
X ($exit 1)
X ELSEIF ($eq ($verb) take) THEN
X ($say "You can't do that to the river!\n")
X ($setg Skip TRUE)
X )
X;
X
X
Xcobra(ACTION) =
X (IF ($and ($eq ($verb) take) ($eq ($loc .ME) ($loc cobra))) THEN
X ($say "Taking the cobra would be a poor idea.\n")
X ($setg Skip TRUE)
X )
X;
X
X
Xcrocodile(ACTION) =
X (IF ($eq ($verb) take) THEN
X ($say "I can't get to any crocodiles from here.\n")
X ($setg Skip TRUE)
X )
X;
X
X
Xcmara =
X (IF ($eq ($verb) take) THEN
X ($say "The statue is too heavy for you to carry.\n")
X ($setg Skip TRUE)
X ($return TRUE)
X )
X ($return FALSE)
X;
X
X
Xclaks =
X (IF ($and ($or ($eq ($verb) take) ($eq ($verb) touch))
X ($eq ($prop statue tlakst) 0))
X THEN
X ($say
X"The statue slides away very easily, revealing a secret passage.\n"
X )
X ($setp statue tlakst 1)
X ($setg Skip TRUE)
X ($return TRUE)
X )
X ($return FALSE)
X;
X
X
Xmara(ACTION) =
X (IF ($eq ($loc .ME) irm10) THEN
X (cmara)
X )
X;
X
X
Xvishnu(ACTION) =
X (IF ($eq ($loc .ME) irm11) THEN
X (cmara)
X )
X;
X
X
Xlakshmi(ACTION) =
X (IF ($eq ($loc .ME) irm12) THEN
X (claks)
X )
X;
X
X
Xstatue(ACTION) =
X (IF ($or ($eq ($loc .ME) irm10) ($eq ($loc .ME) irm11)) THEN
X (IF ($not (cmara)) THEN
X ($say "That won't accomplish anything.\n")
X ($exit 1)
X )
X ELSEIF ($eq ($loc .ME) irm12) THEN
X (IF ($not (claks)) THEN
X ($say "I don't see how you can do that to a statue.\n")
X ($exit 1)
X )
X )
X;
X
X
Xbanana(ACTION) =
X (IF ($eq ($loc banana) .ME) THEN
X (IF ($eq ($verb) eat) THEN
X ($say "You eat the banana, peel and all.\n")
X ($move banana .ALL)
X ($exit 1)
X )
X )
X (IF ($eq ($loc .ME) irm20) THEN
X (IF ($eq ($verb) drop) THEN
X ($say
X"The monkey picks up the banana, eats it, and discards
Xthe banana-peel. As soon as the monkey finishes eating
Xthe banana, a bolt of lighting hits the stone slab and
Xcracks it open.\n"
X )
X ($setp monkey fedmky 1)
X ($move banana .ALL)
X ($move peel irm20)
X ($setg Skip TRUE)
X )
X )
X;
X
X
Xhorn(ACTION) =
X (IF ($prop rhino cutflg) THEN
X ($return 0)
X ELSEIF ($eq ($loc .ME) irm13) THEN
X (IF ($eq ($verb) take) THEN
X ($say "The horn is still attached to the rhino!\n")
X ($setg Skip TRUE)
X ELSEIF ($eq ($verb) cut) THEN
X (IF ($ne ($loc saw) .ME) THEN
X ($say "You don't have something to cut the horn with.\n")
X ($exit 1)
X ELSEIF ($prop rhino earplg) THEN
X ($say "You cut the horn off without waking up the rhino.\n")
X ($setp rhino cutflg 1)
X ($setp horn NOTAKE FALSE)
X ($exit 1)
X ELSE
X ($say
X"The noise of the sawing wakes up the rhinoceros who
Xtramples you to death because you disturbed his beauty sleep.\n"
X )
X (exitg)
X )
X )
X )
X;
X
X
Xlattice(ACTION) =
X (IF ($eq ($loc .ME) irm13) THEN
X (IF ($eq ($verb) take) THEN
X (IF ($prop rhino earplg) THEN
X ($say
X"You successfully take the lattice without waking the
Xrhino. Unfortunately, the lattice was the structure which supported the roof
Xof the room, and the ceiling comes crashing down upon you and breaks every
Xbone in your body.\n"
X )
X ELSE
X ($say
X"As you take the lattice, a large part of the bamboo
Xfalls down. The noise caused by the falling bamboo scares the sleeping
Xrhinoceros who tramples you in his panicked exit from the room.\n"
X )
X )
X )
X (exitg)
X )
X;
X
X
Xmonkey(ACTION) =
X (IF ($eq ($loc .ME) irm20) THEN
X (IF ($eq ($verb) feed) THEN
X (IF ($eq ($loc banana) .ME) THEN
X ($say
X"The monkey takes your banana, peels it, eats it,
Xand throws away the banana peel. As soon as he finishes eating
Xthe banana, there is a rumble from the depths of the earth and
Xa crack appears in the stone slab.\n"
X )
X ($setp monkey fedmky 1)
X ($move banana .ALL)
X ($move peel irm20)
X ($exit 1)
X )
X )
X )
X;
X
X
Xcotton(ACTION) =
X (IF ($eq ($loc .ME) irm13) THEN
X (IF ($and ($eq ($verb) drop) ($eq ($iobj) ears)) THEN
X ($say "You stick the wads of cotton into the rhino's ears.\n")
X ($move cotton .ALL)
X ($setp rhino earplg 1)
X ($setg Skip TRUE)
X ($return 0)
X )
X (IF ($eq ($loc cotton) .ALL) THEN
X (IF ($eq ($loc .ME) irm13) THEN
X (IF ($eq ($verb) take) THEN
X ($setp rhino earplg 0)
X )
X )
X )
X )
X;
X
X
Xpole(ACTION) =
X (IF ($and ($eq ($loc .ME) prm2) ($eq ($verb) take)) THEN
X ($say "The pole is firmly cemented into the ground.\n")
X ($setg Skip TRUE)
X )
X;
X
X
Xlamp(ACTION) =
X (IF ($eq ($verb) light) THEN
X (onlmp)
X ($exit 1)
X ELSEIF ($eq ($verb) douse) THEN
X (IF ($not ($prop lamp LIGHT)) THEN
X ($say "The lamp is already off!\n")
X ELSE
X ($setp lamp LIGHT 0)
X ($say "The lamp is now off.\n")
X )
X ($exit 1)
X )
X;
X
X
Xoven(ACTION) =
X (IF ($and ($eq ($loc .ME) irm4) ($eq ($verb) open)) THEN
X ($say "The door of the oven doesn't budge.\n")
X ($exit 1)
X )
X;
X
X
Xgrate(ACTION) =
X (IF ($and ($eq ($prop paper signed) 0)
X ($eq ($loc .ME) mrm5))
X THEN
X (IF ($or ($eq ($verb) open) ($eq ($verb) take)) THEN
X ($say "The grate appears to be firmly cemented into the wall.\n")
X (IF ($eq ($verb) open) THEN
X ($exit 1)
X ELSE
X ($setg Skip TRUE)
X )
X ELSEIF ($eq ($verb) shut) THEN
X ($say "The grate is already shut.\n")
X ($exit 1)
X )
X )
X;
X
X
Xweapo =
X (IF ($eq ($verb) throw) THEN
X (IF ($and ($not ($prop bear hitbr)) ($eq ($loc .ME) prm19)) THEN
X ($say "The axe bounces harmlessly off of the bear.\n")
X ($move axe prm19)
X ($exit 1)
X ELSEIF ($eq ($loc .ME) prm14) THEN
X ($say
X"The weapon that you just threw imbeds itself deep into the
Xskull of the mammoth and is covered by the mammoth's long fur so that it
Xcan't be seen. The mammoth just stares back at you blankly.\n"
X )
X ($move ($dobj) .ALL)
X ($exit 1)
X ELSEIF ($or ($eq ($loc .ME) irm8) ($eq ($loc .ME) irm9)) THEN
X ($say
X"You miss the crocodile and your weapon sinks into the river.\n"
X )
X ($move ($dobj) .ALL)
X ($exit 1)
X ELSEIF ($eq ($loc .ME) irm13) THEN
X ($say "Your weapon bounces harmlessly off of the rhino.\n")
X ($move ($dobj) irm13)
X ($exit 1)
X ELSEIF ($and ($eq ($loc .ME) prm6) ($not ($prop smilo stond))) THEN
X ($say
X"The sabre-tooth catches your weapon in its mouth and promptly
Xswallows it.\n"
X )
X ($move ($dobj) .ALL)
X ($exit 1)
X ELSEIF ($and ($eq ($loc .ME) prm8) ($not ($prop trogl killd))) THEN
X ($say
X"You hit the troglodyte, who, screaming in pain, drops the
Xgold nugget and falls over the cliff.\n"
X )
X ($setp trogl killd 1)
X ($move ($dobj) .ALL)
X ($move nugget prm8)
X ($exit 1)
X )
X )
X;
X
X
Xspear(ACTION) =
X (IF ($eq ($loc spear) .ME) THEN
X (IF ($ne ($loc .ME) prm19) THEN
X (weapo)
X )
X (IF ($eq ($verb) throw) THEN
X ($say
X"You repeatedly throw your spear at the bear. Eventually, he gets
Xbored and wanders off.\n"
X )
X ($move bear .ALL)
X ($move spear prm19)
X ($setp bear hitbr 1)
X ($exit 1)
X )
X ELSEIF ($eq ($loc .ME) prm17) THEN
X (IF ($eq ($verb) take) THEN
X (IF ($not ($prop spear tooky)) THEN
X ($say
X"You hear a loud roar as an avalanche blocks the path to your north.\n"
X )
X ($setp spear tooky 1)
X )
X )
X ELSEIF ($eq ($verb) shake) THEN
X ($say "I don't see any playwrights here.\n")
X ELSEIF ($and ($eq ($loc .ME) prm23) ($eq ($verb) take)) THEN
X ($say
X"As soon as you take the spear, the Tyranosaurus Rex closes his mouth and
Xswallows you.\n"
X )
X (exitg)
X )
X;
X
X
Xaxe(ACTION) =
X (IF ($eq ($loc axe) .ME) THEN
X (weapo)
X )
X;
X
X
Xsmilo(ACTION) =
X (IF ($and ($eq ($loc .ME) prm6) ($eq ($verb) take)) THEN
X ($say "You must be dumber than you look.\n")
X ($setg Skip TRUE)
X )
X;
X
X
Xtroglodyte(ACTION) =
X (IF ($and ($eq ($loc .ME) prm8) ($eq ($verb) take)) THEN
X ($say
X"The troglodyte does not look like he wants to be
Xcarried.\n"
X )
X ($setg Skip 1)
X )
X;
X
X
Xplant(ACTION) =
X (IF ($eq ($loc .ME) prm6) THEN
X (IF ($or ($eq ($verb) throw) ($eq ($verb) drop)) THEN
X (IF ($not ($prop smilo stond)) THEN
X ($say
X"The plant you were holding turns out to be primo grade catnip. The
Xsabre-tooth cat grabs the plant and runs off purring loudly.\n")
X ($move plant .ALL)
X ($setp smilo stond 1)
X (IF ($eq ($verb) throw) THEN
X ($exit 1)
X ELSE
X ($setg Skip TRUE)
X )
X )
X )
X )
X (IF ($eq ($verb) eat) THEN
X ($say "You completely eat the plant and now feel quite nauseous.\n")
X ($move plant .ALL)
X ($exit 1)
X )
X;
X
X
Xnugget(ACTION) =
X (IF ($and ($eq ($verb) take) ($not ($prop trogl killd))) THEN
X ($say "He ain't gonna let you take it.\n")
X ($setg Skip TRUE)
X )
X;
X
X
Xcheese(ACTION) =
X (IF ($eq ($verb) eat) THEN
X ($say "You eat the cheese, but nothing peculiar happens.\n")
X ($move cheese .ALL)
X ($exit 1)
X ELSEIF ($and ($eq ($verb) drop) ($eq ($loc .ME) prm14)) THEN
X ($say
X"As soon as you drop the cheese, a mouse runs out of the hole in the east
Xwall and takes it. This scares the mammoth who runs off in terror.\n"
X )
X ($setp mammoth blokd 1)
X ($move mammoth .ALL)
X ($move cheese .ALL)
X ($setg Skip TRUE)
X )
X;
X
X
Xmammoth(ACTION) =
X (IF ($eq ($loc mammoth) ($loc .ME)) THEN
X (IF ($eq ($verb) feed) THEN
X ($say "He doesn't look hungry.\n")
X ($exit 1)
X ELSEIF ($eq ($verb) take) THEN
X ($say "He doesn't look too easy to carry.\n")
X ($setg Skip TRUE)
X )
X )
X;
X
X
Xfeet(ACTION) =
X (IF ($eq ($verb) wipe) THEN
X (IF ($ne ($loc towel) .ME) THEN
X ($say "You don't have something to wipe them with.\n")
X ($exit 1)
X ELSE
X ($say "You just cleaned off your feet.\n")
X ($setp feet wiped 0)
X ($exit 1)
X )
X ELSEIF ($eq ($verb) touch) THEN
X ($say "You can't without bending your knees.\n")
X )
X;
X
X
Xcairn(ACTION) =
X (IF ($eq ($loc .ME) prm18) THEN
X ($say
X"How dare you do such a thing. Any idiot with just the slightest knowledge
Xof prehistoric etiquette knows that you aren't supposed to do anything to
Xa cairn.\n"
X )
X ($exit 1)
X )
X;
X
X
Xbear(ACTION) =
X (IF ($eq ($loc .ME) prm19) THEN
X (IF ($eq ($verb) take) THEN
X (IF ($not ($prop bear hitbr)) THEN
X ($say "The bear is a little too bulky to carry.\n")
X ($setg Skip TRUE)
X )
X )
X )
X;
X
X
Xtyranosaur(ACTION) =
X (IF ($and ($ne ($loc .ME) prm22) ($ne ($loc .ME) prm23)) THEN
X ($say
X"What? One of those things hasn't existed in several million years.\n"
X )
X )
X;
X
X
Xhole(ACTION) =
X (IF ($eq ($loc .ME) prm14) THEN
X ($say "That hole is too small to do anything with.\n")
X ($exit 1)
X ELSEIF ($eq ($loc .ME) irm19) THEN
X (IF ($and ($eq ($verb) drop) ($eq ($iobj) hole)) THEN
X ($say "It falls back out of the hole.\n")
X ($setg Skip TRUE)
X )
X ELSEIF ($eq ($loc .ME) irm6) THEN
X (IF ($and ($eq ($verb) drop) ($eq ($iobj) hole)) THEN
X (IF ($eq ($dobj) spices) THEN
X ($say
X"The bag of spices rips against the jagged sides of the shaft and
Xalmost all of the spices get blown away in the wind.\n"
X )
X ($move spices .ALL)
X ELSEIF ($eq ($dobj) rupees) THEN
X ($say
X"The rupees fall down the shaft into the darkness below. You
Xeventually hear a barely audible splash.\n"
X )
X ($setp rupees wellbt 1)
X ($move rupees .ALL)
X ELSE
X ($say "That doesn't fit in the hole.\n")
X )
X ($setg Skip TRUE)
X ($return 0)
X )
X ELSE
X ($say "I do not see any holes here.\n")
X ($exit 1)
X )
X;
X
X
Xnewspaper(ACTION) =
X (IF ($eq ($verb) read) THEN
X ($say
X" DAILY GNUS\n
XVol 2. 25 AUGUST\n
X\n
X"
X )
X ($say
X"Spies in the far reaches of the Museum have reported that new construction
Xis now taking place.\n\n"
X )
X ($say
X"Dungeon consultant Mr. Mctesq has recently waved his magic wand over the
Xaardvark museum. The following things should be brought to light:\n
X\tThe commands SAVE, RESTORE, and SHELL exist and work.\n"
X )
X ($say "\tENTER is a verb, but IN is a preposition.\n\n")
X ($say
X"Again, Adventurers are reminded that restocking of the museum sections will
Xbe greatly rewarded.\n\n"
X )
X ($exit 1)
X )
X;
X
X
Xcrack(ACTION) =
X (IF ($eq ($verb) jamb) THEN
X ($say "The only climbable cracks in this place are A4.\n")
X ($exit 1)
X )
X ($say
X"I can't figure that out. I'm not as smart as I am
Xcracked up to be.\n"
X )
X ($exit 1)
X;
X
X
Xshaft(ACTION) =
X (IF ($eq ($verb) jamb) THEN
X ($say "Try jamb crack (How do you jamb a shaft?)\n")
X ($exit 1)
X ELSEIF ($and ($eq @Verb drop) ($eq @Iobj shaft)) THEN
X ($setg Iobj hole)
X (($prop hole ACTION))
X )
X;
END_OF_samples/aard/objrouts.adl
if test 16618 -ne `wc -c <samples/aard/objrouts.adl`; then
echo shar: \"samples/aard/objrouts.adl\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f samples/demos/actdemo.adl -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"samples/demos/actdemo.adl\"
else
echo shar: Extracting \"samples/demos/actdemo.adl\" \(12205 characters\)
sed "s/^X//" >samples/demos/actdemo.adl <<'END_OF_samples/demos/actdemo.adl'
XINCLUDE "standard.adl"; { Include the standard package }
X
X
X{ The following are Object properties }
X
XBROKEN = 1; { Is the robot damaged? }
XTOLD = 2; { Have I told the robot something? }
XBSTATE = 17; { State of the button }
X B_OFF = 0; { Button is off }
X B_FLASH = 1; { Button is flashing }
X B_LIT = 2; { Button is lit }
X
X
X{ Global variables }
X
XVAR
X RobSave[ 6 ], { Saved sentence for the robot }
X Score; { Current score }
X
X
X{ Utility routines }
X
XROUTINE
X NoGo, Sayer, Myself, Lifter,
X DoorCk, TrapCk, RobMov, BlueCk,
X Header, Die, Skore, RobEntr,
X HatchSD;
X
X
X{ Locations in the dungeon }
X
XNOUN
X Redrm, Bluerm,
X Greenrm, Cellar,
X Endrm;
X
X
X{ Immovable objects }
X
XNOUN
X button( Bluerm ),
X door( Cellar ),
X hatch( Bluerm );
X
X
X{ Objects which may become actors }
X
XNOUN
X me( Redrm ),
X robot( Greenrm );
X
Xme(NOTAKE) = TRUE;
X
X
X{ Room descriptions }
X
XRedrm( LDESC ) =
X ($say
X"You are in a large room which is illuminated by a bright
Xred glow. Exits lie to the east and south.\n"
X )
X;
XRedrm( SDESC ) = ($return (Header "Red room" %0));
XRedrm( LIGHT ) = TRUE;
X
X
XGreenrm( LDESC ) =
X ($say
X"You are in a smallish room which is illuminated by a pleasant
Xgreen glow. The only exit is to the west.\n"
X )
X;
XGreenrm( SDESC ) = ($return (Header "Green room" %0));
XGreenrm( LIGHT ) = TRUE;
X
X
XBluerm( LDESC ) =
X ($say
X"You are in a tiny room which is barely illuminated by a
Xdim blue glow. There is an exit to the north,"
X )
X (IF ($eq ($prop button BSTATE) B_LIT) THEN
X ($say
X" and most of the floor has tilted up to reveal a hatch leading
Xdown into blackness. A button on the wall is glowing brightly."
X )
X ELSE
X ($say " and you seem to make out something on the floor.")
X (IF ($prop button BSTATE) THEN
X ($say " A button on the wall is flashing urgently.")
X ELSE
X ($say " There is a button on the wall.")
X )
X )
X ($say
X" Above the button is a sign that reads:\n\n"
X" DANGER!\n\n"
X" HIGH VOLTAGE!\n\n"
X )
X;
XBluerm( SDESC ) =
X (IF %0 THEN ($return "Blue room"))
X ($say "Blue room.\n")
X;
XBluerm( LIGHT ) = TRUE;
X
X
XCellar( LDESC ) =
X ($say
X"You are in the cellar. Far above you can be seen a dim
Xblue light."
X )
X (IF ($prop door OPENED) THEN
X ($say
X" An open door leads to the north.\n"
X )
X ELSE
X ($say
X" You can barely see the outline of a door to the north.\n"
X )
X )
X;
XCellar( SDESC ) =
X ($return (Header "Cellar" %0))
X;
XCellar( LIGHT ) = TRUE;
X
X
XEndrm( LDESC ) =
X ($say
X"You exit from the dark cellar into a land filled with singing birds,
Xblooming flowers, flowing streams, and bright blue skies. In other words,
Xyou have finished this game!\n"
X )
X ($setg Score ($plus @Score 25))
X (Skore)
X ($spec 3)
X;
XEndrm( LIGHT ) = TRUE;
X
X
X{ Verbs }
X
XVERB
X score,
X push,
X shout;
X
Xtell = TELLER;
Xsay = tell;
Xpress = push;
Xfeel = touch;
Xyell = shout;
X
X
X{ Verb routines }
X
Xtell( PREACT ) =
X (IF ($ne @Iobj robot) THEN
X { The only logical thing to talk to is the robot }
X (Sayer
X"Talking to yourself is said to be a sign of impending insanity"
X )
X ELSEIF ($ge @Dobj 0) THEN
X { You must say strings }
X (Sayer
X"You must put what you want to say in quotes"
X )
X ELSEIF ($ne ($loc robot) ($loc me)) THEN
X { The robot must be in the same place as the player }
X (IF (Myself) THEN
X ($say "You don't see the robot here.\n")
X )
X ELSE
X { Everything is OK. Add 25 points to the score }
X (IF ($not ($prop robot TOLD)) THEN
X ($setg Score ($plus @Score 25))
X ($setp robot TOLD TRUE)
X )
X ($exit 0)
X )
X ($exit 1)
X;
Xtell( ACTION ) =
X { Tell the player that we heard him }
X ($say "\"Sure thing, Boss.\"\n")
X
X { Delete the old action }
X ($delact robot)
X
X { Add the new action - a non-interactive actor }
X ($actor robot @Dobj FALSE)
X;
X
X
Xshout( PREACT ) =
X (IF ($and @Iobj ($ne @Iobj robot)) THEN
X { Shouting at things other than the robot }
X ($say "AAARRRGGGHHH!\n")
X ELSEIF ($ge @Dobj 0) THEN
X { Shouting things other than strings }
X ($say "EEEYYYAAAHHH!\n")
X ELSEIF ($prop robot BROKEN) THEN
X ($say "There is no response.\n")
X ELSE
X { Shouting at the robot - same as telling the robot }
X (IF ($not ($prop robot TOLD)) THEN
X ($setg Score ($plus @Score 25))
X ($setp robot TOLD TRUE)
X )
X ($exit 0)
X )
X ($exit 1)
X;
Xshout( ACTION ) =
X { Tell the player we heard him }
X (IF ($ne ($loc robot) ($loc me)) THEN
X ($say "In the distance you hear the words, ")
X )
X ($say "\"Sure thing, Boss\"\n")
X
X { Delete the old robot action }
X ($delact robot)
X
X { Add the new robot action }
X ($actor robot @Dobj FALSE)
X;
X
X
Xpush( PREACT ) =
X { Expect a plain direct object }
X (Expect ($or ONE_OBJ PLAIN_OBJ) NO_OBJ)
X (CheckAvail)
X;
Xpush( ACTION ) =
X (Sayer "That doesn't seem to do anything")
X ($exit 1)
X;
X
X
Xscore(PREACT) =
X { Score can accept no objects }
X (Expect NO_OBJ NO_OBJ)
X (Skore)
X ($exit 1)
X;
X
X
X{ Object properties }
X
Xbutton( SDESC ) =
X (IF ($eq ($prop button BSTATE) B_OFF) THEN
X ($say "a button")
X ELSEIF ($eq ($prop button BSTATE) B_FLASH) THEN
X ($say "an urgently flashing button")
X ELSE
X ($say "a brightly lit button")
X )
X;
Xbutton( ACTION ) =
X (IF ($and (Myself)
X ($or ($eq @Verb push)
X ($eq @Verb take)
X ($eq @Verb touch)
X )
X )
X THEN
X { The player tried to do something with the button }
X ($say
X"As you reach for the button, a 10,000,000 volt bolt of lightning
Xarcs toward your finger, disintegrating you upon impact.\n"
X )
X (Die)
X ELSEIF ($and ($eq @Verb push) ($eq ($prop button BSTATE) B_OFF)) THEN
X { The robot pushed the button }
X ($setp button BSTATE B_FLASH)
X ($setg Score ($plus @Score 50))
X ($sfus me Lifter 4)
X ($exit 1)
X ELSEIF ($eq @Verb take) THEN
X { Can't take the button }
X ($setg Skip TRUE)
X )
X;
X
X
XSimpleRobot = "I am just a simple robot";
Xrobot( LDESC ) = ($say "There is a robot here.\n");
Xrobot( SDESC ) = ($say "a robot");
Xrobot( ACTION ) =
X (IF (Myself) THEN
X { I'm doing something with the robot }
X (IF ($eq @Verb tell) THEN
X (IF ($prop robot BROKEN) THEN
X ($say "There is no response.\n")
X ($exit 1)
X )
X ELSEIF ($eq @Verb take) THEN
X ($say "The robot weighs at least 500 pounds!\n")
X ($exit 1)
X )
X ELSEIF ($eq ($phase) 2) THEN
X { This is being called as the Actor ACTION }
X (ActAction)
X (IF ($and ($ne @Verb push)
X ($ne @Verb go)
X ($ne @Verb wait)
X ($ne @Verb take)
X ($or ($lt @Verb north) ($gt @Verb down)))
X THEN
X { The robot has a VERY simple vocabulary }
X (Sayer SimpleRobot)
X ($delact robot)
X ($exit 1)
X )
X ELSEIF ($eq @Verb take) THEN
X { The robot is trying to take itself }
X (Sayer "Mmmph! Akkk!! GGGGRR!! No can do. Sorry")
X ($setg Skip TRUE)
X ELSE
X { The robot is doing something to itself }
X (Sayer SimpleRobot)
X ($delact robot)
X ($exit 1)
X )
X;
Xrobot( SAVESENT ) = RobSave;
X
X
X
X{ We break me( ACTION ) out into a named routine because
X StdInit overwrites that property and we need to restore it }
X
XMeAct =
X (IF ($eq ($phase) 2) THEN
X { This is the Actor ACTION - call standard's actor action }
X (ActAction)
X ELSEIF ($eq @Verb take) THEN
X (Sayer "I thought you would never ask")
X ($setg Skip TRUE)
X )
X;
X
X
X{ We break hatch( SDESC ) out into a named routine because
X the hatch isn't visible until after Lifter has executed }
X
XHatchSD = ($say "an open hatch");
XHatchMSG = "The hatch doesn't budge";
Xhatch( ACTION ) =
X (IF ($eq @Verb take) THEN
X { Can't take the hatch }
X (Sayer HatchMSG)
X ($setg Skip TRUE)
X ELSEIF ($or ($eq @Verb open) ($eq @Verb push)) THEN
X { Can't open or push it, either }
X (Sayer HatchMSG)
X ($exit 1)
X )
X;
Xhatch( OPENS ) = TRUE;
Xhatch( NOTAKE ) = TRUE;
X
X
Xdoor( SDESC ) = ($say "a door");
Xdoor( ACTION ) =
X (IF ($eq @Verb take) THEN
X ($say "You can't take a door!\n")
X ($setg Skip TRUE)
X )
X;
Xdoor( OPENS ) = TRUE;
X
X
X{ Transition routines. Note that RobMov is used in $miss.
X This produces the 'The robot exits to the <direction>
X messages. The calls to RobEntr produce the messages like
X 'The robot enters from the <direction>. }
X
XBluerm( ACTION ) =
X ($miss RobMov NoGo NoGo NoGo NoGo TrapCk 0 0 0 0)
X ($hit .ME Redrm 0 0 0 0 Cellar 0 0 0 0)
X (RobEntr)
X;
X
X
XRedrm( ACTION ) =
X ($miss NoGo BlueCk RobMov NoGo NoGo NoGo 0 0 0 0)
X ($hit .ME 0 Bluerm Greenrm 0 0 0 0 0 0 0)
X (RobEntr)
X;
X
X
XGreenrm( ACTION ) =
X ($miss NoGo NoGo NoGo RobMov NoGo NoGo 0 0 0 0)
X ($hit .ME 0 0 0 Redrm 0 0 0 0 0 0)
X (RobEntr)
X;
X
X
XCellar( ACTION ) =
X ($miss DoorCk NoGo NoGo NoGo BlueCk NoGo 0 0 0 0)
X ($hit .ME Endrm 0 0 0 Bluerm 0 0 0 0 0)
X (RobEntr)
X;
X
X
X{ Routines }
X
X{ (Myself) - returns 1 if "me" is the current actor; 0 otherwise }
XMyself =
X ($return ($eq .ME me))
X;
X
X
X{ (Sayer str) - Says a string with appropriate quoting, depending
X on whether the robot or the player is doing the saying. }
XSayer =
X (IF (Myself) THEN
X ($say %1 ".\n")
X ELSEIF ($eq ($loc robot) ($loc me)) THEN
X ($say "\"" %1 ", Boss.\"\n")
X ELSE
X ($say "You hear a muffled voice in the distance.\n")
X )
X;
X
X
X{ (NoGo) - "You can't go that way" }
XNoGo =
X (Sayer "You can't go that way")
X ($exit 1)
X;
X
X
X{ (Header str arg0) - To accomplish the printing of header lines,
X each location SDESC need to return a string if a parameter is
X passed to it. By doing ($return (Header <sdesc> %0)), we can
X centralize the saying/returning decision. }
XHeader =
X (IF ($not %2) THEN
X ($say %1 ".\n")
X )
X ($return %1)
X;
X
X
XRobMov =
X (IF ($and ($not (Myself)) ($eq ($loc robot) ($loc me))) THEN
X ($say
X "The robot exits to the "
X (IF ($eq @Verb e) THEN
X ($val "east")
X ELSEIF ($eq @Verb w) THEN
X ($val "west")
X ELSEIF ($eq @Verb s) THEN
X ($val "south")
X { The robot can't be seen leaving to the north }
X )
X ".\n"
X )
X )
X;
X
X
XRobEntr =
X (IF ($and ($not (Myself)) ($eq ($loc robot ) ($loc me))) THEN
X ($say
X (IF ($eq @Verb north) THEN
X ($val "The robot enters from the south.\n")
X ELSEIF ($eq @Verb east) THEN
X ($val "The robot enters from the west.\n")
X ELSEIF ($eq @Verb west) THEN
X ($val "The robot enters from the east.\n")
X { The robot can't enter from the north in
X this scenario }
X )
X )
X )
X;
X
X
XDoorCk =
X (IF ($not ($prop door OPENED)) THEN
X ($say "The door seems to be closed.\n")
X ($exit 1)
X )
X;
X
X
XTrapCk =
X (IF ($ne ($prop button BSTATE) B_LIT) THEN
X (NoGo)
X )
X;
X
X
X{ (BlueCk) - make sure that only one actor is in the blue room
X at one time. }
XBlueCk =
X (IF ($or ($eq ($loc me) Bluerm) ($eq ($loc robot) Bluerm)) THEN
X (IF (Myself) THEN
X ($say
X"The room is too small for both you and the robot to fit.\n"
X )
X )
X ($exit 1)
X ELSEIF ($and ($not (Myself)) ($eq ($prop button BSTATE) B_LIT)) THEN
X (RobMov)
X ($say "You hear a loud CRASH! in the distance.\n")
X ($setg Score ($minus @Score 10))
X ($setp robot BROKEN TRUE)
X ($move robot Bluerm)
X ($delact robot)
X ($exit 1)
X )
X (RobMov)
X;
X
X
X{ (Die) - kill off the player }
XDie =
X ($setg Score ($minus @Score 50))
X (Skore)
X ($say "Do you wish to restart the game? ")
X (IF ($yorn) THEN
X ($spec 2)
X ELSE
X ($spec 3)
X )
X;
X
X
X{ (Lifter) - Lift the hatch, possibly killing the robot or
X the player }
XLifter =
X (IF ($eq ($loc me) Bluerm) THEN
X ($say
X"All of a sudden, the floor lifts up, and you are crushed between it
Xand the wall! "
X )
X (Die)
X ELSE
X ($say "In the distance, you hear a loud CRASH!\n")
X (IF ($eq ($loc robot) Bluerm) THEN
X ($setg Score ($minus @Score 10))
X ($setp robot BROKEN TRUE)
X ($delact robot)
X )
X )
X ($setp hatch SDESC HatchSD)
X ($setp button BSTATE B_LIT)
X ($setp Bluerm SEEN FALSE)
X;
X
X
X{ Prompt - print the status line and a prompt }
XPROMPT =
X ($spec 9 (($sdesc ($loc .ME)) 1) @Score ($turns))
X ($say "> ")
X;
X
X
X{ Increment - increment the turn counter }
XINCREMENT =
X (IF (Myself) THEN
X { We only want to increment once per turn }
X ($incturn)
X ELSE
X { We don't want Looker executing for the robot }
X ($exit 0)
X )
X;
X
X
X{ (Skore) - print out the current score. }
XSkore =
X ($say "You have scored " ($str @Score)
X " out of a possible 100 in " ($str ($turns)) " moves.\n")
X;
X
X
X{ Dwimming routines }
XDWIMI = (Dwimmer %1);
XDWIMD = (Dwimmer %1);
X
XSTART =
X ($spec MARGIN 69) { Set the screen to 69 wide }
X ($sdem INCREMENT) { Turn counter increment }
X (StdInit me) { Initialize standard }
X ($setp me ACTION MeAct) { Restore me( ACTION ) }
X ($setv n s e w u d 0 0 0 0) { Use our own transition vector }
X ($prompt PROMPT) { and our own prompter }
X ($setg Indent TRUE) { Indent the object descriptions }
X;
X
X{*** EOF actdemo.adl ***}
END_OF_samples/demos/actdemo.adl
if test 12205 -ne `wc -c <samples/demos/actdemo.adl`; then
echo shar: \"samples/demos/actdemo.adl\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 6 \(of 11\).
cp /dev/null ark6isdone
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 a;
X cagesnug