[Vm-dev] VM Maker: Cog-eem.225.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Nov 27 22:10:48 UTC 2014


Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.225.mcz

==================== Summary ====================

Name: Cog-eem.225
Author: eem
Time: 27 November 2014, 2:10:31.056 pm
UUID: d914fb1c-dc37-4dd4-ad8b-fe37e90ff1c0
Ancestors: Cog-eem.224

Spur Bootstrap:
Update the prototypes and package patching for
the Float => Float,BoxedFloat64/SmallFloat64
refactoring.
Use collect:as: to simplify allMethodPrototypes.

=============== Diff against Cog-eem.224 ===============

Item was changed:
  ----- Method: InstructionStream>>InstructionStreamPROTOTYPEskipCallPrimitive (in category '*Cog-method prototypes') -----
  InstructionStreamPROTOTYPEskipCallPrimitive
  	"If the receiver's method starts with a callPrimitive: bytecode, skip it."
  	| method encoderClass callPrimitiveCode |
  	method := self method.
+ 	encoderClass := method encoderClass.
- 	encoderClass := method  encoderClass.
  	callPrimitiveCode := encoderClass callPrimitiveCode.
  	(method byteAt: pc) = callPrimitiveCode ifTrue:
  		[pc := pc + (encoderClass bytecodeSize: callPrimitiveCode)]!

Item was changed:
  ----- Method: SpurBootstrap class>>categoryForClass:meta:selector: (in category 'method prototype categorization') -----
  categoryForClass: className meta: isMeta selector: selector 
  	^(isMeta
  			ifTrue: [{ className. #class. selector }]
  			ifFalse: [{ className. selector }])
  		caseOf: {
  			[#(Behavior allInstancesOrNil)]					-> [#enumerating].
  			[#(Behavior byteSizeOfInstance)]				-> [#'accessing instances and variables'].
  			[#(Behavior byteSizeOfInstanceOfSize:)]		-> [#'accessing instances and variables'].
  			[#(Behavior elementSize)]						-> [#'accessing instances and variables'].
  			[#(Behavior handleFailingBasicNew)]			-> [#private].
  			[#(Behavior handleFailingBasicNew:)]			-> [#private].
  			[#(Behavior handleFailingFailingBasicNew)]		-> [#private].
  			[#(Behavior handleFailingFailingBasicNew:)]		-> [#private].
  			[#(Behavior identityHash)]						-> [#comparing].
  			[#(Behavior isEphemeronClass)]				-> [#testing].
  			[#(Behavior isImmediateClass)]					-> [#testing].
+ 			[#(BoxedFloat64 class basicNew)]				-> [#'instance creation'].
+ 			[#(BoxedFloat64 class basicNew:)]				-> [#'instance creation'].
  			[#(Character identityHash)]						-> [#comparing].
  			[#(Character setValue:)]						-> [#accessing].
  			[#(Class immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)]
  															-> [#'subclass creation'].
  			[#(ClassBuilder superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)]
  															-> [#public].
  			[#(CompiledMethod bytecodeSetName)]		-> [#accessing].
  			[#(CompiledMethod class handleFailingFailingNewMethod:header:)]
  															-> [#private].
  			[#(CompiledMethod class handleFailingNewMethod:header:)]
  															-> [#private].
  			[#(CompiledMethod class headerFlagForEncoder:)]
  															-> [#'method encoding'].
  			[#(CompiledMethod class installPrimaryBytecodeSet:)]
  															-> [#'class initialization'].
  			[#(CompiledMethod class installSecondaryBytecodeSet:)]
  															-> [#'class initialization'].
  			[#(Context class allInstances)]					-> [#enumerating].
  			[#(Context class allInstancesDo:)]				-> [#enumerating].
  			[#(Context failPrimitiveWith:)]					-> [#'system simulation'].
  			[#(Context isPrimFailToken:)]					-> [#private].
  			[#(Context send:to:with:lookupIn:)]				-> [#controlling].
  			[#(ContextPart isPrimFailToken:)]				-> [#private].
  			[#(ContextPart send:to:with:lookupIn:)]			-> [#controlling].
  			[#(EncoderForV3 computeMethodHeaderForNumArgs:numTemps:numLits:primitive:)]
  															-> [#'method encoding'].
  			[#(EncoderForV3PlusClosures genCallPrimitive:)]
  															-> [#'bytecode generation'].
  			[#(EncoderForV3PlusClosures class callPrimitiveCode)]
  															-> [#'bytecode decoding'].
  			[#(MethodContext failPrimitiveWith:)]			-> [#'system simulation'].
  			[#(MethodContext class allInstances)]			-> [#enumerating].
  			[#(MethodContext class allInstancesDo:)]		-> [#enumerating].
+ 			[#(SmallFloat64 class basicNew)]				-> [#'instance creation'].
+ 			[#(SmallFloat64 class basicNew:)]				-> [#'instance creation'].
+ 			[#(SmallFloat64 copy)]							-> [#copying].
+ 			[#(SmallFloat64 deepCopy)]					-> [#copying].
+ 			[#(SmallFloat64 shallowCopy)]					-> [#copying].
+ 			[#(SmallFloat64 veryDeepCopyWith:)]			-> [#copying].
  			[#(SmallInteger asCharacter)]					-> [#converting].
  			[#(SmalltalkImage growMemoryByAtLeast:)]	-> [#'memory space'].
  			[#(SmalltalkImage maxIdentityHash)]			-> [#'system attributes'].
  			[#(SystemDictionary growMemoryByAtLeast:)]	-> [#'memory space'].
  			[#(SystemDictionary maxIdentityHash)]			-> [#'system attributes'].
  			[#(SystemDictionary setGCParameters)]		-> [#'snapshot and quit'].
  			[#(SystemNavigation allObjects)]				-> [#query].
  			[#(SystemNavigation allObjectsOrNil)]			-> [#query].
  			 }
  		otherwise:
  			[Transcript nextPutAll: className.
  			 isMeta ifTrue: [Transcript nextPutAll: ' class'].
  			 Transcript nextPutAll: '>>'; store: selector; nextPutAll: ' is unclassified'; cr; flush.
  			 ^Categorizer default]!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>classDefinitionFor:type:from:comment:stamp: (in category 'private-accessing') -----
+ classDefinitionFor: className type: typeSymbol from: definitions comment: commentString stamp: stampString
+ 	| classDef |
+ 	classDef := definitions
+ 					detect: [:d| d isClassDefinition and: [d className = className]]
+ 					ifNone:
+ 						[self assert: (#(BoxedFloat64 SmallFloat64) includes: className).
+ 						 MCClassDefinition
+ 							name: className
+ 							superclassName: #Float
+ 							traitComposition: '{}'
+ 							classTraitComposition: '{}'
+ 							category: 'Kernel-Numbers'
+ 							instVarNames: #()
+ 							classVarNames: #()
+ 							poolDictionaryNames: #()
+ 							classInstVarNames: #()
+ 							type: typeSymbol
+ 							comment: commentString asString
+ 							commentStamp: stampString].
+ 	className == #Character ifTrue:
+ 		[classDef variables removeAllSuchThat:
+ 			[:varDef|
+ 			 varDef isInstanceVariable and: [varDef name = 'value']]].
+ 	classDef instVarNamed: 'type' put: typeSymbol.
+ 	commentString ifNotNil:
+ 		[classDef
+ 			instVarNamed: 'comment' put: commentString;
+ 			instVarNamed: 'commentStamp' put: stampString].
+ 	^MCAddition of: classDef!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>filteredDefinitionsAsPatches:patches: (in category 'private-accessing') -----
+ filteredDefinitionsAsPatches: modifiedDefinitions patches: existingPatches
+ 	^modifiedDefinitions
+ 		select:
+ 			[:def|
+ 			 existingPatches noneSatisfy:
+ 				[:addition|
+ 				def isMethodDefinition
+ 				and: [addition definition isMethodDefinition
+ 				and: [addition definition selector = def selector
+ 				and: [addition definition className = def className
+ 				and: [addition definition classIsMeta = def classIsMeta]]]]]]
+ 		thenCollect:
+ 			[:def|
+ 			 ((def source includesSubString: 'DELETEME')
+ 				ifTrue: [MCRemoval]
+ 				ifFalse: [MCAddition]) of: def]!

Item was removed:
- ----- Method: SpurBootstrapMonticelloPackagePatcher>>immediateClassDefinitionFor:from:comment:stamp: (in category 'private-accessing') -----
- immediateClassDefinitionFor: className from: definitions comment: commentString stamp: stampString
- 	| classDef |
- 	classDef := definitions detect: [:d| d isClassDefinition and: [d className = className]].
- 	classDef variables removeAllSuchThat:
- 		[:varDef|
- 		 varDef isInstanceVariable and: [varDef name = 'value']].
- 	classDef
- 		instVarNamed: 'type' put: #immediate;
- 		instVarNamed: 'comment' put: commentString;
- 		instVarNamed: 'commentStamp' put: stampString.
- 	^MCAddition of: classDef!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>modifiedFloatDefinitionsIn: (in category 'private-accessing') -----
+ modifiedFloatDefinitionsIn: definitions
+ 	"Delete the non-accessing primitives in Float (prims 41 through 59),
+ 	 and copy them to BoxedFloat64,
+ 	 and create corresponding ones in SmallFloat64 with primtiive numbers + 500."
+ 	| floatPrims |
+ 	floatPrims := definitions select:
+ 					[:d| | index |
+ 					d isMethodDefinition
+ 					and: [d fullClassName = #Float
+ 					and: [(index := d source indexOfSubCollection: '<primitive: ') > 0
+ 					and: [(Integer readFrom: (ReadStream on: d source from: index + '<primitive: ' size to: index + '<primitive: ' size + 4))
+ 							between: 41
+ 							and: 59]]]].
+ 	^(floatPrims collect:
+ 		[:d|
+ 		 MCMethodDefinition 
+ 			className: d className
+ 			classIsMeta: false
+ 			selector: d selector
+ 			category: d category
+ 			timeStamp: d timeStamp
+ 			source: d source, 'DELETEME']),
+ 	 (floatPrims collect:
+ 		[:d|
+ 		 MCMethodDefinition 
+ 			className: #BoxedFloat64
+ 			classIsMeta: false
+ 			selector: d selector
+ 			category: d category
+ 			timeStamp: d timeStamp
+ 			source: d source]),
+ 	 (floatPrims collect:
+ 		[:d|
+ 		 MCMethodDefinition 
+ 			className: #SmallFloat64
+ 			classIsMeta: false
+ 			selector: d selector
+ 			category: d category
+ 			timeStamp: 'eem 11/25/2014 07:54'
+ 			source: (d source copyReplaceAll: '<primitive: ' with: '<primitive: 5')])!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>packageForMissingClassNamed: (in category 'accessing') -----
+ packageForMissingClassNamed: className
+ 	(className = #BoxedFloat64
+ 	 or: [className = #SmallFloat64]) ifTrue:
+ 		[^PackageInfo named: 'Kernel'].
+ 	self error: 'unknown missing class'!

Item was changed:
  ----- Method: SpurBootstrapMonticelloPackagePatcher>>packagesAndPatches (in category 'private-accessing') -----
  packagesAndPatches
  	"SpurBootstrapMonticelloPackagePatcher new packagesAndPatches"
  	| spurBootstrap |
  	packagesAndPatches ifNotNil:
  		[^packagesAndPatches].
  	packagesAndPatches := Dictionary new.
  	spurBootstrap := SpurBootstrap new.
  	imageTypes ifNotNil:
  		[spurBootstrap imageTypes: imageTypes].
  	spurBootstrap prototypeClassNameMetaSelectorMethodDo:
+ 		[:className :isMeta :selector :method| | package category source definition |
+ 		 (Smalltalk classNamed: className)
+ 			ifNil: [package := self packageForMissingClassNamed: className]
+ 			ifNotNil:
+ 				[:behavior| | class methodReference |
+ 				 class := isMeta ifTrue: [behavior class] ifFalse: [behavior].
+ 				 (class includesSelector: selector) ifTrue:
+ 					[methodReference := (class >> selector) methodReference.
+ 					 category := methodReference category].
+ 				 package := (methodReference isNil
+ 							  or: [methodReference category = Categorizer default])
+ 								ifTrue: [PackageOrganizer default packageOfClass: class]
+ 								ifFalse: [PackageOrganizer default packageOfMethod: methodReference]].
- 		[:className :isMeta :selector :method| | class methodReference source definition |
- 		 class := Smalltalk classNamed: className.
- 		 isMeta ifTrue:
- 			[class := class class].
- 		 methodReference := (class includesSelector: selector) ifTrue:
- 								[(class >> selector) methodReference].
- 		 (methodReference notNil
- 		  and: [methodReference category = Categorizer default]) ifTrue:
- 			[methodReference := nil].
  		 source := method getSourceFromFile asString allButFirst: method selector size - selector size.
  		 source first ~= selector first ifTrue:
  			[source replaceFrom: 1 to: selector size with: selector startingAt: 1].
  		 definition := MCAddition of: (MCMethodDefinition
  										className: className
  										classIsMeta: isMeta
  										selector: selector
+ 										category: (category ifNil: [SpurBootstrap
+ 																	categoryForClass: className
+ 																	meta: isMeta
+ 																	selector: selector])
- 										category: (methodReference
- 													ifNotNil: [methodReference category]
- 													ifNil: [SpurBootstrap
- 															categoryForClass: className
- 															meta: isMeta
- 															selector: selector])
  										timeStamp: method timeStamp
  										source: source).
  		 (method pragmaAt: #remove) ifNotNil:
  			[definition := definition inverse].
+ 		 (packagesAndPatches at: package ifAbsentPut: [OrderedCollection new])
- 		 (packagesAndPatches
- 				at: (methodReference
- 						ifNotNil: [PackageOrganizer default packageOfMethod: methodReference]
- 						ifNil: [PackageOrganizer default packageOfClass: class])
- 				ifAbsentPut: [OrderedCollection new])
  			add: definition].
  	^packagesAndPatches!

Item was changed:
  ----- Method: SpurBootstrapMonticelloPackagePatcher>>patch (in category 'patching') -----
  patch
  	"(SpurBootstrapMonticelloPackagePatcher new
+ 			from: 'trunkpackages'
+ 			to: 'spurpackages')
+ 		patch"
+ 	"(SpurBootstrapMonticelloPackagePatcher new
  			from: '/Users/eliot/Squeak/Squeak4.5-spur/squeakv3-package-cache'
  			to: '/Users/eliot/Squeak/Squeak4.5-spur/package-cache')
  		patch"
  	"(SpurBootstrapMonticelloPackagePatcher new
  			from: '/Users/eliot/Glue/repositories/nsboot/Squeak4.3/squeak-package-cache'
  			to: '/Users/eliot/Glue/repositories/nsboot/Squeak4.3/package-cache')
  		patch"
  	
  	sourceDir exists ifFalse:
  		[self error: 'source directory doest not exist'].
  	destDir assureExistence.
  	self packagesAndPatches keysAndValuesDo:
  		[:package :patches|
  		 (self filesForPackage: package in: sourceDir) do:
  			[:packageFile|
  			 self patchPackage: packageFile with: patches for: package]]!

Item was changed:
  ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchForPackage:withPatches:snapshot: (in category 'patching') -----
  patchForPackage: package withPatches: patches snapshot: snapshot
  	(package includesClass: Character) ifTrue:
  		[patches
+ 			addAll: (self filteredDefinitionsAsPatches: (self modifiedCharacterDefinitionsIn: snapshot definitions)
+ 						patches: patches);
+ 			add: (self
+ 					classDefinitionFor: #Character
+ 					type: #immediate
- 			addAll: ((self modifiedCharacterDefinitionsIn: snapshot definitions)
- 						select:
- 							[:def|
- 							 patches noneSatisfy:
- 								[:addition|
- 								def isMethodDefinition
- 								and: [addition definition isMethodDefinition
- 								and: [addition definition selector = def selector
- 								and: [addition definition className = def className
- 								and: [addition definition classIsMeta = def classIsMeta]]]]]]
- 						thenCollect:
- 							[:def|
- 							 ((def source includesSubString: 'DELETEME')
- 								ifTrue: [MCRemoval]
- 								ifFalse: [MCAddition]) of: def]);
- 			add: (self immediateClassDefinitionFor: #Character
  					from: snapshot definitions
  					comment: 'I represent a character by storing its associated Unicode as an unsigned 30-bit value.  Characters are created uniquely, so that all instances of a particular Unicode are identical.  My instances are encoded in tagged pointers in the VM, so called immediates, and therefore are pure immutable values.
  
  	The code point is based on Unicode.  Since Unicode is 21-bit wide character set, we have several bits available for other information.  As the Unicode Standard  states, a Unicode code point doesn''t carry the language information.  This is going to be a problem with the languages so called CJK (Chinese, Japanese, Korean.  Or often CJKV including Vietnamese).  Since the characters of those languages are unified and given the same code point, it is impossible to display a bare Unicode code point in an inspector or such tools.  To utilize the extra available bits, we use them for identifying the languages.  Since the old implementation uses the bits to identify the character encoding, the bits are sometimes called "encoding tag" or neutrally "leading char", but the bits rigidly denotes the concept of languages.
  
  	The other languages can have the language tag if you like.  This will help to break the large default font (font set) into separately loadable chunk of fonts.  However, it is open to the each native speakers and writers to decide how to define the character equality, since the same Unicode code point may have different language tag thus simple #= comparison may return false.'
  					stamp: 'eem 8/12/2014 14:53')].
  	(package includesClass: SmallInteger) ifTrue:
  		[patches
  			add: (self
+ 					classDefinitionFor: #SmallInteger
+ 					type: #immediate
- 					immediateClassDefinitionFor: #SmallInteger
  					from: snapshot definitions
  					comment: 'My instances are at least 31-bit numbers, stored in twos complement form. The allowable range in 32-bits is approximately +- 10^9 (+- 1billion).  In 64-bits my instances are 61-bit numbers, stored in twos complement form. The allowable range is approximately +- 10^18 (+- 1 quintillion).   The actual values are computed at start-up.  See SmallInteger class startUp:, minVal, maxVal.'
  					stamp: 'eem 11/20/2014 08:41')].
+ 	(package includesClass: Float) ifTrue:
+ 		[patches
+ 			add: (self
+ 					classDefinitionFor: #Float
+ 					type: #normal
+ 					from: snapshot definitions
+ 					comment: nil
+ 					stamp: nil);
+ 			add: (self
+ 					classDefinitionFor: #BoxedFloat64
+ 					type: #words
+ 					from: snapshot definitions
+ 					comment: 'My instances hold 64-bit Floats in heap objects.  This is the only representation on 32-bit systems.  But on 64-bit systems SmallFloat64 holds a subset of the full 64-bit double-precision range in immediate objects.'
+ 					stamp: 'eem 11/25/2014 07:54');
+ 			add: (self
+ 					classDefinitionFor: #SmallFloat64
+ 					type: #immediate
+ 					from: snapshot definitions
+ 					comment: 'My instances represent 64-bit Floats whose exponent fits in 8 bits as immediate objects.  This representation is only available on 64-bit systems, not 32-bit systems.'
+ 					stamp: 'eem 11/25/2014 07:54');
+ 			addAll: (self filteredDefinitionsAsPatches: (self modifiedFloatDefinitionsIn: snapshot definitions)
+ 						patches: patches)].
  	(package includesClass: CompiledMethod) ifTrue:
  		[patches
+ 			add: self compiledMethodClassDefinition].
- 			add: (self compiledMethodClassDefinition)].
  	^MCPatch operations: patches!

Item was changed:
  ----- Method: SpurBootstrapPrototypes class>>allMethodPrototypes (in category 'accessing method dictionary') -----
  allMethodPrototypes
  	^(self canUnderstand: #allMethods)
  		ifTrue: "Pharo"
  			[self allMethods select:
  				[:each| each category = 'method prototypes']]
+ 		ifFalse: "Squeak" "%$#@*!! collect: on IdentitySet answers a *Set*, not an IdentitySet %$#@*!!"
+ 			[(self allSelectors collect: [:s| self lookupSelector: s] as: IdentitySet)
+ 				select: [:m| m protocol = 'method prototypes']]!
- 		ifFalse: "Squeak"
- 			[false
- 				ifTrue: "%$#@*!! collect: on IdentitySet answers a *Set*, not an IdentitySet %$#@*!!"
- 					[self allSelectors
- 						collect: [:s| self lookupSelector: s]
- 						thenSelect: [:m| m protocol = 'method prototypes']]
- 				ifFalse: "...hence: "
- 					[self allSelectors
- 						inject: IdentitySet new
- 						into: [:methods :sel| | method |
- 							method := self lookupSelector: sel.
- 							method protocol = 'method prototypes' ifTrue:
- 								[methods add: method].
- 							methods]]]!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BoxedFloat64classPROTOTYPEbasicNew (in category 'method prototypes') -----
+ BoxedFloat64classPROTOTYPEbasicNew
+ 	^self basicNew: 2!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BoxedFloat64classPROTOTYPEbasicNew: (in category 'method prototypes') -----
+ BoxedFloat64classPROTOTYPEbasicNew: sizeRequested 
+ 	"Primitive. Answer an instance of this class with the number
+ 	 of indexable variables specified by the argument, sizeRequested.
+ 	 Fail if this class is not indexable or if the argument is not a
+ 	 positive Integer, or if there is not enough memory available. 
+ 	 Essential. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 71>
+ 	sizeRequested isInteger ifTrue:
+ 		[^sizeRequested = 2
+ 			ifTrue: "arg okay; space must be low."
+ 				[OutOfMemory signal.
+ 				 self basicNew: sizeRequested]  "retry if user proceeds"
+ 			ifFalse:
+ 				[self error: 'a Float shall always have two slots']].
+ 	self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>FloatclassPROTOTYPEbasicNew (in category 'method prototypes') -----
+ FloatclassPROTOTYPEbasicNew
+ 	^BoxedFloat64 basicNew: 2!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>FloatclassPROTOTYPEbasicNew: (in category 'method prototypes') -----
+ FloatclassPROTOTYPEbasicNew: anInteger
+ 	^BoxedFloat64 basicNew: 2!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEcopy (in category 'method prototypes') -----
+ SmallFloat64PROTOTYPEcopy
+ 	"Answer the receiver, because SmallFloat64s are unique."
+ 	^self!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEdeepCopy (in category 'method prototypes') -----
+ SmallFloat64PROTOTYPEdeepCopy
+ 	"Answer the receiver, because SmallFloat64s are unique."
+ 	^self!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEshallowCopy (in category 'method prototypes') -----
+ SmallFloat64PROTOTYPEshallowCopy
+ 	"Answer the receiver, because SmallFloat64s are unique."
+ 	^self!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SmallFloat64PROTOTYPEveryDeepCopyWith: (in category 'method prototypes') -----
+ SmallFloat64PROTOTYPEveryDeepCopyWith: deepCopier
+ 	"Answer the receiver, because SmallFloat64s are unique."
+ 	^self!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SmallFloat64classPROTOTYPEbasicNew (in category 'method prototypes') -----
+ SmallFloat64classPROTOTYPEbasicNew
+ 	self error: 'SmallFloat64s can only be created by performing arithmetic'!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SmallFloat64classPROTOTYPEbasicNew: (in category 'method prototypes') -----
+ SmallFloat64classPROTOTYPEbasicNew: anInteger
+ 	^self basicNew!



More information about the Vm-dev mailing list