v13i054: New release of little smalltalk, Part02/05

[Rich Salz]

Submitted-by: Tim Budd <budd at MIST.CS.ORST.EDU>
Posting-number: Volume 13, Issue 54
Archive-name: little-st2/part02

#!/bin/sh
#
# 
# This is version 2.02 of Little Smalltalk, distributed in five parts.
# 
# This version is dated 12/25/87
# 
# Several bugs and many features and improvements have been made since the
# first posting to comp.src.unix.  See the file ``todo'' for a partial list.
# 
# Comments, bug reports, and the like should be submitted to:
# 	Tim Budd
# 	Smalltalk Distribution
# 	Department of Computer Science
# 	Oregon State University
# 	Corvallis, Oregon
# 	97330
# 
# 	budd at cs.orst.edu
# 	{hp-pcd, tektronix}!orstcs!budd
# 
#
echo 'Start of small.v2, part 02 of 05:'
echo 'x - explore.ms'
sed 's/^X//' > explore.ms << '/'
X.SH
XExploring and Creating
X.PP
XThis document describes how to discover information about existing objects 
Xand create new objects using the Unix interface to the Little Smalltalk
Xsystem (version two).  The Little Smalltalk system running 
Xunder different operating
Xsystems may have a slightly different interface, and the reader should be
Xforewarned.
X.PP
XWhen you start version two Little Smalltalk under Unix, you will be given a 
Xprompt.
XYou can enter expressions in response to the prompt, and the system will 
Xevaluate them (although it will not print the result unless you request 
Xit\s-2\u*\d\s+2).
X.FS
X* Note that this is a change from version one of Little Smalltalk, where
Xexpressions were automatically printed.
XThe reason has to do with now expressions are compiled and executed
Xnow, using more Smalltalk code, and less C code.
X.FE
X.DS I
X>	(5 + 7) print
X12
X>
X.DE
XIn Smalltalk one communicates with objects by passing messages to them.
XEven the addition sign shown above is treated as a message passed to the
Xobject 5, with argument 7.  Other messages can be used to discover
Xinformation about various objects.
XThe most basic fact you can discover about an object is its class.
XThis is given by the message \fBclass\fP, as in the following examples:
X.DS I
X>	7 class print
XInteger
X>	nil class print
XUndefinedObject
X.DE
X.PP
XOccasionally, especially when programming, one would like to ask whether
Xthe class of an object matches some known class.  One way to do this would
Xbe to use the message \fB=\!=\fP, which tells whether two expressions 
Xrepresent the same object:
X.DS I
X>	( 7 class =\!= Integer) print
XTrue
X>	nil class == Object ; print
XFalse
X.DE
X.LP
X(Notice that second example uses cascades in place of parenthesis.
XThe only difference between these two is that in the first example the
Xresult of the expression is the value returned by the print, whereas in the
Xsecond the result of the expression is the value returned by =\!=.  But
Xsince in any case the value is thrown away, it makes no difference.)
X.PP
XAn easier way is to use the message \fBisMemberOf:\fP;
X.DS I
X>	7 isMemberOf: Integer ; print
XTrue
X>	nil isMemberOf: Integer ; print
XFalse
X.DE
X.PP
XSometimes you want to know if an object is an instance of a particular
Xclass or one if its subclasses; in this case the appropriate message is
X\fBisKindOf:\fP.
X.DS I
X>	7 isMemberOf: Number ; print
XFalse
X>	7 isKindOf: Number ; print
XTrue
X.DE
X.PP
XAll objects will respond to the message \fBdisplay\fP by telling a little
Xabout themselves.  Many just give their class and their printable
Xrepresentation:
X.DS I
X>	7 display
X(Class Integer) 7
X>	nil display
X(Class UndefinedObject) nil
X.DE
X.LP
XOthers, such as classes, are a little more verbose:
X.DS I
X>	Integer display
XClass Name: Integer
XSuperClass: Number
XInstance Variables:
Xno instance variables
XSubclasses:
X.DE
X.LP
XThe display shows that the class \fBInteger\fP is a subclass of class
X\fBNumber\fP (that is, class \fBNumber\fP is the superclass of
X\fBInteger\fP).  There are no instance variables for this class, and it
Xcurrently has no subclasses.  
XAll of this information could be obtained by means of other messages,
Xalthough the \fBdisplay\fP form is the easiest.
X.DS I
X>	List variables display
Xlinks
X>	Integer superClass print
XNumber
X>	Collection subClasses display
XIndexedCollection
XInterval
XList
X.DE
XAbout the only bit of information that is not provided when one passes the
Xmessage \fBdisplay\fP to a class
Xis a list of methods the class responds to.  There are two
Xreasons for this omission; the first is that this list can often be quite
Xlong, and we don't want to scroll the other information off the screen
Xbefore the user has seen it.  The second reason is that there are really
Xtwo different questions the user could be asking.  The first is what
Xmethods are actually implemented in a given class.  A dictionary containing
Xthe set of methods implemented in a class can be found by passing the
Xmessage \fBmethods\fP to a class.  Since we are only interested in the set
Xof keys for this dictionary (that is, the message selectors), we can use
Xthe message \fBkeys\fP.  Finally, as we saw with the message
X\fBsubClasses\fP shown above, our old friend \fBdisplay\fP prints this
Xinformation out one method to a line:
X.DS I
X>	True methods keys display
X#ifTrue:ifFalse:
X#not
X.DE
X.PP
XA second question that one could ask is what message selectors an instance of a
Xgiven class will respond to, whether they are inherited from superclasses
Xor are defined in the given class.  This set is given in response to the
Xmessage \fBrespondsTo\fP.
X.DS I
X>	True respondsTo display
X#class
X#==
X#hash
X#isNil
X#display
X#=
X#basicSize
X#isMemberOf:
X#notNil
X#print
X#basicAt:put:
X#isKindOf:
X#basicAt:
X#printString
X#or:
X#and:
X#ifFalse:ifTrue:
X#ifTrue:
X#ifFalse:
X#not
X#ifTrue:ifFalse:
X.DE
X.PP
XAlternatively, one can ask whether instances of a given class will respond
Xto a specific message by writing the message selector as a symbol:
X.DS I
X>	( String respondsTo: #print ) print
XTrue
X>	String respondsTo: #+ ; print
XFalse
X.DE
X.PP
XThe inverse of this would be to ask what classes contain methods for a
Xgiven message selector.  Class \fBSymbol\fP defines a method to yield just
Xthis information:
X.DS I
X>	#+ respondsTo display
XInteger
XNumber
XFloat
X.DE
X.PP
XThe method that will be executed in response to a given message selector
Xcan be displayed by means of the message \fBviewMethod:\fP
X.DS I
X>	Integer viewMethod: #gcd:
Xgcd: value
X	(value = 0) ifTrue: [ \(ua self ].
X	(self negative) ifTrue: [ \(ua self negated gcd: value ].
X	(value negative) ifTrue: [ \(ua self gcd: value negated ].
X	(value > self) ifTrue: [ \(ua value gcd: self ].
X	\(ua value gcd: (self rem: value)
X.DE
X.PP
XNew functionality can be added using the message \fBaddMethod\fP.
XWhen passed to an instance of \fBClass\fP, this message drops the user into
Xa standard Unix Editor.  A body for a new method can then be entered.
XWhen the user exists the editor, the method body is compiled.  If it is
Xsyntactically correct, it is added to the methods for the class.  If it is
Xincorrect, the user is given the option of re-editing the method.
X.DS I
X>	Integer addMethod
X\& ... drop into editor and enter the following text
X% x
X	\(ua ( x + )
X\& ... exit editor
Xcompiler error: invalid expression start )
Xedit again (yn) ?
X\& ...
X.DE
X.PP
XIn a similar manner, existing methods can be editing by passing their
Xselectors, as symbols to the message \fBeditMethod:\fP.
X.DS I
X>	Integer editMethod: #gcd:
X\& ... drop into editor working on the body of gcd:
X.DE
X.PP
XThe name of the editor used by these methods is taken from a string
Xpointed to by the global variable \fIeditor\fP.  Different editors can be
Xselected merely by redefining this value:
X.DS I
XglobalNames at: #editor put: 'emacs'
X.DE
X.PP
XSome Smalltalk systems make it very difficult for you to discover the
Xbytecodes that a method gets translated into.  Since the primary goal of
XLittle Smalltalk is to help the student to discover how a modern very high
Xleval language is implemented, it makes sense that the system should help
Xyou as much as possible discover everything about its internal structure.
XThus a method, when presented with the message \fBdisplay\fP, will print
Xout its bytecode representation.
X.DS I
X>	Char methods at: #isAlphabetic ; display
XMethod #isAlphabetic
X	isAlphabetic
X		^ (self isLowercase) or: [ self isUppercase ]
X
Xliterals
XArray ( #isLowercase #isUppercase )
Xbytecodes
X32 2 0
X144 9 0
X0 0 0
X250 15 10
X8 0 8
X32 2 0
X144 9 0
X1 0 1
X242 15 2
X241 15 1
X.DE
X.PP
XBytecodes are represented by four bit opcodes and four bit operands, with
Xoccasional bytes representing data (more detail can be found in the book).
XThe three numbers written on each line for the bytecodes represent the 
Xbyte value followed by the upper four bits and the lower four bits.
X.PP
XNew objects are created using the message \fBnew\fP.  
XWithin a method
Xthese can be assigned to instance varibles using the assignment arrow.
X.DS I
X\fBaMethod\fP
X	x \(<- Set new.
X	\&...
X.DE
X.PP
XThe assignment arrow is not recognized at the topmost level.  Instead,
Xglobal variables (variables recognized in any context), are created by
Xpassing messages to \fBglobalNames\fP (below).
X.PP
XNew classes, on the
Xother hand, are created by sending a message \fBaddSubClass\fP to the class
Xthat will be the superclass of the new class.  The user will then be
Xinterrogated for information to be associated with the new class:
X.DS I
X>	Object addSubClass
XClass Name? Foo
XInstance Variables? x y z
XAdd a method (yn) ? y
X\&...
X>	Foo display
XClass Name: Foo
XSuperclass: Object
XInstance Variables: 
Xx
Xy
Xz
XSubclasses:
X.DE
X.PP
XClasses created using \fBaddSubClass\fP will be automatically added to the
Xlist of global variables.  Other global variables can be created merely by
Xplacing their name and value into the 
Xdictionary \fBglobalNames\fP\s-2\u*\d\s+2.
X.DS I
X>	globalNames at: #version put: 2.1
X
X>	version print
X2.1
X.DE
X.FS
X* This is a change from version 1 of Little Smalltalk, where it was
Xpossible to create global variables merely by assiging a value to them at
Xthe command level.  The change is an unfortunate consequence of the
Xfact that more is done now
Xis Smalltalk, and less in C.  The bytecode interpreter now knows little
Xabout the object globalNames, in particular, the bytecode interpreter
Xdoesn't know how to add a new object; this is done entirely in Smalltalk
Xcode.  One possiblity would be to automatically have the parser change an
Xassignment at the command level into an at:put:, but this would seem to
Xcomplicate the parser unnecessarily.
X.FE
X.PP
XIf you have written a new class and want to print the class methods on a
Xfile you can use the message \fBfileOut:\fP, after first creating a file to
Xwrite to.  Both classes and individual methods can be filed out, and
Xseveral classes and/or methods can be placed in one file.
X.DS I
X>	globalNames at: #f put: File new
X>	f name: 'foo.st'
X>	f open: 'w'
X>	Foo fileOut: f
X>	Bar fileOut: f
X>	Object fileOutMethod: #isFoo to: f
X>	f close
X.DE
X.LP
XThe file ``newfile'' will now have a printable representation of the
Xmethods for the class Foo.
XThese can subsequently be filed back into a different smalltalk image.
X.DS I
X>	globalNames at: #f put: File new
X>	f name: 'foo.st'
X>	f open: 'r'
X>	f fileIn
X>	2 isFoo print
XFalse
X.DE
X.PP
XFinally, once the user has added classes and variables and made whatever other
Xchanges they want, the message \fBsaveImage\fP, passed to the pseudo
Xvariable \fBsmalltalk\fP, can be used to save an entire object image on a file.
XIf the writing of the image is successful, a message will be displayed.
X.DS I
X>	smalltalk saveImage
XImage name? newimage
Ximage newimage created
X>	
X.DE
X.PP
XTyping control-D causes the interpreter to exit.
X.PP
XWhen the smalltalk system is restarted, an alternative image, such as the
Ximage just created, can be specified by giving its name on the argument
Xline:
X.DS I
Xst newimage
X.DE
X.PP
XFurther information on Little Smalltalk can be found in the book.
X.SH
XIncompatabilities with the Book
X.PP
XIt is unfortunately the case that during the transition from version 1 (the
Xversion described in the book) and version 2 (the new version that is one
Xthird the size and three times faster), certain changes to the user
Xinterface were required.  I will describe these here.
X.PP
XThe first incompatability comes at the very beginning.  In version 1 there
Xwere a great number of command line options.  These have all been
Xeliminated in version two.  In version two the only command line option is
Xthe file name of an image file.
X.PP
XIn version 1 it is possible to create global variables simply by assigning
Xto them.  That is, a statement such as
X.DS I
Xxx \(<- 27
X.DE
Xwhen issued at the command level would create a new global variable.
XSince it is not possible to assign to an unknown name within a method, this
Xin effect required the version one system to keep around two parsers, one
Xfor methods and another for command lines.  These were replaced with a
Xsingle parser in version two, which necessitated a change.  Now to create a
Xglobal variable one must first establish it in the dictionary, using the
Xcommand 
X.DS I
XglobalNames at: #xx put: 27
X.DE
XIt is not possible to use assignment to create a global variable in version
Xtwo.
X.PP
XThe interface to the editor has been changed.  In version one this was
Xhandled by the system, and not by Smalltalk code.  This required a command
Xformat that was clearly not a Smalltalk command, so that they could be
Xdistinguished.  The convention adoped was to use an APL style system
Xcommand:
X.DS I
X)e filename
X.DE
XIn version two we have moved these functions into Smalltalk code.  Now
Xthe problem is just the reverse, we need a command that is a Smalltalk
Xcommand.  In addition, in version one entire classes were edited at once,
Xwhereas in version two only individual methods are edited.  As we have
Xalready noted, the new commands to add or edit methods are as follows:
X.DS I
X\fIclassname\fP addMethod
X\fIclassname\fP editMethod: \fImethodname\fP
X.DE
X.PP
XThe only other significant syntactic change is the way primitive methods
Xare invoked.  In version one these were either named or numbered, 
Xsomething like the following:
X.DS I
X<primitive 37 a b>
X<IntegerAdd a b>
X.DE
XIn version two we have simply eliminated the keyword \fBprimitive\fP, so
Xprimitives now look like:
X.DS I
X<37 a b>
X.DE
X.PP
XThere are far fewer primitives in version two, and much more of the system
Xis now performed using Smalltalk code.
X.PP
XIn addition to these syntactic changes, there are various small changes in
Xthe class structure.  I hope to have a document describing these changes at
Xsome point, but as of right now the code itself is the best description.
/
echo 'x - image.c'
sed 's/^X//' > image.c << '/'
X/*
X	Little Smalltalk, version 2
X	Written by Tim Budd, Oregon State University, July 1987
X
X	routines used in the making of the initial object image
X*/
X
X# include <stdio.h>
X# include "env.h"
X# include "memory.h"
X# include "names.h"
X# include "lex.h"
X# ifdef STRING
X# include <string.h>
X# endif
X# ifdef STRINGS
X# include <strings.h>
X# endif
X
X# define SymbolTableSize 71
X# define GlobalNameTableSize 53
X# define MethodTableSize 39
X
X# define globalNameSet(sym, value) nameTableInsert(globalNames, sym, value)
X/*
X	the following classes are used repeately, so we put them in globals.
X*/
Xstatic object ObjectClass;
Xstatic object ClassClass;
Xstatic object LinkClass;
Xstatic object DictionaryClass;
Xstatic object ArrayClass;
X
X/*
X	we read the input a line at a time, putting lines into the following
X	buffer.  In addition, all methods must also fit into this buffer.
X*/
X# define TextBufferSize 1024
Xstatic char textBuffer[TextBufferSize];
X
X/*
X	nameTableInsert is used to insert a symbol into a name table.
X	see names.c for futher information on name tables
X*/
XnameTableInsert(dict, symbol, value)
Xobject dict, symbol, value;
X{	object table, link, newLink, nextLink, tablentry;
X	int hash;
X
X	/* first get the hash table */
X	table = basicAt(dict, 1);
X
X	if (objectSize(table) < 3)
X		sysError("attempt to insert into","too small name table");
X	else {
X		hash = 3 * ( symbol % (objectSize(table) / 3));
X		tablentry = basicAt(table, hash+1);
X		if ((tablentry == nilobj) || (tablentry == symbol)) {
X			basicAtPut(table, hash+1, symbol);
X			basicAtPut(table, hash+2, value);
X			}
X		else {
X			newLink = allocObject(3);
X			incr(newLink);
X			setClass(newLink, globalSymbol("Link"));
X			basicAtPut(newLink, 1, symbol);
X			basicAtPut(newLink, 2, value);
X			link = basicAt(table, hash+3);
X			if (link == nilobj)
X				basicAtPut(table, hash+3, newLink);
X			else
X				while(1)
X					if (basicAt(link,1) == symbol) {
X						basicAtPut(link, 2, value);
X						break;
X						}
X					else if ((nextLink = basicAt(link, 3)) == nilobj) {
X						basicAtPut(link, 3, newLink);
X						break;
X						}
X					else
X						link = nextLink;
X			decr(newLink);
X			}
X	}
X}
X
X/*
X	there is sort of a chicken and egg problem about building the 
X	first classes.
X	in order to do it, you need symbols, 
X	but in order to make symbols, you need the class Symbol.
X	the routines makeClass and buildInitialNameTable attempt to get 
X	carefully get around this initialization problem
X*/
X
Xstatic object makeClass(name)
Xchar *name;
X{	object theClass, theSymbol;
X
X	/* this can only be called once newSymbol works properly */
X
X	theClass = allocObject(classSize);
X	theSymbol = newSymbol(name);
X	basicAtPut(theClass, nameInClass, theSymbol);
X	globalNameSet(theSymbol, theClass);
X	setClass(theClass, ClassClass);
X
X	return(theClass);
X}
X
XbuildInitialNameTables()
X{	object symbolString, classString;
X	object globalHashTable;
X	int hash;
X	char *p;
X
X	/* build the table that contains all symbols */
X	symbols = allocObject(2 * SymbolTableSize);
X	incr(symbols);
X
X	/* build the table (a dictionary) that contains all global names */
X	globalNames = allocObject(1);
X	globalHashTable = allocObject(3 * GlobalNameTableSize);
X	incr(globalNames);
X	basicAtPut(globalNames, 1, globalHashTable);
X
X	/* next create class Symbol, so we can call newSymbol */
X	/* notice newSymbol uses the global variable symbolclass */
X	symbolString = allocSymbol("Symbol");
X	symbolclass =  allocObject(classSize);
X	setClass(symbolString, symbolclass);
X	basicAtPut(symbolclass, nameInClass, symbolString);
X	/* we recreate the hash computation used by newSymbol */
X	hash = 0;
X	for (p = "Symbol"; *p; p++)
X		hash += *p;
X	if (hash < 0) hash = - hash;
X	hash %= (objectSize(symbols) / 2);
X	basicAtPut(symbols, 2*hash + 1, symbolString);
X	globalNameSet(symbolString, symbolclass);
X	/* now the routine newSymbol should work properly */
X
X	/* now go on to make class Class so we can call makeClass */
X	ClassClass = allocObject(classSize);
X	classString = newSymbol("Class");
X	basicAtPut(ClassClass, nameInClass, classString);
X	globalNameSet(classString, ClassClass);
X	setClass(ClassClass, ClassClass);
X	setClass(symbolclass, ClassClass);
X
X	/* now create a few other important classes */
X	ObjectClass = makeClass("Object");
X	LinkClass = makeClass("Link");
X	setClass(nilobj, makeClass("UndefinedObject"));
X	DictionaryClass = makeClass("Dictionary");
X	ArrayClass = makeClass("Array");
X	setClass(symbols, DictionaryClass);
X	setClass(globalNames, DictionaryClass);
X	setClass(globalHashTable, ArrayClass);
X	
X}
X
X/*
X	findClass gets a class object,
X	either by finding it already or making it
X	in addition, it makes sure it has a size, by setting
X	the size to zero if it is nil.
X*/
Xstatic object findClass(name)
Xchar *name;
X{	object newobj;
X
X	newobj = globalSymbol(name);
X	if (newobj == nilobj)
X		newobj = makeClass(name);
X	if (basicAt(newobj, sizeInClass) == nilobj)
X		basicAtPut(newobj, sizeInClass, newInteger(0));
X	return(newobj);
X}
X
X/*
X	readDeclaration reads a declaration of a class
X*/
Xstatic readDeclaration()
X{	object classObj, super, vars;
X	int i, size, instanceTop;
X	object instanceVariables[15];
X
X	if (nextToken() != nameconst)
X		sysError("bad file format","no name in declaration");
X	classObj = findClass(tokenString);
X	size = 0;
X	if (nextToken() == nameconst) {	/* read superclass name */
X		super = findClass(tokenString);
X		basicAtPut(classObj, superClassInClass, super);
X		size = intValue(basicAt(super, sizeInClass));
X		ignore nextToken();
X		}
X	if (token == nameconst) {		/* read instance var names */
X		instanceTop = 0;
X		while (token == nameconst) {
X			instanceVariables[instanceTop++] = newSymbol(tokenString);
X			size++;
X			ignore nextToken();
X			}
X		vars = newArray(instanceTop);
X		for (i = 0; i < instanceTop; i++)
X			basicAtPut(vars, i+1, instanceVariables[i]);
X		basicAtPut(classObj, variablesInClass, vars);
X		}
X	basicAtPut(classObj, sizeInClass, newInteger(size));
X}
X
X/*
X	readInstance - read an instance directive 
X*/
Xstatic readInstance()
X{	object classObj, newObj;
X	int size;
X
X	if (nextToken() != nameconst)
X		sysError("no name","following instance command");
X	classObj = globalSymbol(tokenString);
X	if (nextToken() != nameconst)
X		sysError("no instance name","in instance command");
X
X	/* now make a new instance of the class -
X		note that we can't do any initialization */
X	size = intValue(basicAt(classObj, sizeInClass));
X	newObj = allocObject(size);
X	setClass(newObj, classObj);
X	globalNameSet(newSymbol(tokenString), newObj);
X}
X
X/*
X	readClass reads a class method description
X*/
Xstatic readClass(fd, printit)
XFILE *fd;
Xboolean printit;
X{	object classObj, methTable, theMethod, selector;
X# define LINEBUFFERSIZE 512
X	object methDict;
X	char *eoftest, lineBuffer[LINEBUFFERSIZE];
X
X	/* if we haven't done it already, read symbols now */
X	if (trueobj == nilobj)
X		initCommonSymbols();
X
X	if (nextToken() != nameconst)
X		sysError("missing name","following Class keyword");
X	classObj = findClass(tokenString);
X	setInstanceVariables(classObj);
X	if (printit)
Xignore fprintf(stderr,"class %s\n", charPtr(basicAt(classObj, nameInClass)));
X
X	/* find or create a methods table */
X	methTable = basicAt(classObj, methodsInClass);
X	if (methTable == nilobj) {
X		methTable = allocObject(1);
X		basicAtPut(classObj, methodsInClass, methTable);
X		setClass(methTable, globalSymbol("Dictionary"));
X		methDict = allocObject(MethodTableSize);
X		basicAtPut(methTable, 1, methDict);
X		setClass(methDict, globalSymbol("Array"));
X		}
X
X	/* now go read the methods */
X	do {
X		textBuffer[0] = '\0';
X		while((eoftest = fgets(lineBuffer, LINEBUFFERSIZE, fd)) != NULL) {
X			if ((lineBuffer[0] == '|') || (lineBuffer[0] == ']'))
X				break;
X			ignore strcat(textBuffer, lineBuffer);
X			}
X		if (eoftest == NULL) {
X			sysError("unexpected end of file","while reading method");
X			break;
X			}
X		/* now we have a method */
X		theMethod = allocObject(methodSize);
X		setClass(theMethod, globalSymbol("Method"));
X		if (parse(theMethod, textBuffer)) {
X			selector = basicAt(theMethod, messageInMethod);
X			if (printit)
Xignore fprintf(stderr,"method %s\n", charPtr(selector));
X			nameTableInsert(methTable, selector, theMethod);
X			}
X		else {
X			/* get rid of unwanted method */
X			incr(theMethod);
X			decr(theMethod);
Xignore fprintf(stderr,"push return to continue\n");
Xignore gets(textBuffer);
X			}
X		
X	} while (lineBuffer[0] != ']');
X}
X
X/*
X	readFile reads a class descriptions file
X*/
XreadFile(fd, printit)
XFILE *fd;
Xboolean printit;
X{
X	while(fgets(textBuffer, TextBufferSize, fd) != NULL) {
X		lexinit(textBuffer);
X		if (token == inputend)
X			; /* do nothing, get next line */
X		else if ((token == binary) && streq(tokenString, "*"))
X			; /* do nothing, its a comment */
X		else if ((token == nameconst) && streq(tokenString, "Declare"))
X			readDeclaration();
X		else if ((token == nameconst) && streq(tokenString,"Instance"))
X			readInstance();
X		else if ((token == nameconst) && streq(tokenString,"Class"))
X			readClass(fd, printit);
X		else 
X			ignore fprintf(stderr,"unknown line %s\n", textBuffer);
X		}
X}
/
echo 'x - parser.c'
sed 's/^X//' > parser.c << '/'
X/*
X	Little Smalltalk, version 2
X	Written by Tim Budd, Oregon State University, July 1987
X
X	Method parser - parses the textual description of a method,
X	generating bytecodes and literals.
X
X	This parser is based around a simple minded recursive descent
X	parser.
X	It is used both by the module that builds the initial virtual image,
X	and by a primitive when invoked from a running Smalltalk system.
X
X	The latter case could, if the bytecode interpreter were fast enough,
X	be replaced by a parser written in Smalltalk.  This would be preferable,
X	but not if it slowed down the system too terribly.
X
X	To use the parser the routine setInstanceVariables must first be
X	called with a class object.  This places the appropriate instance
X	variables into the memory buffers, so that references to them
X	can be correctly encoded.
X
X	As this is recursive descent, you should read it SDRAWKCAB !
X		(from bottom to top)
X*/
X# include <stdio.h>
X# include "env.h"
X# include "memory.h"
X# include "names.h"
X# include "interp.h"
X# include "lex.h"
X# ifdef STRING
X# include <string.h>
X# endif
X# ifdef STRINGS
X# include <strings.h>
X# endif
X
X		/* all of the following limits could be increased (up to
X			256) without any trouble.  They are kept low 
X			to keep memory utilization down */
X
X# define codeLimit 256		/* maximum number of bytecodes permitted */
X# define literalLimit 32	/* maximum number of literals permitted */
X# define temporaryLimit 16	/* maximum number of temporaries permitted */
X# define argumentLimit 16	/* maximum number of arguments permitted */
X# define instanceLimit 16	/* maximum number of instance vars permitted */
X# define methodLimit 32		/* maximum number of methods permitted */
X
Xextern object binSyms[];
Xextern object keySyms[];
Xextern char *unStrs[], *binStrs[], *keyStrs[];
X
Xstatic boolean parseok;			/* parse still ok? */
Xstatic int codeTop;			/* top position filled in code array */
Xstatic byte codeArray[codeLimit];	/* bytecode array */
Xstatic int literalTop;			/*  ... etc. */
Xstatic object literalArray[literalLimit];
Xstatic int temporaryTop;
Xstatic char *temporaryName[temporaryLimit];
Xstatic int argumentTop;
Xstatic char *argumentName[argumentLimit];
Xstatic int instanceTop;
Xstatic char *instanceName[instanceLimit];
X
Xstatic int maxTemporary;		/* highest temporary see so far */
Xstatic char selector[80];		/* message selector */
X
Xstatic boolean inBlock;			/* true if compiling a block */
Xstatic boolean optimizedBlock;		/* true if compiling optimized block */
X
XsetInstanceVariables(aClass)
Xobject aClass;
X{	int i, limit;
X	object vars;
X
X	if (aClass == nilobj)
X		instanceTop = 0;
X	else {
X		setInstanceVariables(basicAt(aClass, superClassInClass));
X		vars = basicAt(aClass, variablesInClass);
X		if (vars != nilobj) {
X			limit = objectSize(vars);
X			for (i = 1; i <= limit; i++)
X				instanceName[++instanceTop] = charPtr(basicAt(vars, i));
X			}
X		}
X}
X
XcompilWarn(str1, str2)
Xchar *str1, *str2;
X{
X	ignore fprintf(stderr,"compiler warning: %s %s\n", str1, str2);
X}
X
XcompilError(str1, str2)
Xchar *str1, *str2;
X{
X	ignore fprintf(stderr,"compiler error: %s %s\n", str1, str2);
X	parseok = false;
X}
X
Xstatic object newChar(value)
Xint value;
X{	object newobj;
X
X	newobj = allocObject(1);
X	basicAtPut(newobj, 1, newInteger(value));
X	setClass(newobj, globalSymbol("Char"));
X	return(newobj);
X}
X
Xstatic object newByteArray(size)
Xint size;
X{	object newobj;
X
X	newobj = allocByte(size);
X	setClass(newobj, globalSymbol("ByteArray"));
X	return(newobj);
X}
X
Xstatic genCode(value)
Xint value;
X{
X	if (codeTop >= codeLimit)
X		compilError("too many bytecode instructions in method","");
X	else
X		codeArray[codeTop++] = value;
X}
X
Xstatic genInstruction(high, low)
Xint high, low;
X{
X	if (low >= 16) {
X		genInstruction(0, high);
X		genCode(low);
X		}
X	else
X		genCode(high * 16 + low);
X}
X
Xstatic int genLiteral(aLiteral)
Xobject aLiteral;
X{
X	if (literalTop >= literalLimit)
X		compilError("too many literals in method","");
X	else {
X		literalArray[++literalTop] = aLiteral;
X		incr(aLiteral);
X		}
X	return(literalTop - 1);
X}
X
Xstatic char *glbsyms[] = {"nil", "true", "false", "smalltalk", "globalNames",
X0 };
X
Xstatic boolean nameTerm(name)
Xchar *name;
X{	int i;
X	boolean done = false;
X	boolean isSuper = false;
X	object newterm;
X
X	/* it might be self or super */
X	if (streq(name, "self") || streq(name, "super")) {
X		genInstruction(PushArgument, 0);
X		done = true;
X		if (streq(name,"super")) isSuper = true;
X		}
X
X	/* or it might be a temporary */
X	if (! done)
X		for (i = 1; (! done) && ( i <= temporaryTop ) ; i++)
X			if (streq(name, temporaryName[i])) {
X				genInstruction(PushTemporary, i-1);
X				done = true;
X				}
X
X	/* or it might be an argument */
X	if (! done)
X		for (i = 1; (! done) && (i <= argumentTop ) ; i++)
X			if (streq(name, argumentName[i])) {
X				genInstruction(PushArgument, i);
X				done = true;
X				}
X
X	/* or it might be an instance variable */
X	if (! done)
X		for (i = 1; (! done) && (i <= instanceTop); i++) {
X			if (streq(name, instanceName[i])) {
X				genInstruction(PushInstance, i-1);
X				done = true;
X				}
X			}
X
X	/* or it might be a global constant */
X	if (! done)
X		for (i = 0; (! done) && glbsyms[i]; i++)
X			if (streq(name, glbsyms[i])) {
X				genInstruction(PushConstant, i+4);
X				done = true;
X				}
X
X	/* not anything else, it must be a global */
X	/* see if we know of it first */
X	if (! done) { 
X		newterm = globalSymbol(name);
X		if (newterm != nilobj) {
X			genInstruction(PushLiteral, genLiteral(newterm));
X			done = true;
X			}
X		}
X
X	/* otherwise, must look it up at run time */
X	if (! done) {
X		genInstruction(PushGlobal, genLiteral(newSymbol(name)));
X		}
X
X	return(isSuper);
X}
X
Xstatic int parseArray()
X{	int i, size, base;
X	object newLit, obj;
X
X	base = literalTop;
X	ignore nextToken();
X	while (parseok && (token != closing)) {
X		switch(token) {
X			case arraybegin:
X				ignore parseArray();
X				break;
X
X			case intconst:
X				ignore genLiteral(newInteger(tokenInteger));
X				ignore nextToken();
X				break;
X
X			case floatconst:
X				ignore genLiteral(newFloat(tokenFloat));
X				ignore nextToken();
X				break;
X
X			case nameconst: case namecolon: case symconst:
X				ignore genLiteral(newSymbol(tokenString));
X				ignore nextToken();
X				break;
X
X			case binary:
X				if (streq(tokenString, "(")) {
X					ignore parseArray();
X					}
X				else {
X					ignore genLiteral(newSymbol(tokenString));
X					ignore nextToken();
X					}
X				break;
X
X			case charconst:
X				ignore genLiteral(newChar(
X					newInteger(tokenInteger)));
X				ignore nextToken();
X				break;
X
X			case strconst:
X				ignore genLiteral(newStString(tokenString));
X				ignore nextToken();
X				break;
X
X			default:
X				compilError("illegal text in literal array",
X					tokenString);
X				ignore nextToken();
X				break;
X		}
X	}
X
X	if (parseok)
X		if (! streq(tokenString, ")"))
X			compilError("array not terminated by right parenthesis",
X				tokenString);
X		else
X			ignore nextToken();
X	size = literalTop - base;
X	newLit = newArray(size);
X	for (i = size; i >= 1; i--) {
X		obj = literalArray[literalTop];
X		basicAtPut(newLit, i, obj);
X		decr(obj);
X		literalArray[literalTop] = nilobj;
X		literalTop = literalTop - 1;
X		}
X	return(genLiteral(newLit));
X}
X
Xstatic boolean term()
X{	boolean superTerm = false;	/* true if term is pseudo var super */
X
X	if (token == nameconst) {
X		superTerm = nameTerm(tokenString);
X		ignore nextToken();
X		}
X	else if (token == intconst) {
X		if ((tokenInteger >= 0) && (tokenInteger <= 2))
X			genInstruction(PushConstant, tokenInteger);
X		else
X			genInstruction(PushLiteral, 
X				genLiteral(newInteger(tokenInteger)));
X		ignore nextToken();
X		}
X	else if (token == floatconst) {
X		genInstruction(PushLiteral, genLiteral(newFloat(tokenFloat)));
X		ignore nextToken();
X		}
X	else if ((token == binary) && streq(tokenString, "-")) {
X		ignore nextToken();
X		if (token == intconst) {
X			if (tokenInteger == 1)
X				genInstruction(PushConstant, 3);
X			else
X				genInstruction(PushLiteral, 
X					genLiteral(newInteger( - tokenInteger)));
X			}
X		else if (token == floatconst) {
X			genInstruction(PushLiteral,
X				genLiteral(newFloat(-tokenFloat)));
X			}
X		else
X			compilError("negation not followed",
X				"by number");
X		ignore nextToken();
X		}
X	else if (token == charconst) {
X		genInstruction(PushLiteral,
X			genLiteral(newChar(tokenInteger)));
X		ignore nextToken();
X		}
X	else if (token == symconst) {
X		genInstruction(PushLiteral,
X			genLiteral(newSymbol(tokenString)));
X		ignore nextToken();
X		}
X	else if (token == strconst) {
X		genInstruction(PushLiteral,
X			genLiteral(newStString(tokenString)));
X		ignore nextToken();
X		}
X	else if (token == arraybegin) {
X		genInstruction(PushLiteral, parseArray());
X		}
X	else if ((token == binary) && streq(tokenString, "(")) {
X		ignore nextToken();
X		expression();
X		if (parseok)
X			if ((token != closing) || ! streq(tokenString, ")"))
X				compilError("Missing Right Parenthesis","");
X			else
X				ignore nextToken();
X		}
X	else if ((token == binary) && streq(tokenString, "<"))
X		parsePrimitive();
X	else if ((token == binary) && streq(tokenString, "["))
X		block();
X	else
X		compilError("invalid expression start", tokenString);
X
X	return(superTerm);
X}
X
Xstatic parsePrimitive()
X{	int primitiveNumber, argumentCount;
X
X	if (nextToken() != intconst)
X		compilError("primitive number missing","");
X	primitiveNumber = tokenInteger;
X	ignore nextToken();
X	argumentCount = 0;
X	while (parseok && ! ((token == binary) && streq(tokenString, ">"))) {
X		ignore term();
X		argumentCount++;
X		}
X	genInstruction(DoPrimitive, argumentCount);
X	genCode(primitiveNumber);
X	ignore nextToken();
X}
X
Xstatic genMessage(toSuper, argumentCount, messagesym)
Xboolean toSuper;
Xint argumentCount;
Xobject messagesym;
X{
X	if (toSuper) {
X		genInstruction(DoSpecial, SendToSuper);
X		genCode(argumentCount);
X		}
X	else
X		genInstruction(SendMessage, argumentCount);
X	genCode(genLiteral(messagesym));
X}
X
Xstatic boolean unaryContinuation(superReceiver)
Xboolean superReceiver;
X{	int i;
X	boolean sent;
X	object messagesym;
X
X	while (parseok && (token == nameconst)) {
X		/* first check to see if it could be a temp by mistake */
X		for (i=1; i < temporaryTop; i++)
X			if (streq(tokenString, temporaryName[i]))
X				compilWarn("message same as temporary:",
X					tokenString);
X		for (i=1; i < argumentTop; i++)
X			if (streq(tokenString, argumentName[i]))
X				compilWarn("message same as argument:",
X					tokenString);
X		/* the next generates too many spurious messages */
X		/* for (i=1; i < instanceTop; i++)
X			if (streq(tokenString, instanceName[i]))
X				compilWarn("message same as instance",
X					tokenString); */
X
X		sent = false;
X		messagesym = newSymbol(tokenString);
X		/* check for built in messages */
X		if (! superReceiver)
X			for (i = 0; (! sent) && unStrs[i] ; i++)
X				if (streq(tokenString, unStrs[i])) {
X					genInstruction(SendUnary, i);
X					sent = true;
X					}
X		if (! sent) {
X			genMessage(superReceiver, 0, messagesym);
X			}
X		/* once a message is sent to super, reciever is not super */
X		superReceiver = false;
X		ignore nextToken();
X		}
X	return(superReceiver);
X}
X
Xstatic boolean binaryContinuation(superReceiver)
Xboolean superReceiver;
X{	int i;
X	boolean sent, superTerm;
X	object messagesym;
X
X	superReceiver = unaryContinuation(superReceiver);
X	while (parseok && (token == binary)) {
X		messagesym = newSymbol(tokenString);
X		ignore nextToken();
X		superTerm = term();
X		ignore unaryContinuation(superTerm);
X		sent = false;
X		/* check for built in messages */
X		if (! superReceiver) {
X			for (i = 0; (! sent) && binStrs[i]; i++)
X				if (messagesym == binSyms[i]) {
X					genInstruction(SendBinary, i);
X					sent = true;
X					}
X
X			}
X		if (! sent) {
X			genMessage(superReceiver, 1, messagesym);
X			}
X		superReceiver = false;
X		}
X	return(superReceiver);
X}
X
Xstatic int optimizeBlock(instruction, dopop)
Xint instruction;
Xboolean dopop;
X{	int location;
X	boolean saveOB;
X
X	genInstruction(DoSpecial, instruction);
X	location = codeTop;
X	genCode(0);
X	if (dopop)
X		genInstruction(DoSpecial, PopTop);
X	ignore nextToken();
X	if (streq(tokenString, "[")) {
X		ignore nextToken();
X		saveOB = optimizedBlock;
X		optimizedBlock = true;
X		body();
X		optimizedBlock = saveOB;
X		if (! streq(tokenString, "]"))
X			compilError("missing close","after block");
X		ignore nextToken();
X		}
X	else {
X		ignore binaryContinuation(term());
X		genInstruction(SendUnary, 3 /* value command */);
X		}
X	codeArray[location] = codeTop;
X	return(location);
X}
X
Xstatic boolean keyContinuation(superReceiver)
Xboolean superReceiver;
X{	int i, j, argumentCount;
X	boolean sent, superTerm;
X	object messagesym;
X	char pattern[80];
X
X	superReceiver = binaryContinuation(superReceiver);
X	if (token == namecolon) {
X		if (streq(tokenString, "ifTrue:")) {
X			i = optimizeBlock(BranchIfFalse, false);
X			if (streq(tokenString, "ifFalse:")) {
X				codeArray[i] = codeTop + 3;
X				ignore optimizeBlock(Branch, true);
X				}
X			}
X		else if (streq(tokenString, "ifFalse:")) {
X			i = optimizeBlock(BranchIfTrue, false);
X			if (streq(tokenString, "ifTrue:")) {
X				codeArray[i] = codeTop + 3;
X				ignore optimizeBlock(Branch, true);
X				}
X			}
X		else if (streq(tokenString, "whileTrue:")) {
X			j = codeTop;
X			genInstruction(DoSpecial, Duplicate);
X			genInstruction(SendUnary, 3 /* value command */);
X			i = optimizeBlock(BranchIfFalse, false);
X			genInstruction(DoSpecial, PopTop);
X			genInstruction(DoSpecial, Branch);
X			genCode(j);
X			codeArray[i] = codeTop;
X			genInstruction(DoSpecial, PopTop);
X			}
X		else if (streq(tokenString, "and:"))
X			ignore optimizeBlock(AndBranch, false);
X		else if (streq(tokenString, "or:"))
X			ignore optimizeBlock(OrBranch, false);
X		else {
X			pattern[0] = '\0';
X			argumentCount = 0;
X			while (parseok && (token == namecolon)) {
X				ignore strcat(pattern, tokenString);
X				argumentCount++;
X				ignore nextToken();
X				superTerm = term();
X				ignore binaryContinuation(superTerm);
X				}
X			sent = false;
X
X			/* check for predefined messages */
X			messagesym = newSymbol(pattern);
X			if (! superReceiver) {
X				for (i = 0; (! sent) && binStrs[i]; i++)
X					if (messagesym == binSyms[i]) {
X						sent = true;
X						genInstruction(SendBinary, i);
X						}
X
X				for (i = 0; (! sent) && keyStrs[i]; i++)
X					if (messagesym == keySyms[i]) {
X						genInstruction(SendKeyword, i);
X						sent = true;
X						}
X				}
X
X			if (! sent) {
X				genMessage(superReceiver, argumentCount, messagesym);
X				}
X			}
X		superReceiver = false;
X		}
X	return(superReceiver);
X}
X
Xstatic continuation(superReceiver)
Xboolean superReceiver;
X{
X	superReceiver = keyContinuation(superReceiver);
X
X	while (parseok && (token == closing) && streq(tokenString, ";")) {
X		genInstruction(DoSpecial, Duplicate);
X		ignore nextToken();
X		ignore keyContinuation(superReceiver);
X		genInstruction(DoSpecial, PopTop);
X		}
X}
X
Xstatic expression()
X{	boolean superTerm;
X
X	superTerm = term();
X	if (parseok)
X		continuation(superTerm);
X}
X
Xstatic assignment(name)
Xchar *name;
X{	int i;
X	boolean done;
X
X	done = false;
X
X	/* it might be a temporary */
X	for (i = 1; (! done) && (i <= temporaryTop); i++)
X		if (streq(name, temporaryName[i])) {
X			genInstruction(PopTemporary, i-1);
X			done = true;
X			}
X
X	/* or it might be an instance variable */
X	for (i = 1; (! done) && (i <= instanceTop); i++)
X		if (streq(name, instanceName[i])) {
X			genInstruction(PopInstance, i-1);
X			done = true;
X			}
X
X	if (! done)
X		compilError("assignment to unknown name", name);
X}
X
Xstatic statement()
X{	char assignname[80];
X	boolean superReceiver = false;
X
X	if ((token == binary) && streq(tokenString, "^")) {
X		ignore nextToken();
X		expression();
X		if (inBlock)
X			genInstruction(DoSpecial, BlockReturn);
X		else
X			genInstruction(DoSpecial, StackReturn);
X		}
X	else if (token == nameconst) {	/* possible assignment */
X		ignore strcpy(assignname, tokenString);
X		ignore nextToken();
X		if ((token == binary) && streq(tokenString, "<-")) {
X			ignore nextToken();
X			expression();
X			if (inBlock || optimizedBlock)
X				if ((token == closing) && streq(tokenString,"]"))
X					genInstruction(DoSpecial, Duplicate);
X			assignment(assignname);
X			if (inBlock && (token == closing) &&
X				streq(tokenString, "]"))
X				genInstruction(DoSpecial, StackReturn);
X			}
X		else {		/* not an assignment after all */
X			superReceiver = nameTerm(assignname);
X			continuation(superReceiver);
X			if ((token == closing) && streq(tokenString, "]")) {
X				if (inBlock && ! optimizedBlock)
X					genInstruction(DoSpecial, StackReturn);
X				}
X			else
X				genInstruction(DoSpecial, PopTop);
X			}
X		}
X	else {
X		expression();
X		if ((token == closing) && streq(tokenString, "]")) {
X			if (inBlock && ! optimizedBlock)
X				genInstruction(DoSpecial, StackReturn);
X			}
X		else
X			genInstruction(DoSpecial, PopTop);
X		}
X}
X
Xstatic body()
X{
X	if (inBlock || optimizedBlock)
X		if ((token == closing) && streq(tokenString, "]")) {
X			genInstruction(PushConstant, 4);
X			if (! optimizedBlock)
X				genInstruction(DoSpecial, StackReturn);
X			return;
X			}
X
X	while(parseok) {
X		statement();
X		if (token == closing)
X			if (streq(tokenString,".")) {
X				ignore nextToken();
X				if (token == inputend)
X					break;
X				}
X			else
X				break;
X		else
X			if (token == inputend)
X				break;
X		else {
X			compilError("invalid statement ending; token is ",
X				tokenString);
X			}
X		}
X}
X
Xstatic block()
X{	int saveTemporary, argumentCount, fixLocation;
X	boolean saveInBlock, saveOB;
X	object tempsym;
X
X	saveTemporary = temporaryTop;
X	argumentCount = 0;
X	ignore nextToken();
X	if ((token == binary) && streq(tokenString, ":")) {
X		while (parseok && (token == binary) && streq(tokenString,":")) {
X			if (nextToken() != nameconst)
X				compilError("name must follow colon",
X					"in block argument list");
X		        if (++temporaryTop > maxTemporary)
X				maxTemporary = temporaryTop;
X			argumentCount++;
X			if (temporaryTop > temporaryLimit)
X				compilError("too many temporaries in method","");
X			else {
X				tempsym = newSymbol(tokenString);
X				temporaryName[temporaryTop] = charPtr(tempsym);
X				}
X			ignore nextToken();
X			}
X		if ((token != binary) || ! streq(tokenString, "|"))
X			compilError("block argument list must be terminated",
X					"by |");
X		ignore nextToken();
X		}
X	genInstruction(CreateBlock, argumentCount);
X	if (argumentCount != 0){
X		genCode(saveTemporary + 1);
X		}
X	fixLocation = codeTop;
X	genCode(0);
X	saveInBlock = inBlock;
X	saveOB = optimizedBlock;
X	inBlock = true;
X	optimizedBlock = false;
X	body();
X	if ((token == closing) && streq(tokenString, "]"))
X		ignore nextToken();
X	else
X		compilError("block not terminated by ]","");
X	codeArray[fixLocation] = codeTop;
X	inBlock = saveInBlock;
X	optimizedBlock = saveOB;
X	temporaryTop = saveTemporary;
X}
X
Xstatic temporaries()
X{	object tempsym;
X
X	temporaryTop = 0;
X	if ((token == binary) && streq(tokenString, "|")) {
X		ignore nextToken();
X		while (token == nameconst) {
X			if (++temporaryTop > maxTemporary)
X				maxTemporary = temporaryTop;
X			if (temporaryTop > temporaryLimit)
X				compilError("too many temporaries in method","");
X			else {
X				tempsym = newSymbol(tokenString);
X				temporaryName[temporaryTop] = charPtr(tempsym);
X				}
X			ignore nextToken();
X			}
X		if ((token != binary) || ! streq(tokenString, "|"))
X			compilError("temporary list not terminated by bar","");
X		else
X			ignore nextToken();
X		}
X}
X
Xstatic messagePattern()
X{	object argsym;
X
X	argumentTop = 0;
X	ignore strcpy(selector, tokenString);
X	if (token == nameconst)		/* unary message pattern */
X		ignore nextToken();
X	else if (token == binary) {	/* binary message pattern */
X		ignore nextToken();
X		if (token != nameconst) 
X			compilError("binary message pattern not followed by name",selector);
X		argsym = newSymbol(tokenString);
X		argumentName[++argumentTop] = charPtr(argsym);
X		ignore nextToken();
X		}
X	else if (token == namecolon) {	/* keyword message pattern */
X		selector[0] = '\0';
X		while (parseok && (token == namecolon)) {
X			ignore strcat(selector, tokenString);
X			ignore nextToken();
X			if (token != nameconst)
X				compilError("keyword message pattern",
X					"not followed by a name");
X			if (++argumentTop > argumentLimit)
X				compilError("too many arguments in method","");
X			argsym = newSymbol(tokenString);
X			argumentName[argumentTop] = charPtr(argsym);
X			ignore nextToken();
X			}
X		}
X	else
X		compilError("illegal message selector", tokenString);
X}
X
Xboolean parse(method, text)
Xobject method;
Xchar *text;
X{	int i;
X	object bytecodes, theLiterals;
X	byte *bp;
X
X	lexinit(text);
X	parseok = true;
X	codeTop = 0;
X	literalTop = temporaryTop = argumentTop =0;
X	maxTemporary = 0;
X	inBlock = optimizedBlock = false;
X
X	messagePattern();
X	if (parseok)
X		temporaries();
X	if (parseok)
X		body();
X	if (parseok)
X		genInstruction(DoSpecial, SelfReturn);
X
X	if (! parseok)
X		basicAtPut(method, bytecodesInMethod, nilobj);
X	else {
X		bytecodes = newByteArray(codeTop);
X		bp = bytePtr(bytecodes);
X		for (i = 0; i < codeTop; i++) {
X			bp[i] = codeArray[i];
X			}
X		basicAtPut(method, messageInMethod, newSymbol(selector));
X		basicAtPut(method, bytecodesInMethod, bytecodes);
X		if (literalTop > 0) {
X			theLiterals = newArray(literalTop);
X			for (i = 1; i <= literalTop; i++) {
X				basicAtPut(theLiterals, i, literalArray[i]);
X				decr(literalArray[i]);
X				}
X			basicAtPut(method, literalsInMethod, theLiterals);
X			}
X		else
X			basicAtPut(method, literalsInMethod, nilobj);
X		basicAtPut(method, stackSizeInMethod, newInteger(6));
X		basicAtPut(method, temporarySizeInMethod,
X			newInteger(1 + maxTemporary));
X		basicAtPut(method, textInMethod, newStString(text));
X		return(true);
X		}
X	return(false);
X}
/
echo 'x - queen.st'
sed 's/^X//' > queen.st << '/'
XClass Queen Object #row #column #neighbor
XMethod Queen
X	setColumn: aNumber neighbor: aQueen
X		column <- aNumber.
X		neighbor <- aQueen
X
X|
XMethod Queen
X	checkRow: testRow column: testColumn | columnDifference |
X		columnDifference <- testColumn - column.
X		(((row = testRow) or: 
X			[ row + columnDifference = testRow]) or:
X			[ row - columnDifference = testRow])
X				ifTrue: [ ^ true ].
X		(neighbor notNil)
X			ifTrue: [ ^ neighbor checkRow: testRow 
X					column: testColumn ]
X			ifFalse: [ ^ false ]
X
X|
XMethod Queen
X	first
X		(neighbor notNil)
X			ifTrue: [ neighbor first ].
X		row <- 1.
X		^ self testPosition
X
X|
XMethod Queen
X	next
X		(row = 8)
X			ifTrue: [ ((neighbor isNil) or: [neighbor next isNil])
X				ifTrue: [ ^ nil ].
X				row <- 0 ].
X		row <- row + 1.
X		^ self testPosition
X
X|
XMethod Queen
X	testPosition
X		(neighbor isNil) ifTrue: [ ^ self ].
X		(neighbor checkRow: row column: column)
X			ifTrue: [ ^ self next ]
X			ifFalse: [ ^ self ]
X
X|
XMethod Queen
X	result
X		^ ((neighbor isNil)
X			ifTrue: [ List new ]
X			ifFalse: [ neighbor result ] )
X				addLast: row
X
X|
XMethod Test
X	queen		| lastQueen |
X		lastQueen <- nil.
X		(1 to: 8) do: [:i | lastQueen <- Queen new;
X					setColumn: i neighbor: lastQueen ].
X		lastQueen first.
X		(lastQueen result asArray = #(1 5 8 6 3 7 2 4) )
X			ifTrue: ['8 queens test passed' print]
X			ifFalse: [smalltalk error: '8queen test failed']
X
X|
/
echo 'Part 02 of small.v2 complete.'
exit
-- 
For comp.sources.unix stuff, mail to sources at uunet.uu.net.