SystemOrganization addCategory: #'Transactional-Core'! SystemOrganization addCategory: #'Transactional-Tests'! 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: '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-abort' stamp: 'lr 4/23/2007 17:07'! testErrorInst self should: [ [ value := true. self assert: value ] atomic ] raise: ZeroDivide. self assert: value isNil! ! !ACTestCase methodsFor: 'testing-abort' stamp: 'lr 4/23/2007 17:08'! testErrorLiteral self should: [ [ Value := true. self assert: Value ] atomic ] raise: ZeroDivide. self assert: Value isNil! ! !ACTestCase methodsFor: 'testing-abort' stamp: 'lr 4/23/2007 17:08'! testErrorTemp | temp | self should: [ [ temp := true. self assert: temp ] atomic ] raise: ZeroDivide. self assert: temp isNil! ! !ContextPart methodsFor: '*transactional' stamp: 'lr 4/23/2007 13:14'! atomic ^ ACTransaction run: self! ! Object subclass: #ACChange instanceVariableNames: 'transaction value' 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/23/2007 13:45'! apply self subclassResponsibility! ! !ACChange methodsFor: 'initialization' stamp: 'lr 4/23/2007 16:22'! initializeWithTransaction: aTransaction transaction := aTransaction! ! !ACChange methodsFor: 'actions' stamp: 'lr 4/23/2007 16:39'! update self subclassResponsibility! ! !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 subclass: #ACInstanceVariableChange instanceVariableNames: 'receiver index' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Core'! !ACInstanceVariableChange class methodsFor: 'as yet unclassified' stamp: 'lr 4/23/2007 16:48'! in: aTransaction offset: anInteger | receiver slots change | receiver := aTransaction context receiver. slots := aTransaction changes 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: 'actions' stamp: 'lr 4/23/2007 16:37'! apply self receiver instVarAt: self index put: self value! ! !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: '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: 'actions' stamp: 'lr 4/23/2007 16:39'! update self value: (self receiver instVarAt: self index)! ! ACChange subclass: #ACLiteralVariableChange instanceVariableNames: 'association' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Core'! !ACLiteralVariableChange class methodsFor: 'as yet unclassified' stamp: 'lr 4/23/2007 16:54'! in: aTransaction association: anAssociation ^ aTransaction changes at: anAssociation ifAbsentPut: [ (self in: aTransaction) association: anAssociation; update ]! ! !ACLiteralVariableChange methodsFor: 'actions' stamp: 'lr 4/23/2007 16:38'! apply self association value: self value! ! !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: 'actions' stamp: 'lr 4/23/2007 16:54'! update self value: self association value! ! ACChange subclass: #ACTemporaryVariableChange instanceVariableNames: 'context index' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Core'! !ACTemporaryVariableChange class methodsFor: 'as yet unclassified' stamp: 'lr 4/23/2007 16:52'! in: aTransaction offset: anInteger | context slots change | context := aTransaction context home. slots := aTransaction changes at: context ifAbsentPut: [ Array new: context basicSize ]. change := slots at: anInteger. change ifNil: [ change := slots at: anInteger put: ((self in: aTransaction) context: context; index: anInteger; update) ]. ^ change! ! !ACTemporaryVariableChange methodsFor: 'actions' stamp: 'lr 4/23/2007 16:36'! apply self context at: self index put: self value! ! !ACTemporaryVariableChange methodsFor: 'accessing' stamp: 'lr 4/23/2007 16:36'! context ^ context! ! !ACTemporaryVariableChange methodsFor: 'accessing' stamp: 'lr 4/23/2007 16:36'! context: aContext context := aContext! ! !ACTemporaryVariableChange methodsFor: 'accessing' stamp: 'lr 4/23/2007 16:36'! index ^ index! ! !ACTemporaryVariableChange methodsFor: 'accessing' stamp: 'lr 4/23/2007 16:36'! index: anInteger index := anInteger! ! !ACTemporaryVariableChange methodsFor: 'actions' stamp: 'lr 4/23/2007 16:39'! update self value: (self context at: self index)! ! Object subclass: #ACTransaction instanceVariableNames: 'changes context' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Core'! !ACTransaction class methodsFor: 'instance-creation' stamp: 'lr 4/23/2007 13:15'! run: aBlock ^ self basicNew run: aBlock! ! !ACTransaction methodsFor: 'public' stamp: 'lr 4/23/2007 16:58'! abort changes := nil ! ! !ACTransaction methodsFor: 'public' stamp: 'lr 4/23/2007 13:49'! begin changes := 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/23/2007 16:18'! changes ^ changes! ! !ACTransaction methodsFor: 'public' stamp: 'lr 4/23/2007 17:00'! commit changes do: [ :each | (each respondsTo: #apply) ifTrue: [ each apply ] ifFalse: [ each do: [ :each2 | each2 isNil ifFalse: [ each2 apply ] ] ] ]! ! !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: 'private' stamp: 'lr 4/23/2007 13:32'! interpret: aBlock context := aBlock asContext. context privSender: thisContext. [ context == thisContext ] whileFalse: [ context := context interpretNextInstructionFor: self ]. ^ 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: '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: 'interpreting' stamp: 'lr 4/23/2007 16:50'! popIntoTemporaryVariable: anInteger "Remove top of stack and store into temporary variable of method bytecode." | change | change := ACTemporaryVariableChange in: self offset: anInteger + 1. change value: context pop. ^ context! ! !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: 'interpreting' stamp: 'lr 4/23/2007 16:50'! pushTemporaryVariable: anInteger "Push contents of temporary variable whose index is the argument, offset, on top of stack bytecode." | change | change := ACTemporaryVariableChange in: self offset: anInteger + 1. context push: change value. ^ context! ! !ACTransaction methodsFor: 'public' stamp: 'lr 4/23/2007 13:32'! run: aBlock | result | self begin. [ result := self interpret: aBlock ] ifCurtailed: [ self abort ]. self commit. ^ result! ! !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: 'interpreting' stamp: 'lr 4/23/2007 16:50'! storeIntoTemporaryVariable: anInteger "Store top of stack into temporary variable of method bytecode." | change | change := ACTemporaryVariableChange in: self offset: anInteger + 1. change value: context top. ^ context! ! Error subclass: #ACConflict instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Transactional-Core'!