4785 lines
117 KiB
C
4785 lines
117 KiB
C
|
|
#include <assert.h>
|
|
#include <ctype.h>
|
|
#include <math.h>
|
|
#include <setjmp.h>
|
|
#include <signal.h>
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
#include <string.h>
|
|
#include <time.h>
|
|
|
|
#define streq(a,b) (strcmp(a,b) == 0)
|
|
|
|
typedef void* addr;
|
|
|
|
typedef enum {false,true} bool;
|
|
|
|
typedef unsigned char byte;
|
|
|
|
typedef unsigned short hwrd;
|
|
|
|
typedef unsigned int word;
|
|
|
|
/*
|
|
Some kinds of objects are small enough and used often enough that it can
|
|
be worthwhile to tightly encode the entire representation (both a class
|
|
reference and a value). We refer to them using "encoded values" and
|
|
treat a subset of the host's signed integer range this way.
|
|
*/
|
|
typedef struct {
|
|
bool flg: 1; /* true */
|
|
int dat: 31;
|
|
} encVal;
|
|
|
|
inline encVal encValueOf(int x)
|
|
{
|
|
encVal ans = {true,x};
|
|
return(ans);
|
|
}
|
|
|
|
inline int intValueOf(encVal x)
|
|
{
|
|
return(x.dat);
|
|
}
|
|
|
|
/*
|
|
The safest and easiest way to find out if a value can be embedded
|
|
(encoded) without losing information is to try it and test whether or
|
|
not it works.
|
|
*/
|
|
inline bool canEmbed(int x)
|
|
{
|
|
return(intValueOf(encValueOf(x)) == x);
|
|
}
|
|
|
|
/*
|
|
Objects which are not referenced using encoded values must be referenced
|
|
by other means. We refer to them using "encoded pointers" and treat the
|
|
datum as an index into an "object table".
|
|
*/
|
|
typedef struct {
|
|
bool flg: 1; /* false */
|
|
word dat: 31;
|
|
} encPtr;
|
|
|
|
inline encPtr encIndexOf(word x)
|
|
{
|
|
encPtr ans = {false,x};
|
|
return(ans);
|
|
}
|
|
|
|
inline word oteIndexOf(encPtr x)
|
|
{
|
|
return(x.dat);
|
|
}
|
|
|
|
/*
|
|
Any part of an object representation that isn't kept in either an
|
|
encoded value or an object table entry is kept elsewhere in the host's
|
|
main memory. We call that part of the object "von Neumann space" and
|
|
keep a pointer to it. Mapping between field counts and address units is
|
|
done using a scale factor expressed as a shift count. We distinguish
|
|
between objects whose fields do or don't contain object references. We
|
|
distinguish between objects whose fields have or haven't been traced.
|
|
We call objects which might not be transitively accessible from any root
|
|
object(s) "volatile". Within the object table, we distinguish between
|
|
entries that are or aren't available.
|
|
*/
|
|
typedef struct {
|
|
addr vnspc;
|
|
word shift: 3;
|
|
bool orefs: 1;
|
|
bool mrked: 1;
|
|
bool voltl: 1;
|
|
bool avail: 1;
|
|
word :25;
|
|
} otbEnt;
|
|
|
|
/*
|
|
We keep track of how large a given von Neumann space is in address
|
|
units. This "space count" is used along with the scale factor to derive
|
|
a field count, among other things. We also need to keep track of the
|
|
class of which a given object is an instance.
|
|
*/
|
|
typedef struct {
|
|
word spcct;
|
|
encPtr class;
|
|
} ot2Ent;
|
|
|
|
#define otbLob 0
|
|
#define otbHib 65535
|
|
#define otbDom ((otbHib + 1) - otbLob)
|
|
|
|
otbEnt* objTbl = NULL;
|
|
/*otbEnt objTbl[otbDom];*/
|
|
|
|
ot2Ent* ob2Tbl = NULL;
|
|
/*ot2Ent ob2Tbl[otbDom];*/
|
|
|
|
/*
|
|
An object reference is either an encoded value or an encoded pointer.
|
|
We distinguish one from the other by means of the flag (q.v.) defined in
|
|
both. N.B.: This kind of overlay definition would be safer and easier
|
|
both to specify and to use if compilers would pack a 1-bit flag and a
|
|
<wordSize-1>-bit union (resp. field) into a <wordSize>-bit struct.
|
|
*/
|
|
typedef union {
|
|
encVal val;
|
|
encPtr ptr;
|
|
} objRef;
|
|
|
|
inline bool isValue(objRef x)
|
|
{
|
|
return(x.val.flg == true);
|
|
}
|
|
|
|
inline bool isIndex(objRef x)
|
|
{
|
|
return(x.ptr.flg == false);
|
|
}
|
|
|
|
inline bool ptrEq(objRef x, objRef y)
|
|
{
|
|
return(x.ptr.flg == y.ptr.flg && x.ptr.dat == y.ptr.dat);
|
|
}
|
|
|
|
inline bool ptrNe(objRef x, objRef y)
|
|
{
|
|
return(x.ptr.flg != y.ptr.flg || x.ptr.dat != y.ptr.dat);
|
|
}
|
|
|
|
inline addr addressOf(encPtr x)
|
|
{
|
|
return(objTbl[oteIndexOf(x)].vnspc);
|
|
}
|
|
|
|
inline void addressOfPut(encPtr x, addr v)
|
|
{
|
|
objTbl[oteIndexOf(x)].vnspc = v;
|
|
}
|
|
|
|
inline word scaleOf(encPtr x)
|
|
{
|
|
return(objTbl[oteIndexOf(x)].shift);
|
|
}
|
|
|
|
inline void scaleOfPut(encPtr x, word v)
|
|
{
|
|
objTbl[oteIndexOf(x)].shift = v;
|
|
}
|
|
|
|
inline bool isObjRefs(encPtr x)
|
|
{
|
|
return(objTbl[oteIndexOf(x)].orefs == true);
|
|
}
|
|
|
|
inline void isObjRefsPut(encPtr x, bool v)
|
|
{
|
|
objTbl[oteIndexOf(x)].orefs = v;
|
|
}
|
|
|
|
inline bool isMarked(encPtr x)
|
|
{
|
|
return(objTbl[oteIndexOf(x)].mrked == true);
|
|
}
|
|
|
|
inline void isMarkedPut(encPtr x, bool v)
|
|
{
|
|
objTbl[oteIndexOf(x)].mrked = v;
|
|
}
|
|
|
|
inline bool isVolatile(encPtr x)
|
|
{
|
|
return(objTbl[oteIndexOf(x)].voltl == true);
|
|
}
|
|
|
|
inline void isVolatilePut(encPtr x, bool v)
|
|
{
|
|
objTbl[oteIndexOf(x)].voltl = v;
|
|
}
|
|
|
|
inline bool isAvail(encPtr x)
|
|
{
|
|
return(objTbl[oteIndexOf(x)].avail == true);
|
|
}
|
|
|
|
inline void isAvailPut(encPtr x, bool v)
|
|
{
|
|
objTbl[oteIndexOf(x)].avail = v;
|
|
}
|
|
|
|
inline word spaceOf(encPtr x)
|
|
{
|
|
return(ob2Tbl[oteIndexOf(x)].spcct);
|
|
}
|
|
|
|
inline void spaceOfPut(encPtr x, word v)
|
|
{
|
|
ob2Tbl[oteIndexOf(x)].spcct = v;
|
|
}
|
|
|
|
inline encPtr classOf(encPtr x)
|
|
{
|
|
return(ob2Tbl[oteIndexOf(x)].class);
|
|
}
|
|
|
|
inline void classOfPut(encPtr x, encPtr v)
|
|
{
|
|
#if 0
|
|
assert(isIndex(v));
|
|
#endif
|
|
isVolatilePut(v, false);
|
|
ob2Tbl[oteIndexOf(x)].class = v;
|
|
}
|
|
|
|
inline word countOf(encPtr x)
|
|
{
|
|
return(spaceOf(x) >> scaleOf(x));
|
|
}
|
|
|
|
inline objRef orefOf(encPtr x, word i)
|
|
{
|
|
return(((objRef*) objTbl[oteIndexOf(x)].vnspc) [i-1]);
|
|
}
|
|
|
|
inline void orefOfPut(encPtr x, word i, objRef v)
|
|
{
|
|
if(isIndex(v))
|
|
isVolatilePut(v.ptr, false);
|
|
((objRef*) objTbl[oteIndexOf(x)].vnspc) [i-1] = v;
|
|
}
|
|
|
|
inline byte byteOf(encPtr x, word i)
|
|
{
|
|
return(((byte*) objTbl[oteIndexOf(x)].vnspc) [i-1]);
|
|
}
|
|
|
|
inline void byteOfPut(encPtr x, word i, byte v)
|
|
{
|
|
((byte*) objTbl[oteIndexOf(x)].vnspc) [i-1] = v;
|
|
}
|
|
|
|
inline hwrd hwrdOf(encPtr x, word i)
|
|
{
|
|
return(((hwrd*) objTbl[oteIndexOf(x)].vnspc) [i-1]);
|
|
}
|
|
|
|
inline void hwrdOfPut(encPtr x, word i, hwrd v)
|
|
{
|
|
((hwrd*) objTbl[oteIndexOf(x)].vnspc) [i-1] = v;
|
|
}
|
|
|
|
inline word wordOf(encPtr x, word i)
|
|
{
|
|
return(((word*) objTbl[oteIndexOf(x)].vnspc) [i-1]);
|
|
}
|
|
|
|
inline void wordOfPut(encPtr x, word i, word v)
|
|
{
|
|
((word*) objTbl[oteIndexOf(x)].vnspc) [i-1] = v;
|
|
}
|
|
|
|
#define pointerList encIndexOf(0)
|
|
|
|
int availCount(void)
|
|
{
|
|
int ans = 0;
|
|
encPtr tmp = classOf(pointerList);
|
|
while(oteIndexOf(tmp) != 0) {
|
|
ans++;
|
|
tmp = classOf(tmp);
|
|
}
|
|
return(ans);
|
|
}
|
|
|
|
void freePointer(encPtr x)
|
|
{
|
|
#if 0
|
|
assert(false);
|
|
#endif
|
|
scaleOfPut(x,0);
|
|
isObjRefsPut(x,false);
|
|
isMarkedPut(x,false);
|
|
isVolatilePut(x,false);
|
|
isAvailPut(x,true);
|
|
classOfPut(x,classOf(pointerList));
|
|
classOfPut(pointerList,x);
|
|
}
|
|
|
|
void freeStorage(addr x)
|
|
{
|
|
#if 0
|
|
assert(false);
|
|
#endif
|
|
assert(x != NULL);
|
|
free(x);
|
|
}
|
|
|
|
void visit(objRef x)
|
|
{
|
|
if(isIndex(x)) {
|
|
if(isMarked(x.ptr) == false) {
|
|
/* then it's the first time we've visited it, so: */
|
|
isMarkedPut(x.ptr, true);
|
|
visit((objRef) classOf(x.ptr));
|
|
if(isObjRefs(x.ptr)) {
|
|
objRef* f = addressOf(x.ptr);
|
|
objRef* p = (void*)f + spaceOf(x.ptr);
|
|
while(p != f)
|
|
visit(*--p);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
extern encPtr symbols;
|
|
|
|
/*
|
|
It's safe to ignore volatile objects only when all necessary object
|
|
references are stored in object memory. Currently, that's the case
|
|
only upon a successful return from the interpreter. In operation, the
|
|
interpreter does many stores directly into host memory (as opposed to
|
|
indirectly via the object table). As a result, volatile objects will
|
|
remain flagged as such. Tracing them ensures that they (and their
|
|
referents) get kept.
|
|
*/
|
|
void reclaim(bool all)
|
|
{
|
|
word ord;
|
|
encPtr ptr;
|
|
visit((objRef) symbols);
|
|
if(all)
|
|
for(ord = otbLob; ord <= otbHib; ord++) {
|
|
ptr = encIndexOf(ord);
|
|
if(isVolatile(ptr))
|
|
visit((objRef) ptr);
|
|
}
|
|
classOfPut(pointerList,encIndexOf(0));
|
|
for(ord = otbHib; ord > otbLob; ord--) { /*fix*/
|
|
ptr = encIndexOf(ord);
|
|
if(isAvail(ptr)) {
|
|
freePointer(ptr);
|
|
continue;
|
|
}
|
|
if(isMarked(ptr)) {
|
|
if(!all) /*stored but not by orefOfPut...*/
|
|
isVolatilePut(ptr,false);
|
|
isMarkedPut(ptr,false);
|
|
continue;
|
|
}
|
|
if(spaceOf(ptr)) {
|
|
freeStorage(addressOf(ptr));
|
|
addressOfPut(ptr,0);
|
|
spaceOfPut(ptr,0);
|
|
}
|
|
freePointer(ptr);
|
|
}
|
|
}
|
|
|
|
encPtr newPointer(void)
|
|
{
|
|
encPtr ans = classOf(pointerList);
|
|
if(oteIndexOf(ans) == 0) {
|
|
reclaim(true);
|
|
ans = classOf(pointerList);
|
|
}
|
|
assert(oteIndexOf(ans) != 0);
|
|
classOfPut(pointerList,classOf(ans));
|
|
#if 0
|
|
classOfPut(ans,encIndexOf(0));
|
|
#endif
|
|
isVolatilePut(ans, true);
|
|
isAvailPut(ans, false);
|
|
return(ans);
|
|
}
|
|
|
|
addr newStorage(word bytes)
|
|
{
|
|
addr ans;
|
|
if(bytes) {
|
|
ans = calloc(bytes,sizeof(byte));
|
|
assert(ans != NULL);
|
|
}
|
|
else
|
|
ans = NULL;
|
|
return(ans);
|
|
}
|
|
|
|
void coldObjectTable(void)
|
|
{
|
|
word i;
|
|
objTbl = calloc(otbDom,sizeof(otbEnt));
|
|
assert(objTbl != NULL);
|
|
ob2Tbl = calloc(otbDom,sizeof(ot2Ent));
|
|
assert(ob2Tbl != NULL);
|
|
for(i=otbLob; i != otbHib; i++) {
|
|
classOfPut(encIndexOf(i),encIndexOf(i+1));
|
|
isAvailPut(encIndexOf(i+1), true);
|
|
}
|
|
}
|
|
|
|
void warmObjectTableOne(void)
|
|
{
|
|
word i;
|
|
objTbl = calloc(otbDom,sizeof(otbEnt));
|
|
assert(objTbl != NULL);
|
|
ob2Tbl = calloc(otbDom,sizeof(ot2Ent));
|
|
assert(ob2Tbl != NULL);
|
|
for(i=otbLob; i != otbHib; i++)
|
|
isAvailPut(encIndexOf(i+1), true);
|
|
}
|
|
|
|
void warmObjectTableTwo(void)
|
|
{
|
|
word i;
|
|
classOfPut(pointerList,encIndexOf(0));
|
|
for(i = otbHib; i > otbLob; i--) /*fix*/
|
|
if(isAvail(encIndexOf(i)))
|
|
freePointer(encIndexOf(i));
|
|
}
|
|
|
|
extern encPtr nilObj;
|
|
|
|
encPtr allocOrefObj(word n)
|
|
{
|
|
encPtr ptr = newPointer();
|
|
word num = n << 2; /*fix*/
|
|
addr mem = newStorage(num);
|
|
addressOfPut(ptr,mem);
|
|
scaleOfPut(ptr,2); /*fix*/
|
|
isObjRefsPut(ptr,true);
|
|
spaceOfPut(ptr,num);
|
|
classOfPut(ptr,nilObj);
|
|
while(n--)
|
|
*((encPtr*)mem)++ = nilObj;
|
|
return(ptr);
|
|
}
|
|
|
|
encPtr allocByteObj(word n)
|
|
{
|
|
encPtr ptr = newPointer();
|
|
word num = n << 0; /*fix*/
|
|
addr mem = newStorage(num);
|
|
addressOfPut(ptr,mem);
|
|
scaleOfPut(ptr,0); /*fix*/
|
|
isObjRefsPut(ptr,false);
|
|
spaceOfPut(ptr,num);
|
|
classOfPut(ptr,nilObj);
|
|
return(ptr);
|
|
}
|
|
|
|
encPtr allocHWrdObj(word n)
|
|
{
|
|
encPtr ptr = newPointer();
|
|
word num = n << 1; /*fix*/
|
|
addr mem = newStorage(num);
|
|
addressOfPut(ptr,mem);
|
|
scaleOfPut(ptr,1); /*fix*/
|
|
isObjRefsPut(ptr,false);
|
|
spaceOfPut(ptr,num);
|
|
classOfPut(ptr,nilObj);
|
|
return(ptr);
|
|
}
|
|
|
|
encPtr allocWordObj(word n)
|
|
{
|
|
encPtr ptr = newPointer();
|
|
word num = n << 2; /*fix*/
|
|
addr mem = newStorage(num);
|
|
addressOfPut(ptr,mem);
|
|
scaleOfPut(ptr,2); /*fix*/
|
|
isObjRefsPut(ptr,false);
|
|
spaceOfPut(ptr,num);
|
|
classOfPut(ptr,nilObj);
|
|
return(ptr);
|
|
}
|
|
|
|
encPtr allocZStrObj(char* zstr)
|
|
{
|
|
encPtr ptr = newPointer();
|
|
word num = strlen(zstr) + 1;
|
|
addr mem = newStorage(num);
|
|
addressOfPut(ptr,mem);
|
|
scaleOfPut(ptr,0); /*fix*/
|
|
isObjRefsPut(ptr,false);
|
|
spaceOfPut(ptr,num);
|
|
classOfPut(ptr,nilObj);
|
|
(void) strcpy(addressOf(ptr), zstr);
|
|
return(ptr);
|
|
}
|
|
|
|
#define classSize 5
|
|
#define nameInClass 1
|
|
#define sizeInClass 2
|
|
#define methodsInClass 3
|
|
#define superClassInClass 4
|
|
#define variablesInClass 5
|
|
|
|
#define methodSize 8
|
|
#define textInMethod 1
|
|
#define messageInMethod 2
|
|
#define bytecodesInMethod 3
|
|
#define literalsInMethod 4
|
|
#define stackSizeInMethod 5
|
|
#define temporarySizeInMethod 6
|
|
#define methodClassInMethod 7
|
|
#define watchInMethod 8
|
|
|
|
#define methodStackSize(x) intValueOf(orefOf(x, stackSizeInMethod).val)
|
|
#define methodTempSize(x) intValueOf(orefOf(x, temporarySizeInMethod).val)
|
|
|
|
#define contextSize 6
|
|
#define linkPtrInContext 1
|
|
#define methodInContext 2
|
|
#define argumentsInContext 3
|
|
#define temporariesInContext 4
|
|
|
|
#define blockSize 6
|
|
#define contextInBlock 1
|
|
#define argumentCountInBlock 2
|
|
#define argumentLocationInBlock 3
|
|
#define bytecountPositionInBlock 4
|
|
|
|
#define processSize 3
|
|
#define stackInProcess 1
|
|
#define stackTopInProcess 2
|
|
#define linkPtrInProcess 3
|
|
|
|
encPtr nilObj = {false,1}; /* pseudo variable nil */
|
|
|
|
encPtr trueObj = {false,2}; /* pseudo variable true */
|
|
encPtr falseObj = {false,3}; /* pseudo variable false */
|
|
|
|
#if 0
|
|
encPtr hashTable = {false,4};
|
|
#endif
|
|
encPtr symbols = {false,5};
|
|
encPtr classes = {false,1};
|
|
|
|
encPtr unSyms[16] = {};
|
|
encPtr binSyms[32] = {};
|
|
|
|
#define globalValue(s) nameTableLookup(symbols, s)
|
|
|
|
void sysError(char*, char*);
|
|
|
|
encPtr newLink(encPtr key, encPtr value);
|
|
|
|
void nameTableInsert(encPtr dict, word hash, encPtr key, encPtr value)
|
|
{
|
|
encPtr table,
|
|
link,
|
|
nwLink,
|
|
nextLink,
|
|
tablentry;
|
|
|
|
/* first get the hash table */
|
|
table = orefOf(dict, 1).ptr;
|
|
|
|
if (countOf(table) < 3)
|
|
sysError("attempt to insert into", "too small name table");
|
|
else {
|
|
hash = 3 * (hash % (countOf(table) / 3));
|
|
assert(hash <= countOf(table)-3);
|
|
tablentry = orefOf(table, hash + 1).ptr;
|
|
if (ptrEq((objRef) tablentry, (objRef) nilObj) || ptrEq((objRef) tablentry, (objRef) key)) {
|
|
orefOfPut(table, hash + 1, (objRef) key);
|
|
orefOfPut(table, hash + 2, (objRef) value);
|
|
} else {
|
|
nwLink = newLink(key, value);
|
|
link = orefOf(table, hash + 3).ptr;
|
|
if (ptrEq((objRef) link, (objRef) nilObj)) {
|
|
orefOfPut(table, hash + 3, (objRef) nwLink);
|
|
} else
|
|
while (1)
|
|
if (ptrEq(orefOf(link, 1), (objRef) key)) {
|
|
/* get rid of unwanted Link */
|
|
isVolatilePut(nwLink, false);
|
|
orefOfPut(link, 2, (objRef) value);
|
|
break;
|
|
} else if (ptrEq((objRef) (nextLink = orefOf(link, 3).ptr), (objRef) nilObj)) {
|
|
orefOfPut(link, 3, (objRef) nwLink);
|
|
break;
|
|
} else
|
|
link = nextLink;
|
|
}
|
|
}
|
|
}
|
|
|
|
encPtr hashEachElement(encPtr dict, word hash, int(*fun)(encPtr))
|
|
{
|
|
encPtr table,
|
|
key,
|
|
value,
|
|
link;
|
|
encPtr *hp;
|
|
word tablesize;
|
|
|
|
table = orefOf(dict, 1).ptr;
|
|
|
|
/* now see if table is valid */
|
|
if ((tablesize = countOf(table)) < 3)
|
|
sysError("system error", "lookup on null table");
|
|
else {
|
|
hash = 1 + (3 * (hash % (tablesize / 3)));
|
|
assert(hash <= tablesize-2);
|
|
hp = (encPtr*)addressOf(table) + (hash - 1);
|
|
key = *hp++; /* table at: hash */
|
|
value = *hp++; /* table at: hash + 1 */
|
|
if (ptrNe((objRef) key, (objRef) nilObj) && (*fun) (key))
|
|
return value;
|
|
for (link = *hp; ptrNe((objRef) link, (objRef) nilObj); link = *hp) {
|
|
hp = addressOf(link);
|
|
key = *hp++; /* link at: 1 */
|
|
value = *hp++; /* link at: 2 */
|
|
if (ptrNe((objRef) key, (objRef) nilObj) && (*fun) (key))
|
|
return value;
|
|
}
|
|
}
|
|
return nilObj;
|
|
}
|
|
|
|
int strHash(char* str)
|
|
{
|
|
int hash;
|
|
char *p;
|
|
|
|
hash = 0;
|
|
for (p = str; *p; p++)
|
|
hash += *p;
|
|
if (hash < 0)
|
|
hash = -hash;
|
|
/* make sure it can be a smalltalk integer */
|
|
if (hash > 16384)
|
|
hash >>= 2;
|
|
return hash;
|
|
}
|
|
|
|
word symHash(encPtr sym)
|
|
{
|
|
return(oteIndexOf(sym));
|
|
}
|
|
|
|
char* charBuffer = 0;
|
|
encPtr objBuffer = {true,0};
|
|
|
|
int strTest(encPtr key)
|
|
{
|
|
if (addressOf(key) && streq(addressOf(key), charBuffer)) {
|
|
objBuffer = key;
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
encPtr globalKey(char* str)
|
|
{
|
|
charBuffer = str;
|
|
objBuffer = nilObj;
|
|
(void) hashEachElement(symbols, strHash(str), strTest);
|
|
return objBuffer;
|
|
}
|
|
|
|
encPtr nameTableLookup(encPtr dict, char* str)
|
|
{
|
|
charBuffer = str;
|
|
return hashEachElement(dict, strHash(str), strTest);
|
|
}
|
|
|
|
char *unStrs[] = {
|
|
"isNil", "notNil", "value", "new", "class", "size", "basicSize",
|
|
"print", "printString",
|
|
0
|
|
};
|
|
|
|
char *binStrs[] = {
|
|
"+", "-", "<", ">", "<=", ">=", "=", "~=", "*", "quo:", "rem:",
|
|
"bitAnd:", "bitXor:", "==", ",", "at:", "basicAt:", "do:", "coerce:",
|
|
"error:", "includesKey:", "isMemberOf:", "new:", "to:", "value:",
|
|
"whileTrue:", "addFirst:", "addLast:",
|
|
0
|
|
};
|
|
|
|
encPtr newSymbol(char* str);
|
|
|
|
void initCommonSymbols(void)
|
|
{
|
|
int i;
|
|
|
|
assert(ptrEq((objRef)nilObj,(objRef)globalValue("nil")));
|
|
|
|
assert(ptrEq((objRef)trueObj,(objRef)globalValue("true")));
|
|
assert(ptrEq((objRef)falseObj,(objRef)globalValue("false")));
|
|
|
|
#if 0
|
|
assert(ptrEq(hashTable,globalValue("hashTable")));
|
|
#endif
|
|
assert(ptrEq((objRef)symbols,(objRef)globalValue("symbols")));
|
|
classes = globalValue("classes");
|
|
|
|
for(i = 0; i != 16; i++)
|
|
unSyms[i] = nilObj;
|
|
for (i = 0; unStrs[i]; i++)
|
|
unSyms[i] = newSymbol(unStrs[i]);
|
|
for(i = 0; i != 32; i++)
|
|
binSyms[i] = nilObj;
|
|
for (i = 0; binStrs[i]; i++)
|
|
binSyms[i] = newSymbol(binStrs[i]);
|
|
}
|
|
|
|
encPtr arrayClass = {false,1}; /* the class Array */
|
|
encPtr intClass = {false,1}; /* the class Integer */
|
|
encPtr stringClass = {false,1}; /* the class String */
|
|
encPtr symbolClass = {false,1}; /* the class Symbol */
|
|
|
|
double floatValue(encPtr o)
|
|
{
|
|
double d;
|
|
|
|
(void) memcpy(&d, addressOf(o), sizeof(double));
|
|
return d;
|
|
}
|
|
|
|
encPtr newArray(int size)
|
|
{
|
|
encPtr newObj;
|
|
|
|
newObj = allocOrefObj(size);
|
|
if (ptrEq((objRef) arrayClass, (objRef) nilObj))
|
|
arrayClass = globalValue("Array");
|
|
classOfPut(newObj, arrayClass);
|
|
return newObj;
|
|
}
|
|
|
|
encPtr newBlock(void)
|
|
{
|
|
encPtr newObj;
|
|
|
|
newObj = allocOrefObj(blockSize);
|
|
classOfPut(newObj, globalValue("Block"));
|
|
return newObj;
|
|
}
|
|
|
|
encPtr newByteArray(int size)
|
|
{
|
|
encPtr newobj;
|
|
|
|
newobj = allocByteObj(size);
|
|
classOfPut(newobj, globalValue("ByteArray"));
|
|
return newobj;
|
|
}
|
|
|
|
encPtr newChar(int value)
|
|
{
|
|
encPtr newobj;
|
|
|
|
newobj = allocOrefObj(1);
|
|
orefOfPut(newobj, 1, (objRef) encValueOf(value));
|
|
classOfPut(newobj, globalValue("Char"));
|
|
return (newobj);
|
|
}
|
|
|
|
encPtr newClass(char* name)
|
|
{
|
|
encPtr newMeta;
|
|
encPtr newInst;
|
|
char* metaName;
|
|
encPtr nameMeta;
|
|
encPtr nameInst;
|
|
|
|
newMeta = allocOrefObj(classSize);
|
|
classOfPut(newMeta, globalValue("Metaclass"));
|
|
orefOfPut(newMeta, sizeInClass, (objRef) encValueOf(classSize));
|
|
newInst = allocOrefObj(classSize);
|
|
classOfPut(newInst, newMeta);
|
|
|
|
metaName = newStorage(strlen(name) + 4 + 1);
|
|
(void) strcpy(metaName, name);
|
|
(void) strcat(metaName, "Meta");
|
|
|
|
/* now make names */
|
|
nameMeta = newSymbol(metaName);
|
|
orefOfPut(newMeta, nameInClass, (objRef) nameMeta);
|
|
nameInst = newSymbol(name);
|
|
orefOfPut(newInst, nameInClass, (objRef) nameInst);
|
|
|
|
/* now put in global symbols and classes tables */
|
|
nameTableInsert(symbols, strHash(metaName), nameMeta, newMeta);
|
|
nameTableInsert(symbols, strHash(name), nameInst, newInst);
|
|
if(ptrNe((objRef) classes, (objRef) nilObj)) {
|
|
nameTableInsert(classes, symHash(nameMeta), nameMeta, newMeta);
|
|
nameTableInsert(classes, symHash(nameInst), nameInst, newInst);
|
|
}
|
|
|
|
freeStorage(metaName);
|
|
|
|
return(newInst);
|
|
}
|
|
|
|
encPtr newContext(int link, encPtr method, encPtr args, encPtr temp)
|
|
{
|
|
encPtr newObj;
|
|
|
|
newObj = allocOrefObj(contextSize);
|
|
classOfPut(newObj, globalValue("Context"));
|
|
orefOfPut(newObj, linkPtrInContext, (objRef) encValueOf(link));
|
|
orefOfPut(newObj, methodInContext, (objRef) method);
|
|
orefOfPut(newObj, argumentsInContext, (objRef) args);
|
|
orefOfPut(newObj, temporariesInContext, (objRef) temp);
|
|
return newObj;
|
|
}
|
|
|
|
encPtr newDictionary(int size)
|
|
{
|
|
encPtr newObj;
|
|
|
|
newObj = allocOrefObj(1);
|
|
classOfPut(newObj, globalValue("Dictionary"));
|
|
orefOfPut(newObj, 1, (objRef) newArray(size));
|
|
return newObj;
|
|
}
|
|
|
|
encPtr newFloat(double d)
|
|
{
|
|
encPtr newObj;
|
|
|
|
newObj = allocByteObj(sizeof(double));
|
|
(void) memcpy(addressOf(newObj), &d, sizeof(double));
|
|
classOfPut(newObj, globalValue("Float"));
|
|
return newObj;
|
|
}
|
|
|
|
encPtr newLink(encPtr key, encPtr value)
|
|
{
|
|
encPtr newObj;
|
|
|
|
newObj = allocOrefObj(3);
|
|
classOfPut(newObj, globalValue("Link"));
|
|
orefOfPut(newObj, 1, (objRef) key);
|
|
orefOfPut(newObj, 2, (objRef) value);
|
|
return newObj;
|
|
}
|
|
|
|
encPtr newMethod(void)
|
|
{
|
|
encPtr newObj;
|
|
|
|
newObj = allocOrefObj(methodSize);
|
|
classOfPut(newObj, globalValue("Method"));
|
|
return newObj;
|
|
}
|
|
|
|
encPtr newString(char* value)
|
|
{
|
|
encPtr newObj;
|
|
|
|
newObj = allocZStrObj(value);
|
|
if (ptrEq((objRef) stringClass, (objRef) nilObj))
|
|
stringClass = globalValue("String");
|
|
classOfPut(newObj, stringClass);
|
|
return (newObj);
|
|
}
|
|
|
|
encPtr newSymbol(char* str)
|
|
{
|
|
encPtr newObj;
|
|
|
|
/* first see if it is already there */
|
|
newObj = globalKey(str);
|
|
if (ptrNe((objRef) newObj, (objRef) nilObj))
|
|
return newObj;
|
|
|
|
/* not found, must make */
|
|
newObj = allocZStrObj(str);
|
|
if (ptrEq((objRef) symbolClass, (objRef) nilObj))
|
|
symbolClass = globalValue("Symbol");
|
|
classOfPut(newObj, symbolClass);
|
|
nameTableInsert(symbols, strHash(str), newObj, nilObj);
|
|
return newObj;
|
|
}
|
|
|
|
inline encPtr getClass(objRef obj)
|
|
{
|
|
if (isValue(obj)) {
|
|
if (ptrEq((objRef) intClass, (objRef) nilObj))
|
|
intClass = globalValue("Integer");
|
|
return (intClass);
|
|
}
|
|
return (classOf(obj.ptr));
|
|
}
|
|
|
|
typedef enum tokensyms {
|
|
nothing, nameconst, namecolon,
|
|
intconst, floatconst, charconst, symconst,
|
|
arraybegin, strconst, binary, closing, inputend
|
|
} tokentype;
|
|
|
|
tokentype token = nothing;
|
|
char tokenString[4096] = {}; /* text of current token */
|
|
int tokenInteger = 0; /* or character */
|
|
double tokenFloat = 0.0;
|
|
|
|
char *cp = 0;
|
|
char cc = 0;
|
|
|
|
int pushindex = 0;
|
|
char pushBuffer[16] = {};
|
|
|
|
long longresult = 0; /*fix*/
|
|
|
|
void pushBack(char c)
|
|
{
|
|
pushBuffer[pushindex++] = c;
|
|
}
|
|
|
|
char nextChar(void)
|
|
{
|
|
if (pushindex > 0)
|
|
cc = pushBuffer[--pushindex];
|
|
else if (*cp)
|
|
cc = *cp++;
|
|
else
|
|
cc = '\0';
|
|
return (cc);
|
|
}
|
|
|
|
char peek(void)
|
|
{
|
|
pushBack(nextChar());
|
|
return (cc);
|
|
}
|
|
|
|
bool isClosing(char c)
|
|
{
|
|
switch (c) {
|
|
case '.':
|
|
case ']':
|
|
case ')':
|
|
case ';':
|
|
case '\"':
|
|
case '\'':
|
|
return (true);
|
|
}
|
|
return (false);
|
|
}
|
|
|
|
bool isSymbolChar(char c)
|
|
{
|
|
if (isdigit(c) || isalpha(c))
|
|
return (true);
|
|
if (isspace(c) || isClosing(c))
|
|
return (false);
|
|
return (true);
|
|
}
|
|
|
|
bool singleBinary(char c)
|
|
{
|
|
switch (c) {
|
|
case '[':
|
|
case '(':
|
|
case ')':
|
|
case ']':
|
|
return (true);
|
|
}
|
|
return (false);
|
|
}
|
|
|
|
bool binarySecond(char c)
|
|
{
|
|
if (isalpha(c) || isdigit(c) || isspace(c) || isClosing(c) ||
|
|
singleBinary(c))
|
|
return (false);
|
|
return (true);
|
|
}
|
|
|
|
tokentype nextToken(void)
|
|
{
|
|
char *tp;
|
|
bool sign;
|
|
|
|
/* skip over blanks and comments */
|
|
while (nextChar() && (isspace(cc) || (cc == '"')))
|
|
if (cc == '"') {
|
|
/* read comment */
|
|
while (nextChar() && (cc != '"')) ;
|
|
if (!cc)
|
|
break; /* break if we run into eof */
|
|
}
|
|
tp = tokenString;
|
|
*tp++ = cc;
|
|
|
|
if (!cc) /* end of input */
|
|
token = inputend;
|
|
|
|
else if (isalpha(cc)) { /* identifier */
|
|
while (nextChar() && isalnum(cc))
|
|
*tp++ = cc;
|
|
if (cc == ':') {
|
|
*tp++ = cc;
|
|
token = namecolon;
|
|
} else {
|
|
pushBack(cc);
|
|
token = nameconst;
|
|
}
|
|
} else if (isdigit(cc)) { /* number */
|
|
longresult = cc - '0';
|
|
while (nextChar() && isdigit(cc)) {
|
|
*tp++ = cc;
|
|
longresult = (longresult * 10) + (cc - '0');
|
|
}
|
|
if (canEmbed(longresult)) {
|
|
tokenInteger = longresult;
|
|
token = intconst;
|
|
} else {
|
|
token = floatconst;
|
|
tokenFloat = (double) longresult;
|
|
}
|
|
if (cc == '.') { /* possible float */
|
|
if (nextChar() && isdigit(cc)) {
|
|
*tp++ = '.';
|
|
do
|
|
*tp++ = cc;
|
|
while (nextChar() && isdigit(cc));
|
|
if (cc)
|
|
pushBack(cc);
|
|
token = floatconst;
|
|
*tp = '\0';
|
|
tokenFloat = atof(tokenString);
|
|
} else {
|
|
/* nope, just an ordinary period */
|
|
if (cc)
|
|
pushBack(cc);
|
|
pushBack('.');
|
|
}
|
|
} else
|
|
pushBack(cc);
|
|
|
|
if (nextChar() && cc == 'e') { /* possible float */
|
|
if (nextChar() && cc == '-') {
|
|
sign = true;
|
|
(void) nextChar();
|
|
} else
|
|
sign = false;
|
|
if (cc && isdigit(cc)) { /* yep, its a float */
|
|
*tp++ = 'e';
|
|
if (sign)
|
|
*tp++ = '-';
|
|
while (cc && isdigit(cc)) {
|
|
*tp++ = cc;
|
|
(void) nextChar();
|
|
}
|
|
if (cc)
|
|
pushBack(cc);
|
|
*tp = '\0';
|
|
token = floatconst;
|
|
tokenFloat = atof(tokenString);
|
|
} else { /* nope, wrong again */
|
|
if (cc)
|
|
pushBack(cc);
|
|
if (sign)
|
|
pushBack('-');
|
|
pushBack('e');
|
|
}
|
|
} else if (cc)
|
|
pushBack(cc);
|
|
} else if (cc == '$') { /* character constant */
|
|
tokenInteger = (int) nextChar();
|
|
token = charconst;
|
|
} else if (cc == '#') { /* symbol */
|
|
tp--; /* erase pound sign */
|
|
if (nextChar() == '(')
|
|
token = arraybegin;
|
|
else {
|
|
pushBack(cc);
|
|
while (nextChar() && isSymbolChar(cc))
|
|
*tp++ = cc;
|
|
pushBack(cc);
|
|
token = symconst;
|
|
}
|
|
} else if (cc == '\'') { /* string constant */
|
|
tp--; /* erase pound sign */
|
|
strloop:
|
|
while (nextChar() && (cc != '\''))
|
|
*tp++ = cc;
|
|
/* check for nested quote marks */
|
|
if (cc && nextChar() && (cc == '\'')) {
|
|
*tp++ = cc;
|
|
goto strloop;
|
|
}
|
|
pushBack(cc);
|
|
token = strconst;
|
|
} else if (isClosing(cc)) /* closing expressions */
|
|
token = closing;
|
|
|
|
else if (singleBinary(cc)) { /* single binary expressions */
|
|
token = binary;
|
|
} else { /* anything else is binary */
|
|
if (nextChar() && binarySecond(cc))
|
|
*tp++ = cc;
|
|
else
|
|
pushBack(cc);
|
|
token = binary;
|
|
}
|
|
|
|
*tp = '\0';
|
|
return (token);
|
|
}
|
|
|
|
void lexinit(char* str)
|
|
{
|
|
pushindex = 0;
|
|
cp = str;
|
|
/* get first token */
|
|
(void) nextToken();
|
|
}
|
|
|
|
#define Extended 0
|
|
#define PushInstance 1
|
|
#define PushArgument 2
|
|
#define PushTemporary 3
|
|
#define PushLiteral 4
|
|
#define PushConstant 5
|
|
#define AssignInstance 6
|
|
#define AssignTemporary 7
|
|
#define MarkArguments 8
|
|
#define SendMessage 9
|
|
#define SendUnary 10
|
|
#define SendBinary 11
|
|
#define DoPrimitive 13
|
|
#define DoSpecial 15
|
|
|
|
#define minusOne 3 /* the value -1 */
|
|
#define contextConst 4 /* the current context */
|
|
#define nilConst 5 /* the constant nil */
|
|
#define trueConst 6 /* the constant true */
|
|
#define falseConst 7 /* the constant false */
|
|
|
|
#define SelfReturn 1
|
|
#define StackReturn 2
|
|
#define Duplicate 4
|
|
#define PopTop 5
|
|
#define Branch 6
|
|
#define BranchIfTrue 7
|
|
#define BranchIfFalse 8
|
|
#define AndBranch 9
|
|
#define OrBranch 10
|
|
#define SendToSuper 11
|
|
|
|
void sysWarn(char* s1, char* s2);
|
|
void compilWarn(char* selector, char* str1, char* str2);
|
|
void compilError(char* selector, char* str1, char* str2);
|
|
|
|
#define codeLimit 256
|
|
#define literalLimit 256
|
|
#define temporaryLimit 256
|
|
#define argumentLimit 256
|
|
#define instanceLimit 256
|
|
|
|
bool parseOk = false;
|
|
|
|
int codeTop = 0;
|
|
byte codeArray[codeLimit] = {};
|
|
|
|
int literalTop = 0;
|
|
objRef literalArray[literalLimit] = {};
|
|
|
|
int temporaryTop = 0;
|
|
char *temporaryName[temporaryLimit] = {};
|
|
|
|
int argumentTop = 0;
|
|
char *argumentName[argumentLimit] = {};
|
|
|
|
int instanceTop = 0;
|
|
char *instanceName[instanceLimit] = {};
|
|
|
|
int maxTemporary = 0;
|
|
char selector[4096] = {};
|
|
|
|
enum blockstatus {
|
|
NotInBlock, InBlock, OptimizedBlock
|
|
} blockstat = NotInBlock;
|
|
|
|
void setInstanceVariables(encPtr aClass)
|
|
{
|
|
int i,
|
|
limit;
|
|
encPtr vars;
|
|
|
|
if (ptrEq((objRef) aClass, (objRef) nilObj))
|
|
instanceTop = 0;
|
|
else {
|
|
setInstanceVariables(orefOf(aClass, superClassInClass).ptr);
|
|
vars = orefOf(aClass, variablesInClass).ptr;
|
|
if (ptrNe((objRef) vars, (objRef) nilObj)) {
|
|
limit = countOf(vars);
|
|
for (i = 1; i <= limit; i++)
|
|
instanceName[++instanceTop] = addressOf(orefOf(vars, i).ptr);
|
|
}
|
|
}
|
|
}
|
|
|
|
void genMessage(bool toSuper, int argumentCount, encPtr messagesym);
|
|
void expression(void);
|
|
void parsePrimitive(void);
|
|
void block(void);
|
|
void body(void);
|
|
void assignment(char* name);
|
|
|
|
void genCode(int value)
|
|
{
|
|
if (codeTop >= codeLimit)
|
|
compilError(selector, "too many bytecode instructions in method", "");
|
|
else
|
|
codeArray[codeTop++] = value;
|
|
}
|
|
|
|
void genInstruction(int high, int low)
|
|
{
|
|
if (low >= 16) {
|
|
genInstruction(Extended, high);
|
|
genCode(low);
|
|
} else
|
|
genCode(high * 16 + low);
|
|
}
|
|
|
|
int genLiteral(objRef aLiteral)
|
|
{
|
|
if (literalTop >= literalLimit)
|
|
compilError(selector, "too many literals in method", "");
|
|
else {
|
|
literalArray[++literalTop] = aLiteral;
|
|
}
|
|
return (literalTop - 1);
|
|
}
|
|
|
|
void genInteger(int val)
|
|
{
|
|
if (val == -1)
|
|
genInstruction(PushConstant, minusOne);
|
|
else if ((val >= 0) && (val <= 2))
|
|
genInstruction(PushConstant, val);
|
|
else
|
|
genInstruction(PushLiteral,
|
|
genLiteral((objRef) encValueOf(val)));
|
|
}
|
|
|
|
char *glbsyms[] = {
|
|
"currentInterpreter", "nil", "true", "false",
|
|
0
|
|
};
|
|
|
|
bool nameTerm(char* name)
|
|
{
|
|
int i;
|
|
bool done = false;
|
|
bool isSuper = false;
|
|
|
|
/* it might be self or super */
|
|
if (streq(name, "self") || streq(name, "super")) {
|
|
genInstruction(PushArgument, 0);
|
|
done = true;
|
|
if (streq(name, "super"))
|
|
isSuper = true;
|
|
}
|
|
/* or it might be a temporary (reverse this to get most recent first) */
|
|
if (!done)
|
|
for (i = temporaryTop; (!done) && (i >= 1); i--)
|
|
if (streq(name, temporaryName[i])) {
|
|
genInstruction(PushTemporary, i - 1);
|
|
done = true;
|
|
}
|
|
/* or it might be an argument */
|
|
if (!done)
|
|
for (i = 1; (!done) && (i <= argumentTop); i++)
|
|
if (streq(name, argumentName[i])) {
|
|
genInstruction(PushArgument, i);
|
|
done = true;
|
|
}
|
|
/* or it might be an instance variable */
|
|
if (!done)
|
|
for (i = 1; (!done) && (i <= instanceTop); i++) {
|
|
if (streq(name, instanceName[i])) {
|
|
genInstruction(PushInstance, i - 1);
|
|
done = true;
|
|
}
|
|
}
|
|
/* or it might be a global constant */
|
|
if (!done)
|
|
for (i = 0; (!done) && glbsyms[i]; i++)
|
|
if (streq(name, glbsyms[i])) {
|
|
genInstruction(PushConstant, i + 4);
|
|
done = true;
|
|
}
|
|
/* not anything else, it must be a global */
|
|
/* must look it up at run time */
|
|
if (!done) {
|
|
genInstruction(PushLiteral, genLiteral((objRef) newSymbol(name)));
|
|
genMessage(false, 0, newSymbol("value"));
|
|
}
|
|
return (isSuper);
|
|
}
|
|
|
|
int parseArray(void)
|
|
{
|
|
int i,
|
|
size,
|
|
base;
|
|
encPtr newLit;
|
|
objRef obj;
|
|
|
|
base = literalTop;
|
|
(void) nextToken();
|
|
while (parseOk && (token != closing)) {
|
|
switch (token) {
|
|
case arraybegin:
|
|
(void) parseArray();
|
|
break;
|
|
|
|
case intconst:
|
|
(void) genLiteral((objRef) encValueOf(tokenInteger));
|
|
(void) nextToken();
|
|
break;
|
|
|
|
case floatconst:
|
|
(void) genLiteral((objRef) newFloat(tokenFloat));
|
|
(void) nextToken();
|
|
break;
|
|
|
|
case nameconst:
|
|
case namecolon:
|
|
case symconst:
|
|
(void) genLiteral((objRef) newSymbol(tokenString));
|
|
(void) nextToken();
|
|
break;
|
|
|
|
case binary:
|
|
if (streq(tokenString, "(")) {
|
|
(void) parseArray();
|
|
break;
|
|
}
|
|
if (streq(tokenString, "-") && isdigit(peek())) {
|
|
(void) nextToken();
|
|
if (token == intconst)
|
|
(void) genLiteral((objRef) encValueOf(-tokenInteger));
|
|
else if (token == floatconst) {
|
|
(void) genLiteral((objRef) newFloat(-tokenFloat));
|
|
} else
|
|
compilError(selector, "negation not followed",
|
|
"by number");
|
|
(void) nextToken();
|
|
break;
|
|
}
|
|
(void) genLiteral((objRef) newSymbol(tokenString));
|
|
(void) nextToken();
|
|
break;
|
|
|
|
case charconst:
|
|
(void) genLiteral((objRef) newChar(tokenInteger));
|
|
(void) nextToken();
|
|
break;
|
|
|
|
case strconst:
|
|
(void) genLiteral((objRef) newString(tokenString));
|
|
(void) nextToken();
|
|
break;
|
|
|
|
default:
|
|
compilError(selector, "illegal text in literal array",
|
|
tokenString);
|
|
(void) nextToken();
|
|
break;
|
|
}
|
|
}
|
|
|
|
if (parseOk)
|
|
if (!streq(tokenString, ")"))
|
|
compilError(selector, "array not terminated by right parenthesis",
|
|
tokenString);
|
|
else
|
|
(void) nextToken();
|
|
size = literalTop - base;
|
|
newLit = newArray(size);
|
|
for (i = size; i >= 1; i--) {
|
|
obj = literalArray[literalTop];
|
|
orefOfPut(newLit, i, obj);
|
|
literalArray[literalTop] = (objRef) nilObj;
|
|
literalTop = literalTop - 1;
|
|
}
|
|
return (genLiteral((objRef) newLit));
|
|
}
|
|
|
|
bool term(void)
|
|
{
|
|
bool superTerm = false; /* true if term is pseudo var super */
|
|
|
|
if (token == nameconst) {
|
|
superTerm = nameTerm(tokenString);
|
|
(void) nextToken();
|
|
} else if (token == intconst) {
|
|
genInteger(tokenInteger);
|
|
(void) nextToken();
|
|
} else if (token == floatconst) {
|
|
genInstruction(PushLiteral, genLiteral((objRef) newFloat(tokenFloat)));
|
|
(void) nextToken();
|
|
} else if ((token == binary) && streq(tokenString, "-")) {
|
|
(void) nextToken();
|
|
if (token == intconst)
|
|
genInteger(-tokenInteger);
|
|
else if (token == floatconst) {
|
|
genInstruction(PushLiteral,
|
|
genLiteral((objRef) newFloat(-tokenFloat)));
|
|
} else
|
|
compilError(selector, "negation not followed",
|
|
"by number");
|
|
(void) nextToken();
|
|
} else if (token == charconst) {
|
|
genInstruction(PushLiteral,
|
|
genLiteral((objRef) newChar(tokenInteger)));
|
|
(void) nextToken();
|
|
} else if (token == symconst) {
|
|
genInstruction(PushLiteral,
|
|
genLiteral((objRef) newSymbol(tokenString)));
|
|
(void) nextToken();
|
|
} else if (token == strconst) {
|
|
genInstruction(PushLiteral,
|
|
genLiteral((objRef) newString(tokenString)));
|
|
(void) nextToken();
|
|
} else if (token == arraybegin) {
|
|
genInstruction(PushLiteral, parseArray());
|
|
} else if ((token == binary) && streq(tokenString, "(")) {
|
|
(void) nextToken();
|
|
expression();
|
|
if (parseOk)
|
|
if ((token != closing) || !streq(tokenString, ")"))
|
|
compilError(selector, "Missing Right Parenthesis", "");
|
|
else
|
|
(void) nextToken();
|
|
} else if ((token == binary) && streq(tokenString, "<"))
|
|
parsePrimitive();
|
|
else if ((token == binary) && streq(tokenString, "["))
|
|
block();
|
|
else
|
|
compilError(selector, "invalid expression start", tokenString);
|
|
|
|
return (superTerm);
|
|
}
|
|
|
|
void parsePrimitive(void)
|
|
{
|
|
int primitiveNumber,
|
|
argumentCount;
|
|
|
|
if (nextToken() != intconst)
|
|
compilError(selector, "primitive number missing", "");
|
|
primitiveNumber = tokenInteger;
|
|
(void) nextToken();
|
|
argumentCount = 0;
|
|
while (parseOk && !((token == binary) && streq(tokenString, ">"))) {
|
|
(void) term();
|
|
argumentCount++;
|
|
}
|
|
genInstruction(DoPrimitive, argumentCount);
|
|
genCode(primitiveNumber);
|
|
(void) nextToken();
|
|
}
|
|
|
|
void genMessage(bool toSuper, int argumentCount, encPtr messagesym)
|
|
{
|
|
bool sent = false;
|
|
int i;
|
|
|
|
if ((!toSuper) && (argumentCount == 0))
|
|
for (i = 0; (!sent) && ptrNe((objRef)unSyms[i],(objRef)nilObj); i++)
|
|
if (ptrEq((objRef) messagesym, (objRef) unSyms[i])) {
|
|
genInstruction(SendUnary, i);
|
|
sent = true;
|
|
}
|
|
if ((!toSuper) && (argumentCount == 1))
|
|
for (i = 0; (!sent) && ptrNe((objRef)binSyms[i],(objRef)nilObj); i++)
|
|
if (ptrEq((objRef) messagesym, (objRef) binSyms[i])) {
|
|
genInstruction(SendBinary, i);
|
|
sent = true;
|
|
}
|
|
if (!sent) {
|
|
genInstruction(MarkArguments, 1 + argumentCount);
|
|
if (toSuper) {
|
|
genInstruction(DoSpecial, SendToSuper);
|
|
genCode(genLiteral((objRef) messagesym));
|
|
} else
|
|
genInstruction(SendMessage, genLiteral((objRef) messagesym));
|
|
}
|
|
}
|
|
|
|
bool unaryContinuation(bool superReceiver)
|
|
{
|
|
int i;
|
|
bool sent;
|
|
|
|
while (parseOk && (token == nameconst)) {
|
|
/* first check to see if it could be a temp by mistake */
|
|
for (i = 1; i < temporaryTop; i++)
|
|
if (streq(tokenString, temporaryName[i]))
|
|
compilWarn(selector, "message same as temporary:",
|
|
tokenString);
|
|
for (i = 1; i < argumentTop; i++)
|
|
if (streq(tokenString, argumentName[i]))
|
|
compilWarn(selector, "message same as argument:",
|
|
tokenString);
|
|
/* the next generates too many spurious messages */
|
|
/* for (i=1; i < instanceTop; i++)
|
|
if (streq(tokenString, instanceName[i]))
|
|
compilWarn(selector,"message same as instance",
|
|
tokenString); */
|
|
|
|
sent = false;
|
|
|
|
if (!sent) {
|
|
genMessage(superReceiver, 0, newSymbol(tokenString));
|
|
}
|
|
/* once a message is sent to super, reciever is not super */
|
|
superReceiver = false;
|
|
(void) nextToken();
|
|
}
|
|
return (superReceiver);
|
|
}
|
|
|
|
bool binaryContinuation(bool superReceiver)
|
|
{
|
|
bool superTerm;
|
|
encPtr messagesym;
|
|
|
|
superReceiver = unaryContinuation(superReceiver);
|
|
while (parseOk && (token == binary)) {
|
|
messagesym = newSymbol(tokenString);
|
|
(void) nextToken();
|
|
superTerm = term();
|
|
(void) unaryContinuation(superTerm);
|
|
genMessage(superReceiver, 1, messagesym);
|
|
superReceiver = false;
|
|
}
|
|
return (superReceiver);
|
|
}
|
|
|
|
int optimizeBlock(int instruction, bool dopop)
|
|
{
|
|
int location;
|
|
enum blockstatus savebstat;
|
|
|
|
savebstat = blockstat;
|
|
genInstruction(DoSpecial, instruction);
|
|
location = codeTop;
|
|
genCode(0);
|
|
if (dopop)
|
|
genInstruction(DoSpecial, PopTop);
|
|
(void) nextToken();
|
|
if (streq(tokenString, "[")) {
|
|
(void) nextToken();
|
|
if (blockstat == NotInBlock)
|
|
blockstat = OptimizedBlock;
|
|
body();
|
|
if (!streq(tokenString, "]"))
|
|
compilError(selector, "missing close", "after block");
|
|
(void) nextToken();
|
|
} else {
|
|
(void) binaryContinuation(term());
|
|
genMessage(false, 0, newSymbol("value"));
|
|
}
|
|
codeArray[location] = codeTop + 1;
|
|
blockstat = savebstat;
|
|
return (location);
|
|
}
|
|
|
|
bool keyContinuation(bool superReceiver)
|
|
{
|
|
int i,
|
|
j,
|
|
argumentCount;
|
|
bool sent,
|
|
superTerm;
|
|
encPtr messagesym;
|
|
char pattern[4096];
|
|
|
|
superReceiver = binaryContinuation(superReceiver);
|
|
if (token == namecolon) {
|
|
if (streq(tokenString, "ifTrue:")) {
|
|
i = optimizeBlock(BranchIfFalse, false);
|
|
if (streq(tokenString, "ifFalse:")) {
|
|
codeArray[i] = codeTop + 3;
|
|
(void) optimizeBlock(Branch, true);
|
|
}
|
|
} else if (streq(tokenString, "ifFalse:")) {
|
|
i = optimizeBlock(BranchIfTrue, false);
|
|
if (streq(tokenString, "ifTrue:")) {
|
|
codeArray[i] = codeTop + 3;
|
|
(void) optimizeBlock(Branch, true);
|
|
}
|
|
} else if (streq(tokenString, "whileTrue:")) {
|
|
j = codeTop;
|
|
genInstruction(DoSpecial, Duplicate);
|
|
genMessage(false, 0, newSymbol("value"));
|
|
i = optimizeBlock(BranchIfFalse, false);
|
|
genInstruction(DoSpecial, PopTop);
|
|
genInstruction(DoSpecial, Branch);
|
|
genCode(j + 1);
|
|
codeArray[i] = codeTop + 1;
|
|
genInstruction(DoSpecial, PopTop);
|
|
} else if (streq(tokenString, "and:"))
|
|
(void) optimizeBlock(AndBranch, false);
|
|
else if (streq(tokenString, "or:"))
|
|
(void) optimizeBlock(OrBranch, false);
|
|
else {
|
|
pattern[0] = '\0';
|
|
argumentCount = 0;
|
|
while (parseOk && (token == namecolon)) {
|
|
(void) strcat(pattern, tokenString);
|
|
argumentCount++;
|
|
(void) nextToken();
|
|
superTerm = term();
|
|
(void) binaryContinuation(superTerm);
|
|
}
|
|
sent = false;
|
|
|
|
/* check for predefined messages */
|
|
messagesym = newSymbol(pattern);
|
|
|
|
if (!sent) {
|
|
genMessage(superReceiver, argumentCount, messagesym);
|
|
}
|
|
}
|
|
superReceiver = false;
|
|
}
|
|
return (superReceiver);
|
|
}
|
|
|
|
void continuation(bool superReceiver)
|
|
{
|
|
superReceiver = keyContinuation(superReceiver);
|
|
|
|
while (parseOk && (token == closing) && streq(tokenString, ";")) {
|
|
genInstruction(DoSpecial, Duplicate);
|
|
(void) nextToken();
|
|
(void) keyContinuation(superReceiver);
|
|
genInstruction(DoSpecial, PopTop);
|
|
}
|
|
}
|
|
|
|
void expression(void)
|
|
{
|
|
bool superTerm;
|
|
char assignname[4096];
|
|
|
|
if (token == nameconst) { /* possible assignment */
|
|
(void) strcpy(assignname, tokenString);
|
|
(void) nextToken();
|
|
if ((token == binary) && streq(tokenString, "<-")) {
|
|
(void) nextToken();
|
|
assignment(assignname);
|
|
} else { /* not an assignment after all */
|
|
superTerm = nameTerm(assignname);
|
|
continuation(superTerm);
|
|
}
|
|
} else {
|
|
superTerm = term();
|
|
if (parseOk)
|
|
continuation(superTerm);
|
|
}
|
|
}
|
|
|
|
void assignment(char* name)
|
|
{
|
|
int i;
|
|
bool done;
|
|
|
|
done = false;
|
|
|
|
/* it might be a temporary */
|
|
for (i = temporaryTop; (!done) && (i > 0); i--)
|
|
if (streq(name, temporaryName[i])) {
|
|
expression();
|
|
genInstruction(AssignTemporary, i - 1);
|
|
done = true;
|
|
}
|
|
/* or it might be an instance variable */
|
|
for (i = 1; (!done) && (i <= instanceTop); i++)
|
|
if (streq(name, instanceName[i])) {
|
|
expression();
|
|
genInstruction(AssignInstance, i - 1);
|
|
done = true;
|
|
}
|
|
if (!done) { /* not known, handle at run time */
|
|
genInstruction(PushArgument, 0);
|
|
genInstruction(PushLiteral, genLiteral((objRef) newSymbol(name)));
|
|
expression();
|
|
genMessage(false, 2, newSymbol("assign:value:"));
|
|
}
|
|
}
|
|
|
|
void statement(void)
|
|
{
|
|
|
|
if ((token == binary) && streq(tokenString, "^")) {
|
|
(void) nextToken();
|
|
expression();
|
|
if (blockstat == InBlock) {
|
|
/* change return point before returning */
|
|
genInstruction(PushConstant, contextConst);
|
|
genMessage(false, 0, newSymbol("blockReturn"));
|
|
genInstruction(DoSpecial, PopTop);
|
|
}
|
|
genInstruction(DoSpecial, StackReturn);
|
|
} else {
|
|
expression();
|
|
}
|
|
}
|
|
|
|
void body(void)
|
|
{
|
|
/* empty blocks are same as nil */
|
|
if ((blockstat == InBlock) || (blockstat == OptimizedBlock))
|
|
if ((token == closing) && streq(tokenString, "]")) {
|
|
genInstruction(PushConstant, nilConst);
|
|
return;
|
|
}
|
|
while (parseOk) {
|
|
statement();
|
|
if (token == closing)
|
|
if (streq(tokenString, ".")) {
|
|
(void) nextToken();
|
|
if (token == inputend)
|
|
break;
|
|
else /* pop result, go to next statement */
|
|
genInstruction(DoSpecial, PopTop);
|
|
} else
|
|
break; /* leaving result on stack */
|
|
else if (token == inputend)
|
|
break; /* leaving result on stack */
|
|
else {
|
|
compilError(selector, "invalid statement ending; token is ",
|
|
tokenString);
|
|
}
|
|
}
|
|
}
|
|
|
|
void block(void)
|
|
{
|
|
int saveTemporary,
|
|
argumentCount,
|
|
fixLocation;
|
|
encPtr tempsym,
|
|
newBlk;
|
|
enum blockstatus savebstat;
|
|
|
|
saveTemporary = temporaryTop;
|
|
savebstat = blockstat;
|
|
argumentCount = 0;
|
|
(void) nextToken();
|
|
if ((token == binary) && streq(tokenString, ":")) {
|
|
while (parseOk && (token == binary) && streq(tokenString, ":")) {
|
|
if (nextToken() != nameconst)
|
|
compilError(selector, "name must follow colon",
|
|
"in block argument list");
|
|
if (++temporaryTop > maxTemporary)
|
|
maxTemporary = temporaryTop;
|
|
argumentCount++;
|
|
if (temporaryTop > temporaryLimit)
|
|
compilError(selector, "too many temporaries in method", "");
|
|
else {
|
|
tempsym = newSymbol(tokenString);
|
|
temporaryName[temporaryTop] = addressOf(tempsym);
|
|
}
|
|
(void) nextToken();
|
|
}
|
|
if ((token != binary) || !streq(tokenString, "|"))
|
|
compilError(selector, "block argument list must be terminated",
|
|
"by |");
|
|
(void) nextToken();
|
|
}
|
|
newBlk = newBlock();
|
|
orefOfPut(newBlk, argumentCountInBlock, (objRef) encValueOf(argumentCount));
|
|
orefOfPut(newBlk, argumentLocationInBlock,
|
|
(objRef) encValueOf(saveTemporary + 1));
|
|
genInstruction(PushLiteral, genLiteral((objRef) newBlk));
|
|
genInstruction(PushConstant, contextConst);
|
|
genInstruction(DoPrimitive, 2);
|
|
genCode(29);
|
|
genInstruction(DoSpecial, Branch);
|
|
fixLocation = codeTop;
|
|
genCode(0);
|
|
/*genInstruction(DoSpecial, PopTop); */
|
|
orefOfPut(newBlk, bytecountPositionInBlock, (objRef) encValueOf(codeTop + 1));
|
|
blockstat = InBlock;
|
|
body();
|
|
if ((token == closing) && streq(tokenString, "]"))
|
|
(void) nextToken();
|
|
else
|
|
compilError(selector, "block not terminated by ]", "");
|
|
genInstruction(DoSpecial, StackReturn);
|
|
codeArray[fixLocation] = codeTop + 1;
|
|
temporaryTop = saveTemporary;
|
|
blockstat = savebstat;
|
|
}
|
|
|
|
void temporaries(void)
|
|
{
|
|
encPtr tempsym;
|
|
|
|
temporaryTop = 0;
|
|
if ((token == binary) && streq(tokenString, "|")) {
|
|
(void) nextToken();
|
|
while (token == nameconst) {
|
|
if (++temporaryTop > maxTemporary)
|
|
maxTemporary = temporaryTop;
|
|
if (temporaryTop > temporaryLimit)
|
|
compilError(selector, "too many temporaries in method", "");
|
|
else {
|
|
tempsym = newSymbol(tokenString);
|
|
temporaryName[temporaryTop] = addressOf(tempsym);
|
|
}
|
|
(void) nextToken();
|
|
}
|
|
if ((token != binary) || !streq(tokenString, "|"))
|
|
compilError(selector, "temporary list not terminated by bar", "");
|
|
else
|
|
(void) nextToken();
|
|
}
|
|
}
|
|
|
|
void messagePattern(void)
|
|
{
|
|
encPtr argsym;
|
|
|
|
argumentTop = 0;
|
|
(void) strcpy(selector, tokenString);
|
|
if (token == nameconst) /* unary message pattern */
|
|
(void) nextToken();
|
|
else if (token == binary) { /* binary message pattern */
|
|
(void) nextToken();
|
|
if (token != nameconst)
|
|
compilError(selector, "binary message pattern not followed by name", selector);
|
|
argsym = newSymbol(tokenString);
|
|
argumentName[++argumentTop] = addressOf(argsym);
|
|
(void) nextToken();
|
|
} else if (token == namecolon) { /* keyword message pattern */
|
|
selector[0] = '\0';
|
|
while (parseOk && (token == namecolon)) {
|
|
(void) strcat(selector, tokenString);
|
|
(void) nextToken();
|
|
if (token != nameconst)
|
|
compilError(selector, "keyword message pattern",
|
|
"not followed by a name");
|
|
if (++argumentTop > argumentLimit)
|
|
compilError(selector, "too many arguments in method", "");
|
|
argsym = newSymbol(tokenString);
|
|
argumentName[argumentTop] = addressOf(argsym);
|
|
(void) nextToken();
|
|
}
|
|
} else
|
|
compilError(selector, "illegal message selector", tokenString);
|
|
}
|
|
|
|
bool parse(encPtr method, char* text, bool saveText)
|
|
{
|
|
int i;
|
|
encPtr bytecodes,
|
|
theLiterals;
|
|
byte *bp;
|
|
|
|
lexinit(text);
|
|
parseOk = true;
|
|
blockstat = NotInBlock;
|
|
codeTop = 0;
|
|
literalTop = temporaryTop = argumentTop = 0;
|
|
maxTemporary = 0;
|
|
|
|
messagePattern();
|
|
if (parseOk)
|
|
temporaries();
|
|
if (parseOk)
|
|
body();
|
|
if (parseOk) {
|
|
genInstruction(DoSpecial, PopTop);
|
|
genInstruction(DoSpecial, SelfReturn);
|
|
}
|
|
if (!parseOk) {
|
|
orefOfPut(method, bytecodesInMethod, (objRef) nilObj);
|
|
} else {
|
|
bytecodes = newByteArray(codeTop);
|
|
bp = addressOf(bytecodes);
|
|
for (i = 0; i < codeTop; i++) {
|
|
bp[i] = codeArray[i];
|
|
}
|
|
orefOfPut(method, messageInMethod, (objRef) newSymbol(selector));
|
|
orefOfPut(method, bytecodesInMethod, (objRef) bytecodes);
|
|
if (literalTop > 0) {
|
|
theLiterals = newArray(literalTop);
|
|
for (i = 1; i <= literalTop; i++) {
|
|
orefOfPut(theLiterals, i, literalArray[i]);
|
|
}
|
|
orefOfPut(method, literalsInMethod, (objRef) theLiterals);
|
|
} else {
|
|
orefOfPut(method, literalsInMethod, (objRef) nilObj);
|
|
}
|
|
orefOfPut(method, stackSizeInMethod, (objRef) encValueOf(6));
|
|
orefOfPut(method, temporarySizeInMethod,
|
|
(objRef) encValueOf(1 + maxTemporary));
|
|
if (saveText) {
|
|
orefOfPut(method, textInMethod, (objRef) newString(text));
|
|
}
|
|
return (true);
|
|
}
|
|
return (false);
|
|
}
|
|
|
|
extern word traceVect[];
|
|
|
|
#define traceSize 3
|
|
#define execTrace traceVect[0]
|
|
#define primTrace traceVect[1]
|
|
#define mselTrace traceVect[2]
|
|
|
|
inline objRef unsupportedPrim(objRef arg[])
|
|
{
|
|
return((objRef) nilObj);
|
|
}
|
|
|
|
/*
|
|
Prints the number of available object table entries.
|
|
Always fails.
|
|
Called from Scheduler>>initialize
|
|
*/
|
|
objRef primAvailCount(objRef arg[])
|
|
{
|
|
fprintf(stderr, "free: %d\n", availCount());
|
|
return((objRef) nilObj);
|
|
}
|
|
|
|
/*
|
|
Returns a pseudo-random integer.
|
|
Called from
|
|
Random>>next
|
|
Random>>randInteger:
|
|
*/
|
|
objRef primRandom(objRef arg[])
|
|
{
|
|
short i;
|
|
/* this is hacked because of the representation */
|
|
/* of integers as shorts */
|
|
i = rand() >> 8; /* strip off lower bits */
|
|
if (i < 0)
|
|
i = -i;
|
|
return((objRef) encValueOf(i >> 1));
|
|
}
|
|
|
|
extern bool watching;
|
|
|
|
/*
|
|
Inverts the state of a switch. The switch controls, in part, whether or
|
|
not "watchWith:" messages are sent to Methods during execution.
|
|
Returns the Boolean representation of the switch value after the invert.
|
|
Called from Smalltalk>>watch
|
|
*/
|
|
objRef primFlipWatching(objRef arg[])
|
|
{
|
|
watching = !watching;
|
|
return((objRef) (watching ? trueObj : falseObj));
|
|
}
|
|
|
|
/*
|
|
Terminates the interpreter.
|
|
Never returns.
|
|
Not called from the image.
|
|
*/
|
|
objRef primExit(objRef arg[])
|
|
{
|
|
exit(0);
|
|
}
|
|
|
|
/*
|
|
Returns the class of which the receiver is an instance.
|
|
Called from Object>>class
|
|
*/
|
|
objRef primClass(objRef arg[])
|
|
{
|
|
return((objRef) getClass(arg[0]));
|
|
}
|
|
|
|
/*
|
|
Returns the field count of the von Neumann space of the receiver.
|
|
Called from Object>>basicSize
|
|
*/
|
|
objRef primSize(objRef arg[])
|
|
{
|
|
int i;
|
|
if (isValue(arg[0]))
|
|
i = 0;
|
|
else
|
|
i = countOf(arg[0].ptr);
|
|
return((objRef) encValueOf(i));
|
|
}
|
|
|
|
/*
|
|
Returns a hashed representation of the receiver.
|
|
Called from Object>>hash
|
|
*/
|
|
objRef primHash(objRef arg[])
|
|
{
|
|
if (isValue(arg[0]))
|
|
return(arg[0]);
|
|
else
|
|
return((objRef) encValueOf(oteIndexOf(arg[0].ptr)));
|
|
}
|
|
|
|
extern encPtr processStack;
|
|
extern int linkPointer;
|
|
int* counterAddress = NULL;
|
|
|
|
/*
|
|
Changes the active process stack if appropriate. The change causes
|
|
control to be returned (eventually) to the context which sent the
|
|
message which created the context which invoked this primitive.
|
|
Returns true if the change was made; false if not.
|
|
Called from Context>>blockReturn
|
|
N.B.: This involves some tricky code. The compiler generates the
|
|
message which invokes Context>>blockReturn. Context>>blockReturn is a
|
|
normal method. It processes the true/false indicator. Its result is
|
|
discarded when it returns, exposing the value to be returned from the
|
|
context which invokes this primitive. Only then is the process stack
|
|
change effective.
|
|
*/
|
|
objRef primBlockReturn(objRef arg[])
|
|
{
|
|
int i;
|
|
int j;
|
|
/* first get previous link pointer */
|
|
i = intValueOf(orefOf(processStack, linkPointer).val);
|
|
/* then creating context pointer */
|
|
j = intValueOf(orefOf(arg[0].ptr, 1).val);
|
|
if (ptrNe(orefOf(processStack, j + 1), arg[0]))
|
|
return((objRef) falseObj);
|
|
/* first change link pointer to that of creator */
|
|
orefOfPut(processStack, i, orefOf(processStack, j));
|
|
/* then change return point to that of creator */
|
|
orefOfPut(processStack, i + 2, orefOf(processStack, j + 2));
|
|
return((objRef) trueObj);
|
|
}
|
|
|
|
jmp_buf jb = {};
|
|
|
|
void brkfun(int sig)
|
|
{
|
|
longjmp(jb, 1);
|
|
}
|
|
|
|
void brkignore(int sig)
|
|
{
|
|
}
|
|
|
|
bool execute(encPtr aProcess, int maxsteps);
|
|
|
|
/*
|
|
Executes the receiver until its time slice is ended or terminated.
|
|
Returns true in the former case; false in the latter.
|
|
Called from Process>>execute
|
|
*/
|
|
objRef primExecute(objRef arg[])
|
|
{
|
|
encPtr saveProcessStack;
|
|
int saveLinkPointer;
|
|
int* saveCounterAddress;
|
|
objRef returnedObject;
|
|
/* first save the values we are about to clobber */
|
|
saveProcessStack = processStack;
|
|
saveLinkPointer = linkPointer;
|
|
saveCounterAddress = counterAddress;
|
|
/* trap control-C */
|
|
signal(SIGINT, brkfun);
|
|
if (setjmp(jb))
|
|
returnedObject = (objRef) falseObj;
|
|
else
|
|
if (execute(arg[0].ptr, 1 << 12))
|
|
returnedObject = (objRef) trueObj;
|
|
else
|
|
returnedObject = (objRef) falseObj;
|
|
signal(SIGINT, brkignore);
|
|
/* then restore previous environment */
|
|
processStack = saveProcessStack;
|
|
linkPointer = saveLinkPointer;
|
|
counterAddress = saveCounterAddress;
|
|
return(returnedObject);
|
|
}
|
|
|
|
/*
|
|
Returns true if the content of the receiver's objRef is equal to that
|
|
of the first argument's; false otherwise.
|
|
Called from Object>>==
|
|
*/
|
|
objRef primIdent(objRef arg[])
|
|
{
|
|
if (ptrEq(arg[0], arg[1]))
|
|
return((objRef) trueObj);
|
|
else
|
|
return((objRef) falseObj);
|
|
}
|
|
|
|
/*
|
|
Defines the receiver to be an instance of the first argument.
|
|
Returns the receiver.
|
|
Called from
|
|
BlockNode>>newBlock
|
|
ByteArray>>asString
|
|
ByteArray>>size:
|
|
Class>>new:
|
|
*/
|
|
objRef primClassOfPut(objRef arg[])
|
|
{
|
|
classOfPut(arg[0].ptr, arg[1].ptr);
|
|
return(arg[0]);
|
|
}
|
|
|
|
/*
|
|
Creates a new String. The von Neumann space of the new String is that
|
|
of the receiver, up to the left-most null, followed by that of the first
|
|
argument, up to the left-most null, followed by a null.
|
|
Returns the new String.
|
|
Called from
|
|
String>>,
|
|
Symbol>>asString
|
|
*/
|
|
objRef primStringCat(objRef arg[])
|
|
{
|
|
addr src1 = addressOf(arg[0].ptr);
|
|
word len1 = strlen(src1);
|
|
addr src2 = addressOf(arg[1].ptr);
|
|
word len2 = strlen(src2);
|
|
encPtr ans = allocByteObj(len1+len2+1);
|
|
addr tgt = addressOf(ans);
|
|
(void) memcpy(tgt,src1,len1);
|
|
(void) memcpy(((byte*)tgt)+len1,src2,len2);
|
|
if (ptrEq((objRef) stringClass, (objRef) nilObj)) /*fix*/
|
|
stringClass = globalValue("String");
|
|
classOfPut(ans, stringClass);
|
|
return((objRef) ans);
|
|
}
|
|
|
|
/*
|
|
Returns the objRef of the receiver denoted by the argument.
|
|
Called from Object>>basicAt:
|
|
*/
|
|
objRef primBasicAt(objRef arg[])
|
|
{
|
|
int i;
|
|
if (isValue(arg[0]))
|
|
return((objRef) nilObj);
|
|
if (!isObjRefs(arg[0].ptr))
|
|
return((objRef) nilObj);
|
|
if (isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
i = intValueOf(arg[1].val);
|
|
if(i < 1 || i > countOf(arg[0].ptr))
|
|
return((objRef) nilObj);
|
|
return(orefOf(arg[0].ptr, i));
|
|
}
|
|
|
|
/*
|
|
Returns an encoded representation of the byte of the receiver denoted by
|
|
the argument.
|
|
Called from ByteArray>>basicAt:
|
|
*/
|
|
objRef primByteAt(objRef arg[]) /*fix*/
|
|
{
|
|
int i;
|
|
if (isIndex(arg[1]))
|
|
sysError("non integer index", "byteAt:");
|
|
i = byteOf(arg[0].ptr, intValueOf(arg[1].val));
|
|
if (i < 0)
|
|
i += 256;
|
|
return((objRef) encValueOf(i));
|
|
}
|
|
|
|
/*
|
|
Defines the global value of the receiver to be the first argument.
|
|
Returns the receiver.
|
|
Called from Symbol>>assign:
|
|
*/
|
|
objRef primSymbolAssign(objRef arg[]) /*fix*/
|
|
{
|
|
nameTableInsert(
|
|
symbols, strHash(addressOf(arg[0].ptr)), arg[0].ptr, arg[1].ptr);
|
|
return(arg[0]);
|
|
}
|
|
|
|
/*
|
|
Changes the active process stack. The change causes control to be
|
|
returned in the method containing the block controlled by the receiver
|
|
rather than the method which sent the message (e.g. Block>>value) which
|
|
created the context which invoked this primitive. Execution will resume
|
|
at the location denoted by the first argument.
|
|
Called from Context>>returnToBlock:
|
|
N.B.: The code involved here isn't quite as tricky as that involved
|
|
in primBlockReturn (q.v.).
|
|
*/
|
|
objRef primBlockCall(objRef arg[]) /*fix*/
|
|
{
|
|
int i;
|
|
/* first get previous link */
|
|
i = intValueOf(orefOf(processStack, linkPointer).val);
|
|
/* change context and byte pointer */
|
|
orefOfPut(processStack, i + 1, arg[0]);
|
|
orefOfPut(processStack, i + 4, arg[1]);
|
|
return(arg[0]);
|
|
}
|
|
|
|
/*
|
|
Returns a modified copy of the receiver. The receiver is a block. The
|
|
modification defines the controlling context of the clone to be the
|
|
argument. The argument is the current context and is the target of any
|
|
"^" return eventually invoked by the receiver.
|
|
This primitive is called by compiler-generated code.
|
|
N.B.: The code involved here isn't quite as tricky as that involved
|
|
in primBlockReturn (q.v.).
|
|
*/
|
|
objRef primBlockClone(objRef arg[]) /*fix*/
|
|
{
|
|
objRef returnedObject;
|
|
returnedObject = (objRef) newBlock();
|
|
orefOfPut(returnedObject.ptr, 1, arg[1]);
|
|
orefOfPut(returnedObject.ptr, 2, orefOf(arg[0].ptr, 2));
|
|
orefOfPut(returnedObject.ptr, 3, orefOf(arg[0].ptr, 3));
|
|
orefOfPut(returnedObject.ptr, 4, orefOf(arg[0].ptr, 4));
|
|
return(returnedObject);
|
|
}
|
|
|
|
/*
|
|
Defines the objRef of the receiver denoted by the first argument to be
|
|
the second argument.
|
|
Returns the receiver.
|
|
Called from Object>>basicAt:put:
|
|
*/
|
|
objRef primBasicAtPut(objRef arg[])
|
|
{
|
|
int i;
|
|
if (isValue(arg[0]))
|
|
return((objRef) nilObj);
|
|
if (!isObjRefs(arg[0].ptr))
|
|
return((objRef) nilObj);
|
|
if (isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
i = intValueOf(arg[1].val);
|
|
if(i < 1 || i > countOf(arg[0].ptr))
|
|
return((objRef) nilObj);
|
|
orefOfPut(arg[0].ptr, i, arg[2]);
|
|
return(arg[0]);
|
|
}
|
|
|
|
/*
|
|
Defines the byte of the receiver denoted by the first argument to be a
|
|
decoded representation of the second argument.
|
|
Returns the receiver.
|
|
Called from ByteArray>>basicAt:put:
|
|
*/
|
|
objRef primByteAtPut(objRef arg[]) /*fix*/
|
|
{
|
|
if (isIndex(arg[1]))
|
|
sysError("non integer index", "byteAtPut");
|
|
if (isIndex(arg[2]))
|
|
sysError("assigning non int", "to byte");
|
|
byteOfPut(arg[0].ptr, intValueOf(arg[1].val), intValueOf(arg[2].val));
|
|
return(arg[0]);
|
|
}
|
|
|
|
inline word min(word one, word two)
|
|
{
|
|
return(one <= two ? one : two);
|
|
}
|
|
|
|
/*
|
|
Creates a new String. The von Neumann space of the new String is
|
|
usually that of a substring of the receiver, from the byte denoted by
|
|
the first argument through the byte denoted by the second argument,
|
|
followed by a null. However, if the denoted substring is partially
|
|
outside the space of the receiver, only that portion within the space of
|
|
the receiver is used. Also, if the denoted substring includes a null,
|
|
only that portion up to the left-most null is used. Further, if the
|
|
denoted substring is entirely outside the space of the receiver or its
|
|
length is less than one, none of it is used.
|
|
Returns the new String.
|
|
Called from String>>copyFrom:to:
|
|
*/
|
|
objRef primCopyFromTo(objRef arg[]) /*fix*/
|
|
{
|
|
if ((isIndex(arg[1])) || (isIndex(arg[2])))
|
|
sysError("non integer index", "copyFromTo");
|
|
{
|
|
addr src = addressOf(arg[0].ptr);
|
|
word len = strlen(src);
|
|
int pos1 = intValueOf(arg[1].val);
|
|
int pos2 = intValueOf(arg[2].val);
|
|
int req = pos2 + 1 - pos1;
|
|
word act;
|
|
encPtr ans;
|
|
addr tgt;
|
|
if(pos1 >= 1 && pos1 <= len && req >= 1)
|
|
act = min(req, strlen(((byte*)src)+(pos1-1)));
|
|
else
|
|
act = 0;
|
|
ans = allocByteObj(act+1);
|
|
tgt = addressOf(ans);
|
|
(void) memcpy(tgt,((byte*)src)+(pos1-1),act);
|
|
if (ptrEq((objRef) stringClass, (objRef) nilObj)) /*fix*/
|
|
stringClass = globalValue("String");
|
|
classOfPut(ans, stringClass);
|
|
return((objRef) ans);
|
|
}
|
|
}
|
|
|
|
void flushCache(encPtr messageToSend, encPtr class);
|
|
|
|
/*
|
|
Kills the cache slot denoted by the receiver and argument. The receiver
|
|
should be a message selector symbol. The argument should be a class.
|
|
Returns the receiver.
|
|
Called from Class>>install:
|
|
*/
|
|
objRef primFlushCache(objRef arg[])
|
|
{
|
|
if(isValue(arg[0]) || isValue(arg[1]))
|
|
return((objRef) nilObj);
|
|
flushCache(arg[0].ptr, arg[1].ptr);
|
|
return(arg[0]);
|
|
}
|
|
|
|
objRef primParse(objRef arg[]) /*del*/
|
|
{
|
|
setInstanceVariables(arg[0].ptr);
|
|
if (parse(arg[2].ptr, addressOf(arg[1].ptr), false)) {
|
|
flushCache(orefOf(arg[2].ptr, messageInMethod).ptr, arg[0].ptr);
|
|
return((objRef) trueObj);
|
|
} else
|
|
return((objRef) falseObj);
|
|
}
|
|
|
|
/*
|
|
Returns the equivalent of the receiver's value in a floating-point
|
|
representation.
|
|
Called from Integer>>asFloat
|
|
*/
|
|
objRef primAsFloat(objRef arg[])
|
|
{
|
|
if(isIndex(arg[0]))
|
|
return((objRef) nilObj);
|
|
return((objRef) newFloat((double) intValueOf(arg[0].val)));
|
|
}
|
|
|
|
/*
|
|
Defines a counter to be the argument's value. When this counter is
|
|
less than 1, a Process time slice is finished.
|
|
Always fails.
|
|
Called from
|
|
Scheduler>>critical:
|
|
Scheduler>>yield
|
|
*/
|
|
objRef primSetTimeSlice(objRef arg[])
|
|
{
|
|
if(isIndex(arg[0]))
|
|
return((objRef) nilObj);
|
|
*counterAddress = intValueOf(arg[0].val);
|
|
return((objRef) nilObj);
|
|
}
|
|
|
|
/*
|
|
Sets the seed for a pseudo-random number generator.
|
|
Always fails.
|
|
Called from Random>>set:
|
|
*/
|
|
objRef primSetSeed(objRef arg[])
|
|
{
|
|
if(isIndex(arg[0]))
|
|
return((objRef) nilObj);
|
|
(void) srand((unsigned) intValueOf(arg[0].val));
|
|
return((objRef) nilObj);
|
|
}
|
|
|
|
/*
|
|
Returns a new object. The von Neumann space of the new object will be
|
|
presumed to contain a number of objRefs. The number is denoted by the
|
|
receiver.
|
|
Called from
|
|
BlockNode>>newBlock
|
|
Class>>new:
|
|
*/
|
|
objRef primAllocOrefObj(objRef arg[])
|
|
{
|
|
if(isIndex(arg[0]))
|
|
return((objRef) nilObj);
|
|
return((objRef) allocOrefObj(intValueOf(arg[0].val)));
|
|
}
|
|
|
|
/*
|
|
Returns a new object. The von Neumann space of the new object will be
|
|
presumed to contain a number of bytes. The number is denoted by the
|
|
receiver.
|
|
Called from
|
|
ByteArray>>size:
|
|
*/
|
|
objRef primAllocByteObj(objRef arg[])
|
|
{
|
|
if(isIndex(arg[0]))
|
|
return((objRef) nilObj);
|
|
return((objRef) allocByteObj(intValueOf(arg[0].val)));
|
|
}
|
|
|
|
/*
|
|
Returns the result of adding the argument's value to the receiver's
|
|
value.
|
|
Called from Integer>>+
|
|
Also called for SendBinary bytecodes.
|
|
*/
|
|
objRef primAdd(objRef arg[])
|
|
{
|
|
long longresult;
|
|
if(isIndex(arg[0]) || isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
longresult = intValueOf(arg[0].val);
|
|
longresult += intValueOf(arg[1].val);
|
|
if (canEmbed(longresult))
|
|
return((objRef) encValueOf(longresult));
|
|
else
|
|
return((objRef) nilObj);
|
|
}
|
|
|
|
/*
|
|
Returns the result of subtracting the argument's value from the
|
|
receiver's value.
|
|
Called from Integer>>-
|
|
Also called for SendBinary bytecodes.
|
|
*/
|
|
objRef primSubtract(objRef arg[])
|
|
{
|
|
long longresult;
|
|
if(isIndex(arg[0]) || isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
longresult = intValueOf(arg[0].val);
|
|
longresult -= intValueOf(arg[1].val);
|
|
if (canEmbed(longresult))
|
|
return((objRef) encValueOf(longresult));
|
|
else
|
|
return((objRef) nilObj);
|
|
}
|
|
|
|
/*
|
|
Returns true if the receiver's value is less than the argument's
|
|
value; false otherwise.
|
|
Called from Integer>><
|
|
Also called for SendBinary bytecodes.
|
|
*/
|
|
objRef primLessThan(objRef arg[])
|
|
{
|
|
if(isIndex(arg[0]) || isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
if(intValueOf(arg[0].val) < intValueOf(arg[1].val))
|
|
return((objRef) trueObj);
|
|
else
|
|
return((objRef) falseObj);
|
|
}
|
|
|
|
/*
|
|
Returns true if the receiver's value is greater than the argument's
|
|
value; false otherwise.
|
|
Called from Integer>>>
|
|
Also called for SendBinary bytecodes.
|
|
*/
|
|
objRef primGreaterThan(objRef arg[])
|
|
{
|
|
if(isIndex(arg[0]) || isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
if(intValueOf(arg[0].val) > intValueOf(arg[1].val))
|
|
return((objRef) trueObj);
|
|
else
|
|
return((objRef) falseObj);
|
|
}
|
|
|
|
/*
|
|
Returns true if the receiver's value is less than or equal to the
|
|
argument's value; false otherwise.
|
|
Called for SendBinary bytecodes.
|
|
*/
|
|
objRef primLessOrEqual(objRef arg[])
|
|
{
|
|
if(isIndex(arg[0]) || isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
if(intValueOf(arg[0].val) <= intValueOf(arg[1].val))
|
|
return((objRef) trueObj);
|
|
else
|
|
return((objRef) falseObj);
|
|
}
|
|
|
|
/*
|
|
Returns true if the receiver's value is greater than or equal to the
|
|
argument's value; false otherwise.
|
|
Called for SendBinary bytecodes.
|
|
*/
|
|
objRef primGreaterOrEqual(objRef arg[])
|
|
{
|
|
if(isIndex(arg[0]) || isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
if(intValueOf(arg[0].val) >= intValueOf(arg[1].val))
|
|
return((objRef) trueObj);
|
|
else
|
|
return((objRef) falseObj);
|
|
}
|
|
|
|
/*
|
|
Returns true if the receiver's value is equal to the argument's value;
|
|
false otherwise.
|
|
Called for SendBinary bytecodes.
|
|
*/
|
|
objRef primEqual(objRef arg[])
|
|
{
|
|
if(isIndex(arg[0]) || isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
if(intValueOf(arg[0].val) == intValueOf(arg[1].val))
|
|
return((objRef) trueObj);
|
|
else
|
|
return((objRef) falseObj);
|
|
}
|
|
|
|
/*
|
|
Returns true if the receiver's value is not equal to the argument's
|
|
value; false otherwise.
|
|
Called for SendBinary bytecodes.
|
|
*/
|
|
objRef primNotEqual(objRef arg[])
|
|
{
|
|
if(isIndex(arg[0]) || isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
if(intValueOf(arg[0].val) != intValueOf(arg[1].val))
|
|
return((objRef) trueObj);
|
|
else
|
|
return((objRef) falseObj);
|
|
}
|
|
|
|
/*
|
|
Returns the result of multiplying the receiver's value by the
|
|
argument's value.
|
|
Called from Integer>>*
|
|
Also called for SendBinary bytecodes.
|
|
*/
|
|
objRef primMultiply(objRef arg[])
|
|
{
|
|
long longresult;
|
|
if(isIndex(arg[0]) || isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
longresult = intValueOf(arg[0].val);
|
|
longresult *= intValueOf(arg[1].val);
|
|
if (canEmbed(longresult))
|
|
return((objRef) encValueOf(longresult));
|
|
else
|
|
return((objRef) nilObj);
|
|
}
|
|
|
|
/*
|
|
Returns the quotient of the result of dividing the receiver's value by
|
|
the argument's value.
|
|
Called from Integer>>quo:
|
|
Also called for SendBinary bytecodes.
|
|
*/
|
|
objRef primQuotient(objRef arg[])
|
|
{
|
|
long longresult;
|
|
if(isIndex(arg[0]) || isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
if(intValueOf(arg[1].val) == 0)
|
|
return((objRef) nilObj);
|
|
longresult = intValueOf(arg[0].val);
|
|
longresult /= intValueOf(arg[1].val);
|
|
if (canEmbed(longresult))
|
|
return((objRef) encValueOf(longresult));
|
|
else
|
|
return((objRef) nilObj);
|
|
}
|
|
|
|
/*
|
|
Returns the remainder of the result of dividing the receiver's value by
|
|
the argument's value.
|
|
Called for SendBinary bytecodes.
|
|
*/
|
|
objRef primRemainder(objRef arg[])
|
|
{
|
|
long longresult;
|
|
if(isIndex(arg[0]) || isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
if(intValueOf(arg[1].val) == 0)
|
|
return((objRef) nilObj);
|
|
longresult = intValueOf(arg[0].val);
|
|
longresult %= intValueOf(arg[1].val);
|
|
if (canEmbed(longresult))
|
|
return((objRef) encValueOf(longresult));
|
|
else
|
|
return((objRef) nilObj);
|
|
}
|
|
|
|
/*
|
|
Returns the bit-wise "and" of the receiver's value and the argument's
|
|
value.
|
|
Called from Integer>>bitAnd:
|
|
Also called for SendBinary bytecodes.
|
|
*/
|
|
objRef primBitAnd(objRef arg[])
|
|
{
|
|
long longresult;
|
|
if(isIndex(arg[0]) || isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
longresult = intValueOf(arg[0].val);
|
|
longresult &= intValueOf(arg[1].val);
|
|
return((objRef) encValueOf(longresult));
|
|
}
|
|
|
|
/*
|
|
Returns the bit-wise "exclusive or" of the receiver's value and the
|
|
argument's value.
|
|
Called from Integer>>bitXor:
|
|
Also called for SendBinary bytecodes.
|
|
*/
|
|
objRef primBitXor(objRef arg[])
|
|
{
|
|
long longresult;
|
|
if(isIndex(arg[0]) || isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
longresult = intValueOf(arg[0].val);
|
|
longresult ^= intValueOf(arg[1].val);
|
|
return((objRef) encValueOf(longresult));
|
|
}
|
|
|
|
/*
|
|
Returns the result of shifting the receiver's value a number of bit
|
|
positions denoted by the argument's value. Positive arguments cause
|
|
left shifts. Negative arguments cause right shifts. Note that the
|
|
result is truncated to the range of embeddable values.
|
|
Called from Integer>>bitXor:
|
|
*/
|
|
objRef primBitShift(objRef arg[])
|
|
{
|
|
long longresult;
|
|
if(isIndex(arg[0]) || isIndex(arg[1]))
|
|
return((objRef) nilObj);
|
|
longresult = intValueOf(arg[0].val);
|
|
if(intValueOf(arg[1].val) < 0)
|
|
longresult >>= -intValueOf(arg[1].val);
|
|
else
|
|
longresult <<= intValueOf(arg[1].val);
|
|
return((objRef) encValueOf(longresult));
|
|
}
|
|
|
|
/*
|
|
Returns the field count of the von Neumann space of the receiver up to
|
|
the left-most null.
|
|
Called from String>>size
|
|
*/
|
|
objRef primStringSize(objRef arg[])
|
|
{
|
|
return((objRef) encValueOf(strlen(addressOf(arg[0].ptr))));
|
|
}
|
|
|
|
/*
|
|
Returns a hashed representation of the von Neumann space of the receiver
|
|
up to the left-most null.
|
|
Called from
|
|
String>>hash
|
|
Symbol>>stringHash
|
|
*/
|
|
objRef primStringHash(objRef arg[])
|
|
{
|
|
return((objRef) encValueOf(strHash(addressOf(arg[0].ptr))));
|
|
}
|
|
|
|
/*
|
|
Returns a unique object. Here, "unique" is determined by the
|
|
von Neumann space of the receiver up to the left-most null. A copy will
|
|
either be found in or added to the global symbol table. The returned
|
|
object will refer to the copy.
|
|
Called from String>>asSymbol
|
|
*/
|
|
objRef primAsSymbol(objRef arg[])
|
|
{
|
|
return((objRef) newSymbol(addressOf(arg[0].ptr)));
|
|
}
|
|
|
|
/*
|
|
Returns the object associated with the receiver in the global symbol
|
|
table.
|
|
Called from Symbol>>value
|
|
*/
|
|
objRef primGlobalValue(objRef arg[])
|
|
{
|
|
return((objRef) globalValue(addressOf(arg[0].ptr)));
|
|
}
|
|
|
|
/*
|
|
Passes the von Neumann space of the receiver to the host's "system"
|
|
function. Returns what that function returns.
|
|
Called from String>>unixCommand
|
|
*/
|
|
objRef primHostCommand(objRef arg[])
|
|
{
|
|
return((objRef) encValueOf(system(addressOf(arg[0].ptr))));
|
|
}
|
|
|
|
/*
|
|
Returns the equivalent of the receiver's value in a printable character
|
|
representation.
|
|
Called from Float>>printString
|
|
*/
|
|
objRef primAsString(objRef arg[])
|
|
{
|
|
char buffer[32];
|
|
(void) sprintf(buffer, "%g", floatValue(arg[0].ptr));
|
|
return((objRef) newString(buffer));
|
|
}
|
|
|
|
/*
|
|
Returns the natural logarithm of the receiver's value.
|
|
Called from Float>>ln
|
|
*/
|
|
objRef primNaturalLog(objRef arg[])
|
|
{
|
|
return((objRef) newFloat(log(floatValue(arg[0].ptr))));
|
|
}
|
|
|
|
/*
|
|
Returns "e" raised to a power denoted by the receiver's value.
|
|
Called from Float>>exp
|
|
*/
|
|
objRef primERaisedTo(objRef arg[])
|
|
{
|
|
return((objRef) newFloat(exp(floatValue(arg[0].ptr))));
|
|
}
|
|
|
|
/*
|
|
Returns a new Array containing two integers n and m such that the
|
|
receiver's value can be expressed as n * 2**m.
|
|
Called from Float>>integerPart
|
|
*/
|
|
objRef primIntegerPart(objRef arg[])
|
|
{
|
|
double temp;
|
|
int i;
|
|
int j;
|
|
encPtr returnedObject = nilObj;
|
|
#define ndif 12
|
|
temp = frexp(floatValue(arg[0].ptr), &i);
|
|
if ((i >= 0) && (i <= ndif)) {
|
|
temp = ldexp(temp, i);
|
|
i = 0;
|
|
} else {
|
|
i -= ndif;
|
|
temp = ldexp(temp, ndif);
|
|
}
|
|
j = (int) temp;
|
|
returnedObject = newArray(2);
|
|
orefOfPut(returnedObject, 1, (objRef) encValueOf(j));
|
|
orefOfPut(returnedObject, 2, (objRef) encValueOf(i));
|
|
#ifdef trynew
|
|
/* if number is too big it can't be integer anyway */
|
|
if (floatValue(arg[0].ptr) > 2e9)
|
|
returnedObject = nilObj;
|
|
else {
|
|
(void) modf(floatValue(arg[0].ptr), &temp);
|
|
ltemp = (long) temp;
|
|
if (canEmbed(ltemp))
|
|
returnedObject = encValueOf((int) temp);
|
|
else
|
|
returnedObject = newFloat(temp);
|
|
}
|
|
#endif
|
|
return((objRef) returnedObject);
|
|
}
|
|
|
|
/*
|
|
Returns the result of adding the argument's value to the receiver's
|
|
value.
|
|
Called from Float>>+
|
|
*/
|
|
objRef primFloatAdd(objRef arg[])
|
|
{
|
|
double result;
|
|
result = floatValue(arg[0].ptr);
|
|
result += floatValue(arg[1].ptr);
|
|
return((objRef) newFloat(result));
|
|
}
|
|
|
|
/*
|
|
Returns the result of subtracting the argument's value from the
|
|
receiver's value.
|
|
Called from Float>>-
|
|
*/
|
|
objRef primFloatSubtract(objRef arg[])
|
|
{
|
|
double result;
|
|
result = floatValue(arg[0].ptr);
|
|
result -= floatValue(arg[1].ptr);
|
|
return((objRef) newFloat(result));
|
|
}
|
|
|
|
/*
|
|
Returns true if the receiver's value is less than the argument's
|
|
value; false otherwise.
|
|
Called from Float>><
|
|
*/
|
|
objRef primFloatLessThan(objRef arg[])
|
|
{
|
|
if(floatValue(arg[0].ptr) < floatValue(arg[1].ptr))
|
|
return((objRef) trueObj);
|
|
else
|
|
return((objRef) falseObj);
|
|
}
|
|
|
|
/*
|
|
Returns true if the receiver's value is greater than the argument's
|
|
value; false otherwise.
|
|
Not called from the image.
|
|
*/
|
|
objRef primFloatGreaterThan(objRef arg[])
|
|
{
|
|
if(floatValue(arg[0].ptr) > floatValue(arg[1].ptr))
|
|
return((objRef) trueObj);
|
|
else
|
|
return((objRef) falseObj);
|
|
}
|
|
|
|
/*
|
|
Returns true if the receiver's value is less than or equal to the
|
|
argument's value; false otherwise.
|
|
Not called from the image.
|
|
*/
|
|
objRef primFloatLessOrEqual(objRef arg[])
|
|
{
|
|
if(floatValue(arg[0].ptr) <= floatValue(arg[1].ptr))
|
|
return((objRef) trueObj);
|
|
else
|
|
return((objRef) falseObj);
|
|
}
|
|
|
|
/*
|
|
Returns true if the receiver's value is greater than or equal to the
|
|
argument's value; false otherwise.
|
|
Not called from the image.
|
|
*/
|
|
objRef primFloatGreaterOrEqual(objRef arg[])
|
|
{
|
|
if(floatValue(arg[0].ptr) >= floatValue(arg[1].ptr))
|
|
return((objRef) trueObj);
|
|
else
|
|
return((objRef) falseObj);
|
|
}
|
|
|
|
/*
|
|
Returns true if the receiver's value is equal to the argument's value;
|
|
false otherwise.
|
|
Called from Float>>=
|
|
*/
|
|
objRef primFloatEqual(objRef arg[])
|
|
{
|
|
if(floatValue(arg[0].ptr) == floatValue(arg[1].ptr))
|
|
return((objRef) trueObj);
|
|
else
|
|
return((objRef) falseObj);
|
|
}
|
|
|
|
/*
|
|
Returns true if the receiver's value is not equal to the argument's
|
|
value; false otherwise.
|
|
Not called from the image.
|
|
*/
|
|
objRef primFloatNotEqual(objRef arg[])
|
|
{
|
|
if(floatValue(arg[0].ptr) != floatValue(arg[1].ptr))
|
|
return((objRef) trueObj);
|
|
else
|
|
return((objRef) falseObj);
|
|
}
|
|
|
|
/*
|
|
Returns the result of multiplying the receiver's value by the
|
|
argument's value.
|
|
Called from Float>>*
|
|
*/
|
|
objRef primFloatMultiply(objRef arg[])
|
|
{
|
|
double result;
|
|
result = floatValue(arg[0].ptr);
|
|
result *= floatValue(arg[1].ptr);
|
|
return((objRef) newFloat(result));
|
|
}
|
|
|
|
/*
|
|
Returns the result of dividing the receiver's value by the argument's
|
|
value.
|
|
Called from Float>>/
|
|
*/
|
|
objRef primFloatDivide(objRef arg[])
|
|
{
|
|
double result;
|
|
result = floatValue(arg[0].ptr);
|
|
result /= floatValue(arg[1].ptr);
|
|
return((objRef) newFloat(result));
|
|
}
|
|
|
|
#define MAXFILES 32
|
|
|
|
FILE *fp[MAXFILES] = {};
|
|
|
|
/*
|
|
Opens the file denoted by the first argument, if necessary. Some of the
|
|
characteristics of the file and/or the operations permitted on it may be
|
|
denoted by the second argument.
|
|
Returns non-nil if successful; nil otherwise.
|
|
Called from File>>open
|
|
*/
|
|
objRef primFileOpen(objRef arg[])
|
|
{
|
|
int i = intValueOf(arg[0].val);
|
|
char *p = addressOf(arg[1].ptr);
|
|
if (streq(p, "stdin"))
|
|
fp[i] = stdin;
|
|
else if (streq(p, "stdout"))
|
|
fp[i] = stdout;
|
|
else if (streq(p, "stderr"))
|
|
fp[i] = stderr;
|
|
else {
|
|
char* q = addressOf(arg[2].ptr);
|
|
char* r = strchr(q,'b');
|
|
encPtr s = {false,1};
|
|
if(r == NULL) {
|
|
int t = strlen(q);
|
|
s = allocByteObj(t + 2);
|
|
r = addressOf(s);
|
|
memcpy(r,q,t);
|
|
*(r + t) = 'b';
|
|
q = r;
|
|
}
|
|
fp[i] = fopen(p, q);
|
|
if(r == NULL)
|
|
isVolatilePut(s,false);
|
|
}
|
|
if (fp[i] == NULL)
|
|
return((objRef) nilObj);
|
|
else
|
|
return((objRef) encValueOf(i));
|
|
}
|
|
|
|
/*
|
|
Closes the file denoted by the receiver.
|
|
Always fails.
|
|
Called from File>>close
|
|
*/
|
|
objRef primFileClose(objRef arg[])
|
|
{
|
|
int i = intValueOf(arg[0].val);
|
|
if (fp[i])
|
|
(void) fclose(fp[i]);
|
|
fp[i] = NULL;
|
|
return((objRef) nilObj);
|
|
}
|
|
|
|
void coldFileIn(encVal tagRef);
|
|
|
|
/*
|
|
Applies the built-in "fileIn" function to the file denoted by the
|
|
receiver.
|
|
Always fails.
|
|
Not called from the image.
|
|
N.B.: The built-in function uses the built-in compiler. Both should be
|
|
used only in connection with building an initial image.
|
|
*/
|
|
objRef primFileIn(objRef arg[])
|
|
{
|
|
int i = intValueOf(arg[0].val);
|
|
if (fp[i])
|
|
coldFileIn(arg[0].val);
|
|
return((objRef) nilObj);
|
|
}
|
|
|
|
/*
|
|
Reads the next line of characters from the file denoted by the receiver.
|
|
This line usually starts with the character at the current file position
|
|
and ends with the left-most newline. However, if reading from standard
|
|
input, the line may be continued by immediately preceding the newline
|
|
with a backslash, both of which are deleted. Creates a new String. The
|
|
von Neumann space of the new String is usually the characters of the
|
|
complete line followed by a null. However, if reading from standard
|
|
input, the trailing newline is deleted. Also, if the line includes a
|
|
null, only that portion up to the left-most null is used.
|
|
Returns the new String if successful, nil otherwise.
|
|
Called from File>>getString
|
|
*/
|
|
objRef primGetString(objRef arg[])
|
|
{
|
|
int i = intValueOf(arg[0].val);
|
|
int j;
|
|
char buffer[4096];
|
|
if (!fp[i])
|
|
return((objRef) nilObj);
|
|
j = 0;
|
|
buffer[j] = '\0';
|
|
while (1) {
|
|
if (fgets(&buffer[j], 512, fp[i]) == NULL) {
|
|
if (fp[i] == stdin)
|
|
(void) fputc('\n', stdout);
|
|
return ((objRef) nilObj); /* end of file */
|
|
}
|
|
if (fp[i] == stdin) {
|
|
/* delete the newline */
|
|
j = strlen(buffer);
|
|
if (buffer[j - 1] == '\n')
|
|
buffer[j - 1] = '\0';
|
|
}
|
|
j = strlen(buffer) - 1;
|
|
if (buffer[j] != '\\')
|
|
break;
|
|
/* else we loop again */
|
|
}
|
|
return((objRef) newString(buffer));
|
|
}
|
|
|
|
inline bool irf(FILE* tag, addr dat, word len) {
|
|
return((fread(dat,len,1,tag) == 1) ? true : false);
|
|
}
|
|
|
|
encPtr imageRead(FILE* tag)
|
|
{
|
|
encVal ver = encValueOf(3);
|
|
encVal val;
|
|
word ord;
|
|
otbEnt* otp;
|
|
ot2Ent* o2p;
|
|
encPtr ptr;
|
|
word len;
|
|
if(irf(tag, &val, sizeof val) != true)
|
|
goto fail;
|
|
if(ptrNe((objRef)val,(objRef)ver))
|
|
goto fail;
|
|
while(irf(tag, &val, sizeof val) == true) {
|
|
ord = intValueOf(val);
|
|
otp = &objTbl[ord];
|
|
#if 0
|
|
if(irf(tag, (void*)otp, sizeof(addr)) != true)
|
|
goto fail;
|
|
#endif
|
|
if(irf(tag, ((void*)otp)+sizeof(addr), sizeof(otbEnt)-sizeof(addr)) != true)
|
|
goto fail;
|
|
o2p = &ob2Tbl[ord];
|
|
if(irf(tag, o2p, sizeof(ot2Ent)) != true)
|
|
goto fail;
|
|
ptr = encIndexOf(ord);
|
|
if((len = spaceOf(ptr))) {
|
|
addressOfPut(ptr,newStorage(len));
|
|
if(irf(tag, addressOf(ptr), len) != true)
|
|
goto fail;
|
|
}
|
|
}
|
|
return(trueObj);
|
|
fail:
|
|
return(falseObj);
|
|
}
|
|
|
|
inline bool iwf(FILE* tag, addr dat, word len) {
|
|
return((fwrite(dat,len,1,tag) == 1) ? true : false);
|
|
}
|
|
|
|
encPtr imageWrite(FILE* tag)
|
|
{
|
|
encVal val = encValueOf(3);
|
|
word ord;
|
|
encPtr ptr;
|
|
otbEnt* otp;
|
|
ot2Ent* o2p;
|
|
word len;
|
|
if(iwf(tag, &val, sizeof val) != true)
|
|
goto fail;
|
|
for(ord = otbLob; ord <= otbHib; ord++) {
|
|
ptr = encIndexOf(ord);
|
|
if(isAvail(ptr))
|
|
continue;
|
|
val = encValueOf(ord);
|
|
if(iwf(tag, &val, sizeof val) != true)
|
|
goto fail;
|
|
otp = &objTbl[ord];
|
|
#if 0
|
|
if(iwf(tag, (void*)otp, sizeof(addr)) != true)
|
|
goto fail;
|
|
#endif
|
|
if(iwf(tag, ((void*)otp)+sizeof(addr), sizeof(otbEnt)-sizeof(addr)) != true)
|
|
goto fail;
|
|
o2p = &ob2Tbl[ord];
|
|
if(iwf(tag, o2p, sizeof(ot2Ent)) != true)
|
|
goto fail;
|
|
if((len = spaceOf(ptr)))
|
|
if(iwf(tag, addressOf(ptr), len) != true)
|
|
goto fail;
|
|
}
|
|
return(trueObj);
|
|
fail:
|
|
return(falseObj);
|
|
}
|
|
|
|
/*
|
|
Writes the currently running set of objects in binary form to the file
|
|
denoted by the receiver.
|
|
Returns true if successful; false or nil otherwise.
|
|
Called from File>>saveImage
|
|
*/
|
|
objRef primImageWrite(objRef arg[])
|
|
{
|
|
int i = intValueOf(arg[0].val);
|
|
if (fp[i])
|
|
return((objRef) imageWrite(fp[i]));
|
|
else
|
|
return((objRef) nilObj);
|
|
}
|
|
|
|
/*
|
|
Writes the von Neumann space of the argument, up to the left-most null,
|
|
to the file denoted by the receiver.
|
|
Always fails.
|
|
Called from File>>printNoReturn:
|
|
*/
|
|
objRef primPrintWithoutNL(objRef arg[])
|
|
{
|
|
int i = intValueOf(arg[0].val);
|
|
if (!fp[i])
|
|
return((objRef) nilObj);
|
|
(void) fputs(addressOf(arg[1].ptr), fp[i]);
|
|
(void) fflush(fp[i]);
|
|
return((objRef) nilObj);
|
|
}
|
|
|
|
/*
|
|
Writes the von Neumann space of the argument, up to the left-most null,
|
|
to the file denoted by the receiver and appends a newline.
|
|
Always fails.
|
|
Called from File>>print:
|
|
*/
|
|
objRef primPrintWithNL(objRef arg[])
|
|
{
|
|
int i = intValueOf(arg[0].val);
|
|
if (!fp[i])
|
|
return((objRef) nilObj);
|
|
(void) fputs(addressOf(arg[1].ptr), fp[i]);
|
|
(void) fputc('\n', fp[i]);
|
|
return((objRef) nilObj);
|
|
}
|
|
|
|
/*
|
|
Defines the trace vector slot denoted by the receiver to be the value
|
|
denoted by the argument.
|
|
Returns the receiver.
|
|
Not usually called from the image.
|
|
*/
|
|
objRef primSetTrace(objRef arg[])
|
|
{
|
|
traceVect[intValueOf(arg[0].val)] = intValueOf(arg[1].val);
|
|
return(arg[0]);
|
|
}
|
|
|
|
/*
|
|
Prints the von Neumann space of the receiver, followed by a newline, and
|
|
causes an abort.
|
|
Not usually called from the image.
|
|
*/
|
|
objRef primError(objRef arg[])
|
|
{
|
|
(void) fprintf(stderr,"error: '%s'\n",(char*)addressOf(arg[0].ptr));
|
|
assert(false);
|
|
return(arg[0]);
|
|
}
|
|
|
|
/*
|
|
Causes memory reclamation.
|
|
Returns the receiver.
|
|
Not usually called from the image.
|
|
N.B.: Do not call this primitive from the image with a receiver of
|
|
false.
|
|
*/
|
|
objRef primReclaim(objRef arg[])
|
|
{
|
|
if(ptrEq(arg[0], (objRef) trueObj) || ptrEq(arg[0], (objRef) falseObj)) {
|
|
reclaim(ptrEq(arg[0], (objRef) trueObj));
|
|
return(arg[0]);
|
|
}
|
|
else
|
|
return((objRef) nilObj);
|
|
}
|
|
|
|
FILE* logTag = NULL;
|
|
encPtr logBuf = {false,1};
|
|
addr logPtr = 0;
|
|
word logSiz = 0;
|
|
word logPos = 0;
|
|
|
|
void logInit()
|
|
{
|
|
logPos = 0;
|
|
}
|
|
|
|
void logByte(byte val)
|
|
{
|
|
if(logPos == logSiz) {
|
|
encPtr newBuf = allocByteObj(logSiz + 128);
|
|
addr newPtr = addressOf(newBuf);
|
|
(void) memcpy(newPtr,logPtr,logSiz);
|
|
isVolatilePut(logBuf,false);
|
|
logBuf = newBuf;
|
|
logPtr = newPtr;
|
|
logSiz = countOf(logBuf);
|
|
}
|
|
*(((byte*)logPtr)+logPos++) = val;
|
|
}
|
|
|
|
bool logFini()
|
|
{
|
|
if(logTag == NULL)
|
|
return(false);
|
|
if(fwrite(logPtr,logPos,1,logTag) != 1)
|
|
return(false);
|
|
if(fflush(logTag) == EOF)
|
|
return(false);
|
|
return(true);
|
|
}
|
|
|
|
/*
|
|
Writes the von Neumann space of the receiver, except for trailing nulls,
|
|
to the transcript in "chunk" form. A chunk is usually a sequence of
|
|
non-'!' bytes followed by a '!' byte followed by a newline. To
|
|
support '!' bytes within a chunk, such bytes are written as pairs of
|
|
'!' bytes.
|
|
Returns the receiver if successful; nil otherwise.
|
|
Called from ByteArray>>logChunk
|
|
*/
|
|
objRef primLogChunk(objRef arg[])
|
|
{
|
|
logInit();
|
|
{
|
|
encPtr txtBuf = arg[0].ptr;
|
|
addr txtPtr = addressOf(txtBuf);
|
|
word txtSiz = countOf(txtBuf);
|
|
word txtPos = 0;
|
|
while(txtSiz && *(((byte*)txtPtr)+(txtSiz-1)) == '\0')
|
|
txtSiz--;
|
|
while(txtPos != txtSiz) {
|
|
byte val = *(((byte*)txtPtr)+txtPos++);
|
|
logByte(val);
|
|
if(val == '!')
|
|
logByte(val);
|
|
}
|
|
}
|
|
logByte('!');
|
|
logByte('\n');
|
|
if(logFini() != true)
|
|
return((objRef) nilObj);
|
|
return(arg[0]);
|
|
}
|
|
|
|
encPtr bwsBuf = {false,1};
|
|
addr bwsPtr = 0;
|
|
word bwsSiz = 0;
|
|
word bwsPos = 0;
|
|
|
|
void bwsInit(void)
|
|
{
|
|
bwsPos = 0;
|
|
}
|
|
|
|
void bwsNextPut(byte val)
|
|
{
|
|
if(bwsPos == bwsSiz) {
|
|
encPtr newBuf = allocByteObj(bwsSiz + 128);
|
|
addr newPtr = addressOf(newBuf);
|
|
(void) memcpy(newPtr,bwsPtr,bwsSiz);
|
|
isVolatilePut(bwsBuf,false);
|
|
bwsBuf = newBuf;
|
|
bwsPtr = newPtr;
|
|
bwsSiz = countOf(bwsBuf);
|
|
}
|
|
*(((byte*)bwsPtr)+bwsPos++) = val;
|
|
}
|
|
|
|
encPtr bwsFiniGet(void)
|
|
{
|
|
encPtr ans = allocByteObj(bwsPos+1);
|
|
addr tgt = addressOf(ans);
|
|
(void) memcpy(tgt,bwsPtr,bwsPos);
|
|
if (ptrEq((objRef) stringClass, (objRef) nilObj)) /*fix*/
|
|
stringClass = globalValue("String");
|
|
classOfPut(ans, stringClass);
|
|
return(ans);
|
|
}
|
|
|
|
bool bwsFiniPut(FILE* tag)
|
|
{
|
|
if(fwrite(bwsPtr,bwsPos,1,tag) != 1)
|
|
return(false);
|
|
if(fflush(tag) == EOF)
|
|
return(false);
|
|
return(true);
|
|
}
|
|
|
|
/*
|
|
Reads the next chunk of characters from the file denoted by the
|
|
receiver. A chunk is usually a sequence of non-'!' bytes followed by
|
|
a '!' byte followed by a newline. To support '!' bytes within a
|
|
chunk, such bytes are read as pairs of '!' bytes. Creates a new
|
|
String. The von Neumann space of the new String is the bytes of the
|
|
chunk, not including the trailing '!' byte or newline, followed by a
|
|
null.
|
|
Returns the new String if successful, nil otherwise.
|
|
Called from File>>getChunk
|
|
*/
|
|
objRef primGetChunk(objRef arg[])
|
|
{
|
|
int i;
|
|
FILE* tag;
|
|
int val;
|
|
i = intValueOf(arg[0].val);
|
|
if((tag = fp[i]) == NULL)
|
|
goto fail;
|
|
bwsInit();
|
|
while((val = fgetc(tag)) != EOF) {
|
|
if(val == '!')
|
|
switch((val = fgetc(tag))) {
|
|
case '\n':
|
|
goto done;
|
|
case '!':
|
|
break;
|
|
default:
|
|
goto fail;
|
|
}
|
|
bwsNextPut(val);
|
|
}
|
|
fail:
|
|
return((objRef) nilObj);
|
|
done:
|
|
return((objRef) bwsFiniGet());
|
|
}
|
|
|
|
/*
|
|
Writes the von Neumann space of the argument, except for trailing nulls,
|
|
to the file denoted by the receiver in "chunk" form. A chunk is usually
|
|
a sequence of non-'!' bytes followed by a '!' byte followed by a
|
|
newline. To support '!' bytes within a chunk, such bytes are written
|
|
as pairs of '!' bytes.
|
|
Returns the receiver if successful; nil otherwise.
|
|
Called from File>>putChunk
|
|
*/
|
|
objRef primPutChunk(objRef arg[])
|
|
{
|
|
int i;
|
|
FILE* tag;
|
|
i = intValueOf(arg[0].val);
|
|
if((tag = fp[i]) == NULL)
|
|
goto fail;
|
|
bwsInit();
|
|
{
|
|
encPtr txtBuf = arg[1].ptr;
|
|
addr txtPtr = addressOf(txtBuf);
|
|
word txtSiz = countOf(txtBuf);
|
|
word txtPos = 0;
|
|
while(txtSiz && *(((byte*)txtPtr)+(txtSiz-1)) == '\0')
|
|
txtSiz--;
|
|
while(txtPos != txtSiz) {
|
|
byte val = *(((byte*)txtPtr)+txtPos++);
|
|
bwsNextPut(val);
|
|
if(val == '!')
|
|
bwsNextPut(val);
|
|
}
|
|
}
|
|
bwsNextPut('!');
|
|
bwsNextPut('\n');
|
|
if(bwsFiniPut(tag) == true)
|
|
goto done;
|
|
fail:
|
|
return((objRef) nilObj);
|
|
done:
|
|
return(arg[0]);
|
|
}
|
|
|
|
typedef objRef primitiveMethod(objRef arg[]);
|
|
|
|
#define primVectLob 0
|
|
#define primVectHib 255
|
|
#define primVectDom ((primVectHib + 1) - primVectLob)
|
|
|
|
primitiveMethod* primitiveVector[primVectDom] = {
|
|
/*000*/ &unsupportedPrim,
|
|
/*001*/ &unsupportedPrim,
|
|
/*002*/ &primAvailCount,
|
|
/*003*/ &primRandom,
|
|
/*004*/ &unsupportedPrim,
|
|
/*005*/ &primFlipWatching,
|
|
/*006*/ &unsupportedPrim,
|
|
/*007*/ &unsupportedPrim,
|
|
/*008*/ &unsupportedPrim,
|
|
/*009*/ &primExit,
|
|
/*010*/ &unsupportedPrim,
|
|
/*011*/ &primClass,
|
|
/*012*/ &primSize,
|
|
/*013*/ &primHash,
|
|
/*014*/ &unsupportedPrim,
|
|
/*015*/ &unsupportedPrim,
|
|
/*016*/ &unsupportedPrim,
|
|
/*017*/ &unsupportedPrim,
|
|
/*018*/ &primBlockReturn,
|
|
/*019*/ &primExecute,
|
|
/*020*/ &unsupportedPrim,
|
|
/*021*/ &primIdent,
|
|
/*022*/ &primClassOfPut,
|
|
/*023*/ &unsupportedPrim,
|
|
/*024*/ &primStringCat,
|
|
/*025*/ &primBasicAt,
|
|
/*026*/ &primByteAt,
|
|
/*027*/ &primSymbolAssign,
|
|
/*028*/ &primBlockCall,
|
|
/*029*/ &primBlockClone,
|
|
/*030*/ &unsupportedPrim,
|
|
/*031*/ &primBasicAtPut,
|
|
/*032*/ &primByteAtPut,
|
|
/*033*/ &primCopyFromTo,
|
|
/*034*/ &unsupportedPrim,
|
|
/*035*/ &unsupportedPrim,
|
|
/*036*/ &unsupportedPrim,
|
|
/*037*/ &unsupportedPrim,
|
|
/*038*/ &primFlushCache,
|
|
/*039*/ &primParse,
|
|
/*040*/ &unsupportedPrim,
|
|
/*041*/ &unsupportedPrim,
|
|
/*042*/ &unsupportedPrim,
|
|
/*043*/ &unsupportedPrim,
|
|
/*044*/ &unsupportedPrim,
|
|
/*045*/ &unsupportedPrim,
|
|
/*046*/ &unsupportedPrim,
|
|
/*047*/ &unsupportedPrim,
|
|
/*048*/ &unsupportedPrim,
|
|
/*049*/ &unsupportedPrim,
|
|
/*050*/ &unsupportedPrim,
|
|
/*051*/ &primAsFloat,
|
|
/*052*/ &unsupportedPrim,
|
|
/*053*/ &primSetTimeSlice,
|
|
/*054*/ &unsupportedPrim,
|
|
/*055*/ &primSetSeed,
|
|
/*056*/ &unsupportedPrim,
|
|
/*057*/ &unsupportedPrim,
|
|
/*058*/ &primAllocOrefObj,
|
|
/*059*/ &primAllocByteObj,
|
|
/*060*/ &primAdd,
|
|
/*061*/ &primSubtract,
|
|
/*062*/ &primLessThan,
|
|
/*063*/ &primGreaterThan,
|
|
/*064*/ &primLessOrEqual,
|
|
/*065*/ &primGreaterOrEqual,
|
|
/*066*/ &primEqual,
|
|
/*067*/ &primNotEqual,
|
|
/*068*/ &primMultiply,
|
|
/*069*/ &primQuotient,
|
|
/*070*/ &primRemainder,
|
|
/*071*/ &primBitAnd,
|
|
/*072*/ &primBitXor,
|
|
/*073*/ &unsupportedPrim,
|
|
/*074*/ &unsupportedPrim,
|
|
/*075*/ &unsupportedPrim,
|
|
/*076*/ &unsupportedPrim,
|
|
/*077*/ &unsupportedPrim,
|
|
/*078*/ &unsupportedPrim,
|
|
/*079*/ &primBitShift,
|
|
/*080*/ &unsupportedPrim,
|
|
/*081*/ &primStringSize,
|
|
/*082*/ &primStringHash,
|
|
/*083*/ &primAsSymbol,
|
|
/*084*/ &unsupportedPrim,
|
|
/*085*/ &unsupportedPrim,
|
|
/*086*/ &unsupportedPrim,
|
|
/*087*/ &primGlobalValue,
|
|
/*088*/ &primHostCommand,
|
|
/*089*/ &unsupportedPrim,
|
|
/*090*/ &unsupportedPrim,
|
|
/*091*/ &unsupportedPrim,
|
|
/*092*/ &unsupportedPrim,
|
|
/*093*/ &unsupportedPrim,
|
|
/*094*/ &unsupportedPrim,
|
|
/*095*/ &unsupportedPrim,
|
|
/*096*/ &unsupportedPrim,
|
|
/*097*/ &unsupportedPrim,
|
|
/*098*/ &unsupportedPrim,
|
|
/*099*/ &unsupportedPrim,
|
|
/*100*/ &unsupportedPrim,
|
|
/*101*/ &primAsString,
|
|
/*102*/ &primNaturalLog,
|
|
/*103*/ &primERaisedTo,
|
|
/*104*/ &unsupportedPrim,
|
|
/*105*/ &unsupportedPrim,
|
|
/*106*/ &primIntegerPart,
|
|
/*107*/ &unsupportedPrim,
|
|
/*108*/ &unsupportedPrim,
|
|
/*109*/ &unsupportedPrim,
|
|
/*110*/ &primFloatAdd,
|
|
/*111*/ &primFloatSubtract,
|
|
/*112*/ &primFloatLessThan,
|
|
/*113*/ &primFloatGreaterThan,
|
|
/*114*/ &primFloatLessOrEqual,
|
|
/*115*/ &primFloatGreaterOrEqual,
|
|
/*116*/ &primFloatEqual,
|
|
/*117*/ &primFloatNotEqual,
|
|
/*118*/ &primFloatMultiply,
|
|
/*119*/ &primFloatDivide,
|
|
/*120*/ &primFileOpen,
|
|
/*121*/ &primFileClose,
|
|
/*122*/ &unsupportedPrim,
|
|
/*123*/ &primFileIn,
|
|
/*124*/ &unsupportedPrim,
|
|
/*125*/ &primGetString,
|
|
/*126*/ &unsupportedPrim,
|
|
/*127*/ &primImageWrite,
|
|
/*128*/ &primPrintWithoutNL,
|
|
/*129*/ &primPrintWithNL,
|
|
/*130*/ &unsupportedPrim,
|
|
/*131*/ &unsupportedPrim,
|
|
/*132*/ &unsupportedPrim,
|
|
/*133*/ &unsupportedPrim,
|
|
/*134*/ &unsupportedPrim,
|
|
/*135*/ &unsupportedPrim,
|
|
/*136*/ &unsupportedPrim,
|
|
/*137*/ &unsupportedPrim,
|
|
/*138*/ &unsupportedPrim,
|
|
/*139*/ &unsupportedPrim,
|
|
/*140*/ &unsupportedPrim,
|
|
/*141*/ &unsupportedPrim,
|
|
/*142*/ &unsupportedPrim,
|
|
/*143*/ &unsupportedPrim,
|
|
/*144*/ &unsupportedPrim,
|
|
/*145*/ &unsupportedPrim,
|
|
/*146*/ &unsupportedPrim,
|
|
/*147*/ &unsupportedPrim,
|
|
/*148*/ &unsupportedPrim,
|
|
/*149*/ &unsupportedPrim,
|
|
/*150*/ &unsupportedPrim,
|
|
/*151*/ &primSetTrace,
|
|
/*152*/ &primError,
|
|
/*153*/ &primReclaim,
|
|
/*154*/ &primLogChunk,
|
|
/*155*/ &unsupportedPrim,
|
|
/*156*/ &unsupportedPrim,
|
|
/*157*/ &primGetChunk,
|
|
/*158*/ &primPutChunk,
|
|
/*159*/ &unsupportedPrim
|
|
};
|
|
|
|
inline objRef primitive(int primitiveNumber, objRef* arguments)
|
|
{
|
|
if(primitiveNumber >= primVectLob && primitiveNumber <= primVectHib)
|
|
{
|
|
primitiveMethod* primMethPtr = primitiveVector[primitiveNumber];
|
|
if(primMethPtr)
|
|
return((*primMethPtr)(arguments));
|
|
}
|
|
return(unsupportedPrim(arguments));
|
|
}
|
|
|
|
encPtr findClass(char* name)
|
|
{
|
|
encPtr newobj;
|
|
|
|
newobj = globalValue(name);
|
|
if (ptrEq((objRef) newobj, (objRef) nilObj))
|
|
newobj = newClass(name);
|
|
if (ptrEq(orefOf(newobj, sizeInClass), (objRef) nilObj)) {
|
|
orefOfPut(newobj, sizeInClass, (objRef) encValueOf(0));
|
|
}
|
|
return newobj;
|
|
}
|
|
|
|
void coldClassDef(encPtr strRef)
|
|
{
|
|
encPtr superStr;
|
|
encPtr classObj;
|
|
int size;
|
|
lexinit(addressOf(strRef));
|
|
superStr = newString(tokenString);
|
|
(void) nextToken();
|
|
(void) nextToken();
|
|
classObj = findClass(tokenString);
|
|
if(streq(addressOf(superStr),"nil"))
|
|
size = 0;
|
|
else {
|
|
encPtr superObj;
|
|
superObj = findClass(addressOf(superStr));
|
|
size = intValueOf(orefOf(superObj, sizeInClass).val);
|
|
orefOfPut(classObj, superClassInClass, (objRef) superObj);
|
|
{
|
|
encPtr classMeta = classOf(classObj);
|
|
encPtr superMeta = classOf(superObj);
|
|
orefOfPut(classMeta, superClassInClass, (objRef) superMeta);
|
|
}
|
|
}
|
|
(void) nextToken();
|
|
(void) nextToken();
|
|
if(*tokenString) {
|
|
encPtr instStr;
|
|
int instTop;
|
|
encPtr instVars[256];
|
|
encPtr varVec;
|
|
int i;
|
|
instStr = newString(tokenString);
|
|
lexinit(addressOf(instStr));
|
|
instTop = 0;
|
|
while(*tokenString) {
|
|
instVars[instTop++] = newSymbol(tokenString);
|
|
size++;
|
|
(void) nextToken();
|
|
}
|
|
varVec = newArray(instTop);
|
|
for (i = 0; i < instTop; i++)
|
|
orefOfPut(varVec, i + 1, (objRef) instVars[i]);
|
|
orefOfPut(classObj, variablesInClass, (objRef) varVec);
|
|
isVolatilePut(instStr,false);
|
|
}
|
|
orefOfPut(classObj, sizeInClass, (objRef) encValueOf(size));
|
|
isVolatilePut(superStr,false);
|
|
}
|
|
|
|
#define MethodTableSize 39
|
|
|
|
void coldMethods(encVal tagRef)
|
|
{
|
|
encPtr strRef;
|
|
encPtr classObj;
|
|
encPtr methTable;
|
|
if(ptrEq(strRef = primGetChunk((objRef *) &tagRef).ptr, (objRef) nilObj))
|
|
return;
|
|
if(streq(addressOf(strRef),"}"))
|
|
return;
|
|
lexinit(addressOf(strRef));
|
|
classObj = findClass(tokenString);
|
|
setInstanceVariables(classObj);
|
|
/* now find or create a method table */
|
|
methTable = orefOf(classObj, methodsInClass).ptr;
|
|
if (ptrEq((objRef) methTable, (objRef) nilObj)) { /* must make */
|
|
methTable = newDictionary(MethodTableSize);
|
|
orefOfPut(classObj, methodsInClass, (objRef) methTable);
|
|
}
|
|
while(ptrNe(strRef = primGetChunk((objRef *) &tagRef).ptr, (objRef) nilObj)) {
|
|
encPtr theMethod;
|
|
encPtr selector;
|
|
if(streq(addressOf(strRef),"}"))
|
|
return;
|
|
/* now we have a method */
|
|
theMethod = newMethod();
|
|
if (parse(theMethod, addressOf(strRef), true)) {
|
|
orefOfPut(theMethod, methodClassInMethod, (objRef) classObj);
|
|
selector = orefOf(theMethod, messageInMethod).ptr;
|
|
nameTableInsert(methTable, oteIndexOf(selector), selector, theMethod);
|
|
} else {
|
|
/* get rid of unwanted method */
|
|
isVolatilePut(theMethod, false);
|
|
}
|
|
}
|
|
}
|
|
|
|
void coldFileIn(encVal tagRef)
|
|
{
|
|
encPtr strRef;
|
|
while(ptrNe(strRef = primGetChunk((objRef *) &tagRef).ptr, (objRef) nilObj)) {
|
|
if(streq(addressOf(strRef),"{"))
|
|
coldMethods(tagRef);
|
|
else
|
|
coldClassDef(strRef);
|
|
}
|
|
}
|
|
|
|
/*
|
|
The basic scheduling unit is a Process. We keep a separate copy of its
|
|
reference. This interpreter is explicitly stack-based. We use a
|
|
separate stack for each Process and keep pointers to both its bottom and
|
|
top. Information about particular activations of a Method can be
|
|
maintained in separate Context objects. However, if a separate object
|
|
isn't needed, this information is kept within the process stack. A
|
|
returned object replaces the receiver and arguments of the message which
|
|
produced it. This occurs within the process stack at an offset called
|
|
the "return point". We treat arguments and temporaries as if they were
|
|
stored in separate spaces. However, they may actually be kept within
|
|
the process stack. Though the receiver can be thought of as the
|
|
"zeroth" argument and accessed from the argument space, we keep separate
|
|
copies of its reference and a pointer to its instance variable space.
|
|
We also keep separate pointers to the literal and bytecode spaces of a
|
|
Method. The "instruction pointer" is kept as an offset into the
|
|
bytecode space. An explicit counter supports a rudimentary multi-
|
|
programming scheme.
|
|
*/
|
|
typedef struct {
|
|
encPtr pcso; /* process object */
|
|
/*encPtr pso; process stack object */
|
|
objRef* psb; /* process stack base address */
|
|
objRef* pst; /* process stack top address */
|
|
encPtr cxto; /* context or process stack object */
|
|
objRef* cxtb; /* context or process stack base address */
|
|
int rtnp; /* offset at which to store a returned object */
|
|
objRef* argb; /* argument base address */
|
|
objRef* tmpb; /* temporary base address */
|
|
objRef rcvo; /* receiver object */
|
|
objRef* rcvb; /* receiver base address */
|
|
/*encPtr lito; literal object */
|
|
objRef* litb; /* literal base address */
|
|
/*encPtr byto; bytecode object */
|
|
byte* bytb; /* bytecode base address - 1 */
|
|
word byteOffset;
|
|
int timeSliceCounter;
|
|
} execState;
|
|
#define processObject pcso
|
|
#define contextObject cxto
|
|
#define returnPoint rtnp
|
|
#define receiverObject rcvo
|
|
|
|
inline objRef processStackAt(execState* es, int n)
|
|
{
|
|
return(*(es->psb+(n-1)));
|
|
}
|
|
|
|
inline objRef stackTop(execState* es)
|
|
{
|
|
return(*es->pst);
|
|
}
|
|
|
|
inline void stackTopPut(execState* es, objRef x)
|
|
{
|
|
*es->pst = x;
|
|
}
|
|
|
|
inline void stackTopFree(execState* es)
|
|
{
|
|
*es->pst-- = (objRef) nilObj;
|
|
}
|
|
|
|
inline int stackInUse(execState* es)
|
|
{
|
|
return((es->pst+1)-es->psb);
|
|
}
|
|
|
|
inline void ipush(execState* es, objRef x)
|
|
{
|
|
*++es->pst = x;
|
|
}
|
|
|
|
inline objRef ipop(execState* es)
|
|
{
|
|
objRef x = *es->pst;
|
|
*es->pst-- = (objRef) nilObj;
|
|
return(x);
|
|
}
|
|
|
|
inline objRef argumentAt(execState* es, int n)
|
|
{
|
|
return(*(es->argb+n));
|
|
}
|
|
|
|
inline objRef temporaryAt(execState* es, int n)
|
|
{
|
|
return(*(es->tmpb+n));
|
|
}
|
|
|
|
inline void temporaryAtPut(execState* es, int n, objRef x)
|
|
{
|
|
*(es->tmpb+n) = x;
|
|
}
|
|
|
|
inline objRef receiverAt(execState* es, int n)
|
|
{
|
|
return(*(es->rcvb+n));
|
|
}
|
|
|
|
inline void receiverAtPut(execState* es, int n, objRef x)
|
|
{
|
|
*(es->rcvb+n) = x;
|
|
}
|
|
|
|
inline objRef literalAt(execState* es, int n)
|
|
{
|
|
return(*(es->litb+n));
|
|
}
|
|
|
|
inline byte nextByte(execState* es)
|
|
{
|
|
return(*(es->bytb + es->byteOffset++));
|
|
}
|
|
|
|
bool unsupportedByte(execState* es, int low)
|
|
{
|
|
sysError("invalid bytecode", "");
|
|
return(false);
|
|
}
|
|
|
|
/*
|
|
Pushes the value of one of the receiver's instance variables onto the
|
|
process stack. The instruction operand denotes which one.
|
|
*/
|
|
bool bytePushInstance(execState* es, int low)
|
|
{
|
|
ipush(es, receiverAt(es, low));
|
|
return(true);
|
|
}
|
|
|
|
/*
|
|
Pushes the value of one of the message's argument variables onto the
|
|
process stack. The instruction operand denotes which one. Note that
|
|
the receiver is accessed as the "zeroth" argument.
|
|
*/
|
|
bool bytePushArgument(execState* es, int low)
|
|
{
|
|
ipush(es, argumentAt(es, low));
|
|
return(true);
|
|
}
|
|
|
|
/*
|
|
Pushes the value of one of the method's temporary variables onto the
|
|
process stack. The instruction operand denotes which one.
|
|
*/
|
|
bool bytePushTemporary(execState* es, int low)
|
|
{
|
|
ipush(es, temporaryAt(es, low));
|
|
return(true);
|
|
}
|
|
|
|
/*
|
|
Pushes one of the method's literal values onto the process stack. The
|
|
instruction operand denotes which one. See also "bytePushConstant".
|
|
*/
|
|
bool bytePushLiteral(execState* es, int low)
|
|
{
|
|
ipush(es, literalAt(es, low));
|
|
return(true);
|
|
}
|
|
|
|
encPtr method = {true,0};
|
|
|
|
encPtr copyFrom(encPtr obj, int start, int size)
|
|
{
|
|
encPtr newObj;
|
|
int i;
|
|
|
|
newObj = newArray(size);
|
|
for (i = 1; i <= size; i++) {
|
|
orefOfPut(newObj, i, orefOf(obj, start));
|
|
start++;
|
|
}
|
|
return newObj;
|
|
}
|
|
|
|
void fetchLinkageState(execState* es)
|
|
{
|
|
es->contextObject = processStackAt(es, linkPointer + 1).ptr;
|
|
es->returnPoint = intValueOf(processStackAt(es, linkPointer + 2).val);
|
|
es->byteOffset = intValueOf(processStackAt(es, linkPointer + 4).val);
|
|
if (ptrEq((objRef) es->contextObject, (objRef) nilObj)) {
|
|
es->contextObject = processStack;
|
|
es->cxtb = es->psb;
|
|
es->argb = es->cxtb + (es->returnPoint - 1);
|
|
method = processStackAt(es, linkPointer + 3).ptr;
|
|
es->tmpb = es->cxtb + linkPointer + 4;
|
|
} else { /* read from context object */
|
|
es->cxtb = addressOf(es->contextObject);
|
|
method = orefOf(es->contextObject, methodInContext).ptr;
|
|
es->argb = addressOf(orefOf(es->contextObject, argumentsInContext).ptr);
|
|
es->tmpb = addressOf(orefOf(es->contextObject, temporariesInContext).ptr);
|
|
}
|
|
}
|
|
|
|
inline void fetchReceiverState(execState* es)
|
|
{
|
|
es->receiverObject = argumentAt(es, 0);
|
|
if (isIndex(es->receiverObject)) {
|
|
assert(ptrNe(es->receiverObject, (objRef) pointerList));
|
|
es->rcvb = addressOf(es->receiverObject.ptr);
|
|
}
|
|
else
|
|
es->rcvb = (objRef*) 0;
|
|
}
|
|
|
|
inline void fetchMethodState(execState* es)
|
|
{
|
|
es->litb = addressOf(orefOf(method, literalsInMethod).ptr);
|
|
es->bytb = addressOf(orefOf(method, bytecodesInMethod).ptr) - 1;
|
|
}
|
|
|
|
/*
|
|
Pushes one of several "constant" value onto the process stack. The
|
|
instruction operand denotes which one. Note that a given context object
|
|
is not "constant" in that the values of its instance variables may
|
|
change. However, the identity of a given context object is "constant"
|
|
in that it will not change. See also "bytePushLiteral".
|
|
*/
|
|
bool bytePushConstant(execState* es, int low)
|
|
{
|
|
switch (low) {
|
|
case 0:
|
|
case 1:
|
|
case 2:
|
|
ipush(es, (objRef) encValueOf(low));
|
|
break;
|
|
case minusOne:
|
|
ipush(es, (objRef) encValueOf(-1));
|
|
break;
|
|
case contextConst:
|
|
/* check to see if we have made a block context yet */
|
|
if (ptrEq((objRef) es->contextObject, (objRef) processStack)) {
|
|
/* not yet, do it now - first get real return point */
|
|
es->returnPoint = intValueOf(processStackAt(es, linkPointer + 2).val);
|
|
es->contextObject = newContext(
|
|
linkPointer,
|
|
method,
|
|
copyFrom(processStack, es->returnPoint, linkPointer - es->returnPoint),
|
|
copyFrom(processStack, linkPointer + 5, methodTempSize(method) ) );
|
|
orefOfPut(processStack, linkPointer + 1, (objRef) es->contextObject);
|
|
ipush(es, (objRef) es->contextObject);
|
|
/* save byte pointer then restore things properly */
|
|
orefOfPut(processStack, linkPointer + 4, (objRef) encValueOf(es->byteOffset));
|
|
fetchLinkageState(es);
|
|
fetchReceiverState(es);
|
|
fetchMethodState(es);
|
|
break;
|
|
}
|
|
ipush(es, (objRef) es->contextObject);
|
|
break;
|
|
case nilConst:
|
|
ipush(es, (objRef) nilObj);
|
|
break;
|
|
case trueConst:
|
|
ipush(es, (objRef) trueObj);
|
|
break;
|
|
case falseConst:
|
|
ipush(es, (objRef) falseObj);
|
|
break;
|
|
default:
|
|
sysError("unimplemented constant", "pushConstant");
|
|
return(false);
|
|
}
|
|
return(true);
|
|
}
|
|
|
|
/*
|
|
Stores the value on the top of the process stack into of one of the
|
|
receiver's instance variables. The instruction operand denotes which
|
|
one. Note that this doesn't pop the value from the stack.
|
|
*/
|
|
bool byteAssignInstance(execState* es, int low)
|
|
{
|
|
receiverAtPut(es, low, stackTop(es));
|
|
return(true);
|
|
}
|
|
|
|
/*
|
|
Stores the value on the top of the process stack into of one of the
|
|
method's temporary variables. The instruction operand denotes which
|
|
one. Note that this doesn't pop the value from the stack.
|
|
*/
|
|
bool byteAssignTemporary(execState* es, int low)
|
|
{
|
|
temporaryAtPut(es, low, stackTop(es));
|
|
return(true);
|
|
}
|
|
|
|
/*
|
|
Computes the offset within the process stack at which a returned object
|
|
will replace the receiver and arguments of a message.
|
|
*/
|
|
bool byteMarkArguments(execState* es, int low)
|
|
{
|
|
es->returnPoint = (stackInUse(es) - low) + 1;
|
|
es->timeSliceCounter++; /* make sure we do send */
|
|
return(true);
|
|
}
|
|
|
|
inline encPtr firstLookupClass(execState* es)
|
|
{
|
|
es->argb = es->psb + (es->returnPoint - 1);
|
|
fetchReceiverState(es);
|
|
return(getClass(es->receiverObject));
|
|
}
|
|
|
|
encPtr messageToSend = {true,0};
|
|
|
|
int messTest(encPtr obj)
|
|
{
|
|
return(ptrEq((objRef) obj, (objRef) messageToSend));
|
|
}
|
|
|
|
bool findMethod(encPtr* methodClassLocation)
|
|
{
|
|
encPtr methodTable,
|
|
methodClass;
|
|
|
|
method = nilObj;
|
|
methodClass = *methodClassLocation;
|
|
|
|
for (; ptrNe((objRef) methodClass, (objRef) nilObj); methodClass =
|
|
orefOf(methodClass, superClassInClass).ptr) {
|
|
methodTable = orefOf(methodClass, methodsInClass).ptr;
|
|
if (ptrEq((objRef) methodTable, (objRef) nilObj)) { /*fix*/
|
|
methodTable = newDictionary(MethodTableSize);
|
|
orefOfPut(methodClass, methodsInClass, (objRef) methodTable);
|
|
}
|
|
method = hashEachElement(methodTable, oteIndexOf(messageToSend), messTest);
|
|
if (ptrNe((objRef) method, (objRef) nilObj))
|
|
break;
|
|
}
|
|
|
|
if (ptrEq((objRef) method, (objRef) nilObj)) { /* it wasn't found */
|
|
methodClass = *methodClassLocation;
|
|
return false;
|
|
}
|
|
*methodClassLocation = methodClass;
|
|
return true;
|
|
}
|
|
|
|
#define cacheSize 211
|
|
|
|
struct {
|
|
encPtr cacheMessage; /* the message being requested */
|
|
encPtr lookupClass; /* the class of the receiver */
|
|
encPtr cacheClass; /* the class of the method */
|
|
encPtr cacheMethod; /* the method itself */
|
|
} methodCache[cacheSize] = {};
|
|
|
|
void flushCache(encPtr messageToSend, encPtr class)
|
|
{
|
|
int i;
|
|
for(i = 0; i != cacheSize; i++)
|
|
if(ptrEq((objRef) methodCache[i].cacheMessage, (objRef) messageToSend))
|
|
methodCache[i].cacheMessage = nilObj;
|
|
}
|
|
|
|
bool lookupGivenSelector(execState* es, encPtr methodClass)
|
|
{
|
|
int hash;
|
|
int j;
|
|
encPtr argarray;
|
|
objRef returnedObject;
|
|
if(mselTrace)
|
|
fprintf(stderr, "%d: %s\n",mselTrace--,(char*)addressOf(messageToSend));
|
|
/* look up method in cache */
|
|
hash = (oteIndexOf(messageToSend) + oteIndexOf(methodClass)) % cacheSize;
|
|
assert(hash >= 0 && hash < cacheSize);
|
|
if (ptrEq((objRef) methodCache[hash].cacheMessage, (objRef) messageToSend) &&
|
|
ptrEq((objRef) methodCache[hash].lookupClass, (objRef) methodClass)) {
|
|
method = methodCache[hash].cacheMethod;
|
|
methodClass = methodCache[hash].cacheClass;
|
|
assert(isAvail(method) == false);
|
|
} else {
|
|
methodCache[hash].lookupClass = methodClass;
|
|
if (!findMethod(&methodClass)) {
|
|
/* not found, we invoke a smalltalk method */
|
|
/* to recover */
|
|
j = stackInUse(es) - es->returnPoint;
|
|
argarray = newArray(j + 1);
|
|
for (; j >= 0; j--) {
|
|
returnedObject = ipop(es);
|
|
orefOfPut(argarray, j + 1, returnedObject);
|
|
}
|
|
ipush(es, orefOf(argarray, 1)); /* push receiver back */
|
|
ipush(es, (objRef) messageToSend);
|
|
messageToSend = newSymbol("message:notRecognizedWithArguments:");
|
|
ipush(es, (objRef) argarray);
|
|
/* try again - if fail really give up */
|
|
if (!findMethod(&methodClass)) {
|
|
sysWarn("can't find", "error recovery method");
|
|
/* just quit */
|
|
return false;
|
|
}
|
|
}
|
|
methodCache[hash].cacheMessage = messageToSend;
|
|
methodCache[hash].cacheMethod = method;
|
|
methodCache[hash].cacheClass = methodClass;
|
|
}
|
|
return(true);
|
|
}
|
|
|
|
bool watching = 0;
|
|
|
|
bool lookupWatchSelector(execState* es)
|
|
{
|
|
int j;
|
|
encPtr argarray;
|
|
objRef returnedObject;
|
|
encPtr methodClass;
|
|
if (watching && ptrNe(orefOf(method, watchInMethod), (objRef) nilObj)) {
|
|
/* being watched, we send to method itself */
|
|
j = stackInUse(es) - es->returnPoint;
|
|
argarray = newArray(j + 1);
|
|
for (; j >= 0; j--) {
|
|
returnedObject = ipop(es);
|
|
orefOfPut(argarray, j + 1, returnedObject);
|
|
}
|
|
ipush(es, (objRef) method); /* push method */
|
|
ipush(es, (objRef) argarray);
|
|
messageToSend = newSymbol("watchWith:");
|
|
/* try again - if fail really give up */
|
|
methodClass = classOf(method);
|
|
if (!findMethod(&methodClass)) {
|
|
sysWarn("can't find", "watch method");
|
|
/* just quit */
|
|
return false;
|
|
}
|
|
}
|
|
return(true);
|
|
}
|
|
|
|
encPtr growProcessStack(int top, int toadd)
|
|
{
|
|
int size,
|
|
i;
|
|
encPtr newStack;
|
|
|
|
if (toadd < 128)
|
|
toadd = 128;
|
|
size = countOf(processStack) + toadd;
|
|
newStack = newArray(size);
|
|
for (i = 1; i <= top; i++) {
|
|
orefOfPut(newStack, i, orefOf(processStack, i));
|
|
}
|
|
return newStack;
|
|
}
|
|
|
|
void pushStateAndEnter(execState* es)
|
|
{
|
|
int i;
|
|
int j;
|
|
/* save the current byte pointer */
|
|
orefOfPut(processStack, linkPointer + 4, (objRef) encValueOf(es->byteOffset));
|
|
/* make sure we have enough room in current process */
|
|
/* stack, if not make stack larger */
|
|
i = 6 + methodTempSize(method) + methodStackSize(method);
|
|
j = stackInUse(es);
|
|
if ((j + i) > countOf(processStack)) {
|
|
processStack = growProcessStack(j, i);
|
|
es->psb = addressOf(processStack);
|
|
es->pst = (es->psb + j);
|
|
orefOfPut(es->processObject, stackInProcess, (objRef) processStack);
|
|
}
|
|
es->byteOffset = 1;
|
|
/* now make linkage area */
|
|
/* position 0 : old linkage pointer */
|
|
ipush(es, (objRef) encValueOf(linkPointer));
|
|
linkPointer = stackInUse(es);
|
|
/* position 1 : context obj (nil means stack) */
|
|
ipush(es, (objRef) nilObj);
|
|
es->contextObject = processStack;
|
|
es->cxtb = es->psb;
|
|
/* position 2 : return point */
|
|
ipush(es, (objRef) encValueOf(es->returnPoint));
|
|
es->argb = es->cxtb + (es->returnPoint - 1);
|
|
/* position 3 : method */
|
|
ipush(es, (objRef) method);
|
|
/* position 4 : bytecode counter */
|
|
ipush(es, (objRef) encValueOf(es->byteOffset));
|
|
/* then make space for temporaries */
|
|
es->tmpb = es->pst + 1;
|
|
es->pst += methodTempSize(method);
|
|
fetchMethodState(es);
|
|
#if 0
|
|
/* break if we are too big and probably looping */
|
|
if (countOf(processStack) > 4096)
|
|
es->timeSliceCounter = 0;
|
|
#endif
|
|
}
|
|
|
|
inline bool lookupAndEnter(execState* es, encPtr methodClass)
|
|
{
|
|
if(!lookupGivenSelector(es, methodClass))
|
|
return(false);
|
|
if(!lookupWatchSelector(es))
|
|
return(false);
|
|
pushStateAndEnter(es);
|
|
return(true);
|
|
}
|
|
|
|
/*
|
|
Looks for a Method corresponding to the combination of a prospective
|
|
receiver's class and a symbol denoting some desired behavior. The
|
|
instruction operand denotes which symbol. Changes the execution state
|
|
of the interpreter such that the next bytecode executed will be that of
|
|
the Method located, if possible, in an appropriate context. See also
|
|
"byteSendUnary", "byteSendBinary" and "byteDoSpecial".
|
|
*/
|
|
bool byteSendMessage(execState* es, int low)
|
|
{
|
|
encPtr methodClass;
|
|
messageToSend = literalAt(es, low).ptr;
|
|
methodClass = firstLookupClass(es);
|
|
return(lookupAndEnter(es, methodClass));
|
|
}
|
|
|
|
/*
|
|
Handles certain special cases of messages involving one object. See
|
|
also "byteSendMessage", "byteSendBinary" and "byteDoSpecial".
|
|
*/
|
|
bool byteSendUnary(execState* es, int low)
|
|
{
|
|
encPtr methodClass;
|
|
/* do isNil and notNil as special cases, since */
|
|
/* they are so common */
|
|
if ((!watching) && (low >= 0 && low <= 1)) {
|
|
switch(low) {
|
|
case 0: /* isNil */
|
|
stackTopPut(es, (objRef) (
|
|
ptrEq(stackTop(es), (objRef) nilObj) ? trueObj : falseObj ) );
|
|
return(true);
|
|
case 1: /* notNil */
|
|
stackTopPut(es, (objRef) (
|
|
ptrEq(stackTop(es), (objRef) nilObj) ? falseObj : trueObj ) );
|
|
return(true);
|
|
}
|
|
}
|
|
es->returnPoint = stackInUse(es);
|
|
messageToSend = unSyms[low];
|
|
methodClass = firstLookupClass(es);
|
|
return(lookupAndEnter(es, methodClass));
|
|
}
|
|
|
|
/*
|
|
Handles certain special cases of messages involving two objects. See
|
|
also "byteSendMessage", "byteSendUnary" and "byteDoSpecial".
|
|
*/
|
|
bool byteSendBinary(execState* es, int low)
|
|
{
|
|
objRef* primargs;
|
|
objRef returnedObject;
|
|
encPtr methodClass;
|
|
/* optimized as long as arguments are int */
|
|
/* and conversions are not necessary */
|
|
/* and overflow does not occur */
|
|
if ((!watching) && (low >= 0 && low <= 12)) {
|
|
if(primTrace)
|
|
fprintf(stderr, "%d: <%d>\n",primTrace--,low+60);
|
|
primargs = es->pst - 1;
|
|
returnedObject = primitive(low + 60, primargs);
|
|
if (ptrNe(returnedObject, (objRef) nilObj)) {
|
|
/* pop arguments off stack , push on result */
|
|
stackTopFree(es);
|
|
stackTopPut(es, returnedObject);
|
|
return(true);
|
|
}
|
|
}
|
|
es->returnPoint = stackInUse(es) - 1;
|
|
messageToSend = binSyms[low];
|
|
methodClass = firstLookupClass(es);
|
|
return(lookupAndEnter(es, methodClass));
|
|
}
|
|
|
|
/*
|
|
Calls a routine to evoke some desired behavior which is not implemented
|
|
in the form of a Method.
|
|
*/
|
|
bool byteDoPrimitive(execState* es, int low)
|
|
{
|
|
objRef* primargs;
|
|
int i;
|
|
objRef returnedObject;
|
|
/* low gives number of arguments */
|
|
/* next byte is primitive number */
|
|
primargs = (es->pst - low) + 1;
|
|
/* next byte gives primitive number */
|
|
i = nextByte(es);
|
|
if(primTrace)
|
|
fprintf(stderr, "%d: <%d>\n",primTrace--,i);
|
|
returnedObject = primitive(i, primargs);
|
|
/* pop off arguments */
|
|
while (low-- > 0) {
|
|
if(isIndex(stackTop(es)))
|
|
isVolatilePut(stackTop(es).ptr, false);
|
|
stackTopFree(es);
|
|
}
|
|
ipush(es, returnedObject);
|
|
return(true);
|
|
}
|
|
|
|
bool leaveAndAnswer(execState* es, objRef returnedObject)
|
|
{
|
|
es->returnPoint = intValueOf(orefOf(processStack, linkPointer + 2).val);
|
|
linkPointer = intValueOf(orefOf(processStack, linkPointer).val);
|
|
while (stackInUse(es) >= es->returnPoint) {
|
|
if(isIndex(stackTop(es)))
|
|
isVolatilePut(stackTop(es).ptr, false);
|
|
stackTopFree(es);
|
|
}
|
|
ipush(es, returnedObject);
|
|
/* now go restart old routine */
|
|
if (linkPointer) {
|
|
fetchLinkageState(es);
|
|
fetchReceiverState(es);
|
|
fetchMethodState(es);
|
|
return(true);
|
|
}
|
|
else
|
|
return(false); /* all done */
|
|
}
|
|
|
|
/*
|
|
Handles operations which aren't handled in other ways. The instruction
|
|
operand denotes which operation. Returning objects changes the
|
|
execution state of the interpreter such that the next bytecode executed
|
|
will be that of the Method which is to process the returned object, if
|
|
possible, in an appropriate context. See also "byteSendMessage"
|
|
"byteSendUnary" and "byteSendBinary". Various facilities such as
|
|
cascaded messages and optimized control structures involve tinkering
|
|
with the top of the process stack and the "instruction counter".
|
|
Sending messages to "super" changes the first class to be searched for a
|
|
Method from that of the prospective receiver to the superclass of that
|
|
in which the executing Method is located, if possible.
|
|
*/
|
|
bool byteDoSpecial(execState* es, int low)
|
|
{
|
|
objRef returnedObject;
|
|
int i;
|
|
encPtr methodClass;
|
|
switch (low) {
|
|
case SelfReturn:
|
|
returnedObject = argumentAt(es, 0);
|
|
return(leaveAndAnswer(es, returnedObject));
|
|
case StackReturn:
|
|
returnedObject = ipop(es);
|
|
return(leaveAndAnswer(es, returnedObject));
|
|
case Duplicate:
|
|
/* avoid possible subtle bug */
|
|
returnedObject = stackTop(es);
|
|
ipush(es, returnedObject);
|
|
return(true);
|
|
case PopTop:
|
|
returnedObject = ipop(es);
|
|
if(isIndex(returnedObject))
|
|
isVolatilePut(returnedObject.ptr, false);
|
|
return(true);
|
|
case Branch:
|
|
/* avoid a subtle bug here */
|
|
i = nextByte(es);
|
|
es->byteOffset = i;
|
|
return(true);
|
|
case BranchIfTrue:
|
|
returnedObject = ipop(es);
|
|
i = nextByte(es);
|
|
if (ptrEq(returnedObject, (objRef) trueObj)) {
|
|
/* leave nil on stack */
|
|
es->pst++;
|
|
es->byteOffset = i;
|
|
}
|
|
return(true);
|
|
case BranchIfFalse:
|
|
returnedObject = ipop(es);
|
|
i = nextByte(es);
|
|
if (ptrEq(returnedObject, (objRef) falseObj)) {
|
|
/* leave nil on stack */
|
|
es->pst++;
|
|
es->byteOffset = i;
|
|
}
|
|
return(true);
|
|
case AndBranch:
|
|
returnedObject = ipop(es);
|
|
i = nextByte(es);
|
|
if (ptrEq(returnedObject, (objRef) falseObj)) {
|
|
ipush(es, returnedObject);
|
|
es->byteOffset = i;
|
|
}
|
|
return(true);
|
|
case OrBranch:
|
|
returnedObject = ipop(es);
|
|
i = nextByte(es);
|
|
if (ptrEq(returnedObject, (objRef) trueObj)) {
|
|
ipush(es, returnedObject);
|
|
es->byteOffset = i;
|
|
}
|
|
return(true);
|
|
case SendToSuper:
|
|
i = nextByte(es);
|
|
messageToSend = literalAt(es, i).ptr;
|
|
(void) firstLookupClass(es); /* fix? */
|
|
methodClass = orefOf(method, methodClassInMethod).ptr;
|
|
/* if there is a superclass, use it
|
|
otherwise for class Object (the only
|
|
class that doesn't have a superclass) use
|
|
the class again */
|
|
returnedObject = orefOf(methodClass, superClassInClass);
|
|
if (ptrNe(returnedObject, (objRef) nilObj))
|
|
methodClass = returnedObject.ptr;
|
|
return(lookupAndEnter(es, methodClass));
|
|
default:
|
|
sysError("invalid doSpecial", "");
|
|
return(false);
|
|
}
|
|
}
|
|
|
|
typedef bool bytecodeMethod(execState* es, int low);
|
|
|
|
#define byteVectLob 0
|
|
#define byteVectHib 15
|
|
#define byteVectDom ((byteVectHib + 1) - byteVectLob)
|
|
|
|
bytecodeMethod* bytecodeVector[byteVectDom] = {
|
|
/*00*/ &unsupportedByte,
|
|
/*01*/ &bytePushInstance,
|
|
/*02*/ &bytePushArgument,
|
|
/*03*/ &bytePushTemporary,
|
|
/*04*/ &bytePushLiteral,
|
|
/*05*/ &bytePushConstant,
|
|
/*06*/ &byteAssignInstance,
|
|
/*07*/ &byteAssignTemporary,
|
|
/*08*/ &byteMarkArguments,
|
|
/*09*/ &byteSendMessage,
|
|
/*10*/ &byteSendUnary,
|
|
/*11*/ &byteSendBinary,
|
|
/*12*/ &unsupportedByte,
|
|
/*13*/ &byteDoPrimitive,
|
|
/*14*/ &unsupportedByte,
|
|
/*15*/ &byteDoSpecial
|
|
};
|
|
|
|
encPtr processStack = {true,0};
|
|
|
|
int linkPointer = 0;
|
|
|
|
void fetchProcessState(execState* es)
|
|
{
|
|
int j;
|
|
processStack = orefOf(es->processObject, stackInProcess).ptr;
|
|
es->psb = addressOf(processStack);
|
|
j = intValueOf(orefOf(es->processObject, stackTopInProcess).val);
|
|
es->pst = es->psb + (j - 1);
|
|
linkPointer = intValueOf(orefOf(es->processObject, linkPtrInProcess).val);
|
|
}
|
|
|
|
void storeProcessState(execState* es)
|
|
{
|
|
orefOfPut(es->processObject, stackInProcess, (objRef) processStack);
|
|
orefOfPut(es->processObject, stackTopInProcess, (objRef) encValueOf(stackInUse(es)));
|
|
orefOfPut(es->processObject, linkPtrInProcess, (objRef) encValueOf(linkPointer));
|
|
}
|
|
|
|
word traceVect[traceSize] = {};
|
|
|
|
bool execute(encPtr aProcess, int maxsteps)
|
|
{
|
|
execState es = {};
|
|
|
|
es.processObject = aProcess;
|
|
es.timeSliceCounter = maxsteps;
|
|
counterAddress = &es.timeSliceCounter;
|
|
|
|
fetchProcessState(&es);
|
|
fetchLinkageState(&es);
|
|
fetchReceiverState(&es);
|
|
fetchMethodState(&es);
|
|
|
|
while (--es.timeSliceCounter > 0) {
|
|
int low;
|
|
int high;
|
|
low = (high = nextByte(&es)) & 0x0F;
|
|
high >>= 4;
|
|
if (high == 0) {
|
|
high = low;
|
|
low = nextByte(&es);
|
|
}
|
|
if(execTrace)
|
|
fprintf(stderr, "%d: %d %d\n",execTrace--,high,low);
|
|
if(high >= byteVectLob && high <= byteVectHib)
|
|
{
|
|
bytecodeMethod* byteMethPtr = bytecodeVector[high];
|
|
if(byteMethPtr) {
|
|
if(!(*byteMethPtr)(&es, low))
|
|
return(false);
|
|
continue;
|
|
}
|
|
}
|
|
if(!unsupportedByte(&es, low))
|
|
return(false);
|
|
}
|
|
|
|
orefOfPut(processStack, linkPointer + 4, (objRef) encValueOf(es.byteOffset));
|
|
storeProcessState(&es);
|
|
|
|
return(true);
|
|
}
|
|
|
|
void makeInitialImage(void)
|
|
{
|
|
encPtr hashTable;
|
|
encPtr symbolObj;
|
|
encPtr symbolClass; /*shadows global for a reason*/
|
|
encPtr metaclassClass;
|
|
encPtr linkClass;
|
|
|
|
nilObj = allocOrefObj(0);
|
|
assert(oteIndexOf(nilObj) == 1);
|
|
|
|
trueObj = allocOrefObj(0);
|
|
assert(oteIndexOf(trueObj) == 2);
|
|
falseObj = allocOrefObj(0);
|
|
assert(oteIndexOf(falseObj) == 3);
|
|
|
|
/* create the symbol table */
|
|
|
|
hashTable = allocOrefObj(3 * 53);
|
|
assert(oteIndexOf(hashTable) == 4);
|
|
symbols = allocOrefObj(1);
|
|
assert(oteIndexOf(symbols) == 5);
|
|
orefOfPut(symbols, 1, (objRef) hashTable);
|
|
|
|
/* create #Symbol, Symbol[Meta] and Metaclass[Meta] */
|
|
|
|
symbolObj = newSymbol("Symbol");
|
|
#if 0
|
|
assert(ptrEq(classOf(symbolObj),nilObj));
|
|
assert(ptrEq(globalValue("Symbol"),nilObj));
|
|
#endif
|
|
symbolClass = newClass("Symbol");
|
|
#if 0
|
|
assert(ptrNe(classOf(symbolClass),nilObj));
|
|
assert(ptrEq(classOf(classOf(symbolClass)),nilObj));
|
|
assert(ptrEq(globalValue("Symbol"),symbolClass));
|
|
#endif
|
|
classOfPut(symbolObj, symbolClass);
|
|
classOfPut(newSymbol("SymbolMeta"), symbolClass);
|
|
metaclassClass = newClass("Metaclass");
|
|
#if 0
|
|
assert(ptrNe(classOf(metaclassClass),nilObj));
|
|
assert(ptrEq(classOf(classOf(metaclassClass)),nilObj));
|
|
assert(ptrEq(globalValue("Metaclass"),metaclassClass));
|
|
#endif
|
|
classOfPut(classOf(symbolClass), metaclassClass);
|
|
classOfPut(classOf(metaclassClass), metaclassClass);
|
|
|
|
/* patch the class fields of nil, true and false */
|
|
/* set their global values */
|
|
|
|
classOfPut(nilObj, newClass("UndefinedObject"));
|
|
nameTableInsert(symbols, strHash("nil"), newSymbol("nil"), nilObj);
|
|
classOfPut(trueObj, newClass("True"));
|
|
nameTableInsert(symbols, strHash("true"), newSymbol("true"), trueObj);
|
|
classOfPut(falseObj, newClass("False"));
|
|
nameTableInsert(symbols, strHash("false"), newSymbol("false"), falseObj);
|
|
|
|
/* patch the class fields of the symbol table links */
|
|
/* make the symbol table refer to itself */ /*fix?*/
|
|
|
|
linkClass = newClass("Link");
|
|
{
|
|
word ord = 0;
|
|
word hib = countOf(hashTable);
|
|
for( ; ord != hib; ord += 3) {
|
|
encPtr link = orefOf(hashTable, ord + 3).ptr;
|
|
while(ptrNe((objRef) link, (objRef) nilObj)) {
|
|
if(ptrEq((objRef) classOf(link), (objRef) nilObj))
|
|
classOfPut(link, linkClass);
|
|
else
|
|
assert(ptrEq((objRef) classOf(link), (objRef) linkClass));
|
|
link = orefOf(link, 3).ptr;
|
|
}
|
|
}
|
|
}
|
|
classOfPut(hashTable, newClass("Array"));
|
|
classOfPut(symbols, newClass("SymbolTable"));
|
|
nameTableInsert(symbols, strHash("symbols"), newSymbol("symbols"), symbols);
|
|
|
|
/* graft a skeleton metaclass tree to a skeleton class tree */
|
|
{
|
|
encPtr objectInst = newClass("Object");
|
|
encPtr classInst = newClass("Class");
|
|
orefOfPut(classOf(objectInst), superClassInClass, (objRef) classInst);
|
|
}
|
|
|
|
/* create other skeleton classes */
|
|
|
|
/*(void) newClass("Array");*/
|
|
(void) newClass("Block");
|
|
(void) newClass("ByteArray");
|
|
(void) newClass("Char");
|
|
(void) newClass("Context");
|
|
(void) newClass("Dictionary");
|
|
(void) newClass("Float");
|
|
/*(void) newClass("Link");*/
|
|
/*(void) newClass("Metaclass");*/
|
|
(void) newClass("Method");
|
|
(void) newClass("String");
|
|
/*(void) newClass("Symbol");*/
|
|
|
|
}
|
|
|
|
void goDoIt(char* text)
|
|
{
|
|
encPtr method;
|
|
encPtr process;
|
|
encPtr stack;
|
|
|
|
method = newMethod();
|
|
setInstanceVariables(nilObj);
|
|
(void) parse(method, text, false);
|
|
|
|
process = allocOrefObj(processSize);
|
|
stack = allocOrefObj(50);
|
|
|
|
/* make a process */
|
|
orefOfPut(process, stackInProcess, (objRef) stack);
|
|
orefOfPut(process, stackTopInProcess, (objRef) encValueOf(10));
|
|
orefOfPut(process, linkPtrInProcess, (objRef) encValueOf(2));
|
|
|
|
/* put argument on stack */
|
|
orefOfPut(stack, 1, (objRef) nilObj); /* argument */
|
|
/* now make a linkage area in stack */
|
|
orefOfPut(stack, 2, (objRef) encValueOf(0)); /* previous link */
|
|
orefOfPut(stack, 3, (objRef) nilObj); /* context object (nil => stack) */
|
|
orefOfPut(stack, 4, (objRef) encValueOf(1)); /* return point */
|
|
orefOfPut(stack, 5, (objRef) method); /* method */
|
|
orefOfPut(stack, 6, (objRef) encValueOf(1)); /* byte offset */
|
|
|
|
/* now go execute it */
|
|
while (execute(process, 1 << 14))
|
|
fprintf(stderr, ".");
|
|
|
|
/* get rid of unwanted process */
|
|
isVolatilePut(process, false);
|
|
}
|
|
|
|
int main_1(int argc, char* argv[])
|
|
{
|
|
char methbuf[4096];
|
|
int i;
|
|
|
|
sysWarn("\nPublic Domain Smalltalk", "");
|
|
|
|
coldObjectTable();
|
|
|
|
makeInitialImage();
|
|
|
|
initCommonSymbols();
|
|
|
|
for (i = 1; i < argc; i++) {
|
|
fprintf(stderr, "%s:\n", argv[i]);
|
|
(void) sprintf(methbuf,
|
|
"goDoIt <120 1 '%s' 'r'>. <123 1>. <121 1>",
|
|
argv[i]);
|
|
goDoIt(methbuf);
|
|
}
|
|
|
|
/* when we are all done looking at the arguments, do initialization */
|
|
fprintf(stderr, "initialization\n");
|
|
#if 0
|
|
execTrace = 16;
|
|
primTrace = 16;
|
|
mselTrace = 16;
|
|
#endif
|
|
goDoIt("goDoIt nil initialize\n");
|
|
fprintf(stderr, "finished\n");
|
|
|
|
return 0;
|
|
}
|
|
|
|
int main_2(int argc, char* argv[])
|
|
{
|
|
FILE *fp;
|
|
encPtr firstProcess;
|
|
char *p,
|
|
buffer[4096];
|
|
|
|
sysWarn("\nPublic Domain Smalltalk", "");
|
|
|
|
warmObjectTableOne();
|
|
|
|
strcpy(buffer, "systemImage");
|
|
p = buffer;
|
|
if (argc != 1)
|
|
p = argv[1];
|
|
|
|
fp = fopen(p, "rb");
|
|
if (fp == NULL) {
|
|
sysError("cannot open image", p);
|
|
return(1);
|
|
}
|
|
|
|
if(ptrNe((objRef) imageRead(fp), (objRef) trueObj)) {
|
|
sysError("cannot read image", p);
|
|
return(1);
|
|
}
|
|
|
|
(void) fclose(fp);
|
|
|
|
warmObjectTableTwo();
|
|
|
|
initCommonSymbols();
|
|
|
|
firstProcess = globalValue("systemProcess");
|
|
if (ptrEq((objRef) firstProcess, (objRef) nilObj)) {
|
|
sysError("no initial process", "in image");
|
|
return(1);
|
|
}
|
|
|
|
/* execute the main system process loop repeatedly */
|
|
|
|
while (execute(firstProcess, 1 << 14)) ;
|
|
|
|
return 0;
|
|
}
|
|
|
|
void compilError(char* selector, char* str1, char* str2)
|
|
{
|
|
(void) fprintf(stderr, "compiler error: Method %s : %s %s\n",
|
|
selector, str1, str2);
|
|
parseOk = false;
|
|
}
|
|
|
|
void compilWarn(char* selector, char* str1, char* str2)
|
|
{
|
|
(void) fprintf(stderr, "compiler warning: Method %s : %s %s\n",
|
|
selector, str1, str2);
|
|
}
|
|
|
|
void sysError(char* s1, char* s2)
|
|
{
|
|
(void) fprintf(stderr, "%s\n%s\n", s1, s2);
|
|
(void) abort();
|
|
}
|
|
|
|
void sysWarn(char* s1, char* s2)
|
|
{
|
|
(void) fprintf(stderr, "%s\n%s\n", s1, s2);
|
|
}
|
|
|
|
int main(int argc, char* argv[])
|
|
{
|
|
int ans = 1;
|
|
logTag = fopen("transcript","ab");
|
|
if(argc > 1 && streq(argv[1],"-c")) {
|
|
argv[1] = argv[0];
|
|
argc--;
|
|
argv++;
|
|
ans = main_1(argc, argv);
|
|
}
|
|
if(argc > 1 && streq(argv[1],"-w")) {
|
|
argv[1] = argv[0];
|
|
argc--;
|
|
argv++;
|
|
ans = main_2(argc, argv);
|
|
}
|
|
#if 0
|
|
fprintf(stderr,"%s?\n",
|
|
(char*)addressOf(orefOf(encIndexOf(100),nameInClass).ptr));
|
|
#endif
|
|
if(ans == 0) {
|
|
FILE* tag;
|
|
tag = fopen("snapshot", "wb");
|
|
if(tag != NULL) {
|
|
reclaim(false);
|
|
if(ptrNe((objRef) imageWrite(tag), (objRef) trueObj))
|
|
ans = 2;
|
|
(void) fclose(tag);
|
|
}
|
|
else
|
|
ans = 2;
|
|
}
|
|
if(logTag != NULL)
|
|
(void) fclose(logTag);
|
|
return(ans);
|
|
}
|