[net.sources] Modified XLISP, part 3 of 5

john@x.UUCP (John Woods) (08/27/84)

This represents part 3 of 5 of my modified XLISP.  Tear at the dotted line,
and run "sh" over it to extract.

Thanks to Dave Betz for providing the original XLISP.
________________________________________________________________
echo extract with /bin/sh, not /bin/csh
echo x xlio.c
sed -n -e 's/^X//p' > xlio.c << '!Funky!Stuff!'
X			 /* xlio - xlisp i/o routines */
X
X
X#ifdef CI_86
X#include "a:stdio.h"
X#include "xlisp.h"
X#endif
X
X#ifdef AZTEC
X#include "a:stdio.h"
X#include "xlisp.h"
X#endif
X
X#ifdef unix
X#include <stdio.h>
X#include "xlisp.h"
X#endif
X
X
X			     /* global variables */
Xint (*xlgetc)();
Xint xlpvals;
Xint xlplevel;
XFILE *ofp = 0;
X
X			/* externs */
Xextern int (*xlofun)(), xlstrout();
X
X			      /* local variables */
X
Xstatic int prompt = 0;
Xstatic FILE *ifp = 0;
X
X		 /**********************************************
X		 *  tgetc - get a character from the terminal  *
X		 **********************************************/
X
Xstatic int tgetc()
X{
X    int ch;
X
X    if (prompt)                        /* Prompt if required */
X    {
X	if (xlplevel > 0)
X	    printf("%d> ", xlplevel);
X	else
X	    printf("> ");
X	prompt = FALSE;
X    }
X
X    if ((ch = getc(stdin)) == '\n')
X	prompt = TRUE;
X
X    return (ch);
X}
X
X
X		       /*******************************
X		       *  xltin - setup terminal I/O  *
X		       *******************************/
X
Xint xltin(flag)
X  int flag;
X{
X    if (flag & !prompt)                /* Flush line if flag set */
X	while (tgetc() != '\n')
X	    ;
X
X    prompt = TRUE;
X    xlplevel = 0;
X    xlgetc = tgetc;
X    if (ofp && ofp != stdout) {
X	fclose(ofp);
X    }
X    ofp = stdout;
X    xlofun = xlstrout;
X    xlpvals = TRUE;
X}
X
X
X		   /*****************************************
X		   *  fgetcx - get a character from a file  *
X		   *****************************************/
X
Xstatic int fgetcx()
X{
X    int ch;
X
X    if ((ch = getc(ifp)) <= 0) {
X	xlgetc = tgetc;
X	xlpvals = TRUE;
X	return (tgetc());
X    }
X
X    return (ch);
X}
X
X
X			 /*****************************
X			 *  xlfin - setup file input  *
X			 *****************************/
X
Xxlfin(str)
X  char *str;
X{
X
X#ifdef DEFEXT
X    char fname[100];
X
X    strcpy(fname, str);
X#else
X#define fname str
X#endif
X
X    if ((ifp = fopen(fname, "r")) != NULL)
X    {
X	xlgetc = fgetcx;
X	xlpvals = FALSE;
X	return;
X    }
X
X#ifdef DEFEXT
X    if (strchr(fname, '.') == 0)
X	strcat(fname, ".lsp");
X
X    if ((ifp = fopen(fname, "r")) != NULL)
X    {
X	xlgetc = fgetcx;
X	xlpvals = FALSE;
X	return;
X    }
X#endif
X
X    printf("Can't open \"%s\" for input\n", fname);
X    xlfail("io redirection failed");
X}
X
X			 /*******************************
X			 *  xlfout - setup file output  *
X			 *******************************/
X
Xxlfout(str)
X  char *str;
X{
X
X#ifdef DEFEXT
X    char fname[100];
X
X    strcpy(fname, str);
X#else
X#define fname str
X#endif
X
X    if (ofp != stdout)
X	fclose(ofp);
X    else
X	fflush(stdout);
X
X    if (fname == 0)
X    {	ofp = stdout;
X	return;
X    }
X
X    if ((ofp = fopen(fname, "w")) != NULL)
X    {
X	return;
X    }
X
X#ifdef DEFEXT
X    if (strchr(fname, '.') == 0)
X	strcat(fname, ".lsp");
X
X    if ((ofp = fopen(fname, "w")) != NULL)
X    {
X	return;
X    }
X#endif
X
X    printf("Can't open \"%s\" for output\n", fname);
X    xlfail("io redirection failed");
X}
!Funky!Stuff!
echo x xlisp.c
sed -n -e 's/^X//p' > xlisp.c << '!Funky!Stuff!'
X
X		      /* xlisp - a small subset of lisp */
X
X#ifdef CI_86
X#include "A:STDIO.H"
X#include "xlisp.h"
X#endif
X
X#ifdef AZTEC
X#include "a:stdio.h"
X#include "a:setjmp.h"
X#include "xlisp.h"
X#endif
X
X#ifdef DECUS
X#include <stdio.h>
X#include <setjmp.h>
X#include "xlisp.h"
X#endif
X
X#ifdef unix
X#include <stdio.h>
X#include <setjmp.h>
X#include "xlisp.h"
X#endif
X
X			  /* External variables */
X
Xextern struct node *xlenv;
Xextern struct node *xlstack;
Xextern int xlpvals;
X
X			      /* Local variables */
X
Xstatic jmp_buf ljmp;
X
Xouch(n) {
X	signal(n,ouch);
X	longjmp(ljmp,1);
X}
X
X			   /**************************
X			   * main - the main routine *
X			   **************************/
X
Xmain(argc,argv)
X  int argc; char *argv[];
X{
X    struct node expr;
X
X    xldmeminit();                 /* initialize the dynamic memory module */
X				  /* (must be first initilization call */
X#ifdef DEBUG
X    xldebuginit();
X#endif
X				  /* initialize each lisp module */
X    xlinit();
X    xleinit();
X    xllinit();
X    xlminit();
X    xloinit();
X    xlsinit();
X    xlfinit();
X    xlpinit();
X    xlxinit();		/* extensions */
X
X#ifdef KEYMAPCLASS
X    xlkinit();
X#endif
X
X    xltin(FALSE);
X
X    if (argc > 1)                 /* read the input file if specified */
X	xlfin(argv[1]);
X    else
X	printf("XLISP version 1.2\n");
X
X    signal(2,ouch);
X
X    setjmp(ljmp);                 /* Set up the error return */
X    while (TRUE)                  /* Main command processing loop */
X    {
X	xlstack = xlenv = NULL;   /* Free any previous expression and */
X				  /* left over context */
X
X	xlsave(&expr,NULL);       /* create a new stack frame */
X
X	expr.n_ptr = xlread();    /* Read and evaluate an expression */
X	expr.n_ptr = xleval(expr.n_ptr);
X
X	if (xlpvals)              /* print it if necessary */
X	{
X	    xlprint(expr.n_ptr, TRUE);
X	    putchar('\n');
X	}
X    }
X}
X
X
Xxlabort()
X{
X    /* Procedure to localize machine dependent abort jump */
X
X    longjmp(ljmp);
X}
!Funky!Stuff!
echo x xlisp.doc
sed -n -e 's/^X//p' > xlisp.doc << '!Funky!Stuff!'
X
X
X
X
X	      XLISP: An Experimental Object Oriented Language
X
X
X				     by
X				 David Betz
X			     114 Davenport Ave.
X			   Manchester, NH  03103
X
X			       (603) 625-4691
X
X
X	XLISP is an experimental programming language combining some
X	of  the  features  of LISP with an object oriented extension
X	capability.  It was  implemented  to  allow  experimentation
X	with  object oriented programming on small computers.  There
X	are currently implementations running on  the  PDP-11  under
X	RSX-11,  RT-11, and UNIX V7, on the VAX-11 under VAX/VMS and
X	Berkeley VAX/UNIX and on the Z-80 running  CP/M-80.   It  is
X	completely  written  in  the programming language 'C' and is
X	believed to be easily extended  with  user  written  builtin
X	functions  and  classes.  It is available free of charge and
X	is in the public domain.
X
X	Many traditional LISP functions are built  into  XLISP.   In
X	addition,   XLISP   defines  the  object  classes  'Object',
X	'Class', and 'Keymap' as primitives.  'Object' is  the  only
X	class  that  has  no superclass and hence is the root of the
X	class heirarchy tree.  'Class' is the  class  of  which  all
X	classes  are  instances  (it  is  the only object that is an
X	instance of itself).  'Keymap' is a  class  whose  instances
X	are mappings from input key sequences to messages.
X
X	This document is intended  to  be  a  brief  description  of
X	XLISP.    It   assumes  some  knowledge  of  LISP  and  some
X	understanding   of   the   concepts   of   object   oriented
X	programming.
X
X	XLISP: An Experimental Object Oriented Language       Page 2
X	XLISP Command Loop
X
X
X	When XLISP is started, it issues the following prompt:
X
X	>
X
X	This indicates that XLISP is waiting for an expression to be
X	typed.   When  an  incomplete expression has been typed (one
X	where the left and right parens don't match)  XLISP  changes
X	its prompt to:
X
X	n>
X
X	where n is an integer indicating how many levels  of  parens
X	remain unclosed.
X
X	When a complete expression has been entered, XLISP  attempts
X	to  evaluate  that  expression.  If the expression evaluates
X	successfully, XLISP prints the result of the evaluation  and
X	then  returns  to  the  initial  prompt  waiting for another
X	expression to be typed.
X
X	Input can be aborted at any time  by  typing  the  EOF  key.
X	Another EOF will exit from XLISP.
X
X	XLISP: An Experimental Object Oriented Language       Page 3
X	DATA TYPES AND THE EVALUATOR
X
X
X	XLISP data types
X
X	There are several different data types  available  to  XLISP
X	programmers.
X
X
X	      o  symbols
X
X	      o  strings
X
X	      o  integers
X
X	      o  objects
X
X	      o  file pointers
X
X	      o  lists
X
X	      o  subrs (builtin functions)
X
X
X	The XLISP evaluator
X
X	The process of evaluation in XLISP:
X
X	      o  Integers,  strings,  objects,  file  pointers,  and
X		 subrs evaluate to themselves
X
X	      o  Symbols evaluate to the value associated with their
X		 current binding
X
X	      o  Lists are evaluated by evaluating the first element
X		 of the list
X
X		  o  If it evaluates to a subr, the builtin function
X		     is  executed  using the remaining list elements
X		     as arguments (they are evaluated  by  the  subr
X		     itself)
X
X		  o  If it evaluates to a list, the list is  assumed
X		     to be a function definition and the function is
X		     evaluated using the  values  of  the  remaining
X		     list elements as arguments
X
X		  o  If it evaluates to an object, the  second  list
X		     element  is  evaluated  and  used  as a message
X		     selector.  The message formed by combining  the
X		     selector  with the values of the remaining list
X		     elements is sent to the object.
X
X
X
X	XLISP: An Experimental Object Oriented Language       Page 4
X	LEXICAL CONVENTIONS
X
X
X	XLISP lexical conventions:
X
X	The following conventions are followed when  entering  XLISP
X	programs:
X
X	Comments in XLISP code begin with a semi-colon character and
X	continue to the end of the line.
X
X	Symbol names  in  XLISP  can  consist  of  any  sequence  of
X	non-blank printable characters except the following:
X
X		( ) . ' " ;
X
X	Symbol names must not begin with a digit.
X
X	Integer literals consist of a sequence of digits  optionally
X	beginning with a '+' or '-'.  The range of values an integer
X	can represent is limited by the size of a  C  'int'  on  the
X	machine that XLISP is running on.
X
X	Literal strings are sequences of  characters  surrounded  by
X	double  quotes.   Within quoted strings the '\' character is
X	used to allow non-printable characters to be included.   The
X	codes recognized are:
X
X		\\      means the character '\'
X		\n      means newline
X		\t      means tab
X		\r      means return
X		\e      means escape
X		\nnn    means the character whose octal code is nnn
X
X	The single quote character can be used as a shorthand for  a
X	call on the function 'quote':
X
X				'foo
X	is equivalent to:
X				(quote foo)
X
X	XLISP: An Experimental Object Oriented Language       Page 5
X	OBJECTS
X
X
X	Objects:
X
X	Definitions:
X
X	      o  selector - a symbol used to select  an  appropriate
X		 method
X
X	      o  message - a selector and a list of actual arguments
X
X	      o  method - the code that implements a message
X
X	Since XLISP was  created  to  provide  a  simple  basis  for
X	experimenting  with  object oriented programming, one of the
X	primitive data types included was 'object'.   In  XLISP,  an
X	object  consists of a data structure containing a pointer to
X	the object's class as well as a list containing  the  values
X	of the object's instance variables.
X
X	Officially, there is no way to see inside an object (look at
X	the  values  of  its  instance  variables).  The only way to
X	communicate with an object is by sending it a message.  When
X	the  XLISP  evaluator  evaluates  a  list the value of whose
X	first element is an object, it interprets the value  of  the
X	second  element  of the list (which must be a symbol) as the
X	message selector.  The evaluator determines the class of the
X	receiving object and attempts to find a method corresponding
X	to the message selector in the set of messages  defined  for
X	that  class.   If  the  message is not found in the object's
X	class and the class has a super-class, the search  continues
X	by  looking  at  the  messages  defined for the super-class.
X	This process continues from  one  super-class  to  the  next
X	until  a  method  for the message is found.  If no method is
X	found, an error occurs.
X
X	When a method is found, the evaluator  binds  the  receiving
X	object  to  the  symbol 'self', binds the class in which the
X	method was found to the symbol 'msgclass', and evaluates the
X	method  using the remaining elements of the original list as
X	arguments  to  the  method.   These  arguments  are   always
X	evaluated prior to being bound to their corresponding formal
X	arguments.  The result of evaluating the method becomes  the
X	result of the expression.
X
X	XLISP: An Experimental Object Oriented Language       Page 6
X	OBJECTS
X
X
X	Classes:
X
X	Object  THE TOP OF THE CLASS HEIRARCHY
X
X	    Messages:
X
X		print   THE DEFAULT OBJECT PRINT ROUTINE
X		    returns     the object
X
X		show    SHOW AN OBJECT'S INSTANCE VARIABLES
X		    returns     the object
X
X		class   RETURN THE CLASS OF AN OBJECT
X		    returns     the class of the object
X
X		isnew   THE DEFAULT OBJECT INITIALIZATION ROUTINE
X		    returns     the object
X
X		sendsuper <sel> [<args>...] SEND SUPERCLASS A MESSAGE
X		    <sel>       the message selector
X		    <args>      the message arguments
X		    returns     the result of sending the message
X
X
X	Class   THE CLASS OF ALL OBJECT CLASSES (including itself)
X
X	    Messages:
X
X		new     CREATE A NEW INSTANCE OF A CLASS
X		    returns     the new class object
X
X		isnew [<scls>]  INITIALIZE A NEW CLASS
X		    <scls>      the superclass
X		    returns     the new class object
X
X		answer <msg> <fargs> <code>     ADD A MESSAGE TO A CLASS
X		    <msg>       the message symbol
X		    <fargs>     the formal argument list
X				  this list is of the form:
X				    (<farg>... [/ <local>...])
X				  where
X				    <farg>      a formal argument
X				    <local>     a local variable
X		    <code>      a list of executable expressions
X		    returns     the object
X
X		ivars <vars>    DEFINE THE LIST OF INSTANCE VARIABLES
X		    <vars>      the list of instance variable symbols
X		    returns     the object
X
X		cvars <vars>    DEFINE THE LIST OF CLASS VARIABLES
X		    <vars>      the list of class variable symbols
X		    returns     the object
X
X	XLISP: An Experimental Object Oriented Language       Page 7
X	OBJECTS
X
X
X	When a new instance of a class is  created  by  sending  the
X	message  'new'  to  an  existing  class, the message 'isnew'
X	followed by whatever parameters were  passed  to  the  'new'
X	message is sent to the newly created object.
X
X	When a new class is created by sending the 'new' message  to
X	the  object  'Class', an optional parameter may be specified
X	indicating of which class the newly generated class is to be
X	a  subclass.   If  this  parameter is omitted, the new class
X	will be a subclass of 'Object'.
X
X	 Example:
X
X	    ; create 'Foo' as a subclass of 'Object'
X	    (setq Foo (Class 'new))
X
X	    ; create 'Bar' as a subclass of 'Foo'
X	    (setq Bar (Class 'new Foo))
X
X	A class inherits all instance  variables,  class  variables,
X	and methods from its super-class.
X
X	XLISP: An Experimental Object Oriented Language       Page 8
X	OBJECTS
X
X
X	The 'Keymap' Class:
X
X	A keymap is data structure that  translates  a  sequence  of
X	keystrokes into a message.
X
X	In order to create a keymap:
X
X		(setq km (Keymap 'new))
X
X	In order to add a key definition to a keymap (km):
X
X		(km 'key "\eA" 'up)
X		(km 'key "\eB" 'down)
X		(km 'key "\eC" 'right)
X		(km 'key "\eD" 'left)
X
X	Executing a keymap:
X
X		(setq env (list ob1 ob2 ob3 ob4))
X		(km 'process env)
X
X	When the process  message  is  sent,  its  method  enters  a
X	character  input  loop  calling  kbin to get single unechoed
X	characters from the keyboard.  When a sequence of characters
X	is  found that matches one of the sequences defined in a key
X	function call,  the  corresponding  message  is  sent.   The
X	method  tries  to send the message to each of the objects in
X	the environment list.  It stops when it finds an object that
X	knows  how  to  answer  the message.  Along with the message
X	selector given  in  the  key  definition,  the  sequence  of
X	matched characters is passed as a single string parameter.
X
X	    Keymap
X
X		new     CREATE A NEW KEYMAP
X		    returns     a new keymap
X
X		isnew   INITIALIZE THE NEW KEYMAP
X		    returns     the keymap
X
X		key <kstr> <ksym>       ADD A KEY DEFINITION TO A KEYMAP
X		    <kstr>      the string defining the key
X		    <ksym>      the symbol for the message
X		    returns     the keymap
X
X		process <envlist>       PROCESS INPUT USING A KEYMAP
X		    <envlist>   list of active objects
X		    returns     the keymap when a message evaluates to nil
X
X	XLISP: An Experimental Object Oriented Language       Page 9
X	SYMBOLS
X
X
X	Symbols:
X
X
X	      o  self  -  the  current  object  (within  a   message
X		 context)
X
X	      o  msgclass - the class in which  the  current  method
X		 was found
X
X	      o  currentenv - the environment list for  the  current
X		 invocation of kmprocess
X
X	      o  oblist - the object list
X
X
X	XLISP: An Experimental Object Oriented Language      Page 10
X	FUNCTIONS
X
X
X	Utility functions:
X
X	(load <fname>)  LOAD AN XLISP SOURCE FILE
X	    <fname>     the filename string
X	    returns     the filename
X
X	(mem)   SHOW MEMORY ALLOCATION STATISTICS
X	    returns     nil
X
X	(gc)    FORCE GARBAGE COLLECTION
X	    returns     nil
X
X	(alloc <num>)   CHANGE NUMBER OF NODES TO ALLOCATE IN EACH SEGMENT
X	    <num>       the number of nodes to allocate
X	    returns     the old number of nodes to allocate
X
X	(expand <num>)  EXPAND MEMORY BY ADDING SEGMENTS
X	    <num>       the number of segments to add
X	    returns     the number of segments added
X
X	XLISP: An Experimental Object Oriented Language      Page 11
X	FUNCTIONS
X
X
X	Functions:
X
X	(eval <expr>)   EVALUATE AN XLISP EXPRESSION
X	    <expr>      the expression to be evaluated
X	    returns     the result of evaluating the expression
X
X	(set <sym> <expr>)      SET THE VALUE OF A SYMBOL
X	    <sym>       the symbol being set
X	    <expr>      the new value
X	    returns     the new value
X
X	(setq <qsym> <expr>)    SET THE VALUE OF A SYMBOL
X	    <qsym>      the symbol being set (quoted)
X	    <expr>      the new value
X	    returns     the new value
X
X	(print <expr>...)       PRINT A LIST OF VALUES
X	    <expr>      the expressions to be printed
X	    returns     nil
X
X	(princ <expr>...)       PRINT A LIST OF VALUES WITHOUT QUOTING
X	    <expr>      the expressions to be printed
X	    returns     nil
X
X	(quote <expr>)  RETURN AN EXPRESSION UNEVALUATED
X	or
X	'<expr>
X	    <expr>      the expression to be quoted (quoted)
X	    returns     <expr> unevaluated
X
X	(if <texpr> <expr1> [ <expr2> ])        EXECUTE EXPRESSIONS CONDITIONALLY
X	    <texpr>     test expression
X	    <expr1>     expression evaluated if texpr is non-nil or non-zero
X	    <expr2>     expression evaluated if texpr is nil or zero
X	    returns     the value of the expression evaluated
X
X	(while <texpr> <expr>...)       ITERATE WHILE AN EXPRESSION IS TRUE
X	    <texpr>     test expression evaluated at start of each iteration
X	    <expr>      expressions evaluated as long as <texpr> evaluates to
X			non-nil or non-zero
X	    returns     the result of the last expression evaluated
X
X	(repeat <iexpr> <expr>...)      ITERATE USING A REPEAT COUNT
X	    <iexpr>     integer expression indicating the repeat count
X	    <expr>      expressions evaluated <iexpr> times
X	    returns     the result of the last expression evaluated
X
X	(foreach <qsym> <list> <expr>...) ITERATE FOR EACH ELEMENT IN A LIST
X	    <qsym>      symbol to assign each list element to (quoted)
X	    <list>      list to iterate through
X	    <expr>      expressions evaluated for each element in the list
X	    returns     the result of the last expression evaluated
X
X	XLISP: An Experimental Object Oriented Language      Page 12
X	FUNCTIONS
X
X
X	(defun <qsym> <qfargs> <expr>...)       DEFINE A NEW FUNCTION
X	    <qsym>      symbol to be defined (quoted)
X	    <qfargs>    list of formal arguments (quoted)
X			  this list is of the form:
X			    (<farg>... [/ <local>...])
X			  where
X			    <farg>      is a formal argument
X			    <local>     is a local variable
X	    <expr>      expressions constituting the body of the
X			function (quoted)
X	    returns     the function symbol
X
X	(cond <pair>...)        EVALUATE CONDITIONALLY
X	    <pair>      pair consisting of:
X			    (<pred> <expr>)
X			  where
X			    <pred>      is a predicate expression
X			    <expr>      is evaluated if the predicate
X					is not nil
X	    returns     the value of the first expression whose predicate
X			is not nil
X
X	(exit)  EXIT XLISP
X	    returns     never returns
X
X	XLISP: An Experimental Object Oriented Language      Page 13
X	FUNCTIONS
X
X
X	I/O Functions:
X
X	(fopen <fname> <mode>)  OPEN A FILE
X	    <fname>     the file name string
X	    <mode>      the open mode string
X	    returns     a file pointer
X
X	(fclose <fp>)   CLOSE A FILE
X	    <fp>        the file pointer
X	    returns     nil
X
X	(getc [<fp>])   GET A CHARACTER FROM A FILE
X	    <fp>        the file pointer (default is stdin)
X	    returns     the character (integer)
X
X	(putc <ch> [<fp>])      PUT A CHARACTER TO A FILE
X	    <ch>        the character to put (integer)
X	    <fp>        the file pointer (default is stdout)
X	    returns     the character (integer)
X
X	(fgets [<fp>])  GET A STRING FROM A FILE
X	    <fp>        the file pointer (default is stdin)
X	    returns     the input string
X
X	(fputs <str> [<fp>]) PUT A STRING TO A FILE
X	    <str>       the string to output
X	    <fp>        the file pointer (default is stdout)
X	    returns     the string
X
X	XLISP: An Experimental Object Oriented Language      Page 14
X	FUNCTIONS
X
X
X	String Functions:
X
X	(strcat <expr>...) CONCATENATE STRINGS
X	    <expr>      string expressions
X	    returns     result of concatenating the strings
X
X	(strlen <expr>) COMPUTE THE LENGTH OF A STRING
X	    <expr>      the string expression
X	    returns     the length of the string
X
X	(substr <expr> <sexpr> [<lexpr>]) RETURN SUBSTRING
X	    <expr>      string expression
X	    <sexpr>     starting position
X	    <lexpr>     optional length (default is rest of string)
X	    returns     substring starting at <sexpr> for <lexpr>
X
X	(ascii <expr>)  NUMERIC VALUE OF CHARACTER
X	    <expr>      string expression
X	    returns     numeric value of first character (according to ASCII)
X
X	(chr <expr>)    CHARACTER EQUIVALENT OF ASCII VALUE
X	    <expr>      numeric expression
X	    returns     one character string with ASCII equivalent of <expr>
X
X	(atoi <expr>)   CONVERT AN ASCII STRING TO AN INTEGER
X	    <expr>      string expression
X	    returns     the integer value of the string expression
X
X	(itoa <expr>)   CONVERT AN INTEGER TO AN ASCII STRING
X	    <expr>      integer expression
X	    returns     the string representation of the integer value
X
X	XLISP: An Experimental Object Oriented Language      Page 15
X	FUNCTIONS
X
X
X	List Functions:
X
X	(head <expr>)   RETURN THE HEAD ELEMENT OF A LIST
X	or
X	(car <expr)
X	    <expr>      the list
X	    returns     the first element of the list
X
X	(tail <expr>)   RETURN THE TAIL ELEMENTS OF A LIST
X	or
X	(cdr <expr>)
X	    <expr>      the list
X	    returns     the list minus the first element
X
X	(list <expr>...)        CREATE A LIST OF VALUES
X	    <expr>      evaluated expressions to be combined into a list
X	    returns     the new list
X
X	(nth <n> <list>)        RETURN THE NTH ELEMENT OF A LIST
X	    <n>         the number of the element to return
X	    <list>      the list to return the nth element of
X	    returns     the nth element or nil if the list isn't that long
X
X	(append <expr>...)      APPEND LISTS
X	    <expr>      lists whose elements are to be appended
X	    returns     the new list
X
X	(cons <e1> <e2>)        CONSTRUCT A NEW LIST ELEMENT
X	    <e1>        becomes the head (car) of the new list
X	    <e2>        becomes the tail (cdr) of the new list
X	    returns     the new list
X
X	(null <expr>)   CHECKS FOR AN EMPTY LIST
X	    <expr>      the list to check
X	    returns     t if the list is empty, nil otherwise
X
X	(atom <expr>)   CHECKS FOR AN ATOM (ANYTHING THAT ISN'T A LIST)
X	    <expr>      the expression to check
X	    returns     t if the value is an atom, nil otherwise
X
X	(listp <expr>)  CHECKS FOR A LIST
X	    <expr>      the expression to check
X	    returns     t if the value is a list, nil otherwise
X
X	XLISP: An Experimental Object Oriented Language      Page 16
X	FUNCTIONS
X
X
X	(type <expr>)   RETURNS THE TYPE OF THE EXPRESSION
X	    <expr>      the expression to return the type of
X	    returns     nil if the value is nil otherwise one of the symbols:
X			    SYM  for symbols
X			    OBJ  for objects
X			    LIST for list nodes
X			    KMAP for keymap nodes
X			    SUBR for internal subroutine nodes
X			    STR  for string nodes
X			    INT  for integer nodes
X			    FPTR for file pointer nodes
X
X	(eq <expr1> <expr2>)    CHECKS FOR THE EXPRESSIONS BEING THE SAME
X	    <expr1>     the first expression
X	    <expr2>     the second expression
X	    returns     t if they are equal, nil otherwise
X
X	(equal <expr1> <expr2>) CHECKS FOR THE EXPRESSIONS BEING EQUAL
X	    <expr1>     the first expression
X	    <expr2>     the second expression
X	    returns     t if they are equal, nil otherwise
X
X	(read [ <str> ])        READ AN XLISP EXPRESSION
X	    <str>       the string to use as input (optional)
X	    returns     the expression read
X
X	(reverse <expr>)        REVERSE A LIST
X	    <expr>      the list to reverse
X	    returns     a new list in the reverse order
X
X	(length <expr>) FIND THE LENGTH OF A LIST
X	    <expr>      the list to find the length of
X	    returns     the length
X
X	XLISP: An Experimental Object Oriented Language      Page 17
X	FUNCTIONS
X
X
X	Arithmetic Functions:
X
X	(+ <expr>...)   ADD A LIST OF VALUES
X	    <expr>      expressions to be added
X	    returns     the result of the addition
X
X	(- <expr>...)   SUBTRACT A LIST OF VALUES
X	    <expr>      expressions to be subtracted
X	    returns     the result of the subtraction
X
X	(* <expr>...)   MULTIPLY A LIST OF VALUES
X	    <expr>      expressions to be multiplied
X	    returns     the result of the multiplication
X
X	(/ <expr>...)   DIVIDE A LIST OF VALUES
X	    <expr>      expressions to be divided
X	    returns     the result of the division
X
X	(% <expr>...)   MODulus A LIST OF VALUES
X	    <expr>      expressions to be MODulused
X	    returns     the result of mod
X
X	(& <expr>...)   THE BITWISE AND OF A LIST OF VALUES
X	    <expr>      expressions to be ANDed
X	    returns     the bit by bit ANDing of expressions
X
X	(| <expr...)    THE BITWISE OR OF A LIST OF VALUES
X	    <expr>      expressions to be ORed
X	    returns     the bit by bit ORing of expressions
X
X	(~ <expr>)      THE BITWISE NOT OF A VALUE
X	    <expr>      expression to be NOTed
X	    returns     the bit by bit inversion of expression
X
X	(min <expr>...) THE SMALLEST OF A LIST OF VALUES
X	    <expr>      expressions to be checked
X	    returns     the smallest value of the list
X
X	(max <expr>...) THE LARGEST OF A LIST OF VALUES
X	    <expr>      expressions to be checked
X	    returns     the largest value of the list
X
X	(abs <expr>)    THE ABSOLUTE VALUE OF AN EXPRESSION
X	    <expr>      integer expression
X	    returns     the absolute value of the expression
X
X	XLISP: An Experimental Object Oriented Language      Page 18
X	FUNCTIONS
X
X
X	Boolean Functions:
X
X	(&& <expr>...)  THE LOGICAL AND OF A LIST OF VALUES
X	    <expr>      expressions to be ANDed
X	    returns     the result of anding the expressions
X			(evaluation of expressions stops after the first
X			 expression that evaluates to false)
X
X	(|| <expr>...)  THE LOGICAL OR OF A LIST OF VALUES
X	    <expr>      expressions to be ORed
X	    returns     the result of oring the expressions
X			(evaluation of expressions stops after the first
X			 expression that evaluates to true)
X
X	(! <expr>)      THE LOGICAL NOT OF A VALUE
X	    <expr>      expression to be NOTed
X	    return      logical not of <expr>
X
X	XLISP: An Experimental Object Oriented Language      Page 19
X	FUNCTIONS
X
X
X	Relational Functions:
X
X	The relational functions can be used to compare integers and
X	strings.   The  functions  '==' and '!=' can also be used to
X	compare other types.  The result  of  these  comparisons  is
X	computed the same way as for 'eq'.
X
X	(< <e1> <e2>)   TEST FOR LESS THAN
X	    <e1>        the left operand of the comparison
X	    <e2>        the right operand of the comparison
X	    returns     the result of comparing <e1> with <e2>
X
X	(<= <e1> <e2>)  TEST FOR LESS THAN OR EQUAL TO
X	    <e1>        the left operand of the comparison
X	    <e2>        the right operand of the comparison
X	    returns     the result of comparing <e1> with <e2>
X
X	(== <e1> <e2>)  TEST FOR EQUAL TO
X	    <e1>        the left operand of the comparison
X	    <e2>        the right operand of the comparison
X	    returns     the result of comparing <e1> with <e2>
X
X	(!= <e1> <e2>)  TEST FOR NOT EQUAL TO
X	    <e1>        the left operand of the comparison
X	    <e2>        the right operand of the comparison
X	    returns     the result of comparing <e1> with <e2>
X
X	(>= <e1> <e2>)  TEST FOR GREATER THAN OR EQUAL TO
X	    <e1>        the left operand of the comparison
X	    <e2>        the right operand of the comparison
X	    returns     the result of comparing <e1> with <e2>
X
X	(> <e1> <e2>)   TEST FOR GREATER THAN
X	    <e1>        the left operand of the comparison
X	    <e2>        the right operand of the comparison
X	    returns     the result of comparing <e1> with <e2>
!Funky!Stuff!
echo x xlisp.h
sed -n -e 's/^X//p' > xlisp.h << '!Funky!Stuff!'
X
X		      /* xlisp - a small subset of lisp */
X
X
X			/* system specific definitions */
X
X/* DEFEXT       define to enable default extension of '.lsp' on 'load' */
X/* FGETNAME     define if system supports 'fgetname' */
X/* NNODES       number of nodes to allocate in each request */
X/* TDEPTH       trace stack depth */
X/* KEYMAPCLASS  define to include the 'Keymap' class */
X
X
X			 /* for the VAX-11 C compiler */
X
X#ifdef vms
X#define DEFEXT
X#define FGETNAME
X#define KEYMAPCLASS
X#define NNODES  2000
X#define TDEPTH  1000
X#endif
X
X			 /* for the DECUS C compiler */
X
X#ifdef decus
X#define DEFEXT
X#define KEYMAPCLASS
X#define NNODES  200
X#define TDEPTH  100
X#endif
X
X			    /* for unix compilers */
X
X#ifdef unix
X#define KEYMAPCLASS
X#define NNODES  200
X#define TDEPTH  100
X#define REALS
X#endif
X
X			 /* for the AZTEC C compiler */
X
X#ifdef AZTEC
X#define DEFEXT
X#define KEYMAPCLASS
X#define NNODES  200
X#define TDEPTH  100
X#define getc(fp)        getch(fp)
X#define kbin()          CPM(6,0xFF)
X#define malloc          alloc
X#endif
X
X			 /* for the CI_86 PC compiler */
X
X#ifdef CI_86
X#define REALS                               /* Enables real arithmetic code */
X/*  #define DEBUG                              Enables debug code           */
X					    /* Module XLDEBUG need not be linked
X					       if DEBUG is undefined        */
X#define DEFEXT
X#define KEYMAPCLASS
X#define NNODES  200
X#define TDEPTH  100
X#define strchr          index
X#endif
X
X		       /* default important definitions */
X
X#ifndef NNODES
X#define NNODES  200
X#endif
X
X#ifndef TDEPTH
X#define TDEPTH  100
X#endif
X
X			    /* useful definitions */
X
X#define TRUE    1
X#define FALSE   0
X
X			      /* program limits */
X
X#define STRMAX  100     /* maximum length of a string constant */
X
X				/* node types */
X
X#define FREE    0
X#define FSUBR    1
X#define LIST    2
X#define SYM     3
X#define INT     4
X#define STR     5
X#define OBJ     6
X#define FPTR    7
X#define KMAP    8
X#define REAL    9
X#define SUBR	10
X#define PROGSTK 12
X
X				/* prog longjump types */
X#define GO 1
X#define RETURN 2
X
X				/* node flags */
X
X#define MARK    1
X#define LEFT    2
X
X			       /* string types */
X
X#define DYNAMIC 0
X#define STATIC  1
X
X			      /* struct defines */
X
X			     /* Symbol structure */
X
Xstruct xsym {
X    struct node *xsy_value;     /* the current value */
X    struct node *xsy_plist;	/* the property list */
X    char *xsy_name;             /* symbol name */
X};
X
X			    /* subr node structure */
X
Xstruct xsubr {
X    struct node *(*xsu_subr)(); /* pointer to an internal routine */
X};
X
X			    /* list node structure */
X
Xstruct xlist {
X    struct node *xl_value;      /* value at this node */
X    struct node *xl_next;       /* next node */
X};
X
X			  /* integer node structure */
X
Xstruct xint {
X    int xi_int;                 /* integer value */
X};
X
X#ifdef REALS
X			    /* real node structure */
X
Xstruct xreal {
X    long float xr_real;        /* real value */
X};
X#endif
X
X			   /* string node structure */
X
Xstruct xstr {
X    int xst_type;               /* string type */
X    char *xst_str;              /* string pointer */
X};
X
X			   /* object node structure */
X
Xstruct xobj {
X    struct node *xo_obclass;    /* class of object */
X    struct node *xo_obdata;     /* instance data */
X};
X
X			/* file pointer node structure */
X
Xstruct xfptr {
X    FILE *xf_fp;                /* the file pointer */
X};
X
X			     /* keymap structure */
X
Xstruct xkmap {
X    struct node *(*xkm_map)[];  /* selection pointer */
X};
X
X			/* prog return block structure */
Xstruct xprogret {
X	char *xpg_ptr;
X	struct node *xpg_next;
X};
X
X	     /* shorthand macros for accessing node substructures */
X
X/* symbol node */
X
X#define n_symname       n_info.n_xsym.xsy_name
X#define n_symvalue      n_info.n_xsym.xsy_value
X#define n_plist		n_info.n_xsym.xsy_plist
X
X/* subr node */
X
X#define n_subr          n_info.n_xsubr.xsu_subr
X
X/* list node (and message node and binding node) */
X
X#define n_listvalue     n_info.n_xlist.xl_value
X#define n_listnext      n_info.n_xlist.xl_next
X#define n_msg           n_info.n_xlist.xl_value
X#define n_msgcode       n_info.n_xlist.xl_next
X#define n_bndsym        n_info.n_xlist.xl_value
X#define n_bndvalue      n_info.n_xlist.xl_next
X#define n_left          n_info.n_xlist.xl_value
X#define n_right         n_info.n_xlist.xl_next
X#define n_ptr           n_info.n_xlist.xl_value
X
X/* integer, real and string  nodes */
X
X#define n_int           n_info.n_xint.xi_int
X#define n_real          n_info.n_xreal.xr_real
X#define n_str           n_info.n_xstr.xst_str
X#define n_strtype       n_info.n_xstr.xst_type
X
X/* object node */
X
X#define n_obclass       n_info.n_xobj.xo_obclass
X#define n_obdata        n_info.n_xobj.xo_obdata
X
X/* file pointer node */
X
X#define n_fname         n_info.n_xfptr.xf_name
X#define n_fp            n_info.n_xfptr.xf_fp
X
X/* key map node */
X
X#define n_kmap          n_info.n_xkmap.xkm_map
X
X/* prog ret node */
X#define n_progval	n_info.n_xprogret.xpg_ptr
X#define n_prognext	n_info.n_xprogret.xpg_next
X
X			      /* node structure */
X
Xstruct node {
X    char n_type;                /* type of node */
X    char n_flags;               /* flag bits */
X    union {                     /* value */
X	struct xsym n_xsym;     /*     symbol node */
X	struct xsubr n_xsubr;   /*     subr node */
X	struct xlist n_xlist;   /*     list node */
X	struct xint n_xint;     /*     integer node */
X#ifdef REALS
X	 struct xreal n_xreal;  /*     real node */
X#endif
X	struct xstr n_xstr;     /*     string node */
X	struct xobj n_xobj;     /*     object node */
X	struct xfptr n_xfptr;   /*     file pointer node */
X	struct xkmap n_xkmap;   /*     key map node */
X	struct xprogret n_xprogret;	/* prog return block */
X    } n_info;
X};
X
X#define null_node   = {'\0','\0'}
X
X		      /* external procedure declarations */
X
Xextern struct node *xlread();           /* read an expression */
Xextern struct node *xleval();           /* evaluate an expression */
Xextern struct node *xlarg();            /* fetch an argument */
Xextern struct node *xlevarg();          /* fetch and evaluate an argument */
Xextern struct node *xlmatch();          /* fetch an typed argument */
Xextern struct node *xlevmatch();        /* fetch and evaluate a typed arg */
Xextern struct node *xlsend();           /* send a message to an object */
Xextern struct node *xlmfind();          /* find the method for a message */
Xextern struct node *xlxsend();          /* execute a message method */
Xextern struct node *xlenter();          /* enter a symbol into the oblist */
Xextern struct node *xlsave();           /* generate a stack frame */
Xextern struct node *xlobsym();          /* find an object's class or instance
X					   variable */
Xextern struct node *xlclass();          /* enter a class definition */
Xextern struct node *xlivar();           /* get an instance variable */
Xextern struct node *xlcvar();           /* get an instance variable */
Xextern struct node *newnode();          /* allocate a new node */
Xextern struct node *xlevlis();		/* turn a list of forms into a list
X					   of values */
Xextern char *stralloc();                /* allocate string space */
Xextern char *strsave();                 /* make a safe copy of a string */
X
!Funky!Stuff!
echo x xlkmap.c
sed -n -e 's/^X//p' > xlkmap.c << '!Funky!Stuff!'
X		     /* xlkmap - xlisp key map functions */
X
X#ifdef CI_86
X#include "a:stdio.h"
X#include "xlisp.h"
X#endif
X
X#ifdef AZTEC
X#include "a:stdio.h"
X#include "xlisp.h"
X#endif
X
X#ifdef unix
X#include <stdio.h>
X#include "xlisp.h"
X#endif
X
X#ifdef unos
X#include <ttymodes.h>
XTTYMODE savemodes, newmodes;
X#endif
X			    /* external variables */
X
Xextern struct node *xlstack;
Xextern struct node *xlenv;
Xextern struct node *self;
X
X
X			     /* local definitions */
X
X#define KMSIZE  256     /* number of characters in a keymap */
X#define KMAX    20      /* maximum number of characters in a key sequence */
X#define KEYMAP  0       /* instance variable number for 'keymap' */
X
X
X			      /* local variables */
X
Xstatic struct node *currentenv;
X
X#ifdef HACK
X	/* forward declarations (the extern hack is because of decusc) */
X
Xextern struct node *sendmsg();
X#endif
X
X		      /************************************
X		      *  isnew - initialize a new keymap  *
X		      ************************************/
X
Xstatic struct node *isnew(args)
X  struct node *args;
X{
X    xllastarg(args);                   /* No arguments ! */
X
X				       /* Create a keymap node */
X    xlivar(self->n_symvalue,KEYMAP)->n_listvalue = newnode(KMAP);
X
X    return (self->n_symvalue);         /* and return it */
X}
X
X
X	    /*******************************************************
X	    *  newkmap - allocate memory for a new key map vector  *
X	    *******************************************************/
X
Xstatic struct node *(*newkmap())[]
X{
X    struct node *(*map)[];
X
X				       /* allocate the vector */
X    if ((map = (struct node *(*)[]) calloc(1,sizeof(struct node *) * KMSIZE))
X			 == NULL)
X    {
X	printf("insufficient memory");
X	exit();
X    }
X
X    return (map);                      /* And return it */
X}
X
X
X			    /***********************
X			    *  key - define a key  *
X			    ***********************/
X
Xstatic struct node *key(args)
X  struct node *args;
X{
X    struct node *oldstk,arg,kstr,ksym,*kmap,*kmptr;
X    struct node *(*map)[];
X    char *sptr;
X    int ch;
X
X    oldstk = xlsave(&arg,&kstr,&ksym,NULL); /* Create new stack frame */
X    arg.n_ptr = args;                       /* initialize */
X
X    kmap = xlivar(self->n_symvalue,KEYMAP)->n_listvalue;   /* get keymap */
X    if (kmap == NULL && kmap->n_type != KMAP)
X	xlfail("bad keymap object");
X
X    kstr.n_ptr = xlevmatch(STR,&arg.n_ptr); /* Find key string */
X    ksym.n_ptr = xlevmatch(SYM,&arg.n_ptr); /* the the key symbol */
X    xllastarg(arg.n_ptr);                   /* and make sure thats all */
X
X    for (kmptr = kmap, sptr = kstr.n_ptr->n_str; /* process each char */
X	 *sptr != 0;
X	 kmptr = (*map)[ch])
X    {
X	ch = *sptr++;                       /* Get the character */
X	if ((map = kmptr->n_kmap) == NULL)  /* Allocate key map if reqd */
X	    map = kmptr->n_kmap = newkmap();
X
X	if (*sptr == 0)                     /* End of string ? */
X	    (*map)[ch] = ksym.n_ptr;
X	else
X	    if ((*map)[ch] == NULL || (*map)[ch]->n_type != KMAP)
X	    {
X		(*map)[ch] = newnode(KMAP);
X		(*map)[ch]->n_kmap = newkmap();
X	    }
X    }
X
X    xlstack = oldstk;                       /* Restore old stack frame */
X    return (self->n_symvalue);              /* and return keymap */
X}
X
X
X	    /*******************************************************
X	    *  process - process input characters using a key map  *
X	    *******************************************************/
X
Xstatic struct node *process(args)
X  struct node *args;
X{
X    struct node *oldstk,arg,env,margs,*kmap,*kmptr,*nptr,*oldenv;
X    struct node *(*map)[];
X    char keys[KMAX+1];
X    int ch,kndx;
X
X    oldstk = xlsave(&arg,&env,&margs,NULL); /* create new stack frame */
X    arg.n_ptr = args;                       /* Initialize */
X
X    kmap = xlivar(self->n_symvalue,KEYMAP)->n_listvalue;   /* Get keymap */
X    if (kmap == NULL && kmap->n_type != KMAP)
X	xlfail("bad keymap object");
X
X    env.n_ptr = xlevmatch(LIST,&arg.n_ptr); /* Get the environment */
X    xllastarg(arg.n_ptr);                   /* Ensure thats all */
X
X    oldenv = xlenv;                         /* Bind the environment variable */
X    xlbind(currentenv,env.n_ptr);
X    xlfixbindings(oldenv);
X
X    if (kmap->n_kmap == NULL)               /* Ensure key map is defined */
X	xlfail("empty keymap");
X
X    margs.n_ptr = newnode(LIST);            /* Create argument list */
X    margs.n_ptr->n_listvalue = newnode(STR);
X    margs.n_ptr->n_listvalue->n_str = keys;
X    margs.n_ptr->n_listvalue->n_strtype = STATIC;
X
X#ifdef unos
X    spfun(1,GTTY,&savemodes);
X    newmodes = savemodes;
X    UNIX_RAW_MODES(newmodes);
X    CLEAR_ECHO_MODES(newmodes);
X    newmodes.t_nowait = 1;
X    spfun(1,STTY,&newmodes);
X#endif
X
X    for (kmptr = kmap, kndx = 0; TRUE; )    /* Character processing loop */
X    {
X	fflush(stdout);                     /* Flush pending output */
X
X	if ((ch = kbin()) < 0)              /* Get a character */
X	    break;
X
X	if (kndx < KMAX)                    /* Put it is the key sequence */
X	    keys[kndx++] = ch;
X	else
X	    xlfail("key sequence too long");
X
X	if ((map = kmptr->n_kmap) == NULL)  /* dispatch on character code */
X	    xlfail("bad keymap");
X	else
X	if ((nptr = (*map)[ch]) == NULL)
X	{
X	    kmptr = kmap;
X	    kndx = 0;
X	}
X	else
X	if (nptr->n_type == KMAP)
X	    kmptr = (*map)[ch];
X	else
X	if (nptr->n_type == SYM)
X	{
X	    keys[kndx] = 0;
X	    if (sendmsg(nptr,currentenv->n_symvalue,margs.n_ptr) == NULL)
X		break;
X	    kmptr = kmap;
X	    kndx = 0;
X	}
X	else
X	    xlfail("bad keymap");
X    }
X
X#ifdef unos
X    spfun(1,STTY,&savemodes);
X#endif
X
X    xlunbind(oldenv);                       /* unbind */
X    xlstack = oldstk;                       /* Restore old stack frame */
X    return (self->n_symvalue);              /* and return keymap object */
X}
X
X
X	    /*******************************************************
X	    *  sendmsg - send a message given an environment list  *
X	    *******************************************************/
X
Xstatic struct node *sendmsg(msym,env,args)
X  struct node *msym,*env,*args;
X{
X    struct node *eptr,*obj,*msg;
X
X    /* look for an object that answers the message */
X    for (eptr = env; eptr != NULL; eptr = eptr->n_listnext)
X	if ((obj = eptr->n_listvalue) != NULL && obj->n_type == OBJ)
X	    if ((msg = xlmfind(obj,msym)) != NULL)
X		return (xlxsend(obj,msg,args));
X
X    /* return the message if no object answered it */
X    return (msym);
X}
X
X
X			 /*****************************
X			 *  xlkmmark - mark a keymap  *
X			 *****************************/
X
Xxlkmmark(km)
X  struct node *km;
X{
X    struct node *(*map)[];
X    int i;
X
X    km->n_flags |= MARK;               /* Mark the keymap node */
X
X    if ((map = km->n_kmap) == NULL)    /* Check for null keymap */
X	return;
X
X    for (i = 0; i < KMSIZE; i++)       /* Loop through each entry */
X	if (((*map)[i] != NULL) && (*map)[i]->n_type == KMAP)
X	    xlkmmark((*map)[i]);
X}
X
X
X			 /*****************************
X			 *  xlkmfree - free a keymap  *
X			 *****************************/
X
Xxlkmfree(km)
X  struct node *km;
X{
X    struct node *(*map)[];
X    int i;
X
X    if ((map = km->n_kmap) == NULL)         /* Check for null keymap */
X	return;
X
X    for (i = 0; i < KMSIZE; i++)            /* loop through each entry */
X	if (((*map)[i] != NULL) && (*map)[i]->n_type == KMAP)
X	    xlkmfree((*map)[i]);
X
X    free(km->n_kmap);                       /* and free this one */
X}
X
X
X	     /******************************************************
X	     *  xlkinit - key map function initialization routine  *
X	     ******************************************************/
X
Xxlkinit()
X{
X    struct node *keymap;
X
X    currentenv = xlenter("currentenv");     /* Define xlisp variables */
X
X    keymap = xlclass("Keymap",1);           /* Define keymap class */
X    xladdivar(keymap,"keymap");
X    xladdmsg(keymap,"isnew",isnew);
X    xladdmsg(keymap,"key",key);
X    xladdmsg(keymap,"process",process);
X}
X
X
X			 /******************************
X			 *  kbin : fetch a key stroke  *
X			 ******************************/
X
Xstatic kbin()
X{
X#ifdef unos
X    char c;
X    read(0,&c,1);
X    return c;
X#endif
X
X#ifdef AZTEC
X    return (CPM(6, 0xFF));
X#endif
X
X#ifdef CI_86
X    if (bdos(0x0b, 0) & 0xFF == 0xFF)
X	 return (bdos(0x08, 0));
X    return -1;
X#endif
X}
!Funky!Stuff!
exit 0
-- 
John Woods, Charles River Data Systems, Framingham MA, (617) 626-1114
...!decvax!frog!john, ...!mit-eddie!jfw, JFW@MIT-XX.ARPA

I have absolutely nothing clever to say in this signature.