rsalz@bbn.com (Rich Salz) (02/23/88)
Submitted-by: Tim Budd <budd@MIST.CS.ORST.EDU> Posting-number: Volume 13, Issue 57 Archive-name: little-st2/part05 #!/bin/sh # # # This is version 2.02 of Little Smalltalk, distributed in five parts. # # This version is dated 12/25/87 # # Several bugs and many features and improvements have been made since the # first posting to comp.src.unix. See the file ``todo'' for a partial list. # # Comments, bug reports, and the like should be submitted to: # Tim Budd # Smalltalk Distribution # Department of Computer Science # Oregon State University # Corvallis, Oregon # 97330 # # budd@cs.orst.edu # {hp-pcd, tektronix}!orstcs!budd # # echo 'Start of small.v2, part 05 of 05:' echo 'x - Bugs' sed 's/^X//' > Bugs << '/' Xobjects are limited to size 256 X this mostly limits the text (char) size of methods - to 512 chars. X this could be fixed by changing memory.c. X Xradices other than 10 aren't implemented. X XThe parser doesn always do literal arrays correctly, in particular, I X think negation signs on numbers aren't recognized within arrays. X (should be reorganized in the parser). X Xparser should leave method text in method, so it can be edited dynamically X(does this now, but it should be an option, to save space on small Xsystems). X XThe collection hierarchy has been completely reorginized (this isn't a bug) X many of the more obscure messages are left unimplmented. X many of the abstract classes are eliminated X Bags have been eliminated (they can be replaced by lists) X collections are now magnitudes (set subset relations) X XThe basic classes are somewhat incomplete, in particular X points aren't implemented X radians are implemented (neither are trig functions) X XBytearrays are a bit odd. In particular, X converting to bytearrays gives something too big (by twice) X converting bytearrays to strings can cause bugs if the last X byte is not zero (causing non null terminated strings) X XSemaphores and processes aren't implemented yet - even in the multiprocess X version X initial experiments aren't encouraging - X they seem to be too slow. X XPROJECTS______________________________________________________________ XFor those with time on their hands and nothing to do, here is a list Xof several projects that need doing. X X1. Profiling indicates that about 45% of execution time is spent in the Xroutine ``execute'', in interp.c. Rewrite this in your favorite assembly Xlanguage to speed it up. X X2. Rewrite the memory manager. Possible changes X a. use garbage collection of some sort X b. allow big objects (bigger than 256 words) X X3. Rewrite the process manager in assembly language, permitting the X Smalltalk process stack to exist intermixed with the C X execution stack. X X4. Port to your favorite machine, making the interface fit the machine. X Make sure you send me a diff script of any changes you made, X so I can incorporate them into the next release X X5. Lots of extensions could stand implementing, such as X infinite precision numbers X semaphores and processes / echo 'x - Makefile' sed 's/^X//' > Makefile << '/' X# X# Makefile for Little Smalltalk, version 2 X# XCFLAGS = -g X XCOMMONc = memory.c names.c lex.c parser.c XCOMMONo = memory.o names.o lex.o parser.o XPARSEc = comp.c $(COMMONc) image.c XPARSEo = comp.o $(COMMONo) image.o XSTc = main.c $(COMMONc) process.c primitive.c interp.c XSTo = main.o $(COMMONo) process.o primitive.o interp.o Xclasses = basic.st unix.st mult.st munix.st test.st Xallfiles = READ_ME Bugs Makefile todo *.ms *.h *.c *.st *.ini X Xinstall: stest sunix X echo "created single process version, see docs for more info" X X# X# parse - the object image parser. X# used to build the initial object image X# Xparse: $(PARSEo) X cc -o parse $(CFLAGS) $(PARSEo) X Xparseprint: X pr *.h $(PARSEc) | lpr X Xparselint: X lint $(PARSEc) X X# X# st - the actual bytecode interpreter X# runs bytecodes from the initial image, or another image X# Xst: $(STo) X cc $(CFLAGS) -o st $(STo) -lm X Xstlint: X lint $(STc) X Xstprint: X pr *.h $(STc) | lpr X X# X# image - build the initial object image X# Xclasslpr: X pr $(classes) | lpr X Xsunix: parse st X parse basic.st unix.st X st - - <script.ini X Xmunix: parse st X parse basic.st unix.st mult.st munix.st X st - - <script.ini X Xstest: parse st X parse -s basic.st unix.st test.st X st - - <script.ini X st <test.ini X Xmtest: parse st X parse -s basic.st unix.st mult.st munix.st test.st mtest.st X st - - <script.ini X st <test.ini X X# X# include file dependencies X# Xcomp.o: env.h memory.h names.h Ximage.o: env.h memory.h names.h lex.h Xinterp.o: env.h memory.h names.h process.h interp.h Xlex.o: env.h memory.h lex.h Xmain.o: env.h memory.h names.h interp.h process.h Xmemory.o: env.h memory.h Xnames.o: env.h memory.h names.h Xparser.o: env.h memory.h names.h interp.h lex.h Xprimitive.o: env.h memory.h names.h process.h Xprocess.o: env.h memory.h names.h process.h X X# X# distribution bundles X# X Xtar: X tar cvf ../smalltalk.v2.tar . X compress -c ../smalltalk.v2.tar >../smalltalk.v2.tar.Z X Xpack: X packmail -o'small.v2' -h'head' $(allfiles) / echo 'x - comp.c' sed 's/^X//' > comp.c << '/' X/* X Little Smalltalk, version 2 X Written by Tim Budd, Oregon State University, July 1987 X X Unix specific front end for the initial object image maker X (parse utility) X*/ X X# include <stdio.h> X# include "env.h" X# include "memory.h" X# include "names.h" X Xmain(argc, argv) Xint argc; Xchar **argv; X{ FILE *fp; X int i; X boolean printit = true; X X initMemoryManager(); X X buildInitialNameTables(); X X if (argc == 1) X readFile(stdin, printit); X else X for (i = 1; i < argc; i++) { X if (argv[i][0] == '-') { X switch(argv[i][1]) { X case 's': printit = false; break; X case 'v': printit = true; break; X } X } X else { X fp = fopen(argv[i], "r"); X if (fp == NULL) { X ignore fprintf(stderr, X "can't open file %s", argv[i]); X exit(1); X } X else { X readFile(fp, printit); X ignore fclose(fp); X } X } X } X X# ifndef BINREADWRITE X fp = fopen(INITIALIMAGE, "w"); X# endif X# ifdef BINREADWRITE X fp = fopen(INITIALIMAGE, "wb"); X# endif X if (fp == NULL) sysError("error during image file open",INITIALIMAGE); X imageWrite(fp); X ignore fclose(fp); X exit(0); X} / echo 'x - interp.h' sed 's/^X//' > interp.h << '/' X/* X Little Smalltalk, version 2 X Written by Tim Budd, Oregon State University, July 1987 X*/ X/* X symbolic definitions for the bytecodes X*/ X X# define Extended 0 X# define PushInstance 1 X# define PushArgument 2 X# define PushTemporary 3 X# define PushLiteral 4 X# define PushConstant 5 X# define PushGlobal 6 X# define PopInstance 7 X# define PopTemporary 8 X# define SendMessage 9 X# define SendUnary 10 X# define SendBinary 11 X# define SendKeyword 12 X# define DoPrimitive 13 X# define CreateBlock 14 X# define DoSpecial 15 X X/* types of special instructions (opcode 15) */ X X# define SelfReturn 1 X# define StackReturn 2 X# define BlockReturn 3 X# define Duplicate 4 X# define PopTop 5 X# define Branch 6 X# define BranchIfTrue 7 X# define BranchIfFalse 8 X# define AndBranch 9 X# define OrBranch 10 X# define SendToSuper 11 / echo 'x - lex.h' sed 's/^X//' > lex.h << '/' X/* X Little Smalltalk, version 2 X Written by Tim Budd, Oregon State University, July 1987 X*/ X/* X values returned by the lexical analyzer X*/ X X# ifndef NOENUMS X Xtypedef enum tokensyms { nothing, nameconst, namecolon, X intconst, floatconst, charconst, symconst, X arraybegin, strconst, binary, closing, inputend} tokentype; X# endif X X# ifdef NOENUMS X# define tokentype int X# define nothing 0 X# define nameconst 1 X# define namecolon 2 X# define intconst 3 X# define floatconst 4 X# define charconst 5 X# define symconst 6 X# define arraybegin 7 X# define strconst 8 X# define binary 9 X# define closing 10 X# define inputend 11 X X# endif X Xextern tokentype nextToken(NOARGS); X Xextern tokentype token; /* token variety */ Xextern char tokenString[]; /* text of current token */ Xextern int tokenInteger; /* integer (or character) value of token */ Xextern double tokenFloat; /* floating point value of token */ Xextern noreturn lexinit(); /* initialization routine */ / echo 'x - main.c' sed 's/^X//' > main.c << '/' X/* X Little Smalltalk, version 2 X Written by Tim Budd, Oregon State University, July 1987 X X unix specific driver (front-end) for bytecode interpreter. X*/ X# include <stdio.h> X X# include "env.h" X# include "memory.h" X# include "names.h" X# include "interp.h" X# include "process.h" X X# ifdef STRING X# include <string.h> X# endif X# ifdef STRINGS X# include <strings.h> X# endif X# ifdef SIGNALS X# include <signal.h> X# include <setjmp.h> Xjmp_buf intenv; X# endif X# ifdef SSIGNALS X# include <signal.h> X# include <setjmp.h> Xjmp_buf intenv; X# endif X Xextern int processStackTop; Xextern object processStack[]; X X# ifdef SIGNALS Xbrkfun() { longjmp(intenv, 1); } X# endif X# ifdef SSIGNALS Xbrkfun() { longjmp(intenv, 1); } X# endif X Xmain(argc, argv) Xint argc; Xchar **argv; X{ XFILE *fp; Xchar fileName[120]; X XinitMemoryManager(); X Xif ((argc == 1) || ((argc > 1) && streq(argv[1],"-"))){ X# ifdef BINREADWRITE X fp = fopen(INITIALIMAGE,"rb"); X# endif X# ifndef BINREADWRITE X fp = fopen(INITIALIMAGE,"r"); X# endif X if (fp == NULL) X sysError("cannot read image file",INITIALIMAGE); X } Xelse { X# ifdef BINREADWRITE X fp = fopen(argv[1], "rb"); X# endif X# ifndef BINREADWRITE X fp = fopen(argv[1], "r"); X# endif X if (fp == NULL) X sysError("cannot read image file", argv[1]); X } XimageRead(fp); Xignore fclose(fp); X XinitCommonSymbols(); X Xignore fprintf(stderr,"initially %d objects\n", objcount()); X X/* now we are ready to start */ X X# ifdef SIGNALS Xignore signal(SIGINT, brkfun); Xignore setjmp(intenv); X# endif X# ifdef SSIGNALS Xignore ssignal(SIGINT, brkfun); Xignore setjmp(intenv); X# endif X Xprpush(smallobj); XsendMessage(newSymbol("commandLoop"), getClass(smallobj), 0); Xflushstack(); X Xignore fprintf(stderr,"finally %d objects\n", objcount()); X Xif (argc > 2) { X if (streq(argv[2],"-")) X ignore strcpy(fileName, INITIALIMAGE); X else X ignore strcpy(fileName, argv[2]); X# ifdef BINREADWRITE X fp = fopen(fileName,"wb"); X# endif X# ifndef BINREADWRITE X fp = fopen(fileName,"w"); X# endif X if (fp == NULL) X sysError("cannot write image file",fileName); X else { X ignore fprintf(stderr,"creating image file %s\n", fileName); X imageWrite(fp); X ignore fclose(fp); X } X } Xexit(0); X} / echo 'x - mtest.st' sed 's/^X//' > mtest.st << '/' X* X* tests for multiprocessing system X* XDeclare Mtest Test XDeclare Future Object result sem XInstance Mtest test XClass Mtest X all X super all. X 'all multiprocessing tests passed' print. X| X future | a f | X a <- List new. X f <- Future new; eval: [(1 to: 100) do: [:x | nil]. X a addLast: 2. 3]. X a addLast: 1. X a addLast: f value. X (a asArray = #(1 2 3)) X ifFalse: [ smalltalk error: 'future error']. X 'future test passed' print X] XClass Future X new X sem <- Semaphore new; set: 0 X| X eval: aBlock X [ result <- aBlock value. sem signal ] fork X| X value X sem wait. X sem signal. X ^ result X] X / echo 'x - mult.st' sed 's/^X//' > mult.st << '/' X* X* Little Smalltalk, version 2 X* Written by Tim Budd, Oregon State University, July 1987 X* X* multiprocess scheduler - this is optional X* XDeclare Interpreter Object context prev creating stack stackTop byteCodePointer XDeclare Process Object interpreter yield XDeclare Scheduler Object processList atomic currentProcess XDeclare Semaphore Object count processList XInstance Scheduler scheduler XClass Block X newProcess X ^ (context newInterpreter: bytecodeCounter) newProcess X| X fork X self newProcess resume X] XClass Context X newInterpreter: start X ^ Interpreter new; X context: self; X byteCounter: start; X stack: (Array new: 20) X] XClass Interpreter X new X stackTop <- 0. X byteCodePointer <- 0 X| X execute X ^ <19 self> X| X byteCounter: start X byteCodePointer <- start X| X context: value X context <- value X| X stack: value X stack <- value. X| X newProcess X ^ Process new; interpreter: self X] XClass Method X executeWith: arguments X ( ( Context new ; method: self ; X temporaries: ( Array new: temporarySize) ; X arguments: arguments ) newInterpreter: 0 ) X newProcess resume X] XClass Process X execute | i | X yield <- true. X i <- 0. X [ interpreter notNil and: [ yield ]] X whileTrue: [ interpreter <- interpreter execute. X i <- i + 1. X (i > 200) ifTrue: [yield <- false ]]. X (interpreter isNil) X ifTrue: [ self terminate ] X| X interpreter: value X interpreter <- value X| X resume X scheduler addProcess: self X| X terminate X scheduler removeProcess: self X| X yield X yield <- false X] XClass Scheduler X new X processList <- Set new. X atomic <- false X| X addProcess: aProcess X processList add: aProcess X| X critical: aBlock X atomic <- true. X aBlock value. X atomic <- false X| X currentProcess X ^ currentProcess X| X removeProcess: aProcess X processList remove: aProcess X| X run X [ processList size ~= 0 ] whileTrue: X [ processList do: X [ :x | currentProcess <- x. X [ x execute. atomic ] whileTrue ] ] X] XClass Semaphore X new X count <- 0. X processList <- List new X| X critical: aBlock X self wait. X aBlock value. X self signal X| X set: aNumber X count <- aNumber X| X signal X (processList size = 0) X ifTrue: [ count <- count + 1] X ifFalse: [ scheduler critical: X [ processList first resume. X processList removeFirst ]] X| X wait | process | X (count = 0) X ifTrue: [ scheduler critical: X [ process <- scheduler currentProcess. X processList add: process. X scheduler removeProcess: process]. X scheduler currentProcess yield ] X ifFalse: [ count <- count - 1] X] / echo 'x - munix.st' sed 's/^X//' > munix.st << '/' X* X* Little Smalltalk, version 2 X* Written by Tim Budd, Oregon State University, July 1987 X* X* unix specific routines for the multiprocess front end X* X* XClass Smalltalk X commandLoop | string | X self openFiles. X scheduler new. X [ string <- stdin getPrompt: '> '. string notNil ] X whileTrue: [ (string size strictlyPositive) X ifTrue: [ self doIt: string ] ] X| X doIt: aString | method | X method <- Method new. X method text: ( 'proceed ', aString ). X (method compileWithClass: Object) X ifTrue: [ method executeWith: #( 1 ). X scheduler run ] X| X error: aString | process | X stderr print: 'Error: ', aString. X scheduler critical: X [ process <- scheduler currentProcess. X scheduler removeProcess: process]. X " flush out current process " X scheduler currentProcess yield. X " could we do traceback here?" X] / echo 'x - names.h' sed 's/^X//' > names.h << '/' X/* X Little Smalltalk, version 2 X Written by Tim Budd, Oregon State University, July 1987 X*/ X/* X names and sizes of internally object used internally in the system X*/ X X# define classSize 6 X# define nameInClass 1 X# define sizeInClass 2 X# define methodsInClass 3 X# define superClassInClass 4 X# define variablesInClass 5 X X# define methodSize 6 X# define textInMethod 1 X# define messageInMethod 2 X# define bytecodesInMethod 3 X# define literalsInMethod 4 X# define stackSizeInMethod 5 X# define temporarySizeInMethod 6 X X# define contextSize 6 X# define methodInContext 1 X# define methodClassInContext 2 X# define argumentsInContext 3 X# define temporariesInContext 4 X X# define blockSize 6 X# define contextInBlock 1 X# define argumentCountInBlock 2 X# define argumentLocationInBlock 3 X# define bytecountPositionInBlock 4 X# define creatingInterpreterInBlock 5 X X# define InterpreterSize 6 X# define contextInInterpreter 1 X# define previousInterpreterInInterpreter 2 X# define creatingInterpreterInInterpreter 3 X# define stackInInterpreter 4 X# define stackTopInInterpreter 5 X# define byteCodePointerInInterpreter 6 X Xextern object nameTableLookup(OBJ X OBJ); X X# define globalSymbol(s) nameTableLookup(globalNames, newSymbol(s)) X Xextern object trueobj; /* the pseudo variable true */ Xextern object falseobj; /* the pseudo variable false */ Xextern object smallobj; /* the pseudo variable smalltalk */ Xextern object blockclass; /* the class ``Block'' */ Xextern object contextclass; /* the class ``Context'' */ Xextern object intclass; /* the class ``Integer'' */ Xextern object intrclass; /* the class ``Interpreter'' */ Xextern object symbolclass; /* the class ``Symbol'' */ Xextern object stringclass; /* the class ``String'' */ X Xextern object getClass(OBJ); /* get class of an object */ Xextern object newSymbol(STR); /* new smalltalk symbol */ Xextern object newArray(INT); /* new array */ Xextern object newStString(STR); /* new smalltalk string */ Xextern object newFloat(FLOAT); /* new floating point number */ Xextern noreturn initCommonSymbols(); /* common symbols */ / echo 'x - process.h' sed 's/^X//' > process.h << '/' X/* X Little Smalltalk, version 2 X Written by Tim Budd, Oregon State University, July 1987 X*/ X/* X constants and types used by process manager. X See process.c and interp.c for more details. X*/ X/* X if there are no enumerated types, make tasks simply integer constants X*/ X# ifdef NOENUMS X# define taskType int X X# define sendMessageTask 1 X# define sendSuperTask 2 X# define ReturnTask 3 X# define BlockReturnTask 4 X# define BlockCreateTask 5 X# define ContextExecuteTask 6 X X#endif X X# ifndef NOENUMS X Xtypedef enum {sendMessageTask, sendSuperTask, ReturnTask, BlockReturnTask, X BlockCreateTask, ContextExecuteTask} taskType; X X# endif X Xextern int finalStackTop; /* stack top when finished with interpreter */ Xextern int finalByteCounter; /* bytecode counter when finished with interpreter */ Xextern int argumentsOnStack; /* position of arguments on stack for mess send */ Xextern object messageToSend; /* message to send */ Xextern object returnedObject; /* object returned from message */ Xextern taskType finalTask; /* next task to do (see below) */ Xextern object creator; X X Xextern noreturn sendMessage(OBJ X OBJ X INT); Xextern noreturn prpush(OBJ); / echo 'x - test.st' sed 's/^X//' > test.st << '/' X* X* X* Little Smalltalk, version 2 X* Written by Tim Budd, Oregon State University, July 1987 X* X* a few test cases. X* invoke by messages to global variable ``test'', i.e. X* test collection X* X* all test cases can be run by sending the message all to test X* test all X* XDeclare Test Object XDeclare One Object XDeclare Two One XDeclare Three Two XDeclare Four Three XInstance Test test XClass One X test X ^ 1 X| X result1 X ^ self test X] XClass Two X test X ^ 2 X] XClass Three X result2 X ^ self result1 X| X result3 X ^ super test X] XClass Four X test X ^ 4 X] XClass Test X all X self super. X self conversions. X self collections. X self factorial. X self filein. X 'all tests completed' print X| X conversions X " test a few conversion routines " X ( (#abc == #abc asString asSymbol) and: [ X ($A == $A asInteger asCharacter) and: [ X (12 == 12 asDigit digitValue) and: [ X (237 == 237 asString asInteger) and: [ X (43 = 43 asFloat truncated) and: [ X $A == ($A asString at: 1) ] ] ] ] ] ) X ifFalse: [^ smalltalk error: 'conversion failure']. X 'conversion test passed' print. X| X collections X " test the collection classes a little" X ( (#(1 2 3 3 2 4 2) asSet = #(1 2 3 4) asSet) and: [ X (#(1 5 3 2 4) sort asArray = #(1 2 3 4 5)) and: [ X ((#+ respondsTo occurrencesOf: Float) = 1) and: [ X ('First' < 'last') ] ] ] ) X ifFalse: [^smalltalk error: 'collection failure']. X 'collection test passed' print. X| X factorial | t | X t <- [:x | (x = 1) ifTrue: [ 1 ] X ifFalse: [ x * (t value: x - 1) ] ]. X ((t value: 5) = 5 factorial) X ifFalse: [ smalltalk error: 'factorial failure']. X 'factorial test passed' print X X| X filein X File new; name: 'queen.st'; open: 'r'; fileIn. X (globalNames includesKey: #Queen ) X ifFalse: [ smalltalk error: 'fileIn failure']. X 'file in test passed' print. X self queen X| X super2 | x1 x2 x3 x4 | X x1 <- One new. X x2 <- Two new. X x3 <- Three new. X x4 <- Four new. X ^ List new; addLast: x1 test; X addLast: x1 result1; X addLast: x2 test; X addLast: x2 result1; X addLast: x3 test; X addLast: x4 result1; X addLast: x3 result2; X addLast: x4 result2; X addLast: x3 result3; X addLast: x4 result3 X| X super X (self super2 asArray = #(1 1 2 2 2 4 2 4 2 2) ) X ifTrue: ['super test passed' print] X ifFalse: [ smalltalk error: 'super test failed'] X] / echo 'Part 05 of small.v2 complete.' exit -- For comp.sources.unix stuff, mail to sources@uunet.uu.net.