home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume11 / little-st / part02 < prev    next >
Encoding:
Internet Message Format  |  1987-10-03  |  58.1 KB
  1. Subject:  v11i087:  Little Smalltalk interpreter, Part002/03
  2. Newsgroups: comp.sources.unix
  3. Sender: sources
  4. Approved: rs@uunet.UU.NET
  5.  
  6. Submitted-by: Tim Budd <budd@cs.orst.edu>
  7. Posting-number: Volume 11, Issue 87
  8. Archive-name: little-st/part02
  9.  
  10. The following is version two of the Little Smalltalk system, distributed
  11. in three parts.  Little Smalltalk is an interpreter for the language
  12. Smalltalk.
  13.  
  14. Questions or comments should be sent to Tim Budd,
  15.     budd@oregon-state.csnet
  16.     budd@cs.orst.edu    (128.193.32.1)
  17.     {tektronix, hp-pcd}!orstcs!budd
  18.  
  19. -----------cut here--------------------------------------------
  20. : To unbundle, sh this file
  21. echo unbundling memory.c 1>&2
  22. cat >memory.c <<'End'
  23. /*
  24.     Little Smalltalk, version 2
  25.     Written by Tim Budd, Oregon State University, July 1987
  26.  
  27.     memory management module
  28.  
  29.     This is a rather simple, straightforward, reference counting scheme.
  30.     There are no provisions for detecting cycles, nor any attempt made
  31.     at compaction.  Free lists of various sizes are maintained.
  32.     At present only objects up to 255 bytes can be allocated, 
  33.     which mostly only limits the size of method (in text) you can create.
  34.  
  35.     About the only tricky feature to this code is the fact that
  36.     reference counts are not stored as part of an object image, but
  37.     are instead recreated when the object is read back in.
  38.     (This will, in fact, eliminate cycles, as well as other unreachable
  39.     objects).
  40.  
  41.     This can, and should, be replaced by a better memory management
  42.     algorithm.
  43. */
  44. # include <stdio.h>
  45. # include "env.h"
  46. # include "memory.h"
  47.  
  48. # define ObjectTableMax 5000
  49. # define MemoryBlockSize 1000
  50.  
  51. boolean debugging = false;
  52. object sysobj;    /* temporary used to avoid rereference in macros */
  53. object intobj;
  54.  
  55. object symbols;        /* table of all symbols created */
  56. object globalNames;    /* table of all accessible global names */
  57.  
  58. /*
  59.     in theory the objectTable should only be accessible to the memory
  60.     manager.  Indeed, given the right macro definitions, this can be
  61.     made so.  Never the less, for efficiency sake some of the macros
  62.     can also be defined to access the object table directly
  63. */
  64.  
  65. struct objectStruct objectTable[ObjectTableMax];
  66.  
  67. /*
  68.     The following global variables are strictly local to the memory
  69.     manager module
  70. */
  71.  
  72. static object objectFreeList[256];    /* free list of objects */
  73. static short objectTop;            /* last object allocated */
  74. static object *memoryBlock;        /* malloc'ed chunck of memory */
  75. static int    currentMemoryPosition;    /* last used position in above */
  76.  
  77.  
  78. /* initialize the memory management module */
  79. initMemoryManager() {
  80.     int i;
  81.  
  82.     /* set all the free list pointers to zero */
  83.     for (i = 0; i < 256; i++)
  84.         objectFreeList[i] = nilobj;
  85.  
  86.     /* set all the reference counts to zero */
  87.     for (i = 0; i < ObjectTableMax; i++)
  88.         objectTable[i].referenceCount = 0;
  89.  
  90.     objectTop = 0;
  91.  
  92.     /* force an allocation on first object assignment */
  93.     currentMemoryPosition = MemoryBlockSize + 1;
  94.  
  95.     /* object at location 0 is the nil object, so give it nonzero ref */
  96.     objectTable[0].referenceCount = 1;
  97.     objectTable[0].size = 0;
  98.     objectTable[0].type = objectMemory;
  99. }
  100.  
  101. /* report a (generally fatal) memory manager error */
  102. sysError(s1, s2)
  103. char *s1, *s2;
  104. {    int i;
  105.     fprintf(stderr,"%s\n%s\n", s1, s2);
  106.     i = 0;
  107.     i = 32 / i;
  108. }
  109.  
  110. /*
  111.   mBlockAlloc - rip out a block (array) of object of the given size from
  112.     the current malloc block 
  113. */
  114. static object *mBlockAlloc(memorySize)
  115. int memorySize;
  116. {    object *objptr;
  117.  
  118.     if (currentMemoryPosition + memorySize >= MemoryBlockSize) {
  119.         memoryBlock = (object *) calloc(MemoryBlockSize, sizeof(object));
  120.         if (! memoryBlock)
  121.             sysError("out of memory","malloc failed");
  122.         currentMemoryPosition = 0;
  123.         }
  124.     objptr = (object *) &memoryBlock[currentMemoryPosition];
  125.     currentMemoryPosition += memorySize;
  126.     return(objptr);
  127. }
  128.  
  129. /* allocate a new memory object */
  130. object alcObject(memorySize, memoryType)
  131. int memorySize;
  132. int memoryType;
  133. {    int position, trip;
  134.  
  135.     if (memorySize >= 256) {
  136.         sysError("allocation bigger than 256","");
  137.         }
  138.  
  139.     if (objectFreeList[memorySize] != 0) {
  140.         objectFreeList[memorySize] = 
  141.             objectTable[ position = objectFreeList[memorySize]].class;
  142.         }
  143.     else {        /* not found, must allocate a new object */
  144.         position = trip = 0;
  145.         do { 
  146.             objectTop = objectTop + 1;
  147.             if (objectTop >= ObjectTableMax)
  148.                 if (trip) {
  149.                     sysError("out of objects ","  ");
  150.                     position = 1;
  151.                     }
  152.                 else {
  153.                     trip = objectTop =1;
  154.                     }
  155.             else if (objectTable[objectTop].referenceCount <= 0)
  156.                 position = objectTop;
  157.         } while (position == 0);
  158.  
  159.         /* allocate memory pointer */
  160.         objectTable[position].size = memorySize;
  161.         objectTable[position].memory = mBlockAlloc(memorySize);
  162.  
  163.         }
  164.  
  165.     /* set class and type */
  166.     objectTable[position].referenceCount = 0;
  167.     objectTable[position].class = nilobj;
  168.     objectTable[position].type = memoryType;
  169.     return(position << 1);
  170. }
  171.  
  172. object allocSymbol(str)
  173. char *str;
  174. {    object newSym;
  175.  
  176.     newSym = alcObject((2 + strlen(str))/2, charMemory);
  177.     ignore strcpy(charPtr(newSym), str);
  178.     return(newSym);
  179. }
  180.  
  181. # ifdef incr
  182. object incrobj;        /* buffer for increment macro */
  183. # endif
  184. # ifndef incr
  185. void incr(z)
  186. object z;
  187. {
  188.     if (z && ! isInteger(z)) {
  189.         objectTable[z>>1].referenceCount++;
  190.         globalinccount++;
  191.         }
  192. }
  193. # endif
  194.  
  195. # ifndef decr
  196. void decr(z)
  197. object z;
  198. {
  199.     if (z && ! isInteger(z)) {
  200.         if (--objectTable[z>>1].referenceCount <= 0) {
  201.             sysDecr(z);
  202.             }
  203.         globaldeccount++;
  204.         }
  205. }
  206. # endif
  207.  
  208. /* do the real work in the decr procedure */
  209. sysDecr(z)
  210. object z;
  211. {    register struct objectStruct *p;
  212.     register int i;
  213.  
  214.     p = &objectTable[z>>1];
  215.     if (p->referenceCount < 0) {
  216.         sysError("negative reference count","");
  217.         }
  218.     decr(p->class);
  219.     p->class = objectFreeList[p->size];
  220.     objectFreeList[p->size] = z>>1;
  221.     if (((int) p->size) > 0) {
  222.         if (p->type == objectMemory)
  223.             for (i = p->size; i > 0 ; )
  224.                 decr(p->memory[--i]);
  225.         for (i = p->size; i > 0; )
  226.             p->memory[--i] = nilobj;
  227.         }
  228.  
  229. }
  230.  
  231. # ifndef basicAt
  232. object basicAt(z, i)
  233. object z;
  234. register int i;
  235. {
  236.     if (isInteger(z))
  237.         sysError("attempt to index","into integer");
  238.     else if ((i <= 0) || (i > objectSize(z))) {
  239.         fprintf(stderr,"index %d size %d\n", i, (int) objectSize(z));
  240.         sysError("index out of range","in basicAt");
  241.         }
  242.     else
  243.         return(sysMemPtr(z)[i-1]);
  244.     return(0);
  245. }
  246. # endif
  247.  
  248. void basicAtPut(z, i, v)
  249. object z, v;
  250. register int i;
  251. {
  252.     if (isInteger(z))
  253.         sysError("assigning index to","integer value");
  254.     else if ((i <= 0) || (i > objectSize(z))) {
  255.         fprintf(stderr,"index %d size %d\n", i, (int) objectSize(z));
  256.         sysError("index out of range","in basicAtPut");
  257.         }
  258.     else {
  259.         incr(v);
  260.         decr(sysMemPtr(z)[i-1]);
  261.         sysMemPtr(z)[i-1] = v;
  262.         }
  263. }
  264.  
  265. /*
  266.     imageWrite - write out an object image
  267. */
  268. static iwerr() { sysError("imageWrite count error",""); }
  269.  
  270. imageWrite(fp)
  271. FILE *fp;
  272. {    short i;
  273.  
  274.     if (fwrite(&symbols, sizeof(object), 1, fp) != 1) iwerr();
  275.     if (fwrite(&globalNames, sizeof(object), 1, fp) != 1) iwerr();
  276.  
  277.     for (i = 0; i < ObjectTableMax; i++) {
  278.         if (objectTable[i].referenceCount > 0) {
  279.             if (fwrite(&i, sizeof(short), 1, fp) != 1) iwerr();
  280.             if (fwrite(&objectTable[i].class, sizeof(object), 1, fp)
  281.                 != 1) iwerr();
  282.             if (fwrite(&objectTable[i].size, sizeof(byte), 1, fp)
  283.                 != 1) iwerr();
  284.             if (fwrite(&objectTable[i].type, sizeof(byte), 1, fp)
  285.                 != 1) iwerr();
  286.             if (objectTable[i].size != 0)
  287.                 if (fwrite(objectTable[i].memory, sizeof(object),
  288.                     objectTable[i].size, fp) != objectTable[i].size)
  289.                         iwerr();
  290.             }
  291.         }
  292. }
  293.  
  294. /*
  295.     imageRead - read in an object image
  296. */
  297. static irerr() { sysError("imageWrite count error",""); }
  298.  
  299. /*
  300.     the following two routines, addmittedly a bit complicated,
  301. assure that objects read in are really referenced, eliminating junk
  302. that may be in the object file but not referenced */
  303.  
  304. static membump(i, j)
  305. int i, j;
  306. {    int k;
  307.     object *p;
  308.  
  309.     k = objectTable[j].class;
  310.     if (k) memincr(i, k>>1);
  311.     if (objectTable[j].type == objectMemory) {
  312.         p = objectTable[j].memory;
  313.         for (k = byteToInt(objectTable[j].size) - 1; k >= 0; k--)
  314.             if (p[k] && ! isInteger(p[k]))
  315.                 memincr(i, p[k]>>1);
  316.         }
  317. }
  318.  
  319. static memincr(i, j)
  320. int i, j;
  321. {
  322.     objectTable[j].referenceCount++;
  323.     if ((j <= i) && (objectTable[j].referenceCount == 1))
  324.         membump(i, j);
  325. }
  326.  
  327. imageRead(fp)
  328. FILE *fp;
  329. {    short i;
  330.     object *p;
  331.  
  332.     if (fread( &symbols, sizeof(object), 1, fp) != 1) irerr();
  333.     if (fread( &globalNames, sizeof(object), 1, fp) != 1) irerr();
  334.     objectTable[symbols>>1].referenceCount++;
  335.     objectTable[globalNames>>1].referenceCount++;
  336.  
  337.     while(fread( &i, sizeof(short), 1, fp) == 1) {
  338.         if (fread( &objectTable[i].class, sizeof(object), 1, fp)
  339.                 != 1) irerr();
  340.  
  341.         if (fread( &objectTable[i].size, sizeof(byte), 1, fp)
  342.                 != 1) irerr();
  343.         if (fread( &objectTable[i].type, sizeof(byte), 1, fp)
  344.                 != 1) irerr();
  345.         if (objectTable[i].size != 0) {
  346.             p = objectTable[i].memory = mBlockAlloc((int) objectTable[i].size);
  347.             if (fread( p, sizeof(object),
  348.                  byteToInt(objectTable[i].size), fp) != byteToInt(objectTable[i].size))
  349.                         irerr();
  350.             if (objectTable[i].referenceCount > 0)
  351.                 membump(i, i);
  352.             }
  353.         else
  354.             objectTable[i].memory = (object *) 0;
  355.         }
  356. }
  357.  
  358. static ncopy(p, q, n)
  359. char *p, *q;
  360. int n;
  361. {
  362.  
  363.     while (n>0) {
  364.         *p++ = *q++; 
  365.         n--;
  366.         }
  367. }
  368.  
  369. object allocFloat(d)
  370. double d;
  371. {    object newObj;
  372.  
  373.     newObj = alcObject((int) sizeof (double), floatMemory);
  374.     ncopy(charPtr(newObj), (char *) &d, (int) sizeof (double));
  375.     return(newObj);
  376. }
  377.  
  378. double floatValue(obj)
  379. object obj;
  380. {    double d;
  381.  
  382.     ncopy((char *) &d, charPtr(obj), (int) sizeof (double));
  383.     return(d);
  384. }
  385.  
  386. int objcount() 
  387. {    int i, count;
  388.  
  389.     
  390.     for (count = i = 0; i < ObjectTableMax; i++)
  391.         if (objectTable[i].referenceCount > 0)
  392.             count++;
  393.     return(count);
  394. }
  395. End
  396. echo unbundling names.c 1>&2
  397. cat >names.c <<'End'
  398. /*
  399.     Little Smalltalk, version 2
  400.     Written by Tim Budd, Oregon State University, July 1987
  401.  
  402.     Name Table module
  403.  
  404.     A name table is the term used for a Dictionary indexed by symbols.
  405.     There are two name tables used internally by the bytecode interpreter.
  406.     The first is the table, contained in the variable globalNames,
  407.     that contains the names and values of all globally accessible 
  408.     identifiers.  The second is the table of methods associated with
  409.     every class.  Notice that in neither of these cases does the
  410.     system ever put anything INTO the tables, thus there are only
  411.     routines here for reading FROM tables.
  412.  
  413.     (putting things INTO the table is all done in Smalltalk code,
  414.     using the methods from class Dictionary)
  415.  
  416.     One complication of instances of class Symbol is that all
  417.     symbols must be unique, not only so that == will work as expected,
  418.     but so that memory does not get overly clogged up with symbols.
  419.     Thus all symbols are kept in a hash table, and when new symbols
  420.     are created (via newSymbol(), below) they are inserted into this
  421.     table, if not already there.
  422.  
  423.     This module also manages the definition of various symbols that are
  424.     given fixed values for efficiency sake.  These include the objects
  425.     nil, true, false, and various classes.
  426. */
  427.  
  428. # include <stdio.h>
  429. # include "env.h"
  430. # include "memory.h"
  431. # include "names.h"
  432.  
  433. /* global variables used to avoid repeated examinations of the global symbol table */
  434. object trueobj = nilobj;    /* the pseudo variable true */
  435. object falseobj = nilobj;    /* the pseudo variable false */
  436. object smallobj = nilobj;    /* the pseudo variable smalltalk */
  437. object arrayclass = nilobj;    /* the class ``Array'' */
  438. object blockclass = nilobj;    /* the class ``Block'' */
  439. object contextclass = nilobj;    /* the class ``Context'' */
  440. object intclass = nilobj;    /* the class ``Integer'' */
  441. object intrclass = nilobj;    /* the class ``Interpreter'' */
  442. object symbolclass = nilobj;    /* the class ``Symbol'' */
  443. object stringclass = nilobj;    /* the class ``String'' */
  444.  
  445. /*
  446.     some messages are encoded in concise bytecode format -
  447. to reduce the size of the compiled methods
  448. (also, in some cases, to more efficiently detect special cases
  449. handled in the interpreter, rather than by methods)
  450. */
  451.  
  452. char *binStrs[] = {"+", "-", "<", ">", "<=", ">=", "=", "~=", "*", 
  453. "quo:", "rem:", "bitAnd:", "bitXor:", 
  454. "==", ",", "at:", "basicAt:", "do:", "coerce:", "error:", "includesKey:",
  455. "isMemberOf:", "new:", "to:", "value:", "whileTrue:", "addFirst:", "addLast:",
  456. 0};
  457.  
  458. object binSyms[28];
  459.  
  460. char *unStrs[] = {"isNil", "notNil", "new", "value", "class", "size",
  461. "basicSize", "print", "printString", 0};
  462.  
  463. object unSyms[9];
  464.  
  465. char *keyStrs[] = {"at:ifAbsent:", "at:put:", "basicAt:put:", "between:and:",
  466. 0};
  467.  
  468. object keySyms[4];
  469.  
  470. object nameTableLookup(table, symbol)
  471. object table, symbol;
  472. {    int hash, tablesize;
  473.     object link;
  474.  
  475.     if ((tablesize = objectSize(table)) == 0)
  476.         sysError("system error","lookup on null table");
  477.     else {
  478.         hash = 3 * ( symbol % (tablesize / 3));
  479.         if (basicAt(table, hash+1) == symbol)
  480.             return(basicAt(table, hash+2));
  481.  
  482.         /* otherwise look along the chain of links */
  483.         for (link=basicAt(table, hash+3); link != nilobj; 
  484.                     link=basicAt(link, 3))
  485.             if (basicAt(link, 1) == symbol)
  486.                 return(basicAt(link, 2));
  487.  
  488.     }
  489.     return (nilobj);
  490. }
  491.  
  492. getClass(obj)
  493. object obj;
  494. {
  495.     if (isInteger(obj))
  496.         return(intclass);
  497.     return (classField(obj));
  498. }
  499.  
  500. static object globalGet(name)
  501. char *name;
  502. {    object newobj;
  503.  
  504.     newobj = globalSymbol(name);
  505.     if (newobj == nilobj)
  506.         sysError("symbol not found in image", name);
  507.     return(newobj);
  508. }
  509.  
  510. initCommonSymbols()
  511. {    int i;
  512.  
  513.     trueobj = globalGet("true");
  514.     falseobj = globalGet("false");
  515.     smallobj  = globalGet("smalltalk");
  516.     arrayclass = globalGet("Array");
  517.     blockclass = globalGet("Block");
  518.     contextclass = globalGet("Context");
  519.     intclass = globalGet("Integer");
  520.     symbolclass = globalGet("Symbol");
  521.     stringclass = globalGet("String");
  522.     /* interpreter may or may not be there */
  523.     intrclass = globalSymbol("Interpreter");
  524.  
  525.     for (i = 0; i < 28; i++)
  526.         binSyms[i] = newSymbol(binStrs[i]);
  527.  
  528.     for (i = 0; i < 9; i++)
  529.         unSyms[i] = newSymbol(unStrs[i]);
  530.  
  531.     for (i = 0; i < 4; i++)
  532.         keySyms[i] = newSymbol(keyStrs[i]);
  533. }
  534.  
  535. object newArray(size)
  536. int size;
  537. {    object newobj;
  538.  
  539.     newobj = allocObject(size);
  540.     setClass(newobj, arrayclass);
  541.     return(newobj);
  542. }
  543.  
  544. object newSymbol(str)
  545. char *str;
  546. {    int hash;
  547.     object newSym, link;
  548.     char *p;
  549.  
  550.     /* first compute hash value of string text */
  551.     /* this is duplicated in image.c - make sure any changes match there */
  552.     hash = 0;
  553.     for (p = str; *p; p++)
  554.         hash += *p;
  555.     if (hash < 0) hash = - hash;
  556.     hash = 2 * ( hash % (objectSize(symbols) / 2));
  557.  
  558.     /* next look to see if it is in symbols - note that this
  559.        text duplicates that found in nameTableLookup, only using
  560.        string comparison instead of symbol comparison */
  561.     newSym = basicAt(symbols, hash+1);
  562.     if (streq(str, charPtr(newSym)))
  563.         return(newSym);
  564.  
  565.     /* not in table, look along links */
  566.     for (link=basicAt(symbols, hash+2); link != nilobj; link=basicAt(link,2)) {
  567.         newSym = basicAt(link, 1);
  568.         if (streq(str, charPtr(newSym)))
  569.             return(newSym);
  570.         }
  571.  
  572.     /* not found, make a new symbol */
  573.     newSym = allocSymbol(str);
  574.     setClass(newSym, symbolclass);
  575.  
  576.     /* now insert new symbol in table, so next time we will find it */
  577.     if (basicAt(symbols, hash+1) == nilobj)
  578.         basicAtPut(symbols, hash+1, newSym);
  579.     else {        /* insert along links */
  580.         link = allocObject(2);
  581.         basicAtPut(link, 1, newSym);
  582.         basicAtPut(link, 2, basicAt(symbols, hash+2));
  583.         basicAtPut(symbols, hash+2, link);
  584.         }
  585.  
  586.     return(newSym);
  587. }
  588.  
  589. object newStString(value)
  590. char *value;
  591. {    object newobj;
  592.  
  593.     newobj = allocSymbol(value);
  594.     setClass(newobj, stringclass);
  595.     return(newobj);
  596. }
  597.  
  598. object newFloat(d)
  599. double d;
  600. {    object newobj;
  601.  
  602.     newobj = allocFloat(d);
  603.     setClass(newobj, globalSymbol("Float"));
  604.     return(newobj);
  605. }
  606. End
  607. echo unbundling lex.c 1>&2
  608. cat >lex.c <<'End'
  609. /*
  610.     Little Smalltalk, version 2
  611.     Written by Tim Budd, Oregon State University, July 1987
  612.  
  613.     lexical analysis routines for method parser
  614.     should be called only by parser 
  615. */
  616.  
  617. # include <stdio.h>
  618. # include <ctype.h>
  619. # include "env.h"
  620. # include "memory.h"
  621. # include "lex.h"
  622.  
  623. extern double atof();
  624.  
  625. /* global variables returned by lexical analyser */
  626.  
  627. tokentype token;        /* token variety */
  628. char tokenString[80];        /* text of current token */
  629. int tokenInteger;        /* integer (or character) value of token */
  630. double tokenFloat;        /* floating point value of token */
  631.  
  632. /* local variables used only by lexical analyser */
  633.  
  634. static char *cp;        /* character pointer */
  635. static char pushBuffer[10];    /* pushed back buffer */
  636. static int  pushindex;        /* index of last pushed back char */
  637. static char cc;            /* current character */
  638.  
  639. /* lexinit - initialize the lexical analysis routines */
  640. lexinit(str)
  641. char *str;
  642. {
  643.     pushindex = 0;
  644.     cp = str;
  645.     /* get first token */
  646.     nextToken();
  647. }
  648.  
  649. /* pushBack - push one character back into the input */
  650. static pushBack(c)
  651. char c;
  652. {
  653.     pushBuffer[pushindex++] = c;
  654. }
  655.  
  656. /* nextChar - retrieve the next char, from buffer or input */
  657. static char nextChar()
  658. {
  659.     if (pushindex > 0) cc = pushBuffer[--pushindex];
  660.     else cc = *cp++;
  661.     return(cc);
  662. }
  663.  
  664. /* isClosing - characters which can close an expression */
  665. static boolean isClosing(c)
  666. char c;
  667. {
  668.     switch(c) {
  669.         case '.': case ']': case ')': case ';':
  670.             return(true);
  671.     }
  672.     return(false);
  673. }
  674.  
  675. /* singleBinary - binary characters that cannot be continued */
  676. static boolean singleBinary(c)
  677. char c;
  678. {
  679.     switch(c) {
  680.         case '[': case '(': case ')': case ']':
  681.             return(true);
  682.     }
  683.     return(false);
  684. }
  685.  
  686. /* binarySecond - return true if char can be second char in binary symbol */
  687. static boolean binarySecond(c)
  688. char c;
  689. {
  690.     if (isalpha(c) || isdigit(c) || isspace(c) || isClosing(c) ||
  691.         singleBinary(c))
  692.         return(false);
  693.     return(true);
  694. }
  695.  
  696. tokentype nextToken()
  697. {    char *tp;
  698.     boolean sign;
  699.  
  700.     /* skip over blanks and comments */
  701.     while(nextChar() && (isspace(cc) || (cc == '"')))
  702.         if (cc == '"') {
  703.             /* read comment */
  704.             while (nextChar() && (cc != '"')) ;
  705.             if (! cc) break;    /* break if we run into eof */
  706.             }
  707.  
  708.     tp = tokenString;
  709.     *tp++ = cc;
  710.  
  711.     if (! cc)            /* end of input */
  712.         token = inputend;
  713.     
  714.     else if (isalpha(cc)) {        /* identifier */
  715.         while (nextChar() && isalnum(cc))
  716.             *tp++ = cc;
  717.         if (cc == ':') {
  718.             *tp++ = cc;
  719.             token = namecolon;
  720.             }
  721.         else {
  722.             pushBack(cc);
  723.             token = name;
  724.             }
  725.         }
  726.  
  727.     else if (isdigit(cc)) {        /* number */
  728.         tokenInteger = cc - '0';
  729.         while (nextChar() && isdigit(cc)) {
  730.             *tp++ = cc;
  731.             tokenInteger = (tokenInteger * 10) + (cc - '0');
  732.             }
  733.         token = intconst;
  734.         if (cc == '.') {    /* possible float */
  735.             if (nextChar() && isdigit(cc)) {
  736.                 *tp++ = '.';
  737.                 do
  738.                     *tp++ = cc;
  739.                 while (nextChar() && isdigit(cc));
  740.                 if (cc) pushBack(cc);
  741.                 token = floatconst;
  742.                 *tp = '\0';
  743.                 tokenFloat = atof(tokenString);
  744.                 }
  745.             else {
  746.                 /* nope, just an ordinary period */
  747.                 if (cc) pushBack(cc);
  748.                 pushBack('.');
  749.                 }
  750.             }
  751.         else
  752.             pushBack(cc);
  753.  
  754.         if (nextChar() && cc == 'e') {    /* possible float */
  755.             if (nextChar() && cc == '-') {
  756.                 sign = true;
  757.                 nextChar();
  758.                 }
  759.             else
  760.                 sign = false;
  761.             if (cc && isdigit(cc)) { /* yep, its a float */
  762.                 *tp++ = 'e';
  763.                 if (sign) *tp++ = '-';
  764.                 while (cc && isdigit(cc)) {
  765.                     *tp++ = cc;
  766.                     nextChar();
  767.                     }
  768.                 if (cc) pushBack(cc);
  769.                 *tp = '\0';
  770.                 token = floatconst;
  771.                 tokenFloat = atof(tokenString);
  772.                 }
  773.             else {    /* nope, wrong again */
  774.                 if (cc) pushBack(cc);
  775.                 if (sign) pushBack('-');
  776.                 pushBack('e');
  777.                 }
  778.             }
  779.             else
  780.                 if (cc) pushBack(cc);
  781.         }
  782.  
  783.     else if (cc == '$') {        /* character constant */
  784.         tokenInteger = (int) nextChar();
  785.         token = charconst;
  786.         }
  787.  
  788.     else if (cc == '#') {        /* symbol */
  789.         tp--;    /* erase pound sign */
  790.         if (nextChar() == '(')
  791.             token = arraybegin;
  792.         else {
  793.             pushBack(cc);
  794.             while (nextChar() && (isalnum(cc) || (cc == ':')))
  795.                 *tp++ = cc;
  796.             pushBack(cc);
  797.             token = symconst;
  798.             }
  799.         }
  800.  
  801.     else if (cc == '\'') {        /* string constant */
  802.         tp--;    /* erase pound sign */
  803.         while (nextChar() && (cc != '\''))
  804.             *tp++ = cc;
  805.         if (!cc) pushBack(cc);    /* push back an eof */
  806.         token = strconst;
  807.         }
  808.  
  809.     else if (isClosing(cc))        /* closing expressions */
  810.         token = closing;
  811.  
  812.     else if (singleBinary(cc))    /* single binary expressions */
  813.         token = binary;
  814.  
  815.     else {                /* anything else is binary */
  816.         if (nextChar() && binarySecond(cc))
  817.             *tp++ = cc;
  818.         else
  819.             pushBack(cc);
  820.         token = binary;
  821.         }
  822.  
  823.     *tp = '\0';
  824.     return(token);
  825. }
  826. End
  827. echo unbundling parser.c 1>&2
  828. cat >parser.c <<'End'
  829. /*
  830.     Little Smalltalk, version 2
  831.     Written by Tim Budd, Oregon State University, July 1987
  832.  
  833.     Method parser - parses the textual description of a method,
  834.     generating bytecodes and literals.
  835.  
  836.     This parser is based around a simple minded recursive descent
  837.     parser.
  838.     It is used both by the module that builds the initial virtual image,
  839.     and by a primitive when invoked from a running Smalltalk system.
  840.  
  841.     The latter case could, if the bytecode interpreter were fast enough,
  842.     be replaced by a parser written in Smalltalk.  This would be preferable,
  843.     but not if it slowed down the system too terribly.
  844.  
  845.     To use the parser the routine setInstanceVariables must first be
  846.     called with a class object.  This places the appropriate instance
  847.     variables into the memory buffers, so that references to them
  848.     can be correctly encoded.
  849.  
  850.     As this is recursive descent, you should read it SDRAWKCAB !
  851.         (from bottom to top)
  852. */
  853. # include <stdio.h>
  854. # include "env.h"
  855. # include "memory.h"
  856. # include "names.h"
  857. # include "interp.h"
  858. # include "lex.h"
  859.  
  860.         /* all of the following limits could be increased (up to
  861.             256) without any trouble.  They are kept low 
  862.             to keep memory utilization down */
  863.  
  864. # define codeLimit 256        /* maximum number of bytecodes permitted */
  865. # define literalLimit 32    /* maximum number of literals permitted */
  866. # define temporaryLimit 16    /* maximum number of temporaries permitted */
  867. # define argumentLimit 16    /* maximum number of arguments permitted */
  868. # define instanceLimit 16    /* maximum number of instance vars permitted */
  869. # define methodLimit 32        /* maximum number of methods permitted */
  870.  
  871. extern object binSyms[];
  872. extern object keySyms[];
  873. extern char *unStrs[], *binStrs[], *keyStrs[];
  874.  
  875. static boolean parseok;            /* parse still ok? */
  876. static int codeTop;            /* top position filled in code array */
  877. static byte codeArray[codeLimit];    /* bytecode array */
  878. static int literalTop;            /*  ... etc. */
  879. static object literalArray[literalLimit];
  880. static int temporaryTop;
  881. static char *temporaryName[temporaryLimit];
  882. static int argumentTop;
  883. static char *argumentName[argumentLimit];
  884. static int instanceTop;
  885. static char *instanceName[instanceLimit];
  886.  
  887. static int maxTemporary;        /* highest temporary see so far */
  888. static char selector[80];        /* message selector */
  889.  
  890. static boolean inBlock;            /* true if compiling a block */
  891. static boolean optimizedBlock;        /* true if compiling optimized block */
  892.  
  893. setInstanceVariables(aClass)
  894. object aClass;
  895. {    int i, limit;
  896.     object vars;
  897.  
  898.     if (aClass == nilobj)
  899.         instanceTop = 0;
  900.     else {
  901.         setInstanceVariables(basicAt(aClass, superClassInClass));
  902.         vars = basicAt(aClass, variablesInClass);
  903.         if (vars != nilobj) {
  904.             limit = objectSize(vars);
  905.             for (i = 1; i <= limit; i++)
  906.                 instanceName[++instanceTop] = charPtr(basicAt(vars, i));
  907.             }
  908.         }
  909. }
  910.  
  911. compilError(str1, str2)
  912. char *str1, *str2;
  913. {
  914.     fprintf(stderr,"compiler error: %s %s\n", str1, str2);
  915.     parseok = false;
  916. }
  917.  
  918. static object newChar(value)
  919. int value;
  920. {    object newobj;
  921.  
  922.     newobj = allocObject(1);
  923.     basicAtPut(newobj, 1, newInteger(value));
  924.     setClass(newobj, globalSymbol("Char"));
  925.     return(newobj);
  926. }
  927.  
  928. static object newByteArray(size)
  929. int size;
  930. {    object newobj;
  931.  
  932.     newobj = allocByte(size);
  933.     setClass(newobj, globalSymbol("ByteArray"));
  934.     return(newobj);
  935. }
  936.  
  937. static genCode(value)
  938. int value;
  939. {
  940.     if (codeTop >= codeLimit)
  941.         compilError("too many bytecode instructions in method","");
  942.     else
  943.         codeArray[codeTop++] = value;
  944. }
  945.  
  946. static genInstruction(high, low)
  947. int high, low;
  948. {
  949.     if (low >= 16) {
  950.         genInstruction(0, high);
  951.         genCode(low);
  952.         }
  953.     else
  954.         genCode(high * 16 + low);
  955. }
  956.  
  957. static int genLiteral(aLiteral)
  958. object aLiteral;
  959. {
  960.     if (literalTop >= literalLimit)
  961.         compilError("too many literals in method","");
  962.     else
  963.         literalArray[++literalTop] = aLiteral;
  964.     return(literalTop - 1);
  965. }
  966.  
  967. static char *glbsyms[] = {"nil", "true", "false", "smalltalk", 0 };
  968.  
  969. static boolean nameTerm(name)
  970. char *name;
  971. {    int i;
  972.     boolean done = false;
  973.     boolean isSuper = false;
  974.  
  975.     /* it might be self or super */
  976.     if (streq(name, "self") || streq(name, "super")) {
  977.         genInstruction(PushArgument, 0);
  978.         done = true;
  979.         if (streq(name,"super")) isSuper = true;
  980.         }
  981.  
  982.     /* or it might be a temporary */
  983.     if (! done)
  984.         for (i = 1; (! done) && ( i <= temporaryTop ) ; i++)
  985.             if (streq(name, temporaryName[i])) {
  986.                 genInstruction(PushTemporary, i-1);
  987.                 done = true;
  988.                 }
  989.  
  990.     /* or it might be an argument */
  991.     if (! done)
  992.         for (i = 1; (! done) && (i <= argumentTop ) ; i++)
  993.             if (streq(name, argumentName[i])) {
  994.                 genInstruction(PushArgument, i);
  995.                 done = true;
  996.                 }
  997.  
  998.     /* or it might be an instance variable */
  999.     if (! done)
  1000.         for (i = 1; (! done) && (i <= instanceTop); i++) {
  1001.             if (streq(name, instanceName[i])) {
  1002.                 genInstruction(PushInstance, i-1);
  1003.                 done = true;
  1004.                 }
  1005.             }
  1006.  
  1007.     /* or it might be a global constant */
  1008.     if (! done)
  1009.         for (i = 0; (! done) && glbsyms[i]; i++)
  1010.             if (streq(name, glbsyms[i])) {
  1011.                 genInstruction(PushConstant, i+4);
  1012.                 done = true;
  1013.                 }
  1014.  
  1015.     /* not anything else, it must be a global */
  1016.     if (! done) {
  1017.         genInstruction(PushGlobal, genLiteral(newSymbol(name)));
  1018.         }
  1019.  
  1020.     return(isSuper);
  1021. }
  1022.  
  1023. static int parseArray()
  1024. {    int i, size, base;
  1025.     object newLit, obj;
  1026.  
  1027.     base = literalTop;
  1028.     ignore nextToken();
  1029.     while (parseok && (token != closing)) {
  1030.         switch(token) {
  1031.             case arraybegin:
  1032.                 ignore parseArray();
  1033.                 break;
  1034.  
  1035.             case intconst:
  1036.                 ignore genLiteral(newInteger(tokenInteger));
  1037.                 ignore nextToken();
  1038.                 break;
  1039.  
  1040.             case floatconst:
  1041.                 ignore genLiteral(newFloat(tokenFloat));
  1042.                 ignore nextToken();
  1043.                 break;
  1044.  
  1045.             case name: case namecolon: case symconst:
  1046.                 ignore genLiteral(newSymbol(tokenString));
  1047.                 ignore nextToken();
  1048.                 break;
  1049.  
  1050.             case binary:
  1051.                 if (streq(tokenString, "(")) {
  1052.                     ignore parseArray();
  1053.                     }
  1054.                 else {
  1055.                     ignore genLiteral(newSymbol(tokenString));
  1056.                     ignore nextToken();
  1057.                     }
  1058.                 break;
  1059.  
  1060.             case charconst:
  1061.                 ignore genLiteral(newChar(
  1062.                     newInteger(tokenInteger)));
  1063.                 ignore nextToken();
  1064.                 break;
  1065.  
  1066.             case strconst:
  1067.                 ignore genLiteral(newStString(tokenString));
  1068.                 ignore nextToken();
  1069.                 break;
  1070.  
  1071.             default:
  1072.                 compilError("illegal text in literal array",
  1073.                     tokenString);
  1074.                 ignore nextToken();
  1075.                 break;
  1076.         }
  1077.     }
  1078.  
  1079.     if (parseok)
  1080.         if (! streq(tokenString, ")"))
  1081.             compilError("array not terminated by right parenthesis",
  1082.                 tokenString);
  1083.         else
  1084.             ignore nextToken();
  1085.     size = literalTop - base;
  1086.     newLit = newArray(size);
  1087.     for (i = size; i >= 1; i--) {
  1088.         obj = literalArray[literalTop];
  1089.         basicAtPut(newLit, i, obj);
  1090.         decr(obj);
  1091.         literalArray[literalTop] = nilobj;
  1092.         literalTop = literalTop - 1;
  1093.         }
  1094.     return(genLiteral(newLit));
  1095. }
  1096.  
  1097. static boolean term()
  1098. {    boolean superTerm = false;    /* true if term is pseudo var super */
  1099.  
  1100.     if (token == name) {
  1101.         superTerm = nameTerm(tokenString);
  1102.         ignore nextToken();
  1103.         }
  1104.     else if (token == intconst) {
  1105.         if ((tokenInteger >= 0) && (tokenInteger <= 2))
  1106.             genInstruction(PushConstant, tokenInteger);
  1107.         else
  1108.             genInstruction(PushLiteral, 
  1109.                 genLiteral(newInteger(tokenInteger)));
  1110.         ignore nextToken();
  1111.         }
  1112.     else if (token == floatconst) {
  1113.         genInstruction(PushLiteral, genLiteral(newFloat(tokenFloat)));
  1114.         ignore nextToken();
  1115.         }
  1116.     else if ((token == binary) && streq(tokenString, "-")) {
  1117.         if (nextToken() != intconst)
  1118.             compilError("negation not followed",
  1119.                 "by integer");
  1120.  
  1121.         if (tokenInteger == 1)
  1122.             genInstruction(PushConstant, 3);
  1123.         else
  1124.             genInstruction(PushLiteral, 
  1125.                 genLiteral(newInteger( - tokenInteger)));
  1126.         ignore nextToken();
  1127.         }
  1128.     else if (token == charconst) {
  1129.         genInstruction(PushLiteral,
  1130.             genLiteral(newChar(tokenInteger)));
  1131.         ignore nextToken();
  1132.         }
  1133.     else if (token == symconst) {
  1134.         genInstruction(PushLiteral,
  1135.             genLiteral(newSymbol(tokenString)));
  1136.         ignore nextToken();
  1137.         }
  1138.     else if (token == strconst) {
  1139.         genInstruction(PushLiteral,
  1140.             genLiteral(newStString(tokenString)));
  1141.         ignore nextToken();
  1142.         }
  1143.     else if (token == arraybegin) {
  1144.         genInstruction(PushLiteral, parseArray());
  1145.         }
  1146.     else if ((token == binary) && streq(tokenString, "(")) {
  1147.         ignore nextToken();
  1148.         expression();
  1149.         if (parseok)
  1150.             if ((token != closing) || ! streq(tokenString, ")"))
  1151.                 compilError("Missing Right Parenthesis","");
  1152.             else
  1153.                 ignore nextToken();
  1154.         }
  1155.     else if ((token == binary) && streq(tokenString, "<"))
  1156.         parsePrimitive();
  1157.     else if ((token == binary) && streq(tokenString, "["))
  1158.         block();
  1159.     else
  1160.         compilError("invalid expression start", tokenString);
  1161.  
  1162.     return(superTerm);
  1163. }
  1164.  
  1165. static parsePrimitive()
  1166. {    int primitiveNumber, argumentCount;
  1167.  
  1168.     if (nextToken() != intconst)
  1169.         compilError("primitive number missing","");
  1170.     primitiveNumber = tokenInteger;
  1171.     ignore nextToken();
  1172.     argumentCount = 0;
  1173.     while (parseok && ! ((token == binary) && streq(tokenString, ">"))) {
  1174.         (void) term();
  1175.         argumentCount++;
  1176.         }
  1177.     genInstruction(DoPrimitive, argumentCount);
  1178.     genCode(primitiveNumber);
  1179.     ignore nextToken();
  1180. }
  1181.  
  1182. static genMessage(toSuper, argumentCount, messagesym)
  1183. boolean toSuper;
  1184. int argumentCount;
  1185. object messagesym;
  1186. {
  1187.     if (toSuper) {
  1188.         genInstruction(DoSpecial, SendToSuper);
  1189.         genCode(argumentCount);
  1190.         }
  1191.     else
  1192.         genInstruction(SendMessage, argumentCount);
  1193.     genCode(genLiteral(messagesym));
  1194. }
  1195.  
  1196. static boolean unaryContinuation(superReceiver)
  1197. boolean superReceiver;
  1198. {    int i;
  1199.     boolean sent;
  1200.     object messagesym;
  1201.  
  1202.     while (parseok && (token == name)) {
  1203.         sent = false;
  1204.         messagesym = newSymbol(tokenString);
  1205.         /* check for built in messages */
  1206.         if (! superReceiver)
  1207.             for (i = 0; i < 9; i++)
  1208.                 if (streq(tokenString, unStrs[i])) {
  1209.                     genInstruction(SendUnary, i);
  1210.                     sent = true;
  1211.                     }
  1212.         if (! sent) {
  1213.             genMessage(superReceiver, 0, messagesym);
  1214.             }
  1215.         /* once a message is sent to super, reciever is not super */
  1216.         superReceiver = false;
  1217.         ignore nextToken();
  1218.         }
  1219.     return(superReceiver);
  1220. }
  1221.  
  1222. static boolean binaryContinuation(superReceiver)
  1223. boolean superReceiver;
  1224. {    int i;
  1225.     boolean sent, superTerm;
  1226.     object messagesym;
  1227.  
  1228.     superReceiver = unaryContinuation(superReceiver);
  1229.     while (parseok && (token == binary)) {
  1230.         messagesym = newSymbol(tokenString);
  1231.         ignore nextToken();
  1232.         superTerm = term();
  1233.         ignore unaryContinuation(superTerm);
  1234.         sent = false;
  1235.         /* check for built in messages */
  1236.         if (! superReceiver) {
  1237.             for (i = 0; (! sent) && binStrs[i]; i++)
  1238.                 if (messagesym == binSyms[i]) {
  1239.                     genInstruction(SendBinary, i);
  1240.                     sent = true;
  1241.                     }
  1242.  
  1243.             }
  1244.         if (! sent) {
  1245.             genMessage(superReceiver, 1, messagesym);
  1246.             }
  1247.         superReceiver = false;
  1248.         }
  1249.     return(superReceiver);
  1250. }
  1251.  
  1252. static int optimizeBlock(instruction, dopop)
  1253. int instruction;
  1254. boolean dopop;
  1255. {    int location;
  1256.     boolean saveOB;
  1257.  
  1258.     genInstruction(DoSpecial, instruction);
  1259.     location = codeTop;
  1260.     genCode(0);
  1261.     if (dopop)
  1262.         genInstruction(DoSpecial, PopTop);
  1263.     ignore nextToken();
  1264.     if (! streq(tokenString, "["))
  1265.         compilError("block needed","following optimized message");
  1266.     ignore nextToken();
  1267.     saveOB = optimizedBlock;
  1268.     optimizedBlock = true;
  1269.     body();
  1270.     optimizedBlock = saveOB;
  1271.     if (! streq(tokenString, "]"))
  1272.         compilError("missing close","after block");
  1273.     ignore nextToken();
  1274.     codeArray[location] = codeTop;
  1275.     return(location);
  1276. }
  1277.  
  1278. static boolean keyContinuation(superReceiver)
  1279. boolean superReceiver;
  1280. {    int i, j, argumentCount, savetop;
  1281.     boolean sent, superTerm;
  1282.     object messagesym;
  1283.     char pattern[80];
  1284.  
  1285.     savetop = codeTop;
  1286.     superReceiver = binaryContinuation(superReceiver);
  1287.     if (token == namecolon) {
  1288.         if (streq(tokenString, "ifTrue:")) {
  1289.             i = optimizeBlock(BranchIfFalse, false);
  1290.             if (streq(tokenString, "ifFalse:")) {
  1291.                 codeArray[i] = codeTop + 3;
  1292.                 ignore optimizeBlock(Branch, true);
  1293.                 }
  1294.             }
  1295.         else if (streq(tokenString, "ifFalse:")) {
  1296.             i = optimizeBlock(BranchIfTrue, false);
  1297.             if (streq(tokenString, "ifTrue:")) {
  1298.                 codeArray[i] = codeTop + 3;
  1299.                 ignore optimizeBlock(Branch, true);
  1300.                 }
  1301.             }
  1302.         else if (streq(tokenString, "whileTrue:")) {
  1303.             genInstruction(SendUnary, 3 /* value command */);
  1304.             i = optimizeBlock(BranchIfFalse, false);
  1305.             genInstruction(DoSpecial, PopTop);
  1306.             genInstruction(DoSpecial, Branch);
  1307.             for (j = codeTop - 1; j > 0; j--)
  1308.                 if ((codeArray[j] == savetop) &&
  1309.                     (codeArray[j-1] == CreateBlock*16)) {
  1310.                     genCode(j-1);
  1311.                     break;
  1312.                     }
  1313.             if (i == 0)
  1314.                 compilError("block needed before","whileTrue:");
  1315.             codeArray[i] = codeTop;
  1316.             }
  1317.         else if (streq(tokenString, "and:"))
  1318.             ignore optimizeBlock(AndBranch, false);
  1319.         else if (streq(tokenString, "or:"))
  1320.             ignore optimizeBlock(OrBranch, false);
  1321.         else {
  1322.             pattern[0] = '\0';
  1323.             argumentCount = 0;
  1324.             while (parseok && (token == namecolon)) {
  1325.                 ignore strcat(pattern, tokenString);
  1326.                 argumentCount++;
  1327.                 ignore nextToken();
  1328.                 superTerm = term();
  1329.                 ignore binaryContinuation(superTerm);
  1330.                 }
  1331.             sent = false;
  1332.  
  1333.             /* check for predefined messages */
  1334.             messagesym = newSymbol(pattern);
  1335.             if (! superReceiver) {
  1336.                 for (i = 0; (! sent) && binStrs[i]; i++)
  1337.                     if (messagesym == binSyms[i]) {
  1338.                         sent = true;
  1339.                         genInstruction(SendBinary, i);
  1340.                         }
  1341.  
  1342.                 for (i = 0; (! sent) && keyStrs[i]; i++)
  1343.                     if (messagesym == keySyms[i]) {
  1344.                         genInstruction(SendKeyword, i);
  1345.                         sent = true;
  1346.                         }
  1347.                 }
  1348.  
  1349.             if (! sent) {
  1350.                 genMessage(superReceiver, argumentCount, messagesym);
  1351.                 }
  1352.             }
  1353.         superReceiver = false;
  1354.         }
  1355.     return(superReceiver);
  1356. }
  1357.  
  1358. static continuation(superReceiver)
  1359. boolean superReceiver;
  1360. {
  1361.     superReceiver = keyContinuation(superReceiver);
  1362.  
  1363.     while (parseok && (token == closing) && streq(tokenString, ";")) {
  1364.         genInstruction(DoSpecial, Duplicate);
  1365.         ignore nextToken();
  1366.         ignore keyContinuation(superReceiver);
  1367.         genInstruction(DoSpecial, PopTop);
  1368.         }
  1369. }
  1370.  
  1371. static expression()
  1372. {    boolean superTerm;
  1373.  
  1374.     superTerm = term();
  1375.     if (parseok)
  1376.         continuation(superTerm);
  1377. }
  1378.  
  1379. static assignment(name)
  1380. char *name;
  1381. {    int i;
  1382.     boolean done;
  1383.  
  1384.     done = false;
  1385.  
  1386.     /* it might be a temporary */
  1387.     for (i = 1; (! done) && (i <= temporaryTop); i++)
  1388.         if (streq(name, temporaryName[i])) {
  1389.             genInstruction(PopTemporary, i-1);
  1390.             done = true;
  1391.             }
  1392.  
  1393.     /* or it might be an instance variable */
  1394.     for (i = 1; (! done) && (i <= instanceTop); i++)
  1395.         if (streq(name, instanceName[i])) {
  1396.             genInstruction(PopInstance, i-1);
  1397.             done = true;
  1398.             }
  1399.  
  1400.     if (! done)
  1401.         compilError("assignment to unknown name", name);
  1402. }
  1403.  
  1404. static statement()
  1405. {    char assignname[80];
  1406.     boolean superReceiver = false;
  1407.  
  1408.     if ((token == binary) && streq(tokenString, "^")) {
  1409.         ignore nextToken();
  1410.         expression();
  1411.         if (inBlock)
  1412.             genInstruction(DoSpecial, BlockReturn);
  1413.         else
  1414.             genInstruction(DoSpecial, StackReturn);
  1415.         }
  1416.     else if (token == name) {    /* possible assignment */
  1417.         ignore strcpy(assignname, tokenString);
  1418.         ignore nextToken();
  1419.         if ((token == binary) && streq(tokenString, "<-")) {
  1420.             ignore nextToken();
  1421.             expression();
  1422.             if (inBlock || optimizedBlock)
  1423.                 if ((token == closing) && streq(tokenString,"]"))
  1424.                     genInstruction(DoSpecial, Duplicate);
  1425.             assignment(assignname);
  1426.             if (inBlock && (token == closing) &&
  1427.                 streq(tokenString, "]"))
  1428.                 genInstruction(DoSpecial, StackReturn);
  1429.             }
  1430.         else {        /* not an assignment after all */
  1431.             superReceiver = nameTerm(assignname);
  1432.             continuation(superReceiver);
  1433.             if (! optimizedBlock)
  1434.                 if (inBlock && (token == closing) &&
  1435.                     streq(tokenString, "]"))
  1436.                     genInstruction(DoSpecial, StackReturn);
  1437.                 else
  1438.                     genInstruction(DoSpecial, PopTop);
  1439.             }
  1440.         }
  1441.     else {
  1442.         expression();
  1443.         if (! optimizedBlock)
  1444.             if (inBlock && (token == closing) &&
  1445.                 streq(tokenString, "]"))
  1446.                 genInstruction(DoSpecial, StackReturn);
  1447.             else
  1448.                 genInstruction(DoSpecial, PopTop);
  1449.         }
  1450. }
  1451.  
  1452. static body()
  1453. {
  1454.     do {
  1455.         statement();
  1456.         if ((token == closing) && streq(tokenString, "."))
  1457.             ignore nextToken();
  1458.         } while (parseok && (token != closing) && (token != inputend));
  1459. }
  1460.  
  1461. static block()
  1462. {    int saveTemporary, argumentCount, fixLocation;
  1463.     boolean saveInBlock, saveOB;
  1464.     object tempsym;
  1465.  
  1466.     saveTemporary = temporaryTop;
  1467.     argumentCount = 0;
  1468.     ignore nextToken();
  1469.     if ((token == binary) && streq(tokenString, ":")) {
  1470.         while (parseok && (token == binary) && streq(tokenString,":")) {
  1471.             if (nextToken() != name)
  1472.                 compilError("name must follow colon",
  1473.                     "in block argument list");
  1474.                 if (++temporaryTop > maxTemporary)
  1475.                 maxTemporary = temporaryTop;
  1476.             argumentCount++;
  1477.             if (temporaryTop > temporaryLimit)
  1478.                 compilError("too many temporaries in method","");
  1479.             else {
  1480.                 tempsym = newSymbol(tokenString);
  1481.                 temporaryName[temporaryTop] = charPtr(tempsym);
  1482.                 }
  1483.             ignore nextToken();
  1484.             }
  1485.         if ((token != binary) || ! streq(tokenString, "|"))
  1486.             compilError("block argument list must be terminated",
  1487.                     "by |");
  1488.         ignore nextToken();
  1489.         }
  1490.     genInstruction(CreateBlock, argumentCount);
  1491.     if (argumentCount != 0){
  1492.         genCode(saveTemporary + 1);
  1493.         }
  1494.     fixLocation = codeTop;
  1495.     genCode(0);
  1496.     saveInBlock = inBlock;
  1497.     saveOB = optimizedBlock;
  1498.     inBlock = true;
  1499.     optimizedBlock = false;
  1500.     body();
  1501.     if ((token == closing) && streq(tokenString, "]"))
  1502.         ignore nextToken();
  1503.     else
  1504.         compilError("block not terminated by ]","");
  1505.     codeArray[fixLocation] = codeTop;
  1506.     inBlock = saveInBlock;
  1507.     optimizedBlock = saveOB;
  1508.     temporaryTop = saveTemporary;
  1509. }
  1510.  
  1511. static temporaries()
  1512. {    object tempsym;
  1513.  
  1514.     temporaryTop = 0;
  1515.     if ((token == binary) && streq(tokenString, "|")) {
  1516.         ignore nextToken();
  1517.         while (token == name) {
  1518.             if (++temporaryTop > maxTemporary)
  1519.                 maxTemporary = temporaryTop;
  1520.             if (temporaryTop > temporaryLimit)
  1521.                 compilError("too many temporaries in method","");
  1522.             else {
  1523.                 tempsym = newSymbol(tokenString);
  1524.                 temporaryName[temporaryTop] = charPtr(tempsym);
  1525.                 }
  1526.             ignore nextToken();
  1527.             }
  1528.         if ((token != binary) || ! streq(tokenString, "|"))
  1529.             compilError("temporary list not terminated by bar","");
  1530.         else
  1531.             ignore nextToken();
  1532.         }
  1533. }
  1534.  
  1535. static messagePattern()
  1536. {    object argsym;
  1537.  
  1538.     argumentTop = 0;
  1539.     ignore strcpy(selector, tokenString);
  1540.     if (token == name)        /* unary message pattern */
  1541.         ignore nextToken();
  1542.     else if (token == binary) {    /* binary message pattern */
  1543.         ignore nextToken();
  1544.         if (token != name) 
  1545.             compilError("binary message pattern not followed by name",selector);
  1546.         argsym = newSymbol(tokenString);
  1547.         argumentName[++argumentTop] = charPtr(argsym);
  1548.         ignore nextToken();
  1549.         }
  1550.     else if (token == namecolon) {    /* keyword message pattern */
  1551.         selector[0] = '\0';
  1552.         while (parseok && (token == namecolon)) {
  1553.             ignore strcat(selector, tokenString);
  1554.             ignore nextToken();
  1555.             if (token != name)
  1556.                 compilError("keyword message pattern",
  1557.                     "not followed by a name");
  1558.             if (++argumentTop > argumentLimit)
  1559.                 compilError("too many arguments in method","");
  1560.             argsym = newSymbol(tokenString);
  1561.             argumentName[argumentTop] = charPtr(argsym);
  1562.             ignore nextToken();
  1563.             }
  1564.         }
  1565.     else
  1566.         compilError("illegal message selector", tokenString);
  1567. }
  1568.  
  1569. boolean parse(method, text)
  1570. object method;
  1571. char *text;
  1572. {    int i;
  1573.     object bytecodes, theLiterals;
  1574.     byte *bp;
  1575.  
  1576.     lexinit(text);
  1577.     parseok = true;
  1578.     codeTop = 0;
  1579.     literalTop = temporaryTop = argumentTop =0;
  1580.     maxTemporary = 0;
  1581.     inBlock = optimizedBlock = false;
  1582.  
  1583.     messagePattern();
  1584.     if (parseok)
  1585.         temporaries();
  1586.     if (parseok)
  1587.         body();
  1588.     if (parseok)
  1589.         genInstruction(DoSpecial, SelfReturn);
  1590.  
  1591.     if (! parseok)
  1592.         basicAtPut(method, bytecodesInMethod, nilobj);
  1593.     else {
  1594.         bytecodes = newByteArray(codeTop);
  1595.         bp = bytePtr(bytecodes);
  1596.         for (i = 0; i < codeTop; i++) {
  1597.             bp[i] = codeArray[i];
  1598.             }
  1599.         basicAtPut(method, messageInMethod, newSymbol(selector));
  1600.         basicAtPut(method, bytecodesInMethod, bytecodes);
  1601.         if (literalTop > 0) {
  1602.             theLiterals = newArray(literalTop);
  1603.             for (i = 1; i <= literalTop; i++) {
  1604.                 basicAtPut(theLiterals, i, literalArray[i]);
  1605.                 }
  1606.             basicAtPut(method, literalsInMethod, theLiterals);
  1607.             }
  1608.         else
  1609.             basicAtPut(method, literalsInMethod, nilobj);
  1610.         basicAtPut(method, stackSizeInMethod, newInteger(6));
  1611.         basicAtPut(method, temporarySizeInMethod,
  1612.             newInteger(1 + maxTemporary));
  1613.         basicAtPut(method, textInMethod, newStString(text));
  1614.         return(true);
  1615.         }
  1616.     return(false);
  1617. }
  1618. End
  1619. echo unbundling primitive.c 1>&2
  1620. cat >primitive.c <<'End'
  1621. /*
  1622.     Little Smalltalk, version 2
  1623.     Written by Tim Budd, Oregon State University, July 1987
  1624.  
  1625.     Primitive processor
  1626.  
  1627.     primitives are how actions are ultimately executed in the Smalltalk 
  1628.     system.
  1629.     unlike ST-80, Little Smalltalk primitives cannot fail (although
  1630.     they can return nil, and methods can take this as an indication
  1631.     of failure).  In this respect primitives in Little Smalltalk are
  1632.     much more like traditional system calls.
  1633.  
  1634.     Primitives are combined into groups of 10 according to 
  1635.     argument count and type, and in some cases type checking is performed.
  1636. */
  1637.  
  1638. # include <stdio.h>
  1639. # include <math.h>
  1640. # include "env.h"
  1641. # include "memory.h"
  1642. # include "names.h"
  1643. # include "process.h"
  1644.  
  1645. # define normalresult 1
  1646. # define counterror 2
  1647. # define typeerror  3
  1648. # define quitinterp 4
  1649.  
  1650. extern object doInterp();
  1651. extern double modf();
  1652. extern char *getenv();
  1653.  
  1654. char tempfilename[100];        /* temp file for editing */
  1655.  
  1656. static int zeroaryPrims(number)
  1657. int number;
  1658. {    char buffer[100];
  1659.     short i;
  1660.  
  1661.     returnedObject = nilobj;
  1662.     switch(number) {
  1663.         case 1:            /* read from user */
  1664.             if (gets(buffer) != NULL)
  1665.                 returnedObject = newStString(buffer);
  1666.             break;
  1667.  
  1668.         case 2:
  1669.             flushMessageCache();
  1670.             break;
  1671.  
  1672.         case 3:            /* return a random number */
  1673.             /* this is hacked because of the representation */
  1674.             /* of integers as shorts */
  1675.             i = rand() >> 8;    /* strip off lower bits */
  1676.             if (i < 0) i = - i;
  1677.             returnedObject = newInteger(i>>1);
  1678.             break;
  1679.  
  1680.         default:        /* unknown primitive */
  1681.             sysError("unknown primitive","zeroargPrims");
  1682.             break;
  1683.     }
  1684.     return(normalresult);
  1685. }
  1686.  
  1687. static int unaryPrims(number, firstarg)
  1688. int number;
  1689. object firstarg;
  1690. {
  1691.  
  1692.     returnedObject = firstarg;
  1693.     switch(number) {
  1694.         case 1:        /* class of object */
  1695.             returnedObject = getClass(firstarg);
  1696.             break;
  1697.  
  1698.         case 2:        /* basic size of object */
  1699.             if (isInteger(firstarg))
  1700.                 returnedObject = newInteger(0);
  1701.             else
  1702.                 returnedObject = newInteger(objectSize(firstarg));
  1703.             break;
  1704.  
  1705.         case 3:        /* hash value of object */
  1706.             if (isInteger(firstarg))
  1707.                 returnedObject = firstarg;
  1708.             else
  1709.                 returnedObject = newInteger((int) firstarg);
  1710.             break;
  1711.  
  1712.         case 9:        /* interpreter bytecodes */
  1713.             returnedObject = doInterp(firstarg);
  1714.             break;
  1715.  
  1716.         default:        /* unknown primitive */
  1717.             sysError("unknown primitive","unaryPrims");
  1718.             break;
  1719.     }
  1720.     return(normalresult);
  1721. }
  1722.  
  1723. static int binaryPrims(number, firstarg, secondarg)
  1724. int number;
  1725. object firstarg, secondarg;
  1726. {    char buffer[120];
  1727.     char *bp;
  1728.  
  1729.     returnedObject = firstarg;
  1730.     switch(number) {
  1731.         case 1:        /* object identity test */
  1732.             if (firstarg == secondarg)
  1733.                 returnedObject = trueobj;
  1734.             else
  1735.                 returnedObject = falseobj;
  1736.             break;
  1737.  
  1738.         case 2:        /* set class of object */
  1739.             decr(classField(firstarg));
  1740.             setClass(firstarg, secondarg);
  1741.             returnedObject = firstarg;
  1742.             break;
  1743.  
  1744.         case 4:        /* string cat */
  1745.             ignore strcpy(buffer, charPtr(firstarg));
  1746.             ignore strcat(buffer, charPtr(secondarg));
  1747.             returnedObject = newStString(buffer);
  1748.             break;
  1749.         
  1750.         case 5:        /* basicAt: */
  1751.             returnedObject = basicAt(firstarg, intValue(secondarg));
  1752.             break;
  1753.  
  1754.         case 6:        /* byteAt: */
  1755.             bp = charPtr(firstarg);
  1756.             returnedObject = newInteger(bp[intValue(secondarg)-1]);
  1757.             break;
  1758.  
  1759.         case 8:        /* execute a context */
  1760.             messageToSend = firstarg;
  1761.             argumentsOnStack = intValue(secondarg);
  1762.             finalTask = ContextExecuteTask;
  1763.             return(quitinterp);
  1764.  
  1765.         default:        /* unknown primitive */
  1766.             sysError("unknown primitive","binaryPrims");
  1767.             break;
  1768.  
  1769.     }
  1770.     return(normalresult);
  1771. }
  1772.  
  1773. static int trinaryPrims(number, firstarg, secondarg, thirdarg)
  1774. int number;
  1775. object firstarg, secondarg, thirdarg;
  1776. {    char *bp;
  1777.  
  1778.     returnedObject = firstarg;
  1779.     switch(number) {
  1780.         case 1:            /* basicAt:Put: */
  1781.             basicAtPut(firstarg, intValue(secondarg), thirdarg);
  1782.             break;
  1783.  
  1784.         case 2:            /* basicAt:Put: for bytes */
  1785.             bp = charPtr(firstarg);
  1786.             bp[intValue(secondarg)-1] = intValue(thirdarg);
  1787.             break;
  1788.  
  1789.         case 9:            /* compile method */
  1790.             setInstanceVariables(firstarg);
  1791.             if (parse(thirdarg, charPtr(secondarg)))
  1792.                 returnedObject = trueobj;
  1793.             else
  1794.                 returnedObject = falseobj;
  1795.             break;
  1796.         
  1797.         default:        /* unknown primitive */
  1798.             sysError("unknown primitive","trinaryPrims");
  1799.             break;
  1800.         }
  1801.     return(normalresult);
  1802. }
  1803.  
  1804. static int intUnary(number, firstarg)
  1805. int number, firstarg;
  1806. {    char buffer[20];
  1807.  
  1808.     switch(number) {
  1809.         case 1:        /* float equiv of integer */
  1810.             returnedObject = newFloat((double) firstarg);
  1811.             break;
  1812.  
  1813.         case 5:        /* set random number */
  1814.             srand(firstarg);
  1815.             returnedObject = nilobj;
  1816.             break;
  1817.  
  1818.         case 6:        /* string equiv of number */
  1819.             buffer[0] = firstarg;
  1820.             buffer[1] = '\0';
  1821.             returnedObject = newStString(buffer);
  1822.             break;
  1823.  
  1824.         case 7:
  1825.             ignore sprintf(buffer,"%d",firstarg);
  1826.             returnedObject = newStString(buffer);
  1827.             break;
  1828.  
  1829.         case 8:
  1830.             returnedObject = allocObject(firstarg);
  1831.             break;
  1832.  
  1833.         case 9:
  1834.             returnedObject = allocByte(firstarg);
  1835.             break;
  1836.  
  1837.         default:
  1838.             sysError("intUnary primitive","not implemented yet");
  1839.         }
  1840.     return(normalresult);
  1841. }
  1842.  
  1843. int intBinary(number, firstarg, secondarg)
  1844. register int firstarg, secondarg;
  1845. int number;
  1846. {    boolean binresult;
  1847.  
  1848.     switch(number) {
  1849.         case 0:
  1850.             firstarg += secondarg; break;
  1851.         case 1:
  1852.             firstarg -= secondarg; break;
  1853.         case 2:
  1854.             binresult = firstarg < secondarg; break;
  1855.         case 3:
  1856.             binresult = firstarg > secondarg; break;
  1857.         case 4:
  1858.             binresult = firstarg <= secondarg; break;
  1859.         case 5:
  1860.             binresult = firstarg >= secondarg; break;
  1861.         case 6:
  1862.             binresult = firstarg == secondarg; break;
  1863.         case 7:
  1864.             binresult = firstarg != secondarg; break;
  1865.         case 8:
  1866.             firstarg *= secondarg; break;
  1867.         case 9:
  1868.             firstarg /= secondarg; break;
  1869.         case 10:
  1870.             firstarg %= secondarg; break;
  1871.         case 11:
  1872.             firstarg &= secondarg; break;
  1873.         case 12:
  1874.             firstarg ^= secondarg; break;
  1875.         case 19:
  1876.             if (secondarg < 0)
  1877.                 firstarg >>= (- secondarg);
  1878.             else
  1879.                 firstarg <<= secondarg;
  1880.             break;
  1881.     }
  1882.     if ((number >= 2) && (number <= 7))
  1883.         if (binresult)
  1884.             returnedObject = trueobj;
  1885.         else
  1886.             returnedObject = falseobj;
  1887.     else
  1888.         returnedObject = newInteger(firstarg);
  1889.     return(normalresult);
  1890. }
  1891.  
  1892. static int strUnary(number, firstargument)
  1893. int number;
  1894. char *firstargument;
  1895. {    FILE *fp;
  1896.     char *p, buffer[1000];
  1897.  
  1898.     switch(number) {
  1899.         case 1:        /* length of string */
  1900.             returnedObject = newInteger(strlen(firstargument));
  1901.             break;
  1902.  
  1903.         case 2:        /* copy of string */
  1904.             returnedObject = newStString(firstargument);
  1905.             break;
  1906.  
  1907.         case 3:        /* string as symbol */
  1908.             returnedObject = newSymbol(firstargument);
  1909.             break;
  1910.  
  1911.         case 6:        /* print, no newline */
  1912.             fputs(firstargument, stdout);
  1913.             ignore fflush(stdout);
  1914.             returnedObject = nilobj;
  1915.             break;
  1916.  
  1917.         case 7:        /* make an object image */
  1918.             returnedObject = falseobj;
  1919.             fp = fopen(firstargument, "w");
  1920.             if (fp == NULL) break;
  1921.             imageWrite(fp);
  1922.             ignore fclose(fp);
  1923.             returnedObject = trueobj;
  1924.             break;
  1925.  
  1926.         case 8:        /* print a string */
  1927.             puts(firstargument);
  1928.             ignore fflush(stdout);
  1929.             returnedObject = nilobj;
  1930.             break;
  1931.  
  1932.         case 9:        /* edit a string */
  1933.             fp = fopen(tempfilename, "w");
  1934.             fputs(firstargument, fp);
  1935.             ignore fclose(fp);
  1936.             p = getenv("EDITOR");
  1937.             if (! p) p = "ed";
  1938.             sprintf(buffer,"%s %s", p, tempfilename);
  1939.             ignore system(buffer);
  1940.             fp = fopen(tempfilename, "r");
  1941.             for (p = buffer; (*p = getc(fp)) != EOF; p++);
  1942.             *p = '\0';
  1943.             ignore fclose(fp);
  1944.             returnedObject = newStString(buffer);
  1945.             sprintf(buffer,"rm %s", tempfilename);
  1946.             ignore system(buffer);
  1947.             break;
  1948.  
  1949.         default:
  1950.             sysError("unknown primitive", "strUnary");
  1951.             break;
  1952.         }
  1953.  
  1954.     return(normalresult);
  1955. }
  1956.  
  1957. static int floatUnary(number, firstarg)
  1958. int number;
  1959. double firstarg;
  1960. {    char buffer[20];
  1961.     double temp;
  1962.  
  1963.     switch(number) {
  1964.         case 1:        /* asString */
  1965.             ignore sprintf(buffer,"%g", firstarg);
  1966.             returnedObject = newStString(buffer);
  1967.             break;
  1968.  
  1969.         case 2:        /* log */
  1970.             returnedObject = newFloat(log(firstarg));
  1971.             break;
  1972.  
  1973.         case 3:        /* exp */
  1974.             returnedObject = newFloat(exp(firstarg));
  1975.             break;
  1976.  
  1977.         case 4:        /* sqrt */
  1978.             returnedObject = newFloat(sqrt(firstarg));
  1979.             break;
  1980.  
  1981.         case 5:        /* gamma */
  1982.             returnedObject = newFloat(gamma(firstarg));
  1983.             break;
  1984.  
  1985.         case 6:        /* integer part */
  1986.             modf(firstarg, &temp);
  1987.             returnedObject = newInteger((int) temp);
  1988.             break;
  1989.  
  1990.         default:
  1991.             sysError("unknown primitive","floatUnary");
  1992.             break;
  1993.         }
  1994.  
  1995.     return(normalresult);
  1996. }
  1997.  
  1998. int floatBinary(number, first, second)
  1999. int number;
  2000. double first, second;
  2001. {     boolean binResult;
  2002.  
  2003.     switch(number) {
  2004.         case 0: first += second; break;
  2005.  
  2006.         case 1:    first -= second; break;
  2007.         case 2: binResult = (first < second); break;
  2008.         case 3: binResult = (first > second); break;
  2009.         case 4: binResult = (first <= second); break;
  2010.         case 5: binResult = (first >= second); break;
  2011.         case 6: binResult = (first == second); break;
  2012.         case 7: binResult = (first != second); break;
  2013.         case 8: first *= second; break;
  2014.         case 9: first /= second; break;
  2015.         default:    
  2016.             sysError("unknown primitive", "floatBinary");
  2017.             break;
  2018.         }
  2019.  
  2020.     if ((number >= 2) && (number <= 7))
  2021.         if (binResult)
  2022.             returnedObject = trueobj;
  2023.         else
  2024.             returnedObject = falseobj;
  2025.     else
  2026.         returnedObject = newFloat(first);
  2027.     return(normalresult);
  2028. }
  2029.  
  2030. boolean primitive(primitiveNumber, arguments, size)
  2031. int primitiveNumber, size;
  2032. object *arguments;
  2033. {    int primitiveGroup;
  2034.     boolean done = false;
  2035.     int response;
  2036.  
  2037.     primitiveGroup = primitiveNumber / 10;
  2038.     response = normalresult;
  2039.     switch(primitiveGroup) {
  2040.         case 0: case 1: case 2: case 3:
  2041.             if (size != primitiveGroup)
  2042.                 response = counterror;
  2043.             else {
  2044.                 switch(primitiveGroup) {
  2045.                     case 0:
  2046.                         response = zeroaryPrims(primitiveNumber);
  2047.                         break;
  2048.                     case 1:
  2049.                         response = unaryPrims(primitiveNumber - 10, arguments[0]);
  2050.                         break;
  2051.                     case 2:
  2052.                         response = binaryPrims(primitiveNumber-20, arguments[0], arguments[1]);
  2053.                         break;
  2054.                     case 3:
  2055.                         response = trinaryPrims(primitiveNumber-30, arguments[0], arguments[1], arguments[2]);
  2056.                         break;
  2057.                 }
  2058.             }
  2059.             break;
  2060.  
  2061.  
  2062.         case 5:            /* integer unary operations */
  2063.             if (size != 1)
  2064.                 response = counterror;
  2065.             else if (! isInteger(arguments[0]))
  2066.                 response = typeerror;
  2067.             else
  2068.                 response = intUnary(primitiveNumber-50,
  2069.                         intValue(arguments[0]));
  2070.             break;
  2071.  
  2072.         case 6: case 7:        /* integer binary operations */
  2073.             if (size != 2)
  2074.                 response = counterror;
  2075.             else if ((! isInteger(arguments[0])) || 
  2076.                   ! isInteger(arguments[1]))
  2077.                 response = typeerror;
  2078.             else
  2079.                 response = intBinary(primitiveNumber-60,
  2080.                     intValue(arguments[0]), 
  2081.                     intValue(arguments[1]));
  2082.             break;
  2083.  
  2084.         case 8:            /* string unary */
  2085.             if (size != 1)
  2086.                 response = counterror;
  2087.             else if (! isString(arguments[0]))
  2088.                 response = typeerror;
  2089.             else
  2090.                 response = strUnary(primitiveNumber-80,
  2091.                     charPtr(arguments[0]));
  2092.             break;
  2093.  
  2094.         case 10:        /* float unary */
  2095.             if (size != 1)
  2096.                 response = counterror;
  2097.             else if (! isFloat(arguments[0]))
  2098.                 response = typeerror;
  2099.             else
  2100.                 response = floatUnary(primitiveNumber-100,
  2101.                     floatValue(arguments[0]));
  2102.             break;
  2103.  
  2104.         case 11:        /* float binary */
  2105.             if (size != 2)
  2106.                 response = counterror;
  2107.             else if ((! isFloat(arguments[0])) ||
  2108.                  (! isFloat(arguments[1])))
  2109.                 response = typeerror;
  2110.             else
  2111.                 response = floatBinary(primitiveNumber-110,
  2112.                     floatValue(arguments[0]),
  2113.                     floatValue(arguments[1]));
  2114.             break;
  2115.  
  2116.     }
  2117.  
  2118.     /* now check return code */
  2119.     switch(response) {
  2120.         case normalresult:
  2121.             break;
  2122.         case quitinterp:
  2123.             done = true;
  2124.             break;
  2125.         case counterror:
  2126.             sysError("count error","in primitive");
  2127.             break;
  2128.         case typeerror:
  2129. fprintf(stderr,"primitive number %d\n", primitiveNumber);
  2130.             sysError("type error","in primitive");
  2131.             returnedObject = nilobj;
  2132.             break;
  2133.  
  2134.         default:
  2135.             sysError("unknown return code","in primitive");
  2136.             returnedObject = nilobj;
  2137.             break;
  2138.     }
  2139.     return (done);
  2140. }
  2141.  
  2142. End
  2143. echo unbundling interp.c 1>&2
  2144. cat >interp.c <<'End'
  2145. /*
  2146.     Little Smalltalk version 2
  2147.     Written by Tim Budd, Oregon State University, July 1987
  2148.  
  2149.     bytecode interpreter module
  2150.  
  2151.     execute bytecodes for a given method until one of six events occur
  2152.     1. A message must be sent to another object
  2153.     2. A message must be sent to super
  2154.     3. A return from a method occurs
  2155.     4. An explicit return from a block occurs (backs up the process chain)
  2156.     5. A block must be created
  2157.     6. A block must begin execution
  2158.  
  2159.     the global variable finalTask indicates which of the six events is to
  2160.     be performed.  Various other global variables (described in process.h)
  2161.     give other information to be used in performing the called for task.
  2162.  
  2163.     Note that the interpreter is called as part of the
  2164.     main instruction sequence (single process) and (via a primitive call)
  2165.     as part of the multi-process scheduler loop (class Scheduler, Process,
  2166.     et al)
  2167. */
  2168.  
  2169. # include <stdio.h>
  2170. # include "env.h"
  2171. # include "memory.h"
  2172. # include "names.h"
  2173. # include "process.h"
  2174. # include "interp.h"
  2175.  
  2176. extern object unSyms[], binSyms[], keySyms[];
  2177. extern boolean primitive();
  2178.  
  2179. # define nextByte byteToInt(bytecodes[byteCounter++])
  2180. # define ipush(x) incr(stack[stacktop++] = x)
  2181. /* note that ipop leaves a ref count on the popped object */
  2182. # define ipop(x)  x=stack[--stacktop]; stack[stacktop]=nilobj
  2183.  
  2184. execute(method, byteCounter, stack, stacktop, arguments, temporaries)
  2185. object method, *stack, *arguments, *temporaries;
  2186. register int byteCounter;
  2187. register int stacktop;
  2188. {
  2189.     int i, low, high;
  2190.     object receiver, *instance, *literals;
  2191.     object newobj;
  2192.     byte  *bytecodes;
  2193.     boolean done;
  2194.     double f;
  2195.  
  2196.     /* do initialization */
  2197.     receiver = arguments[0];
  2198.     if (isInteger(receiver))
  2199.         instance = (object *) 0;
  2200.     else
  2201.         instance = memoryPtr(receiver);
  2202.     bytecodes = bytePtr(basicAt(method, bytecodesInMethod));
  2203.     literals = memoryPtr(basicAt(method, literalsInMethod));
  2204.     done = false;
  2205.  
  2206.  
  2207.     while( ! done ) {
  2208.         low = (high = nextByte) & 0x0F;
  2209.         high >>= 4;
  2210.         if (high == 0) {
  2211.             high = low;
  2212.             low = nextByte;
  2213.             }
  2214. /*fprintf(stderr,"executing %d %d\n", high, low);*/
  2215.  
  2216.         switch(high) {
  2217.             case PushInstance:
  2218.                 ipush(instance[low]);
  2219.                 break;
  2220.  
  2221.             case PushArgument:
  2222.                 ipush(arguments[low]);
  2223.                 break;
  2224.  
  2225.             case PushTemporary:
  2226.                 ipush(temporaries[low]);
  2227.                 break;
  2228.  
  2229.             case PushLiteral:
  2230.                 ipush(literals[low]);
  2231.                 break;
  2232.  
  2233.             case PushConstant:
  2234.                 if (low == 3)
  2235.                     low = -1;
  2236.                 if (low < 3) {
  2237.                     ipush(newInteger(low));
  2238.                     }
  2239.                 else
  2240.                     switch(low) {
  2241.                         case 4: 
  2242.                             ipush(nilobj);
  2243.                             break;
  2244.  
  2245.                         case 5:
  2246.                             ipush(trueobj);
  2247.                             break;
  2248.  
  2249.                         case 6:
  2250.                             ipush(falseobj);
  2251.                             break;
  2252.  
  2253.                         case 7:
  2254.                             ipush(smallobj);
  2255.                             break;
  2256.  
  2257.                         default:
  2258.                     sysError("not done yet","pushConstant");
  2259.                         }
  2260.                 break;
  2261.  
  2262.             case PushGlobal:
  2263.                 newobj = nameTableLookup(globalNames, 
  2264.                     literals[low]);
  2265.                 if (newobj == nilobj) {
  2266.                     /* send message instead */
  2267.                     ipush(smallobj);
  2268.                     ipush(literals[low]);
  2269.                     argumentsOnStack = stacktop - 2;
  2270.                     messageToSend = 
  2271.                         newSymbol("cantFindGlobal:");
  2272.                     finalTask = sendMessageTask;
  2273.                     done = true;
  2274.                     }
  2275.                 else
  2276.                     ipush(newobj);
  2277.                 break;
  2278.     
  2279.             case PopInstance:
  2280.                 decr(instance[low]);
  2281.                 /* we transfer reference count to instance */
  2282.                 ipop(instance[low]);
  2283.                 break;
  2284.  
  2285.             case PopTemporary:
  2286.                 decr(temporaries[low]);
  2287.                 /* we transfer reference count to temporaries */
  2288.                 ipop(temporaries[low]);
  2289.                 break;
  2290.  
  2291.             case SendMessage:
  2292.                 argumentsOnStack = stacktop - (low + 1);
  2293.                 messageToSend = literals[nextByte];
  2294.                 finalTask = sendMessageTask;
  2295.                 done = true;
  2296.                 break;
  2297.  
  2298.             case SendUnary:
  2299.                 /* we optimize a couple common messages */
  2300.                 if (low == 0) {        /* isNil */
  2301.                     ipop(newobj);
  2302.                     if (newobj == nilobj) {
  2303.                         ipush(trueobj);
  2304.                         }
  2305.                     else {
  2306.                         decr(newobj);
  2307.                         ipush(falseobj);
  2308.                         }
  2309.                     }
  2310.                 else if (low == 1) {    /* notNil */
  2311.                     ipop(newobj);
  2312.                     if (newobj == nilobj) {
  2313.                         ipush(falseobj);
  2314.                         }
  2315.                     else {
  2316.                         decr(newobj);
  2317.                         ipush(trueobj);
  2318.                         }
  2319.                     }
  2320.                 else {
  2321.                     argumentsOnStack = stacktop - 1;
  2322.                     messageToSend = unSyms[low];
  2323.                     finalTask = sendMessageTask;
  2324.                     done = true;
  2325.                     }
  2326.                 break;
  2327.  
  2328.             case SendBinary:
  2329.                 /* optimize arithmetic as long as no */
  2330.                 /* conversions are necessary */
  2331.                 if (low <= 12) {
  2332.                     if (isInteger(stack[stacktop-1]) &&
  2333.                             isInteger(stack[stacktop-2])) {
  2334.                         ipop(newobj);
  2335.                         i = intValue(newobj);
  2336.                         ipop(newobj);
  2337.                         ignore intBinary(low, intValue(newobj), i);
  2338.                         ipush(returnedObject);
  2339.                         break;
  2340.                         }
  2341.                     if (isFloat(stack[stacktop-1]) &&
  2342.                         isFloat(stack[stacktop-2])) {
  2343.                         ipop(newobj);
  2344.                         f = floatValue(newobj);
  2345.                         decr(newobj);
  2346.                         ipop(newobj);
  2347.                         ignore floatBinary(low, floatValue(newobj), f);
  2348.                         decr(newobj);
  2349.                         ipush(returnedObject);
  2350.                         break;
  2351.                         }
  2352.                     }
  2353.                 argumentsOnStack = stacktop - 2;
  2354.                 messageToSend = binSyms[low];
  2355.                 finalTask = sendMessageTask;
  2356.                 done = true;
  2357.                 break;
  2358.  
  2359.             case SendKeyword:
  2360.                 argumentsOnStack = stacktop - 3;
  2361.                 messageToSend = keySyms[low];
  2362.                 finalTask = sendMessageTask;
  2363.                 done = true;
  2364.                 break;
  2365.  
  2366.             case DoPrimitive:
  2367.                 i = nextByte;
  2368.                 done = primitive(i, &stack[stacktop - low], low);
  2369.                 incr(returnedObject);
  2370.                 /* pop off arguments */
  2371.                 for (i = low; i > 0; i--) {
  2372.                     ipop(newobj);
  2373.                     decr(newobj);
  2374.                     }
  2375.                 if (! done) {
  2376.                     ipush(returnedObject);
  2377.                     decr(returnedObject);
  2378.                     }
  2379.                 break;
  2380.  
  2381.             case CreateBlock:
  2382.                 /* we do most of the work in making the block */
  2383.                 /* leaving it to the caller to fill in */
  2384.                 /* the context information */
  2385.                 newobj = allocObject(blockSize);
  2386.                 setClass(newobj, blockclass);
  2387.                 basicAtPut(newobj, argumentCountInBlock, newInteger(low));
  2388.                 i = (low > 0) ? nextByte : 0;
  2389.                 basicAtPut(newobj, argumentLocationInBlock, 
  2390.                     newInteger(i));
  2391.                 basicAtPut(newobj, bytecountPositionInBlock,
  2392.                     newInteger(byteCounter + 1));
  2393.                 incr(returnedObject = newobj);
  2394.                 /* avoid a subtle side effect here */
  2395.                 i = nextByte;
  2396.                 byteCounter = i;
  2397.                 finalTask = BlockCreateTask;
  2398.                 done = true;
  2399.                 break;
  2400.  
  2401.             case DoSpecial:
  2402.                 switch(low) {
  2403.                     case SelfReturn:
  2404.                         incr(returnedObject = receiver);
  2405.                         finalTask = ReturnTask;
  2406.                         done = true;
  2407.                         break;
  2408.  
  2409.                     case StackReturn:
  2410.                         ipop(returnedObject);
  2411.                         finalTask = ReturnTask;
  2412.                         done = true;
  2413.                         break;
  2414.  
  2415.                     case BlockReturn:
  2416.                         ipop(returnedObject);
  2417.                         finalTask = BlockReturnTask;
  2418.                         done = true;
  2419.                         break;
  2420.  
  2421.                     case Duplicate:
  2422.                         ipop(newobj);
  2423.                         ipush(newobj);
  2424.                         ipush(newobj);
  2425.                         decr(newobj);
  2426.                         break;
  2427.  
  2428.                     case PopTop:
  2429.                         ipop(newobj);
  2430.                         decr(newobj);
  2431.                         break;
  2432.  
  2433.                     case Branch:
  2434.                         /* avoid a subtle bug here */
  2435.                         i = nextByte;
  2436.                         byteCounter = i;
  2437.                         break;
  2438.  
  2439.                     case BranchIfTrue:
  2440.                         ipop(newobj);
  2441.                         i = nextByte;
  2442.                         if (newobj == trueobj) {
  2443.                             ++stacktop;
  2444.                             byteCounter = i;
  2445.                             }
  2446.                         decr(newobj);
  2447.                         break;
  2448.  
  2449.                     case BranchIfFalse:
  2450.                         ipop(newobj);
  2451.                         i = nextByte;
  2452.                         if (newobj == falseobj) {
  2453.                             ++stacktop;
  2454.                             byteCounter = i;
  2455.                             }
  2456.                         decr(newobj);
  2457.                         break;
  2458.  
  2459.                     case AndBranch:
  2460.                         ipop(newobj);
  2461.                         i = nextByte;
  2462.                         if (newobj == falseobj) {
  2463.                             ipush(newobj);
  2464.                             byteCounter = i;
  2465.                             }
  2466.                         decr(newobj);
  2467.                         break;
  2468.  
  2469.                     case OrBranch:
  2470.                         ipop(newobj);
  2471.                         i = nextByte;
  2472.                         if (newobj == trueobj) {
  2473.                             ipush(newobj);
  2474.                             byteCounter = i;
  2475.                             }
  2476.                         decr(newobj);
  2477.                         break;
  2478.  
  2479.                     case SendToSuper:
  2480.                         argumentsOnStack = stacktop -
  2481.                             (nextByte + 1);
  2482.                         messageToSend = 
  2483.                             literals[nextByte];
  2484.                         finalTask = sendSuperTask;
  2485.                         done = true;
  2486.                         break;
  2487.  
  2488.                     default:
  2489.                         sysError("invalid doSpecial","");
  2490.                         break;
  2491.                 }
  2492.                 break;
  2493.  
  2494.             default:
  2495.                 sysError("invalid bytecode","");
  2496.                 break;
  2497.         }
  2498.     }
  2499.  
  2500.     /* when done, save stack top and bytecode counter */
  2501.     /* before we exit */
  2502.  
  2503.     finalStackTop = stacktop;
  2504.     finalByteCounter = byteCounter;
  2505. }
  2506.  
  2507. End
  2508.