nil subclass: #Object instanceVariableNames: ''! Object subclass: #Behavior instanceVariableNames: 'name instanceSize methods superClass variables'! Behavior subclass: #Class instanceVariableNames: ''! Behavior subclass: #Metaclass instanceVariableNames: ''! Object subclass: #Block instanceVariableNames: 'context argCount argLoc bytePointer'! Object subclass: #Boolean instanceVariableNames: ''! Boolean subclass: #False instanceVariableNames: ''! Boolean subclass: #True instanceVariableNames: ''! Object subclass: #Context instanceVariableNames: 'linkLocation method arguments temporaries'! Object subclass: #Encoder instanceVariableNames: 'parser name byteCodes index literals stackSize maxStack'! Object subclass: #File instanceVariableNames: 'name number mode'! Object subclass: #Link instanceVariableNames: 'key value nextLink'! Object subclass: #Magnitude instanceVariableNames: ''! Magnitude subclass: #Char instanceVariableNames: 'value'! Magnitude subclass: #Collection instanceVariableNames: ''! Collection subclass: #IndexedCollection instanceVariableNames: ''! IndexedCollection subclass: #Array instanceVariableNames: ''! Array subclass: #ByteArray instanceVariableNames: ''! ByteArray subclass: #String instanceVariableNames: ''! IndexedCollection subclass: #Dictionary instanceVariableNames: 'hashTable'! Dictionary subclass: #SymbolTable instanceVariableNames: ''! Collection subclass: #Interval instanceVariableNames: 'lower upper step'! Collection subclass: #List instanceVariableNames: 'links'! List subclass: #Set instanceVariableNames: ''! Magnitude subclass: #Number instanceVariableNames: ''! Number subclass: #Float instanceVariableNames: ''! Number subclass: #Fraction instanceVariableNames: 'top bottom'! Number subclass: #Integer instanceVariableNames: ''! Integer subclass: #LongInteger instanceVariableNames: 'negative digits'! Object subclass: #Method instanceVariableNames: 'text message bytecodes literals stackSize temporarySize class watch'! Object subclass: #Parser instanceVariableNames: 'text index tokenType token argNames tempNames instNames maxTemps errBlock'! Object subclass: #ParserNode instanceVariableNames: ''! ParserNode subclass: #ArgumentNode instanceVariableNames: 'position'! ParserNode subclass: #AssignNode instanceVariableNames: 'target expression'! ParserNode subclass: #BlockNode instanceVariableNames: 'statements temporaryLocation argumentCount temporaryCount'! ParserNode subclass: #BodyNode instanceVariableNames: 'statements'! ParserNode subclass: #CascadeNode instanceVariableNames: 'head list'! ParserNode subclass: #InstNode instanceVariableNames: 'position'! ParserNode subclass: #LiteralNode instanceVariableNames: 'value'! ParserNode subclass: #MessageNode instanceVariableNames: 'receiver name arguments'! ParserNode subclass: #PrimitiveNode instanceVariableNames: 'number arguments'! ParserNode subclass: #ReturnNode instanceVariableNames: 'expression'! ParserNode subclass: #TemporaryNode instanceVariableNames: 'position'! ParserNode subclass: #ValueNode instanceVariableNames: 'name'! Object subclass: #Process instanceVariableNames: 'stack stackTop linkPointer overflowed'! Object subclass: #Random instanceVariableNames: ''! Object subclass: #Scheduler instanceVariableNames: 'notdone processList currentProcess'! Object subclass: #Semaphore instanceVariableNames: 'count processList'! Object subclass: #Smalltalk instanceVariableNames: ''! Object subclass: #Switch instanceVariableNames: 'const notdone'! Object subclass: #Symbol instanceVariableNames: ''! Object subclass: #UndefinedObject instanceVariableNames: ''! {! ArgumentNode methods! compile: encoder block: inBlock position = 0 ifTrue: [ encoder genHigh: 2 low: 0 ] ifFalse: [ encoder genHigh: 2 low: position - 1 ]! isSuper ^ position = 0! position: p position <- p! }! {! ArrayMeta methods! basicNew ^ self basicNew: 0! new ^ self new: 0! }! {! Array methods! < coll (coll isKindOf: Array) ifTrue: [ self with: coll do: [:x :y | (x = y) ifFalse: [ ^ x < y ]]. ^ self size < coll size ] ifFalse: [ ^ super < coll ]! = coll (coll isKindOf: Array) ifTrue: [ (self size = coll size) ifFalse: [ ^ false ]. self with: coll do: [:x :y | (x = y) ifFalse: [ ^ false ] ]. ^ true ] ifFalse: [ ^ super = coll ]! at: index put: value (self includesKey: index) ifTrue: [ self basicAt: index put: value ] ifFalse: [ smalltalk error: 'illegal index to at:put: for array' ]! binaryDo: aBlock (1 to: self size) do: [:i | aBlock value: i value: (self at: i) ]! collect: aBlock | s newArray | s <- self size. newArray <- Array new: s. (1 to: s) do: [:i | newArray at: i put: (aBlock value: (self at: i))]. ^ newArray! copyFrom: low to: high | newArray newlow newhigh | newlow <- low max: 1. newhigh <- high min: self size. newArray <- self class new: (0 max: newhigh - newlow + 1). (newlow to: newhigh) do: [:i | newArray at: ((i - newlow) + 1) put: (self at: i) ]. ^ newArray! deepCopy ^ self deepCopyFrom: 1 to: self size! deepCopyFrom: low to: high | newArray newlow newhigh | newlow <- low max: 1. newhigh <- high min: self size. newArray <- self class new: (0 max: newhigh - newlow + 1). (newlow to: newhigh) do: [:i | newArray at: ((i - newlow) + 1) put: (self at: i) copy ]. ^ newArray! do: aBlock (1 to: self size) do: [:i | aBlock value: (self at: i) ]! exchange: a and: b | temp | temp <- self at: a. self at: a put: (self at: b). self at: b put: temp! grow: aValue | s newArray | s <- self size. newArray <- Array new: s + 1. (1 to: s) do: [:i | newArray at: i put: (self at: i)]. newArray at: s+1 put: aValue. ^ newArray! includesKey: index ^ index between: 1 and: self size! reverseDo: aBlock (self size to: 1 by: -1) do: [:i | aBlock value: (self at: i) ]! select: aCond | newList | newList <- List new. self do: [:i | (aCond value: i) ifTrue: [newList addLast: i]]. ^ newList asArray! shallowCopy ^ self copyFrom: 1 to: self size! size ^ self basicSize! with: newElement | s newArray | s <- self size. newArray <- Array new: (s + 1). (1 to: s) do: [:i | newArray at: i put: (self at: i) ]. newArray at: s+1 put: newElement. ^ newArray! with: coll do: aBlock (1 to: (self size min: coll size)) do: [:i | aBlock value: (self at: i) value: (coll at: i) ]! with: coll ifAbsent: z do: aBlock | xsize ysize | xsize <- self size. ysize <- coll size. (1 to: (xsize max: ysize)) do: [:i | aBlock value: (i <= xsize ifTrue: [ self at: i ] ifFalse: [ z ]) value: (i <= ysize ifTrue: [ coll at: i ] ifFalse: [ z ])]! }! {! AssignNode methods! compile: encoder block: inBlock target class == ValueNode ifTrue: [ "fix" target assign: encoder value: expression block: inBlock ] ifFalse: [ expression compile: encoder block: inBlock. target assign: encoder ]! target: t expression: e target <- t. expression <- e! }! {! Behavior methods! addMethod | m | (m <- self doEdit: '') notNil ifTrue: [ self install: m ]! basicNew ^ self primOrefs: instanceSize! basicNew: size ^ self primOrefs: size! display ('Class name: ', name asString) print. (superClass notNil) ifTrue: [ ('Superclass: ', superClass ) print ]. 'Instance Variables:' print. variables isNil ifTrue: [ 'no instance variables ' print ] ifFalse: [ variables display ]. 'Subclasses: ' print. self subClasses display! doEdit: aString | tmp ans | " edit a method definition until it compiles correctly " tmp <- aString. [ tmp <- tmp edit trimmed. ans <- Parser new parse: tmp in: self. ans notNil ifTrue: [ ^ ans ] ifFalse: [ smalltalk inquire: 'edit again (yn) ? ' ] ] whileTrue. ^ nil! editMethod: name | m | m <- self methodNamed: name. m notNil ifTrue: [ (m <- self doEdit: m text) notNil ifTrue: [ self install: m ] ] ifFalse: [ 'no such method' print ]! fileOut: aSym | aMth cStr mStr aStr aFile | " file out one method on class.method.st " (aMth <- self methodNamed: aSym) isNil ifTrue: [ ^ self ]. cStr <- aMth methodClass name asString. mStr <- aMth name asString. aStr <- cStr , '.' , mStr , '.st'. (aFile <- File name: aStr mode: 'w') open. aFile putChunk: '{'. aFile putChunk: cStr , ' methods'. aFile putChunk: aMth trimmedText. aFile putChunk: '}'. aFile close! fileOutMethodsOn: aFile | sorted | " file out all methods " methods isNil ifTrue: [ methods <- Dictionary new ]. "fix" methods isEmpty ifFalse: [ sorted <- methods sort: [ :x :y | x name asString < y name asString ]. aFile putChunk: '{'. aFile putChunk: name asString , ' methods'. sorted do: [ :y | aFile putChunk: y trimmedText ]. aFile putChunk: '}' ]! install: aMethod | sel old | "fix?" sel <- aMethod name. old <- self methodNamed: sel. "avoid GC lossage?" methods at: sel put: aMethod. <38 sel self>. "primFlushCache" self logMethod: aMethod! instanceSize ^ instanceSize! logMethod: aMethod '{' logChunk. (self name asString , ' methods') logChunk. aMethod trimmedText logChunk. '}' logChunk! methodNamed: name (methods includesKey: name) ifTrue: [ ^ methods at: name ]. (superClass notNil) ifTrue: [ ^ superClass methodNamed: name ]. ^ nil! methods ^ methods! name ^ name! name: aString name <- aString! name: nSym instanceSize: iInt methods: mDict superClass: sClass variables: vArray name <- nSym. instanceSize <- iInt. methods <- mDict. superClass <- sClass. variables <- vArray! new ^ self primOrefs: instanceSize! new: size ^ self primOrefs: size! newMethod: aStr | m | (m <- self doEdit: aStr) notNil ifTrue: [ self install: m ]! primBytes: size "create a new block, set its class" ^ <22 <59 size> self>! primOrefs: size "create a new block, set its class" ^ <22 <58 size> self>! printString ^ name asString! readMethods [ smalltalk inquire: 'Add a method (yn) ? ' ] whileTrue: [ self addMethod ]! removeMethod: name | m | m <- self methodNamed: name. (m notNil and: [m methodClass == self]) ifTrue: [ methods removeKey: name. <38 name self> ] "primFlushCache" ifFalse: [ 'no such method' print ]! respondsTo | theSet | theSet <- Dictionary new. self upSuperclassChain: [:x | theSet addAll: x methods ]. ^ theSet! superClass ^ superClass! superClass: aClass superClass <- aClass! upSuperclassChain: aBlock aBlock value: self. (superClass notNil) ifTrue: [ superClass upSuperclassChain: aBlock ]! variables ^ variables! variables: nameArray variables <- nameArray. instanceSize <- superClass instanceSize + nameArray size! viewMethod: methodName | m | m <- self methodNamed: methodName. (m notNil) ifTrue: [ m signature print. m trimmedText print ] ifFalse: [ 'no such method' print ]! watch: name | m | m <- self methodNamed: name. (m notNil) ifTrue: [ ^ m watch: [:a | ('executing ', name) print. a print] ] ifFalse: [ ^ 'no such method' ]! }! {! Block methods! blockContext: ctx context <- ctx! checkArgumentCount: count ^ (argCount = count) ifTrue: [ true ] ifFalse: [ smalltalk error: 'wrong number of arguments passed to block'. false ]! fork self newProcess resume! forkWith: args (self newProcessWith: args) resume! newProcess " create a new process to execute block " ^ Process context: context startAt: bytePointer! newProcessWith: args (self checkArgumentCount: args size) ifTrue: [ (1 to: args size) do: [:i | context at: (argLoc + i - 1) put: (args at: i)]]. ^ self newProcess! value ^ (self checkArgumentCount: 0) ifTrue: [ context returnToBlock: bytePointer ]! value: x ^ (self checkArgumentCount: 1) ifTrue: [ context at: argLoc put: x. context returnToBlock: bytePointer ]! value: x value: y ^ (self checkArgumentCount: 2) ifTrue: [ context at: argLoc put: x. context at: argLoc + 1 put: y. context returnToBlock: bytePointer ]! value: x value: y value: z ^ (self checkArgumentCount: 3) ifTrue: [ context at: argLoc put: x. context at: argLoc + 1 put: y. context at: argLoc + 2 put: z. context returnToBlock: bytePointer ]! whileFalse: aBlock [ self value not ] whileTrue: aBlock! whileTrue self whileTrue: []! whileTrue: aBlock ( self value ) ifTrue: [ aBlock value. self whileTrue: aBlock ]! }! {! BlockNode methods! compile: encoder block: inBlock | blk fwd | blk <- self newBlock. "fix" encoder genHigh: 4 low: (encoder genLiteral: blk). encoder genHigh: 5 low: 4. "ldc thisContext" encoder genHigh: 13 low: 2. "prim 29" encoder genCode: 29. encoder genHigh: 15 low: 6. "jmp " fwd <- encoder genCode: 0. blk basicAt: 4 put: encoder currentLocation + 1. self compileInLine: encoder block: true. encoder genHigh: 15 low: 2. "rtnt" encoder hack: fwd ":" "fix?"! compileInLine: encoder block: inBlock | base | temporaryCount > 0 ifTrue: [ base <- temporaryLocation + argumentCount. (1 to: temporaryCount) do: [ :i | encoder genHigh: 5 low: 5. "ldc nil" encoder genHigh: 7 low: base + (i - 1). "stt" encoder genHigh: 15 low: 5 "pop" ] ]. statements reverseDo: [ :stmt | stmt compile: encoder block: inBlock. encoder genHigh: 15 low: 5 "pop" ]. encoder backUp! isBlock ^ true! newBlock "fix" | ans | ans <- <22 <58 6> Block>. ans basicAt: 2 put: argumentCount. "argCount" ans basicAt: 3 put: temporaryLocation + 1. "argLoc" ans basicAt: 4 put: 0. "bytePointer" ^ ans! statements: s temporaryLocation: t argumentCount: ac temporaryCount: tc statements <- s. temporaryLocation <- t. argumentCount <- ac. temporaryCount <- tc! }! {! BodyNode methods! compile: encoder block: inBlock statements reverseDo: [ :stmt | stmt compile: encoder block: inBlock. encoder genHigh: 15 low: 5 " pop "]. encoder genHigh: 15 low: 1 " return self "! statements: s statements <- s! }! {! Boolean methods! and: aBlock ^ self ifTrue: aBlock ifFalse: [ false ]! ifFalse: falseBlock ^ self ifTrue: [] ifFalse: falseBlock! ifFalse: falseBlock ifTrue: trueBlock ^ self ifTrue: trueBlock ifFalse: falseBlock! ifTrue: trueBlock ^ self ifTrue: trueBlock ifFalse: []! or: aBlock ^ self ifTrue: [ true ] ifFalse: aBlock! }! {! ByteArrayMeta methods! basicNew: size ^ self primBytes: size! new: size ^ self primBytes: size! }! {! ByteArray methods! asByteArray ^ self! asString | newString i | newString <- String new: self size. i <- 0. self do: [:x | i <- i + 1. newString at: i put: x asCharacter]. ^ newString! basicAt: index ^ <26 self index>! basicAt: index put: value ^ ((value isMemberOf: Integer) and: [value between: 0 and: 255]) ifTrue: [ <32 self index value > ] ifFalse: [ value print. smalltalk error: 'assign illegal value to ByteArray']! logChunk ^ <154 self>! size: value ^ <22 <59 value> ByteArray>! }! {! CascadeNode methods! compile: encoder block: inBlock | left | head compile: encoder block: inBlock. left <- list size. list reverseDo: [ :stmt | left <- left - 1. left > 0 ifTrue: [ encoder genHigh: 15 low: 4 " duplicate " ]. stmt compile: encoder block: inBlock. left > 0 ifTrue: [ encoder genHigh: 15 low: 5 "pop from stack " ] ]! head: h head <- h! list: l list <- l! }! {! CharMeta methods! value: aValue ^ self new value: aValue! }! {! Char methods! < aValue " can only compare characters to characters " ^ aValue isChar ifTrue: [ value < aValue asInteger ] ifFalse: [ smalltalk error: 'char compared to nonchar']! == aValue ^ aValue isChar ifTrue: [ value = aValue asInteger ] ifFalse: [ false ]! asInteger ^ value! asString " make ourselves into a string " ^ ' ' copy yourself; at: 1 put: self; yourself! digitValue " return an integer representing our value " self isDigit ifTrue: [ ^ value - $0 asInteger ]. self isUppercase ifTrue: [ ^ value - $A asInteger + 10 ]. ^ smalltalk error: 'illegal conversion, char to digit'! isAlphaNumeric ^ (self isAlphabetic) or: [ self isDigit ]! isAlphabetic ^ (self isLowercase) or: [ self isUppercase ]! isBlank ^ value = $ asInteger " blank char "! isChar ^ true! isDigit ^ value between: $0 asInteger and: $9 asInteger! isLowercase ^ value between: $a asInteger and: $z asInteger! isUppercase ^ value between: $A asInteger and: $Z asInteger! printString ^ '$', self asString! value: aValue " private - used for initialization " value <- aValue! }! {! Class methods! fileOut | f | " file out whole class on class.st " (f <- File name: (name asString,'.st') mode: 'w') open. self fileOutOn: f. f close! fileOutClassOn: aFile | dlm pad buf buf2 | dlm <- 10 asCharacter asString. pad <- 9 asCharacter asString. buf <- superClass isNil ifTrue: [ 'nil' ] ifFalse: [ superClass name asString ]. buf <- buf , dlm , pad. buf <- buf , 'subclass: ' , self name printString. buf <- buf , dlm , pad. buf2 <- ''. variables notNil ifTrue: [ variables inject: '' into: [ :p :v | buf2 <- buf2 , p , v. ' ' ] ]. buf <- buf , 'instanceVariableNames: ' , buf2 printString. aFile putChunk: buf! fileOutOn: aFile " file out class description " self fileOutClassOn: aFile. self class fileOutMethodsOn: aFile. self fileOutMethodsOn: aFile! subClasses ^ classes inject: List new into: [:x :y | (y superClass == self) ifTrue: [ x add: y]. x ]! subclass: aSymbol instanceVariableNames: aString | newMeta varArray newClass | newMeta <- Metaclass metaName: (aSymbol asString , 'Meta') asSymbol instanceSize: self class instanceSize methods: Dictionary new superClass: self class variables: (Array primOrefs: 0). varArray <- aString words: [ :x | x isAlphaNumeric ]. newClass <- newMeta instName: aSymbol instanceSize: self instanceSize + varArray basicSize methods: Dictionary new superClass: self variables: varArray. newMeta name assign: newMeta. aSymbol assign: newClass. classes at: aSymbol put: newClass. ^ newClass! }! {! Collection methods! < coll (coll respondsTo: #includes:) ifFalse: [ ^ smalltalk error: 'collection compared to non collection']. self do: [:x | ((self occurrencesOf: x) < (coll occurrencesOf: x))ifFalse: [ ^ false ]]. coll do: [:x | (self includes: x) ifFalse: [ ^ true ]]. ^ false! = coll self do: [:x | (self occurrencesOf: x) = (coll occurrencesOf: x) ifFalse: [ ^ false ] ]. ^ true! asArray | newArray i | newArray <- Array new: self size. i <- 0. self do: [:x | i <- i + 1. newArray at: i put: x]. ^ newArray! asByteArray | newArray i | newArray <- ByteArray new size: self size. i <- 0. self do: [:x | i <- i + 1. newArray at: i put: x]. ^ newArray! asSet ^ Set new addAll: self! asString ^ self asByteArray asString! display self do: [:x | x print ]! includes: value self do: [:x | (x = value) ifTrue: [ ^ true ] ]. ^ false! inject: thisValue into: binaryBlock | last | last <- thisValue. self do: [:x | last <- binaryBlock value: last value: x]. ^ last! isEmpty ^ self size == 0! occurrencesOf: anObject ^ self inject: 0 into: [:x :y | (y = anObject) ifTrue: [x + 1] ifFalse: [x] ]! printString ^ ( self inject: self class printString , ' (' into: [:x :y | x , ' ' , y printString]), ' )'! size ^ self inject: 0 into: [:x :y | x + 1]! sort ^ self sort: [:x :y | x < y ]! sort: aBlock ^ self inject: List new into: [:x :y | x add: y ordered: aBlock. x]! }! {! ContextMeta methods! method: aMeth arguments: aVec temporaries: tVec ^ self new method: aMeth arguments: aVec temporaries: tVec! }! {! Context methods! arguments: a arguments <- a! at: key put: value temporaries at: key put: value! blockReturn <18 self> ifFalse: [ ^ smalltalk error: 'incorrect context for block return']! copy ^ super copy temporaries: temporaries copy! method: m method <- m! method: aMeth arguments: aVec temporaries: tVec method <- aMeth. arguments <- aVec. temporaries <- tVec! returnToBlock: bytePtr " change the location we will return to, to execute a block" <28 self bytePtr>! temporaries: t temporaries <- t! }! {! DictionaryMeta methods! new ^ self basicNew hashTable: (Array new: 39)! }! {! Dictionary methods! at: aKey ifAbsent: exceptionBlock | hashPosition link | hashPosition <- self hash: aKey. ((hashTable at: hashPosition + 1) = aKey) ifTrue: [ ^ hashTable at: hashPosition + 2]. link <- hashTable at: hashPosition + 3. ^ (link notNil) ifTrue: [ link at: aKey ifAbsent: exceptionBlock ] ifFalse: exceptionBlock! at: aKey put: aValue | hashPosition link | hashPosition <- self hash: aKey. ((hashTable at: hashPosition + 1) isNil) ifTrue: [ hashTable at: hashPosition + 1 put: aKey ]. ((hashTable at: hashPosition + 1) = aKey) ifTrue: [ hashTable at: hashPosition + 2 put: aValue ] ifFalse: [ link <- hashTable at: hashPosition + 3. (link notNil) ifTrue: [ link at: aKey put: aValue ] ifFalse: [ hashTable at: hashPosition + 3 put: (Link key: aKey value: aValue)]]! basicRemoveKey: aKey | hashPosition link | hashPosition <- self hash: aKey. ((hashTable at: hashPosition + 1) = aKey) ifTrue: [ link <- hashTable at: hashPosition + 3. (link notNil) ifTrue: [ hashTable at: hashPosition + 1 put: link key. hashTable at: hashPosition + 2 put: link value. hashTable at: hashPosition + 3 put: link next ] ifFalse: [ hashTable at: hashPosition + 1 put: nil. hashTable at: hashPosition + 2 put: nil ] ] ifFalse: [ link <- hashTable at: hashPosition + 3. (link notNil) ifTrue: [ hashTable at: hashPosition + 3 put: (link removeKey: aKey) ] ]! binaryDo: aBlock (1 to: hashTable size by: 3) do: [:i | (hashTable at: i) notNil ifTrue: [ aBlock value: (hashTable at: i) value: (hashTable at: i+1) ]. (hashTable at: i+2) notNil ifTrue: [ (hashTable at: i+2) binaryDo: aBlock ] ]! display self binaryDo: [:x :y | (x printString , ' -> ', y printString ) print ]! hash: aKey ^ 3 * ((aKey hash) rem: ((hashTable size) quo: 3))! hashTable: hArray hashTable <- hArray! includesKey: aKey " look up, but throw away result " self at: aKey ifAbsent: [ ^ false ]. ^ true! removeKey: aKey ^ self removeKey: aKey ifAbsent: [ smalltalk error: 'remove key not found']! removeKey: aKey ifAbsent: exceptionBlock ^ (self includesKey: aKey) ifTrue: [ self basicRemoveKey: aKey ] ifFalse: exceptionBlock! }! {! Encoder methods! backUp " back up one instruction " index <- index - 1! currentLocation ^ index! expandByteCodes | newarray size | size <- byteCodes size. newarray <- byteCodes size: size + 8. "fix" (1 to: size) do: [:i | newarray at: i put: (byteCodes at: i)]. byteCodes <- newarray! genCode: byte index = 256 ifTrue: [ parser error: 'too many byte codes' ]. index <- index + 1. (index >= byteCodes size) ifTrue: [ self expandByteCodes]. byteCodes at: index put: byte. ^ index! genHigh: high low: low (low >= 16) ifTrue: [ self genHigh: 0 low: high. self genCode: low ] ifFalse: [ self genCode: high * 16 + low ]! genLiteral: aValue literals size = 256 ifTrue: [ parser error: 'too many literals' ]. literals <- literals with: aValue. ^ literals size - 1! hack: loc "fix" byteCodes at: loc put: index + 1! hackByteCodes | newarray | newarray <- byteCodes size: index. "fix" (1 to: index) do: [:i | newarray at: i put: (byteCodes at: i)]. byteCodes <- newarray! hackLiterals literals size = 0 ifTrue: [ literals <- nil ]! hackMaxStack maxStack <- 6! method: maxTemps class: c text: text | ans | ans <- Method new. ans text: text. ans message: name. self hackByteCodes. ans basicAt: 3 put: byteCodes. self hackLiterals. ans basicAt: 4 put: literals. self hackMaxStack. ans basicAt: 5 put: maxStack. "self hackMaxTemps." ans basicAt: 6 put: maxTemps + 1. ans methodClass: c. ^ ans! name: n name <- n asSymbol. byteCodes <- '' size: 20. "fix" index <- 0. literals <- Array new: 0. stackSize <- 0. maxStack <- 1.! parser: aParser parser <- aParser! patch: loc " patch a goto from a block " byteCodes at: loc put: index! popArgs: n stackSize <- stackSize - n.! pushArgs: n stackSize <- stackSize + n. maxStack <- stackSize max: maxStack! }! {! False methods! ifTrue: trueBlock ifFalse: falseBlock ^ falseBlock value! not ^ true! printString ^ 'false'! xor: aBoolean ^ aBoolean! }! {! FileMeta methods! name: nStr mode: mStr ^ self new name: nStr mode: mStr! name: nStr open: mStr ^ self new name: nStr open: mStr! }! {! File methods! asString | text line | text <- ''. [ (line <- self getString) notNil ] whileTrue: [ text <- text , line ]. ^ text! close " close file, take entry out of global variable " number isNil ifTrue: [ ^ nil ]. files at: number put: nil. <121 number>. number <- nil.! delete ('rm ', name) unixCommand! fileIn | str | [ (str <- self getChunk) notNil ] whileTrue: [ str = '{' ifTrue: [ self fileInSet ] ifFalse: [ str execute ] ]! fileIn: name self name: name. self open: 'r'. self fileIn. self close.! fileInSet | str pos cls mth | (str <- self getChunk) isNil ifTrue: [ self halt ]. str = '}' ifTrue: [ ^ self ]. pos <- str indexOf: [ :c | c isBlank ]. cls <- (str copyFrom: 1 to: pos - 1) asSymbol value. [ (str <- self getChunk) notNil ] whileTrue: [ str = '}' ifTrue: [ ^ self ]. (mth <- Parser new parse: str in: cls) notNil ifTrue: [ cls install: mth ] ]. self halt! getChunk ^ (number notNil) ifTrue: [<157 number>]! getNumber " get a file number - called only by open" (1 to: 15) do: [:i | (files at: i) isNil ifTrue: [ files at: i put: self. number <- i. ^ nil]]! getString ^ (number notNil) ifTrue: [<125 number>]! mode: m mode <- m! name ^ name! name: string name <- string! name: nStr mode: mStr name <- nStr. mode <- mStr! name: nStr open: mStr name <- nStr. mode <- mStr. self open! open number notNil ifTrue: [ self close ]. self getNumber. <120 number name mode> isNil ifTrue: [ smalltalk error: 'open failed: ', name. ^ false]. ^ true! open: m self mode: m. self open! print: aString (number notNil) ifTrue: [<129 number aString>] ifFalse: [smalltalk error: 'file not open']! printNoReturn: aString (number notNil) ifTrue: [<128 number aString>] ifFalse: [smalltalk error: 'file not open']! putChunk: buffer ^ (number notNil) ifTrue: [<158 number buffer>]! readUntil: conditionBlock doing: actionBlock | line | [ line <- self getString. line notNil] whileTrue: [ (conditionBlock value: line) ifTrue: [ ^ line ]. actionBlock value: line ]. ^ nil! saveImage | saveAns | " subtle problem - when we read in image don't want image file to be open for writing, so we remove it's number from files array temporarily " (number notNil) ifTrue: [ files at: number put: nil. saveAns <- <127 number>. files at: number put: self] ifFalse: [smalltalk error: 'saveImage: file not open']. ^saveAns! scratchFile name <- 'junk.tmp'! }! {! FloatMeta methods! new ^ smalltalk error: 'cannot create floats with new'! }! {! Float methods! * value ^ value isFloat ifTrue: [ <118 self value> ] ifFalse: [ super * value ]! + value ^ value isFloat ifTrue: [ <110 self value> " floating add " ] ifFalse: [ super + value ]! - value ^ value isFloat ifTrue: [ <111 self value> " floating subtract " ] ifFalse: [ super - value ]! / value ^ value isFloat ifTrue: [ (value = 0.0) ifTrue: [ smalltalk error: 'float division by zero' ] ifFalse: [ <119 self value> ]] ifFalse: [ super / value ]! < value ^ value isFloat ifTrue: [ <112 self value> " floating comparison " ] ifFalse: [ super < value ]! = value ^ value isFloat ifTrue: [ <116 self value> ] ifFalse: [ super = value ]! coerce: value " convert the value into a floating point number " ^ value asFloat! exp " return e raised to self " ^ <103 self>! generality " our numerical generality - used for mixed mode arithmetic" ^ 7! integerPart | i j | i <- <106 self>. j <- i basicAt: 2. i <- i basicAt: 1. j < 0 ifTrue: [ ^ 0 ] ifFalse: [ ^ i * (2 raisedTo: j)]! isFloat ^ true! ln " natural log of self " ^ <102 self>! printString ^ <101 self>! quo: value ^ (self / value) truncated! rounded ^ (self + 0.5) floor! truncated | result f i | " truncate to an integer rounded towards zero" f <- self. result <- 0. [ i <- f integerPart. i > 0] whileTrue: [ result <- result + i. f <- f - i ]. ^ result! }! {! FractionMeta methods! top: tNum bottom: bNum ^ self new top: tNum bottom: bNum! }! {! Fraction methods! * f f isFraction ifTrue: [ ^ (top * f top) / (bottom * f bottom) ] ifFalse: [ ^ super * f ]! + f f isFraction ifTrue: [ ^ ((top * f bottom) + (bottom * f top)) / (bottom * f bottom) ] ifFalse:[ ^ super + f ]! - f f isFraction ifTrue: [ ^ ((top * f bottom) - (bottom * f top)) / (bottom * f bottom) ] ifFalse:[ ^ super - f ]! / f ^ self * f reciprocal! < f f isFraction ifTrue: [ ^ (top * f bottom) < (bottom * f top) ] ifFalse:[ ^ super < f ]! = f f isFraction ifTrue: [ ^ (top = f top) and: [ bottom = f bottom ] ] ifFalse: [ ^ super = f ]! abs ^ top abs / bottom! asFloat " convert to a floating point number " ^ top asFloat / bottom asFloat! bottom ^ bottom! coerce: x " coerce a value into being a fraction " ^ x asFraction! generality " generality value - used in mixed type arithmetic " ^ 5! isFraction ^ true! ln ^ (top ln) - (bottom ln)! printString ^ top printString, '/', bottom printString! raisedTo: x ^ (top raisedTo: x) / (bottom raisedTo: x)! reciprocal ^ bottom / top! top ^ top! top: tNum bottom: bNum top <- tNum. bottom <- bNum! truncated " convert to an integer rounded towards zero " ^ top quo: bottom! with: t over: b " initialization " top <- t. bottom <- b! }! {! IndexedCollection methods! addAll: aCollection aCollection binaryDo: [:i :x | self at: i put: x ]! asArray ^ (Array new: self size) yourself; addAll: self; yourself! asDictionary ^ Dictionary new yourself; addAll: self; yourself! at: aKey ^ self at: aKey ifAbsent: [ smalltalk error: 'index to at: illegal' ]! at: index ifAbsent: exceptionBlock ^ (self includesKey: index) ifTrue: [ self basicAt: index ] ifFalse: exceptionBlock! binaryInject: thisValue into: aBlock | last | last <- thisValue. self binaryDo: [:i :x | last <- aBlock value: last value: i value: x]. ^ last! collect: aBlock ^ self binaryInject: Dictionary new into: [:s :i :x | s at: i put: (aBlock value: x). s]! do: aBlock self binaryDo: [:i :x | aBlock value: x ]! indexOf: aBlock ^ self indexOf: aBlock ifAbsent: [ smalltalk error: 'index not found']! indexOf: aBlock ifAbsent: exceptionBlock self binaryDo: [:i :x | (aBlock value: x) ifTrue: [ ^ i ] ]. ^ exceptionBlock value! keys ^ self binaryInject: Set new into: [:s :i :x | s add: i ]! select: aBlock ^ self binaryInject: Dictionary new into: [:s :i :x | (aBlock value: x) ifTrue: [ s at: i put: x ]. s ]! values ^ self binaryInject: List new into: [:s :i :x | s add: x ]! }! {! InstNode methods! assign: encoder encoder genHigh: 6 low: position - 1! assignable ^ true! compile: encoder block: inBlock encoder genHigh: 1 low: position - 1! position: p position <- p! }! {! IntegerMeta methods! new ^ smalltalk error: 'cannot create integers with new'! }! {! Integer methods! * value | r | ^ (self isShortInteger and: [value isShortInteger]) ifTrue: [ r <- <68 self value>. "primitive will return nil on overflow" r notNil ifTrue: [ r ] ifFalse: [ self asLongInteger * value asLongInteger ]] ifFalse: [ super * value ]! + value | r | ^ (self isShortInteger and: [value isShortInteger]) ifTrue: [ r <- <60 self value>. "primitive will return nil on overflow" r notNil ifTrue: [ r ] ifFalse: [ self asLongInteger + value asLongInteger ]] ifFalse: [ super + value ]! , value " used to make long integer constants " ^ self * 1000 + value! - value | r | ^ (self isShortInteger and: [value isShortInteger]) ifTrue: [ r <- <61 self value>. "primitive will return nil on overflow" r notNil ifTrue: [ r ] ifFalse: [ self asLongInteger - value asLongInteger ]] ifFalse: [ super - value ]! / value | t b | value = 0 ifTrue: [ ^ smalltalk error: 'division by zero']. value isInteger ifTrue: [ b <- self gcd: value . t <- self quo: b. b <- value quo: b. b negative ifTrue: [ t <- t negated. b <- b negated ]. (b = 1) ifTrue: [ ^ t ]. ^ Fraction top: t bottom: b ] ifFalse: [ ^ super / value ]! < value ^ (self isShortInteger and: [value isShortInteger]) ifTrue: [ <62 self value> ] ifFalse: [ super < value ]! = value ^ (self isShortInteger and: [value isShortInteger]) ifTrue: [ self == value ] ifFalse: [ super = value ]! > value ^ (self isShortInteger and: [value isShortInteger]) ifTrue: [ <63 self value> ] ifFalse: [ super > value ]! allMask: value " see if all bits in argument are on" ^ value = (self bitAnd: value)! anyMask: value " see if any bits in argument are on" ^ 0 ~= (self bitAnd: value)! asCharacter ^ Char value: self! asDigit " return as character digit " (self >= 0) ifTrue: [ (self <= 9) ifTrue: [ ^ (self + $0 asInteger) asCharacter ]. (self < 36) ifTrue: [ ^ (self + $A asInteger - 10) asCharacter ] ]. ^ smalltalk error: 'illegal conversion, integer to digit'! asFloat " should be redefined by any subclasses " self isShortInteger ifTrue: [ ^ <51 self> ]! asFraction ^ Fraction top: self bottom: 1! asLongInteger | newList i | newList <- List new. i = 0 ifTrue: [ newList add: 0 ] ifFalse: [ i <- self abs. [ i ~= 0 ] whileTrue: [ newList addLast: (i rem: 100). i <- i quo: 100 ] ]. ^ LongInteger negative: i negative digits: newList asArray! asString ^ self radix: 10! bitAnd: value ^ (self isShortInteger and: [value isShortInteger]) ifTrue: [ <71 self value > ] ifFalse: [ smalltalk error: 'arguments to bit operation must be short integer']! bitAt: value ^ (self bitShift: 1 - value) bitAnd: 1! bitInvert "invert all bits in self" ^ self bitXor: -1! bitOr: value ^ (self bitXor: value) bitXor: (self bitAnd: value)! bitShift: value ^ (self isShortInteger and: [value isShortInteger]) ifTrue: [ <79 self value > ] ifFalse: [ smalltalk error: 'argument to bit operation must be integer']! bitXor: value ^ (self isShortInteger and: [value isShortInteger]) ifTrue: [ <72 self value > ] ifFalse: [ smalltalk error: 'argument to bit operation must be integer']! even ^ (self rem: 2) = 0! factorial ^ (2 to: self) inject: 1 into: [:x :y | x * y ]! gcd: value (value = 0) ifTrue: [ ^ self ]. (self negative) ifTrue: [ ^ self negated gcd: value ]. (value negative) ifTrue: [ ^ self gcd: value negated ]. (value > self) ifTrue: [ ^ value gcd: self ]. ^ value gcd: (self rem: value)! generality " generality value - used in mixed class arithmetic " ^ 2! isShortInteger ^ true! lcm: value ^ (self quo: (self gcd: value)) * value! odd ^ (self rem: 2) ~= 0! printString ^ self asString! quo: value | r | ^ (self isShortInteger and: [value isShortInteger]) ifTrue: [ r <- <69 self value>. (r isNil) ifTrue: [ smalltalk error: 'quo: or rem: with argument 0'] ifFalse: [ r ]] ifFalse: [ ^ super quo: value ]! radix: base | sa text | " return a printed representation of self in given base" sa <- self abs. text <- (sa \\ base) asDigit asString. ^ (sa < base) ifTrue: [ (self negative) ifTrue: [ '-' , text ] ifFalse: [ text ]] ifFalse: [ ((self quo: base) radix: base), text ]! timesRepeat: aBlock | i | " use while, which is optimized, not to:, which is not" i <- 0. [ i < self ] whileTrue: [ aBlock value. i <- i + 1]! truncated ^ self! }! {! IntervalMeta methods! lower: lValue upper: uValue step: sValue ^ self new lower: lValue upper: uValue step: sValue! }! {! Interval methods! do: aBlock | current | current <- lower. (step > 0) ifTrue: [ [ current <= upper ] whileTrue: [ aBlock value: current. current <- current + step ] ] ifFalse: [ [ current >= upper ] whileTrue: [ aBlock value: current. current <- current + step ] ]! lower: aValue lower <- aValue! lower: lValue upper: uValue step: sValue lower <- lValue. upper <- uValue. step <- sValue! step: aValue step <- aValue! upper: aValue upper <- aValue! }! {! LinkMeta methods! key: aKey value: aValue ^ self new key: aKey value: aValue! value: aValue ^ self new value: aValue! value: aValue link: aLink ^ self new value: aValue link: aLink! }! {! Link methods! add: newValue whenFalse: aBlock (aBlock value: value value: newValue) ifTrue: [ (nextLink notNil) ifTrue: [ nextLink <- nextLink add: newValue whenFalse: aBlock ] ifFalse: [ nextLink <- Link value: newValue] ] ifFalse: [ ^ Link value: newValue link: self ]! at: aKey ifAbsent: exceptionBlock (aKey = key) ifTrue: [ ^value ] ifFalse: [ ^ (nextLink notNil) ifTrue: [ nextLink at: aKey ifAbsent: exceptionBlock ] ifFalse: exceptionBlock ]! at: aKey put: aValue (aKey = key) ifTrue: [ value <- aValue ] ifFalse: [ (nextLink notNil) ifTrue: [ nextLink at: aKey put: aValue] ifFalse: [ nextLink <- Link key: aKey value: aValue] ]! binaryDo: aBlock aBlock value: key value: value. (nextLink notNil) ifTrue: [ nextLink binaryDo: aBlock ]! includesKey: aKey (key = aKey) ifTrue: [ ^ true ]. (nextLink notNil) ifTrue: [ ^ nextLink includesKey: aKey ] ifFalse: [ ^ false ]! key ^ key! key: aKey key <- aKey! key: aKey value: aValue key <- aKey. value <- aValue! link: aLink nextLink <- aLink! next ^ nextLink! removeKey: aKey (aKey = key) ifTrue: [ ^ nextLink ] ifFalse: [ (nextLink notNil) ifTrue: [ nextLink <- nextLink removeKey: aKey]]! removeValue: aValue (aValue = value) ifTrue: [ ^ nextLink ] ifFalse: [ (nextLink notNil) ifTrue: [ nextLink <- nextLink removeValue: aValue]]! reverseDo: aBlock (nextLink notNil) ifTrue: [ nextLink reverseDo: aBlock ]. aBlock value: value! size (nextLink notNil) ifTrue: [ ^ 1 + nextLink size] ifFalse: [ ^ 1 ]! value ^ value! value: aValue value <- aValue! value: aValue link: aLink value <- aValue. nextLink <- aLink! }! {! List methods! add: aValue ^ self addLast: aValue! add: aValue ordered: aBlock (links isNil) ifTrue: [ self addFirst: aValue] ifFalse: [ links <- links add: aValue whenFalse: aBlock ]! addAll: aValue aValue do: [:x | self add: x ]! addFirst: aValue links <- Link value: aValue link: links! addLast: aValue (links isNil) ifTrue: [ self addFirst: aValue ] ifFalse: [ links add: aValue whenFalse: [ :x :y | true ] ]! collect: aBlock ^ self inject: self class new into: [:x :y | x add: (aBlock value: y). x ]! do: aBlock (links notNil) ifTrue: [ links binaryDo: [:x :y | aBlock value: y]]! first ^ (links notNil) ifTrue: links ifFalse: [ smalltalk error: 'first on empty list']! links ^ links "used to walk two lists in parallel "! reject: aBlock ^ self select: [:x | (aBlock value: x) not ]! remove: value (links notNil) ifTrue: [ links <- links removeValue: value ]! removeFirst self remove: self first! reverseDo: aBlock (links notNil) ifTrue: [ links reverseDo: aBlock ]! select: aBlock ^ self inject: self class new into: [:x :y | (aBlock value: y) ifTrue: [x add: y]. x]! size (links isNil) ifTrue: [ ^ 0 ] ifFalse: [ ^ links size ]! }! {! LiteralNode methods! compile: encoder block: inBlock (value class == Integer and: [ value >= 0 and: [value <= 2] ]) ifTrue: [ ^ encoder genHigh: 5 low: value ]. (value class == Integer and: [ value = -1 ]) ifTrue: [ ^ encoder genHigh: 5 low: 3 ]. "value == #currentInterpreter ifTrue: [ ^ encoder genHigh: 5 low: 4 ]." nil == value ifTrue: [ ^ encoder genHigh: 5 low: 5 ]. true == value ifTrue: [ ^ encoder genHigh: 5 low: 6 ]. false == value ifTrue: [ ^ encoder genHigh: 5 low: 7 ]. encoder genHigh: 4 low: (encoder genLiteral: value)! value: v value <- v! }! {! LongIntegerMeta methods! negative: nBool digits: dArray ^ self basicNew negative: nBool digits: dArray! new ^ self basicNew negative: nil digits: nil! }! {! LongInteger methods! * n | result | n isShortInteger ifTrue: [ ^ self timesShort: n ]. n isLongInteger ifFalse: [ ^ super * n ]. result <- 0 asLongInteger. digits reverseDo: [:x | result <- (result timesShort: 100) + (n timesShort: x)]. negative ifTrue: [ result <- result negated ]. ^ result! + n | newDigits z carry | n isLongInteger ifFalse: [ ^ super + n ]. negative ifTrue: [ ^ n - self negated ]. n negative ifTrue: [ ^ self - n negated ]. " reduced to positive + positive case " newDigits <- List new. carry <- 0. self with: n bitDo: [:x :y | z <- x + y + carry. (z >= 100) ifTrue: [ carry <- 1. z <- z - 100] ifFalse: [ carry <- 0 ]. newDigits addLast: z ]. carry > 0 ifTrue: [ newDigits addLast: carry ]. ^ LongInteger negative: false digits: newDigits asArray! - n | result newDigits z borrow | n isLongInteger ifFalse: [ ^ super - n ]. negative ifTrue: [ ^ (self negated + n) negated ]. n negative ifTrue: [ ^ self + n negated ]. (self < n) ifTrue: [ ^ (n - self) negated ]. " reduced to positive - smaller positive " newDigits <- List new. borrow <- 0. self with: n bitDo: [:x :y | z <- (x - borrow) - y. (z >= 0) ifTrue: [ borrow <- 0] ifFalse: [ z <- z + 100. borrow <- 1]. newDigits addLast: z ]. result <- 0. "now normalize result by multiplication " newDigits reverseDo: [:x | result <- result * 100 + x ]. ^ result! < n | result | n isLongInteger ifFalse: [ ^ super < n ]. (negative == n negative) ifFalse: [ ^ negative ]. " now either both positive or both negative " result <- false. self with: n bitDo: [:x :y | (x ~= y) ifTrue: [ result <- x < y]]. negative ifTrue: [ result <- result not ]. ^ result! = n n isLongInteger ifFalse: [ ^ super = n ]. (negative == n negative) ifFalse: [ ^ false ]. ^ digits = n digits! abs negative ifTrue: [ ^ self negated] ! asFloat | r | r <- 0.0 . digits reverseDo: [ :x | r <- r * 100.0 + x asFloat]. negative ifTrue: [ r <- r negated ]. ^ r.! bitShift: n (n >= 0) ifTrue: [ ^ self * (2 raisedTo: n) ] ifFalse: [ ^ self quo: (2 raisedTo: n negated)]! coerce: n ^ n asLongInteger! digits ^ digits! generality ^ 4 "generality value - used in mixed type arithmetic "! isLongInteger ^ true! isShortInteger " override method in class Integer " ^ false! negated ^ LongInteger negative: negative not digits: digits! negative ^ negative! negative: nBool digits: dArray negative <- nBool. digits <- dArray! printString | str | str <- negative ifTrue: [ '-' ] ifFalse: [ '' ]. digits reverseDo: [:x | str <- str , (x quo: 10) printString , (x rem: 10) printString ]. ^ str! quo: value | a b quo result | result <- 0. a <- self abs. b <- value abs. [a > b] whileTrue: [ quo <- (a asFloat quo: b). result <- result + quo. a <- a - (b * quo) ]. ^ result! sign: s digits: d negative <- s. digits <- d.! timesShort: value | y z carry newDigits | y <- value abs. carry <- 0. newDigits <- digits collect: [:x | z <- x * y + carry. carry <- z quo: 100. z - (carry * 100)]. (carry > 0) ifTrue: [ newDigits <- newDigits grow: carry ]. ^ LongInteger negative: (negative xor: value negative) digits: newDigits! with: n bitDo: aBlock | d di dj | " run down two digits lists in parallel doing block " di <- digits size. d <- n digits. dj <- d size. (1 to: (di max: dj)) do: [:i | aBlock value: ((i <= di) ifTrue: [ digits at: i] ifFalse: [0]) value: ((i <= dj) ifTrue: [ d at: i] ifFalse: [0]) ]! }! {! Magnitude methods! < value ^ (self <= value) and: [ self ~= value ]! <= value ^ (self < value) or: [ self = value ]! = value ^ (self == value)! > value ^ (value < self)! >= value ^ value <= self! between: low and: high ^ (low <= self) and: [ self <= high ]! isChar ^ false! max: value ^ (self < value) ifTrue: [ value ] ifFalse: [ self ]! min: value ^ (self < value) ifTrue: [ self ] ifFalse: [ value ]! ~= value ^ (self = value) not! }! {! MessageNode methods! argumentsAreBlock arguments do: [ :arg | arg isBlock ifFalse: [ ^ false ]]. ^ true! cascade: encoder block: inBlock self evaluateArguments: encoder block: inBlock. (self sent2Arg: encoder selector: name) ifTrue: [ ^ self ]. self sendMessage: encoder block: inBlock! compile2: encoder block: inBlock self argumentsAreBlock ifTrue: [ name = #ifTrue: ifTrue: [ ^ self compile: encoder test: 8 constant: 5 block: inBlock ]. name = #ifFalse: ifTrue: [ ^ self compile: encoder test: 7 constant: 5 block: inBlock ]. name = #and: ifTrue: [ ^ self compile: encoder test: 9 constant: 7 block: inBlock ]. name = #or: ifTrue: [ ^ self compile: encoder test: 10 constant: 6 block: inBlock ] ]. name = #ifTrue:ifFalse: ifTrue: [ ^ self optimizeIf: encoder block: inBlock ]. self evaluateArguments: encoder block: inBlock. (self sent2Arg: encoder selector: name) ifTrue: [ ^ self ]. self sendMessage: encoder block: inBlock! compile: encoder block: inBlock receiver isNil ifTrue: [ ^ self cascade: encoder block: inBlock ]. "((receiver isBlock and: [ self argumentsAreBlock ]) and: [name = #whileTrue: or: [ name = #whileFalse ] ] )" (name = #whileTrue: or: [ name = #whileFalse ]) "fix" ifTrue: [ ^ self optimizeWhile: encoder block: inBlock ]. receiver compile: encoder block: inBlock. receiver isSuper ifTrue: [ ^ self sendToSuper: encoder block: inBlock ]. #(#isNil #notNil #value #new #class #size #basicSize #print #printString) binaryDo: [ :i :s | name = s ifTrue: [ ^ encoder genHigh: 10 low: i - 1 ] ]. self compile2: encoder block: inBlock! compile: encoder test: t constant: c block: inBlock | save | encoder genHigh: 15 low: t. " branch test " save <- encoder genCode: 0. arguments first compileInLine: encoder block: inBlock. encoder hack: save "fix?"! evaluateArguments: encoder block: inBlock encoder pushArgs: 1 + arguments size. arguments reverseDo: [ :arg | arg compile: encoder block: inBlock ]! optimizeIf: encoder block: inBlock | flsBlk truBlk save ssave | flsBlk <- arguments first. arguments removeFirst. truBlk <- arguments first. encoder genHigh: 15 low: 8. " branch if false test " save <- encoder genCode: 0. truBlk isBlock ifTrue: [ truBlk compileInLine: encoder block: inBlock ] ifFalse: [ "fix" truBlk compile: encoder block: inBlock. encoder genHigh: 10 low: 2 ]. "snd1 value" encoder genHigh: 15 low: 6. " branch " ssave <- encoder genCode: 0. encoder hack: save. "fix?" encoder genHigh: 15 low: 5. " pop " flsBlk isBlock ifTrue: [ flsBlk compileInLine: encoder block: inBlock ] ifFalse: [ "fix" flsBlk compile: encoder block: inBlock. encoder genHigh: 10 low: 2 ]. "snd1 value" encoder hack: ssave "fix?"! optimizeWhile: encoder block: inBlock | blk fwd top arg | receiver isBlock ifTrue: [ blk <- receiver newBlock. "fix" encoder genHigh: 4 low: (encoder genLiteral: blk). encoder genHigh: 5 low: 4. "ldc thisContext" encoder genHigh: 13 low: 2. "prim 29" encoder genCode: 29. encoder genHigh: 15 low: 6. "jmp " fwd <- encoder genCode: 0. blk basicAt: 4 put: encoder currentLocation + 1. receiver compileInLine: encoder block: true. encoder genHigh: 15 low: 2. "rtnt" encoder genHigh: 15 low: 4. "dup" encoder patch: fwd ] ":" ifFalse: [ "fix" receiver compile: encoder block: inBlock. encoder genHigh: 15 low: 4 ]. "dup" top <- encoder currentLocation. encoder genHigh: 10 low: 2. "snd1 value" name = #whileTrue: "jmpf/t " ifTrue: [ encoder genHigh: 15 low: 8 ] ifFalse: [ encoder genHigh: 15 low: 7 ]. fwd <- encoder genCode: 0. (arg <- arguments first) isBlock ifTrue: [ arg compileInLine: encoder block: inBlock ] ifFalse: [ "fix" arg compile: encoder block: inBlock. encoder genHigh: 10 low: 2 ]. "snd1 value" encoder genHigh: 15 low: 5. "pop" encoder genHigh: 15 low: 6. "jmp " encoder genCode: top. encoder genHigh: 15 low: 5. "pop" "fix" encoder patch: fwd ":"! receiver: r name: n arguments: a receiver <- r. name <- n. arguments <- a! sendMessage: encoder block: inBlock encoder popArgs: arguments size. " mark arguments, then send message " encoder genHigh: 8 low: 1 + arguments size. encoder genHigh: 9 low: (encoder genLiteral: name)! sendToSuper: encoder block: inBlock self evaluateArguments: encoder block: inBlock. encoder genHigh: 8 low: 1 + arguments size. encoder genHigh: 15 low: 11. encoder genCode: (encoder genLiteral: name)! sent2Arg: encoder selector: symbol #(#+ #- #< #> #<= #>= #= #~= #* #quo: #rem: #bitAnd: #bitXor: #== #, #at: #basicAt: #do: #coerce: #error: #includesKey: #isMemberOf: #new: #to: #value: #whileTrue: #addFirst: #addLast:) binaryDo: [ :i :s | symbol == s ifTrue: [ encoder genHigh: 11 low: i - 1. ^ true ] ]. ^ false! }! {! MetaclassMeta methods! metaName: nSym instanceSize: iInt methods: mDict superClass: sClass variables: vArray ^ self basicNew name: nSym instanceSize: iInt methods: mDict superClass: sClass variables: vArray! }! {! Metaclass methods! instName: nSym instanceSize: iInt methods: mDict superClass: sClass variables: vArray ^ self basicNew name: nSym instanceSize: iInt methods: mDict superClass: sClass variables: vArray! subClasses ^ classes inject: List new into: [:x :y | (y class superClass == self) ifTrue: [ x add: y class ]. x ]! }! {! Method methods! display ('Method ', message) print. 'text' print. text print. 'literals' print. literals print. 'bytecodes' print. bytecodes class print. bytecodes do: [:x | (x printString, ' ', (x quo: 16), ' ', (x rem: 16)) print ]! executeWith: arguments ^ (Context method: self arguments: arguments temporaries: (Array new: temporarySize) ) returnToBlock: 1! message: aSymbol message <- aSymbol! methodClass ^class! methodClass: aClass class <- aClass! name ^ message! printString ^ message asString! signature ^ class asString,' ', message asString! text ^ (text notNil) ifTrue: [ text ] ifFalse: [ 'text not saved']! text: aString text <- aString! trimmedText | dlm ans | dlm <- 10 asCharacter. (ans <- self text) isEmpty ifTrue: [ ^ans ]. [ (ans at: 1) == dlm ] whileTrue: [ ans <- ans copyFrom: 2 to: ans size ]. [ (ans at: ans size) == dlm ] whileTrue: [ ans <- ans copyFrom: 1 to: ans size - 1 ]. ^ans! watch: aBlock watch <- aBlock! watchWith: arguments " note that we are being watched " text print. watch value: arguments. ^ self executeWith: arguments! }! {! Number methods! * value ^ (self maxgen: value) * (value maxgen: self)! + value ^ (self maxgen: value) + (value maxgen: self)! - value ^ (self maxgen: value) - (value maxgen: self)! / value ^ (self maxgen: value) / (value maxgen: self)! // value " integer division, truncate towards negative infinity" " see quo: " ^ (self / value) floor! < value ^ (self maxgen: value) < (value maxgen: self)! = value ^ value isNumber ifTrue: [ (self maxgen: value) = (value maxgen: self) ] ifFalse: [ false ]! \\ value " remainder after integer division " ^ self - (self // value * value)! abs ^ (self < 0) ifTrue: [ 0 - self ] ifFalse: [ self ]! ceiling | i | i <- self truncated. ^ ((self positive) and: [ self ~= i ]) ifTrue: [ i + 1 ] ifFalse: [ i ]! copy ^ self! exp ^ self asFloat exp! floor | i | i <- self truncated. ^ ((self negative) and: [ self ~= i ]) ifTrue: [ i - 1 ] ifFalse: [ i ]! fractionalPart ^ self - self truncated! isInteger ^ self isLongInteger or: [ self isShortInteger ]! isNumber ^ true! ln ^ self asFloat ln! log: value ^ self ln / value ln! maxgen: value (self isNumber and: [ value isNumber ]) ifFalse: [ ^ smalltalk error: 'arithmetic on non-numbers' ]. ^ (self generality > value generality) ifTrue: [ self ] ifFalse: [ value coerce: self ]! negated ^ 0 - self! negative ^ self < 0! positive ^ self >= 0! quo: value ^ (self maxgen: value) quo: (value maxgen: self)! raisedTo: x | y | x negative ifTrue: [ ^ 1 / (self raisedTo: x negated) ]. x isShortInteger ifTrue: [ (x = 0) ifTrue: [ ^ 1 ]. y <- (self raisedTo: (x quo: 2)) squared. x odd ifTrue: [ y <- y * self ]. ^ y ] "use logrithms to do exponeneation" ifFalse: [ ^ ( x * self ln ) exp ]! reciprocal ^ 1 / self! rem: value ^ self - ((self quo: value) * value)! roundTo: value ^ (self / value ) rounded * value! sign ^ (self = 0) ifTrue: [ 0 ] ifFalse: [ self / self abs ]! sqrt ^ (self negative) ifTrue: [ smalltalk error: 'sqrt of negative'] ifFalse: [ self raisedTo: 0.5 ]! squared ^ self * self! strictlyPositive ^ self > 0! to: value ^ Interval lower: self upper: value step: 1! to: value by: step ^ Interval lower: self upper: value step: step! trucateTo: value ^ (self / value) trucated * value! }! {! Object methods! = aValue ^ self == aValue! == aValue ^ <21 self aValue>! asString ^ self printString! assign: name value: val ^ name assign: val! basicAt: index ^ <25 self index>! basicAt: index put: value ^ <31 self index value>! basicSize ^ <12 self>! class ^ <11 self>! copy ^ self shallowCopy! deepCopy | newObj | newObj <- self class new. (1 to: self basicSize) do: [:i | newObj basicAt: i put: (self basicAt: i) copy]. ^ newObj! display ('(Class ', self class, ') ' , self printString ) print! hash ^ <13 self>! isFloat ^ false! isFraction ^ false! isInteger ^ false! isKindOf: aClass self class upSuperclassChain: [:x | (x == aClass) ifTrue: [ ^ true ] ]. ^ false! isLongInteger ^ false! isMemberOf: aClass ^ self class == aClass! isNil ^ false! isNumber ^ false! isShortInteger ^ false! message: m notRecognizedWithArguments: a ^ smalltalk error: 'not recognized ', (self class printString), ' ', (m printString)! notNil ^ true! print self printString print ! printString ^ self class printString! respondsTo: message self class upSuperclassChain: [:c | (c methodNamed: message) notNil ifTrue: [ ^ true ]]. ^ false! shallowCopy | newObj | newObj <- self class new. (1 to: self basicSize) do: [:i | newObj basicAt: i put: (self basicAt: i) ]. ^ newObj! yourself ^ self! ~= aValue ^ self ~~ aValue! ~~ aValue ^ (self == aValue) not! }! {! Parser methods! addArgName: name (argNames includes: name) ifTrue: [ self error: 'doubly defined argument name ']. argNames size = 256 ifTrue: [ self error: 'too many arguments' ]. argNames <- argNames with: name! addTempName: name (((argNames includes: name) or: [ instNames includes: name ] ) or: [ tempNames includes: name ] ) ifTrue: [ self error: 'doubly defined name ']. tempNames size = 256 ifTrue: [ self error: 'too many temporaries' ]. tempNames <- tempNames with: name. maxTemps <- maxTemps max: tempNames size! arrayLiteral | node value | tokenType isAlphabetic ifTrue: [ node <- token asSymbol. self nextLex. ^ node ]. tokenType = $( ifTrue: [ self nextLex. value <- Array new: 0. [ tokenType ~= $) ] whileTrue: [ value <- value with: self arrayLiteral ]. self nextLex. ^ value ]. ^ self readLiteral! binaryContinuation: base | receiver name | receiver <- self unaryContinuation: base. [ self tokenIsBinary] whileTrue: [ name <- token asSymbol. self nextLex. receiver <- MessageNode new receiver: receiver name: name arguments: (List new addFirst: (self unaryContinuation: self readTerm)) ]. ^ receiver! charIsSyntax: c ^ ('.()[]#^$;' includes: c) or: [ c = $' ]! currentChar ^ text at: index ifAbsent: [ nil ]! error: aString ('compiler error ' , aString) print. errBlock value! getInstanceNames: aClass | pos ans tmp | pos <- aClass instanceSize. pos > 256 ifTrue: [ "fix?" self error: 'too many instance vars' ]. ans <- Array new: pos. aClass upSuperclassChain: [ :c | (tmp <- c variables) notNil ifTrue: [ tmp reverseDo: [ :v | ans at: pos put: v asSymbol. "fix" pos <- pos - 1 ] ] ]. ^ans! keywordContinuation: base | receiver name args | receiver <- self binaryContinuation: base. self tokenIsKeyword ifFalse: [ ^ receiver ]. name <- ''. args <- List new. [ self tokenIsKeyword ] whileTrue: [ name <- name , token. self nextLex. args addFirst: (self binaryContinuation: self readTerm) ]. ^ MessageNode new receiver: receiver name: name asSymbol arguments: args! lexAlphaNumeric | cc start | start <- index. [ (cc <- self nextChar) isAlphaNumeric ] whileTrue: [ nil ]. " add any trailing colons " cc = $: ifTrue: [ self nextChar ]. token <- text copyFrom: start to: index - 1! lexAlphabetic | cc start | start <- index. [ (cc <- self nextChar) isAlphabetic ] whileTrue: [ nil ]. " add any trailing colons " cc = $: ifTrue: [ self nextChar ]. token <- text copyFrom: start to: index - 1! lexBinary | c d | c <- self currentChar. token <- c asString. d <- self nextChar. (self charIsSyntax: c) ifTrue: [ ^ token ]. (((d asInteger <= 32 or: [ d isDigit]) or: [ d isAlphabetic ]) or: [ self charIsSyntax: d]) ifTrue: [ ^ token ]. token <- token , d asString. self nextChar! lexInteger | start | start <- index. [ self nextChar isDigit ] whileTrue: [ nil ]. token <- text copyFrom: start to: index - 1! nameNode: name " make a new name node " name == #super ifTrue: [ ^ ArgumentNode new position: 0 ]. (1 to: tempNames size) do: [:i | (name == (tempNames at: i)) ifTrue: [ ^ TemporaryNode new position: i ] ]. (1 to: argNames size) do: [:i | (name == (argNames at: i)) ifTrue: [ ^ ArgumentNode new position: i ] ]. (1 to: instNames size) do: [:i | (name == (instNames at: i)) ifTrue: [ ^ InstNode new position: i ] ]. (#(nil true false) includes: name) ifFalse: [ (symbols includesKey: name) ifTrue: [ ^ ValueNode new name: name ] ]. ^ LiteralNode new value: (symbols at: name "fix" ifAbsent: [ ^ self error: 'unrecognized name:' , name printString ])! nextChar index <- index + 1. ^ text at: index ifAbsent: [ $ ]! nextLex self skipBlanks. tokenType <- self currentChar. tokenType isNil " end of input " ifTrue: [ tokenType <- $ . token <- nil. ^ nil ]. tokenType isDigit ifTrue: [ ^ self lexInteger ]. tokenType isAlphabetic ifTrue: [ ^ self lexAlphaNumeric ]. ^ self lexBinary! parse: c | encoder | " note -- must call text:instanceVars: first " errBlock <- [ ^ nil ]. self nextLex. encoder <- Encoder new. encoder parser: self. encoder name: self readMethodName. self readMethodVariables. self readBody compile: encoder block: false. ^ encoder method: maxTemps class: c text: text! parse: aString in: aClass errBlock <- [ ^ nil ]. self text: aString instanceVars: (self getInstanceNames: aClass). ^ self parse: aClass! peekChar ^ text at: index + 1 ifAbsent: [ $ ]! readArray | value | self nextChar. self nextLex. value <- Array new: 0. [ tokenType ~= $) ] whileTrue: [ value <- value with: self arrayLiteral ]. self nextLex. ^ value! readBlock | stmts saveTemps argCount tmpCount | saveTemps <- tempNames. self nextLex. tokenType = $: ifTrue: [ self readBlockArguments ]. argCount <- tempNames size - saveTemps size. tokenType = $| ifTrue: [ self readBlockTemporaries ]. tmpCount <- tempNames size - saveTemps size - argCount. (stmts <- self readStatementList) isEmpty ifTrue: [ stmts addFirst: (self nameNode: 'nil' asSymbol) ]. tempNames <- saveTemps. tokenType = $] ifTrue: [ self nextLex. ^ BlockNode new statements: stmts temporaryLocation: saveTemps size argumentCount: argCount temporaryCount: tmpCount ] ifFalse: [ self error: 'unterminated block']! readBlockArguments [ tokenType = $: ] whileTrue: [ self currentChar isAlphabetic ifFalse: [ self error: 'ill formed block argument']. self nextLex. self tokenIsName ifTrue: [ self addTempName: token asSymbol ] ifFalse: [ self error: 'invalid block argument list ']. self nextLex ]. tokenType = $| ifTrue: [ self nextLex ] ifFalse: [ self error: 'invalid block argument list ']! readBlockTemporaries tokenType = $| ifFalse: [ ^ nil ]. self nextLex. [ self tokenIsName ] whileTrue: [ self addTempName: token asSymbol. self nextLex ]. tokenType = $| ifTrue: [ self nextLex ] ifFalse: [ self error: 'illegal block temporary declaration']! readBody ^ BodyNode new statements: self readStatementList! readCascade: base | node head list | node <- self keywordContinuation: base. tokenType = $; ifTrue: [ head <- node basicAt: 1. "fix" node basicAt: 1 put: nil. "fix" list <- List new. list addFirst: node. [ tokenType = $; ] whileTrue: [ self nextLex. list addFirst: (self keywordContinuation: nil ) ]. node <- CascadeNode new head: head. node list: list ]. ^ node! readExpression | node | self tokenIsName ifFalse: [ ^ self readCascade: self readTerm ]. node <- self nameNode: token asSymbol. self nextLex. self tokenIsAssign ifTrue: [ node assignable ifFalse: [ self error: 'illegal assignment']. self nextLex. ^ AssignNode new target: node expression: self readExpression ]. ^ self readCascade: node! readIntOrFlo | lpart rpart denom d value | tokenType isDigit ifFalse: [ self error: 'integer expected' ]. lpart <- 0. token do: [:c | lpart <- lpart * 10 + (c asInteger - 48) ]. (self currentChar = $. and: [self peekChar isDigit]) ifTrue: [ rpart <- 0. denom <- 1. [ (d <- self nextChar) isDigit ] whileTrue: [ rpart <- rpart * 10 + (d asInteger - 48). denom <- denom * 10 ]. value <- lpart asFloat + (rpart asFloat / denom asFloat) ] ifFalse: [ value <- lpart ]. self nextLex. ^ value! readInteger | value | tokenType isDigit ifFalse: [ self error: 'integer expected' ]. value <- 0. token do: [:c | value <- value * 10 + (c asInteger - 48) ]. self nextLex. ^ value! readLiteral | node | tokenType = $$ ifTrue: [ node <- self currentChar. self nextChar. self nextLex. ^ node ]. tokenType isDigit ifTrue: [ ^ self readIntOrFlo ]. token = '-' ifTrue: [ self nextLex. ^ self readIntOrFlo negated ]. tokenType = $' ifTrue: [ ^ self readString ]. tokenType = $# ifTrue: [ ^ self readSymbol ]. self error: 'invalid literal:' , token! readMethodName | name | self tokenIsName " unary method " ifTrue: [ name <- token. self nextLex. ^ name ]. self tokenIsBinary " binary method " ifTrue: [ name <- token. self nextLex. self tokenIsName ifFalse: [ self error: 'missing argument']. self addArgName: token asSymbol. self nextLex. ^ name ]. self tokenIsKeyword ifFalse: [ self error: 'invalid method header']. name <- ''. [ self tokenIsKeyword ] whileTrue: [ name <- name , token. self nextLex. self tokenIsName ifFalse: [ self error: 'missing argument']. self addArgName: token asSymbol. self nextLex ]. ^ name! readMethodVariables tokenType = $| ifFalse: [ ^ nil ]. self nextLex. [ self tokenIsName ] whileTrue: [ self addTempName: token asSymbol. self nextLex ]. tokenType = $| ifTrue: [ self nextLex ] ifFalse: [ self error: 'illegal method variable declaration']! readPrimitive | num args | self nextLex. num <- self readInteger. args <- List new. [ tokenType ~= $> ] whileTrue: [ args addFirst: self readTerm ]. self nextLex. ^ PrimitiveNode new number: num arguments: args! readStatement tokenType = $^ ifTrue: [ self nextLex. ^ ReturnNode new expression: self readExpression ]. ^ self readExpression! readStatementList | list | list <- List new. (token isNil or: [ tokenType = $] ] ) ifTrue: [ ^ list ]. [ list addFirst: self readStatement. tokenType notNil and: [ tokenType = $. ] ] whileTrue: [ self nextLex. (token isNil or: [ tokenType = $] ] ) ifTrue: [ ^ list ] ]. ^ list! readString | first last cc | first <- index. [ cc <- self currentChar. cc isNil ifTrue: [ self error: 'unterminated string constant']. cc ~= $' ] whileTrue: [ index <- index + 1 ]. last <- index - 1. self nextChar = $' ifTrue: [ self nextChar. ^ (text copyFrom: first to: index - 2) , self readString ]. self nextLex. ^ text copyFrom: first to: last! readSymbol | cc tmp | cc <- self currentChar. (cc isNil or: [ cc asInteger <= 32 ]) ifTrue: [ self error: 'invalid symbol']. cc = $( ifTrue: [ ^ self readArray ]. cc = $' ifTrue: [ self nextChar. ^ self readString asSymbol ]. (self charIsSyntax: cc) ifTrue: [ self error: 'invalid symbol']. self nextLex. self tokenIsKeyword ifTrue: [ [ (cc <- self currentChar) notNil and: [ cc isAlphabetic ] ] whileTrue: [ tmp <- token. self nextLex. self tokenIsKeyword ifTrue: [ token <- tmp , token ] ifFalse: [ self error: 'invalid keyword' ] ] ]. cc <- token asSymbol. self nextLex. ^ cc! readTerm | node | token isNil ifTrue: [ self error: 'unexpected end of input' ]. tokenType = $( ifTrue: [ self nextLex. node <- self readExpression. tokenType = $) ifFalse: [ self error: 'unbalanced parenthesis' ]. self nextLex. ^ node ]. tokenType = $[ ifTrue: [ ^ self readBlock ]. tokenType = $< ifTrue: [ ^ self readPrimitive ]. self tokenIsName ifTrue: [ node <- self nameNode: token asSymbol. self nextLex. ^ node ]. ^ LiteralNode new value: self readLiteral! skipBlanks | cc | [ cc <- self currentChar. cc notNil and: [ cc asInteger <= 32 ] ] "fix" whileTrue: [ index <- index + 1 ]. (cc notNil and: [ cc = $" ] ) ifTrue: [ self skipComment ]! skipComment | cc | [ index <- index + 1. cc <- self currentChar. cc isNil ifTrue: [ ^ self error: 'unterminated comment']. cc ~= $" ] whileTrue: [ nil ]. self nextChar. self skipBlanks! text: aString instanceVars: anArray text <- aString. index <- 1. argNames <- Array new: 1. argNames at: 1 put: #self. instNames <- anArray. tempNames <- Array new: 0. maxTemps <- 0! tokenIsAssign (token isKindOf: String) ifFalse: [ ^ false ]. ^ token = ':=' or: [ token = '<-' ]! tokenIsBinary (((token isNil or: [ self tokenIsName]) or: [ self tokenIsKeyword]) or: [ self charIsSyntax: tokenType ]) ifTrue: [ ^ false ]. ^ true! tokenIsKeyword tokenType isAlphabetic ifFalse: [ ^ false ]. ^ (token at: token size) = $:! tokenIsName tokenType isAlphabetic ifFalse: [ ^ false ]. ^ (token at: token size) isAlphaNumeric! unaryContinuation: base | receiver | receiver <- base. [ self tokenIsName ] whileTrue: [ receiver <- MessageNode new receiver: receiver name: token asSymbol arguments: (List new). self nextLex ]. ^ receiver! }! {! ParserNode methods! assignable ^ false! isBlock ^ false! isSuper ^ false! }! {! PrimitiveNode methods! compile: encoder block: inBlock arguments reverseDo: [ :a | a compile: encoder block: inBlock ]. encoder genHigh: 13 low: arguments size. encoder genCode: number! number: n arguments: a number <- n. arguments <- a.! }! {! ProcessMeta methods! context: cObj startAt: sInt ^ self new context: cObj startAt: sInt! new | sArray | sArray <- Array new: 50. sArray at: 2 put: 0. "previous link" sArray at: 4 put: 1. "return point" sArray at: 6 put: 1. "bytecode counter" ^ self basicNew stack: sArray stackTop: 10 linkPointer: 2! }! {! Process methods! context ^ stack at: 3! context: ctx stack at: 3 put: ctx.! context: cObj startAt: sInt stack at: 3 put: cObj. stack at: 6 put: sInt "starting bytecode value"! execute " execute for time slice, terminating if all over " (overflowed isNil and: [(stack size > 8192)]) ifTrue: [ overflowed <- true. smalltalk error: 'process stack overflowed']. <19 self> ifTrue: [] ifFalse: [ self terminate ].! method: x stack at: 5 put: x.! resume " resume current process " scheduler addProcess: self! stack: sArray stackTop: sInt linkPointer: lInt stack <- sArray. stackTop <- sInt. linkPointer <- lInt! startAt: x stack at: 6 put: x. "starting bytecode value"! terminate " kill current process " scheduler removeProcess: self. scheduler yield.! trace | more link m r s | " first yield scheduler, forceing store of linkPointer" overflowed notNil ifTrue: [ ^ self ]. scheduler yield. more <- 8. link <- linkPointer. link <- stack at: link+1. " then trace back chain " [ more > 0 and: [link ~= 0] ] whileTrue: [ m <- stack at: link+3. m notNil ifTrue: [ s <- m signature, ' ('. r <- stack at: link+2. (r to: link-1) do: [:x | s <- s, ' ', (stack at: x) class asString]. (s, ')') print ]. more <- more - 1. link <- stack at: link ]! }! {! Random methods! between: low and: high " return random number in given range " ^ (self next * (high - low)) + low! next " convert rand integer into float between 0 and 1 " ^ (<3> rem: 1000) / 1000! next: value | list | " return a list of random numbers of given size " list <- List new. value timesRepeat: [ list add: self next ]. ^ list! randInteger: value ^ 1 + (<3> rem: value)! set: value " set seed for random number generator " <55 value>! }! {! ReturnNode methods! compile: encoder block: inBlock expression compile: encoder block: inBlock. inBlock ifTrue: [ encoder genHigh: 5 low: 4. "ldc thisContext" encoder genHigh: 8 low: 1. "mark" encoder genHigh: 9 low: (encoder genLiteral: #blockReturn). encoder genHigh: 15 low: 5 ]. "pop" encoder genHigh: 15 low: 2 "rtnt"! expression: e expression <- e! }! {! SchedulerMeta methods! new ^ self basicNew notdone: true processList: Set new currentProcess: nil! }! {! Scheduler methods! addProcess: aProcess " add a process to the process list " processList add: aProcess! critical: aBlock "set time slice counter high to insure bytecodes are executed before continuing " <53 10000>. aBlock value. "then yield processor " <53 0>.! currentProcess " return the currently executing process " ^ currentProcess! initialize | string | <2>. string <- smalltalk getPrompt: '> '. string isNil ifTrue: [ '''EOF''' logChunk. notdone <- false ] ifFalse: [ (string size > 0) ifTrue: [ string logChunk. echoInput ifTrue: [ string print ]. [ string value print ] fork ] ]! notdone: nBool processList: pSet currentProcess: cProc notdone <- nBool. processList <- pSet. currentProcess <- cProc! removeProcess: aProcess " remove a given process from the process list " processList remove: aProcess.! run " run as long as process list is non empty " [ notdone ] whileTrue: [ processList size = 0 ifTrue: [ self initialize ]. processList do: [ :x | currentProcess <- x. x execute ] ]! yield " set time slice counter to zero, thereby yielding to next process " <53 0>! }! {! SemaphoreMeta methods! new ^ self basicNew count: 0 processList: List new! }! {! Semaphore methods! count: cInt processList: pList count <- cInt. processList <- pList! critical: aBlock self wait. aBlock value. self signal! set: aNumber count <- aNumber! signal (processList size = 0) ifTrue: [ count <- count + 1] ifFalse: [ scheduler critical: [ processList first resume. processList removeFirst ]]! wait | process | (count = 0) ifTrue: [ scheduler critical: [ process <- scheduler currentProcess. processList add: process. scheduler removeProcess: process]. scheduler yield ] ifFalse: [ count <- count - 1]! }! {! Set methods! add: value (self includes: value) ifFalse: [ self addFirst: value ]! }! {! Smalltalk methods! echo " enable - disable echo input " echoInput <- echoInput not! error: aString " print a message, and remove current process " stderr print: aString. scheduler currentProcess yourself; trace; terminate! getPrompt: aString stdout printNoReturn: aString. ^ stdin getString! inquire: aString | response | response <- self getPrompt: aString. response isNil ifTrue: [ ^ false ]. ^ 'Yy' includes: (response at: 1 ifAbsent: [])! perform: message withArguments: args ^ self perform: message withArguments: args ifError: [ self error: 'cant perform' ]! perform: message withArguments: args ifError: aBlock | receiver method | receiver <- args at: 1 ifAbsent: [ ^ aBlock value ]. method <- receiver class methodNamed: message. ^ method notNil ifTrue: [ method executeWith: args ] ifFalse: aBlock! saveImage self saveImage: (self getPrompt: 'type image name: '). ^ 'done'! saveImage: name scheduler critical: [ " first get rid of our own process " scheduler removeProcess: scheduler currentProcess. (File name: name open: 'w') yourself; saveImage; close ]! shutDown files do: [ :e | e notNil ifTrue: [ (#('stdin' 'stdout' 'stderr') includes: e name) ifFalse: [ e close ] ] ]! watch ^ <5>! }! {! StringMeta methods! basicNew: size ^ self primBytes: size + 1! new: size ^ self primBytes: size + 1! }! {! String methods! , value (value isMemberOf: String) ifTrue: [ ^ <24 self value> ] ifFalse: [ ^ self , value asString ]! < value (value isKindOf: String) ifTrue: [ ^ super < value ] ifFalse: [ ^ false ]! = value (value isKindOf: String) ifTrue: [ ^ super = value ] ifFalse: [ ^ false ]! asByteArray | newArray i | newArray <- ByteArray new: self size. i <- 0. self do: [:x | i <- i + 1. newArray at: i put: x asInteger]. ^ newArray! asInteger ^ self inject: 0 into: [:x :y | x * 10 + y digitValue ]! asString ^ self! asSymbol ^ <83 self>! basicAt: index ^ (super basicAt: index) asCharacter! basicAt: index put: aValue (aValue isMemberOf: Char) ifTrue: [ super basicAt: index put: aValue asInteger ] ifFalse: [ smalltalk error: 'cannot put non Char into string' ]! copy " catenation makes copy automatically " ^ '',self! copyFrom: position1 to: position2 ^ <33 self position1 position2>! edit | file text | (file <- File new) yourself; scratchFile; open: 'w'; print: self; close. (editor, ' ', file name) unixCommand. file open: 'r'. text <- file asString. file yourself; close; delete. ^ text! execute | meth | " execute self as body of a method " meth <- Parser new parse: 'DoIt ' , self in: UndefinedObject. ^ meth notNil ifTrue: [ meth executeWith: (Array new: 1) ] "nil" ifFalse: [ nil ]! hash ^ <82 self>! print stdout print: self! printString ^ '''' , self, ''''! size ^ <81 self>! trimmed | dlm ans | dlm <- 10 asCharacter. (ans <- self) isEmpty ifTrue: [ ^ans ]. [ (ans at: 1) == dlm ] whileTrue: [ ans <- ans copyFrom: 2 to: ans size. ans isEmpty ifTrue: [ ^ ans ] ]. [ (ans at: ans size) == dlm ] whileTrue: [ ans <- ans copyFrom: 1 to: ans size - 1. ans isEmpty ifTrue: [ ^ ans ] ]. ^ans! unixCommand ^ <88 self>! value " evaluate self as an expression " ^ ( '^ [ ', self, ' ] value' ) execute! words: aBlock | text index list | list <- List new. text <- self. [ text <- text copyFrom: (text indexOf: aBlock ifAbsent: [ text size + 1]) to: text size. text size > 0 ] whileTrue: [ index <- text indexOf: [:x | (aBlock value: x) not ] ifAbsent: [ text size + 1]. list addLast: (text copyFrom: 1 to: index - 1). text <- text copyFrom: index to: text size ]. ^ list asArray! }! {! Switch methods! else: block notdone ifTrue: [ notdone <- false. block value ]! ifMatch: key do: block (notdone and: [ const = key ]) ifTrue: [ notdone <- false. block value ]! key: value const <- value. notdone <- true.! }! {! Symbol methods! apply: args ^ self apply: args ifError: [ 'does not apply' ]! apply: args ifError: aBlock ^ smalltalk perform: self withArguments: args ifError: aBlock! asString " catenation makes string and copy automatically " ^ <24 self ''>! asSymbol ^ self! assign: value <27 self value>. ^ value! copy ^ self! printString ^ '#' , self asString! respondsTo ^ classes inject: Set new into: [:x :y | ((y methodNamed: self) notNil) ifTrue: [ x add: y]. x]! stringHash ^ <82 self>! value ^ <87 self>! }! {! SymbolTable methods! hash: aKey ^ 3 * ((aKey stringHash) rem: ((hashTable size) quo: 3))! printString ^ self class printString , ' (...)'! }! {! TemporaryNode methods! assign: encoder encoder genHigh: 7 low: position - 1! assignable ^ true! compile: encoder block: inBlock encoder genHigh: 3 low: position - 1! position: p position <- p! }! {! True methods! ifTrue: trueBlock ifFalse: falseBlock ^ trueBlock value! not ^ false! printString ^ 'true'! xor: aBoolean ^ aBoolean not! }! {! UndefinedObject methods! initBot | aBlock saveFile saveAns | " initialize the initial object image " aBlock <- [ files do: [:f | f notNil ifTrue: [ f open ]]. echoInput <- false. scheduler run. scheduler <- Scheduler new. systemProcess <- aBlock newProcess ]. scheduler <- Scheduler new. systemProcess <- aBlock newProcess. saveFile <- File name: 'systemImage' open: 'w'. saveAns <- saveFile saveImage. saveFile close. stdout yourself; printNoReturn: 'saveImage: '; print: saveAns printString! initMid " initialize the initial object image " | metaclasses key | metaclasses <- Dictionary new. symbols binaryDo: [ :x :y | (y class == Metaclass) ifTrue: [ key <- (x asString copyFrom: 1 to: x basicSize - 5) asSymbol. metaclasses at: key put: y ] ]. classes <- Dictionary new. symbols binaryDo: [ :x :y | ((metaclasses at: x ifAbsent: [nil]) == y class) ifTrue: [ classes at: x put: y ] ]! initTop " initialize the initial object image " files <- Array new: 15. (stdin <- File name: 'stdin' mode: 'r') open. (stdout <- File name: 'stdout' mode: 'w') open. (stderr <- File name: 'stderr' mode: 'w') open. editor <- 'vi'! initialize " initialize the initial object image " smalltalk <- Smalltalk new. self initTop. self initMid. self initBot! isNil ^ true! notNil ^ false! printString ^ 'nil'! }! {! ValueNode methods! assign: encoder "encoder genHigh: 7 low: position - 1" self halt! assign: encoder value: expression block: inBlock "fix" encoder genHigh: 2 low: 0. "self" encoder genHigh: 4 low: (encoder genLiteral: name). expression compile: encoder block: inBlock. encoder genHigh: 8 low: 3. "mark" encoder genHigh: 9 low: (encoder genLiteral: #assign:value:)! assignable ^ true! compile: encoder block: inBlock "fix" encoder genHigh: 4 low: (encoder genLiteral: name). encoder genHigh: 10 low: 2 "value"! name: n name <- n! }!