SystemOrganization addCategory: #'Transactional-Model'! SystemOrganization addCategory: #'Transactional-Tests'! !BlockContext methodsFor: '*transactional' stamp: 'lr 5/4/2007 15:48'! atomic self error: 'This should never be called directly'! ! !CompiledMethod methodsFor: '*transactional' stamp: 'lr 5/5/2007 19:20'! atomicMethod ^ self reflectiveMethodOrNil ifNil: [ self ]! ! !CompiledMethod methodsFor: '*transactional' stamp: 'lr 5/5/2007 10:10'! flushAtomic self reflectiveMethodOrNil ifNotNilDo: [ :m | m flushAtomic ]! ! !RBMethodNode methodsFor: '*transactional' stamp: 'lr 5/5/2007 19:39'! beAtomic ^ self propertyAt: #atomic put: true! ! !RBMethodNode methodsFor: '*transactional' stamp: 'lr 5/5/2007 19:39'! isAtomic ^ self propertyAt: #atomic ifAbsentPut: [ false ]! ! 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/4/2007 17:55'! testBasicContext self assert: [ thisContext home ] atomic == thisContext! ! !ACBasicTest methodsFor: 'testing-basic' stamp: 'lr 4/23/2007 13:17'! 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/5/2007 19:15'! 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! ! Object subclass: #ACChange instanceVariableNames: 'transaction value previous' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Model'! !ACChange class methodsFor: 'accessing' stamp: 'lr 5/4/2007 18:49'! currentTransaction ^ ACCurrentTransaction signal! ! !ACChange class methodsFor: 'instance-creation' stamp: 'lr 4/23/2007 16:22'! 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 4/25/2007 11:11'! 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/4/2007 18:37'! binding: aBinding | transaction | transaction := self currentTransaction. ^ 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/4/2007 18:39'! object: anObject offset: anInteger | transaction slots change | transaction := self currentTransaction. 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: #ACTempChange instanceVariableNames: 'frame offset' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Model'! !ACTempChange class methodsFor: 'instance-creation' stamp: 'lr 5/4/2007 18:40'! frame: aContext offset: anInteger | transaction slots change | transaction := self currentTransaction. slots := transaction instanceChanges at: aContext ifAbsentPut: [ Array new: aContext basicSize ]. change := slots at: anInteger. change ifNil: [ change := slots at: anInteger put: ((self in: transaction) frame: aContext; offset: anInteger; update) ]. ^ change! ! !ACTempChange methodsFor: 'accessing' stamp: 'lr 5/4/2007 18:26'! frame ^ frame! ! !ACTempChange methodsFor: 'accessing' stamp: 'lr 5/4/2007 18:26'! frame: aContext frame := aContext! ! !ACTempChange methodsFor: 'accessing' stamp: 'lr 5/4/2007 18:26'! offset ^ offset! ! !ACTempChange methodsFor: 'accessing' stamp: 'lr 5/4/2007 18:26'! offset: anInteger offset := anInteger! ! !ACTempChange methodsFor: 'utilities' stamp: 'lr 5/4/2007 18:27'! read ^ self frame at: self offset! ! !ACTempChange methodsFor: 'utilities' stamp: 'lr 5/4/2007 18:29'! write: anObject self frame at: self offset put: anObject! ! ACChange subclass: #ACVariableChange instanceVariableNames: 'object offset' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Model'! !ACVariableChange class methodsFor: 'instance-creation' stamp: 'lr 5/4/2007 18:41'! object: anObject offset: anInteger | transaction slots change | transaction := self currentTransaction. 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/4/2007 18:30'! read ^ self object basicAt: self index! ! !ACVariableChange methodsFor: 'utilities' stamp: 'lr 5/4/2007 18:30'! write: anObject self object basicAt: self index put: anObject! ! !Object methodsFor: '*transactional' stamp: 'lr 5/5/2007 18:21'! atomicInstVarAt: anInteger! ! !Object methodsFor: '*transactional' stamp: 'lr 5/5/2007 18:21'! atomicInstVarAt: anInteger put: anObject! ! !Object methodsFor: '*transactional' stamp: 'lr 5/5/2007 19:25'! atomicPerform: aSelector withArguments: anArray | method | method := self class lookupSelector: aSelector. method ifNil: [ ^ self perform: aSelector withArguments: anArray ]. ^ self withArgs: anArray executeMethod: method! ! Error subclass: #ACConflict instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Model'! !GPTempVariable methodsFor: '*transactional' stamp: 'lr 5/4/2007 18:51'! atomic ^ (ACTempChange frame: self frame home offset: self offset) value! ! Notification subclass: #ACCurrentTransaction instanceVariableNames: '' classVariableNames: '' poolDictionaries: 'ContextPart' category: 'Transactional-Model'! !ACCurrentTransaction class methodsFor: 'as yet unclassified' stamp: 'lr 5/4/2007 17:46'! use: aTransaction during: aBlock ^ aBlock on: self do: [ :n | n resume: aTransaction ]! ! Object subclass: #ACTransaction instanceVariableNames: 'context changes globalChanges instanceChanges tempChanges variableChanges' classVariableNames: '' poolDictionaries: 'ContextPart' category: 'Transactional-Model'! !ACTransaction class methodsFor: 'events' stamp: 'lr 5/4/2007 18:18'! assignement: anOperation ^ anOperation atomic! ! !ACTransaction class methodsFor: 'events' stamp: 'lr 5/5/2007 09:55'! send: anOperation | method | method := anOperation receiver class lookupSelector: anOperation selector. ^ anOperation receiver withArgs: anOperation arguments executeMethod: method atomicMethod! ! !ACTransaction class methodsFor: 'events' stamp: 'lr 5/4/2007 18:18'! variable: anOperation ^ anOperation atomic! ! !ACTransaction class methodsFor: 'instance-creation' stamp: 'lr 5/4/2007 17:47'! within: aBlock ^ self new within: aBlock! ! !ACTransaction methodsFor: 'public' stamp: 'lr 5/4/2007 18:33'! abort changes := globalChanges := instanceChanges := tempChanges := variableChanges := nil! ! !ACTransaction methodsFor: 'private' stamp: 'lr 5/4/2007 18:44'! basicCommit | changed | changed := changes select: [ :each | each hasChanged ]. changed do: [ :each | each hasConflict ifTrue: [ ACConflict signal ] ]. changed do: [ :each | each apply ]! ! !ACTransaction methodsFor: 'public' stamp: 'lr 5/4/2007 18:33'! begin changes := OrderedCollection new. globalChanges := IdentityDictionary new. instanceChanges := IdentityDictionary new. tempChanges := IdentityDictionary new. variableChanges := IdentityDictionary new! ! !ACTransaction methodsFor: 'accessing' stamp: 'lr 4/25/2007 11:10'! changes ^ changes! ! !ACTransaction methodsFor: 'public' stamp: 'lr 5/4/2007 18:43'! commit [ self basicCommit ] valueUnpreemptively! ! !ACTransaction methodsFor: 'accessing' stamp: 'lr 4/23/2007 16:33'! 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'! tempChanges ^ tempChanges! ! !ACTransaction methodsFor: 'accessing-changes' stamp: 'lr 5/4/2007 18:32'! variableChanges ^ variableChanges! ! !ACTransaction methodsFor: 'public' stamp: 'lr 5/4/2007 17:48'! within: aBlock | result | self begin. [ ACCurrentTransaction use: self during: [ result := aBlock value ] ] ifCurtailed: [ self abort ]. self commit. ^ result! ! !GPOperation methodsFor: '*transactional' stamp: 'lr 5/4/2007 18:35'! transaction ^ ACCurrentTransaction ifNil: [ self error: 'Invalid transaction' ]! ! !BlockClosure methodsFor: '*transactional' stamp: 'lr 5/4/2007 15:48'! atomic self error: 'This should never be called directly.'! ! !GPInstanceAssignment methodsFor: '*transactional' stamp: 'lr 5/4/2007 18:47'! atomic ^ (ACInstanceChange object: self object offset: self offset) value: self newValue! ! !GPTempAssignment methodsFor: '*transactional' stamp: 'lr 5/4/2007 18:51'! atomic ^ (ACTempChange frame: self frame home offset: self offset) value: self newValue! ! !ReflectiveMethod methodsFor: '*transactional' stamp: 'lr 5/5/2007 09:41'! 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/5/2007 19:21'! newAtomicMethod | parseTree | parseTree := self parseTree copy. ACTransformer install: parseTree. ^ parseTree generate! ! !GPGlobalAssignment methodsFor: '*transactional' stamp: 'lr 5/4/2007 18:49'! atomic ^ (ACGlobalChange binding: self binding) value: self newValue! ! !GPGlobalVariable methodsFor: '*transactional' stamp: 'lr 5/4/2007 18:49'! atomic ^ (ACGlobalChange binding: self binding) value! ! PECompilerPlugin subclass: #ACCompilerPlugin instanceVariableNames: 'enabled' classVariableNames: 'Enabled' poolDictionaries: '' category: 'Transactional-Model'! !ACCompilerPlugin class methodsFor: 'initialization' stamp: 'lr 5/6/2007 11:21'! initialize Enabled := true! ! !ACCompilerPlugin class methodsFor: 'plugin-interface' stamp: 'lr 5/6/2007 11:21'! isCompilerBackendPlugin ^ Enabled ifNil: [ Enabled := false ]! ! !ACCompilerPlugin class methodsFor: 'plugin-interface' stamp: 'lr 5/4/2007 15:44'! priority ^ GPTransformer priority - 1! ! !ACCompilerPlugin methodsFor: 'visiting-transform' stamp: 'lr 5/5/2007 20:18'! acceptAssignmentNode: anAssignmentNode self visitNode: anAssignmentNode value! ! !ACCompilerPlugin methodsFor: 'visiting' stamp: 'lr 5/5/2007 20:12'! acceptBlockNode: aBlockNode | previous | previous := enabled. (aBlockNode parent notNil and: [ aBlockNode parent isMessage and: [ aBlockNode parent selector = #atomic ] ]) ifTrue: [ aBlockNode selector: #value. enabled := true ]. self visitNode: aBlockNode body. enabled := previous! ! !ACCompilerPlugin methodsFor: 'visiting-transform' stamp: 'lr 5/5/2007 20:18'! acceptMessageNode: aMessageNode | gplink | super acceptMessageNode: aMessageNode. enabled ifFalse: [ ^ self ]. gplink := GPLink metaObject: #receiver. gplink instead; selector: #atomicPerform:withArguments:; arguments: #( selector arguments ). aMessageNode link: gplink ! ! !ACCompilerPlugin methodsFor: 'visiting' stamp: 'lr 5/5/2007 19:42'! acceptMethodNode: aMethodNode enabled := aMethodNode isAtomic. self visitNode: aMethodNode body! ! !ACCompilerPlugin methodsFor: 'visiting' stamp: 'lr 5/5/2007 20:12'! acceptSequenceNode: aSequenceNode aSequenceNode statements do: [ :each | self visitNode: each ]! ! !ACCompilerPlugin methodsFor: 'visiting-transform' stamp: 'lr 5/5/2007 20:11'! acceptVariableNode: aVariableNode! ! !ACCompilerPlugin methodsFor: 'accessing' stamp: 'lr 5/5/2007 20:09'! reservedNames ^ #( 'self' 'super' 'thisContext' )! ! !GPInstanceVariable methodsFor: '*transactional' stamp: 'lr 5/4/2007 18:47'! atomic ^ (ACInstanceChange object: self object offset: self offset) value! ! ACTransactionalTest initialize! ACCompilerPlugin initialize!