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.