SystemOrganization addCategory: #'Transactional-Model'! SystemOrganization addCategory: #'Transactional-Tests'! SystemOrganization addCategory: #'Transactional-Errors'! Notification subclass: #ACCurrentTransaction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Errors'! !ACCurrentTransaction class methodsFor: 'evaluating' stamp: 'lr 5/4/2007 17:46'! use: aTransaction during: aBlock ^ aBlock on: self do: [ :n | n resume: aTransaction ]! ! !ContextPart methodsFor: '*transactional' stamp: 'lr 5/7/2007 08:20'! atomicTempAt: anInteger ^ self home atomicAt: anInteger! ! !ContextPart methodsFor: '*transactional' stamp: 'lr 5/7/2007 08:19'! atomicTempAt: anInteger put: anObject ^ self home atomicAt: anInteger put: anObject! ! !BlockContext methodsFor: '*transactional' stamp: 'lr 5/7/2007 07:09'! atomic ^ ACTransaction within: self! ! !CompiledMethod methodsFor: '*transactional' stamp: 'lr 5/6/2007 11:38'! atomicMethod ^ self properties at: #atomicMethod ifAbsentPut: [ self newAtomicMethod ]! ! !CompiledMethod methodsFor: '*transactional' stamp: 'lr 5/6/2007 11:53'! flushAtomic ^ self properties removeKey: #atomicMethod ifAbsent: nil! ! !CompiledMethod methodsFor: '*transactional' stamp: 'lr 5/6/2007 15:29'! newAtomicMethod ^ self methodNode copy beAtomic generate compiledMethod! ! !RBMethodNode methodsFor: '*transactional' stamp: 'lr 5/6/2007 15:30'! beAtomic self propertyAt: #atomic put: true! ! !RBMethodNode methodsFor: '*transactional' stamp: 'lr 5/5/2007 19:39'! isAtomic ^ self propertyAt: #atomic ifAbsentPut: [ false ]! ! !RBMethodNode methodsFor: '*transactional' stamp: 'lr 5/7/2007 08:11'! primitive ^ primitiveNode ifNotNil: [ :node | node num ]! ! TestCase subclass: #ACTransactionalTest instanceVariableNames: 'value array' classVariableNames: 'Value' poolDictionaries: '' category: 'Transactional-Tests'! ACTransactionalTest subclass: #ACBasicTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Tests'! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/5/2007 19:16'! testAccessor self assert: [ self value: true. self value ] atomic! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/5/2007 19:16'! testAccessorRead self value: true. self assert: [ self value ] atomic! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/5/2007 19:16'! testAccessorWrite [ self value: true ] atomic. self assert: self value! ! !ACBasicTest methodsFor: 'testing-basic' stamp: 'lr 5/7/2007 07:36'! testBasicContext self assert: [ thisContext home ] atomic == thisContext! ! !ACBasicTest methodsFor: 'testing-basic' stamp: 'lr 5/7/2007 07:36'! testBasicSelf self assert: [ self ] atomic == self! ! !ACBasicTest methodsFor: 'testing-basic' stamp: 'lr 4/23/2007 13:17'! testBasicSuper self assert: [ super ] atomic == self! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/4/2007 14:37'! testGlobal self assert: [ GlobalValue := true. GlobalValue ] atomic! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/4/2007 14:37'! testGlobalRead GlobalValue := true. self assert: [ GlobalValue ] atomic! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/4/2007 14:37'! testGlobalWrite [ GlobalValue := true ] atomic. self assert: GlobalValue! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/4/2007 16:22'! testInstance self assert: [ value := true. value ] atomic! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/4/2007 16:23'! testInstanceRead value := true. self assert: [ value ] atomic! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/4/2007 16:23'! testInstanceWrite [ value := true ] atomic. self assert: value! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/3/2007 14:02'! testLiteral self assert: [ Value := true. Value ] atomic! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/3/2007 14:02'! testLiteralRead Value := true. self assert: [ Value ] atomic! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/3/2007 14:02'! testLiteralWrite [ Value := true ] atomic. self assert: Value! ! !ACBasicTest methodsFor: 'testing' stamp: 'lr 5/7/2007 07:36'! testLoop "This code showed some bug in the exception handling." | current | [ current := SortedCollection. [ current == nil ] whileFalse: [ current == Object ifTrue: [ ^ self ]. current := current superclass ] ] atomic. self assert: current == Object! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/3/2007 14:04'! testTemp | temp | self assert: [ temp := true. temp ] atomic! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/3/2007 14:03'! testTempRead | temp | temp := true. self assert: [ temp ] atomic! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/3/2007 14:04'! testTempWrite | temp | [ temp := true ] atomic. self assert: temp! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/3/2007 14:03'! testVariable self assert: [ array at: 1 put: true; at: 1 ] atomic! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/3/2007 14:03'! testVariableRead array at: 1 put: true. self assert: [ array at: 1 ] atomic! ! !ACBasicTest methodsFor: 'testing-kinds' stamp: 'lr 5/3/2007 14:03'! testVariableWrite [ array at: 1 put: true ] atomic. self assert: (array at: 1)! ! ACTransactionalTest subclass: #ACCollectionTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Tests'! !ACCollectionTest methodsFor: 'testing' stamp: 'lr 5/3/2007 15:58'! testArray | arr | arr := Array new: 10 withAll: 1. 3 to: 10 do: [ :each | [ arr at: each put: (arr at: each - 1) + (arr at: each - 2) ] atomic ]. 3 to: 10 do: [ :each | self assert: (arr at: each) - (arr at: each - 1) = (arr at: each - 2) ]! ! !ACCollectionTest methodsFor: 'testing' stamp: 'lr 5/3/2007 15:58'! testBag | bag | bag := Bag new. 1 to: 10 do: [ :each | [ bag add: each; add: each ] atomic ]. self assert: bag size = 20. 1 to: 10 do: [ :each | self assert: (bag occurrencesOf: each) = 2 ]! ! !ACCollectionTest methodsFor: 'testing' stamp: 'lr 5/3/2007 15:58'! testDictionary | dict | dict := Dictionary new. 1 to: 10 do: [ :each | [ dict at: each put: each ] atomic ]. self assert: dict size = 10. 1 to: 10 do: [ :each | self assert: (dict at: each) = each ]! ! !ACCollectionTest methodsFor: 'testing' stamp: 'lr 5/3/2007 15:58'! testSet | set | set := Set new. 1 to: 10 do: [ :each | [ set add: each ] atomic ]. self assert: set size = 10. 1 to: 10 do: [ :each | self assert: (set includes: each) ]! ! ACTransactionalTest subclass: #ACErrorTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Tests'! !ACErrorTest methodsFor: 'testing' stamp: 'lr 5/4/2007 13:50'! testAccessor self should: [ [ self value: true. self assert: self value. 1 / 0 ] atomic ] raise: ZeroDivide. self assert: (array at: 1) isNil! ! !ACErrorTest methodsFor: 'testing' stamp: 'lr 5/4/2007 13:50'! testInst self should: [ [ value := true. self assert: value. 1 / 0 ] atomic ] raise: ZeroDivide. self assert: value isNil! ! !ACErrorTest methodsFor: 'testing' stamp: 'lr 5/4/2007 13:50'! testLiteral self should: [ [ Value := true. self assert: Value. 1 / 0 ] atomic ] raise: ZeroDivide. self assert: Value isNil! ! !ACErrorTest methodsFor: 'testing' stamp: 'lr 5/4/2007 14:51'! testTemp | temp | self should: [ [ temp := true. self assert: temp. 1 / 0 ] atomic ] raise: ZeroDivide. self assert: temp isNil! ! !ACErrorTest methodsFor: 'testing' stamp: 'lr 5/4/2007 13:50'! testVar self should: [ [ array at: 1 put: true. self assert: (array at: 1). 1 / 0 ] atomic ] raise: ZeroDivide. self assert: (array at: 1) isNil! ! !ACTransactionalTest class methodsFor: 'initialization' stamp: 'lr 5/4/2007 14:37'! initialize self environment at: #GlobalValue put: nil! ! !ACTransactionalTest methodsFor: 'running' stamp: 'lr 5/4/2007 14:37'! setUp value := nil. array := Array new: 1. Value := nil. GlobalValue := nil! ! !ACTransactionalTest methodsFor: 'utilities' stamp: 'lr 5/3/2007 15:59'! start: anInteger processes: aBlock | semaphores | aBlock fixTemps. semaphores := (1 to: anInteger) collect: [ :each | Semaphore new ]. semaphores do: [ :each | [ aBlock value. each signal ] fixTemps fork ]. semaphores do: [ :each | each wait ]! ! !ACTransactionalTest methodsFor: 'accessing' stamp: 'lr 5/3/2007 15:59'! value ^ value! ! !ACTransactionalTest methodsFor: 'accessing' stamp: 'lr 5/3/2007 15:59'! value: anObject value := anObject! ! !BlockClosure methodsFor: '*transactional' stamp: 'lr 5/7/2007 07:09'! atomic ^ ACTransaction within: self! ! !ReflectiveMethod methodsFor: '*transactional' stamp: 'lr 5/6/2007 11:53'! atomicMethod ^ self properties at: #atomicMethod ifAbsentPut: [ self newAtomicMethod ]! ! !ReflectiveMethod methodsFor: '*transactional' stamp: 'lr 5/5/2007 09:57'! flushAtomic ^ self properties removeKey: #atomicMethod ifAbsent: nil! ! !ReflectiveMethod methodsFor: '*transactional' stamp: 'lr 5/6/2007 15:29'! newAtomicMethod ^ self methodNode copy beAtomic generate compiledMethod! ! Object subclass: #ACChange instanceVariableNames: 'transaction value previous' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Model'! !ACChange class methodsFor: 'instance-creation' stamp: 'lr 5/7/2007 06:52'! in: aTransaction ^ self new initializeWithTransaction: aTransaction! ! !ACChange methodsFor: 'actions' stamp: 'lr 4/27/2007 11:09'! apply self write: self value! ! !ACChange methodsFor: 'testing' stamp: 'lr 4/25/2007 13:33'! hasChanged ^ self previous ~~ self value! ! !ACChange methodsFor: 'testing' stamp: 'lr 4/25/2007 13:33'! hasConflict ^ self previous ~~ self read! ! !ACChange methodsFor: 'initialization' stamp: 'lr 5/7/2007 06:53'! initializeWithTransaction: aTransaction aTransaction changes add: self. transaction := aTransaction! ! !ACChange methodsFor: 'accessing' stamp: 'lr 4/25/2007 10:53'! previous ^ previous! ! !ACChange methodsFor: 'accessing' stamp: 'lr 4/25/2007 11:23'! previous: anObject previous := anObject! ! !ACChange methodsFor: 'printing' stamp: 'lr 5/4/2007 14:20'! printOn: aStream super printOn: aStream. " aStream nextPutAll: ' value: '; print: self value "! ! !ACChange methodsFor: 'utilities' stamp: 'lr 4/25/2007 10:57'! read "Read the value from the receiver." self subclassResponsibility! ! !ACChange methodsFor: 'actions' stamp: 'lr 4/25/2007 11:23'! update self value: self read. self previous: self value! ! !ACChange methodsFor: 'accessing' stamp: 'lr 4/23/2007 16:23'! value "Read the value local to the receivers transaction." ^ value! ! !ACChange methodsFor: 'accessing' stamp: 'lr 4/27/2007 10:46'! value: aValue "Write the value local to the receivers transaction." ^ value := aValue! ! !ACChange methodsFor: 'utilities' stamp: 'lr 4/25/2007 10:58'! write: anObject "Write anObject into the receiver." self subclassResponsibility! ! ACChange subclass: #ACGlobalChange instanceVariableNames: 'binding' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Model'! !ACGlobalChange class methodsFor: 'instance-creation' stamp: 'lr 5/7/2007 09:22'! binding: aBinding | transaction | transaction := ACTransaction current. ^ transaction globalChanges at: aBinding ifAbsentPut: [ (self in: transaction) binding: aBinding; update ]! ! !ACGlobalChange methodsFor: 'accessing' stamp: 'lr 5/4/2007 18:22'! binding ^ binding! ! !ACGlobalChange methodsFor: 'accessing' stamp: 'lr 5/4/2007 18:22'! binding: aBinding binding := aBinding! ! !ACGlobalChange methodsFor: 'utilities' stamp: 'lr 5/4/2007 18:23'! read ^ self binding value! ! !ACGlobalChange methodsFor: 'utilities' stamp: 'lr 5/4/2007 18:23'! write: anObject self binding value: anObject! ! ACChange subclass: #ACInstanceChange instanceVariableNames: 'object offset' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Model'! !ACInstanceChange class methodsFor: 'instance-creation' stamp: 'lr 5/7/2007 06:34'! object: anObject offset: anInteger | transaction slots change | transaction := ACTransaction current. slots := transaction instanceChanges at: anObject ifAbsentPut: [ Array new: anObject class instSize ]. change := slots at: anInteger. change ifNil: [ change := slots at: anInteger put: ((self in: transaction) object: anObject; offset: anInteger; update) ]. ^ change! ! !ACInstanceChange methodsFor: 'accessing' stamp: 'lr 5/4/2007 18:25'! object ^ object! ! !ACInstanceChange methodsFor: 'accessing' stamp: 'lr 5/4/2007 18:25'! object: anObject object := anObject! ! !ACInstanceChange methodsFor: 'accessing' stamp: 'lr 5/4/2007 18:24'! offset ^ offset! ! !ACInstanceChange methodsFor: 'accessing' stamp: 'lr 5/4/2007 18:24'! offset: anInteger offset := anInteger! ! !ACInstanceChange methodsFor: 'utilities' stamp: 'lr 5/4/2007 18:25'! read ^ self object instVarAt: self offset! ! !ACInstanceChange methodsFor: 'utilities' stamp: 'lr 5/4/2007 18:25'! write: anObject self object instVarAt: self offset put: anObject! ! ACChange subclass: #ACVariableChange instanceVariableNames: 'object offset' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Model'! !ACVariableChange class methodsFor: 'instance-creation' stamp: 'lr 5/7/2007 08:03'! object: anObject offset: anInteger | transaction slots change | transaction := ACTransaction current. slots := transaction instanceChanges at: anObject ifAbsentPut: [ Array new: anObject basicSize ]. change := slots at: anInteger. change ifNil: [ change := slots at: anInteger put: ((self in: transaction) object: anObject; offset: anInteger; update) ]. ^ change! ! !ACVariableChange methodsFor: 'accessing' stamp: 'lr 5/4/2007 18:30'! object ^ object! ! !ACVariableChange methodsFor: 'accessing' stamp: 'lr 5/4/2007 18:30'! object: anObject object := anObject! ! !ACVariableChange methodsFor: 'accessing' stamp: 'lr 5/4/2007 18:21'! offset ^ offset! ! !ACVariableChange methodsFor: 'accessing' stamp: 'lr 5/4/2007 18:20'! offset: anInteger offset := anInteger! ! !ACVariableChange methodsFor: 'utilities' stamp: 'lr 5/7/2007 08:26'! read ^ self object basicAt: self offset! ! !ACVariableChange methodsFor: 'utilities' stamp: 'lr 5/7/2007 08:26'! write: anObject self object basicAt: self offset put: anObject! ! Object subclass: #ACTransaction instanceVariableNames: 'context changes globalChanges instanceChanges variableChanges' classVariableNames: '' poolDictionaries: 'ContextPart' category: 'Transactional-Model'! !ACTransaction class methodsFor: 'instance-creation' stamp: 'lr 5/7/2007 09:22'! current ^ ACCurrentTransaction signal! ! !ACTransaction class methodsFor: 'instance-creation' stamp: 'lr 5/7/2007 07:09'! within: aBlock ^ self new within: aBlock! ! !ACTransaction methodsFor: 'public' stamp: 'lr 5/7/2007 08:24'! abort changes := globalChanges := instanceChanges := variableChanges := nil! ! !ACTransaction methodsFor: 'private' stamp: 'lr 5/7/2007 07:35'! basicCommit | changed conflicts | changed := changes select: [ :each | each hasChanged ]. conflicts := changed select: [ :each | each hasConflict ]. conflicts isEmpty ifFalse: [ ACConflict changes: conflicts ]. changed do: [ :each | each apply ]! ! !ACTransaction methodsFor: 'public' stamp: 'lr 5/7/2007 08:24'! begin changes := OrderedCollection new. globalChanges := IdentityDictionary new. instanceChanges := IdentityDictionary new. variableChanges := IdentityDictionary new! ! !ACTransaction methodsFor: 'accessing' stamp: 'lr 5/7/2007 06:37'! changes ^ changes! ! !ACTransaction methodsFor: 'public' stamp: 'lr 5/7/2007 06:37'! commit [ self basicCommit ] valueUnpreemptively! ! !ACTransaction methodsFor: 'accessing' stamp: 'lr 5/7/2007 06:37'! context ^ context! ! !ACTransaction methodsFor: 'accessing-changes' stamp: 'lr 5/4/2007 18:32'! globalChanges ^ globalChanges! ! !ACTransaction methodsFor: 'accessing-changes' stamp: 'lr 5/4/2007 18:32'! instanceChanges ^ instanceChanges! ! !ACTransaction methodsFor: 'accessing-changes' stamp: 'lr 5/4/2007 18:32'! variableChanges ^ variableChanges! ! !ACTransaction methodsFor: 'public' stamp: 'lr 5/7/2007 07:11'! within: aBlock | result | self begin. [ result := ACCurrentTransaction use: self during: aBlock ] ifCurtailed: [ self abort ]. self commit. ^ result! ! !Object methodsFor: '*transactional' stamp: 'lr 5/7/2007 09:47'! atomicAt: anInteger ^ (ACVariableChange object: self offset: anInteger) value! ! !Object methodsFor: '*transactional' stamp: 'lr 5/7/2007 09:47'! atomicAt: anInteger put: anObject ^ (ACVariableChange object: self offset: anInteger) value: anObject! ! !Object methodsFor: '*transactional' stamp: 'lr 5/7/2007 06:32'! atomicInstVarAt: anInteger ^ (ACInstanceChange object: self offset: anInteger) value! ! !Object methodsFor: '*transactional' stamp: 'lr 5/7/2007 06:32'! atomicInstVarAt: anInteger put: anObject ^ (ACInstanceChange object: self offset: anInteger) value: anObject! ! !Object methodsFor: '*transactional' stamp: 'lr 5/6/2007 12:19'! atomicPerform: aSelector withArguments: anArray | method | method := self class lookupSelector: aSelector. method ifNil: [ ^ self perform: aSelector withArguments: anArray ]. ^ self withArgs: anArray executeMethod: method atomicMethod! ! !LookupKey methodsFor: '*transactional' stamp: 'lr 5/7/2007 07:59'! atomicValue ^ (ACGlobalChange binding: self) value! ! !LookupKey methodsFor: '*transactional' stamp: 'lr 5/7/2007 07:59'! atomicValue: anObject ^ (ACGlobalChange binding: self) value: anObject! ! PECompilerPlugin subclass: #ACCompilerPlugin instanceVariableNames: 'active' classVariableNames: 'Enabled' poolDictionaries: '' category: 'Transactional-Model'! !ACCompilerPlugin class methodsFor: 'initialization' stamp: 'lr 5/7/2007 07:02'! initialize Enabled := true! ! !ACCompilerPlugin class methodsFor: 'plugin-interface' stamp: 'lr 5/7/2007 07:02'! isCompilerBackendPlugin ^ Enabled ifNil: [ false ]! ! !ACCompilerPlugin class methodsFor: 'plugin-interface' stamp: 'lr 5/7/2007 07:02'! priority ^ GPTransformer priority - 1! ! !ACCompilerPlugin methodsFor: 'visiting-transform' stamp: 'lr 5/7/2007 08:00'! acceptAssignmentNode: aNode | gplink | self visitNode: aNode value. self isActive ifFalse: [ ^ self ]. (self reservedNames includes: aNode name) ifTrue: [ ^ self ]. gplink := GPLink new instead. aNode variable ifTemp: [ gplink metaObject: #context; selector: #atomicTempAt:put:; arguments: #(offset newValue) ] ifInstance: [ gplink metaObject: #object; selector: #atomicInstVarAt:put:; arguments: #(offset newValue) ] ifGlobal: [ gplink metaObject: #binding; selector: #atomicValue:; arguments: #(newValue) ]. aNode link: gplink! ! !ACCompilerPlugin methodsFor: 'visiting' stamp: 'lr 5/7/2007 09:34'! acceptBlockNode: aNode (self shouldEnter: aNode) ifFalse: [ self visitNode: aNode body ] ifTrue: [ self isActive ifTrue: [ aNode parent selector: #value ] ifFalse: [ self active: true. [ self visitNode: aNode body ] ensure: [ self active: false ] ] ]! ! !ACCompilerPlugin methodsFor: 'visiting-transform' stamp: 'lr 5/7/2007 09:42'! acceptMessageNode: aNode | gplink | super acceptMessageNode: aNode. self isActive ifFalse: [ ^ self ]. aNode isInline ifTrue: [ ^ self ]. gplink := GPLink metaObject: #receiver. gplink instead; selector: #atomicPerform:withArguments:; arguments: #(selector arguments). aNode link: gplink ! ! !ACCompilerPlugin methodsFor: 'visiting' stamp: 'lr 5/7/2007 09:36'! acceptMethodNode: aNode self active: aNode isAtomic. (self isActive and: [ aNode primitive = 60 ]) ifTrue: [ ^ aNode becomeForward: (Object >> #atomicAt:) methodNode copy ]. (self isActive and: [ aNode primitive = 61 ]) ifTrue: [ ^ aNode becomeForward: (Object >> #atomicAt:put:) methodNode copy ]. self visitNode: aNode body! ! !ACCompilerPlugin methodsFor: 'visiting' stamp: 'lr 5/7/2007 06:49'! acceptSequenceNode: aNode aNode statements do: [ :each | self visitNode: each ]! ! !ACCompilerPlugin methodsFor: 'visiting-transform' stamp: 'lr 5/7/2007 08:00'! acceptVariableNode: aNode | gplink | self isActive ifFalse: [ ^ self ]. (self reservedNames includes: aNode name) ifTrue: [ ^ self ]. gplink := GPLink new instead. aNode ifTemp: [ gplink metaObject: #context; selector: #atomicTempAt:; arguments: #(offset) ] ifInstance: [ gplink metaObject: #object; selector: #atomicInstVarAt:; arguments: #(offset) ] ifGlobal: [ gplink metaObject: #binding; selector: #atomicValue; arguments: #() ]. aNode link: gplink! ! !ACCompilerPlugin methodsFor: 'accessing' stamp: 'lr 5/7/2007 09:33'! active: aBoolean active := aBoolean! ! !ACCompilerPlugin methodsFor: 'testing' stamp: 'lr 5/7/2007 09:33'! isActive ^ active! ! !ACCompilerPlugin methodsFor: 'accessing' stamp: 'lr 5/7/2007 09:33'! reservedNames ^ #( 'self' 'super' 'thisContext' )! ! !ACCompilerPlugin methodsFor: 'testing' stamp: 'lr 5/7/2007 09:33'! shouldEnter: aNode ^ aNode isBlock and: [ aNode parent notNil and: [ aNode parent isMessage and: [ aNode parent selector = #atomic ] ] ]! ! Error subclass: #ACConflict instanceVariableNames: 'changes' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Errors'! !ACConflict class methodsFor: 'instance-creation' stamp: 'lr 5/7/2007 07:16'! changes: aCollection ^ self new changes: aCollection; signal! ! !ACConflict methodsFor: 'accessing' stamp: 'lr 5/7/2007 07:16'! changes ^ changes! ! !ACConflict methodsFor: 'accessing' stamp: 'lr 5/7/2007 07:16'! changes: aCollection changes := aCollection! ! Error subclass: #ACInvalidTransaction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Errors'! ACTransactionalTest initialize! ACCompilerPlugin initialize!