earlw@pesnta.UUCP (Earl Wallace) (06/12/85)
#! /bin/sh
#
# This is the Little Smalltalk program that Marc Ries of the P-E Tustin Office
# acquired and passed on to me. It should work with Perkin-Elmer's Edition VII
# and XELOS systems.
#
# -earlw@pesnta
#
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# sources
# This archive created: Tue Jun 11 19:05:46 1985
# By: Earl Wallace (Perkin-Elmer Data Systems Group / Customer Service)
export PATH; PATH=/bin:$PATH
if test ! -d 'sources'
then
mkdir 'sources'
fi
cd 'sources'
if test -f 'disclaim'
then
echo shar: will not over-write existing file "'disclaim'"
else
cat << \SHAR_EOF > 'disclaim'
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
SHAR_EOF
if test 512 -ne "`wc -c < 'disclaim'`"
then
echo shar: error transmitting "'disclaim'" '(should have been 512 characters)'
fi
fi # end of overwriting check
if test -f 'Makefile'
then
echo shar: will not over-write existing file "'Makefile'"
else
cat << \SHAR_EOF > 'Makefile'
CFLAGS =-O
LFLAGS =-n
LIB = -lm
BINDIR = ../bin
PARSEDIR = ../parser
Objects = main.o object.o line.o \
class.o number.o symbol.o string.o byte.o array.o file.o \
primitive.o syms.o cldict.o process.o interp.o block.o courier.o \
lex.o drive.o lexcmd.o
Objects.c = main.c object.c line.c \
class.c number.c symbol.c string.c byte.c array.c file.c \
primitive.c syms.c cldict.c process.c interp.c block.c courier.c \
lex.c drive.c lexcmd.c
MISC = disclaim Makefile *.h sstr.c symbols
st: sstr drive.h cmds.h env.h $(Objects)
cc ${CFLAGS} $(LFLAGS) -o st $(Objects) $(LIB)
# the following is used by st make script for installation on the DecPro 350
# ld -o st -X -u __doprnt -u fltused -u fptrap -m \
# -lfpsim /lib/fcrt0.o $(Objects) -lm -lc
install: st
mv st $(BINDIR)
bundle: $(MISC) $(Objects.c)
rm -f drive.h cmds.h env.h
bundle $(MISC) $(Objects.c) >../sources.bundle
lint.out:$(Objects.c)
lint $(Objects.c)
syms.c: sstr symbols
sstr -t symbols SYMTABMAX '# include "object.h"' '# include "symbol.h"' >syms.c
sstr: sstr.c
cc ${CFLAGS} $(LFLAGS) -o sstr sstr.c
drive.h: $(PARSEDIR)/drive.h symbols
cp $(PARSEDIR)/drive.h .
cmds.h: $(PARSEDIR)/cmds.h symbols
sstr symbols <$(PARSEDIR)/cmds.h >cmds.h
env.h: $(PARSEDIR)/env.h
cp $(PARSEDIR)/env.h .
number.o: number.c number.h
interp.o: drive.h cmds.h
primitive.o: *.h
main.o: *.h
clean:
-rm -f ${Objects} sstr drive.h cmds.h env.h
SHAR_EOF
if test 1410 -ne "`wc -c < 'Makefile'`"
then
echo shar: error transmitting "'Makefile'" '(should have been 1410 characters)'
fi
fi # end of overwriting check
if test -f 'block.h'
then
echo shar: will not over-write existing file "'block.h'"
else
cat << \SHAR_EOF > 'block.h'
/*
Little Smalltalk
block definitions
timothy a. budd, 10/84
*/
/*
for blocks
b_size = BLOCKSIZE
b_interpreter is an instance of interpreter that will
actually execute the bytecodes for the block.
b_numargs and b_arglocation are the number of arguments and
the starting argument location in the context array.
*/
struct block_struct {
int b_ref_count;
int b_size;
interpreter *b_interpreter;
int b_numargs;
int b_arglocation;
} ;
typedef struct block_struct block;
extern object *new_block();
extern interpreter *block_execute();
SHAR_EOF
if test 562 -ne "`wc -c < 'block.h'`"
then
echo shar: error transmitting "'block.h'" '(should have been 562 characters)'
fi
fi # end of overwriting check
if test -f 'byte.h'
then
echo shar: will not over-write existing file "'byte.h'"
else
cat << \SHAR_EOF > 'byte.h'
/*
Little Smalltalk
Bytearray definitions
*/
struct byte_struct {
int a_ref_count;
int a_size;
int a_bsize;
uchar *a_bytes;
} ;
typedef struct byte_struct bytearray;
# define byte_value(x) (((bytearray *)(x))->a_bytes)
/*
bytearrays of size less than MAXBSAVE are kept on a free list
*/
# define MAXBSAVE 50
/*
in order to avoid a large number of small mallocs, especially
while reading the standard prelude, a fixed area of MAXBTABSIZE is
allocated and used for bytecodes until it is full. Thereafter
bytecodes are allocated using malloc. This area should be large
enough to hold at least all the bytecodes for the standard prelude.
*/
# define MAXBTABSIZE 5500
/*
for the same reason, a number of bytearrays structs are statically
allocated and placed on a free list
*/
# define MAXBYINIT 400
extern object *new_bytearray();
SHAR_EOF
if test 855 -ne "`wc -c < 'byte.h'`"
then
echo shar: error transmitting "'byte.h'" '(should have been 855 characters)'
fi
fi # end of overwriting check
if test -f 'file.h'
then
echo shar: will not over-write existing file "'file.h'"
else
cat << \SHAR_EOF > 'file.h'
/*
Little Smalltalk
class File definitions
timothy a. budd, 11/84
*/
/*
files use standard i/o package
*/
struct file_struct {
int l_ref_count;
int l_size;
int file_mode;
FILE *fp;
};
typedef struct file_struct file;
extern object *new_file();
extern object *file_read();
/* files can be opened in one of three modes, modes are either
0 - char mode - each read gets one char
1 - string mode - each read gets a string
2 - integer mode - each read gets an integer
*/
# define CHARMODE 0
# define STRMODE 1
# define INTMODE 2
SHAR_EOF
if test 544 -ne "`wc -c < 'file.h'`"
then
echo shar: error transmitting "'file.h'" '(should have been 544 characters)'
fi
fi # end of overwriting check
if test -f 'interp.h'
then
echo shar: will not over-write existing file "'interp.h'"
else
cat << \SHAR_EOF > 'interp.h'
/*
Little Smalltalk interpeter definitions
*/
/*
for interpreters
t_size = INTERPSIZE
creator is a pointer to the interpreter which created
the current interpreter. it is zero except in the case
of blocks, in which case it points to the creating
interpreter for a block. it is NOT a reference, ie,
the ref_count field of the creator is not incremented when
this field is set - this avoids memory reference loops.
stacktop is a pointer to a pointer to an object, however it
is not considered a reference. ie, changing stacktop does
not alter reference counts.
*/
struct interp_struct {
int t_ref_count;
int t_size; /* should always be INTERPSIZE */
struct interp_struct *creator;
struct interp_struct *sender;
object *bytecodes;
object *receiver;
object *literals;
object *context;
object *stack;
object **stacktop;
uchar *currentbyte;
};
typedef struct interp_struct interpreter;
extern interpreter *cr_interpreter();
extern object *o_drive;
# define is_driver(x) (o_drive == (object *) x)
SHAR_EOF
if test 1065 -ne "`wc -c < 'interp.h'`"
then
echo shar: error transmitting "'interp.h'" '(should have been 1065 characters)'
fi
fi # end of overwriting check
if test -f 'number.h'
then
echo shar: will not over-write existing file "'number.h'"
else
cat << \SHAR_EOF > 'number.h'
/*
Little Smalltalk number definitions
*/
/*
integer and character definitions
for integers
i_size = INTEGERSIZE
for characters
i_size = CHARSIZE
*/
struct int_struct {
int i_ref_count;
int i_size;
int i_value;
};
typedef struct int_struct integer;
# define int_value(x) (((integer *)x)->i_value)
# define char_value(x) ((char) int_value(x))
extern object *new_cori(); /* new Character OR Integer */
# define new_int(x) new_cori(x, 1)
# define new_char(x) new_cori(x, 0)
# define INTINITMAX 50
/*
floating point definitions
size should always be FLOATSIZE
*/
struct float_struct {
int f_ref_count;
int f_size;
double f_value;
};
typedef struct float_struct sfloat;
# define float_value(x) (((sfloat *)x)->f_value)
extern object *new_float();
SHAR_EOF
if test 790 -ne "`wc -c < 'number.h'`"
then
echo shar: error transmitting "'number.h'" '(should have been 790 characters)'
fi
fi # end of overwriting check
if test -f 'object.h'
then
echo shar: will not over-write existing file "'object.h'"
else
cat << \SHAR_EOF > 'object.h'
/*
Little Smalltalk object definitions
*/
# include "env.h"
/*
for objects the inst_var array is actually made as large as
necessary (as large as the size field). since C does not do
subscript bounds checking array indexing can be used
*/
struct obj_struct {
int ref_count;
int size;
struct class_struct *class;
struct obj_struct *super_obj;
struct obj_struct *inst_var[1];
};
/*
for classes
c_size = CLASSSIZE
class_name and super_class should be SYMBOLs
containing the names of the class and superclass,
respectively.
c_inst_vars should be an array of symbols, containing the
names of the instance variables
context size is the size of the context that should be
created each time a message is sent to objects of this
class.
message_names should be an array of symbols, corresponding
to the messages accepted by objects of this class.
methods should be an array of arrays, each element being a
two element array of bytecodes and literals.
*/
struct class_struct {
int c_ref_count;
int c_size;
struct obj_struct *class_name;
struct obj_struct *super_class;
struct obj_struct *file_name;
struct obj_struct *c_inst_vars;
int context_size;
struct obj_struct *message_names;
struct obj_struct *methods;
int stack_max;
};
typedef struct class_struct class;
typedef struct obj_struct object;
/*
objects with non-object value (classes, integers, etc) have a
negative size field, the particular value being used to indicate
the type of object (the class field cannot be used for this purpose
since all classes, even those for built in objects, can be redefined)
check_bltin is a macro that tests the size field for a particular
value. it is used to define other macros, such as is_class, that
test each particular type of object.
The following classes are builtin
Block
ByteArray
Char
Class
Float
Integer
Interpreter
String
Symbol
*/
# define BLOCKSIZE -83
# define BYTEARRAYSIZE -567
# define CHARSIZE -33
# define CLASSSIZE -3
# define FILESIZE -5
# define FLOATSIZE -31415
# define INTEGERSIZE -17
# define INTERPSIZE -15
# define PROCSIZE -100
# define STRINGSIZE -258
# define SYMBOLSIZE -14
# define is_bltin(x) (x && (((object *) x)->size < 0))
# define check_bltin(obj, type) (obj && (((object *) obj)->size == type))
# define is_block(x) check_bltin(x, BLOCKSIZE)
# define is_bytearray(x) check_bltin(x, BYTEARRAYSIZE)
# define is_character(x) check_bltin(x, CHARSIZE)
# define is_class(x) check_bltin(x, CLASSSIZE)
# define is_file(x) check_bltin(x, FILESIZE)
# define is_float(x) check_bltin(x, FLOATSIZE)
# define is_integer(x) check_bltin(x, INTEGERSIZE)
# define is_interpreter(x) check_bltin(x, INTERPSIZE)
# define is_process(p) check_bltin(p, PROCSIZE)
# define is_string(x) check_bltin(x, STRINGSIZE)
# define is_symbol(x) check_bltin(x, SYMBOLSIZE)
/*
mstruct is used (via casts) to store linked lists of structures of
various types for memory saving and recovering
*/
struct mem_struct {
struct mem_struct *mlink;
};
typedef struct mem_struct mstruct;
/*
sassign assigns val to obj, which should not have a valid
value in it already.
assign decrements an existing val field first, then assigns.
note this will not work for assign(x,x) if x ref count is 1.
safeassign, although producing less efficient code, will work even
in this case
*/
# define sassign(obj, val) obj_inc((object *) (obj = val))
# define assign(obj, val) {obj_dec((object *) obj); sassign(obj, val);}
# define safeassign(obj, val) {obj_inc((object *) val); \
obj_dec((object *) obj); obj = val; }
/* structalloc calls alloc to allocate a block of memory
for a structure and casts the returned
pointer to the appropriate type */
# define structalloc(type) (type *) o_alloc(sizeof(type))
/*
if INLINE is defined ( see env.h ) , inline code will be generated
for object increments. inline code is generally faster, but
larger than using subroutine calls for incs and decs
*/
extern int n_incs, n_decs;
# ifdef INLINE
# define obj_inc(x) n_incs++, (x)->ref_count++
extern object *_dx;
# define obj_dec(x) {n_decs++; if (--((_dx=x)->ref_count) <= 0) ob_dec(_dx);}
# endif
extern char *o_alloc(); /* allocate a block of memory */
extern object *new_inst(); /* make a new instance of a class */
extern object *new_sinst(); /* an internal (system) version of new_inst*/
extern object *new_obj(); /* allocate a new object */
extern object *new_array(); /* make a new array */
extern object *primitive(); /* perform a primitive operation */
extern object *o_nil; /* current value of pseudo variable nil */
extern object *o_true; /* current value of pseudo variable true */
extern object *o_false; /* current value of pseudo variable false */
extern object *o_smalltalk; /* current value of pseudo var smalltalk */
extern int debug; /* debugging toggle */
/* reference count macro, used during debugging */
# define rc(x) ((object *)x)->ref_count
SHAR_EOF
if test 5074 -ne "`wc -c < 'object.h'`"
then
echo shar: error transmitting "'object.h'" '(should have been 5074 characters)'
fi
fi # end of overwriting check
if test -f 'primitive.h'
then
echo shar: will not over-write existing file "'primitive.h'"
else
cat << \SHAR_EOF > 'primitive.h'
/*
Little Smalltalk primitive definitions
(only a subset of primitives are described here,
basically those used by the courier and other systems routines.
All other primitives are known only by number)
*/
# define EQTEST 7
# define GAMMAFUN 77
# define SYMEQTEST 91
# define SYMPRINT 94
# define FINDCLASS 99
# define GROW 113
# define BLKRETERROR 127
# define REFCOUNTERROR 128
# define NORESPONDERROR 129
# define RAWPRINT 120
# define PRINT 121
# define ERRPRINT 123
# define BLOCKEXECUTE 140
# define DOPERFORM 143
SHAR_EOF
if test 528 -ne "`wc -c < 'primitive.h'`"
then
echo shar: error transmitting "'primitive.h'" '(should have been 528 characters)'
fi
fi # end of overwriting check
if test -f 'process.h'
then
echo shar: will not over-write existing file "'process.h'"
else
cat << \SHAR_EOF > 'process.h'
/*
Little Smalltalk
process definitions
dennis a. vadner and michael t. benhase, 11/84
*/
/*
the process
interp = pointer to the head of the process'
interpreter chain
p_state = current state of the process
next = link to the next process in the active list
prev = link to the previous process in the active list
*/
struct process_struct {
int p_ref_count;
int p_size;
interpreter *interp;
int p_state;
struct process_struct *next;
struct process_struct *prev;
} ;
typedef struct process_struct process;
extern int atomcnt; /* atomic action flag */
extern process *runningProcess; /* currently running process */
extern process *cr_process(); /* create a new process */
extern int set_state(); /* set the state on a process */
/* process states */
# define ACTIVE 0
# define SUSPENDED 1
# define READY ~SUSPENDED
# define BLOCKED 2
# define UNBLOCKED ~BLOCKED
# define TERMINATED 4
# define CUR_STATE 10
# define terminate_process(aProcess) {set_state(aProcess, TERMINATED); \
if (aProcess == runningProcess) \
atomcnt = 0;}
SHAR_EOF
if test 1106 -ne "`wc -c < 'process.h'`"
then
echo shar: error transmitting "'process.h'" '(should have been 1106 characters)'
fi
fi # end of overwriting check
if test -f 'string.h'
then
echo shar: will not over-write existing file "'string.h'"
else
cat << \SHAR_EOF > 'string.h'
/*
Little Smalltalk string definitions
*/
/*
for strings s_size = STRINGSIZE
Unlike other special objects (integers, floats, etc), strings
must keep their own super_obj pointer, since the class
ArrayedCollection (a super class of String) contains instance
variables, and thus each instance of String must have a unique
super_obj.
*/
struct string_struct {
int s_ref_count;
int s_size;
object *s_super_obj;
char *s_value;
} ;
typedef struct string_struct string;
extern object *new_str(); /* make a new string object */
extern string *new_istr(); /* internal form of new string */
extern char *walloc(); /* allocate a copy a word */
# define string_value(x) (((string *) x)->s_value)
SHAR_EOF
if test 706 -ne "`wc -c < 'string.h'`"
then
echo shar: error transmitting "'string.h'" '(should have been 706 characters)'
fi
fi # end of overwriting check
if test -f 'symbol.h'
then
echo shar: will not over-write existing file "'symbol.h'"
else
cat << \SHAR_EOF > 'symbol.h'
/*
Little Smalltalk string and symbol definitions
*/
/*
for symbols y_size = SYMBOLSIZE
only one text copy of each symbol is kept.
A global symbol table is searched each time a new symbol is
created, and symbols with the same character representation are
given the same entry.
*/
struct symbol_struct {
int y_ref_count;
int y_size;
char *y_value;
} ;
typedef struct symbol_struct symbol;
extern symbol *sy_search(); /* binary search for a symbol */
extern char *w_search(); /* binary search for a word */
# define symbol_value(x) (((symbol *) x)->y_value)
# define new_sym(val) ((object *) sy_search(val, 1))
# define SYMTABMAX 500
/* SYMINITSIZE symbol entries are allocated at the start of execution,
which prevents malloc from being called too many times */
# define SYMINITSIZE 60
SHAR_EOF
if test 807 -ne "`wc -c < 'symbol.h'`"
then
echo shar: error transmitting "'symbol.h'" '(should have been 807 characters)'
fi
fi # end of overwriting check
if test -f 'sstr.c'
then
echo shar: will not over-write existing file "'sstr.c'"
else
cat << \SHAR_EOF > 'sstr.c'
/*
sstr - find and replace string occurrences
with common addresses,
can be used to share strings accross compiled boundaries
written by tim budd, 9/84
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# define WORDTABMAX 1000
# define STRTABMAX 10000
int x_cmax = 0;
int x_tmax = -1;
char x_str[STRTABMAX];
char *x_tab[WORDTABMAX];
main(argc, argv)
int argc;
char **argv;
{ int i;
FILE *fd;
if (strcmp(argv[1], "-f") == 0) {
for (i = 2; i < argc; i++) {
fd = fopen(argv[i], "r");
if (fd != NULL) {
findstrs(fd);
fclose(fd);
}
}
}
else if (strcmp(argv[1], "-t") == 0) {
for (i = 4; i < argc; i++)
puts(argv[i]);
fd = fopen(argv[2], "r");
if (fd == NULL) {
fprintf(stderr,"can't open string table\n");
exit(1);
}
maketab(fd, stdout, argv[3]);
}
else {
fd = fopen(argv[1], "r");
if (fd == NULL) {
fprintf(stderr,"can't open string table\n");
exit(1);
}
maketab(fd, 0, 0);
printf("extern char x_str[];\n");
replacestr(stdin);
}
exit(0);
}
/* findstrs - find all strings and output them to stdout */
findstrs(fd)
FILE *fd;
{
char *p, buffer[500];
int c;
for (; (c = getc(fd)) != EOF; )
if (c == '\"') {
for (p = buffer; (c = getc(fd)) != '\"'; p++)
if (c == EOF) {
fprintf(stderr,"unexpected eof\n");
exit(1);
}
else *p = c;
*p = '\0';
puts(buffer);
}
}
/* replacestr - replace strings with their address in x_str */
replacestr(fd)
FILE *fd;
{
char *p, buffer[500], *w_search();
int c;
for (; (c = getc(fd)) != EOF; )
if (c != '\"') putchar(c);
else {
for (p = buffer; (c = getc(fd)) != '\"'; p++)
if (c == EOF) {
fprintf(stderr,"unexpected eof\n");
exit(1);
}
else *p = c;
*p = '\0';
p = w_search(buffer, 0);
if (p) printf("&x_str[%d]", p - &x_str[0]);
else printf("\"%s\"", buffer);
}
}
maketab(ifd, ofd, itab)
FILE *ifd, *ofd;
char *itab;
{ char wbuf[100], *p;
int i;
x_cmax = 0;
if (ofd)
fprintf(ofd, "char x_str[] = {");
while (fgets(wbuf, 100, ifd) != NULL) {
x_tab[++x_tmax] = &x_str[x_cmax];
for (p = wbuf; *p; p++) {
if (*p == '\n') {*p = '\0'; break;}
if (ofd)
fprintf(ofd,"0%o, ", *p);
x_str[x_cmax++] = *p;
}
if (ofd)
fprintf(ofd, "0, /* %s */\n", wbuf);
x_str[x_cmax++] = '\0';
}
if (ofd) {
fprintf(ofd, "0 };\n");
fprintf(ofd, "int x_cmax = %d;\n", x_cmax);
}
if (itab) {
fprintf(ofd, "static symbol x_sytab[] = {\n");
for (i = 0; i <= x_tmax; i++) {
fprintf(ofd, "{1, SYMBOLSIZE, &x_str[%d]}, /* ",
x_tab[i]-x_tab[0]);
for (p = x_tab[i]; *p; p++)
putc(*p, ofd);
fprintf(ofd," */\n");
}
fprintf(ofd, "0};\n");
fprintf(ofd, "symbol *x_tab[%s] = {\n", itab);
for (i = 0; i <= x_tmax; i++) {
fprintf(ofd, "&x_sytab[%d], /* ",i);
for (p = x_tab[i]; *p; p++)
putc(*p, ofd);
fprintf(ofd," */\n");
}
fprintf(ofd, "0};\n");
fprintf(ofd,"int x_tmax = %d;\n", x_tmax);
}
}
/*
word search for table routines
*/
char *w_search(word, insert)
char *word;
int insert;
{ int i,j,k;
for (i=1; i <= x_tmax; i <<= 1);
for (i >>= 1, j = i >>1, i--; ; j >>= 1) {
if (! (k = strcmp(word, x_tab[i])))
return(x_tab[i]);
if (!j) break;
if (k < 0) i -= j;
else {
if ((i += j) > x_tmax) i = x_tmax;
}
}
if (insert) {
for (k = ++x_tmax; k > i; k--) {
x_tab[k] = x_tab[k-1];
}
if (!(x_tab[i] = (char *) malloc(1 + strlen(word))))
return((char *) 0);
strcpy(x_tab[i], word);
return(x_tab[i]);
}
else return((char *) 0);
}
SHAR_EOF
if test 4018 -ne "`wc -c < 'sstr.c'`"
then
echo shar: error transmitting "'sstr.c'" '(should have been 4018 characters)'
fi
fi # end of overwriting check
if test -f 'symbols'
then
echo shar: will not over-write existing file "'symbols'"
else
cat << \SHAR_EOF > 'symbols'
!
&
(
)
*
+
,
-
/
//
<
<=
=
==
>
>=
@
Array
ArrayedCollection
BLOCKED
Bag
Block
Boolean
ByteArray
Char
Class
Collection
Complex
Dictionary
False
File
Float
Integer
Interpreter
Interval
KeyedCollection
List
Little Smalltalk
Magnitude
Main
Number
Object
OrderedCollection
Point
Process
READY
Radian
Random
SUSPENDED
Semaphore
SequenceableCollection
Set
Smalltalk
String
Symbol
TERMINATED
True
UndefinedObject
[
\\
\\\\
]
^
abs
add:
add:after:
add:before:
add:withOccurrences:
addAll:
addAllFirst:
addAllLast:
addFirst:
addLast:
after:
allMask:
and:
anyMask:
arcCos
arcSin
arcTan
argerror
asArray
asBag
asCharacter
asDictionary
asFloat
asFraction
asInteger
asList
asLowercase
asOrderedCollection
asSet
asString
asSymbol
asUppercase
asciiValue
at:
at:ifAbsent:
at:put:
atAll:put:
atAllPut:
before:
between:and:
binaryDo:
bitAnd:
bitAt:
bitInvert
bitOr:
bitShift:
bitXor:
block
blockedProcessQueue
ceiling
checkBucket:
class
cleanUp
coerce:
collect:
commands:
compareError
copy
copyArguments:
copyArguments:to:
copyFrom:
copyFrom:length:
copyFrom:to:
copyWith:
copyWithout:
cos
count
currAssoc
currBucket
current
currentBucket
currentKey
currentList
date
debug:
deepCopy
deepCopy:
detect:
detect:ifAbsent:
detect:ifNone:
dict
dictionary
digitValue
digitValue:
display
displayAssign
dist:
do:
doPrimitive:
doPrimitive:withArguments:
edit
equals:startingAt:
eqv:
error:
even
excessSignals
executeWith:
exp
factorial
findAssociation:inList:
findFirst:
findFirst:ifAbsent:
findLast
findLast:
findLast:ifAbsent:
first
firstKey
floor
floorLog:
fork
forkWith:
fractionPart
free:
from:
from:to:
from:to:by:
gamma
gcd:
getList:
grid:
hashNumber:
hashTab
hashTable
highBit
i
ifFalse:
ifFalse:ifTrue:
ifTrue:
ifTrue:ifFalse:
inRange:
includes:
includesKey:
indexOf:
indexOf:ifAbsent:
indexOfSubCollection:startingAt:
indexOfSubCollection:startingAt:ifAbsent:
init:
init:super:
init:super:numVars:
inject:into:
integerPart
isAlphaNumeric
isDigit
isEmpty
isKindOf:
isLetter
isLowercase
isMemberOf:
isNil
isSeparator
isUppercase
isVowel
keys
keysDo:
keysSelect:
last
lastKey
lcm:
list
ln
log:
lower
main
max:
maxContext:
maxtype:
methods:
min:
modeCharacter
modeInteger
modeString
name:
negated
negative
new
new:
newProcess
newProcessWith:
next
next:
noDisplay
noMask:
not
notNil
nothing
occurrencesOf:
odd
opError
open:
open:for:
or:
perform:
perform:withArguments:
pi
positive
print
printString
put:
quo:
radians
radix:
raisedTo:
raisedToInteger:
randInteger:
randomize
read
reciprocal
reject:
rem:
remove:
remove:ifAbsent:
removeAll:
removeError
removeFirst
removeKey:
removeKey:ifAbsent:
removeLast
removed
replaceFrom:to:with:
replaceFrom:to:with:startingAt:
respondsTo
respondsTo:
resume
reverseDo:
reversed
roundTo:
rounded
sameAs:
seed
select:
setCurrentLocation:
sh:
shallowCopy
shallowCopy:
sign
signal
sin
size
smalltalk
sort
sort:
sqrt
squared
state
step
strictlyPositive
superClass
superClass:
suspend
tan
temp
termErr:
terminate
time:
timesRepeat:
to:
to:by:
transpose
truncateTo:
truncated
truncatedGrid:
unblock
upper
value
value:
value:value:
value:value:value:
value:value:value:value:
value:value:value:value:value:
values
variables
variables:
view
wait
whileFalse:
whileTrue:
with:do:
withArguments:
write:
x
x:
xor:
xvalue
y
y:
yield
yvalue
|
~
~=
~~
SHAR_EOF
if test 3253 -ne "`wc -c < 'symbols'`"
then
echo shar: error transmitting "'symbols'" '(should have been 3253 characters)'
fi
fi # end of overwriting check
if test -f 'main.c'
then
echo shar: will not over-write existing file "'main.c'"
else
cat << \SHAR_EOF > 'main.c'
/*
Little Smalltalk -
main driver
timothy a. budd
1. initializes various smalltalk constants and classes with
legitimate values. these values, however, will for the most part
be overridden when the standard prelude is read in.
2. reads in the standard prelude, plus any additional files listed
on the command line.
3. places the driver reading stdin on the process queue and starts
the process driver running.
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
int version = 2; /* a Kludge to get us the start of the data segment.
used to save and restore contexts */
# include <stdio.h>
# include "object.h"
# include "string.h"
# include "symbol.h"
# include "interp.h"
# include "primitive.h"
static object *null_object; /* a totally classless object */
static char filebase[80]; /* base for forming temp file names */
extern int n_incs, n_decs, n_mallocs; /* counters */
extern int ca_block, ca_barray, ca_class, ca_terp, ca_int, ca_float;
extern int ca_obj, ca_str, ca_sym, ca_wal, ca_cdict;
extern int ca_cobj[];
extern int btabletop, wtop; /* more counters */
# ifdef INLINE
object *_dx; /* object pointer used for decrementing */
# endif
int silence = 0; /* 1 if silence is desired on output */
int noload = 0; /* 1 if no loading of standard prelude is desired */
int debug = 0; /* debug flag, set by a primitive call */
int fastload = 0; /* 1 if doing a fast load of saved image */
int lexprnt = 0; /* 1 if printing during lex is desired (for debug) */
int prallocs = 0; /* 1 if printing final allocation figures is wanted */
int started = 0; /* 1 if we have started reading user commands */
int prntcmd = 1; /* 1 or 2 and commands will be printed as evaled */
/* pseudo-variables */
object *o_acollection; /* arrayed collection (used internally) */
object *o_drive; /* driver interpreter */
object *o_empty; /* the empty array (used during initial) */
object *o_false; /* value for pseudo variable false */
object *o_magnitude; /* instance of class Magnitude */
object *o_nil; /* value for pseudo variable nil */
object *o_number; /* instance of class Number */
object *o_object; /* instance of class Object */
object *o_tab; /* string with tab only */
object *o_true; /* value of pseudo variable true */
object *o_smalltalk; /* value of pseudo variable smalltalk */
/* classes to be initialized */
extern class *Array;
extern class *ArrayedCollection;
/* input stack */
extern FILE *fdstack[];
extern int fdtop;
/* main - main driver */
main(argc, argv)
int argc;
char **argv;
{ int i;
class *null_class();
object *tempobj;
FILE *sfd;
# ifdef FASTDEFAULT
fastload = 1;
# endif
# ifndef FASTDEFAULT
fastload = 0;
# endif
/* first check for flags */
for (i = 1; i < argc; i++)
if (argv[i][0] == '-')
switch(argv[i][1]) {
case 'f': fastload = 1; break;
case 'l': /* fall through */
case 'n': noload = 1; /* fall through */
case 'm': fastload = 0; break;
case 'z': lexprnt = 1; break;
}
if (fastload) {
dofast();
}
else { /* gotta do it the hard way */
strcpy(filebase, TEMPFILE);
mktemp(filebase);
byte_init();
class_init();
cdic_init();
int_init();
str_init();
sym_init();
init_objs();
null_object = new_obj((class *) 0, 0, 0);
sassign(o_object, null_object);
/* true is given a different object from others , so comparisons
work correctly */
sassign(o_true, new_obj((class *) 0, 0, 0));
sassign(o_false, null_object);
sassign(o_nil, null_object);
sassign(o_number, null_object);
sassign(o_magnitude, null_object);
sassign(o_empty, null_object);
sassign(o_smalltalk, null_object);
sassign(o_acollection, null_object);
sassign(Array, null_class("Array"));
sassign(ArrayedCollection, null_class("ArrayedCollection"));
drv_init(); /* initialize the driver */
sassign(o_drive, (object *) cr_interpreter((interpreter *) 0,
null_object, null_object, null_object, null_object));
init_process((interpreter *) o_drive);
/* now read in standard prelude */
if (! noload) {
sfd = fopen(PRELUDE, "r");
if (sfd == NULL) cant_happen(20);
set_file(sfd);
start_execution();
fclose(sfd);
}
/* then set lexer up to read stdin */
set_file(stdin);
sassign(o_tab, new_str("\t"));
}
/* announce that we're ready for action */
sassign(tempobj, new_sym("Little Smalltalk"));
primitive(SYMPRINT, 1, &tempobj);
obj_dec(tempobj);
started = 1;
/* now read in the command line files */
user_read(argc, argv);
start_execution();
/* print out one last newline - to move everything out of output
queue */
sassign(tempobj, new_sym("\n"));
primitive(SYMPRINT, 1, &tempobj);
obj_dec(tempobj);
/* now free things up, hopefully keeping ref counts straight */
drv_free();
flush_processes();
free_low_nums();
obj_dec((object *) Array);
obj_dec((object *) ArrayedCollection);
free_all_classes();
obj_dec(o_tab);
obj_dec(o_drive);
obj_dec(o_magnitude);
obj_dec(o_number);
obj_dec(o_nil);
obj_dec(o_false);
obj_dec(o_true);
obj_dec(o_object);
obj_dec(o_empty);
obj_dec(o_smalltalk);
obj_dec(o_acollection);
if (! silence)
fprintf(stderr,"incs %u decs %u difference %d allocs %d\n",
n_incs, n_decs, n_incs - n_decs, n_mallocs);
if (prallocs) {
fprintf(stderr,"blocks allocated %d\n", ca_block);
fprintf(stderr,"bytearrays allocated %d\n", ca_barray);
fprintf(stderr,"classes allocated %d\n", ca_class);
fprintf(stderr,"interpreters allocated %d\n", ca_terp);
fprintf(stderr,"ints allocated %d\n", ca_int);
fprintf(stderr,"floats allocated %d\n", ca_float);
fprintf(stderr,"strings allocated %d\n", ca_str);
fprintf(stderr,"symbols allocated %d\n", ca_sym);
fprintf(stderr,"class entryies %d\n", ca_cdict);
fprintf(stderr,"wallocs %d\n", ca_wal);
fprintf(stderr,"wtop %d\n", wtop);
fprintf(stderr,"byte table top %d\n", btabletop);
fprintf(stderr,"smalltalk objects allocated %d\n", ca_obj);
for (i = 0; i < 5; i++)
fprintf(stderr,"size %d objects %d\n", i, ca_cobj[i]);
}
clean_files();
exit(0); /* say good by gracie */
}
/* dofast - do a fast load of the standard prelude */
static dofast() {
char buffer[100];
sprintf(buffer,")l %s\n", FAST);
dolexcommand(buffer);
}
/* null_class - create a null class for bootstrapping purposes */
static class *null_class(name)
char *name;
{ class *new, *new_class();
new = new_class();
assign(new->class_name, new_sym(name));
enter_class(name, (object *) new);
return(new);
}
/* user_read - read the user command line arguments */
static user_read(argc, argv)
int argc;
char **argv;
{ int i, count;
char buffer[100];
char name[100];
FILE *fd = 0;
gettemp(name);
count = 0;
fd = fopen(name, "w");
if (fd == NULL)
cant_happen(22);
for (i = 1; i < argc; i++)
if (argv[i][0] == '-') {
switch(argv[i][1]) {
case 'a':
prallocs = 1; break;
case 'l':
sprintf(buffer,")l %s\n", argv[++i]);
count++;
fputs(buffer, fd);
break;
case 'd':
prntcmd = argv[i][1] - '0';
break;
case 'r':
sprintf(buffer,")r %s\n", argv[++i]);
count++;
fputs(buffer, fd);
break;
case 's':
silence = 1;
break;
}
}
else {
sprintf(buffer,")i %s\n", argv[i]);
count++;
fputs(buffer, fd);
}
fclose(fd);
if (count) {
fd = fopen(name, "r");
if (fd == NULL)
cant_happen(22);
set_file(fd);
}
}
/* gettemp makes a temp file name that can be deleted when finished */
static char c = 'a';
gettemp(buffer)
char *buffer;
{
sprintf(buffer,"%s%c", filebase, c++);
if (c > 'z') c = 'a'; /* wrap around forever */
}
/* clean_files - delete all temp files created */
static clean_files()
{
char buffer[100];
# ifndef NOSYSTEM
sprintf(buffer,"rm -f %s*", filebase);
system(buffer);
# endif
}
SHAR_EOF
if test 8245 -ne "`wc -c < 'main.c'`"
then
echo shar: error transmitting "'main.c'" '(should have been 8245 characters)'
fi
fi # end of overwriting check
if test -f 'object.c'
then
echo shar: will not over-write existing file "'object.c'"
else
cat << \SHAR_EOF > 'object.c'
/*
Little Smalltalk
object memory management
timothy a. budd, 10/84
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include "object.h"
# include "drive.h"
# include "string.h"
# include "symbol.h"
# include "byte.h"
# include "number.h"
# include "interp.h"
# include "process.h"
# include "block.h"
# include "file.h"
# include "primitive.h"
# define DEBUG 0
extern object *o_acollection;
int n_incs = 0; /* number of increments counter */
int n_decs = 0; /* number of decrements counter (should be equal)*/
int n_mallocs = 0; /* number of mallocs counter */
/* o_alloc - allocate a block of memory, checking for end of memory */
char *o_alloc(n)
unsigned n;
{ char *p, *malloc();
p = malloc(n);
if (p == (char *) 0) cant_happen(1); /* out of memory */
n_mallocs++;
return(p);
}
#ifndef INLINE
/* obj_inc - increment an object (usually expanded in-line) */
obj_inc(x)
register object *x;
{
x->ref_count++;
n_incs++;
}
/* obj_dec - decrement an object (usually half expanded in-line) */
obj_dec(x)
object *x;
{
n_decs++;
if (--(x->ref_count) > 0) return;
# endif
# ifdef INLINE
ob_dec(x)
object *x;
{
# endif
if (x->ref_count < 0) {
fprintf(stderr,"ref count %d %d\n", x->ref_count, x);
x->ref_count /= 0;
primitive(REFCOUNTERROR, 1, &x);
return;
}
if (is_bltin(x)) { /* free a built-in object */
switch(x->size) {
case BLOCKSIZE:
free_block(x); break;
case BYTEARRAYSIZE:
free_bytearray((bytearray *) x); break;
case CLASSSIZE :
free_class((class *) x); break;
case FILESIZE:
free_file((struct file_struct *) x);
break;
case FLOATSIZE:
free_float((sfloat *) x); break;
case INTEGERSIZE: case CHARSIZE:
free_integer((integer *) x); break;
case INTERPSIZE:
free_terpreter((interpreter *) x); break;
case PROCSIZE:
free_process((process *) x); break;
case SYMBOLSIZE:
cant_happen(16);
case STRINGSIZE:
free_string((string *) x); break;
default: cant_happen(6);
}
}
else { /* free a normal (non-special) object */
if (x->super_obj)
obj_dec(x->super_obj);
free_obj(x, 1);
}
}
# define MAXOBJLIST 100
# define sizeobj(x) (sizeof(object) + ((x) - 1) * sizeof(object *) )
/* obj_free_list is a free list for memory blocks */
static object *obj_free_list[MAXOBJLIST]; /* better be initialized to zero! */
int ca_obj = 0; /* count the number of allocations made */
int ca_cobj[5] = {0,0,0,0,0}; /* count how many allocations for small vals*/
/* make sure the following list is null terminated! */
int size_obj_init[] = {15, 75, 420, 10, 10, 5, 0};
/* init_objs - initialize the memory management module */
init_objs() {
int i, j, max, size;
char *p;
object *new;
for (i = 0; (max = size_obj_init[i]); i++) {
size = sizeobj(i);
p = o_alloc((unsigned int) (max * size));
for (j = 0; j < max; j++) {
new = (object *) p;
new->super_obj = obj_free_list[i];
obj_free_list[i] = new;
p += size;
}
}
}
/* new_obj - create a new non-special object */
object *new_obj(nclass, nsize, alloc)
class *nclass;
int nsize, alloc;
{ register object *new;
int i;
if (nsize < 0)
cant_happen(2);
if (nsize < MAXOBJLIST && obj_free_list[nsize])
obj_free_list[nsize] = (new = obj_free_list[nsize])->super_obj;
else {
new = (object *) o_alloc(sizeobj(nsize));
ca_obj++;
if (nsize < 5)
ca_cobj[nsize]++;
}
new->super_obj = (object *) 0;
new->class = nclass;
if (nclass)
obj_inc((object *) new->class );
new->ref_count = 0;
new->size = nsize;
if (alloc)
for (i = 0; i < nsize; i++) {
sassign(new->inst_var[ i ], o_nil);
}
return(new);
}
/* free_obj - free a non-special object */
free_obj(obj, dofree)
register object *obj;
int dofree;
{ int size, i;
size = obj->size;
if (dofree)
for (i = 0; i < size; i++)
obj_dec(obj->inst_var[i]);
if (obj->class)
obj_dec((object *) obj->class);
if (size < MAXOBJLIST) {
obj->super_obj = obj_free_list[size];
obj_free_list[size] = obj;
}
else {
free(obj);
}
}
/* fnd_class - find the class of a special object */
object *fnd_class(anObject)
object *anObject;
{ object *result, *lookup_class();
char *name;
if (is_bltin(anObject)) {
switch(anObject->size) {
case BLOCKSIZE: name = "Block"; break;
case CLASSSIZE: name = "Class"; break;
case FILESIZE: name = "File"; break;
case FLOATSIZE: name = "Float"; break;
case INTEGERSIZE: name = "Integer"; break;
case CHARSIZE: name = "Char"; break;
case INTERPSIZE: name = "Interp"; break;
case PROCSIZE: name = "Process"; break;
case SYMBOLSIZE: name = "Symbol"; break;
case STRINGSIZE: name = "String"; break;
case BYTEARRAYSIZE: name = "ByteArray"; break;
default: cant_happen(6);
}
result = lookup_class(name);
}
else
result = (object *) anObject->class;
return(result);
}
extern object *o_object, *o_magnitude, *o_number;
/* fnd_super - produce a super-object for a special object */
object *fnd_super(anObject)
object *anObject;
{ object *result;
if (is_bltin(anObject)) {
switch(anObject->size) {
case BLOCKSIZE: result = o_object; break;
case CLASSSIZE: result = o_object; break;
case FILESIZE: result = o_object; break;
case FLOATSIZE: result = o_number; break;
case INTEGERSIZE: result = o_number; break;
case CHARSIZE: result = o_magnitude; break;
case INTERPSIZE: result = o_object; break;
case PROCSIZE: result = o_object; break;
case SYMBOLSIZE: result = o_object; break;
case STRINGSIZE: /* strings DO have superobjs*/
result = ((string *) anObject)->s_super_obj;
break;
case BYTEARRAYSIZE: result = o_acollection; break;
default: cant_happen(6);
}
}
else
result = anObject->super_obj;
return(result);
}
SHAR_EOF
if test 6270 -ne "`wc -c < 'object.c'`"
then
echo shar: error transmitting "'object.c'" '(should have been 6270 characters)'
fi
fi # end of overwriting check
if test -f 'line.c'
then
echo shar: will not over-write existing file "'line.c'"
else
cat << \SHAR_EOF > 'line.c'
/*
Little Smalltalk
line grabber - does lowest level input for command lines.
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include "object.h"
# include "primitive.h"
# define MAXINCLUDE 10
# define MAXBUFFER 1200 /* text buffer */
static FILE *fdstack[MAXINCLUDE];
static int fdtop = -1;
static char buffer[MAXBUFFER];
static char *buftop = buffer;
char *lexptr = buffer;
static enum {empty, half, filled} bufstate = empty;
int inisstd = 0;
extern object *o_tab;
/* set file - set a file on the file descriptor stack */
set_file(fd)
FILE *fd;
{
if ((++fdtop) > MAXINCLUDE)
cant_happen(18);
fdstack[fdtop] = fd;
if (fd == stdin) inisstd = 1;
else inisstd = 0;
}
/* line-grabber - read a line of text
do blocked i/o if blocked is nonzero,
otherwise do non-blocking i/o */
int line_grabber(block)
int block;
{
/* if it was filled last time, it is now empty */
if (bufstate == filled) {
bufstate = empty;
buftop = buffer;
lexptr = buffer;
}
if ( ! block)
return(0); /* for now, only respond to blocked requests*/
else while (bufstate != filled) {
if (fdtop < 0) {
fprintf(stderr,"no files to read\n");
return(-1);
}
if (inisstd && o_tab)
primitive(RAWPRINT, 1, &o_tab);
if (fgets(buftop, MAXBUFFER, fdstack[fdtop]) == NULL) {
bufstate = empty;
if (fdstack[fdtop] != stdin)
fclose(fdstack[fdtop]);
if (--fdtop < 0) return(-1);
inisstd = (fdstack[fdtop] == stdin);
}
else {
bufstate = half;
while (*buftop) buftop++;
if (*(buftop-1) == '\n') {
if (*(buftop-2) == '\\') {
buftop -= 2;
}
else {
if ((buftop - buffer) > MAXBUFFER)
cant_happen(18);
*buftop = '\0';
bufstate = filled;
}
}
}
}
return(bufstate == filled);
}
SHAR_EOF
if test 2244 -ne "`wc -c < 'line.c'`"
then
echo shar: error transmitting "'line.c'" '(should have been 2244 characters)'
fi
fi # end of overwriting check
if test -f 'class.c'
then
echo shar: will not over-write existing file "'class.c'"
else
cat << \SHAR_EOF > 'class.c'
/*
Little Smalltalk
class instance creation and deletion
timothy a. budd 10/84
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include "object.h"
# include "file.h"
# include "number.h"
# include "symbol.h"
# include "string.h"
# include "primitive.h"
# define streq(x,y) (strcmp(x,y) == 0)
extern class *Array, *ArrayedCollection;
extern object *o_object, *o_empty, *o_number, *o_magnitude;
extern object *o_smalltalk, *o_acollection;
static mstruct *fr_class = 0;
int ca_class = 0; /* count class allocations */
# define CLASSINITMAX 30
static class cl_table[CLASSINITMAX];
class_init()
{ class *p;
mstruct *new;
int i;
for (p = cl_table, i = 0; i < CLASSINITMAX; i++, p++) {
new = (mstruct *) p;
new->mlink = fr_class;
fr_class = new;
}
}
class *new_class()
{ class *new;
if (fr_class) {
new = (class *) fr_class;
fr_class = fr_class->mlink;
}
else {
new = structalloc(class);
ca_class++;
}
new->c_ref_count = 0;
new->c_size = CLASSSIZE;
sassign(new->file_name, o_nil);
sassign(new->class_name, o_nil);
new->super_class = (object *) 0;
sassign(new->c_inst_vars, o_nil);
new->context_size = 0;
sassign(new->message_names, o_nil);
sassign(new->methods, o_nil);
return(new);
}
class *mk_class(classname, args)
char *classname;
object **args;
{ class *new;
object *new_iarray();
new = new_class();
assign(new->class_name, args[0]);
if (! streq(classname, "Object"))
sassign(new->super_class, args[1]);
assign(new->file_name, args[2]);
assign(new->c_inst_vars, args[3]);
assign(new->message_names, args[4]);
assign(new->methods, args[5]);
new->context_size = int_value(args[6]);
new->stack_max = int_value(args[7]);
if (streq(classname, "Array")) {
assign(Array, new);
assign(o_empty, new_iarray(0));
}
else if (streq(classname, "ArrayedCollection")) {
assign(ArrayedCollection, new);
assign(o_acollection, new_inst(new));
assign(o_empty, new_iarray(0));
}
else if (streq(classname, "False"))
assign(o_false, new_inst(new))
else if (streq(classname, "Magnitude"))
assign(o_magnitude, new_inst(new))
else if (streq(classname, "Number"))
assign(o_number, new_inst(new))
else if (streq(classname, "Object"))
assign(o_object, new_inst(new))
else if (streq(classname, "Smalltalk"))
assign(o_smalltalk, new_inst(new))
else if (streq(classname, "True"))
assign(o_true, new_inst(new))
else if (streq(classname, "UndefinedObject"))
assign(o_nil, new_inst(new))
return(new);
}
/* new_sinst - new instance with explicit super object */
object *new_sinst(aclass, super)
class *aclass;
object *super;
{ object *new;
char *classname, buffer[80];
if (! is_class(aclass))
cant_happen(4);
classname = symbol_value(aclass->class_name);
if ( streq(classname, "Block") ||
streq(classname, "Char") ||
streq(classname, "Class") ||
streq(classname, "Float") ||
streq(classname, "Integer") ||
streq(classname, "Process") ||
streq(classname, "Symbol") ) {
sprintf(buffer,"%s: does not respond to new", classname);
sassign(new, new_str(buffer));
primitive(ERRPRINT, 1, &new);
obj_dec(new);
if (super) /* get rid of unwanted object */
{obj_inc((object *) super);
obj_dec((object *) super);}
new = o_nil;
}
else if (streq(classname, "File")) {
new = new_file();
if (super) /* get rid of unwanted object */
{obj_inc((object *) super);
obj_dec((object *) super);}
}
else if (streq(classname, "String")) {
new = new_str("");
if (super)
assign(((string *) new)->s_super_obj, super);
}
else {
new = new_obj(aclass, (aclass->c_inst_vars)->size, 1);
if (super)
sassign(new->super_obj, super);
}
return(new);
}
object *new_inst(aclass)
class *aclass;
{ object *super, *sp_class_name, *lookup_class();
class *super_class;
if (! is_class(aclass))
cant_happen(4);
if (aclass == o_object->class)
return(o_object);
super = (object *) 0;
sp_class_name = aclass->super_class;
if (sp_class_name && is_symbol(sp_class_name)) {
super_class = (class *)
lookup_class(symbol_value(sp_class_name));
if (super_class && is_class(super_class))
super = new_inst(super_class);
}
return(new_sinst(aclass, super));
}
free_class(c)
class *c;
{
if (! is_class(c))
cant_happen(8);
obj_dec(c->class_name);
if (c->super_class)
obj_dec((object *) c->super_class);
obj_dec(c->file_name);
obj_dec(c->c_inst_vars);
obj_dec(c->message_names);
obj_dec(c->methods);
((mstruct *) c )->mlink = fr_class;
fr_class = (mstruct *) c;
}
SHAR_EOF
if test 4976 -ne "`wc -c < 'class.c'`"
then
echo shar: error transmitting "'class.c'" '(should have been 4976 characters)'
fi
fi # end of overwriting check
if test -f 'number.c'
then
echo shar: will not over-write existing file "'number.c'"
else
cat << \SHAR_EOF > 'number.c'
/*
Little Smalltalk
number definitions
timothy a. budd, 10/84
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include "object.h"
# include "number.h"
# define MAXLOW 100 /* maximum low numbers kept */
static integer *low_nums[MAXLOW]; /* better be initialized to zero ! */
static mstruct *fr_integer = 0;
static mstruct *fr_float = 0;
static integer init_itable[INTINITMAX];
int_init() {
integer *p;
mstruct *new;
int i;
for (p = init_itable, i = 0; i < INTINITMAX; i++, p++) {
new = (mstruct *) p;
new->mlink = fr_integer;
/*fprintf(stderr,"init int %d %d\n", new, new->mlink);*/
fr_integer = new;
}
}
int ca_int = 0; /* count the number of integer allocations */
extern object *o_magnitude;
extern object *o_number;
/* new_cori - new character or integer */
object *new_cori(val, type)
int val, type;
{ register integer *new;
if ((type == 1) && (val >= 0 && val < MAXLOW) && low_nums[val])
return( (struct obj_struct *) low_nums[val]);
if (fr_integer) {
new = (integer *) fr_integer;
/*fprintf(stderr,"int off list %d %d\n", fr_integer,
fr_integer->mlink);*/
fr_integer = fr_integer->mlink;
}
else {
new = structalloc(integer);
/*fprintf(stderr,"allocating new int %d\n", new);*/
ca_int++;
}
new->i_ref_count = 0;
new->i_value = val;
switch(type) {
case 0: /* chars */
new->i_size = CHARSIZE;
break;
case 1: /* integers */
new->i_size = INTEGERSIZE;
if (val >= 0 && val < MAXLOW)
sassign(low_nums[val], new);
break;
default: cant_happen(5);
}
return ((object *) new);
}
free_integer(i)
integer *i;
{
if ((! is_integer(i)) && (! is_character(i)))
cant_happen(8);
((mstruct *) i)->mlink = fr_integer;
fr_integer = (mstruct *) i;
/*fprintf(stderr,"freeing integer %d %d\n", fr_integer,
fr_integer->mlink);*/
}
free_low_nums()
{ int i;
for (i = 0; i < MAXLOW; i++)
if (low_nums[i]) {
obj_dec((object *) low_nums[i]);
low_nums[i] = (integer *) 0;
}
}
int ca_float = 0;
/* new_float - produce a new floating point number */
object *new_float(val)
double val;
{ register sfloat *new;
if (fr_float) {
new = (sfloat *) fr_float;
fr_float = fr_float->mlink;
}
else {
new = structalloc(sfloat);
ca_float++;
}
new->f_ref_count = 0;
new->f_size = FLOATSIZE;
new->f_value = val;
return( (object *) new);
}
free_float(f)
sfloat *f;
{
if (! is_float(f))
cant_happen(8);
((mstruct *) f)->mlink = fr_float;
fr_float = (mstruct *) f;
}
SHAR_EOF
if test 2951 -ne "`wc -c < 'number.c'`"
then
echo shar: error transmitting "'number.c'" '(should have been 2951 characters)'
fi
fi # end of overwriting check
if test -f 'symbol.c'
then
echo shar: will not over-write existing file "'symbol.c'"
else
cat << \SHAR_EOF > 'symbol.c'
/*
Little Smalltalk
symbol creation - symbols are never deleted once created.
timothy a. budd, 10/84
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include "object.h"
# include "symbol.h"
/*
only one copy of symbol values are kept.
multiple copies of the same symbol point to the same
location.
sy_search will find, and if necessary insert, a string into
this common table
*/
extern char x_str[]; /* initialized common string table */
extern symbol *x_tab[]; /* initialized common symbols table */
extern int x_tmax; /* top of symbols table */
extern char *walloc(); /* routine to allocate a new word */
int ca_sym = 0; /* symbol allocation counter */
/* sy_search performs a binary search of a symbol, is the main interface to
the symbols routines */
symbol *sy_search(word, insert)
char *word;
int insert;
{ register int i;
register int j;
register int k;
char *p;
symbol *new_y();
for (i=1; i <= x_tmax; i <<= 1);
for (i >>= 1, j = i >>1, i--; ; j >>= 1) {
p = symbol_value(x_tab[i]);
if (word == p) return(x_tab[i]);
k = *word - *p;
if (!k) k = *(word+1) - *(p+1);
if (!k) k = strcmp(word, p);
if (!k)
return(x_tab[i]);
if (!j) break;
if (k < 0) i -= j;
else {
if ((i += j) > x_tmax) i = x_tmax;
}
}
if (insert) {
if (k > 0) i++;
if ((k = ++x_tmax) >= SYMTABMAX)
cant_happen(12);
for (; k > i; k--) {
x_tab[k] = x_tab[k-1];
}
/*fprintf(stderr,"adding %s\n", word);*/
x_tab[i] = new_y(walloc(word));
x_tab[i]->y_ref_count++; /* make sure not freed */
return(x_tab[i]);
}
else return((symbol *) 0);
}
/* w_search performs a search for a word, not a symbol */
char *w_search(word, insert)
char *word;
int insert;
{ symbol *sym;
sym = sy_search(word, insert);
if (sym)
return(symbol_value(sym));
else
return((char *) 0);
}
/*---------------------------------------*/
static mstruct *fr_symbol = 0; /* symbols free list */
static symbol strspace[SYMINITSIZE]; /* initial symbols free list */
extern object *o_object; /* common instance of Object */
extern class *ArrayedCollection;
/* sym_init - initialize the symbols routine */
sym_init() {
int i;
symbol *p;
mstruct *new;
p = strspace;
for (i = 0; i < SYMINITSIZE; i++) {
new = (mstruct *) p;
new->mlink = fr_symbol;
fr_symbol = new;
p++;
}
}
/* new_y is the internal routine for making new symbols */
symbol *new_y(text)
char *text;
{ symbol *new;
if (fr_symbol) {
new = (symbol *) fr_symbol;
fr_symbol = fr_symbol->mlink;
}
else {
ca_sym++;
new = structalloc(symbol);
}
new->y_ref_count = 0;
new->y_size = SYMBOLSIZE;
new->y_value = text;
return(new);
}
SHAR_EOF
if test 3138 -ne "`wc -c < 'symbol.c'`"
then
echo shar: error transmitting "'symbol.c'" '(should have been 3138 characters)'
fi
fi # end of overwriting check
if test -f 'string.c'
then
echo shar: will not over-write existing file "'string.c'"
else
cat << \SHAR_EOF > 'string.c'
/*
Little Smalltalk
string creation and deletion
timothy a. budd, 10/84
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include "object.h"
# include "string.h"
int ca_str = 0;
int ca_wal = 0;
/* walloc allocates a string containing the same chars as the arg */
# define WALLOCINITSIZE 1000
static char wtable[WALLOCINITSIZE];
int wtop = 0;
char *walloc(val)
char *val;
{ char *p;
int size;
size = 1 + strlen(val);
if ((size < 40) && ((wtop + size) < WALLOCINITSIZE)) {
p = &wtable[wtop];
wtop += size;
}
else {
p = o_alloc((unsigned) size);
ca_wal++;
}
strcpy(p, val);
return(p);
}
/*---------------------------------------*/
extern class *ArrayedCollection;
extern object *o_acollection;
static mstruct *fr_string = 0;
# define STRINITSIZE 50
static string st_init_table[STRINITSIZE];
str_init() {
string *p;
mstruct *new;
int i;
for (p = st_init_table, i = 0; i < STRINITSIZE; i++, p++) {
new = (mstruct *) p;
new->mlink = fr_string;
fr_string = new;
}
}
extern int started;
static new_rstr(new)
string *new;
{
new->s_ref_count = 0;
new->s_size = STRINGSIZE;
if (! started)
sassign(new->s_super_obj, o_acollection);
else if (ArrayedCollection)
sassign(new->s_super_obj, new_inst(ArrayedCollection));
else
new->s_super_obj = (object *) 0;
}
string *new_istr(text)
char *text;
{ register string *new;
if (fr_string) {
new = (string *) fr_string;
fr_string = fr_string->mlink;
}
else {
ca_str++;
new = structalloc(string);
}
new->s_value = text;
new_rstr(new);
return(new);
}
# define STRLISTMAX 100
mstruct *frl_str[STRLISTMAX];
object *new_str(text)
char *text;
{ int size;
string *new;
size = 1 + strlen(text);
if ((size < STRLISTMAX) && frl_str[size]) {
new = (string *) frl_str[size];
frl_str[size] = frl_str[size]->mlink;
strcpy(new->s_value, text);
new_rstr(new);
}
else {
new = new_istr(walloc(text));
}
return((object *) new);
}
free_string(s)
string *s;
{ int size;
if (s->s_super_obj)
obj_dec(s->s_super_obj);
size = 1 + strlen(s->s_value);
if (size < STRLISTMAX) {
((mstruct *)s)->mlink = frl_str[size];
frl_str[size] = (mstruct *) s;
}
else {
((mstruct *)s)->mlink = fr_string;
fr_string = (mstruct *) s;
}
}
SHAR_EOF
if test 2734 -ne "`wc -c < 'string.c'`"
then
echo shar: error transmitting "'string.c'" '(should have been 2734 characters)'
fi
fi # end of overwriting check
if test -f 'byte.c'
then
echo shar: will not over-write existing file "'byte.c'"
else
cat << \SHAR_EOF > 'byte.c'
/*
Little Smalltalk
bytearray manipulation.
bytearrays are used almost entirely for storing bytecodes.
timothy a. budd, 11/84
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include "object.h"
# include "byte.h"
/*
bytearrays of less than MAXBSAVE are kept on a free list
*/
static mstruct *fr_bytearray[MAXBSAVE]; /* better be initialized to zero ! */
/*
in order to avoid a large number of small mallocs, a table is used
for the first new bytearrays. After the table becomes full,
malloc is used to get more space.
table should be large enough for the standard prelude, at least
*/
static uchar btable[MAXBTABSIZE];
int btabletop = 0;
/*
for the same reason, a number of bytearray bases are statically
allocated and kept on a free list
*/
int ca_barray = 0;
static mstruct *fr_bybase = 0;
static bytearray by_init[MAXBYINIT];
byte_init()
{ int i;
bytearray *p;
mstruct *new;
p = by_init;
for (i = 0; i < MAXBYINIT; i++) {
new = (mstruct *) p;
new->mlink = fr_bybase;
fr_bybase = new;
p++;
}
}
object *new_bytearray(values, size)
uchar *values;
int size;
{ bytearray *new;
uchar *p, *q;
if (size < MAXBSAVE && fr_bytearray[size]) {
new = (bytearray *) fr_bytearray[size];
fr_bytearray[size] = fr_bytearray[size]->mlink;
}
else {
if (fr_bybase) {
new = (bytearray *) fr_bybase;
fr_bybase = fr_bybase->mlink;
}
else {
new = structalloc(bytearray);
ca_barray++;
}
if ((btabletop + size) < MAXBTABSIZE) {
new->a_bytes = &btable[btabletop];
btabletop += size;
}
else {
new->a_bytes = (uchar *) o_alloc((unsigned) size);
}
}
new->a_ref_count = 0;
new->a_size = BYTEARRAYSIZE;
new->a_bsize = size;
for (p = new->a_bytes, q = values; size; size--) {
*p++ = *q++;
}
return((object *) new);
}
free_bytearray(obj)
bytearray *obj;
{ int size;
if (! is_bytearray(obj))
cant_happen(8);
size = obj->a_bsize;
if (size < MAXBSAVE) {
((mstruct *) obj)->mlink = fr_bytearray[size];
fr_bytearray[size] = ((mstruct *) obj);
}
}
SHAR_EOF
if test 2517 -ne "`wc -c < 'byte.c'`"
then
echo shar: error transmitting "'byte.c'" '(should have been 2517 characters)'
fi
fi # end of overwriting check
if test -f 'array.c'
then
echo shar: will not over-write existing file "'array.c'"
else
cat << \SHAR_EOF > 'array.c'
/*
Little Smalltalk
Array creation
timothy a. budd 10/84
builds a new instance of class array.
called mostly by the driver to construct array constants.
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include "object.h"
class *Array = (class *) 0;
class *ArrayedCollection = (class *) 0;
extern object *o_nil, *o_empty, *o_acollection;
extern int started; /* gets set after reading std prelude */
/* new_iarray - internal form of new array */
object *new_iarray(size)
int size;
{ object *new;
if (size < 0) cant_happen(2);
new = new_obj(Array, size, 0);
if (! started) {
sassign(new->super_obj, o_acollection);
}
else if (ArrayedCollection)
sassign(new->super_obj, new_inst(ArrayedCollection));
return(new);
}
/* new_array - create a new array */
object *new_array(size, initial)
int size, initial;
{ int i;
object *new;
if (size == 0) return(o_empty);
new = new_iarray(size);
if (initial) {
for (i = 0; i < size; i++)
sassign(new->inst_var[ i ], o_nil);
}
return(new);
}
SHAR_EOF
if test 1500 -ne "`wc -c < 'array.c'`"
then
echo shar: error transmitting "'array.c'" '(should have been 1500 characters)'
fi
fi # end of overwriting check
if test -f 'file.c'
then
echo shar: will not over-write existing file "'file.c'"
else
cat << \SHAR_EOF > 'file.c'
/*
Little Smalltalk
programs used by class File
timothy a. budd 11/84
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include "object.h"
# include "file.h"
# include "string.h"
# include "number.h"
# include "primitive.h"
static mstruct *fr_file = 0; /* free file list */
object *new_file()
{ struct file_struct *new;
if (fr_file) {
new = (struct file_struct *) fr_file;
fr_file = fr_file->mlink;
}
else {
new = structalloc(struct file_struct);
}
new->l_size = FILESIZE;
new->l_ref_count = 0;
new->file_mode = STRMODE;
new->fp = NULL;
return((object *) new);
}
free_file(phil)
struct file_struct *phil;
{
if (! is_file(phil))
cant_happen(8);
if (phil->fp != NULL)
fclose(phil->fp);
((mstruct *) phil)->mlink = fr_file;
fr_file = (mstruct *) phil;
}
file_err(message)
char *message;
{ object *errp;
char buffer[150];
sprintf(buffer,"File: %s", message);
sassign(errp, new_str(buffer));
primitive(ERRPRINT, 1, &errp);
obj_dec(errp);
}
file_open(phil, name, type)
struct file_struct *phil;
char *name, *type;
{ char buffer[100];
if (phil->fp != NULL)
fclose(phil->fp);
phil->fp = fopen(name, type);
if (phil->fp == NULL) {
sprintf(buffer,"can't open: %s\n", name);
file_err(buffer);
}
}
# define BUFLENGTH 250
object *file_read(phil)
struct file_struct *phil;
{ object *new;
int c;
char buffer[BUFLENGTH], *p;
if (phil->fp == NULL) {
file_err("attempt to read from unopened file");
return(o_nil);
}
switch(phil->file_mode) {
case CHARMODE:
if (EOF == (c = fgetc(phil->fp)))
new = o_nil;
else
new = new_char(c);
break;
case STRMODE:
if (NULL == fgets(buffer, BUFLENGTH, phil->fp))
new = o_nil;
else {
p = &buffer[strlen(buffer) - 1];
if (*p == '\n') *p = '\0';
new = new_str(buffer);
}
break;
case INTMODE:
if (EOF == (c = getw(phil->fp)))
new = o_nil;
else
new = new_int(c);
break;
default:
file_err("unknown mode");
new = o_nil;
}
return(new);
}
file_write(phil, obj)
struct file_struct *phil;
object *obj;
{
if (phil->fp == NULL) {
file_err("attempt to write to unopened file");
return;
}
switch(phil->file_mode) {
case CHARMODE:
if (! is_character(obj)) goto modeerr;
fputc(int_value(obj), phil->fp);
break;
case STRMODE:
if (! is_string(obj)) goto modeerr;
fputs(string_value(obj), phil->fp);
fputc('\n', phil->fp);
break;
case INTMODE:
if (! is_integer(obj)) goto modeerr;
putw(int_value(obj), phil->fp);
break;
}
return;
modeerr:
file_err("attempt to write object of wrong type for mode");
}
SHAR_EOF
if test 3082 -ne "`wc -c < 'file.c'`"
then
echo shar: error transmitting "'file.c'" '(should have been 3082 characters)'
fi
fi # end of overwriting check
if test -f 'primitive.c'
then
echo shar: will not over-write existing file "'primitive.c'"
else
cat << \SHAR_EOF > 'primitive.c'
/*
Little Smalltalk
Primitive manager
timothy a. budd
10/84
hashcode code written by Robert McConeghy
(who also wrote classes Dictionary, et al).
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include <ctype.h>
# include <math.h>
# include <errno.h>
# include "object.h"
# include "drive.h"
# include "interp.h"
# include "process.h"
# include "block.h"
# include "string.h"
# include "symbol.h"
# include "number.h"
# include "file.h"
# include "byte.h"
# include "primitive.h"
extern int errno;
extern int prntcmd;
extern double modf();
extern long time();
extern object *lookup_class();
extern process *runningProcess;
extern int responds_to(), generality();
extern class *mk_class();
extern object *o_object, *o_true, *o_false, *o_nil, *o_number, *o_magnitude;
object *primitive(primnumber, numargs, args)
int primnumber, numargs;
object **args;
{ object *resultobj;
object *leftarg, *rightarg, *fnd_class(), *fnd_super();
int leftint, rightint, i, j;
double leftfloat, rightfloat;
long clock;
char *leftp, *rightp, *errp;
class *aClass;
bytearray *byarray;
struct file_struct *phil;
int opnumber = primnumber % 10;
char strbuffer[300], tempname[100];
errno = 0;
/* first do argument type checking */
switch(i = (primnumber / 10)) {
case 0: /* misc operations */
if (opnumber <= 5 && numargs != 1) goto argcerror;
leftarg = args[0];
break;
case 1: /* integer operations */
case 2:
if (numargs != 2) goto argcerror;
rightarg = args[1];
if (! is_integer(rightarg)) goto argterror;
rightint = int_value(rightarg);
case 3:
if (i == 3 && opnumber && numargs != 1)
goto argcerror;
leftarg = args[0];
if (! is_integer(leftarg)) goto argterror;
leftint = int_value(leftarg);
break;
case 4: /* character operations */
if (numargs != 2) goto argcerror;
rightarg = args[1];
if (! is_character(rightarg)) goto argterror;
rightint = int_value(rightarg);
case 5:
if (i == 5 && numargs != 1) goto argcerror;
leftarg = args[0];
if (! is_character(leftarg)) goto argterror;
leftint = int_value(leftarg);
break;
case 6: /* floating point operations */
if (numargs != 2) goto argcerror;
rightarg = args[1];
if (! is_float(rightarg)) goto argterror;
rightfloat = float_value(rightarg);
case 7:
if (i == 7 && numargs != 1) goto argcerror;
case 8:
if (i == 8 && opnumber < 8 && numargs != 1)
goto argcerror;
leftarg = args[0];
if (! is_float(leftarg)) goto argterror;
leftfloat = float_value(leftarg);
break;
case 9: /* symbol operations */
leftarg = args[0];
if (! is_symbol(leftarg)) goto argterror;
leftp = symbol_value(leftarg);
break;
case 10: /* string operations */
if (numargs < 1) goto argcerror;
leftarg = args[0];
if (! is_string(leftarg)) goto argterror;
leftp = string_value(leftarg);
if (opnumber && opnumber <= 3) {
if (numargs != 2) goto argcerror;
rightarg = args[1];
if (! is_string(rightarg)) goto argterror;
rightp = string_value(rightarg);
}
else if ((opnumber >= 4) && (opnumber <= 6)) {
if (numargs < 2) goto argcerror;
if (! is_integer(args[1])) goto argterror;
i = int_value(args[1])-1;
if ((i < 0) || (i >= strlen(leftp)))
goto indexerror;
}
break;
case 11: /* misc operations */
if ((opnumber == 1) || (opnumber == 2)) {
if (is_bltin(args[0])) goto argterror;
if (numargs < 2) goto argcerror;
if (! is_integer(args[1])) goto argterror;
i = int_value(args[1]);
if (i < 1 || i > args[0]->size)
goto indexerror;
}
else if ((opnumber >= 4) && (opnumber <= 6)) {
if (numargs != 1) goto argcerror;
if (! is_integer(args[0])) goto argterror;
i = int_value(args[0]);
if (i < 0) goto indexerror;
}
else if (opnumber >= 7) {
if (numargs < 1) goto argcerror;
if (! is_bytearray(args[0])) goto argterror;
byarray = (bytearray *) args[0];
if (opnumber >= 8) {
if (numargs < 2) goto argcerror;
if (! is_integer(args[1]))
goto argterror;
i = int_value(args[1]) - 1;
if (i < 0 || i >= byarray->a_bsize)
goto indexerror;
}
}
break;
case 12: /* string i/o operations */
if (opnumber < 6) {
if (numargs < 1) goto argcerror;
leftarg = args[0];
if (! is_string(leftarg)) goto argterror;
leftp = string_value(leftarg);
}
break;
case 13: /* operations on file */
if (numargs < 1) goto argcerror;
if (! is_file(args[0])) goto argterror;
phil = (struct file_struct *) args[0];
if (opnumber && (phil->fp == (FILE *) NULL)) {
errp = "file must be open for operation";
goto return_error;
}
break;
case 15: /* operations on classes */
if (opnumber < 3 && numargs != 1) goto argcerror;
if (! is_class(args[0])) goto argterror;
aClass = (class *) args[0];
break;
}
/* now do operation */
switch(primnumber) {
case 1: /* class of object */
resultobj = fnd_class(args[0]);
if (resultobj) goto return_obj;
else goto return_nil;
case 2: /* get super_object */
resultobj = fnd_super(args[0]);
if (resultobj) goto return_obj;
else goto return_nil;
case 3: /* see if class responds to new */
leftint = 0;
if (! is_class(args[0])) goto return_boolean;
leftint = responds_to("new", (class *) args[0]);
goto return_boolean;
case 4: /* compute size of object */
leftint = args[0]->size;
goto return_integer;
case 5: /* return hashnum of object */
if (is_integer(leftarg))
leftint = int_value(leftarg);
else if (is_character(leftarg))
leftint = int_value(leftarg);
else if (is_symbol(leftarg))
leftint = (int) symbol_value(leftarg);
else if (is_string(leftarg)) {
leftp = string_value(leftarg);
leftint = 0;
for(i = 0; *leftp != 0; leftp++){
leftint += *leftp;
i++;
if(i > 5)
break;
}
}
else /* for all other objects return address */
leftint = (int) &leftarg;
if (leftint < 0)
leftint = -leftint;
goto return_integer;
case 6: /* built in object type testing */
if (numargs != 2) goto argcerror;
leftint = (args[0]->size == args[1]->size);
goto return_boolean;
case 7: /* object equality testing */
if (numargs != 2) goto argcerror;
leftint = (args[0] == args[1]);
goto return_boolean;
case 8: /* toggle debugging flag */
if (numargs == 0) {
debug = 1 - debug;
goto return_nil;
}
if (numargs != 2) goto argcerror;
if (! is_integer(args[0])) goto argterror;
if (! is_integer(args[1])) goto argterror;
leftint = int_value(args[0]);
rightint = int_value(args[1]);
switch(leftint) {
case 1: prntcmd = rightint; break;
case 2: debug = rightint; break;
}
goto return_nil;
case 9: /* numerical generality comparison */
if (numargs != 2) goto argcerror;
leftint =
(generality(args[0]) > generality(args[1]));
goto return_boolean;
case 10: /* integer addition */
leftint += rightint;
goto return_integer;
case 11: /* integer subtraction */
leftint -= rightint;
goto return_integer;
case 12: case 42:
leftint = (leftint < rightint);
goto return_boolean;
case 13: case 43:
leftint = (leftint > rightint);
goto return_boolean;
case 14: case 44:
leftint = (leftint <= rightint);
goto return_boolean;
case 15: case 45:
leftint = (leftint >= rightint);
goto return_boolean;
case 16: case 46:
leftint = (leftint == rightint);
goto return_boolean;
case 17: case 47:
leftint = (leftint != rightint);
goto return_boolean;
case 18:
leftint *= rightint;
goto return_integer;
case 19: /* // integer */
if (rightint == 0) goto numerror;
i = leftint / rightint;
if ((leftint < 0) && (leftint % rightint))
i -= 1;
leftint = i;
goto return_integer;
case 20: /* gcd of two integers */
if (leftint == 0 || rightint == 0) goto numerror;
if (leftint < 0) leftint = -leftint;
if (rightint < 0) rightint = -rightint;
if (leftint > rightint)
{i = leftint; leftint = rightint; rightint = i;}
while (i = rightint % leftint)
{rightint = leftint; leftint = i;}
goto return_integer;
case 21: /* bitAt: */
leftint = (leftint & (1 << rightint)) ? 1 : 0;
goto return_integer;
case 22: /* logical bit-or */
leftint |= rightint;
goto return_integer;
case 23: /* logical bit-and */
leftint &= rightint;
goto return_integer;
case 24: /* logical bit-exclusive or */
leftint ^= rightint;
goto return_integer;
case 25: /* bit shift */
if (rightint < 0)
leftint >>= - rightint;
else
leftint <<= rightint;
goto return_integer;
case 26: /* integer radix */
if (rightint < 2 || rightint > 36) goto numerror;
prnt_radix(leftint, rightint, strbuffer);
goto return_string;
case 28:
if (rightint == 0) goto numerror;
leftint /= rightint;
goto return_integer;
case 29:
if (rightint == 0) goto numerror;
leftint %= rightint;
goto return_integer;
case 30: /* doPrimitive:withArguments: */
if (numargs != 2) goto argcerror;
resultobj = primitive(leftint, args[1]->size,
&args[1]->inst_var[0]);
goto return_obj;
case 32: /* convert random int into random float */
leftfloat = ((double) ((leftint/10) % 1000)) / 1000.0;
goto return_float;
case 33: /* bit inverse */
leftint ^= -1;
goto return_integer;
case 34: /* highBit */
rightint = leftint;
for (leftint = 32; leftint >= 0; leftint--)
if (rightint & (1 << leftint))
goto return_integer;
goto return_nil;
case 35: /* random number */
srand(leftint);
leftint = rand();
goto return_integer;
case 36: /* convert integer to character */
goto return_character;
case 37: /* convert integer to string */
sprintf(strbuffer,"%d", leftint);
goto return_string;
case 38: /* factorial */
if (leftint < 0) goto numerror;
if (leftint < FACTMAX) {
for (i = 1; leftint; leftint--)
i *= leftint;
leftint = i;
goto return_integer;
}
# ifndef GAMMA
/* gamma not supported, use float multiply */
leftfloat = 1.0;
if (leftint < 30) {
for (i = 1; leftint; leftint--)
leftfloat *= leftint;
}
goto return_float;
# endif
# ifdef GAMMA
/* compute gamma */
leftfloat = (double) (leftint + 1);
sassign(leftarg, new_float(leftfloat));
resultobj = primitive(GAMMAFUN, 1, &leftarg);
obj_dec(leftarg);
goto return_obj;
# endif
case 39: /* convert integer to float */
leftfloat = (double) leftint;
goto return_float;
case 50: /* digitValue */
if (isdigit(leftint))
leftint -= '0';
else if (isupper(leftint)) {
leftint -= 'A';
leftint += 10;
}
else goto return_nil;
goto return_integer;
case 51:
if (isupper(leftint)) leftint += 'a' - 'A';
leftint = (leftint == 'a') || (leftint == 'e') ||
(leftint == 'i') || (leftint == 'o') ||
(leftint == 'u');
goto return_boolean;
case 52:
leftint = isalpha(leftint);
goto return_boolean;
case 53:
leftint = islower(leftint);
goto return_boolean;
case 54:
leftint = isupper(leftint);
goto return_boolean;
case 55:
leftint = isspace(leftint);
goto return_boolean;
case 56:
leftint = isalnum(leftint);
goto return_boolean;
case 57:
if (isupper(leftint)) leftint += 'a' - 'A';
else if (islower(leftint)) leftint += 'A' - 'a';
goto return_character;
case 58: /* convert character to string */
sprintf(strbuffer,"%c", leftint);
goto return_string;
case 59: /* convert character to integer */
goto return_integer;
case 60: /* floating point addition */
leftfloat += rightfloat;
goto return_float;
case 61: /* floating point subtraction */
leftfloat -= rightfloat;
goto return_float;
case 62:
leftint = (leftfloat < rightfloat);
goto return_boolean;
case 63:
leftint = (leftfloat > rightfloat);
goto return_boolean;
case 64:
leftint = (leftfloat <= rightfloat);
goto return_boolean;
case 65:
leftint = (leftfloat >= rightfloat);
goto return_boolean;
case 66:
leftint = (leftfloat == rightfloat);
goto return_boolean;
case 67:
leftint = (leftfloat != rightfloat);
goto return_boolean;
case 68:
leftfloat *= rightfloat;
goto return_float;
case 69:
if (rightfloat == 0) goto numerror;
leftfloat /= rightfloat;
goto return_float;
case 70:
leftfloat = log(leftfloat);
goto float_check;
case 71:
if (leftfloat < 0) goto numerror;
leftfloat = sqrt(leftfloat);
goto float_check;
case 72:
leftint = (int) floor(leftfloat);
goto return_integer;
case 73: /* ceiling */
leftint = (int) ceil(leftfloat);
goto return_integer;
case 75: /* integer part */
leftfloat = modf(leftfloat, &rightfloat);
leftint = (int) rightfloat;
goto return_integer;
case 76: /* fractional part */
leftfloat = modf(leftfloat, &rightfloat);
goto return_float;
case 77: /* gamma function */
# ifdef GAMMA
leftfloat = gamma(leftfloat);
if (leftfloat > 88.0) goto numerror;
leftfloat = exp(leftfloat);
goto float_check;
# endif
# ifndef GAMMA
errp = "gamma function";
goto not_implemented;
# endif
case 78:
sprintf(strbuffer,"%g", leftfloat);
goto return_string;
case 79:
leftfloat = exp(leftfloat);
goto return_float;
case 80: /* normalize radian value */
# define TWOPI (double) 6.2831853072
rightfloat =
floor(((leftfloat < 0) ? -leftfloat:leftfloat) / TWOPI);
if (leftfloat < 0)
leftfloat += (1 + rightfloat) * TWOPI;
else
leftfloat -= rightfloat * TWOPI;
goto return_float;
case 81:
leftfloat = sin(leftfloat);
goto float_check;
case 82:
leftfloat = cos(leftfloat);
goto float_check;
case 84:
leftfloat = asin(leftfloat);
goto float_check;
case 85:
leftfloat = acos(leftfloat);
goto float_check;
case 86:
leftfloat = atan(leftfloat);
goto float_check;
case 88:
if (numargs != 2) goto argcerror;
if (! is_float(args[1])) goto argterror;
leftfloat = pow(leftfloat, float_value(args[1]));
goto float_check;
case 89: /* floating point radix */
if (numargs != 2) goto argcerror;
if (! is_integer(args[1])) goto argterror;
i = int_value(args[1]); /* base */
if (i < 2 || i > 36) goto numerror;
fprnt_radix(leftfloat, i, strbuffer);
goto return_string;
case 91: /* symbol comparison */
if (numargs != 2) goto argcerror;
if (! is_symbol(args[1])) goto argterror;
leftint = (leftp == symbol_value(args[1]));
goto return_boolean;
case 92: /* symbol printString */
sprintf(strbuffer, "#%s", leftp);
goto return_string;
case 93: /* symbol asString */
sprintf(strbuffer, "%s", leftp);
goto return_string;
case 94: /* symbol print ( with tabs) */
if (numargs == 2) {
if (! is_integer(args[1])) goto argterror;
for (i = int_value(args[1]); i >= 0; i--)
putchar('\t');
}
printf("%s\n", leftp);
# ifdef FLUSHREQ
fflush(stdout);
# endif
goto return_nil;
case 96:
goto return_nil;
case 97: /* make a new class (generated by parser)*/
if (numargs != 8) goto argcerror;
if (! is_symbol(args[1])) goto argterror;
if (! is_symbol(args[2])) goto argterror;
if (! is_integer(args[6])) goto argterror;
if (! is_integer(args[7])) goto argterror;
resultobj = (object *) mk_class(leftp, args);
goto return_obj;
case 98: /* install class in dictionary */
if (numargs != 2) goto argcerror;
if (! is_class(args[1])) goto argterror;
enter_class(leftp, args[1]);
goto return_nil;
case 99: /* find a class in class dictionary */
if (numargs != 1) goto argcerror;
resultobj = lookup_class(leftp);
if (resultobj == (object *) 0) {
sprintf(strbuffer,"cannot find class %s",
leftp);
sassign(resultobj, new_str(strbuffer));
primitive(ERRPRINT, 1, &resultobj);
obj_dec(resultobj);
resultobj = lookup_class("Object");
if (! resultobj) cant_happen(7);
}
goto return_obj;
case 100: /* string length */
leftint = strlen(leftp);
goto return_integer;
case 101: /* string compare, case dependent */
leftint = strcmp(leftp, rightp);
goto return_integer;
case 102: /* string compare, case independent */
leftint = 1;
while (*leftp || *rightp) {
i = *leftp++;
j = *rightp++;
if (i >= 'A' && i <= 'Z')
i = i - 'A' + 'a';
if (j >= 'A' && j <= 'Z')
j = j - 'A' + 'a';
if (i != j) {leftint = 0; break;}
}
goto return_boolean;
case 103: /* string catenation */
for (i = leftint = 0; i < numargs; i++) {
if (! is_string(args[i])) goto argterror;
leftint += strlen(string_value(args[i]));
}
errp = (char *) o_alloc((unsigned) (1 + leftint));
*errp = '\0';
for (i = 0; i < numargs; i++)
strcat(errp, string_value(args[i]));
resultobj = (object *) new_istr(errp);
goto return_obj;
case 104: /* string at: */
if (numargs != 2) goto argcerror;
leftint = leftp[i];
goto return_character;
case 105: /* string at: put: */
if (numargs != 3) goto argcerror;
if (! is_character(args[2])) goto argterror;
leftp[i] = int_value(args[2]);
goto return_nil;
case 106: /* copyFrom: length: */
if (numargs != 3) goto argcerror;
if (! is_integer(args[2])) goto argterror;
j = int_value(args[2]);
if (j < 0) goto indexerror;
for (rightp = strbuffer; j; j--, i++)
*rightp++ = leftp[i];
*rightp = '\0';
goto return_string;
case 107: /* string copy */
if (numargs != 1) goto argcerror;
resultobj = new_str(leftp);
goto return_obj;
case 108: /* string asSymbol */
if (numargs != 1) goto argcerror;
resultobj = new_sym(leftp);
goto return_obj;
case 109: /* string printString */
if (numargs != 1) goto argcerror;
sprintf(strbuffer,"\'%s\'", leftp);
goto return_string;
case 110: /* new untyped object */
if (numargs != 1) goto argcerror;
if (! is_integer(args[0])) goto argterror;
leftint = int_value(args[0]);
if (leftint < 0) goto numerror;
resultobj = new_obj((class *) 0, leftint, 1);
goto return_obj;
case 111: /* object at: */
if (numargs != 2) goto argcerror;
resultobj = args[0]->inst_var[ i - 1 ];
goto return_obj;
case 112: /* object at:put: */
if (numargs != 3) goto argcerror;
assign(args[0]->inst_var[i - 1], args[2]);
goto return_nil;
case 113: /* object grow */
leftarg = args[0];
rightarg = args[1];
if (is_bltin(leftarg)) goto argterror;
resultobj = new_obj(leftarg->class,
leftarg->size+1, 0);
if (leftarg->super_obj)
sassign(resultobj->super_obj,
leftarg->super_obj);
for (i = 0; i < leftarg->size; i++)
sassign(resultobj->inst_var[i], leftarg->inst_var[i]);
sassign(resultobj->inst_var[i], rightarg);
goto return_obj;
case 114: /* new array */
resultobj = new_array(i, 1);
goto return_obj;
case 115: /* new string */
for (j = 0; j < i; j++)
strbuffer[j] = ' ';
strbuffer[j] = '\0';
goto return_string;
case 116: /* bytearray new */
/* initialize with random garbage */
resultobj = new_bytearray(strbuffer, i);
goto return_obj;
case 117: /* bytearray size */
if (numargs != 1) goto argcerror;
leftint = byarray->a_bsize;
goto return_integer;
case 118: /* bytearray at: */
if (numargs != 2) goto argcerror;
leftint = uctoi(byarray->a_bytes[i]);
goto return_integer;
case 119: /* bytearray at:put: */
if (numargs != 3) goto argcerror;
if (! int_value(args[2])) goto argterror;
byarray->a_bytes[i] = itouc(int_value(args[2]));
goto return_nil;
case 120: /* print, no return */
printf("%s", leftp);
# ifdef FLUSHREQ
fflush(stdout);
# endif
goto return_nil;
case 121: /* print, with return */
printf("%s\n", leftp);
# ifdef FLUSHREQ
fflush(stdout);
# endif
goto return_nil;
case 122: /* format for error printing */
aClass = (class *) fnd_class(args[1]);
sprintf(strbuffer,"%s: %s",
symbol_value(aClass->class_name), leftp);
leftp = strbuffer;
case 123: /* print on error output */
fprintf(stderr,"%s\n", leftp);
# ifdef FLUSHREQ
fflush(stderr);
# endif
goto return_nil;
case 125: /* unix system call */
# ifndef NOSYSTEM
leftint = system(leftp);
goto return_integer;
# endif
# ifdef NOSYSTEM
errp = "system()";
goto not_implemented;
# endif
case 127: /* block return */
errp = "block return without surrounding context";
goto return_error;
case 128: /* reference count error */
if (numargs != 1) goto argcerror;
sprintf(strbuffer,"object %d reference count %d",
args[0], args[0]->ref_count);
errp = strbuffer;
goto return_error;
case 129: /* does not respond error */
if (numargs != 2) goto argcerror;
if (! is_symbol(args[1])) goto argterror;
fprintf(stderr,"129 error %s\n",
symbol_value(args[1]));
aClass = (class *) fnd_class(args[0]);
if (! is_class(aClass)) goto argterror;
sprintf(strbuffer,"%s: does not respond to %s",
symbol_value(aClass->class_name),
symbol_value(args[1]));
errp = strbuffer;
goto return_error;
case 130: /* file open */
if (numargs != 3) goto argcerror;
if (! is_string(args[1])) goto argterror;
if (! is_string(args[2])) goto argterror;
file_open(phil,
string_value(args[1]), string_value(args[2]));
goto return_nil;
case 131: /* file read */
if (numargs != 1) goto argcerror;
resultobj = file_read(phil);
goto return_obj;
case 132: /* file write */
if (numargs != 2) goto argcerror;
file_write(phil, args[1]);
goto return_nil;
case 133: /* set file mode */
if (numargs != 2) goto argcerror;
if (! is_integer(args[1])) goto argterror;
phil->file_mode = int_value(args[1]);
goto return_nil;
case 134: /* compute file size */
fseek(phil->fp, (long) 0, 2);
leftint = (int) ftell(phil->fp);
goto return_integer;
case 135: /* set file position */
if (numargs != 2) goto argcerror;
if (! is_integer(args[1])) goto argterror;
leftint = fseek(phil->fp, (long) int_value(args[1]), 0);
goto return_integer;
case 136: /* find current position */
if (numargs != 1) goto argcerror;
leftint = (int) ftell(phil->fp);
goto return_integer;
case 140:
errp = "block execute should be trapped by interp";
goto return_error;
case 141: /* newProcess (withArguments:) */
if (numargs < 1) goto argcerror;
if (! is_block(args[0])) goto argterror;
if (numargs == 1)
resultobj = (object *) cr_process(
block_execute((interpreter *) 0,
(block *) args[0], 0, args));
else if (numargs == 2)
resultobj = (object *) cr_process(
block_execute((interpreter *) 0,
(block *) args[0], args[1]->size,
&(args[1]->inst_var[0])));
else goto argcerror;
goto return_obj;
case 142: /* terminate a process */
if (numargs != 1) goto argcerror;
if (! is_process(args[0])) goto argterror;
terminate_process( (process *) args[0]);
goto return_nil;
case 143: /* perform:withArguments: */
errp = "perform should be trapped by interpreter";
goto return_error;
case 145: /* set the state of a process */
if (numargs != 2) goto argcerror;
if (! is_process(args[0])) goto argterror;
if (! is_integer(args[1])) goto argterror;
leftint = int_value(args[1]);
switch (leftint) {
case 0: leftint = READY;
break;
case 1: leftint = SUSPENDED;
break;
case 2: leftint = BLOCKED;
break;
case 3: leftint = UNBLOCKED;
break;
default: errp = "invalid state for process";
goto return_error;
}
set_state((process *) args[0], leftint);
goto return_integer;
case 146: /* return the state of a process */
if (numargs != 1) goto argcerror;
if (! is_process(args[0])) goto argterror;
leftint = set_state((process *) args[0], CUR_STATE);
goto return_integer;
case 148: /* begin atomic action */
if (numargs != 0) goto argcerror;
atomcnt++;
goto return_nil;
case 149: /* end atomic action */
if (numargs != 0) goto argcerror;
if (atomcnt == 0) {
errp = "end atomic attempted while not in atomic action";
goto return_error;
}
atomcnt--;
goto return_nil;
case 150: /* class edit */
leftp = symbol_value(aClass->file_name);
if (! writeable(leftp)) {
gettemp(tempname);
sprintf(strbuffer,"cp %s %s", leftp, tempname);
# ifndef NOSYSTEM
system(strbuffer);
# endif
leftp = tempname;
}
if (! lexedit(leftp)) lexinclude(leftp);
goto return_nil;
case 151: /* superclass of a class */
if (! aClass->super_class)
goto return_nil;
resultobj = (object *) aClass->super_class;
if (! is_symbol(resultobj)) goto return_nil;
resultobj = lookup_class(symbol_value(resultobj));
if (! resultobj) goto return_nil;
goto return_obj;
case 152: /* class name */
resultobj = aClass->class_name;
leftp = symbol_value(resultobj);
resultobj = new_str(leftp);
goto return_obj;
case 153: /* new */
if (numargs != 2) goto argcerror;
if (args[1] == o_nil)
resultobj = new_inst(aClass);
else
resultobj = new_sinst(aClass, args[1]);
goto return_obj;
case 154: /* print message names list */
prnt_messages(aClass);
goto return_nil;
case 155: /* respondsTo: aMessage */
if (numargs != 2) goto argcerror;
if (! is_symbol(args[1])) goto argterror;
leftint = responds_to(symbol_value(args[1]), aClass);
goto return_boolean;
case 156: /* class view */
leftp = symbol_value(aClass->file_name);
gettemp(tempname);
# ifndef NOSYSTEM
sprintf(strbuffer,"cp %s %s", leftp, tempname);
# endif
system(strbuffer);
leftp = tempname;
lexedit(leftp);
goto return_nil;
case 157: /* class list */
class_list(aClass, 0);
goto return_nil;
case 158: /* variables */
resultobj = aClass->c_inst_vars;
goto return_obj;
case 160: /* current time */
time(&clock);
strcpy(strbuffer, ctime(&clock));
goto return_string;
case 161: /* time, measure in seconds */
leftint = (int) time((long *) 0);
goto return_integer;
default: fprintf(stderr,"Primitive number %d not implemented\n",
primnumber);
goto return_nil;
}
/* return different types of objects */
return_obj:
return(resultobj);
return_nil:
return(o_nil);
return_integer:
return(new_int(leftint));
return_character:
return(new_char(leftint));
return_boolean:
return(leftint ? o_true : o_false);
float_check:
if (errno == ERANGE || errno == EDOM) goto numerror;
return_float:
return(new_float(leftfloat));
return_string:
return(new_str(strbuffer));
/* error conditions */
not_implemented:
sprintf(strbuffer,"%s not implemented yet", errp);
errp = strbuffer;
goto return_error;
argcerror:
sprintf(strbuffer,"%d is wrong number of arguments for primitive %d",
numargs, primnumber);
errp = strbuffer;
goto return_error;
argterror:
sprintf(strbuffer,"argument type not correct for primitive %d",
primnumber);
errp = strbuffer;
goto return_error;
numerror:
errp = "numerical error in primitive";
goto return_error;
indexerror:
errp = "primitive index error";
goto return_error;
return_error:
sassign(resultobj, new_str(errp));
primitive(ERRPRINT, 1, &resultobj);
obj_dec(resultobj);
goto return_nil;
}
static prnt_radix(n, r, buffer)
int n, r;
char buffer[];
{ char *p, *q, buffer2[60];
int i, s;
if (n < 0) {n = - n; s = 1;}
else s = 0;
p = buffer2; *p++ = '\0';
if (n == 0) *p++ = '0';
while (n) {
i = n % r;
*p++ = i + ((i < 10) ? '0' : ('A' - 10));
n = n / r;
}
sprintf(buffer,"%dr", r);
for (q = buffer; *q; q++);
if (s) *q++ = '-';
for (*p = '0' ; *p ; ) *q++ = *--p;
*q = '\0';
}
static fprnt_radix(f, n, buffer)
double f;
int n;
char buffer[];
{ int sign, exp, i, j;
char *p, *q, tempbuffer[60];
double ip;
if (f < 0) {
sign = 1;
f = - f;
}
else sign = 0;
exp = 0;
if (f != 0) {
exp = (int) floor(log(f) / log((double) n));
if (exp < -4 || 4 < exp) {
f *= pow((double) n, (double) - exp);
}
else exp = 0;
}
f = modf(f, &ip);
if (sign) ip = - ip;
prnt_radix((int) ip, n, buffer);
for (p = buffer; *p; p++) ;
if (f != 0) {
*p++ = '.';
for (j = 0; (f != 0) && (j < 6); j++){
i = (int) (f *= n);
*p++ = (i < 10) ? '0' + i : 'A' + (i-10) ;
f -= i;
}
}
if (exp) {
*p++ = 'e';
sprintf(tempbuffer,"%d", exp);
for (q = tempbuffer; *q; )
*p++ = *q++;
}
*p = '\0';
return;
}
/* generalit - numerical generality */
static int generality(aNumber)
object *aNumber;
{ int i;
if (is_integer(aNumber)) i = 1;
else if (is_float(aNumber)) i = 2;
else i = 3;
return(i);
}
/* cant_happen - report that an impossible condition has occured */
cant_happen(n) int n;
{ char *s;
# ifdef SMALLDATA
s = "what a pain!";
# endif
# ifndef SMALLDATA
switch(n) {
case 1: s = "out of memory allocation space"; break;
case 2: s = "array size less than zero"; break;
case 3: s = "block return from call should not occur"; break;
case 4: s = "attempt to make instance of non class"; break;
case 5: s = "case error in new integer or string"; break;
case 6: s = "decrement on unknown built in object"; break;
case 7: s = "cannot find class Object"; break;
case 8: s = "primitive free of object of wrong type"; break;
case 9: s = "internal interpreter error"; break;
case 11: s = "block execute on non-block"; break;
case 12: s = "out of symbol space"; break;
case 14: s = "out of standard bytecode space"; break;
case 15: s = "system deadlocked - all processes blocked"; break;
case 16: s = "attempt to free symbol"; break;
case 17: s = "invalid process state passed to set_state"; break;
case 18: s = "internal buffer overflow"; break;
case 20: s = "can't open prelude file"; break;
case 22: s = "system file open error"; break;
case 23: s = "fastsave error"; break;
default: s = "unknown, but impossible nonetheless, condition"; break;
}
# endif
fprintf(stderr,"Can't happen number %d: %s\n", n, s);
n = n / 0; /* on vax, this will force a core dump */
exit(1);
}
/* writeable - see if a file can be written to */
int writeable(name)
char *name;
{ char buffer[150];
sprintf(buffer,"test -w %s", name);
# ifdef NOSYSTEM
return(0);
# endif
# ifndef NOSYSTEM
return(! system(buffer));
# endif
}
SHAR_EOF
if test 31094 -ne "`wc -c < 'primitive.c'`"
then
echo shar: error transmitting "'primitive.c'" '(should have been 31094 characters)'
fi
fi # end of overwriting check
if test -f 'syms.c'
then
echo shar: will not over-write existing file "'syms.c'"
else
cat << \SHAR_EOF > 'syms.c'
# include "object.h"
# include "symbol.h"
char x_str[] = {041, 0, /* ! */
046, 0, /* & */
050, 0, /* ( */
051, 0, /* ) */
052, 0, /* * */
053, 0, /* + */
054, 0, /* , */
055, 0, /* - */
057, 0, /* / */
057, 057, 0, /* // */
074, 0, /* < */
074, 075, 0, /* <= */
075, 0, /* = */
075, 075, 0, /* == */
076, 0, /* > */
076, 075, 0, /* >= */
0100, 0, /* @ */
0101, 0162, 0162, 0141, 0171, 0, /* Array */
0101, 0162, 0162, 0141, 0171, 0145, 0144, 0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 0, /* ArrayedCollection */
0102, 0114, 0117, 0103, 0113, 0105, 0104, 0, /* BLOCKED */
0102, 0141, 0147, 0, /* Bag */
0102, 0154, 0157, 0143, 0153, 0, /* Block */
0102, 0157, 0157, 0154, 0145, 0141, 0156, 0, /* Boolean */
0102, 0171, 0164, 0145, 0101, 0162, 0162, 0141, 0171, 0, /* ByteArray */
0103, 0150, 0141, 0162, 0, /* Char */
0103, 0154, 0141, 0163, 0163, 0, /* Class */
0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 0, /* Collection */
0103, 0157, 0155, 0160, 0154, 0145, 0170, 0, /* Complex */
0104, 0151, 0143, 0164, 0151, 0157, 0156, 0141, 0162, 0171, 0, /* Dictionary */
0106, 0141, 0154, 0163, 0145, 0, /* False */
0106, 0151, 0154, 0145, 0, /* File */
0106, 0154, 0157, 0141, 0164, 0, /* Float */
0111, 0156, 0164, 0145, 0147, 0145, 0162, 0, /* Integer */
0111, 0156, 0164, 0145, 0162, 0160, 0162, 0145, 0164, 0145, 0162, 0, /* Interpreter */
0111, 0156, 0164, 0145, 0162, 0166, 0141, 0154, 0, /* Interval */
0113, 0145, 0171, 0145, 0144, 0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 0, /* KeyedCollection */
0114, 0151, 0163, 0164, 0, /* List */
0114, 0151, 0164, 0164, 0154, 0145, 040, 0123, 0155, 0141, 0154, 0154, 0164, 0141, 0154, 0153, 0, /* Little Smalltalk */
0115, 0141, 0147, 0156, 0151, 0164, 0165, 0144, 0145, 0, /* Magnitude */
0115, 0141, 0151, 0156, 0, /* Main */
0116, 0165, 0155, 0142, 0145, 0162, 0, /* Number */
0117, 0142, 0152, 0145, 0143, 0164, 0, /* Object */
0117, 0162, 0144, 0145, 0162, 0145, 0144, 0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 0, /* OrderedCollection */
0120, 0157, 0151, 0156, 0164, 0, /* Point */
0120, 0162, 0157, 0143, 0145, 0163, 0163, 0, /* Process */
0122, 0105, 0101, 0104, 0131, 0, /* READY */
0122, 0141, 0144, 0151, 0141, 0156, 0, /* Radian */
0122, 0141, 0156, 0144, 0157, 0155, 0, /* Random */
0123, 0125, 0123, 0120, 0105, 0116, 0104, 0105, 0104, 0, /* SUSPENDED */
0123, 0145, 0155, 0141, 0160, 0150, 0157, 0162, 0145, 0, /* Semaphore */
0123, 0145, 0161, 0165, 0145, 0156, 0143, 0145, 0141, 0142, 0154, 0145, 0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 0, /* SequenceableCollection */
0123, 0145, 0164, 0, /* Set */
0123, 0155, 0141, 0154, 0154, 0164, 0141, 0154, 0153, 0, /* Smalltalk */
0123, 0164, 0162, 0151, 0156, 0147, 0, /* String */
0123, 0171, 0155, 0142, 0157, 0154, 0, /* Symbol */
0124, 0105, 0122, 0115, 0111, 0116, 0101, 0124, 0105, 0104, 0, /* TERMINATED */
0124, 0162, 0165, 0145, 0, /* True */
0125, 0156, 0144, 0145, 0146, 0151, 0156, 0145, 0144, 0117, 0142, 0152, 0145, 0143, 0164, 0, /* UndefinedObject */
0133, 0, /* [ */
0134, 0134, 0, /* \\ */
0134, 0134, 0134, 0134, 0, /* \\\\ */
0135, 0, /* ] */
0136, 0, /* ^ */
0141, 0142, 0163, 0, /* abs */
0141, 0144, 0144, 072, 0, /* add: */
0141, 0144, 0144, 072, 0141, 0146, 0164, 0145, 0162, 072, 0, /* add:after: */
0141, 0144, 0144, 072, 0142, 0145, 0146, 0157, 0162, 0145, 072, 0, /* add:before: */
0141, 0144, 0144, 072, 0167, 0151, 0164, 0150, 0117, 0143, 0143, 0165, 0162, 0162, 0145, 0156, 0143, 0145, 0163, 072, 0, /* add:withOccurrences: */
0141, 0144, 0144, 0101, 0154, 0154, 072, 0, /* addAll: */
0141, 0144, 0144, 0101, 0154, 0154, 0106, 0151, 0162, 0163, 0164, 072, 0, /* addAllFirst: */
0141, 0144, 0144, 0101, 0154, 0154, 0114, 0141, 0163, 0164, 072, 0, /* addAllLast: */
0141, 0144, 0144, 0106, 0151, 0162, 0163, 0164, 072, 0, /* addFirst: */
0141, 0144, 0144, 0114, 0141, 0163, 0164, 072, 0, /* addLast: */
0141, 0146, 0164, 0145, 0162, 072, 0, /* after: */
0141, 0154, 0154, 0115, 0141, 0163, 0153, 072, 0, /* allMask: */
0141, 0156, 0144, 072, 0, /* and: */
0141, 0156, 0171, 0115, 0141, 0163, 0153, 072, 0, /* anyMask: */
0141, 0162, 0143, 0103, 0157, 0163, 0, /* arcCos */
0141, 0162, 0143, 0123, 0151, 0156, 0, /* arcSin */
0141, 0162, 0143, 0124, 0141, 0156, 0, /* arcTan */
0141, 0162, 0147, 0145, 0162, 0162, 0157, 0162, 0, /* argerror */
0141, 0163, 0101, 0162, 0162, 0141, 0171, 0, /* asArray */
0141, 0163, 0102, 0141, 0147, 0, /* asBag */
0141, 0163, 0103, 0150, 0141, 0162, 0141, 0143, 0164, 0145, 0162, 0, /* asCharacter */
0141, 0163, 0104, 0151, 0143, 0164, 0151, 0157, 0156, 0141, 0162, 0171, 0, /* asDictionary */
0141, 0163, 0106, 0154, 0157, 0141, 0164, 0, /* asFloat */
0141, 0163, 0106, 0162, 0141, 0143, 0164, 0151, 0157, 0156, 0, /* asFraction */
0141, 0163, 0111, 0156, 0164, 0145, 0147, 0145, 0162, 0, /* asInteger */
0141, 0163, 0114, 0151, 0163, 0164, 0, /* asList */
0141, 0163, 0114, 0157, 0167, 0145, 0162, 0143, 0141, 0163, 0145, 0, /* asLowercase */
0141, 0163, 0117, 0162, 0144, 0145, 0162, 0145, 0144, 0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 0, /* asOrderedCollection */
0141, 0163, 0123, 0145, 0164, 0, /* asSet */
0141, 0163, 0123, 0164, 0162, 0151, 0156, 0147, 0, /* asString */
0141, 0163, 0123, 0171, 0155, 0142, 0157, 0154, 0, /* asSymbol */
0141, 0163, 0125, 0160, 0160, 0145, 0162, 0143, 0141, 0163, 0145, 0, /* asUppercase */
0141, 0163, 0143, 0151, 0151, 0126, 0141, 0154, 0165, 0145, 0, /* asciiValue */
0141, 0164, 072, 0, /* at: */
0141, 0164, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* at:ifAbsent: */
0141, 0164, 072, 0160, 0165, 0164, 072, 0, /* at:put: */
0141, 0164, 0101, 0154, 0154, 072, 0160, 0165, 0164, 072, 0, /* atAll:put: */
0141, 0164, 0101, 0154, 0154, 0120, 0165, 0164, 072, 0, /* atAllPut: */
0142, 0145, 0146, 0157, 0162, 0145, 072, 0, /* before: */
0142, 0145, 0164, 0167, 0145, 0145, 0156, 072, 0141, 0156, 0144, 072, 0, /* between:and: */
0142, 0151, 0156, 0141, 0162, 0171, 0104, 0157, 072, 0, /* binaryDo: */
0142, 0151, 0164, 0101, 0156, 0144, 072, 0, /* bitAnd: */
0142, 0151, 0164, 0101, 0164, 072, 0, /* bitAt: */
0142, 0151, 0164, 0111, 0156, 0166, 0145, 0162, 0164, 0, /* bitInvert */
0142, 0151, 0164, 0117, 0162, 072, 0, /* bitOr: */
0142, 0151, 0164, 0123, 0150, 0151, 0146, 0164, 072, 0, /* bitShift: */
0142, 0151, 0164, 0130, 0157, 0162, 072, 0, /* bitXor: */
0142, 0154, 0157, 0143, 0153, 0, /* block */
0142, 0154, 0157, 0143, 0153, 0145, 0144, 0120, 0162, 0157, 0143, 0145, 0163, 0163, 0121, 0165, 0145, 0165, 0145, 0, /* blockedProcessQueue */
0143, 0145, 0151, 0154, 0151, 0156, 0147, 0, /* ceiling */
0143, 0150, 0145, 0143, 0153, 0102, 0165, 0143, 0153, 0145, 0164, 072, 0, /* checkBucket: */
0143, 0154, 0141, 0163, 0163, 0, /* class */
0143, 0154, 0145, 0141, 0156, 0125, 0160, 0, /* cleanUp */
0143, 0157, 0145, 0162, 0143, 0145, 072, 0, /* coerce: */
0143, 0157, 0154, 0154, 0145, 0143, 0164, 072, 0, /* collect: */
0143, 0157, 0155, 0155, 0141, 0156, 0144, 0163, 072, 0, /* commands: */
0143, 0157, 0155, 0160, 0141, 0162, 0145, 0105, 0162, 0162, 0157, 0162, 0, /* compareError */
0143, 0157, 0160, 0171, 0, /* copy */
0143, 0157, 0160, 0171, 0101, 0162, 0147, 0165, 0155, 0145, 0156, 0164, 0163, 072, 0, /* copyArguments: */
0143, 0157, 0160, 0171, 0101, 0162, 0147, 0165, 0155, 0145, 0156, 0164, 0163, 072, 0164, 0157, 072, 0, /* copyArguments:to: */
0143, 0157, 0160, 0171, 0106, 0162, 0157, 0155, 072, 0, /* copyFrom: */
0143, 0157, 0160, 0171, 0106, 0162, 0157, 0155, 072, 0154, 0145, 0156, 0147, 0164, 0150, 072, 0, /* copyFrom:length: */
0143, 0157, 0160, 0171, 0106, 0162, 0157, 0155, 072, 0164, 0157, 072, 0, /* copyFrom:to: */
0143, 0157, 0160, 0171, 0127, 0151, 0164, 0150, 072, 0, /* copyWith: */
0143, 0157, 0160, 0171, 0127, 0151, 0164, 0150, 0157, 0165, 0164, 072, 0, /* copyWithout: */
0143, 0157, 0163, 0, /* cos */
0143, 0157, 0165, 0156, 0164, 0, /* count */
0143, 0165, 0162, 0162, 0101, 0163, 0163, 0157, 0143, 0, /* currAssoc */
0143, 0165, 0162, 0162, 0102, 0165, 0143, 0153, 0145, 0164, 0, /* currBucket */
0143, 0165, 0162, 0162, 0145, 0156, 0164, 0, /* current */
0143, 0165, 0162, 0162, 0145, 0156, 0164, 0102, 0165, 0143, 0153, 0145, 0164, 0, /* currentBucket */
0143, 0165, 0162, 0162, 0145, 0156, 0164, 0113, 0145, 0171, 0, /* currentKey */
0143, 0165, 0162, 0162, 0145, 0156, 0164, 0114, 0151, 0163, 0164, 0, /* currentList */
0144, 0141, 0164, 0145, 0, /* date */
0144, 0145, 0142, 0165, 0147, 072, 0, /* debug: */
0144, 0145, 0145, 0160, 0103, 0157, 0160, 0171, 0, /* deepCopy */
0144, 0145, 0145, 0160, 0103, 0157, 0160, 0171, 072, 0, /* deepCopy: */
0144, 0145, 0164, 0145, 0143, 0164, 072, 0, /* detect: */
0144, 0145, 0164, 0145, 0143, 0164, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* detect:ifAbsent: */
0144, 0145, 0164, 0145, 0143, 0164, 072, 0151, 0146, 0116, 0157, 0156, 0145, 072, 0, /* detect:ifNone: */
0144, 0151, 0143, 0164, 0, /* dict */
0144, 0151, 0143, 0164, 0151, 0157, 0156, 0141, 0162, 0171, 0, /* dictionary */
0144, 0151, 0147, 0151, 0164, 0126, 0141, 0154, 0165, 0145, 0, /* digitValue */
0144, 0151, 0147, 0151, 0164, 0126, 0141, 0154, 0165, 0145, 072, 0, /* digitValue: */
0144, 0151, 0163, 0160, 0154, 0141, 0171, 0, /* display */
0144, 0151, 0163, 0160, 0154, 0141, 0171, 0101, 0163, 0163, 0151, 0147, 0156, 0, /* displayAssign */
0144, 0151, 0163, 0164, 072, 0, /* dist: */
0144, 0157, 072, 0, /* do: */
0144, 0157, 0120, 0162, 0151, 0155, 0151, 0164, 0151, 0166, 0145, 072, 0, /* doPrimitive: */
0144, 0157, 0120, 0162, 0151, 0155, 0151, 0164, 0151, 0166, 0145, 072, 0167, 0151, 0164, 0150, 0101, 0162, 0147, 0165, 0155, 0145, 0156, 0164, 0163, 072, 0, /* doPrimitive:withArguments: */
0145, 0144, 0151, 0164, 0, /* edit */
0145, 0161, 0165, 0141, 0154, 0163, 072, 0163, 0164, 0141, 0162, 0164, 0151, 0156, 0147, 0101, 0164, 072, 0, /* equals:startingAt: */
0145, 0161, 0166, 072, 0, /* eqv: */
0145, 0162, 0162, 0157, 0162, 072, 0, /* error: */
0145, 0166, 0145, 0156, 0, /* even */
0145, 0170, 0143, 0145, 0163, 0163, 0123, 0151, 0147, 0156, 0141, 0154, 0163, 0, /* excessSignals */
0145, 0170, 0145, 0143, 0165, 0164, 0145, 0127, 0151, 0164, 0150, 072, 0, /* executeWith: */
0145, 0170, 0160, 0, /* exp */
0146, 0141, 0143, 0164, 0157, 0162, 0151, 0141, 0154, 0, /* factorial */
0146, 0151, 0156, 0144, 0101, 0163, 0163, 0157, 0143, 0151, 0141, 0164, 0151, 0157, 0156, 072, 0151, 0156, 0114, 0151, 0163, 0164, 072, 0, /* findAssociation:inList: */
0146, 0151, 0156, 0144, 0106, 0151, 0162, 0163, 0164, 072, 0, /* findFirst: */
0146, 0151, 0156, 0144, 0106, 0151, 0162, 0163, 0164, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* findFirst:ifAbsent: */
0146, 0151, 0156, 0144, 0114, 0141, 0163, 0164, 0, /* findLast */
0146, 0151, 0156, 0144, 0114, 0141, 0163, 0164, 072, 0, /* findLast: */
0146, 0151, 0156, 0144, 0114, 0141, 0163, 0164, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* findLast:ifAbsent: */
0146, 0151, 0162, 0163, 0164, 0, /* first */
0146, 0151, 0162, 0163, 0164, 0113, 0145, 0171, 0, /* firstKey */
0146, 0154, 0157, 0157, 0162, 0, /* floor */
0146, 0154, 0157, 0157, 0162, 0114, 0157, 0147, 072, 0, /* floorLog: */
0146, 0157, 0162, 0153, 0, /* fork */
0146, 0157, 0162, 0153, 0127, 0151, 0164, 0150, 072, 0, /* forkWith: */
0146, 0162, 0141, 0143, 0164, 0151, 0157, 0156, 0120, 0141, 0162, 0164, 0, /* fractionPart */
0146, 0162, 0145, 0145, 072, 0, /* free: */
0146, 0162, 0157, 0155, 072, 0, /* from: */
0146, 0162, 0157, 0155, 072, 0164, 0157, 072, 0, /* from:to: */
0146, 0162, 0157, 0155, 072, 0164, 0157, 072, 0142, 0171, 072, 0, /* from:to:by: */
0147, 0141, 0155, 0155, 0141, 0, /* gamma */
0147, 0143, 0144, 072, 0, /* gcd: */
0147, 0145, 0164, 0114, 0151, 0163, 0164, 072, 0, /* getList: */
0147, 0162, 0151, 0144, 072, 0, /* grid: */
0150, 0141, 0163, 0150, 0116, 0165, 0155, 0142, 0145, 0162, 072, 0, /* hashNumber: */
0150, 0141, 0163, 0150, 0124, 0141, 0142, 0, /* hashTab */
0150, 0141, 0163, 0150, 0124, 0141, 0142, 0154, 0145, 0, /* hashTable */
0150, 0151, 0147, 0150, 0102, 0151, 0164, 0, /* highBit */
0151, 0, /* i */
0151, 0146, 0106, 0141, 0154, 0163, 0145, 072, 0, /* ifFalse: */
0151, 0146, 0106, 0141, 0154, 0163, 0145, 072, 0151, 0146, 0124, 0162, 0165, 0145, 072, 0, /* ifFalse:ifTrue: */
0151, 0146, 0124, 0162, 0165, 0145, 072, 0, /* ifTrue: */
0151, 0146, 0124, 0162, 0165, 0145, 072, 0151, 0146, 0106, 0141, 0154, 0163, 0145, 072, 0, /* ifTrue:ifFalse: */
0151, 0156, 0122, 0141, 0156, 0147, 0145, 072, 0, /* inRange: */
0151, 0156, 0143, 0154, 0165, 0144, 0145, 0163, 072, 0, /* includes: */
0151, 0156, 0143, 0154, 0165, 0144, 0145, 0163, 0113, 0145, 0171, 072, 0, /* includesKey: */
0151, 0156, 0144, 0145, 0170, 0117, 0146, 072, 0, /* indexOf: */
0151, 0156, 0144, 0145, 0170, 0117, 0146, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* indexOf:ifAbsent: */
0151, 0156, 0144, 0145, 0170, 0117, 0146, 0123, 0165, 0142, 0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 072, 0163, 0164, 0141, 0162, 0164, 0151, 0156, 0147, 0101, 0164, 072, 0, /* indexOfSubCollection:startingAt: */
0151, 0156, 0144, 0145, 0170, 0117, 0146, 0123, 0165, 0142, 0103, 0157, 0154, 0154, 0145, 0143, 0164, 0151, 0157, 0156, 072, 0163, 0164, 0141, 0162, 0164, 0151, 0156, 0147, 0101, 0164, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* indexOfSubCollection:startingAt:ifAbsent: */
0151, 0156, 0151, 0164, 072, 0, /* init: */
0151, 0156, 0151, 0164, 072, 0163, 0165, 0160, 0145, 0162, 072, 0, /* init:super: */
0151, 0156, 0151, 0164, 072, 0163, 0165, 0160, 0145, 0162, 072, 0156, 0165, 0155, 0126, 0141, 0162, 0163, 072, 0, /* init:super:numVars: */
0151, 0156, 0152, 0145, 0143, 0164, 072, 0151, 0156, 0164, 0157, 072, 0, /* inject:into: */
0151, 0156, 0164, 0145, 0147, 0145, 0162, 0120, 0141, 0162, 0164, 0, /* integerPart */
0151, 0163, 0101, 0154, 0160, 0150, 0141, 0116, 0165, 0155, 0145, 0162, 0151, 0143, 0, /* isAlphaNumeric */
0151, 0163, 0104, 0151, 0147, 0151, 0164, 0, /* isDigit */
0151, 0163, 0105, 0155, 0160, 0164, 0171, 0, /* isEmpty */
0151, 0163, 0113, 0151, 0156, 0144, 0117, 0146, 072, 0, /* isKindOf: */
0151, 0163, 0114, 0145, 0164, 0164, 0145, 0162, 0, /* isLetter */
0151, 0163, 0114, 0157, 0167, 0145, 0162, 0143, 0141, 0163, 0145, 0, /* isLowercase */
0151, 0163, 0115, 0145, 0155, 0142, 0145, 0162, 0117, 0146, 072, 0, /* isMemberOf: */
0151, 0163, 0116, 0151, 0154, 0, /* isNil */
0151, 0163, 0123, 0145, 0160, 0141, 0162, 0141, 0164, 0157, 0162, 0, /* isSeparator */
0151, 0163, 0125, 0160, 0160, 0145, 0162, 0143, 0141, 0163, 0145, 0, /* isUppercase */
0151, 0163, 0126, 0157, 0167, 0145, 0154, 0, /* isVowel */
0153, 0145, 0171, 0163, 0, /* keys */
0153, 0145, 0171, 0163, 0104, 0157, 072, 0, /* keysDo: */
0153, 0145, 0171, 0163, 0123, 0145, 0154, 0145, 0143, 0164, 072, 0, /* keysSelect: */
0154, 0141, 0163, 0164, 0, /* last */
0154, 0141, 0163, 0164, 0113, 0145, 0171, 0, /* lastKey */
0154, 0143, 0155, 072, 0, /* lcm: */
0154, 0151, 0163, 0164, 0, /* list */
0154, 0156, 0, /* ln */
0154, 0157, 0147, 072, 0, /* log: */
0154, 0157, 0167, 0145, 0162, 0, /* lower */
0155, 0141, 0151, 0156, 0, /* main */
0155, 0141, 0170, 072, 0, /* max: */
0155, 0141, 0170, 0103, 0157, 0156, 0164, 0145, 0170, 0164, 072, 0, /* maxContext: */
0155, 0141, 0170, 0164, 0171, 0160, 0145, 072, 0, /* maxtype: */
0155, 0145, 0164, 0150, 0157, 0144, 0163, 072, 0, /* methods: */
0155, 0151, 0156, 072, 0, /* min: */
0155, 0157, 0144, 0145, 0103, 0150, 0141, 0162, 0141, 0143, 0164, 0145, 0162, 0, /* modeCharacter */
0155, 0157, 0144, 0145, 0111, 0156, 0164, 0145, 0147, 0145, 0162, 0, /* modeInteger */
0155, 0157, 0144, 0145, 0123, 0164, 0162, 0151, 0156, 0147, 0, /* modeString */
0156, 0141, 0155, 0145, 072, 0, /* name: */
0156, 0145, 0147, 0141, 0164, 0145, 0144, 0, /* negated */
0156, 0145, 0147, 0141, 0164, 0151, 0166, 0145, 0, /* negative */
0156, 0145, 0167, 0, /* new */
0156, 0145, 0167, 072, 0, /* new: */
0156, 0145, 0167, 0120, 0162, 0157, 0143, 0145, 0163, 0163, 0, /* newProcess */
0156, 0145, 0167, 0120, 0162, 0157, 0143, 0145, 0163, 0163, 0127, 0151, 0164, 0150, 072, 0, /* newProcessWith: */
0156, 0145, 0170, 0164, 0, /* next */
0156, 0145, 0170, 0164, 072, 0, /* next: */
0156, 0157, 0104, 0151, 0163, 0160, 0154, 0141, 0171, 0, /* noDisplay */
0156, 0157, 0115, 0141, 0163, 0153, 072, 0, /* noMask: */
0156, 0157, 0164, 0, /* not */
0156, 0157, 0164, 0116, 0151, 0154, 0, /* notNil */
0156, 0157, 0164, 0150, 0151, 0156, 0147, 0, /* nothing */
0157, 0143, 0143, 0165, 0162, 0162, 0145, 0156, 0143, 0145, 0163, 0117, 0146, 072, 0, /* occurrencesOf: */
0157, 0144, 0144, 0, /* odd */
0157, 0160, 0105, 0162, 0162, 0157, 0162, 0, /* opError */
0157, 0160, 0145, 0156, 072, 0, /* open: */
0157, 0160, 0145, 0156, 072, 0146, 0157, 0162, 072, 0, /* open:for: */
0157, 0162, 072, 0, /* or: */
0160, 0145, 0162, 0146, 0157, 0162, 0155, 072, 0, /* perform: */
0160, 0145, 0162, 0146, 0157, 0162, 0155, 072, 0167, 0151, 0164, 0150, 0101, 0162, 0147, 0165, 0155, 0145, 0156, 0164, 0163, 072, 0, /* perform:withArguments: */
0160, 0151, 0, /* pi */
0160, 0157, 0163, 0151, 0164, 0151, 0166, 0145, 0, /* positive */
0160, 0162, 0151, 0156, 0164, 0, /* print */
0160, 0162, 0151, 0156, 0164, 0123, 0164, 0162, 0151, 0156, 0147, 0, /* printString */
0160, 0165, 0164, 072, 0, /* put: */
0161, 0165, 0157, 072, 0, /* quo: */
0162, 0141, 0144, 0151, 0141, 0156, 0163, 0, /* radians */
0162, 0141, 0144, 0151, 0170, 072, 0, /* radix: */
0162, 0141, 0151, 0163, 0145, 0144, 0124, 0157, 072, 0, /* raisedTo: */
0162, 0141, 0151, 0163, 0145, 0144, 0124, 0157, 0111, 0156, 0164, 0145, 0147, 0145, 0162, 072, 0, /* raisedToInteger: */
0162, 0141, 0156, 0144, 0111, 0156, 0164, 0145, 0147, 0145, 0162, 072, 0, /* randInteger: */
0162, 0141, 0156, 0144, 0157, 0155, 0151, 0172, 0145, 0, /* randomize */
0162, 0145, 0141, 0144, 0, /* read */
0162, 0145, 0143, 0151, 0160, 0162, 0157, 0143, 0141, 0154, 0, /* reciprocal */
0162, 0145, 0152, 0145, 0143, 0164, 072, 0, /* reject: */
0162, 0145, 0155, 072, 0, /* rem: */
0162, 0145, 0155, 0157, 0166, 0145, 072, 0, /* remove: */
0162, 0145, 0155, 0157, 0166, 0145, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* remove:ifAbsent: */
0162, 0145, 0155, 0157, 0166, 0145, 0101, 0154, 0154, 072, 0, /* removeAll: */
0162, 0145, 0155, 0157, 0166, 0145, 0105, 0162, 0162, 0157, 0162, 0, /* removeError */
0162, 0145, 0155, 0157, 0166, 0145, 0106, 0151, 0162, 0163, 0164, 0, /* removeFirst */
0162, 0145, 0155, 0157, 0166, 0145, 0113, 0145, 0171, 072, 0, /* removeKey: */
0162, 0145, 0155, 0157, 0166, 0145, 0113, 0145, 0171, 072, 0151, 0146, 0101, 0142, 0163, 0145, 0156, 0164, 072, 0, /* removeKey:ifAbsent: */
0162, 0145, 0155, 0157, 0166, 0145, 0114, 0141, 0163, 0164, 0, /* removeLast */
0162, 0145, 0155, 0157, 0166, 0145, 0144, 0, /* removed */
0162, 0145, 0160, 0154, 0141, 0143, 0145, 0106, 0162, 0157, 0155, 072, 0164, 0157, 072, 0167, 0151, 0164, 0150, 072, 0, /* replaceFrom:to:with: */
0162, 0145, 0160, 0154, 0141, 0143, 0145, 0106, 0162, 0157, 0155, 072, 0164, 0157, 072, 0167, 0151, 0164, 0150, 072, 0163, 0164, 0141, 0162, 0164, 0151, 0156, 0147, 0101, 0164, 072, 0, /* replaceFrom:to:with:startingAt: */
0162, 0145, 0163, 0160, 0157, 0156, 0144, 0163, 0124, 0157, 0, /* respondsTo */
0162, 0145, 0163, 0160, 0157, 0156, 0144, 0163, 0124, 0157, 072, 0, /* respondsTo: */
0162, 0145, 0163, 0165, 0155, 0145, 0, /* resume */
0162, 0145, 0166, 0145, 0162, 0163, 0145, 0104, 0157, 072, 0, /* reverseDo: */
0162, 0145, 0166, 0145, 0162, 0163, 0145, 0144, 0, /* reversed */
0162, 0157, 0165, 0156, 0144, 0124, 0157, 072, 0, /* roundTo: */
0162, 0157, 0165, 0156, 0144, 0145, 0144, 0, /* rounded */
0163, 0141, 0155, 0145, 0101, 0163, 072, 0, /* sameAs: */
0163, 0145, 0145, 0144, 0, /* seed */
0163, 0145, 0154, 0145, 0143, 0164, 072, 0, /* select: */
0163, 0145, 0164, 0103, 0165, 0162, 0162, 0145, 0156, 0164, 0114, 0157, 0143, 0141, 0164, 0151, 0157, 0156, 072, 0, /* setCurrentLocation: */
0163, 0150, 072, 0, /* sh: */
0163, 0150, 0141, 0154, 0154, 0157, 0167, 0103, 0157, 0160, 0171, 0, /* shallowCopy */
0163, 0150, 0141, 0154, 0154, 0157, 0167, 0103, 0157, 0160, 0171, 072, 0, /* shallowCopy: */
0163, 0151, 0147, 0156, 0, /* sign */
0163, 0151, 0147, 0156, 0141, 0154, 0, /* signal */
0163, 0151, 0156, 0, /* sin */
0163, 0151, 0172, 0145, 0, /* size */
0163, 0155, 0141, 0154, 0154, 0164, 0141, 0154, 0153, 0, /* smalltalk */
0163, 0157, 0162, 0164, 0, /* sort */
0163, 0157, 0162, 0164, 072, 0, /* sort: */
0163, 0161, 0162, 0164, 0, /* sqrt */
0163, 0161, 0165, 0141, 0162, 0145, 0144, 0, /* squared */
0163, 0164, 0141, 0164, 0145, 0, /* state */
0163, 0164, 0145, 0160, 0, /* step */
0163, 0164, 0162, 0151, 0143, 0164, 0154, 0171, 0120, 0157, 0163, 0151, 0164, 0151, 0166, 0145, 0, /* strictlyPositive */
0163, 0165, 0160, 0145, 0162, 0103, 0154, 0141, 0163, 0163, 0, /* superClass */
0163, 0165, 0160, 0145, 0162, 0103, 0154, 0141, 0163, 0163, 072, 0, /* superClass: */
0163, 0165, 0163, 0160, 0145, 0156, 0144, 0, /* suspend */
0164, 0141, 0156, 0, /* tan */
0164, 0145, 0155, 0160, 0, /* temp */
0164, 0145, 0162, 0155, 0105, 0162, 0162, 072, 0, /* termErr: */
0164, 0145, 0162, 0155, 0151, 0156, 0141, 0164, 0145, 0, /* terminate */
0164, 0151, 0155, 0145, 072, 0, /* time: */
0164, 0151, 0155, 0145, 0163, 0122, 0145, 0160, 0145, 0141, 0164, 072, 0, /* timesRepeat: */
0164, 0157, 072, 0, /* to: */
0164, 0157, 072, 0142, 0171, 072, 0, /* to:by: */
0164, 0162, 0141, 0156, 0163, 0160, 0157, 0163, 0145, 0, /* transpose */
0164, 0162, 0165, 0156, 0143, 0141, 0164, 0145, 0124, 0157, 072, 0, /* truncateTo: */
0164, 0162, 0165, 0156, 0143, 0141, 0164, 0145, 0144, 0, /* truncated */
0164, 0162, 0165, 0156, 0143, 0141, 0164, 0145, 0144, 0107, 0162, 0151, 0144, 072, 0, /* truncatedGrid: */
0165, 0156, 0142, 0154, 0157, 0143, 0153, 0, /* unblock */
0165, 0160, 0160, 0145, 0162, 0, /* upper */
0166, 0141, 0154, 0165, 0145, 0, /* value */
0166, 0141, 0154, 0165, 0145, 072, 0, /* value: */
0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0, /* value:value: */
0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0, /* value:value:value: */
0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0, /* value:value:value:value: */
0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0166, 0141, 0154, 0165, 0145, 072, 0, /* value:value:value:value:value: */
0166, 0141, 0154, 0165, 0145, 0163, 0, /* values */
0166, 0141, 0162, 0151, 0141, 0142, 0154, 0145, 0163, 0, /* variables */
0166, 0141, 0162, 0151, 0141, 0142, 0154, 0145, 0163, 072, 0, /* variables: */
0166, 0151, 0145, 0167, 0, /* view */
0167, 0141, 0151, 0164, 0, /* wait */
0167, 0150, 0151, 0154, 0145, 0106, 0141, 0154, 0163, 0145, 072, 0, /* whileFalse: */
0167, 0150, 0151, 0154, 0145, 0124, 0162, 0165, 0145, 072, 0, /* whileTrue: */
0167, 0151, 0164, 0150, 072, 0144, 0157, 072, 0, /* with:do: */
0167, 0151, 0164, 0150, 0101, 0162, 0147, 0165, 0155, 0145, 0156, 0164, 0163, 072, 0, /* withArguments: */
0167, 0162, 0151, 0164, 0145, 072, 0, /* write: */
0170, 0, /* x */
0170, 072, 0, /* x: */
0170, 0157, 0162, 072, 0, /* xor: */
0170, 0166, 0141, 0154, 0165, 0145, 0, /* xvalue */
0171, 0, /* y */
0171, 072, 0, /* y: */
0171, 0151, 0145, 0154, 0144, 0, /* yield */
0171, 0166, 0141, 0154, 0165, 0145, 0, /* yvalue */
0174, 0, /* | */
0176, 0, /* ~ */
0176, 075, 0, /* ~= */
0176, 0176, 0, /* ~~ */
0 };
int x_cmax = 3253;
static symbol x_sytab[] = {
{1, SYMBOLSIZE, &x_str[0]}, /* ! */
{1, SYMBOLSIZE, &x_str[2]}, /* & */
{1, SYMBOLSIZE, &x_str[4]}, /* ( */
{1, SYMBOLSIZE, &x_str[6]}, /* ) */
{1, SYMBOLSIZE, &x_str[8]}, /* * */
{1, SYMBOLSIZE, &x_str[10]}, /* + */
{1, SYMBOLSIZE, &x_str[12]}, /* , */
{1, SYMBOLSIZE, &x_str[14]}, /* - */
{1, SYMBOLSIZE, &x_str[16]}, /* / */
{1, SYMBOLSIZE, &x_str[18]}, /* // */
{1, SYMBOLSIZE, &x_str[21]}, /* < */
{1, SYMBOLSIZE, &x_str[23]}, /* <= */
{1, SYMBOLSIZE, &x_str[26]}, /* = */
{1, SYMBOLSIZE, &x_str[28]}, /* == */
{1, SYMBOLSIZE, &x_str[31]}, /* > */
{1, SYMBOLSIZE, &x_str[33]}, /* >= */
{1, SYMBOLSIZE, &x_str[36]}, /* @ */
{1, SYMBOLSIZE, &x_str[38]}, /* Array */
{1, SYMBOLSIZE, &x_str[44]}, /* ArrayedCollection */
{1, SYMBOLSIZE, &x_str[62]}, /* BLOCKED */
{1, SYMBOLSIZE, &x_str[70]}, /* Bag */
{1, SYMBOLSIZE, &x_str[74]}, /* Block */
{1, SYMBOLSIZE, &x_str[80]}, /* Boolean */
{1, SYMBOLSIZE, &x_str[88]}, /* ByteArray */
{1, SYMBOLSIZE, &x_str[98]}, /* Char */
{1, SYMBOLSIZE, &x_str[103]}, /* Class */
{1, SYMBOLSIZE, &x_str[109]}, /* Collection */
{1, SYMBOLSIZE, &x_str[120]}, /* Complex */
{1, SYMBOLSIZE, &x_str[128]}, /* Dictionary */
{1, SYMBOLSIZE, &x_str[139]}, /* False */
{1, SYMBOLSIZE, &x_str[145]}, /* File */
{1, SYMBOLSIZE, &x_str[150]}, /* Float */
{1, SYMBOLSIZE, &x_str[156]}, /* Integer */
{1, SYMBOLSIZE, &x_str[164]}, /* Interpreter */
{1, SYMBOLSIZE, &x_str[176]}, /* Interval */
{1, SYMBOLSIZE, &x_str[185]}, /* KeyedCollection */
{1, SYMBOLSIZE, &x_str[201]}, /* List */
{1, SYMBOLSIZE, &x_str[206]}, /* Little Smalltalk */
{1, SYMBOLSIZE, &x_str[223]}, /* Magnitude */
{1, SYMBOLSIZE, &x_str[233]}, /* Main */
{1, SYMBOLSIZE, &x_str[238]}, /* Number */
{1, SYMBOLSIZE, &x_str[245]}, /* Object */
{1, SYMBOLSIZE, &x_str[252]}, /* OrderedCollection */
{1, SYMBOLSIZE, &x_str[270]}, /* Point */
{1, SYMBOLSIZE, &x_str[276]}, /* Process */
{1, SYMBOLSIZE, &x_str[284]}, /* READY */
{1, SYMBOLSIZE, &x_str[290]}, /* Radian */
{1, SYMBOLSIZE, &x_str[297]}, /* Random */
{1, SYMBOLSIZE, &x_str[304]}, /* SUSPENDED */
{1, SYMBOLSIZE, &x_str[314]}, /* Semaphore */
{1, SYMBOLSIZE, &x_str[324]}, /* SequenceableCollection */
{1, SYMBOLSIZE, &x_str[347]}, /* Set */
{1, SYMBOLSIZE, &x_str[351]}, /* Smalltalk */
{1, SYMBOLSIZE, &x_str[361]}, /* String */
{1, SYMBOLSIZE, &x_str[368]}, /* Symbol */
{1, SYMBOLSIZE, &x_str[375]}, /* TERMINATED */
{1, SYMBOLSIZE, &x_str[386]}, /* True */
{1, SYMBOLSIZE, &x_str[391]}, /* UndefinedObject */
{1, SYMBOLSIZE, &x_str[407]}, /* [ */
{1, SYMBOLSIZE, &x_str[409]}, /* \\ */
{1, SYMBOLSIZE, &x_str[412]}, /* \\\\ */
{1, SYMBOLSIZE, &x_str[417]}, /* ] */
{1, SYMBOLSIZE, &x_str[419]}, /* ^ */
{1, SYMBOLSIZE, &x_str[421]}, /* abs */
{1, SYMBOLSIZE, &x_str[425]}, /* add: */
{1, SYMBOLSIZE, &x_str[430]}, /* add:after: */
{1, SYMBOLSIZE, &x_str[441]}, /* add:before: */
{1, SYMBOLSIZE, &x_str[453]}, /* add:withOccurrences: */
{1, SYMBOLSIZE, &x_str[474]}, /* addAll: */
{1, SYMBOLSIZE, &x_str[482]}, /* addAllFirst: */
{1, SYMBOLSIZE, &x_str[495]}, /* addAllLast: */
{1, SYMBOLSIZE, &x_str[507]}, /* addFirst: */
{1, SYMBOLSIZE, &x_str[517]}, /* addLast: */
{1, SYMBOLSIZE, &x_str[526]}, /* after: */
{1, SYMBOLSIZE, &x_str[533]}, /* allMask: */
{1, SYMBOLSIZE, &x_str[542]}, /* and: */
{1, SYMBOLSIZE, &x_str[547]}, /* anyMask: */
{1, SYMBOLSIZE, &x_str[556]}, /* arcCos */
{1, SYMBOLSIZE, &x_str[563]}, /* arcSin */
{1, SYMBOLSIZE, &x_str[570]}, /* arcTan */
{1, SYMBOLSIZE, &x_str[577]}, /* argerror */
{1, SYMBOLSIZE, &x_str[586]}, /* asArray */
{1, SYMBOLSIZE, &x_str[594]}, /* asBag */
{1, SYMBOLSIZE, &x_str[600]}, /* asCharacter */
{1, SYMBOLSIZE, &x_str[612]}, /* asDictionary */
{1, SYMBOLSIZE, &x_str[625]}, /* asFloat */
{1, SYMBOLSIZE, &x_str[633]}, /* asFraction */
{1, SYMBOLSIZE, &x_str[644]}, /* asInteger */
{1, SYMBOLSIZE, &x_str[654]}, /* asList */
{1, SYMBOLSIZE, &x_str[661]}, /* asLowercase */
{1, SYMBOLSIZE, &x_str[673]}, /* asOrderedCollection */
{1, SYMBOLSIZE, &x_str[693]}, /* asSet */
{1, SYMBOLSIZE, &x_str[699]}, /* asString */
{1, SYMBOLSIZE, &x_str[708]}, /* asSymbol */
{1, SYMBOLSIZE, &x_str[717]}, /* asUppercase */
{1, SYMBOLSIZE, &x_str[729]}, /* asciiValue */
{1, SYMBOLSIZE, &x_str[740]}, /* at: */
{1, SYMBOLSIZE, &x_str[744]}, /* at:ifAbsent: */
{1, SYMBOLSIZE, &x_str[757]}, /* at:put: */
{1, SYMBOLSIZE, &x_str[765]}, /* atAll:put: */
{1, SYMBOLSIZE, &x_str[776]}, /* atAllPut: */
{1, SYMBOLSIZE, &x_str[786]}, /* before: */
{1, SYMBOLSIZE, &x_str[794]}, /* between:and: */
{1, SYMBOLSIZE, &x_str[807]}, /* binaryDo: */
{1, SYMBOLSIZE, &x_str[817]}, /* bitAnd: */
{1, SYMBOLSIZE, &x_str[825]}, /* bitAt: */
{1, SYMBOLSIZE, &x_str[832]}, /* bitInvert */
{1, SYMBOLSIZE, &x_str[842]}, /* bitOr: */
{1, SYMBOLSIZE, &x_str[849]}, /* bitShift: */
{1, SYMBOLSIZE, &x_str[859]}, /* bitXor: */
{1, SYMBOLSIZE, &x_str[867]}, /* block */
{1, SYMBOLSIZE, &x_str[873]}, /* blockedProcessQueue */
{1, SYMBOLSIZE, &x_str[893]}, /* ceiling */
{1, SYMBOLSIZE, &x_str[901]}, /* checkBucket: */
{1, SYMBOLSIZE, &x_str[914]}, /* class */
{1, SYMBOLSIZE, &x_str[920]}, /* cleanUp */
{1, SYMBOLSIZE, &x_str[928]}, /* coerce: */
{1, SYMBOLSIZE, &x_str[936]}, /* collect: */
{1, SYMBOLSIZE, &x_str[945]}, /* commands: */
{1, SYMBOLSIZE, &x_str[955]}, /* compareError */
{1, SYMBOLSIZE, &x_str[968]}, /* copy */
{1, SYMBOLSIZE, &x_str[973]}, /* copyArguments: */
{1, SYMBOLSIZE, &x_str[988]}, /* copyArguments:to: */
{1, SYMBOLSIZE, &x_str[1006]}, /* copyFrom: */
{1, SYMBOLSIZE, &x_str[1016]}, /* copyFrom:length: */
{1, SYMBOLSIZE, &x_str[1033]}, /* copyFrom:to: */
{1, SYMBOLSIZE, &x_str[1046]}, /* copyWith: */
{1, SYMBOLSIZE, &x_str[1056]}, /* copyWithout: */
{1, SYMBOLSIZE, &x_str[1069]}, /* cos */
{1, SYMBOLSIZE, &x_str[1073]}, /* count */
{1, SYMBOLSIZE, &x_str[1079]}, /* currAssoc */
{1, SYMBOLSIZE, &x_str[1089]}, /* currBucket */
{1, SYMBOLSIZE, &x_str[1100]}, /* current */
{1, SYMBOLSIZE, &x_str[1108]}, /* currentBucket */
{1, SYMBOLSIZE, &x_str[1122]}, /* currentKey */
{1, SYMBOLSIZE, &x_str[1133]}, /* currentList */
{1, SYMBOLSIZE, &x_str[1145]}, /* date */
{1, SYMBOLSIZE, &x_str[1150]}, /* debug: */
{1, SYMBOLSIZE, &x_str[1157]}, /* deepCopy */
{1, SYMBOLSIZE, &x_str[1166]}, /* deepCopy: */
{1, SYMBOLSIZE, &x_str[1176]}, /* detect: */
{1, SYMBOLSIZE, &x_str[1184]}, /* detect:ifAbsent: */
{1, SYMBOLSIZE, &x_str[1201]}, /* detect:ifNone: */
{1, SYMBOLSIZE, &x_str[1216]}, /* dict */
{1, SYMBOLSIZE, &x_str[1221]}, /* dictionary */
{1, SYMBOLSIZE, &x_str[1232]}, /* digitValue */
{1, SYMBOLSIZE, &x_str[1243]}, /* digitValue: */
{1, SYMBOLSIZE, &x_str[1255]}, /* display */
{1, SYMBOLSIZE, &x_str[1263]}, /* displayAssign */
{1, SYMBOLSIZE, &x_str[1277]}, /* dist: */
{1, SYMBOLSIZE, &x_str[1283]}, /* do: */
{1, SYMBOLSIZE, &x_str[1287]}, /* doPrimitive: */
{1, SYMBOLSIZE, &x_str[1300]}, /* doPrimitive:withArguments: */
{1, SYMBOLSIZE, &x_str[1327]}, /* edit */
{1, SYMBOLSIZE, &x_str[1332]}, /* equals:startingAt: */
{1, SYMBOLSIZE, &x_str[1351]}, /* eqv: */
{1, SYMBOLSIZE, &x_str[1356]}, /* error: */
{1, SYMBOLSIZE, &x_str[1363]}, /* even */
{1, SYMBOLSIZE, &x_str[1368]}, /* excessSignals */
{1, SYMBOLSIZE, &x_str[1382]}, /* executeWith: */
{1, SYMBOLSIZE, &x_str[1395]}, /* exp */
{1, SYMBOLSIZE, &x_str[1399]}, /* factorial */
{1, SYMBOLSIZE, &x_str[1409]}, /* findAssociation:inList: */
{1, SYMBOLSIZE, &x_str[1433]}, /* findFirst: */
{1, SYMBOLSIZE, &x_str[1444]}, /* findFirst:ifAbsent: */
{1, SYMBOLSIZE, &x_str[1464]}, /* findLast */
{1, SYMBOLSIZE, &x_str[1473]}, /* findLast: */
{1, SYMBOLSIZE, &x_str[1483]}, /* findLast:ifAbsent: */
{1, SYMBOLSIZE, &x_str[1502]}, /* first */
{1, SYMBOLSIZE, &x_str[1508]}, /* firstKey */
{1, SYMBOLSIZE, &x_str[1517]}, /* floor */
{1, SYMBOLSIZE, &x_str[1523]}, /* floorLog: */
{1, SYMBOLSIZE, &x_str[1533]}, /* fork */
{1, SYMBOLSIZE, &x_str[1538]}, /* forkWith: */
{1, SYMBOLSIZE, &x_str[1548]}, /* fractionPart */
{1, SYMBOLSIZE, &x_str[1561]}, /* free: */
{1, SYMBOLSIZE, &x_str[1567]}, /* from: */
{1, SYMBOLSIZE, &x_str[1573]}, /* from:to: */
{1, SYMBOLSIZE, &x_str[1582]}, /* from:to:by: */
{1, SYMBOLSIZE, &x_str[1594]}, /* gamma */
{1, SYMBOLSIZE, &x_str[1600]}, /* gcd: */
{1, SYMBOLSIZE, &x_str[1605]}, /* getList: */
{1, SYMBOLSIZE, &x_str[1614]}, /* grid: */
{1, SYMBOLSIZE, &x_str[1620]}, /* hashNumber: */
{1, SYMBOLSIZE, &x_str[1632]}, /* hashTab */
{1, SYMBOLSIZE, &x_str[1640]}, /* hashTable */
{1, SYMBOLSIZE, &x_str[1650]}, /* highBit */
{1, SYMBOLSIZE, &x_str[1658]}, /* i */
{1, SYMBOLSIZE, &x_str[1660]}, /* ifFalse: */
{1, SYMBOLSIZE, &x_str[1669]}, /* ifFalse:ifTrue: */
{1, SYMBOLSIZE, &x_str[1685]}, /* ifTrue: */
{1, SYMBOLSIZE, &x_str[1693]}, /* ifTrue:ifFalse: */
{1, SYMBOLSIZE, &x_str[1709]}, /* inRange: */
{1, SYMBOLSIZE, &x_str[1718]}, /* includes: */
{1, SYMBOLSIZE, &x_str[1728]}, /* includesKey: */
{1, SYMBOLSIZE, &x_str[1741]}, /* indexOf: */
{1, SYMBOLSIZE, &x_str[1750]}, /* indexOf:ifAbsent: */
{1, SYMBOLSIZE, &x_str[1768]}, /* indexOfSubCollection:startingAt: */
{1, SYMBOLSIZE, &x_str[1801]}, /* indexOfSubCollection:startingAt:ifAbsent: */
{1, SYMBOLSIZE, &x_str[1843]}, /* init: */
{1, SYMBOLSIZE, &x_str[1849]}, /* init:super: */
{1, SYMBOLSIZE, &x_str[1861]}, /* init:super:numVars: */
{1, SYMBOLSIZE, &x_str[1881]}, /* inject:into: */
{1, SYMBOLSIZE, &x_str[1894]}, /* integerPart */
{1, SYMBOLSIZE, &x_str[1906]}, /* isAlphaNumeric */
{1, SYMBOLSIZE, &x_str[1921]}, /* isDigit */
{1, SYMBOLSIZE, &x_str[1929]}, /* isEmpty */
{1, SYMBOLSIZE, &x_str[1937]}, /* isKindOf: */
{1, SYMBOLSIZE, &x_str[1947]}, /* isLetter */
{1, SYMBOLSIZE, &x_str[1956]}, /* isLowercase */
{1, SYMBOLSIZE, &x_str[1968]}, /* isMemberOf: */
{1, SYMBOLSIZE, &x_str[1980]}, /* isNil */
{1, SYMBOLSIZE, &x_str[1986]}, /* isSeparator */
{1, SYMBOLSIZE, &x_str[1998]}, /* isUppercase */
{1, SYMBOLSIZE, &x_str[2010]}, /* isVowel */
{1, SYMBOLSIZE, &x_str[2018]}, /* keys */
{1, SYMBOLSIZE, &x_str[2023]}, /* keysDo: */
{1, SYMBOLSIZE, &x_str[2031]}, /* keysSelect: */
{1, SYMBOLSIZE, &x_str[2043]}, /* last */
{1, SYMBOLSIZE, &x_str[2048]}, /* lastKey */
{1, SYMBOLSIZE, &x_str[2056]}, /* lcm: */
{1, SYMBOLSIZE, &x_str[2061]}, /* list */
{1, SYMBOLSIZE, &x_str[2066]}, /* ln */
{1, SYMBOLSIZE, &x_str[2069]}, /* log: */
{1, SYMBOLSIZE, &x_str[2074]}, /* lower */
{1, SYMBOLSIZE, &x_str[2080]}, /* main */
{1, SYMBOLSIZE, &x_str[2085]}, /* max: */
{1, SYMBOLSIZE, &x_str[2090]}, /* maxContext: */
{1, SYMBOLSIZE, &x_str[2102]}, /* maxtype: */
{1, SYMBOLSIZE, &x_str[2111]}, /* methods: */
{1, SYMBOLSIZE, &x_str[2120]}, /* min: */
{1, SYMBOLSIZE, &x_str[2125]}, /* modeCharacter */
{1, SYMBOLSIZE, &x_str[2139]}, /* modeInteger */
{1, SYMBOLSIZE, &x_str[2151]}, /* modeString */
{1, SYMBOLSIZE, &x_str[2162]}, /* name: */
{1, SYMBOLSIZE, &x_str[2168]}, /* negated */
{1, SYMBOLSIZE, &x_str[2176]}, /* negative */
{1, SYMBOLSIZE, &x_str[2185]}, /* new */
{1, SYMBOLSIZE, &x_str[2189]}, /* new: */
{1, SYMBOLSIZE, &x_str[2194]}, /* newProcess */
{1, SYMBOLSIZE, &x_str[2205]}, /* newProcessWith: */
{1, SYMBOLSIZE, &x_str[2221]}, /* next */
{1, SYMBOLSIZE, &x_str[2226]}, /* next: */
{1, SYMBOLSIZE, &x_str[2232]}, /* noDisplay */
{1, SYMBOLSIZE, &x_str[2242]}, /* noMask: */
{1, SYMBOLSIZE, &x_str[2250]}, /* not */
{1, SYMBOLSIZE, &x_str[2254]}, /* notNil */
{1, SYMBOLSIZE, &x_str[2261]}, /* nothing */
{1, SYMBOLSIZE, &x_str[2269]}, /* occurrencesOf: */
{1, SYMBOLSIZE, &x_str[2284]}, /* odd */
{1, SYMBOLSIZE, &x_str[2288]}, /* opError */
{1, SYMBOLSIZE, &x_str[2296]}, /* open: */
{1, SYMBOLSIZE, &x_str[2302]}, /* open:for: */
{1, SYMBOLSIZE, &x_str[2312]}, /* or: */
{1, SYMBOLSIZE, &x_str[2316]}, /* perform: */
{1, SYMBOLSIZE, &x_str[2325]}, /* perform:withArguments: */
{1, SYMBOLSIZE, &x_str[2348]}, /* pi */
{1, SYMBOLSIZE, &x_str[2351]}, /* positive */
{1, SYMBOLSIZE, &x_str[2360]}, /* print */
{1, SYMBOLSIZE, &x_str[2366]}, /* printString */
{1, SYMBOLSIZE, &x_str[2378]}, /* put: */
{1, SYMBOLSIZE, &x_str[2383]}, /* quo: */
{1, SYMBOLSIZE, &x_str[2388]}, /* radians */
{1, SYMBOLSIZE, &x_str[2396]}, /* radix: */
{1, SYMBOLSIZE, &x_str[2403]}, /* raisedTo: */
{1, SYMBOLSIZE, &x_str[2413]}, /* raisedToInteger: */
{1, SYMBOLSIZE, &x_str[2430]}, /* randInteger: */
{1, SYMBOLSIZE, &x_str[2443]}, /* randomize */
{1, SYMBOLSIZE, &x_str[2453]}, /* read */
{1, SYMBOLSIZE, &x_str[2458]}, /* reciprocal */
{1, SYMBOLSIZE, &x_str[2469]}, /* reject: */
{1, SYMBOLSIZE, &x_str[2477]}, /* rem: */
{1, SYMBOLSIZE, &x_str[2482]}, /* remove: */
{1, SYMBOLSIZE, &x_str[2490]}, /* remove:ifAbsent: */
{1, SYMBOLSIZE, &x_str[2507]}, /* removeAll: */
{1, SYMBOLSIZE, &x_str[2518]}, /* removeError */
{1, SYMBOLSIZE, &x_str[2530]}, /* removeFirst */
{1, SYMBOLSIZE, &x_str[2542]}, /* removeKey: */
{1, SYMBOLSIZE, &x_str[2553]}, /* removeKey:ifAbsent: */
{1, SYMBOLSIZE, &x_str[2573]}, /* removeLast */
{1, SYMBOLSIZE, &x_str[2584]}, /* removed */
{1, SYMBOLSIZE, &x_str[2592]}, /* replaceFrom:to:with: */
{1, SYMBOLSIZE, &x_str[2613]}, /* replaceFrom:to:with:startingAt: */
{1, SYMBOLSIZE, &x_str[2645]}, /* respondsTo */
{1, SYMBOLSIZE, &x_str[2656]}, /* respondsTo: */
{1, SYMBOLSIZE, &x_str[2668]}, /* resume */
{1, SYMBOLSIZE, &x_str[2675]}, /* reverseDo: */
{1, SYMBOLSIZE, &x_str[2686]}, /* reversed */
{1, SYMBOLSIZE, &x_str[2695]}, /* roundTo: */
{1, SYMBOLSIZE, &x_str[2704]}, /* rounded */
{1, SYMBOLSIZE, &x_str[2712]}, /* sameAs: */
{1, SYMBOLSIZE, &x_str[2720]}, /* seed */
{1, SYMBOLSIZE, &x_str[2725]}, /* select: */
{1, SYMBOLSIZE, &x_str[2733]}, /* setCurrentLocation: */
{1, SYMBOLSIZE, &x_str[2753]}, /* sh: */
{1, SYMBOLSIZE, &x_str[2757]}, /* shallowCopy */
{1, SYMBOLSIZE, &x_str[2769]}, /* shallowCopy: */
{1, SYMBOLSIZE, &x_str[2782]}, /* sign */
{1, SYMBOLSIZE, &x_str[2787]}, /* signal */
{1, SYMBOLSIZE, &x_str[2794]}, /* sin */
{1, SYMBOLSIZE, &x_str[2798]}, /* size */
{1, SYMBOLSIZE, &x_str[2803]}, /* smalltalk */
{1, SYMBOLSIZE, &x_str[2813]}, /* sort */
{1, SYMBOLSIZE, &x_str[2818]}, /* sort: */
{1, SYMBOLSIZE, &x_str[2824]}, /* sqrt */
{1, SYMBOLSIZE, &x_str[2829]}, /* squared */
{1, SYMBOLSIZE, &x_str[2837]}, /* state */
{1, SYMBOLSIZE, &x_str[2843]}, /* step */
{1, SYMBOLSIZE, &x_str[2848]}, /* strictlyPositive */
{1, SYMBOLSIZE, &x_str[2865]}, /* superClass */
{1, SYMBOLSIZE, &x_str[2876]}, /* superClass: */
{1, SYMBOLSIZE, &x_str[2888]}, /* suspend */
{1, SYMBOLSIZE, &x_str[2896]}, /* tan */
{1, SYMBOLSIZE, &x_str[2900]}, /* temp */
{1, SYMBOLSIZE, &x_str[2905]}, /* termErr: */
{1, SYMBOLSIZE, &x_str[2914]}, /* terminate */
{1, SYMBOLSIZE, &x_str[2924]}, /* time: */
{1, SYMBOLSIZE, &x_str[2930]}, /* timesRepeat: */
{1, SYMBOLSIZE, &x_str[2943]}, /* to: */
{1, SYMBOLSIZE, &x_str[2947]}, /* to:by: */
{1, SYMBOLSIZE, &x_str[2954]}, /* transpose */
{1, SYMBOLSIZE, &x_str[2964]}, /* truncateTo: */
{1, SYMBOLSIZE, &x_str[2976]}, /* truncated */
{1, SYMBOLSIZE, &x_str[2986]}, /* truncatedGrid: */
{1, SYMBOLSIZE, &x_str[3001]}, /* unblock */
{1, SYMBOLSIZE, &x_str[3009]}, /* upper */
{1, SYMBOLSIZE, &x_str[3015]}, /* value */
{1, SYMBOLSIZE, &x_str[3021]}, /* value: */
{1, SYMBOLSIZE, &x_str[3028]}, /* value:value: */
{1, SYMBOLSIZE, &x_str[3041]}, /* value:value:value: */
{1, SYMBOLSIZE, &x_str[3060]}, /* value:value:value:value: */
{1, SYMBOLSIZE, &x_str[3085]}, /* value:value:value:value:value: */
{1, SYMBOLSIZE, &x_str[3116]}, /* values */
{1, SYMBOLSIZE, &x_str[3123]}, /* variables */
{1, SYMBOLSIZE, &x_str[3133]}, /* variables: */
{1, SYMBOLSIZE, &x_str[3144]}, /* view */
{1, SYMBOLSIZE, &x_str[3149]}, /* wait */
{1, SYMBOLSIZE, &x_str[3154]}, /* whileFalse: */
{1, SYMBOLSIZE, &x_str[3166]}, /* whileTrue: */
{1, SYMBOLSIZE, &x_str[3177]}, /* with:do: */
{1, SYMBOLSIZE, &x_str[3186]}, /* withArguments: */
{1, SYMBOLSIZE, &x_str[3201]}, /* write: */
{1, SYMBOLSIZE, &x_str[3208]}, /* x */
{1, SYMBOLSIZE, &x_str[3210]}, /* x: */
{1, SYMBOLSIZE, &x_str[3213]}, /* xor: */
{1, SYMBOLSIZE, &x_str[3218]}, /* xvalue */
{1, SYMBOLSIZE, &x_str[3225]}, /* y */
{1, SYMBOLSIZE, &x_str[3227]}, /* y: */
{1, SYMBOLSIZE, &x_str[3230]}, /* yield */
{1, SYMBOLSIZE, &x_str[3236]}, /* yvalue */
{1, SYMBOLSIZE, &x_str[3243]}, /* | */
{1, SYMBOLSIZE, &x_str[3245]}, /* ~ */
{1, SYMBOLSIZE, &x_str[3247]}, /* ~= */
{1, SYMBOLSIZE, &x_str[3250]}, /* ~~ */
0};
symbol *x_tab[SYMTABMAX] = {
&x_sytab[0], /* ! */
&x_sytab[1], /* & */
&x_sytab[2], /* ( */
&x_sytab[3], /* ) */
&x_sytab[4], /* * */
&x_sytab[5], /* + */
&x_sytab[6], /* , */
&x_sytab[7], /* - */
&x_sytab[8], /* / */
&x_sytab[9], /* // */
&x_sytab[10], /* < */
&x_sytab[11], /* <= */
&x_sytab[12], /* = */
&x_sytab[13], /* == */
&x_sytab[14], /* > */
&x_sytab[15], /* >= */
&x_sytab[16], /* @ */
&x_sytab[17], /* Array */
&x_sytab[18], /* ArrayedCollection */
&x_sytab[19], /* BLOCKED */
&x_sytab[20], /* Bag */
&x_sytab[21], /* Block */
&x_sytab[22], /* Boolean */
&x_sytab[23], /* ByteArray */
&x_sytab[24], /* Char */
&x_sytab[25], /* Class */
&x_sytab[26], /* Collection */
&x_sytab[27], /* Complex */
&x_sytab[28], /* Dictionary */
&x_sytab[29], /* False */
&x_sytab[30], /* File */
&x_sytab[31], /* Float */
&x_sytab[32], /* Integer */
&x_sytab[33], /* Interpreter */
&x_sytab[34], /* Interval */
&x_sytab[35], /* KeyedCollection */
&x_sytab[36], /* List */
&x_sytab[37], /* Little Smalltalk */
&x_sytab[38], /* Magnitude */
&x_sytab[39], /* Main */
&x_sytab[40], /* Number */
&x_sytab[41], /* Object */
&x_sytab[42], /* OrderedCollection */
&x_sytab[43], /* Point */
&x_sytab[44], /* Process */
&x_sytab[45], /* READY */
&x_sytab[46], /* Radian */
&x_sytab[47], /* Random */
&x_sytab[48], /* SUSPENDED */
&x_sytab[49], /* Semaphore */
&x_sytab[50], /* SequenceableCollection */
&x_sytab[51], /* Set */
&x_sytab[52], /* Smalltalk */
&x_sytab[53], /* String */
&x_sytab[54], /* Symbol */
&x_sytab[55], /* TERMINATED */
&x_sytab[56], /* True */
&x_sytab[57], /* UndefinedObject */
&x_sytab[58], /* [ */
&x_sytab[59], /* \\ */
&x_sytab[60], /* \\\\ */
&x_sytab[61], /* ] */
&x_sytab[62], /* ^ */
&x_sytab[63], /* abs */
&x_sytab[64], /* add: */
&x_sytab[65], /* add:after: */
&x_sytab[66], /* add:before: */
&x_sytab[67], /* add:withOccurrences: */
&x_sytab[68], /* addAll: */
&x_sytab[69], /* addAllFirst: */
&x_sytab[70], /* addAllLast: */
&x_sytab[71], /* addFirst: */
&x_sytab[72], /* addLast: */
&x_sytab[73], /* after: */
&x_sytab[74], /* allMask: */
&x_sytab[75], /* and: */
&x_sytab[76], /* anyMask: */
&x_sytab[77], /* arcCos */
&x_sytab[78], /* arcSin */
&x_sytab[79], /* arcTan */
&x_sytab[80], /* argerror */
&x_sytab[81], /* asArray */
&x_sytab[82], /* asBag */
&x_sytab[83], /* asCharacter */
&x_sytab[84], /* asDictionary */
&x_sytab[85], /* asFloat */
&x_sytab[86], /* asFraction */
&x_sytab[87], /* asInteger */
&x_sytab[88], /* asList */
&x_sytab[89], /* asLowercase */
&x_sytab[90], /* asOrderedCollection */
&x_sytab[91], /* asSet */
&x_sytab[92], /* asString */
&x_sytab[93], /* asSymbol */
&x_sytab[94], /* asUppercase */
&x_sytab[95], /* asciiValue */
&x_sytab[96], /* at: */
&x_sytab[97], /* at:ifAbsent: */
&x_sytab[98], /* at:put: */
&x_sytab[99], /* atAll:put: */
&x_sytab[100], /* atAllPut: */
&x_sytab[101], /* before: */
&x_sytab[102], /* between:and: */
&x_sytab[103], /* binaryDo: */
&x_sytab[104], /* bitAnd: */
&x_sytab[105], /* bitAt: */
&x_sytab[106], /* bitInvert */
&x_sytab[107], /* bitOr: */
&x_sytab[108], /* bitShift: */
&x_sytab[109], /* bitXor: */
&x_sytab[110], /* block */
&x_sytab[111], /* blockedProcessQueue */
&x_sytab[112], /* ceiling */
&x_sytab[113], /* checkBucket: */
&x_sytab[114], /* class */
&x_sytab[115], /* cleanUp */
&x_sytab[116], /* coerce: */
&x_sytab[117], /* collect: */
&x_sytab[118], /* commands: */
&x_sytab[119], /* compareError */
&x_sytab[120], /* copy */
&x_sytab[121], /* copyArguments: */
&x_sytab[122], /* copyArguments:to: */
&x_sytab[123], /* copyFrom: */
&x_sytab[124], /* copyFrom:length: */
&x_sytab[125], /* copyFrom:to: */
&x_sytab[126], /* copyWith: */
&x_sytab[127], /* copyWithout: */
&x_sytab[128], /* cos */
&x_sytab[129], /* count */
&x_sytab[130], /* currAssoc */
&x_sytab[131], /* currBucket */
&x_sytab[132], /* current */
&x_sytab[133], /* currentBucket */
&x_sytab[134], /* currentKey */
&x_sytab[135], /* currentList */
&x_sytab[136], /* date */
&x_sytab[137], /* debug: */
&x_sytab[138], /* deepCopy */
&x_sytab[139], /* deepCopy: */
&x_sytab[140], /* detect: */
&x_sytab[141], /* detect:ifAbsent: */
&x_sytab[142], /* detect:ifNone: */
&x_sytab[143], /* dict */
&x_sytab[144], /* dictionary */
&x_sytab[145], /* digitValue */
&x_sytab[146], /* digitValue: */
&x_sytab[147], /* display */
&x_sytab[148], /* displayAssign */
&x_sytab[149], /* dist: */
&x_sytab[150], /* do: */
&x_sytab[151], /* doPrimitive: */
&x_sytab[152], /* doPrimitive:withArguments: */
&x_sytab[153], /* edit */
&x_sytab[154], /* equals:startingAt: */
&x_sytab[155], /* eqv: */
&x_sytab[156], /* error: */
&x_sytab[157], /* even */
&x_sytab[158], /* excessSignals */
&x_sytab[159], /* executeWith: */
&x_sytab[160], /* exp */
&x_sytab[161], /* factorial */
&x_sytab[162], /* findAssociation:inList: */
&x_sytab[163], /* findFirst: */
&x_sytab[164], /* findFirst:ifAbsent: */
&x_sytab[165], /* findLast */
&x_sytab[166], /* findLast: */
&x_sytab[167], /* findLast:ifAbsent: */
&x_sytab[168], /* first */
&x_sytab[169], /* firstKey */
&x_sytab[170], /* floor */
&x_sytab[171], /* floorLog: */
&x_sytab[172], /* fork */
&x_sytab[173], /* forkWith: */
&x_sytab[174], /* fractionPart */
&x_sytab[175], /* free: */
&x_sytab[176], /* from: */
&x_sytab[177], /* from:to: */
&x_sytab[178], /* from:to:by: */
&x_sytab[179], /* gamma */
&x_sytab[180], /* gcd: */
&x_sytab[181], /* getList: */
&x_sytab[182], /* grid: */
&x_sytab[183], /* hashNumber: */
&x_sytab[184], /* hashTab */
&x_sytab[185], /* hashTable */
&x_sytab[186], /* highBit */
&x_sytab[187], /* i */
&x_sytab[188], /* ifFalse: */
&x_sytab[189], /* ifFalse:ifTrue: */
&x_sytab[190], /* ifTrue: */
&x_sytab[191], /* ifTrue:ifFalse: */
&x_sytab[192], /* inRange: */
&x_sytab[193], /* includes: */
&x_sytab[194], /* includesKey: */
&x_sytab[195], /* indexOf: */
&x_sytab[196], /* indexOf:ifAbsent: */
&x_sytab[197], /* indexOfSubCollection:startingAt: */
&x_sytab[198], /* indexOfSubCollection:startingAt:ifAbsent: */
&x_sytab[199], /* init: */
&x_sytab[200], /* init:super: */
&x_sytab[201], /* init:super:numVars: */
&x_sytab[202], /* inject:into: */
&x_sytab[203], /* integerPart */
&x_sytab[204], /* isAlphaNumeric */
&x_sytab[205], /* isDigit */
&x_sytab[206], /* isEmpty */
&x_sytab[207], /* isKindOf: */
&x_sytab[208], /* isLetter */
&x_sytab[209], /* isLowercase */
&x_sytab[210], /* isMemberOf: */
&x_sytab[211], /* isNil */
&x_sytab[212], /* isSeparator */
&x_sytab[213], /* isUppercase */
&x_sytab[214], /* isVowel */
&x_sytab[215], /* keys */
&x_sytab[216], /* keysDo: */
&x_sytab[217], /* keysSelect: */
&x_sytab[218], /* last */
&x_sytab[219], /* lastKey */
&x_sytab[220], /* lcm: */
&x_sytab[221], /* list */
&x_sytab[222], /* ln */
&x_sytab[223], /* log: */
&x_sytab[224], /* lower */
&x_sytab[225], /* main */
&x_sytab[226], /* max: */
&x_sytab[227], /* maxContext: */
&x_sytab[228], /* maxtype: */
&x_sytab[229], /* methods: */
&x_sytab[230], /* min: */
&x_sytab[231], /* modeCharacter */
&x_sytab[232], /* modeInteger */
&x_sytab[233], /* modeString */
&x_sytab[234], /* name: */
&x_sytab[235], /* negated */
&x_sytab[236], /* negative */
&x_sytab[237], /* new */
&x_sytab[238], /* new: */
&x_sytab[239], /* newProcess */
&x_sytab[240], /* newProcessWith: */
&x_sytab[241], /* next */
&x_sytab[242], /* next: */
&x_sytab[243], /* noDisplay */
&x_sytab[244], /* noMask: */
&x_sytab[245], /* not */
&x_sytab[246], /* notNil */
&x_sytab[247], /* nothing */
&x_sytab[248], /* occurrencesOf: */
&x_sytab[249], /* odd */
&x_sytab[250], /* opError */
&x_sytab[251], /* open: */
&x_sytab[252], /* open:for: */
&x_sytab[253], /* or: */
&x_sytab[254], /* perform: */
&x_sytab[255], /* perform:withArguments: */
&x_sytab[256], /* pi */
&x_sytab[257], /* positive */
&x_sytab[258], /* print */
&x_sytab[259], /* printString */
&x_sytab[260], /* put: */
&x_sytab[261], /* quo: */
&x_sytab[262], /* radians */
&x_sytab[263], /* radix: */
&x_sytab[264], /* raisedTo: */
&x_sytab[265], /* raisedToInteger: */
&x_sytab[266], /* randInteger: */
&x_sytab[267], /* randomize */
&x_sytab[268], /* read */
&x_sytab[269], /* reciprocal */
&x_sytab[270], /* reject: */
&x_sytab[271], /* rem: */
&x_sytab[272], /* remove: */
&x_sytab[273], /* remove:ifAbsent: */
&x_sytab[274], /* removeAll: */
&x_sytab[275], /* removeError */
&x_sytab[276], /* removeFirst */
&x_sytab[277], /* removeKey: */
&x_sytab[278], /* removeKey:ifAbsent: */
&x_sytab[279], /* removeLast */
&x_sytab[280], /* removed */
&x_sytab[281], /* replaceFrom:to:with: */
&x_sytab[282], /* replaceFrom:to:with:startingAt: */
&x_sytab[283], /* respondsTo */
&x_sytab[284], /* respondsTo: */
&x_sytab[285], /* resume */
&x_sytab[286], /* reverseDo: */
&x_sytab[287], /* reversed */
&x_sytab[288], /* roundTo: */
&x_sytab[289], /* rounded */
&x_sytab[290], /* sameAs: */
&x_sytab[291], /* seed */
&x_sytab[292], /* select: */
&x_sytab[293], /* setCurrentLocation: */
&x_sytab[294], /* sh: */
&x_sytab[295], /* shallowCopy */
&x_sytab[296], /* shallowCopy: */
&x_sytab[297], /* sign */
&x_sytab[298], /* signal */
&x_sytab[299], /* sin */
&x_sytab[300], /* size */
&x_sytab[301], /* smalltalk */
&x_sytab[302], /* sort */
&x_sytab[303], /* sort: */
&x_sytab[304], /* sqrt */
&x_sytab[305], /* squared */
&x_sytab[306], /* state */
&x_sytab[307], /* step */
&x_sytab[308], /* strictlyPositive */
&x_sytab[309], /* superClass */
&x_sytab[310], /* superClass: */
&x_sytab[311], /* suspend */
&x_sytab[312], /* tan */
&x_sytab[313], /* temp */
&x_sytab[314], /* termErr: */
&x_sytab[315], /* terminate */
&x_sytab[316], /* time: */
&x_sytab[317], /* timesRepeat: */
&x_sytab[318], /* to: */
&x_sytab[319], /* to:by: */
&x_sytab[320], /* transpose */
&x_sytab[321], /* truncateTo: */
&x_sytab[322], /* truncated */
&x_sytab[323], /* truncatedGrid: */
&x_sytab[324], /* unblock */
&x_sytab[325], /* upper */
&x_sytab[326], /* value */
&x_sytab[327], /* value: */
&x_sytab[328], /* value:value: */
&x_sytab[329], /* value:value:value: */
&x_sytab[330], /* value:value:value:value: */
&x_sytab[331], /* value:value:value:value:value: */
&x_sytab[332], /* values */
&x_sytab[333], /* variables */
&x_sytab[334], /* variables: */
&x_sytab[335], /* view */
&x_sytab[336], /* wait */
&x_sytab[337], /* whileFalse: */
&x_sytab[338], /* whileTrue: */
&x_sytab[339], /* with:do: */
&x_sytab[340], /* withArguments: */
&x_sytab[341], /* write: */
&x_sytab[342], /* x */
&x_sytab[343], /* x: */
&x_sytab[344], /* xor: */
&x_sytab[345], /* xvalue */
&x_sytab[346], /* y */
&x_sytab[347], /* y: */
&x_sytab[348], /* yield */
&x_sytab[349], /* yvalue */
&x_sytab[350], /* | */
&x_sytab[351], /* ~ */
&x_sytab[352], /* ~= */
&x_sytab[353], /* ~~ */
0};
int x_tmax = 353;
SHAR_EOF
if test 51259 -ne "`wc -c < 'syms.c'`"
then
echo shar: error transmitting "'syms.c'" '(should have been 51259 characters)'
fi
fi # end of overwriting check
if test -f 'cldict.c'
then
echo shar: will not over-write existing file "'cldict.c'"
else
cat << \SHAR_EOF > 'cldict.c'
/*
Little Smalltalk
Internal class dictionary
timothy a. budd, 10/84
In order to facilitate lookup, classes are kept in an internal data
dictionary. Classes are inserted into this dictionary using a
primtitive, and are removed by either being overridden, or being
flushed at the end of execution.
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include "object.h"
# include "number.h"
# include "symbol.h"
# include "primitive.h"
struct class_entry { /* structure for internal dictionary */
char *cl_name;
object *cl_description;
struct class_entry *cl_link;
};
static struct class_entry *class_dictionary = 0;
int ca_cdict = 0;
static mstruct *fr_cdict = 0; /* class dictionary free list */
# define CDICTINIT 30
static struct class_entry cdsinit[CDICTINIT];
/* cdic_init - initialize the internal class dictionary */
cdic_init() {
struct class_entry *p;
mstruct *new;
int i;
for (p = cdsinit, i = 0; i < CDICTINIT; i++, p++) {
new = (mstruct *) p;
new->mlink = fr_cdict;
fr_cdict = new;
}
}
/* enter_class - enter a class into the internal class dictionary */
enter_class(name, description)
char *name;
object *description;
{ struct class_entry *p;
for (p = class_dictionary; p; p = p->cl_link)
if (strcmp(name, p->cl_name) == 0) {
assign(p->cl_description, description);
return;
}
/* not found, make a new entry */
if (fr_cdict) {
p = (struct class_entry *) fr_cdict;
fr_cdict = fr_cdict->mlink;
}
else {
p = structalloc(struct class_entry);
ca_cdict++;
}
p->cl_name = name;
sassign(p->cl_description, description);
p->cl_link = class_dictionary;
class_dictionary = p;
}
/* lookup - take a name and find the associated class object */
object *lookup_class(name)
char *name;
{ struct class_entry *p;
for (p = class_dictionary; p; p = p->cl_link)
if (strcmp(name, p->cl_name) == 0)
return(p->cl_description);
return((object *) 0);
}
/* free_all_classes - flush all references for the class dictionary */
free_all_classes()
{ struct class_entry *p;
for (p = class_dictionary; p; p = p->cl_link) {
obj_dec(p->cl_description);
}
}
/* class_list - list all the subclasses of a class (recursively),
indenting by a specified number of tab stops */
class_list(c, n)
class *c;
int n;
{ struct class_entry *p;
object *prs[2];
class *q;
char *name;
/* first print out this class name */
if (! is_symbol(c->class_name))
return;
sassign(prs[0], c->class_name);
name = symbol_value(c->class_name);
sassign(prs[1], new_int(n));
primitive(SYMPRINT, 2, prs);
obj_dec(prs[0]);
obj_dec(prs[1]);
/* now find all subclasses and print them out */
for (p = class_dictionary; p; p = p->cl_link) {
q = (class *) p->cl_description;
if ((is_symbol(q->super_class)) &&
(strcmp(name, symbol_value(q->super_class)) == 0) )
class_list(q, n+1);
}
}
SHAR_EOF
if test 3326 -ne "`wc -c < 'cldict.c'`"
then
echo shar: error transmitting "'cldict.c'" '(should have been 3326 characters)'
fi
fi # end of overwriting check
if test -f 'process.c'
then
echo shar: will not over-write existing file "'process.c'"
else
cat << \SHAR_EOF > 'process.c'
/*
Little Smalltalk
process manager
dennis a. vadner and michael t. benhase, 11/84
modified by timothy a. budd 4/85
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include <signal.h>
# include <setjmp.h>
# include "drive.h"
# include "object.h"
# include "interp.h"
# include "process.h"
extern int test_driver(); /* routine to test for user keystrokes*/
static process *currentProcess; /* current process */
static process *fr_process = 0; /* process memory free list */
int atomcnt = 0; /* atomic action flag */
process *runningProcess; /* currently running process,
may be different from
currentProcess during process
termination */
# define PROCINITMAX 6
static process prcinit[PROCINITMAX]; /* initial process free list */
/* init_process - initialize the process module */
init_process ()
{ process *p;
int i;
/* first make the initial process free list */
for (p = prcinit, i = 0; i < PROCINITMAX; i++, p++) {
p->next = fr_process;
fr_process = p;
}
/* make the process associated with the driver */
currentProcess = cr_process(o_drive);
assign(currentProcess->next, currentProcess);
assign(currentProcess->prev, currentProcess);
currentProcess->p_state = ACTIVE;
}
/* cr_process - create a new process with the given interpreter */
process *cr_process (anInterpreter)
interpreter *anInterpreter;
{ process *new;
if (fr_process) {
new = (process *) fr_process;
fr_process = fr_process->next;
}
else
new = structalloc(process);
new->p_ref_count = 0;
new->p_size = PROCSIZE;
sassign(new->interp, anInterpreter);
new->p_state = SUSPENDED;
sassign(new->next, (process *) o_nil);
sassign(new->prev, (process *) o_nil);
return(new);
}
/* free_process - return an unused process to free list */
free_process (aProcess)
process *aProcess;
{
obj_dec((object *) aProcess->interp);
obj_dec((object *) aProcess->next);
obj_dec((object *) aProcess->prev);
aProcess->p_state = TERMINATED;
aProcess->next = fr_process;
fr_process = aProcess;
}
/* flush_processes - flush out any remaining process from queue */
flush_processes ()
{
while (currentProcess != currentProcess->next)
remove_process(currentProcess);
/* prev link and next link should point to the same place now.
In order to avoid having memory recovered while we are
manipulating pointers, we increment reference count, then change
pointers, then decrement reference counts */
obj_inc((object *) currentProcess);
safeassign(currentProcess->prev, (process *) o_nil);
safeassign(currentProcess->next, (process *) o_nil);
obj_dec((object *) currentProcess);
}
/* link_to_process - change the interpreter for the current process */
link_to_process (anInterpreter)
interpreter *anInterpreter;
{ object *temp;
safeassign(runningProcess->interp, anInterpreter);
}
/* remove_process - remove a process from process queue */
static remove_process (aProcess)
process *aProcess;
{
if (aProcess == aProcess->next)
cant_happen(15); /* removing last active process */
/* currentProcess must always point to a process that is on the
process queue, make sure this remains true */
if (aProcess == currentProcess)
currentProcess = currentProcess->prev;
/* In order to avoid having memory recovered while we are changing
pointers, we increment the reference counts on both processes,
change pointers, then decrement reference counts */
obj_inc((object *) currentProcess); obj_inc((object *) aProcess);
safeassign(aProcess->next->prev, aProcess->prev);
safeassign(aProcess->prev->next, aProcess->next);
obj_dec((object *) currentProcess); obj_dec((object *) aProcess);
}
/* schedule_process - add a new process to the process queue */
static schedule_process (aProcess)
process *aProcess;
{
safeassign(aProcess->next, currentProcess);
safeassign(aProcess->prev, currentProcess->prev);
safeassign(aProcess->prev->next, aProcess);
safeassign(currentProcess->prev, aProcess);
}
/* set_state - set the state on a process, which may involve inserting or
removing it from the process queue */
int set_state (aProcess, state)
process *aProcess;
int state;
{
switch (state) {
case BLOCKED:
case SUSPENDED:
case TERMINATED: if (aProcess->p_state == ACTIVE)
remove_process(aProcess);
aProcess->p_state |= state;
break;
case READY:
case UNBLOCKED: if ((aProcess->p_state ^ state) == ~ACTIVE)
schedule_process(aProcess);
aProcess->p_state &= state;
break;
case CUR_STATE: break;
default: cant_happen(17);
}
return(aProcess->p_state);
}
# ifdef SETJUMP
static jmp_buf intenv;
# endif
/* brkfun - what to do on a break key */
brkfun()
{ static int warn = 1;
# ifndef SETJUMP
exit(1);
# endif
if (warn) {
fprintf(stderr,"warning: recovery from interrupt may cause\n");
fprintf(stderr,"reference counts to be incorrect, and\n");
fprintf(stderr,"some memory to be inaccessible\n");
warn = 0;
}
# ifdef SETJUMP
longjmp(intenv, 1);
# endif
}
/* start_execution - main execution loop */
start_execution ()
{ interpreter *presentInterpreter;
atomcnt = 0;
# ifdef SIGS
/* trap user interrupt signals and recover */
signal(SIGINT, brkfun);
# endif
# ifdef SETJUMP
if (setjmp(intenv)) {
atomcnt = 0;
link_to_process(o_drive);
}
# endif
while (1) {
/* unless it is an atomic action get the next process */
if (! atomcnt)
runningProcess = currentProcess = currentProcess->next;
if (! is_driver(runningProcess->interp)) {
sassign(presentInterpreter, runningProcess->interp);
resume(presentInterpreter);
obj_dec((object *) presentInterpreter);
}
else if (! test_driver((currentProcess == currentProcess->next) ||
(atomcnt > 0)))
break;
}
}
SHAR_EOF
if test 6273 -ne "`wc -c < 'process.c'`"
then
echo shar: error transmitting "'process.c'" '(should have been 6273 characters)'
fi
fi # end of overwriting check
if test -f 'interp.c'
then
echo shar: will not over-write existing file "'interp.c'"
else
cat << \SHAR_EOF > 'interp.c'
/*
Little Smalltalk
bytecode interpreter
timothy a. budd
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include "object.h"
# include "drive.h"
# include "cmds.h"
# include "interp.h"
# include "process.h"
# include "number.h"
# include "string.h"
# include "symbol.h"
# include "byte.h"
# include "block.h"
# include "primitive.h"
extern object *o_smalltalk; /* value of pseudo variable smalltalk */
extern object *fnd_class(); /* used to find classes from names */
static mstruct *fr_interp = 0; /* interpreter memory free list */
int ca_terp = 0; /* counter for interpreter allocations */
/* cr_interpreter - create a new interpreter */
interpreter *cr_interpreter(sender, receiver, literals, bitearray, context)
interpreter *sender;
object *literals, *bitearray, *receiver, *context;
{ interpreter *new;
class *rclass;
int isize;
if (fr_interp) {
new = (interpreter *) fr_interp;
fr_interp = fr_interp->mlink;
}
else {
new = structalloc(interpreter);
ca_terp++;
}
new->t_ref_count = 0;
new->t_size = INTERPSIZE;
new->creator = (interpreter *) 0;
if (sender)
sassign(new->sender, sender);
else
sassign(new->sender, (interpreter *) o_nil);
sassign(new->literals, literals);
sassign(new->bytecodes, bitearray);
sassign(new->receiver, receiver);
rclass = (class *) fnd_class(receiver);
if ((! rclass) || ! is_class(rclass))
isize = 25;
else {
isize = rclass->stack_max;
}
sassign(new->context, context);
sassign(new->stack, new_obj((class *) 0, isize, 1));
new->stacktop = &(new->stack)->inst_var[0];
new->currentbyte = byte_value(new->bytecodes);
return(new);
}
/* free_terpreter - return an unused interpreter to free list */
free_terpreter(anInterpreter)
interpreter *anInterpreter;
{
if (! is_interpreter(anInterpreter))
cant_happen(8);
obj_dec((object *) anInterpreter->sender);
obj_dec(anInterpreter->receiver);
obj_dec(anInterpreter->bytecodes);
obj_dec(anInterpreter->literals);
obj_dec(anInterpreter->context);
obj_dec(anInterpreter->stack);
((mstruct *) anInterpreter)->mlink = fr_interp;
fr_interp = (mstruct *) anInterpreter;
}
/* copy_arguments - copy an array of arguments into the context */
copy_arguments(anInterpreter, argLocation, argCount, argArray)
interpreter *anInterpreter;
int argLocation, argCount;
object **argArray;
{ object *context = anInterpreter->context;
int i;
for (i = 0; i < argCount; argLocation++, i++) {
assign(context->inst_var[ argLocation ], argArray[i]);
}
}
# define push(x) {assign(*(anInterpreter->stacktop), x); \
anInterpreter->stacktop++;}
/* push_object - push a returned value on to an interpreter stack */
push_object(anInterpreter, anObject)
interpreter *anInterpreter;
object *anObject;
{
push(anObject); /* what? no bounds checking?!? */
}
# define nextbyte(x) {x = uctoi(*anInterpreter->currentbyte);\
anInterpreter->currentbyte++;}
# define instvar(x) (anInterpreter->receiver)->inst_var[ x ]
# define tempvar(x) (anInterpreter->context)->inst_var[ x ]
# define lit(x) (anInterpreter->literals)->inst_var[ x ]
# define popstack() (*(--anInterpreter->stacktop))
# define decstack(x) (anInterpreter->stacktop -= x)
# define skip(x) (anInterpreter->currentbyte += x )
/* resume - resume executing bytecodes associated with an interpreter */
resume(anInterpreter)
register interpreter *anInterpreter;
{
int highBits;
register int lowBits;
object *tempobj, *receiver, *fnd_super();
interpreter *sender;
int i, j, numargs, arglocation;
char *message;
while(1) {
nextbyte(highBits);
lowBits = highBits % 16;
highBits /= 16;
switchtop:
switch(highBits) {
default: cant_happen(9);
break;
case 0: /* two bit form */
highBits = lowBits;
nextbyte(lowBits);
goto switchtop;
case 1: /* push instance variable */
push(instvar(lowBits));
break;
case 2: /* push context value */
push(tempvar(lowBits));
break;
case 3: /* literals */
push(lit(lowBits));
break;
case 4: /* push class */
tempobj = lit(lowBits);
if (! is_symbol(tempobj)) cant_happen(9);
tempobj = primitive(FINDCLASS, 1, &tempobj);
push(tempobj);
break;
case 5: /* special literals */
if (lowBits < 10)
tempobj = new_int(lowBits);
else if (lowBits == 10)
tempobj = new_int(-1);
else if (lowBits == 11)
tempobj = o_true;
else if (lowBits == 12)
tempobj = o_false;
else if (lowBits == 13)
tempobj = o_nil;
else if (lowBits == 14)
tempobj = o_smalltalk;
else if (lowBits == 15)
tempobj = (object *) runningProcess;
else if ((lowBits >= 30) && (lowBits < 60)) {
/* get class */
tempobj =
new_sym(classpecial[lowBits-30]);
tempobj = primitive(FINDCLASS, 1,
&tempobj);
}
else tempobj = new_int(lowBits);
push(tempobj);
break;
case 6: /* pop and store instance variable */
assign(instvar(lowBits), popstack());
break;
case 7: /* pop and store in context */
assign(tempvar(lowBits), popstack());
break;
case 8: /* send a message */
numargs = lowBits;
nextbyte(i);
tempobj = lit(i);
if (! is_symbol(tempobj)) cant_happen(9);
message = symbol_value(tempobj);
goto do_send;
case 9: /* send a superclass message */
numargs = lowBits;
nextbyte(i);
tempobj = lit(i);
if (! is_symbol(tempobj)) cant_happen(9);
message = symbol_value(tempobj);
receiver =
fnd_super(anInterpreter->receiver);
goto do_send2;
case 10: /* send a special unary message */
numargs = 0;
message = unspecial[lowBits];
goto do_send;
case 11: /* send a special binary message */
numargs = 1;
message = binspecial[lowBits];
goto do_send;
case 12: /* send a special arithmetic message */
tempobj = *(anInterpreter->stacktop - 2);
if (! is_integer(tempobj)) goto ohwell;
i = int_value(tempobj);
tempobj = *(anInterpreter->stacktop - 1);
if (! is_integer(tempobj)) goto ohwell;
j = int_value(tempobj);
decstack(2);
switch(lowBits) {
case 0: i += j; break;
case 1: i -= j; break;
case 2: i *= j; break;
case 3: if (i < 0) i = -i;
i %= j; break;
case 4: if (j < 0) i >>= (-j);
else i <<= j; break;
case 5: i &= j; break;
case 6: i |= j; break;
case 7: i = (i < j); break;
case 8: i = (i <= j); break;
case 9: i = (i == j); break;
case 10: i = (i != j); break;
case 11: i = (i >= j); break;
case 12: i = (i > j); break;
case 13: i %= j; break;
case 14: i /= j; break;
case 15: i = (i < j) ? i : j;
break;
case 16: i = (i < j) ? j : i;
break;
default: cant_happen(9);
}
if ((lowBits < 7) || (lowBits > 12))
tempobj = new_int(i);
else tempobj = (i ? o_true : o_false);
push(tempobj);
break;
ohwell: /* oh well, send message */
numargs = 1;
message = arithspecial[lowBits];
goto do_send;
case 13: /* send a special ternary keyword messae */
numargs = 2;
message = keyspecial[lowBits];
goto do_send;
case 14: /* block creation */
numargs = lowBits;
if (numargs)
nextbyte(arglocation);
nextbyte(i); /* size of block */
push(new_block(anInterpreter, numargs,
arglocation));
skip(i);
break;
case 15: /* special bytecodes */
switch(lowBits) {
case 0: /* no - op */
break;
case 1: /* duplicate top of stack */
push(*(anInterpreter->stacktop - 1));
break;
case 2: /* pop top of stack */
anInterpreter->stacktop--;
break;
case 3: /* return top of stack */
tempobj = popstack();
goto do_return;
case 4: /* block return */
block_return(anInterpreter, popstack());
return;
case 5: /* self return */
tempobj = tempvar(0);
goto do_return;
case 6: /* skip on true */
nextbyte(i);
tempobj = popstack();
if (tempobj == o_true) {
skip(i);
push(o_nil);
}
break;
case 7: /* skip on false */
nextbyte(i);
tempobj = popstack();
if (tempobj == o_false) {
skip(i);
push(o_nil);
}
break;
case 8: /* just skip */
nextbyte(i);
skip(i);
break;
case 9: /* skip backward */
nextbyte(i);
skip( - i );
break;
case 10: /* execute a primitive */
nextbyte(numargs);
nextbyte(i); /* primitive number */
if (i == BLOCKEXECUTE)
goto blk_execute;
else if (i == DOPERFORM)
goto do_perform;
else {
decstack(numargs);
tempobj = primitive(i, numargs,
anInterpreter->stacktop);
push(tempobj);
}
break;
case 11: /* skip true, push true */
nextbyte(i);
tempobj = popstack();
if (tempobj == o_true) {
skip(i);
anInterpreter->stacktop++;
}
break;
case 12: /* skip on false, push false */
nextbyte(i);
tempobj = popstack();
if (tempobj == o_false) {
skip(i);
anInterpreter->stacktop++;
}
break;
default:
cant_happen(9);
}
break;
}
}
/* sorry for the unstructured gotos.
the sins of unstructuredness seemed less bothersome than
the problems of not doing the same thing in all places
-tab
*/
do_perform: /* process perform:withArguments: */
tempobj = popstack();
message = symbol_value(tempobj);
tempobj = popstack();
numargs = tempobj->size - 1;
for (i = 0; i <= numargs; i++)
push(tempobj->inst_var[i]);
/* fall through into do_send */
/* do_send - call courier to send a message */
do_send:
receiver = *(anInterpreter->stacktop - (numargs + 1));
do_send2:
decstack(numargs + 1);
send_mess(anInterpreter, receiver, message,
anInterpreter->stacktop , numargs);
return;
/* do_return - return from a message */
do_return:
sender = anInterpreter->sender;
if (is_interpreter(sender)) {
if (! is_driver(sender))
push_object(sender, tempobj);
link_to_process(sender);
}
else {
terminate_process(runningProcess);
}
return;
/* blk_execute - perform the block execute primitive */
blk_execute:
tempobj = popstack();
if (! is_integer(tempobj)) cant_happen(9);
numargs = int_value(tempobj);
sender = block_execute(anInterpreter->sender,
(block *) tempvar(0), numargs, &tempvar(1));
link_to_process(sender);
return;
}
SHAR_EOF
if test 10870 -ne "`wc -c < 'interp.c'`"
then
echo shar: error transmitting "'interp.c'" '(should have been 10870 characters)'
fi
fi # end of overwriting check
if test -f 'block.c'
then
echo shar: will not over-write existing file "'block.c'"
else
cat << \SHAR_EOF > 'block.c'
/*
Little Smalltalk
block creation and block return
timothy a. budd, 10/84
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include "object.h"
# include "drive.h"
# include "interp.h"
# include "block.h"
# include "string.h"
# include "primitive.h"
# include "process.h"
extern object *o_object; /* value of generic object */
static mstruct *fr_block = 0; /* free list of unused blocks */
int ca_block = 0; /* count block allocations */
/* cpyInterpreter - make a new copy of an existing interpreter */
static interpreter *cpyInterpreter(anInterpreter)
interpreter *anInterpreter;
{ interpreter *new;
new = cr_interpreter((interpreter *) 0,
anInterpreter->receiver,
anInterpreter->literals,
anInterpreter->bytecodes,
anInterpreter->context);
if (anInterpreter->creator)
new->creator = anInterpreter->creator;
else
new->creator = anInterpreter;
new->currentbyte = anInterpreter->currentbyte;
return(new);
}
/* new_block - create a new instance of class Block */
object *new_block(anInterpreter, argcount, arglocation)
interpreter *anInterpreter;
int argcount, arglocation;
{ block *new;
if (fr_block) {
new = (block *) fr_block;
fr_block = fr_block->mlink;
}
else {
new = structalloc(block);
ca_block++;
}
new->b_ref_count = 0;
new->b_size = BLOCKSIZE;
sassign(new->b_interpreter, cpyInterpreter(anInterpreter));
new->b_numargs = argcount;
new->b_arglocation = arglocation;
return((object *) new);
}
/* free_block - return an unused block to the block free list */
free_block(b)
block *b;
{
if (! is_block(b))
cant_happen(8);
obj_dec((object *)(b->b_interpreter));
((mstruct *) b)->mlink = fr_block;
fr_block = (mstruct *) b;
}
/* block_execute - queue a block interpreter for execution */
interpreter *block_execute(sender, aBlock, numargs, args)
interpreter *sender;
block *aBlock;
int numargs;
object **args;
{ interpreter *newInt;
object *tempobj;
if (! is_block(aBlock)) cant_happen(11);
if (numargs != aBlock->b_numargs) {
sassign(tempobj,
new_str("wrong number of arguments for block"));
primitive(ERRPRINT, 1, &tempobj);
obj_dec(tempobj);
if (sender) {
push_object(sender, o_nil);
}
return(sender); /* not sure about this ..... */
}
/* we copy the interpreter so as to not destroy the original and to
avoid memory pointer cycles */
newInt = cpyInterpreter(aBlock->b_interpreter);
if (sender)
assign(newInt->sender, sender);
if (numargs)
copy_arguments(newInt, aBlock->b_arglocation,
numargs, args);
return(newInt);
}
/* block_return - return an object from the context in which a block was
created */
block_return(blockInterpreter, anObject)
interpreter *blockInterpreter;
object *anObject;
{ interpreter *backchain, *parent;
interpreter *creatorblock;
creatorblock = blockInterpreter->creator;
for (backchain = blockInterpreter->sender; backchain;
backchain = backchain->sender) {
if (! is_interpreter(backchain)) break;
if (backchain == creatorblock) {
/* found creating context, back up one more */
parent = backchain->sender;
if (parent) {
if (! is_driver(parent))
push_object(parent, anObject);
link_to_process(parent);
}
else {
terminate_process(runningProcess);
}
return;
}
}
/* no block found, issue error message */
primitive(BLKRETERROR, 1, (object **) &blockInterpreter);
parent = blockInterpreter->sender;
if (parent) {
if (! is_driver(parent))
push_object(parent, anObject);
link_to_process(parent);
}
else {
terminate_process(runningProcess);
}
}
SHAR_EOF
if test 4045 -ne "`wc -c < 'block.c'`"
then
echo shar: error transmitting "'block.c'" '(should have been 4045 characters)'
fi
fi # end of overwriting check
if test -f 'courier.c'
then
echo shar: will not over-write existing file "'courier.c'"
else
cat << \SHAR_EOF > 'courier.c'
/*
Little Smalltalk
courier - message passing interface
timothy a. budd 10/84
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include "object.h"
# include "interp.h"
# include "string.h"
# include "symbol.h"
# include "primitive.h"
# define streq(x,y) (strcmp(x,y) == 0)
/* send_mess - find the method needed to respond to a message, create the
proper context and interpreter for executing the method */
send_mess(sender, receiver, message, args, numargs)
interpreter *sender;
object *receiver, **args;
char *message;
int numargs;
{ object *robject, *method;
register object *message_array;
object *context, *fnd_super(), *fnd_class();
class *objclass;
interpreter *anInterpreter;
int i, maxc;
for (robject = receiver; robject; ) {
if (robject == (object *) 0) break;
if (is_bltin(robject))
objclass = (class *) fnd_class(robject);
else
objclass = robject->class;
if ((objclass == (class *) 0) || ! is_class(objclass)) break;
message_array = objclass->message_names;
for (i = 0; i < message_array->size; i++) {
if (symbol_value(message_array->inst_var[i]) ==
message) {
method = (objclass->methods)->inst_var[ i ];
goto do_cmd;
}
}
if (is_bltin(robject))
robject = fnd_super(robject);
else
robject = robject->super_obj;
}
/* if we reach this point then no method has been found matching message */
sassign(robject, new_obj((class *) 0, 2, 0));
sassign(robject->inst_var[0], receiver);
sassign(robject->inst_var[1], new_sym(message));
primitive(NORESPONDERROR, 2, &(robject->inst_var[0]));
obj_dec(robject);
/* generate a message passing trace */
backtrace(sender);
/* return nil by default */
if (is_interpreter(sender))
push_object(sender, o_nil);
link_to_process(sender);
goto clean_up;
/* do an interpreted method */
/* make a context and fill it in, make an interpeter and link it into
process queue */
do_cmd:
maxc = objclass->context_size;
sassign(context, new_obj((class *)0, maxc, 0));
for (i = 0; i <= numargs; i++)
sassign(context->inst_var[i], args[i]);
for ( ; i < maxc ; i++ )
sassign(context->inst_var[i], o_nil);
anInterpreter = cr_interpreter(sender, robject, method->inst_var[1],
method->inst_var[0], context);
link_to_process(anInterpreter);
obj_dec(context);
goto clean_up;
/* clean up after yourself */
clean_up:
return;
}
/* responds_to - see if a class responds to a message */
int responds_to(message, aClass)
char *message;
class *aClass;
{ object *message_names;
int i;
message_names = aClass->message_names;
for (i = 0; i < message_names->size; i++)
if (streq(symbol_value(message_names->inst_var[i]),
message))
return(1);
return(0);
}
/* backtrace - generate a backwards message passing trace */
static backtrace(current)
interpreter *current;
{
while (is_interpreter(current->sender) &&
! is_driver(current->sender)) {
fnd_message(current->receiver, current->bytecodes);
current = current->sender;
}
}
/* fnd_message - find the message associated with an interpreter */
static fnd_message(receiver, bytecodes)
object *receiver, *bytecodes;
{ int i;
class *oclass;
object *messar, *temp;
char buffer[100];
oclass = (class *) fnd_class(receiver);
messar = oclass->methods;
for (i = 0; i < messar->size; i++) {
if ((messar->inst_var[i])->inst_var[0] == bytecodes) {
sprintf(buffer,"%s: backtrace. message %s",
symbol_value(oclass->class_name),
symbol_value(
(oclass->message_names)->inst_var[i]));
sassign(temp, new_str(buffer));
primitive(ERRPRINT, 1, &temp);
obj_dec(temp);
return;
}
}
cant_happen(24);
}
/* prnt_messages - print all the messages a class responds to.
needed because the messages names array for some of the classes is
created before ArrayedCollection, and thus some do not respond to
do: */
prnt_messages(aClass)
class *aClass;
{ object *message_names;
int i;
message_names = aClass->message_names;
for (i = 0; i < message_names->size; i++)
primitive(SYMPRINT, 1, &message_names->inst_var[i]);
}
SHAR_EOF
if test 4517 -ne "`wc -c < 'courier.c'`"
then
echo shar: error transmitting "'courier.c'" '(should have been 4517 characters)'
fi
fi # end of overwriting check
if test -f 'lex.c'
then
echo shar: will not over-write existing file "'lex.c'"
else
cat << \SHAR_EOF > 'lex.c'
/*
Little Smalltalk lexical analyzer for driver
timothy a. budd 12/84
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include <ctype.h>
# include <math.h>
# define DRIVECODE
# include "drive.h"
# define MAXTOKEN 100
char toktext[MAXTOKEN];
tok_type t;
enum lextokens token;
extern char *lexptr;
extern double atof();
static char ocbuf = 0;
static int pbbuf[20];
# define input() (ocbuf ? pbbuf[--ocbuf] : *lexptr++ )
# define putbak(c) (pbbuf[ocbuf++] = c)
static char *psuvars[] = {"nil", "true", "false", "smalltalk", 0};
static enum pseuvars psuval[] = {nilvar, truevar, falsevar, smallvar};
static char symbols[] = "\n-()[]!|.;>" ;
static enum lextokens symval[] = {NL, MINUS, LP, RP, LB, RB, BAR, BAR,
PERIOD, SEMI, PE};
static enum lextokens lexsave(type)
enum lextokens type;
{ char *w_search();
if (! (t.c = w_search(toktext, 1)))
lexerr("cannot create symbol %s", toktext);
/* assign token, and return value */
return(token = type);
}
enum lextokens nextlex() {
register char c;
register char *p;
char *q;
int i, n, base;
double d, denom;
do { /* read whitespace (including comments) */
c = input();
if (c == '\"') {
while ((c = input()) && c != '\"') ;
if (c == '\"') c = input();
else lexerr("unterminated comment", "");
}
} while (c == ' ' || c == '\t') ;
if (!c) return(token = nothing);
p = toktext;
*p = c;
toktext[1] = '\0';
/* identifiers and keywords */
if (( c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')) {
for (*p++ = c; (c = input()) && isalnum(c) ; *p++ = c) ;
*p = '\0';
lexsave(0);
if (c == ':') {
return(token = KEYWORD);
}
else {
putbak(c);
if (islower(toktext[0])) {
for (i = 0; psuvars[i]; i++)
if (strcmp(toktext, psuvars[i]) == 0) {
t.p = psuval[i];
return(token = PSEUDO);
}
return(token = LOWERCASEVAR);
}
else {
return(token = UPPERCASEVAR);
}
}
}
# define scandigits(x) for(*p++ = c; (c = input()) && isdigit(c) ; *p++ = c) x
if (c >= '0' && c <= '9') { /* numbers */
i = c - '0';
scandigits( i = 10 * i + (c - '0') );
if (c == '.' || c == 'e') {
if (c == '.')
scandigits();
if (c == 'e') {
*p++ = c;
c = input();
if (c == '+' || c == '-') {
*p++ = c; c = input(); }
scandigits();
}
putbak(c);
*p = '\0';
t.f = atof(toktext);
return(token = LITFNUM);
}
else if ((c == 'r') && ((i >= 2) && (i <= 36))) {
base = i;
i = 0;
for (*p++ = c; c = input(); *p++ = c) {
if (isdigit(c)) n = c - '0';
else if (isupper(c)) n = (c - 'A') + 10;
else break;
if (n >= base) break;
i = base * i + n;
}
if (c == '.' || c == 'e') {
d = (double) i;
if (c == '.') {
denom = 1.0 / (double) base;
for (*p++ = c; c = input(); *p++ = c) {
if (isdigit(c))
n = c - '0';
else if (isupper(c))
n = (c - 'A') + 10;
else break;
if (n >= base) break;
d += n * denom;
denom /= base;
}
}
if (c == 'e') {
*p++ = c;
c = input();
if (c == '+' || c == '-') {
n = c;
*p++ = c;
c = input();
}
else n = 0;
i = c - '0';
scandigits(i = 10 * i + (c - '0'));
if (n == '-') i = - i;
d *= pow((double) base, (double) i);
}
putbak(c);
*p = '\0';
t.f = d;
return(token = LITFNUM);
}
}
putbak(c);
*p = '\0';
t.i = i;
return(token = LITNUM);
}
if (c == '#') { /* symbol */
i = 1;
while (i)
switch(c = input()) {
case '\0': case ' ': case '\t': case '\n':
case '(': case '[': case ')':
putbak(c);
i = 0;
break;
default:
*p++ = c;
}
if (p == toktext)
return(token = PS);
else {
*p = '\0';
if ((p - toktext) >= MAXTOKEN) cant_happen(18);
return(lexsave(LITSYM));
}
}
if (c == '\'') { /* quoted string */
do {
for ( ; (c = input()) && c != '\'' ; *p++ = c) ;
c = input();
if (c == '\'') *p++ = '\'';
} while (c == '\'');
putbak(c);
*p = '\0';
if ((p - toktext) >= MAXTOKEN) cant_happen(18);
t.c = toktext;
return(token = LITSTR);
}
if (c == ':') { /* colon or argument name */
c = input();
if (c == '=')
return(token = ASSIGN);
else if (isalnum(c)) {
for (*p++ = c; isalnum(c = input()); *p++ = c );
putbak(c);
*p = '\0';
return(lexsave(COLONVAR));
}
putbak(c);
return(lexsave(BINARY));
}
if (c == '<') { /* assign, less than or primitive */
*p++ = c; *p = '\0';
c = input();
if (c == '-')
return(token = ASSIGN);
for (p = q = "primitive"; *p && *p == c; p++)
c = input();
putbak(c);
if (*p) {
for (p--; p >= q; p--) putbak(*p);
return(lexsave(BINARY));
}
else
return(token = PRIMITIVE);
}
if (c == '.') { /* number or period */
c = input();
if (c >= '0' && c <= '9') {
putbak(c); /* reparse with digit */
putbak('.'); /* inserted on front */
putbak('0'); /* so it looks like */
return(nextlex()); /* a number */
}
putbak(c);
return(token = PERIOD);
}
if (c == '\\') { /* binary or hidden newline */
c = input();
if (c == '\n')
return(nextlex());
putbak(c);
return(lexsave(BINARY));
}
if (c == '$') { /* literal character or binary */
c = input();
if (c) {
t.i = c;
return(token = LITCHAR);
}
return(lexsave(BINARY));
}
for (i = 0; symbols[i]; i++)
if (c == symbols[i])
return(lexsave(symval[i]));
return(lexsave(BINARY));
}
SHAR_EOF
if test 5964 -ne "`wc -c < 'lex.c'`"
then
echo shar: error transmitting "'lex.c'" '(should have been 5964 characters)'
fi
fi # end of overwriting check
if test -f 'drive.c'
then
echo shar: will not over-write existing file "'drive.c'"
else
cat << \SHAR_EOF > 'drive.c'
/*
Little Smalltalk
command parser
timothy a. budd, 12/84
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include "object.h"
# define DRIVECODE
# include "drive.h"
# include "cmds.h"
# include "number.h"
# include "symbol.h"
# include "string.h"
# include "byte.h"
# include "interp.h"
# include "primitive.h"
extern enum lextokens token, nextlex();
extern int prntcmd;
extern int inisstd;
extern int started;
extern char toktext[];
extern char *lexptr;
extern int line_grabber();
extern tok_type t;
/* test_driver - see if the driver should be invoked */
int test_driver(block)
int block; /* indicates wheter to use block or non-blocking input */
{
switch(line_grabber( block )) {
default: cant_happen(17);
case -1:
/* return end of file indication */
return(0);
case 0:
/* enqueue driver process again */
return(1);
case 1:
if (*lexptr == ')') {
dolexcommand(lexptr);
return(1);
}
parse();
return(1);
}
}
/* ---- code generation routines -------------- */
# define CODEMAX 500
static uchar code[CODEMAX];
static int codetop = 0;
static gencode(value)
register int value;
{
if (value >= 256)
lexerr("code word too big: %d", value);
if (codetop > CODEMAX)
lexerr("too many code words: %d", codetop);
/*if (started)
fprintf(stderr,"code %d (%d %d)\n", value, value/16, value%16);*/
code[codetop++] = itouc(value);
}
static genhighlow(high, low)
register int high;
register int low;
{
if (high < 0 || high > 16)
lexerr("genhighlow error: %d", high);
if (low < 0)
lexerr("genhighlow low error: %d", low);
if (low < 16) gencode(high * 16 + low);
else {
gencode(TWOBIT * 16 + high);
gencode(low);
}
}
/*-------------------------------------------------------*/
static int errflag;
/* parse - main parser */
int parse()
{ register int i;
errflag = 0;
reset();
if (nextlex() == nothing) return(1);
if (token == NL) return(1);
i = aprimary();
if (i >= 0) {
asign(i);
if ((prntcmd > 1) && inisstd)
genhighlow(UNSEND, PRNTCMD);
}
else {
cexpression();
if (prntcmd && inisstd)
genhighlow(UNSEND, PRNTCMD);
}
genhighlow(POPINSTANCE, 0); /* assign to ``last'' */
if (errflag)
return(1);
if (token == nothing || token == NL) {
bld_interpreter();
return(0);
}
expect("end of expression");
return(1);
}
/* asign - code for an assignment statement - leaves result on stack */
static asign(pos)
int pos;
{ int i;
i = aprimary();
if (i >= 0) {
asign(i);
}
else {
cexpression();
}
genhighlow(SPECIAL, DUPSTACK);
genhighlow(POPINSTANCE, pos);
}
/* expression - read an expression, leaving result on stack */
static expression()
{ int i;
i = aprimary();
if (i >= 0) {
asign(i);
}
else {
cexpression();
}
}
/* cexpression - code for a (possibly cascaded) expression */
static cexpression()
{
kcontinuation();
while (token == SEMI) {
genhighlow(SPECIAL, DUPSTACK);
nextlex();
kcontinuation();
genhighlow(SPECIAL, POPSTACK);
}
}
/* kcontinuation - keyword continuation */
static kcontinuation()
{ char kbuf[150];
int kcount;
bcontinuation();
if (token == KEYWORD) {
kbuf[0] = '\0';
kcount = 0;
while (token == KEYWORD) {
strcat(kbuf, t.c);
strcat(kbuf, ":");
kcount++;
nextlex();
primary(1);
bcontinuation();
}
gensend(kbuf, kcount);
}
}
/* isbinary - see if the current token(s) is a binary */
static int isbinary(bbuf)
char *bbuf;
{
if (token == BINARY || token == MINUS ||
token == BAR || token == PE) {
strcpy(bbuf, t.c);
nextlex();
if (token == BINARY || token == MINUS ||
token == BAR || token == PE) {
strcat(bbuf, t.c);
nextlex();
}
return(1);
}
return(0);
}
/* bcontinuation - binary continuation */
static bcontinuation()
{ char bbuf[3];
ucontinuation();
while (isbinary(bbuf)) {
primary(1);
ucontinuation();
gensend(bbuf, 1);
}
}
/* ucontinuation - unary continuation */
static ucontinuation()
{
while (token == LOWERCASEVAR) {
gensend(t.c, 0);
nextlex();
}
}
/* aprimary - primary or beginning of assignment */
static int aprimary()
{ char *c;
if (token == LOWERCASEVAR) {
c = t.c;
if (nextlex() == ASSIGN) {
nextlex();
return(findvar(c, 1));
}
else {
genvar(c);
return( -1 );
}
}
primary(1);
return( - 1 );
}
/* primary - find a primary expression */
static int primary(must)
int must; /* must we find something ? */
{ int i, count;
switch(token) {
case UPPERCASEVAR:
genhighlow(PUSHCLASS, aliteral(1));
break;
case LOWERCASEVAR:
genvar(t.c);
nextlex();
break;
case LITNUM:
if (t.i >= 0 && t.i < 10) {
genhighlow(PUSHSPECIAL, t.i);
nextlex();
}
else {
genhighlow(PUSHLIT, aliteral(1));
}
break;
case MINUS:
case LITFNUM:
case LITCHAR:
case LITSTR:
case LITSYM:
case PS:
genhighlow(PUSHLIT, aliteral(1));
break;
case PSEUDO:
switch(t.p) {
case nilvar: i = 13; break;
case truevar: i = 11; break;
case falsevar: i = 12; break;
case smallvar: i = 14; break;
default: lexerr("unknown pseudo var %d", t.p);
}
genhighlow(PUSHSPECIAL, i);
nextlex();
break;
case PRIMITIVE:
if (nextlex() != LITNUM) expect("primitive number");
i = t.i;
nextlex();
count = 0;
while (primary(0)) count++;
if (token != PE) expect("primitive end");
nextlex();
genhighlow(SPECIAL, PRIMCMD);
gencode(count);
gencode(i);
break;
case LP:
nextlex();
expression();
if (token != RP) expect("right parenthesis");
nextlex();
break;
case LB:
nextlex();
block();
break;
default:
if (must) expect("primary expression");
return(0);
}
return(1);
}
static int maxtemps = 1;
static int temptop = 0;
static char *tempnames[20];
/* block - parse a block definition */
static block()
{ int count, i, position;
count = 0;
if (token == COLONVAR) {
while (token == COLONVAR) {
tempnames[temptop++] = t.c;
if (temptop > maxtemps) maxtemps = temptop;
count++;
nextlex();
}
if (token != BAR)
expect("bar following arguments in block");
nextlex();
}
genhighlow(BLOCKCREATE, count);
if (count) /* where arguments go in context */
gencode(1 + (temptop - count));
position = codetop;
gencode(0);
if (token == RB) {
genhighlow(PUSHSPECIAL, 13);
}
else
while (1) {
i = aprimary();
if (i >= 0) {
expression();
if (token != PERIOD)
genhighlow(SPECIAL, DUPSTACK);
genhighlow(POPINSTANCE, i);
}
else {
cexpression();
if (token == PERIOD)
genhighlow(SPECIAL, POPSTACK);
}
if (token != PERIOD)
break;
nextlex();
}
genhighlow(SPECIAL, RETURN);
if (token != RB) expect("end of block");
temptop -= count;
nextlex();
i = (codetop - position) - 1;
if (i > 255)
lexerr("block too big %d", i);
code[position] = itouc(i);
}
# define LITMAX 100
static object *lit_array[LITMAX];
static int littop = 0;
static int addliteral(lit)
object *lit;
{
if (littop >= LITMAX)
cant_happen(18);
sassign(lit_array[littop++], lit);
return(littop - 1);
}
/* aliteral - find a literal that is part of a literal array */
static int aliteral(must)
int must; /* must we find something ? */
{ char *c;
object *new;
int count;
int bytetop;
uchar bytes[200];
switch(token) {
case MINUS:
c = t.c;
nextlex();
if (token == LITNUM) {
new = new_int( - t.i );
nextlex();
}
else if (token == LITFNUM) {
new = new_float( - t.f );
nextlex();
}
else {
new = new_sym(c);
}
break;
case LITNUM:
new = new_int(t.i);
nextlex();
break;
case LITFNUM:
new = new_float(t.f);
nextlex();
break;
case LITCHAR:
new = new_char(t.i);
nextlex();
break;
case LITSTR:
new = new_str(t.c);
nextlex();
break;
case LITSYM:
new = new_sym(t.c);
nextlex();
break;
case PSEUDO:
switch(t.p) {
case nilvar: new = o_nil; break;
case truevar: new = o_true; break;
case falsevar: new = o_false; break;
case smallvar: new = o_smalltalk; break;
default: lexerr("unknown peudo %d", t.p);
}
nextlex();
break;
case PS:
nextlex();
if (token == LP) goto rdarray;
else if (token == LB) {
bytetop = 0;
while (nextlex() == LITNUM)
bytes[bytetop++] = itouc(t.i);
if (token != RB)
expect("right bracket");
nextlex();
new = new_bytearray(bytes, bytetop);
}
else expect("array or bytearray");
break;
case LP: rdarray:
count = 0;
nextlex();
while (aliteral(0) >= 0) {
count++;
}
if (token != RP) expect("right parenthesis");
nextlex();
new = new_array(count, 0);
while (count)
new->inst_var[--count] = lit_array[--littop];
break;
case UPPERCASEVAR:
case LOWERCASEVAR:
case KEYWORD:
case COLONVAR:
case BINARY:
case PE:
case BAR:
case SEMI:
new = new_sym(t.c);
nextlex();
break;
default:
if (must)
expect("literal");
else return( - 1 );
}
return(addliteral(new));
}
/* gensend - generate a message send */
static gensend(message, numargs)
char *message;
int numargs;
{ int i;
char **p, c;
tok_type e;
c = *message;
if (numargs == 0) {
for (p = unspecial, i = 0; *p; i++, p++)
if ((**p == c) && (strcmp(*p, message) == 0)) {
genhighlow(UNSEND, i);
return;
}
}
else if (numargs == 1) {
for (p = binspecial, i = 0; *p; i++, p++)
if ((**p == c) && (strcmp(*p, message) == 0)) {
genhighlow(BINSEND, i);
return;
}
for (p = arithspecial, i = 0; *p; i++, p++)
if ((**p == c) && (strcmp(*p, message) == 0)) {
genhighlow(ARITHSEND, i);
return;
}
}
else if (numargs == 2) {
for (p = keyspecial, i = 0; *p; i++, p++)
if ((**p == c) && (strcmp(*p, message) == 0)) {
genhighlow(KEYSEND, i);
return;
}
}
genhighlow(SEND, numargs);
gencode(addliteral(new_sym(message)));
}
static object *var_names;
static object *var_values;
extern object *o_nil, *o_true;
static int findvar(str, make)
char *str;
int make;
{ int i;
object *comp_obj;
sassign(comp_obj, new_obj((class *) 0, 2, 0));
sassign(comp_obj->inst_var[0], o_nil);
sassign(comp_obj->inst_var[1], new_sym(str));
for (i = 0; i < var_names->size; i++) {
assign(comp_obj->inst_var[0], var_names->inst_var[i]);
if (o_true == primitive(SYMEQTEST, 2, &(comp_obj->inst_var[0]))) {
obj_dec(comp_obj);
return(i);
}
}
/* not found, perhaps it's new */
if (make) {
assign(comp_obj->inst_var[0], var_names);
assign(var_names, primitive(GROW, 2, &(comp_obj->inst_var[0])));
assign(comp_obj->inst_var[0], var_values);
assign(comp_obj->inst_var[1], o_nil);
assign(var_values, primitive(GROW, 2, &(comp_obj->inst_var[0])));
}
else {
lexerr("unknown variable %s", str);
i = 0;
}
obj_dec(comp_obj);
return(i);
}
genvar(name)
char *name;
{ int i;
for (i = 0; i < temptop; i++)
if (strcmp(name, tempnames[i]) == 0) {
genhighlow(PUSHTEMP, i+1);
return;
}
genhighlow(PUSHINSTANCE, findvar(name, 0));
}
/* lexerr - error printing with limited reformatting */
lexerr(s, v)
char *s, *v;
{
char e1[500], e2[500];
object *new;
errflag = 1;
sprintf(e1, s, v); /* format error message */
sprintf(e2, "error: %s\n", e1);
sassign(new, new_str(e2));
primitive(ERRPRINT, 1, &new);
obj_dec(new);
}
expect(str)
char *str;
{ char ebuf[150];
/*fprintf(stderr,"expected %s\n", str);
fprintf(stderr,"current token type %d\n", token);
fprintf(stderr,"remainder of line %s\n", lexptr);
fprintf(stderr,"current text %s\n", toktext);*/
sprintf(ebuf,"expected %s found %s", str, toktext);
lexerr(ebuf,"");
}
extern object *o_drive; /* ``driver'' interpreter */
bld_interpreter()
{ interpreter *interp;
object *literals, *bytecodes, *context;
int i;
if (codetop == 0) {
return;
}
genhighlow(SPECIAL, SELFRETURN);
gencode(0); /* mark end of bytecodes */
sassign(literals, new_array(littop, 0));
for (i = 0; i < littop; i++)
literals->inst_var[ i ] = lit_array[i];
sassign(bytecodes, new_bytearray(code, codetop));
sassign(context, new_obj((class *) 0, 1 + maxtemps, 1));
interp = cr_interpreter((interpreter *) o_drive, var_values,
literals, bytecodes, context);
link_to_process(interp);
obj_dec(context);
obj_dec(bytecodes);
obj_dec(literals);
}
reset(){
codetop = littop = temptop = 0;
maxtemps = 1;
}
/* drv_init initializes the driver, should be called only once */
drv_init() {
sassign(var_names, new_obj((class *) 0, 0, 0));
sassign(var_values, new_obj((class *) 0, 0, 0));
reset();
findvar("last", 1); /* create variable "last" */
}
drv_free() {
int i;
for (i = 0; i < var_values->size; i++)
assign(var_values->inst_var[ i ], o_nil);
obj_dec(var_names);
obj_dec(var_values);
}
SHAR_EOF
if test 13242 -ne "`wc -c < 'drive.c'`"
then
echo shar: error transmitting "'drive.c'" '(should have been 13242 characters)'
fi
fi # end of overwriting check
if test -f 'lexcmd.c'
then
echo shar: will not over-write existing file "'lexcmd.c'"
else
cat << \SHAR_EOF > 'lexcmd.c'
/*
Little Smalltalk
misc lexer related routines
timothy a. budd 12/84
*/
/*
The source code for the Little Smalltalk System may be freely
copied provided that the source of all files is acknowledged
and that this condition is copied with each file.
The Little Smalltalk System is distributed without responsibility
for the performance of the program and without any guarantee of
maintenance.
All questions concerning Little Smalltalk should be addressed to:
Professor Tim Budd
Department of Computer Science
The University of Arizona
Tucson, Arizona
85721
USA
*/
# include <stdio.h>
# include "env.h"
# include <ctype.h>
# ifdef OPEN3ARG
# include <fcntl.h>
# endif OPEN3ARG
extern char toktext[];
/* dolexcommand - read a ) type directive, and process it */
dolexcommand(p)
char *p;
{ char *q;
/* replace trailing newline with end of string */
for (q = p; *q && *q != '\n'; q++);
if (*q == '\n') *q = '\0';
switch( *++p) {
case '!':
# ifndef NOSYSTEM
system(++p);
# endif
break;
case 'e': for (++p; isspace(*p); p++);
if (! lexedit(p)) lexinclude(p);
break;
case 'i': for (++p; isspace(*p); p++);
lexinclude(p);
break;
case 'r': for (++p; isspace(*p); p++);
lexread(p);
break;
case 's': for(++p; isspace(*p); p++);
dosave(p);
break;
case 'l': for(++p; isspace(*p); p++);
doload(p);
break;
default: lexerr("unknown command %s", toktext);
}
}
/* doload/dosave routines written by nick buchholz */
/*
doload and dosave routines make the following assumptions
1. version is the first global variable declared in main.
2. main is the first procedure seen by the loader
3. the loader allocates memory in the order it sees the procedures
4. memory is laid out as on the vax 780 under 4.2
on other machines any or all of these might be false and the
doload/dosave routines will not work
*/
extern int version;
dosave(p) char *p;{
int fd;
char *start, *end, *sbrk();
unsigned int length, len;
int dlen;
# ifdef OPEN3ARG
if ((fd = open(p, O_WRONLY|O_CREAT|O_TRUNC, 0666)) == -1)
# endif
# ifndef OPEN3ARG
if ((fd = creat(p, 0666)) == -1)
# endif
fprintf(stderr,"can't open: %s\n",p);
start = (char *) &version;
end = sbrk(0);
length = end - start;
write(fd, &version, sizeof(int));
write(fd, &start, sizeof(char *));
write(fd, &length, sizeof(unsigned int));
for (len = 0; len < length; len += dlen) {
dlen = ((length - len) > 512) ? 512 : (length - len);
if (dlen != write(fd, start + len, dlen)) {
cant_happen(23);
}
}
fprintf(stderr,"%u bytes written\n",len);
close(fd);
}
# ifdef ENVSAVE
extern char **environ;
# endif
doload(p) char *p;{
int fd;
char *start, *end, *brk();
unsigned int length, len;
int dlen;
int test;
# ifdef ENVSAVE
char **evsave;
# endif
# ifdef OPEN3ARG
if ((fd = open(p, O_RDONLY, 0)) == -1)
# endif
# ifndef OPEN3ARG
if ((fd = open(p, 0 )) == -1)
# endif
fprintf(stderr,"no such context as: %s\n", p);
else {
read(fd, &test, sizeof(int));
read(fd, &start, sizeof(char *));
read(fd, &length, sizeof(unsigned int));
if ((test != version) || (start != (char *) &version))
fprintf(stderr,"%s: not a valid context file for version %d\n",
p, version);
else {
start = (char *) &version;
end = brk(start + length + 1);
# ifdef ENVSAVE
evsave = environ;
# endif
for (len = 0; len < length; len += dlen) {
dlen = ((length - len) > 512) ? 512 : (length - len);
if (dlen != read(fd, start + len, dlen)) {
cant_happen(23);
}
}
# ifdef ENVSAVE
environ = evsave;
# endif
fprintf(stderr,"%u bytes read\n",len);
}
close(fd);
}
}
/* lexread - read commands from a file */
lexread(name)
char *name;
{ FILE *fd;
fd = fopen(name, "r");
if (fd == NULL) {
fprintf(stderr,"can't open %s\n", name);
}
else {
set_file(fd);
}
}
/* lexinclude - parse a class and include the class description */
lexinclude(name)
char *name;
{ char template[60], cmdbuf[120];
int i;
# ifndef NOSYSTEM
gettemp(template);
sprintf(cmdbuf,"%s %s >%s", PARSER, name, template);
i = system(cmdbuf);
if (i == 0)
lexread(template);
# endif
# ifdef NOSYSTEM
fprintf(stderr,")i does not work on this system\n");
# endif
}
/* lexedit - edit a class description */
int lexedit(name)
char *name;
{ char *e, buffer[100], *getenv();
# ifndef NOSYSTEM
e = getenv("EDITOR");
if (!e) e = "ed";
sprintf(buffer,"%s %s", e, name);
return(system(buffer));
# endif
# ifdef NOSYSTEM
fprintf(stderr,")e does not work on this system\n");
return(1);
# endif
}
SHAR_EOF
if test 4830 -ne "`wc -c < 'lexcmd.c'`"
then
echo shar: error transmitting "'lexcmd.c'" '(should have been 4830 characters)'
fi
fi # end of overwriting check
cd ..
# End of shell archive
exit 0