'From Squeak2.6 of 12 October 1999 [latest update: #1559] on 10 November 1999 at 10:08:29 am'! "Change Set: Smalltalk-72 Date: May 1999 Author: Dan Ingalls This file implements Smalltalk-72 within Squeak. In addition to this file you should have ALLDEFS -- the nearly original bootstrap file with updated comments ST72Font10.sf2 -- the original ST-72 font, converted from Alto format. After filing in, execute... ST72Context bootFrom: 'ALLDEFS' This will open a transcript, and read the file of bootstrap definitions. You should then follow instructions shown in the transcript. The following things WORK at this point... The scrolling read-eval-print loop The menu-driven code editor The pretty printer The turtle The following things do NOT yet work The file system (this should all be thrown out and replaced by a simple set of primitives using the Squeak file system) The debugger (it was never much, but it would be nice to show a walkback and then do an automatic restart) The leech class, used by the debugger and classPrinter (some of the class table format has changed, and we might want to go back to the integer accessor codes) Some fun things to type in the ST-72 window (followed by cursor-up)... 3 + 4 The smoke test. 355.0 / 113 Test floating-point. for i _ 1 to 300 do (@ go i turn 89) Turtle geometry example Enjoy. "! Object subclass: #ST72Accessor instanceVariableNames: 'type index ' classVariableNames: '' poolDictionaries: '' category: 'Smalltalk-72'! Object subclass: #ST72Object instanceVariableNames: '' classVariableNames: 'ClassTableForArray ClassTableForAtom ClassTableForFalse ClassTableForFloat ClassTableForNumber ClassTableForString ' poolDictionaries: '' category: 'Smalltalk-72'! ST72Object subclass: #ST72Context instanceVariableNames: 'instance class return message global temps pc code mode value subEval ' classVariableNames: 'InputStream LeftArrow NoEval OpenColon OutputStream PrimitiveTable Quote ST72Style STPen Stats TopLev TraceOn Trans ' poolDictionaries: '' category: 'Smalltalk-72'! ST72Object class instanceVariableNames: 'table '! TranscriptStream subclass: #ST72TranscriptStream instanceVariableNames: 'readRequestBlock ' classVariableNames: '' poolDictionaries: '' category: 'Smalltalk-72'! !Object methodsFor: 'user interface' stamp: 'di 5/17/1999 21:26'! evaluateSelection: selectionStream inEditor: editor | rcvr ctxt result | (self respondsTo: #doItReceiver) ifTrue: [FakeClassPool adopt: self selectedClass. "Include pool vars if any" rcvr _ self doItReceiver. ctxt _ self doItContext] ifFalse: [rcvr _ ctxt _ nil]. result _ rcvr class evaluatorClass new evaluate: selectionStream in: ctxt to: rcvr notifying: editor ifFail: [FakeClassPool adopt: nil. ^ #failedDoit]. FakeClassPool adopt: nil. ^ result ! ! !Object methodsFor: 'Smalltalk-72' stamp: 'di 11/10/1999 09:36'! isAtom ^ false! ! !Object methodsFor: 'Smalltalk-72' stamp: 'di 11/10/1999 09:37'! isClass ^ false! ! !Object class methodsFor: 'Smalltalk-72' stamp: 'di 11/10/1999 09:36'! classTable: aDictionary ST72Object classTable: aDictionary forClass: self! ! !Object class methodsFor: 'Smalltalk-72' stamp: 'di 11/10/1999 09:36'! isClass ^ true! ! !Array class methodsFor: 'Smalltalk-72' stamp: 'di 11/10/1999 09:34'! classTable ^ ST72Object classTableForArray! ! !False class methodsFor: 'Smalltalk-72' stamp: 'di 11/10/1999 09:34'! classTable ^ ST72Object classTableForFalse! ! !Float class methodsFor: 'Smalltalk-72' stamp: 'di 11/10/1999 09:34'! classTable ^ ST72Object classTableForFloat! ! !ParagraphEditor methodsFor: 'do-its' stamp: 'di 5/17/1999 21:27'! evaluateSelection "Treat the current selection as an expression; evaluate it and return the result" | result | self lineSelectAndEmptyCheck: [^ '']. result _ model evaluateSelection: self selectionAsStream inEditor: self. Smalltalk logChange: self selection string. ^ result! ! !ReadWriteStream methodsFor: 'accessing' stamp: 'di 5/17/1999 22:43'! contentsRemaining ^ collection copyFrom: position+1 to: readLimit! ! !ST72Accessor methodsFor: 'as yet unclassified' stamp: 'di 5/15/1999 23:18'! getValueFromTemps: temps orInstance: instance type == #temp ifTrue: [^ temps at: index]. type == #ivar ifTrue: [^ instance instVarAt: index]. self error! ! !ST72Accessor methodsFor: 'as yet unclassified' stamp: 'di 5/15/1999 23:18'! putValue: aValue intoTemps: temps orInstance: instance type == #temp ifTrue: [^ temps at: index put: aValue]. type == #ivar ifTrue: [^ instance instVarAt: index put: aValue]. self error! ! !ST72Accessor methodsFor: 'as yet unclassified' stamp: 'di 5/6/1999 22:30'! type: t index: i type _ t. index _ i.! ! !ST72Accessor class methodsFor: 'as yet unclassified' stamp: 'di 5/6/1999 22:29'! type: t index: i ^ self new type: t index: i! ! !ST72Context commentStamp: 'di 11/10/1999 09:55' prior: 0! This class simulates the Smalltalk-72 language. It opens a transcript, reads a file of bootstrap definitions, and then responds to further definitions and commands from the transcript. Happy Birthday, Alan!! Dan Ingalls 5/99! !ST72Context methodsFor: 'initialization' stamp: 'di 5/18/1999 11:12'! instance: inst class: cls return: ret message: msg global: glob temps: tempArray code: cod subEval: sub instance _ inst. class _ cls. return _ ret. message _ msg. global _ glob. temps _ tempArray. code _ cod. pc _ 0. subEval _ sub. TraceOn ifTrue: [Trans cr; cr; print: return; cr; nextPutAll: 'calls '; print: self; endEntry]! ! !ST72Context methodsFor: 'printing' stamp: 'di 5/14/1999 22:19'! printOn: strm strm nextPutAll: class name; space; nextPutAll: (mode == nil ifTrue: ['nil'] ifFalse: [mode]) , ':'. 1 to: code size do: [:i | pc = (i-1) ifTrue: [strm nextPutAll: ' ->']. ((code at: i) isMemberOf: Array) ifTrue: [strm nextPutAll: ' (...)'] ifFalse: [strm space; print: (code at: i)]]. pc >= code size ifTrue: [strm nextPutAll: ' ->']. ! ! !ST72Context methodsFor: 'printing' stamp: 'di 5/15/1999 09:51'! printStack | c cs | c _ self. cs _ OrderedCollection new. [c == nil] whileFalse: [cs addLast: c. c _ c return]. cs _ cs asArray. ^ String streamContents: [:s | cs do: [:a | s cr; nextPutAll: 'arec', (cs indexOf: a) printString , ': '; print: a; cr; tab; tab; nextPutAll: 'retn=', 'arec', (cs indexOf: a return) printString; tab; nextPutAll: 'mess=', 'arec', (cs indexOf: a message) printString; tab; nextPutAll: 'glob=', 'arec', (cs indexOf: a global) printString]]! ! !ST72Context methodsFor: 'printing' stamp: 'di 5/15/1999 09:35'! stackDepth | c i | c _ self. i _ 1. [c == nil] whileFalse: [i _ i+1. c _ c return]. ^ i! ! !ST72Context methodsFor: 'access' stamp: 'di 5/9/1999 23:53'! classs "Missspelled to avoid clash with class" ^ class! ! !ST72Context methodsFor: 'access' stamp: 'di 5/9/1999 23:52'! global ^ global! ! !ST72Context methodsFor: 'access' stamp: 'di 5/9/1999 23:51'! instance ^ instance! ! !ST72Context methodsFor: 'access' stamp: 'di 5/9/1999 23:51'! message ^ message! ! !ST72Context methodsFor: 'access' stamp: 'di 5/9/1999 22:12'! mode ^ mode! ! !ST72Context methodsFor: 'access' stamp: 'di 5/13/1999 12:25'! return ^ return! ! !ST72Context methodsFor: 'access' stamp: 'di 5/13/1999 13:59'! temps ^ temps! ! !ST72Context methodsFor: 'access' stamp: 'di 5/9/1999 16:22'! value ^ value! ! !ST72Context methodsFor: 'eval' stamp: 'di 11/10/1999 08:25'! apply "Apply the current value to remaining stream." | token | value == nil ifTrue: [^ mode _ #eval]. (token _ self peekToken) == nil ifTrue: [^ mode _ #eval]. token == #. ifTrue: [^ mode _ #eval]. token == #? ifTrue: [value == false ifTrue: [^ self nextToken; conditional: false]]. token == #is ifTrue: [self nextToken. ^ value _ self nextToken == (value class classTable at: #TITLE)]. value _ self activate: value ! ! !ST72Context methodsFor: 'eval' stamp: 'di 5/18/1999 08:18'! apply: aValue value _ aValue. mode == #return ifTrue: [^ self]. mode _ #apply! ! !ST72Context methodsFor: 'eval' stamp: 'di 5/18/1999 21:24'! conditional: theBoolean | subVector | subVector _ self nextToken. theBoolean ifFalse: [^ mode _ #eval]. (subVector isMemberOf: Array) ifFalse: [self error]. self returnValue: ((ST72Context new instance: instance class: class return: self message: message global: global temps: temps code: subVector subEval: subEval) evaluate) ! ! !ST72Context methodsFor: 'eval' stamp: 'di 11/10/1999 09:26'! eval | token | (token _ self nextToken) == nil ifTrue: [^ self returnValue: instance]. token == #CODE ifTrue: [^ self perform: (PrimitiveTable at: self nextToken)]. token == #% ifTrue: [^ self apply: (self matchNextFrom: message) "... add a quick skip of ?() here later for speed..."]. token == #: ifTrue: [^ self fetchFrom: message inContext: message]. token == #? ifTrue: [^ self conditional: true]. token == #. ifTrue: [^ self]. token == #!! ifTrue: [^ self returnValue: (self fetchFrom: self) to: message]. token == Quote ifTrue: [^ self apply: self nextToken]. token == OpenColon ifTrue: [^ self apply: message nextToken]. token == NoEval ifTrue: [^ value _ self valueAt: self nextToken]. value _ token isAtom ifTrue: [self valueAt: token] ifFalse: [token]. value == nil ifTrue: [self error: token printString , ' has no value.'.] ifFalse: [self apply: (self activate: value)] ! ! !ST72Context methodsFor: 'eval' stamp: 'di 5/18/1999 13:46'! evalOnce | applyPC | mode _ #eval. self eval. "Eval once..." applyPC _ 0. [mode == #apply and: [pc > applyPC and: [pc < code size]]] whileTrue: [applyPC _ pc. "Keep applying until return or no progress" self apply]. ^ value ! ! !ST72Context methodsFor: 'eval' stamp: 'di 5/18/1999 13:11'! evaluate mode _ #eval. [self peekToken == #. ifTrue: [self nextToken]. mode == #return or: [pc >= code size]] whileFalse: [self evalOnce]. mode == #return ifTrue: [^ value]. "Active return" subEval ifTrue: "Result of subList eval" [pc < code size ifTrue: [mode _ #apply]. ^ value]. instance == nil ifFalse: [^ instance]. "Return the instance if there is one" ^ value " ...otherwise return the current value"! ! !ST72Context methodsFor: 'eval' stamp: 'di 5/13/1999 21:01'! reset pc _ 0! ! !ST72Context methodsFor: 'activation' stamp: 'di 11/10/1999 08:29'! activate: classOrInst | inst cls | (classOrInst == true or: [classOrInst class == ST72Context]) ifTrue: [^ classOrInst]. "Currently no ST72 semantics" classOrInst isClass ifTrue: [inst _ nil. cls _ classOrInst] ifFalse: [inst _ classOrInst. cls _ classOrInst class]. ^ (ST72Context new instance: inst class: cls return: self message: self global: self temps: (Array new: (cls classTable at: #ARSIZE)) code: (cls classTable at: #DO) subEval: false) evaluate! ! !ST72Context methodsFor: 'activation' stamp: 'di 5/18/1999 14:38'! returnValue: aValue value _ aValue. value == false ifTrue: [message == nil ifFalse: [message peekToken == #? ifTrue: [message nextToken; nextToken]]]. mode _ #return! ! !ST72Context methodsFor: 'activation' stamp: 'di 5/21/1999 14:21'! returnValue: val to: context "Climb the stack, setting return flags along the way." | caller | caller _ self. [caller == context] whileFalse: [caller returnValue: val. caller _ caller return]. "caller returnValue: val" context apply: val! ! !ST72Context methodsFor: 'messages' stamp: 'di 5/14/1999 22:45'! fetchFrom: ctxt ctxt peekToken == #. ifTrue: [^ nil]. ^ ctxt evalOnce! ! !ST72Context methodsFor: 'messages' stamp: 'di 11/10/1999 09:26'! fetchFrom: msg inContext: glob | nextToken token | nextToken _ self peekToken. nextToken == Quote ifTrue: [self nextToken. ^ self bind: msg nextToken]. nextToken == NoEval ifTrue: [self nextToken. token _ msg nextToken. ^ self bind: (token isAtom ifTrue: [msg valueAt: token] ifFalse: [token])]. msg evalOnce. self apply: (self bind: msg value)! ! !ST72Context methodsFor: 'messages'! implicitEval: aVector "Repeats an acknowleged crock in the original ST72 intepreter: Test if an inlined vector should be evalled if it is the same as the last message token and that is not preceded by a quote(!!)" ^ (code at: pc) == aVector and: [pc = 1 or: [(code at: pc-1) ~~ Quote]]! ! !ST72Context methodsFor: 'messages' stamp: 'di 5/11/1999 17:46'! match: token from: msg "Peek ahead in the message stream. If the next token matches this one, then advance the message stream and return the token. If not, then do not advance the message, and return false." msg peekToken == token ifTrue: [msg nextToken. ^ true] ifFalse: [^ false] ! ! !ST72Context methodsFor: 'messages' stamp: 'di 5/11/1999 17:45'! matchNextFrom: msg "The next token in the code stream is an atom to be matched. Peek ahead in the message stream. If the next token matches this one, then advance the message stream and return the token. If not, then do not advance the message, and return false." | token | token _ self nextToken. ^ self match: token from: msg! ! !ST72Context methodsFor: 'messages' stamp: 'di 5/10/1999 00:38'! nextToken | token | token _ pc = code size ifTrue: [nil] ifFalse: [code at: (pc _ pc + 1)]. "Transcript cr; nextPutAll: '==> '; print: token; endEntry." ^ token! ! !ST72Context methodsFor: 'messages' stamp: 'di 5/8/1999 20:46'! peekToken pc = code size ifTrue: [^ nil]. ^ code at: pc + 1! ! !ST72Context methodsFor: 'lookup' stamp: 'di 11/10/1999 09:29'! bind: aValue "Look ahead and if the next token is an atom, then store aValue as the value of that variable." | token | value _ aValue. token _ self peekToken. token == nil ifTrue:[^ value]. token == #. ifTrue:[^ value]. token isAtom ifFalse: [^ self error]. self nextToken. self valueAt: token put: value. ^ value ! ! !ST72Context methodsFor: 'lookup' stamp: 'di 11/10/1999 09:20'! bootValueAt: token "Tolerates code written in no context, defaulting to the top-level dictionary." class == nil ifTrue: [^ TopLev at: token ifAbsent: [^ nil]]. ^ self valueAt: token! ! !ST72Context methodsFor: 'lookup' stamp: 'di 11/10/1999 09:22'! bootValueAt: token put: aValue "Tolerates code written in no context, defaulting to the top-level dictionary." class == nil ifTrue: [^ TopLev at: token put: aValue]. ^ self valueAt: token put: aValue! ! !ST72Context methodsFor: 'lookup' stamp: 'di 11/10/1999 09:27'! valueAt: token "Look up and return the value of this variable. If the variable does not exist at this level, then resend to global." | val | token == #SELF ifTrue: [^ instance]. token == #MESS ifTrue: [^ message]. token == #GLOB ifTrue: [^ global]. val _ class classTable at: token ifAbsent: [global == nil ifTrue: [^ nil] ifFalse: [^ global valueAt: token]]. val class == ST72Accessor ifTrue: [^ val getValueFromTemps: temps orInstance: instance] ifFalse: [^ val]! ! !ST72Context methodsFor: 'lookup' stamp: 'di 11/10/1999 09:31'! valueAt: token put: aValue "Look up this variable and store aValue as its new value. If the variable does not exist at this level, then resend to global." | val | token == #MESS ifTrue: [^ message _ aValue "fasten seat belts"]. token == #GLOB ifTrue: [^ global _ aValue "fasten seat belts"]. val _ class classTable at: token ifAbsent: [global == nil ifTrue:[^ class classTable at: token put: aValue] ifFalse: [^ global valueAt: token put: aValue]]. val class == ST72Accessor ifTrue: [^ val putValue: aValue intoTemps: temps orInstance: instance] ifFalse: [^ class classTable at: token put: aValue]! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/13/1999 09:19'! codeAgain "Implements again, the loop restart primitive." | caller | caller _ self. [caller mode == #repeat] whileFalse: [caller setMode: #return. caller _ caller return]. self returnValue: nil! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 11/10/1999 08:31'! codeApply "Applies temp1 to caller's message or a vector in temp2." | mess classOrInst inst cls | (temps at: 2) == nil ifTrue: [mess _ message] ifFalse: [code _ temps at: 2. pc _ 0. mess _ self]. (classOrInst _ temps at: 1) isClass ifTrue: [inst _ nil. cls _ classOrInst] ifFalse: [inst _ classOrInst. cls _ classOrInst class]. self returnValue: (ST72Context new instance: inst class: cls return: self message: mess message global: message temps: (Array new: (cls classTable at: #ARSIZE)) code: (cls classTable at: #DO) subEval: false) evaluate! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 11/10/1999 09:30'! codeAtom "Implements primitive operations of atoms." | nextToken | (nextToken _ message peekToken) == nil ifTrue: [^ self returnValue: instance]. nextToken == #_ ifTrue: [message nextToken. value _ self fetchFrom: message. global valueAt: instance put: value. ^ self returnValue: value]. nextToken == #eval ifTrue: [message nextToken. ^ self returnValue: (message valueAt: instance)]. nextToken == #= ifTrue: [message nextToken. ^ self returnValue: instance == (self fetchFrom: message)]. nextToken == #chars ifTrue: [message nextToken. ^ self returnValue: instance asString]. ! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/21/1999 14:36'! codeDClearEtc "Implements the basic BitBlt operations." | destRect color | value = 0 ifTrue: [destRect _ self fetchRect. color _ (self fetchFrom: message) = 1 ifTrue: [Color white] ifFalse: [Color black]. Display fill: destRect fillColor: color]. value = 1 ifTrue: [Display reverse: self fetchRect]. value = 2 ifTrue: [self halt]. value = 3 ifTrue: [self halt]. ! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/15/1999 15:00'! codeDisp "Implements output to a character display." OutputStream nextPut: (Character value: (temps at: 1)) "; endEntry". self returnValue: (temps at: 1)! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/15/1999 17:01'! codeDone "Implements done, the loop termination primitive." | caller | caller _ self. [caller mode == #repeat] whileFalse: [caller returnValue: nil. caller _ caller return]. caller returnValue: (temps at: 1). self returnValue: nil! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/18/1999 08:40'! codeEq "Implements test for two identical objects" self returnValue: self fetch == self fetch! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/14/1999 22:47'! codeFalse "Implements primitive operations of false." | nextToken | (nextToken _ message peekToken) == nil ifTrue: [^ self returnValue: instance]. nextToken == #or ifTrue: [message nextToken. ^ self returnValue: (self fetchFrom: message)]. (nextToken == #and or: [nextToken == #< or: [nextToken == #= or: [nextToken == #>]]]) ifTrue: [message nextToken. self fetchFrom: message. self returnValue: instance]. ! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/21/1999 00:21'! codeFloat "Implements primitive operations of floating-point numbers." | nextToken | (nextToken _ message peekToken) == nil ifTrue: [^ self returnValue: instance]. "Arithmetic ops, +, -, etc." nextToken == #+ ifTrue: [^ self advanceAndApply: #+]. nextToken == #- ifTrue: [^ self advanceAndApply: #-]. nextToken == #* ifTrue: [^ self advanceAndApply: #*]. nextToken == #/ ifTrue: [^ self advanceAndApply: #/]. nextToken == #< ifTrue: [^ self advanceAndCompare: #<]. nextToken == #= ifTrue: [^ self advanceAndCompare: #=]. nextToken == #> ifTrue: [^ self advanceAndCompare: #>]. nextToken == #<= ifTrue: [^ self advanceAndCompare: #<=]. nextToken == NoEval "#" ifTrue: [^ self advanceAndCompare: #~=]. nextToken == #>= ifTrue: [^ self advanceAndCompare: #>=]. nextToken == #ipart ifTrue: [message nextToken. ^ self returnValue: instance integerPart asInteger]. nextToken == #fpart ifTrue: [message nextToken. ^ self returnValue: instance fractionPart]. ! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 11/10/1999 09:30'! codeFor "Implements repeat, the looping primitive." | codeVector var currentValue increment finalValue ctxt | codeVector _ temps at: 6. var _ temps at: 4. "induction variable" currentValue _ temps at: 5. "starting value" increment _ temps at: 2. finalValue _ temps at: 3. value _ nil. ctxt _ ST72Context new instance: message instance class: message classs return: self message: message message global: message global temps: message temps code: codeVector subEval: true. mode _ #repeat. [mode == #repeat and: [increment < 0 ifTrue: [currentValue >= finalValue] ifFalse: [currentValue <= finalValue]]] whileTrue: [ctxt valueAt: var put: currentValue. ctxt reset; evaluate. currentValue _ currentValue + increment]. self returnValue: value "done will store into this"! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 11/10/1999 07:54'! codeGet "Implements the GET primitive." | cls name | cls _ temps at: 1. name _ temps at: 2. self returnValue: (cls classTable at: name ifAbsent: [nil])! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/14/1999 00:15'! codeIsnew "Implements isnew." self returnValue: message doIsnew! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/23/1999 22:52'! codeKbd | kbVal | InputStream closed ifTrue: [[Sensor keyboardPressed] whileFalse. kbVal _ Sensor keyboard asciiValue. kbVal = 59 ifTrue: [kbVal _ 3]. "Map semicolon to ST72 open colon" kbVal = 96 ifTrue: [kbVal _ 19]. "Map open-string-quote to apost-s" self returnValue: kbVal] ifFalse: [self returnValue: InputStream next asciiValue] ! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/21/1999 13:58'! codeMouse "Implements access to mouse x, y and buttons." temps first < 8 ifTrue: [^ self returnValue: (Sensor buttons bitAnd: temps first)]. temps first = 8 ifTrue: [^ self returnValue: Sensor cursorPoint x]. temps first = 9 ifTrue: [^ self returnValue: Sensor cursorPoint y]. ! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/18/1999 21:36'! codeNumber "Implements primitive operations of integers." | nextToken | (nextToken _ message peekToken) == nil ifTrue: [^ self returnValue: instance]. "Arithmetic ops, +, -, etc." nextToken == #+ ifTrue: [^ self advanceAndApply: #+]. nextToken == #- ifTrue: [^ self advanceAndApply: #-]. nextToken == #* ifTrue: [^ self advanceAndApply: #*]. nextToken == #/ ifTrue: [^ self advanceAndApply: #//]. nextToken == #mod ifTrue: [^ self advanceAndApply: #\\]. nextToken == #< ifTrue: [^ self advanceAndCompare: #<]. nextToken == #= ifTrue: [^ self advanceAndCompare: #=]. nextToken == #> ifTrue: [^ self advanceAndCompare: #>]. nextToken == #<= ifTrue: [^ self advanceAndCompare: #<=]. nextToken == NoEval "#" ifTrue: [^ self advanceAndCompare: #~=]. nextToken == #>= ifTrue: [^ self advanceAndCompare: #>=]. nextToken == #& ifTrue: ["Logical ops, &+, &-, etc." message nextToken. nextToken _ message peekToken. nextToken == #+ ifTrue: [^ self advanceAndApply: #bitOr:]. nextToken == #- ifTrue: [^ self advanceAndApply: #bitXor:]. nextToken == #* ifTrue: [^ self advanceAndApply: #bitAnd:]. nextToken == #/ ifTrue: [^ self advanceAndApply: #bitShift:]]. ! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 11/10/1999 09:12'! codePut "Implements the PUT primitive." | cls name val | cls _ temps at: 1. name _ temps at: 2. val _ temps at: 3. cls classTable at: name put: val. self returnValue: nil. ! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/21/1999 14:23'! codeRead "Implements read, the bootstrap read routine." | rd caller | (temps size > 0 and: [temps first ~~ nil]) ifTrue: [^ self returnValue: (Scanner new initForST72 scanTokens: temps first)]. rd _ (self class readFrom: InputStream). rd == nil ifTrue: ["Return to the top level at end of bootstrap." caller _ self. [caller == nil] whileFalse: [caller returnValue: nil. caller _ caller return]. ^ self]. self returnValue: rd! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/14/1999 17:54'! codeRepeat "Implements repeat, the looping primitive." | codeVector ctxt | codeVector _ temps at: 1. ctxt _ ST72Context new instance: message instance class: message classs return: self message: message message global: message global temps: message temps code: codeVector subEval: true. mode _ #repeat. [mode == #repeat] whileTrue: [ctxt reset; evaluate]. self returnValue: value "done will store into this"! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/21/1999 11:05'! codeStrVec "Implements primitive operations of strings and vectors." | val subscript | instance == nil "isnew" ifTrue: [^ self returnValue: (class new: (self fetchFrom: message))]. class == Array ifTrue: ["Only vectors respond to eval" ((message implicitEval: instance) or: [self match: #eval from: message]) ifTrue: [val _ (ST72Context new instance: message instance class: message classs return: self message: message message global: message temps: message temps code: instance subEval: true) evaluate. ^ self returnValue: val]]. (self match: #length from: message) ifTrue: [^ self returnValue: instance size]. (self match: #[ from: message) ifTrue: [subscript _ self fetchFrom: message. temps at: 1 put: subscript. "For access by substr hack" (self match: #] from: message) ifTrue: [(self match: #_ from: message) ifTrue: [value _ self fetchFrom: message. instance at: subscript put: (class == String ifTrue: [Character value: (value bitAnd: 255)] ifFalse: [value]). ^ self returnValue: value] ifFalse: [value _ instance at: subscript. class == String ifTrue: [^ self returnValue: value asciiValue] ifFalse: [^ self returnValue: value]]] ifFalse: [(self match: #to from: message) ifTrue: [^ self apply: true] ifFalse: [self error: 'Missing close bracket']]]. "Note CODE 3 has very special fall-through behavior -- if it does something, then it causes an active return if it doesn't do anything, then it applies false if it sees [i to ..., then it applies true to invoke SUBSTR" "Should just fall back into eval for further code" ^ self apply: false ! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/20/1999 16:43'! codeStream "Implements primitive operations of streams." | index buffer length val | instance == nil ifTrue: [^ self]. index _ instance instVarAt: 1. buffer _ instance instVarAt: 2. length _ instance instVarAt: 3. (self match: #_ from: message) ifTrue: [val _ self fetchFrom: message. index >= length ifTrue: [buffer _ buffer , (buffer species new: buffer size). instance instVarAt: 2 put: buffer]. instance instVarAt: 1 put: (index _ index + 1). buffer at: index put: val. ^ self returnValue: val]. (self match: #next from: message) ifTrue: [index >= length ifTrue: [^ self returnValue: 0]. instance instVarAt: 1 put: (index _ index + 1). ^ self returnValue: (buffer at: index)]. (self match: #contents from: message) ifTrue: [^ self returnValue: (buffer copyFrom: 1 to: index)]. ! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/23/1999 15:16'! codeSubstr "Implements the substr package." | op item lb ub s s2 lb2 repSize | op _ temps at: 1. item _ temps at: 2. s _ temps at: 3. lb _ temps at: 4. ub _ temps at: 5. (s isMemberOf: String) ifTrue: [item _ Character value: item]. op = 0 ifTrue: [s atAll: (lb to: ub) put: item. ^ self returnValue: s]. op = 1 ifTrue: [lb to: (ub min: s size) do: [:i | (s at: i) = item ifTrue: [^ self returnValue: i]]. ^ self returnValue: 0]. op = 2 ifTrue: [(ub min: s size) to: lb by: -1 do: [:i | (s at: i) = item ifTrue: [^ self returnValue: i]]. ^ self returnValue: 0]. op = 3 ifTrue: [lb to: (ub min: s size) do: [:i | (s at: i) ~= item ifTrue: [^ self returnValue: i]]. ^ self returnValue: 0]. op = 4 ifTrue: [(ub min: s size) to: lb by: -1 do: [:i | (s at: i) ~= item ifTrue: [^ self returnValue: i]]. ^ self returnValue: 0]. s2 _ temps at: 6. lb2 _ temps at: 7. op = 5 ifTrue: [repSize _ ub - lb + 1 min: s2 size - lb2 + 1. s replaceFrom: lb to: lb + repSize - 1 with: s2 startingAt: lb2. ^ self returnValue: s]. op = 6 ifTrue: [ub > s size ifTrue: [^ self returnValue: (s copyFrom: lb to: s size) , (String new: ub - s size)] ifFalse: [^ self returnValue: (s copyFrom: lb to: ub)]]. ! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/21/1999 14:07'! codeTextFrame "Implements the text and display frame operations." | ins insertLoc arg bs mx my char ixFirstAndLast cBlock width | value = 0 ifTrue: [arg _ self fetchFrom: message. arg isInteger ifTrue: [bs _ arg=8. ins _ (String with: (Character value: arg)) asText] ifFalse: [bs _ false. ins _ arg asText]. self realParagraphFrom: instance do: [:para | insertLoc _ para text size + 1. bs ifTrue: [para replaceFrom: insertLoc-1 to: insertLoc - 1 with: Text new displaying: true] ifFalse: [para replaceFrom: insertLoc to: insertLoc - 1 with: ins displaying: true]. [(para characterBlockForIndex: para text size) bottom > para clippingRectangle bottom] whileTrue: [self scrollParagraph: para]]. ^ self returnValue: arg]. value = 1 ifTrue: [self realParagraphFrom: instance do: [:para | para replaceFrom: 1 to: para text size with: Text new displaying: true]. Display fillWhite: ((self dispWindow: instance) intersect: (self dispFrame: instance)). ^ self returnValue: instance]. value = 3 ifTrue: [self realParagraphFrom: instance do: [:para | para displayOn: Display]. ^ self returnValue: instance]. value = 4 ifTrue: [Display fillWhite: ((self dispWindow: instance) intersect: (self dispFrame: instance)). ^ self "may be followed by, eg, 3 CODE 51"]. value = 6 ifTrue: [mx _ self fetchFrom: message. my _ self fetchFrom: message. self realParagraphFrom: instance do: [:para | char _ (para characterBlockAtPoint: mx@my) stringIndex. ixFirstAndLast _ self findTokenIndexOf: char in: para text string. cBlock _ para characterBlockForIndex: ixFirstAndLast second. width _ (para characterBlockForIndex: ixFirstAndLast third + 1) left - cBlock left]. ^ self returnValue: (Array with: ixFirstAndLast first with: cBlock left with: width with: cBlock top)]. value = 7 ifTrue: [mx _ self fetchFrom: message. my _ self fetchFrom: message. self realParagraphFrom: instance do: [:para | char _ (para characterBlockAtPoint: mx@my) stringIndex]. ^ self returnValue: char]. self halt: 'Unimplemented Text op'! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/15/1999 23:26'! codeTo "Implements to, the class-defining primitive." | title tempNames ivars cvars token | title _ message nextToken. tempNames _ OrderedCollection new. ivars _ OrderedCollection new. cvars _ OrderedCollection new. token _ message nextToken. [token isAtom and: [token ~~ #:]] whileTrue: [tempNames add: token. token _ message nextToken]. (token isKindOf: Array) ifTrue: [^ self to: title temps: tempNames ivars: ivars cvars: cvars code: token]. token == #: ifTrue: [token _ message nextToken] ifFalse: [self error: 'missing '':''']. [token isAtom and: [token ~~ #:]] whileTrue: [ivars add: token. token _ message nextToken]. (token isKindOf: Array) ifTrue: [^ self to: title temps: tempNames ivars: ivars cvars: cvars code: token]. token == #: ifTrue: [token _ message nextToken] ifFalse: [self error: 'missing '':''']. [token isAtom and: [token ~~ #:]] whileTrue: [cvars add: token. token _ message nextToken]. (token isKindOf: Array) ifTrue: [^ self to: title temps: tempNames ivars: ivars cvars: cvars code: token]. self error: 'missing code vector'! ! !ST72Context methodsFor: 'code primitives' stamp: 'di 5/21/1999 08:38'! codeTurtle "Implements primitive operations of turtles." (self match: #go from: message) ifTrue: [self realPenFrom: instance do: [:pen | pen go: self fetch]]. (self match: #turn from: message) ifTrue: [self realPenFrom: instance do: [:pen | pen turn: self fetch]]. (self match: #goto from: message) ifTrue: [self realPenFrom: instance do: [:pen | pen goto: self fetch @ self fetch]]. ! ! !ST72Context methodsFor: 'code support' stamp: 'di 5/18/1999 12:51'! advanceAndApply: selector message nextToken. self returnValue: (instance perform: selector with: (self fetchFrom: message))! ! !ST72Context methodsFor: 'code support' stamp: 'di 5/18/1999 12:53'! advanceAndCompare: selector "Whacky ST72 comparisons mix booleans with numbers as in 0 char ifTrue: [^ Array with: i with: strix with: strix + tokenStr size-1]]. self error: 'problem in findToken'! ! !ST72Context methodsFor: 'code support' stamp: 'di 5/18/1999 09:17'! nextAndFetch message nextToken. ^self fetchFrom: message! ! !ST72Context methodsFor: 'code support' stamp: 'di 5/21/1999 11:11'! realParagraphFrom: inst do: aBlock "Load paragraph from inst, evaluate the block, and store back into inst." | para buf last cb | "Load the paragraph which we have stached in the editor field." para _ inst instVarAt: 18. para == nil ifTrue: ["If nil, create a new paragaph." buf _ instance instVarAt: 16. last _ instance instVarAt: 9. para _ Paragraph withText: (buf copyFrom: 1 to: last) asText style: ST72Style compositionRectangle: (self dispFrame: inst) clippingRectangle: (self dispWindow: inst) foreColor: Color black backColor: Color white. instance instVarAt: 18 put: para] ifFalse: ["Check if frames have changes; if so recompose." para destinationForm: Display. para compositionRectangle = (self dispFrame: inst) ifFalse: [para composeAll]. para clippingRectangle = (self dispWindow: inst) ifFalse: [para composeAll]]. aBlock value: para. "store the various paramters back into the instance" buf _ para text string. instance instVarAt: 9 put: buf size. "last" instance instVarAt: 11 put: "lastln" (para numberOfLines = 0 ifTrue: [1] ifFalse: [(para lines at: para numberOfLines) first]). cb _ para characterBlockForIndex: buf size. instance instVarAt: 12 put: cb right. "charx" instance instVarAt: 13 put: cb top. "chary" instance instVarAt: 16 put: buf. ! ! !ST72Context methodsFor: 'code support' stamp: 'di 5/21/1999 09:17'! realPenFrom: inst do: aBlock "Load STPen from inst, evaluate the block, and store back into inst." | color width | STPen == nil ifTrue: [STPen _ Pen new]. STPen squareNib: (width _ inst instVarAt: 3). (color _ inst instVarAt: 2) isInteger ifTrue: [color = 1 ifTrue: [STPen color: Color white] ifFalse: [STPen color: Color black]] ifFalse: [STPen color: (Color perform: color)]. STPen location: ((inst instVarAt: 6) @ (inst instVarAt: 7)) - (width//2) direction: (inst instVarAt: 4) asFloat penDown: (inst instVarAt: 1) = 1. (inst instVarAt: 5) = 1 ifTrue: [STPen combinationRule: Form reverse] ifFalse: [STPen combinationRule: Form over]. "STPen clipRect: (self dispWindow: (inst instVarAt: 9))" aBlock value: STPen. inst instVarAt: 4 put: STPen direction. inst instVarAt: 6 put: STPen location x + (width//2). inst instVarAt: 7 put: STPen location y + (width//2). ! ! !ST72Context methodsFor: 'code support' stamp: 'di 5/20/1999 23:41'! scrollParagraph: para "Remove the top line of this paragraph." | endLineOne | endLineOne _ para characterBlockAtPoint: para compositionRectangle topLeft + (0@para lineGrid) + (1@2). para replaceFrom: 1 to: endLineOne stringIndex - 1 with: Text new displaying: true. "Adjust mark" instance instVarAt: 10 put: (instance instVarAt: 10) - (endLineOne stringIndex - 1). ! ! !ST72Context methodsFor: 'code support' stamp: 'di 11/10/1999 09:23'! to: title temps: tempNames ivars: ivars cvars: cvars code: codeVector "Create a new class, or identify an existing one or Squeak equivalent" | ix sqName theClass ivarString dict | ix _ #(number vector atom string arec float falseclass) indexOf: title. ix > 0 ifTrue: ["Alias common types to Squeak system classes" sqName _ #(SmallInteger Array Symbol String ST72Arec Float False) at: ix. theClass _ Smalltalk at: sqName] ifFalse: [ivarString _ String streamContents: [:s | ivars do: [:v | s space; nextPutAll: v]]. (theClass _ global bootValueAt: title) == nil ifTrue: ["Circumlocution to reuse all existing class machinery." theClass _ ST72Object subclass: #ST72Thing instanceVariableNames: ivarString classVariableNames: '' poolDictionaries: '' category: 'ST72'. Smalltalk removeKey: #ST72Thing. SystemOrganization removeElement: #ST72Thing. theClass instVarNamed: 'name' put: title]]. title == #USER ifTrue: [dict _ TopLev "USER provides the top-level table."] ifFalse: [dict _ IdentityDictionary new]. dict at: #TABLE put: dict. theClass classTable: dict. tempNames withIndexDo: [:temp :i | dict at: temp put: (ST72Accessor type: #temp index: i)]. ivars withIndexDo: [:ivar :i | dict at: ivar put: (ST72Accessor type: #ivar index: i)]. cvars withIndexDo: [:cvar :i | dict at: cvar put: nil "OR old value if redef"]. dict at: #TITLE put: title. dict at: #DO put: codeVector. dict at: #ARSIZE put: tempNames size. global bootValueAt: title put: theClass. temps isEmpty ifFalse: [temps at: 1 put: title]. ^ value _ title ! ! !ST72Object class methodsFor: 'all' stamp: 'di 11/10/1999 09:07'! classTable ^ table! ! !ST72Object class methodsFor: 'all' stamp: 'di 11/10/1999 08:49'! classTable: aDictionary table _ aDictionary! ! !ST72Object class methodsFor: 'all' stamp: 'di 11/10/1999 08:59'! classTable: aDictionary forClass: aSqueakClass aSqueakClass == Array ifTrue: [^ ClassTableForArray _ aDictionary]. aSqueakClass == Symbol ifTrue: [^ ClassTableForAtom _ aDictionary]. aSqueakClass == False ifTrue: [^ ClassTableForFalse _ aDictionary]. aSqueakClass == Float ifTrue: [^ ClassTableForFloat _ aDictionary]. aSqueakClass == SmallInteger ifTrue: [^ ClassTableForNumber _ aDictionary]. aSqueakClass == String ifTrue: [^ ClassTableForString _ aDictionary]. self error: 'unrecognized system class' ! ! !ST72Object class methodsFor: 'all' stamp: 'di 11/10/1999 08:05'! classTableForArray ^ ClassTableForArray! ! !ST72Object class methodsFor: 'all' stamp: 'di 11/10/1999 08:06'! classTableForAtom ^ ClassTableForAtom! ! !ST72Object class methodsFor: 'all' stamp: 'di 11/10/1999 08:05'! classTableForFalse ^ ClassTableForFalse! ! !ST72Object class methodsFor: 'all' stamp: 'di 11/10/1999 08:05'! classTableForFloat ^ ClassTableForFloat! ! !ST72Object class methodsFor: 'all' stamp: 'di 11/10/1999 08:05'! classTableForNumber ^ ClassTableForNumber! ! !ST72Object class methodsFor: 'all' stamp: 'di 11/10/1999 08:06'! classTableForString ^ ClassTableForString! ! !ST72Object class methodsFor: 'all' stamp: 'di 6/10/1999 10:05'! removeST72classes "Remove any ST72 classes left from prior builds..." subclasses asOrderedCollection do: [:c | (Smalltalk includesKey: c name) ifFalse: [self removeSubclass: c]]. ! ! !ST72Context class methodsFor: 'initialize' stamp: 'di 5/21/1999 11:27'! initPrimitiveTable "ST72Context initPrimitiveTable" PrimitiveTable _ #( codeRepeat "CODE 01" codeRead "CODE 02" codeStrVec "CODE 03" codeNumber "CODE 04" codeIsnew "CODE 05" codeAgain "CODE 06" codeMissing "CODE 07" codeMissing "CODE 08" codeMissing "CODE 09" codeApply "CODE 10" codeFalse "CODE 11" codePut "CODE 12" codeMissing "CODE 13" codeMissing "CODE 14" codeEq "CODE 15" codeMissing "CODE 16" codeMissing "CODE 17" codeMissing "CODE 18" codeTo "CODE 19" codeKbd "CODE 20" codeTurtle "CODE 21" codeStream "CODE 22" codeDisp "CODE 23" codeFor "CODE 24" codeDone "CODE 25" codeMissing "CODE 26" codeMissing "CODE 27" codeGet "CODE 28" codeAtom "CODE 29" codeMissing "CODE 30" codeMissing "CODE 31" codeMissing "CODE 32" codeMissing "CODE 33" codeMissing "CODE 34" codeMouse "CODE 35" codeMissing "CODE 36" codeMissing "CODE 37" codeMissing "CODE 38" codeMissing "CODE 39" codeSubstr "CODE 40" codeMissing "CODE 41" codeFloat "CODE 42" codeMissing "CODE 43" codeMissing "CODE 44" codeMissing "CODE 45" codeMissing "CODE 46" codeMissing "CODE 47" codeMissing "CODE 48" codeMissing "CODE 49" codeMissing "CODE 50" codeTextFrame "CODE 51" codeDClearEtc "CODE 52" codeMissing "CODE 53" codeMissing "CODE 54" codeMissing "CODE 55" codeMissing "CODE 56" codeMissing "CODE 57" codeMissing "CODE 58" codeMissing "CODE 59" codeMissing "CODE 60" codeMissing "CODE 61" codeMissing "CODE 62" codeMissing "CODE 63" codeMissing "CODE 64" codeMissing "CODE 65" codeMissing "CODE 66" codeMissing "CODE 67" codeMissing "CODE 68" codeMissing "CODE 69" codeMissing "CODE 70" )! ! !ST72Context class methodsFor: 'initialize' stamp: 'di 5/23/1999 22:59'! initialize "ST72Context initialize" Quote _ '"' asSymbol. OpenColon _ (Character value: 3) asString asSymbol. LeftArrow _ '_' asSymbol. NoEval _ '#' asSymbol. self initPrimitiveTable. (TextConstants includesKey: #ST72) ifFalse: [TextConstants at: #ST72 put: (TextStyle fontArray: (Array with: (StrikeFont new readFromStrike2: 'ST72Font10.sf2')))]. ST72Style _ TextConstants at: #ST72. ST72Style leading: 0.! ! !ST72Context class methodsFor: 'bootstrap reader' stamp: 'di 11/10/1999 10:39'! bootFrom: defsFileName "ST72Context bootFrom: 'ALLDEFS'" "The file ALLDEFS must be in the current directory" | tokenVector result | ST72Object removeST72classes. Trans == nil ifTrue: [Trans _ ST72TranscriptStream new. World == nil ifTrue: [PopUpMenu notify: 'Sorry, but you will have to execute bootFrom: a second time to get started in MVC.']. Trans openLabel: 'Welcome to Smalltalk-72'] ifFalse: [Trans clear]. TraceOn _ false. Stats _ Bag new. OutputStream _ Trans. TopLev _ Dictionary new. InputStream _ FileStream readOnlyFileNamed: defsFileName. 'Reading ALLDEFS...' displayProgressAt: Sensor cursorPoint from: 0 to: InputStream size during: [:bar | [InputStream atEnd] whileFalse: [bar value: InputStream position. (TopLev includesKey: #USER) ifTrue: ["If a USER class can be found then run its code." result _ self runAsUserCode: ((TopLev at: #USER) classTable at: #DO). OutputStream cr; print: result; endEntry] ifFalse: ["Otherwise spoon-feed until one gets defined." tokenVector _ self readFrom: InputStream. "READ" result _ self eval1: tokenVector. "EVAL" OutputStream cr; print: result; endEntry. "PRINT"]]. InputStream close. ]. Trans clear. Trans show: 'To start Smalltalk-72 for the first time, execute (select and cmd-d) this line... t USER To restart Smalltalk after closing errors, execute this line... disp show. disp frame. USER After the Alto prompt, type any expression followed by doit for doit, type the cursor-up key for open-colon, type the semicolon key for apostrophe-s, type the open-string-quote key You can re-execute something you have already typed by redo or edit it for re-execution by fix You can access earlier do-its with, eg, redo 2 or fix 3. You can edit a function or class by typing, eg, edit factorial ' ! ! !ST72Context class methodsFor: 'bootstrap reader' stamp: 'di 5/9/1999 09:20'! dropCommentsFrom: anArray ^ (anArray reject: [:item | item isMemberOf: String]) collect: [:item | (item isMemberOf: Array) ifTrue: [self dropCommentsFrom: item] ifFalse: [item]]! ! !ST72Context class methodsFor: 'bootstrap reader' stamp: 'di 5/15/1999 23:39'! eval1: codeVector "Bootstrap eval routine until ST72 is alive." | topCtxt toCtxt | codeVector isEmpty ifTrue: [^ codeVector]. (codeVector size = 1 and: [codeVector first isMemberOf: String]) ifTrue: [^ codeVector]. codeVector first == #to ifTrue: ["Set up contexts as though evaluating at top level" topCtxt _ ST72Context new instance: nil class: nil return: nil message: nil global: nil temps: Array new code: codeVector allButFirst subEval: false. toCtxt _ ST72Context new instance: nil class: nil return: topCtxt message: topCtxt global: topCtxt temps: Array new code: #(CODE 19) subEval: false. toCtxt codeTo. ^ toCtxt value]. self error: 'Bootstrap reader can only process class defs'. ! ! !ST72Context class methodsFor: 'bootstrap reader' stamp: 'di 5/15/1999 23:23'! print: anItem "Bootstrap print routine until ST72 is alive." Trans cr; print: anItem; endEntry ! ! !ST72Context class methodsFor: 'bootstrap reader' stamp: 'di 5/17/1999 22:30'! readFrom: inStream "Bootstrap eval routine until ST72 is alive." | parCount strCount buffer line tokenVector | parCount _ strCount _ 0. buffer _ WriteStream on: (String new: 500). [inStream atEnd] whileFalse: [line _ inStream upTo: Character cr. parCount _ parCount + (line occurrencesOf: $( ). parCount _ parCount - (line occurrencesOf: $) ). strCount _ strCount + (line occurrencesOf: $' ). buffer nextPutAll: line; nextPut: Character cr. (parCount = 0 and: [strCount even]) ifTrue: [tokenVector _ self dropCommentsFrom: (Scanner new initForST72 scanTokens: buffer contents). tokenVector isEmpty ifTrue: ["Ignore null inputs" ^ self readFrom: inStream]. OutputStream cr. self print: tokenVector. ^ tokenVector]]. ^ nil! ! !ST72Context class methodsFor: 'bootstrap reader' stamp: 'di 11/10/1999 08:30'! runAsUserCode: userCode "Set up context for evaluating at top level" | userClass topCtxt | userClass _ TopLev at: #USER. topCtxt _ ST72Context new instance: nil class: userClass return: nil message: nil global: nil temps: (Array new: (userClass classTable at: #ARSIZE)) code: userCode subEval: false. ^ topCtxt evaluate! ! !ST72Context class methodsFor: 'bootstrap reader' stamp: 'di 5/17/1999 22:57'! runAsUserText: userText ^ self runAsUserCode: (Array with: (Scanner new initForST72 scanTokens: userText) with: #print)! ! !ST72TranscriptStream methodsFor: 'as yet unclassified' stamp: 'di 5/23/1999 16:08'! evaluateSelection: selectionStream inEditor: editor ST72Context runAsUserText: selectionStream contentsRemaining.! ! !Scanner methodsFor: 'initialize-release' stamp: 'di 5/14/1999 21:20'! initForST72 typeTable _ typeTable copy. typeTable at: $" asciiValue put: #xBinary. "Make these work as binary ops" typeTable at: $# asciiValue put: #xBinary. typeTable _ typeTable collect: [:was | was == #xBinary "Defeat Squeak's agglutinated binaries" ifTrue: [#simpleBinary] ifFalse: [was]]! ! !Scanner methodsFor: 'multi-character scans' stamp: 'di 5/14/1999 21:16'! simpleBinary tokenType _ #binary. token _ Symbol internCharacter: self step. ! ! !SmallInteger class methodsFor: 'Smalltalk-72' stamp: 'di 11/10/1999 09:35'! classTable ^ ST72Object classTableForNumber! ! !String class methodsFor: 'Smalltalk-72' stamp: 'di 11/10/1999 09:36'! classTable ^ ST72Object classTableForString! ! !Symbol methodsFor: 'Smalltalk-72' stamp: 'di 11/10/1999 09:36'! isAtom ^ true! ! !Symbol class methodsFor: 'Smalltalk-72' stamp: 'di 11/10/1999 09:36'! classTable ^ ST72Object classTableForAtom! ! !TextStyle methodsFor: 'private' stamp: 'di 5/21/1999 19:53'! newFontArray: anArray "Currently there is no supporting protocol for changing these arrays. If an editor wishes to implement margin setting, then a copy of the default should be stored with these instance variables. , Make size depend on first font." fontArray _ anArray. lineGrid _ (fontArray at: 1) height. "For whole family" baseline _ (fontArray at: 1) ascent + leading. alignment _ 0. firstIndent _ 0. restIndent _ 0. rightIndent _ 0. tabsArray _ DefaultTabsArray. marginTabsArray _ DefaultMarginTabsArray " TextStyle allInstancesDo: [:ts | ts newFontArray: TextStyle default fontArray]. "! ! ST72Accessor removeSelector: #putValue:into:! ST72Accessor removeSelector: #getValueFrom:! ST72Context removeSelector: #resultOrInstance! ST72Context removeSelector: #activate:inContext:messageStream:! ST72Context removeSelector: #code05! ST72Context removeSelector: #instance:class:return:message:global:temps:code:pc:mode:listEval:! ST72Context removeSelector: #code03! ST72Context removeSelector: #code01! ST72Context removeSelector: #code19! ST72Context removeSelector: #code29! ST72Context removeSelector: #code25! ST72Context removeSelector: #dispWindow! ST72Context removeSelector: #instance:class:return:message:global:temps:code:! ST72Context removeSelector: #loadPenFrom:! ST72Context removeSelector: #code23! ST72Context removeSelector: #dispFrame! ST72Context removeSelector: #code06! ST72Context removeSelector: #instance:class:return:message:global:temps:code:pc:mode:! ST72Context removeSelector: #storePento:! ST72Context removeSelector: #returnPassive:! ST72Context removeSelector: #instance:class:return:message:global:code:pc:mode:! ST72Context removeSelector: #storePenTo:! ST72Context removeSelector: #resultOrInstance:! ST72Context removeSelector: #putValue:at:! ST72Context removeSelector: #code04! ST72Context removeSelector: #getValueAt:! ST72Context removeSelector: #code02! ST72Context removeSelector: #code11! ST72Object class removeSelector: #arecSize:! ST72Object class removeSelector: #code:! ST72Object class removeSelector: #initClassTables! ST72Object class removeSelector: #at:put:! ST72Object class removeSelector: #at:ifAbsent:! ST72Object class removeSelector: #table! ST72Object class removeSelector: #arecSize! ST72Object class removeSelector: #code! ST72Object class removeSelector: #table:! ST72Context initialize! ST72Context class removeSelector: #runUserCode! ST72Context class removeSelector: #eval:!