[Vm-dev] VM Maker: VMMakerCompatibilityForPharo6-eem.9.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Sep 26 21:34:56 UTC 2018
Eliot Miranda uploaded a new version of VMMakerCompatibilityForPharo6 to project VM Maker:
http://source.squeak.org/VMMaker/VMMakerCompatibilityForPharo6-eem.9.mcz
==================== Summary ====================
Name: VMMakerCompatibilityForPharo6-eem.9
Author: eem
Time: 26 September 2018, 2:34:40.566729 pm
UUID: ed2013ba-2e33-0d00-8be4-25a8015cfeb3
Ancestors: VMMakerCompatibilityForPharo6-eem.8
More compatbility. InstructionPrinter et al are missing in Pharo6 and subsequent. RBProgramNode methods for Slang. GtTranscript compatibility.
=============== Diff against VMMakerCompatibilityForPharo6-eem.8 ===============
Item was added:
+ ----- Method: GtTranscript>>ensureCr (in category '*VMMakerCompatibilityForPharo6') -----
+ ensureCr
+ "do nothing"
+ (self text isEmpty or: [ self text last == Character cr]) ifFalse:
+ [ self cr ]!
Item was added:
+ ----- Method: GtTranscript>>flush (in category '*VMMakerCompatibilityForPharo6') -----
+ flush
+ "do nothing"!
Item was added:
+ ----- Method: GtTranscript>>next:put: (in category '*VMMakerCompatibilityForPharo6') -----
+ next: anInteger put: aCharacter
+ "Make anObject be the next anInteger number of objects accessible by the
+ receiver. Answer anObject."
+
+ 1 to: anInteger do: [:i| self nextPut: aCharacter ].
+ ^ aCharacter!
Item was added:
+ InstructionClient subclass: #InstructionPrinter
+ instanceVariableNames: 'method scanner stream oldPC innerIndents indent printPC indentSpanOfFollowingJump'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMakerCompatibilityForPharo6-Kernel-Methods'!
+
+ !InstructionPrinter commentStamp: 'md 4/8/2003 12:47' prior: 0!
+ My instances can print the object code of a CompiledMethod in symbolic format. They print into an instance variable, stream, and uses oldPC to determine how many bytes to print in the listing. The variable method is used to hold the method being printed.!
Item was added:
+ ----- Method: InstructionPrinter class>>on: (in category 'printing') -----
+ on: aMethod
+ ^self new method: aMethod.
+ !
Item was added:
+ ----- Method: InstructionPrinter class>>printClass: (in category 'printing') -----
+ printClass: class
+ "Create a file whose name is the argument followed by '.bytes'. Store on
+ the file the symbolic form of the compiled methods of the class."
+ | file |
+ file := FileStream newFileNamed: class name , '.bytes'.
+ class selectorsAndMethodsDo:
+ [:sel :m |
+ file cr; nextPutAll: sel; cr.
+ (self on: m) printInstructionsOn: file].
+ file close
+ "InstructionPrinter printClass: Parser."
+ !
Item was added:
+ ----- Method: InstructionPrinter>>blockReturnConstant: (in category 'instruction decoding') -----
+ blockReturnConstant: value
+ "Print the Return Constant From Block bytecode."
+
+ self print: 'blockReturn: ', value printString!
Item was added:
+ ----- Method: InstructionPrinter>>blockReturnTop (in category 'instruction decoding') -----
+ blockReturnTop
+ "Print the Return Top Of Stack bytecode."
+
+ self print: 'blockReturn'!
Item was added:
+ ----- Method: InstructionPrinter>>callPrimitive: (in category 'instruction decoding') -----
+ callPrimitive: index
+ "Print the callPrimitive bytecode."
+
+ self print: 'callPrimitive: ' , index printString!
Item was added:
+ ----- Method: InstructionPrinter>>directedSuperSend:numArgs: (in category 'instruction decoding') -----
+ directedSuperSend: selector "<Symbol>" numArgs: numArgs "<SmallInteger>"
+ self print: 'directedSuperSend: ' , (self stringForSelector: selector numArgs: numArgs)!
Item was added:
+ ----- Method: InstructionPrinter>>doDup (in category 'instruction decoding') -----
+ doDup
+ "Print the Duplicate Top Of Stack bytecode."
+
+ self print: 'dup'!
Item was added:
+ ----- Method: InstructionPrinter>>doPop (in category 'instruction decoding') -----
+ doPop
+ "Print the Remove Top Of Stack bytecode."
+
+ self print: 'pop'!
Item was added:
+ ----- Method: InstructionPrinter>>indent (in category 'accessing') -----
+ indent
+
+ ^ indent ifNil: [0]!
Item was added:
+ ----- Method: InstructionPrinter>>indent: (in category 'initialize-release') -----
+ indent: numTabs
+
+ indent := numTabs!
Item was added:
+ ----- Method: InstructionPrinter>>jump: (in category 'instruction decoding') -----
+ jump: offset
+ "Print the Unconditional Jump bytecode."
+
+ self print: 'jumpTo: ' , (scanner pc + offset) printString.
+ indentSpanOfFollowingJump ifTrue:
+ [indentSpanOfFollowingJump := false.
+ innerIndents atAll: (scanner pc to: scanner pc + offset - 1) put: (innerIndents at: scanner pc - 1) + 1]!
Item was added:
+ ----- Method: InstructionPrinter>>jump:if: (in category 'instruction decoding') -----
+ jump: offset if: condition
+ "Print the Conditional Jump bytecode."
+
+ self print:
+ (condition
+ ifTrue: ['jumpTrue: ']
+ ifFalse: ['jumpFalse: '])
+ , (scanner pc + offset) printString!
Item was added:
+ ----- Method: InstructionPrinter>>method (in category 'accessing') -----
+ method
+ ^method.!
Item was added:
+ ----- Method: InstructionPrinter>>method: (in category 'accessing') -----
+ method: aMethod
+ method := aMethod.
+ printPC := true.
+ indentSpanOfFollowingJump := false!
Item was added:
+ ----- Method: InstructionPrinter>>methodReturnConstant: (in category 'instruction decoding') -----
+ methodReturnConstant: value
+ "Print the Return Constant bytecode."
+
+ self print: 'return: ' , value printString!
Item was added:
+ ----- Method: InstructionPrinter>>methodReturnReceiver (in category 'instruction decoding') -----
+ methodReturnReceiver
+ "Print the Return Self bytecode."
+
+ self print: 'returnSelf'!
Item was added:
+ ----- Method: InstructionPrinter>>methodReturnTop (in category 'instruction decoding') -----
+ methodReturnTop
+ "Print the Return Top Of Stack bytecode."
+
+ self print: 'returnTop'!
Item was added:
+ ----- Method: InstructionPrinter>>popIntoLiteralVariable: (in category 'instruction decoding') -----
+ popIntoLiteralVariable: anAssociation
+ "Print the Remove Top Of Stack And Store Into Literal Variable bytecode."
+
+ self print: 'popIntoLit: ' , anAssociation key!
Item was added:
+ ----- Method: InstructionPrinter>>popIntoReceiverVariable: (in category 'instruction decoding') -----
+ popIntoReceiverVariable: offset
+ "Print the Remove Top Of Stack And Store Into Instance Variable
+ bytecode."
+
+ self print: 'popIntoRcvr: ' , offset printString!
Item was added:
+ ----- Method: InstructionPrinter>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
+ popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
+ self print: 'popIntoTemp: ', remoteTempIndex printString, ' inVectorAt: ', tempVectorIndex printString!
Item was added:
+ ----- Method: InstructionPrinter>>popIntoTemporaryVariable: (in category 'instruction decoding') -----
+ popIntoTemporaryVariable: offset
+ "Print the Remove Top Of Stack And Store Into Temporary Variable
+ bytecode."
+
+ self print: 'popIntoTemp: ' , offset printString!
Item was added:
+ ----- Method: InstructionPrinter>>print: (in category 'printing') -----
+ print: instruction
+ "Append to the receiver a description of the bytecode, instruction."
+
+ | code |
+ stream tab: self indent.
+ printPC ifTrue: [stream print: oldPC; space].
+ stream tab: (innerIndents at: oldPC).
+ stream nextPut: $<.
+ oldPC to: scanner pc - 1 do:
+ [:i |
+ code := (method at: i) radix: 16.
+ stream nextPut:
+ (code size < 2
+ ifTrue: [$0]
+ ifFalse: [code at: 1]).
+ stream nextPut: code last; space].
+ stream skip: -1.
+ stream nextPut: $>.
+ stream space.
+ stream nextPutAll: instruction.
+ stream cr.
+ oldPC := scanner pc.
+ "(InstructionPrinter compiledMethodAt: #print:) symbolic."
+ !
Item was added:
+ ----- Method: InstructionPrinter>>printInstructionsOn: (in category 'initialize-release') -----
+ printInstructionsOn: aStream
+ "Append to the stream, aStream, a description of each bytecode in the
+ instruction stream."
+
+ | end |
+ stream := aStream.
+ scanner := InstructionStream on: method.
+ end := method endPC.
+ oldPC := scanner pc.
+ innerIndents := Array new: end withAll: 0.
+ [scanner pc <= end] whileTrue:
+ [scanner interpretNextInstructionFor: self]!
Item was added:
+ ----- Method: InstructionPrinter>>printInstructionsOn:do: (in category 'initialize-release') -----
+ printInstructionsOn: aStream do: aBlock
+ "Append to the stream, aStream, a description of each bytecode in the
+ instruction stream. Evaluate aBlock with the receiver, the scanner and
+ the stream after each instruction."
+
+ | end |
+ stream := aStream.
+ scanner := InstructionStream on: method.
+ end := method endPC.
+ oldPC := scanner pc.
+ innerIndents := Array new: end withAll: 0.
+ [scanner pc <= end] whileTrue:
+ [scanner interpretNextInstructionFor: self.
+ aBlock value: self value: scanner value: stream]!
Item was added:
+ ----- Method: InstructionPrinter>>printPC (in category 'accessing') -----
+ printPC
+ ^printPC!
Item was added:
+ ----- Method: InstructionPrinter>>printPC: (in category 'accessing') -----
+ printPC: aBoolean
+ printPC := aBoolean!
Item was added:
+ ----- Method: InstructionPrinter>>pushActiveContext (in category 'instruction decoding') -----
+ pushActiveContext
+ "Print the Push Active Context On Top Of Its Own Stack bytecode."
+
+ self print: 'pushThisContext: '!
Item was added:
+ ----- Method: InstructionPrinter>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
+ pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
+ self print: 'closureNumCopied: ', numCopied printString
+ , ' numArgs: ', numArgs printString
+ , ' bytes ', scanner pc printString
+ , ' to ', (scanner pc + blockSize - 1) printString.
+ innerIndents
+ atAll: (scanner pc to: scanner pc + blockSize - 1)
+ put: (innerIndents at: scanner pc - 1) + 1!
Item was added:
+ ----- Method: InstructionPrinter>>pushConsArrayWithElements: (in category 'instruction decoding') -----
+ pushConsArrayWithElements: numElements
+ self print: 'pop ', numElements printString, ' into (Array new: ', numElements printString, ')'!
Item was added:
+ ----- Method: InstructionPrinter>>pushConstant: (in category 'instruction decoding') -----
+ pushConstant: obj
+ "Print the Push Constant, obj, on Top Of Stack bytecode."
+
+ self print: (String streamContents:
+ [:s |
+ s nextPutAll: 'pushConstant: '.
+ obj isVariableBinding
+ ifTrue:
+ [obj key
+ ifNotNil: [s nextPutAll: '##'; nextPutAll: obj key]
+ ifNil: [s nextPutAll: '###'; nextPutAll: obj value soleInstance name]]
+ ifFalse:
+ [obj isClosure
+ ifTrue: [s nextPutAll: obj sourceString]
+ ifFalse: [obj printOn: s]]]).
+
+ obj isCompiledMethod ifTrue:
+ [obj longPrintOn: stream indent: self indent + 2.
+ ^self]!
Item was added:
+ ----- Method: InstructionPrinter>>pushFullClosure:numCopied: (in category 'printing') -----
+ pushFullClosure: aCompiledBlock numCopied: numCopied
+ | literalIndex |
+ literalIndex := method literals identityIndexOf: aCompiledBlock.
+ literalIndex = 0
+ ifTrue:
+ [self print: 'closureNumCopied: ', numCopied printString
+ , ' numArgs: ', aCompiledBlock numArgs printString]
+ ifFalse:
+ [self print: 'pushFullClosure: (self literalAt: ', literalIndex printString,
+ ') numCopied: ', numCopied printString,
+ ' "numArgs: ', aCompiledBlock numArgs printString, '"']!
Item was added:
+ ----- Method: InstructionPrinter>>pushLiteralVariable: (in category 'instruction decoding') -----
+ pushLiteralVariable: anAssociation
+ "Print the Push Value Of anAssociation On Top Of Stack bytecode."
+
+ self print: 'pushLitVar: ' , (anAssociation printStringLimitedTo: 64)!
Item was added:
+ ----- Method: InstructionPrinter>>pushNewArrayOfSize: (in category 'instruction decoding') -----
+ pushNewArrayOfSize: numElements
+ self print: 'push: (Array new: ', numElements printString, ')'!
Item was added:
+ ----- Method: InstructionPrinter>>pushReceiver (in category 'instruction decoding') -----
+ pushReceiver
+ "Print the Push Active Context's Receiver on Top Of Stack bytecode."
+
+ self print: 'self'!
Item was added:
+ ----- Method: InstructionPrinter>>pushReceiverVariable: (in category 'instruction decoding') -----
+ pushReceiverVariable: offset
+ "Print the Push Contents Of the Receiver's Instance Variable Whose Index
+ is the argument, offset, On Top Of Stack bytecode."
+
+ self print: 'pushRcvr: ' , offset printString!
Item was added:
+ ----- Method: InstructionPrinter>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
+ pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
+ self print: 'pushTemp: ', remoteTempIndex printString, ' inVectorAt: ', tempVectorIndex printString!
Item was added:
+ ----- Method: InstructionPrinter>>pushTemporaryVariable: (in category 'instruction decoding') -----
+ pushTemporaryVariable: offset
+ "Print the Push Contents Of Temporary Variable Whose Index Is the
+ argument, offset, On Top Of Stack bytecode."
+
+ self print: 'pushTemp: ' , offset printString!
Item was added:
+ ----- Method: InstructionPrinter>>send:super:numArgs: (in category 'instruction decoding') -----
+ send: selector super: supered numArgs: numArgs
+ "Print the Send Message With Selector, selector, bytecode. The argument,
+ supered, indicates whether the receiver of the message is specified with
+ 'super' in the source method. The arguments of the message are found in
+ the top numArguments locations on the stack and the receiver just
+ below them."
+
+ self print: (supered
+ ifTrue: ['superSend: ']
+ ifFalse: ['send: '])
+ , (self stringForSelector: selector numArgs: numArgs)!
Item was added:
+ ----- Method: InstructionPrinter>>storeIntoLiteralVariable: (in category 'instruction decoding') -----
+ storeIntoLiteralVariable: anAssociation
+ "Print the Store Top Of Stack Into Literal Variable Of Method bytecode."
+
+ self print: 'storeIntoLit: ' , anAssociation key!
Item was added:
+ ----- Method: InstructionPrinter>>storeIntoReceiverVariable: (in category 'instruction decoding') -----
+ storeIntoReceiverVariable: offset
+ "Print the Store Top Of Stack Into Instance Variable Of Method bytecode."
+
+ self print: 'storeIntoRcvr: ' , offset printString!
Item was added:
+ ----- Method: InstructionPrinter>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
+ storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
+ self print: 'storeIntoTemp: ', remoteTempIndex printString, ' inVectorAt: ', tempVectorIndex printString!
Item was added:
+ ----- Method: InstructionPrinter>>storeIntoTemporaryVariable: (in category 'instruction decoding') -----
+ storeIntoTemporaryVariable: offset
+ "Print the Store Top Of Stack Into Temporary Variable Of Method
+ bytecode."
+
+ self print: 'storeIntoTemp: ' , offset printString!
Item was added:
+ ----- Method: InstructionPrinter>>stringForSelector:numArgs: (in category 'printing') -----
+ stringForSelector: selector numArgs: numArgs
+ ^(selector isSymbol and: [selector numArgs = numArgs])
+ ifTrue: [selector]
+ ifFalse: [selector printString
+ , (numArgs = 1
+ ifTrue: [' (1 arg)']
+ ifFalse: [' (', numArgs printString, ' args)'])]!
Item was added:
+ ----- Method: InstructionPrinter>>trapIfNotInstanceOf: (in category 'instruction decoding') -----
+ trapIfNotInstanceOf: behaviorOrArrayOfBehavior
+ "If the top of stack is not an instance of either the argument, or, if the argument is an Array,
+ any of the elements of the argument, send the class trap message to the current context."
+ self print: 'trapIfNotInstanceOf: ', behaviorOrArrayOfBehavior printString!
Item was changed:
----- Method: RBAssignmentNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') -----
asTranslatorNodeIn: aTMethod
"Answer a TParseNode subclass equivalent of me"
| varNode valueNode |
varNode := variable asTranslatorNodeIn: aTMethod.
valueNode := value asTranslatorNodeIn: aTMethod.
valueNode isStmtList ifFalse:
[^TAssignmentNode new
setVariable: varNode
expression: valueNode;
+ comment: self commentOrNil].
- comment: self missingCommentNeededForCTranslation].
"This is a super expansion. We are in trouble if any statement other than the last is a return."
(self anyReturns: valueNode statements allButLast) ifTrue:
[self error: 'haven''t implemented pushing down assignments into other than the last return'].
"As of 6/25/2012 19:30 superExpansionNodeFor:args: elides the final return."
self assert: valueNode statements last isReturn not.
^TStmtListNode new
setStatements: valueNode statements allButLast,
{ TAssignmentNode new
setVariable: varNode
expression: valueNode statements last;
+ comment: self commentOrNil };
- comment: self missingCommentNeededForCTranslation };
yourself!
Item was changed:
----- Method: RBBlockNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') -----
asTranslatorNodeIn: aTMethod
"Answer a TParseNode subclass equivalent of me"
| statementList |
statementList := OrderedCollection new.
body statements do:
[:s | | newS |
newS := s asTranslatorNodeIn: aTMethod.
"inline the statement list returned when a CascadeNode is translated and/or when ifNotNil: is transformed"
newS isStmtList
ifTrue: [statementList addAll: newS statements]
ifFalse: [statementList add: newS]].
^TStmtListNode new
setArguments: (arguments asArray collect: [:arg | arg name])
statements: statementList;
+ comment: self commentOrNil!
- comment: self missingCommentNeededForCTranslation!
Item was changed:
----- Method: RBCascadeNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') -----
asTranslatorNodeIn: aTMethod
"Answer a TParseNode subclass equivalent of me."
^TStmtListNode new
setArguments: #()
statements:
(Array streamContents:
[:s| | receiverNode |
receiverNode := messages first receiver asTranslatorNodeIn: aTMethod.
"don't expand the receiver if it is a send to get an implicit receiver,
e.g self interpreter printHex: oop => printHex(oop), /not/ printHex(cascade0,oop)."
(receiverNode isSend and: [aTMethod definingClass isNonArgumentImplicitReceiverVariableName: receiverNode selector]) ifTrue:
[receiverNode := TVariableNode new setName: receiverNode selector].
receiverNode isLeaf ifFalse:
[| varNode |
varNode := aTMethod newCascadeTempFor: receiverNode.
s nextPut: (TAssignmentNode new
setVariable: varNode
expression: receiverNode).
receiverNode := varNode].
messages do:
[ :msg | s nextPut: ((msg asTranslatorNodeIn: aTMethod) receiver: receiverNode)]]);
+ comment: self commentOrNil!
- comment: self missingCommentNeededForCTranslation!
Item was changed:
----- Method: RBMessageNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') -----
asTranslatorNodeIn: aTMethod
"Answer a TParseNode subclass equivalent of me"
"selector is sometimes a Symbol, sometimes a SelectorNode!!
On top of this, numArgs is needed due to the (truly grody) use of
arguments as a place to store the extra expressions needed to generate
code for in-line to:by:do:, etc. see below, where it is used.
Expand super nodes in place. Elide sends of halt so that halts can be
sprinkled through the simulator but will be eliminated from the generated C."
+ | rcvrOrNil args ifNotNilBlock |
- | rcvrOrNil sel args ifNotNilBlock |
rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod].
(rcvrOrNil notNil
and: [rcvrOrNil isVariable
and: [rcvrOrNil name = 'super']]) ifTrue:
[^aTMethod superExpansionNodeFor: selector args: arguments].
+ selector == #halt ifTrue: [^rcvrOrNil].
+ (selector == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block."
+ or: [selector == #cCode:]) ifTrue:
- sel := selector. "historical; can be simply selector"
- sel == #halt ifTrue: [^rcvrOrNil].
- (sel == #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block."
- or: [sel == #cCode:]) ifTrue:
[arguments first isBlockNode ifTrue:
[| block |
^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1
ifTrue: [block statements first]
ifFalse: [block]].
(arguments first isLiteralNode
and: [arguments first value isString
and: [arguments first value isEmpty]]) ifTrue:
[^arguments first asTranslatorNodeIn: aTMethod]].
args := arguments collect: [:arg| arg asTranslatorNodeIn: aTMethod].
+ (selector == #ifTrue:ifFalse: and: [arguments first statements isEmpty]) ifTrue:
+ [selector := #ifFalse:. args := {args last}].
+ (selector == #ifTrue:ifFalse: and: [arguments last statements isEmpty]) ifTrue:
+ [selector := #ifTrue:. args := {args first}].
+ (selector == #ifFalse:ifTrue: and: [arguments first statements isEmpty]) ifTrue:
+ [selector := #ifTrue:. args := {args last}].
+ (selector == #ifFalse:ifTrue: and: [arguments last statements isEmpty]) ifTrue:
+ [selector := #ifTrue:. args := {args first}].
+ ((CCodeGenerator isVarargsSelector: selector)
- false ifTrue:
- [(sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) ifTrue:
- ["Restore limit expr that got moved by transformToDo:"
- args := {(arguments at: 7) value asTranslatorNodeIn: aTMethod.
- args second.
- args third. "add the limit var as a hidden extra argument; we may need it later"
- TVariableNode new setName: arguments first key}].
- (sel == #ifTrue:ifFalse: and: [arguments first isNodeNil]) ifTrue:
- [sel := #ifFalse:. args := {args last}].
- (sel == #ifTrue:ifFalse: and: [arguments last isNodeNil]) ifTrue:
- [sel := #ifTrue:. args := {args first}].
- (sel == #ifFalse:ifTrue: and: [arguments first isNodeNil]) ifTrue:
- [sel := #ifTrue:. args := {args last}].
- (sel == #ifFalse:ifTrue: and: [arguments last isNodeNil]) ifTrue:
- [sel := #ifTrue:. args := {args first}].
- ((sel == #ifFalse: or: [sel == #or:])
- and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue:
- ["Restore argument block that got moved by transformOr: or transformIfFalse:"
- args := {(arguments at: 2) asTranslatorNodeIn: aTMethod}].
- (args size > sel numArgs and: [sel ~~ #to:by:do:]) ifTrue: "to:by:do: has iLimiT hidden in last arg"
- ["prune the extra blocks left by ifTrue:, ifFalse:, and: & or:"
- self assert: args size - sel numArgs = 1.
- self assert: (args last isStmtList
- and: [args last statements size = 1
- and: [(args last statements first isVariable
- or: [args last statements first isConstant])
- and: [#('nil' true false) includes: args last statements first nameOrValue]]]).
- args := args first: sel numArgs].
- "For the benefit of later passes, e.g. value: inlining,
- transform e ifNotNil: [:v| ...] into v := e. v ifNotNil: [...],
- which in fact means transforming (v := e) ifTrue: [:v|...] into v := e. v ifTrue: [...]."
- ((sel == #ifTrue: or: [sel == #ifFalse: or: [sel == #ifTrue:ifFalse: or: [sel == #ifFalse:ifTrue:]]])
- and: [receiver notNil
- and: [receiver isAssignmentEqualsEqualsNil
- and: [(ifNotNilBlock := args detect: [:arg| arg isStmtList and: [arg args size = 1]] ifNone: []) notNil]]]) ifTrue:
- [ifNotNilBlock setArguments: #().
- ^TStmtListNode new
- setArguments: #()
- statements:
- { receiver receiver asTranslatorNodeIn: aTMethod.
- TSendNode new
- setSelector: sel
- receiver: (TSendNode new
- setSelector: #==
- receiver: (receiver receiver variable asTranslatorNodeIn: aTMethod)
- arguments: {receiver arguments first asTranslatorNodeIn: aTMethod})
- arguments: args }]].
- ((CCodeGenerator isVarargsSelector: sel)
and: [args last isCollection
and: [args last isSequenceable]]) ifTrue:
[args := args allButLast, args last].
^TSendNode new
+ setSelector: selector
- setSelector: sel
receiver: rcvrOrNil
arguments: args!
Item was changed:
----- Method: RBMethodNode>>asTranslationMethodOfClass: (in category '*VMMakerCompatibilityForPharo6-C translation') -----
asTranslationMethodOfClass: aTMethodClass
"Answer a TMethod (or subclass) derived from the receiver."
+ | additionalMethodState |
+ additionalMethodState := AdditionalMethodState forMethod: nil selector: selector.
+ pragmas ifNotNil:
+ [pragmas do:
+ [:pragmaNode|
+ additionalMethodState := additionalMethodState copyWith: pragmaNode asPragma]].
^aTMethodClass new
setSelector: selector
+ definingClass: compilationContext getClass
- definingClass: scope instanceScope outerScope getClass
args: arguments
locals: ((self allDefinedVariables copyWithoutAll: arguments) collect: [:string| string -> string])
+ block: (body lastIsReturn
+ ifTrue: [body]
+ ifFalse: [body shallowCopy
+ addSelfReturn;
+ yourself])
- block: body
primitive: ((pragmas ifNotNil:
[pragmas detect: [:pragmaNode| pragmaNode selector beginsWith: #primitve:] ifNone: []])
ifNil: [0]
ifNotNil: [:pragmaNode| pragmaNode arguments first value])
+ properties: additionalMethodState
+ comment: self commentOrNil!
- properties: (properties ifNil: [AdditionalMethodState new])
- comment: self missingCommentNeededForCTranslation!
Item was added:
+ ----- Method: RBProgramNode>>commentOrNil (in category '*VMMakerCompatibilityForPharo6-C translation') -----
+ commentOrNil
+ ^self propertyAt: #comments ifAbsent: []!
Item was added:
+ ----- Method: RBProgramNode>>isVariableNode (in category '*VMMakerCompatibilityForPharo6-testing') -----
+ isVariableNode
+ ^false!
Item was changed:
----- Method: RBReturnNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') -----
asTranslatorNodeIn: aTMethod
"Answer a TParseNode subclass equivalent of a return."
| exprTranslation lastExpr |
exprTranslation := value asTranslatorNodeIn: aTMethod.
(value isMessage
and: [value receiver isVariable
and: [value receiver name = 'super'
and: [exprTranslation isStmtList]]]) ifTrue:
["super expansions containing returns are fine, and (as of 6/25/2012 19:27) the last
return is elided from the expansion by TMethod>>superExpansionNodeFor:args:.
So we need to ensure the last expression is a return and simply reuse any other
returns in the expansion."
lastExpr := exprTranslation statements last.
(lastExpr isReturn
or: [lastExpr isReturningIf]) ifFalse:
[exprTranslation statements
at: exprTranslation statements size
put:
(TReturnNode new
setExpression: lastExpr;
+ comment: self commentOrNil;
- comment: self missingCommentNeededForCTranslation;
yourself)].
^exprTranslation].
^TReturnNode new
setExpression: exprTranslation;
+ comment: self commentOrNil;
- comment: self missingCommentNeededForCTranslation;
yourself!
Item was changed:
----- Method: RBSequenceNode>>asTranslatorNodeIn: (in category '*VMMakerCompatibilityForPharo6-C translation') -----
asTranslatorNodeIn: aTMethod
"Answer a TParseNode subclass equivalent of me"
| statementList |
statementList := OrderedCollection new.
statements do:
[:s | | newS |
newS := s asTranslatorNodeIn: aTMethod.
"inline the statement list returned when a CascadeNode is translated and/or when ifNotNil: is transformed"
newS isStmtList
ifTrue: [statementList addAll: newS statements]
ifFalse: [statementList add: newS]].
^TStmtListNode new
+ setArguments: (parent isMethod
+ ifTrue: [#()]
+ ifFalse: [parent arguments asArray collect: [:arg | arg name]])
- setArguments: (parent arguments asArray collect: [:arg | arg name])
statements: statementList;
+ comment: self commentOrNil!
- comment: self missingCommentNeededForCTranslation!
Item was added:
+ ----- Method: RBVariableNode>>isVariableNode (in category '*VMMakerCompatibilityForPharo6-testing') -----
+ isVariableNode
+ ^true!
Item was added:
+ InstructionPrinter subclass: #RelativeInstructionPrinter
+ instanceVariableNames: 'printCode labels labelling'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMakerCompatibilityForPharo6-Kernel-Methods'!
Item was added:
+ ----- Method: RelativeInstructionPrinter>>jump: (in category 'instruction decoding') -----
+ jump: offset
+ "Print the Unconditional Jump bytecode."
+
+ labelling
+ ifTrue:
+ [labels at: scanner pc + offset + 1 put: true.
+ self print: 'jumpBy: ', offset printString,
+ ' to: ', (scanner pc + offset - method initialPC) printString]
+ ifFalse:
+ [self print: 'jumpTo: ', (labels at: scanner pc + offset + 1)]!
Item was added:
+ ----- Method: RelativeInstructionPrinter>>jump:if: (in category 'instruction decoding') -----
+ jump: offset if: condition
+ "Print the Conditional Jump bytecode."
+
+ labelling
+ ifTrue:
+ [labels at: scanner pc + offset + 1 put: true.
+ self print:
+ (condition ifTrue: ['jumpTrueBy: '] ifFalse: ['jumpFalseBy: ']), offset printString,
+ ' to: ', (labelling
+ ifTrue: [(scanner pc + offset - method initialPC) printString]
+ ifFalse: [labels at: scanner pc + offset])]
+ ifFalse:
+ [self print:
+ (condition ifTrue: ['jumpTrueTo: '] ifFalse: ['jumpFalseTo: ']), (labels at: scanner pc + offset + 1)]!
Item was added:
+ ----- Method: RelativeInstructionPrinter>>print: (in category 'printing') -----
+ print: instruction
+ "Append to the receiver a description of the bytecode, instruction."
+
+ stream tab: self indent.
+ labelling
+ ifTrue: [stream print: oldPC - method initialPC; space]
+ ifFalse: [stream tab].
+ stream tab: (innerIndents at: oldPC).
+ self printCode ifTrue:
+ [stream nextPut: $<.
+ oldPC to: scanner pc - 1 do:
+ [:i | | code |
+ code := (method at: i) radix: 16.
+ stream
+ nextPut: (code size < 2 ifTrue: [$0] ifFalse: [code at: 1]);
+ nextPut: code last;
+ space].
+ stream skip: -1; nextPut: $>; space].
+ stream nextPutAll: instruction.
+ stream cr.
+ labelling ifFalse:
+ [(labels at: scanner pc + 1) ~~ false ifTrue:
+ [stream nextPutAll: (labels at: scanner pc + 1); nextPut: $:; cr]].
+ oldPC := scanner pc!
Item was added:
+ ----- Method: RelativeInstructionPrinter>>printCode (in category 'printing') -----
+ printCode
+ ^printCode ~~ false!
Item was added:
+ ----- Method: RelativeInstructionPrinter>>printCode: (in category 'initialize-release') -----
+ printCode: aBoolean
+ printCode := aBoolean!
Item was added:
+ ----- Method: RelativeInstructionPrinter>>printInstructionsOn: (in category 'printing') -----
+ printInstructionsOn: aStream
+ "Append to the stream, aStream, a description of each bytecode in the instruction stream."
+
+ | label |
+ labelling := true.
+ labels := Array new: method size + 1 withAll: false.
+ super printInstructionsOn: (String new: 1024) writeStream.
+ label := 0.
+ labels withIndexDo:
+ [:bool :index|
+ bool ifTrue: [labels at: index put: 'L', (label := label + 1) printString]].
+ labelling := false.
+ super printInstructionsOn: aStream!
Item was added:
+ ----- Method: RelativeInstructionPrinter>>printInstructionsOn:do: (in category 'printing') -----
+ printInstructionsOn: aStream do: aBlock
+ "Append to the stream, aStream, a description of each bytecode in the instruction stream.
+ Evaluate aBlock with the receiver, the scanner and the stream after each instruction."
+
+ | label |
+ labelling := true.
+ labels := Array new: method size withAll: false.
+ super printInstructionsOn: (String new: 1024) writeStream do: [:ig :no :re|].
+ label := 0.
+ labels withIndexDo:
+ [:bool :index|
+ bool ifTrue: [labels at: index put: 'L', (label := label + 1) printString]].
+ labelling := false.
+ super printInstructionsOn: aStream do: aBlock!
Item was added:
+ ----- Method: String>>withBlanksTrimmed (in category '*VMMakerCompatibilityForPharo6-converting') -----
+ withBlanksTrimmed
+ "Return a copy of the receiver from which leading and trailing blanks have been trimmed."
+
+ | first last |
+ first := self indexOfAnyOf: CharacterSet nonSeparators startingAt: 1.
+ first = 0 ifTrue: [ ^'' ]. "no non-separator character"
+ last := self lastIndexOfAnyOf: CharacterSet nonSeparators startingAt: self size ifAbsent: [self size].
+ (first = 1 and: [ last = self size ]) ifTrue: [ ^self copy ].
+ ^self
+ copyFrom: first
+ to: last
+ !
More information about the Vm-dev
mailing list