rsalz@uunet.UU.NET (Rich Salz) (10/04/87)
Submitted-by: Tim Budd <budd@cs.orst.edu>
Posting-number: Volume 11, Issue 86
Archive-name: little-st/part01
The following is version two of the Little Smalltalk system, distributed
in three parts. Little Smalltalk is an interpreter for the language
Smalltalk.
Questions or comments should be sent to Tim Budd,
budd@oregon-state.csnet
budd@cs.orst.edu (128.193.32.1)
{tektronix, hp-pcd}!orstcs!budd
-----------cut here--------------------------------------------
: To unbundle, sh this file
echo unbundling READ_ME 1>&2
cat >READ_ME <<'End'
.\" information on Little Smalltalk, version 2, beta release
.SH
General Overview
.PP
First, the obvious facts. This is not Smalltalk-80, nor even Smalltalk-V.
This is the second version of the Little Smalltalk system, the first version
of which is described in the book recently published by Addison-Wesley*.
.FS
* \fIA Little Smalltalk\fP, by Timothy A. Budd. Published by Addison
Wesley, 1987. In better bookshops everywhere.
.FE
Version two is smaller and faster; does more in Smalltalk, not in C; and is
designed to be more portable to a wider variety of machines (we are working
on versions now for various PCs).
.PP
My attitude towards the language has been
rather cavalier; what I liked I kept and what I didn't like I tossed out.
This is explained in more detail in my book and in the end of this note.
As a consequence, individuals familiar with ST-80 or ST-V will be struck
by how much they are missing, and I make no apologies for this. On the
other hand, you don't find ST-V posted to net.sources. Among the features
you won't find here are metaclasses, class methods, windows, graphics
support, and more.
.PP
What you will find is a small language that does give you the flavor of
object oriented programming at very little cost. We are working to improve
the system, and hope to distribute new versions as we develop them,
as well as porting it to a wide range of machines.
If you find (and preferably, fix!) bugs let us know.
If you make nice additions let us know.
If you want to make complements let us know.
If you want to make complaints let us know.
If you want support you just might be out of luck.
.PP
This software is entirely public domain. You are encouraged to give it
to as many friends as you may have. As a courtesy, I would appreciate it
if you left my name on the code as the author, but I make no other claims
to it (I also, of course, disavow any liability for any bizarre things you
may choose to do with it). Enjoy.
.SH
Building the System
.PP
There are three steps involving in building the system; making the parser
(the component used to generate the initial object image), making the
bytecode interpreter, and making the object image.
.PP
After you have unbundled all the files, to create the parser type
.DS I
make parse
.DE
.PP
The resulting program, called parse, is used to generate the object image
initially loaded into the bytecode interpreter.
.PP
Next, make the interpreter itself by typing
.DS I
make st
.DE
.PP
Note that the interpreter and the parser share some files.
.PP
Finally, produce an initial object image. The image created when you type
.DS I
make sunix
.DE
.LP
is the smallest and fastest. It is a single process version of smalltalk.
A buggy multiprocess version can be created by typing ``make munix''*.
.FS
* Multi processing from munix is done entirely in Smalltalk.
While this is a good idea from the point of view of keeping the bytecode
interpreter small and giving one the greatest flexibility, there seems to
be a dramatic performance penalty. I'm considering the alternatives.
.FE
Of more interest, an image containing test cases (***currently only
the 8 queens***) can be generated by typing ``make stest''.
In the latter case, the command ``test all'', when given in response to the
prompt (see below), runs all the test cases.
.PP
Once you have created an object image, type
.DS I
st
.DE
.LP
to run the system.
By default the image file ``imageFile'' is read. You can optionally
use a different image file by giving the name on the command line following
the st command.
.SH
Getting Started
.PP
When you start version two Little Smalltalk under Unix, you will be given a
prompt.
You can enter expressions in response to the prompt, and the system will
evaluate them (although it will not print the result unless you request it).
For example:
.DS I
> (4 + 5) print
7
.DE
.PP
You can create a new global variable (a variable known every place, including
the command line) by simply inserting a command into the dictionary that
maintains the names of all global variables. You use as key the name of
the new global variable (as a Symbol), and as value the initial value to
be associated with the variable.
.DS I
> globalNames at: #i put: 17
> i print
17
.DE
.PP
Global variables cannot be modified by the assignment arrow. In particular,
the following gives an error:
.DS I
> i <- 16
Compiler error: unknown variable i
.DE
.PP
Global variables can, however, be used in expressions:
.DS I
> (i + 3) print
20
.DE
.PP
The most common use for global variables is creating a new Class. A Class
is simply a global variable, by convention (but only convention) being given
a name beginning with an uppercase letter. For example:
.DS I
> globalNames at: #Employee put: Class new
.DE
.PP
This creates a new class called \fBEmployee\fP, an instance of
class \fBClass\fP. Various messages, understood by instances of class
\fBClass\fP, can be used to initialize various features of this new object.
(This would be a good time to take a peek at the file ``basicclasses'', which
contains a textual description of all the methods used in the standard
classes. Note carefully the methods used in class Class).
.DS I
> globalNames superClass: Object
> globalNames name: #Employee
> globalNames variables: #(department salary)
.DE
.PP
The most important initializing message is \fBaddMethod\fP, which
drops you into an editor (currently only \fIvi\fP), in which you enter
the body of a method. When you exit the editor the method is compiled,
and either entered into the method dictionary for the class (if there
are no errors) or a sequence of error messages are displayed on the output
device.
.PP
To save an object image, type the command
.DS I
smalltalk saveImage
.DE
You will be prompted for the name of the image file.
.SH
Changes from Little Smalltalk version one
.PP
The following changes have been made from version one to version two:
.IP \(bu
The user interface is slightly different. This is most apparent in the way
new classes are added (see above).
.IP \(bu
Much (very much) more of the system is now written in Smalltalk, rather
than C. This allows the user to see, and modify it if they wish.
This also means that the virtual machine is now much smaller.
.IP \(bu
The pseudo variable selfProcess is no longer supported.
The variables true, false and nil are now treated as global variables, not
pseudo variables (see below).
There are plans for adding processes to version two, but they have not
been formalized yet.
.IP \(bu
Global variables are now supported; in fact classes are now simply global
variables, as are the variables true, false, smalltalk and nil.
The global variable globalNames contains the dictionary of all currently
known global variables and their values.
(Pool variables are still not supported).
.IP \(bu
The internal bytecodes are slightly different. In particular, the bytecode
representing ``send to super'' has been eliminated, and a bytecode representing
``do a primitive'' has been added.
.IP \(bu
The Collection hierarchy has been rearranged. The rational for this change
is explained in more detail in another essay.
(possibly not written yet).
.IP \(bu
Some methods, most notably the error message methods, have been moved out
of class Object and into class Smalltalk.
.IP \(bu
The syntax for primitives is different; the keyword \fBprimitive\fP has been
eliminated, and named primitives are now gone as well.
Fewer actions are performed by primitives, having been
replaced by Smalltalk methods.
.IP \(bu
Command line options, such as the fast load feature, have been eliminated.
However, since version two reads in a binary object image, not a textual
file, loading should be considerably faster.
.SH
Electronic Communication
.PP
Here is my address, various net addresses:
.DS I
Tim Budd
Oregon State University
Department of Computer Science
Corvallis, Oregon 97331 USA
(503) 754-3273
budd@oregon-state.csnet
{tektronix, hp-pcd} !orstcs!budd
.DE
.SH
Changes
.PP
I want to emphasize that this is not even a beta-test version (does that
make it an alpha or a gamma version?). I will be making a number of
changes, hopefully just additions to the initial image, in the next
few months. In addition, I hope to prepare versions for other machines,
notably the Macintosh and the IBM PC. I am also encouraging others to
port the system to new machines. If you have done so, please let me
know.
End
echo unbundling Bugs 1>&2
cat >Bugs <<'End'
objects are limited to size 256
this mostly limits the text (char) size of methods - to 512 chars.
this could be fixed by changing memory.c.
nested array literals don't seem to work properly
radices other than 10 aren't implemented.
parser should leave method text in method, so it can be edited dynamically
(does this now, but it should be an option).
The collection hierarchy has been completely reorginized (this isn't a bug)
many of the more obscure messages are left unimplmented.
many of the abstract classes are eliminated
Bags have been eliminated (they can be replaced by lists)
collections are now magnitudes (set subset relations)
The basic classes are somewhat incomplete, in particular
points aren't implemented
radians are implemented (neither are trig functions)
Bytearrays are a bit odd. In particular,
converting to bytearrays gives something too big (by twice)
converting bytearrays to strings can cause bugs if the last
byte is not zero (causing non null terminated strings)
Files aren't implemented;
when they are addMethod and editMethod should be changed to use
Smalltalk files.
Semaphores and processes aren't implemented yet - even in the multiprocess
version
initial experiments aren't encouraging -
they seem to be too slow.
PROJECTS______________________________________________________________
For those with time on their hands and nothing to do, here is a list
of several projects that need doing.
1. Profiling indicates that about 45% of execution time is spent in the
routine ``execute'', in interp.c. Rewrite this in your favorite assembly
language to speed it up.
2. Rewrite the memory manager. Possible changes
a. use garbage collection of some sort
b. allow big objects (bigger than 256 words)
3. Rewrite the process manager in assembly language, permitting the
Smalltalk process stack to exist intermixed with the C
execution stack.
4. Port to your favorite machine, making the interface fit the machine.
End
echo unbundling Makefile 1>&2
cat >Makefile <<'End'
#
# Makefile for Little Smalltalk, version 2
#
CFLAGS = -p -O
COMMONc = memory.c names.c lex.c parser.c
COMMONo = memory.o names.o lex.o parser.o
PARSEc = comp.c $(COMMONc) image.c
PARSEo = comp.o $(COMMONo) image.o
STc = main.c $(COMMONc) process.c primitive.c interp.c
STo = main.o $(COMMONo) process.o primitive.o interp.o
classes = basicclasses unixclasses multclasses unix2classes testclasses
B1F = READ_ME Bugs Makefile at top *.h comp.c image.c main.c process.c
B2F = $(COMMONc) primitive.c interp.c
B3F = $(classes) stest.out
install: parse sunix st
echo "created single process version, see docs for more info"
#
# parse - the object image parser.
# used to build the initial object image
#
parse: $(PARSEo)
cc -o parse $(CFLAGS) $(PARSEo)
parseprint:
pr *.h $(PARSEc) | lpr
parselint:
lint $(PARSEc)
#
# st - the actual bytecode interpreter
# runs bytecodes from the initial image, or another image
#
st: $(STo)
cc $(CFLAGS) -o st $(STo) -lm
stlint:
lint $(STc)
stprint:
pr *.h $(STc) | lpr
report: memory.o report.o
cc -o report memory.o report.o
#
# image - build the initial object image
#
classlpr:
pr $(classes) | lpr
sunix: parse
parse basicclasses unixclasses
munix: parse
parse basicclasses multclasses unix2classes
stest: parse
parse basicclasses unixclasses testclasses
mtest: parse
parse basicclasses multclasses unix2classes testclasses
#
# distribution bundles
#
bundles:
bundle $(B1F) >bundle.1
bundle $(B2F) >bundle.2
bundle $(B3F) >bundle.3
tar:
tar cvf ../smalltalk.v2.tar .
compress -c ../smalltalk.v2.tar >../smalltalk.v2.tar.Z
End
echo unbundling at 1>&2
cat >at <<'End'
.LP
(note: this is the first of a series of essays descriging how various
features of the Little Smalltalk bytecodes work).
.SH
Where It's At
.PP
This short note explains how the messages \fBat:\fP, \fBat:put:\fP, and their
relatives are defined and used in collections. We start by discussing the
simplest form of collections, arrays and strings.
.PP
The message \fBat:\fP is not defined anywhere in class \fBArray\fP or any of
its subclasses. Instead, this message is inherited from
class \fBCollection\fP, which defines it using the following method:
.DS I
\fBat:\fP index
\(ua self at: index
ifAbsent: [ smalltalk error: 'index to at: illegal' ]
.DE
.PP
The functioning of the message \fBerror:\fP is the topic of another essay;
it is sufficient for our purposes to note only that this message prints out
the error string and returns nil. By redefining \fBat:\fP in this fashion,
the subclasses of \fBCollection\fP need not be concerned about how to deal
with errors in cases where no error recovery action has been specified.
.PP
For an array, an index is out of bounds if it is either less than 1 or greater
than the size of the array. This is tested by a method in class \fBArray\fP:
.DS I
\fBincludesKey:\fP index
^ index between: 1 and: self size
.DE
.PP
The message \fBsize\fP is defined in class \fBArray\fP in terms of the
message \fBbasicSize\fP
.DS I
\fBsize\fP
^ self basicSize
.DE
.PP
The message \fBbasicSize\fP (as well as \fBbasicAt:\fP, discussed below)
is inherited from class
\fBObject\fP. It can be used on any object; on non-arrays it returns
the number of instance variables for the object. The messages \fBbasicSize\fP
and \fBbasicAt:put:\fP can be used by system
classes, for example debuggers, to access instance variables in an object
without having explicit access to the instance variables. One must be
careful, however,
\fBbasicAt:\fP produces a system error, and not a Smalltalk error message,
if it is given an index value that is out of range.
.PP
Using \fBincludesKey:\fP for a test, a value is only accessed if the index
is legal. The following method appears in class \fBArray\fP:
.DS I
\fBat:\fP index \fBifAbsent:\fP exceptionBlock
^ (self includesKey: index)
ifTrue: [ self basicAt: index ]
ifFalse: [ exceptionBlock value ]
.DE
.PP
A subclass of \fBArray\fP is the class \fBByteArray\fP. A byte array is a form
of array in which the elements can only take on values from zero to 255, or
to put it another way, values that can be stored in one byte.
On most 16 bit machines, we can store two such bytes in the space it takes
to store one object pointer. Thus, the message \fBsize\fP is redefined
in class \fBByteArray\fP as follows:
.DS I
\fBsize\fP
\(ua self basicSize * 2
.DE
.LP
Note that this implies that byte arrays always have an even number of
elements. Next the message \fBbasicAt:\fP is redefined to use a byte,
instead of object, form of index. This is accomplished using a primitive
method, (the message \fBbasicAt:\fP is handled in a similar fashion in
class \fBObject\fP, only using a different primitive).
.DS I
\fBbasicAt:\fP index
\(ua <26 self index>
.DE
.PP
Like a byte array, a string can also store two byte values in the space
it takes to store a single object pointer. Unlike a byte array, however,
a string can be any length, not just an even length. Therefore the message
\fBsize\fP is redefned in class \fBString\fP, a subclass of \fBByteArray\fP.
.DS I
\fBsize\fP
\(ua <14 self>
.DE
.PP
Another difference between a string and a byte array is that the value
returned by a string must be a character, not an integer. Therefore
\fBbasicAt:\fP must also be redefined. By using the message \fBbasicAt:\fP
defined in \fBByteArray\fP, (the superclass of String, and therefore accessible
via the pseudo variable \fBsuper\fP) the method can obtain the integer value
of the appropriate character. This value is then used to create a new
instance of class \fBChar\fP:
.DS I
\fBbasicAt:\fP index
\(ua Char new; value: (super basicAt: index)
.DE
.PP
A value is placed into an array using the message \fPat:put:\fP. As with
\fBat:\fP, a value should only be placed if the index represents a legal
subscript. This is checked in the following method:
.DS I
\fBat:\fP index \fBput:\fP value
(self includesKey: index)
ifTrue: [ self basicAt: index put: value ]
ifFalse: [ smalltalk error:
'illegal index to at:put: for array' ]
.DE
.PP
As was the case with \fBbasicAt:\fP, one version of \fBbasicAt:put:\fP,
to be used by arrays of objects, is defined as part of class \fBObject\fP.
A different version is found in class \fBByteArray\fP. Finally a third
version, which first checks to see if the argument is a Character, is found
in class \fBString\fP.
.DS I
\fBat:\fP index \fBput:\fP aValue
(aValue isMemberOf: Char)
ifTrue: [ super basicAt: index put: aValue asciiValue ]
ifFalse: [ smalltalk error:
'cannot put non Char into string' ]
.DE
.SH
Exercises
.IP 1.
Describe the sequence of messages used to respond to the following:
.DS B
x \(<- #(1 2 3) at: 2
.DE
.IP 2.
Describe how the execution of the above expression could be speeded up by
adding new methods. Note if your methods are specific to arrays of objects,
arrays of bytes, or strings.
End
echo unbundling top 1>&2
cat >top <<'End'
.SH
Who's On Top?
.PP
One of the most important decisions to be made in designing a new user
interface (or front end) for the Little Smalltalk system is whether the user
interface management code should sit on top of the Smalltalk bytecode
interpreter, setting up commands and invoking the interpreter to execute them,
or underneith the bytecode interpreter, being invoked by Smalltalk, via the
mechanism of primitive methods. Both schemes have advantages and disadvantages
which we will discuss in this essay.
.PP
In a simple interface, placing Smalltalk on top is often easier. The main
driver need only set up one initial call to the Smalltalk bytecode interpreter,
and thereafter everything is done in Smalltalk. For example, we might put
initialization code in a method in class \fBSmalltalk\fP, as follows:
.DS L
Class Smalltalk
getString
\(ua <1>
|
run | string |
[ '> ' printNoReturn.
string <- smalltalk getString.
string notNil ]
whileTrue: [ (string size > 0)
ifTrue: [ smalltalk doIt: string ] ]
]
.DE
.PP
Once the bytecode interpreter is started on the method \fBrun\fP, it will
loop continuously, reading commands from the user (via the method
\fBgetString\fP) and executing them (via the method \fBdoIt:\fP).
Presumably the user has some way of indicating end of input, such as the
unix control-D convention, which causes \fBgetString\fP to return the
value nil. The \fIif\fP statement inside the while loop
insures that if the user simply hits the return key execution will quickly
loop back to the prompt.
.PP
Besides making the initialization for the Little Smalltalk system easy,
this approach also has the advantage of putting more code into Smalltalk
itself, where the user can see it and (presumably) modify it if they wish.
A general guideline is that it is better to put as much into Smalltalk
as possible, since Smalltalk is easier to write and the bytecode representation
usually smaller than the equivalent code in C.
Never the less, there are valid reasons why an implementor might choose
a different technique.
.PP
For example, if there are many other activities which should command the
attention of the controlling program (window updates, mouse motions) the
Smalltalk code may not be able to respond fast enough, or might become too
large and complex to be workable.
In this case the only alternative is to have the front end respond directly
to events, and only invoke the Smalltalk interpreter as time permits.
In basic terms, the front end would perform the loop written in the method
\fBinit\fP shown above (along with handling various other tasks), and then
call upon the method in class \fBSmalltalk\fP
to execute the message \fBdoIt:\fP.
.SH
How to Do It
.PP
In either of the two schemes described above, an important message is
\fBdoIt:\fP, which takes a string (presumably representing a Smalltalk
expression) and performs it. An easy way to perform this message is to
make a method out of the expression, by appending a message pattern
on front, and then pass the string to the method parser. If the method
parser is successful, the method can then be executed.
.DS L
doIt: aString | method |
method <- Method new.
method text: ( 'proceed ', aString ).
(method compileWithClass: Smalltalk)
ifTrue: [ method executeWith: #( 0 ) ]
.DE
.PP
The message \fBcompileWithClass:\fP compiles the method as if it was
appearing as part of class Smalltalk. If compilation is successful,
the message \fBexecuteWith:\fP executes the message, using as arguments
the array #(0). The array that accompanies this message must have at
least one element, as the first value is used as the receiver for
the method.
Similar techniques can be used for the message \fBprintIt:\fP, if desired.
.SH
The Other End
.PP
The opposite extreme from the front end are those messages that originate
within the bytecode interpreter and must be communicated to the user.
We can divide these values into four categories:
.IP 1.
System errors. These are all funnelled through the routine sysError(), found
in memory.c. System errors are caused by dramatically wrong conditions,
and should generally cause the system to abort after printing the message
passed as argument to sysError().
.IP 2.
Compiler errors. As we noted above, the method compiler is used to
parse expressions typed directly at the keyboard, so these message can
also arise in that manner. These are all funnelled through the routine
compilError(), found in parse.c. These should print their arguments
(two strings), in an appropriate location on the users screen.
Execution continues normally after call.
.IP 3.
Various primitives, found in primitive.c, are also used to print strings
on the users terminal. In particular, an appropriate meaning should be
given to the message \fBprint\fP in class \fBString\fP. What appropriate
means is undoubtedly implementation specific.
.IP 4.
Finally, and perhaps most importantly, there must be some means provided
to allow users to enter and edit methods. The interface for this task
is standard; instances of class \fBClass\fP must respond to the messages
\fBaddMethod\fP and \fBeditMethod:\fP, the latter taking as argument a
symbol representing the name of a method. How they achieve their two
tasks is, however, implementation specific.
Under Unix, a simple implementation adds a new primitive for Strings;
this primitive copies the string into a temporary file, starts up the
editor on the file, and returns the contents of the file when the user
exits the editor. Having this capability, the method editing code
can be given as follows. In class \fBClass\fP:
.DS L
addMethod
self doEdit: ''
|
editMethod: name | theMethod |
theMethod <- methods at: name
ifAbsent: [ 'no such method ' print. \(ua nil ].
self doEdit: theMethod text
|
doEdit: startingText | theMethod |
theMethod <- Method new;
text: startingText edit.
(theMethod compileWithClass: self)
ifTrue: [ methods at: theMethod name put: theMethod ]
.DE
.LP
And in class \fBString\fP:
.DS L
edit
\(ua <19 self>
.DE
.LP
Here primitive 19 performs all the tasks of creating the temporary file,
starting the editor, and creating the string representing the file
contents when the editor is exited.
.PP
Alternative techniques, for example using windowing, would undoubtedly
be more complicated.
End
echo unbundling env.h 1>&2
cat >env.h <<'End'
/*
Little Smalltalk, version two
Written by Tim Budd, Oregon State University, July 1987
environmental factors
This include file gathers together environmental factors that
are likely to change from one C compiler to another, or from
one system to another. These include:
1. The type boolean. A typedef is used to define this;
on some older systems typedefs may not work, and a
# define statement should be used instead.
The only other typedef appears in memory.h
2. The statement ignore - this appears on functions being used
as procedures. It has no effect except as a lint
silencer, and is also the only place where the type
``void'' appears. If your system doesn't support void,
define ignore to be nothing.
3. The datatype byte - an 8-bit unsigned quantity.
On some systems the datatype ``unsigned char'' does not
work - for these some experimentation may be necessary.
The macro byteToInt() converts a byte value into an integer.
Again a typedef is used, which can be replaced by a
define.
4. If your system does not have enumerated constants, the define
NOENUM should be given, in which case enumerated constants
are replaced by defines.
5. The define constant INITIALIMAGE should give the name (as a path)
of the default standard object image file.
*/
# define true 1
# define false 0
typedef int boolean;
# define ignore (void)
typedef unsigned char byte;
# define byteToInt(b) (b)
# define INITIALIMAGE "imageFile"
# define TEMPFILENAME "/usr/tmp/lstXXXXXX"
End
echo unbundling interp.h 1>&2
cat >interp.h <<'End'
/*
Little Smalltalk, version 2
Written by Tim Budd, Oregon State University, July 1987
*/
/*
symbolic definitions for the bytecodes
*/
# define Extended 0
# define PushInstance 1
# define PushArgument 2
# define PushTemporary 3
# define PushLiteral 4
# define PushConstant 5
# define PushGlobal 6
# define PopInstance 7
# define PopTemporary 8
# define SendMessage 9
# define SendUnary 10
# define SendBinary 11
# define SendKeyword 12
# define DoPrimitive 13
# define CreateBlock 14
# define DoSpecial 15
/* types of special instructions (opcode 15) */
# define SelfReturn 1
# define StackReturn 2
# define BlockReturn 3
# define Duplicate 4
# define PopTop 5
# define Branch 6
# define BranchIfTrue 7
# define BranchIfFalse 8
# define AndBranch 9
# define OrBranch 10
# define SendToSuper 11
End
echo unbundling lex.h 1>&2
cat >lex.h <<'End'
/*
Little Smalltalk, version 2
Written by Tim Budd, Oregon State University, July 1987
*/
/*
values returned by the lexical analyzer
*/
# ifndef NOENUMS
typedef enum tokensyms { nothing, name, namecolon,
intconst, floatconst, charconst, symconst,
arraybegin, strconst, binary, closing, inputend} tokentype;
# endif
# ifdef NOENUMS
# define tokentype int
# define nothing 0
# define name 1
# define namecolon 2
# define intconst 3
# define floatconst 4
# define charconst 5
# define symconst 6
# define arraybegin 7
# define strconst 8
# define binary 9
# define closing 10
# define inputend 11
# endif
extern tokentype nextToken();
extern tokentype token; /* token variety */
extern char tokenString[]; /* text of current token */
extern int tokenInteger; /* integer (or character) value of token */
extern double tokenFloat; /* floating point value of token */
End
echo unbundling memory.h 1>&2
cat >memory.h <<'End'
/*
Little Smalltalk, version 2
Written by Tim Budd, Oregon State University, July 1987
*/
# define streq(a,b) (strcmp(a,b) == 0)
/*
The first major decision to be made in the memory manager is what
an entity of type object really is. Two obvious choices are a pointer (to
the actual object memory) or an index into an object table. We decided to
use the latter, although either would work.
Similarly, one can either define the token object using a typedef,
or using a define statement. Either one will work (check this?)
*/
typedef short object;
/*
The memory module itself is defined by over a dozen routines.
All of these could be defined by procedures, and indeed this was originally
done. However, for efficiency reasons, many of these procedures can be
replaced by macros generating in-line code. For the latter approach
to work, the structure of the object table must be known. For this reason,
it is given here. Note, however, that ONLY the macros described in this
file make use of this structure: therefore modifications or even complete
replacement is possible as long as the interface remains consistent
*/
struct objectStruct {
object class;
short referenceCount;
byte size;
byte type;
object *memory;
};
extern struct objectStruct objectTable[];
/* types of object memory */
# define objectMemory 0
# define byteMemory 1
# define charMemory 2
# define floatMemory 3
# define isString(x) ((objectTable[x>>1].type == charMemory) || (objectTable[x>>1].type == byteMemory))
# define isFloat(x) (objectTable[x>>1].type == floatMemory)
/*
The most basic routines to the memory manager are incr and decr,
which increment and decrement reference counts in objects. By separating
decrement from memory freeing, we could replace these as procedure calls
by using the following macros:*/
extern object incrobj;
# define incr(x) if ((incrobj=(x))&&!isInteger(incrobj)) \
objectTable[incrobj>>1].referenceCount++
# define decr(x) if (((incrobj=x)&&!isInteger(incrobj))&&\
(--objectTable[incrobj>>1].referenceCount<=0)) sysDecr(incrobj);
/*
notice that the argument x is first assigned to a global variable; this is
in case evaluation of x results in side effects (such as assignment) which
should not be repeated. */
# ifndef incr
extern void incr();
# endif
# ifndef decr
extern void decr();
# endif
/*
The next most basic routines in the memory module are those that
allocate blocks of storage. There are three routines:
allocObject(size) - allocate an array of objects
allocByte(size) - allocate an array of bytes
allocChar(size) - allocate an array of character values
allocSymbol(value) - allocate a string value
allocInt(value) - allocate an integer value
allocFloat(value) - allocate a floating point object
again, these may be macros, or they may be actual procedure calls
*/
extern object alcObject(); /* the actual routine */
# define allocObject(size) alcObject(size, objectMemory)
# define allocByte(size) alcObject(size, byteMemory)
# define allocChar(size) alcObject(size, charMemory)
extern object allocSymbol();
# define allocInt(value) ((value<0)?value:(value<<1)+1)
extern object allocFloat();
/*
integer objects are (but need not be) treated specially.
In this memory manager, negative integers are just left as is, but
position integers are changed to x*2+1. Either a negative or an odd
number is therefore an integer, while a nonzero even number is an
object pointer (multiplied by two). Zero is reserved for the object ``nil''
Since newInteger does not fill in the class field, it can be given here.
If it was required to use the class field, it would have to be deferred
until names.h
*/
extern object intobj;
# define isInteger(x) ((x) & 0x8001)
# define newInteger(x) ( (intobj = x)<0 ? intobj : (intobj<<1)+1 )
# define intValue(x) ( (intobj = x)<0 ? intobj : (intobj>>1) )
/*
in addition to alloc floating point routine given above,
another routine must be provided to go the other way. Note that
the routine newFloat, which fills in the class field as well, must
wait until the global name table is known, in names.h
*/
extern double floatValue();
/*
there are four routines used to access fields within an object.
Again, some of these could be replaced by macros, for efficiency
basicAt(x, i) - ith field (start at 1) of object x
basicAtPut(x, i, v) - put value v in object x
byteAt(x, i) - ith field (start at 0) of object x
byteAtPut(x, i, v) - put value v in object x
*/
# define basicAt(x,i) (sysMemPtr(x)[i-1])
# ifndef basicAt
extern object basicAt();
# endif
# ifndef basicAtPut
extern void basicAtPut();
# endif
# ifndef byteAt
extern int byteAt();
# endif
# ifndef byteAtPut
extern void byteAtPut();
# endif
/*
Finally, a few routines (or macros) are used to access or set
class fields and size fields of objects
*/
# define classField(x) objectTable[x>>1].class
# define setClass(x,y) incr(classField(x)=y)
# define objectSize(x) byteToInt(objectTable[x>>1].size)
# define sysMemPtr(x) objectTable[x>>1].memory
extern object sysobj;
# define memoryPtr(x) (isInteger(sysobj = x)?(object *) 0:sysMemPtr(sysobj))
# define bytePtr(x) ((byte *) memoryPtr(x))
# define charPtr(x) ((char *) memoryPtr(x))
# define nilobj (object) 0
/*
these two objects are the source of all objects in the system
*/
extern object symbols;
extern object globalNames;
End
echo unbundling names.h 1>&2
cat >names.h <<'End'
/*
Little Smalltalk, version 2
Written by Tim Budd, Oregon State University, July 1987
*/
/*
names and sizes of internally object used internally in the system
*/
# define classSize 6
# define nameInClass 1
# define sizeInClass 2
# define methodsInClass 3
# define superClassInClass 4
# define variablesInClass 5
# define methodSize 6
# define textInMethod 1
# define messageInMethod 2
# define bytecodesInMethod 3
# define literalsInMethod 4
# define stackSizeInMethod 5
# define temporarySizeInMethod 6
# define contextSize 6
# define methodInContext 1
# define methodClassInContext 2
# define argumentsInContext 3
# define temporariesInContext 4
# define blockSize 6
# define contextInBlock 1
# define argumentCountInBlock 2
# define argumentLocationInBlock 3
# define bytecountPositionInBlock 4
# define creatingInterpreterInBlock 5
# define InterpreterSize 6
# define contextInInterpreter 1
# define previousInterpreterInInterpreter 2
# define creatingInterpreterInInterpreter 3
# define stackInInterpreter 4
# define stackTopInInterpreter 5
# define byteCodePointerInInterpreter 6
extern object nameTableLookup();
# define globalSymbol(s) nameTableLookup(globalNames, newSymbol(s))
extern object trueobj; /* the pseudo variable true */
extern object falseobj; /* the pseudo variable false */
extern object smallobj; /* the pseudo variable smalltalk */
extern object blockclass; /* the class ``Block'' */
extern object contextclass; /* the class ``Context'' */
extern object intclass; /* the class ``Integer'' */
extern object intrclass; /* the class ``Interpreter'' */
extern object symbolclass; /* the class ``Symbol'' */
extern object stringclass; /* the class ``String'' */
extern object newSymbol(); /* new smalltalk symbol */
extern object newArray(); /* new array */
extern object newStString(); /* new smalltalk string */
extern object newFloat(); /* new floating point number */
End
echo unbundling process.h 1>&2
cat >process.h <<'End'
/*
Little Smalltalk, version 2
Written by Tim Budd, Oregon State University, July 1987
*/
/*
constants and types used by process manager.
See process.c and interp.c for more details.
*/
/*
if there are no enumerated types, make tasks simply integer constants
*/
# ifdef NOENUMS
# define taskType int
# define sendMessageTask 1
# define sendSuperTask 2
# define ReturnTask 3
# define BlockReturnTask 4
# define BlockCreateTask 5
# define ContextExecuteTask 6
#endif
# ifndef NOENUMS
typedef enum {sendMessageTask, sendSuperTask, ReturnTask, BlockReturnTask,
BlockCreateTask, ContextExecuteTask} taskType;
# endif
extern int finalStackTop; /* stack top when finished with interpreter */
extern int finalByteCounter; /* bytecode counter when finished with interpreter */
extern int argumentsOnStack; /* position of arguments on stack for mess send */
extern object messageToSend; /* message to send */
extern object returnedObject; /* object returned from message */
extern taskType finalTask; /* next task to do (see below) */
End
echo unbundling comp.c 1>&2
cat >comp.c <<'End'
/*
Little Smalltalk, version 2
Written by Tim Budd, Oregon State University, July 1987
Unix specific front end for the initial object image maker
*/
# include <stdio.h>
# include "env.h"
# include "memory.h"
# include "names.h"
main(argc, argv)
int argc;
char **argv;
{ FILE *fp;
int i;
initMemoryManager();
buildInitialNameTables();
if (argc == 1)
readFile(stdin);
else
for (i = 1; i < argc; i++) {
fp = fopen(argv[i], "r");
if (fp == NULL)
sysError("can't open file", argv[i]);
else {
readFile(fp);
ignore fclose(fp);
}
}
fp = fopen("imageFile", "w");
if (fp == NULL) sysError("error during image file open","imageFile");
imageWrite(fp);
ignore fclose(fp);
}
End
echo unbundling image.c 1>&2
cat >image.c <<'End'
/*
Little Smalltalk, version 2
Written by Tim Budd, Oregon State University, July 1987
routines used in the making of the initial object image
*/
# include <stdio.h>
# include "env.h"
# include "memory.h"
# include "names.h"
# include "lex.h"
# define SymbolTableSize 71
# define GlobalNameTableSize 53
# define MethodTableSize 39
# define globalNameSet(sym, value) nameTableInsert(globalNames, sym, value)
/*
the following classes are used repeately, so we put them in globals.
*/
static object ObjectClass;
static object ClassClass;
static object LinkClass;
static object DictionaryClass;
static object ArrayClass;
/*
we read the input a line at a time, putting lines into the following
buffer. In addition, all methods must also fit into this buffer.
*/
# define TextBufferSize 1024
static char textBuffer[TextBufferSize];
/*
nameTableInsert is used to insert a symbol into a name table.
see names.c for futher information on name tables
*/
nameTableInsert(table, symbol, value)
object table, symbol, value;
{ object link, newLink, nextLink, entry;
int hash;
if (objectSize(table) < 3)
sysError("attempt to insert into","too small name table");
else {
hash = 3 * ( symbol % (objectSize(table) / 3));
entry = basicAt(table, hash+1);
if ((entry == nilobj) || (entry == symbol)) {
basicAtPut(table, hash+1, symbol);
basicAtPut(table, hash+2, value);
}
else {
newLink = allocObject(3);
incr(newLink);
setClass(newLink, globalSymbol("Link"));
basicAtPut(newLink, 1, symbol);
basicAtPut(newLink, 2, value);
link = basicAt(table, hash+3);
if (link == nilobj)
basicAtPut(table, hash+3, newLink);
else
while(1)
if (basicAt(link,1) == symbol) {
basicAtPut(link, 2, value);
break;
}
else if ((nextLink = basicAt(link, 3)) == nilobj) {
basicAtPut(link, 3, newLink);
break;
}
else
link = nextLink;
decr(newLink);
}
}
}
/*
there is sort of a chicken and egg problem about building the
first classes.
in order to do it, you need symbols,
but in order to make symbols, you need the class Symbol.
the routines makeClass and buildInitialNameTable attempt to get
carefully get around this initialization problem
*/
static object makeClass(name)
char *name;
{ object theClass, theSymbol;
/* this can only be called once newSymbol works properly */
theClass = allocObject(classSize);
theSymbol = newSymbol(name);
basicAtPut(theClass, nameInClass, theSymbol);
globalNameSet(theSymbol, theClass);
setClass(theClass, ClassClass);
return(theClass);
}
buildInitialNameTables()
{ object symbolString, classString;
int hash;
char *p;
/* build the table that contains all symbols */
symbols = allocObject(2 * SymbolTableSize);
incr(symbols);
/* build the table that contains all global names */
globalNames = allocObject(3 * GlobalNameTableSize);
incr(globalNames);
/* next create class Symbol, so we can call newSymbol */
/* notice newSymbol uses the global variable symbolclass */
symbolString = allocSymbol("Symbol");
symbolclass = allocObject(classSize);
setClass(symbolString, symbolclass);
basicAtPut(symbolclass, nameInClass, symbolString);
/* we recreate the hash computation used by newSymbol */
hash = 0;
for (p = "Symbol"; *p; p++)
hash += *p;
if (hash < 0) hash = - hash;
hash %= (objectSize(symbols) / 2);
basicAtPut(symbols, 2*hash + 1, symbolString);
globalNameSet(symbolString, symbolclass);
/* now the routine newSymbol should work properly */
/* now go on to make class Class so we can call makeClass */
ClassClass = allocObject(classSize);
classString = newSymbol("Class");
basicAtPut(ClassClass, nameInClass, classString);
globalNameSet(classString, ClassClass);
setClass(ClassClass, ClassClass);
setClass(symbolclass, ClassClass);
/* now create a few other important classes */
ObjectClass = makeClass("Object");
LinkClass = makeClass("Link");
setClass(nilobj, makeClass("UndefinedObject"));
DictionaryClass = makeClass("Dictionary");
ArrayClass = makeClass("Array");
setClass(symbols, DictionaryClass);
setClass(globalNames, DictionaryClass);
globalNameSet(newSymbol("globalNames"), globalNames);
}
/*
findClass gets a class object,
either by finding it already or making it
in addition, it makes sure it has a size, by setting
the size to zero if it is nil.
*/
static object findClass(name)
char *name;
{ object newobj;
newobj = globalSymbol(name);
if (newobj == nilobj)
newobj = makeClass(name);
if (basicAt(newobj, sizeInClass) == nilobj)
basicAtPut(newobj, sizeInClass, newInteger(0));
return(newobj);
}
/*
readDeclaration reads a declaration of a class
*/
static readDeclaration()
{ object classObj, super, vars;
int i, size, instanceTop;
object instanceVariables[15];
if (nextToken() != name)
sysError("bad file format","no name in declaration");
classObj = findClass(tokenString);
size = 0;
if (nextToken() == name) { /* read superclass name */
super = findClass(tokenString);
basicAtPut(classObj, superClassInClass, super);
size = intValue(basicAt(super, sizeInClass));
ignore nextToken();
}
if (token == name) { /* read instance var names */
instanceTop = 0;
while (token == name) {
instanceVariables[instanceTop++] = newSymbol(tokenString);
size++;
ignore nextToken();
}
vars = newArray(instanceTop);
for (i = 0; i < instanceTop; i++)
basicAtPut(vars, i+1, instanceVariables[i]);
basicAtPut(classObj, variablesInClass, vars);
}
basicAtPut(classObj, sizeInClass, newInteger(size));
}
/*
readInstance - read an instance directive
*/
static readInstance()
{ object classObj, newObj;
int size;
if (nextToken() != name)
sysError("no name","following instance command");
classObj = globalSymbol(tokenString);
if (nextToken() != name)
sysError("no instance name","in instance command");
/* now make a new instance of the class -
note that we can't do any initialization */
size = intValue(basicAt(classObj, sizeInClass));
newObj = allocObject(size);
setClass(newObj, classObj);
globalNameSet(newSymbol(tokenString), newObj);
}
/*
readClass reads a class method description
*/
static readClass(fd)
FILE *fd;
{ object classObj, methTable, theMethod, selector;
char *eoftest, lineBuffer[80];
/* if we haven't done it already, read symbols now */
if (trueobj == nilobj)
initCommonSymbols();
if (nextToken() != name)
sysError("missing name","following Class keyword");
classObj = findClass(tokenString);
setInstanceVariables(classObj);
fprintf(stderr,"class %s\n", charPtr(basicAt(classObj, nameInClass)));
/* find or create a methods table */
methTable = basicAt(classObj, methodsInClass);
if (methTable == nilobj) {
methTable = allocObject(MethodTableSize);
setClass(methTable, globalSymbol("Dictionary"));
basicAtPut(classObj, methodsInClass, methTable);
}
/* now go read the methods */
do {
textBuffer[0] = '\0';
while((eoftest = fgets(lineBuffer, 80, fd)) != NULL) {
if ((lineBuffer[0] == '|') || (lineBuffer[0] == ']'))
break;
ignore strcat(textBuffer, lineBuffer);
}
if (eoftest == NULL) {
sysError("unexpected end of file","while reading method");
break;
}
/* now we have a method */
theMethod = allocObject(methodSize);
setClass(theMethod, globalSymbol("Method"));
if (parse(theMethod, textBuffer)) {
selector = basicAt(theMethod, messageInMethod);
fprintf(stderr,"method %s\n", charPtr(selector));
nameTableInsert(methTable, selector, theMethod);
}
else {
/* get rid of unwanted method */
incr(theMethod);
decr(theMethod);
fprintf(stderr,"push return to continue\n");
gets(textBuffer);
}
} while (lineBuffer[0] != ']');
}
/*
readFile reads a class descriptions file
*/
readFile(fd)
FILE *fd;
{
while(fgets(textBuffer, TextBufferSize, fd) != NULL) {
lexinit(textBuffer);
if (token == inputend)
; /* do nothing, get next line */
else if ((token == binary) && streq(tokenString, "*"))
; /* do nothing, its a comment */
else if ((token == name) && streq(tokenString, "Declare"))
readDeclaration();
else if ((token == name) && streq(tokenString,"Instance"))
readInstance();
else if ((token == name) && streq(tokenString,"Class"))
readClass(fd);
else
fprintf("unknown line %s\n", textBuffer);
}
}
End
echo unbundling main.c 1>&2
cat >main.c <<'End'
/*
Little Smalltalk, version 2
Written by Tim Budd, Oregon State University, July 1987
driver (front-end) for bytecode interpreter.
*/
# include <stdio.h>
# include "env.h"
# include "memory.h"
# include "names.h"
# include "interp.h"
extern int processStackTop;
extern object processStack[];
extern char tempfilename[];
main(argc, argv)
int argc;
char **argv;
{
FILE *fp;
initMemoryManager();
if ((argc == 1) || ((argc > 1) && streq(argv[1],"-"))){
fp = fopen(INITIALIMAGE,"r");
if (fp == NULL)
sysError("cannot read image file",INITIALIMAGE);
}
else {
fp = fopen(argv[1], "r");
if (fp == NULL)
sysError("cannot read image file", argv[1]);
}
imageRead(fp);
ignore fclose(fp);
initCommonSymbols();
ignore strcpy(tempfilename, TEMPFILENAME);
ignore mktemp(tempfilename);
fprintf(stderr,"initially %d objects\n", objcount());
/* now we are ready to start */
prpush(smallobj);
sendMessage(newSymbol("init"), getClass(smallobj), 0);
flushstack();
fprintf(stderr,"finally %d objects\n", objcount());
if (argc > 2) {
fp = fopen(argv[2],"w");
if (fp == NULL)
sysError("cannot write image file",argv[2]);
fprintf(stderr,"creating image file %s\n", argv[2]);
imageWrite(fp);
ignore fclose(fp);
}
}
End
echo unbundling process.c 1>&2
cat >process.c <<'End'
/*
Little Smalltalk, version 2
Written by Tim Budd, Oregon State University, July 1987
Process Manager
This module manages the stack of pending processes.
SendMessage is called when it is desired to send a message to an
object. It looks up the method associated with the class of
the receiver, then executes it.
A block context is created only when it is necessary, and when it
is required the routine executeFromContext is called instead of
sendMessage.
DoInterp is called by a primitive method to execute an interpreter,
it returns the interpreter to which execution should continue
following execution.
*/
# include <stdio.h>
# include "env.h"
# include "memory.h"
# include "names.h"
# include "process.h"
# define ProcessStackMax 2000
/* values set by interpreter when exiting */
int finalStackTop; /* stack top when finished with interpreter */
int finalByteCounter; /* bytecode counter when finished with interpreter */
int argumentsOnStack; /* position of arguments on stack for mess send */
object messageToSend; /* message to send */
object returnedObject; /* object returned from message */
taskType finalTask; /* next task to do (see below) */
static object blockReturnContext;
object processStack[ProcessStackMax];
int processStackTop = 0;
/*
we cache recently used methods, in case we want them again
*/
# define ProcessCacheSize 101 /* a suitable prime number */
struct {
object startClass, messageSymbol, methodClass, theMethod;
} methodCache[ProcessCacheSize];
prpush(newobj)
object newobj;
{
incr(processStack[processStackTop++] = newobj);
if (processStackTop >= ProcessStackMax)
sysError("stack overflow","process stack");
}
/* flush out cache so new methods can be read in */
flushMessageCache()
{ int i;
for (i = 0; i < ProcessCacheSize; i++)
methodCache[i].messageSymbol = nilobj;
}
static object findMethod(hash, message, startingClass)
int hash;
object message, startingClass;
{ object method, class, methodtable;
/* first examine cache */
if ((methodCache[hash].messageSymbol == message) &&
(methodCache[hash].startClass == startingClass)) {
/* found it in cache */
method = methodCache[hash].theMethod;
}
else { /* must look in methods tables */
method = nilobj;
class = startingClass;
while ( class != nilobj ) {
methodtable = basicAt(class, methodsInClass);
if (methodtable != nilobj)
method = nameTableLookup(methodtable, message);
if (method != nilobj) {
/* fill in cache */
methodCache[hash].messageSymbol = message;
methodCache[hash].startClass = startingClass;
methodCache[hash].methodClass = class;
methodCache[hash].theMethod = method;
class = nilobj;
}
else
class = basicAt(class, superClassInClass);
}
}
return(method);
}
/* newContext - create a new context. Note this returns three values,
via side effects
*/
static newContext(method, methodClass, contextobj, argobj, tempobj)
object method, methodClass, *contextobj, argobj, *tempobj;
{ int temporarysize;
*contextobj = allocObject(contextSize);
incr(*contextobj);
setClass(*contextobj, contextclass);
basicAtPut(*contextobj, methodInContext, method);
basicAtPut(*contextobj, methodClassInContext, methodClass);
basicAtPut(*contextobj, argumentsInContext, argobj);
temporarysize = intValue(basicAt(method, temporarySizeInMethod));
*tempobj = newArray(temporarysize);
basicAtPut(*contextobj, temporariesInContext, *tempobj);
}
sendMessage(message, startingClass, argumentPosition)
object message, startingClass;
int argumentPosition;
{ object method, methodClass, size;
object contextobj, tempobj, argobj, errMessage;
int i, hash, bytecounter, temporaryPosition, errloc;
int argumentsize, temporarySize;
boolean done;
/* compute size of arguments part of stack */
argumentsize = processStackTop - argumentPosition;
hash = (message + startingClass) % ProcessCacheSize;
method = findMethod(hash, message, startingClass);
/*fprintf(stderr,"sending message %s class %s\n", charPtr(message), charPtr(basicAt(startingClass, nameInClass)));*/
if (method == nilobj) { /* didn't find it */
errMessage = newSymbol("class:doesNotRespond:");
if (message == errMessage)
/* better give up */
sysError("didn't find method", charPtr(message));
else {
errloc = processStackTop;
prpush(smallobj);
prpush(startingClass);
prpush(message);
sendMessage(errMessage, getClass(smallobj), errloc);
}
}
else { /* found it, start execution */
/* initialize things for execution */
bytecounter = 0;
done = false;
/* allocate temporaries */
temporaryPosition = processStackTop;
size = basicAt(method, temporarySizeInMethod);
if (! isInteger(size))
sysError("temp size not integer","in method");
else
for (i = temporarySize = intValue(size); i > 0; i--)
prpush(nilobj);
methodClass = methodCache[hash].methodClass;
while( ! done ) {
execute(method, bytecounter,
processStack, processStackTop,
&processStack[argumentPosition],
&processStack[temporaryPosition]);
bytecounter = finalByteCounter;
processStackTop = finalStackTop;
switch(finalTask) {
case sendMessageTask:
sendMessage(messageToSend,
getClass(processStack[argumentsOnStack]),
argumentsOnStack);
if (finalTask == BlockReturnTask)
done = true;
break;
case sendSuperTask:
sendMessage(messageToSend,
basicAt(methodCache[hash].methodClass, superClassInClass),
argumentsOnStack);
if (finalTask == BlockReturnTask)
done = true;
break;
case ContextExecuteTask:
contextobj = messageToSend;
executeFromContext(contextobj,
argumentsOnStack);
decr(contextobj);
if (finalTask == ReturnTask)
processStack[processStackTop++] = returnedObject;
else
done = true;
break;
case BlockCreateTask:
/* block is in returnedObject, we just add */
/* context info but first we must */
/* create the context */
argobj = newArray(argumentsize);
newContext(method, methodClass, &contextobj, argobj, &tempobj);
for (i = 1; i <= argumentsize; i++) {
basicAtPut(argobj, i, processStack[argumentPosition + i - 1]);
}
for (i = 1; i <= temporarySize; i++) {
basicAtPut(tempobj, i, processStack[temporaryPosition + i - 1]);
}
basicAtPut(returnedObject, contextInBlock, contextobj);
processStack[processStackTop++] = returnedObject;
/* we now execute using context - */
/* so that changes to temp will be */
/* recorded properly */
executeFromContext(contextobj, bytecounter);
while (processStackTop > argumentPosition) {
decr(processStack[--processStackTop]);
processStack[processStackTop] = nilobj;
}
/* if it is a block return, */
/* see if it is our context */
/* if so, make into a simple return */
/* otherwise pass back to caller */
/* we can decr, since only nums are */
/* important */
decr(contextobj);
if (finalTask == BlockReturnTask) {
if (blockReturnContext != contextobj)
return;
}
finalTask = ReturnTask;
/* fall into return code */
case ReturnTask:
while (processStackTop > argumentPosition) {
decr(processStack[--processStackTop]);
processStack[processStackTop] = nilobj;
}
/* note that ref count is picked up */
/* from the interpreter */
processStack[processStackTop++] = returnedObject;
done = true;
break;
default:
sysError("unknown task","in sendMessage");
}
}
}
/*fprintf(stderr,"returning from message %s\n", charPtr(message));*/
}
/*
execute from a context rather than from the process stack
*/
executeFromContext(context, bytecounter)
object context;
int bytecounter;
{ object method, methodclass, arguments, temporaries;
boolean done = false;
method = basicAt(context, methodInContext);
methodclass = basicAt(context, methodClassInContext);
arguments = basicAt(context, argumentsInContext);
temporaries = basicAt(context, temporariesInContext);
while (! done) {
execute(method, bytecounter, processStack, processStackTop,
memoryPtr(arguments), memoryPtr(temporaries));
bytecounter = finalByteCounter;
processStackTop = finalStackTop;
switch(finalTask) {
case sendMessageTask:
sendMessage(messageToSend,
getClass(processStack[argumentsOnStack]),
argumentsOnStack);
if (finalTask == BlockReturnTask)
done = true;
break;
case sendSuperTask:
sendMessage(messageToSend,
basicAt(methodclass, superClassInClass),
argumentsOnStack);
if (finalTask == BlockReturnTask)
done = true;
break;
case BlockCreateTask:
/* block is in returnedObject already */
/* just add our context to it */
basicAtPut(returnedObject, contextInBlock, context);
processStack[processStackTop++] = returnedObject;
break;
case BlockReturnTask:
blockReturnContext = context;
/* fall into next case and return */
case ReturnTask:
/* exit and let caller handle it */
done = true;
break;
default:
sysError("unknown task","in context execute");
}
}
}
flushstack()
{
while (processStackTop > 0) {
decr(processStack[--processStackTop]);
processStack[processStackTop] = nilobj;
}
}
static interpush(interp, value)
object interp, value;
{
int stacktop;
object stack;
stacktop = 1 + intValue(basicAt(interp, stackTopInInterpreter));
stack = basicAt(interp, stackInInterpreter);
basicAtPut(stack, stacktop, value);
basicAtPut(interp, stackTopInInterpreter, newInteger(stacktop));
}
object doInterp(interpreter)
object interpreter;
{ object context, method, arguments, temporaries, stack;
object prev, contextobj, obj, argobj, class, newinterp, tempobj;
int i, hash, argumentSize, bytecounter, stacktop;
context = basicAt(interpreter, contextInInterpreter);
method = basicAt(context, methodInContext);
arguments = basicAt(context, argumentsInContext);
temporaries = basicAt(context, temporariesInContext);
stack = basicAt(interpreter, stackInInterpreter);
stacktop = intValue(basicAt(interpreter, stackTopInInterpreter));
bytecounter = intValue(basicAt(interpreter, byteCodePointerInInterpreter));
execute(method, bytecounter, memoryPtr(stack), stacktop,
memoryPtr(arguments), memoryPtr(temporaries));
basicAtPut(interpreter, stackTopInInterpreter, newInteger(finalStackTop));
basicAtPut(interpreter, byteCodePointerInInterpreter, newInteger(finalByteCounter));
switch(finalTask) {
case sendMessageTask:
case sendSuperTask:
/* first gather up arguments */
argumentSize = finalStackTop - argumentsOnStack;
argobj = newArray(argumentSize);
for (i = argumentSize; i >= 1; i--) {
obj = basicAt(stack, finalStackTop);
basicAtPut(argobj, i, obj);
basicAtPut(stack, finalStackTop, nilobj);
finalStackTop--;
}
/* now go look up method */
if (finalTask == sendMessageTask)
class = getClass(basicAt(argobj, 1));
else
class = basicAt(basicAt(context,
methodClassInContext), superClassInClass);
hash = (messageToSend + class) % ProcessCacheSize;
method = findMethod(hash, messageToSend, class);
if (method == nilobj) {
/* didn't find it, change message */
incr(argobj); /* get rid of old args */
decr(argobj);
argobj = newArray(3);
basicAtPut(argobj, 1, smallobj);
basicAtPut(argobj, 2, class);
basicAtPut(argobj, 3, messageToSend);
class = getClass(smallobj);
messageToSend = newSymbol("class:doesNotRespond:");
hash = (messageToSend + class) % ProcessCacheSize;
method = findMethod(hash, messageToSend, class);
if (method == nilobj) /* oh well */
sysError("cant find method",charPtr(messageToSend));
}
newContext(method, methodCache[hash].methodClass, &contextobj, argobj, &tempobj);
basicAtPut(interpreter, stackTopInInterpreter, newInteger(finalStackTop));
argumentsOnStack = 0;
/* fall into context execute */
case ContextExecuteTask:
if (finalTask == ContextExecuteTask) {
contextobj = messageToSend;
}
newinterp = allocObject(InterpreterSize);
setClass(newinterp, intrclass);
basicAtPut(newinterp, contextInInterpreter, contextobj);
basicAtPut(newinterp, previousInterpreterInInterpreter, interpreter);
/* this shouldn't be 15, but what should it be?*/
basicAtPut(newinterp, stackInInterpreter, newArray(15));
basicAtPut(newinterp, stackTopInInterpreter, newInteger(0));
basicAtPut(newinterp, byteCodePointerInInterpreter, newInteger(argumentsOnStack));
decr(contextobj);
return(newinterp);
break;
case BlockCreateTask:
basicAtPut(returnedObject, contextInBlock, context);
prev = basicAt(interpreter, creatingInterpreterInInterpreter);
if (prev == nilobj)
prev = interpreter;
basicAtPut(returnedObject, creatingInterpreterInBlock, prev);
interpush(interpreter, returnedObject);
decr(returnedObject);
return(interpreter);
case BlockReturnTask:
interpreter = basicAt(interpreter, creatingInterpreterInInterpreter);
/* fall into return task */
case ReturnTask:
prev = basicAt(interpreter, previousInterpreterInInterpreter);
if (prev != nilobj) {
interpush(prev, returnedObject);
}
/* get rid of excess ref count */
decr(returnedObject);
return(prev);
default:
sysError("unknown final task","doInterp");
}
return(nilobj);
}
;
}