SystemOrganization addCategory: #'Persephone-Kernel'! SystemOrganization addCategory: #'Persephone-Annotations-Kernel'! SystemOrganization addCategory: #'Persephone-Annotations-Contrete'! SystemOrganization addCategory: #'Persephone-Compiler'! SystemOrganization addCategory: #'Persephone-Interpreter'! SystemOrganization addCategory: #'Persephone-Parsing'! SystemOrganization addCategory: #'Persephone-Visitors'! SystemOrganization addCategory: #'Persephone-Tests'! SystemOrganization addCategory: #'Persephone-Examples'! SystemOrganization addCategory: #'Persephone-Compatibility'! Trait named: #TBlock uses: {} category: 'Persephone-Interpreter'! !TBlock commentStamp: 'pmm 5/1/2006 12:17' prior: 0! I define the behavoir of blocks.! !TBlock methodsFor: 'exceptions' stamp: 'pmm 5/1/2006 12:33'! assert self assert: self! ! !TBlock methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:20'! bench "See how many times I can value in 5 seconds. I'll answer a meaningful description." | startTime endTime count | count := 0. endTime := Time millisecondClockValue + 5000. startTime := Time millisecondClockValue. [ Time millisecondClockValue > endTime ] whileFalse: [ self value. count := count + 1 ]. endTime := Time millisecondClockValue. ^count = 1 ifTrue: [ ((endTime - startTime) // 1000) printString, ' seconds.' ] ifFalse: [ ((count * 1000) / (endTime - startTime)) asFloat printString, ' per second.' ]! ! !TBlock methodsFor: 'private' stamp: 'pmm 5/1/2006 12:36'! copyForSaving "obsolete"! ! !TBlock methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:16'! doWhileFalse: conditionBlock "Evaluate the receiver once, then again as long the value of conditionBlock is false." | result | [result := self value. conditionBlock value] whileFalse. ^ result! ! !TBlock methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:17'! doWhileTrue: conditionBlock "Evaluate the receiver once, then again as long the value of conditionBlock is true." | result | [result := self value. conditionBlock value] whileTrue. ^ result! ! !TBlock methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:21'! durationToRun "Answer the duration taken to execute this block." ^ Duration milliSeconds: self timeToRun ! ! !TBlock methodsFor: 'exceptions' stamp: 'pmm 5/1/2006 12:33'! ensure: aBlock "Evaluate a termination block after evaluating the receiver, regardless of whether the receiver's evaluation completes." | returnValue b | returnValue := self value. "aBlock wasn't nil when execution of this method began; it is nil'd out by the unwind machinery, and that's how we know it's already been evaluated ... otherwise, obviously, it needs to be evaluated" aBlock == nil ifFalse: [ "nil out aBlock temp before evaluating aBlock so it is not executed again if aBlock remote returns" b := aBlock. thisContext tempAt: 1 put: nil. "aBlock := nil" b value. ]. ^ returnValue! ! !TBlock methodsFor: 'private' stamp: 'pmm 5/1/2006 12:36'! fixTemps "obsolete"! ! !TBlock methodsFor: 'scheduling' stamp: 'pmm 5/1/2006 12:37'! fork "Create and schedule a Process running the code in the receiver." ^ self newProcess resume! ! !TBlock methodsFor: 'scheduling' stamp: 'pmm 5/1/2006 12:37'! forkAndWait "Suspend current process while self runs" | semaphore | semaphore := Semaphore new. [self ensure: [semaphore signal]] fork. semaphore wait. ! ! !TBlock methodsFor: 'scheduling' stamp: 'pmm 5/1/2006 12:38'! forkAt: priority "Create and schedule a Process running the code in the receiver at the given priority. Answer the newly created process." ^ self newProcess priority: priority; resume! ! !TBlock methodsFor: 'scheduling' stamp: 'pmm 5/1/2006 12:38'! forkAt: priority named: name "Create and schedule a Process running the code in the receiver at the given priority and having the given name. Answer the newly created process." | forkedProcess | forkedProcess := self newProcess. forkedProcess priority: priority. forkedProcess name: name. ^ forkedProcess resume! ! !TBlock methodsFor: 'scheduling' stamp: 'pmm 5/1/2006 12:38'! forkNamed: aString "Create and schedule a Process running the code in the receiver and having the given name." ^ self newProcess name: aString; resume! ! !TBlock methodsFor: 'exceptions' stamp: 'pmm 5/1/2006 12:34'! ifCurtailed: aBlock "Evaluate the receiver with an abnormal termination action." ^ self value! ! !TBlock methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:21'! ifError: errorHandlerBlock "Evaluate the block represented by the receiver, and normally return it's value. If an error occurs, the errorHandlerBlock is evaluated, and it's value is instead returned. The errorHandlerBlock must accept zero, one, or two parameters (the error message and the receiver)." "Examples: [1 whatsUpDoc] ifError: [:err :rcvr | 'huh?']. [1 / 0] ifError: [:err :rcvr | 'ZeroDivide' = err ifTrue: [Float infinity] ifFalse: [self error: err]] " ^ self on: Error do: [:ex | errorHandlerBlock valueWithPossibleArgs: {ex description. ex receiver}]! ! !TBlock methodsFor: 'accessing' stamp: 'pmm 5/1/2006 12:14'! isBlock ^ true! ! !TBlock methodsFor: 'scheduling' stamp: 'pmm 5/1/2006 12:38'! newProcess "Answer a Process running the code in the receiver. The process is not scheduled." "Simulation guard" ^ Process forContext: [self value. Processor terminateActive] asContext priority: Processor activePriority! ! !TBlock methodsFor: 'accessing' stamp: 'pmm 6/19/2006 19:05'! numArgs self explicitRequirement! ! !TBlock methodsFor: 'exceptions' stamp: 'pmm 5/1/2006 12:34'! on: exception do: handlerAction "Evaluate the receiver in the scope of an exception handler." | handlerActive | "just a marker, fail and execute the following" handlerActive := true. ^ self value! ! !TBlock methodsFor: 'exceptions' stamp: 'pmm 5/1/2006 12:35'! onDNU: selector do: handleBlock "Catch MessageNotUnderstood exceptions but only those of the given selector (DNU stands for doesNotUnderstand:)" ^ self on: MessageNotUnderstood do: [:exception | exception message selector = selector ifTrue: [handleBlock valueWithPossibleArgs: {exception}] ifFalse: [exception pass] ]! ! !TBlock methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:17'! repeat "Evaluate the receiver repeatedly, ending only if the block explicitly returns." [self value. true] whileTrue! ! !TBlock methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:18'! repeatWithGCIf: testBlock | ans | "run the receiver, and if testBlock returns true, garbage collect and run the receiver again" ans := self value. (testBlock value: ans) ifTrue: [ Smalltalk garbageCollect. ans := self value ]. ^ans! ! !TBlock methodsFor: 'scheduling' stamp: 'pmm 5/1/2006 12:39'! simulate "Like run except interpret self using Smalltalk instead of VM. It is much slower." ^ self newProcess simulate! ! !TBlock methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:22'! timeToRun "Answer the number of milliseconds taken to execute this block." ^ Time millisecondsToRun: self ! ! !TBlock methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:23'! value "Evaluate the block represented by the receiver." ^self valueWithArguments: #() ! ! !TBlock methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:24'! value: arg "Evaluate the block with the given argument. Fail if the block expects other than 1 arguments." ^self valueWithArguments: (Array with: arg)! ! !TBlock methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:25'! value: arg1 value: arg2 "Evaluate the block with the given arguments. Fail if the block expects other than 2 arguments." ^self valueWithArguments: (Array with: arg1 with: arg2)! ! !TBlock methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:25'! value: arg1 value: arg2 value: arg3 "Evaluate the block with the given arguments. Fail if the block expects other than 3 arguments." ^self valueWithArguments: (Array with: arg1 with: arg2 with: arg3)! ! !TBlock methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:26'! value: arg1 value: arg2 value: arg3 value: arg4 "Evaluate the block with the given arguments. Fail if the block expects other than 4 arguments." ^self valueWithArguments: (Array with: arg1 with: arg2 with: arg3 with: arg4)! ! !TBlock methodsFor: 'private' stamp: 'pmm 5/1/2006 12:36'! valueError self error: 'Incompatible number of args'! ! !TBlock methodsFor: 'exceptions' stamp: 'pmm 5/1/2006 12:35'! valueUninterruptably "Prevent remote returns from escaping the sender. Even attempts to terminate (unwind) this process will be halted and the process will resume here. A terminate message is needed for every one of these in the sender chain to get the entire process unwound." ^ self ifCurtailed: [^ self]! ! !TBlock methodsFor: 'evaluating' stamp: 'pmm 6/19/2006 19:05'! valueWithArguments: anArray "Evaluate the block with given args. Fail if the block expects other than the given number of arguments." self explicitRequirement! ! !TBlock methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:32'! valueWithPossibleArgs: anArray "Evaluate the block represented by the receiver. If the block requires arguments, take them from anArray. If anArray is too large, the rest is ignored, if it is too small, use nil for the other arguments" | numArgs | numArgs := self numArgs. numArgs = 0 ifTrue: [^ self value]. numArgs = anArray size ifTrue: [^ self valueWithArguments: anArray]. ^ self valueWithArguments: (numArgs > anArray size ifTrue: [anArray, (Array new: numArgs - anArray size)] ifFalse: [anArray copyFrom: 1 to: numArgs])! ! !TBlock methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:31'! valueWithPossibleArgument: anArg "Evaluate the block represented by the receiver. If the block requires one argument, use anArg, if it requires more than one, fill up the rest with nils." | numArgs | numArgs := self numArgs. numArgs = 0 ifTrue: [^self value]. numArgs = 1 ifTrue: [^self value: anArg]. numArgs > 1 ifTrue: [^self valueWithArguments: {anArg}, (Array new: numArgs - 1)]! ! !TBlock methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:32'! valueWithin: aDuration onTimeout: timeoutBlock "Evaluate the receiver. If the evaluation does not complete in less than aDuration evaluate the timeoutBlock instead" | theProcess delay watchdog done result | aDuration <= Duration zero ifTrue: [^ timeoutBlock value ]. "the block will be executed in the current process" theProcess := Processor activeProcess. delay := aDuration asDelay. "make a watchdog process" watchdog := [ delay wait. "wait for timeout or completion" done ifFalse: [ theProcess signalException: TimedOut ] ] newProcess. "watchdog needs to run at high priority to do its job" watchdog priority: Processor timingPriority. "catch the timeout signal" ^ [ done := false. watchdog resume. "start up the watchdog" result := self value. "evaluate the receiver" done := true. "it has completed, so ..." delay delaySemaphore signal. "arrange for the watchdog to exit" result ] on: TimedOut do: [ :e | timeoutBlock value ]. ! ! !TBlock methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:18'! whileFalse "Ordinarily compiled in-line, and therefore not overridable. This is in case the message is sent to other than a literal block. Evaluate the receiver, as long as its value is false." ^ [self value] whileFalse: []! ! !TBlock methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:18'! whileFalse: aBlock "Ordinarily compiled in-line, and therefore not overridable. This is in case the message is sent to other than a literal block. Evaluate the argument, aBlock, as long as the value of the receiver is false." ^ [self value] whileFalse: [aBlock value]! ! !TBlock methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:19'! whileTrue "Ordinarily compiled in-line, and therefore not overridable. This is in case the message is sent to other than a literal block. Evaluate the receiver, as long as its value is true." ^ [self value] whileTrue: []! ! !TBlock methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:19'! whileTrue: aBlock "Ordinarily compiled in-line, and therefore not overridable. This is in case the message is sent to other than a literal block. Evaluate the argument, aBlock, as long as the value of the receiver is true." ^ [self value] whileTrue: [aBlock value]! ! Trait named: #TJMethod uses: {} category: 'Persephone-Compatibility'! !TJMethod commentStamp: 'pmm 6/19/2006 19:08' prior: 0! This trait makes sure you get JMethods in your class. ! !TJMethod classSide methodsFor: 'accessing' stamp: 'md 3/31/2007 19:14'! compilerClass ^PECompiler! ! !TJMethod classSide methodsFor: 'accessing' stamp: 'md 3/20/2007 17:24'! parseTreeFor: aSymbol ^(self compiledMethodAt: aSymbol) reflectiveMethod methodNode! ! !TJMethod classSide methodsFor: 'compiling' stamp: 'md 3/20/2007 17:28'! recompile: selector from: oldClass | jMethod | jMethod := (oldClass >> selector) reflectiveMethodOrNil. (jMethod notNil and: [ jMethod hasMethodClass not ]) ifTrue: [ jMethod methodClass: oldClass ]. super recompile: selector from: oldClass. ! ! Trait named: #TReflectiveMethods uses: {} category: 'Persephone-Kernel'! !TReflectiveMethods commentStamp: 'md 3/31/2007 19:11' prior: 0! This trait makes sure you get ReflectiveMethod in your class, even when the compiler option is turned off. Good for testing ! !TReflectiveMethods classSide methodsFor: 'compiling' stamp: 'md 3/31/2007 19:14'! compilerClass ^PECompiler! ! !TReflectiveMethods classSide methodsFor: 'compiling' stamp: 'md 3/31/2007 19:09'! parseTreeFor: aSymbol ^(self compiledMethodAt: aSymbol) reflectiveMethod methodNode! ! !TReflectiveMethods classSide methodsFor: 'compiling' stamp: 'md 3/31/2007 19:09'! recompile: selector from: oldClass | jMethod | jMethod := (oldClass >> selector) reflectiveMethodOrNil. (jMethod notNil and: [ jMethod hasMethodClass not ]) ifTrue: [ jMethod methodClass: oldClass ]. super recompile: selector from: oldClass. ! ! !RBAssignmentNode methodsFor: '*persephone' stamp: 'pmm 7/9/2006 10:41'! position ^assignment! ! !RBAssignmentNode methodsFor: '*persephone' stamp: 'pmm 11/11/2005 16:26'! replaceNode: aNode withNodes: aCollection aCollection size = 1 ifTrue: [ self replaceNode: aNode withNode: aCollection anyOne ] ifFalse: [ self error: 'can replace only one node' ]! ! !RBAssignmentNode methodsFor: '*persephone' stamp: 'pmm 7/23/2006 15:53'! variableNode ^self variable copy! ! !Trait methodsFor: '*persephone-override' stamp: 'md 3/31/2007 19:08'! parseTreeFor: aSymbol | method | method := self compiledMethodAt: aSymbol. method hasReflectiveMethod ifTrue: [^method reflectiveMethod methodNode]. "should be moved to #TPureBehavior" ^RBParser parseMethod: (self sourceCodeAt: aSymbol) onError: [:aString :pos | ^nil]! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'pmm 6/11/2006 15:09'! addAnnotation: anAnnotation ^(self annotations includesKey: anAnnotation key) ifFalse: [ self annotations at: anAnnotation key put: anAnnotation ] ifTrue: [ (self annotations at: anAnnotation key) mergeValueOf: anAnnotation ]! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'pmm 10/9/2005 23:07'! addValue: anObject toAnnotationAt: aSymbol ^(self annotationAt: aSymbol) addValue: anObject! ! !RBProgramNode methodsFor: '*persephone' stamp: 'pmm 6/3/2006 14:25'! afterCode ^self annotationAt: InstrumentationAnnotation afterAnnotationKey! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'pmm 11/11/2005 14:51'! annotateAfter: anObject self addValue: anObject toAnnotationAt: InstrumentationAnnotation afterAnnotationKey ! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'pmm 11/11/2005 14:51'! annotateBefore: anObject self addValue: anObject toAnnotationAt: InstrumentationAnnotation beforeAnnotationKey ! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'pmm 11/11/2005 14:51'! annotateReplace: anObject self addValue: anObject toAnnotationAt: InstrumentationAnnotation insteadAnnotationKey ! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'pmm 10/9/2005 22:14'! annotationAt: aSymbol ^self annotations at: aSymbol ifAbsentPut: [ Annotation forKey: aSymbol ]! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'md 3/28/2007 17:48'! annotationAt: aSymbol ifAbsent: aBlock annotations ifNil: aBlock. ^self annotations at: aSymbol ifAbsent: aBlock! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'md 4/12/2007 13:39'! annotations ^annotations ifNil: [annotations := RBSmallIdentityDictionary new: 1]! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'md 3/1/2007 20:09'! annotations: anArray annotations := anArray! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'md 3/29/2007 23:54'! annotationsDo: aTwoArgumentBlock annotations ifNil: [^self]. annotations valuesDo: [ :each | aTwoArgumentBlock value: each ]! ! !RBProgramNode methodsFor: '*persephone' stamp: 'pmm 7/22/2006 13:33'! asSequenceNode ^RBSequenceNode statements: (Array with: self)! ! !RBProgramNode methodsFor: '*persephone' stamp: 'pmm 6/3/2006 14:25'! beforeCode ^self annotationAt: InstrumentationAnnotation beforeAnnotationKey! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'pmm 6/26/2006 19:38'! clearAnnotations annotations := nil! ! !RBProgramNode methodsFor: '*persephone' stamp: 'pmm 9/24/2006 10:32'! evaluate ^(RBDoItNode body: (RBSequenceNode statement: self copy)) evaluate! ! !RBProgramNode methodsFor: '*persephone' stamp: 'pmm 6/3/2006 14:39'! hasAfterCode ^(self hasAnnotation: InstrumentationAnnotation afterAnnotationKey) and: [ self afterCode notEmpty ]! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'md 3/28/2007 17:20'! hasAnnotation: aKey annotations ifNil: [^false]. ^self annotations includesKey: aKey! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'md 3/28/2007 17:20'! hasAnnotations annotations ifNil: [^false]. ^self annotations notEmpty! ! !RBProgramNode methodsFor: '*persephone' stamp: 'pmm 6/3/2006 14:39'! hasBeforeCode ^(self hasAnnotation: InstrumentationAnnotation beforeAnnotationKey) and: [ self beforeCode notEmpty ]! ! !RBProgramNode methodsFor: '*persephone' stamp: 'pmm 6/3/2006 14:40'! hasInsteadCode ^(self hasAnnotation: InstrumentationAnnotation insteadAnnotationKey) and: [ self insteadCode notEmpty ]! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'pmm 1/19/2006 22:55'! hasVisibleAnnotations ^self hasAnnotations and: [ self annotations anySatisfy: [ :each | each isSourceVisible ] ]! ! !RBProgramNode methodsFor: '*persephone' stamp: 'pmm 6/3/2006 14:26'! insteadCode ^self annotationAt: InstrumentationAnnotation insteadAnnotationKey! ! !RBProgramNode methodsFor: '*persephone' stamp: 'pmm 7/9/2006 12:14'! isInstrumented ^self hasBeforeCode or: [ self hasInsteadCode ] or: [ self hasAfterCode ]! ! !RBProgramNode methodsFor: '*persephone' stamp: 'pmm 8/7/2006 09:50'! literalEqual: other ^self == other! ! !RBProgramNode methodsFor: '*persephone' stamp: 'pmm 6/4/2006 13:33'! method ^self parent method! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'md 3/28/2007 17:47'! numberOfAnnotations annotations ifNil: [^0]. ^self annotations size! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'md 3/28/2007 17:47'! numberOfSourceVisibleAnnotations annotations ifNil: [^0]. ^(self annotations select: [ :each | each isSourceVisible ]) size! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'md 3/28/2007 17:44'! removeAnnotation: annotName annotations ifNil: [^self]. self annotations removeKey: annotName ifAbsent:[].! ! !RBProgramNode methodsFor: '*persephone' stamp: 'pmm 7/24/2006 10:03'! replaceNodeAndSetParent: oldNode withNode: newNode self replaceNode: oldNode withNode: newNode. newNode parent: self! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'md 3/28/2007 17:45'! sourceVisibleAnnotations annotations ifNil: [^self]. self annotations select: [ :each | each isSourceVisible ]! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'md 3/28/2007 17:45'! sourceVisibleAnnotationsDo: aOneArgumentBlock annotations ifNil: [^self]. self annotations valuesDo: [ :each | each isSourceVisible ifTrue: [ aOneArgumentBlock value: each ] ]! ! !RBProgramNode methodsFor: '*persephone-annotations' stamp: 'pmm 10/27/2005 09:12'! valueOfAnnotation: aSymbol ^(self annotationAt: aSymbol) value! ! Compiler subclass: #PECompiler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Compiler'! !PECompiler commentStamp: 'md 3/31/2007 19:11' prior: 0! This is a subclass of ClosureCompiler that creates ReflectiveMethods! !PECompiler class methodsFor: 'class init' stamp: 'md 3/21/2007 14:00'! initialize Preferences addPreference: #compileReflectiveMethods category: #compiler default: false balloonHelp: 'If true, we generate ReflectiveMethods when compiling. The newCompiler preference needs to be turned ON, too.' ! ! !PECompiler class methodsFor: 'accessing' stamp: 'md 3/31/2007 18:56'! parserClass "Return a parser class to use for parsing method headers." ^PEParser! ! !PECompiler methodsFor: 'public access' stamp: 'md 3/31/2007 18:56'! compileDoIt: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock log: log "Compiles the sourceStream into a parse tree, then generates code into a method. This method is then wrapped in a block with the receiver or context as the sole free variable which the method refers to. If requestor is not nil, then it will receive a notify:at: message if there is a compile error, followed by the failBlock being executed." | scope parser blockNode method source | source _ textOrStream readStream. scope _ aContext ifNotNil: [aContext doItScope] ifNil: [receiver class parseScope instanceScope]. parser _ PEParser new. blockNode _ parser parse: source class: scope noPattern: true notifying: aRequestor ifFail: [^ failBlock value]. method _ blockNode generate. method selector: #DoIt. log ifTrue: [ method putSource: source contents fromParseNode: blockNode inFile: 2 withPreamble: [:file | file cr]]. ^ BlockClosure new env: (aContext ifNil: [receiver]); method: method; yourself! ! !PECompiler methodsFor: 'assessing' stamp: 'md 3/31/2007 18:56'! parserClass ^PEParser! ! TestCase subclass: #PEAssertDisablerTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Tests'! !PEAssertDisablerTest methodsFor: 'tests' stamp: 'md 4/15/2007 15:33'! testDisableAssert self assert: PersephoneExample new exampleAssert. Preferences enable: #disableAssert. self deny: PersephoneExample new exampleAssert. Preferences disable: #disableAssert. self assert: PersephoneExample new exampleAssert. ! ! TestCase subclass: #PEInterpretationTest instanceVariableNames: 'example' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Tests'! !PEInterpretationTest methodsFor: 'private' stamp: 'pmm 4/27/2006 23:14'! interpret: aSymbol ^self interpret: aSymbol withArguments: #()! ! !PEInterpretationTest methodsFor: 'private' stamp: 'pmm 4/27/2006 23:14'! interpret: aSymbol with: anObject ^self interpret: aSymbol withArguments: (Array with: anObject)! ! !PEInterpretationTest methodsFor: 'private' stamp: 'md 4/16/2007 21:17'! interpret: aSymbol withArguments: aCollection ^(self reflectiveMethod: aSymbol) interpret: aSymbol with: aCollection in: example! ! !PEInterpretationTest methodsFor: 'private' stamp: 'md 4/16/2007 21:17'! reflectiveMethod: aSymbol ^(example class >> aSymbol) reflectiveMethod! ! !PEInterpretationTest methodsFor: 'running' stamp: 'md 4/16/2007 21:21'! setUp super setUp. example := PEInterpretationExamples new ! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 7/1/2006 15:25'! testClassVar "self run: #testClassVar" (self interpret: #classVar: with: 666). self assert: (self interpret: #classVar) = 666. (self interpret: #classVar: with: 'Nova Cat'). self assert: (self interpret: #classVar) = 'Nova Cat'. ! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 4/27/2006 22:53'! testExampleArgument "self run: #testExampleArgument" self assert: (self interpret: #exampleArgument: with: 10) = 15! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 4/26/2006 21:52'! testExampleArray self assert: (self interpret: #exampleArray) = #(1 2 3 5)! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 4/26/2006 21:52'! testExampleArrayLiteral self assert: (self interpret: #exampleArrayLiteral) = #(1 2 3 4)! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 4/26/2006 21:53'! testExampleBlockReturn self assert: (self interpret: #exampleBlockReturn) = 2! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 4/26/2006 21:54'! testExampleBlockTemp self assert: (self interpret: #exampleBlockTemp) = 14! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 4/28/2006 20:37'! testExampleBranch self assert: (self interpret: #exampleBranch) = 31337! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 4/26/2006 21:54'! testExampleCascade self assert: (self interpret: #exampleCascade) = #(1 2 3) asOrderedCollection! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 4/26/2006 21:55'! testExampleDo self assert: (self interpret: #exampleDo) = 6! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 5/1/2006 16:06'! testExampleEnsure self assert: (self interpret: #exampleEnsure) = 20! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'md 4/16/2007 21:26'! testExampleGlobal self assert: (self interpret: #exampleGlobal) = 'PEInterpretationExamples'! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 4/26/2006 21:56'! testExampleInstVar self assert: (self interpret: #exampleInstVar) = 6! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 5/1/2006 16:06'! testExampleOnDo self assert: (self interpret: #exampleOnDo) = 20! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 4/28/2006 19:00'! testExampleOuterBlock self assert: (self interpret: #exampleOuterBlock) = 16! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 4/26/2006 21:57'! testExampleReturnSelf self assert: (self interpret: #exampleReturnSelf) == example! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'md 4/16/2007 21:27'! testExampleTemp self assert: (self interpret: #printString) = 'a PEInterpretationExamples RLY'! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 4/26/2006 21:55'! testExampleTrue self assert: (self interpret: #exampleTrue)! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'pmm 5/1/2006 08:16'! testExampleWhile self assert: (self interpret: #exampleWhile) = 20! ! !PEInterpretationTest methodsFor: 'testing' stamp: 'md 4/16/2007 21:11'! testPrimitive | methodNode result method | methodNode := PESqueakParser parseMethod: (SmalltalkImage >> #getSystemAttribute:) getSource. methodNode methodClass: SmalltalkImage. method := ReflectiveMethod new methodNode: methodNode; yourself. method beInterpreted. result := method run: #getSystemAttribute: with: #(1001) in: SmalltalkImage current. self deny: result isNil. self assert: result = (SmalltalkImage current getSystemAttribute: 1001)! ! TestCase subclass: #PersephoneSystemTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Tests'! !PersephoneSystemTest methodsFor: 'tests' stamp: 'md 3/30/2007 16:42'! testInvalidateOrderedCollectionAdd | cm1 cm2 | PERecompiler new recompileClass: OrderedCollection. cm1 := (OrderedCollection>>#add: ) invalidate. cm2 := (OrderedCollection>>#add: ) invalidate. self deny: cm1 == cm2. OrderedCollection compileAll.! ! !PersephoneSystemTest methodsFor: 'tests' stamp: 'md 3/30/2007 16:42'! testRecompileOrderedCollection PERecompiler new recompileClass: OrderedCollection. (OrderedCollection>>#add: ) reflectiveMethod class = ReflectiveMethod. OrderedCollection compileAll.! ! TestCase subclass: #PersephoneTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Tests'! !PersephoneTest methodsFor: 'tests' stamp: 'md 3/31/2007 19:45'! testCheckTwinClassBinding | method | PersephoneExample compileAll. method := (PersephoneExample>>#exampleSimple). self assert: method reflectiveMethod classBinding notNil. self assert: method reflectiveMethod classBinding == method compiledMethod classBinding. ! ! !PersephoneTest methodsFor: 'tests' stamp: 'md 3/31/2007 19:46'! testCheckTwinClassBinding2 | method | PERecompiler new recompileClass: PersephoneExample. method := (PersephoneExample>>#exampleSimple). self assert: method reflectiveMethod classBinding notNil. self assert: method reflectiveMethod classBinding == method compiledMethod classBinding. ! ! !PersephoneTest methodsFor: 'tests' stamp: 'md 3/27/2007 20:14'! testCheckTwinConsistency "When we nil out the methodNode, it will be recreated from source" | method | PersephoneExample compileAll. method := (PersephoneExample>>#exampleSimple). self assert: method reflectiveMethod compiledMethod == method compiledMethod. PersephoneExample new exampleSimple. self assert: method reflectiveMethod compiledMethod == method compiledMethod. ! ! !PersephoneTest methodsFor: 'tests' stamp: 'md 3/20/2007 17:26'! testCheckTwinSourcePointer | method | PersephoneExample compileAll. method := (PersephoneExample>>#exampleSimple). self assert: method reflectiveMethod sourcePointer > 0. self assert: method reflectiveMethod sourcePointer == method compiledMethod sourcePointer. PersephoneExample new exampleSimple. self assert: method reflectiveMethod compiledMethod == method compiledMethod. ! ! !PersephoneTest methodsFor: 'tests' stamp: 'md 3/20/2007 14:48'! testDeleteMethodNode "When we nil out the methodNode, it will be recreated from source" PersephoneExample compileAll. self assert: (PersephoneExample>>#exampleSimple) isReflectiveMethod. self assert: ((PersephoneExample>>#exampleSimple) methodNode isKindOf: RBMethodNode). (PersephoneExample>>#exampleSimple) methodNode: nil. self assert: ((PersephoneExample>>#exampleSimple) methodNode isKindOf: RBMethodNode). PersephoneExample new exampleSimple. self assert: (PersephoneExample>>#exampleSimple) isInvalid not. ! ! !PersephoneTest methodsFor: 'tests' stamp: 'md 3/26/2007 12:08'! testHasReflectiveMethod "When we nil out the methodNode, it will be recreated from source" | method | PersephoneExample compileAll. method := (PersephoneExample>>#exampleSimple). self assert: method hasReflectiveMethod. PersephoneExample new exampleSimple. self assert: method hasReflectiveMethod ! ! !PersephoneTest methodsFor: 'tests' stamp: 'md 3/1/2007 21:36'! testInValidate "When we compile a new method, this will be a RefectiveMethod" PersephoneExample compileAll. self assert: (PersephoneExample>>#exampleSimple) isReflectiveMethod. self assert: (PersephoneExample>>#exampleSimple) isInvalid. PersephoneExample new exampleSimple. self assert: (PersephoneExample>>#exampleSimple) isInvalid not. (PersephoneExample>>#exampleSimple) invalidate. self assert: (PersephoneExample>>#exampleSimple) isReflectiveMethod. self assert: (PersephoneExample>>#exampleSimple) isInvalid.! ! !PersephoneTest methodsFor: 'tests' stamp: 'md 3/1/2007 20:29'! testRecompile "When we compile a new method, this will be a RefectiveMethod" PersephoneExample compileAll. self assert: (PersephoneExample>>#exampleSimple) isReflectiveMethod. "Now we run it. It a cm is generated" PersephoneExample new exampleSimple. self assert: (PersephoneExample>>#exampleSimple) isCompiledMethod. PersephoneExample compileAll. self assert: (PersephoneExample>>#exampleSimple) isReflectiveMethod. ! ! !PersephoneTest methodsFor: 'tests' stamp: 'md 3/1/2007 20:51'! testRecompileInValid "When we compile a new method, this will be a RefectiveMethod" PersephoneExample compileAll. self assert: (PersephoneExample>>#exampleSimple) isReflectiveMethod. self assert: (PersephoneExample>>#exampleSimple) isInvalid. PersephoneExample new exampleSimple. self assert: (PersephoneExample>>#exampleSimple) isCompiledMethod. self assert: (PersephoneExample>>#exampleSimple) isInvalid not. PersephoneExample compileAll. self assert: (PersephoneExample>>#exampleSimple) isReflectiveMethod. self assert: (PersephoneExample>>#exampleSimple) isInvalid. ! ! !PersephoneTest methodsFor: 'tests - literalCollector' stamp: 'md 4/16/2007 21:17'! testSimple | collector | collector := PELiteralCollector new visitNode: (PersephoneExample>>#exampleSend) methodNode. self assert: collector literals =#(1 sin). ! ! !RenameTemporaryRefactoring methodsFor: '*persephone' stamp: 'pmm 8/1/2005 11:43'! newName: aString newName := aString! ! !RenameTemporaryRefactoring methodsFor: '*persephone' stamp: 'pmm 8/1/2005 11:43'! oldName: aString oldName := aString! ! !ClassDescription methodsFor: '*persephone' stamp: 'md 3/5/2007 15:44'! methods ^methodDict values! ! RBFormatter subclass: #PEFormatter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Visitors'! !PEFormatter methodsFor: 'testing' stamp: 'md 4/13/2007 15:31'! needsAnnotaionParenthesisFor: aNode aNode isVariable ifTrue: [ ^false ]. aNode isLiteral ifTrue: [ ^false ]. aNode isMethod ifTrue: [ ^false ]. aNode hasVisibleAnnotations ifFalse: [ ^false ]. ^aNode isMessage or: [ aNode isSequence ] or: [ aNode isAssignment ]! ! !PEFormatter methodsFor: 'testing' stamp: 'pmm 6/7/2006 09:32'! needsParenthesisFor: aNode ^(super needsParenthesisFor: aNode) or: [ self needsAnnotaionParenthesisFor: aNode ]! ! !PEFormatter methodsFor: 'private' stamp: 'pmm 10/10/2005 10:53'! numberOfClosingParenthesisFor: aNode ^(self needsParenthesisFor: aNode) ifTrue: [ 1 ] ifFalse: [ 0 ]! ! !PEFormatter methodsFor: 'private' stamp: 'pmm 6/7/2006 09:33'! numberOfOpeningParenthesisFor: aNode ^(self needsParenthesisFor: aNode) ifFalse: [ 0 ] ifTrue: [ (self needsAnnotaionParenthesisFor: aNode) ifTrue: [ 2 ] ifFalse: [ 1 ] ]! ! !PEFormatter methodsFor: 'private' stamp: 'pmm 6/7/2006 09:35'! printAnnotation: anAnnotaion value: anObject | key | key := anAnnotaion key. codeStream nextPutAll: '<:'. anAnnotaion ifUnary: [ self printUnaryAnnotationNamed: key ] ifBinary: [ self printBinaryAnnotationNamed: key value: anObject ] ifKeyword: [ self printKeywordAnnotationNamed: key value: anObject ]. codeStream nextPutAll: ' :>'.! ! !PEFormatter methodsFor: 'private' stamp: 'pmm 9/22/2005 11:33'! printBinaryAnnotationNamed: aString value: aNode | parenthesis | codeStream nextPutAll: aString; nextPut: Character space. self flag: #todo. "better check if parantessis are needed" parenthesis := true. parenthesis ifTrue: [codeStream nextPut: $(]. self visitNode: aNode. parenthesis ifTrue: [codeStream nextPut: $) ]! ! !PEFormatter methodsFor: 'private' stamp: 'pmm 9/22/2005 11:32'! printKeywordAnnotationNamed: aString value: aCollection | words node parenthesis | words := aString subStrings: #($:). words withIndexDo: [ :each :index | codeStream nextPutAll: each; nextPut: $:; nextPut: Character space. node := aCollection at: index. self flag: #todo. "better check if parantessis are needed" parenthesis := true. parenthesis ifTrue: [codeStream nextPut: $(]. self visitNode: node. parenthesis ifTrue: [codeStream nextPut: $) ] ]! ! !PEFormatter methodsFor: 'private' stamp: 'pmm 8/27/2005 17:10'! printUnaryAnnotationNamed: aString codeStream nextPutAll: aString.! ! !PEFormatter methodsFor: 'private' stamp: 'pmm 6/7/2006 17:57'! processAnnotaionsOf: aNode aNode sourceVisibleAnnotationsDo: [ :each | each do: [ :value | self printAnnotation: each value: value ] ]. (self needsAnnotaionParenthesisFor: aNode) ifTrue: [ codeStream nextPut: $) ].! ! !PEFormatter methodsFor: 'private' stamp: 'pmm 10/9/2005 22:42'! visitNode: aNode (self numberOfOpeningParenthesisFor: aNode) timesRepeat: [codeStream nextPut: $(]. aNode acceptVisitor: self. (self numberOfClosingParenthesisFor: aNode) timesRepeat: [codeStream nextPut: $)]. self processAnnotaionsOf: aNode. ! ! !RBFormatter methodsFor: '*persephone' stamp: 'pmm 6/25/2006 15:32'! acceptObjectLiteralNode: anObjectLiteralNode codeStream space. codeStream nextPutAll: anObjectLiteralNode formattedCode! ! Recompiler subclass: #PERecompiler instanceVariableNames: 'stream' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Compiler'! !PERecompiler commentStamp: 'md 3/31/2007 19:11' prior: 0! [PERecompiler new inspect; recompileImage] forkAt: 30! !PERecompiler methodsFor: 'recompile' stamp: 'md 4/14/2007 10:14'! recompile: selector in: class "Recompile method in class. If method can't be recompiled (because of compile error) add it to problemMethods with general reason" | source oldMethod trailer methodNode newMethod | oldMethod := class compiledMethodAt: selector. source := class sourceCodeAt: selector. source ifNil: [^ self problem: 'no source' sel: selector in: class]. trailer := oldMethod trailer. methodNode := PECompiler new compile: source in: class notifying: self ifFail: [^ self problem: 'syntax error' sel: selector in: class]. selector == methodNode selector ifFalse: [ ^ self problem: 'selector changed' sel: selector in: class]. newMethod := methodNode generate: trailer. methodNode prepareForStorage. methodNode reflectiveMethod classBinding: class binding. methodNode properties: newMethod compiledMethod properties. class addSelectorSilently: selector withMethod: newMethod compiledMethod.! ! RBVariableNode subclass: #RBGlobalVariableNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Parsing'! !RBGlobalVariableNode methodsFor: 'testing' stamp: 'md 3/30/2007 09:57'! isGlobal ^true! ! !RBGlobalVariableNode methodsFor: 'testing' stamp: 'md 3/30/2007 09:57'! isInstance ^false! ! !RBGlobalVariableNode methodsFor: 'testing' stamp: 'md 3/30/2007 09:57'! isTemp ^false! ! RBVariableNode subclass: #RBInstanceVariableNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Parsing'! !RBInstanceVariableNode methodsFor: 'testing' stamp: 'md 3/30/2007 09:56'! isGlobal ^false! ! !RBInstanceVariableNode methodsFor: 'testing' stamp: 'md 3/30/2007 09:56'! isInstance ^true! ! !RBInstanceVariableNode methodsFor: 'testing' stamp: 'md 3/30/2007 09:56'! isTemp ^false! ! RBVariableNode subclass: #RBTempVariableNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Parsing'! !RBTempVariableNode methodsFor: 'testing' stamp: 'md 3/30/2007 09:55'! isGlobal ^false! ! !RBTempVariableNode methodsFor: 'testing' stamp: 'md 3/30/2007 09:55'! isInstance ^false! ! !RBTempVariableNode methodsFor: 'testing' stamp: 'md 3/30/2007 09:55'! isTemp ^true! ! !RBVariableNode methodsFor: '*persephone' stamp: 'pmm 6/12/2006 20:23'! ifTemp: aTempBlock ifInstance: anInstanceBlock ifGlobal: aGlobalBlock ^self isTemp ifTrue: aTempBlock ifFalse: [ self isInstance ifTrue: anInstanceBlock ifFalse: aGlobalBlock ]! ! !TraitBehavior methodsFor: '*persephone-override' stamp: 'md 3/31/2007 19:13'! compilerClass "Answer a compiler class appropriate for source methods of this class." ^(Preferences compileReflectiveMethods) ifTrue: [PECompiler] ifFalse: [Compiler]. ! ! !Collection methodsFor: '*persephone' stamp: 'pmm 9/27/2006 14:45'! addToSequence: aSequenceNode self do: [ :each | each isSequence ifTrue: [ aSequenceNode addNodes: each statements ] ifFalse: [ aSequenceNode addNode: each ] ].! ! !Collection methodsFor: '*persephone' stamp: 'pmm 7/23/2006 21:50'! asAstArrayNode ^RBArrayNode statements: (self collect: [ :each | each copy ])! ! !Collection methodsFor: '*persephone' stamp: 'pmm 7/22/2006 13:39'! asAstSquenceNode | sequence | sequence := RBSequenceNode statements: OrderedCollection new. self addToSequence: sequence. ^sequence! ! !Metaclass methodsFor: '*persephone' stamp: 'pmm 2/14/2007 21:25'! compilerClass ^ self instanceSide compilerClass! ! !RBMessageNode class methodsFor: '*persephone' stamp: 'pmm 8/19/2006 13:33'! receiver: aValueNode selector: aSymbol argument: anotherValueNodes ^self receiver: aValueNode selector: aSymbol arguments: (Array with: anotherValueNodes) ! ! !RBMessageNode methodsFor: '*persephone' stamp: 'pmm 11/4/2006 18:42'! doNotInline self addAnnotation: (ProgrammaticNoInlineAnnotation new key: NoInlineAnnotation key; yourself)! ! !RBMessageNode methodsFor: '*persephone' stamp: 'md 4/14/2007 01:57'! numArgs ^self arguments size! ! SqueakParser subclass: #PESqueakParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Parsing'! !PESqueakParser class methodsFor: 'generated-comments' stamp: 'md 4/7/2007 11:33'! parserDefinitionComment "%id ; %start Sequence MethodPattern; %left Primary; %left Expression; Method: MethodPattern Sequence {#method:} | MethodPattern Pragmas Sequence {#methodPragma:} | MethodPattern Pragmas Temporaries Pragmas Statements {#methodPragmaTempsPragma:} | MethodPattern Temporaries Pragmas Statements {#methodTempsPragma:}; MethodPattern: {#unaryMessage:} | AnnotatedVariable {#messagePart:} | error {#argumentNameMissing:} | KeywordMethodPattern {#first:}; KeywordMethodPattern: AnnotatedVariable {#messagePart:} | error {#argumentNameMissing:} | KeywordMethodPattern AnnotatedVariable {#addMessagePart:} | KeywordMethodPattern error {#argumentNameMissing:}; Pragmas: ""<"" PragmaMessage "">"" {#pragma:} | ""<"" PragmaMessage error {#pragmaEndMissing:} | ""<"" error {#pragmaMissing:} | Pragmas ""<"" PragmaMessage "">"" {#pragmas:} | Pragmas ""<"" PragmaMessage error {#pragmaEndMissing:} | Pragmas ""<"" error {#pragmaMissing:}; Sequence: Statements {#sequence:} | Temporaries Statements {#sequenceWithTemps:}; Temporaries: ""||"" {#arrayAddToken:} | ""|"" TemporaryVariables ""|"" {#secondAddToken:} | ""|"" TemporaryVariables error {#verticalBarMissing:}; TemporaryVariables: {#array} | TemporaryVariables AnnotatedVariable {#add:}; AnnotatedVariable: Variable Annotation* {#annotation:}; Statements: {#array} | StatementList ? {#first:} | StatementList ""^"" Expression ? {#returnAdd:} | ""^"" Expression ? {#return:}; StatementList: Expression {#firstIn:} | StatementList Expression {#add3:}; Block: ""["" BlockArgs ""|"" Sequence {#blockWithArgs:} | ""["" Sequence {#blockNoArgs:} | ""["" BlockArgs {#blockArgs:} | ""["" BlockArgs ""||"" TemporaryVariables ""|"" Statements {#blockWithTemps:}; BlockArgs: AnnotatedVariable {#secondIn:} | error {#argumentNameMissing:} | BlockArgs AnnotatedVariable {#add3:} | BlockArgs error {#argumentNameMissing:}; Annotation: ""<:"" KeywordMessage "":>"" {#keywordAnnotation:} | ""<:"" UnaryMessage "":>"" {#unaryAnnotation:}; Expression: Assignment {#first:} | Cascade {#first:} | Primary Annotation* {#annotation:}; Primary: ""("" Expression {#secondPutToken:} | Array {#first:} | Block {#first:} | Literal {#first:} | Variable {#first:}; Assignment: Variable Expression {#assignment:} | Variable error {#expressionMissing:}; Cascade: MessageSend {#first:} | Cascade Message {#cascade:} | Cascade error {#cascadeMMissing:}; MessageSend: KeywordMessageSend {#first:} | BinaryMessageSend {#first:} | UnaryMessageSend {#first:}; Message: UnaryMessage {#first:} | BinaryMessage {#first:} | KeywordMessage {#first:}; KeywordMessageSend: BinaryMessageSend KeywordMessage {#messageSend:} | UnaryMessageSend KeywordMessage {#messageSend:} | Primary KeywordMessage {#messageSend:}; KeywordMessage: KeywordArgument {#messagePart:} | error {#argumentMissing:} | KeywordMessage KeywordArgument {#addMessagePart:} | KeywordMessage error {#argumentMissing:}; KeywordArgument: BinaryMessageSend {#first:} | UnaryMessageSend {#first:} | Primary {#first:}; BinaryMessageSend: BinaryMessageSend BinaryMessage {#messageSend:} | UnaryMessageSend BinaryMessage {#messageSend:} | Primary BinaryMessage {#messageSend:}; BinaryMessage : BinaryArgument {#messagePart:} | error {#argumentMissing:}; BinaryArgument: UnaryMessageSend {#first:} | Primary {#first:}; UnaryMessageSend : UnaryMessageSend UnaryMessage {#messageSend:} | Primary UnaryMessage {#messageSend:}; UnaryMessage : {#unaryMessage:}; Array: ""{"" Statements {#array:}; Variable: {#variable:}; Literal: ""true"" {#litTrue:} | ""false"" {#litFalse:} | ""nil"" {#litNil:} | {#litNumber:} | {#litNumber:} | {#litChar:} | {#litString:} | ""#"" {#litStringSymbol:} | ""#"" {#litSymbol:} | ""#"" {#litSymbol:} | ""#"" {#litSymbol:} | ""#"" {#litSymbol:} | ""#"" {#litSymbol:} | ""#"" ""["" ByteArray {#litArray:} | ""#"" ""("" LiteralArray {#litArray:} | ""#:"" {#litString:}; ByteArray: {#byteStream} | ByteArray {#byteStreamPut:}; LiteralArray: {#stream} | LiteralArray ArrayLiteral {#streamPut:}; ArrayLiteral: Literal {#value:} | {#valueSymbol:} | {#valueSymbol:} | {#valueSymbol:} | {#valueSymbol:} | {#valueSymbol:} | ""("" LiteralArray {#contents2:} | ""["" ByteArray {#contents2:} | {#valueSymbol:}; PragmaMessage: Apicall {#messagePragma:} | Primitive {#messagePragma:} | MessagePragma {#messagePragma:}; MessagePragma: KeyWordMessagePragma {#pragmaMessage:} | BinaryMessagePragma {#pragmaMessage:} | UnaryMessage {#pragmaUnaryMessage:}; BinaryMessagePragma: PrimaryPragma {#messagePart:} | error {#argumentMissing:}; KeyWordMessagePragma: PrimaryPragma {#messagePart:} | error {#literalMissing:} | KeywordMessage PrimaryPragma {#addMessagePart:} | KeywordMessage error {#literalMissing:}; PrimaryPragma: Array {#first:} | Block {#first:} | Literal {#first:} | Variable {#first:}; Apicall: TypeCall ExternalType IndexName ""("" ParameterApicall {#externalCall:} | TypeCall ExternalType IndexName ""("" ParameterApicall ""module:"" {#externalModuleCall:}; IndexName: {#externalFunction:} | {#externalIndex:}; TypeCall: ""apicall:"" {#callConvention:} | ""cdecl:"" {#callConvention:}; ParameterApicall: ExternalType {#parameterExtCall:} | ParameterApicall ExternalType {#parametersExtCall:}; ExternalType: {#externalType:} | ""*"" {#externalTypePointer:}; Primitive: ""primitive:"" {#primitiveString:} | ""primitive:"" {#primitiveNumber:} | ""primitive:"" error {#primitiveArgMissing:} | ""primitive:"" ""module:"" {#primitiveModule:} | ""primitive:"" ""module:"" error {#moduleArgMissing:}; "! ! !PESqueakParser class methodsFor: 'generated-accessing' stamp: 'md 4/7/2007 11:33'! scannerClass ^PESqueakScanner! ! !PESqueakParser class methodsFor: 'generated-starting states' stamp: 'md 4/7/2007 11:33'! startingStateForMethod ^1! ! !PESqueakParser class methodsFor: 'generated-starting states' stamp: 'md 4/7/2007 11:33'! startingStateForMethodPattern ^3! ! !PESqueakParser class methodsFor: 'generated-starting states' stamp: 'md 4/7/2007 11:33'! startingStateForSequence ^2! ! !PESqueakParser methodsFor: 'reduction actions' stamp: 'pmm 6/9/2006 13:23'! annotation: nodes | node annoations | (nodes size = 1) ifTrue: [^ nodes first]. nodes second isNil ifTrue: [^ nodes first]. node := nodes first. annoations := nodes second. self flag: #todo. "think about mulivalued annotations" annoations do: [ :each | node addAnnotation: each ]. ^node! ! !PESqueakParser methodsFor: 'examples' stamp: 'pmm 6/7/2006 08:37'! exampleCode ^ 'exampleUnknown: anArgument <: noInline :> | unknown <: noInline :> | 1 to: 5 do: [ :each <: noInline :> | Transcript show: each ]. unknown := Unknown basicNew. (unknown ifTrue: [^ false] ifFalse: [^ false]) <: noInline :> . ^ true'! ! !PESqueakParser methodsFor: 'reduction actions' stamp: 'pmm 6/9/2006 13:23'! keywordAnnotation: nodes | selector values | selector := String streamContents: [ :stream | nodes second first do: [ :each | stream nextPutAll: each value ] ]. self flag: #todo. "think about annotations with two arguments" values := nodes second second. ^Annotation forKey: selector asSymbol values: values! ! !PESqueakParser methodsFor: 'reduction actions' stamp: 'md 3/31/2007 18:58'! method: nodes ^ PEReflectiveMethodNode new selectorParts: nodes first first arguments: nodes first last; body: nodes second; yourself! ! !PESqueakParser methodsFor: 'reduction actions' stamp: 'md 3/31/2007 18:58'! methodPragma: nodes ^PEReflectiveMethodNode new selectorParts: nodes first first arguments: nodes first last; body: nodes third; pragmas: nodes second; yourself! ! !PESqueakParser methodsFor: 'reduction actions' stamp: 'md 3/31/2007 18:58'! methodPragmaTempsPragma: nodes | sequence | sequence := (RBSequenceNode temporaries: nodes third first statements: nodes fifth) firstToken: nodes third second; yourself. nodes fifth isEmpty ifFalse: [ sequence lastToken: nodes third third ]. ^ PEReflectiveMethodNode new selectorParts: nodes first first arguments: nodes first last; body: sequence; pragmas: (nodes second addAll: nodes fourth; yourself)! ! !PESqueakParser methodsFor: 'reduction actions' stamp: 'md 3/31/2007 18:58'! methodTempsPragma: nodes | sequence | sequence := (RBSequenceNode temporaries: nodes second first statements: nodes fourth) firstToken: nodes second second; yourself. nodes fourth isEmpty ifFalse: [ sequence lastToken: nodes second third ]. ^ PEReflectiveMethodNode new selectorParts: nodes first first arguments: nodes first last; body: sequence; pragmas: nodes third! ! !PESqueakParser methodsFor: 'generated-reduction actions' stamp: 'md 4/7/2007 11:33'! reduceActionForOptionalXXXperiodX1: nodes ^ nil! ! !PESqueakParser methodsFor: 'generated-reduction actions' stamp: 'md 4/7/2007 11:33'! reduceActionForOptionalXXXperiodX2: nodes ^ nodes at: 1! ! !PESqueakParser methodsFor: 'generated-reduction actions' stamp: 'md 4/7/2007 11:33'! reduceActionForRepeatXXAnnotation1: nodes ^ OrderedCollection new! ! !PESqueakParser methodsFor: 'generated-reduction actions' stamp: 'md 4/7/2007 11:33'! reduceActionForRepeatXXAnnotation2: nodes ^ (nodes at: 1) add: (nodes at: 2); yourself! ! !PESqueakParser methodsFor: 'generated-tables' stamp: 'md 4/7/2007 11:33'! reduceTable ^#( #(41 0 #array) #(41 2 #first:) #(41 5 #returnAdd:) #(41 3 #return:) #(42 2 #method:) #(42 3 #methodPragma:) #(42 5 #methodPragmaTempsPragma:) #(42 4 #methodTempsPragma:) #(43 1 #reduceFor:) #(44 2 #annotation:) #(45 3 #pragma:) #(45 3 #pragmaEndMissing:) #(45 2 #pragmaMissing:) #(45 4 #pragmas:) #(45 4 #pragmaEndMissing:) #(45 3 #pragmaMissing:) #(46 1 #messagePragma:) #(46 1 #messagePragma:) #(46 1 #messagePragma:) #(47 0 #array) #(47 2 #add:) #(48 1 #variable:) #(49 3 #keywordAnnotation:) #(49 3 #unaryAnnotation:) #(50 0 #reduceActionForRepeatXXAnnotation1:) #(50 2 #reduceActionForRepeatXXAnnotation2:) #(51 1 #firstIn:) #(51 3 #add3:) #(52 0 #reduceActionForOptionalXXXperiodX1:) #(52 1 #reduceActionForOptionalXXXperiodX2:) #(53 2 #secondIn:) #(53 2 #argumentNameMissing:) #(53 3 #add3:) #(53 3 #argumentNameMissing:) #(54 5 #blockWithArgs:) #(54 3 #blockNoArgs:) #(54 3 #blockArgs:) #(54 7 #blockWithTemps:) #(55 2 #messagePart:) #(55 2 #argumentMissing:) #(55 3 #addMessagePart:) #(55 3 #argumentMissing:) #(56 1 #unaryMessage:) #(57 3 #assignment:) #(57 3 #expressionMissing:) #(58 1 #first:) #(58 3 #cascade:) #(58 3 #cascadeMMissing:) #(59 3 #array:) #(60 1 #sequence:) #(60 2 #sequenceWithTemps:) #(61 1 #first:) #(61 1 #first:) #(61 2 #annotation:) #(62 1 #unaryMessage:) #(62 2 #messagePart:) #(62 2 #argumentNameMissing:) #(62 1 #first:) #(63 1 #first:) #(63 1 #first:) #(63 1 #first:) #(64 2 #messageSend:) #(64 2 #messageSend:) #(64 2 #messageSend:) #(65 2 #messageSend:) #(65 2 #messageSend:) #(65 2 #messageSend:) #(66 2 #messageSend:) #(66 2 #messageSend:) #(67 2 #messagePart:) #(67 2 #argumentMissing:) #(68 1 #first:) #(68 1 #first:) #(68 1 #first:) #(69 1 #first:) #(69 1 #first:) #(70 3 #secondPutToken:) #(70 1 #first:) #(70 1 #first:) #(70 1 #first:) #(70 1 #first:) #(71 0 #byteStream) #(71 2 #byteStreamPut:) #(72 0 #stream) #(72 2 #streamPut:) #(73 1 #value:) #(73 1 #valueSymbol:) #(73 1 #valueSymbol:) #(73 1 #valueSymbol:) #(73 1 #valueSymbol:) #(73 1 #valueSymbol:) #(73 3 #contents2:) #(73 3 #contents2:) #(73 1 #valueSymbol:) #(74 1 #arrayAddToken:) #(74 3 #secondAddToken:) #(74 3 #verticalBarMissing:) #(75 6 #externalCall:) #(75 8 #externalModuleCall:) #(76 2 #primitiveString:) #(76 2 #primitiveNumber:) #(76 2 #primitiveArgMissing:) #(76 4 #primitiveModule:) #(76 4 #moduleArgMissing:) #(77 1 #pragmaMessage:) #(77 1 #pragmaMessage:) #(77 1 #pragmaUnaryMessage:) #(78 2 #messagePart:) #(78 2 #literalMissing:) #(78 3 #addMessagePart:) #(78 3 #literalMissing:) #(79 2 #messagePart:) #(79 2 #argumentMissing:) #(80 1 #first:) #(80 1 #first:) #(80 1 #first:) #(80 1 #first:) #(81 1 #callConvention:) #(81 1 #callConvention:) #(82 1 #externalType:) #(82 2 #externalTypePointer:) #(83 1 #externalFunction:) #(83 1 #externalIndex:) #(84 1 #parameterExtCall:) #(84 2 #parametersExtCall:) #(87 1 #first:) #(87 1 #first:) #(87 1 #first:) #(88 1 #litTrue:) #(88 1 #litFalse:) #(88 1 #litNil:) #(88 1 #litNumber:) #(88 1 #litNumber:) #(88 1 #litChar:) #(88 1 #litString:) #(88 2 #litStringSymbol:) #(88 2 #litSymbol:) #(88 2 #litSymbol:) #(88 2 #litSymbol:) #(88 2 #litSymbol:) #(88 2 #litSymbol:) #(88 4 #litArray:) #(88 4 #litArray:) #(88 1 #litString:) #(89 2 #messagePart:) #(89 2 #argumentNameMissing:) #(89 3 #addMessagePart:) #(89 3 #argumentNameMissing:) )! ! !PESqueakParser methodsFor: 'generated-tables' stamp: 'md 4/7/2007 11:33'! transitionTable ^#( #(3 17 24 21 25 25 27 29 42 33 62 37 89) #(3 41 1 45 4 49 8 53 9 57 10 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 105 41 109 48 113 51 117 54 121 57 125 58 129 59 133 60 137 61 141 64 145 65 149 66 153 70 157 74 6 85 161 87 165 88) #(3 17 24 21 25 25 27 169 62 37 89) #(2 222 1 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 32 85) #(3 97 24 173 44 177 48 181 86) #(3 97 24 185 44 177 48 189 86) #(2 0 85) #(3 41 1 45 4 193 6 49 8 53 9 57 10 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 105 41 197 45 109 48 113 51 117 54 121 57 125 58 129 59 201 60 137 61 141 64 145 65 149 66 153 70 205 74 6 85 161 87 165 88) #(3 234 1 234 4 234 6 234 8 234 9 234 10 234 11 234 14 234 17 234 18 234 19 234 20 234 21 234 22 234 23 234 24 209 25 234 32 234 85) #(3 41 1 45 4 49 8 53 9 57 10 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 6 35 213 38 105 41 109 48 113 51 217 53 117 54 121 57 125 58 129 59 221 60 137 61 141 64 145 65 149 66 153 70 157 74 161 87 165 88) #(3 82 4 82 24 225 47 82 86) #(3 41 1 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 109 48 117 54 121 57 125 58 129 59 229 61 141 64 145 65 149 66 153 70 161 87 165 88) #(3 41 1 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 109 48 117 54 121 57 125 58 129 59 233 61 141 64 145 65 149 66 153 70 161 87 165 88) #(2 382 1 6 8 9 11 14 17 18 19 20 21 22 23 24 32 35 85) #(3 41 1 49 8 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 6 36 237 41 109 48 113 51 117 54 121 57 125 58 129 59 137 61 141 64 145 65 149 66 153 70 161 87 165 88) #(2 518 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(2 578 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(2 522 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(2 526 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(3 241 1 245 9 249 23 253 24 257 25 261 26 265 27 269 29) #(2 530 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(2 534 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(2 542 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(2 90 1 2 4 5 6 7 8 9 10 11 14 17 18 19 20 21 22 23 24 25 27 28 32 33 35 36 37 38 39 85 86) #(2 538 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(2 202 35 85) #(3 326 2 326 24 326 25 326 27 273 28 326 33 326 35 326 36 326 37 326 85) #(3 277 33 118 35 118 36 281 52 118 85) #(2 318 2 5 24 25 27 33 35 36 37 39 85) #(2 210 33 35 36 37 85) #(3 214 33 214 35 214 36 214 37 285 39 214 85) #(2 314 2 5 24 25 27 33 35 36 37 39 85) #(2 0 85) #(2 110 33 35 36 85) #(2 506 33 35 36 37 39 85) #(3 289 25 293 27 510 33 510 35 510 36 510 37 510 39 297 55 301 67 510 85) #(3 305 24 289 25 293 27 514 33 514 35 514 36 514 37 514 39 309 55 313 56 317 67 514 85) #(3 102 2 305 24 289 25 293 27 102 33 102 35 102 36 102 37 321 50 325 55 329 56 333 67 102 85) #(3 41 1 49 8 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 6 35 337 41 109 48 113 51 117 54 121 57 125 58 129 59 137 61 141 64 145 65 149 66 153 70 6 85 161 87 165 88) #(2 186 33 35 36 37 39 85) #(2 322 2 5 24 25 27 33 35 36 37 39 85) #(2 0 85) #(2 582 1 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 25 32 85) #(3 102 1 102 2 102 4 102 6 102 8 102 9 102 10 102 11 102 14 102 17 102 18 102 19 102 20 102 21 102 22 102 23 102 24 102 25 102 32 102 35 102 38 341 50 102 85 102 86) #(2 586 1 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 25 32 85) #(2 226 1 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 32 85) #(2 230 1 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 32 85) #(3 345 3 349 12 353 13 305 24 357 25 361 27 365 46 369 55 373 56 377 75 381 76 385 77 389 78 393 79 397 81 401 86) #(3 41 1 45 4 405 6 49 8 53 9 57 10 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 105 41 109 48 113 51 117 54 121 57 125 58 129 59 409 60 137 61 141 64 145 65 149 66 153 70 413 74 6 85 161 87 165 88) #(2 22 85) #(3 41 1 193 6 49 8 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 337 41 417 45 109 48 113 51 117 54 121 57 125 58 129 59 137 61 141 64 145 65 149 66 153 70 6 85 161 87 165 88) #(3 97 24 421 44 177 48 425 86) #(3 97 24 429 44 177 48 433 86) #(3 437 4 441 10 445 35 449 38) #(2 453 35) #(3 457 4 97 24 461 44 177 48 465 86) #(3 469 33 118 35 118 36 473 52 118 85) #(2 477 37) #(2 481 36) #(3 330 21 330 35 485 71) #(3 338 1 338 9 338 14 338 17 338 18 338 19 338 20 338 21 338 22 338 23 338 24 338 25 338 26 338 27 338 29 338 32 338 37 338 40 489 72) #(2 546 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(2 550 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(2 558 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(2 562 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(2 554 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(2 566 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(3 41 1 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 109 48 117 54 121 57 125 58 129 59 493 61 141 64 145 65 149 66 153 70 497 86 161 87 165 88) #(3 41 1 501 8 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 122 35 122 36 109 48 117 54 121 57 125 58 129 59 505 61 141 64 145 65 149 66 153 70 122 85 161 87 165 88) #(2 10 35 36 85) #(3 305 24 289 25 293 27 509 55 513 56 517 63 521 67 525 86) #(3 41 1 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 529 48 117 54 129 59 533 65 537 66 541 68 545 70 549 86 165 88) #(3 41 1 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 529 48 117 54 129 59 553 66 557 69 561 70 565 86 165 88) #(3 569 25 250 33 250 35 250 36 250 37 250 39 250 85) #(2 262 5 25 27 33 35 36 37 39 85) #(2 174 5 7 24 25 27 33 35 36 37 39 85 86) #(3 569 25 254 33 254 35 254 36 254 37 254 39 254 85) #(2 274 5 24 25 27 33 35 36 37 39 85) #(2 266 5 25 27 33 35 36 37 39 85) #(3 573 2 218 33 218 35 218 36 218 37 577 49 218 85) #(3 569 25 258 33 258 35 258 36 258 37 258 39 258 85) #(2 278 5 24 25 27 33 35 36 37 39 85) #(2 270 5 25 27 33 35 36 37 39 85) #(2 206 35 85) #(3 42 1 573 2 42 4 42 6 42 8 42 9 42 10 42 11 42 14 42 17 42 18 42 19 42 20 42 21 42 22 42 23 42 24 42 25 42 32 42 35 42 38 577 49 42 85 42 86) #(3 581 21 585 23 589 86) #(2 474 24) #(2 478 24) #(3 41 1 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 593 48 597 54 601 59 533 65 537 66 541 68 545 70 605 80 609 86 613 88) #(3 41 1 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 617 48 621 54 625 59 629 80 633 86 637 88) #(3 641 7 645 86) #(2 649 25) #(2 430 7 86) #(2 70 7 86) #(2 74 7 86) #(2 78 7 86) #(2 422 7 86) #(2 426 7 86) #(3 653 24 657 82) #(2 54 1 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 32 85) #(3 345 3 349 12 353 13 305 24 357 25 361 27 661 46 369 55 373 56 377 75 381 76 385 77 389 78 393 79 397 81 665 86) #(2 26 85) #(3 41 1 193 6 49 8 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 337 41 669 45 109 48 113 51 117 54 121 57 125 58 129 59 137 61 141 64 145 65 149 66 153 70 6 85 161 87 165 88) #(3 41 1 405 6 49 8 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 673 41 109 48 113 51 117 54 121 57 125 58 129 59 137 61 141 64 145 65 149 66 153 70 6 85 161 87 165 88) #(2 590 1 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 25 32 85) #(2 594 1 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 25 32 85) #(2 126 4 10 35 38) #(2 130 4 10 35 38) #(3 41 1 45 4 49 8 53 9 57 10 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 6 35 105 41 109 48 113 51 117 54 121 57 125 58 129 59 677 60 137 61 141 64 145 65 149 66 153 70 157 74 161 87 165 88) #(3 82 4 82 24 681 47) #(2 150 2 5 7 24 25 27 33 35 36 37 39 85 86) #(3 97 24 685 44 177 48 689 86) #(2 146 2 5 7 24 25 27 33 35 36 37 39 85 86) #(2 386 1 6 8 9 11 14 17 18 19 20 21 22 23 24 32 35 85) #(2 86 4 24 86) #(2 390 1 6 8 9 11 14 17 18 19 20 21 22 23 24 32 35 85) #(2 122 35 36 85) #(2 18 35 36 85) #(2 310 2 5 24 25 27 33 35 36 37 39 85) #(2 198 2 5 7 24 25 27 33 35 36 37 39 85 86) #(3 693 21 697 35) #(3 701 1 705 9 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 709 24 713 25 717 26 721 27 725 29 101 32 729 37 733 40 737 73 741 88) #(2 178 33 35 36 37 85) #(2 182 33 35 36 37 85) #(3 41 1 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 109 48 117 54 121 57 125 58 129 59 745 61 141 64 145 65 149 66 153 70 161 87 165 88) #(2 114 33 35 36 85) #(3 569 25 246 33 246 35 246 36 246 37 246 39 246 85) #(2 238 33 35 36 37 39 85) #(2 190 33 35 36 37 39 85) #(2 242 33 35 36 37 39 85) #(2 194 33 35 36 37 39 85) #(2 326 5 24 25 27 33 35 36 37 39 85) #(3 290 5 290 25 293 27 290 33 290 35 290 36 290 37 290 39 301 67 290 85) #(3 294 5 305 24 294 25 293 27 294 33 294 35 294 36 294 37 294 39 313 56 317 67 294 85) #(2 158 5 25 33 35 36 37 39 85) #(3 298 5 305 24 298 25 293 27 298 33 298 35 298 36 298 37 298 39 329 56 333 67 298 85) #(2 162 5 25 33 35 36 37 39 85) #(3 302 5 305 24 302 25 302 27 302 33 302 35 302 36 302 37 302 39 313 56 302 85) #(2 282 5 25 27 33 35 36 37 39 85) #(3 306 5 305 24 306 25 306 27 306 33 306 35 306 36 306 37 306 39 329 56 306 85) #(2 286 5 25 27 33 35 36 37 39 85) #(3 41 1 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 529 48 117 54 129 59 533 65 537 66 749 68 545 70 753 86 165 88) #(3 305 24 289 25 757 55 761 56) #(2 106 1 2 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 25 32 33 35 36 37 38 85 86) #(2 406 7 86) #(3 402 7 765 15 402 86) #(2 410 7 86) #(3 470 7 326 24 326 25 326 27 470 86) #(3 462 7 318 24 318 25 318 27 462 86) #(3 458 7 314 24 314 25 314 27 458 86) #(2 434 7 86) #(3 438 7 162 25 438 86) #(3 466 7 322 24 322 25 322 27 466 86) #(2 470 7 86) #(2 462 7 86) #(2 458 7 86) #(2 450 7 86) #(2 454 7 86) #(2 466 7 86) #(2 46 1 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 32 85) #(2 50 1 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 32 85) #(3 41 1 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 593 48 597 54 601 59 533 65 537 66 749 68 545 70 769 80 773 86 613 88) #(3 777 16 482 21 482 23 482 24 482 37) #(3 781 21 785 23 789 83) #(3 793 7 797 86) #(2 66 1 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 32 85) #(3 41 1 405 6 49 8 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 801 41 109 48 113 51 117 54 121 57 125 58 129 59 137 61 141 64 145 65 149 66 153 70 6 85 161 87 165 88) #(2 34 85) #(2 805 35) #(3 809 4 97 24 461 44 177 48) #(2 134 4 10 35 38) #(2 138 4 10 35 38) #(2 334 21 35) #(2 570 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(3 330 21 330 35 813 71) #(3 338 1 338 9 338 14 338 17 338 18 338 19 338 20 338 21 338 22 338 23 338 24 338 25 338 26 338 27 338 29 338 32 338 37 338 40 817 72) #(2 350 1 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 37 40) #(2 358 1 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 37 40) #(2 362 1 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 37 40) #(2 354 1 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 37 40) #(2 366 1 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 37 40) #(2 574 1 2 5 7 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 33 35 36 37 39 40 85 86) #(2 378 1 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 37 40) #(2 342 1 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 37 40) #(2 346 1 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 37 40) #(3 469 33 118 35 118 36 821 52 118 85) #(2 166 5 25 33 35 36 37 39 85) #(2 170 5 25 33 35 36 37 39 85) #(3 825 5 569 25) #(2 829 5) #(3 833 23 837 86) #(2 442 7 86) #(3 446 7 170 25 446 86) #(2 486 21 23 24 37) #(2 494 9) #(2 490 9) #(2 841 9) #(2 58 1 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 32 85) #(2 62 1 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 32 85) #(2 30 85) #(2 142 2 5 7 24 25 27 33 35 36 37 39 85 86) #(3 41 1 49 8 53 9 61 11 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 97 24 101 32 6 35 845 41 109 48 113 51 117 54 121 57 125 58 129 59 137 61 141 64 145 65 149 66 153 70 161 87 165 88) #(3 693 21 849 35) #(3 701 1 705 9 65 14 69 17 73 18 77 19 81 20 85 21 89 22 93 23 709 24 713 25 717 26 721 27 725 29 101 32 853 37 733 40 737 73 741 88) #(2 14 35 36 85) #(2 94 1 2 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 25 32 33 35 36 37 38 85 86) #(2 98 1 2 4 6 8 9 10 11 14 17 18 19 20 21 22 23 24 25 32 33 35 36 37 38 85 86) #(2 414 7 86) #(2 418 7 86) #(3 653 24 857 82 861 84) #(2 865 35) #(2 374 1 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 37 40) #(2 370 1 9 14 17 18 19 20 21 22 23 24 25 26 27 29 32 37 40) #(2 498 24 37) #(3 653 24 869 37 873 82) #(2 154 2 5 7 24 25 27 33 35 36 37 39 85 86) #(3 394 7 877 15 394 86) #(2 502 24 37) #(2 881 23) #(2 398 7 86) )! ! !PESqueakParser methodsFor: 'reduction actions' stamp: 'pmm 6/9/2006 10:01'! unaryAnnotation: nodes ^Annotation forKey: (nodes second first first value) asSymbol! ! RBLiteralNode subclass: #PEObjectLiteralNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Parsing'! !PEObjectLiteralNode class methodsFor: 'instance creation' stamp: 'pmm 1/16/2006 10:49'! value: anObject ^(super value: anObject) value: anObject; yourself! ! !PEObjectLiteralNode methodsFor: 'comparing' stamp: 'md 3/31/2007 19:18'! = anObject ^self == anObject or: [ (anObject isKindOf: PEObjectLiteralNode) and: [ self value == anObject value ] ]! ! !PEObjectLiteralNode methodsFor: 'visitor' stamp: 'pmm 6/25/2006 15:29'! acceptVisitor: aProgramNodeVisitor ^aProgramNodeVisitor acceptObjectLiteralNode: self! ! !PEObjectLiteralNode methodsFor: 'accessing' stamp: 'pmm 6/21/2006 15:41'! formattedCode ^self value printString! ! !PEObjectLiteralNode methodsFor: 'accessing' stamp: 'pmm 8/23/2006 15:28'! instrumentedClassname ^'JInstrumentedObjectLiteralNode'! ! !PEObjectLiteralNode methodsFor: 'accessing' stamp: 'pmm 8/6/2006 15:27'! token self shouldNotImplement! ! !PEObjectLiteralNode methodsFor: 'accessing' stamp: 'pmm 1/16/2006 10:48'! value ^value! ! ASTTranslatorForValue subclass: #PEASTTranslatorForValue instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Compiler'! !PEASTTranslatorForValue methodsFor: 'visitor-double dispatching' stamp: 'pmm 7/8/2006 16:18'! acceptInstrumentedVariableNode: aVariableNode self emitBefore: aVariableNode. self acceptVariableNode: aVariableNode. self emitAfter: aVariableNode.! ! !PEASTTranslatorForValue methodsFor: 'visitor-double dispatching' stamp: 'md 4/15/2007 14:36'! acceptMessageNode: aMessageNode | noInline | noInline := aMessageNode hasAnnotation: NoInlineAnnotation key. noInline ifFalse: [ aMessageNode isInlineIf ifTrue: [^ self emitIfNode: aMessageNode]. aMessageNode isInlineIfNil ifTrue: [^ self emitIfNilNode: aMessageNode]. aMessageNode isInlineAndOr ifTrue: [^ self emitAndOrNode: aMessageNode]. aMessageNode isInlineWhile ifTrue: [^ self emitWhileNode: aMessageNode]. aMessageNode isInlineToDo ifTrue: [^ self emitToDoNode: aMessageNode]. aMessageNode isInlineCase ifTrue: [^ self emitCaseNode: aMessageNode]. ]. ^ self emitMessageNode: aMessageNode! ! !String methodsFor: '*persephone' stamp: 'pmm 11/27/2006 16:18'! asVariableNode ^RBVariableNode named: self! ! !String methodsFor: '*persephone' stamp: 'md 3/31/2007 18:48'! nodesForInstrumentation ^(PESqueakParser parseDoIt: self) body statements! ! !TCompilingBehavior methodsFor: '*persephone-override' stamp: 'md 3/31/2007 19:14'! compilerClass "Answer a compiler class appropriate for source methods of this class." ^(Preferences compileReflectiveMethods) ifTrue: [PECompiler] ifFalse: [Compiler]. ! ! !TCompilingBehavior methodsFor: '*persephone-override' stamp: 'md 3/21/2007 14:04'! recompile: selector from: oldClass "Compile the method associated with selector in the receiver's method dictionary." "ar 7/10/1999: Use oldClass compiledMethodAt: not self compiledMethodAt:" | method trailer methodNode rMethod | Preferences compileReflectiveMethods ifTrue: [ self flag: #FIXME. "This needs to be checked and removed". rMethod := (oldClass >> selector) reflectiveMethodOrNil. (rMethod notNil and: [ rMethod hasMethodClass not ]) ifTrue: [ rMethod methodClass: oldClass ]. ]. method _ oldClass compiledMethodAt: selector. trailer _ method trailer. methodNode _ self compilerClass new compile: (oldClass sourceCodeAt: selector) in: self notifying: nil ifFail: [^ self]. "Assume OK after proceed from SyntaxError" selector == methodNode selector ifFalse: [self error: 'selector changed!!']. self basicAddSelector: selector withMethod: (methodNode generate: trailer). ! ! ASTTranslator subclass: #PEASTTranslator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Compiler'! !PEASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'md 3/28/2007 15:21'! acceptMethodNode: aJMethodNode super acceptMethodNode: aJMethodNode! ! !PEASTTranslator methodsFor: 'initialize-release' stamp: 'md 3/31/2007 19:15'! initialize methodBuilder := IRBuilder new. effectTranslator := self as: PEASTTranslatorForEffect. valueTranslator := self as: PEASTTranslatorForValue. effectTranslator instVarNamed: #effectTranslator put: effectTranslator. effectTranslator instVarNamed: #valueTranslator put: valueTranslator. valueTranslator instVarNamed: #valueTranslator put: valueTranslator.! ! !PEASTTranslator methodsFor: 'accessing' stamp: 'pmm 9/19/2005 17:36'! noInlineAnnotationKey ^#noInline! ! !Behavior methodsFor: '*persephone-override' stamp: 'md 3/31/2007 19:13'! compilerClass "Answer a compiler class appropriate for source methods of this class." ^(Preferences compileReflectiveMethods) ifTrue: [PECompiler] ifFalse: [Compiler]. ! ! !Behavior methodsFor: '*persephone' stamp: 'md 4/17/2007 16:54'! invalidateMethods "does not use methodsDo:, as we change the dictionary while iteraring and thus need a copy, which #methods will provide" self methods do: [:each | each invalidate].! ! !Behavior methodsFor: '*persephone-override' stamp: 'md 3/21/2007 14:04'! recompile: selector from: oldClass "Compile the method associated with selector in the receiver's method dictionary." "ar 7/10/1999: Use oldClass compiledMethodAt: not self compiledMethodAt:" | method trailer methodNode rMethod | Preferences compileReflectiveMethods ifTrue: [ self flag: #FIXME. "This needs to be checked and removed". rMethod := (oldClass >> selector) reflectiveMethodOrNil. (rMethod notNil and: [ rMethod hasMethodClass not ]) ifTrue: [ rMethod methodClass: oldClass ]. ]. method _ oldClass compiledMethodAt: selector. trailer _ method trailer. methodNode _ self compilerClass new compile: (oldClass sourceCodeAt: selector) in: self notifying: nil ifFail: [^ self]. "Assume OK after proceed from SyntaxError" selector == methodNode selector ifFalse: [self error: 'selector changed!!']. self basicAddSelector: selector withMethod: (methodNode generate: trailer). ! ! ASTTranslatorForEffect subclass: #PEASTTranslatorForEffect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Compiler'! !PEASTTranslatorForEffect methodsFor: 'as yet unclassified' stamp: 'md 3/28/2007 16:30'! acceptMessageNode: aMessageNode | noInline | noInline := aMessageNode hasAnnotation: NoInlineAnnotation key. noInline ifFalse: [ aMessageNode isInlineIf ifTrue: [^ self emitIfNode: aMessageNode]. aMessageNode isInlineIfNil ifTrue: [^ self emitIfNilNode: aMessageNode]. aMessageNode isInlineAndOr ifTrue: [^ self emitAndOrNode: aMessageNode]. aMessageNode isInlineWhile ifTrue: [^ self emitWhileNode: aMessageNode]. aMessageNode isInlineToDo ifTrue: [^ self emitToDoNode: aMessageNode]. aMessageNode isInlineCase ifTrue: [^ self emitCaseNode: aMessageNode]. ]. ^ self emitMessageNode: aMessageNode! ! RBMethodNode subclass: #PEReflectiveMethodNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Parsing'! !PEReflectiveMethodNode class methodsFor: 'accessing' stamp: 'md 3/21/2007 13:40'! formatterClass ^FormatterClass isNil ifTrue: [PEFormatter] ifFalse: [FormatterClass]! ! !PEReflectiveMethodNode methodsFor: 'accessing' stamp: 'md 3/29/2007 23:35'! after ^self propertyAt: #after ifAbsentPut: [OrderedCollection new].! ! !PEReflectiveMethodNode methodsFor: 'accessing' stamp: 'md 3/29/2007 23:32'! after: aCollection self propertyAt: #after put: aCollection! ! !PEReflectiveMethodNode methodsFor: 'accessing' stamp: 'md 3/29/2007 23:35'! before ^self propertyAt: #before ifAbsentPut: [OrderedCollection new].! ! !PEReflectiveMethodNode methodsFor: 'accessing' stamp: 'md 3/29/2007 23:32'! before: aCollection self propertyAt: #before put: aCollection! ! !PEReflectiveMethodNode methodsFor: 'private' stamp: 'md 3/27/2007 17:18'! correctSelector: variableNode ^ self. ! ! !PEReflectiveMethodNode methodsFor: 'private' stamp: 'md 4/13/2007 15:09'! correctVariable: variableNode "Correct the variableNode to a known variable, or declare it as a new variable if such action is requested. We support declaring lowercase variables as temps, and uppercase variables as Globals or ClassVars, depending on whether the context is nil (class=UndefinedObject)." | varName | varName := variableNode name. Transcript show: ' (' , varName , ' is Undeclared) '. varName _ varName asSymbol. Undeclared at: varName put: nil. ^ GlobalVar new assoc: (Undeclared associationAt: varName); scope: self scope! ! !PEReflectiveMethodNode methodsFor: 'private' stamp: 'md 4/2/2007 17:30'! defaultTrailer "this is needed for the source pointer the default #(0) will result in the VM setfaulting because #setSourcePointer: writes into the CompiledMethod *we think*" ^ #(0 0 0 0). ! ! !PEReflectiveMethodNode methodsFor: 'accessing' stamp: 'md 3/31/2007 18:57'! encoder ^PEParser new! ! !PEReflectiveMethodNode methodsFor: 'translate' stamp: 'md 3/29/2007 18:51'! generate: trailer "self verifyIn: (ClassScope new class: JExamples; yourself)" ^ReflectiveMethod methodNode: self compiledMethod: (super generate: trailer)! ! !PEReflectiveMethodNode methodsFor: 'private' stamp: 'md 4/4/2007 18:53'! generateIR ^ PECommonCompilationStrategy new compile: self; ir! ! !PEReflectiveMethodNode methodsFor: 'beforeafter' stamp: 'md 3/29/2007 23:36'! hasAfterCode ^self hasProperty: #after! ! !PEReflectiveMethodNode methodsFor: 'beforeafter' stamp: 'md 3/29/2007 23:36'! hasBeforeCode ^self hasProperty: #before! ! !PEReflectiveMethodNode methodsFor: 'beforeafter' stamp: 'md 3/28/2007 10:33'! hasBeforeOrAfterCode ^self hasBeforeCode or: [ self hasAfterCode ]! ! !PEReflectiveMethodNode methodsFor: 'testing' stamp: 'md 3/28/2007 14:42'! hasInstrumentedArguments ^self arguments anySatisfy: [ :each | each isInstrumented ]! ! !PEReflectiveMethodNode methodsFor: 'testing' stamp: 'pmm 9/27/2006 15:37'! hasMethodClass | className | className _ self valueOfAnnotation: MethodClassAnnotation methodClassAnnotaionKey. ^className notNil and: [ className ~= #unknown ]! ! !PEReflectiveMethodNode methodsFor: 'actions' stamp: 'pmm 10/22/2005 13:35'! killIR self privIR: nil! ! !PEReflectiveMethodNode methodsFor: 'actions' stamp: 'md 3/5/2007 14:37'! killScope PEScopeKiller new visitNode: self! ! !PEReflectiveMethodNode methodsFor: 'actions' stamp: 'md 3/5/2007 17:20'! killSource self source: nil! ! !PEReflectiveMethodNode methodsFor: 'accessing' stamp: 'md 4/13/2007 14:03'! methodClass ^Smalltalk classNamed: (self valueOfAnnotation: MethodClassAnnotation methodClassAnnotaionKey)! ! !PEReflectiveMethodNode methodsFor: 'accessing' stamp: 'md 4/13/2007 14:04'! methodClass: aClass self addValue: aClass name asSymbol toAnnotationAt: MethodClassAnnotation methodClassAnnotaionKey! ! !PEReflectiveMethodNode methodsFor: 'actions' stamp: 'md 4/13/2007 22:16'! prepareForStorage self killScope. self killIR. self killSource. PETokenKiller new visitNode: self! ! !PEReflectiveMethodNode methodsFor: 'private' stamp: 'md 3/27/2007 17:18'! queryUninitializedTemp: variableNode ^ self. ! ! !PEReflectiveMethodNode methodsFor: 'accessing' stamp: 'md 3/30/2007 16:47'! reflectiveMethod ^self parent! ! !PEReflectiveMethodNode methodsFor: 'private' stamp: 'md 3/27/2007 17:17'! removeUnusedTemp: variableNode "Removing unused temp, variableNode, if verified by the user" ^ self. "don't remove and continue"! ! !PEReflectiveMethodNode methodsFor: 'actions' stamp: 'pmm 10/22/2005 13:35'! restoreIR self generateIR! ! !PEReflectiveMethodNode methodsFor: 'actions' stamp: 'pmm 10/22/2005 11:07'! restoreScope self scope! ! !PEReflectiveMethodNode methodsFor: 'accessing' stamp: 'md 3/27/2007 17:16'! scope "Object parseScope" ^ scope ifNil: [ [ self verifyIn: (self methodClass parseScope outerScope: nil parseScope; yourself) ] on: SemanticWarning do: [:ex | ex correctIn: self ]. scope ]! ! !PEReflectiveMethodNode methodsFor: 'accessing' stamp: 'md 4/7/2007 11:31'! source self flag: #FIXME. ^source isNil ifTrue: [self reflectiveMethod getSource] ifFalse: [source].! ! !PEReflectiveMethodNode methodsFor: 'private' stamp: 'md 3/27/2007 17:19'! variable: varNode shadows: semVar ^ Transcript show: '(', varNode name, ' is shadowed)'.! ! !RBMethodNode methodsFor: '*persephone' stamp: 'md 3/31/2007 18:56'! encoder "hack" ^PEParser new! ! !RBMethodNode methodsFor: '*persephone' stamp: 'pmm 9/24/2006 19:10'! hasReturnAtMostAtEnd ^self body hasReturnAtMostAtEnd! ! !RBMethodNode methodsFor: '*persephone' stamp: 'pmm 6/4/2006 13:34'! method ^self! ! !RBMethodNode methodsFor: '*persephone' stamp: 'md 4/14/2007 01:58'! numArgs ^self arguments size! ! !MethodReference methodsFor: '*persephone' stamp: 'md 3/27/2007 11:10'! methodClass ^Smalltalk at: classSymbol ifAbsent: [nil].! ! !CompiledMethod methodsFor: '*persephone' stamp: 'pmm 8/23/2006 14:22'! bytecodes ^ByteArray streamContents: [ :stream | self initialPC to: self size - 4 do: [ :index | stream nextPut: (self at: index) ] ]! ! !CompiledMethod methodsFor: '*persephone' stamp: 'md 3/31/2007 19:45'! classBinding ^(self literalAt: self numLiterals) ! ! !CompiledMethod methodsFor: '*persephone' stamp: 'pmm 7/29/2005 14:21'! compiledMethod ^self! ! !CompiledMethod methodsFor: '*persephone' stamp: 'md 3/31/2007 19:12'! compilerClass ^(Preferences compileReflectiveMethods) ifTrue: [PECompiler] ifFalse: [Compiler]. ! ! !CompiledMethod methodsFor: '*persephone' stamp: 'pmm 7/31/2006 18:01'! getSourceFor: selector in: class "Retrieve or reconstruct the source code for this method." | source flagByte sourceSelector | flagByte _ self last. (flagByte = 0 or: [flagByte = 251 "some source-less methods have flag = 251, rest = 0" and: [((1 to: 3) collect: [:i | self at: self size - i]) = #(0 0 0)]]) ifTrue: ["No source pointer -- decompile without temp names" ^ self decompileString]. flagByte < 252 ifTrue: ["Magic sources -- decompile with temp names" ^ ((self decompilerClass new withTempNames: self tempNames) decompile: selector in: class method: self) decompileString]. "Situation normal; read the sourceCode from the file" [ source _ self getSourceFromFile ] on: Error do: [ :ex | "An error can happen here if, for example, the changes file has been truncated by an aborted download. The present solution is to ignore the error and fall back on the decompiler. A more thorough solution should probably trigger a systematic invalidation of all source pointers past the end of the changes file. Consider that, as time goes on, the changes file will eventually grow large enough to cover the lost code, and then instead of falling into this error case, random source code will get returned." source _ nil ]. source ifNotNil: [ sourceSelector _ self methodClass parserClass new parseSelector: source. ^sourceSelector = selector ifTrue: [source] ifFalse: [ self replace: sourceSelector with: selector in: source]]. "Something really wrong -- decompile blind (no temps)" ^ self decompileString! ! !CompiledMethod methodsFor: '*persephone-override' stamp: 'md 4/15/2007 15:13'! hasLiteralSuchThat: aBlock "Answer true if aBlock returns true for any literal in this method, even if imbedded in array structure or within its pragmas." | literal | self hasReflectiveMethod ifTrue: [^self reflectiveMethod hasLiteralSuchThat: aBlock]. self pragmas do: [ :pragma | (pragma hasLiteralSuchThat: aBlock) ifTrue: [ ^ true ] ]. 2 to: self numLiterals + 1 do: [ :index | literal := self objectAt: index. (aBlock value: literal) ifTrue: [ ^ true ]. (literal hasLiteralSuchThat: aBlock) ifTrue: [ ^ true ] ]. ^ false.! ! !CompiledMethod methodsFor: '*persephone-override' stamp: 'md 4/15/2007 15:13'! hasLiteralThorough: aLiteral "Answer true if any literal in this method is literal, even if embedded in array structure or within its pragmas." | literal | self hasReflectiveMethod ifTrue: [^self reflectiveMethod hasLiteralThorough: aLiteral]. self pragmas do: [ :pragma | (pragma hasLiteral: aLiteral) ifTrue: [ ^ true ] ]. 2 to: self numLiterals + 1 do: [ :index | literal := self objectAt: index. literal == aLiteral ifTrue: [ ^ true ]. (literal hasLiteralThorough: aLiteral) ifTrue: [ ^ true ] ]. ^ false.! ! !CompiledMethod methodsFor: '*persephone' stamp: 'pmm 8/23/2006 09:09'! hasPragma: aSymbol ^self pragmas anySatisfy: [ :each | each keyword = aSymbol ]! ! !CompiledMethod methodsFor: '*persephone' stamp: 'md 4/13/2007 15:07'! hasReflectiveMethod ^self properties includesKey: #reflectiveMethod! ! !CompiledMethod methodsFor: '*persephone' stamp: 'md 4/17/2007 16:48'! invalidate self isInvalid ifTrue: [^self]. self reflectiveMethod invalidate.! ! !CompiledMethod methodsFor: '*persephone' stamp: 'md 3/1/2007 21:57'! isInvalid "the cache is invalidated by installing the RM in the MethodDictionary. State of the compiledMethod is *not* the trigger!!" ^(self methodClass methodDict at: self selector) ~~ self.! ! !CompiledMethod methodsFor: '*persephone' stamp: 'md 3/1/2007 20:25'! isReflectiveMethod ^false! ! !CompiledMethod methodsFor: '*persephone' stamp: 'md 4/4/2007 18:47'! methodNode "Return the parse tree that represents self" | source | self hasReflectiveMethod ifTrue: [^self reflectiveMethod methodNode]. ^ (source := self getSourceFromFile) ifNil: [self decompile] ifNotNil: [self parserClass new parse: source class: (self methodClass ifNil: [self sourceClass])]! ! !CompiledMethod methodsFor: '*persephone' stamp: 'md 4/13/2007 15:07'! reflectiveMethod ^self properties at: #reflectiveMethod ifAbsent: [ Preferences compileReflectiveMethods ifFalse: [self error: 'no reflective Method']. self methodClass recompile: self selector. ^(self methodClass>>self selector) reflectiveMethod. ]! ! !CompiledMethod methodsFor: '*persephone' stamp: 'md 4/13/2007 15:07'! reflectiveMethod: aJMethod self properties at: #reflectiveMethod put: aJMethod! ! !CompiledMethod methodsFor: '*persephone' stamp: 'md 4/13/2007 15:07'! reflectiveMethodOrNil ^self properties at: #reflectiveMethod ifAbsent: [ nil ]! ! !CompiledMethod methodsFor: '*persephone' stamp: 'pmm 7/31/2006 15:33'! replace: oldSelector with: newSelector in: aText | oldKeywords newKeywords args newSelectorWithArgs startOfSource lastSelectorToken | oldKeywords _ oldSelector keywords. newKeywords _ (newSelector ifNil: [self defaultSelector]) keywords. self assert: oldKeywords size = newKeywords size. args _ (self methodClass parserClass new parseArgsAndTemps: aText string notifying: nil) copyFrom: 1 to: self numArgs. newSelectorWithArgs _ String streamContents: [:stream | newKeywords withIndexDo: [:keyword :index | stream nextPutAll: keyword. stream space. args size >= index ifTrue: [ stream nextPutAll: (args at: index); space]]]. lastSelectorToken _ args isEmpty ifFalse: [args last] ifTrue: [oldKeywords last]. startOfSource _ (aText string indexOfSubCollection: lastSelectorToken startingAt: 1) + lastSelectorToken size. ^newSelectorWithArgs withBlanksTrimmed asText , (aText copyFrom: startOfSource to: aText size)! ! !CompiledMethod methodsFor: '*persephone' stamp: 'pmm 7/31/2006 15:32'! sourceSelector "Answer my selector extracted from my source. If no source answer nil" | sourceString | sourceString _ self getSourceFromFile ifNil: [^ nil]. ^ self methodClass parserClass new parseSelector: sourceString! ! !Class methodsFor: '*persephone' stamp: 'pmm 11/27/2006 16:22'! asLiteralNode ^self name asString asVariableNode! ! Object subclass: #Annotation instanceVariableNames: 'key' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Annotations-Kernel'! !Annotation class methodsFor: 'instance creation' stamp: 'pmm 9/24/2006 13:43'! forKey: aSymbol ^self forKey: aSymbol default: GenericNoValueAnnotation! ! !Annotation class methodsFor: 'instance creation' stamp: 'pmm 9/24/2006 13:43'! forKey: aSymbol default: defaultClass | class | class := self allSubclasses detect: [ :each | each keys includes: aSymbol ] ifNone: [ ^defaultClass new sourceVisible: true; yourself ]. ^class key: aSymbol! ! !Annotation class methodsFor: 'instance creation' stamp: 'pmm 12/23/2006 15:41'! forKey: aSymbol values: aCollection | annotation | annotation := self forKey: aSymbol default: (aCollection isEmpty ifTrue: [ GenericNoValueAnnotation ] ifFalse: [ GenericMultiValuedAnnotation ]). annotation addValue: (annotation evaluateAtCompiletime ifTrue: [ aCollection collect: [ :each | each evaluate ] ] ifFalse: [ aCollection ]). ^annotation! ! !Annotation class methodsFor: 'instance creation' stamp: 'pmm 10/9/2005 20:35'! key: aSymbol ^self new key: aSymbol; yourself! ! !Annotation class methodsFor: 'accessing' stamp: 'pmm 10/9/2005 23:08'! keys ^#()! ! !Annotation methodsFor: 'adding' stamp: 'pmm 9/29/2005 08:28'! addValue: anObject self subclassResponsibility ! ! !Annotation methodsFor: 'adding' stamp: 'pmm 6/9/2006 10:18'! addValues: aCollection aCollection do: [ :each | self addValue: each ]! ! !Annotation methodsFor: 'enumerating' stamp: 'pmm 10/9/2005 20:14'! do: aBlock self subclassResponsibility ! ! !Annotation methodsFor: 'testing' stamp: 'pmm 6/12/2006 08:34'! evaluateAtCompiletime ^false! ! !Annotation methodsFor: 'testing' stamp: 'pmm 10/9/2005 20:14'! hasValue self subclassResponsibility ! ! !Annotation methodsFor: 'convenience' stamp: 'pmm 6/7/2006 09:23'! ifUnary: anUnaryBlock ifBinary: aBinaryBlock ifKeyword: aKeywordBlock ^self isUnary ifTrue: anUnaryBlock ifFalse: [ self isKeyword ifTrue:aKeywordBlock ifFalse: aBinaryBlock ]! ! !Annotation methodsFor: 'testing' stamp: 'pmm 6/7/2006 09:21'! isBinary ^self hasValue and: [ self isKeyword not ]! ! !Annotation methodsFor: 'testing' stamp: 'pmm 6/5/2006 13:04'! isEmpty ^self size isZero! ! !Annotation methodsFor: 'testing' stamp: 'pmm 6/7/2006 09:20'! isKeyword ^self key includes: $:! ! !Annotation methodsFor: 'testing' stamp: 'pmm 9/29/2005 08:27'! isMultivalued self subclassResponsibility ! ! !Annotation methodsFor: 'testing' stamp: 'pmm 10/9/2005 20:13'! isSourceVisible self subclassResponsibility! ! !Annotation methodsFor: 'testing' stamp: 'pmm 6/7/2006 09:21'! isUnary ^self hasValue not! ! !Annotation methodsFor: 'accessing' stamp: 'pmm 9/29/2005 08:28'! key ^key! ! !Annotation methodsFor: 'accessing' stamp: 'pmm 6/11/2006 21:49'! key: aSymbol key := aSymbol! ! !Annotation methodsFor: 'adding' stamp: 'pmm 6/11/2006 15:07'! mergeValueOf: anAnnotation self subclassResponsibility ! ! !Annotation methodsFor: 'testing' stamp: 'pmm 6/3/2006 14:35'! notEmpty ^self isEmpty not! ! !Annotation methodsFor: 'accessing' stamp: 'pmm 10/9/2005 20:13'! size self subclassResponsibility ! ! Annotation subclass: #MultiValuedAnnotation instanceVariableNames: 'values' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Annotations-Kernel'! MultiValuedAnnotation subclass: #GenericMultiValuedAnnotation instanceVariableNames: 'sourceVisible' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Annotations-Contrete'! !GenericMultiValuedAnnotation methodsFor: 'testing' stamp: 'pmm 9/24/2006 13:37'! isSourceVisible ^self sourceVisible! ! !GenericMultiValuedAnnotation methodsFor: 'testing' stamp: 'pmm 9/24/2006 13:37'! sourceVisible ^sourceVisible! ! !GenericMultiValuedAnnotation methodsFor: 'testing' stamp: 'pmm 9/24/2006 13:37'! sourceVisible: aBoolean sourceVisible := aBoolean! ! MultiValuedAnnotation subclass: #InstrumentationAnnotation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Annotations-Contrete'! !InstrumentationAnnotation class methodsFor: 'accessing' stamp: 'pmm 9/29/2005 08:23'! afterAnnotationKey ^#after:! ! !InstrumentationAnnotation class methodsFor: 'accessing' stamp: 'pmm 9/29/2005 08:24'! beforeAnnotationKey ^#before:! ! !InstrumentationAnnotation class methodsFor: 'accessing' stamp: 'pmm 9/29/2005 08:24'! insteadAnnotationKey ^#instead:! ! !InstrumentationAnnotation class methodsFor: 'accessing' stamp: 'pmm 9/29/2005 08:25'! keys ^Array with: self beforeAnnotationKey with: self insteadAnnotationKey with: self afterAnnotationKey ! ! !InstrumentationAnnotation methodsFor: 'testing' stamp: 'pmm 7/8/2006 13:40'! isSourceVisible ^false! ! !MultiValuedAnnotation methodsFor: 'adding' stamp: 'pmm 10/9/2005 20:18'! addValue: anObject ^self values add: anObject! ! !MultiValuedAnnotation methodsFor: 'enumerating' stamp: 'pmm 7/9/2006 12:09'! collect: aOneArgumentBlock | newCollection | newCollection := OrderedCollection new. self do: [:each | newCollection add: (aOneArgumentBlock value: each)]. ^ newCollection! ! !MultiValuedAnnotation methodsFor: 'enumerating' stamp: 'pmm 10/9/2005 23:11'! do: aBlock self values do: aBlock! ! !MultiValuedAnnotation methodsFor: 'testing' stamp: 'pmm 10/9/2005 22:44'! hasValue ^true! ! !MultiValuedAnnotation methodsFor: 'initialize-release' stamp: 'pmm 10/9/2005 20:18'! initialize super initialize. self values: OrderedCollection new! ! !MultiValuedAnnotation methodsFor: 'testing' stamp: 'pmm 6/5/2006 10:20'! isMultivalued ^true! ! !MultiValuedAnnotation methodsFor: 'accessing' stamp: 'pmm 6/11/2006 15:09'! mergeValueOf: anAnnotation self addValues: anAnnotation values! ! !MultiValuedAnnotation methodsFor: 'accessing' stamp: 'pmm 10/9/2005 20:17'! size ^self values size! ! !MultiValuedAnnotation methodsFor: 'accessing' stamp: 'pmm 10/9/2005 20:17'! values ^values! ! !MultiValuedAnnotation methodsFor: 'accessing' stamp: 'pmm 6/11/2006 21:51'! values: aCollection values := aCollection! ! Annotation subclass: #NoValueAnnotation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Annotations-Kernel'! NoValueAnnotation subclass: #AssertionAnnotation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Examples'! !AssertionAnnotation class methodsFor: 'accessing' stamp: 'pmm 10/9/2005 20:31'! assertionAnnotationKey ^#assertion! ! !AssertionAnnotation class methodsFor: 'accessing' stamp: 'pmm 10/9/2005 20:32'! keys ^Array with: self assertionAnnotationKey ! ! !AssertionAnnotation methodsFor: 'testing' stamp: 'pmm 10/9/2005 23:50'! isSourceVisible ^true! ! NoValueAnnotation subclass: #EvaluateAtCompiletimeAnnotation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Examples'! !EvaluateAtCompiletimeAnnotation class methodsFor: 'accessing' stamp: 'pmm 1/14/2006 14:37'! evaluteAtCompiletimeAnnotaionKey ^#evaluteAtCompiletime! ! !EvaluateAtCompiletimeAnnotation class methodsFor: 'accessing' stamp: 'pmm 1/14/2006 14:38'! keys ^Array with: self evaluteAtCompiletimeAnnotaionKey! ! !EvaluateAtCompiletimeAnnotation methodsFor: 'testing' stamp: 'pmm 1/14/2006 14:37'! isSourceVisible ^true! ! NoValueAnnotation subclass: #GenericNoValueAnnotation instanceVariableNames: 'sourceVisible' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Annotations-Contrete'! !GenericNoValueAnnotation class methodsFor: 'accessing' stamp: 'pmm 7/23/2006 15:59'! keys ^#()! ! !GenericNoValueAnnotation methodsFor: 'testing' stamp: 'pmm 9/24/2006 13:38'! isSourceVisible ^self sourceVisible! ! !GenericNoValueAnnotation methodsFor: 'testing' stamp: 'pmm 9/24/2006 13:38'! sourceVisible ^sourceVisible! ! !GenericNoValueAnnotation methodsFor: 'testing' stamp: 'pmm 9/24/2006 13:38'! sourceVisible: aBoolean sourceVisible := aBoolean! ! NoValueAnnotation subclass: #NoInlineAnnotation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Annotations-Contrete'! !NoInlineAnnotation class methodsFor: 'accessing' stamp: 'pmm 6/11/2006 09:56'! key ^#noInline! ! !NoInlineAnnotation class methodsFor: 'accessing' stamp: 'pmm 6/11/2006 09:57'! keys ^Array with: self key! ! !NoInlineAnnotation methodsFor: 'testing' stamp: 'pmm 10/9/2005 20:29'! isSourceVisible ^true! ! NoInlineAnnotation subclass: #ProgrammaticNoInlineAnnotation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Annotations-Contrete'! !ProgrammaticNoInlineAnnotation class methodsFor: 'accessing' stamp: 'pmm 11/4/2006 18:41'! keys ^#()! ! !ProgrammaticNoInlineAnnotation methodsFor: 'testing' stamp: 'pmm 11/4/2006 18:41'! isSourceVisible ^false! ! !NoValueAnnotation class methodsFor: 'instance creation' stamp: 'pmm 7/28/2006 11:13'! newWithKey ^self new key: self keys anyOne; yourself! ! !NoValueAnnotation methodsFor: 'adding' stamp: 'pmm 10/9/2005 22:44'! addValue: anObject "do nothing"! ! !NoValueAnnotation methodsFor: 'enumerating' stamp: 'pmm 10/9/2005 22:58'! do: aBlock aBlock value: nil! ! !NoValueAnnotation methodsFor: 'testing' stamp: 'pmm 10/9/2005 22:44'! hasValue ^false! ! !NoValueAnnotation methodsFor: 'testing' stamp: 'pmm 6/5/2006 10:20'! isMultivalued ^false! ! !NoValueAnnotation methodsFor: 'adding' stamp: 'pmm 6/11/2006 15:07'! mergeValueOf: anAnnotation "ignore"! ! !NoValueAnnotation methodsFor: 'accessing' stamp: 'pmm 6/5/2006 10:20'! size ^0! ! Annotation subclass: #SingleValuedAnnotation instanceVariableNames: 'value' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Annotations-Kernel'! SingleValuedAnnotation subclass: #GenericSingleValuedAnnotation instanceVariableNames: 'sourceVisible' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Annotations-Contrete'! !GenericSingleValuedAnnotation methodsFor: 'testing' stamp: 'pmm 9/24/2006 13:38'! isSourceVisible ^self sourceVisible! ! !GenericSingleValuedAnnotation methodsFor: 'testing' stamp: 'pmm 9/24/2006 13:38'! sourceVisible ^sourceVisible! ! !GenericSingleValuedAnnotation methodsFor: 'testing' stamp: 'pmm 9/24/2006 13:38'! sourceVisible: aBoolean sourceVisible := aBoolean! ! SingleValuedAnnotation subclass: #MethodClassAnnotation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Annotations-Contrete'! !MethodClassAnnotation class methodsFor: 'accessing' stamp: 'pmm 3/23/2006 10:11'! keys ^Array with: self methodClassAnnotaionKey! ! !MethodClassAnnotation class methodsFor: 'accessing' stamp: 'pmm 3/23/2006 10:11'! methodClassAnnotaionKey ^#definitionClass! ! !MethodClassAnnotation methodsFor: 'testing' stamp: 'pmm 10/10/2005 10:41'! isSourceVisible ^false! ! !SingleValuedAnnotation methodsFor: 'adding' stamp: 'pmm 10/9/2005 20:19'! addValue: anObject self value: anObject. ^anObject! ! !SingleValuedAnnotation methodsFor: 'enumerating' stamp: 'pmm 10/9/2005 20:17'! do: aBlock aBlock value: self value! ! !SingleValuedAnnotation methodsFor: 'testing' stamp: 'pmm 10/9/2005 22:43'! hasValue ^true! ! !SingleValuedAnnotation methodsFor: 'testing' stamp: 'pmm 6/5/2006 10:20'! isMultivalued ^false! ! !SingleValuedAnnotation methodsFor: 'adding' stamp: 'pmm 6/11/2006 15:07'! mergeValueOf: anAnnotation self value: anAnnotation value! ! !SingleValuedAnnotation methodsFor: 'accessing' stamp: 'pmm 10/9/2005 20:16'! size ^1! ! !SingleValuedAnnotation methodsFor: 'accessing' stamp: 'pmm 10/9/2005 20:16'! value ^value! ! !SingleValuedAnnotation methodsFor: 'accessing' stamp: 'pmm 10/9/2005 20:16'! value: anObject value := anObject! ! Object subclass: #JObject uses: TJMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Compatibility'! JObject class uses: TJMethod classTrait instanceVariableNames: ''! !JObject class methodsFor: 'accessing' stamp: 'md 3/31/2007 19:13'! compilerClass ^PECompiler! ! !JObject class methodsFor: 'accessing' stamp: 'md 3/20/2007 17:24'! parseTreeFor: aSymbol ^(self compiledMethodAt: aSymbol) reflectiveMethod methodNode! ! !Object methodsFor: '*persephone' stamp: 'pmm 7/18/2005 10:24'! allInstVars ^self class allInstVarNames collect: [ :each | self instVarNamed: each ]! ! !Object methodsFor: '*persephone' stamp: 'md 3/31/2007 19:18'! asLiteralNode ^self isLiteral ifTrue: [ RBLiteralNode value: self ] ifFalse: [ PEObjectLiteralNode value: self ]! ! Object subclass: #PECommonCompilationStrategy instanceVariableNames: 'ir' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Compiler'! !PECommonCompilationStrategy methodsFor: 'private' stamp: 'md 3/28/2007 15:53'! afterWithReplacedMetaVariablesOf: eMethodNode ^eMethodNode after collect: [ :each | PENodeReplacer replacementNodeFor: each of: eMethodNode] ! ! !PECommonCompilationStrategy methodsFor: 'private' stamp: 'md 3/28/2007 15:53'! beforeWithReplacedMetaVariablesOf: aMethodNode ^aMethodNode before collect: [ :each | PENodeReplacer replacementNodeFor: each of: aMethodNode] ! ! !PECommonCompilationStrategy methodsFor: 'compiling' stamp: 'md 4/2/2007 17:32'! compile: aJMethod | methodNode | aJMethod methodNode restoreScope. methodNode := self transform: aJMethod methodNode. ^(methodNode hasBeforeOrAfterCode or: [methodNode hasInstrumentedArguments ] or: ["methodNode hasAnyLink" false]) ifTrue: [ self compileTransformed: methodNode ] ifFalse: [ self compileDefault: methodNode ]! ! !PECommonCompilationStrategy methodsFor: 'private' stamp: 'md 4/2/2007 17:28'! compileDefault: aMethodNode ^self compileNode: aMethodNode trailer: aMethodNode defaultTrailer! ! !PECommonCompilationStrategy methodsFor: 'private' stamp: 'md 4/4/2007 18:53'! compileNode: aMethodNode trailer: aByteArray ^(ir := PEASTTranslator new visitNode: aMethodNode; ir) compiledMethodWith: aByteArray! ! !PECommonCompilationStrategy methodsFor: 'private' stamp: 'pmm 7/21/2006 15:17'! compileTransformed: aJMethod self subclassResponsibility! ! !PECommonCompilationStrategy methodsFor: 'as yet unclassified' stamp: 'md 4/4/2007 18:53'! ir ^ir! ! !PECommonCompilationStrategy methodsFor: 'private' stamp: 'pmm 7/28/2006 15:26'! temporariesIn: aCollection ^aCollection select: [ :each | each isSequence ] thenCollect: [ :each | each temporaries ]! ! !PECommonCompilationStrategy methodsFor: 'private' stamp: 'md 3/28/2007 14:32'! transform: aNode | transfromedNode | transfromedNode := aNode copy. transfromedNode scope:nil. self transformers do: [ :each | each visitNode: transfromedNode ]. ^transfromedNode! ! !PECommonCompilationStrategy methodsFor: 'private' stamp: 'md 3/28/2007 15:56'! transformers ^(PECompilerPlugin allSubclasses select: [ :each | each isCompilerBackendPlugin ]) asSortedCollection collect: [ :each | each new ]! ! !PECommonCompilationStrategy methodsFor: 'private' stamp: 'pmm 8/11/2006 10:25'! wrap: aNode withEnsure: anStatementsNode ^RBMessageNode receiver: (RBBlockNode body: aNode asSequenceNode) selector: #ensure: argument: (RBBlockNode body: anStatementsNode) ! ! PECommonCompilationStrategy subclass: #PEInlineCompilationStrategy instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Compiler'! !PEInlineCompilationStrategy methodsFor: 'private' stamp: 'pmm 8/28/2006 11:44'! addNoChangeAfter: aJMethod to: aSequenceNode | original | original := aJMethod methodNode. ^aSequenceNode addNode: (self wrap: original body copy withEnsure: (self afterWithReplacedMetaVariablesOf: aJMethod) asSequenceNode); yourself! ! !PEInlineCompilationStrategy methodsFor: 'private' stamp: 'md 3/29/2007 16:02'! addOutlineReturnAfter: original to: aSequenceNode | body last | body := original body copy. last := body statements last. last isReturn ifTrue: [ body replaceNode: last withNode: last value ]. aSequenceNode addNode: (self wrap: body withEnsure: (self afterWithReplacedMetaVariablesOf: original) asSequenceNode). ^last isReturn ifTrue: [ (RBReturnNode value: aSequenceNode) asSequenceNode ] ifFalse: [ aSequenceNode ]! ! !PEInlineCompilationStrategy methodsFor: 'private' stamp: 'md 3/31/2007 18:58'! compileTransformed: original | aJMethod methodNode sequence | aJMethod := original parent. sequence := RBSequenceNode temporaries: (self temporariesIn: original before) , original body temporaries , (self temporariesIn: original after) statements: OrderedCollection new. (self beforeWithReplacedMetaVariablesOf: original) addToSequence: sequence. original hasAfterCode ifTrue: [sequence := original hasReturnAtMostAtEnd ifTrue: [self addOutlineReturnAfter: original to: sequence] ifFalse: [self addNoChangeAfter: original to: sequence]] ifFalse: [sequence addNodes: original body statements]. methodNode := PEReflectiveMethodNode selector: original selector arguments: original arguments body: sequence. methodNode methodClass: aJMethod methodClass. methodNode parent: original parent. original hasAnnotations ifTrue: [methodNode annotations: original annotations]. ^ self compileNode: methodNode trailer: aJMethod defaultTrailer! ! PECommonCompilationStrategy subclass: #PEWrapperCompilationStrategy instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Compiler'! !PEWrapperCompilationStrategy methodsFor: 'private' stamp: 'md 3/31/2007 19:19'! compileTransformed: aMethodNode | wrapped methodNode sequence executeSend | wrapped := self compileDefault: aMethodNode. sequence := RBSequenceNode temporaries: (self temporariesIn: aMethodNode before) , (self temporariesIn: aMethodNode after) statements: OrderedCollection new. (self beforeWithReplacedMetaVariablesOf: aMethodNode) addToSequence: sequence. executeSend := (RBMessageNode receiver: 'self' asVariableNode selector: #withArgs:executeMethod: arguments: (Array with: (RBArrayNode statements: (aMethodNode arguments collect: [ :each | | node | self flag: #xxx. "duplicated in JASTByteNurseTransformer >> #transform:" node := each. each hasInsteadCode ifTrue: [ self flag: #xxx. "not really clever if multiple instead" each insteadCode do: [ :replacementAnnotation | node := self replacementNodeFor: replacementAnnotation first of: each ] ]. node ])) with: (PEObjectLiteralNode value: wrapped))). aMethodNode hasAfterCode ifTrue: [ executeSend := self wrap: executeSend withEnsure: (self afterWithReplacedMetaVariablesOf: aMethodNode) asSequenceNode ]. sequence addNode: (RBReturnNode value: executeSend). methodNode := PEReflectiveMethodNode selector: aMethodNode selector arguments: aMethodNode arguments body: sequence. methodNode parent: aMethodNode parent. aMethodNode hasAnnotations ifTrue: [methodNode annotations: aMethodNode annotations]. methodNode methodClass: aMethodNode parent methodClass. ^self compileNode: methodNode trailer: aMethodNode parent defaultTrailer ! ! !PEWrapperCompilationStrategy methodsFor: 'private' stamp: 'md 3/28/2007 15:53'! replacementNodeFor: aNode of: anAnnotedNode ^PENodeReplacer replacementNodeFor: aNode of: anAnnotedNode! ! Object subclass: #PEInterpretationExamples uses: TReflectiveMethods instanceVariableNames: 'instVar' classVariableNames: 'ClassVar' poolDictionaries: '' category: 'Persephone-Tests'! PEInterpretationExamples class uses: TReflectiveMethods classTrait instanceVariableNames: ''! !PEInterpretationExamples class methodsFor: 'compiling' stamp: 'md 3/31/2007 19:14'! compilerClass ^PECompiler! ! !PEInterpretationExamples class methodsFor: 'compiling' stamp: 'md 3/31/2007 19:09'! parseTreeFor: aSymbol ^(self compiledMethodAt: aSymbol) reflectiveMethod methodNode! ! !PEInterpretationExamples methodsFor: 'accessing' stamp: 'pmm 5/31/2006 10:55'! classVar ^ClassVar! ! !PEInterpretationExamples methodsFor: 'accessing' stamp: 'pmm 5/31/2006 10:55'! classVar: anObject ClassVar := anObject! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 4/26/2006 21:41'! exampleArgument: anObject ^anObject + 5! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 4/26/2006 21:49'! exampleArray ^{ 1 . 1 + 1 . 1 + 2 . 2 + 3 }! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 4/26/2006 21:40'! exampleArrayLiteral ^#(1 2 3 4)! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 4/26/2006 21:45'! exampleBlockReturn #(1 2 3) do: [ :each | each = 2 ifTrue: [ ^each ] ]! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 4/26/2006 21:44'! exampleBlockTemp instVar := 0. #(1 2 3) do: [ :each | | x | x := each. x := x * x. instVar := instVar + x ]. ^instVar! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 4/28/2006 20:40'! exampleBranch ^1 > 2 ifTrue: [ 1000 + 337 ] ifFalse: [ 30000 + 1000 + 337 ]! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 4/26/2006 21:48'! exampleCascade ^OrderedCollection new add: 1; add: 2; add: 3; yourself! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 4/26/2006 21:42'! exampleDo | x | x := 0. #(1 2 3) do: [ :each | x := x + each ]. ^x! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 5/1/2006 16:21'! exampleEnsure | x | x := ValueHolder new contents: 0 yourself. [ 0 / 1 ] ensure: [ x contents: 20 ]. ^x contents! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'md 4/16/2007 21:26'! exampleGlobal ^PEInterpretationExamples name! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 4/26/2006 21:43'! exampleInstVar instVar := 0. #(1 2 3) do: [ :each | instVar := instVar + each ]. ^instVar! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 5/1/2006 16:08'! exampleOnDo | x | x := 0. [ 1 / 0 ] on: ZeroDivide do: [ x:= 20 ]. ^x! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 4/28/2006 18:59'! exampleOuterBlock | x | x := 0. #(1 2 3) do: [ :each | | blockTemp | blockTemp := each. blockTemp = 2 ifTrue: [ blockTemp := blockTemp + 10 ]. x := x + blockTemp ]. ^x! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 4/26/2006 21:40'! exampleReturnSelf 1 + 2! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 4/26/2006 21:41'! exampleTemp | temp | temp := 1000. temp := temp + 337. ^temp! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 4/26/2006 21:55'! exampleTrue ^true! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'pmm 5/1/2006 08:16'! exampleWhile | x | x := 40. [ (x > 20) ] whileTrue: [ x := x - 2 ]. ^x! ! !PEInterpretationExamples methodsFor: 'examples' stamp: 'md 4/16/2007 21:30'! printString ^super printString , ' RLY'! ! Object subclass: #PEInterpreterContext instanceVariableNames: 'codeInterpreter' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Interpreter'! !PEInterpreterContext class methodsFor: 'instance creation' stamp: 'pmm 4/26/2006 09:03'! codeInterpreter: aCodeInterpreter ^self new codeInterpreter: aCodeInterpreter; yourself! ! !PEInterpreterContext methodsFor: 'accessing' stamp: 'pmm 4/26/2006 09:02'! codeInterpreter ^codeInterpreter! ! !PEInterpreterContext methodsFor: 'accessing' stamp: 'pmm 4/26/2006 09:02'! codeInterpreter: aCodeInterpreter codeInterpreter := aCodeInterpreter! ! Object subclass: #PersephoneExample uses: TJMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Tests'! PersephoneExample class uses: TJMethod classTrait instanceVariableNames: ''! !PersephoneExample class methodsFor: 'accessing' stamp: 'md 3/31/2007 19:13'! compilerClass ^PECompiler! ! !PersephoneExample class methodsFor: 'accessing' stamp: 'md 3/20/2007 17:24'! parseTreeFor: aSymbol ^(self compiledMethodAt: aSymbol) reflectiveMethod methodNode! ! !PersephoneExample class methodsFor: 'compiling' stamp: 'md 3/20/2007 17:28'! recompile: selector from: oldClass | jMethod | jMethod := (oldClass >> selector) reflectiveMethodOrNil. (jMethod notNil and: [ jMethod hasMethodClass not ]) ifTrue: [ jMethod methodClass: oldClass ]. super recompile: selector from: oldClass. ! ! !PersephoneExample methodsFor: 'examples' stamp: 'md 4/15/2007 15:30'! exampleAssert self assert: [^true]. ^false! ! !PersephoneExample methodsFor: 'examples' stamp: 'md 4/15/2007 15:30'! exampleAssertDelay self assert: [(Delay forSeconds: 2) wait. true].! ! !PersephoneExample methodsFor: 'examples' stamp: 'md 4/15/2007 14:41'! exampleSend ^ 1 sin.! ! !PersephoneExample methodsFor: 'examples' stamp: 'md 3/20/2007 14:47'! exampleSimple ^ 1 ! ! Object subclass: #PersephoneTODO instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Tests'! !PersephoneTODO methodsFor: 'todo' stamp: 'md 4/17/2007 16:43'! todo ' - Compiler: Core methods need to be installed as CMs - properties different between ReflectiveMethod and MethodNode - selector doubled between ReflectiveMethod and MethodNode - Problem: source slow --> save stop in property. - check tests JMethod, move over. - remove ByteNurse infrastructure: before/after annotations -> RBSequenceNode: temporaries optionally -> RBMethodNode: get binding from parent, no annotation -> RBMethod/BlockNode: ir as pragma -> RBMethodNode>>primitiveNode: Generate from pragma. no iVar -> RBMethodNode: scope as properties -> annotation as property -> RBReturnNode: return --> #position property -> RBAssignment: assignment --> #position property '! ! Object subclass: #ReflectiveMethod instanceVariableNames: 'compiledMethod methodNode properties sourcePointer classBinding literals' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Kernel'! ReflectiveMethod subclass: #InterpretedReflectiveMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Kernel'! !InterpretedReflectiveMethod methodsFor: 'interpretation' stamp: 'md 4/18/2007 12:37'! beInterpreted "ignore"! ! !InterpretedReflectiveMethod methodsFor: 'interpretation' stamp: 'md 4/18/2007 12:37'! beNative self primitiveChangeClassTo: ReflectiveMethod new.! ! !InterpretedReflectiveMethod methodsFor: 'interpretation' stamp: 'md 4/18/2007 12:30'! isInterpreted ^true! ! !InterpretedReflectiveMethod methodsFor: 'running' stamp: 'md 4/18/2007 12:30'! run: oldSelector with: arguments in: aReceiver ^self interpret: oldSelector with: arguments in: aReceiver.! ! !ReflectiveMethod class methodsFor: 'instance creation' stamp: 'md 4/15/2007 14:43'! methodNode: aMethodNode compiledMethod: aCompiledMethod | inst | inst := self new. inst methodNode: aMethodNode. inst methodNode prepareForStorage. inst compiledMethod: aCompiledMethod. inst literals: (PELiteralCollector new visitNode: aMethodNode) literals. inst properties: aCompiledMethod properties. aCompiledMethod reflectiveMethod: inst. ^inst.! ! !ReflectiveMethod methodsFor: 'refactoring browser' stamp: 'pmm 7/15/2005 13:49'! allLiterals ^ self compiledMethod allLiterals! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'pmm 8/3/2005 20:19'! argumentNames ^self methodNode argumentNames! ! !ReflectiveMethod methodsFor: 'refactoring browser' stamp: 'pmm 4/27/2006 21:41'! ast ^self parseTree! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'pmm 6/21/2006 11:10'! at: anInteger ^self compiledMethod at: anInteger! ! !ReflectiveMethod methodsFor: 'interpretation' stamp: 'md 4/18/2007 12:36'! beInterpreted self primitiveChangeClassTo: InterpretedReflectiveMethod new.! ! !ReflectiveMethod methodsFor: 'interpretation' stamp: 'md 4/18/2007 12:37'! beNative "ignore"! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'pmm 8/23/2006 14:21'! bytecodes ^self compiledMethod bytecodes! ! !ReflectiveMethod methodsFor: 'source code management-legacy' stamp: 'pmm 7/15/2005 13:51'! checkOKToAdd: size at: filePosition "Issue several warnings as the end of the changes file approaches its limit, and finally halt with an error when the end is reached." ^self compiledMethod checkOKToAdd: size at: filePosition! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'md 3/31/2007 19:43'! classBinding ^classBinding! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'md 3/31/2007 19:43'! classBinding: aBinding classBinding := aBinding! ! !ReflectiveMethod methodsFor: 'compilation' stamp: 'md 4/14/2007 10:23'! compilationStrategy ^self properties at: #compilationStrategy ifAbsent: [ self defaultCompilationStrategy ]! ! !ReflectiveMethod methodsFor: 'compilation' stamp: 'md 4/14/2007 10:22'! compilationStrategy: aJCompilationStragetyClass ^self properties at: #compilationStrategy put: aJCompilationStragetyClass! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'md 4/13/2007 13:57'! compiledMethod compiledMethod ifNil: [ compiledMethod := self generateCompiledMethod. self hasMethodClass ifTrue: [ compiledMethod methodClass: self methodClass ] ]. ^compiledMethod! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'md 4/13/2007 13:58'! compiledMethod: aCompiledMethod compiledMethod := aCompiledMethod. "(aCompiledMethod notNil and: [ self hasMethodClass not ] and: [ compiledMethod methodClass notNil ]) ifTrue: [ Beeper beep. self setMethodClass: compiledMethod methodClass ]." (aCompiledMethod notNil and: [ aCompiledMethod sourcePointer isZero not ]) ifTrue: [ sourcePointer := aCompiledMethod sourcePointer ]! ! !ReflectiveMethod methodsFor: 'compression' stamp: 'md 4/15/2007 22:03'! compress | compressed serialized rwstream | rwstream := RWBinaryOrTextStream on: (ByteArray new: 500). serialized := (ReferenceStream on: rwstream) nextPut: methodNode; contents. compressed := ByteArray streamContents: [:strm | (GZipWriteStream on: strm) nextPutAll: serialized; close]. ^compressed contents! ! !ReflectiveMethod methodsFor: 'compilation' stamp: 'md 3/31/2007 19:16'! defaultCompilationStrategy self methodNode isPrimitive ifTrue: [^PEWrapperCompilationStrategy]. ^PEInlineCompilationStrategy! ! !ReflectiveMethod methodsFor: 'private' stamp: 'pmm 9/1/2005 08:37'! defaultTrailer "this is needed for the source pointer the default #(0) will result in the VM setfaulting because #setSourcePointer: writes into the CompiledMethod *we think*" ^ #(0 0 0 0). ! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'pmm 6/19/2006 19:17'! endPC "Answer the index of the last bytecode." ^ self compiledMethod endPC! ! !ReflectiveMethod methodsFor: 'source code management-legacy' stamp: 'pmm 7/15/2005 13:51'! fileIndex ^self compiledMethod fileIndex! ! !ReflectiveMethod methodsFor: 'source code management-legacy' stamp: 'pmm 7/15/2005 13:51'! filePosition ^self compiledMethod filePosition! ! !ReflectiveMethod methodsFor: 'actions' stamp: 'pmm 9/9/2005 16:21'! flushCache self class flushCache! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'pmm 7/22/2005 13:24'! formattedCode ^self methodNode formattedCode! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'pmm 7/15/2005 13:43'! frameSize "Answer the size of temporary frame needed to run the receiver." "NOTE: Versions 2.7 and later use two sizes of contexts." ^self compiledMethod frameSize ! ! !ReflectiveMethod methodsFor: 'compilation' stamp: 'md 4/17/2007 16:20'! generateCompiledMethod | method ms | ms := compiledMethod sourcePointer. method := self compilationStrategy new compile: self. method compiledMethod setSourcePointer: ms. self methodNode prepareForStorage. method reflectiveMethod: self. ^method! ! !ReflectiveMethod methodsFor: 'private' stamp: 'md 3/29/2007 14:03'! getMethodClass ^classBinding value! ! !ReflectiveMethod methodsFor: 'source code management-legacy' stamp: 'pmm 7/29/2005 16:57'! getPreambleFrom: aFileStream at: position ^self compiledMethod getPreambleFrom: aFileStream at: position! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'pmm 8/23/2006 14:25'! getSource ^ self compiledMethod getSource! ! !ReflectiveMethod methodsFor: 'source code management-legacy' stamp: 'pmm 7/31/2006 15:31'! getSourceFor: aSelector in: aClass "Retrieve or reconstruct the source code for this method." ^self compiledMethod getSourceFor: aSelector in: aClass! ! !ReflectiveMethod methodsFor: 'source code management-legacy' stamp: 'pmm 7/15/2005 13:52'! getSourceFromFile "Read the source code from file, determining source file index and file position from the last 3 bytes of this method." ^self compiledMethod getSourceFromFile! ! !ReflectiveMethod methodsFor: 'testing' stamp: 'pmm 7/22/2006 13:41'! hasBeforeCode ^self before notEmpty! ! !ReflectiveMethod methodsFor: 'testing-legacy' stamp: 'md 4/3/2007 11:07'! hasBreakpoint ^false! ! !ReflectiveMethod methodsFor: 'testing' stamp: 'pmm 8/11/2006 15:04'! hasCompiledMethod ^compiledMethod notNil! ! !ReflectiveMethod methodsFor: 'literals-legacy' stamp: 'md 4/15/2007 15:41'! hasLiteral: literal ^self literals identityIncludes: literal.! ! !ReflectiveMethod methodsFor: 'literals-legacy' stamp: 'md 4/15/2007 15:41'! hasLiteralSuchThat: aBlock self pragmas do: [ :pragma | (pragma hasLiteralSuchThat: aBlock) ifTrue: [ ^ true ] ]. self literals do: [ :literal | (aBlock value: literal) ifTrue: [ ^ true ]. (literal hasLiteralSuchThat: aBlock) ifTrue: [ ^ true ] ]. ^ false.! ! !ReflectiveMethod methodsFor: 'literals-legacy' stamp: 'md 4/15/2007 15:42'! hasLiteralThorough: aLiteral "Answer true if any literal in this method is literal, even if embedded in array structure or within its pragmas." self pragmas do: [ :pragma | (pragma hasLiteral: aLiteral) ifTrue: [ ^ true ] ]. self literals do: [ :literal | literal == aLiteral ifTrue: [ ^ true ]. (literal hasLiteralThorough: aLiteral) ifTrue: [ ^ true ] ]. ^ false.! ! !ReflectiveMethod methodsFor: 'testing' stamp: 'pmm 3/23/2006 10:06'! hasMethodClass ^self getMethodClass in: [ :class | class notNil and: [ class ~= #unknown ] ]! ! !ReflectiveMethod methodsFor: 'accessing-delegation' stamp: 'pmm 8/23/2006 14:11'! hasPragma: aSymbol ^self compiledMethod hasPragma: aSymbol! ! !ReflectiveMethod methodsFor: 'testing' stamp: 'md 3/26/2007 12:08'! hasReflectiveMethod ^true! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'pmm 7/15/2005 13:43'! header ^self compiledMethod header! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'pmm 7/15/2005 13:43'! initialPC "Answer the program counter for the receiver's first bytecode." ^ self compiledMethod initialPC! ! !ReflectiveMethod methodsFor: 'interpretation' stamp: 'pmm 4/28/2006 19:47'! interpret: oldSelector with: arguments in: aReceiver ^self interpreterClass run: (self methodNode scope; yourself) with: arguments in: aReceiver! ! !ReflectiveMethod methodsFor: 'private' stamp: 'pmm 9/25/2005 11:44'! interpretSender: aSender receiver: aReceiver arguments: anArray | context result | context := MethodContext sender: aSender receiver: aReceiver method: self arguments: anArray. result := context runUntilErrorOrReturnFrom: aSender.! ! !ReflectiveMethod methodsFor: 'interpretation' stamp: 'md 4/14/2007 10:19'! interpreterClass ^self properties at: #interpreterClass ifAbsent: [ PEMethodInterpreter ]! ! !ReflectiveMethod methodsFor: 'interpretation' stamp: 'md 4/14/2007 10:19'! interpreterClass: aClass self properties at: #interpreterClass put: aClass! ! !ReflectiveMethod methodsFor: 'running' stamp: 'md 4/18/2007 12:20'! invalidate self isInvalid ifTrue: [^self]. self isCoreMethod ifTrue: [ compiledMethod = self generateCompiledMethod. self methodClass addSelectorSilently: self selector withMethod: compiledMethod. ^self. ]. self methodClass addSelectorSilently: self selector withMethod: self.! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'pmm 7/12/2005 23:03'! ir ^self methodNode ir! ! !ReflectiveMethod methodsFor: 'testing-legacy' stamp: 'md 3/27/2007 23:48'! isBlockMethod ^false! ! !ReflectiveMethod methodsFor: 'testing' stamp: 'md 4/18/2007 12:05'! isCoreMethod | class | class := self methodClass. Object == class ifTrue: [^true]. ProtoObject == class ifTrue: [^true]. ReflectiveMethod == class ifTrue: [^true]. MethodDictionary == class ifTrue: [^true]. ArrayedCollection == class ifTrue: [^true]. WriteStream == class ifTrue: [^true]. SequenceableCollection == class ifTrue: [^true]. Dictionary == class ifTrue: [^true]. SmallInteger == class ifTrue: [^true]. IdentityDictionary == class ifTrue: [^true]. Set == class ifTrue: [^true]. Integer == class ifTrue: [^true]. LargePositiveInteger == class ifTrue: [^true]. Behavior == class ifTrue: [^true]. BitBlt == class ifTrue: [^true]. CharacterScanner == class ifTrue: [^true]. MultiCharacterScanner == class ifTrue: [^true]. BlockContext == class ifTrue: [^true]. LookupKey == class ifTrue: [^true]. ReadOnlyVariableBinding == class ifTrue: [^true]. MethodProperties == class ifTrue: [^true]. ^false.! ! !ReflectiveMethod methodsFor: 'interpretation' stamp: 'md 4/18/2007 12:31'! isInterpreted ^false! ! !ReflectiveMethod methodsFor: 'testing' stamp: 'md 3/1/2007 21:58'! isInvalid "the cache is invalidated by installing the RM in the MethodDictionary. State of the compiledMethod is *not* the trigger!!" ^(self methodClass methodDict at: self selector) == self. ! ! !ReflectiveMethod methodsFor: 'testing-legacy' stamp: 'pmm 6/19/2006 19:12'! isProvided ^self compiledMethod isProvided! ! !ReflectiveMethod methodsFor: 'testing-legacy' stamp: 'pmm 7/15/2005 13:55'! isQuick "Answer whether the receiver is a quick return (of self or of an instance variable)." ^ self compiledMethod isQuick! ! !ReflectiveMethod methodsFor: 'testing' stamp: 'md 3/1/2007 20:25'! isReflectiveMethod ^true! ! !ReflectiveMethod methodsFor: 'testing-legacy' stamp: 'pmm 7/15/2005 13:55'! isReturnField "Answer whether the receiver is a quick return of an instance variable." ^self compiledMethod isReturnField! ! !ReflectiveMethod methodsFor: 'testing-legacy' stamp: 'pmm 7/15/2005 13:55'! isReturnSelf "Answer whether the receiver is a quick return of self." ^ self compiledMethod isReturnSelf! ! !ReflectiveMethod methodsFor: 'testing-legacy' stamp: 'pmm 7/15/2005 13:55'! isReturnSpecial "Answer whether the receiver is a quick return of self or constant." ^ self compiledMethod isReturnSpecial! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'pmm 7/15/2005 13:44'! last ^self compiledMethod last! ! !ReflectiveMethod methodsFor: 'source code management-legacy' stamp: 'pmm 1/28/2007 15:21'! linesOfCode ^self compiledMethod linesOfCode! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'pmm 7/15/2005 13:44'! literalAt: anInteger ^self compiledMethod literalAt: anInteger! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'md 4/15/2007 15:09'! literals ^literals ifNil: [#()].! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'md 4/15/2007 14:37'! literals: anArray ^literals := anArray.! ! !ReflectiveMethod methodsFor: 'refactoring browser' stamp: 'pmm 7/15/2005 13:49'! literalsDo: aOneArgumentBlock ^self compiledMethod literalsDo: aOneArgumentBlock! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'pmm 9/19/2005 17:12'! messages ^self compiledMethod messages! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'pmm 6/11/2006 21:46'! methodClass | cls | ^self hasMethodClass ifTrue: [ self getMethodClass ] ifFalse: [ cls := self compiledMethod methodClass. cls isNil ifTrue: [ self methodNode methodClass ] ifFalse: [ cls ] ]! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'pmm 7/26/2006 20:09'! methodClass: aClass self setMethodClass: aClass. self modifyMethodNode: [ :node | node methodClass: aClass ]. compiledMethod isNil ifFalse: [ compiledMethod methodClass: aClass ]! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'md 3/31/2007 18:57'! methodNode | source | ^methodNode ifNil: [ compiledMethod ifNotNil: [ self methodNode: ((source := self getSourceFromFile) ifNil: [compiledMethod decompile] ifNotNil: [PEParser new parse: source class: (self methodClass ifNil: [self sourceClass])])]. methodNode parent: self]. ! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'md 3/29/2007 16:12'! methodNode: aMethodNode methodNode := aMethodNode. aMethodNode ifNotNil: [aMethodNode parent: self].! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'pmm 9/24/2006 11:54'! methodReference ^MethodReference class: self methodClass selector: self selector! ! !ReflectiveMethod methodsFor: 'private' stamp: 'pmm 11/3/2005 12:47'! modifyMethodNode: aBlock aBlock value: self methodNode! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'pmm 7/15/2005 13:45'! nStack ^self compiledMethod nStack! ! !ReflectiveMethod methodsFor: 'private' stamp: 'pmm 10/4/2006 12:41'! nameForInstVarAt: anInteger ^self methodClass allInstVarNames at: anInteger! ! !ReflectiveMethod methodsFor: 'initialize-release' stamp: 'pmm 7/15/2005 13:47'! needsFrameSize: newFrameSize "Set the largeFrameBit to accomodate the newFrameSize" ^self compiledMethod needsFrameSize: newFrameSize! ! !ReflectiveMethod methodsFor: 'refactoring browser' stamp: 'pmm 7/15/2005 13:49'! needsHybridFrame ^self compiledMethod needsHybridFrame! ! !ReflectiveMethod methodsFor: 'enumeration' stamp: 'md 3/28/2007 15:52'! nodesDo: aBlock (PEMethodBodyInstrumentationVisitor block: aBlock) visitNode: self methodNode! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'pmm 7/15/2005 13:45'! numArgs "Answer the number of arguments the receiver takes." ^ self compiledMethod numArgs! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'md 4/15/2007 14:46'! numLiterals "Answer the number of literals used by the receiver." ^ self literals size! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'pmm 7/15/2005 13:46'! numTemps "Answer the number of temporary variables used by the receiver." ^ self compiledMethod numTemps! ! !ReflectiveMethod methodsFor: 'refactoring browser' stamp: 'pmm 7/13/2005 20:10'! parseTree ^self methodNode! ! !ReflectiveMethod methodsFor: 'copying' stamp: 'md 4/14/2007 10:48'! postCopy super postCopy. compiledMethod := nil. methodNode := methodNode copy.! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'SR 9/2/2006 17:32'! pragmas ^ self compiledMethod pragmas! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'pmm 7/15/2005 13:46'! primitive "Answer the primitive index associated with the receiver. Zero indicates that this is not a primitive method. We currently allow 11 bits of primitive index, but they are in two places for backward compatibility. The time to unpack is negligible, since the reconstituted full index is stored in the method cache." ^self compiledMethod primitive! ! !ReflectiveMethod methodsFor: 'printing' stamp: 'lr 5/6/2007 11:50'! printOn: aStream super printOn: aStream. aStream nextPut: $(; nextPutAll: (self selector ifNil: [ '' ]); nextPut: $)! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'md 4/14/2007 10:11'! properties ^properties ifNil: [properties := MethodProperties new]! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'pmm 7/16/2005 11:00'! properties: aDictionary properties := aDictionary! ! !ReflectiveMethod methodsFor: 'source code management-legacy' stamp: 'md 3/20/2007 11:56'! putSource: sourceStr fromParseNode: aMethodNode class: class category: catName withStamp: changeStamp inFile: fileIndex priorMethod: priorMethod | t | t := self compiledMethod putSource: sourceStr fromParseNode: aMethodNode class: class category: catName withStamp: changeStamp inFile: fileIndex priorMethod: priorMethod. self setSourcePointer: self compiledMethod sourcePointer. ^t.! ! !ReflectiveMethod methodsFor: 'source code management-legacy' stamp: 'pmm 7/15/2005 13:53'! putSource: sourceStr fromParseNode: aMethodNode inFile: fileIndex withPreamble: preambleBlock "Store the source code for the receiver on an external file. If no sources are available, i.e., SourceFile is nil, then store temp names for decompilation at the end of the method. If the fileIndex is 1, print on *.sources; if it is 2, print on *.changes, in each case, storing a 4-byte source code pointer at the method end." ^self compiledMethod putSource: sourceStr fromParseNode: aMethodNode inFile: fileIndex withPreamble: preambleBlock! ! !ReflectiveMethod methodsFor: 'source code management-legacy' stamp: 'pmm 3/23/2006 09:45'! putSourceInChangesCategory: catName priorMethod: priorMethod ^ self compiledMethod putSource: self formattedCode fromParseNode: self methodNode class: self methodClass category: catName withStamp: Utilities changeStamp inFile: 2 "2 means changes file" priorMethod: priorMethod! ! !ReflectiveMethod methodsFor: 'testing-legacy' stamp: 'pmm 10/4/2006 12:52'! readsField: varIndex | variableName | variableName := self nameForInstVarAt: varIndex. self nodesDo: [ :each | (each isVariable and: [ each name = variableName ] and: [ each isRead ]) ifTrue: [ ^true ] ]. ^false! ! !ReflectiveMethod methodsFor: 'actions' stamp: 'pmm 3/23/2006 09:46'! recompile self methodClass recompile: self methodNode selector from: self methodClass! ! !ReflectiveMethod methodsFor: 'refactoring browser' stamp: 'pmm 7/15/2005 13:50'! refersToLiteral:aLiteral ^self compiledMethod refersToLiteral:aLiteral! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'md 3/1/2007 20:27'! reflectiveMethod ^self! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'md 3/20/2007 17:32'! reflectiveMethodOrNil ^self! ! !ReflectiveMethod methodsFor: 'actions' stamp: 'pmm 8/7/2005 14:12'! renameArgument: oldName to: newName self renameTemporary: oldName to: newName! ! !ReflectiveMethod methodsFor: 'actions' stamp: 'md 3/29/2007 13:45'! renameTemporary: oldName to: newName | oldCategory oldMethod | oldCategory := self methodClass organization categoryOfElement: self selector. oldMethod := self compiledMethod. self modifyMethodNode: [ :node | (RenameTemporaryRefactoring new oldName: oldName; newName: newName; yourself) renameNode: node. node methodNode scope: nil ]. self invalidate. self putSourceInChangesCategory: oldCategory priorMethod: oldMethod. SystemChangeNotifier uniqueInstance methodChangedFrom: oldMethod to: self compiledMethod selector: self selector inClass: self methodClass ! ! !ReflectiveMethod methodsFor: 'actions' stamp: 'md 3/29/2007 13:45'! renameTo: aSymbol | oldSelector oldCategory oldMethod | "self halt" oldSelector := self methodNode selector. oldCategory := self methodClass organization categoryOfElement: oldSelector. oldMethod := self compiledMethod. self modifyMethodNode: [ :node | node selector: aSymbol ]. self methodClass addSelector: aSymbol withMethod: self. self methodClass organization classify: aSymbol under: oldCategory. self invalidate. self putSourceInChangesCategory: oldCategory priorMethod: oldMethod. self methodClass removeSelector: oldSelector. SystemChangeNotifier uniqueInstance methodChangedFrom: oldMethod to: self compiledMethod selector: aSymbol inClass: self methodClass ! ! !ReflectiveMethod methodsFor: 'interpretation' stamp: 'pmm 11/27/2006 18:50'! resetInterpreterClass ^self properties removeKey: #interpreterClass ifAbsent: [ "ignore" ]! ! !ReflectiveMethod methodsFor: 'running' stamp: 'md 4/18/2007 12:42'! run: oldSelector with: arguments in: aReceiver "for the following recompile, install the old method again... it will be overrridden as soon as we have generated a new one. Maybe this needs to block other threads..." | class | class := classBinding value. class methodDict at: oldSelector put: compiledMethod. oldSelector flushCache. compiledMethod := self generateCompiledMethod. class addSelectorSilently: oldSelector withMethod: compiledMethod. ^aReceiver withArgs: arguments executeMethod: compiledMethod.! ! !ReflectiveMethod methodsFor: 'scanning-legacy' stamp: 'pmm 7/17/2005 14:14'! scanFor: byte ^self compiledMethod scanFor: byte ! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'md 4/14/2007 10:06'! selector ^self properties selector! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'md 4/14/2007 10:07'! selector: aSymbol self properties selector: aSymbol. self modifyMethodNode: [ :node | node selector: aSymbol ].! ! !ReflectiveMethod methodsFor: 'refactoring browser' stamp: 'md 3/31/2007 19:06'! sendsSelector: aSymbol | visitor | visitor := PEMessageSendSearcher selector: aSymbol. visitor visitNode: self methodNode. ^visitor found! ! !ReflectiveMethod methodsFor: 'scanning-legacy' stamp: 'md 3/27/2007 15:39'! sendsToSuper ^self compiledMethod sendsToSuper.! ! !ReflectiveMethod methodsFor: 'private' stamp: 'md 3/29/2007 14:03'! setMethodClass: aClass classBinding := aClass binding.! ! !ReflectiveMethod methodsFor: 'source code management-legacy' stamp: 'md 3/29/2007 13:47'! setSourcePointer: srcPointer self hasCompiledMethod ifTrue: [ self compiledMethod setSourcePointer: srcPointer ]. sourcePointer := srcPointer! ! !ReflectiveMethod methodsFor: 'source code management-legacy' stamp: 'md 3/29/2007 13:48'! setSourcePosition: position inFile: fileIndex self hasCompiledMethod ifTrue: [ self compiledMethod setSourcePosition: position inFile: fileIndex ]. sourcePointer := position! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'pmm 7/19/2005 07:05'! sourceCode ^self methodNode source! ! !ReflectiveMethod methodsFor: 'source code management-legacy' stamp: 'md 3/29/2007 13:46'! sourcePointer ^ sourcePointer.! ! !ReflectiveMethod methodsFor: 'printing-legacy' stamp: 'pmm 9/8/2005 20:15'! symbolic ^self compiledMethod symbolic! ! !ReflectiveMethod methodsFor: 'accessing' stamp: 'pmm 7/11/2005 15:48'! tempNames ^self methodNode tempNames! ! !ReflectiveMethod methodsFor: 'source code management-legacy' stamp: 'pmm 7/15/2005 13:54'! timeStamp "Answer the authoring time-stamp for the given method, retrieved from the sources or changes file. Answer the empty string if no time stamp is available." "(CompiledMethod compiledMethodAt: #timeStamp) timeStamp" ^self compiledMethod timeStamp ! ! !ReflectiveMethod methodsFor: 'accessing-legacy' stamp: 'pmm 7/15/2005 13:46'! trailer ^self compiledMethod trailer! ! !ReflectiveMethod methodsFor: 'compression' stamp: 'md 4/17/2007 17:17'! uncompress | zipped | zipped := GZipReadStream on: methodNode. ^ (ReferenceStream on: zipped) next.! ! !ReflectiveMethod methodsFor: 'actions' stamp: 'md 3/5/2007 10:46'! updateSource: oldCompiledMethod | selector category | selector := self methodNode selector. category := self methodClass organization categoryOfElement: selector. self putSourceInChangesCategory: category priorMethod: oldCompiledMethod. SystemChangeNotifier uniqueInstance methodChangedFrom: oldCompiledMethod to: self compiledMethod selector: selector inClass: self methodClass. self methodClass addSelectorSilently: self selector withMethod: self compiledMethod.! ! !ReflectiveMethod methodsFor: 'refactoring browser' stamp: 'pmm 7/15/2005 13:50'! withAllBlockMethods ^self compiledMethod withAllBlockMethods! ! !ReflectiveMethod methodsFor: 'refactoring browser' stamp: 'pmm 7/15/2005 13:50'! withAllBlockMethodsDo: aOneArgumentBlock self compiledMethod withAllBlockMethodsDo: aOneArgumentBlock ! ! !ReflectiveMethod methodsFor: 'testing-legacy' stamp: 'pmm 10/4/2006 12:52'! writesField: varIndex | variableName | variableName := self nameForInstVarAt: varIndex. self nodesDo: [ :each | (each isVariable and: [ each name = variableName ] and: [ each isWrite ]) ifTrue: [ ^true ] ]. ^false! ! !RBSequenceNode class methodsFor: '*persephone' stamp: 'pmm 9/19/2006 18:33'! statement: aNode ^self statements: (Array with: aNode) ! ! !RBSequenceNode methodsFor: '*persephone' stamp: 'pmm 7/22/2006 13:34'! asSequenceNode ^self! ! !RBSequenceNode methodsFor: '*persephone' stamp: 'md 3/21/2007 13:40'! countReturns ^PEReturnCounter returnsIn: self! ! !RBSequenceNode methodsFor: '*persephone' stamp: 'pmm 9/24/2006 10:32'! evaluate ^(RBDoItNode body: self copy) evaluate! ! !RBSequenceNode methodsFor: '*persephone' stamp: 'pmm 8/28/2006 11:37'! hasReturnAtMostAtEnd "returns true if I contain at most one return and it is a the end" | returns | returns := self countReturns. ^self statements isEmpty or: [ returns = 0 ] or: [ returns = 1 and: [ self statements last isReturn ] ]! ! !RBBlockNode methodsFor: '*persephone' stamp: 'md 4/14/2007 01:57'! numArgs ^self arguments size! ! !SequenceableCollection methodsFor: '*persephone' stamp: 'pmm 8/21/2006 10:28'! asSequenceNode ^RBSequenceNode statements: self! ! !SequenceableCollection methodsFor: '*persephone' stamp: 'pmm 8/11/2006 10:29'! literalIndexOf: anElement ^self literalIndexOf: anElement ifAbsent: [ self errorNotFound: anElement ]! ! RBProgramNodeVisitor subclass: #PECodeInterpreter instanceVariableNames: 'temps' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Interpreter'! PECodeInterpreter subclass: #PEBlockInterpreter uses: TBlock instanceVariableNames: 'methodInterpreter outerInterpreter blockNode' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Interpreter'! PEBlockInterpreter class uses: TBlock classTrait instanceVariableNames: ''! !PEBlockInterpreter class methodsFor: 'instance creation' stamp: 'pmm 4/28/2006 10:43'! block: aBlockNode interpreter: aMethodInterpreter ^self new blockNode: aBlockNode; methodInterpreter: aMethodInterpreter; outerInterpreter: aMethodInterpreter; yourself! ! !PEBlockInterpreter class methodsFor: 'instance creation' stamp: 'pmm 4/28/2006 10:44'! block: aBlockNode methodDnterpreter: aMethodInterpreter outerInterpreter: aCodeInterpreter ^self new blockNode: aBlockNode; methodInterpreter: aMethodInterpreter; outerInterpreter: aCodeInterpreter; yourself! ! !PEBlockInterpreter class methodsFor: 'instance creation' stamp: 'pmm 4/28/2006 10:45'! block: aBlockNode methodInterpreter: aMethodInterpreter outerInterpreter: aCodeInterpreter ^self new blockNode: aBlockNode; methodInterpreter: aMethodInterpreter; outerInterpreter: aCodeInterpreter; yourself! ! !PEBlockInterpreter methodsFor: 'visitor-double dispatching' stamp: 'pmm 4/28/2006 19:01'! acceptBlockNode: aBlockNode ^self blockInterpreterClass block: aBlockNode methodInterpreter: methodInterpreter outerInterpreter: self! ! !PEBlockInterpreter methodsFor: 'exceptions' stamp: 'pmm 5/1/2006 12:33'! assert self assert: self! ! !PEBlockInterpreter methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:20'! bench "See how many times I can value in 5 seconds. I'll answer a meaningful description." | startTime endTime count | count := 0. endTime := Time millisecondClockValue + 5000. startTime := Time millisecondClockValue. [ Time millisecondClockValue > endTime ] whileFalse: [ self value. count := count + 1 ]. endTime := Time millisecondClockValue. ^count = 1 ifTrue: [ ((endTime - startTime) // 1000) printString, ' seconds.' ] ifFalse: [ ((count * 1000) / (endTime - startTime)) asFloat printString, ' per second.' ]! ! !PEBlockInterpreter methodsFor: 'accessing' stamp: 'pmm 4/24/2006 20:13'! blockNode ^blockNode! ! !PEBlockInterpreter methodsFor: 'accessing' stamp: 'pmm 4/24/2006 20:13'! blockNode: aBlockNode blockNode := aBlockNode! ! !PEBlockInterpreter methodsFor: 'accessing' stamp: 'pmm 4/27/2006 21:44'! codeNode ^blockNode! ! !PEBlockInterpreter methodsFor: 'private' stamp: 'pmm 5/1/2006 12:36'! copyForSaving "obsolete"! ! !PEBlockInterpreter methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:16'! doWhileFalse: conditionBlock "Evaluate the receiver once, then again as long the value of conditionBlock is false." | result | [result := self value. conditionBlock value] whileFalse. ^ result! ! !PEBlockInterpreter methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:17'! doWhileTrue: conditionBlock "Evaluate the receiver once, then again as long the value of conditionBlock is true." | result | [result := self value. conditionBlock value] whileTrue. ^ result! ! !PEBlockInterpreter methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:21'! durationToRun "Answer the duration taken to execute this block." ^ Duration milliSeconds: self timeToRun ! ! !PEBlockInterpreter methodsFor: 'exceptions' stamp: 'pmm 5/1/2006 12:33'! ensure: aBlock "Evaluate a termination block after evaluating the receiver, regardless of whether the receiver's evaluation completes." | returnValue b | returnValue := self value. "aBlock wasn't nil when execution of this method began; it is nil'd out by the unwind machinery, and that's how we know it's already been evaluated ... otherwise, obviously, it needs to be evaluated" aBlock == nil ifFalse: [ "nil out aBlock temp before evaluating aBlock so it is not executed again if aBlock remote returns" b := aBlock. thisContext tempAt: 1 put: nil. "aBlock := nil" b value. ]. ^ returnValue! ! !PEBlockInterpreter methodsFor: 'private' stamp: 'pmm 5/1/2006 12:36'! fixTemps "obsolete"! ! !PEBlockInterpreter methodsFor: 'scheduling' stamp: 'pmm 5/1/2006 12:37'! fork "Create and schedule a Process running the code in the receiver." ^ self newProcess resume! ! !PEBlockInterpreter methodsFor: 'scheduling' stamp: 'pmm 5/1/2006 12:37'! forkAndWait "Suspend current process while self runs" | semaphore | semaphore := Semaphore new. [self ensure: [semaphore signal]] fork. semaphore wait. ! ! !PEBlockInterpreter methodsFor: 'scheduling' stamp: 'pmm 5/1/2006 12:38'! forkAt: priority "Create and schedule a Process running the code in the receiver at the given priority. Answer the newly created process." ^ self newProcess priority: priority; resume! ! !PEBlockInterpreter methodsFor: 'scheduling' stamp: 'pmm 5/1/2006 12:38'! forkAt: priority named: name "Create and schedule a Process running the code in the receiver at the given priority and having the given name. Answer the newly created process." | forkedProcess | forkedProcess := self newProcess. forkedProcess priority: priority. forkedProcess name: name. ^ forkedProcess resume! ! !PEBlockInterpreter methodsFor: 'scheduling' stamp: 'pmm 5/1/2006 12:38'! forkNamed: aString "Create and schedule a Process running the code in the receiver and having the given name." ^ self newProcess name: aString; resume! ! !PEBlockInterpreter methodsFor: 'exceptions' stamp: 'pmm 5/1/2006 15:57'! ifCurtailed: aBlock "Evaluate the receiver with an abnormal termination action." ^ [ self value ] ifCurtailed: aBlock! ! !PEBlockInterpreter methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:21'! ifError: errorHandlerBlock "Evaluate the block represented by the receiver, and normally return it's value. If an error occurs, the errorHandlerBlock is evaluated, and it's value is instead returned. The errorHandlerBlock must accept zero, one, or two parameters (the error message and the receiver)." "Examples: [1 whatsUpDoc] ifError: [:err :rcvr | 'huh?']. [1 / 0] ifError: [:err :rcvr | 'ZeroDivide' = err ifTrue: [Float infinity] ifFalse: [self error: err]] " ^ self on: Error do: [:ex | errorHandlerBlock valueWithPossibleArgs: {ex description. ex receiver}]! ! !PEBlockInterpreter methodsFor: 'accessing-variables' stamp: 'pmm 4/28/2006 10:28'! instanceVariableAt: aString ^methodInterpreter instanceVariableAt: aString! ! !PEBlockInterpreter methodsFor: 'accessing-variables' stamp: 'pmm 4/28/2006 10:28'! instanceVariableAt: aString put: anObject ^methodInterpreter instanceVariableAt: aString put: anObject! ! !PEBlockInterpreter methodsFor: 'accessing' stamp: 'pmm 5/1/2006 12:14'! isBlock ^ true! ! !PEBlockInterpreter methodsFor: 'accessing' stamp: 'pmm 4/24/2006 20:54'! methodClass ^methodInterpreter methodClass! ! !PEBlockInterpreter methodsFor: 'accessing' stamp: 'pmm 4/24/2006 19:55'! methodInterpreter ^methodInterpreter! ! !PEBlockInterpreter methodsFor: 'accessing' stamp: 'pmm 4/24/2006 20:14'! methodInterpreter: aMethodInterpreter methodInterpreter := aMethodInterpreter! ! !PEBlockInterpreter methodsFor: 'scheduling' stamp: 'pmm 5/1/2006 12:38'! newProcess "Answer a Process running the code in the receiver. The process is not scheduled." "Simulation guard" ^ Process forContext: [self value. Processor terminateActive] asContext priority: Processor activePriority! ! !PEBlockInterpreter methodsFor: 'accessing' stamp: 'pmm 8/23/2006 13:54'! nodesForInstrumentation ^Array with: self blockNode copy! ! !PEBlockInterpreter methodsFor: 'accessing' stamp: 'pmm 4/28/2006 10:53'! numArgs ^blockNode numArgs! ! !PEBlockInterpreter methodsFor: 'exceptions' stamp: 'pmm 5/1/2006 15:56'! on: exception do: handlerAction "Evaluate the receiver in the scope of an exception handler." ^[ self value ] on: exception do: handlerAction! ! !PEBlockInterpreter methodsFor: 'exceptions' stamp: 'pmm 5/1/2006 12:35'! onDNU: selector do: handleBlock "Catch MessageNotUnderstood exceptions but only those of the given selector (DNU stands for doesNotUnderstand:)" ^ self on: MessageNotUnderstood do: [:exception | exception message selector = selector ifTrue: [handleBlock valueWithPossibleArgs: {exception}] ifFalse: [exception pass] ]! ! !PEBlockInterpreter methodsFor: 'accessing' stamp: 'pmm 4/28/2006 10:42'! outerInterpreter ^outerInterpreter! ! !PEBlockInterpreter methodsFor: 'accessing' stamp: 'pmm 4/28/2006 10:43'! outerInterpreter: aCodeInterpreter outerInterpreter := aCodeInterpreter! ! !PEBlockInterpreter methodsFor: 'accessing' stamp: 'pmm 4/24/2006 20:51'! receiver ^methodInterpreter receiver! ! !PEBlockInterpreter methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:17'! repeat "Evaluate the receiver repeatedly, ending only if the block explicitly returns." [self value. true] whileTrue! ! !PEBlockInterpreter methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:18'! repeatWithGCIf: testBlock | ans | "run the receiver, and if testBlock returns true, garbage collect and run the receiver again" ans := self value. (testBlock value: ans) ifTrue: [ Smalltalk garbageCollect. ans := self value ]. ^ans! ! !PEBlockInterpreter methodsFor: 'returning' stamp: 'pmm 4/26/2006 17:45'! return: anObject self methodInterpreter return: anObject! ! !PEBlockInterpreter methodsFor: 'scheduling' stamp: 'pmm 5/1/2006 12:39'! simulate "Like run except interpret self using Smalltalk instead of VM. It is much slower." ^ self newProcess simulate! ! !PEBlockInterpreter methodsFor: 'accessing-variables' stamp: 'pmm 4/28/2006 10:52'! temporaryVariableAt: aString ^temps at: aString ifAbsent: [ outerInterpreter temporaryVariableAt: aString ]! ! !PEBlockInterpreter methodsFor: 'accessing-variables' stamp: 'pmm 4/28/2006 10:46'! temporaryVariableAt: aString put: anObject ^(temps includesKey: aString) ifTrue: [ temps at: aString put: anObject ] ifFalse: [ outerInterpreter temporaryVariableAt: aString put: anObject ]! ! !PEBlockInterpreter methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:22'! timeToRun "Answer the number of milliseconds taken to execute this block." ^ Time millisecondsToRun: self ! ! !PEBlockInterpreter methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:23'! value "Evaluate the block represented by the receiver." ^self valueWithArguments: #() ! ! !PEBlockInterpreter methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:24'! value: arg "Evaluate the block with the given argument. Fail if the block expects other than 1 arguments." ^self valueWithArguments: (Array with: arg)! ! !PEBlockInterpreter methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:25'! value: arg1 value: arg2 "Evaluate the block with the given arguments. Fail if the block expects other than 2 arguments." ^self valueWithArguments: (Array with: arg1 with: arg2)! ! !PEBlockInterpreter methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:25'! value: arg1 value: arg2 value: arg3 "Evaluate the block with the given arguments. Fail if the block expects other than 3 arguments." ^self valueWithArguments: (Array with: arg1 with: arg2 with: arg3)! ! !PEBlockInterpreter methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:26'! value: arg1 value: arg2 value: arg3 value: arg4 "Evaluate the block with the given arguments. Fail if the block expects other than 4 arguments." ^self valueWithArguments: (Array with: arg1 with: arg2 with: arg3 with: arg4)! ! !PEBlockInterpreter methodsFor: 'private' stamp: 'pmm 5/1/2006 12:36'! valueError self error: 'Incompatible number of args'! ! !PEBlockInterpreter methodsFor: 'exceptions' stamp: 'pmm 5/1/2006 12:35'! valueUninterruptably "Prevent remote returns from escaping the sender. Even attempts to terminate (unwind) this process will be halted and the process will resume here. A terminate message is needed for every one of these in the sender chain to get the entire process unwound." ^ self ifCurtailed: [^ self]! ! !PEBlockInterpreter methodsFor: 'evaluating' stamp: 'pmm 4/27/2006 21:45'! valueWithArguments: anArray self initializeArgumentsWith: anArray. ^self visitNode: blockNode body! ! !PEBlockInterpreter methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:32'! valueWithPossibleArgs: anArray "Evaluate the block represented by the receiver. If the block requires arguments, take them from anArray. If anArray is too large, the rest is ignored, if it is too small, use nil for the other arguments" | numArgs | numArgs := self numArgs. numArgs = 0 ifTrue: [^ self value]. numArgs = anArray size ifTrue: [^ self valueWithArguments: anArray]. ^ self valueWithArguments: (numArgs > anArray size ifTrue: [anArray, (Array new: numArgs - anArray size)] ifFalse: [anArray copyFrom: 1 to: numArgs])! ! !PEBlockInterpreter methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:31'! valueWithPossibleArgument: anArg "Evaluate the block represented by the receiver. If the block requires one argument, use anArg, if it requires more than one, fill up the rest with nils." | numArgs | numArgs := self numArgs. numArgs = 0 ifTrue: [^self value]. numArgs = 1 ifTrue: [^self value: anArg]. numArgs > 1 ifTrue: [^self valueWithArguments: {anArg}, (Array new: numArgs - 1)]! ! !PEBlockInterpreter methodsFor: 'evaluating' stamp: 'pmm 5/1/2006 12:32'! valueWithin: aDuration onTimeout: timeoutBlock "Evaluate the receiver. If the evaluation does not complete in less than aDuration evaluate the timeoutBlock instead" | theProcess delay watchdog done result | aDuration <= Duration zero ifTrue: [^ timeoutBlock value ]. "the block will be executed in the current process" theProcess := Processor activeProcess. delay := aDuration asDelay. "make a watchdog process" watchdog := [ delay wait. "wait for timeout or completion" done ifFalse: [ theProcess signalException: TimedOut ] ] newProcess. "watchdog needs to run at high priority to do its job" watchdog priority: Processor timingPriority. "catch the timeout signal" ^ [ done := false. watchdog resume. "start up the watchdog" result := self value. "evaluate the receiver" done := true. "it has completed, so ..." delay delaySemaphore signal. "arrange for the watchdog to exit" result ] on: TimedOut do: [ :e | timeoutBlock value ]. ! ! !PEBlockInterpreter methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:18'! whileFalse "Ordinarily compiled in-line, and therefore not overridable. This is in case the message is sent to other than a literal block. Evaluate the receiver, as long as its value is false." ^ [self value] whileFalse: []! ! !PEBlockInterpreter methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:18'! whileFalse: aBlock "Ordinarily compiled in-line, and therefore not overridable. This is in case the message is sent to other than a literal block. Evaluate the argument, aBlock, as long as the value of the receiver is false." ^ [self value] whileFalse: [aBlock value]! ! !PEBlockInterpreter methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:19'! whileTrue "Ordinarily compiled in-line, and therefore not overridable. This is in case the message is sent to other than a literal block. Evaluate the receiver, as long as its value is true." ^ [self value] whileTrue: []! ! !PEBlockInterpreter methodsFor: 'controlling' stamp: 'pmm 5/1/2006 12:19'! whileTrue: aBlock "Ordinarily compiled in-line, and therefore not overridable. This is in case the message is sent to other than a literal block. Evaluate the argument, aBlock, as long as the value of the receiver is true." ^ [self value] whileTrue: [aBlock value]! ! !PECodeInterpreter methodsFor: 'visitor-double dispatching' stamp: 'pmm 4/24/2006 20:12'! acceptArrayNode: anArrayNode ^anArrayNode children collect: [ :each | self visitNode: each ]! ! !PECodeInterpreter methodsFor: 'visitor-double dispatching' stamp: 'pmm 4/26/2006 17:06'! acceptAssignmentNode: anAssignmentNode self set: anAssignmentNode variable toValue: (self visitNode: anAssignmentNode value)! ! !PECodeInterpreter methodsFor: 'visitor-double dispatching' stamp: 'pmm 4/28/2006 10:45'! acceptBlockNode: aBlockNode self subclassResponsibility! ! !PECodeInterpreter methodsFor: 'visitor-double dispatching' stamp: 'pmm 4/24/2006 20:31'! acceptCascadeNode: aCascadeNode | receiver last | receiver := self visitNode: aCascadeNode receiver. aCascadeNode messages do: [ :each | last := receiver perform: each selector withArguments: (each arguments collect: [ :argument | self visitNode: argument] ) ]. ^last! ! !PECodeInterpreter methodsFor: 'visitor-double dispatching' stamp: 'pmm 4/29/2006 11:58'! acceptDoItNode: aDoItNode | localTempNames | localTempNames := aDoItNode tempNames. temps := Dictionary new: (localTempNames size). localTempNames do: [ :each | temps at: each put: nil ]. self visitNode: aDoItNode body ! ! !PECodeInterpreter methodsFor: 'visitor-double dispatching' stamp: 'pmm 4/24/2006 20:08'! acceptLiteralNode: aLiteralNode ^aLiteralNode value ! ! !PECodeInterpreter methodsFor: 'visitor-double dispatching' stamp: 'md 4/16/2007 21:25'! acceptMessageNode: aMessageNode | isSuperSend messageReceiver messageArguments | isSuperSend := aMessageNode isSuperSend. messageReceiver := isSuperSend ifTrue: [ self receiver ] ifFalse: [ self visitNode: aMessageNode receiver ]. messageArguments := aMessageNode arguments collect: [ :each | self visitNode: each ]. ^isSuperSend ifTrue: [ messageReceiver perform: aMessageNode selector withArguments: messageArguments inSuperclass: self methodClass superclass ] ifFalse: [ messageReceiver perform: aMessageNode selector withArguments: messageArguments ]! ! !PECodeInterpreter methodsFor: 'visitor-double dispatching' stamp: 'pmm 4/27/2006 23:37'! acceptReturnNode: aReturnNode self return: (self visitNode: aReturnNode value)! ! !PECodeInterpreter methodsFor: 'visitor-double dispatching' stamp: 'pmm 4/24/2006 20:22'! acceptSequenceNode: aSequenceNode | last | last := nil. aSequenceNode statements do: [:each | last := self visitNode: each ]. ^last! ! !PECodeInterpreter methodsFor: 'visitor-double dispatching' stamp: 'md 3/31/2007 19:01'! acceptVariableNode: aVariableNode | name | name := aVariableNode name. (#('self' 'super') includes: name) ifTrue: [ ^self receiver ]. name = 'true' ifTrue: [ ^true ]. name = 'false' ifTrue: [ ^false ]. name = 'nil' ifTrue: [ ^nil ]. name = 'thisContext' ifTrue: [ ^ PEInterpreterContext codeInterpreter: self ]. ^aVariableNode ifTemp: [ self temporaryVariableAt: name ] ifInstance: [ self instanceVariableAt: name ] ifGlobal: [ (self receiver class bindingOf: name) value ]! ! !PECodeInterpreter methodsFor: 'private' stamp: 'md 3/31/2007 19:17'! blockInterpreterClass ^PEBlockInterpreter! ! !PECodeInterpreter methodsFor: 'accessing' stamp: 'pmm 4/27/2006 21:44'! codeNode self subclassResponsibility ! ! !PECodeInterpreter methodsFor: 'initialize-release' stamp: 'pmm 4/29/2006 12:45'! initializeArgumentsWith: anArray | localTempNames | localTempNames := self codeNode tempNames. temps := Dictionary new: (localTempNames size). localTempNames do: [ :each | temps at: each put: nil ]. self codeNode arguments withIndexDo: [ :each :index | temps at: each name put: (anArray at: index) ].! ! !PECodeInterpreter methodsFor: 'accessing-variables' stamp: 'pmm 4/26/2006 10:52'! instanceVariableAt: aString self subclassResponsibility ! ! !PECodeInterpreter methodsFor: 'accessing-variables' stamp: 'pmm 4/26/2006 17:03'! instanceVariableAt: aString put: anObject self subclassResponsibility ! ! !PECodeInterpreter methodsFor: 'accessing' stamp: 'pmm 4/24/2006 20:52'! methodClass self subclassResponsibility ! ! !PECodeInterpreter methodsFor: 'accessing' stamp: 'pmm 4/24/2006 20:16'! methodInterpreter self subclassResponsibility ! ! !PECodeInterpreter methodsFor: 'accessing' stamp: 'pmm 4/24/2006 20:51'! receiver self subclassResponsibility ! ! !PECodeInterpreter methodsFor: 'returning' stamp: 'pmm 4/24/2006 19:55'! return: anObject self subclassResponsibility ! ! !PECodeInterpreter methodsFor: 'accessing-variables' stamp: 'pmm 7/1/2006 15:21'! set: aVariable toValue: anObject aVariable ifTemp: [ self temporaryVariableAt: aVariable name put: anObject ] ifInstance: [ self instanceVariableAt: aVariable name put: anObject ] ifGlobal: [ (self receiver class bindingOf: aVariable name) value: anObject ]. ^anObject! ! !PECodeInterpreter methodsFor: 'accessing-variables' stamp: 'pmm 4/26/2006 10:53'! temporaryVariableAt: aString self subclassResponsibility ! ! !PECodeInterpreter methodsFor: 'accessing-variables' stamp: 'pmm 4/26/2006 17:02'! temporaryVariableAt: aString put: anObject self subclassResponsibility ! ! !PECodeInterpreter methodsFor: 'accessing' stamp: 'pmm 4/24/2006 16:29'! temps ^temps! ! !PECodeInterpreter methodsFor: 'accessing' stamp: 'pmm 4/24/2006 16:30'! temps: aDictionary temps := aDictionary! ! PECodeInterpreter subclass: #PEMethodInterpreter instanceVariableNames: 'receiver methodNode instanceVariableMap escaper' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Interpreter'! !PEMethodInterpreter class methodsFor: 'execution' stamp: 'pmm 4/29/2006 12:29'! evaluateDoIt: aDoItNode | instance | instance := self new. ^instance withEscaper: [ instance visitNode: aDoItNode ]! ! !PEMethodInterpreter class methodsFor: 'execution' stamp: 'pmm 8/19/2006 22:14'! run: aMethodNode with: anArray in: anObject ^self new methodNode: aMethodNode; initializeArgumentsWith: anArray; receiver: anObject; run! ! !PEMethodInterpreter methodsFor: 'visitor-double dispatching' stamp: 'pmm 4/28/2006 19:01'! acceptBlockNode: aBlockNode ^self blockInterpreterClass block: aBlockNode interpreter: self! ! !PEMethodInterpreter methodsFor: 'visitor-double dispatching' stamp: 'pmm 7/3/2006 09:11'! acceptMethodNode: aMethodNode aMethodNode isPrimitive ifTrue: [ self executePrimitve: aMethodNode ] ifFalse: [ self interpret: aMethodNode ]! ! !PEMethodInterpreter methodsFor: 'accessing' stamp: 'pmm 7/3/2006 08:36'! arguments ^self codeNode arguments collect: [ :each | temps at: each name ]! ! !PEMethodInterpreter methodsFor: 'accessing' stamp: 'pmm 4/27/2006 21:44'! codeNode ^methodNode! ! !PEMethodInterpreter methodsFor: 'executing' stamp: 'md 3/31/2007 19:18'! executePrimitve: aMethodNode | newMethodNode newBody newMethod | newMethodNode := aMethodNode copy. newBody := RBSequenceNode statement: ( RBMessageNode receiver: (PEObjectLiteralNode value: self) selector: #interpret: argument: (PEObjectLiteralNode value: aMethodNode)). newMethodNode body: newBody. newMethod := (ASTTranslator new visitNode: newMethodNode; ir) compiledMethodWith: #(0 0 0 0). self return: (newMethod valueWithReceiver: self receiver arguments: self arguments)! ! !PEMethodInterpreter methodsFor: 'accessing-variables' stamp: 'pmm 4/26/2006 11:23'! instanceVariableAt: aString ^self receiver instVarAt: (self instanceVariableMap at: aString)! ! !PEMethodInterpreter methodsFor: 'accessing-variables' stamp: 'pmm 4/26/2006 17:20'! instanceVariableAt: aString put: anObject ^self receiver instVarAt: (self instanceVariableMap at: aString) put: anObject! ! !PEMethodInterpreter methodsFor: 'accessing' stamp: 'pmm 4/27/2006 23:05'! instanceVariableMap instanceVariableMap isNil ifTrue: [ instanceVariableMap := Dictionary new. receiver class allInstVarNames withIndexDo: [ :each :index | instanceVariableMap at: each put: index ] ]. ^instanceVariableMap! ! !PEMethodInterpreter methodsFor: 'executing' stamp: 'pmm 7/3/2006 08:21'! interpret: aMethodNode self visitNode: aMethodNode body. self returnSelf! ! !PEMethodInterpreter methodsFor: 'accessing' stamp: 'pmm 4/24/2006 20:54'! methodClass ^methodNode methodClass! ! !PEMethodInterpreter methodsFor: 'accessing' stamp: 'pmm 4/24/2006 20:16'! methodInterpreter ^self! ! !PEMethodInterpreter methodsFor: 'accessing' stamp: 'pmm 4/27/2006 22:04'! methodNode: aMethodNode methodNode := aMethodNode! ! !PEMethodInterpreter methodsFor: 'accessing' stamp: 'pmm 4/24/2006 20:20'! receiver ^receiver! ! !PEMethodInterpreter methodsFor: 'accessing' stamp: 'pmm 4/24/2006 20:20'! receiver: anObject receiver := anObject! ! !PEMethodInterpreter methodsFor: 'returning' stamp: 'pmm 4/27/2006 23:43'! return: anObject escaper value: anObject! ! !PEMethodInterpreter methodsFor: 'returning' stamp: 'pmm 4/27/2006 23:43'! returnSelf self return: receiver ! ! !PEMethodInterpreter methodsFor: 'executing' stamp: 'pmm 4/27/2006 22:06'! run ^self withEscaper: [ self visitNode: methodNode ]! ! !PEMethodInterpreter methodsFor: 'accessing-variables' stamp: 'pmm 4/28/2006 10:53'! temporaryVariableAt: aString ^temps at: aString! ! !PEMethodInterpreter methodsFor: 'accessing-variables' stamp: 'pmm 4/26/2006 17:22'! temporaryVariableAt: aString put: anObject ^temps at: aString put: anObject! ! !PEMethodInterpreter methodsFor: 'visiting' stamp: 'pmm 4/24/2006 16:39'! visitBlockArguments: aNodeCollection self shouldNotImplement! ! !PEMethodInterpreter methodsFor: 'escaping' stamp: 'pmm 4/26/2006 21:13'! withEscaper: aBlock | old | old := escaper. escaper := [ :value | ^ value ]. ^ aBlock ensure: [ escaper := old ]! ! RBProgramNodeVisitor subclass: #PECompilerPlugin instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Visitors'! PECompilerPlugin subclass: #AssertionTransformer instanceVariableNames: 'assertedNodes' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Examples'! !AssertionTransformer class methodsFor: 'class initialization' stamp: 'pmm 10/27/2005 11:15'! initialize "self initialize" Preferences addBooleanPreference: #useAssertions category: #compiler default: true balloonHelp: 'If selected assertions get compiled in.'! ! !AssertionTransformer class methodsFor: 'accessing' stamp: 'pmm 6/11/2006 10:41'! priority ^16rFF! ! !AssertionTransformer methodsFor: 'accessing' stamp: 'pmm 9/16/2005 09:12'! addAssertedNode: aNode ^self assertedNodes add: aNode! ! !AssertionTransformer methodsFor: 'testing' stamp: 'pmm 9/16/2005 09:17'! alreadyAsserted: aNode ^self assertedNodes includes: aNode! ! !AssertionTransformer methodsFor: 'accessing' stamp: 'pmm 9/16/2005 09:12'! assertedNodes ^assertedNodes! ! !AssertionTransformer methodsFor: 'accessing' stamp: 'pmm 9/16/2005 09:12'! assertedNodes: aSet assertedNodes := aSet! ! !AssertionTransformer methodsFor: 'accessing' stamp: 'pmm 10/9/2005 22:33'! assertionAnnotationKey ^AssertionAnnotation assertionAnnotationKey ! ! !AssertionTransformer methodsFor: 'initialize-release' stamp: 'pmm 9/16/2005 09:11'! initialize super initialize. self assertedNodes: IdentitySet new! ! !AssertionTransformer methodsFor: 'testing' stamp: 'pmm 9/16/2005 09:17'! notAlreadyAsserted: aNode ^(self alreadyAsserted: aNode) not! ! !AssertionTransformer methodsFor: 'private' stamp: 'pmm 9/19/2005 11:05'! removeNode: aNode aNode parent removeNode: aNode! ! !AssertionTransformer methodsFor: 'testing' stamp: 'pmm 10/27/2005 11:08'! shouldAssert: aNode ^(aNode hasAnnotation: self assertionAnnotationKey) and: [ self notAlreadyAsserted: aNode ] and: [ self useAssertions ]! ! !AssertionTransformer methodsFor: 'testing' stamp: 'pmm 9/19/2005 16:52'! shouldRemove: aNode ^(aNode hasAnnotation: self assertionAnnotationKey) and: [ self notAlreadyAsserted: aNode ] and: [ self useAssertions not ]! ! !AssertionTransformer methodsFor: 'transforming' stamp: 'pmm 11/27/2006 16:21'! transformAssertedNode: aNode | selfVar message oldParent | self addAssertedNode: aNode. oldParent := aNode parent. selfVar := 'self' asVariableNode. message := RBMessageNode receiver: selfVar selector: #assert: argument: aNode. selfVar parent: message. aNode parent: message. oldParent replaceNodeAndSetParent: aNode withNode: message. self visitNode: message! ! !AssertionTransformer methodsFor: 'testing' stamp: 'pmm 9/16/2005 09:17'! useAssertions ^ Preferences useAssertions! ! !AssertionTransformer methodsFor: 'visiting' stamp: 'pmm 9/19/2005 17:23'! visitNode: aNode ^(self shouldAssert: aNode) ifTrue: [ self transformAssertedNode: aNode ] ifFalse: [ (self shouldRemove: aNode) ifTrue: [ self removeNode: aNode ] ifFalse: [ super visitNode: aNode ] ]! ! PECompilerPlugin subclass: #CompiletimeEvaluator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Examples'! !CompiletimeEvaluator methodsFor: 'transforming' stamp: 'md 3/31/2007 19:18'! evaluateNow: aNode | body doit value literalNode | body := RBSequenceNode statement: aNode copy. doit := RBDoItNode body: body. value := doit compiledMethod valueWithReceiver: nil arguments: #(). literalNode := PEObjectLiteralNode value: value. aNode parent replaceNodeAndSetParent: aNode withNode: literalNode. ^self visitNode: literalNode! ! !CompiletimeEvaluator methodsFor: 'accessing' stamp: 'pmm 1/14/2006 14:49'! evaluteAtCompiletimeAnnotaionKey ^EvaluateAtCompiletimeAnnotation evaluteAtCompiletimeAnnotaionKey! ! !CompiletimeEvaluator methodsFor: 'visiting' stamp: 'pmm 1/14/2006 14:50'! visitNode: aNode ^(aNode hasAnnotation: self evaluteAtCompiletimeAnnotaionKey) ifTrue: [ self evaluateNow: aNode ] ifFalse: [ super visitNode: aNode ]! ! PECompilerPlugin subclass: #PEAssertDisabler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Examples'! !PEAssertDisabler class methodsFor: 'class initialization' stamp: 'md 4/15/2007 15:10'! initialize Preferences addBooleanPreference: #disableAssert categories: #(persephone) default: false balloonHelp: 'If true, we do not compile any code for assert: outside of the TestCase hierarchy.' projectLocal: false changeInformee: self changeSelector: #invalidateSenderOfAssert. ! ! !PEAssertDisabler class methodsFor: 'invalidation' stamp: 'md 4/15/2007 15:19'! invalidateSenderOfAssert ((SystemNavigation new allCallsOn: #assert:) select: [:each | (each methodClass inheritsFrom: TestCase) not]) do: [:ref | ref compiledMethod invalidate].! ! !PEAssertDisabler class methodsFor: 'plugin interface' stamp: 'md 3/26/2007 22:47'! isCompilerBackendPlugin ^Preferences disableAssert! ! !PEAssertDisabler methodsFor: 'visitor-double dispatching' stamp: 'md 4/15/2007 15:27'! acceptMessageNode: aNode (aNode selector == #assert:) ifTrue: [ "we do not want to remove assertions in tests..." (aNode methodNode methodClass inheritsFrom: TestCase) ifFalse: [ aNode replaceWith: (RBVariableNode named: 'self')]]. super acceptMessageNode: aNode.! ! !PECompilerPlugin class methodsFor: 'plugin interface' stamp: 'md 3/16/2007 11:24'! isCompilerBackendPlugin ^true! ! !PECompilerPlugin class methodsFor: 'plugin interface' stamp: 'md 3/16/2007 11:24'! priority ^16rFFFF! ! PECompilerPlugin subclass: #PELiteralEvaluator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Examples'! PELiteralEvaluator class instanceVariableNames: 'enabled'! PELiteralEvaluator class instanceVariableNames: 'enabled'! PELiteralEvaluator subclass: #PEAggressiveLiteralEvaluator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Examples'! !PEAggressiveLiteralEvaluator commentStamp: 'pmm 9/24/2006 10:58' prior: 0! This inliner will stop inlining once the value is no longer a literal.! !PEAggressiveLiteralEvaluator methodsFor: 'testing' stamp: 'pmm 9/24/2006 12:16'! isAcceptable: aResult ^true! ! PELiteralEvaluator subclass: #PEConvervativeLiteralEvaluator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Examples'! !PEConvervativeLiteralEvaluator commentStamp: 'pmm 9/24/2006 10:56' prior: 0! This inliner will inline only as long as the result is a literal.! !PEConvervativeLiteralEvaluator methodsFor: 'testing' stamp: 'pmm 9/24/2006 10:56'! isAcceptable: aResult ^aResult isLiteral! ! !PELiteralEvaluator class methodsFor: 'accessing' stamp: 'pmm 9/24/2006 10:27'! enabled ^enabled ifNil: [ false ]! ! !PELiteralEvaluator class methodsFor: 'accessing' stamp: 'pmm 9/24/2006 10:28'! enabled: aBoolean enabled := aBoolean! ! !PELiteralEvaluator class methodsFor: 'testing' stamp: 'pmm 9/24/2006 10:28'! isCompilerBackendPlugin ^self isEnabled ! ! !PELiteralEvaluator class methodsFor: 'testing' stamp: 'pmm 9/24/2006 10:27'! isEnabled ^self enabled! ! !PELiteralEvaluator class methodsFor: 'accessing' stamp: 'pmm 9/24/2006 12:12'! priority ^16r1000! ! !PELiteralEvaluator methodsFor: 'visitor-double dispatching' stamp: 'pmm 9/24/2006 11:03'! acceptMessageNode: aMessageNode (self canInline: aMessageNode) ifTrue: [ self inline: aMessageNode ] ifFalse: [ super acceptMessageNode: aMessageNode ]! ! !PELiteralEvaluator methodsFor: 'testing' stamp: 'pmm 9/24/2006 11:02'! canInline: aMessageNode ^aMessageNode receiver isLiteral and: [ aMessageNode arguments allSatisfy: [ :each | each isLiteral ] ] and: [ aMessageNode isCascaded not ]! ! !PELiteralEvaluator methodsFor: 'private' stamp: 'pmm 9/24/2006 10:55'! inline: aMessageNode | value | value := aMessageNode evaluate. (self isAcceptable: value) ifTrue: [ aMessageNode replaceWith: (RBLiteralNode value: value). self visitNode: aMessageNode parent ]! ! !PELiteralEvaluator methodsFor: 'testing' stamp: 'pmm 9/24/2006 10:34'! isAcceptable: aResult self subclassResponsibility ! ! PECompilerPlugin subclass: #PELiteralReducer instanceVariableNames: 'normalLiterals objectLiterals' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Examples'! !PELiteralReducer class methodsFor: 'accessing' stamp: 'pmm 8/11/2006 09:56'! priority ^16rFFFFFFFF! ! !PELiteralReducer methodsFor: 'visitor-double dispatching' stamp: 'pmm 8/11/2006 10:06'! acceptLiteralNode: aLiteralNode normalLiterals literalIndexOf: aLiteralNode ifAbsent: [ normalLiterals add: aLiteralNode ]! ! !PELiteralReducer methodsFor: 'visitor-double dispatching' stamp: 'pmm 8/11/2006 10:05'! acceptObjectLiteralNode: anObjectLiteralNode objectLiterals literalIndexOf: anObjectLiteralNode ifAbsent: [ objectLiterals add: anObjectLiteralNode ]! ! !PELiteralReducer methodsFor: 'testing' stamp: 'pmm 8/11/2006 10:08'! hasTooManyLiterals ^normalLiterals size + objectLiterals size > self maximumLiterals ! ! !PELiteralReducer methodsFor: 'initialize-release' stamp: 'pmm 8/11/2006 09:58'! initialize super initialize. normalLiterals := OrderedCollection new. objectLiterals := OrderedCollection new.! ! !PELiteralReducer methodsFor: 'accessing' stamp: 'pmm 8/11/2006 10:03'! maximumLiterals "256 is maximum one is used for properties and one is used for selector and method class" ^256 - 2 ! ! !PELiteralReducer methodsFor: 'actions' stamp: 'pmm 8/11/2006 10:09'! reduceLiterals self hasTooManyLiterals ifFalse: [ ^self ].! ! !PELiteralReducer methodsFor: 'visiting' stamp: 'pmm 8/11/2006 10:09'! visitNode: aNode super visitNode: aNode. aNode isMethod ifTrue: [ self reduceLiterals ]! ! RBProgramNodeVisitor subclass: #PEInstrumentationVisitor instanceVariableNames: 'block' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Visitors'! !PEInstrumentationVisitor class methodsFor: 'instance creation' stamp: 'pmm 9/24/2005 10:08'! block: aBlock ^self new block: aBlock; yourself! ! !PEInstrumentationVisitor methodsFor: 'accessing' stamp: 'pmm 9/24/2005 10:07'! block ^block! ! !PEInstrumentationVisitor methodsFor: 'accessing' stamp: 'pmm 6/11/2006 21:51'! block: aBlock block := aBlock! ! PEInstrumentationVisitor subclass: #PEMethodBodyInstrumentationVisitor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Visitors'! !PEMethodBodyInstrumentationVisitor methodsFor: 'visitor-double dispatching' stamp: 'pmm 9/25/2006 09:18'! acceptAssignmentNode: anAssignmentNode super acceptAssignmentNode: anAssignmentNode. self block value: anAssignmentNode! ! !PEMethodBodyInstrumentationVisitor methodsFor: 'visitor-double dispatching' stamp: 'pmm 11/11/2006 16:34'! acceptBlockNode: aBlockNode self block value: aBlockNode. "don't care about arguments" self visitNode: aBlockNode body! ! !PEMethodBodyInstrumentationVisitor methodsFor: 'visitor-double dispatching' stamp: 'pmm 9/25/2006 09:19'! acceptLiteralNode: aLiteralNode self block value: aLiteralNode! ! !PEMethodBodyInstrumentationVisitor methodsFor: 'visitor-double dispatching' stamp: 'pmm 9/25/2006 09:19'! acceptMessageNode: aMessageNode super acceptMessageNode: aMessageNode. self block value: aMessageNode! ! !PEMethodBodyInstrumentationVisitor methodsFor: 'visitor-double dispatching' stamp: 'pmm 9/25/2006 09:19'! acceptReturnNode: aReturnNode super acceptReturnNode: aReturnNode. self block value: aReturnNode! ! !PEMethodBodyInstrumentationVisitor methodsFor: 'visitor-double dispatching' stamp: 'pmm 11/11/2006 16:34'! acceptSequenceNode: aSequenceNode self block value: aSequenceNode. "don't care about temps" aSequenceNode statements do: [:each | self visitNode: each]! ! !PEMethodBodyInstrumentationVisitor methodsFor: 'visitor-double dispatching' stamp: 'pmm 9/25/2006 09:19'! acceptVariableNode: aVariablNode self block value: aVariablNode! ! RBProgramNodeVisitor subclass: #PELiteralCollector instanceVariableNames: 'literals' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Visitors'! !PELiteralCollector methodsFor: 'as yet unclassified' stamp: 'md 4/15/2007 15:53'! acceptLiteralNode: aNode aNode value ifNotNil: [literals add: aNode value]. ^super acceptLiteralNode: aNode.! ! !PELiteralCollector methodsFor: 'as yet unclassified' stamp: 'md 4/15/2007 14:38'! acceptMessageNode: aMessageNode literals add: aMessageNode selector. ^super acceptMessageNode: aMessageNode.! ! !PELiteralCollector methodsFor: 'as yet unclassified' stamp: 'md 4/15/2007 15:47'! initialize literals := IdentitySet new.! ! !PELiteralCollector methodsFor: 'as yet unclassified' stamp: 'md 4/15/2007 14:37'! literals ^literals asArray.! ! RBProgramNodeVisitor subclass: #PEMessageSendSearcher instanceVariableNames: 'found selector' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Kernel'! !PEMessageSendSearcher class methodsFor: 'instance creation' stamp: 'pmm 7/8/2005 12:47'! selector: aSymbol ^self new selector: aSymbol; yourself! ! !PEMessageSendSearcher methodsFor: 'visitor-double dispatching' stamp: 'pmm 7/8/2005 12:44'! acceptMessageNode: aMessageNode aMessageNode selector = self selector ifTrue: [ self found: true ] ifFalse: [ super acceptMessageNode: aMessageNode ]! ! !PEMessageSendSearcher methodsFor: 'accessing' stamp: 'pmm 7/8/2005 12:42'! found ^found! ! !PEMessageSendSearcher methodsFor: 'accessing' stamp: 'pmm 7/8/2005 12:42'! found: aBoolean found _ aBoolean! ! !PEMessageSendSearcher methodsFor: 'initialize-release' stamp: 'pmm 7/8/2005 12:42'! initialize super initialize. self found: false.! ! !PEMessageSendSearcher methodsFor: 'accessing' stamp: 'pmm 7/8/2005 12:42'! selector ^selector! ! !PEMessageSendSearcher methodsFor: 'accessing' stamp: 'pmm 7/8/2005 12:43'! selector: aSymbol selector _ aSymbol! ! RBProgramNodeVisitor subclass: #PENodeReplacer instanceVariableNames: 'original replacement' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Visitors'! !PENodeReplacer class methodsFor: 'private' stamp: 'pmm 7/26/2006 10:42'! asDictionary: aCollectionOrAssociation ^aCollectionOrAssociation isDictionary ifTrue: [ aCollectionOrAssociation ] ifFalse: [ aCollectionOrAssociation isCollection ifTrue: [ Dictionary withAll: aCollectionOrAssociation ] ifFalse: [ Dictionary with: aCollectionOrAssociation ] ]! ! !PENodeReplacer class methodsFor: 'instance creation' stamp: 'pmm 11/7/2005 12:43'! original: anOriginalNode replacement: aReplacementNode ^self new original: anOriginalNode; replacement: aReplacementNode; yourself! ! !PENodeReplacer class methodsFor: 'utilities' stamp: 'pmm 11/7/2005 12:57'! replace: anOriginalNode with: aReplacementNode in: aNode (self original: anOriginalNode replacement: aReplacementNode) visitNode: aNode! ! !PENodeReplacer class methodsFor: 'private' stamp: 'md 4/13/2007 15:14'! replaceMetavariablesIn: aBlockNode with: aNode shared: aDictionary | newBlock | newBlock := aBlockNode copy. ^newBlock body! ! !PENodeReplacer class methodsFor: 'utilities' stamp: 'pmm 11/27/2006 16:19'! replaceVariablesIn: aNode using: aCollectionOrAssociation (self asDictionary: aCollectionOrAssociation) keysAndValuesDo: [ :variableName :newValue | self replace: variableName asVariableNode with: newValue asLiteralNode in: aNode ]! ! !PENodeReplacer class methodsFor: 'private' stamp: 'pmm 7/26/2006 15:42'! replacementNodeFor: aNode of: anAnnotedNode ^self replacementNodeFor: aNode of: anAnnotedNode shared: Dictionary new! ! !PENodeReplacer class methodsFor: 'private' stamp: 'pmm 7/26/2006 15:41'! replacementNodeFor: aNode of: anAnnotedNode shared: aDictionary | replacement | replacement := aNode isBlock ifFalse: [ aNode ] ifTrue: [ self replaceMetavariablesIn: aNode with: anAnnotedNode shared: aDictionary ]. ^(replacement isSequence and: [ replacement statements size = 1 ]) ifTrue: [ replacement statements first ] ifFalse: [ replacement ]! ! !PENodeReplacer methodsFor: 'accessing' stamp: 'pmm 11/7/2005 11:44'! original ^original! ! !PENodeReplacer methodsFor: 'accessing' stamp: 'pmm 6/11/2006 21:52'! original: aNode original := aNode! ! !PENodeReplacer methodsFor: 'accessing' stamp: 'pmm 11/7/2005 11:44'! replacement ^replacement! ! !PENodeReplacer methodsFor: 'accessing' stamp: 'pmm 6/11/2006 21:52'! replacement: aNode replacement := aNode! ! !PENodeReplacer methodsFor: 'visiting' stamp: 'pmm 9/24/2006 13:39'! visitNode: aNode ^(aNode = self original and: [ (aNode hasAnnotation: #dontreplace) not ]) ifFalse: [ super visitNode: aNode ] ifTrue: [ aNode parent replaceNodeAndSetParent: aNode withNode: (self replacement copy addAnnotation: ((GenericNoValueAnnotation key: #dontreplace) sourceVisible: false; yourself); yourself) ]! ! RBProgramNodeVisitor subclass: #PEReturnCounter instanceVariableNames: 'returns' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Visitors'! !PEReturnCounter class methodsFor: 'convenience' stamp: 'pmm 8/28/2006 11:33'! returnsIn: aNode ^self new visitNode: aNode; returns! ! !PEReturnCounter methodsFor: 'visitor-double dispatching' stamp: 'pmm 8/28/2006 11:32'! acceptReturnNode: aReturnNode returns := returns + 1. super acceptReturnNode: aReturnNode ! ! !PEReturnCounter methodsFor: 'initialize-release' stamp: 'pmm 8/28/2006 11:32'! initialize super initialize. returns := 0! ! !PEReturnCounter methodsFor: 'accessing' stamp: 'pmm 8/28/2006 11:31'! returns ^returns! ! RBProgramNodeVisitor subclass: #PEScopeKiller instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Visitors'! !PEScopeKiller methodsFor: 'visitor-double dispatching' stamp: 'pmm 10/22/2005 14:10'! acceptBlockNode: aBlockNode aBlockNode scope: nil. super acceptBlockNode: aBlockNode ! ! !PEScopeKiller methodsFor: 'visitor-double dispatching' stamp: 'pmm 10/22/2005 11:27'! acceptMethodNode: aMethodNode aMethodNode scope: nil. super acceptMethodNode: aMethodNode! ! !PEScopeKiller methodsFor: 'visitor-double dispatching' stamp: 'md 3/30/2007 10:03'! acceptVariableNode: aVariableNode aVariableNode binding ifNotNil: [ aVariableNode binding isGlobal ifTrue: [aVariableNode primitiveChangeClassTo: RBGlobalVariableNode basicNew]. aVariableNode binding isInstance ifTrue: [aVariableNode primitiveChangeClassTo: RBInstanceVariableNode basicNew]. aVariableNode binding isTemp ifTrue: [aVariableNode primitiveChangeClassTo: RBTempVariableNode basicNew]. ]. aVariableNode binding: nil. super acceptVariableNode: aVariableNode ! ! RBProgramNodeVisitor subclass: #PETokenKiller instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Visitors'! !PETokenKiller methodsFor: 'as yet unclassified' stamp: 'md 4/13/2007 22:21'! acceptLiteralNode: aVariableNode aVariableNode token previous: nil. aVariableNode token next: nil. super acceptLiteralNode: aVariableNode.! ! !PETokenKiller methodsFor: 'as yet unclassified' stamp: 'md 4/13/2007 22:55'! acceptMessageNode: aMethodNode aMethodNode selectorParts do: [:token | token next: nil. token previous: nil]. ^super acceptMessageNode: aMethodNode! ! !PETokenKiller methodsFor: 'as yet unclassified' stamp: 'md 4/13/2007 23:00'! acceptMethodNode: aMethodNode aMethodNode selectorParts do: [:token | token next: nil. token previous: nil]. ^super acceptMethodNode: aMethodNode! ! !PETokenKiller methodsFor: 'as yet unclassified' stamp: 'md 4/13/2007 22:20'! acceptVariableNode: aVariableNode aVariableNode token previous: nil. aVariableNode token next: nil. super acceptVariableNode: aVariableNode.! ! !PETokenKiller methodsFor: 'as yet unclassified' stamp: 'md 4/13/2007 23:48'! visitNode: aNode aNode removeProperty: #firstToken ifAbsent:[]. aNode removeProperty: #lastToken ifAbsent:[]. aNode removeProperty: #comments ifAbsent:[]. super visitNode: aNode.! ! !RBProgramNodeVisitor class methodsFor: '*persephone' stamp: 'pmm 6/11/2006 10:25'! <= other ^self priority <= other priority! ! !RBProgramNodeVisitor class methodsFor: '*persephone' stamp: 'pmm 4/29/2006 12:16'! isCompilerBackendPlugin ^false! ! !RBProgramNodeVisitor class methodsFor: '*persephone' stamp: 'pmm 6/11/2006 10:24'! priority self subclassResponsibility ! ! !RBProgramNodeVisitor methodsFor: '*persephone' stamp: 'pmm 6/25/2006 15:29'! acceptObjectLiteralNode: anObjectLiteralNode ^self acceptLiteralNode: anObjectLiteralNode! ! Parser2 subclass: #PEParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Parsing'! !PEParser methodsFor: 'public access' stamp: 'md 3/21/2007 16:20'! parse: sourceStream class: parseScope noPattern: doitBool notifying: req ifFail: aBlock "Parse sourceStream into a embedded BlockNode if doitFlag is true (no method header) or a MethodNode if doitFlag is false. Parsing is done with respect to parseScope to find non-local variables. Errors in parsing are reported to req if not nil followed by executing the fail block." | parser | source := sourceStream. requestor := req. doitFlag := doitBool. scope := parseScope parseScope. failBlock := [^ aBlock value]. parser := self realParserClass. ^ [ | tree | tree := doitFlag ifTrue: [parser parseDoIt: source] ifFalse: [parser parseMethod: source]. [ tree methodClass: parseScope. tree verifyIn: scope] on: SemanticWarning do: [:ex | ex correctIn: self] ] on: UnhandledError do: [:uEx | | ex | ex := uEx exception. (SmaCCParserError handles: ex) ifTrue: [self notify: ex description at: ex tag position] ifFalse: [uEx pass] ]! ! !PEParser methodsFor: 'accessing' stamp: 'md 3/31/2007 18:48'! realParserClass ^ PESqueakParser! ! SqueakScanner subclass: #PESqueakScanner instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Persephone-Parsing'! !PESqueakScanner class methodsFor: 'generated-initialization' stamp: 'md 4/7/2007 11:33'! initializeKeywordMap keywordMap := Dictionary new. #( #(25 'apicall:' 12 ) #(25 'cdecl:' 13 ) #(25 'module:' 15 ) #(25 'primitive:' 3 ) #(#binarySymbol '||' 10 ) #(24 'false' 18 ) #(24 'nil' 19 ) #(24 'true' 14 ) ) do: [:each | (keywordMap at: each first ifAbsentPut: [Dictionary new]) at: (each at: 2) put: each last]. ^ keywordMap! ! !PESqueakScanner class methodsFor: 'generated-comments' stamp: 'md 4/7/2007 11:33'! scannerDefinitionComment ": [0-9]+ (\. [0-9]+)? ; : [0-9]+ r [0-9A-Z]+ (\. [0-9A-Z]+)? ; : s [0-9]+ ; : ( | ) e \-? [0-9]+ ; : | | | ; : \- ; : \' [^\']* \' (\' [^\']* \')* ; : [a-zA-Z] [a-zA-Z0-9]* ; : \: ; : \: ( \: )+ ; : [\~\!!\@\%\&\*\-\+\=\\\|\?\/\>\<\,] [\~\!!\@\%\&\*\-\+\=\\\|\?\/\>\<\,]* ; : \: \= | \_ ; : \: \: ( \:)* ; : \s+ ; : \"" [^\""]* \"" ; : \$ . ; : \. ; : \: \= ; : ]; : }; : \); : \:; : \;; : . ; # For VW literal arrays that handle #(;) -> #(#';');"! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! assignmentId ^28! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! binarySymbolId ^27! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! characterId ^32! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! colonId ^38! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! emptySymbolTokenId ^85! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! errorTokenId ^86! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! keywordId ^25! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! multikeywordId ^26! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! nameId ^24! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! negativeNumberId ^22! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! numberId ^21! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! periodId ^33! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! rightBoxBracketsId ^35! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! rightCurlyBracketsId ^36! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! rightParenthesesId ^37! ! !PESqueakScanner methodsFor: 'generated-scanner' stamp: 'md 4/7/2007 11:33'! scan1 self recordMatch: #(23 ). self step. currentCharacter = $' ifTrue: [^ self scan2]. ^ self reportLastMatch! ! !PESqueakScanner methodsFor: 'generated-scanner' stamp: 'md 4/7/2007 11:33'! scan10 self step. (currentCharacter between: $0 and: $9) ifTrue: [ [self recordMatch: #(22 ). self step. currentCharacter between: $0 and: $9] whileTrue. ^ self reportLastMatch]. currentCharacter = $- ifTrue: [^ self scan11]. ^ self reportLastMatch! ! !PESqueakScanner methodsFor: 'generated-scanner' stamp: 'md 4/7/2007 11:33'! scan11 self step. (currentCharacter between: $0 and: $9) ifTrue: [ [self recordMatch: #(22 ). self step. currentCharacter between: $0 and: $9] whileTrue. ^ self reportLastMatch]. ^ self reportLastMatch! ! !PESqueakScanner methodsFor: 'generated-scanner' stamp: 'md 4/7/2007 11:33'! scan2 [self step. currentCharacter ~= $'] whileTrue. currentCharacter = $' ifTrue: [^ self scan1]. ^ self reportLastMatch! ! !PESqueakScanner methodsFor: 'generated-scanner' stamp: 'md 4/7/2007 11:33'! scan3 self step. (currentCharacter between: $0 and: $9) ifTrue: [ [self recordMatch: #(21 ). self step. currentCharacter between: $0 and: $9] whileTrue. currentCharacter = $e ifTrue: [^ self scan4]. currentCharacter = $s ifTrue: [^ self scan5]. ^ self reportLastMatch]. ^ self reportLastMatch! ! !PESqueakScanner methodsFor: 'generated-scanner' stamp: 'md 4/7/2007 11:33'! scan4 self step. (currentCharacter between: $0 and: $9) ifTrue: [ [self recordMatch: #(21 ). self step. currentCharacter between: $0 and: $9] whileTrue. ^ self reportLastMatch]. currentCharacter = $- ifTrue: [^ self scan5]. ^ self reportLastMatch! ! !PESqueakScanner methodsFor: 'generated-scanner' stamp: 'md 4/7/2007 11:33'! scan5 self step. (currentCharacter between: $0 and: $9) ifTrue: [ [self recordMatch: #(21 ). self step. currentCharacter between: $0 and: $9] whileTrue. ^ self reportLastMatch]. ^ self reportLastMatch! ! !PESqueakScanner methodsFor: 'generated-scanner' stamp: 'md 4/7/2007 11:33'! scan6 self step. ((currentCharacter between: $0 and: $9) or: [currentCharacter between: $A and: $Z]) ifTrue: [ [self recordMatch: #(21 ). self step. (currentCharacter between: $0 and: $9) or: [currentCharacter between: $A and: $Z]] whileTrue. currentCharacter = $. ifTrue: [self step. ((currentCharacter between: $0 and: $9) or: [currentCharacter between: $A and: $Z]) ifTrue: [ [self recordMatch: #(21 ). self step. (currentCharacter between: $0 and: $9) or: [currentCharacter between: $A and: $Z]] whileTrue. currentCharacter = $e ifTrue: [^ self scan4]. ^ self reportLastMatch]. ^ self reportLastMatch]. currentCharacter = $e ifTrue: [^ self scan4]. ^ self reportLastMatch]. ^ self reportLastMatch! ! !PESqueakScanner methodsFor: 'generated-scanner' stamp: 'md 4/7/2007 11:33'! scan7 [self step. (currentCharacter between: $0 and: $9) or: [(currentCharacter between: $A and: $Z) or: [currentCharacter between: $a and: $z]]] whileTrue. currentCharacter = $: ifTrue: [self recordMatch: #(29 ). self step. ((currentCharacter between: $A and: $Z) or: [currentCharacter between: $a and: $z]) ifTrue: [^ self scan7]. ^ self reportLastMatch]. ^ self reportLastMatch! ! !PESqueakScanner methodsFor: 'generated-scanner' stamp: 'md 4/7/2007 11:33'! scan8 self recordMatch: #(25 ). self step. ((currentCharacter between: $A and: $Z) or: [currentCharacter between: $a and: $z]) ifTrue: [^ self scan9]. currentCharacter = $= ifTrue: [^ self recordAndReportMatch: #variableAssignment]. ^ self reportLastMatch! ! !PESqueakScanner methodsFor: 'generated-scanner' stamp: 'md 4/7/2007 11:33'! scan9 [self step. (currentCharacter between: $0 and: $9) or: [(currentCharacter between: $A and: $Z) or: [currentCharacter between: $a and: $z]]] whileTrue. currentCharacter = $: ifTrue: [self recordMatch: #(26 ). self step. ((currentCharacter between: $A and: $Z) or: [currentCharacter between: $a and: $z]) ifTrue: [^ self scan9]. ^ self reportLastMatch]. ^ self reportLastMatch! ! !PESqueakScanner methodsFor: 'generated-scanner' stamp: 'md 4/7/2007 11:33'! scanForToken self step. (currentCharacter <= Character backspace or: [(currentCharacter between: (Character value: 14) and: (Character value: 31)) or: [currentCharacter = $` or: [currentCharacter >= $]]]) ifTrue: [^ self recordAndReportMatch: #(40 )]. ((currentCharacter between: $A and: $Z) or: [currentCharacter between: $a and: $z]) ifTrue: [self recordMatch: #(24 40 ). self step. ((currentCharacter between: $0 and: $9) or: [(currentCharacter between: $A and: $Z) or: [currentCharacter between: $a and: $z]]) ifTrue: [ [self recordMatch: #(24 ). self step. (currentCharacter between: $0 and: $9) or: [(currentCharacter between: $A and: $Z) or: [currentCharacter between: $a and: $z]]] whileTrue. currentCharacter = $: ifTrue: [^ self scan8]. ^ self reportLastMatch]. currentCharacter = $: ifTrue: [^ self scan8]. ^ self reportLastMatch]. (currentCharacter = $!! or: [(currentCharacter between: $% and: $&) or: [(currentCharacter between: $+ and: $,) or: [currentCharacter = $/ or: [currentCharacter = $= or: [(currentCharacter between: $? and: $@) or: [currentCharacter = $\ or: [currentCharacter = $~]]]]]]]) ifTrue: [self recordMatch: #binarySymbol. self step. (currentCharacter = $!! or: [(currentCharacter between: $% and: $&) or: [(currentCharacter between: $* and: $-) or: [currentCharacter = $/ or: [(currentCharacter between: $< and: $@) or: [currentCharacter = $\ or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]) ifTrue: [ [self recordMatch: #binarySymbol. self step. currentCharacter = $!! or: [(currentCharacter between: $% and: $&) or: [(currentCharacter between: $* and: $-) or: [currentCharacter = $/ or: [(currentCharacter between: $< and: $@) or: [currentCharacter = $\ or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]] whileTrue. ^ self reportLastMatch]. ^ self reportLastMatch]. (currentCharacter between: $0 and: $9) ifTrue: [self recordMatch: #(21 40 ). self step. (currentCharacter between: $0 and: $9) ifTrue: [ [self recordMatch: #(21 ). self step. currentCharacter between: $0 and: $9] whileTrue. currentCharacter = $. ifTrue: [^ self scan3]. currentCharacter = $e ifTrue: [^ self scan4]. currentCharacter = $r ifTrue: [^ self scan6]. currentCharacter = $s ifTrue: [^ self scan5]. ^ self reportLastMatch]. currentCharacter = $. ifTrue: [^ self scan3]. currentCharacter = $e ifTrue: [^ self scan4]. currentCharacter = $r ifTrue: [^ self scan6]. currentCharacter = $s ifTrue: [^ self scan5]. ^ self reportLastMatch]. ((currentCharacter between: Character tab and: Character cr) or: [currentCharacter = Character space]) ifTrue: [self recordMatch: #whitespace. self step. ((currentCharacter between: Character tab and: Character cr) or: [currentCharacter = Character space]) ifTrue: [ [self recordMatch: #whitespace. self step. (currentCharacter between: Character tab and: Character cr) or: [currentCharacter = Character space]] whileTrue. ^ self reportLastMatch]. ^ self reportLastMatch]. currentCharacter = $" ifTrue: [self recordMatch: #(40 ). self step. currentCharacter ~= $" ifTrue: [ [self step. currentCharacter ~= $"] whileTrue. currentCharacter = $" ifTrue: [^ self recordAndReportMatch: #comment]. ^ self reportLastMatch]. currentCharacter = $" ifTrue: [^ self recordAndReportMatch: #comment]. ^ self reportLastMatch]. currentCharacter = $# ifTrue: [self recordMatch: #(20 40 ). self step. currentCharacter = $: ifTrue: [^ self recordAndReportMatch: #(17 )]. ^ self reportLastMatch]. currentCharacter = $$ ifTrue: [self recordMatch: #(40 ). self step. currentCharacter <= $ÿ ifTrue: [^ self recordAndReportMatch: #(32 )]. ^ self reportLastMatch]. currentCharacter = $' ifTrue: [self recordMatch: #(40 ). self step. currentCharacter ~= $' ifTrue: [^ self scan2]. currentCharacter = $' ifTrue: [^ self scan1]. ^ self reportLastMatch]. currentCharacter = $( ifTrue: [^ self recordAndReportMatch: #(9 40 )]. currentCharacter = $) ifTrue: [^ self recordAndReportMatch: #(37 40 )]. currentCharacter = $* ifTrue: [self recordMatch: #(16 27 40 ). self step. (currentCharacter = $!! or: [(currentCharacter between: $% and: $&) or: [(currentCharacter between: $* and: $-) or: [currentCharacter = $/ or: [(currentCharacter between: $< and: $@) or: [currentCharacter = $\ or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]) ifTrue: [ [self recordMatch: #binarySymbol. self step. currentCharacter = $!! or: [(currentCharacter between: $% and: $&) or: [(currentCharacter between: $* and: $-) or: [currentCharacter = $/ or: [(currentCharacter between: $< and: $@) or: [currentCharacter = $\ or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]] whileTrue. ^ self reportLastMatch]. ^ self reportLastMatch]. currentCharacter = $- ifTrue: [self recordMatch: #binarySymbol. self step. (currentCharacter = $!! or: [(currentCharacter between: $% and: $&) or: [(currentCharacter between: $* and: $-) or: [currentCharacter = $/ or: [(currentCharacter between: $< and: $@) or: [currentCharacter = $\ or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]) ifTrue: [ [self recordMatch: #binarySymbol. self step. currentCharacter = $!! or: [(currentCharacter between: $% and: $&) or: [(currentCharacter between: $* and: $-) or: [currentCharacter = $/ or: [(currentCharacter between: $< and: $@) or: [currentCharacter = $\ or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]] whileTrue. ^ self reportLastMatch]. (currentCharacter between: $0 and: $9) ifTrue: [ [self recordMatch: #(22 ). self step. currentCharacter between: $0 and: $9] whileTrue. currentCharacter = $. ifTrue: [self step. (currentCharacter between: $0 and: $9) ifTrue: [ [self recordMatch: #(22 ). self step. currentCharacter between: $0 and: $9] whileTrue. currentCharacter = $e ifTrue: [^ self scan10]. currentCharacter = $s ifTrue: [^ self scan11]. ^ self reportLastMatch]. ^ self reportLastMatch]. currentCharacter = $e ifTrue: [^ self scan10]. currentCharacter = $r ifTrue: [self step. ((currentCharacter between: $0 and: $9) or: [currentCharacter between: $A and: $Z]) ifTrue: [ [self recordMatch: #(22 ). self step. (currentCharacter between: $0 and: $9) or: [currentCharacter between: $A and: $Z]] whileTrue. currentCharacter = $. ifTrue: [self step. ((currentCharacter between: $0 and: $9) or: [currentCharacter between: $A and: $Z]) ifTrue: [ [self recordMatch: #(22 ). self step. (currentCharacter between: $0 and: $9) or: [currentCharacter between: $A and: $Z]] whileTrue. currentCharacter = $e ifTrue: [^ self scan10]. ^ self reportLastMatch]. ^ self reportLastMatch]. currentCharacter = $e ifTrue: [^ self scan10]. ^ self reportLastMatch]. ^ self reportLastMatch]. currentCharacter = $s ifTrue: [^ self scan11]. ^ self reportLastMatch]. ^ self reportLastMatch]. currentCharacter = $. ifTrue: [^ self recordAndReportMatch: #(33 40 )]. currentCharacter = $: ifTrue: [self recordMatch: #(38 40 ). self step. ((currentCharacter between: $A and: $Z) or: [currentCharacter between: $a and: $z]) ifTrue: [^ self scan7]. currentCharacter = $= ifTrue: [^ self recordAndReportMatch: #(28 )]. currentCharacter = $> ifTrue: [^ self recordAndReportMatch: #(5 )]. ^ self reportLastMatch]. currentCharacter = $; ifTrue: [^ self recordAndReportMatch: #(39 40 )]. currentCharacter = $< ifTrue: [self recordMatch: #(6 27 40 ). self step. (currentCharacter = $!! or: [(currentCharacter between: $% and: $&) or: [(currentCharacter between: $* and: $-) or: [currentCharacter = $/ or: [(currentCharacter between: $< and: $@) or: [currentCharacter = $\ or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]) ifTrue: [ [self recordMatch: #binarySymbol. self step. currentCharacter = $!! or: [(currentCharacter between: $% and: $&) or: [(currentCharacter between: $* and: $-) or: [currentCharacter = $/ or: [(currentCharacter between: $< and: $@) or: [currentCharacter = $\ or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]] whileTrue. ^ self reportLastMatch]. currentCharacter = $: ifTrue: [^ self recordAndReportMatch: #(2 )]. ^ self reportLastMatch]. currentCharacter = $> ifTrue: [self recordMatch: #(7 27 40 ). self step. (currentCharacter = $!! or: [(currentCharacter between: $% and: $&) or: [(currentCharacter between: $* and: $-) or: [currentCharacter = $/ or: [(currentCharacter between: $< and: $@) or: [currentCharacter = $\ or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]) ifTrue: [ [self recordMatch: #binarySymbol. self step. currentCharacter = $!! or: [(currentCharacter between: $% and: $&) or: [(currentCharacter between: $* and: $-) or: [currentCharacter = $/ or: [(currentCharacter between: $< and: $@) or: [currentCharacter = $\ or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]] whileTrue. ^ self reportLastMatch]. ^ self reportLastMatch]. currentCharacter = $[ ifTrue: [^ self recordAndReportMatch: #(1 40 )]. currentCharacter = $] ifTrue: [^ self recordAndReportMatch: #(35 40 )]. currentCharacter = $^ ifTrue: [^ self recordAndReportMatch: #(8 40 )]. currentCharacter = $_ ifTrue: [^ self recordAndReportMatch: #(28 40 )]. currentCharacter = ${ ifTrue: [^ self recordAndReportMatch: #(11 40 )]. currentCharacter = $| ifTrue: [self recordMatch: #(4 27 40 ). self step. (currentCharacter = $!! or: [(currentCharacter between: $% and: $&) or: [(currentCharacter between: $* and: $-) or: [currentCharacter = $/ or: [(currentCharacter between: $< and: $@) or: [currentCharacter = $\ or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]) ifTrue: [ [self recordMatch: #binarySymbol. self step. currentCharacter = $!! or: [(currentCharacter between: $% and: $&) or: [(currentCharacter between: $* and: $-) or: [currentCharacter = $/ or: [(currentCharacter between: $< and: $@) or: [currentCharacter = $\ or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]] whileTrue. ^ self reportLastMatch]. ^ self reportLastMatch]. currentCharacter = $} ifTrue: [^ self recordAndReportMatch: #(36 40 )]. ^ self reportLastMatch! ! !PESqueakScanner methodsFor: 'generated-tokens' stamp: 'md 4/7/2007 11:33'! stringId ^23! ! !RBDoItNode methodsFor: '*persephone' stamp: 'pmm 6/11/2006 22:41'! evaluate ^self compiledMethod valueWithReceiver: nil arguments: #()! ! PECompiler initialize! AssertionTransformer initialize! PEAssertDisabler initialize!