Modified XLISP, part 3 of 5
John Woods
john at x.UUCP
Tue Aug 28 00:24:40 AEST 1984
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 at MIT-XX.ARPA
I have absolutely nothing clever to say in this signature.
More information about the Comp.sources.unix
mailing list