Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.137.mcz
==================== Summary ====================
Name: Cog-eem.137 Author: eem Time: 26 February 2014, 11:51:16.288 am UUID: 63230afc-eb3a-49f3-a247-e3dcca870e25 Ancestors: Cog-eem.136
Add a class to patch Newspeak's KernelForSqueak.ns3.
Improve the comments in the instantiation methods and get the MC package patcher to classify the handle methods under private.
=============== Diff against Cog-eem.136 ===============
Item was changed: ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEbasicNew (in category 'method prototypes') ----- BehaviorPROTOTYPEbasicNew "Primitive. Answer an instance of the receiver (which is a class) with no indexable variables. Fail if the class is indexable. Essential. See Object documentation whatIsAPrimitive. If the primitive fails because space is low then the scavenger will run before the method is activated. Check arguments and + retry via handleFailingBasicNew if they're OK." - retry via failingBasicNew: if they're OK."
<primitive: 70> self isVariable ifTrue: [^self basicNew: 0]. "space must have been low, and the scavenger must have run. retry after the scavenge." ^self handleFailingBasicNew!
Item was changed: ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEbasicNew: (in category 'method prototypes') ----- BehaviorPROTOTYPEbasicNew: 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. If the primitive fails because space is low then the scavenger will run before the + method is activated. Check args and retry via handleFailingBasicNew: if they're OK." - method is activated. Check arguments and retry via failingBasicNew: if they're OK."
<primitive: 71> self isVariable ifFalse: [self error: self printString, ' cannot have variable sized instances']. (sizeRequested isInteger and: [sizeRequested >= 0]) ifTrue: ["arg okay; space must have been low, and the scavenger must have run. retry after the scavenge" ^self handleFailingBasicNew: sizeRequested]. self primitiveFailed!
Item was changed: ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEelementSize (in category 'method prototypes') ----- BehaviorPROTOTYPEelementSize "Answer the size in bytes of an element in the receiver. The formats are + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" - 0 = 0 sized objects (UndefinedObject True False et al) - 1 = non-indexable objects with inst vars (Point et al) - 2 = indexable objects with no inst vars (Array et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) - 4 = weak indexable objects with inst vars (WeakArray et al) - 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) - 6 unused, reserved for exotic pointer objects? - 7 reserved by the VM - 8 unused, reserved for exotic non-pointer objects? - 9 (?) 64-bit indexable - 10 - 11 32-bit indexable - 12 - 15 16-bit indexable - 16 - 23 byte indexable - 24 - 31 compiled method" | instSpec | instSpec := self instSpec. instSpec < 9 ifTrue: [^Smalltalk wordSize]. instSpec >= 16 ifTrue: [^1]. instSpec >= 12 ifTrue: [^2]. instSpec >= 10 ifTrue: [^4]. ^8!
Item was changed: ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingBasicNew (in category 'method prototypes') ----- BehaviorPROTOTYPEhandleFailingBasicNew + "handleFailingBasicNew gets sent after basicNew has failed and allowed + a scavenging garbage collection to occur. The scavenging collection + will have happened as the VM is activating the (failing) basicNew. If + handleFailingBasicNew fails then the scavenge failed to reclaim sufficient + space and a global garbage collection is required. Retry after garbage + collecting and growing memory if necessary. - "This basicNew gets sent after basicNew has failed and allowed a - scavenging garbage collection to occur. The scavenging collection - will have happened as the VM is activating the (failing) basicNew. - If failingBasicNew fails then the scavenge failed to reclaim sufficient - space and a global garbage collection is required.
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: 70> Smalltalk garbageCollect < 1048576 ifTrue: [Smalltalk growMemoryByAtLeast: 1048576]. ^self handleFailingFailingBasicNew "retry after global garbage collect"!
Item was changed: ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingBasicNew: (in category 'method prototypes') ----- BehaviorPROTOTYPEhandleFailingBasicNew: sizeRequested + "handleFailingBasicNew: gets sent after basicNew: has failed and allowed + a scavenging garbage collection to occur. The scavenging collection + will have happened as the VM is activating the (failing) basicNew:. If + handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient + space and a global garbage collection is required. Retry after garbage + collecting and growing memory if necessary. - "This basicNew: gets sent after basicNew: has failed and allowed a - scavenging garbage collection to occur. The scavenging collection - will have happened as the VM is activating the (failing) basicNew:. - If handleFailingBasicNew: fails then the scavenge failed to reclaim - sufficient space and a global garbage collection is required.
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> | bytesRequested | bytesRequested := self byteSizeOfInstanceWithIndexableVariables: sizeRequested. Smalltalk garbageCollect < bytesRequested ifTrue: [Smalltalk growMemoryByAtLeast: bytesRequested]. "retry after global garbage collect and possible grow" ^self handleFailingFailingBasicNew: sizeRequested!
Item was changed: ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingFailingBasicNew (in category 'method prototypes') ----- BehaviorPROTOTYPEhandleFailingFailingBasicNew + "This basicNew gets sent after handleFailingBasicNew: has done a full + garbage collection and possibly grown memory. If this basicNew fails + then the system really is low on space, so raise the OutOfMemory signal. - "This basicNew gets sent after failingBasicNew: has sent Smalltalk garbageCollect. - If this fails then the system really is low on space.
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: 70> "space must be low" OutOfMemory signal. ^self basicNew "retry if user proceeds"!
Item was changed: ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingFailingBasicNew: (in category 'method prototypes') ----- BehaviorPROTOTYPEhandleFailingFailingBasicNew: sizeRequested + "This basicNew: gets sent after handleFailingBasicNew: has done a full + garbage collection and possibly grown memory. If this basicNew: fails + then the system really is low on space, so raise the OutOfMemory signal. - "This basicNew: gets sent after failingBasicNew: has sent Smalltalk garbageCollect. - If that fails the system really is low on space.
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> + "space must be low." - "arg okay; space must be low." OutOfMemory signal. ^self basicNew: sizeRequested "retry if user proceeds"!
Item was changed: ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEidentityHash (in category 'method prototypes') ----- BehaviorPROTOTYPEidentityHash "Answer a SmallInteger whose value is related to the receiver's identity. + Behavior implements identityHash to allow the VM to use an object representation which + does not include a direct reference to an object's class in an object. If the VM is using + this implementation then classes are held in a class table and instances contain the index + of their class in the table. A class's class table index is its identityHash so that an instance + can be created without searching the table for a class's index. The VM uses this primitive + to enter the class into the class table, assigning its identityHash with an as yet unused + class table index. If this primitive fails it means that the class table is full. In Spur as of + 2014 there are 22 bits of classTable index and 22 bits of identityHash per object. - This method must not be overridden. - Primitive. Fails if the receiver is not a Behavior. Essential. - See Object documentation whatIsAPrimitive.
+ Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive." - Do not override."
<primitive: 175> self primitiveFailed!
Item was changed: ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEinstSpec (in category 'method prototypes') ----- BehaviorPROTOTYPEinstSpec "Answer the instance specification part of the format that defines what kind of object an instance of the receiver is. The formats are + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" - 0 = 0 sized objects (UndefinedObject True False et al) - 1 = non-indexable objects with inst vars (Point et al) - 2 = indexable objects with no inst vars (Array et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) - 4 = weak indexable objects with inst vars (WeakArray et al) - 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) - 6 unused, reserved for exotic pointer objects? - 7 reserved by the VM - 8 unused, reserved for exotic non-pointer objects? - 9 (?) 64-bit indexable - 10 - 11 32-bit indexable - 12 - 15 16-bit indexable - 16 - 23 byte indexable - 24 - 31 compiled method" ^(format bitShift: -16) bitAnd: 16r1F!
Item was changed: ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisBits (in category 'method prototypes') ----- BehaviorPROTOTYPEisBits "Answer whether the receiver contains just bits (not pointers). Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" + ^self instSpec >= 7! - 0 = 0 sized objects (UndefinedObject True False et al) - 1 = non-indexable objects with inst vars (Point et al) - 2 = indexable objects with no inst vars (Array et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) - 4 = weak indexable objects with inst vars (WeakArray et al) - 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) - 6,7,8 unused - 9 (?) 64-bit indexable - 10 - 11 32-bit indexable - 12 - 15 16-bit indexable - 16 - 23 byte indexable - 24 - 31 compiled method" - ^self instSpec >= 9!
Item was changed: ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisBytes (in category 'method prototypes') ----- BehaviorPROTOTYPEisBytes "Answer whether the receiver has 8-bit instance variables. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" - 0 = 0 sized objects (UndefinedObject True False et al) - 1 = non-indexable objects with inst vars (Point et al) - 2 = indexable objects with no inst vars (Array et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) - 4 = weak indexable objects with inst vars (WeakArray et al) - 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) - 6,7,8 unused - 9 (?) 64-bit indexable - 10 - 11 32-bit indexable - 12 - 15 16-bit indexable - 16 - 23 byte indexable - 24 - 31 compiled method" ^self instSpec >= 16!
Item was changed: ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisVariable (in category 'method prototypes') ----- BehaviorPROTOTYPEisVariable "Answer whether the receiver has indexable variables. Above Cog Spur the class format is <5 bits inst spec><16 bits inst size> where the 5-bit inst spec is + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" - 0 = 0 sized objects (UndefinedObject True False et al) - 1 = non-indexable objects with inst vars (Point et al) - 2 = indexable objects with no inst vars (Array et al) - 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) - 4 = weak indexable objects with inst vars (WeakArray et al) - 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) - 6,7,8 unused - 9 (?) 64-bit indexable - 10 - 11 32-bit indexable - 12 - 15 16-bit indexable - 16 - 23 byte indexable - 24 - 31 compiled method" | instSpec | instSpec := self instSpec. ^instSpec >= 2 and: [instSpec ~= 5]!
Item was added: + Object subclass: #SpurBootstrapNewspeakFilePatcher + instanceVariableNames: 'source substitutions' + classVariableNames: '' + poolDictionaries: '' + category: 'Cog-Bootstrapping'!
Item was added: + ----- Method: SpurBootstrapNewspeakFilePatcher>>editTo: (in category 'patching') ----- + editTo: dest "<FileStream>" + source reopen. + [substitutions do: + [:tuple| + [:start :end :substitution| + [source position + 1 < start] whileTrue: + [dest nextPut: source next]. + dest nextPutAll: (substitution + copyReplaceAll: (String with: Character cr) + with: (String with: Character lf)). + source skip: end - start + 1] valueWithArguments: tuple]. + dest nextPutAll: source upToEnd] + ensure: [source close]!
Item was added: + ----- Method: SpurBootstrapNewspeakFilePatcher>>findClassDeclarationFor:in: (in category 'parsing') ----- + findClassDeclarationFor: className in: ast "<ClassDeclarationAST>" "^(ClassDeclarationAST|nil)" + ^ast instanceSide nestedClasses + detect: [:classDecl| classDecl name = className] + ifNone: []!
Item was added: + ----- Method: SpurBootstrapNewspeakFilePatcher>>findMethodDeclarationFor:in: (in category 'parsing') ----- + findMethodDeclarationFor: selector "<Symbol>" in: ast "<ClassDeclarationAST>" "^(MethodAST|nil)" + ast instanceSide categories do: + [:categoryAST| + categoryAST methods do: + [:methodAST| + methodAST pattern selector = selector ifTrue: + [^methodAST]]]. + ^nil!
Item was added: + ----- Method: SpurBootstrapNewspeakFilePatcher>>initialize (in category 'initialize-release') ----- + initialize + substitutions := SortedCollection sortBlock: [:tupleA :tupleB | tupleA first <= tupleB first]!
Item was added: + ----- Method: SpurBootstrapNewspeakFilePatcher>>newspeakSourceFor:selector: (in category 'patching') ----- + newspeakSourceFor: method "<CompiledMethod>" selector: selector "<Symbol>" + | source startIndex nextIndex | + 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]. + + "map comments to Newspeak format..." + startIndex := 1. + [(startIndex := source indexOf: $" startingAt: startIndex) > 0] whileTrue: + [nextIndex := source indexOf: $" startingAt: startIndex + 1. + nextIndex < startIndex ifTrue: + [self error: 'matching close comment not found']. + source := source copyReplaceFrom: nextIndex to: nextIndex with: ' *)'. + source := source copyReplaceFrom: startIndex to: startIndex with: '(* '. + startIndex := nextIndex + 5]. + + "add the horror-show parentheses" + startIndex := source indexOf: Character cr. + source := source copyReplaceFrom: startIndex to: startIndex - 1 with: ' = ('. + source := source, (String with: Character cr with: $) ). + ^source!
Item was added: + ----- Method: SpurBootstrapNewspeakFilePatcher>>parse (in category 'parsing') ----- + parse + | platform | + platform := BlackMarket platform. + ^[(NewspeakParsing + usingPlatform: platform + grammar: (NewspeakGrammar parserLib: (CombinatorialParsing usingPlatform: platform)) + asts: (NewspeakASTs usingLib: platform)) Parser new compilationUnit parse: source] + ensure: [source close]!
Item was added: + ----- Method: SpurBootstrapNewspeakFilePatcher>>patch:inDirectory: (in category 'patching') ----- + patch: className inDirectory: dir + "SpurBootstrapNewspeakFilePatcher new + patch: 'KernelForSqueak' + inDirectory: '../newspeak'" + | directory | + directory := FileDirectory default directoryNamed: dir. + source := directory oldFileNamed: className, '.ns3'. + self substitute: self parse. + self editTo: (directory forceNewFileNamed: className, '.ns3.patched')!
Item was added: + ----- Method: SpurBootstrapNewspeakFilePatcher>>substitute: (in category 'patching') ----- + substitute: ast "<ClassDeclarationAST>" + + SpurBootstrap new prototypeClassNameMetaSelectorMethodDo: + [:className :isMeta :selector :method| | source | + method primitive = 0 ifTrue: "all primitives are in the VMMirror package" + [(self findClassDeclarationFor: className in: ast) ifNotNil: + [:classDecl| + (self findMethodDeclarationFor: selector in: classDecl) ifNotNil: + [:methodDecl| + source := self newspeakSourceFor: method selector: selector. + substitutions add: {methodDecl start. methodDecl end. source}]]]]!