earlw@pesnta.UUCP (Earl Wallace) (06/12/85)
#! /bin/sh # # This is the Little Smalltalk program that Marc Ries of the P-E Tustin Office # acquired and passed on to me. It should work with Perkin-Elmer's Edition VII # and XELOS systems. # # -earlw@pesnta # #! /bin/sh # This is a shell archive, meaning: # 1. Remove everything above the #! /bin/sh line. # 2. Save the resulting text in a file. # 3. Execute the file with /bin/sh (not csh) to create the files: # Makefile # READ_ME # disclaim # bin # symbols # parser # newsletters # tests # This archive created: Tue Jun 11 19:05:25 1985 # By: Earl Wallace (Perkin-Elmer Data Systems Group / Customer Service) export PATH; PATH=/bin:$PATH if test -f 'Makefile' then echo shar: will not over-write existing file "'Makefile'" else cat << \SHAR_EOF > 'Makefile' install: @echo "Installing Little Smalltalk System" cd parser ; make install cd sources ; make install cd prelude ; make install cd tests ; make install clean: cd sources; make clean cd parser; make clean shar: @echo shar started... shar -c Makefile READ_ME disclaim bin symbols \ parser newsletters tests > lst.1 shar -c sources > lst.2 shar -c prelude > lst.3 shar -c projects > lst.4 shar -c docs > lst.5 @echo shar completed. tartape: tar cv Makefile unbundle *.bundle projects newsletters 800tartape: tar cvf /dev/rmt0 Makefile unbundle *.bundle projects newsletters gone: @echo "WARNING: You just tried to delete all files!" @echo " If you want to do that use: rm -rf *" SHAR_EOF if test 785 -ne "`wc -c < 'Makefile'`" then echo shar: error transmitting "'Makefile'" '(should have been 785 characters)' fi fi # end of overwriting check if test -f 'READ_ME' then echo shar: will not over-write existing file "'READ_ME'" else cat << \SHAR_EOF > 'READ_ME' NOTE: * Origional XELOS directory was /u/smalltalk/... Grep sources for reference to hard-coding and modify as appropriate * Compiled XELOS objects in ../bin need be moved to an accessible path * Documentation is in ../docs. Unfortunately, macros are for the "ms" set and Makefile is geared for itroff and ditroff. * It works so far! Marc Ries June 1985 SHAR_EOF if test 380 -ne "`wc -c < 'READ_ME'`" then echo shar: error transmitting "'READ_ME'" '(should have been 380 characters)' fi fi # end of overwriting check if test -f 'disclaim' then echo shar: will not over-write existing file "'disclaim'" else cat << \SHAR_EOF > 'disclaim' /* The source code for the Little Smalltalk System may be freely copied provided that the source of all files is acknowledged and that this condition is copied with each file. The Little Smalltalk System is distributed without responsibility for the performance of the program and without any guarantee of maintenance. All questions concerning Little Smalltalk should be addressed to: Professor Tim Budd Department of Computer Science The University of Arizona Tucson, Arizona 85721 USA */ SHAR_EOF if test 512 -ne "`wc -c < 'disclaim'`" then echo shar: error transmitting "'disclaim'" '(should have been 512 characters)' fi fi # end of overwriting check if test ! -d 'bin' then mkdir 'bin' fi cd 'bin' cd .. if test -f 'symbols' then echo shar: will not over-write existing file "'symbols'" else cat << \SHAR_EOF > 'symbols' ! & ( ) * + , - / // < <= = == > >= @ Array ArrayedCollection BLOCKED Bag Block Boolean ByteArray Char Class Collection Complex Dictionary False File Float Integer Interpreter Interval KeyedCollection List Little Smalltalk Magnitude Main Number Object OrderedCollection Point Process READY Radian Random SUSPENDED Semaphore SequenceableCollection Set Smalltalk String Symbol TERMINATED True UndefinedObject [ \\ \\\\ ] ^ abs add: add:after: add:before: add:withOccurrences: addAll: addAllFirst: addAllLast: addFirst: addLast: after: allMask: and: anyMask: arcCos arcSin arcTan argerror asArray asBag asCharacter asDictionary asFloat asFraction asInteger asList asLowercase asOrderedCollection asSet asString asSymbol asUppercase asciiValue at: at:ifAbsent: at:put: atAll:put: atAllPut: before: between:and: binaryDo: bitAnd: bitAt: bitInvert bitOr: bitShift: bitXor: block blockedProcessQueue ceiling checkBucket: class cleanUp coerce: collect: commands: compareError copy copyArguments: copyArguments:to: copyFrom: copyFrom:length: copyFrom:to: copyWith: copyWithout: cos count currAssoc currBucket current currentBucket currentKey currentList date debug: deepCopy deepCopy: detect: detect:ifAbsent: detect:ifNone: dict dictionary digitValue digitValue: display displayAssign dist: do: doPrimitive: doPrimitive:withArguments: edit equals:startingAt: eqv: error: even excessSignals executeWith: exp factorial findAssociation:inList: findFirst: findFirst:ifAbsent: findLast findLast: findLast:ifAbsent: first firstKey floor floorLog: fork forkWith: fractionPart free: from: from:to: from:to:by: gamma gcd: getList: grid: hashNumber: hashTab hashTable highBit i ifFalse: ifFalse:ifTrue: ifTrue: ifTrue:ifFalse: inRange: includes: includesKey: indexOf: indexOf:ifAbsent: indexOfSubCollection:startingAt: indexOfSubCollection:startingAt:ifAbsent: init: init:super: init:super:numVars: inject:into: integerPart isAlphaNumeric isDigit isEmpty isKindOf: isLetter isLowercase isMemberOf: isNil isSeparator isUppercase isVowel keys keysDo: keysSelect: last lastKey lcm: list ln log: lower main max: maxContext: maxtype: methods: min: modeCharacter modeInteger modeString name: negated negative new new: newProcess newProcessWith: next next: noDisplay noMask: not notNil nothing occurrencesOf: odd opError open: open:for: or: perform: perform:withArguments: pi positive print printString put: quo: radians radix: raisedTo: raisedToInteger: randInteger: randomize read reciprocal reject: rem: remove: remove:ifAbsent: removeAll: removeError removeFirst removeKey: removeKey:ifAbsent: removeLast removed replaceFrom:to:with: replaceFrom:to:with:startingAt: respondsTo respondsTo: resume reverseDo: reversed roundTo: rounded sameAs: seed select: setCurrentLocation: sh: shallowCopy shallowCopy: sign signal sin size smalltalk sort sort: sqrt squared state step strictlyPositive superClass superClass: suspend tan temp termErr: terminate time: timesRepeat: to: to:by: transpose truncateTo: truncated truncatedGrid: unblock upper value value: value:value: value:value:value: value:value:value:value: value:value:value:value:value: values variables variables: view wait whileFalse: whileTrue: with:do: withArguments: write: x x: xor: xvalue y y: yield yvalue | ~ ~= ~~ SHAR_EOF if test 3253 -ne "`wc -c < 'symbols'`" then echo shar: error transmitting "'symbols'" '(should have been 3253 characters)' fi fi # end of overwriting check if test ! -d 'parser' then mkdir 'parser' fi cd 'parser' if test -f 'parser.y' then echo shar: will not over-write existing file "'parser.y'" else cat << \SHAR_EOF > 'parser.y' /* Little Smalltalk Class method syntax differs from smalltalk-80 slightly class heading is different vertical bar must appear between methods syntax for primitives is different */ /* literals */ %token LITNUM LITFNUM LITCHAR LITSTR LITSYM /* basic objects */ %token CLASS ASSIGN BINARY PRIMITIVE /* types of variables */ %token PSEUDO UPPERCASEVAR LOWERCASEVAR COLONVAR KEYWORD /* one character symbols */ %token LP RP LB RB PERIOD BAR MBAR SEMI UPARROW PS MINUS PE /* ( ) [ ] . | ^| ; ^ # - > */ %{ # include "env.h" # include "drive.h" # include "parser.h" %} %union { struct litlist *a; struct blockstruct *b; char *c; struct exprstruct *e; int i; struct keylist *k; struct classstruct *l; struct methodstruct *m; struct objstruct *o; enum pseuvars p; struct primlist *r; struct statestruct *s; struct litstruct *t; struct primstruct *u } %{ extern struct blockstruct *mkblock(); extern struct classstruct *mkclass(); extern struct varstruct *mkvar(), *addvlist(), *invlist(); extern struct methodstruct *mkmethod(); extern struct exprstruct *mkexpr(), *mkkey(); extern struct keylist *mkklist(); extern struct statestruct *mkstate(); extern struct objstruct *mkobj(); extern struct primstruct *mkprim(); extern struct primlist *addprim(); extern struct litstruct *mklit(); extern struct litlist *addlit(); extern char *bincat(); struct varstruct *instvars; struct varstruct *contextvars; int bytetop = 0; uchar bytearray[1000]; YYSTYPE e; int errorcount = 0; %} %type <a> litarray %type <b> block %type <c> CLASS KEYWORD LOWERCASEVAR UPPERCASEVAR COLONVAR LITSYM LITSTR %type <c> BINARY BAR MINUS UPARROW PE %type <c> classname binarysym binarychar %type <c> LITFNUM fliteral %type <e> pattern expression cexpression binary unary %type <e> kcontinuation bcontinuation ucontinuation %type <i> LITCHAR LITNUM PRIMITIVE %type <i> tempvars cvarlist namelist barglist nliteral %type <k> keypattern keywordlist %type <l> super classheading %type <m> method methodlist %type <o> primary %type <p> PSEUDO %type <r> objlist %type <s> statelist statement sexpression opmessagelist %type <s> bstatelist bstatement bexpression %type <t> literal iliteral aliteral %type <u> primitive %start file %% file : classdef | file classdef ; classdef: classheading lb methodlist RB {if (errorcount == 0) genclass($1, $3);} ; lb : LB | error {if ((yytext[0] == ':') || isalpha(yytext[0])) expect(":SuperClass"); else expect("open brace [");} ; classheading: class super instancevars {$$ = $2;} ; class : CLASS | error {expect("keyword Class");} ; super : classname {$$ = mkclass($1, (char *) 0);} | classname COLONVAR {$$ = mkclass($1, $2);} | error {expect("Classname :Superclass"); $$ = mkclass("Error", (char *) 0);} ; classname: UPPERCASEVAR | CLASS ; instancevars: /* empty */ | bar instvarlist bar ; instvarlist: LOWERCASEVAR {addinst($1);} | instvarlist LOWERCASEVAR {addinst($2);} | error {expect("instance variable");} ; methodlist: method | methodlist MBAR method {$3->nextmethod = $1; $$ = $3;} ; method : pattern tempvars statelist op {deltemps($2); $$ = mkmethod($1, $2, $3);} ; pattern: keypattern {$$ = mkkey((struct exprstruct *) 0, $1);} | binarysym argvariable {$$ = mkexpr((struct exprstruct *) 0, bincmd, $1, (struct exprstruct *) 0);} | LOWERCASEVAR {$$ = mkexpr((struct exprstruct *) 0, uncmd, $1, (struct exprstruct *) 0);} | error {expect("method pattern"); $$ = mkexpr((struct exprstruct *) 0, uncmd, "", (struct exprstruct *) 0);} ; keypattern: KEYWORD argvariable {$$ = mkklist((struct keylist *) 0, $1, (struct exprstruct *) 0);} | keypattern KEYWORD argvariable {$$ = mkklist($1, $2, (struct exprstruct *) 0);} ; argvariable: LOWERCASEVAR {addtemp($1, argvar);} | error {expect("argument variable");} ; tempvars: /* empty */ {$$ = 0;} | bar namelist bar {$$ = $2;} ; bar : BAR | MBAR | error {expect("| (vertical bar)");} ; namelist: tvariable {$$ = 1;} | namelist tvariable {$$ = $1 + 1;} ; tvariable: LOWERCASEVAR {addtemp($1, tempvar);} ; statelist: statement {$$ = $1;} | statelist PERIOD statement {$3->nextstate = $1; $$ = $3;} ; op : /* empty - optional period */ | PERIOD ; statement: UPARROW sexpression {$$ = mkstate(upar, (char *) 0, $2);} | sexpression ; sexpression: LOWERCASEVAR ASSIGN sexpression {$$ = mkstate(asgn, $1, $3);} | cexpression {$$ = mkstate(expr, (char *) 0, (struct statestruct *) $1);} ; cexpression: expression | kcontinuation {$$ = mkexpr($1, semiend, 0, 0);} ; kcontinuation: bcontinuation | bcontinuation keywordlist {$$ = mkkey($1, $2);} ; bcontinuation: ucontinuation | bcontinuation binarysym unary {$$ = mkexpr($1, bincmd, $2, $3);} ; ucontinuation: cexpression SEMI {$$ = mkexpr($1, semistart, 0, 0);} | ucontinuation LOWERCASEVAR {$$ = mkexpr($1, uncmd, $2, (struct exprstruct *) 0);} ; expression: binary {$$ = $1;} | binary keywordlist {$$ = mkkey($1, $2);} ; keywordlist: KEYWORD binary {$$ = mkklist((struct keylist *) 0, $1, $2);} | keywordlist KEYWORD binary {$$ = mkklist($1, $2, $3);} ; binary : unary {$$ = $1;} | binary binarysym unary {$$ = mkexpr($1, bincmd, $2, $3);} ; binarysym: binarychar {$$ = $1;} | binarychar binarychar {$$ = bincat($1, $2);} ; binarychar: BINARY | BAR | MINUS | UPARROW | PE ; unary : primary {$$ = mkexpr((struct exprstruct *) 0, reccmd, (char *) 0, (struct exprstruct *) $1);} | unary LOWERCASEVAR {$$ = mkexpr($1, uncmd, $2, (struct exprstruct *) 0);} ; primary : classname {e.c = $1; $$ = mkobj(classobj, &e);} | LOWERCASEVAR {e.c = $1; $$ = mkobj(varobj, &e);} | literal {e.t = $1; $$ = mkobj(litobj, &e);} | PSEUDO {e.p = $1; $$ = mkobj(pseuobj, &e);} | primitive {e.u = $1; $$ = mkobj(primobj, &e);} | LP sexpression RP {e.s = $2; $$ = mkobj(exprobj, &e);} | block {e.b = $1; $$ = mkobj(blockobj, &e);} ; primitive: PRIMITIVE LITNUM objlist PE {$$ = mkprim($2, $3);} ; objlist : /* empty */ {$$ = (struct primlist *) 0;} | objlist primary {$$ = addprim($1, $2);} ; block : LB barglist opmessagelist RB {$$ = mkblock($2, $3); deltemps($2);} ; barglist : /* empty */ {$$ = 0;} | cvarlist BAR {$$ = $1;} ; cvarlist: COLONVAR {addtemp($1, argvar); $$ = 1;} | cvarlist COLONVAR {addtemp($2, argvar); $$ = $1 + 1;} ; opmessagelist: bstatelist bstatement {$2->nextstate = $1; $$ = $2;} | bstatement {$$ = $1;} ; bstatement: UPARROW sexpression {$$ = mkstate(blkupar, (char *) 0, $2);} | bexpression {$$ = mkstate(upar, (char *) 0, $1);} ; bexpression: /* empty */ {e.p = nilvar; $$ = mkstate(expr, (char *) 0, (struct statestruct *) mkexpr((struct exprstruct *) 0, reccmd, (char *) 0, (struct exprstruct *) mkobj(pseuobj, &e)));} | sexpression {$$ = $1;} ; bstatelist: sexpression PERIOD {$$ = $1;} | bstatelist sexpression PERIOD {$2->nextstate = $1; $$ = $2;} ; literal : iliteral {$$ = $1;} | alitstart litarray RP {e.a = $2; $$ = mklit(arlit, &e);} ; alitstart: PS LP ; iliteral: fliteral {e.c = $1; $$ = mklit(fnumlit, &e);} | nliteral {e.i = $1; $$ = mklit(numlit, &e);} | LITCHAR {e.i = $1; $$ = mklit(charlit, &e);} | LITSTR {e.c = $1; $$ = mklit(strlit, &e);} | LITSYM {e.c = $1; $$ = mklit(symlit, &e);} | PS LB bytearray RB {bytearray[bytetop] = '\0'; $$ = mklit(bytelit, &e);} ; fliteral: LITFNUM {$$ = $1;} | MINUS LITFNUM {$$ = bincat("-", $2);} ; nliteral: LITNUM {$$ = $1;} | MINUS LITNUM {$$ = - $2;} ; aliteral: iliteral {$$ = $1;} | LOWERCASEVAR {e.c = $1; $$ = mklit(symlit, &e);} | UPPERCASEVAR {e.c = $1; $$ = mklit(symlit, &e);} | KEYWORD {e.c = $1; $$ = mklit(symlit, &e);} | COLONVAR {e.c = $1; $$ = mklit(symlit, &e);} | CLASS {e.c = $1; $$ = mklit(symlit, &e);} | binarysym {e.c = $1; $$ = mklit(symlit, &e);} | ias litarray RP {e.a = $2; $$ = mklit(arlit, &e);} ; ias : PS LP | LP ; litarray: /* empty */ {$$ = (struct litlist *) 0;} | litarray aliteral {$$ = addlit($1, $2);} ; bytearray: LITNUM {bytetop = 0; bytearray[bytetop++] = itouc($1);} | bytearray LITNUM {bytearray[bytetop++] = itouc($2);} ; %% # include <stdio.h> char *filename; FILE *fp; FILE *ofd; # include "lex.yy.c" main(argc, argv) int argc; char **argv; { if (argc != 2) quiter("parser: wrong number of arguments"); filename = argv[1]; fp = fopen(filename, "r"); if (fp == NULL) { yerr("cannot open input file %s", filename); quiter("parser quits"); } ofd = stdout; return(yyparse()); } quiter(s) char *s; {fprintf(stderr,"%s\n", s); exit(1);} yywarn(s, v) char *s, *v; { fprintf(stderr, "%s: line %d: Warning ", filename, linenum); fprintf(stderr, s, v); fprintf(stderr,"\n"); } yyerror(s) char *s; {yerr(s, "");} yerr(s, v) char *s, *v; { fprintf(stderr, "%s: line %d: ", filename, linenum); fprintf(stderr, s, v); fprintf(stderr,"\n"); if (errorcount++ > 10) quiter("too many errors, goodby"); } expect(str) char *str; { char buffer[100]; sprintf(buffer,"Expected %%s found %s", yytext); yerr(buffer, str); } int yywrap() { return(1);} char *alloc(size) int size; /* allocate a block of storage */ { char *p, *malloc(); p = malloc( (unsigned) size); if (p == (char *) 0) yyerror("out of free space"); return(p); } char *bincat(s1, s2) char *s1, *s2; { char *p; p = alloc(strlen(s1) + strlen(s2) + 1); strcpy(p, s1); strcat(p, s2); return(p); } SHAR_EOF if test 11138 -ne "`wc -c < 'parser.y'`" then echo shar: error transmitting "'parser.y'" '(should have been 11138 characters)' fi fi # end of overwriting check if test -f 'parser.lex' then echo shar: will not over-write existing file "'parser.lex'" else cat << \SHAR_EOF > 'parser.lex' %{ /* Little Smalltalk lexical analyzer */ # include <math.h> # undef input # undef unput double atof(); int linenum = 1; %} %% [ \t]+ {;} \n {linenum++;} \" {readcomment();} ":=" {return(ASSIGN);} "<-" {return(ASSIGN);} Class {return(lexsave(CLASS));} self {yylval.p = selfvar; return(PSEUDO);} selfProcess {yylval.p = procvar; return(PSEUDO);} super {yylval.p = supervar; return(PSEUDO);} nil {yylval.p = nilvar; return(PSEUDO);} true {yylval.p = truevar; return(PSEUDO);} false {yylval.p = falsevar; return(PSEUDO);} smalltalk {yylval.p = smallvar; return(PSEUDO);} \$. {yylval.i = yytext[1]; return(LITCHAR);} # {return(PS);} [0-9]+r-?[0-9A-Z]+(\.[0-9A-Z]+)?(e[-+]?[0-9]+)? {return(lexsave(LITFNUM));} [0-9]+ {yylval.i = atoi(yytext); return(LITNUM);} [0-9]+(\.[0-9]+)?(e[-+]?[0-9]+)? {return(lexsave(LITFNUM));} '[^']*' {char c; unput(c = input()); if (c == '\'') yymore(); else return(lexlstr());} [a-zA-Z0-9]+:? {return(varlex());} :[a-zA-Z0-9]+ {return(slexsave(COLONVAR));} #[^ \t\n.()\[]+ {return(slexsave(LITSYM));} "-" {return(lexsave(MINUS));} "(" {return(LP);} ")" {return(RP);} "[" {return(LB);} "]" {return(RB);} "." {return(PERIOD);} ^"|" {return(lexsave(MBAR));} ^"!" {return(lexsave(MBAR));} "|" {return(lexsave(BAR));} "!" {return(lexsave(BAR));} ";" {return(SEMI);} "^" {return(lexsave(UPARROW));} ">" {return(lexsave(PE));} [^ \t\nA-Za-z0-9] {return(lexsave(BINARY));} "<primitive" {return(PRIMITIVE);} %% static int ocbuf = 0; static int pbbuf[400]; static int input() { int c; if (ocbuf) {c = pbbuf[--ocbuf]; } else { c = getc(fp); if (c == EOF) c = 0; } return(c); } static unput(c) char c; { if (c) pbbuf[ocbuf++] = c; } # include <ctype.h> static readcomment() { char c; while ((c = input()) && c != '\"') if (c == '\n') linenum++; if (!c) yyerror("unterminated comment"); } char *walloc(s) char *s; { char *p, *malloc(); p = malloc((unsigned) (strlen(s) + 1)); if (p == (char *) 0) yyerror("out of variable string space"); strcpy(p, s); return(p); } static int slexsave(type) int type; { yylval.c = walloc(&yytext[1]); if (yylval.c == 0) yerr("cannot create symbol %s", yytext); return(type); } static int lexsave(type) int type; { yylval.c = walloc(yytext); if (yylval.c == 0) yerr("cannot create string %s", yytext); return(type); } static int varlex() { lexsave(0); if (yytext[yyleng-1] == ':') return(KEYWORD); else if (islower(yytext[0])) return(LOWERCASEVAR); else return(UPPERCASEVAR); } static int lexlstr() { char *p, *q; yylval.c = p = walloc(&yytext[1]); *(p + yyleng -2) = '\0'; return(LITSTR); } SHAR_EOF if test 3484 -ne "`wc -c < 'parser.lex'`" then echo shar: error transmitting "'parser.lex'" '(should have been 3484 characters)' fi fi # end of overwriting check if test -f 'parse1.c' then echo shar: will not over-write existing file "'parse1.c'" else cat << \SHAR_EOF > 'parse1.c' /* Little Smalltalk pass 1 of the parser timothy a. budd, 10/84 */ /* The source code for the Little Smalltalk System may be freely copied provided that the source of all files is acknowledged and that this condition is copied with each file. The Little Smalltalk System is distributed without responsibility for the performance of the program and without any guarantee of maintenance. All questions concerning Little Smalltalk should be addressed to: Professor Tim Budd Department of Computer Science The University of Arizona Tucson, Arizona 85721 USA */ # include <stdio.h> # include "env.h" # include "drive.h" # include "parser.h" # include "y.tab.h" extern char *alloc(); int maxcontext = 0; struct classstruct *mkclass(classname, supername) char *classname, *supername; { struct classstruct *new; struct varstruct *mkvar(), *addvlist(); new = structalloc(classstruct); new->name = classname; if (supername) new->super = supername; else new->super = walloc("Object"); instvars = (struct varstruct *) 0; contextvars = (struct varstruct *) 0; maxcontext = 0; addtemp("_self", (enum vartypes) 0); return(new); } struct varstruct *mkvar(text, vtype) char *text; enum vartypes vtype; { struct varstruct *p; p = structalloc(varstruct); p->vtype = vtype; p->text = text; p->nextvar = (struct varstruct *) 0; p->position = 17; return(p); } struct varstruct *addvlist(varnode, vlist) struct varstruct *varnode, *vlist; { varnode->nextvar = vlist; if (vlist) varnode->position = 1 + vlist->position; else varnode->position = 0; return(varnode); } addtemp(name, vtype) char *name; enum vartypes vtype; { contextvars = addvlist(mkvar(name, vtype), contextvars); if (contextvars->position > maxcontext) maxcontext = contextvars->position; } struct varstruct *invlist(varnode, name) struct varstruct *varnode; char *name; { for ( ; varnode; varnode = varnode->nextvar) if (strcmp(varnode->text, name) == 0) return(varnode); return((struct varstruct *) 0); } struct methodstruct *mkmethod(pat, temps, state) struct exprstruct *pat; int temps; struct statestruct *state; { struct methodstruct *new; int i; new = structalloc(methodstruct); new->pattern = pat; new->numtempvars = temps; new->states = state; new->nextmethod = (struct methodstruct *) 0; switch(pat->cmdtype) { case uncmd: i = 0; break; case bincmd: i = 1; break; case keycmd: i = keycount(pat->cc.keys); break; } deltemps(i); return(new); } keycount(kl) struct keylist *kl; { if (kl->nextkey) return(1 + keycount(kl->nextkey)); else return(1); } struct statestruct *mkstate(type, name, sexpr) enum statetypes type; char *name; struct statestruct *sexpr; { struct statestruct *new; struct varstruct *v; new = structalloc(statestruct); new->statetype = type; new->nextstate = (struct statestruct *) 0; switch(type) { case upar: case blkupar: new->nn.stateexpr = sexpr; break; case expr: new->nn.cmd = (struct exprstruct *) sexpr; break; case asgn: new->nn.stateexpr = sexpr; v = invlist(instvars, name); if (v) { new->statetype = iasgn; new->mm.varpos = v->position; break; } v = invlist(contextvars, name); if (v) { new->statetype = casgn; new->mm.varpos = v->position; break; } default: yyerror("unknown variable or case in mkstate"); } return(new); } struct exprstruct *mkexpr(receiver, type, name, args) struct exprstruct *receiver, *args; enum cmdtypes type; char *name; { struct exprstruct *new; new = structalloc(exprstruct); new->cmdtype = type; new->cmdname = name; new->receiver = receiver; switch(type) { case reccmd: new->cc.recobj = (struct objstruct *) args; break; case uncmd: break; case bincmd: new->cc.argument = args; break; case keycmd: new->cc.keys = (struct keylist *) args; break; } return(new); } struct keylist *mkklist(kl, kw, ka) struct keylist *kl; char *kw; struct exprstruct *ka; { struct keylist *new; new = structalloc(keylist); new->keyword = kw; new->arg = ka; new->nextkey = kl; return(new); } mkkname(kl, kb) struct keylist *kl; char *kb; { if (kl->nextkey) mkkname(kl->nextkey, kb); strcat(kb, kl->keyword); } struct exprstruct *mkkey(receiver, keywordlist) struct exprstruct *receiver; struct keylist *keywordlist; { char kbuffer[500]; kbuffer[0] = '\0'; mkkname(keywordlist, kbuffer); return(mkexpr(receiver, keycmd, walloc(kbuffer), (struct exprstruct *) keywordlist)); } struct objstruct *mkobj(type, info) enum objtypes type; YYSTYPE *info; { struct objstruct *new; struct varstruct *v; struct litstruct *mklit(); new = structalloc(objstruct); new->objtype = type; switch(type) { case classobj: new->ee.litinfo = mklit(symlit, info); break; case varobj: v = invlist(instvars, info->c); if (v) { new->objtype = instvarobj; new->ee.varoffset = v->position; return(new); } v = invlist(contextvars, info->c); if (v) { new->objtype = contvarobj; new->ee.varoffset = v->position; return(new); } yerr("unknown variable %s", info->c); break; case litobj: new->ee.litinfo = info->t; break; case pseuobj: new->ee.pseuinfo = info->p; break; case primobj: new->ee.priminfo = info->u; break; case exprobj: new->ee.stateinfo = info->s; break; case blockobj: new->ee.blockinfo = info->b; break; } return(new); } struct blockstruct *mkblock(numargs, bstates) int numargs; struct statestruct *bstates; { struct blockstruct *new; int i; new = structalloc(blockstruct); new->numargs = numargs; if (contextvars) i = (contextvars->position - numargs) +1; else i = 1; new->arglocation = i; new->bstates = bstates; return(new); } struct primstruct *mkprim(pnum, plist) struct primlist *plist; int pnum; { struct primstruct *new; new = structalloc(primstruct); new->primnumber = pnum; new->plist = plist; return(new); } struct primlist *addprim(plist, prim) struct primlist *plist; struct objstruct *prim; { struct primlist *new; new = structalloc(primlist); new->nextprim = plist; new->pobject = prim; return(new); } struct litlist *addlit(list, lit) struct litlist *list; struct litstruct *lit; { struct litlist *new; new = structalloc(litlist); new->litele = lit; new->nextlit = list; return(new); } struct litstruct *mklit(littype, e) enum littypes littype; YYSTYPE *e; { struct litstruct *p; p = structalloc(litstruct); p->littype = littype; switch(littype) { case numlit: p->ll.litint = e->i; break; case fnumlit: p->ll.litstr = e->c; break; case charlit: p->ll.litchar = (char) e->i; break; case strlit: p->ll.litstr = e->c; break; case symlit: p->ll.litsym = e->c; break; case arlit: p->ll.litarry = e->a; break; } return(p); } deltemps(n) int n; { while (n--) { contextvars = contextvars->nextvar; } } SHAR_EOF if test 6917 -ne "`wc -c < 'parse1.c'`" then echo shar: error transmitting "'parse1.c'" '(should have been 6917 characters)' fi fi # end of overwriting check if test -f 'parse2.c' then echo shar: will not over-write existing file "'parse2.c'" else cat << \SHAR_EOF > 'parse2.c' /* Little Smalltalk pass 2 of the parser timothy a. budd, 10/84 */ /* The source code for the Little Smalltalk System may be freely copied provided that the source of all files is acknowledged and that this condition is copied with each file. The Little Smalltalk System is distributed without responsibility for the performance of the program and without any guarantee of maintenance. All questions concerning Little Smalltalk should be addressed to: Professor Tim Budd Department of Computer Science The University of Arizona Tucson, Arizona 85721 USA */ # include <stdio.h> # include "env.h" # include "drive.h" # include "cmds.h" # include "parser.h" # include "y.tab.h" extern int maxcontext; extern char *filename; extern FILE *ofd; static int inblock = 0; static int topstack = 0; static int maxstack = 0; # define bumpstk() if (++topstack > maxstack) maxstack = topstack # define popstk(i) topstack -= i genclass(clinfo, mlist) struct classstruct *clinfo; struct methodstruct *mlist; { int i; struct methodstruct *m, *n; topstack = 0; maxstack = 0; /* first find out how many methods have been declared */ /* also check for multiply defined methods */ for (m = mlist, i = 0; m; i++, m = m->nextmethod) for (n = m->nextmethod; n; n = n->nextmethod) if (streq((m->pattern)->cmdname , (n->pattern)->cmdname)) yerr("%s multiply defined", (m->pattern)->cmdname); fprintf(ofd,"temp <- <primitive 110 %d >\n", i); /* next print out each method */ for (m = mlist, i = 1; m; i++, m = m->nextmethod) { fprintf(ofd,"<primitive 112 temp %d\t\t\" %s \" \\\n", i, (m->pattern)->cmdname); topstack = 0; genmeth(m); } /* finally print out class definition stuff */ fprintf(ofd,"<primitive 98 #%s \\\n", clinfo->name); fprintf(ofd,"\t<primitive 97 #%s #%s #%s \\\n", clinfo->name, clinfo->super, filename); fprintf(ofd,"\t#( "); if (instvars) prvars(instvars); fprintf(ofd," ) \\\n"); fprintf(ofd,"\t#( "); for (m = mlist; m; m = m->nextmethod) fprintf(ofd,"#%s ", (m->pattern)->cmdname); fprintf(ofd," ) \\\n"); fprintf(ofd,"\ttemp %d %d > >\n\n", 1 + maxcontext, 1 + maxstack); } prvars(v) struct varstruct *v; { if (v->nextvar) prvars(v->nextvar); fprintf(ofd," #%s", v->text); } static int codetop = 0; static uchar code[1000]; static gencode(value) int value; { if (value >= 256) { yerr("code word too big: %d", value); value /= 0; } code[codetop++] = itouc(value); } static genhighlow(high, low) int high, low; { if (high < 0 || high > 16) yerr("genhighlow error: %d", high); if (low < 16) gencode(high * 16 + low); else { gencode(TWOBIT * 16 + high); gencode(low); } } static struct litstruct *literals[100]; int littop = 0; int litcomp(l1, l2) struct litstruct *l1, *l2; { if (l1->littype != l2->littype) return(0); switch(l1->littype) { case charlit: if (l1->ll.litchar != l2->ll.litchar) return(0); break; case numlit: if (l1->ll.litint != l2->ll.litint) return(0); break; case fnumlit: if (l1->ll.litstr != l2->ll.litstr) return(0); break; case strlit: if (strcmp(l1->ll.litstr, l2->ll.litstr)) return(0); break; case symlit: if (strcmp(l1->ll.litsym, l2->ll.litsym)) return(0); break; default: return(0); } return(1); } int genlitix(l) struct litstruct *l; { int i; for (i = 0; i < littop; i++) if (litcomp(l, literals[i])) return(i); i = littop; literals[littop++] = l; return(i); } static printalit(lit) struct litlist *lit; { if (lit) { if(lit->nextlit) printalit(lit->nextlit); printlit(lit->litele); } } printlit(lit) struct litstruct *lit; { if (lit) switch(lit->littype) { case numlit: fprintf(ofd,"%d ", lit->ll.litint); break; case fnumlit: fprintf(ofd,"%s ", lit->ll.litstr); break; case charlit: fprintf(ofd,"$%c ", lit->ll.litchar); break; case strlit: fprintf(ofd,"\'%s\' ", lit->ll.litstr); break; case symlit: fprintf(ofd,"#%s ", lit->ll.litsym); break; case arlit: fprintf(ofd,"#( "); printalit(lit->ll.litarry); fprintf(ofd,") "); break; default: yerr("unknown literal type %d", lit->littype); } } genmeth(m) struct methodstruct *m; { int i; fprintf(ofd,"\t#( #["); codetop = littop = 0; genstate(m->states, 1); genhighlow(SPECIAL, SELFRETURN); for (i = 0; i < codetop; i++){ fprintf(ofd," %d", uctoi(code[i])); if (i % 15 == 14) fprintf(ofd," \\\n"); } fprintf(ofd,"] \\\n"); fprintf(ofd,"\t#( "); for (i = 0; i < littop; i++) printlit(literals[i]); fprintf(ofd," ) ) >\n\n"); } genstate(s, doret) struct statestruct *s; int doret; { if (s->nextstate) genstate(s->nextstate, doret); switch(s->statetype) { default: yerr("unknown case in genstate %d", s->statetype); case blkupar: gensexpr(s->nn.stateexpr); if (inblock) genhighlow(SPECIAL, BLOCKRETURN); else genhighlow(SPECIAL, RETURN); popstk(1); break; case upar: gensexpr(s->nn.stateexpr); if (doret) genhighlow(SPECIAL, RETURN); popstk(1); break; case iasgn: gensexpr(s->nn.stateexpr); genhighlow(POPINSTANCE, s->mm.varpos); popstk(1); break; case casgn: gensexpr(s->nn.stateexpr); genhighlow(POPTEMP, s->mm.varpos); popstk(1); break; case expr: genexpr(s->nn.cmd); genhighlow(SPECIAL, POPSTACK); popstk(1); break; } } gensexpr(s) struct statestruct *s; { switch(s->statetype) { default: yerr("unknown state in gensexpr %d", s->statetype); case iasgn: gensexpr(s->nn.stateexpr); genhighlow(SPECIAL, DUPSTACK); bumpstk(); genhighlow(POPINSTANCE, s->mm.varpos); popstk(1); break; case casgn: gensexpr(s->nn.stateexpr); genhighlow(SPECIAL, DUPSTACK); bumpstk(); genhighlow(POPTEMP, s->mm.varpos); popstk(1); break; case expr: genexpr(s->nn.cmd); break; } } int supertest(rec) struct exprstruct *rec; { struct objstruct *o; if (rec->cmdtype != reccmd) return(0); o = rec->cc.recobj; if (o->objtype != pseuobj) return(0); if (o->ee.pseuinfo == supervar) return(1); return(0); } int isblock(e) struct exprstruct *e; { struct objstruct *o; if (e->cmdtype != reccmd) return(0); o = e->cc.recobj; if (o->objtype != blockobj) return(0); return(1); } genbarg(e) struct exprstruct *e; { if (isblock(e)) { genstate(((e->cc.recobj)->ee.blockinfo)->bstates, 0); } else { genexpr(e); genhighlow(UNSEND, VALUECMD); } } fixjump(loc) int loc; { int size; size = (codetop - loc) - 1; if (size > 255) yerr("block too big %d", size); code[loc] = itouc(size); } int gencond(message, e) char *message; struct exprstruct *e; { struct keylist *k; int i, j; k = e->cc.keys; i = 0; if ((i = streq(message, "ifTrue:")) || streq(message, "ifFalse:")) { genhighlow(SPECIAL, i ? SKIPFALSEPUSH : SKIPTRUEPUSH); i = codetop; gencode(0); genbarg(k->arg); fixjump(i); return(1); } if ((i = streq(message, "ifTrue:ifFalse:")) || streq(message, "ifFalse:ifTrue:")) { genhighlow(SPECIAL, i ? SKIPFALSEPUSH : SKIPTRUEPUSH); i = codetop; gencode(0); genbarg((k->nextkey)->arg); genhighlow(SPECIAL, SKIPFORWARD); j = codetop; gencode(0); fixjump(i); genhighlow(SPECIAL, POPSTACK); popstk(1); genbarg(k->arg); fixjump(j); return(1); } if ((i = streq(message, "and:")) || streq(message, "or:")) { genhighlow(SPECIAL, i ? SKIPF : SKIPT); i = codetop; gencode(0); genbarg(k->arg); fixjump(i); return(1); } if ((j = streq(message, "whileTrue:")) || streq(message, "whileFalse:")) { i = codetop; genbarg(e->receiver); genhighlow(SPECIAL, j ? SKIPFALSEPUSH : SKIPTRUEPUSH); j = codetop; gencode(0); genbarg(k->arg); genhighlow(SPECIAL, POPSTACK); popstk(1); genhighlow(SPECIAL, SKIPBACK); /* add one because bytecount pointer already advanced */ gencode((codetop - i) + 1); fixjump(j); return(1); } return(0); } genexpr(e) struct exprstruct *e; { char *message = e->cmdname; char **p; int i, numargs, s; YYSTYPE ex; struct litstruct *mklit(); if (e->cmdtype != reccmd) s = supertest(e->receiver); switch(e->cmdtype) { default: yerr("unknown state in genexpr %d", e->cmdtype); case reccmd: genobj(e->cc.recobj); return; case semiend: genexpr(e->receiver); genhighlow(SPECIAL, POPSTACK); popstk(1); return; case semistart: genexpr(e->receiver); genhighlow(SPECIAL, DUPSTACK); bumpstk(); return; case uncmd: genexpr(e->receiver); numargs = 0; break; case bincmd: genexpr(e->receiver); numargs = 1; genexpr(e->cc.argument); break; case keycmd: if ((!s) && isblock(e->receiver) && (streq(message, "whileTrue:") || streq(message, "whileFalse:"))) if (gencond(message, e)) return; genexpr(e->receiver); if ((!s) && ((streq(message, "ifTrue:")) || (streq(message, "ifFalse:")) || (streq(message, "and:")) || (streq(message, "or:")) || (streq(message, "ifTrue:ifFalse:")) || (streq(message, "ifFalse:ifTrue:")))) if (gencond(message, e)) return; numargs = genkargs(e->cc.keys); break; } if (s) { /* message to super */ genhighlow(SUPERSEND, numargs); popstk(numargs - 1); ex.c = message; gencode(genlitix(mklit(symlit, &ex))); return; } for (p = unspecial, i = 0; *p; i++, p++) if (strcmp(*p, message) == 0) { genhighlow(UNSEND, i); return; } for (p = binspecial, i = 0; *p; i++, p++) if (strcmp(*p, message) == 0) { genhighlow(BINSEND, i); popstk(1); return; } for (p = arithspecial, i = 0; *p; i++, p++) if (strcmp(*p, message) == 0) { genhighlow(ARITHSEND, i); popstk(1); return; } for (p = keyspecial, i = 0; *p; i++, p++) if (strcmp(*p, message) == 0) { genhighlow(KEYSEND, i); popstk(2); return; } genhighlow(SEND, numargs); popstk(numargs - 1); ex.c = message; gencode(genlitix(mklit(symlit, &ex))); } int genkargs(kl) struct keylist *kl; { int i; if (kl->nextkey) i = genkargs(kl->nextkey); else i = 0; genexpr(kl->arg); return(i + 1); } genobj(o) struct objstruct *o; { switch(o->objtype) { default: yerr("unknown state in genobj %d", o->objtype); case classobj: genspclass(o->ee.litinfo); break; case instvarobj: genhighlow(PUSHINSTANCE, o->ee.varoffset); bumpstk(); break; case contvarobj: genhighlow(PUSHTEMP, o->ee.varoffset); bumpstk(); break; case litobj: genlit(o->ee.litinfo); break; case pseuobj: genpseu(o->ee.pseuinfo); break; case primobj: genprim(o->ee.priminfo); break; case exprobj: gensexpr(o->ee.stateinfo); break; case blockobj: genblock(o->ee.blockinfo); break; } } genspclass(litinfo) struct litstruct *litinfo; { int i; char **p, *name; if (litinfo->littype != symlit) yerr("can't happen in genspclass %d", litinfo->littype); name = litinfo->ll.litsym; for (p = classpecial, i = 30; *p; i++, p++) if (strcmp(name, *p) == 0) { genhighlow(PUSHSPECIAL, i); bumpstk(); return; } genhighlow(PUSHCLASS, genlitix(litinfo)); bumpstk(); } genpseu(p) enum pseuvars p; { switch(p) { default: yerr("unknown state in genpseu %d", p); case truevar: genhighlow(PUSHSPECIAL, 11); break; case falsevar: genhighlow(PUSHSPECIAL, 12); break; case nilvar: genhighlow(PUSHSPECIAL, 13); break; case smallvar: genhighlow(PUSHSPECIAL, 14); break; case procvar: genhighlow(PUSHSPECIAL, 15); break; case supervar: case selfvar: genhighlow(PUSHTEMP, 0); break; } bumpstk(); } int genpargs(p) struct primlist *p; { int i; if (p) { i = 1 + genpargs(p->nextprim); genobj(p->pobject); } else i = 0; return(i); } genprim(p) struct primstruct *p; { int i; i = genpargs(p->plist); genhighlow(SPECIAL, PRIMCMD); popstk(i-1); gencode(i); gencode(p->primnumber); } genlit(l) struct litstruct *l; { int i; if (l->littype == numlit) { i = l->ll.litint; if (i == -1) genhighlow(PUSHSPECIAL, 10); else if (i >= 0 && i < 10) genhighlow(PUSHSPECIAL, i); else if ((i > 15) && (i < 30)) genhighlow(PUSHSPECIAL, i); else if ((i > 60) && (i < 256)) genhighlow(PUSHSPECIAL, i); else genhighlow(PUSHLIT, genlitix(l)); } else genhighlow(PUSHLIT, genlitix(l)); bumpstk(); } genblock(b) struct blockstruct *b; { int i, size, bsave; bsave = inblock; inblock |= 1; genhighlow(BLOCKCREATE, b->numargs); bumpstk(); if (b->numargs) gencode(b->arglocation); i = codetop; gencode(0); /* block size */ genstate(b->bstates, 1); size = (codetop - i) - 1; if (size > 255) yerr("block too big %d", size); code[i] = size; inblock = bsave; } SHAR_EOF if test 12764 -ne "`wc -c < 'parse2.c'`" then echo shar: error transmitting "'parse2.c'" '(should have been 12764 characters)' fi fi # end of overwriting check if test -f 'disclaim' then echo shar: will not over-write existing file "'disclaim'" else cat << \SHAR_EOF > 'disclaim' /* The source code for the Little Smalltalk System may be freely copied provided that the source of all files is acknowledged and that this condition is copied with each file. The Little Smalltalk System is distributed without responsibility for the performance of the program and without any guarantee of maintenance. All questions concerning Little Smalltalk should be addressed to: Professor Tim Budd Department of Computer Science The University of Arizona Tucson, Arizona 85721 USA */ SHAR_EOF if test 512 -ne "`wc -c < 'disclaim'`" then echo shar: error transmitting "'disclaim'" '(should have been 512 characters)' fi fi # end of overwriting check if test -f 'Makefile' then echo shar: will not over-write existing file "'Makefile'" else cat << \SHAR_EOF > 'Makefile' CFLAGS =-O LFLAGS =-n BINDIR = ../bin SOURCES = parser.y parser.lex parse1.c parse2.c MISC = disclaim Makefile *.h y.tab.c lex.yy.c uchar.c install: parse mv parse $(BINDIR) parse: y.tab.o parse1.o parse2.o cc $(LFLAGS) -o parse y.tab.o parse1.o parse2.o -lm bundle: y.tab.c lex.yy.c bundle $(SOURCES) $(MISC) >../parser.bundle y.tab.o: y.tab.c lex.yy.c y.tab.c: parser.y yacc -d parser.y lex.yy.c: parser.lex lex parser.lex parse2.o: parse2.c drive.h lint.out: y.tab.c lint y.tab.c parse1.c parse2.c -lm clean: -rm -f *.o SHAR_EOF if test 541 -ne "`wc -c < 'Makefile'`" then echo shar: error transmitting "'Makefile'" '(should have been 541 characters)' fi fi # end of overwriting check if test -f 'cmds.h' then echo shar: will not over-write existing file "'cmds.h'" else cat << \SHAR_EOF > 'cmds.h' /* Little Smalltalk The following very common commands are given a concise description in bytecodes. */ static char *unspecial[] = {"new", "isNil", "notNil", "size", "class", "value", "first", "next", "print", "printString", "strictlyPositive", "currentKey", "not", /* after the first 16 - which should be the most common messages, order doesn't make as much difference so we might as well list things in alphabetical order */ "abs", "asArray", "asFloat", "asString", "asSymbol", "block", "compareError", "copy", "current", "deepCopy", "exp", "findLast", "firstKey", "gamma", "isEmpty", "isLowercase", "isUppercase", "last", "lastKey", "ln", "newProcess", "not", "opError", "read", "removeError", "removeFirst", "removeLast", "resume", "rounded", "shallowCopy", "sqrt", "squared", "state", "superClass", "truncated", "unblock", "x", "y", 0 }; # define VALUECMD 5 # define PRNTCMD 8 static char *binspecial[] = {"new:", "at:", "to:", "do:", "value:", "==", "~~", "timesRepeat:", "whileTrue:", "whileFalse:", "ifTrue:", "ifFalse:", "error:", "add:", "/", "coerce:", "^", ",", "//", "addAll:", "addAllLast:", "addFirst:", "addLast:", "binaryDo:", "checkBucket:", "collect:", "deepCopy:", "gcd:", "getList:", "hashNumber:", "includes:", "inRange:", "keysDo:", "log:", "maxtype:", "newProcessWith:", "occurrencesOf:", "raisedTo:", "reject:", "remove:", "removeKey:", "respondsTo:", "reverseDo:", "roundTo:", "select:", "shallowCopy:", "sort:", "termErr:", "truncateTo:", "write:", "x:", "y:", "includesKey:", 0}; static char *arithspecial[] = {"+", "-", "*", "\\\\", "bitShift:", "bitAnd:", "bitOr:", "<", "<=", "=", "~=", ">=", ">", "rem:", "quo:", "min:", "max:", 0}; static char *keyspecial[] = {"at:put:", "ifTrue:ifFalse:", "ifFalse:ifTrue:", "value:value:", "to:by:", "at:ifAbsent:", "indexOf:ifAbsent:", "inject:into:", "remove:ifAbsent:", "removeKey:ifAbsent:", "between:and:", "findFirst:ifAbsent:", "findLast:ifAbsent:", "equals:startingAt:", "findAssociation:inList:", "detect:ifAbsent:", 0}; /* The classes included in the standard prelude also have a very concise description in bytecode representation */ static char *classpecial[] = {"Array", "ArrayedCollection", "Bag", "Block", "Boolean", "ByteArray", "Char", "Class", "Collection", "Complex", "Dictionary", "False", "File", "Float", "Integer", "Interpreter", "Interval", "KeyedCollection", "List", "Magnitude", "Number", "Object", "OrderedCollection", "Point", "Radian", "Random", "SequenceableCollection", "Set", "String", "Symbol", "True", "UndefinedObject", 0 }; SHAR_EOF if test 3146 -ne "`wc -c < 'cmds.h'`" then echo shar: error transmitting "'cmds.h'" '(should have been 3146 characters)' fi fi # end of overwriting check if test -f 'drive.h' then echo shar: will not over-write existing file "'drive.h'" else cat << \SHAR_EOF > 'drive.h' /* Little Smalltalk defines used by both parser and driver */ # define TWOBIT 0 # define PUSHINSTANCE 1 # define PUSHTEMP 2 # define PUSHLIT 3 # define PUSHCLASS 4 # define PUSHSPECIAL 5 # define POPINSTANCE 6 # define POPTEMP 7 # define SEND 8 # define SUPERSEND 9 # define UNSEND 10 # define BINSEND 11 # define ARITHSEND 12 # define KEYSEND 13 # define BLOCKCREATE 14 # define SPECIAL 15 /* arguments for special */ # define NOOP 0 # define DUPSTACK 1 # define POPSTACK 2 # define RETURN 3 # define BLOCKRETURN 4 # define SELFRETURN 5 # define SKIPTRUEPUSH 6 # define SKIPFALSEPUSH 7 # define SKIPFORWARD 8 # define SKIPBACK 9 # define PRIMCMD 10 # define SKIPT 11 # define SKIPF 12 enum pseuvars {nilvar, truevar, falsevar, selfvar, supervar, smallvar, procvar}; # define streq(a,b) (strcmp(a,b) == 0) /* only include driver code in driver, keeps both lint and the 11/70 quiet */ # ifdef DRIVECODE enum lextokens { nothing, LITNUM , LITFNUM , LITCHAR , LITSTR , LITSYM , LITARR , LITBYTE , ASSIGN , BINARY , PRIMITIVE , PSEUDO , UPPERCASEVAR , LOWERCASEVAR , COLONVAR , KEYWORD , LP , RP , LB , RB , PERIOD , BAR , SEMI , PS , MINUS , PE , NL }; typedef union { char *c; double f; int i; enum pseuvars p; } tok_type; extern tok_type t; # endif SHAR_EOF if test 1453 -ne "`wc -c < 'drive.h'`" then echo shar: error transmitting "'drive.h'" '(should have been 1453 characters)' fi fi # end of overwriting check if test -f 'env.h' then echo shar: will not over-write existing file "'env.h'" else cat << \SHAR_EOF > 'env.h' /* Little Smalltalk execution environment definitions. The Little Smalltalk system is tailored to various machines by changing defined constants. These constants, and their meanings, are as follows: GAMMA defined if gamma() is part of the math library ENVSAVE defined if it is required to save environ during fast load FACTMAX maximum integer value for which a factorial can be computed by repeated multiplication without overflow. FASTDEFAULT defined if the default behavior should be to do a fast load FLUSHREQ if defined a fflush is given after every call to printf or fprintf INLINE generate inline code for increments or decrements - produces larger, but faster, code. MDWINDOWS defined if the maryland windows package is used NOSYSTEM defined if the system() call is NOT provided (seriously limits functionality) OPEN3ARG defined if 3 argument style opens are used SMALLDATA if defined various means are used to reduce the size of the data segment, at the expense of some functionality. SIGS define in the signal system call is available for trapping user interrupt signals SETJUMP defined if the setjump facility is available In addition to defining constants, the identifier type ``unsigned character'' needs to be defined. Bytecodes are stored using this datatype. On machines which do not support this datatype directly, macros need to be defined that convert normal chars into unsigned chars. unsigned chars are defined by a typedef for ``uchar'' and a pair of macros that convert an int into a uchar and vice-versa. In order to simplify installation on systems to which the Little Smalltalk system has already been ported, various ``meta-defines'' are recognized. By defining one of these symbols, the correct definitions for other symbols will automatically be generated. The currently recognized meta-defines are as follows: BERK42 Vax Berkeley 4.2 DECPRO Dec Professional 350 running Venix HP9000 Hewlett Packard 9000 PDP1170 PdP 11/70 (also other PDP 11 machines) PERKELM Perken Elmer 8/32 RIDGE Ridge ROS 3.1 Finally, a few path names have to be compiled into the code. These path names are the following: TEMPFILE - a temporary file name in mktemp format PARSER - the location of the parser PRELUDE - the location of the standard prelude in ascii format FAST - the location of the standard prelude in saved format */ # define TEMPFILE "/tmp/stXXXXXX" # define PARSER "/usr/src/public/lsmalltalk/bin/parse" # define PRELUDE "/usr/src/public/lsmalltalk/prelude/standard" # define FAST "/usr/src/public/lsmalltalk/prelude/stdsave" /* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>meta-define <<<<<<<<<<<<<<<*/ # define PERKELM /*------------------------------ VAX Berkeley 4.2 definition */ # ifdef BERK42 # define GAMMA /* gamma value is known */ # define FACTMAX 12 # define FLUSHREQ /* flush after every printf */ # define SIGS # define SETJUMP typedef unsigned char uchar; # define itouc(x) ((uchar) x) # define uctoi(x) ((int) x) /* # define MDWINDOWS */ /* FASTLOADING DOES work, and should eventually be defined to be standard*/ /*# define FASTDEFAULT*/ /* default to fast-loading */ # endif /* BERK42 definition */ /*------------------------------ HP 9000 / HP - UX definition */ # ifdef HP9000 # define GAMMA /* gamma value is known */ # define FACTMAX 12 # define FLUSHREQ /* flush after every printf */ # define SIGS # define SETJUMP typedef unsigned char uchar; # define itouc(x) ((uchar) x) # define uctoi(x) ((int) x) # endif /* HP 9000 definition */ /* ---------------------------------------RIDGE ROS 3.1 definition */ # ifdef RIDGE # define GAMMA /* gamma value is known */ # define FACTMAX 12 typedef unsigned char uchar; # define itouc(x) ((uchar) x) # define uctoi(x) ((int) x) # endif /* RIDGE definition */ /* --------------------------------------------DEC PRO definitions */ # ifdef DECPRO /* GAMMA, OPEN3ARG not defined */ # define ENVSAVE # define FACTMAX 8 # define SMALLDATA /* unsigned characters not supported, but can be simulated */ typedef char uchar; # define itouc(x) ((uchar) x) # define uctoi(x) (unsigned) (x >= 0 ? x : x + 256) # endif /* DECPRO definition */ /* --------------------------------------------PDP11/70 definitions */ # ifdef PDP1170 /* GAMMA, OPEN3ARG not defined */ # define ENVSAVE # define FACTMAX 8 # define FLUSHREQ # define SIGS # define SETJUMP /* unsigned characters not supported, but can be simulated */ typedef char uchar; # define itouc(x) ((uchar) x) # define uctoi(x) (unsigned) (x >= 0 ? x : x + 256) # endif /* PDP1170 definition */ /*------------------------------ Perkin Elmer 8/32 definitions */ # ifdef PERKELM # define ENVSAVE # define FACTMAX 12 /* # define FLUSHREQ /* flush after every printf */ # define FASTDEFAULT /* default to fast-loading */ # define OPEN3ARG # define SETJUMP # define SIGS # define GAMMA /* gamma value is known */ typedef unsigned char uchar; # define itouc(x) ((uchar) x) # define uctoi(x) ((int) x) # endif /* PERKELM definition */ /******************************************************************/ /* the following are pretty much independent of any system */ # define INLINE /* produce in line code for incs and decs */ SHAR_EOF if test 5214 -ne "`wc -c < 'env.h'`" then echo shar: error transmitting "'env.h'" '(should have been 5214 characters)' fi fi # end of overwriting check if test -f 'parser.h' then echo shar: will not over-write existing file "'parser.h'" else cat << \SHAR_EOF > 'parser.h' /* Little Smalltalk definitions used by parser */ enum vartypes {instvar, argvar, tempvar}; struct varstruct { struct varstruct *nextvar; enum vartypes vtype; char *text; short position; }; enum objtypes {classobj, varobj, instvarobj, contvarobj, litobj, pseuobj, primobj, exprobj, blockobj}; struct objstruct { enum objtypes objtype; union { char *varname; int varoffset; struct litstruct *litinfo; enum pseuvars pseuinfo; struct primstruct *priminfo; struct statestruct *stateinfo; struct blockstruct *blockinfo; } ee; }; struct blockstruct { int arglocation; int numargs; struct statestruct *bstates; }; enum littypes {numlit, fnumlit, charlit, strlit, symlit, arlit, bytelit}; struct litstruct { enum littypes littype; union { int litint; char litchar; char *litstr; char *litsym; struct litlist *litarry; } ll; }; struct litlist { struct litstruct *litele; struct litlist *nextlit; int litposition; }; struct primstruct { int primnumber; struct primlist *plist; } ; struct primlist { struct primlist *nextprim; struct objstruct *pobject; }; enum cmdtypes {reccmd, uncmd, bincmd, keycmd, semistart, semiend}; struct exprstruct { enum cmdtypes cmdtype; char *cmdname; struct exprstruct *receiver; union { struct exprstruct *argument; struct keylist *keys; struct objstruct *recobj; } cc; struct exprstruct *nextcmd; }; enum statetypes {blkupar, upar, asgn, iasgn, casgn, expr}; struct statestruct { enum statetypes statetype; struct statestruct *nextstate; union { struct varstruct *variable; int varpos; } mm; union { struct statestruct *stateexpr; struct exprstruct *cmd; } nn; }; struct keylist { char *keyword; struct exprstruct *arg; struct keylist *nextkey; }; struct methodstruct { struct exprstruct *pattern; int numtempvars; struct statestruct *states; struct methodstruct *nextmethod; }; struct classstruct { char *name; char *super; }; # define structalloc(type) (struct type *) alloc(sizeof (struct type )) extern struct varstruct *instvars; extern struct varstruct *contextvars; # define addinst(x) (instvars = addvlist(mkvar(x, instvar), instvars)) extern char *walloc(); SHAR_EOF if test 2746 -ne "`wc -c < 'parser.h'`" then echo shar: error transmitting "'parser.h'" '(should have been 2746 characters)' fi fi # end of overwriting check if test -f 'y.tab.h' then echo shar: will not over-write existing file "'y.tab.h'" else cat << \SHAR_EOF > 'y.tab.h' # define LITNUM 257 # define LITFNUM 258 # define LITCHAR 259 # define LITSTR 260 # define LITSYM 261 # define CLASS 262 # define ASSIGN 263 # define BINARY 264 # define PRIMITIVE 265 # define PSEUDO 266 # define UPPERCASEVAR 267 # define LOWERCASEVAR 268 # define COLONVAR 269 # define KEYWORD 270 # define LP 271 # define RP 272 # define LB 273 # define RB 274 # define PERIOD 275 # define BAR 276 # define MBAR 277 # define SEMI 278 # define UPARROW 279 # define PS 280 # define MINUS 281 # define PE 282 typedef union { struct litlist *a; struct blockstruct *b; char *c; struct exprstruct *e; int i; struct keylist *k; struct classstruct *l; struct methodstruct *m; struct objstruct *o; enum pseuvars p; struct primlist *r; struct statestruct *s; struct litstruct *t; struct primstruct *u } YYSTYPE; extern YYSTYPE yylval; SHAR_EOF if test 868 -ne "`wc -c < 'y.tab.h'`" then echo shar: error transmitting "'y.tab.h'" '(should have been 868 characters)' fi fi # end of overwriting check if test -f 'y.tab.c' then echo shar: will not over-write existing file "'y.tab.c'" else cat << \SHAR_EOF > 'y.tab.c' # define LITNUM 257 # define LITFNUM 258 # define LITCHAR 259 # define LITSTR 260 # define LITSYM 261 # define CLASS 262 # define ASSIGN 263 # define BINARY 264 # define PRIMITIVE 265 # define PSEUDO 266 # define UPPERCASEVAR 267 # define LOWERCASEVAR 268 # define COLONVAR 269 # define KEYWORD 270 # define LP 271 # define RP 272 # define LB 273 # define RB 274 # define PERIOD 275 # define BAR 276 # define MBAR 277 # define SEMI 278 # define UPARROW 279 # define PS 280 # define MINUS 281 # define PE 282 # line 26 "parser.y" # include "env.h" # include "drive.h" # include "parser.h" # line 31 "parser.y" typedef union { struct litlist *a; struct blockstruct *b; char *c; struct exprstruct *e; int i; struct keylist *k; struct classstruct *l; struct methodstruct *m; struct objstruct *o; enum pseuvars p; struct primlist *r; struct statestruct *s; struct litstruct *t; struct primstruct *u } YYSTYPE; # line 49 "parser.y" extern struct blockstruct *mkblock(); extern struct classstruct *mkclass(); extern struct varstruct *mkvar(), *addvlist(), *invlist(); extern struct methodstruct *mkmethod(); extern struct exprstruct *mkexpr(), *mkkey(); extern struct keylist *mkklist(); extern struct statestruct *mkstate(); extern struct objstruct *mkobj(); extern struct primstruct *mkprim(); extern struct primlist *addprim(); extern struct litstruct *mklit(); extern struct litlist *addlit(); extern char *bincat(); struct varstruct *instvars; struct varstruct *contextvars; int bytetop = 0; uchar bytearray[1000]; YYSTYPE e; int errorcount = 0; #define yyclearin yychar = -1 #define yyerrok yyerrflag = 0 extern int yychar; extern short yyerrflag; #ifndef YYMAXDEPTH #define YYMAXDEPTH 150 #endif YYSTYPE yylval, yyval; # define YYERRCODE 256 # line 348 "parser.y" # include <stdio.h> char *filename; FILE *fp; FILE *ofd; # include "lex.yy.c" main(argc, argv) int argc; char **argv; { if (argc != 2) quiter("parser: wrong number of arguments"); filename = argv[1]; fp = fopen(filename, "r"); if (fp == NULL) { yerr("cannot open input file %s", filename); quiter("parser quits"); } ofd = stdout; return(yyparse()); } quiter(s) char *s; {fprintf(stderr,"%s\n", s); exit(1);} yywarn(s, v) char *s, *v; { fprintf(stderr, "%s: line %d: Warning ", filename, linenum); fprintf(stderr, s, v); fprintf(stderr,"\n"); } yyerror(s) char *s; {yerr(s, "");} yerr(s, v) char *s, *v; { fprintf(stderr, "%s: line %d: ", filename, linenum); fprintf(stderr, s, v); fprintf(stderr,"\n"); if (errorcount++ > 10) quiter("too many errors, goodby"); } expect(str) char *str; { char buffer[100]; sprintf(buffer,"Expected %%s found %s", yytext); yerr(buffer, str); } int yywrap() { return(1);} char *alloc(size) int size; /* allocate a block of storage */ { char *p, *malloc(); p = malloc( (unsigned) size); if (p == (char *) 0) yyerror("out of free space"); return(p); } char *bincat(s1, s2) char *s1, *s2; { char *p; p = alloc(strlen(s1) + strlen(s2) + 1); strcpy(p, s1); strcat(p, s2); return(p); } short yyexca[] ={ -1, 1, 0, -1, -2, 0, }; # define YYNPROD 119 # define YYLAST 309 short yyact[]={ 81, 79, 75, 76, 77, 127, 92, 25, 157, 141, 124, 123, 126, 125, 131, 156, 140, 155, 36, 26, 152, 37, 28, 130, 132, 29, 81, 79, 75, 76, 77, 127, 89, 25, 154, 149, 124, 123, 126, 125, 131, 120, 10, 119, 34, 26, 114, 40, 28, 130, 132, 29, 81, 79, 75, 76, 77, 15, 105, 9, 71, 65, 14, 116, 32, 33, 67, 146, 72, 107, 106, 35, 107, 43, 98, 78, 80, 147, 81, 79, 75, 76, 77, 15, 48, 42, 71, 65, 14, 54, 99, 84, 67, 91, 72, 143, 47, 109, 108, 102, 138, 78, 80, 81, 79, 75, 76, 77, 15, 13, 6, 71, 65, 14, 54, 15, 5, 67, 136, 72, 14, 69, 62, 101, 58, 52, 78, 80, 81, 79, 75, 76, 77, 15, 53, 60, 71, 65, 14, 54, 24, 51, 67, 93, 72, 81, 79, 75, 76, 77, 15, 78, 80, 71, 65, 14, 116, 31, 22, 67, 83, 72, 94, 17, 129, 45, 25, 142, 78, 80, 21, 20, 23, 25, 70, 41, 39, 25, 26, 95, 2, 28, 7, 27, 29, 26, 34, 90, 28, 26, 27, 29, 28, 34, 27, 29, 88, 46, 84, 44, 20, 49, 100, 96, 86, 87, 32, 33, 30, 4, 63, 8, 1, 32, 33, 12, 85, 66, 121, 64, 117, 139, 97, 122, 135, 134, 113, 50, 133, 16, 115, 112, 3, 118, 11, 19, 74, 103, 137, 144, 110, 82, 104, 111, 38, 61, 59, 57, 55, 56, 18, 73, 68, 145, 150, 0, 148, 0, 0, 0, 0, 0, 0, 0, 128, 0, 0, 122, 0, 0, 151, 0, 0, 153, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 128 }; short yypact[]={ -146,-146,-1000,-214,-147,-1000,-1000,-1000, -98,-1000, -1000,-212,-198,-1000,-1000,-1000,-256,-1000,-212,-223, -183,-1000,-1000,-183, -87,-1000,-1000,-1000,-1000,-1000, -1000,-172,-1000,-1000,-1000,-1000,-1000, -98,-154,-177, -183,-1000,-1000,-1000,-1000,-1000, -63,-1000,-1000,-1000, -243,-1000,-129,-1000,-170,-272,-1000,-1000, -91, -91, -194,-178,-1000,-1000,-1000,-1000,-1000,-129,-1000,-1000, -1000,-158,-211,-1000,-1000,-1000,-1000,-1000,-201,-1000, -160,-1000, -70,-1000,-1000,-1000,-1000,-1000,-1000,-154, -1000,-129,-1000,-224,-112,-112,-224,-112,-1000,-1000, -229,-231,-1000,-179,-260,-1000,-1000,-162,-1000,-1000, -1000,-1000,-1000,-1000,-112,-194,-1000, -87,-194,-1000, -1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000,-1000, -204,-1000,-160,-205,-239,-179,-1000,-255,-129,-1000, -1000,-1000,-240,-1000, -87,-257,-1000,-1000,-1000,-1000, -1000,-267,-1000,-1000,-1000,-1000,-1000,-1000 }; short yypgo[]={ 0, 123, 252, 210, 162, 140, 251, 250, 249, 248, 124, 135, 247, 246, 245, 244, 242, 241, 237, 236, 235, 143, 234, 232, 163, 229, 122, 228, 227, 141, 134, 225, 224, 118, 221, 219, 121, 218, 217, 212, 180, 211, 209, 208, 157, 197, 196, 175, 160, 174, 167, 164 }; short yyr1[]={ 0, 39, 39, 40, 41, 41, 23, 42, 42, 22, 22, 22, 3, 3, 43, 43, 45, 45, 45, 25, 25, 24, 7, 7, 7, 7, 20, 20, 47, 47, 15, 15, 44, 44, 44, 17, 17, 48, 28, 28, 46, 46, 29, 29, 30, 30, 9, 9, 12, 12, 13, 13, 14, 14, 8, 8, 21, 21, 10, 10, 4, 4, 5, 5, 5, 5, 5, 11, 11, 26, 26, 26, 26, 26, 26, 26, 38, 27, 27, 2, 18, 18, 16, 16, 31, 31, 33, 33, 34, 34, 32, 32, 35, 35, 49, 36, 36, 36, 36, 36, 36, 6, 6, 19, 19, 37, 37, 37, 37, 37, 37, 37, 37, 51, 51, 1, 1, 50, 50 }; short yyr2[]={ 0, 1, 2, 4, 1, 1, 3, 1, 1, 1, 2, 1, 1, 1, 0, 3, 1, 2, 1, 1, 3, 4, 1, 2, 1, 1, 2, 3, 1, 1, 0, 3, 1, 1, 1, 1, 2, 1, 1, 3, 0, 1, 2, 1, 3, 1, 1, 1, 1, 2, 1, 3, 2, 2, 1, 2, 2, 3, 1, 3, 1, 2, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 3, 1, 4, 0, 2, 4, 0, 2, 1, 2, 2, 1, 2, 1, 0, 1, 2, 3, 1, 3, 2, 1, 1, 1, 1, 1, 4, 1, 2, 1, 2, 1, 1, 1, 1, 1, 1, 1, 3, 2, 1, 0, 2, 1, 2 }; short yychk[]={ -1000, -39, -40, -23, -42, 262, 256, -40, -41, 273, 256, -22, -3, 256, 267, 262, -25, -24, -7, -20, -4, 268, 256, 270, -5, 264, 276, 281, 279, 282, -43, -44, 276, 277, 256, 269, 274, 277, -15, -44, 270, -47, 268, 256, -47, -5, -45, 268, 256, -24, -28, -29, 279, -30, 268, -9, -8, -12, -10, -13, -11, -14, -26, -3, -35, 266, -38, 271, -2, -36, -49, 265, 273, -6, -19, 259, 260, 261, 280, 258, 281, 257, -17, -48, 268, -47, -44, 268, -46, 275, -30, 263, 278, -21, -4, 270, -21, -4, 268, 268, -30, -1, 257, -18, -16, 269, 271, 273, 258, 257, -44, -48, -29, -30, 270, -11, 268, -10, -11, 272, 272, -37, -36, 268, 267, 270, 269, 262, -4, -51, 280, 271, 281, -27, -31, -32, -33, -30, 279, -34, 276, 269, -50, 257, -10, -1, 271, 282, -26, 274, -33, -30, 275, -30, 274, 257, 272, 275 }; short yydef[]={ 0, -2, 1, 0, 0, 7, 8, 2, 0, 4, 5, 14, 9, 11, 12, 13, 0, 19, 30, 22, 0, 24, 25, 0, 60, 62, 63, 64, 65, 66, 6, 0, 32, 33, 34, 10, 3, 0, 0, 0, 0, 23, 28, 29, 26, 61, 0, 16, 18, 20, 40, 38, 0, 43, 70, 45, 46, 47, 54, 48, 58, 50, 67, 69, 71, 72, 73, 0, 75, 92, 115, 0, 80, 95, 96, 97, 98, 99, 0, 101, 0, 103, 0, 35, 37, 27, 15, 17, 21, 41, 42, 0, 52, 55, 0, 0, 49, 0, 68, 53, 0, 0, 77, 88, 0, 82, 94, 0, 102, 104, 31, 36, 39, 44, 0, 59, 70, 56, 51, 74, 93, 116, 105, 106, 107, 108, 109, 110, 111, 115, 0, 114, 64, 0, 0, 88, 85, 89, 0, 87, 81, 83, 0, 117, 57, 0, 113, 76, 78, 79, 84, 89, 90, 86, 100, 118, 112, 91 }; #ifndef lint static char yaccpar_sccsid[] = "@(#)yaccpar 4.1 (Berkeley) 2/11/83"; #endif not lint # # define YYFLAG -1000 # define YYERROR goto yyerrlab # define YYACCEPT return(0) # define YYABORT return(1) /* parser for yacc output */ #ifdef YYDEBUG int yydebug = 0; /* 1 for debugging */ #endif YYSTYPE yyv[YYMAXDEPTH]; /* where the values are stored */ int yychar = -1; /* current input token number */ int yynerrs = 0; /* number of errors */ short yyerrflag = 0; /* error recovery flag */ yyparse() { short yys[YYMAXDEPTH]; short yyj, yym; register YYSTYPE *yypvt; register short yystate, *yyps, yyn; register YYSTYPE *yypv; register short *yyxi; yystate = 0; yychar = -1; yynerrs = 0; yyerrflag = 0; yyps= &yys[-1]; yypv= &yyv[-1]; yystack: /* put a state and value onto the stack */ #ifdef YYDEBUG if( yydebug ) printf( "state %d, char 0%o\n", yystate, yychar ); #endif if( ++yyps> &yys[YYMAXDEPTH] ) { yyerror( "yacc stack overflow" ); return(1); } *yyps = yystate; ++yypv; *yypv = yyval; yynewstate: yyn = yypact[yystate]; if( yyn<= YYFLAG ) goto yydefault; /* simple state */ if( yychar<0 ) if( (yychar=yylex())<0 ) yychar=0; if( (yyn += yychar)<0 || yyn >= YYLAST ) goto yydefault; if( yychk[ yyn=yyact[ yyn ] ] == yychar ){ /* valid shift */ yychar = -1; yyval = yylval; yystate = yyn; if( yyerrflag > 0 ) --yyerrflag; goto yystack; } yydefault: /* default state action */ if( (yyn=yydef[yystate]) == -2 ) { if( yychar<0 ) if( (yychar=yylex())<0 ) yychar = 0; /* look through exception table */ for( yyxi=yyexca; (*yyxi!= (-1)) || (yyxi[1]!=yystate) ; yyxi += 2 ) ; /* VOID */ while( *(yyxi+=2) >= 0 ){ if( *yyxi == yychar ) break; } if( (yyn = yyxi[1]) < 0 ) return(0); /* accept */ } if( yyn == 0 ){ /* error */ /* error ... attempt to resume parsing */ switch( yyerrflag ){ case 0: /* brand new error */ yyerror( "syntax error" ); yyerrlab: ++yynerrs; case 1: case 2: /* incompletely recovered error ... try again */ yyerrflag = 3; /* find a state where "error" is a legal shift action */ while ( yyps >= yys ) { yyn = yypact[*yyps] + YYERRCODE; if( yyn>= 0 && yyn < YYLAST && yychk[yyact[yyn]] == YYERRCODE ){ yystate = yyact[yyn]; /* simulate a shift of "error" */ goto yystack; } yyn = yypact[*yyps]; /* the current yyps has no shift onn "error", pop stack */ #ifdef YYDEBUG if( yydebug ) printf( "error recovery pops state %d, uncovers %d\n", *yyps, yyps[-1] ); #endif --yyps; --yypv; } /* there is no state on the stack with an error shift ... abort */ yyabort: return(1); case 3: /* no shift yet; clobber input char */ #ifdef YYDEBUG if( yydebug ) printf( "error recovery discards char %d\n", yychar ); #endif if( yychar == 0 ) goto yyabort; /* don't discard EOF, quit */ yychar = -1; goto yynewstate; /* try again in the same state */ } } /* reduction by production yyn */ #ifdef YYDEBUG if( yydebug ) printf("reduce %d\n",yyn); #endif yyps -= yyr2[yyn]; yypvt = yypv; yypv -= yyr2[yyn]; yyval = yypv[1]; yym=yyn; /* consult goto table to find next state */ yyn = yyr1[yyn]; yyj = yypgo[yyn] + *yyps + 1; if( yyj>=YYLAST || yychk[ yystate = yyact[yyj] ] != -yyn ) yystate = yyact[yypgo[yyn]]; switch(yym){ case 3: # line 103 "parser.y" {if (errorcount == 0) genclass(yypvt[-3].l, yypvt[-1].m);} break; case 5: # line 107 "parser.y" {if ((yytext[0] == ':') || isalpha(yytext[0])) expect(":SuperClass"); else expect("open brace [");} break; case 6: # line 112 "parser.y" {yyval.l = yypvt[-1].l;} break; case 8: # line 116 "parser.y" {expect("keyword Class");} break; case 9: # line 119 "parser.y" {yyval.l = mkclass(yypvt[-0].c, (char *) 0);} break; case 10: # line 120 "parser.y" {yyval.l = mkclass(yypvt[-1].c, yypvt[-0].c);} break; case 11: # line 121 "parser.y" {expect("Classname :Superclass"); yyval.l = mkclass("Error", (char *) 0);} break; case 16: # line 133 "parser.y" {addinst(yypvt[-0].c);} break; case 17: # line 134 "parser.y" {addinst(yypvt[-0].c);} break; case 18: # line 135 "parser.y" {expect("instance variable");} break; case 20: # line 140 "parser.y" {yypvt[-0].m->nextmethod = yypvt[-2].m; yyval.m = yypvt[-0].m;} break; case 21: # line 144 "parser.y" {deltemps(yypvt[-2].i); yyval.m = mkmethod(yypvt[-3].e, yypvt[-2].i, yypvt[-1].s);} break; case 22: # line 148 "parser.y" {yyval.e = mkkey((struct exprstruct *) 0, yypvt[-0].k);} break; case 23: # line 150 "parser.y" {yyval.e = mkexpr((struct exprstruct *) 0, bincmd, yypvt[-1].c, (struct exprstruct *) 0);} break; case 24: # line 152 "parser.y" {yyval.e = mkexpr((struct exprstruct *) 0, uncmd, yypvt[-0].c, (struct exprstruct *) 0);} break; case 25: # line 153 "parser.y" {expect("method pattern"); yyval.e = mkexpr((struct exprstruct *) 0, uncmd, "", (struct exprstruct *) 0);} break; case 26: # line 158 "parser.y" {yyval.k = mkklist((struct keylist *) 0, yypvt[-1].c, (struct exprstruct *) 0);} break; case 27: # line 160 "parser.y" {yyval.k = mkklist(yypvt[-2].k, yypvt[-1].c, (struct exprstruct *) 0);} break; case 28: # line 163 "parser.y" {addtemp(yypvt[-0].c, argvar);} break; case 29: # line 164 "parser.y" {expect("argument variable");} break; case 30: # line 167 "parser.y" {yyval.i = 0;} break; case 31: # line 168 "parser.y" {yyval.i = yypvt[-1].i;} break; case 34: # line 173 "parser.y" {expect("| (vertical bar)");} break; case 35: # line 176 "parser.y" {yyval.i = 1;} break; case 36: # line 177 "parser.y" {yyval.i = yypvt[-1].i + 1;} break; case 37: # line 180 "parser.y" {addtemp(yypvt[-0].c, tempvar);} break; case 38: # line 183 "parser.y" {yyval.s = yypvt[-0].s;} break; case 39: # line 184 "parser.y" {yypvt[-0].s->nextstate = yypvt[-2].s; yyval.s = yypvt[-0].s;} break; case 42: # line 191 "parser.y" {yyval.s = mkstate(upar, (char *) 0, yypvt[-0].s);} break; case 44: # line 196 "parser.y" {yyval.s = mkstate(asgn, yypvt[-2].c, yypvt[-0].s);} break; case 45: # line 198 "parser.y" {yyval.s = mkstate(expr, (char *) 0, (struct statestruct *) yypvt[-0].e);} break; case 47: # line 202 "parser.y" {yyval.e = mkexpr(yypvt[-0].e, semiend, 0, 0);} break; case 49: # line 206 "parser.y" {yyval.e = mkkey(yypvt[-1].e, yypvt[-0].k);} break; case 51: # line 211 "parser.y" {yyval.e = mkexpr(yypvt[-2].e, bincmd, yypvt[-1].c, yypvt[-0].e);} break; case 52: # line 214 "parser.y" {yyval.e = mkexpr(yypvt[-1].e, semistart, 0, 0);} break; case 53: # line 216 "parser.y" {yyval.e = mkexpr(yypvt[-1].e, uncmd, yypvt[-0].c, (struct exprstruct *) 0);} break; case 54: # line 219 "parser.y" {yyval.e = yypvt[-0].e;} break; case 55: # line 220 "parser.y" {yyval.e = mkkey(yypvt[-1].e, yypvt[-0].k);} break; case 56: # line 224 "parser.y" {yyval.k = mkklist((struct keylist *) 0, yypvt[-1].c, yypvt[-0].e);} break; case 57: # line 226 "parser.y" {yyval.k = mkklist(yypvt[-2].k, yypvt[-1].c, yypvt[-0].e);} break; case 58: # line 229 "parser.y" {yyval.e = yypvt[-0].e;} break; case 59: # line 230 "parser.y" {yyval.e = mkexpr(yypvt[-2].e, bincmd, yypvt[-1].c, yypvt[-0].e);} break; case 60: # line 233 "parser.y" {yyval.c = yypvt[-0].c;} break; case 61: # line 234 "parser.y" {yyval.c = bincat(yypvt[-1].c, yypvt[-0].c);} break; case 67: # line 245 "parser.y" {yyval.e = mkexpr((struct exprstruct *) 0, reccmd, (char *) 0, (struct exprstruct *) yypvt[-0].o);} break; case 68: # line 248 "parser.y" {yyval.e = mkexpr(yypvt[-1].e, uncmd, yypvt[-0].c, (struct exprstruct *) 0);} break; case 69: # line 251 "parser.y" {e.c = yypvt[-0].c; yyval.o = mkobj(classobj, &e);} break; case 70: # line 252 "parser.y" {e.c = yypvt[-0].c; yyval.o = mkobj(varobj, &e);} break; case 71: # line 253 "parser.y" {e.t = yypvt[-0].t; yyval.o = mkobj(litobj, &e);} break; case 72: # line 254 "parser.y" {e.p = yypvt[-0].p; yyval.o = mkobj(pseuobj, &e);} break; case 73: # line 255 "parser.y" {e.u = yypvt[-0].u; yyval.o = mkobj(primobj, &e);} break; case 74: # line 256 "parser.y" {e.s = yypvt[-1].s; yyval.o = mkobj(exprobj, &e);} break; case 75: # line 257 "parser.y" {e.b = yypvt[-0].b; yyval.o = mkobj(blockobj, &e);} break; case 76: # line 261 "parser.y" {yyval.u = mkprim(yypvt[-2].i, yypvt[-1].r);} break; case 77: # line 264 "parser.y" {yyval.r = (struct primlist *) 0;} break; case 78: # line 265 "parser.y" {yyval.r = addprim(yypvt[-1].r, yypvt[-0].o);} break; case 79: # line 269 "parser.y" {yyval.b = mkblock(yypvt[-2].i, yypvt[-1].s); deltemps(yypvt[-2].i);} break; case 80: # line 273 "parser.y" {yyval.i = 0;} break; case 81: # line 274 "parser.y" {yyval.i = yypvt[-1].i;} break; case 82: # line 277 "parser.y" {addtemp(yypvt[-0].c, argvar); yyval.i = 1;} break; case 83: # line 278 "parser.y" {addtemp(yypvt[-0].c, argvar); yyval.i = yypvt[-1].i + 1;} break; case 84: # line 281 "parser.y" {yypvt[-0].s->nextstate = yypvt[-1].s; yyval.s = yypvt[-0].s;} break; case 85: # line 282 "parser.y" {yyval.s = yypvt[-0].s;} break; case 86: # line 285 "parser.y" {yyval.s = mkstate(blkupar, (char *) 0, yypvt[-0].s);} break; case 87: # line 286 "parser.y" {yyval.s = mkstate(upar, (char *) 0, yypvt[-0].s);} break; case 88: # line 290 "parser.y" {e.p = nilvar; yyval.s = mkstate(expr, (char *) 0, (struct statestruct *) mkexpr((struct exprstruct *) 0, reccmd, (char *) 0, (struct exprstruct *) mkobj(pseuobj, &e)));} break; case 89: # line 294 "parser.y" {yyval.s = yypvt[-0].s;} break; case 90: # line 297 "parser.y" {yyval.s = yypvt[-1].s;} break; case 91: # line 299 "parser.y" {yypvt[-1].s->nextstate = yypvt[-2].s; yyval.s = yypvt[-1].s;} break; case 92: # line 302 "parser.y" {yyval.t = yypvt[-0].t;} break; case 93: # line 303 "parser.y" {e.a = yypvt[-1].a; yyval.t = mklit(arlit, &e);} break; case 95: # line 309 "parser.y" {e.c = yypvt[-0].c; yyval.t = mklit(fnumlit, &e);} break; case 96: # line 310 "parser.y" {e.i = yypvt[-0].i; yyval.t = mklit(numlit, &e);} break; case 97: # line 311 "parser.y" {e.i = yypvt[-0].i; yyval.t = mklit(charlit, &e);} break; case 98: # line 312 "parser.y" {e.c = yypvt[-0].c; yyval.t = mklit(strlit, &e);} break; case 99: # line 313 "parser.y" {e.c = yypvt[-0].c; yyval.t = mklit(symlit, &e);} break; case 100: # line 314 "parser.y" {bytearray[bytetop] = '\0'; yyval.t = mklit(bytelit, &e);} break; case 101: # line 318 "parser.y" {yyval.c = yypvt[-0].c;} break; case 102: # line 319 "parser.y" {yyval.c = bincat("-", yypvt[-0].c);} break; case 103: # line 322 "parser.y" {yyval.i = yypvt[-0].i;} break; case 104: # line 323 "parser.y" {yyval.i = - yypvt[-0].i;} break; case 105: # line 326 "parser.y" {yyval.t = yypvt[-0].t;} break; case 106: # line 327 "parser.y" {e.c = yypvt[-0].c; yyval.t = mklit(symlit, &e);} break; case 107: # line 328 "parser.y" {e.c = yypvt[-0].c; yyval.t = mklit(symlit, &e);} break; case 108: # line 329 "parser.y" {e.c = yypvt[-0].c; yyval.t = mklit(symlit, &e);} break; case 109: # line 330 "parser.y" {e.c = yypvt[-0].c; yyval.t = mklit(symlit, &e);} break; case 110: # line 331 "parser.y" {e.c = yypvt[-0].c; yyval.t = mklit(symlit, &e);} break; case 111: # line 332 "parser.y" {e.c = yypvt[-0].c; yyval.t = mklit(symlit, &e);} break; case 112: # line 333 "parser.y" {e.a = yypvt[-1].a; yyval.t = mklit(arlit, &e);} break; case 115: # line 340 "parser.y" {yyval.a = (struct litlist *) 0;} break; case 116: # line 341 "parser.y" {yyval.a = addlit(yypvt[-1].a, yypvt[-0].t);} break; case 117: # line 344 "parser.y" {bytetop = 0; bytearray[bytetop++] = itouc(yypvt[-0].i);} break; case 118: # line 346 "parser.y" {bytearray[bytetop++] = itouc(yypvt[-0].i);} break; } goto yystack; /* stack new state and value */ } SHAR_EOF if test 20727 -ne "`wc -c < 'y.tab.c'`" then echo shar: error transmitting "'y.tab.c'" '(should have been 20727 characters)' fi fi # end of overwriting check if test -f 'lex.yy.c' then echo shar: will not over-write existing file "'lex.yy.c'" else cat << \SHAR_EOF > 'lex.yy.c' # include "stdio.h" # define U(x) x # define NLSTATE yyprevious=YYNEWLINE # define BEGIN yybgin = yysvec + 1 + # define INITIAL 0 # define YYLERR yysvec # define YYSTATE (yyestate-yysvec-1) # define YYOPTIM 1 # define YYLMAX 200 # define output(c) putc(c,yyout) # define input() (((yytchar=yysptr>yysbuf?U(*--yysptr):getc(yyin))==10?(yylineno++,yytchar):yytchar)==EOF?0:yytchar) # define unput(c) {yytchar= (c);if(yytchar=='\n')yylineno--;*yysptr++=yytchar;} # define yymore() (yymorfg=1) # define ECHO fprintf(yyout, "%s",yytext) # define REJECT { nstr = yyreject(); goto yyfussy;} int yyleng; extern char yytext[]; int yymorfg; extern char *yysptr, yysbuf[]; int yytchar; FILE *yyin ={stdin}, *yyout ={stdout}; extern int yylineno; struct yysvf { struct yywork *yystoff; struct yysvf *yyother; int *yystops;}; struct yysvf *yyestate; extern struct yysvf yysvec[], *yybgin; /* Little Smalltalk lexical analyzer */ # include <math.h> # undef input # undef unput double atof(); int linenum = 1; # define YYNEWLINE 10 yylex(){ int nstr; extern int yyprevious; while((nstr = yylook()) >= 0) yyfussy: switch(nstr){ case 0: if(yywrap()) return(0); break; case 1: {;} break; case 2: {linenum++;} break; case 3: {readcomment();} break; case 4: {return(ASSIGN);} break; case 5: {return(ASSIGN);} break; case 6: {return(lexsave(CLASS));} break; case 7: {yylval.p = selfvar; return(PSEUDO);} break; case 8: {yylval.p = procvar; return(PSEUDO);} break; case 9: {yylval.p = supervar; return(PSEUDO);} break; case 10: {yylval.p = nilvar; return(PSEUDO);} break; case 11: {yylval.p = truevar; return(PSEUDO);} break; case 12: {yylval.p = falsevar; return(PSEUDO);} break; case 13: {yylval.p = smallvar; return(PSEUDO);} break; case 14: {yylval.i = yytext[1]; return(LITCHAR);} break; case 15: {return(PS);} break; case 16: {return(lexsave(LITFNUM));} break; case 17: {yylval.i = atoi(yytext); return(LITNUM);} break; case 18: {return(lexsave(LITFNUM));} break; case 19: {char c; unput(c = input()); if (c == '\'') yymore(); else return(lexlstr());} break; case 20: {return(varlex());} break; case 21: {return(slexsave(COLONVAR));} break; case 22: {return(slexsave(LITSYM));} break; case 23: {return(lexsave(MINUS));} break; case 24: {return(LP);} break; case 25: {return(RP);} break; case 26: {return(LB);} break; case 27: {return(RB);} break; case 28: {return(PERIOD);} break; case 29: {return(lexsave(MBAR));} break; case 30: {return(lexsave(MBAR));} break; case 31: {return(lexsave(BAR));} break; case 32: {return(lexsave(BAR));} break; case 33: {return(SEMI);} break; case 34: {return(lexsave(UPARROW));} break; case 35: {return(lexsave(PE));} break; case 36: {return(lexsave(BINARY));} break; case 37: {return(PRIMITIVE);} break; case -1: break; default: fprintf(yyout,"bad switch yylook %d",nstr); } return(0); } /* end of yylex */ static int ocbuf = 0; static int pbbuf[400]; static int input() { int c; if (ocbuf) {c = pbbuf[--ocbuf]; } else { c = getc(fp); if (c == EOF) c = 0; } return(c); } static unput(c) char c; { if (c) pbbuf[ocbuf++] = c; } # include <ctype.h> static readcomment() { char c; while ((c = input()) && c != '\"') if (c == '\n') linenum++; if (!c) yyerror("unterminated comment"); } char *walloc(s) char *s; { char *p, *malloc(); p = malloc((unsigned) (strlen(s) + 1)); if (p == (char *) 0) yyerror("out of variable string space"); strcpy(p, s); return(p); } static int slexsave(type) int type; { yylval.c = walloc(&yytext[1]); if (yylval.c == 0) yerr("cannot create symbol %s", yytext); return(type); } static int lexsave(type) int type; { yylval.c = walloc(yytext); if (yylval.c == 0) yerr("cannot create string %s", yytext); return(type); } static int varlex() { lexsave(0); if (yytext[yyleng-1] == ':') return(KEYWORD); else if (islower(yytext[0])) return(LOWERCASEVAR); else return(UPPERCASEVAR); } static int lexlstr() { char *p, *q; yylval.c = p = walloc(&yytext[1]); *(p + yyleng -2) = '\0'; return(LITSTR); } int yyvstop[] ={ 0, 36, 0, 1, 0, 2, 0, 32, 36, 0, 3, 36, 0, 15, 36, 0, 36, 0, 36, 0, 24, 36, 0, 25, 36, 0, 23, 36, 0, 28, 36, 0, 17, 18, 20, 0, 36, 0, 33, 36, 0, 36, 0, 35, 36, 0, 20, 0, 20, 0, 26, 36, 0, 27, 36, 0, 34, 36, 0, 20, 0, 20, 0, 20, 0, 20, 0, 31, 36, 0, 30, 32, 36, 0, 29, 31, 36, 0, 22, 0, 14, 0, 19, 0, 20, 0, 20, 0, 20, 0, 21, 0, 4, 0, 5, 0, 20, 0, 20, 0, 20, 0, 20, 0, 20, 0, 20, 0, 20, 0, 18, 0, 18, 20, 0, 16, 20, 0, 20, 0, 20, 0, 10, 20, 0, 20, 0, 20, 0, 20, 0, 20, 0, 18, 0, 16, 0, 20, 0, 20, 0, 20, 0, 7, 20, 0, 20, 0, 20, 0, 11, 20, 0, 16, 0, 16, 20, 0, 6, 20, 0, 12, 20, 0, 20, 0, 20, 0, 9, 20, 0, 16, 0, 20, 0, 20, 0, 20, 0, 20, 0, 20, 0, 20, 0, 20, 0, 13, 20, 0, 37, 0, 20, 0, 8, 20, 0, 0}; # define YYTYPE char struct yywork { YYTYPE verify, advance; } yycrank[] ={ 0,0, 0,0, 1,3, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 1,4, 1,5, 0,0, 0,0, 0,0, 4,4, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 1,6, 1,7, 1,8, 1,9, 4,4, 0,0, 1,10, 1,11, 1,12, 0,0, 1,3, 0,0, 1,13, 1,14, 18,42, 1,15, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 1,16, 1,17, 1,18, 0,0, 1,19, 0,0, 0,0, 1,20, 0,0, 1,21, 0,0, 0,0, 0,0, 64,52, 0,0, 64,52, 2,30, 2,7, 2,8, 2,9, 0,0, 0,0, 8,32, 0,0, 2,12, 0,0, 0,0, 0,0, 2,13, 2,14, 8,0, 8,0, 0,0, 1,22, 0,0, 1,23, 1,24, 0,0, 0,0, 1,20, 9,33, 2,16, 2,17, 2,18, 1,25, 2,19, 25,45, 44,57, 9,33, 9,0, 2,21, 21,44, 1,26, 8,0, 26,46, 45,58, 18,43, 1,27, 1,28, 28,50, 8,32, 8,0, 8,0, 10,34, 8,32, 27,47, 1,29, 8,0, 43,56, 8,32, 46,59, 10,34, 10,34, 27,48, 2,22, 47,60, 2,23, 2,24, 9,33, 9,33, 48,61, 27,49, 9,33, 49,62, 50,63, 2,25, 8,32, 9,33, 51,64, 56,69, 57,70, 58,71, 60,72, 2,26, 61,73, 62,74, 63,75, 69,80, 2,27, 2,28, 66,67, 10,35, 10,34, 70,81, 9,33, 10,34, 71,82, 2,31, 72,83, 73,84, 10,34, 74,85, 8,0, 77,76, 80,87, 83,88, 84,89, 87,90, 8,32, 88,91, 89,92, 90,93, 91,94, 92,95, 93,96, 94,97, 95,98, 10,34, 96,99, 97,100, 100,101, 0,0, 0,0, 0,0, 0,0, 0,0, 9,33, 0,0, 0,0, 0,0, 0,0, 15,36, 0,0, 15,15, 15,15, 15,15, 15,15, 15,15, 15,15, 15,15, 15,15, 15,15, 15,15, 15,37, 0,0, 66,76, 0,0, 0,0, 0,0, 10,34, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 15,20, 15,20, 15,20, 15,20, 15,38, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,39, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 15,20, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 0,0, 0,0, 0,0, 16,41, 0,0, 0,0, 0,0, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 16,40, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,37, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 20,20, 32,0, 32,0, 36,51, 36,51, 36,51, 36,51, 36,51, 36,51, 36,51, 36,51, 36,51, 36,51, 52,65, 52,65, 52,65, 52,65, 52,65, 52,65, 52,65, 52,65, 52,65, 52,65, 0,0, 32,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 32,0, 32,0, 38,52, 0,0, 38,52, 0,0, 32,0, 38,53, 38,53, 38,53, 38,53, 38,53, 38,53, 38,53, 38,53, 38,53, 38,53, 53,53, 53,53, 53,53, 53,53, 53,53, 53,53, 53,53, 53,53, 53,53, 53,53, 0,0, 0,0, 0,0, 0,0, 0,0, 39,54, 0,0, 0,0, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 32,0, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 39,55, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 40,40, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 54,66, 55,67, 0,0, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 55,55, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 55,68, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 67,77, 68,78, 0,0, 68,78, 0,0, 0,0, 68,79, 68,79, 68,79, 68,79, 68,79, 68,79, 68,79, 68,79, 68,79, 68,79, 76,78, 0,0, 76,78, 0,0, 0,0, 76,86, 76,86, 76,86, 76,86, 76,86, 76,86, 76,86, 76,86, 76,86, 76,86, 78,86, 78,86, 78,86, 78,86, 78,86, 78,86, 78,86, 78,86, 78,86, 78,86, 79,79, 79,79, 79,79, 79,79, 79,79, 79,79, 79,79, 79,79, 79,79, 79,79, 0,0}; struct yysvf yysvec[] ={ 0, 0, 0, yycrank+-1, 0, 0, yycrank+-42, yysvec+1, 0, yycrank+0, 0, yyvstop+1, yycrank+6, 0, yyvstop+3, yycrank+0, 0, yyvstop+5, yycrank+0, 0, yyvstop+7, yycrank+0, 0, yyvstop+10, yycrank+-80, 0, yyvstop+13, yycrank+-98, 0, yyvstop+16, yycrank+-121, 0, yyvstop+18, yycrank+0, 0, yyvstop+20, yycrank+0, 0, yyvstop+23, yycrank+0, 0, yyvstop+26, yycrank+0, 0, yyvstop+29, yycrank+154, 0, yyvstop+32, yycrank+229, 0, yyvstop+36, yycrank+0, 0, yyvstop+38, yycrank+3, 0, yyvstop+41, yycrank+0, 0, yyvstop+43, yycrank+304, 0, yyvstop+46, yycrank+2, yysvec+20, yyvstop+48, yycrank+0, 0, yyvstop+50, yycrank+0, 0, yyvstop+53, yycrank+0, 0, yyvstop+56, yycrank+8, yysvec+20, yyvstop+59, yycrank+8, yysvec+20, yyvstop+61, yycrank+23, yysvec+20, yyvstop+63, yycrank+4, yysvec+20, yyvstop+65, yycrank+0, 0, yyvstop+67, yycrank+0, 0, yyvstop+70, yycrank+0, 0, yyvstop+74, yycrank+-418, yysvec+8, yyvstop+78, yycrank+0, 0, yyvstop+80, yycrank+0, yysvec+10, 0, yycrank+0, 0, yyvstop+82, yycrank+381, 0, 0, yycrank+0, 0, yyvstop+84, yycrank+417, yysvec+20, yyvstop+86, yycrank+445, yysvec+20, yyvstop+88, yycrank+488, 0, yyvstop+90, yycrank+0, 0, yyvstop+92, yycrank+0, 0, yyvstop+94, yycrank+13, 0, 0, yycrank+9, yysvec+20, yyvstop+96, yycrank+6, yysvec+20, yyvstop+98, yycrank+21, yysvec+20, yyvstop+100, yycrank+26, yysvec+20, yyvstop+102, yycrank+42, yysvec+20, yyvstop+104, yycrank+30, yysvec+20, yyvstop+106, yycrank+26, yysvec+20, yyvstop+108, yycrank+46, yysvec+36, yyvstop+110, yycrank+391, 0, 0, yycrank+427, yysvec+20, yyvstop+112, yycrank+563, 0, 0, yycrank+608, yysvec+20, yyvstop+115, yycrank+43, 0, 0, yycrank+34, yysvec+20, yyvstop+118, yycrank+35, yysvec+20, yyvstop+120, yycrank+0, yysvec+20, yyvstop+122, yycrank+49, yysvec+20, yyvstop+125, yycrank+45, yysvec+20, yyvstop+127, yycrank+53, yysvec+20, yyvstop+129, yycrank+54, yysvec+20, yyvstop+131, yycrank+29, yysvec+52, 0, yycrank+0, yysvec+52, yyvstop+133, yycrank+113, yysvec+54, yyvstop+135, yycrank+651, 0, 0, yycrank+699, yysvec+20, yyvstop+137, yycrank+47, 0, 0, yycrank+47, yysvec+20, yyvstop+139, yycrank+64, yysvec+20, yyvstop+141, yycrank+87, yysvec+20, yyvstop+143, yycrank+60, yysvec+20, yyvstop+146, yycrank+56, yysvec+20, yyvstop+148, yycrank+0, yysvec+20, yyvstop+150, yycrank+714, 0, 0, yycrank+71, yysvec+67, yyvstop+153, yycrank+724, 0, 0, yycrank+734, yysvec+20, yyvstop+155, yycrank+68, 0, 0, yycrank+0, yysvec+20, yyvstop+158, yycrank+0, yysvec+20, yyvstop+161, yycrank+60, yysvec+20, yyvstop+164, yycrank+59, yysvec+20, yyvstop+166, yycrank+0, yysvec+20, yyvstop+168, yycrank+0, yysvec+78, yyvstop+171, yycrank+60, 0, 0, yycrank+67, yysvec+20, yyvstop+173, yycrank+82, yysvec+20, yyvstop+175, yycrank+75, 0, 0, yycrank+82, yysvec+20, yyvstop+177, yycrank+74, yysvec+20, yyvstop+179, yycrank+65, 0, 0, yycrank+83, yysvec+20, yyvstop+181, yycrank+78, yysvec+20, yyvstop+183, yycrank+86, 0, 0, yycrank+73, yysvec+20, yyvstop+185, yycrank+0, yysvec+20, yyvstop+187, yycrank+0, 0, yyvstop+190, yycrank+74, yysvec+20, yyvstop+192, yycrank+0, yysvec+20, yyvstop+194, 0, 0, 0}; struct yywork *yytop = yycrank+791; struct yysvf *yybgin = yysvec+1; char yymatch[] ={ 00 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,011 ,012 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 011 ,01 ,01 ,01 ,01 ,01 ,01 ,047 , '(' ,'(' ,01 ,'+' ,01 ,'+' ,'(' ,01 , '0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' , '0' ,'0' ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' , 'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' , 'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' , 'A' ,'A' ,'A' ,'(' ,01 ,01 ,01 ,01 , 01 ,'a' ,'a' ,'a' ,'a' ,'a' ,'a' ,'a' , 'a' ,'a' ,'a' ,'a' ,'a' ,'a' ,'a' ,'a' , 'a' ,'a' ,'a' ,'a' ,'a' ,'a' ,'a' ,'a' , 'a' ,'a' ,'a' ,01 ,01 ,01 ,01 ,01 , 0}; char yyextra[] ={ 0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0, 0}; /* ncform 4.1 83/08/11 */ int yylineno =1; # define YYU(x) x # define NLSTATE yyprevious=YYNEWLINE char yytext[YYLMAX]; struct yysvf *yylstate [YYLMAX], **yylsp, **yyolsp; char yysbuf[YYLMAX]; char *yysptr = yysbuf; int *yyfnd; extern struct yysvf *yyestate; int yyprevious = YYNEWLINE; yylook(){ register struct yysvf *yystate, **lsp; register struct yywork *yyt; struct yysvf *yyz; int yych; struct yywork *yyr; # ifdef LEXDEBUG int debug; # endif char *yylastch; /* start off machines */ # ifdef LEXDEBUG debug = 0; # endif if (!yymorfg) yylastch = yytext; else { yymorfg=0; yylastch = yytext+yyleng; } for(;;){ lsp = yylstate; yyestate = yystate = yybgin; if (yyprevious==YYNEWLINE) yystate++; for (;;){ # ifdef LEXDEBUG if(debug)fprintf(yyout,"state %d\n",yystate-yysvec-1); # endif yyt = yystate->yystoff; if(yyt == yycrank){ /* may not be any transitions */ yyz = yystate->yyother; if(yyz == 0)break; if(yyz->yystoff == yycrank)break; } *yylastch++ = yych = input(); tryagain: # ifdef LEXDEBUG if(debug){ fprintf(yyout,"char "); allprint(yych); putchar('\n'); } # endif yyr = yyt; if ( (int)yyt > (int)yycrank){ yyt = yyr + yych; if (yyt <= yytop && yyt->verify+yysvec == yystate){ if(yyt->advance+yysvec == YYLERR) /* error transitions */ {unput(*--yylastch);break;} *lsp++ = yystate = yyt->advance+yysvec; goto contin; } } # ifdef YYOPTIM else if((int)yyt < (int)yycrank) { /* r < yycrank */ yyt = yyr = yycrank+(yycrank-yyt); # ifdef LEXDEBUG if(debug)fprintf(yyout,"compressed state\n"); # endif yyt = yyt + yych; if(yyt <= yytop && yyt->verify+yysvec == yystate){ if(yyt->advance+yysvec == YYLERR) /* error transitions */ {unput(*--yylastch);break;} *lsp++ = yystate = yyt->advance+yysvec; goto contin; } yyt = yyr + YYU(yymatch[yych]); # ifdef LEXDEBUG if(debug){ fprintf(yyout,"try fall back character "); allprint(YYU(yymatch[yych])); putchar('\n'); } # endif if(yyt <= yytop && yyt->verify+yysvec == yystate){ if(yyt->advance+yysvec == YYLERR) /* error transition */ {unput(*--yylastch);break;} *lsp++ = yystate = yyt->advance+yysvec; goto contin; } } if ((yystate = yystate->yyother) && (yyt= yystate->yystoff) != yycrank){ # ifdef LEXDEBUG if(debug)fprintf(yyout,"fall back to state %d\n",yystate-yysvec-1); # endif goto tryagain; } # endif else {unput(*--yylastch);break;} contin: # ifdef LEXDEBUG if(debug){ fprintf(yyout,"state %d char ",yystate-yysvec-1); allprint(yych); putchar('\n'); } # endif ; } # ifdef LEXDEBUG if(debug){ fprintf(yyout,"stopped at %d with ",*(lsp-1)-yysvec-1); allprint(yych); putchar('\n'); } # endif while (lsp-- > yylstate){ *yylastch-- = 0; if (*lsp != 0 && (yyfnd= (*lsp)->yystops) && *yyfnd > 0){ yyolsp = lsp; if(yyextra[*yyfnd]){ /* must backup */ while(yyback((*lsp)->yystops,-*yyfnd) != 1 && lsp > yylstate){ lsp--; unput(*yylastch--); } } yyprevious = YYU(*yylastch); yylsp = lsp; yyleng = yylastch-yytext+1; yytext[yyleng] = 0; # ifdef LEXDEBUG if(debug){ fprintf(yyout,"\nmatch "); sprint(yytext); fprintf(yyout," action %d\n",*yyfnd); } # endif return(*yyfnd++); } unput(*yylastch); } if (yytext[0] == 0 /* && feof(yyin) */) { yysptr=yysbuf; return(0); } yyprevious = yytext[0] = input(); if (yyprevious>0) output(yyprevious); yylastch=yytext; # ifdef LEXDEBUG if(debug)putchar('\n'); # endif } } yyback(p, m) int *p; { if (p==0) return(0); while (*p) { if (*p++ == m) return(1); } return(0); } /* the following are only used in the lex library */ yyinput(){ return(input()); } yyoutput(c) int c; { output(c); } yyunput(c) int c; { unput(c); } SHAR_EOF if test 19007 -ne "`wc -c < 'lex.yy.c'`" then echo shar: error transmitting "'lex.yy.c'" '(should have been 19007 characters)' fi fi # end of overwriting check if test -f 'uchar.c' then echo shar: will not over-write existing file "'uchar.c'" else cat << \SHAR_EOF > 'uchar.c' # include "env.h" main() { int i; uchar c; i = 250; c = itouc(i); i = uctoi(c); if (i == 250) printf("success\n"); else printf("failure\n"); } SHAR_EOF if test 164 -ne "`wc -c < 'uchar.c'`" then echo shar: error transmitting "'uchar.c'" '(should have been 164 characters)' fi fi # end of overwriting check cd .. if test ! -d 'newsletters' then mkdir 'newsletters' fi cd 'newsletters' if test -f 'letter2' then echo shar: will not over-write existing file "'letter2'" else cat << \SHAR_EOF > 'letter2' .ds CM .SH \s+9Little Smalltalk Update, Number 2\s0 .PP The good news is that Little Smalltalk has now been distributed to over 100 sites; and that it appears to port rather easily to anything calling itself Unix. The bad news is that with so many sites running the software there were bound to be a few bugs reported. There were. Special thanks go to Charlie Allen of Purdue for not only locating a large number of bugs but also, in most cases, providing fixes. Other bugs (and, in some cases, fixes) were reported by Jan Gray of Waterloo and Charles Hayden of AT&T. .PP The major bugs fixed since the last update include the following: .RS .IP The bug that was causing the fast save routines to fail on the PDP 11/70 and other 16 bit machines was located and fixed (the environment variable was being trashed). .IP Bases were not being checked properly on the ``radix:'' message in classes Integer and Float. A base of zero or one would cause an infinite loop or core dump. A message is now produced in these cases. .IP The confusion over whether instances of Dictionary should return a value or a point in response to first and next was resolved in favor of a value. Various locations using instances of Dictionary were affected by this. .IP The pseudo variable smalltalk was being improperly initialized, and would not respond to at: or at:put:. This has been changed. .IP Empty arrays have been fixed to print correctly. .IP The message at:put: in class String has been fixed to work properly. .IP Bags and Sets have been fixed to print properly. .IP An error in computing the hash value of a Symbol was found and fixed. .IP An error in computing relations between Points was fixed. .IP In various places in Collection and subclasses the message == was used where = should have been used. .RE .PP In addition, the following changes/enhancements were made: .RS .IP An exit was added at the end of main. .IP The message ``perform:withArguments:'', which permits messages to be constructed at run time, was implemented in class Smalltalk. .IP A backtrace routine was added so now when a message is not understood by a receiver not only is an error message printed but a list of messages that were executed leading up to the point of error is printed. .IP The process manager was revised and cleaned up. .IP Hashing was changed so that the modular division is now done in Smalltalk rather than in the primitive. .IP The message ``variables'' was added to class Class. This message returns an array of symbols representing the names of instance variables defined in the class. .IP The mode setting messages for class File were changed from ``asInteger'' (for example) to ``integerMode''. .IP Several messages were added to class Random, including ``randomize'' (by default instances of class Random return the same pseudo-random sequence), \&``randInteger:'' (return a random integer in a given range), and \&``between:and:'' (return a random floating value in a given range). .IP The message ``asDictionary'' (which converts a collection into a Dictionary) was added to class KeyedCollection. .IP The message ``doPrimitive:withArguments:'' was moved from class Object to class Smalltalk. .IP The unary looping messages ``whileTrue'' and ``whileFalse'' were added to class Block. (A program illustrating the use of whileFalse is given in the ``programming corner'' at the end of this newsletter). .IP The message ``date'', returning the current date and time, was added to class Smalltalk. .IP A primitive was added to gain access to the low order bits of the Unix clock, which is accurate to one second. With this, the message ``time:'' was added to class Smalltalk. This message executes a block and returns the elapsed time, to within one second. .IP Instances of class ByteArray were given protocol and made accessible to the user, in addition to being used extensively internally in the Little Smalltalk system. .RE .PP The source for these changes is too large to report here. However, as we announced in the last newsletter, as long as changes and bug fixes continue to be relatively common, anybody who has paid for the distribution tape can obtain the latest sources by merely sending a blank tape back to the University of Arizona at the address given below. .SH Machines .PP To date, successful ports of the Little Smalltalk system have been reported on the following machines: .DS I Amdahl AT&T 3B2 DecPro 350 (running Venix) HP 9000 IBM PC/IX (running Unix) Perkin Elmer (type not known) PDP 11/70 and 11/44 Pyramid 90x Ridge Sequent Vax 780 and 750, both 4.2 and Sys V .DE .PP If you have the Little Smalltalk system running on some machine not listed here, we would be interested in hearing about it. .SH Programs Wanted .PP A textbook is currently under development describing the Little Smalltalk language and its implementation. The book will be divided into two parts, the first of which will describe the language, and could be used in, say, a comparative programming course. The second part will describe in detail the implementation, and could be used in an upper division undergraduate or graduate level seminar on very high level language implementation. .PP As part of the effort of writing this book, we would be most interested in acquiring any unique or interesting applications developed using the Little Smalltalk system. These would be considered for use as examples (with appropriate acknowledgments, of course) or as suggested projects for students to develop. Also programs are solicited for the Programming Corner (below). .SH Rising Costs .PP Due to the increased cost of magnetic tapes and postage, it is unfortunately the case that we must raise the price for the Little Smalltalk system from $15 to $20. Distribution tapes for the Little Smalltalk system can be obtained by sending a check for $20, made out to ``The University of Arizona'' to: .DS I Professor Tim Budd Smalltalk Distribution The Department of Computer Science The University of Arizona Tucson, Arizona 85721 CSNET: budd@arizona UUCP {ucbvax, noao, ihnp4} ! arizona ! budd .DE .SH Programming Corner .PP It is hoped that in the future these newsletters will contain fewer bug reports and more useful information. As an attempt to move in the latter direction, we would eagerly like to solicit short example programs that illustrate the power or utility of Smalltalk. Please send any programs you would like us to consider, along with a short written description, to the address given above. .PP This time we will illustrate the use of \fIgenerators\fP in Smalltalk. We define a generator to be any object that produces a sequence of values in response to the messages \fIfirst\fP and \fInext\fP. In response to either of these message the value \fInil\fP is used to indicate the end of sequence. Generators are an extremely powerful programming tool, and will be discussed in detail in the forthcoming book on Little Smalltalk (discussed above). In the Little Smalltalk standard prelude (the set of classes included at the start of execution) there are many instances of generators. All the various subclasses of Collection, for example, will respond to first and next. Notice, however, that there are basically two approaches used in the subclasses of Collection. Some objects, such as instances of Dictionary or Array, maintain all their values in memory and merely interate over them in response to these messages. Instances of Interval or Random, on the other hand, never maintain the entire list, and produce new elements only on demand. It is the latter approach we will consider here. .PP The problem is to generate the set of prime numbers up to some fixed limit. The algorithm used in the first program is a variation on the sieve of Eratosthenes (see Knuth Vol.2 pages 373-376 for a discussion of this technique). In this program the prime producer proceeds by first constructing a generator for the numbers from 2 to the desired limit, using an Interval. This generator is used to produce the first prime, the number 2. When asked to produce the next prime, a new generator is produced by adding a \fIfilter\fP to the previous generator. The filter (in this case an instance of class Factor) is given two objects; the original generator, and a specific non-negative number. The filter will pass inquiries back to the original generator, but in the process filter out values that have the number as a factor. .PP Pictorially, the underlying generator can be viewed as follows: .DS B .PS line <- box "2 filter" line <- box "2 to: n" "generator" .PE .DE .PP Again, when asked for the next prime, the generator is once more modified by adding a second filter, this time for the last value, the number 3. .DS B .PS line <- box "3 filter" line <- box "2 filter" line <- box "2 to: n" "generator" .PE .DE .PP The program continues, each time a new prime is requested a filter is constructed to remove all factors of the previous prime. In this fashion, all the primes are eventually generated. .PP The code is as follows: .DS I Class Primes | primeGenerator lastFactor | [ first primeGenerator \(<- 2 to: 100. lastFactor \(<- primeGenerator first. \(ua lastFactor | next primeGenerator \(<- (Factor new ; remove: lastFactor from: primeGenerator ). \(ua lastFactor \(<- primeGenerator next ] Class Factor | myFactor generator | [ remove: factorValue from: generatorValue myFactor \(<- factorValue. generator \(<- generatorValue | next | possible | [ (possible \(<- generator next) notNil ] whileTrue: [ (possible \e\e myFactor ~= 0) ifTrue: [ \(ua possible ] ]. \(ua nil ] .DE .PP By way of contrast, a second program will be presented that also generates the list of prime numbers. Unlike the first program, this program always generates the \fIinfinite\fP list of primes. (This difference is largely superficial; the first program could easily be modified to also generate the infinite sequence by merely initializing the internal generator with one that produces the infinite list of natural numbers. Similarly, we could add a specific test to halt the second program after a given point.) .PP Instead of using a filter, this second program builds a recursive chain of generators for each new number considered. Each time a new value is requested, the value of the last prime produced is incremented by one, and a new instance of the primes generator constructed. If any value less than the square root of the putative prime is a factor, the number is rejected. Otherwise, the number is accepted and returned. .DS I Class Primes | lastPrime | [ first \(ua lastPrime \(<- 2 | next [ lastPrime \(<- lastPrime + 1. self testNumber: lastPrime ] whileFalse. \(ua lastPrime | testNumber: n (Primes new) do: [:x | (x squared > n) ifTrue: [ \(ua true ]. (n \e\e x = 0) ifTrue: [ \(ua false ] ] ] .DE .PP The method for the message \fIdo:\fP, inherited from class Object, is implemented in terms of the messages \fIfirst\fP and \fInext\fP, and illustrates the pervasive nature of generators in Little Smalltalk. .PP While the second solution is shorter and requires only one class, it tends to be much less efficient. A possible source for this inefficiency is the need to regenerate the list of primes each time a number is to be tested. To determine the effect of this regeneration a third program was produced that kept an explicit list of the previous primes. .DS I Class Primes | prevPrimes lastPrime | [ first prevPrimes \(<- LinkedList new. prevPrimes add: (lastPrime \(<- 2). \(ua lastPrime | next [ lastPrime \(<- lastPrime + 1. self testNumber: lastPrime ] whileFalse. prevPrimes addLast: lastPrime. \(ua lastPrime | testNumber: n prevPrimes do: [:x | (x squared > n) ifTrue: [ \(ua true ]. (n \\ x = 0) ifTrue: [ \(ua false ] ] ] .DE .PP The third version was about twice as fast as the second, however it requires significantly more space for the list of previous primes. It was still not as efficient as the first program. .PP A final lesson that can be observed concerns the appropriate choce of data structures. I originally wrote the third program using a Set instead of a LinkedList. The LinkedList has the advantage of keeping the values ordered, which is important since small values (such as 2 or 3) tend to be factors of non-primes much more frequently than do larger values. Since the testNumber: loop halts when the first factor is found, the ordering can be significant. .PP The following chart gives the execution time in seconds and the number of memory reference increments and decrements performed by the four algorithms in computing the first 300 primes. While the Unix clock is only accurate to within one second, the increment/decrement count is a fairly reliable measure of computation, since almost every operation requires at least one increment or decrement. .TS center box; l c c l | c | r. Program Time (in seconds) Reference Counts _ 1. Generator and Filters 12 199,987 2. Generators and regeneration 65 690,817 3. Generator and LinkedList 21 331,565 4. Generator and Set 168 2,032,211 .TE SHAR_EOF if test 13177 -ne "`wc -c < 'letter2'`" then echo shar: error transmitting "'letter2'" '(should have been 13177 characters)' fi fi # end of overwriting check if test -f 'letter1' then echo shar: will not over-write existing file "'letter1'" else cat << \SHAR_EOF > 'letter1' .SH \s20Little Smalltalk Update\s0 .PP In the first month of distribution copies of the Little Smalltalk system have been sent out to over 50 sites. Currently it is reported that attempts are being made to port the system to the following machines. Numbers in parenthesis indicate the number of sites using the machine, while asterisk indicates at least one successful port has been reported. .DS L .ta 2i 4i * AT&T 3B2 (2) * Ahmdal (1) Altos 8600 (1) Arete 1100 (1) CRD 68/35 (1) DecPro 350 - P/Os (1) * DecPro 350 - Venix (1) Fortune 32:16 - SYS III (2) HP 3000 (1) * HP 9000 (1) IBM PC - DOS 3.0 (1) Macintosh (1) Masscomp MC 500 (1) Metheus Lambda 4.2 (1) * PDP 11/70 - Berkeley 2.9 (3) PDP 11/70 - Sys V (1) Perkin Elmer 8/32 (1) Pyramid 90x (2) * Ridge (2) VAX 750 - 8th Edition (1) * VAX 750 - Berkeley 4.2 (7) * VAX 780 - Berkeley 4.2 (21) VAX 780 - SYS V (3) VAX 780 ULTRIX (1) .DE .PP If you have the Little Smalltalk system, and have been able to successfully port it to a system I have not indicated here, please send me an electronic note indicating what difficulties (if any) you may have encountered. .SH BUGS .PP Unfortunately, there were also in this first month a number of BUGS reported, and some enhancements made to the system. There were three major bugs: command lines containing pseudo variables did not work correctly, the arbitrary radix form of numbers was not recognized correctly, and the system could get into an infinite loop if an error was encountered during a fastsave. There were also a fair number of less critical bugs reported and fixed. (The class SmallTalk should have been Smalltalk, various error messages were wrong, the parser would sometimes core dump on incorrect programs, and linked lists could sometimes get into an infinite loop). Finally there were several enhancements made to improve the functionality of the system. .PP The attached sheet shows the date each one of these changes was made in the distribution version of the software. You can compare this date to the date shown on your distribution tape - all changes with earlier dates will be reflected in your copy of the software. .PP As a policy, those individuals who have obtained a copy of Little Smalltalk by earlier sending a check for $15 can obtain the lastest distribution \fIfree\fP by merely returning a magnetic tape on which to copy the software. .SH Installation Notes .PP The installation notes distributed along with the Little Smalltalk system were greatly expanded during this first month in reponse to questions and difficulties encountered in installating the system on various machines. Sections were added on fast loading, protections, trouble shooting and further distribution. Since many of you received your distribution before these sections were written, they are reprinted here below. .SH Fast Loading .PP The Little Smalltalk system has the ability to save and restore a user environment by basically moving a copy of all of the users data space into a file. Although this produces rather large files, the savings in time permitted by not having to recreate a specific environment can be substantial. Because this is such an unusual thing to do, it is probably wise, if installing the system on a new machine/operating system, to first comment out the define for FASTDEFAULT in parser/env.h, which will install a system which will not default to doing a fast load. .PP Once such a system has been created and passed all self tests, you can experiment with fast loading by executing the st command with the argument \-f. For test cases you can use the programs in /tests. If it appears to be successful, then (by defining the variable FASTDEFAULT) you should regenerate the system so that the default behavior is to do a fast loading. (When regenerating the system, sources/main.c should be the only file needing to be recompiled). .PP Fastloading does not currently work on the HP-9000, or the DEC-pro 350. It may not work on other machines as well. .SH Protections .PP The directories /sources and /parser need not be readable by casual users. The directory /prelude contains files, however, which must be loaded by the Little Smalltalk system prior to every execution. The protection of this directory, and on the files in it, should therefore be such that all users have READ access. Although the /tests directory is only used during system installation, users may want to refer to it for examples of class descriptions and to see how various problems (8 queens, dinning philosophers) have been solved in Smalltalk. Allowing all users access to the /docs directory will permit a kind of on-line access, however users should not be allowed to modify any files in any directory. .SH Troubleshooting .PP Here are a few of the problems you might run into, and possible solutions: .PP The first thing to suspect if you observe strange behavior is the fastloading feature. Try running the system with the \-m flag, which will turn off fastloading. For example, on the 11/70 fastloading will inhibit the )i command from working correctly, but no error messages will be generated. The appearance of a message such as ``\fIxxx\fP: is not an identifier'', or of can't happen message number 23 is also a clue that fastloading does not work and should be disabled. Similarly, the appearance of the message ``no such context as: \fIxxx\fP/stdsave'' during startup is an indication that the file containing the saved binary form of the standard prelude either does not exist or is unreadable, or that the path given in parser/env.h is wrong. .PP Solutions to problems with fastloading are to try to to recreate the stdsave file in /prelude, or as a last resort to remove the definition for FASTDEFAULT from /parser/env.h and recompile everything. This latter step will configure a system that will not attempt fastloading unless explicitly called for. .PP If the function _gamma is undefined following load for st. Solution: remove the definition for the symbol GAMMA and recompile. .PP No output appears when you start the program, and if you type control-D all the output appears. Solution: define the symbol FLUSHREQ and recompile. .PP Can't happen number 22 - either TEMPFILE is unreadable, or /prelude/standard does not exist. .PP Systems that have trouble with long lines may have difficulty with the file syms.c in /sources (there is one line in that file over 300 characters long). If necessary, this file can (and will be) automatically reconstructed from other files in the directory. .PP Receiving error number 129 whenever any non-primitive class method is called may be a symptom of a clash of variable names. On older systems the variables runningProcess and runningInterpreter would clash on systems that did not support long variable names. The variable runningInterpreter (in process.c) has since been changed to presentInterpreter, so this problem should not occur in software taken from more recent distribution tapes. .SH Further Distribution .PP The Little Smalltalk system is public domain, and may be distributed further as long as proper attribution is given in all published references. .PP In the interests of keeping the distribution up to date and as error free as possible, we wish to keep track of known sites using the system. People interested in being placed on the mailing list for future bug announcements and new version announcements should contact Professor Budd. Changes, modifications, or improvements to the code or the standard library can be submitted also, and will be considered for inclusion in future distributions. SHAR_EOF if test 7613 -ne "`wc -c < 'letter1'`" then echo shar: error transmitting "'letter1'" '(should have been 7613 characters)' fi fi # end of overwriting check if test -f 'letter2.bak' then echo shar: will not over-write existing file "'letter2.bak'" else cat << \SHAR_EOF > 'letter2.bak' .SH \s+9Little Smalltalk Update, Number 2\s0 .PP The good news is that Little Smalltalk has now been distributed to over 100 sites; and that it appears to port rather easily to anything calling itself Unix. The bad news is that with so many sites running the software there were bound to be a few bugs reported. There were. Special thanks go to Charlie Allen of Purdue for not only locating a large number of bugs but also, in most cases, providing fixes. Other bugs (and, in some cases, fixes) were reported by Jan Gray of Waterloo and Charles Hayden of AT&T. .PP The major bugs fixed since the last update include the following: .RS .IP The bug that was causing the fast save routines to fail on the PDP 11/70 and other 16 bit machines was located and fixed (the environment variable was being trashed). .IP The message ``perform:withArguments:'', which permits messages to be constructed at run time, was implemented in class Smalltalk. .IP Bases were not being checked properly on the ``radix:'' message in classes Integer and Float. A base of zero or one would cause an infinite loop or core dump. A message is now produced in these cases. .IP The confusion over whether instances of Dictionary should return a value or a point in response to first and next was resolved in favor of a value. Various locations using Dictionarys were affected by this. .IP The pseudo variable smalltalk was being improperly initialized, and would not respond to at: or at:put:. This has been changed. .IP Empty arrays have been fixed to print correctly. .IP The message at:put: in class String has been fixed to work properly. .IP Bags and Sets have been fixed to print properly. .IP In various places in Collection and subclasses the message == was used where = should have been used. .RE .PP In addition, the following changes/enhancements were made: .RS .IP An exit was added at the end of main. .IP The process manager was revised and cleaned up. .IP Hashing was changed so that the modular division is now done in Smalltalk rather than in the primitive. .IP An error in computing the hash value of a Symbol was found and fixed. .IP The message ``variables'' was added to class Class. This message returns an array of symbols representing the names of instance variables defined in the class. .IP The mode setting messages for class File where changed from ``asInteger'' (for example) to ``integerMode''. .IP Several messages were added to class Random, include ``randomize'' (by default instances of class Random return the same pseudo-random sequence), \&``randInteger:'' (return a random integer in a given range), and \&``between:and:''. .IP The message ``asDictionary'' was added to KeyedCollection. .IP The message ``doPrimitive:withArguments:'' was moved from class Object to class Smalltalk. .IP The message ``date'' was added to class Smalltalk. .IP A primitive was added to gain access to the low order bits of the Unix clock, which is accurate to one second. With this, the message ``time:'' was added to class Smalltalk. This message executes a block and returns the elapsed time, to within one second. .RE .PP The source for these changes is too large to report here. However, as always, anybody who has paid for the distribution tape can obtain the latest sources by merely sending a blank tape back to us here at the University of Arizona. .bp .SH Machines .PP To date, successful ports of the Little Smalltalk system have been reported on the following machines: .DS I Amdahl AT&T 3B2 DecPro 350 HP 9000 IBM PC/IX Perkin Elmer PDP 11/70 and 11/44 Pyramid 90x Ridge Vax 780 and 750, both 4.2 and Sys V .DE .SH Programs Wanted .PP A book is currently under development describing the Little Smalltalk language and implementation. As part of this effort, we would be most interested in acquiring any unique or interesting applications developed using Little Smalltalk. These would be considered for use as examples (with appropriate acknowledgments, of course) or as projects in the book. Also programs are solicited for the Programming Corner (below). .SH Rising Costs .PP Due to the increased cost of magnetic tapes and postage, it is unfortunately the case that we must raise the price for the Little Smalltalk system from $15 to $20. Distribution tapes for the Little Smalltalk system can be obtained by sending a check for $20, made out to ``The University of Arizona'' to: .DS I Professor Tim Budd Smalltalk Distribution The Department of Computer Science The University of Arizona Tucson, Arizona 85721 .DE .SH Programming Corner .PP The following program was contributed by Jan Gray, an undergraduate with the Waterloo Smalltalk Project at the University of Waterloo. The program simulates a simple Turing Machine with a one-way tape. An example TM program is provided which merely changes a run of uppercase I's into lowercase i's. .nf Class Main [ main | tm | tm \(<- TuringMachine new initialize. tm delta state: 0 input: $# nextState: 1 output: $L. tm delta state: 1 input: $I nextState: 1 output: $i. tm delta state: 1 input: $i nextState: 1 output: $L. tm delta state: 1 input: $# nextState: 2 output: $R. tm delta state: 2 input: $i nextState: 2 output: $R. tm delta state: 2 input: $# nextState: 'halt' output: $#. tm tape: 'IIIIII'. tm delta print. tm run ] Class TuringMachine | tape "Infinite tape" state "Current state, TM continues if state is a number" delta "A TransitionTable, which for each (state, input) gives (next state, output)" tapeMoves "A Dictionary which maps L and R into [tape left] and [tape right]" | [ initialize tapeMoves \(<- Dictionary new. tapeMoves at: $L put: [tape left]. tapeMoves at: $R put: [tape right]. delta \(<- TransitionTable new. self tape: ''. self state: 0 | tape: aString tape \(<- Tape new with: aString | state: aState state \(<- aState | delta \(ua delta | step | next | next \(<- delta atState: state input: tape read. state \(<- next state. (state isKindOf: Number) ifTrue: [(tapeMoves includesKey: next symbol) ifTrue: [(tapeMoves at: next symbol) value] ifFalse: [tape write: next symbol]] | run state \(<- 0. self print. [state isKindOf: Number] whileTrue: [self step print] | printString \(ua 'State ', state printString, ', Tape ', tape printString ] Class Pair :Magnitude | state symbol | [ state: aState symbol: aSymbol state \(<- aState. symbol \(<- aSymbol | state \(ua state | symbol \(ua symbol | < aPair \(ua state < aPair state or: [state = aPair state and: [symbol < aPair symbol]] | printString \(ua state printString, ' ', symbol printString ] Class TransitionTable :Dictionary [ state: aState input: in nextState: nextState output: out self at: (Pair new state: aState symbol: in) put: (Pair new state: nextState symbol: out). \(ua nil | atState: aState input: in \(ua self at: (Pair new state: aState symbol: in) ifAbsent: [\(ua Pair new state: 'hung' symbol: nil]. | print 'State Read Next Write' print. self binaryDo: [:x :y | (x printString , ' ', y printString) print] ] Class Tape :Object | tape position | [ with: aString tape \(<- '#', aString, '#'. position \(<- tape size | read \(ua tape at: position | write: aChar tape at: position put: aChar. | left (position > 1) ifTrue: [position \(<- position - 1] | right (position = tape size) ifTrue: [tape \(<- tape, '#']. position \(<- position + 1 | printString \(ua (tape copyFrom: 1 to: position - 1), '{', ((tape at: position) asString), '}', (tape copyFrom: position + 1 to: tape size) ] SHAR_EOF if test 8524 -ne "`wc -c < 'letter2.bak'`" then echo shar: error transmitting "'letter2.bak'" '(should have been 8524 characters)' fi fi # end of overwriting check if test -f 'Makefile' then echo shar: will not over-write existing file "'Makefile'" else cat << \SHAR_EOF > 'Makefile' l1: letter1 itroff -ms letter1 l2: letter2 pic letter2 | tbl | eqn | ditroff -ms SHAR_EOF if test 85 -ne "`wc -c < 'Makefile'`" then echo shar: error transmitting "'Makefile'" '(should have been 85 characters)' fi fi # end of overwriting check cd .. if test ! -d 'tests' then mkdir 'tests' fi cd 'tests' if test -f 'Makefile' then echo shar: will not over-write existing file "'Makefile'" else cat << \SHAR_EOF > 'Makefile' .SUFFIXES : .st .test BINDIR = ../bin FILES = Makefile in *.st *.out .st.test: $(BINDIR)/st -m $*.st <in | diff - $*.out install: @echo Performing Self Checking Tests -make basic.test -make blocks.test -make fork.test -make new.test -make super.test -make copy.test -make num.test -make file.test -make primes.test -make collect.test -make 4queen.test @echo The following produce cycles, thus have nonzero differences -make phil.test @echo Differences in random numbers may change results in following -make sim1.test -make sim2.test @echo Finished Self Checking Tests bundle: bundle $(FILES) >../tests.bundle SHAR_EOF if test 636 -ne "`wc -c < 'Makefile'`" then echo shar: error transmitting "'Makefile'" '(should have been 636 characters)' fi fi # end of overwriting check if test -f 'in' then echo shar: will not over-write existing file "'in'" else cat << \SHAR_EOF > 'in' Main new main SHAR_EOF if test 14 -ne "`wc -c < 'in'`" then echo shar: error transmitting "'in'" '(should have been 14 characters)' fi fi # end of overwriting check if test -f '4queen.st' then echo shar: will not over-write existing file "'4queen.st'" else cat << \SHAR_EOF > '4queen.st' Class Queen | myrow mycolumn neighbor boardsize | [ build: aQueen col: aNumber size: brdmax neighbor <- aQueen. mycolumn <- aNumber. myrow <- 1. boardsize <- brdmax. neighbor first. ^ self | checkCol: colNumber row: rowNumber | cd | (rowNumber = myrow) ifTrue: [ ^ false ]. cd <- colNumber - mycolumn. ((myrow + cd) = rowNumber) ifTrue: [ ^ false ]. ((myrow - cd) = rowNumber) ifTrue: [ ^ false ]. (neighbor isNil) ifFalse: [ ^ neighbor checkCol: colNumber row: rowNumber ]. ^ true | first myrow <- 1. ^ self checkrow | next myrow <- myrow + 1. ^ self checkrow | checkrow (neighbor isNil) ifTrue: [^ myrow]. [myrow <= boardsize] whileTrue: [(neighbor checkCol: mycolumn row: myrow) ifTrue: [^ myrow] ifFalse: [myrow <- myrow + 1] ]. ((neighbor next) isNil) ifTrue: [^ nil]. ^ self first | printboard (neighbor isNil) ifFalse: [ neighbor printboard]. ('Col ', mycolumn asString , ' Row ' , myrow asString) print ] Class Main | lastq | [ main | size | size <- 4. lastq <- nil. (1 to: size) do: [:x | lastq <- Queen new build: lastq col: x size: size ]. lastq first. lastq printboard ] SHAR_EOF if test 1731 -ne "`wc -c < '4queen.st'`" then echo shar: error transmitting "'4queen.st'" '(should have been 1731 characters)' fi fi # end of overwriting check if test -f '8queen.st' then echo shar: will not over-write existing file "'8queen.st'" else cat << \SHAR_EOF > '8queen.st' Class Queen | myrow mycolumn neighbor boardsize | [ build: aQueen col: aNumber size: brdmax neighbor <- aQueen. mycolumn <- aNumber. myrow <- 1. boardsize <- brdmax. neighbor first. ^ self | checkCol: colNumber row: rowNumber | cd | (rowNumber = myrow) ifTrue: [ ^ false ]. cd <- colNumber - mycolumn. ((myrow + cd) = rowNumber) ifTrue: [ ^ false ]. ((myrow - cd) = rowNumber) ifTrue: [ ^ false ]. (neighbor isNil) ifFalse: [ ^ neighbor checkCol: colNumber row: rowNumber ]. ^ true | first myrow <- 1. ^ self checkrow | next myrow <- myrow + 1. ^ self checkrow | checkrow (neighbor isNil) ifTrue: [^ myrow]. [myrow <= boardsize] whileTrue: [(neighbor checkCol: mycolumn row: myrow) ifTrue: [^ myrow] ifFalse: [myrow <- myrow + 1] ]. ((neighbor next) isNil) ifTrue: [^ nil]. ^ self first | printboard (neighbor isNil) ifFalse: [ neighbor printboard]. ('Col ', mycolumn asString , ' Row ' , myrow asString) print ] Class Main | lastq | [ main | size | size <- 8. lastq <- nil. (1 to: size) do: [:x | lastq <- Queen new build: lastq col: x size: size ]. lastq first. lastq printboard ] SHAR_EOF if test 1731 -ne "`wc -c < '8queen.st'`" then echo shar: error transmitting "'8queen.st'" '(should have been 1731 characters)' fi fi # end of overwriting check if test -f 'basic.st' then echo shar: will not over-write existing file "'basic.st'" else cat << \SHAR_EOF > 'basic.st' Class Main [ main 88 print. 3.14159 print. 'this is it' print. #(this is also it) print. 88 respondsTo: #+ ; print. Object respondsTo. smalltalk at: 3 put: #(22 17). (smalltalk at: 3) print. Smalltalk respondsTo. ] SHAR_EOF if test 234 -ne "`wc -c < 'basic.st'`" then echo shar: error transmitting "'basic.st'" '(should have been 234 characters)' fi fi # end of overwriting check if test -f 'blocks.st' then echo shar: will not over-write existing file "'blocks.st'" else cat << \SHAR_EOF > 'blocks.st' Class Main [ main (2 < 3) ifTrue: ['correct-1' print]. ((2 < 3) ifTrue: ['correct-2']) print. [:x | x print] value: 'correct-3' . ((2 < 3) or: [3 < 4]) ifTrue: ['correct-4' print]. ((2 > 3) or: [3 < 4]) ifTrue: ['correct-5' print]. ((2 < 3) and: [3 < 4]) ifTrue: ['correct-6' print]. ((2 > 3) and: [3 < 4]) ifFalse: ['correct-7' print]. self test1 print | test1 self test2: [^ 'correct-8']. 'should not print' print | test2: aBlock self test3: aBlock. 'should not print' print | test3: bBlock bBlock value. 'should not print' print ] SHAR_EOF if test 566 -ne "`wc -c < 'blocks.st'`" then echo shar: error transmitting "'blocks.st'" '(should have been 566 characters)' fi fi # end of overwriting check if test -f 'check.st' then echo shar: will not over-write existing file "'check.st'" else cat << \SHAR_EOF > 'check.st' Class CheckBook | balance | [ new balance <- 0 | + amount balance <- balance + amount. ^ balance | - amount balance <- balance - amount. ^ balance ] SHAR_EOF if test 163 -ne "`wc -c < 'check.st'`" then echo shar: error transmitting "'check.st'" '(should have been 163 characters)' fi fi # end of overwriting check if test -f 'collect.st' then echo shar: will not over-write existing file "'collect.st'" else cat << \SHAR_EOF > 'collect.st' Class Main | i | [ main self test1. self test2. self test3 | test1 | j | (i <- 'example') print. i size print. i asArray print. (i occurrencesOf: $e) print. i asBag print. (j <- i asSet) print. j asString reversed print. i asDictionary print. (j <- i asList) print. j addFirst: 2 / 3. j addAllLast: (12.5 to: 15 by: 0.75). j print. j removeLast print. (j , #($a 7) ) print. (i reject: [:x | x isVowel] ) print. (i copyWithout: $e) print. i sort print. (i sort: [:x :y | y < x]) print. i keys print. i values print. (i atAll: (1 to: 7 by: 2) put: $x) print | test2 | j | i <- (1 to: 6) asBag print. i size print. (i select: [:x | (x \\ 2) strictlyPositive] ) print. (j <- (i collect: [:x | x \\ 3]) asSet ) print. j size print | test3 ('bead' at: 1 put: $r) print ] SHAR_EOF if test 832 -ne "`wc -c < 'collect.st'`" then echo shar: error transmitting "'collect.st'" '(should have been 832 characters)' fi fi # end of overwriting check if test -f 'cond.st' then echo shar: will not over-write existing file "'cond.st'" else cat << \SHAR_EOF > 'cond.st' Class Main [ main | i | ((2 < 3) ifTrue: ['correct']) print. (2 < 3) ifTrue: ['correct' print ]. i <- 1. [i < 3] whileTrue: [i <- i + 1]. (i >= 3) ifTrue: ['correct' print] ] SHAR_EOF if test 189 -ne "`wc -c < 'cond.st'`" then echo shar: error transmitting "'cond.st'" '(should have been 189 characters)' fi fi # end of overwriting check if test -f 'control.st' then echo shar: will not over-write existing file "'control.st'" else cat << \SHAR_EOF > 'control.st' " control the values produced by a generator " Class ControlGenerator :Generator | firstGenerator secondGenerator currentFirst currentSecond controlBlock computeBlock | [ initA: fGen b: sGen control: aBlock compute: anotherBlock firstGenerator <- fGen. secondGenerator <- sGen. controlBlock <- aBlock. computeBlock <- anotherBlock | first currentFirst <- firstGenerator first. currentSecond <- secondGenerator first. (currentFirst isNil & currentSecond isNil) ifTrue: [^ nil]. ^ self controlGeneratorNext | next ^ self controlGeneratorNext | controlGeneratorNext | control returnedValue | control <- 0. [ control anyMask: 12] whileFalse: [ control <- controlBlock value: currentFirst value: currentSecond. (control allMask: 64) ifTrue: [^nil]. (control allMask: 32) ifTrue: [currentFirst <- firstGenerator first]. (control allMask: 16) ifTrue: [currentSecond <- secondGenerator first]. (control allMask: 12) ifTrue: [returnedValue <- computeBlock value: currentFirst value: currentSecond] ifFalse: [ (control allMask: 8) ifTrue: [returnedValue <- computeBlock value: currentFirst]. (control allMask: 4) ifTrue: [returnedValue <- computeBlock value: currentSecond]. ]. (control allMask: 2) ifTrue: [currentFirst <- firstGenerator next]. (control allMask: 1) ifTrue: [currentSecond <- secondGenerator next]. ]. ^ returnedValue ] SHAR_EOF if test 2100 -ne "`wc -c < 'control.st'`" then echo shar: error transmitting "'control.st'" '(should have been 2100 characters)' fi fi # end of overwriting check if test -f 'copy.st' then echo shar: will not over-write existing file "'copy.st'" else cat << \SHAR_EOF > 'copy.st' Class Main | i j k l | [ main i <- Test new. i set: 17. j <- Test new. j set: i. k <- j deepCopy. l <- j shallowCopy. i set: 12. k print. l print. i <- Test new. i set: 17. j <- #(2). j at: 1 put: i. k <- j deepCopy. l <- j shallowCopy. i set: 12. k print. l print. ] Class Test | var | [ printString ^ 'test value ', var printString | set: aVal var <- aVal ] SHAR_EOF if test 404 -ne "`wc -c < 'copy.st'`" then echo shar: error transmitting "'copy.st'" '(should have been 404 characters)' fi fi # end of overwriting check if test -f 'fib.st' then echo shar: will not over-write existing file "'fib.st'" else cat << \SHAR_EOF > 'fib.st' Class Fib :Generator | lastNumber nextToLastNumber | [ first nextToLastNumber <- 0. ^ lastNumber <- 1 | next | sum | sum <- nextToLastNumber + lastNumber. nextToLastNumber <- lastNumber. ^ lastNumber <- sum ] SHAR_EOF if test 246 -ne "`wc -c < 'fib.st'`" then echo shar: error transmitting "'fib.st'" '(should have been 246 characters)' fi fi # end of overwriting check if test -f 'file.st' then echo shar: will not over-write existing file "'file.st'" else cat << \SHAR_EOF > 'file.st' Class Main [ main | f g | f <- File new ; open: 'file.st'. g <- File new ; open: 'foo' for: 'w'. f do: [:x | g write: x reversed]. g <- File new ; open: 'foo' for: 'r'. g do: [:x | x print]. f modeCharacter. f first print. 10 timesRepeat: [ f next print ]. (f at: 2) print. f currentKey print. f size print. ] SHAR_EOF if test 335 -ne "`wc -c < 'file.st'`" then echo shar: error transmitting "'file.st'" '(should have been 335 characters)' fi fi # end of overwriting check if test -f 'fork.st' then echo shar: will not over-write existing file "'fork.st'" else cat << \SHAR_EOF > 'fork.st' Class Main [ loop1 10 timesRepeat: [17 print] | loop2 10 timesRepeat: [23 print] | main [self loop1] fork. self loop2 ] SHAR_EOF if test 132 -ne "`wc -c < 'fork.st'`" then echo shar: error transmitting "'fork.st'" '(should have been 132 characters)' fi fi # end of overwriting check if test -f 'generator.st' then echo shar: will not over-write existing file "'generator.st'" else cat << \SHAR_EOF > 'generator.st' Class Generator :Collection [ , aGenerator ^ DyadicControlGenerator new; firstGen: self secondGen: aGenerator control: [:x :y | (x isNil) ifTrue: [(y isNil) ifTrue: [2r01000000] ifFalse: [2r00000101] ] ifFalse: [2r00001010] ] compute: [:x | x ] | collect: xformBlock ^ MonadicControlGenerator new; initGen: self deepCopy control: [ :x | (x isNil) ifTrue: [2r1000] ifFalse: [2r0101] ] init: [] compute: [:x | xformBlock value: x] | first: limit | count | count <- 0. ^ MonadicControlGenerator new; initGen: self deepCopy control: [ :x | (x isNil) ifTrue: [2r1000] ifFalse: [((count <- count + 1) > limit) ifTrue: [2r1000] ifFalse: [2r0101] ] ] init: [count <- 0] compute: [:x | x] | select: condBlock ^ MonadicControlGenerator new; initGen: self deepCopy control: [ :x | (x isNil) ifTrue: [2r1000] ifFalse: [(condBlock value: x) ifTrue: [2r0101] ifFalse: [2r0001] ] ] init: [] compute: [:x | x] | until: condBlock ^ MonadicControlGenerator new; initGen: self deepCopy control: [ :x | (x isNil) ifTrue: [2r1000] ifFalse: [(condBlock value: x) ifTrue: [2r1000] ifFalse: [2r0101] ] ] init: [] compute: [:x | x] | with: aGenerator when: conditionBlock ^ DyadicControlGenerator new ; firstGen: self secondGen: aGenerator control: [:x :y | (x isNil) ifTrue: [(y isNil) ifTrue: [2r01000000] ifFalse: [2r00000101] ] ifFalse: [(y isNil) ifTrue: [2r00001010] ifFalse: [(conditionBlock value: x value: y) ifTrue: [2r00001010] ifFalse: [2r00000101] ] ] ] compute: [:x | x ] ] Class MonadicControlGenerator :Generator | subGenerator currentValue controlBlock initBlock computeBlock | [ initGen: aGenerator control: conBlk init: iniBlk compute: cmpBlk subGenerator <- aGenerator. controlBlock <- conBlk. initBlock <- iniBlk. computeBlock <- cmpBlk. currentValue <- nil | first (currentValue <- subGenerator first) isNil ifTrue: [^ nil]. initBlock value. ^ self next | next | control returnedValue | control <- 0. [control anyMask: 2r0100] whileFalse: [ control <- controlBlock value: currentValue. (control anyMask: 2r1000) ifTrue: [^ nil]. (control anyMask: 2r0100) ifTrue: [returnedValue <- computeBlock value: currentValue]. (control anyMask: 2r0010) ifTrue: [currentValue <- subGenerator first]. (control anyMask: 2r0001) ifTrue: [currentValue <- subGenerator next] ]. ^ returnedValue ] Class DyadicControlGenerator :Generator | firstGenerator secondGenerator currentFirst currentSecond controlBlock computeBlock | [ firstGen: firstGen secondGen: secondGen control: contBlock compute: compBlock firstGenerator <- firstGen. secondGenerator <- secondGen. controlBlock <- contBlock. computeBlock <- compBlock | first currentFirst <- firstGenerator first. currentSecond <- secondGenerator first. (currentFirst isNil & currentSecond isNil) ifTrue: [^ nil]. ^ self next | next | control returnedValue | control <- 0. [ control anyMask: 2r00001100] whileFalse: [ control <- controlBlock value: currentFirst value: currentSecond. (control allMask: 2r01000000) ifTrue: [^nil]. (control allMask: 2r00100000) ifTrue: [currentFirst <- firstGenerator first]. (control allMask: 2r00010000) ifTrue: [currentSecond <- secondGenerator first]. (control allMask: 2r00001100) ifTrue: [returnedValue <- computeBlock value: currentFirst value: currentSecond] ifFalse: [ (control allMask: 2r00001000) ifTrue: [returnedValue <- computeBlock value: currentFirst]. (control allMask: 2r00000100) ifTrue: [returnedValue <- computeBlock value: currentSecond]. ]. (control allMask: 2r00000010) ifTrue: [currentFirst <- firstGenerator next]. (control allMask: 2r00000001) ifTrue: [currentSecond <- secondGenerator next]. ]. ^ returnedValue ] SHAR_EOF if test 5472 -ne "`wc -c < 'generator.st'`" then echo shar: error transmitting "'generator.st'" '(should have been 5472 characters)' fi fi # end of overwriting check if test -f 'new.st' then echo shar: will not over-write existing file "'new.st'" else cat << \SHAR_EOF > 'new.st' Class Acl | vara | [ new vara <- 'correct' | printa vara print ] Class Bcl :Acl | varb | [ new varb <- 'correct' | printb varb print ] Class Main [ main | i | i <- Bcl new . i printb . i printa ] SHAR_EOF if test 218 -ne "`wc -c < 'new.st'`" then echo shar: error transmitting "'new.st'" '(should have been 218 characters)' fi fi # end of overwriting check if test -f 'num.st' then echo shar: will not over-write existing file "'num.st'" else cat << \SHAR_EOF > 'num.st' Class Main [ testChars ($A max: $a) print. (4 between: 3.1 and: (17/3)) print. ($A < $0) print. $A asciiValue print. $A asString print. $A printString print. $A isVowel print. $A digitValue print | testNums 3 + 4.1 ; print. 3.14159 exp print. 1 pi exp print. 3.5 radians print. 13 roundTo: 5 ; print. 13 truncateTo: 5 ; print. (smalltalk perform: #+ withArguments: #(3 4.1) ) print. (smalltalk doPrimitive: 10 withArguments: #(3 4) ) print | testInts 5 allMask: 4 ; print. 4 allMask: 5 ; print. 5 anyMask: 4 ; print. 5 bitAnd: 3 ; print. 5 bitOr: 3 ; print. 5 bitInvert print. 254 radix: 16 ; print. 5 reciprocal print. -5 // 4 ; print. -5 quo: 4 ; print. -5 \\ 4 ; print. -5 rem: 4 ; print. 4 factorial print. | testFloats 2.1 ^ 4 ; print. 0.5 arcSin print. 4.3 sqrt print. 256 log: 10 ; print. 16rC.ABC print. (14.5408 radix: 16) print. 0.5236 radians sin print. (100 @ 12) transpose print. | main self testChars. self testNums. self testInts. self testFloats. ] SHAR_EOF if test 1052 -ne "`wc -c < 'num.st'`" then echo shar: error transmitting "'num.st'" '(should have been 1052 characters)' fi fi # end of overwriting check if test -f 'phil.st' then echo shar: will not over-write existing file "'phil.st'" else cat << \SHAR_EOF > 'phil.st' Class Main [ main ( DiningPhilosophers new: 5 ) dine: 4 ] Class DiningPhilosophers | diners forks philosophers | [ new: aNumber diners <- aNumber. forks <- Array new: aNumber. philosophers <- Array new: aNumber. (1 to: diners) do: [ :p | forks at: p put: (Semaphore new: 1). philosophers at: p put: (Philosopher new: p)] | dine: time (1 to: diners) do: [ :p | (philosophers at: p) leftFork: (forks at: p) rightFork: (forks at: ((p \\ diners) + 1))]. time timesRepeat: [(1 to: diners) do: [ :p | (philosophers at: p) philosophize]]. (1 to: diners) do: [ :p | (philosophers at: p) sleep] ] Class Philosopher | leftFork rightFork myName myPhilosophy | [ new: name myName <- name. myPhilosophy <- [[true] whileTrue: [self think. self getForks. self eat. self releaseForks. selfProcess suspend] ] newProcess | leftFork: lfork rightFork: rfork leftFork <- lfork. rightFork <- rfork | getForks ((myName \\ 2) == 0) ifTrue: [leftFork wait. rightFork wait] ifFalse: [rightFork wait. leftFork wait] | releaseForks leftFork signal. rightFork signal | think ('Philosopher ',(myName asString),' is thinking.') print. 10 timesRepeat: [selfProcess yield] | eat ('Philosopher ',(myName asString),' is eating.') print. 10 timesRepeat: [selfProcess yield] | philosophize myPhilosophy resume | sleep myPhilosophy terminate. ('Philosopher ',(myName asString),' is sleeping.') print. myPhilosophy <- nil ] SHAR_EOF if test 1592 -ne "`wc -c < 'phil.st'`" then echo shar: error transmitting "'phil.st'" '(should have been 1592 characters)' fi fi # end of overwriting check if test -f 'prime.st' then echo shar: will not over-write existing file "'prime.st'" else cat << \SHAR_EOF > 'prime.st' Class Main [ main | x gen | gen <- Primes new. (smalltalk time: [ x <- gen first. [x < 300] whileTrue: [ x print. x <- gen next] ] ) print. ] Class Primes | lastPrime | [ first ^ lastPrime <- 2 | next [lastPrime <- lastPrime + 1. self testNumber: lastPrime] whileFalse. ^ lastPrime | testNumber: n (Primes new) do: [:x | (x squared > n) ifTrue: [ ^ true ]. (n \\ x = 0) ifTrue: [ ^ false ] ] ] SHAR_EOF if test 428 -ne "`wc -c < 'prime.st'`" then echo shar: error transmitting "'prime.st'" '(should have been 428 characters)' fi fi # end of overwriting check if test -f 'prime3.st' then echo shar: will not over-write existing file "'prime3.st'" else cat << \SHAR_EOF > 'prime3.st' Class Main [ main | x gen | gen <- Primes new. (smalltalk time: [ x <- gen first. [x < 300] whileTrue: [ x print. x <- gen next] ]) print ] Class Primes | prevPrimes lastPrime | [ first prevPrimes <- LinkedList new. prevPrimes add: (lastPrime <- 2). ^ lastPrime | next [lastPrime <- lastPrime + 1. self testNumber: lastPrime] whileFalse. prevPrimes addLast: lastPrime. ^ lastPrime | testNumber: n prevPrimes do: [:x | (x squared > n) ifTrue: [ ^ true ]. (n \\ x = 0) ifTrue: [ ^ false ] ] ] SHAR_EOF if test 533 -ne "`wc -c < 'prime3.st'`" then echo shar: error transmitting "'prime3.st'" '(should have been 533 characters)' fi fi # end of overwriting check if test -f 'prime4.st' then echo shar: will not over-write existing file "'prime4.st'" else cat << \SHAR_EOF > 'prime4.st' Class Main [ main | x gen | gen <- Primes new. (smalltalk time: [x <- gen first. [x < 300] whileTrue: [ x print. x <- gen next] ] ) print ] Class Primes | prevPrimes lastPrime | [ first prevPrimes <- Set new. prevPrimes add: (lastPrime <- 2). ^ lastPrime | next [lastPrime <- lastPrime + 1. self testNumber: lastPrime] whileFalse. prevPrimes add: lastPrime. ^ lastPrime | testNumber: n prevPrimes do: [:x | (n \\ x = 0) ifTrue: [ ^ false ] ]. ^ true ] SHAR_EOF if test 491 -ne "`wc -c < 'prime4.st'`" then echo shar: error transmitting "'prime4.st'" '(should have been 491 characters)' fi fi # end of overwriting check if test -f 'primes.st' then echo shar: will not over-write existing file "'primes.st'" else cat << \SHAR_EOF > 'primes.st' Class Main [ main (Primes new) do: [:x | x print] ] Class Primes | primeGenerator lastFactor | [ first primeGenerator <- 2 to: 300. lastFactor <- primeGenerator first. ^ lastFactor | next primeGenerator <- (Factor new ; remove: lastFactor from: primeGenerator ). ^ lastFactor <- primeGenerator next. ] Class Factor | myFactor generator | [ remove: factorValue from: generatorValue myFactor <- factorValue. generator <- generatorValue | next | possible | [(possible <- generator next) notNil] whileTrue: [(possible \\ myFactor ~= 0) ifTrue: [ ^ possible] ]. ^ nil ] SHAR_EOF if test 618 -ne "`wc -c < 'primes.st'`" then echo shar: error transmitting "'primes.st'" '(should have been 618 characters)' fi fi # end of overwriting check if test -f 'prob.st' then echo shar: will not over-write existing file "'prob.st'" else cat << \SHAR_EOF > 'prob.st' Class DiscreteProbability | randnum | [ initialize randnum <- Random new | next ^ self inverseDistribution: randnum next | computeSample: m outOf: n m > n ifTrue: [^ 0.0] ^ n factorial / (n - m) factorial ] Class Geometric :DiscreteProbability | prob | [ mean: m prob <- m | mean ^ 1.0 / prob | variance ^ (1.0 - prob) / prob * prob | density: x x > 0 ifTrue: [^prob * ((1.0-prob) raisedTo: x-1)] ifFalse: [^1.0] | inverseDistribution: x ^ (x ln / (1.0 - prob) ln) ceiling ] Class Binomial :DiscreteProbability | number prob | [ events: num mean: p (p between: 0.0 and: 1.0) ifFalse: [self error: 'mean must be > 0']. number <- num. prob <- p | mean ^ prob | variance ^ prob * (1 - prob) | density: x (x between: 0.0 and number) ifTrue: [^((self computeSample: x outOf: number) / (self computeSample: x outOf: x)) * (prob raisedTo: x) * ((1 - prob) raisedTo: number - x)] ifFalse: [^0.0] | inverseDistribution: x x <= prob ifTrue: [^ 1] ifFalse: [^ 0] | next | t | t <- 0. number timesRepeat: [t <- t + super next]. ^ t ] SHAR_EOF if test 1118 -ne "`wc -c < 'prob.st'`" then echo shar: error transmitting "'prob.st'" '(should have been 1118 characters)' fi fi # end of overwriting check if test -f 'sim1.st' then echo shar: will not over-write existing file "'sim1.st'" else cat << \SHAR_EOF > 'sim1.st' " Simple Minded simulation from Chapter 6 of book " Class Main [ main | i | i <- IceCreamStore new. [i time < 25] whileTrue: [ i proceed ]. i reportProfits ] Class Simulation | currentTime nextEvent nextEventTime | [ new currentTime <- 0 | time ^ currentTime | addEvent: event at: eventTime nextEvent <- event. nextEventTime <- eventTime | proceed currentTime <- nextEventTime. self processEvent: nextEvent ] Class IceCreamStore :Simulation | profit rand | [ new profit <- 0. rand <- Random new. "rand randomize. taken out so results remain the same" self scheduleArrival | scheduleArrival self addEvent: Customer new at: (self time + (rand randInteger: 5)) | processEvent: event ('customer received at ', self time printString) print. profit <- profit + ( event numberOfScoops * 0.17 ). self scheduleArrival | reportProfits ('profits are ', profit printString) print ] Class Customer | rand | [ new (rand <- Random new) "--randomize (taken out)" | numberOfScoops | number | number <- rand randInteger: 3. ('customer has ', number printString , ' scoops ') print. ^ number ] SHAR_EOF if test 1141 -ne "`wc -c < 'sim1.st'`" then echo shar: error transmitting "'sim1.st'" '(should have been 1141 characters)' fi fi # end of overwriting check if test -f 'sim2.st' then echo shar: will not over-write existing file "'sim2.st'" else cat << \SHAR_EOF > 'sim2.st' " Simple Minded simulation from Chapter 6 of book IceCream Store - single event queue multiple group size discrete probability on number of scoops selected " Class Main [ main | i | i <- IceCreamStore new. [i time < 25] whileTrue: [ i proceed ]. i reportProfits ] Class Simulation | currentTime nextEvent nextEventTime | [ new currentTime <- 0 | time ^ currentTime | addEvent: event at: eventTime nextEvent <- event. nextEventTime <- eventTime | proceed currentTime <- nextEventTime. self processEvent: nextEvent ] Class IceCreamStore :Simulation | profit rand scoopDistribution | [ new profit <- 0. rand <- Random new. (scoopDistribution <- DiscreteProbability new) defineWeights: #(65 25 10). self scheduleArrival | scheduleArrival self addEvent: Customer new at: (self time + (rand randInteger: 5)) | processEvent: event ('customer received at ', self time printString) print. profit <- profit + ((self scoopsFor: event groupSize) * 0.17 ). self scheduleArrival | scoopsFor: group | number | number <- 0. group timesRepeat: [number <- number + scoopDistribution next]. ('group of ', group printString, ' have ', number printString, ' scoops ') print. ^ number | reportProfits ('profits are ', profit printString) print ] Class Customer | groupSize | [ new groupSize <- (Random new "randomize" ) randInteger: 8 | groupSize ^ groupSize ] Class DiscreteProbability | weights rand max | [ defineWeights: anArray weights <- anArray. (rand <- Random new) "randomize". max <- anArray inject: 0 into: [:x :y | x + y] | next | index value | value <- rand randInteger: max. index <- 1. [value > (weights at: index)] whileTrue: [value <- value - (weights at: index). index <- index + 1]. ^ index ] SHAR_EOF if test 1804 -ne "`wc -c < 'sim2.st'`" then echo shar: error transmitting "'sim2.st'" '(should have been 1804 characters)' fi fi # end of overwriting check if test -f 'sim3.st' then echo shar: will not over-write existing file "'sim3.st'" else cat << \SHAR_EOF > 'sim3.st' " Simple Minded simulation from Chapter 6 of book IceCream Store - multiple event queue " Class Main [ main | i | i <- IceCreamStore new. [i time < 60] whileTrue: [ i proceed ]. i reportProfits ] Class Simulation | currentTime eventQueue | [ new eventQueue <- Dictionary new. currentTime <- 0 | time ^ currentTime | addEvent: event at: eventTime (eventQueue includesKey: eventTime) ifTrue: [(eventQueue at: eventTime) add: event] ifFalse: [eventQueue at: eventTime put: (Set new ; add: event)] | addEvent: event next: timeIncrement self addEvent: event at: currentTime + timeIncrement | proceed | minTime eventset event | minTime <- 99999. eventQueue keysDo: [:x | (x < minTime) ifTrue: [minTime <- x]]. currentTime <- minTime. eventset <- eventQueue at: minTime ifAbsent: [^nil]. event <- eventset first. eventset remove: event. (eventset isEmpty) ifTrue: [eventQueue removeKey: minTime]. self processEvent: event ] Class IceCreamStore :Simulation | profit arrivalDistribution rand scoopDistribution remainingChairs | [ new profit <- 0. remainingChairs <- 15. rand <- Random new. (arrivalDistribution <- Normal new) setMean: 3.0 deviation: 1.0. (scoopDistribution <- DiscreteProbability new) defineWeights: #(65 25 10). self scheduleArrival | scheduleArrival | newcustomer time | newcustomer <- Customer new. time <- self time + (arrivalDistribution next). (time < 15) ifTrue: [ self addEvent: [self customerArrival: newcustomer] at: time ] | processEvent: event ('event received at ', self time printString) print. event value. self scheduleArrival | customerArrival: customer | size | size <- customer groupSize. ('group of size ', size printString , ' arrives') print. (size < remainingChairs) ifTrue: [remainingChairs <- remainingChairs - size. 'take chairs, schedule order' print. self addEvent: [self customerOrder: customer] next: (rand randInteger: 3). ] ifFalse: ['finds no chairs, leave' print] | customerOrder: customer | size numScoops | size <- customer groupSize. numScoops <- 0. size timesRepeat: [numScoops <- numScoops + scoopDistribution next]. ('group of size ', size printString, ' orders ' , numScoops printString, ' scoops') print. profit <- profit + (numScoops * 0.17). self addEvent: [self customerLeave: customer] next: (rand randInteger: 5) | customerLeave: customer | size | size <- customer groupSize. ('group of size ', size printString, ' leaves') print. remainingChairs <- remainingChairs + customer groupSize | reportProfits ('profits are ', profit printString) print ] Class Customer | groupSize | [ new groupSize <- (Random new "randomize") randInteger: 8 | groupSize ^ groupSize ] Class DiscreteProbability | weights rand max | [ defineWeights: anArray weights <- anArray. (rand <- Random new) "randomize". max <- anArray inject: 0 into: [:x :y | x + y] | next | index value | value <- rand randInteger: max. index <- 1. [value > (weights at: index)] whileTrue: [value <- value - (weights at: index). index <- index + 1]. ^ index ] Class Normal :Random | mean deviation | [ new self setMean: 1.0 deviation: 0.5 | setMean: m deviation: s mean <- m. deviation <- s | next | v1 v2 s u | s <- 1. [s >= 1] whileTrue: [v1 <- (2 * super next) - 1. v2 <- (2 * super next) - 1. s <- v1 squared + v2 squared ]. u <- (-2.0 * s ln / s) sqrt. ^ mean + (deviation * v1 * u) ] SHAR_EOF if test 3541 -ne "`wc -c < 'sim3.st'`" then echo shar: error transmitting "'sim3.st'" '(should have been 3541 characters)' fi fi # end of overwriting check if test -f 'super.st' then echo shar: will not over-write existing file "'super.st'" else cat << \SHAR_EOF > 'super.st' Class One [ test ^ 1 | result1 ^ self test ] Class Two :One [ test ^ 2 ] Class Three :Two [ result2 ^ self result1 | result3 ^ super test ] Class Four :Three [ test ^ 4 ] Class Main | example1 example2 example3 example4 | [ main example1 <- One new. example2 <- Two new. example3 <- Three new. example4 <- Four new. example1 test print. example1 result1 print. example2 test print. example2 result1 print. example3 test print. example4 result1 print. example3 result2 print. example4 result2 print. example3 result3 print. example4 result3 print ] SHAR_EOF if test 924 -ne "`wc -c < 'super.st'`" then echo shar: error transmitting "'super.st'" '(should have been 924 characters)' fi fi # end of overwriting check if test -f 'temp.st' then echo shar: will not over-write existing file "'temp.st'" else cat << \SHAR_EOF > 'temp.st' Class Main [ main | i | i <- 1. [i < 3] whileTrue: [i print. i <- i + 1] ] SHAR_EOF if test 83 -ne "`wc -c < 'temp.st'`" then echo shar: error transmitting "'temp.st'" '(should have been 83 characters)' fi fi # end of overwriting check if test -f 'turing.st' then echo shar: will not over-write existing file "'turing.st'" else cat << \SHAR_EOF > 'turing.st' " Turing machine simulator contributed by Jan Gray, the University of Waterloo " Class Main [ main | tm | tm <- TuringMachine new initialize. tm delta state: 0 input: $# nextState: 1 output: $L. tm delta state: 1 input: $I nextState: 1 output: $i. tm delta state: 1 input: $i nextState: 1 output: $L. tm delta state: 1 input: $# nextState: 2 output: $R. tm delta state: 2 input: $i nextState: 2 output: $R. tm delta state: 2 input: $# nextState: 'halt' output: $#. tm tape: 'IIIIII'. tm delta print. tm run ] Class TuringMachine | tape "Infinite tape" state "Current state, TM continues if state is a number" delta "A TransitionTable, which for each (state, input) gives (next state, output)" tapeMoves "A Dictionary which maps L and R into [tape left] and [tape right]" | [ initialize tapeMoves <- Dictionary new. tapeMoves at: $L put: [tape left]. tapeMoves at: $R put: [tape right]. delta <- TransitionTable new. self tape: ''. self state: 0 | tape: aString tape <- Tape new with: aString | state: aState state <- aState | delta ^ delta | step | next | next <- delta atState: state input: tape read. state <- next state. (state isKindOf: Number) ifTrue: [(tapeMoves includesKey: next symbol) ifTrue: [(tapeMoves at: next symbol) value] ifFalse: [tape write: next symbol]] | run state <- 0. self print. [state isKindOf: Number] whileTrue: [self step print] | printString ^ 'State ', state printString, ', Tape ', tape printString ] Class Pair :Magnitude | state symbol | [ state: aState symbol: aSymbol state <- aState. symbol <- aSymbol | state ^ state | symbol ^ symbol | < aPair ^ state < aPair state or: [state = aPair state and: [symbol < aPair symbol]] | printString ^ state printString, ' ', symbol printString ] Class TransitionTable :Dictionary [ state: aState input: in nextState: nextState output: out self at: (Pair new state: aState symbol: in) put: (Pair new state: nextState symbol: out). ^ nil | atState: aState input: in ^ self at: (Pair new state: aState symbol: in) ifAbsent: [^ Pair new state: 'hung' symbol: nil]. | print 'State Read Next Write' print. self binaryDo: [:x :y | (x printString , ' ', y printString) print] ] Class Tape :Object | tape position | [ with: aString tape <- '#', aString, '#'. position <- tape size | read ^ tape at: position | write: aChar tape at: position put: aChar. | left (position > 1) ifTrue: [position <- position - 1] | right (position = tape size) ifTrue: [tape <- tape, '#']. position <- position + 1 | printString ^ (tape copyFrom: 1 to: position - 1), '{', ((tape at: position) asString), '}', (tape copyFrom: position + 1 to: tape size) ] SHAR_EOF if test 3680 -ne "`wc -c < 'turing.st'`" then echo shar: error transmitting "'turing.st'" '(should have been 3680 characters)' fi fi # end of overwriting check if test -f 'visitor.st' then echo shar: will not over-write existing file "'visitor.st'" else cat << \SHAR_EOF > 'visitor.st' Class SimulationObject :Object | sizeDist waitDist | [ init sizeDist <- Binomial new initialize events: 5 mean: 0.4. waitDist <- Random new "uniform distribution" | size ^ sizeDist next | wait: sizeGroup "uniform distribution from 1 to 6" ^ waitDist next * sizeGroup * 6 ] Class Visitor :SimulationObject | sizeGroup wait alreadyEaten | [ initialize: superClass sizeGroup <- superClass size. wait <- superClass wait: sizeGroup. alreadyEaten <- false | entering (alreadyEaten == false) ifTrue: [alreadyEaten <- true. ^ true]. ^ false | time ^ wait | groupSize ^ sizeGroup ] SHAR_EOF if test 617 -ne "`wc -c < 'visitor.st'`" then echo shar: error transmitting "'visitor.st'" '(should have been 617 characters)' fi fi # end of overwriting check if test -f '4queen.out' then echo shar: will not over-write existing file "'4queen.out'" else cat << \SHAR_EOF > '4queen.out' Little Smalltalk Col 1 Row 2 Col 2 Row 4 Col 3 Row 1 Col 4 Row 3 Main SHAR_EOF if test 74 -ne "`wc -c < '4queen.out'`" then echo shar: error transmitting "'4queen.out'" '(should have been 74 characters)' fi fi # end of overwriting check if test -f 'basic.out' then echo shar: will not over-write existing file "'basic.out'" else cat << \SHAR_EOF > 'basic.out' Little Smalltalk 88 3.14159 this is it #( #this #is #also #it ) True shallowCopy respondsTo: printString print notNil next isNil isMemberOf: isKindOf: first error: do: deepCopy copy class asSymbol asString ~= = ~~ == #( 22 17 ) time: sh: perform:withArguments: noDisplay doPrimitive:withArguments: displayAssign display debug: date Main SHAR_EOF if test 341 -ne "`wc -c < 'basic.out'`" then echo shar: error transmitting "'basic.out'" '(should have been 341 characters)' fi fi # end of overwriting check if test -f 'blocks.out' then echo shar: will not over-write existing file "'blocks.out'" else cat << \SHAR_EOF > 'blocks.out' Little Smalltalk correct-1 correct-2 correct-3 correct-4 correct-5 correct-6 correct-7 correct-8 Main SHAR_EOF if test 106 -ne "`wc -c < 'blocks.out'`" then echo shar: error transmitting "'blocks.out'" '(should have been 106 characters)' fi fi # end of overwriting check if test -f 'collect.out' then echo shar: will not over-write existing file "'collect.out'" else cat << \SHAR_EOF > 'collect.out' Little Smalltalk example 7 #( $e $x $a $m $p $l $e ) 2 Bag ( $x $l $m $p $a $e $e ) Set ( $l $p $m $a $x $e ) exampl Dictionary ( 1 @ $e 2 @ $x 3 @ $a 4 @ $m 5 @ $p 6 @ $l 7 @ $e ) List ( $e $x $a $m $p $l $e ) List ( 0.666667 $e $x $a $m $p $l $e 12.5 13.25 14 14.75 ) 14.75 List ( 0.666667 $e $x $a $m $p $l $e 12.5 13.25 14 $a 7 ) xmpl xampl aeelmpx xpmleea Set ( 7 6 5 4 3 2 1 ) Bag ( $x $l $m $p $a $e $e ) xxxmxlx Bag ( 1 2 3 4 5 6 ) 6 Bag ( 1 3 5 ) Set ( 2 1 0 ) 3 read Main SHAR_EOF if test 486 -ne "`wc -c < 'collect.out'`" then echo shar: error transmitting "'collect.out'" '(should have been 486 characters)' fi fi # end of overwriting check if test -f 'copy.out' then echo shar: will not over-write existing file "'copy.out'" else cat << \SHAR_EOF > 'copy.out' Little Smalltalk test value test value 17 test value test value 12 #( test value 17 ) #( test value 12 ) Main SHAR_EOF if test 114 -ne "`wc -c < 'copy.out'`" then echo shar: error transmitting "'copy.out'" '(should have been 114 characters)' fi fi # end of overwriting check if test -f 'file.out' then echo shar: will not over-write existing file "'file.out'" else cat << \SHAR_EOF > 'file.out' Little Smalltalk niaM ssalC [ | g f | niam .'ts.elif' :nepo ; wen eliF -< f .'w' :rof 'oof' :nepo ; wen eliF -< g .]desrever x :etirw g | x:[ :od f .'r' :rof 'oof' :nepo ; wen eliF -< g .]tnirp x | x:[ :od g .retcarahCedom f .tnirp tsrif f .] tnirp txen f [ :taepeRsemit 01 .tnirp )2 :ta f( .tnirp yeKtnerruc f .tnirp ezis f ] $C $l $a $s $s $ $M $a $i $n $ $a 3 335 Main SHAR_EOF if test 403 -ne "`wc -c < 'file.out'`" then echo shar: error transmitting "'file.out'" '(should have been 403 characters)' fi fi # end of overwriting check if test -f 'fork.out' then echo shar: will not over-write existing file "'fork.out'" else cat << \SHAR_EOF > 'fork.out' Little Smalltalk 17 23 17 23 17 23 17 23 17 23 17 23 17 23 17 23 17 23 17 23 Main SHAR_EOF if test 86 -ne "`wc -c < 'fork.out'`" then echo shar: error transmitting "'fork.out'" '(should have been 86 characters)' fi fi # end of overwriting check if test -f 'new.out' then echo shar: will not over-write existing file "'new.out'" else cat << \SHAR_EOF > 'new.out' Little Smalltalk correct correct Main SHAR_EOF if test 42 -ne "`wc -c < 'new.out'`" then echo shar: error transmitting "'new.out'" '(should have been 42 characters)' fi fi # end of overwriting check if test -f 'num.out' then echo shar: will not over-write existing file "'num.out'" else cat << \SHAR_EOF > 'num.out' Little Smalltalk $a True False 65 A $A True 10 7.1 23.1406 23.1407 3.5 radians 15 10 7.1 7 True False True 1 7 -6 16rFE 0.2 -2 -1 1 -1 24 19.4481 0.523599 radians 2.07364 2.40824 12.6709 16rE.8A71DE 0.500001 12 @ 100 Main SHAR_EOF if test 226 -ne "`wc -c < 'num.out'`" then echo shar: error transmitting "'num.out'" '(should have been 226 characters)' fi fi # end of overwriting check if test -f 'phil.out' then echo shar: will not over-write existing file "'phil.out'" else cat << \SHAR_EOF > 'phil.out' Little Smalltalk Philosopher 1 is thinking. Philosopher 2 is thinking. Philosopher 3 is thinking. Philosopher 4 is thinking. Philosopher 1 is eating. Philosopher 5 is thinking. Philosopher 3 is eating. Philosopher 5 is eating. Philosopher 2 is eating. Philosopher 4 is eating. Philosopher 1 is thinking. Philosopher 2 is thinking. Philosopher 3 is thinking. Philosopher 4 is thinking. Philosopher 1 is eating. Philosopher 5 is thinking. Philosopher 3 is eating. Philosopher 5 is eating. Philosopher 2 is eating. Philosopher 4 is eating. Philosopher 1 is sleeping. Philosopher 2 is sleeping. Philosopher 3 is sleeping. Philosopher 4 is sleeping. Philosopher 5 is sleeping. Main SHAR_EOF if test 681 -ne "`wc -c < 'phil.out'`" then echo shar: error transmitting "'phil.out'" '(should have been 681 characters)' fi fi # end of overwriting check if test -f 'primes.out' then echo shar: will not over-write existing file "'primes.out'" else cat << \SHAR_EOF > 'primes.out' Little Smalltalk 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 Main SHAR_EOF if test 245 -ne "`wc -c < 'primes.out'`" then echo shar: error transmitting "'primes.out'" '(should have been 245 characters)' fi fi # end of overwriting check if test -f 'sim1.out' then echo shar: will not over-write existing file "'sim1.out'" else cat << \SHAR_EOF > 'sim1.out' Little Smalltalk customer received at 4 customer has 3 scoops customer received at 5 customer has 3 scoops customer received at 8 customer has 3 scoops customer received at 10 customer has 3 scoops customer received at 13 customer has 3 scoops customer received at 14 customer has 3 scoops customer received at 19 customer has 3 scoops customer received at 23 customer has 3 scoops customer received at 27 customer has 3 scoops profits are 4.59 Main SHAR_EOF if test 463 -ne "`wc -c < 'sim1.out'`" then echo shar: error transmitting "'sim1.out'" '(should have been 463 characters)' fi fi # end of overwriting check if test -f 'sim2.out' then echo shar: will not over-write existing file "'sim2.out'" else cat << \SHAR_EOF > 'sim2.out' Little Smalltalk customer received at 4 group of 7 have 10 scoops customer received at 5 group of 7 have 9 scoops customer received at 8 group of 7 have 11 scoops customer received at 10 group of 7 have 7 scoops customer received at 13 group of 7 have 9 scoops customer received at 14 group of 7 have 10 scoops customer received at 19 group of 7 have 11 scoops customer received at 23 group of 7 have 8 scoops customer received at 27 group of 7 have 8 scoops profits are 14.11 Main SHAR_EOF if test 495 -ne "`wc -c < 'sim2.out'`" then echo shar: error transmitting "'sim2.out'" '(should have been 495 characters)' fi fi # end of overwriting check if test -f 'sim3.out' then echo shar: will not over-write existing file "'sim3.out'" else cat << \SHAR_EOF > 'sim3.out' Little Smalltalk event received at 3.46877 group of size 7 arrives take chairs, schedule order event received at 5.81336 group of size 7 arrives take chairs, schedule order event received at 6.46877 group of size 7 orders 10 scoops event received at 6.81336 group of size 7 orders 9 scoops event received at 8.81336 group of size 7 leaves event received at 8.91228 group of size 7 arrives take chairs, schedule order event received at 9.46877 group of size 7 leaves event received at 10.9123 group of size 7 orders 11 scoops event received at 10.9499 group of size 7 arrives take chairs, schedule order event received at 11.1909 group of size 7 arrives finds no chairs, leave event received at 11.9123 group of size 7 leaves event received at 11.9204 group of size 7 arrives take chairs, schedule order event received at 12.3266 group of size 7 arrives finds no chairs, leave event received at 13.1723 group of size 7 arrives finds no chairs, leave event received at 13.6961 group of size 7 arrives finds no chairs, leave event received at 13.7641 group of size 7 arrives finds no chairs, leave event received at 13.9204 group of size 7 orders 7 scoops event received at 13.9499 group of size 7 orders 9 scoops event received at 14.3689 group of size 7 arrives finds no chairs, leave event received at 14.3911 group of size 7 arrives finds no chairs, leave event received at 16.9499 group of size 7 leaves event received at 17.9204 group of size 7 leaves profits are 7.82 Main SHAR_EOF if test 1481 -ne "`wc -c < 'sim3.out'`" then echo shar: error transmitting "'sim3.out'" '(should have been 1481 characters)' fi fi # end of overwriting check if test -f 'super.out' then echo shar: will not over-write existing file "'super.out'" else cat << \SHAR_EOF > 'super.out' Little Smalltalk 1 1 2 2 2 4 2 4 2 2 Main SHAR_EOF if test 46 -ne "`wc -c < 'super.out'`" then echo shar: error transmitting "'super.out'" '(should have been 46 characters)' fi fi # end of overwriting check if test -f 'foo' then echo shar: will not over-write existing file "'foo'" else cat << \SHAR_EOF > 'foo' niaM ssalC [ | g f | niam .'ts.elif' :nepo ; wen eliF -< f .'w' :rof 'oof' :nepo ; wen eliF -< g .]desrever x :etirw g | x:[ :od f .'r' :rof 'oof' :nepo ; wen eliF -< g .]tnirp x | x:[ :od g .retcarahCedom f .tnirp tsrif f .] tnirp txen f [ :taepeRsemit 01 .tnirp )2 :ta f( .tnirp yeKtnerruc f .tnirp ezis f ] SHAR_EOF if test 335 -ne "`wc -c < 'foo'`" then echo shar: error transmitting "'foo'" '(should have been 335 characters)' fi fi # end of overwriting check cd .. # End of shell archive exit 0