('Welcome to GNU Smalltalk [', Version, '] This file contains a wealth of goodies, not all packaged neatly. It sort of grows by accretion, so you''re likely to find most anything in here.' ) printNl. Smalltalk quitPrimitive! "| q | q _ SharedQueue new. q nextPut: 'foo'. q nextPut: 'bar'. q next printNl. q next printNl. q next printNl ""Should print no-runnable-proceses"" ! " Object withAllSubclasses do: [ :subclass | (subclass name notNil and: [ subclass comment isNil ]) ifTrue: [ subclass name print. ' has no comment.' printNl ] ] ! Smalltalk quitPrimitive! !Object methodsFor: 'testing'! test | x | x _ [ :dummy | "thisContext inspect. Smalltalk backtrace." thisContext backit ]. " x inspect." x value: 3 ! backit | n context | n _ 0. context _ thisContext. [ context notNil ] whileTrue: [ n _ n + 1. context _ context parentContext ]. context _ thisContext. n to: 1 by: -1 do: [ :i | context receiver print. '>>' print. context selector printNl. context _ context parentContext ]. !! !BlockContext methodsFor: 'debugging'! callers self inspect. caller notNil ifTrue: [ caller callers ] ! parentContext ^caller ! selector ^selector ! receiver ^'[] in ', home class name !! !MethodContext methodsFor: 'debugging'! callers self inspect. sender notNil ifTrue: [ sender callers ] ! parentContext ^sender ! receiver ^receiver class name ! selector ^selector !! 3 test! Smalltalk quitPrimitive! "| count | SymbolTable do: [ :elt | elt printString. "Character nl print count _ 0. elt notNil ifTrue: [ elt do: [ :x | count _ count + 1 ]]. count timesRepeat: [ 'x' print ]. Character nl print" ] ! Smalltalk quitPrimitive! " "| d days | d _ Date new. 1 to: 70 do: [ :year | days _ year * 365. days - 5 to: days + 5 do: [ :i | d setDays: i. d printString ] ] ! Smalltalk quitPrimitive!" Date edit: #computeDateParts:! "| pipe | pipe _ FileStream popen: 'lpr -Pelab' dir: 'w'. FileStream fileOutOn: pipe. FileStream class fileOutOn: pipe. pipe close!" | d days | d _ Date new. 1 to: 70 do: [ :year | days _ year * 365. '----------' printNl. days - 5 to: days + 5 do: [ :i | d setDays: i. d printNl ] ] ! Date today printNl! | f | f _ ReadWriteStream on: (String new: 0). 'foo on you' printOn: f. f position: 3. '123456789' printOn: f. f skip: -1. f next printNl. f contents printNl. f reset. 'test[]' printOn: f. f contents printNl! 16r3F0000000 printNl! Smalltalk quitPrimitive! !Date methodsFor: 'rambo'! computeDateParts: aBlock | yearInteger tempDays monthIndex daysInMonth | tempDays _ days - (days // 1460) "4*365" + (days // 36500) "100*365" - (days // 146000). "400*365" yearInteger _ tempDays // 365. tempDays _ days - (yearInteger * 365) - (yearInteger // 4) + (yearInteger // 100) - (yearInteger // 400) + 1. yearInteger _ yearInteger + 1901. monthIndex _ 1. [ monthIndex < 12 and: [ daysInMonth _ Date daysInMonthIndex: monthIndex forYear: yearInteger. tempDays > daysInMonth ] ] whileTrue: [ monthIndex _ monthIndex + 1. tempDays _ tempDays - daysInMonth ]. ^aBlock value: yearInteger value: monthIndex value: tempDays !! | d days | d _ Date new. 1 to: 70 do: [ :year | days _ year * 365. '----------' printNl. days - 5 to: days + 5 do: [ :i | d setDays: i. d printNl ] ] ! Date today printNl! | f | f _ ReadWriteStream on: (String new: 0). 'foo on you' printOn: f. f position: 3. '123456789' printOn: f. f skip: -1. f next printNl. f contents printNl. f reset. 'test[]' printOn: f. f contents printNl! 16r3F0000000 printNl! | d days | d _ Date new. 1 to: 70 do: [ :year | days _ year * 365. '----------' printNl. days - 3 to: days + 10 do: [ :i | d setDays: i. d printNl ] ] ! Date today printNl! | f | f _ ReadWriteStream on: (String new: 0). 'foo on you' printOn: f. f position: 3. '123456789' printOn: f. f skip: -1. f next printNl. f contents printNl. f reset. 'test[]' printOn: f. f contents printNl! Object withAllSubclasses do: [ :aClass | aClass fileOutOn: stdout ]! !Bag methodsFor: 'enumerating the elements of a collection'! occurrencesOf: anObject ^contents at: anObject ifAbsent: [ ^0 ] ! size | count | count _ 0. contents printNl. contents do: [ :element | count _ count + element ]. ^count ! do: aBlock contents associationsDo: [ :assoc | assoc value printNl " assoc value timesRepeat: [ aBlock value: assoc key ]" ] !! | b | b _ Bag new. (b occurrencesOf: 'foo' ) printNl. b size printNl. b basicSize printNl. b add: 'foo'. b add: 'bar'. b add: 'quem.'. b do: [ :value | 'value is ' print. value printNl ] ! !ClassDescription methodsFor: 'filing'! fileOutOn: aFileStream | categories | categories _ Bag new. methodDictionary do: [ :method | categories add: (method methodCategory) ]. 'categories....' printNl. categories inspect. categories do: [ :category | category printNl "self emitCategory: category toStream: aFileStream" ] !! !ClassDescription methodsFor: 'private'! emitCategory: category toStream: aFileStream ' methodsFor: ''' printOn: aFileStream. category printOn: aFileStream. ''' ' printOn: aFileStream. methodDictionary do: [ :method | (method methodCategory) = category ifTrue: [ method methodSourceString printOn: aFileStream. '! ' printOn: aFileStream ] ]. '! ' printOn: aFileStream !! Object fileOutOn: stdout! "Boolean selectors do: [ :selectors | selectors printNl ]. ' after ' printNl. Boolean copyCategory: 'basic' from: True. Boolean selectors do: [ :selectors | selectors printNl ]!" "| method newMethod | method _ CompiledMethod compiledMethodAt: #bytecodeAt:. 'Original' printNl. method inspect. ' Cheap imitation' printNl. newMethod _ Object copy: #bytecodeAt: from: CompiledMethod classified: 'rambo'. (Object compiledMethodAt: #bytecodeAt:) methodCategory printNl. method methodCategory printNl ! Smalltalk quitPrimitive!" "| j | j _ 0. 1 to: 20000 do: [ :i | j _ j + i ]! Smalltalk quitPrimitive!" "Smalltalk gcMessage: false!" !ClassDescription methodsFor: 'test'! printSubclassMethods | mySubclasses | self name printNl. instanceVariables notNil ifTrue: [ 'Instance variables: ' print. instanceVariables do: [ :var | var print. ' ' print ]. Character nl print]. '-----------------------------------------------' printNl. self selectors asSortedCollection do: [ :selector | (self compiledMethodAt: selector) methodSourceString printNl. '' printNl ]. mySubclasses _ self subclasses asSortedCollection: [ :a :b | (a name isNil or: [ b name isNil ]) ifTrue: [ true ] ifFalse: [ a name <= b name ] ]. mySubclasses do: [ :subclass | subclass class ~~ Metaclass ifTrue: [ subclass printSubclassMethods ] ] !! Object printSubclassMethods! Smalltalk quitPrimitive! "" !Collection methodsFor: 'test'! printSorted self asSortedCollection do: [ :element | ' ' print. element printNl ] !! " Smalltalk at: #BasicClassSelectors put: Class allSelectors! " !Behavior methodsFor: 'test'! printInheritedSelectors | sels | sels _ self allSelectors. sels removeAll: self selectors. sels printSorted ! " printNewSelectors | sels | sels _ self allSelectors. sels removeAll: BasicClassSelectors. sels printSorted !"! Smalltalk monitor: true. Class printInheritedSelectors. Smalltalk monitor: false. Smalltalk quitPrimitive!" " "MetaClass allInstancesDo: [ :inst | '------------' print. inst print. inst printNewSelectors. '' print ] !" "| selectorSet newSelectors | selectorSet _ Set new. Object withAllSubclasses do: [ :subclass | newSelectors _ subclass selectors. '-----------------' print. subclass print. newSelectors printSorted. '' print. selectorSet addAll: newSelectors ]. '****************' print. 'The set of selectors is...' print. selectorSet size print. selectorSet do: [ :elt | elt print ] !" 'LIVE' printNl! (Object withAllSubclasses asSortedCollection: [ :a :b | (a name isNil or: [ b name isNil ]) ifTrue: [ true ] ifFalse: [ a name <= b name ] ]) do: [ :subclass | subclass class ~~ Metaclass ifTrue: [ '------------------------------------------' printNl. subclass printNl. 'inherited selectors' printNl. subclass printInheritedSelectors. '' printNl ] ]! Smalltalk quitPrimitive! " "**********************************************************************" ('foo' match: 'foo') printNl. ('foo' match: 'FoO') printNl. ('#oo' match: 'Foo') printNl. ('###' match: 'que') printNl. 'should be false ' print. ('###' match: 'quem') printNl. 'should be false ' print. ('###' match: 'bo') printNl. 'should be true ' print. ('* string' match: 'any string') printNl. 'should be true ' print. ('*.st' match: 'filename.st') printNl. 'should be true ' print. ('foo.*' match: 'foo.bar') printNl. 'should be true ' print. ('foo.*' match: 'foo.') printNl. 'should be true ' print. ('*' match: 'foo.') printNl. 'should be true ' print. ('*' match: '') printNl. 'should be true ' print. ('***' match: '') printNl. 'should be true ' print. ('*.st' match: '.st') printNl. 'should be true ' print. ('*#*' match: '.st') printNl. 'should be true ' print. ('*#*' match: '.s') printNl. 'should be true ' print. ('*#*' match: 's') printNl. 'should be false ' print. ('*.st' match: '.s') printNl. 'should be false ' print. ('*#*' match: '') printNl! Smalltalk quitPrimitive! | j | j _ 0. 1 to: 1000 do: [ :i | j _ j + i ]! Smalltalk quitPrimitive! 300 timesRepeat: [ String new: 20000 ]. 'Foo ' printNl! "Smalltalk quitPrimitive!" !Object methodsFor: 'testing'! quem ^1 + 2 !! !Symbol methodsFor: 'testing'! quem ^1 + 2 !! ((Object compiledMethodAt: #quem) = (Object compiledMethodAt: #quem)) printNl." (LinkedList compiledMethodAt: #addLast:) inspect. (CompiledMethod compiledMethodAt: #inspect) inspect. (Integer compiledMethodAt: #+) inspect. (Stream compiledMethodAt: #next) methodSourceString printNl! (LinkedList compiledMethodAt: #addLast:) methodSourceString printNl! Smalltalk at: #quem put: (['foo' printNl. Processor yield ] newProcess)! Smalltalk at: #proc2 put: (['process2' printNl. Processor yield. 'Hi again from proc 2' printNl. Processor yield ] newProcess)! ['process3' printNl. Processor yield ] fork! quem resume. proc2 resume! 'Yielding...' printNl. Processor yield! "proc2 terminate." 'Back to main' printNl. Processor yield. 'Back to main from second yield' printNl. Smalltalk at: #rambo put: ([ :arg1 :arg2 | arg2 printNl". Processor yield" ] newProcessWith: #('foo on you' 'and your mother'))! rambo resume! Processor yield! Smalltalk quitPrimitive! !Object methodsFor: 'debugging'! ! !Behavior methodsFor: 'test'! ! !ClassDescription methodsFor: 'debug'! printClass | instVarNames instVars instVal | instanceVariables printNl. instVarNames _ self instanceVariableString. instVars _ (TokenStream on: instVarNames) contents. self printNl. 1 to: instVars size do: [ :i | ' ' print. (instVars at: i) print. ': ' print. instVal _ self instVarAt: i. (instVal isKindOf: Dictionary) ifTrue: [ instVal printNl "'a ' print. instVal class print. ' with ' print. instVal size print. ' elements' printNl" ] ifFalse: [ instVal printNl ] ] !! !Metaclass class methodsFor: 'basic'! ! !Metaclass methodsFor: 'basic'! ! | newMeta | newMeta _ Metaclass subclassOf: Object class. (newMeta class whichClassIncludesSelector: #new) printNl. newMeta name: 'Rambo' environment: Smalltalk subclassOf: Object instanceVariableNames: 'john paul george ringo ' variable: false words: true pointers: true classVariableNames: 'charlie davey' poolDictionaries: '' category: '' comment: 'no comment' changed: false ". newMeta print"! Collection inspect! Rambo inspect! Rambo new inspect! "Smalltalk system: 'mail jb'! Smalltalk system: 'ls -lt *.st'!" "12500000000000000000000000000000000.0 print. 0.0625 print. 0.125 print. 0.25 print. 0.5 print. 0.12345678901234 print. 0.0 print. 1.0 print. 2.0 print. 3345678912345678.0 print!" "Behavior defineCFunc: 'marli' withSelectorArgs: 'doMarli: anInteger' forClass: Object returning: #void args: #(int). nil doMarli: 3!" "| addr | addr _ Memory addressOf: 'Quem? and your mother'. (WordMemory at: addr) print. Character nl print. addr _ addr + 8. (Character value: (ByteMemory at: addr)) print. Character nl print !" "(ByteMemory at: 16r2000) print. Character nl print. (ByteMemory at: 16r2001) print. Character nl print. (ByteMemory at: 16r2002) print. Character nl print. (ByteMemory at: 16r2003) print. Character nl print!" " | l | l _ LinkedList new. l add: (Link new). l add: (Link new). l add: (Link new). l store !" "3.5 print. ' ' print! 3.5e5 print. ' ' print!" "!Object methodsFor: 'test'!" "testComp Object compile: (FileStream open: 'test.st' mode: 'r')" " Object compile: 'rambo ''Hi there'' print'" "!!" "nil testComp. nil rambo! " | d | Smalltalk monitor: true. d _ Date new. 10000 to: 10050 do: [ :i | d setDays: i. d storeString. "Character nl print" ] . Smalltalk monitor: false ! | s | "Smalltalk monitor: true." s _ Bag new. s add: #quem. s add: #zoneball. s add: #quem. s add: #juma withOccurrences: 20. s print. s store. " s add: #quem. s add: #juma." " s add: 12345. 'after adding ' print." " s add: 'wont you please break that record' ." " s add: $c." s printOn: stdout. stdout nextPut: Character nl. s storeOn: stdout ". Smalltalk monitor: false" ! "| f | f _ FileStream open: 'foo.test' mode: 'w'. f nextPutAll: 'this is a test of your mother'. f nextPut: Character nl. f close ! | f | f _ FileStream open: 'foo.test' mode: 'r'. [ f atEnd ] whileFalse: [ f next print ]. f position: 0. [ f atEnd ] whileFalse: [ f next print ]. f close ! " !Set methodsFor: 'testing'! printSet 1 to: self basicSize do: [ :i | 'at ' print. i print. (self basicAt: i) print. ] ! findNilBefore: index "Finds the first nil element before index and returns the index of that nil. If there is no nil element, index is returned." | size count i | count _ size _ self basicSize. i _ index. [ count > 0 ] whileTrue: [ i _ i - 2 \\ size + 1. "step backward w/wrap through elements" (self basicAt: i) isNil ifTrue: [ ^i ]. count _ count - 1 ]. ^index + 1 !! Smalltalk quitPrimitive! !Collection methodsFor: 'test'! printSorted self asSortedCollection do: [ :element | element print ] !! Smalltalk at: #BasicClassSelectors put: Class allSelectors! !Behavior methodsFor: 'test'! printInheritedSelectors | sels | sels _ self allSelectors. sels removeAll: self selectors. sels printSorted ! printNewSelectors | sels | sels _ self allSelectors. sels removeAll: BasicClassSelectors. sels printSorted !! "Smalltalk monitor: true. Class printInheritedSelectors. Smalltalk monitor: false. Smalltalk quitPrimitive!" "MetaClass allInstancesDo: [ :inst | '------------' print. inst print. inst printNewSelectors. '' print ] !" | selectorSet newSelectors | selectorSet _ Set new. Object withAllSubclasses do: [ :subclass | newSelectors _ subclass selectors. '-----------------' print. subclass print. newSelectors printSorted. '' print. selectorSet addAll: newSelectors ]. '****************' print. 'The set of selectors is...' print. selectorSet size print. selectorSet do: [ :elt | elt print ] ! Smalltalk quitPrimitive! (Object withAllSubclasses "asSortedCollection: [ :a :b | (a name isNil or: [ b name isNil ]) ifTrue: [ true ] ifFalse: [ a name <= b name ] ]") do: [ :subclass | subclass class ~~ MetaClass ifTrue: [ '------------------------------------------' print. subclass print. 'inherited selectors' print. subclass printInheritedSelectors. '' print ] ]! " !Object methodsFor: 'test'! printElements self do: [ :element | element print ] ! "counter | i total | total _ i _ 0. [i <= self] whileTrue: [ total _ total + i. i _ i + 1 ]. ^total ! timer | i | i _ 0. [i < self] whileTrue: [ i _ i + 1 ] " count2 | sum | sum _ 0. 1 to: self do: [ :i | sum _ sum + i ]. ^sum ! myTest ^12 factorial !! !Integer methodsFor: 'test'! factorial self > 0 ifTrue: [ self * (self - 1) factorial ] ifFalse: [ ^self error: 'factorial of a small number' ] !! ^Symbol allInstances size! Smalltalk quitPrimitive! "^Date yearAsDays: 1904! 1850 to: 2050 do: [ :year | year print. (Date leapYear: year) print ]!" | s | s _ WriteStream on: (String new: 0). s nextPutAll: 'name'. s tab. s nextPutAll: 'city'. s reset. s nextPutAll: 'foo'. s setToEnd. s nl. s nextPutAll: 'quem?'. s workingSize print. ^s contents ! | s str| str _ WriteStream on: (String new: 5). s _ #(foo bar baz quem juma zoneball). s do: [ :sym | str nextPutAll: sym , ' ' ]. ^str contents " s _ s inject: '' into: [ :str :atom | str , atom , ' ' ]. s size print. s grow. s size print. s print" ! | t | t _ #(foo bar baz). t _ t , #(quem juma). t do: [ :element | element print ]! " Smalltalk at: #children put: SortedCollection new! ^children add: #Joe! ^children add: #Bill! ^children add: #Alice! ^children printElements! ^children add: #Sam! ^(children sortBlock: [ :a :b | a > b ]) printElements! ^children add: #Henrietta! ^children printElements! " | t | t _ SortedCollection new. t add: 'foo'. t add: 'bar'. t add: 'dinner'. t add: 'in'. t add: 'the'. t add: 'diner'. t add: 'nothing'. t add: 'could'. t add: 'be'. t add: 'finer'. "1 to: t size do: [ :i | i print. (t at: i ) print ]." t sortBlock: [ :a :b | a > b ]. 1 to: t size do: [ :i | i print. (t at: i ) print ]. ! 600 to: 1000 do: [ :i | i print. i asObject print ]! ^(Bag with: #foo with: #foo ) occurrencesOf: #foo! " Smalltalk at: #Test put: Dictionary new. Smalltalk at: #X put: 0! X _ Bag new! ^X occurrencesOf: 3! ^X add: 3! Test at: #jeff put: 1. Test at: #steve put: 5. Test at: #jiz put: 99! ^Test at: #jeff! ^Test at: #steve! ^Test at: #jiz! X _ Test collect: [ :elt | elt * 2 ]! ^X occurrencesOf: 1! ^X occurrencesOf: 2! ^X occurrencesOf: 5! ^X occurrencesOf: 10! ^X occurrencesOf: 99! ^X occurrencesOf: 99*2! ^X size! " " ^Test at: #blockA put: [ 'this is a test' ]! ^Test at: #blockB put: [ 'hello from block b' ]! ^Test at: #juma put: 'hello jeff!!!'! ^Test size! ^Test at: #juma! ^(Test at: #blockB) value! ^(Test at: #blockA) value! ^Test removeKey: #juma! ^Test size! ^Test removeKey: #juma! " "^Test _ Bag new! ^Test add: #quem! ^Test size! ^Test basicSize! " " ^Test _ Set new! ^'test'! ^Test basicSize! ^Test findObjectIndex: #foo! ^Test species! ^Test add: #quem! ^Test add: #juma! ^Test size! ^Test grow! ^Test add: #juma2! ^Test add: #juma3! ^Test size! ^Test basicSize! ^Test findObjectIndex: #juma2! ^Test remove: #juma2! ^Test findObjectIndex: #juma2! ^Test basicAt: (Test findObjectIndex: #juma2)! ^Test size! ^Test occurrencesOf: #juma2! ^Test occurrencesOf: #juma3! ^Test remove: #juma2!" "^3 * 4.0! ^Float pi! ^'QuemonYour:Mother:' asSymbol! ^3 zoneball! ^#FoobarOnYouBar asUppercase! []! ^[] value! ^3 count2! ^4 count2!" " !Object methodsFor: 'test'! dictTest | d | d _ Dictionary new. d at: #foo put: #bar. d at: #quem put: #juma. d at: #barf put: 'your mama'. ^d at self !!" "Smalltalk at: #poolDict1 put: Dictionary new! Smalltalk at: #poolDict2 put: Dictionary new! poolDict1 at: #pd1foo put: 'foo'! poolDict1 at: #pd1bar put: #bar! poolDict2 at: #pd2baz put: 'bazola'! poolDict2 at: #pd2barn put: #fred! Object subclass: #Rambo instanceVariableNames: 'foo bar' classVariableNames: 'guinea pigs' poolDictionaries: 'poolDict1' category: ''! !Rambo methodsFor: 'test'! xxx pd1foo _ 3. ^pd1bar testMessage: pd2barn + pd2baz ! ramboTest foo _ 3. bar _ 7. ^foo + bar ! initPigs: guineaArg and: pigsArg guinea _ guineaArg. pigs _ pigsArg ! foof ^foo ! barf ^bar ! returnGuinea ^guinea ! returnPigs ^pigs !! Rambo subclass: #Rocky instanceVariableNames: 'quem juma' classVariableNames: '' poolDictionaries: 'poolDict2' category: ''! !Rocky methodsFor: 'test'! xxx pd1foo _ 3. ^pd1bar testMessage: pd2barn + pd2baz ! ramboTest foo _ 12. bar _ 3. ^foo + bar ! quem: arg quem _ arg ! quem ^quem ! juma: arg juma _ arg ! juma ^juma !! " "Smalltalk at: #testVar put: Rambo new!" "^#barf dictTest! ^#foo dictTest! ^#quem dictTest!" "^2 arrayTest!" "^nil atest2!" " ^$C = ('FUBAR' at: 3) !" "^1000 counter !" "^16rA + 16rA ! ^$C ! ^#foo:bar:baz: ! ^'this is a test string I wonder how this will print' !" "100000 timer!" "^3 < 4 ifTrue: [^#foobar] !" " !Boolean methodsFor: 'test'! quem: bar juma: baz bar _ #foon:barn:. baz _ 3. ! marli true when: [3 < (Smalltalk at: #foo)] do: #quem:bar:. Smalltalk at: #foo put: 3 !! !String methodsFor: 'your mother'! xxx: arg self < arg ifTrue: [^false]. (self = arg and: [arg + 1 > 3]) ifTrue: [^#foo] !! " "playing with dates!Date methodsFor: 'rambo'! computeDateParts: aBlock | trialYearInteger yearInteger tempDays monthIndex daysInMonth offset | trialYearInteger _ (days // 365). offset _ (trialYearInteger // 4) - (trialYearInteger // 100) + (trialYearInteger // 400). ""yearInteger print. ' Days: ' print. days print. ' year ' print. (yearInteger * 365) print. ' offset ' print. offset printNl."" yearInteger _ trialYearInteger. tempDays _ days - (yearInteger * 365). '>>> Days: ' print. tempDays print. ' offset ' print. offset printNl. tempDays < offset "" (days - offset) < (yearInteger * 365)"" ifTrue: [ yearInteger _ yearInteger - 1 ] ifFalse: [ tempDays _ tempDays - offset ]. "" yearInteger _ (days - offset) // 365. yearInteger = trialYearInteger ifTrue: [ tempDays _ tempDays - offset ]."" yearInteger _ yearInteger + 1901. monthIndex _ 1. [ monthIndex < 12 and: [ daysInMonth _ Date daysInMonthIndex: monthIndex forYear: yearInteger. tempDays >= daysInMonth ] ] whileTrue: [ monthIndex _ monthIndex + 1. tempDays _ tempDays - daysInMonth ]. ^aBlock value: yearInteger value: monthIndex value: tempDays + 1 !! "