SystemOrganization addCategory: #'Transactional-Core'! SystemOrganization addCategory: #'Transactional-Tests'! Error subclass: #ACConflict instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Core'! !ContextPart methodsFor: '*transactional' stamp: 'lr 4/25/2007 11:13'! atomic ^ ACTransaction within: self! ! Object subclass: #ACChange instanceVariableNames: 'transaction value previous' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Core'! !ACChange class methodsFor: 'instance-creation' stamp: 'lr 4/23/2007 16:22'! in: aTransaction ^ self new initializeWithTransaction: aTransaction! ! !ACChange methodsFor: 'actions' stamp: 'lr 4/25/2007 13:33'! apply self hasChanged ifTrue: [ 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: '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/23/2007 16:23'! 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: #ACInstanceVariableChange instanceVariableNames: 'receiver index' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Core'! !ACInstanceVariableChange class methodsFor: 'instance-creation' stamp: 'lr 4/25/2007 11:05'! in: aTransaction offset: anInteger | receiver slots change | receiver := aTransaction context receiver. slots := aTransaction instanceChanges at: receiver ifAbsentPut: [ Array new: receiver class instSize ]. change := slots at: anInteger. change ifNil: [ change := slots at: anInteger put: ((self in: aTransaction) receiver: receiver; index: anInteger; update) ]. ^ change! ! !ACInstanceVariableChange methodsFor: 'accessing' stamp: 'lr 4/23/2007 16:37'! index ^ index! ! !ACInstanceVariableChange methodsFor: 'accessing' stamp: 'lr 4/23/2007 16:37'! index: anInteger index := anInteger! ! !ACInstanceVariableChange methodsFor: 'utilities' stamp: 'lr 4/25/2007 11:23'! read ^ self receiver instVarAt: self index! ! !ACInstanceVariableChange methodsFor: 'accessing' stamp: 'lr 4/23/2007 16:37'! receiver ^ receiver! ! !ACInstanceVariableChange methodsFor: 'accessing' stamp: 'lr 4/23/2007 16:37'! receiver: anObject receiver := anObject! ! !ACInstanceVariableChange methodsFor: 'utilities' stamp: 'lr 4/25/2007 10:56'! write: anObject self receiver instVarAt: self index put: anObject! ! ACChange subclass: #ACLiteralVariableChange instanceVariableNames: 'association' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Core'! !ACLiteralVariableChange class methodsFor: 'instance-creation' stamp: 'lr 4/25/2007 11:05'! in: aTransaction association: anAssociation ^ aTransaction literalChanges at: anAssociation ifAbsentPut: [ (self in: aTransaction) association: anAssociation; update ]! ! !ACLiteralVariableChange methodsFor: 'accessing' stamp: 'lr 4/23/2007 16:39'! association ^ association! ! !ACLiteralVariableChange methodsFor: 'accessing' stamp: 'lr 4/23/2007 16:38'! association: anAssociation association := anAssociation! ! !ACLiteralVariableChange methodsFor: 'utilities' stamp: 'lr 4/25/2007 10:56'! read ^ self association value! ! !ACLiteralVariableChange methodsFor: 'utilities' stamp: 'lr 4/25/2007 10:56'! write: anObject self association value: anObject! ! Object subclass: #ACTransaction instanceVariableNames: 'context changes instanceChanges literalChanges' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Core'! !ACTransaction class methodsFor: 'instance-creation' stamp: 'lr 4/25/2007 11:12'! within: aBlock ^ self basicNew within: aBlock! ! !ACTransaction methodsFor: 'public' stamp: 'lr 4/25/2007 13:34'! abort changes := instanceChanges := literalChanges := nil! ! !ACTransaction methodsFor: 'public' stamp: 'lr 4/25/2007 13:34'! begin changes := OrderedCollection new. instanceChanges := IdentityDictionary new. literalChanges := IdentityDictionary new! ! !ACTransaction methodsFor: 'delegated' stamp: 'lr 4/23/2007 13:30'! blockReturnTop "Return Top Of Stack bytecode." ^ context blockReturnTop! ! !ACTransaction methodsFor: 'accessing' stamp: 'lr 4/25/2007 11:10'! changes ^ changes! ! !ACTransaction methodsFor: 'public' stamp: 'lr 4/25/2007 11:13'! commit [ self validate. self changes do: [ :each | each apply ] ] valueUnpreemptively! ! !ACTransaction methodsFor: 'accessing' stamp: 'lr 4/23/2007 16:33'! context ^ context! ! !ACTransaction methodsFor: 'delegated' stamp: 'lr 4/23/2007 13:30'! doDup "Duplicate Top Of Stack bytecode." ^ context doDup! ! !ACTransaction methodsFor: 'delegated' stamp: 'lr 4/23/2007 13:30'! doPop "Remove Top Of Stack bytecode." ^ context doPop! ! !ACTransaction methodsFor: 'accessing-changes' stamp: 'lr 4/25/2007 11:03'! instanceChanges ^ instanceChanges! ! !ACTransaction methodsFor: 'private' stamp: 'lr 4/25/2007 13:38'! interpret: aBlock | signal | signal := nil. context := [ aBlock on: Exception do: [ :error | signal := error ] ] asContext. context privSender: thisContext. [ context ~~ thisContext and: [ signal isNil ] ] whileTrue: [ context := context interpretNextInstructionFor: self ]. ^ signal isNil ifFalse: [ thisContext nextHandlerContext handleSignal: signal ] ifTrue: [ context pop ]! ! !ACTransaction methodsFor: 'delegated' stamp: 'lr 4/23/2007 13:30'! jump: offset "Unconditional Jump bytecode." ^ context jump: offset! ! !ACTransaction methodsFor: 'delegated' stamp: 'lr 4/23/2007 13:31'! jump: offset if: condition "Conditional Jump bytecode." ^ context jump: offset if: condition ! ! !ACTransaction methodsFor: 'accessing-changes' stamp: 'lr 4/25/2007 11:03'! literalChanges ^ literalChanges! ! !ACTransaction methodsFor: 'delegated' stamp: 'lr 4/23/2007 13:31'! methodReturnConstant: value "Return Constant bytecode." ^ context methodReturnConstant: value ! ! !ACTransaction methodsFor: 'delegated' stamp: 'lr 4/23/2007 13:31'! methodReturnReceiver "Return Self bytecode." ^ context methodReturnReceiver! ! !ACTransaction methodsFor: 'delegated' stamp: 'lr 4/23/2007 13:31'! methodReturnTop "Return Top Of Stack bytecode." ^ context methodReturnTop! ! !ACTransaction methodsFor: 'interpreting' stamp: 'lr 4/23/2007 16:48'! popIntoLiteralVariable: anAssociation "Remove top of stack and store into literal variable." | change | change := ACLiteralVariableChange in: self association: anAssociation. change value: context pop. ^ context! ! !ACTransaction methodsFor: 'interpreting' stamp: 'lr 4/23/2007 16:50'! popIntoReceiverVariable: anInteger "Remove top of stack and store into instance variable of method bytecode." | change | change := ACInstanceVariableChange in: self offset: anInteger + 1. change value: context pop. ^ context! ! !ACTransaction methodsFor: 'delegated' stamp: 'lr 4/25/2007 13:34'! popIntoTemporaryVariable: anInteger "Remove top of stack and store into temporary variable of method bytecode." ^ context popIntoTemporaryVariable: anInteger! ! !ACTransaction methodsFor: 'delegated' stamp: 'lr 4/23/2007 13:31'! pushActiveContext "Push Active Context On Top Of Its Own Stack bytecode." ^ context pushActiveContext! ! !ACTransaction methodsFor: 'delegated' stamp: 'lr 4/23/2007 13:31'! pushConstant: value "Push Constant, value, on Top Of Stack bytecode." ^ context pushConstant: value! ! !ACTransaction methodsFor: 'interpreting' stamp: 'lr 4/23/2007 16:49'! pushLiteralVariable: anAssociation "Push contents of anAssociation on top of stack." | change | change := ACLiteralVariableChange in: self association: anAssociation. context push: change value. ^ context! ! !ACTransaction methodsFor: 'delegated' stamp: 'lr 4/23/2007 13:37'! pushReceiver "Push Active Context's Receiver on Top Of Stack bytecode." ^ context pushReceiver! ! !ACTransaction methodsFor: 'interpreting' stamp: 'lr 4/23/2007 16:50'! pushReceiverVariable: anInteger "Push contents of the receiver's instance variable whose index is the argument on top of stack bytecode." | change | change := ACInstanceVariableChange in: self offset: anInteger + 1. context push: change value. ^ context! ! !ACTransaction methodsFor: 'delegated' stamp: 'lr 4/25/2007 13:34'! pushTemporaryVariable: anInteger "Push contents of temporary variable whose index is the argument, offset, on top of stack bytecode." ^ context pushTemporaryVariable: anInteger! ! !ACTransaction methodsFor: 'delegated' stamp: 'lr 4/23/2007 13:34'! send: selector super: supered numArgs: numberArguments "Send Message With Selector, selector, bytecode. The argument, supered, indicates whether the receiver of the message is specified with 'super' in the source method. The arguments of the message are found in the top numArguments locations on the stack and the receiver just below them." ^ context send: selector super: supered numArgs: numberArguments ! ! !ACTransaction methodsFor: 'interpreting' stamp: 'lr 4/23/2007 16:49'! storeIntoLiteralVariable: anAssociation "Store Top Of Stack Into Literal Variable Of Method bytecode." | change | change := ACLiteralVariableChange in: self association: anAssociation. change value: context top. ^ context! ! !ACTransaction methodsFor: 'interpreting' stamp: 'lr 4/23/2007 16:50'! storeIntoReceiverVariable: anInteger "Store top of stack into instance variable of method bytecode." | change | change := ACInstanceVariableChange in: self offset: anInteger + 1. change value: context top. ^ context! ! !ACTransaction methodsFor: 'delegated' stamp: 'lr 4/25/2007 13:34'! storeIntoTemporaryVariable: anInteger "Store top of stack into temporary variable of method bytecode." ^ context storeIntoTemporaryVariable: anInteger! ! !ACTransaction methodsFor: 'public' stamp: 'lr 4/25/2007 13:20'! validate changes do: [ :each | each hasConflict ifTrue: [ ACConflict signal ] ]! ! !ACTransaction methodsFor: 'public' stamp: 'lr 4/25/2007 11:12'! within: aBlock | result | self begin. [ result := self interpret: aBlock ] ifCurtailed: [ self abort ]. self commit. ^ result! ! TestCase subclass: #ACTestCase instanceVariableNames: 'value' classVariableNames: 'Value' poolDictionaries: '' category: 'Transactional-Tests'! !ACTestCase methodsFor: 'running' stamp: 'lr 4/23/2007 16:20'! setUp value := nil. Value := nil! ! !ACTestCase methodsFor: 'utilities' stamp: 'lr 4/25/2007 13:50'! 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 ]! ! !ACTestCase methodsFor: 'testing' stamp: 'lr 4/23/2007 13:17'! testBasicContext self assert: [ thisContext home ] atomic == thisContext! ! !ACTestCase methodsFor: 'testing-basic' stamp: 'lr 4/23/2007 16:49'! testBasicInstRead value := true. self assert: [ value ] atomic! ! !ACTestCase methodsFor: 'testing-basic' stamp: 'lr 4/23/2007 13:16'! testBasicInstWrite [ value := true ] atomic. self assert: value! ! !ACTestCase methodsFor: 'testing-basic' stamp: 'lr 4/23/2007 16:20'! testBasicLiteralRead Value := true. self assert: [ Value ] atomic! ! !ACTestCase methodsFor: 'testing-basic' stamp: 'lr 4/23/2007 16:20'! testBasicLiteralWrite [ Value := true ] atomic. self assert: Value! ! !ACTestCase methodsFor: 'testing' stamp: 'lr 4/23/2007 13:17'! testBasicSelf self assert: [ self ] atomic == self! ! !ACTestCase methodsFor: 'testing' stamp: 'lr 4/23/2007 13:17'! testBasicSuper self assert: [ super ] atomic == self! ! !ACTestCase methodsFor: 'testing-basic' stamp: 'lr 4/23/2007 13:16'! testBasicTempRead | temp | temp := true. self assert: [ temp ] atomic! ! !ACTestCase methodsFor: 'testing-basic' stamp: 'lr 4/23/2007 13:16'! testBasicTempWrite | temp | [ temp := true ] atomic. self assert: temp! ! !ACTestCase methodsFor: 'testing-errors' stamp: 'lr 4/25/2007 11:36'! testErrorInst self should: [ [ value := true. self assert: value. 1 / 0 ] atomic ] raise: ZeroDivide. self assert: value isNil! ! !ACTestCase methodsFor: 'testing-errors' stamp: 'lr 4/25/2007 11:36'! testErrorLiteral self should: [ [ Value := true. self assert: Value. 1 / 0 ] atomic ] raise: ZeroDivide. self assert: Value isNil! ! !ACTestCase methodsFor: 'testing-advanced' stamp: 'lr 4/25/2007 13:47'! testParallelDictionary | hash | hash := Dictionary new. self start: 100 processes: [ 1 to: 1000 do: [ :each | [ hash at: each put: (hash at: each ifAbsentPut: [ 0 ]) + 1 ] atomic ] ]. 1 to: 1000 do: [ :each | self assert: (hash at: each) = 100 ]! !