The Computer Language
23.03 Benchmarks Game

reverse-complement VW Smalltalk program

source code

"* The Computer Language Benchmarks Game
    https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
   contributed by Eliot Miranda and Isaac Gouy *"!


Smalltalk.Core defineClass: #BenchmarksGame
	superclass: #{Core.Object}
	indexedType: #none
	private: false
	instanceVariableNames: ''
	classInstanceVariableNames: ''
	imports: ''
	category: ''!


!Core.BenchmarksGame class methodsFor: 'private'!

readFasta: sequenceName from: input
   | prefix newline buffer description line char |
   prefix := '>',sequenceName.
   newline := Character cr.

   "* find start of particular fasta sequence *"
   [(input atEnd) or: [
         (input peek = $>) 
            ifTrue: [((line := input upTo: newline) 
               indexOfSubCollection: prefix startingAt: 1) = 1]
            ifFalse: [input skipThrough: newline. false]]
      ] whileFalse.

   "* line-by-line read - it would be a lot faster to block read *"
   description := line.
   buffer := ReadWriteStream on: (String new: 1028).
   [(input atEnd) or: [(char := input peek) = $>]] whileFalse: [
      (char = $;) 
         ifTrue: [input upTo: newline] 
         ifFalse: [buffer nextPutAll: (input upTo: newline)]
      ].
   ^Association key: description value: buffer contents!

reverseComplement: sequence named: sequenceName to: output
   | complement newline lineLength n |
   (sequenceName isNil) ifTrue: [^self].

   complement := String new: 128 withAll: $*.

   'ABCDGHKMNRSTVWY' with: 
   'TVGHCDMKNYSABWR'
      do: [:a :b|
         complement at: a asInteger put: b.
         complement at: a asLowercase asInteger put: b].

   newline := Character lf.
   lineLength := 60.
   n := sequence size.

   output nextPutAll: sequenceName; nextPut: newline.

   [n > 0] whileTrue: [ 
         1 to: ((n < lineLength) ifTrue: [n] ifFalse: [lineLength]) do:
            [:i | output nextPut: 
               (complement at: (sequence at: n - i + 1) asInteger)].
         output nextPut: newline.
         n := n - lineLength. 
      ]! !

!Core.BenchmarksGame class methodsFor: 'initialize-release'!

do: n
   | input output |
   input := ExternalReadStream on:
      (ExternalConnection ioAccessor: (UnixDiskFileAccessor new handle: 0)).
   output := ExternalWriteStream on:
      (ExternalConnection ioAccessor: (UnixDiskFileAccessor new handle: 1)).

   #('ONE' 'TWO' 'THREE') do:
      [:sequenceName|   | fasta |
         fasta := self readFasta: sequenceName from: input.
         self reverseComplement: fasta value named: fasta key to: output.
      ].

   output flush. 
   ^''! !
    

notes, command-line, and program output

NOTES:
64-bit Ubuntu quad core
VisualWorks® 8.3
Aug 19 2017


Mon, 23 Jan 2023 21:06:55 GMT

MAKE:
cp /opt/src/vw8.3pul/image/visualnc64.im revcomp.vw_run.im
/opt/src/vw8.3pul/bin/visual revcomp.vw_run.im -nogui -pcl MatriX -filein revcomp.vw -doit 'ObjectMemory snapshotThenQuit'

Autoloading MatriX from $(VISUALWORKS)/preview/matrix/MatriX.pcl
Autoloading Xtreams-Support from $(VISUALWORKS)/xtreams/Xtreams-Support.pcl
Autoloading Xtreams-Core from $(VISUALWORKS)/xtreams/Xtreams-Core.pcl
Autoloading Xtreams-Terminals from $(VISUALWORKS)/xtreams/Xtreams-Terminals.pcl
Autoloading Xtreams-Transforms from $(VISUALWORKS)/xtreams/Xtreams-Transforms.pcl
Autoloading Xtreams-Substreams from $(VISUALWORKS)/xtreams/Xtreams-Substreams.pcl
Autoloading Xtreams-Multiplexing from $(VISUALWORKS)/xtreams/Xtreams-Multiplexing.pcl
Filing in from:
	revcomp.vw
BenchmarksGame class<private
BenchmarksGame class<initialize-release
/home/dunham/all-benchmarksgame/benchmarksgame_i53330/revcomp/tmp/revcomp.vw_run.im created at January 23, 2023 1:06:52 PM
6.08s to complete and log all make actions

COMMAND LINE:
/opt/src/vw8.3pul/bin/visual revcomp.vw_run.im -nogui -evaluate "BenchmarksGame do: 0" < revcomp-input100000001.txt

UNEXPECTED OUTPUT 

Binary files _out and 100000001_out differ

(TRUNCATED) PROGRAM OUTPUT:
Unhandled exception: No space available to allocate this object

----------------------------------------------------------------------
ByteString class(Behavior)>>newNoRetry:
Receiver:
	a ByteString class
Instance Variables:
	superclass = ByteEncodedString
	methodDict = a MethodDictionary[10]
	format = 4096
	subclasses = nil
	instanceVariables = nil
	organization = ('accessing' #at: #at:put: #replaceFrom:to:with:startingAt: #size)
('converting' #asByteString #asIntegerArray)
('private' #replaceBytesFrom:to:with:startingAt: #replaceBytesFrom:to:with:startingAt:map:)
('comparing' #hash)
('binary storage' #representBinaryOn:)

	name = #ByteString
	classPool = a NameSpaceOfClass[0]
	environment = a NameSpace[265]
	encoder = a ByteCharacterEncoder
Arguments:
	anInteger = 283115468
Context PC = 15

----------------------------------------------------------------------
ByteString class(Behavior)>>handleFailedNew:size:
Receiver:
	a ByteString class
Instance Variables:
	superclass = ByteEncodedString
	methodDict = a MethodDictionary[10]
	format = 4096
	subclasses = nil
	instanceVariables = nil
	organization = ('accessing' #at: #at:put: #replaceFrom:to:with:startingAt: #size)
('converting' #asByteString #asIntegerArray)
('private' #replaceBytesFrom:to:with:startingAt: #replaceBytesFrom:to:with:startingAt:map:)
('comparing' #hash)
('binary storage' #representBinaryOn:)

	name = #ByteString
	classPool = a NameSpaceOfClass[0]
	environment = a NameSpace[265]
	encoder = a ByteCharacterEncoder
Arguments:
	error = a SystemError(#'allocation failed',283115468)
	newSize = 283115468
Context PC = 29

----------------------------------------------------------------------
ByteString class(Behavior)>>basicNew:
Receiver:
	a ByteString class
Instance Variables:
	superclass = ByteEncodedString
	methodDict = a MethodDictionary[10]
	format = 4096
	subclasses = nil
	instanceVariables = nil
	organization = ('accessing' #at: #at:put: #replaceFrom:to:with:startingAt: #size)
('converting' #asByteString #asIntegerArray)
('private' #replaceBytesFrom:to:with:startingAt: #replaceBytesFrom:to:with:startingAt:map:)
('comparing' #hash)
('binary storage' #representBinaryOn:)

	name = #ByteString
	classPool = a NameSpaceOfClass[0]
	environment = a NameSpace[265]
	encoder = a ByteCharacterEncoder
Arguments:
	anInteger = 283115468
Temporaries:
	error = a SystemError(#'allocation failed',283115468)
Context PC = 11

----------------------------------------------------------------------
ByteString class(ByteEncodedString class)>>new:
Receiver:
	a ByteString class
Instance Variables:
	superclass = ByteEncodedString
	methodDict = a MethodDictionary[10]
	format = 4096
	subclasses = nil
	instanceVariables = nil
	organization = ('accessing' #at: #at:put: #replaceFrom:to:with:startingAt: #size)
('converting' #asByteString #asIntegerArray)
('private' #replaceBytesFrom:to:with:startingAt: #replaceBytesFrom:to:with:startingAt:map:)
('comparing' #hash)
('binary storage' #representBinaryOn:)

	name = #ByteString
	classPool = a NameSpaceOfClass[0]
	environment = a NameSpace[265]
	encoder = a ByteCharacterEncoder
Arguments:
	size = 283115468
Context PC = 5

----------------------------------------------------------------------
ByteString(Collection)>>copyEmpty:
Receiver:
	a ByteString
Arguments:
	aSize = 283115468
Context PC = 6

----------------------------------------------------------------------
ByteString(SequenceableCollection)>>changeSizeTo:
Receiver:
	a ByteString
Arguments:
	newSize = 283115468
Temporaries:
	newArray = nil
Context PC = 5

----------------------------------------------------------------------
ByteString(SequenceableCollection)>>growToAtLeast:
Receiver:
	a ByteString
Arguments:
	anInteger = 141557760
Context PC = 16

----------------------------------------------------------------------
ReadWriteStream(PositionableStream)>>next:putAll:startingAt:
Receiver:
	a ReadWriteStream
Instance Variables:
	collection = 'GGCCGGGCGCGGTGGCTCACGCCTGTAAT...ACATGGTGAAACCCCGTCTCT'
	position = 141557701
	readLimit = 0
	writeLimit = 141557708
	policy = nil
Arguments:
	anInteger = 60
	aSequenceableCollection = 'TACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCG'
	startIndex = 1
Temporaries:
	newPosition = 141557760
Context PC = 34

----------------------------------------------------------------------
ReadWriteStream(Stream)>>nextPutAll:
Receiver:
	a ReadWriteStream
Instance Variables:
	collection = 'GGCCGGGCGCGGTGGCTCACGCCTGTAAT...ACATGGTGAAACCCCGTCTCT'
	position = 141557701
	readLimit = 0
	writeLimit = 141557708
	policy = nil
Arguments:
	aCollection = 'TACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCG'
Context PC = 12

----------------------------------------------------------------------
BenchmarksGame class>>readFasta:from:
Receiver:
	a BenchmarksGame class
Instance Variables:
	superclass = Object
	methodDict = a MethodDictionary[0]
	format = 16384
	subclasses = nil
	instanceVariables = nil
	organization = nil
	name = #BenchmarksGame
	classPool = a NameSpaceOfClass[0]
	environment = a NameSpace[265]
Arguments:
	sequenceName = 'ONE'
	input = an ExternalReadStream
Temporaries:
	prefix = '>ONE'
	newline = Core.Character cr
	buffer = a ReadWriteStream
	description = '>ONE Homo sapiens alu'
	line = '>ONE Homo sapiens alu'
	char = $T "16r0054"
Context PC = 89

----------------------------------------------------------------------
optimized [] in BenchmarksGame class>>do:
Receiver:
	an UndefinedObject
Arguments:
	sequenceName = 'ONE'
Temporaries:
	fasta = nil
	.self = BenchmarksGame
	.input = an ExternalReadStream
	.output = an ExternalWriteStream
Context PC = 8

----------------------------------------------------------------------
Array(SequenceableCollection)>>do:
Receiver:
	an Array
Arguments:
	aBlock = BlockClosure [] in BenchmarksGame class>>do:
Temporaries:
	i = 1
Context PC = 19

----------------------------------------------------------------------
BenchmarksGame class>>do:
Receiver:
	a BenchmarksGame class
Instance Variables:
	superclass = Object
	methodDict = a MethodDictionary[0]
	format = 16384
	subclasses = nil
	instanceVariables = nil
	organization = nil
	name = #BenchmarksGame
	classPool = a NameSpaceOfClass[0]
	environment = a NameSpace[265]
Arguments:
	n = 0
Temporaries:
	input = an ExternalReadStream
	output = an ExternalWriteStream
Context PC = 30

----------------------------------------------------------------------
UndefinedObject>>unboundMethod
Receiver:
	an UndefinedObject
Context PC = 5

----------------------------------------------------------------------
UndefinedObject(Object)>>performMethod:arguments:
Receiver:
	an UndefinedObject
Arguments:
	method = AnnotatedMethod UndefinedObject>>unboundMethod
	args = an Array[0]
Context PC = 5

----------------------------------------------------------------------
UndefinedObject(Object)>>performMethod:
Receiver:
	an UndefinedObject
Arguments:
	method = AnnotatedMethod UndefinedObject>>unboundMethod
Context PC = 5

----------------------------------------------------------------------
Compiler(SmalltalkCompiler)>>evaluate:in:allowReceiver:receiver:environment:notifying:ifFail:
Receiver:
	a Compiler
Instance Variables:
	sourceStream = a ReadStream
	requestor = nil
	class = UndefinedObject
	targetClass = UndefinedObject
	environment = a NameSpace[48]
	context = nil
	methodClass = CompiledMethod
	allowSelfReferences = true
	allowClassVariableReferences = nil
Arguments:
	textOrStream = 'BenchmarksGame do: 0'
	aContext = nil
	allowSelf = true
	receiver = nil
	env = a NameSpace[48]
	aRequestor = nil
	failBlock = BlockClosure [] in SmalltalkCompiler class>>evaluate:for:in:notifying:logged:
Temporaries:
	method = AnnotatedMethod UndefinedObject>>unboundMethod
Context PC = 22

----------------------------------------------------------------------
Compiler class(SmalltalkCompiler class)>>evaluate:for:in:notifying:logged:
Receiver:
	a Compiler class
Instance Variables:
	superclass = SmalltalkCompiler
	methodDict = a MethodDictionary[5]
	format = 16393
	subclasses = an Array[2]
	instanceVariables = nil
	organization = ('private' #compile:in: #newCodeStream #newMethodHolder #parseWithSignalling:in:noPattern:notifying: #translate:noPattern:ifFail:needSourceMap:handler:)

	name = #Compiler
	classPool = a NameSpaceOfClass[0]
	environment = a NameSpace[260]
Arguments:
	textOrString = 'BenchmarksGame do: 0'
	anObject = nil
	aNameSpace = a NameSpace[48]
	aController = nil
	logFlag = false
Temporaries:
	val = nil
Context PC = 14

----------------------------------------------------------------------
Compiler class(SmalltalkCompiler class)>>evaluate:notifying:logged:
Receiver:
	a Compiler class
Instance Variables:
	superclass = SmalltalkCompiler
	methodDict = a MethodDictionary[5]
	format = 16393
	subclasses = an Array[2]
	instanceVariables = nil
	organization = ('private' #compile:in: #newCodeStream #newMethodHolder #parseWithSignalling:in:noPattern:notifying: #translate:noPattern:ifFail:needSourceMap:handler:)

	name = #Compiler
	classPool = a NameSpaceOfClass[0]
	environment = a NameSpace[260]
Arguments:
	textOrString = 'BenchmarksGame do: 0'
	aController = nil
	logFlag = false
Context PC = 9

----------------------------------------------------------------------
Compiler class(SmalltalkCompiler class)>>evaluate:logged:
Receiver:
	a Compiler class
Instance Variables:
	superclass = SmalltalkCompiler
	methodDict = a MethodDictionary[5]
	format = 16393
	subclasses = an Array[2]
	instanceVariables = nil
	organization = ('private' #compile:in: #newCodeStream #newMethodHolder #parseWithSignalling:in:noPattern:notifying: #translate:noPattern:ifFail:needSourceMap:handler:)

	name = #Compiler
	classPool = a NameSpaceOfClass[0]
	environment = a NameSpace[260]
Arguments:
	textOrString = 'BenchmarksGame do: 0'
	logFlag = false
Context PC = 7

----------------------------------------------------------------------
Compiler class(SmalltalkCompiler class)>>evaluate:
Receiver:
	a Compiler class
Instance Variables:
	superclass = SmalltalkCompiler
	methodDict = a MethodDictionary[5]
	format = 16393
	subclasses = an Array[2]
	instanceVariables = nil
	organization = ('private' #compile:in: #newCodeStream #newMethodHolder #parseWithSignall